diff --git a/Lang/360-Assembly/Abundant,-deficient-and-perfect-number-classifications b/Lang/360-Assembly/Abundant,-deficient-and-perfect-number-classifications new file mode 120000 index 0000000000..14f8d74557 --- /dev/null +++ b/Lang/360-Assembly/Abundant,-deficient-and-perfect-number-classifications @@ -0,0 +1 @@ +../../Task/Abundant,-deficient-and-perfect-number-classifications/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Address-of-a-variable b/Lang/360-Assembly/Address-of-a-variable new file mode 120000 index 0000000000..2a7b9e38d9 --- /dev/null +++ b/Lang/360-Assembly/Address-of-a-variable @@ -0,0 +1 @@ +../../Task/Address-of-a-variable/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Balanced-brackets b/Lang/360-Assembly/Balanced-brackets new file mode 120000 index 0000000000..86367e96ab --- /dev/null +++ b/Lang/360-Assembly/Balanced-brackets @@ -0,0 +1 @@ +../../Task/Balanced-brackets/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Boolean-values b/Lang/360-Assembly/Boolean-values new file mode 120000 index 0000000000..f3436bc0b4 --- /dev/null +++ b/Lang/360-Assembly/Boolean-values @@ -0,0 +1 @@ +../../Task/Boolean-values/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Calendar b/Lang/360-Assembly/Calendar new file mode 120000 index 0000000000..99768532b4 --- /dev/null +++ b/Lang/360-Assembly/Calendar @@ -0,0 +1 @@ +../../Task/Calendar/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Combinations b/Lang/360-Assembly/Combinations new file mode 120000 index 0000000000..bb2132c9e9 --- /dev/null +++ b/Lang/360-Assembly/Combinations @@ -0,0 +1 @@ +../../Task/Combinations/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Count-in-octal b/Lang/360-Assembly/Count-in-octal new file mode 120000 index 0000000000..7efdb49f0a --- /dev/null +++ b/Lang/360-Assembly/Count-in-octal @@ -0,0 +1 @@ +../../Task/Count-in-octal/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Count-occurrences-of-a-substring b/Lang/360-Assembly/Count-occurrences-of-a-substring new file mode 120000 index 0000000000..887bd3cdc8 --- /dev/null +++ b/Lang/360-Assembly/Count-occurrences-of-a-substring @@ -0,0 +1 @@ +../../Task/Count-occurrences-of-a-substring/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Day-of-the-week b/Lang/360-Assembly/Day-of-the-week new file mode 120000 index 0000000000..f9084c519a --- /dev/null +++ b/Lang/360-Assembly/Day-of-the-week @@ -0,0 +1 @@ +../../Task/Day-of-the-week/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Dot-product b/Lang/360-Assembly/Dot-product new file mode 120000 index 0000000000..74df57b654 --- /dev/null +++ b/Lang/360-Assembly/Dot-product @@ -0,0 +1 @@ +../../Task/Dot-product/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Five-weekends b/Lang/360-Assembly/Five-weekends new file mode 120000 index 0000000000..875cfe1b7b --- /dev/null +++ b/Lang/360-Assembly/Five-weekends @@ -0,0 +1 @@ +../../Task/Five-weekends/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Generic-swap b/Lang/360-Assembly/Generic-swap new file mode 120000 index 0000000000..89f25c32d8 --- /dev/null +++ b/Lang/360-Assembly/Generic-swap @@ -0,0 +1 @@ +../../Task/Generic-swap/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Greatest-common-divisor b/Lang/360-Assembly/Greatest-common-divisor new file mode 120000 index 0000000000..e81e395647 --- /dev/null +++ b/Lang/360-Assembly/Greatest-common-divisor @@ -0,0 +1 @@ +../../Task/Greatest-common-divisor/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Hello-world-Line-printer b/Lang/360-Assembly/Hello-world-Line-printer new file mode 120000 index 0000000000..9fc96bb523 --- /dev/null +++ b/Lang/360-Assembly/Hello-world-Line-printer @@ -0,0 +1 @@ +../../Task/Hello-world-Line-printer/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Hofstadter-Conway-$10,000-sequence b/Lang/360-Assembly/Hofstadter-Conway-$10,000-sequence new file mode 120000 index 0000000000..2ecc4e6aa9 --- /dev/null +++ b/Lang/360-Assembly/Hofstadter-Conway-$10,000-sequence @@ -0,0 +1 @@ +../../Task/Hofstadter-Conway-$10,000-sequence/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Holidays-related-to-Easter b/Lang/360-Assembly/Holidays-related-to-Easter new file mode 120000 index 0000000000..9fabe196ba --- /dev/null +++ b/Lang/360-Assembly/Holidays-related-to-Easter @@ -0,0 +1 @@ +../../Task/Holidays-related-to-Easter/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Integer-sequence b/Lang/360-Assembly/Integer-sequence new file mode 120000 index 0000000000..1f358e7906 --- /dev/null +++ b/Lang/360-Assembly/Integer-sequence @@ -0,0 +1 @@ +../../Task/Integer-sequence/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Ludic-numbers b/Lang/360-Assembly/Ludic-numbers new file mode 120000 index 0000000000..13e72ba1ff --- /dev/null +++ b/Lang/360-Assembly/Ludic-numbers @@ -0,0 +1 @@ +../../Task/Ludic-numbers/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Luhn-test-of-credit-card-numbers b/Lang/360-Assembly/Luhn-test-of-credit-card-numbers new file mode 120000 index 0000000000..459869f068 --- /dev/null +++ b/Lang/360-Assembly/Luhn-test-of-credit-card-numbers @@ -0,0 +1 @@ +../../Task/Luhn-test-of-credit-card-numbers/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Matrix-arithmetic b/Lang/360-Assembly/Matrix-arithmetic new file mode 120000 index 0000000000..c66460d304 --- /dev/null +++ b/Lang/360-Assembly/Matrix-arithmetic @@ -0,0 +1 @@ +../../Task/Matrix-arithmetic/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Matrix-transposition b/Lang/360-Assembly/Matrix-transposition new file mode 120000 index 0000000000..999b069a26 --- /dev/null +++ b/Lang/360-Assembly/Matrix-transposition @@ -0,0 +1 @@ +../../Task/Matrix-transposition/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Multifactorial b/Lang/360-Assembly/Multifactorial new file mode 120000 index 0000000000..ee646850b5 --- /dev/null +++ b/Lang/360-Assembly/Multifactorial @@ -0,0 +1 @@ +../../Task/Multifactorial/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Perfect-numbers b/Lang/360-Assembly/Perfect-numbers new file mode 120000 index 0000000000..ccd5599a34 --- /dev/null +++ b/Lang/360-Assembly/Perfect-numbers @@ -0,0 +1 @@ +../../Task/Perfect-numbers/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Pernicious-numbers b/Lang/360-Assembly/Pernicious-numbers new file mode 120000 index 0000000000..a45008e22d --- /dev/null +++ b/Lang/360-Assembly/Pernicious-numbers @@ -0,0 +1 @@ +../../Task/Pernicious-numbers/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Pi b/Lang/360-Assembly/Pi new file mode 120000 index 0000000000..4c6fd10d64 --- /dev/null +++ b/Lang/360-Assembly/Pi @@ -0,0 +1 @@ +../../Task/Pi/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Read-a-file-line-by-line b/Lang/360-Assembly/Read-a-file-line-by-line new file mode 120000 index 0000000000..02289fa7f3 --- /dev/null +++ b/Lang/360-Assembly/Read-a-file-line-by-line @@ -0,0 +1 @@ +../../Task/Read-a-file-line-by-line/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Reverse-a-string b/Lang/360-Assembly/Reverse-a-string new file mode 120000 index 0000000000..d1b4aa2c09 --- /dev/null +++ b/Lang/360-Assembly/Reverse-a-string @@ -0,0 +1 @@ +../../Task/Reverse-a-string/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Sorting-algorithms-Bead-sort b/Lang/360-Assembly/Sorting-algorithms-Bead-sort new file mode 120000 index 0000000000..8003d1556f --- /dev/null +++ b/Lang/360-Assembly/Sorting-algorithms-Bead-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Bead-sort/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Sorting-algorithms-Cocktail-sort b/Lang/360-Assembly/Sorting-algorithms-Cocktail-sort new file mode 120000 index 0000000000..2fe0aca0a9 --- /dev/null +++ b/Lang/360-Assembly/Sorting-algorithms-Cocktail-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Cocktail-sort/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Sorting-algorithms-Comb-sort b/Lang/360-Assembly/Sorting-algorithms-Comb-sort new file mode 120000 index 0000000000..1e7b109bc7 --- /dev/null +++ b/Lang/360-Assembly/Sorting-algorithms-Comb-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Comb-sort/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Sorting-algorithms-Heapsort b/Lang/360-Assembly/Sorting-algorithms-Heapsort new file mode 120000 index 0000000000..c8481f9d6a --- /dev/null +++ b/Lang/360-Assembly/Sorting-algorithms-Heapsort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Heapsort/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Sorting-algorithms-Insertion-sort b/Lang/360-Assembly/Sorting-algorithms-Insertion-sort new file mode 120000 index 0000000000..73d819cd60 --- /dev/null +++ b/Lang/360-Assembly/Sorting-algorithms-Insertion-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Insertion-sort/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Sorting-algorithms-Merge-sort b/Lang/360-Assembly/Sorting-algorithms-Merge-sort new file mode 120000 index 0000000000..e8bf5f91e1 --- /dev/null +++ b/Lang/360-Assembly/Sorting-algorithms-Merge-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Merge-sort/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Sorting-algorithms-Selection-sort b/Lang/360-Assembly/Sorting-algorithms-Selection-sort new file mode 120000 index 0000000000..db02d11a79 --- /dev/null +++ b/Lang/360-Assembly/Sorting-algorithms-Selection-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Selection-sort/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Sorting-algorithms-Shell-sort b/Lang/360-Assembly/Sorting-algorithms-Shell-sort new file mode 120000 index 0000000000..71426e96ef --- /dev/null +++ b/Lang/360-Assembly/Sorting-algorithms-Shell-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Shell-sort/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/String-length b/Lang/360-Assembly/String-length new file mode 120000 index 0000000000..b4aeccc79a --- /dev/null +++ b/Lang/360-Assembly/String-length @@ -0,0 +1 @@ +../../Task/String-length/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Strip-a-set-of-characters-from-a-string b/Lang/360-Assembly/Strip-a-set-of-characters-from-a-string new file mode 120000 index 0000000000..b8db6850f9 --- /dev/null +++ b/Lang/360-Assembly/Strip-a-set-of-characters-from-a-string @@ -0,0 +1 @@ +../../Task/Strip-a-set-of-characters-from-a-string/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Sum-digits-of-an-integer b/Lang/360-Assembly/Sum-digits-of-an-integer new file mode 120000 index 0000000000..d3aeb34468 --- /dev/null +++ b/Lang/360-Assembly/Sum-digits-of-an-integer @@ -0,0 +1 @@ +../../Task/Sum-digits-of-an-integer/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Topswops b/Lang/360-Assembly/Topswops new file mode 120000 index 0000000000..a919fa842d --- /dev/null +++ b/Lang/360-Assembly/Topswops @@ -0,0 +1 @@ +../../Task/Topswops/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Ulam-spiral--for-primes- b/Lang/360-Assembly/Ulam-spiral--for-primes- new file mode 120000 index 0000000000..4ac8789205 --- /dev/null +++ b/Lang/360-Assembly/Ulam-spiral--for-primes- @@ -0,0 +1 @@ +../../Task/Ulam-spiral--for-primes-/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Variables b/Lang/360-Assembly/Variables new file mode 120000 index 0000000000..0c05087553 --- /dev/null +++ b/Lang/360-Assembly/Variables @@ -0,0 +1 @@ +../../Task/Variables/360-Assembly \ No newline at end of file diff --git a/Lang/360-Assembly/Write-language-name-in-3D-ASCII b/Lang/360-Assembly/Write-language-name-in-3D-ASCII new file mode 120000 index 0000000000..f07f7d8aab --- /dev/null +++ b/Lang/360-Assembly/Write-language-name-in-3D-ASCII @@ -0,0 +1 @@ +../../Task/Write-language-name-in-3D-ASCII/360-Assembly \ No newline at end of file diff --git a/Lang/6502-Assembly/Fibonacci-sequence b/Lang/6502-Assembly/Fibonacci-sequence new file mode 120000 index 0000000000..03c9d78a6b --- /dev/null +++ b/Lang/6502-Assembly/Fibonacci-sequence @@ -0,0 +1 @@ +../../Task/Fibonacci-sequence/6502-Assembly \ No newline at end of file diff --git a/Lang/6502-Assembly/Function-definition b/Lang/6502-Assembly/Function-definition new file mode 120000 index 0000000000..bf82ee7d38 --- /dev/null +++ b/Lang/6502-Assembly/Function-definition @@ -0,0 +1 @@ +../../Task/Function-definition/6502-Assembly \ No newline at end of file diff --git a/Lang/6502-Assembly/Generate-lower-case-ASCII-alphabet b/Lang/6502-Assembly/Generate-lower-case-ASCII-alphabet new file mode 120000 index 0000000000..daf37e0f53 --- /dev/null +++ b/Lang/6502-Assembly/Generate-lower-case-ASCII-alphabet @@ -0,0 +1 @@ +../../Task/Generate-lower-case-ASCII-alphabet/6502-Assembly \ No newline at end of file diff --git a/Lang/6502-Assembly/Josephus-problem b/Lang/6502-Assembly/Josephus-problem new file mode 120000 index 0000000000..ba41591ae7 --- /dev/null +++ b/Lang/6502-Assembly/Josephus-problem @@ -0,0 +1 @@ +../../Task/Josephus-problem/6502-Assembly \ No newline at end of file diff --git a/Lang/6502-Assembly/Sieve-of-Eratosthenes b/Lang/6502-Assembly/Sieve-of-Eratosthenes new file mode 120000 index 0000000000..821f92acc8 --- /dev/null +++ b/Lang/6502-Assembly/Sieve-of-Eratosthenes @@ -0,0 +1 @@ +../../Task/Sieve-of-Eratosthenes/6502-Assembly \ No newline at end of file diff --git a/Lang/8080-Assembly/Fibonacci-sequence b/Lang/8080-Assembly/Fibonacci-sequence new file mode 120000 index 0000000000..618f2bc246 --- /dev/null +++ b/Lang/8080-Assembly/Fibonacci-sequence @@ -0,0 +1 @@ +../../Task/Fibonacci-sequence/8080-Assembly \ No newline at end of file diff --git a/Lang/8080-Assembly/Integer-sequence b/Lang/8080-Assembly/Integer-sequence new file mode 120000 index 0000000000..765aac26f9 --- /dev/null +++ b/Lang/8080-Assembly/Integer-sequence @@ -0,0 +1 @@ +../../Task/Integer-sequence/8080-Assembly \ No newline at end of file diff --git a/Lang/8086-Assembly/Empty-program b/Lang/8086-Assembly/Empty-program new file mode 120000 index 0000000000..76cdd9e181 --- /dev/null +++ b/Lang/8086-Assembly/Empty-program @@ -0,0 +1 @@ +../../Task/Empty-program/8086-Assembly \ No newline at end of file diff --git a/Lang/ABAP/Execute-a-system-command b/Lang/ABAP/Execute-a-system-command new file mode 120000 index 0000000000..e837e6c69d --- /dev/null +++ b/Lang/ABAP/Execute-a-system-command @@ -0,0 +1 @@ +../../Task/Execute-a-system-command/ABAP \ No newline at end of file diff --git a/Lang/ALGOL-60/Loops-For-with-a-specified-step b/Lang/ALGOL-60/Loops-For-with-a-specified-step new file mode 120000 index 0000000000..fc485f6731 --- /dev/null +++ b/Lang/ALGOL-60/Loops-For-with-a-specified-step @@ -0,0 +1 @@ +../../Task/Loops-For-with-a-specified-step/ALGOL-60 \ No newline at end of file diff --git a/Lang/ALGOL-68/00DESCRIPTION b/Lang/ALGOL-68/00DESCRIPTION index 0fd2841a32..8dfde60d3b 100644 --- a/Lang/ALGOL-68/00DESCRIPTION +++ b/Lang/ALGOL-68/00DESCRIPTION @@ -174,11 +174,11 @@ e !colspan=5| Coercions available in this context !rowspan=2| Coercion examples |- -|bgcolor=eeeeee|Soft -|bgcolor=dddddd|Meek -|bgcolor=cccccc|Weak -|bgcolor=bbbbbb|Firm -|bgcolor=aaaaaa|Strong +|bgcolor=aaaaff|Soft +|bgcolor=aaeeaa|Weak +|bgcolor=ffee99|Meek +|bgcolor=ffcc99|Firm +|bgcolor=ffcccc|Strong |- !S
t
@@ -196,12 +196,12 @@ Also: * Statements yielding VOID * All parts (but one) of a balanced clause * One side of an identity relation, as "~" in: ~ IS ~ -|bgcolor=EEEEEE rowspan=4 width="50px"| deproc- eduring -|bgcolor=DDDDDD rowspan=3 width="50px"| all '''soft''' then weak deref- erencing -|bgcolor=CCCCCC rowspan=2 width="50px"| all '''weak''' then deref- erencing -|bgcolor=BBBBBB rowspan=1 width="50px"| all '''meek''' then uniting -|bgcolor=AAAAAA width="50px"| all '''firm''' then widening, rowing and voiding -|colspan=1 bgcolor=AAAAAA| +|bgcolor=aaaaff rowspan=4 width="50px"| deproc- eduring +|bgcolor=aaeeaa rowspan=3 width="50px"| all '''soft''' then weak deref- erencing +|bgcolor=ffee99 rowspan=2 width="50px"| all '''weak''' then deref- erencing +|bgcolor=ffcc99 rowspan=1 width="50px"| all '''meek''' then uniting +|bgcolor=ffcccc width="50px"| all '''firm''' then widening, rowing and voiding +|colspan=1 bgcolor=ffcccc| Widening occurs if there is no loss of precision. For example: An INT will be coerced to a REAL, and a REAL will be coerced to a LONG REAL. But not vice-versa. Examples: INT to LONG INT INT to REAL @@ -221,7 +221,7 @@ m || *Operands of formulas as "~" in:OP: ~ * ~ *Parameters of transput calls -|colspan=3 bgcolor=BBBBBB| Example: +|colspan=3 bgcolor=ffcc99| Example: UNION(INT,REAL) var := 1 |- !M
@@ -234,7 +234,7 @@ k IF ~ THEN ... FI and FROM ~ BY ~ TO ~ WHILE ~ DO ... OD etc * Primaries of calls (e.g. sin in sin(x)) -|colspan=4 bgcolor=CCCCCC|Examples: +|colspan=4 bgcolor=ffee99|Examples: REF REF BOOL to BOOL REF REF REF INT to INT |- @@ -245,7 +245,7 @@ k || * Primaries of slices, as in "~" in: ~[1:99] * Secondaries of selections, as "~" in: value OF ~ -|colspan=5 bgcolor=DDDDDD|Examples: +|colspan=5 bgcolor=aaeeaa|Examples: REF BOOL to REF BOOL REF REF INT to REF INT REF REF REF REAL to REF REAL @@ -256,7 +256,7 @@ o
f
t || The LHS of assignments, as "~" in: ~ := ... -|colspan=6 bgcolor=EEEEEE| Example: +|colspan=6 bgcolor=aaaaff| Example: * deproceduring of: PROC REAL random: e.g. random |} For more details about Primaries and Secondaries refer to [[Operator_precedence#ALGOL_68|Operator precedence]]. diff --git a/Lang/ALGOL-68/Abundant,-deficient-and-perfect-number-classifications b/Lang/ALGOL-68/Abundant,-deficient-and-perfect-number-classifications new file mode 120000 index 0000000000..e4ae210a06 --- /dev/null +++ b/Lang/ALGOL-68/Abundant,-deficient-and-perfect-number-classifications @@ -0,0 +1 @@ +../../Task/Abundant,-deficient-and-perfect-number-classifications/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Amicable-pairs b/Lang/ALGOL-68/Amicable-pairs new file mode 120000 index 0000000000..6e3fb45283 --- /dev/null +++ b/Lang/ALGOL-68/Amicable-pairs @@ -0,0 +1 @@ +../../Task/Amicable-pairs/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Anagrams b/Lang/ALGOL-68/Anagrams new file mode 120000 index 0000000000..7d9218588d --- /dev/null +++ b/Lang/ALGOL-68/Anagrams @@ -0,0 +1 @@ +../../Task/Anagrams/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Anagrams-Deranged-anagrams b/Lang/ALGOL-68/Anagrams-Deranged-anagrams new file mode 120000 index 0000000000..85de485f7e --- /dev/null +++ b/Lang/ALGOL-68/Anagrams-Deranged-anagrams @@ -0,0 +1 @@ +../../Task/Anagrams-Deranged-anagrams/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Anonymous-recursion b/Lang/ALGOL-68/Anonymous-recursion new file mode 120000 index 0000000000..2e031c9a76 --- /dev/null +++ b/Lang/ALGOL-68/Anonymous-recursion @@ -0,0 +1 @@ +../../Task/Anonymous-recursion/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Associative-array-Iteration b/Lang/ALGOL-68/Associative-array-Iteration new file mode 120000 index 0000000000..5c8b546fe8 --- /dev/null +++ b/Lang/ALGOL-68/Associative-array-Iteration @@ -0,0 +1 @@ +../../Task/Associative-array-Iteration/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Averages-Mean-angle b/Lang/ALGOL-68/Averages-Mean-angle new file mode 120000 index 0000000000..0b507ebc73 --- /dev/null +++ b/Lang/ALGOL-68/Averages-Mean-angle @@ -0,0 +1 @@ +../../Task/Averages-Mean-angle/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Carmichael-3-strong-pseudoprimes b/Lang/ALGOL-68/Carmichael-3-strong-pseudoprimes new file mode 120000 index 0000000000..d209ce17de --- /dev/null +++ b/Lang/ALGOL-68/Carmichael-3-strong-pseudoprimes @@ -0,0 +1 @@ +../../Task/Carmichael-3-strong-pseudoprimes/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Catalan-numbers b/Lang/ALGOL-68/Catalan-numbers new file mode 120000 index 0000000000..404173cdc1 --- /dev/null +++ b/Lang/ALGOL-68/Catalan-numbers @@ -0,0 +1 @@ +../../Task/Catalan-numbers/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Catalan-numbers-Pascals-triangle b/Lang/ALGOL-68/Catalan-numbers-Pascals-triangle new file mode 120000 index 0000000000..f40c9567c1 --- /dev/null +++ b/Lang/ALGOL-68/Catalan-numbers-Pascals-triangle @@ -0,0 +1 @@ +../../Task/Catalan-numbers-Pascals-triangle/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Catamorphism b/Lang/ALGOL-68/Catamorphism new file mode 120000 index 0000000000..97d40a95c6 --- /dev/null +++ b/Lang/ALGOL-68/Catamorphism @@ -0,0 +1 @@ +../../Task/Catamorphism/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Check-that-file-exists b/Lang/ALGOL-68/Check-that-file-exists new file mode 120000 index 0000000000..e81710f720 --- /dev/null +++ b/Lang/ALGOL-68/Check-that-file-exists @@ -0,0 +1 @@ +../../Task/Check-that-file-exists/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Circles-of-given-radius-through-two-points b/Lang/ALGOL-68/Circles-of-given-radius-through-two-points new file mode 120000 index 0000000000..864b54da88 --- /dev/null +++ b/Lang/ALGOL-68/Circles-of-given-radius-through-two-points @@ -0,0 +1 @@ +../../Task/Circles-of-given-radius-through-two-points/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Collections b/Lang/ALGOL-68/Collections new file mode 120000 index 0000000000..49cb69a84e --- /dev/null +++ b/Lang/ALGOL-68/Collections @@ -0,0 +1 @@ +../../Task/Collections/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Create-an-HTML-table b/Lang/ALGOL-68/Create-an-HTML-table new file mode 120000 index 0000000000..4a28ba2148 --- /dev/null +++ b/Lang/ALGOL-68/Create-an-HTML-table @@ -0,0 +1 @@ +../../Task/Create-an-HTML-table/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Digital-root b/Lang/ALGOL-68/Digital-root new file mode 120000 index 0000000000..09dec5dbc8 --- /dev/null +++ b/Lang/ALGOL-68/Digital-root @@ -0,0 +1 @@ +../../Task/Digital-root/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Dinesmans-multiple-dwelling-problem b/Lang/ALGOL-68/Dinesmans-multiple-dwelling-problem new file mode 120000 index 0000000000..f95ef3b5cf --- /dev/null +++ b/Lang/ALGOL-68/Dinesmans-multiple-dwelling-problem @@ -0,0 +1 @@ +../../Task/Dinesmans-multiple-dwelling-problem/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Empty-directory b/Lang/ALGOL-68/Empty-directory new file mode 120000 index 0000000000..17b96fc141 --- /dev/null +++ b/Lang/ALGOL-68/Empty-directory @@ -0,0 +1 @@ +../../Task/Empty-directory/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Execute-HQ9+ b/Lang/ALGOL-68/Execute-HQ9+ new file mode 120000 index 0000000000..8dfa6f2e2d --- /dev/null +++ b/Lang/ALGOL-68/Execute-HQ9+ @@ -0,0 +1 @@ +../../Task/Execute-HQ9+/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Extend-your-language b/Lang/ALGOL-68/Extend-your-language new file mode 120000 index 0000000000..94068d8fb5 --- /dev/null +++ b/Lang/ALGOL-68/Extend-your-language @@ -0,0 +1 @@ +../../Task/Extend-your-language/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Fibonacci-n-step-number-sequences b/Lang/ALGOL-68/Fibonacci-n-step-number-sequences new file mode 120000 index 0000000000..aec7f57865 --- /dev/null +++ b/Lang/ALGOL-68/Fibonacci-n-step-number-sequences @@ -0,0 +1 @@ +../../Task/Fibonacci-n-step-number-sequences/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Fractran b/Lang/ALGOL-68/Fractran new file mode 120000 index 0000000000..48795af30b --- /dev/null +++ b/Lang/ALGOL-68/Fractran @@ -0,0 +1 @@ +../../Task/Fractran/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Hello-world-Newline-omission b/Lang/ALGOL-68/Hello-world-Newline-omission new file mode 120000 index 0000000000..61b3d6226b --- /dev/null +++ b/Lang/ALGOL-68/Hello-world-Newline-omission @@ -0,0 +1 @@ +../../Task/Hello-world-Newline-omission/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Heronian-triangles b/Lang/ALGOL-68/Heronian-triangles new file mode 120000 index 0000000000..d286859a4c --- /dev/null +++ b/Lang/ALGOL-68/Heronian-triangles @@ -0,0 +1 @@ +../../Task/Heronian-triangles/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Hickerson-series-of-almost-integers b/Lang/ALGOL-68/Hickerson-series-of-almost-integers new file mode 120000 index 0000000000..411dd758ac --- /dev/null +++ b/Lang/ALGOL-68/Hickerson-series-of-almost-integers @@ -0,0 +1 @@ +../../Task/Hickerson-series-of-almost-integers/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/I-before-E-except-after-C b/Lang/ALGOL-68/I-before-E-except-after-C new file mode 120000 index 0000000000..d39ec1e2ec --- /dev/null +++ b/Lang/ALGOL-68/I-before-E-except-after-C @@ -0,0 +1 @@ +../../Task/I-before-E-except-after-C/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Inverted-syntax b/Lang/ALGOL-68/Inverted-syntax new file mode 120000 index 0000000000..b53703886e --- /dev/null +++ b/Lang/ALGOL-68/Inverted-syntax @@ -0,0 +1 @@ +../../Task/Inverted-syntax/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Iterated-digits-squaring b/Lang/ALGOL-68/Iterated-digits-squaring new file mode 120000 index 0000000000..0077dcec55 --- /dev/null +++ b/Lang/ALGOL-68/Iterated-digits-squaring @@ -0,0 +1 @@ +../../Task/Iterated-digits-squaring/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Kaprekar-numbers b/Lang/ALGOL-68/Kaprekar-numbers new file mode 120000 index 0000000000..65eeb909c7 --- /dev/null +++ b/Lang/ALGOL-68/Kaprekar-numbers @@ -0,0 +1 @@ +../../Task/Kaprekar-numbers/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Literals-Floating-point b/Lang/ALGOL-68/Literals-Floating-point new file mode 120000 index 0000000000..bf7a8ec041 --- /dev/null +++ b/Lang/ALGOL-68/Literals-Floating-point @@ -0,0 +1 @@ +../../Task/Literals-Floating-point/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Ludic-numbers b/Lang/ALGOL-68/Ludic-numbers new file mode 120000 index 0000000000..dc4c914385 --- /dev/null +++ b/Lang/ALGOL-68/Ludic-numbers @@ -0,0 +1 @@ +../../Task/Ludic-numbers/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Magic-squares-of-odd-order b/Lang/ALGOL-68/Magic-squares-of-odd-order new file mode 120000 index 0000000000..35446cbf6a --- /dev/null +++ b/Lang/ALGOL-68/Magic-squares-of-odd-order @@ -0,0 +1 @@ +../../Task/Magic-squares-of-odd-order/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Map-range b/Lang/ALGOL-68/Map-range new file mode 120000 index 0000000000..b34a1838a2 --- /dev/null +++ b/Lang/ALGOL-68/Map-range @@ -0,0 +1 @@ +../../Task/Map-range/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Narcissistic-decimal-number b/Lang/ALGOL-68/Narcissistic-decimal-number new file mode 120000 index 0000000000..5b61df8f3c --- /dev/null +++ b/Lang/ALGOL-68/Narcissistic-decimal-number @@ -0,0 +1 @@ +../../Task/Narcissistic-decimal-number/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Numeric-error-propagation b/Lang/ALGOL-68/Numeric-error-propagation new file mode 120000 index 0000000000..b7e5189f8a --- /dev/null +++ b/Lang/ALGOL-68/Numeric-error-propagation @@ -0,0 +1 @@ +../../Task/Numeric-error-propagation/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Optional-parameters b/Lang/ALGOL-68/Optional-parameters new file mode 120000 index 0000000000..14b2ecc080 --- /dev/null +++ b/Lang/ALGOL-68/Optional-parameters @@ -0,0 +1 @@ +../../Task/Optional-parameters/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Ordered-words b/Lang/ALGOL-68/Ordered-words new file mode 120000 index 0000000000..e6e1477767 --- /dev/null +++ b/Lang/ALGOL-68/Ordered-words @@ -0,0 +1 @@ +../../Task/Ordered-words/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Pernicious-numbers b/Lang/ALGOL-68/Pernicious-numbers new file mode 120000 index 0000000000..0fdbbcfe4c --- /dev/null +++ b/Lang/ALGOL-68/Pernicious-numbers @@ -0,0 +1 @@ +../../Task/Pernicious-numbers/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Remove-duplicate-elements b/Lang/ALGOL-68/Remove-duplicate-elements new file mode 120000 index 0000000000..938a77501c --- /dev/null +++ b/Lang/ALGOL-68/Remove-duplicate-elements @@ -0,0 +1 @@ +../../Task/Remove-duplicate-elements/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Reverse-words-in-a-string b/Lang/ALGOL-68/Reverse-words-in-a-string new file mode 120000 index 0000000000..b5287ca2a3 --- /dev/null +++ b/Lang/ALGOL-68/Reverse-words-in-a-string @@ -0,0 +1 @@ +../../Task/Reverse-words-in-a-string/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/S-Expressions b/Lang/ALGOL-68/S-Expressions new file mode 120000 index 0000000000..1f9777a246 --- /dev/null +++ b/Lang/ALGOL-68/S-Expressions @@ -0,0 +1 @@ +../../Task/S-Expressions/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Scope-Function-names-and-labels b/Lang/ALGOL-68/Scope-Function-names-and-labels new file mode 120000 index 0000000000..ca764c2a36 --- /dev/null +++ b/Lang/ALGOL-68/Scope-Function-names-and-labels @@ -0,0 +1 @@ +../../Task/Scope-Function-names-and-labels/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Semiprime b/Lang/ALGOL-68/Semiprime new file mode 120000 index 0000000000..2fcfdc8f40 --- /dev/null +++ b/Lang/ALGOL-68/Semiprime @@ -0,0 +1 @@ +../../Task/Semiprime/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Semordnilap b/Lang/ALGOL-68/Semordnilap new file mode 120000 index 0000000000..b25fdff9f3 --- /dev/null +++ b/Lang/ALGOL-68/Semordnilap @@ -0,0 +1 @@ +../../Task/Semordnilap/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Sequence-of-primes-by-Trial-Division b/Lang/ALGOL-68/Sequence-of-primes-by-Trial-Division new file mode 120000 index 0000000000..df1841f2f5 --- /dev/null +++ b/Lang/ALGOL-68/Sequence-of-primes-by-Trial-Division @@ -0,0 +1 @@ +../../Task/Sequence-of-primes-by-Trial-Division/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Solve-a-Holy-Knights-tour b/Lang/ALGOL-68/Solve-a-Holy-Knights-tour new file mode 120000 index 0000000000..c50e19a50c --- /dev/null +++ b/Lang/ALGOL-68/Solve-a-Holy-Knights-tour @@ -0,0 +1 @@ +../../Task/Solve-a-Holy-Knights-tour/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Sorting-algorithms-Stooge-sort b/Lang/ALGOL-68/Sorting-algorithms-Stooge-sort new file mode 120000 index 0000000000..f1c594947a --- /dev/null +++ b/Lang/ALGOL-68/Sorting-algorithms-Stooge-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Stooge-sort/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/String-comparison b/Lang/ALGOL-68/String-comparison new file mode 120000 index 0000000000..0443448136 --- /dev/null +++ b/Lang/ALGOL-68/String-comparison @@ -0,0 +1 @@ +../../Task/String-comparison/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Strip-control-codes-and-extended-characters-from-a-string b/Lang/ALGOL-68/Strip-control-codes-and-extended-characters-from-a-string new file mode 120000 index 0000000000..83d074ee7b --- /dev/null +++ b/Lang/ALGOL-68/Strip-control-codes-and-extended-characters-from-a-string @@ -0,0 +1 @@ +../../Task/Strip-control-codes-and-extended-characters-from-a-string/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Sum-multiples-of-3-and-5 b/Lang/ALGOL-68/Sum-multiples-of-3-and-5 new file mode 120000 index 0000000000..70c0f42a3c --- /dev/null +++ b/Lang/ALGOL-68/Sum-multiples-of-3-and-5 @@ -0,0 +1 @@ +../../Task/Sum-multiples-of-3-and-5/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Textonyms b/Lang/ALGOL-68/Textonyms new file mode 120000 index 0000000000..34b16a1bad --- /dev/null +++ b/Lang/ALGOL-68/Textonyms @@ -0,0 +1 @@ +../../Task/Textonyms/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/The-Twelve-Days-of-Christmas b/Lang/ALGOL-68/The-Twelve-Days-of-Christmas new file mode 120000 index 0000000000..544343d706 --- /dev/null +++ b/Lang/ALGOL-68/The-Twelve-Days-of-Christmas @@ -0,0 +1 @@ +../../Task/The-Twelve-Days-of-Christmas/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Visualize-a-tree b/Lang/ALGOL-68/Visualize-a-tree new file mode 120000 index 0000000000..4417b3de7f --- /dev/null +++ b/Lang/ALGOL-68/Visualize-a-tree @@ -0,0 +1 @@ +../../Task/Visualize-a-tree/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/XML-Output b/Lang/ALGOL-68/XML-Output new file mode 120000 index 0000000000..8a244c0014 --- /dev/null +++ b/Lang/ALGOL-68/XML-Output @@ -0,0 +1 @@ +../../Task/XML-Output/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Zeckendorf-number-representation b/Lang/ALGOL-68/Zeckendorf-number-representation new file mode 120000 index 0000000000..d5b5259ea8 --- /dev/null +++ b/Lang/ALGOL-68/Zeckendorf-number-representation @@ -0,0 +1 @@ +../../Task/Zeckendorf-number-representation/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-W/Execute-HQ9+ b/Lang/ALGOL-W/Execute-HQ9+ new file mode 120000 index 0000000000..c25fcd4e1a --- /dev/null +++ b/Lang/ALGOL-W/Execute-HQ9+ @@ -0,0 +1 @@ +../../Task/Execute-HQ9+/ALGOL-W \ No newline at end of file diff --git a/Lang/ALGOL-W/Factors-of-an-integer b/Lang/ALGOL-W/Factors-of-an-integer new file mode 120000 index 0000000000..e9d7032cc0 --- /dev/null +++ b/Lang/ALGOL-W/Factors-of-an-integer @@ -0,0 +1 @@ +../../Task/Factors-of-an-integer/ALGOL-W \ No newline at end of file diff --git a/Lang/ALGOL-W/Fibonacci-sequence b/Lang/ALGOL-W/Fibonacci-sequence new file mode 120000 index 0000000000..a7077daa9b --- /dev/null +++ b/Lang/ALGOL-W/Fibonacci-sequence @@ -0,0 +1 @@ +../../Task/Fibonacci-sequence/ALGOL-W \ No newline at end of file diff --git a/Lang/ALGOL-W/Heronian-triangles b/Lang/ALGOL-W/Heronian-triangles new file mode 120000 index 0000000000..4fc1949c30 --- /dev/null +++ b/Lang/ALGOL-W/Heronian-triangles @@ -0,0 +1 @@ +../../Task/Heronian-triangles/ALGOL-W \ No newline at end of file diff --git a/Lang/ALGOL-W/Identity-matrix b/Lang/ALGOL-W/Identity-matrix new file mode 120000 index 0000000000..fd27b23bc7 --- /dev/null +++ b/Lang/ALGOL-W/Identity-matrix @@ -0,0 +1 @@ +../../Task/Identity-matrix/ALGOL-W \ No newline at end of file diff --git a/Lang/ALGOL-W/Integer-sequence b/Lang/ALGOL-W/Integer-sequence new file mode 120000 index 0000000000..cd072f7eb5 --- /dev/null +++ b/Lang/ALGOL-W/Integer-sequence @@ -0,0 +1 @@ +../../Task/Integer-sequence/ALGOL-W \ No newline at end of file diff --git a/Lang/ALGOL-W/Return-multiple-values b/Lang/ALGOL-W/Return-multiple-values new file mode 120000 index 0000000000..90e1c28599 --- /dev/null +++ b/Lang/ALGOL-W/Return-multiple-values @@ -0,0 +1 @@ +../../Task/Return-multiple-values/ALGOL-W \ No newline at end of file diff --git a/Lang/ALGOL-W/String-comparison b/Lang/ALGOL-W/String-comparison new file mode 120000 index 0000000000..01714b38e7 --- /dev/null +++ b/Lang/ALGOL-W/String-comparison @@ -0,0 +1 @@ +../../Task/String-comparison/ALGOL-W \ No newline at end of file diff --git a/Lang/ALGOL-W/Zig-zag-matrix b/Lang/ALGOL-W/Zig-zag-matrix new file mode 120000 index 0000000000..d7c53379ae --- /dev/null +++ b/Lang/ALGOL-W/Zig-zag-matrix @@ -0,0 +1 @@ +../../Task/Zig-zag-matrix/ALGOL-W \ No newline at end of file diff --git a/Lang/ALGOL/00DESCRIPTION b/Lang/ALGOL/00DESCRIPTION index db3c72c635..a332fceac0 100644 --- a/Lang/ALGOL/00DESCRIPTION +++ b/Lang/ALGOL/00DESCRIPTION @@ -1,4 +1,8 @@ {{stub}}{{language}} -;See +==See Also== * [[ALGOL 60]] -* [[ALGOL 68]] \ No newline at end of file +* [[ALGOL 68]] +* [[ALGOL W]] +
+* [[JOVIAL]] +* [[Simula]] \ No newline at end of file diff --git a/Lang/AMPL/Haversine-formula b/Lang/AMPL/Haversine-formula new file mode 120000 index 0000000000..3566c780e7 --- /dev/null +++ b/Lang/AMPL/Haversine-formula @@ -0,0 +1 @@ +../../Task/Haversine-formula/AMPL \ No newline at end of file diff --git a/Lang/APL/Arrays b/Lang/APL/Arrays new file mode 120000 index 0000000000..a11d3cb877 --- /dev/null +++ b/Lang/APL/Arrays @@ -0,0 +1 @@ +../../Task/Arrays/APL \ No newline at end of file diff --git a/Lang/APL/Averages-Mode b/Lang/APL/Averages-Mode new file mode 120000 index 0000000000..d743543f6b --- /dev/null +++ b/Lang/APL/Averages-Mode @@ -0,0 +1 @@ +../../Task/Averages-Mode/APL \ No newline at end of file diff --git a/Lang/APL/Caesar-cipher b/Lang/APL/Caesar-cipher new file mode 120000 index 0000000000..9f9616fcf4 --- /dev/null +++ b/Lang/APL/Caesar-cipher @@ -0,0 +1 @@ +../../Task/Caesar-cipher/APL \ No newline at end of file diff --git a/Lang/APL/Case-sensitivity-of-identifiers b/Lang/APL/Case-sensitivity-of-identifiers new file mode 120000 index 0000000000..ed4b5f504c --- /dev/null +++ b/Lang/APL/Case-sensitivity-of-identifiers @@ -0,0 +1 @@ +../../Task/Case-sensitivity-of-identifiers/APL \ No newline at end of file diff --git a/Lang/APL/Catalan-numbers b/Lang/APL/Catalan-numbers new file mode 120000 index 0000000000..09538d3297 --- /dev/null +++ b/Lang/APL/Catalan-numbers @@ -0,0 +1 @@ +../../Task/Catalan-numbers/APL \ No newline at end of file diff --git a/Lang/APL/Catalan-numbers-Pascals-triangle b/Lang/APL/Catalan-numbers-Pascals-triangle new file mode 120000 index 0000000000..ad414f4b9e --- /dev/null +++ b/Lang/APL/Catalan-numbers-Pascals-triangle @@ -0,0 +1 @@ +../../Task/Catalan-numbers-Pascals-triangle/APL \ No newline at end of file diff --git a/Lang/APL/Character-codes b/Lang/APL/Character-codes new file mode 120000 index 0000000000..317df38b8e --- /dev/null +++ b/Lang/APL/Character-codes @@ -0,0 +1 @@ +../../Task/Character-codes/APL \ No newline at end of file diff --git a/Lang/APL/Comments b/Lang/APL/Comments new file mode 120000 index 0000000000..bd292b60be --- /dev/null +++ b/Lang/APL/Comments @@ -0,0 +1 @@ +../../Task/Comments/APL \ No newline at end of file diff --git a/Lang/APL/Entropy b/Lang/APL/Entropy new file mode 120000 index 0000000000..1a8401c07e --- /dev/null +++ b/Lang/APL/Entropy @@ -0,0 +1 @@ +../../Task/Entropy/APL \ No newline at end of file diff --git a/Lang/APL/Even-or-odd b/Lang/APL/Even-or-odd new file mode 120000 index 0000000000..70fa67a19b --- /dev/null +++ b/Lang/APL/Even-or-odd @@ -0,0 +1 @@ +../../Task/Even-or-odd/APL \ No newline at end of file diff --git a/Lang/APL/Factorial b/Lang/APL/Factorial new file mode 120000 index 0000000000..8d87ad43d5 --- /dev/null +++ b/Lang/APL/Factorial @@ -0,0 +1 @@ +../../Task/Factorial/APL \ No newline at end of file diff --git a/Lang/APL/Fibonacci-word b/Lang/APL/Fibonacci-word new file mode 120000 index 0000000000..6b53d249bf --- /dev/null +++ b/Lang/APL/Fibonacci-word @@ -0,0 +1 @@ +../../Task/Fibonacci-word/APL \ No newline at end of file diff --git a/Lang/APL/Generate-lower-case-ASCII-alphabet b/Lang/APL/Generate-lower-case-ASCII-alphabet new file mode 120000 index 0000000000..db7c0eaaf9 --- /dev/null +++ b/Lang/APL/Generate-lower-case-ASCII-alphabet @@ -0,0 +1 @@ +../../Task/Generate-lower-case-ASCII-alphabet/APL \ No newline at end of file diff --git a/Lang/APL/Haversine-formula b/Lang/APL/Haversine-formula new file mode 120000 index 0000000000..d3f4ce3e56 --- /dev/null +++ b/Lang/APL/Haversine-formula @@ -0,0 +1 @@ +../../Task/Haversine-formula/APL \ No newline at end of file diff --git a/Lang/APL/Hello-world-Text b/Lang/APL/Hello-world-Text new file mode 120000 index 0000000000..8885b7bf57 --- /dev/null +++ b/Lang/APL/Hello-world-Text @@ -0,0 +1 @@ +../../Task/Hello-world-Text/APL \ No newline at end of file diff --git a/Lang/APL/Least-common-multiple b/Lang/APL/Least-common-multiple new file mode 120000 index 0000000000..9c865cb4ef --- /dev/null +++ b/Lang/APL/Least-common-multiple @@ -0,0 +1 @@ +../../Task/Least-common-multiple/APL \ No newline at end of file diff --git a/Lang/APL/Logical-operations b/Lang/APL/Logical-operations new file mode 120000 index 0000000000..52d87f5ea3 --- /dev/null +++ b/Lang/APL/Logical-operations @@ -0,0 +1 @@ +../../Task/Logical-operations/APL \ No newline at end of file diff --git a/Lang/APL/Repeat-a-string b/Lang/APL/Repeat-a-string new file mode 120000 index 0000000000..8743e5f05a --- /dev/null +++ b/Lang/APL/Repeat-a-string @@ -0,0 +1 @@ +../../Task/Repeat-a-string/APL \ No newline at end of file diff --git a/Lang/APL/Runge-Kutta-method b/Lang/APL/Runge-Kutta-method new file mode 120000 index 0000000000..772a4f930b --- /dev/null +++ b/Lang/APL/Runge-Kutta-method @@ -0,0 +1 @@ +../../Task/Runge-Kutta-method/APL \ No newline at end of file diff --git a/Lang/APL/Sequence-of-non-squares b/Lang/APL/Sequence-of-non-squares new file mode 120000 index 0000000000..6555d64876 --- /dev/null +++ b/Lang/APL/Sequence-of-non-squares @@ -0,0 +1 @@ +../../Task/Sequence-of-non-squares/APL \ No newline at end of file diff --git a/Lang/APL/Sieve-of-Eratosthenes b/Lang/APL/Sieve-of-Eratosthenes new file mode 120000 index 0000000000..d020b3842f --- /dev/null +++ b/Lang/APL/Sieve-of-Eratosthenes @@ -0,0 +1 @@ +../../Task/Sieve-of-Eratosthenes/APL \ No newline at end of file diff --git a/Lang/APL/Sort-disjoint-sublist b/Lang/APL/Sort-disjoint-sublist new file mode 120000 index 0000000000..2d2a88b2fd --- /dev/null +++ b/Lang/APL/Sort-disjoint-sublist @@ -0,0 +1 @@ +../../Task/Sort-disjoint-sublist/APL \ No newline at end of file diff --git a/Lang/APL/Temperature-conversion b/Lang/APL/Temperature-conversion new file mode 120000 index 0000000000..554bdd2286 --- /dev/null +++ b/Lang/APL/Temperature-conversion @@ -0,0 +1 @@ +../../Task/Temperature-conversion/APL \ No newline at end of file diff --git a/Lang/APL/Zero-to-the-zero-power b/Lang/APL/Zero-to-the-zero-power new file mode 120000 index 0000000000..5a7ed0c103 --- /dev/null +++ b/Lang/APL/Zero-to-the-zero-power @@ -0,0 +1 @@ +../../Task/Zero-to-the-zero-power/APL \ No newline at end of file diff --git a/Lang/ARM-Assembly/Fibonacci-sequence b/Lang/ARM-Assembly/Fibonacci-sequence new file mode 120000 index 0000000000..19055081e0 --- /dev/null +++ b/Lang/ARM-Assembly/Fibonacci-sequence @@ -0,0 +1 @@ +../../Task/Fibonacci-sequence/ARM-Assembly \ No newline at end of file diff --git a/Lang/ARM-Assembly/Integer-sequence b/Lang/ARM-Assembly/Integer-sequence new file mode 120000 index 0000000000..b9daeb89fd --- /dev/null +++ b/Lang/ARM-Assembly/Integer-sequence @@ -0,0 +1 @@ +../../Task/Integer-sequence/ARM-Assembly \ No newline at end of file diff --git a/Lang/ATS/Draw-a-sphere b/Lang/ATS/Draw-a-sphere new file mode 120000 index 0000000000..21b8ab5619 --- /dev/null +++ b/Lang/ATS/Draw-a-sphere @@ -0,0 +1 @@ +../../Task/Draw-a-sphere/ATS \ No newline at end of file diff --git a/Lang/ATS/Power-set b/Lang/ATS/Power-set new file mode 120000 index 0000000000..1ffb37c3af --- /dev/null +++ b/Lang/ATS/Power-set @@ -0,0 +1 @@ +../../Task/Power-set/ATS \ No newline at end of file diff --git a/Lang/ATS/Zig-zag-matrix b/Lang/ATS/Zig-zag-matrix new file mode 120000 index 0000000000..ee8e2c91f9 --- /dev/null +++ b/Lang/ATS/Zig-zag-matrix @@ -0,0 +1 @@ +../../Task/Zig-zag-matrix/ATS \ No newline at end of file diff --git a/Lang/AWK/Almost-prime b/Lang/AWK/Almost-prime new file mode 120000 index 0000000000..8e57fd46cb --- /dev/null +++ b/Lang/AWK/Almost-prime @@ -0,0 +1 @@ +../../Task/Almost-prime/AWK \ No newline at end of file diff --git a/Lang/AWK/Append-a-record-to-the-end-of-a-text-file b/Lang/AWK/Append-a-record-to-the-end-of-a-text-file new file mode 120000 index 0000000000..7ca5f81c94 --- /dev/null +++ b/Lang/AWK/Append-a-record-to-the-end-of-a-text-file @@ -0,0 +1 @@ +../../Task/Append-a-record-to-the-end-of-a-text-file/AWK \ No newline at end of file diff --git a/Lang/AWK/Find-the-last-Sunday-of-each-month b/Lang/AWK/Find-the-last-Sunday-of-each-month new file mode 120000 index 0000000000..531044c50a --- /dev/null +++ b/Lang/AWK/Find-the-last-Sunday-of-each-month @@ -0,0 +1 @@ +../../Task/Find-the-last-Sunday-of-each-month/AWK \ No newline at end of file diff --git a/Lang/AWK/Function-frequency b/Lang/AWK/Function-frequency new file mode 120000 index 0000000000..8a9ee14fb2 --- /dev/null +++ b/Lang/AWK/Function-frequency @@ -0,0 +1 @@ +../../Task/Function-frequency/AWK \ No newline at end of file diff --git a/Lang/AWK/Make-directory-path b/Lang/AWK/Make-directory-path new file mode 120000 index 0000000000..3ad3a0539a --- /dev/null +++ b/Lang/AWK/Make-directory-path @@ -0,0 +1 @@ +../../Task/Make-directory-path/AWK \ No newline at end of file diff --git a/Lang/AWK/Nautical-bell b/Lang/AWK/Nautical-bell new file mode 120000 index 0000000000..fb663d6371 --- /dev/null +++ b/Lang/AWK/Nautical-bell @@ -0,0 +1 @@ +../../Task/Nautical-bell/AWK \ No newline at end of file diff --git a/Lang/AWK/Pick-random-element b/Lang/AWK/Pick-random-element new file mode 120000 index 0000000000..037ee037b4 --- /dev/null +++ b/Lang/AWK/Pick-random-element @@ -0,0 +1 @@ +../../Task/Pick-random-element/AWK \ No newline at end of file diff --git a/Lang/AWK/Power-set b/Lang/AWK/Power-set new file mode 120000 index 0000000000..2c3eb4a49c --- /dev/null +++ b/Lang/AWK/Power-set @@ -0,0 +1 @@ +../../Task/Power-set/AWK \ No newline at end of file diff --git a/Lang/AWK/Roots-of-unity b/Lang/AWK/Roots-of-unity new file mode 120000 index 0000000000..a3fc632da4 --- /dev/null +++ b/Lang/AWK/Roots-of-unity @@ -0,0 +1 @@ +../../Task/Roots-of-unity/AWK \ No newline at end of file diff --git a/Lang/AWK/Tic-tac-toe b/Lang/AWK/Tic-tac-toe new file mode 120000 index 0000000000..7ba29692f5 --- /dev/null +++ b/Lang/AWK/Tic-tac-toe @@ -0,0 +1 @@ +../../Task/Tic-tac-toe/AWK \ No newline at end of file diff --git a/Lang/AWK/Top-rank-per-group b/Lang/AWK/Top-rank-per-group new file mode 120000 index 0000000000..d98801a234 --- /dev/null +++ b/Lang/AWK/Top-rank-per-group @@ -0,0 +1 @@ +../../Task/Top-rank-per-group/AWK \ No newline at end of file diff --git a/Lang/Ada/Flatten-a-list b/Lang/Ada/Flatten-a-list new file mode 120000 index 0000000000..b5ed616c5d --- /dev/null +++ b/Lang/Ada/Flatten-a-list @@ -0,0 +1 @@ +../../Task/Flatten-a-list/Ada \ No newline at end of file diff --git a/Lang/Ada/String-prepend b/Lang/Ada/String-prepend new file mode 120000 index 0000000000..f606cf6d4a --- /dev/null +++ b/Lang/Ada/String-prepend @@ -0,0 +1 @@ +../../Task/String-prepend/Ada \ No newline at end of file diff --git a/Lang/Agena/100-doors b/Lang/Agena/100-doors new file mode 120000 index 0000000000..3a9139bb1c --- /dev/null +++ b/Lang/Agena/100-doors @@ -0,0 +1 @@ +../../Task/100-doors/Agena \ No newline at end of file diff --git a/Lang/Agena/Case-sensitivity-of-identifiers b/Lang/Agena/Case-sensitivity-of-identifiers new file mode 120000 index 0000000000..94f4ba3c20 --- /dev/null +++ b/Lang/Agena/Case-sensitivity-of-identifiers @@ -0,0 +1 @@ +../../Task/Case-sensitivity-of-identifiers/Agena \ No newline at end of file diff --git a/Lang/Agena/Comments b/Lang/Agena/Comments new file mode 120000 index 0000000000..330fe232ec --- /dev/null +++ b/Lang/Agena/Comments @@ -0,0 +1 @@ +../../Task/Comments/Agena \ No newline at end of file diff --git a/Lang/Agena/Create-an-HTML-table b/Lang/Agena/Create-an-HTML-table new file mode 120000 index 0000000000..1693fd3b9c --- /dev/null +++ b/Lang/Agena/Create-an-HTML-table @@ -0,0 +1 @@ +../../Task/Create-an-HTML-table/Agena \ No newline at end of file diff --git a/Lang/Agena/Execute-HQ9+ b/Lang/Agena/Execute-HQ9+ new file mode 120000 index 0000000000..aee9e3d523 --- /dev/null +++ b/Lang/Agena/Execute-HQ9+ @@ -0,0 +1 @@ +../../Task/Execute-HQ9+/Agena \ No newline at end of file diff --git a/Lang/Agena/Sieve-of-Eratosthenes b/Lang/Agena/Sieve-of-Eratosthenes new file mode 120000 index 0000000000..0ece0e39f8 --- /dev/null +++ b/Lang/Agena/Sieve-of-Eratosthenes @@ -0,0 +1 @@ +../../Task/Sieve-of-Eratosthenes/Agena \ No newline at end of file diff --git a/Lang/Agena/Zig-zag-matrix b/Lang/Agena/Zig-zag-matrix new file mode 120000 index 0000000000..f4e443ce50 --- /dev/null +++ b/Lang/Agena/Zig-zag-matrix @@ -0,0 +1 @@ +../../Task/Zig-zag-matrix/Agena \ No newline at end of file diff --git a/Lang/Aime/Align-columns b/Lang/Aime/Align-columns new file mode 120000 index 0000000000..73a4bc2937 --- /dev/null +++ b/Lang/Aime/Align-columns @@ -0,0 +1 @@ +../../Task/Align-columns/Aime \ No newline at end of file diff --git a/Lang/Aime/Averages-Mean-angle b/Lang/Aime/Averages-Mean-angle new file mode 120000 index 0000000000..91970eeca1 --- /dev/null +++ b/Lang/Aime/Averages-Mean-angle @@ -0,0 +1 @@ +../../Task/Averages-Mean-angle/Aime \ No newline at end of file diff --git a/Lang/AppleScript/Align-columns b/Lang/AppleScript/Align-columns new file mode 120000 index 0000000000..65e08dcae5 --- /dev/null +++ b/Lang/AppleScript/Align-columns @@ -0,0 +1 @@ +../../Task/Align-columns/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Amicable-pairs b/Lang/AppleScript/Amicable-pairs new file mode 120000 index 0000000000..aa8e1f17b8 --- /dev/null +++ b/Lang/AppleScript/Amicable-pairs @@ -0,0 +1 @@ +../../Task/Amicable-pairs/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Arithmetic-geometric-mean b/Lang/AppleScript/Arithmetic-geometric-mean new file mode 120000 index 0000000000..f191fb76ca --- /dev/null +++ b/Lang/AppleScript/Arithmetic-geometric-mean @@ -0,0 +1 @@ +../../Task/Arithmetic-geometric-mean/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Array-concatenation b/Lang/AppleScript/Array-concatenation new file mode 120000 index 0000000000..02717668fd --- /dev/null +++ b/Lang/AppleScript/Array-concatenation @@ -0,0 +1 @@ +../../Task/Array-concatenation/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Averages-Pythagorean-means b/Lang/AppleScript/Averages-Pythagorean-means new file mode 120000 index 0000000000..ae42d648a8 --- /dev/null +++ b/Lang/AppleScript/Averages-Pythagorean-means @@ -0,0 +1 @@ +../../Task/Averages-Pythagorean-means/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Balanced-brackets b/Lang/AppleScript/Balanced-brackets new file mode 120000 index 0000000000..ab041b2a77 --- /dev/null +++ b/Lang/AppleScript/Balanced-brackets @@ -0,0 +1 @@ +../../Task/Balanced-brackets/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Binary-digits b/Lang/AppleScript/Binary-digits new file mode 120000 index 0000000000..a07cdaa1c6 --- /dev/null +++ b/Lang/AppleScript/Binary-digits @@ -0,0 +1 @@ +../../Task/Binary-digits/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Box-the-compass b/Lang/AppleScript/Box-the-compass new file mode 120000 index 0000000000..c1bc6d6cc6 --- /dev/null +++ b/Lang/AppleScript/Box-the-compass @@ -0,0 +1 @@ +../../Task/Box-the-compass/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Bulls-and-cows b/Lang/AppleScript/Bulls-and-cows new file mode 120000 index 0000000000..6c6fa1ce0c --- /dev/null +++ b/Lang/AppleScript/Bulls-and-cows @@ -0,0 +1 @@ +../../Task/Bulls-and-cows/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Catamorphism b/Lang/AppleScript/Catamorphism new file mode 120000 index 0000000000..eabbb883b0 --- /dev/null +++ b/Lang/AppleScript/Catamorphism @@ -0,0 +1 @@ +../../Task/Catamorphism/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Closures-Value-capture b/Lang/AppleScript/Closures-Value-capture new file mode 120000 index 0000000000..dd1009a1d5 --- /dev/null +++ b/Lang/AppleScript/Closures-Value-capture @@ -0,0 +1 @@ +../../Task/Closures-Value-capture/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Comments b/Lang/AppleScript/Comments new file mode 120000 index 0000000000..ea30274f1b --- /dev/null +++ b/Lang/AppleScript/Comments @@ -0,0 +1 @@ +../../Task/Comments/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Count-occurrences-of-a-substring b/Lang/AppleScript/Count-occurrences-of-a-substring new file mode 120000 index 0000000000..caa6dc9b24 --- /dev/null +++ b/Lang/AppleScript/Count-occurrences-of-a-substring @@ -0,0 +1 @@ +../../Task/Count-occurrences-of-a-substring/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Currying b/Lang/AppleScript/Currying new file mode 120000 index 0000000000..2dc50b5e38 --- /dev/null +++ b/Lang/AppleScript/Currying @@ -0,0 +1 @@ +../../Task/Currying/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Determine-if-a-string-is-numeric b/Lang/AppleScript/Determine-if-a-string-is-numeric new file mode 120000 index 0000000000..bf0781b3a6 --- /dev/null +++ b/Lang/AppleScript/Determine-if-a-string-is-numeric @@ -0,0 +1 @@ +../../Task/Determine-if-a-string-is-numeric/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Dot-product b/Lang/AppleScript/Dot-product new file mode 120000 index 0000000000..eb284aaf2f --- /dev/null +++ b/Lang/AppleScript/Dot-product @@ -0,0 +1 @@ +../../Task/Dot-product/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Ethiopian-multiplication b/Lang/AppleScript/Ethiopian-multiplication new file mode 120000 index 0000000000..f1b637ddd1 --- /dev/null +++ b/Lang/AppleScript/Ethiopian-multiplication @@ -0,0 +1 @@ +../../Task/Ethiopian-multiplication/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Factors-of-an-integer b/Lang/AppleScript/Factors-of-an-integer new file mode 120000 index 0000000000..a15cfe586d --- /dev/null +++ b/Lang/AppleScript/Factors-of-an-integer @@ -0,0 +1 @@ +../../Task/Factors-of-an-integer/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Find-the-last-Sunday-of-each-month b/Lang/AppleScript/Find-the-last-Sunday-of-each-month new file mode 120000 index 0000000000..172f202b5c --- /dev/null +++ b/Lang/AppleScript/Find-the-last-Sunday-of-each-month @@ -0,0 +1 @@ +../../Task/Find-the-last-Sunday-of-each-month/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Find-the-missing-permutation b/Lang/AppleScript/Find-the-missing-permutation new file mode 120000 index 0000000000..41ac5c633c --- /dev/null +++ b/Lang/AppleScript/Find-the-missing-permutation @@ -0,0 +1 @@ +../../Task/Find-the-missing-permutation/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Generate-lower-case-ASCII-alphabet b/Lang/AppleScript/Generate-lower-case-ASCII-alphabet new file mode 120000 index 0000000000..4a5bc4b1c2 --- /dev/null +++ b/Lang/AppleScript/Generate-lower-case-ASCII-alphabet @@ -0,0 +1 @@ +../../Task/Generate-lower-case-ASCII-alphabet/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Hash-join b/Lang/AppleScript/Hash-join new file mode 120000 index 0000000000..5cc428eaee --- /dev/null +++ b/Lang/AppleScript/Hash-join @@ -0,0 +1 @@ +../../Task/Hash-join/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Heronian-triangles b/Lang/AppleScript/Heronian-triangles new file mode 120000 index 0000000000..760236fb24 --- /dev/null +++ b/Lang/AppleScript/Heronian-triangles @@ -0,0 +1 @@ +../../Task/Heronian-triangles/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Identity-matrix b/Lang/AppleScript/Identity-matrix new file mode 120000 index 0000000000..bdefbf4252 --- /dev/null +++ b/Lang/AppleScript/Identity-matrix @@ -0,0 +1 @@ +../../Task/Identity-matrix/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Last-Friday-of-each-month b/Lang/AppleScript/Last-Friday-of-each-month new file mode 120000 index 0000000000..8830f48cbb --- /dev/null +++ b/Lang/AppleScript/Last-Friday-of-each-month @@ -0,0 +1 @@ +../../Task/Last-Friday-of-each-month/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Least-common-multiple b/Lang/AppleScript/Least-common-multiple new file mode 120000 index 0000000000..51683418f0 --- /dev/null +++ b/Lang/AppleScript/Least-common-multiple @@ -0,0 +1 @@ +../../Task/Least-common-multiple/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/List-comprehensions b/Lang/AppleScript/List-comprehensions new file mode 120000 index 0000000000..9496b9d068 --- /dev/null +++ b/Lang/AppleScript/List-comprehensions @@ -0,0 +1 @@ +../../Task/List-comprehensions/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Loop-over-multiple-arrays-simultaneously b/Lang/AppleScript/Loop-over-multiple-arrays-simultaneously new file mode 120000 index 0000000000..16bbb9b070 --- /dev/null +++ b/Lang/AppleScript/Loop-over-multiple-arrays-simultaneously @@ -0,0 +1 @@ +../../Task/Loop-over-multiple-arrays-simultaneously/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Magic-squares-of-odd-order b/Lang/AppleScript/Magic-squares-of-odd-order new file mode 120000 index 0000000000..c7067f7603 --- /dev/null +++ b/Lang/AppleScript/Magic-squares-of-odd-order @@ -0,0 +1 @@ +../../Task/Magic-squares-of-odd-order/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Matrix-multiplication b/Lang/AppleScript/Matrix-multiplication new file mode 120000 index 0000000000..71dec4693f --- /dev/null +++ b/Lang/AppleScript/Matrix-multiplication @@ -0,0 +1 @@ +../../Task/Matrix-multiplication/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Matrix-transposition b/Lang/AppleScript/Matrix-transposition new file mode 120000 index 0000000000..ecfa05af70 --- /dev/null +++ b/Lang/AppleScript/Matrix-transposition @@ -0,0 +1 @@ +../../Task/Matrix-transposition/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Multiple-distinct-objects b/Lang/AppleScript/Multiple-distinct-objects new file mode 120000 index 0000000000..7c850f0225 --- /dev/null +++ b/Lang/AppleScript/Multiple-distinct-objects @@ -0,0 +1 @@ +../../Task/Multiple-distinct-objects/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Mutual-recursion b/Lang/AppleScript/Mutual-recursion new file mode 120000 index 0000000000..b64d29ec5a --- /dev/null +++ b/Lang/AppleScript/Mutual-recursion @@ -0,0 +1 @@ +../../Task/Mutual-recursion/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/N-queens-problem b/Lang/AppleScript/N-queens-problem new file mode 120000 index 0000000000..f1700476dd --- /dev/null +++ b/Lang/AppleScript/N-queens-problem @@ -0,0 +1 @@ +../../Task/N-queens-problem/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Nautical-bell b/Lang/AppleScript/Nautical-bell new file mode 120000 index 0000000000..4f13975f61 --- /dev/null +++ b/Lang/AppleScript/Nautical-bell @@ -0,0 +1 @@ +../../Task/Nautical-bell/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Nth b/Lang/AppleScript/Nth new file mode 120000 index 0000000000..90ff428109 --- /dev/null +++ b/Lang/AppleScript/Nth @@ -0,0 +1 @@ +../../Task/Nth/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Order-disjoint-list-items b/Lang/AppleScript/Order-disjoint-list-items new file mode 120000 index 0000000000..ebac580eb8 --- /dev/null +++ b/Lang/AppleScript/Order-disjoint-list-items @@ -0,0 +1 @@ +../../Task/Order-disjoint-list-items/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Order-two-numerical-lists b/Lang/AppleScript/Order-two-numerical-lists new file mode 120000 index 0000000000..116df779c6 --- /dev/null +++ b/Lang/AppleScript/Order-two-numerical-lists @@ -0,0 +1 @@ +../../Task/Order-two-numerical-lists/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Palindrome-detection b/Lang/AppleScript/Palindrome-detection new file mode 120000 index 0000000000..2de80e3c70 --- /dev/null +++ b/Lang/AppleScript/Palindrome-detection @@ -0,0 +1 @@ +../../Task/Palindrome-detection/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Pangram-checker b/Lang/AppleScript/Pangram-checker new file mode 120000 index 0000000000..fa3a4df9fb --- /dev/null +++ b/Lang/AppleScript/Pangram-checker @@ -0,0 +1 @@ +../../Task/Pangram-checker/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Pascals-triangle b/Lang/AppleScript/Pascals-triangle new file mode 120000 index 0000000000..b5a6c9d6cb --- /dev/null +++ b/Lang/AppleScript/Pascals-triangle @@ -0,0 +1 @@ +../../Task/Pascals-triangle/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Perfect-numbers b/Lang/AppleScript/Perfect-numbers new file mode 120000 index 0000000000..c4d1d7c278 --- /dev/null +++ b/Lang/AppleScript/Perfect-numbers @@ -0,0 +1 @@ +../../Task/Perfect-numbers/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Permutations b/Lang/AppleScript/Permutations new file mode 120000 index 0000000000..572decd903 --- /dev/null +++ b/Lang/AppleScript/Permutations @@ -0,0 +1 @@ +../../Task/Permutations/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Phrase-reversals b/Lang/AppleScript/Phrase-reversals new file mode 120000 index 0000000000..595c7577ac --- /dev/null +++ b/Lang/AppleScript/Phrase-reversals @@ -0,0 +1 @@ +../../Task/Phrase-reversals/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Power-set b/Lang/AppleScript/Power-set new file mode 120000 index 0000000000..358ec165dd --- /dev/null +++ b/Lang/AppleScript/Power-set @@ -0,0 +1 @@ +../../Task/Power-set/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Range-expansion b/Lang/AppleScript/Range-expansion new file mode 120000 index 0000000000..e7bb647cd2 --- /dev/null +++ b/Lang/AppleScript/Range-expansion @@ -0,0 +1 @@ +../../Task/Range-expansion/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Range-extraction b/Lang/AppleScript/Range-extraction new file mode 120000 index 0000000000..b3cae9dfe7 --- /dev/null +++ b/Lang/AppleScript/Range-extraction @@ -0,0 +1 @@ +../../Task/Range-extraction/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Reverse-words-in-a-string b/Lang/AppleScript/Reverse-words-in-a-string new file mode 120000 index 0000000000..558bef7fc4 --- /dev/null +++ b/Lang/AppleScript/Reverse-words-in-a-string @@ -0,0 +1 @@ +../../Task/Reverse-words-in-a-string/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Roman-numerals-Decode b/Lang/AppleScript/Roman-numerals-Decode new file mode 120000 index 0000000000..5473bd2447 --- /dev/null +++ b/Lang/AppleScript/Roman-numerals-Decode @@ -0,0 +1 @@ +../../Task/Roman-numerals-Decode/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Roman-numerals-Encode b/Lang/AppleScript/Roman-numerals-Encode new file mode 120000 index 0000000000..50d65a3455 --- /dev/null +++ b/Lang/AppleScript/Roman-numerals-Encode @@ -0,0 +1 @@ +../../Task/Roman-numerals-Encode/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Runtime-evaluation-In-an-environment b/Lang/AppleScript/Runtime-evaluation-In-an-environment new file mode 120000 index 0000000000..6858b2bcd4 --- /dev/null +++ b/Lang/AppleScript/Runtime-evaluation-In-an-environment @@ -0,0 +1 @@ +../../Task/Runtime-evaluation-In-an-environment/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Short-circuit-evaluation b/Lang/AppleScript/Short-circuit-evaluation new file mode 120000 index 0000000000..aa6fc8389c --- /dev/null +++ b/Lang/AppleScript/Short-circuit-evaluation @@ -0,0 +1 @@ +../../Task/Short-circuit-evaluation/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Sierpinski-carpet b/Lang/AppleScript/Sierpinski-carpet new file mode 120000 index 0000000000..42eee84b2d --- /dev/null +++ b/Lang/AppleScript/Sierpinski-carpet @@ -0,0 +1 @@ +../../Task/Sierpinski-carpet/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Sierpinski-triangle b/Lang/AppleScript/Sierpinski-triangle new file mode 120000 index 0000000000..e2bf312fb7 --- /dev/null +++ b/Lang/AppleScript/Sierpinski-triangle @@ -0,0 +1 @@ +../../Task/Sierpinski-triangle/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Sort-an-integer-array b/Lang/AppleScript/Sort-an-integer-array new file mode 120000 index 0000000000..568e355b0d --- /dev/null +++ b/Lang/AppleScript/Sort-an-integer-array @@ -0,0 +1 @@ +../../Task/Sort-an-integer-array/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Sort-disjoint-sublist b/Lang/AppleScript/Sort-disjoint-sublist new file mode 120000 index 0000000000..61977a9527 --- /dev/null +++ b/Lang/AppleScript/Sort-disjoint-sublist @@ -0,0 +1 @@ +../../Task/Sort-disjoint-sublist/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Sorting-algorithms-Quicksort b/Lang/AppleScript/Sorting-algorithms-Quicksort new file mode 120000 index 0000000000..9120020f1c --- /dev/null +++ b/Lang/AppleScript/Sorting-algorithms-Quicksort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Quicksort/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Sparkline-in-unicode b/Lang/AppleScript/Sparkline-in-unicode new file mode 120000 index 0000000000..c1d0fc63f3 --- /dev/null +++ b/Lang/AppleScript/Sparkline-in-unicode @@ -0,0 +1 @@ +../../Task/Sparkline-in-unicode/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Spiral-matrix b/Lang/AppleScript/Spiral-matrix new file mode 120000 index 0000000000..2d8cdb5d3f --- /dev/null +++ b/Lang/AppleScript/Spiral-matrix @@ -0,0 +1 @@ +../../Task/Spiral-matrix/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/String-case b/Lang/AppleScript/String-case new file mode 120000 index 0000000000..be66af228f --- /dev/null +++ b/Lang/AppleScript/String-case @@ -0,0 +1 @@ +../../Task/String-case/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Strip-whitespace-from-a-string-Top-and-tail b/Lang/AppleScript/Strip-whitespace-from-a-string-Top-and-tail new file mode 120000 index 0000000000..960ed2b96e --- /dev/null +++ b/Lang/AppleScript/Strip-whitespace-from-a-string-Top-and-tail @@ -0,0 +1 @@ +../../Task/Strip-whitespace-from-a-string-Top-and-tail/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Substring b/Lang/AppleScript/Substring new file mode 120000 index 0000000000..164e2ad0aa --- /dev/null +++ b/Lang/AppleScript/Substring @@ -0,0 +1 @@ +../../Task/Substring/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Sum-of-a-series b/Lang/AppleScript/Sum-of-a-series new file mode 120000 index 0000000000..9410a1117c --- /dev/null +++ b/Lang/AppleScript/Sum-of-a-series @@ -0,0 +1 @@ +../../Task/Sum-of-a-series/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Symmetric-difference b/Lang/AppleScript/Symmetric-difference new file mode 120000 index 0000000000..a0210027d5 --- /dev/null +++ b/Lang/AppleScript/Symmetric-difference @@ -0,0 +1 @@ +../../Task/Symmetric-difference/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Take-notes-on-the-command-line b/Lang/AppleScript/Take-notes-on-the-command-line new file mode 120000 index 0000000000..82d68a73c6 --- /dev/null +++ b/Lang/AppleScript/Take-notes-on-the-command-line @@ -0,0 +1 @@ +../../Task/Take-notes-on-the-command-line/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Temperature-conversion b/Lang/AppleScript/Temperature-conversion new file mode 120000 index 0000000000..fd954b7589 --- /dev/null +++ b/Lang/AppleScript/Temperature-conversion @@ -0,0 +1 @@ +../../Task/Temperature-conversion/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/The-Twelve-Days-of-Christmas b/Lang/AppleScript/The-Twelve-Days-of-Christmas new file mode 120000 index 0000000000..c87617cc8b --- /dev/null +++ b/Lang/AppleScript/The-Twelve-Days-of-Christmas @@ -0,0 +1 @@ +../../Task/The-Twelve-Days-of-Christmas/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Tokenize-a-string b/Lang/AppleScript/Tokenize-a-string new file mode 120000 index 0000000000..7fa26b5014 --- /dev/null +++ b/Lang/AppleScript/Tokenize-a-string @@ -0,0 +1 @@ +../../Task/Tokenize-a-string/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Tree-traversal b/Lang/AppleScript/Tree-traversal new file mode 120000 index 0000000000..83a6d04061 --- /dev/null +++ b/Lang/AppleScript/Tree-traversal @@ -0,0 +1 @@ +../../Task/Tree-traversal/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Variadic-function b/Lang/AppleScript/Variadic-function new file mode 120000 index 0000000000..d3b51b5862 --- /dev/null +++ b/Lang/AppleScript/Variadic-function @@ -0,0 +1 @@ +../../Task/Variadic-function/AppleScript \ No newline at end of file diff --git a/Lang/AppleScript/Zeckendorf-number-representation b/Lang/AppleScript/Zeckendorf-number-representation new file mode 120000 index 0000000000..ddb21bbbb9 --- /dev/null +++ b/Lang/AppleScript/Zeckendorf-number-representation @@ -0,0 +1 @@ +../../Task/Zeckendorf-number-representation/AppleScript \ No newline at end of file diff --git a/Lang/Applesoft-BASIC/Averages-Arithmetic-mean b/Lang/Applesoft-BASIC/Averages-Arithmetic-mean new file mode 120000 index 0000000000..62e70f6ec9 --- /dev/null +++ b/Lang/Applesoft-BASIC/Averages-Arithmetic-mean @@ -0,0 +1 @@ +../../Task/Averages-Arithmetic-mean/Applesoft-BASIC \ No newline at end of file diff --git a/Lang/Applesoft-BASIC/Binary-digits b/Lang/Applesoft-BASIC/Binary-digits new file mode 120000 index 0000000000..cf5fd530fa --- /dev/null +++ b/Lang/Applesoft-BASIC/Binary-digits @@ -0,0 +1 @@ +../../Task/Binary-digits/Applesoft-BASIC \ No newline at end of file diff --git a/Lang/Applesoft-BASIC/Execute-HQ9+ b/Lang/Applesoft-BASIC/Execute-HQ9+ new file mode 120000 index 0000000000..cff840d62c --- /dev/null +++ b/Lang/Applesoft-BASIC/Execute-HQ9+ @@ -0,0 +1 @@ +../../Task/Execute-HQ9+/Applesoft-BASIC \ No newline at end of file diff --git a/Lang/Applesoft-BASIC/Repeat-a-string b/Lang/Applesoft-BASIC/Repeat-a-string new file mode 120000 index 0000000000..ab1e2668a1 --- /dev/null +++ b/Lang/Applesoft-BASIC/Repeat-a-string @@ -0,0 +1 @@ +../../Task/Repeat-a-string/Applesoft-BASIC \ No newline at end of file diff --git a/Lang/Applesoft-BASIC/Sleep b/Lang/Applesoft-BASIC/Sleep new file mode 120000 index 0000000000..73f3718d8b --- /dev/null +++ b/Lang/Applesoft-BASIC/Sleep @@ -0,0 +1 @@ +../../Task/Sleep/Applesoft-BASIC \ No newline at end of file diff --git a/Lang/Applesoft-BASIC/Strip-comments-from-a-string b/Lang/Applesoft-BASIC/Strip-comments-from-a-string new file mode 120000 index 0000000000..49729c8434 --- /dev/null +++ b/Lang/Applesoft-BASIC/Strip-comments-from-a-string @@ -0,0 +1 @@ +../../Task/Strip-comments-from-a-string/Applesoft-BASIC \ No newline at end of file diff --git a/Lang/Applesoft-BASIC/Terminal-control-Preserve-screen b/Lang/Applesoft-BASIC/Terminal-control-Preserve-screen new file mode 120000 index 0000000000..5f549f0896 --- /dev/null +++ b/Lang/Applesoft-BASIC/Terminal-control-Preserve-screen @@ -0,0 +1 @@ +../../Task/Terminal-control-Preserve-screen/Applesoft-BASIC \ No newline at end of file diff --git a/Lang/Assembly/00DESCRIPTION b/Lang/Assembly/00DESCRIPTION index 6861d124a3..9e0b98ba59 100644 --- a/Lang/Assembly/00DESCRIPTION +++ b/Lang/Assembly/00DESCRIPTION @@ -1,6 +1,6 @@ {{language}}{{assembler language}} {{language programming paradigm|Imperative}} -[[Category:Encyclopedia]]'''Assembly language''' (or just '''assembly'''; often abbreviated '''asm'''; sometimes called '''assembler''', although that more properly refers to the program that translates the assembly source into machine code) is a term used for a language which is as close to raw machine code as a language can get. Writing in assembly typically requires strict knowledge of the underlying hardware, which lends itself well to implementing [[wp:Firmware|firmware]] due to size and speed constraints. +'''Assembly language''' (or just '''assembly'''; often abbreviated '''asm'''; sometimes called '''assembler''', although that more properly refers to the program that translates the assembly source into machine code) is a term used for a language which is as close to raw machine code as a language can get. Writing in assembly typically requires strict knowledge of the underlying hardware, which lends itself well to implementing [[wp:Firmware|firmware]] due to size and speed constraints. Assembly languages use textual "[[wp:Mnemonic|mnemonics]]" that correspond directly to machine instructions ([[wp:Opcode|opcodes]]). Writing in assembly often gives direct control over the overall layout of the assembled program on disk and in memory. Available instructions and codes are specific to the architecture being programmed on (although there are assemblers which provide an abstracted, non-architecture-specific language; the most notable of which is the [[wp:GNU Assembler|GNU Assembler]]). Assembly programs are typically loaded directly into a computer's memory and run from there. A software [[wp:Emulator|emulator]] can be used for testing purposes, or in the absence of hardware. diff --git a/Lang/AutoHotkey/00DESCRIPTION b/Lang/AutoHotkey/00DESCRIPTION index 1651708ee5..8d4901d152 100644 --- a/Lang/AutoHotkey/00DESCRIPTION +++ b/Lang/AutoHotkey/00DESCRIPTION @@ -6,11 +6,12 @@ |site=http://ahkscript.org/ |LCT=yes}}'''[[wp:AutoHotkey|AutoHotkey]]''' is an [[open source]] programming language for Microsoft [[Windows]]. ==Citations== -* [http://ahkscript.org/docs Documentation] -* [http://ahkscript.org/archives/Download.html Download archives] -* [http://ahkscript.org/docs/scripts/ Script Showcase] -* [http://ahkscript.org/wiki AutoHotkey Wiki] -* [http://ahkscript.org/boards/ New Community forum], [http://www.autohotkey.com/forum/ Community forum] +* [http://autohotkey.com/docs Documentation] +* [http://autohotkey.com/download Downloads] +* [http://autohotkey.com/docs/scripts/ Script Showcase] +* [http://autohotkey.com/boards/ New Community forum] +* [http://www.autohotkey.com/forum/ Archived Community forum] +* [http://ahkscript.org/foundation AutoHotkey Foundation LLC] * [[wp:AutoHotkey|AutoHotkey on Wikipedia]] * [irc://irc.freenode.net/ahk #ahk] on [[Help:IRC|freenode]] ([http://webchat.freenode.net/?channels=%23ahk Web interface]) * [[:Category:AutoHotkey_Originated]] \ No newline at end of file diff --git a/Lang/AutoHotkey/Stern-Brocot-sequence b/Lang/AutoHotkey/Stern-Brocot-sequence new file mode 120000 index 0000000000..181763fd79 --- /dev/null +++ b/Lang/AutoHotkey/Stern-Brocot-sequence @@ -0,0 +1 @@ +../../Task/Stern-Brocot-sequence/AutoHotkey \ No newline at end of file diff --git a/Lang/AutoIt/Playing-cards b/Lang/AutoIt/Playing-cards new file mode 120000 index 0000000000..83ba039c41 --- /dev/null +++ b/Lang/AutoIt/Playing-cards @@ -0,0 +1 @@ +../../Task/Playing-cards/AutoIt \ No newline at end of file diff --git a/Lang/AutoIt/Simple-windowed-application b/Lang/AutoIt/Simple-windowed-application new file mode 120000 index 0000000000..a50a1bf457 --- /dev/null +++ b/Lang/AutoIt/Simple-windowed-application @@ -0,0 +1 @@ +../../Task/Simple-windowed-application/AutoIt \ No newline at end of file diff --git a/Lang/BASIC/ABC-Problem b/Lang/BASIC/ABC-Problem new file mode 120000 index 0000000000..a129a75315 --- /dev/null +++ b/Lang/BASIC/ABC-Problem @@ -0,0 +1 @@ +../../Task/ABC-Problem/BASIC \ No newline at end of file diff --git a/Lang/BASIC/Read-a-configuration-file b/Lang/BASIC/Read-a-configuration-file new file mode 120000 index 0000000000..7bdb47dfc9 --- /dev/null +++ b/Lang/BASIC/Read-a-configuration-file @@ -0,0 +1 @@ +../../Task/Read-a-configuration-file/BASIC \ No newline at end of file diff --git a/Lang/BASIC/Remove-lines-from-a-file b/Lang/BASIC/Remove-lines-from-a-file new file mode 120000 index 0000000000..e5b923947b --- /dev/null +++ b/Lang/BASIC/Remove-lines-from-a-file @@ -0,0 +1 @@ +../../Task/Remove-lines-from-a-file/BASIC \ No newline at end of file diff --git a/Lang/BASIC/Tic-tac-toe b/Lang/BASIC/Tic-tac-toe new file mode 120000 index 0000000000..7b1e3bb4bf --- /dev/null +++ b/Lang/BASIC/Tic-tac-toe @@ -0,0 +1 @@ +../../Task/Tic-tac-toe/BASIC \ No newline at end of file diff --git a/Lang/BASIC/Update-a-configuration-file b/Lang/BASIC/Update-a-configuration-file new file mode 120000 index 0000000000..e135fa85a5 --- /dev/null +++ b/Lang/BASIC/Update-a-configuration-file @@ -0,0 +1 @@ +../../Task/Update-a-configuration-file/BASIC \ No newline at end of file diff --git a/Lang/BBC-BASIC/Call-a-function b/Lang/BBC-BASIC/Call-a-function new file mode 120000 index 0000000000..5666f472ad --- /dev/null +++ b/Lang/BBC-BASIC/Call-a-function @@ -0,0 +1 @@ +../../Task/Call-a-function/BBC-BASIC \ No newline at end of file diff --git a/Lang/BBC-BASIC/Munching-squares b/Lang/BBC-BASIC/Munching-squares new file mode 120000 index 0000000000..4c618d8f6c --- /dev/null +++ b/Lang/BBC-BASIC/Munching-squares @@ -0,0 +1 @@ +../../Task/Munching-squares/BBC-BASIC \ No newline at end of file diff --git a/Lang/BBC-BASIC/Old-lady-swallowed-a-fly b/Lang/BBC-BASIC/Old-lady-swallowed-a-fly new file mode 120000 index 0000000000..12a5db62d1 --- /dev/null +++ b/Lang/BBC-BASIC/Old-lady-swallowed-a-fly @@ -0,0 +1 @@ +../../Task/Old-lady-swallowed-a-fly/BBC-BASIC \ No newline at end of file diff --git a/Lang/BBC-BASIC/Penneys-game b/Lang/BBC-BASIC/Penneys-game new file mode 120000 index 0000000000..575e4080b2 --- /dev/null +++ b/Lang/BBC-BASIC/Penneys-game @@ -0,0 +1 @@ +../../Task/Penneys-game/BBC-BASIC \ No newline at end of file diff --git a/Lang/BBC-BASIC/String-comparison b/Lang/BBC-BASIC/String-comparison new file mode 120000 index 0000000000..bd886b4e21 --- /dev/null +++ b/Lang/BBC-BASIC/String-comparison @@ -0,0 +1 @@ +../../Task/String-comparison/BBC-BASIC \ No newline at end of file diff --git a/Lang/Babel/00DESCRIPTION b/Lang/Babel/00DESCRIPTION index 788288c54b..c41d0351b4 100644 --- a/Lang/Babel/00DESCRIPTION +++ b/Lang/Babel/00DESCRIPTION @@ -1,4 +1,4 @@ {{alertbox|#ffffe0|''Were you looking for the [[Common Lisp]] library? That category has now been [[:Category:Babel (library)|renamed]].''}} -{{language}}Babel is an interpreted language designed by Clayton Bauman. It is an untyped, stack-based, postfix language with support for arrays, lists and maps (dictionaries). Babel 1.0 will support built-in crypto-based verification of code in order to enable safer remote code execution. +{{language}}[https://github.com/claytonkb/clean_babel Babel] is an interpreted language designed by Clayton Bauman. It is an untyped, stack-based, postfix language with support for arrays, lists, matrices and maps (dictionaries). Babel 1.0 will support built-in crypto-based verification of code in order to enable safer remote code execution. -Babel is implemented in [[C]] (compiles on MinGW32). It is still under development, so please excuse the dust and debris in the [https://github.com/claytonkb/clean_babel current implementation]. To get started quickly on Windows, clone the repository and run bin/babel.exe from the repo directory. Type 'rc !' (no quotes) to load the rc file and get some convenience operators. Since this is a development build, you can type '0 dev' to view the dev options. To build on Windows, use MinGW32; on Linux, use gcc. \ No newline at end of file +Babel is implemented in [[C]] and compiles with MinGW32. It is still under development, so please excuse the dust and debris in the current implementation. To get started quickly on Windows, clone the repository and run bin/babel.exe from the repo directory. This will start Babel in interactive mode and the examples given on RC are for interactive mode, unless otherwise noted. Since this is a development build, you can type '0 dev' to view the dev options. To build on Windows, use MinGW32; on Linux, use gcc. \ No newline at end of file diff --git a/Lang/Babel/Command-line-arguments b/Lang/Babel/Command-line-arguments new file mode 120000 index 0000000000..4b440aff89 --- /dev/null +++ b/Lang/Babel/Command-line-arguments @@ -0,0 +1 @@ +../../Task/Command-line-arguments/Babel \ No newline at end of file diff --git a/Lang/Babel/Quine b/Lang/Babel/Quine new file mode 120000 index 0000000000..695d81e20f --- /dev/null +++ b/Lang/Babel/Quine @@ -0,0 +1 @@ +../../Task/Quine/Babel \ No newline at end of file diff --git a/Lang/Babel/Sort-an-array-of-composite-structures b/Lang/Babel/Sort-an-array-of-composite-structures new file mode 120000 index 0000000000..87c7171f31 --- /dev/null +++ b/Lang/Babel/Sort-an-array-of-composite-structures @@ -0,0 +1 @@ +../../Task/Sort-an-array-of-composite-structures/Babel \ No newline at end of file diff --git a/Lang/Babel/Sort-an-integer-array b/Lang/Babel/Sort-an-integer-array new file mode 120000 index 0000000000..6c092dfb68 --- /dev/null +++ b/Lang/Babel/Sort-an-integer-array @@ -0,0 +1 @@ +../../Task/Sort-an-integer-array/Babel \ No newline at end of file diff --git a/Lang/Babel/Sort-using-a-custom-comparator b/Lang/Babel/Sort-using-a-custom-comparator new file mode 120000 index 0000000000..43891ae361 --- /dev/null +++ b/Lang/Babel/Sort-using-a-custom-comparator @@ -0,0 +1 @@ +../../Task/Sort-using-a-custom-comparator/Babel \ No newline at end of file diff --git a/Lang/Batch-File/Align-columns b/Lang/Batch-File/Align-columns new file mode 120000 index 0000000000..a8f40d6a5b --- /dev/null +++ b/Lang/Batch-File/Align-columns @@ -0,0 +1 @@ +../../Task/Align-columns/Batch-File \ No newline at end of file diff --git a/Lang/Batch-File/CSV-to-HTML-translation b/Lang/Batch-File/CSV-to-HTML-translation new file mode 120000 index 0000000000..d069fca0fe --- /dev/null +++ b/Lang/Batch-File/CSV-to-HTML-translation @@ -0,0 +1 @@ +../../Task/CSV-to-HTML-translation/Batch-File \ No newline at end of file diff --git a/Lang/Batch-File/Discordian-date b/Lang/Batch-File/Discordian-date new file mode 120000 index 0000000000..2f43a9f5ce --- /dev/null +++ b/Lang/Batch-File/Discordian-date @@ -0,0 +1 @@ +../../Task/Discordian-date/Batch-File \ No newline at end of file diff --git a/Lang/Batch-File/Draw-a-sphere b/Lang/Batch-File/Draw-a-sphere new file mode 120000 index 0000000000..22035e1856 --- /dev/null +++ b/Lang/Batch-File/Draw-a-sphere @@ -0,0 +1 @@ +../../Task/Draw-a-sphere/Batch-File \ No newline at end of file diff --git a/Lang/Batch-File/Find-the-last-Sunday-of-each-month b/Lang/Batch-File/Find-the-last-Sunday-of-each-month new file mode 120000 index 0000000000..5946ef4baa --- /dev/null +++ b/Lang/Batch-File/Find-the-last-Sunday-of-each-month @@ -0,0 +1 @@ +../../Task/Find-the-last-Sunday-of-each-month/Batch-File \ No newline at end of file diff --git a/Lang/Batch-File/Permutations b/Lang/Batch-File/Permutations new file mode 120000 index 0000000000..dd4db43d79 --- /dev/null +++ b/Lang/Batch-File/Permutations @@ -0,0 +1 @@ +../../Task/Permutations/Batch-File \ No newline at end of file diff --git a/Lang/Batch-File/Playing-cards b/Lang/Batch-File/Playing-cards new file mode 120000 index 0000000000..b8ce1fb08e --- /dev/null +++ b/Lang/Batch-File/Playing-cards @@ -0,0 +1 @@ +../../Task/Playing-cards/Batch-File \ No newline at end of file diff --git a/Lang/Batch-File/Priority-queue b/Lang/Batch-File/Priority-queue new file mode 120000 index 0000000000..fae08066fd --- /dev/null +++ b/Lang/Batch-File/Priority-queue @@ -0,0 +1 @@ +../../Task/Priority-queue/Batch-File \ No newline at end of file diff --git a/Lang/Batch-File/Sequence-of-primes-by-Trial-Division b/Lang/Batch-File/Sequence-of-primes-by-Trial-Division new file mode 120000 index 0000000000..f381990355 --- /dev/null +++ b/Lang/Batch-File/Sequence-of-primes-by-Trial-Division @@ -0,0 +1 @@ +../../Task/Sequence-of-primes-by-Trial-Division/Batch-File \ No newline at end of file diff --git a/Lang/Batch-File/Time-a-function b/Lang/Batch-File/Time-a-function new file mode 120000 index 0000000000..c80d59b6c6 --- /dev/null +++ b/Lang/Batch-File/Time-a-function @@ -0,0 +1 @@ +../../Task/Time-a-function/Batch-File \ No newline at end of file diff --git a/Lang/Bc/99-Bottles-of-Beer b/Lang/Bc/99-Bottles-of-Beer new file mode 120000 index 0000000000..4e5f04bcf7 --- /dev/null +++ b/Lang/Bc/99-Bottles-of-Beer @@ -0,0 +1 @@ +../../Task/99-Bottles-of-Beer/Bc \ No newline at end of file diff --git a/Lang/Bc/Shell-one-liner b/Lang/Bc/Shell-one-liner new file mode 120000 index 0000000000..e126985331 --- /dev/null +++ b/Lang/Bc/Shell-one-liner @@ -0,0 +1 @@ +../../Task/Shell-one-liner/Bc \ No newline at end of file diff --git a/Lang/Befunge/00DESCRIPTION b/Lang/Befunge/00DESCRIPTION index 055fe26193..d0bece7b14 100644 --- a/Lang/Befunge/00DESCRIPTION +++ b/Lang/Befunge/00DESCRIPTION @@ -3,7 +3,7 @@ In the latter part of the 90s, several attempts were made to extend the language, with mutually incompatible versions proposed in '96, '97 and '98. It was at this time that the idea of variant dimensions were introduced, with '''Unefunge''' (one-dimensional), '''Trefunge''' (three-dimensional) and '''Nefunge''' (''N''-dimensional) - the general language class then being refered to as a '''Funge'''. -The '96 and '97 versions are now largely considered abandoned, and while '''Funge-98''' did gain a certain amount of tranction, it has never been as widely adopted as the original '''Befunge-93'''. Being considerably more complex than the original, it is often deemed "too complicated" and sometimes even "too normal". +The '96 and '97 versions are now largely considered abandoned, and while '''Funge-98''' did gain a certain amount of traction, it has never been as widely adopted as the original '''Befunge-93'''. Being considerably more complex than the original, it is often deemed "too complicated" and sometimes even "too normal". ==See also== * [http://github.com/catseye/Befunge-93/blob/master/doc/Befunge-93.markdown Befunge-93 Specification] diff --git a/Lang/Befunge/Greatest-element-of-a-list b/Lang/Befunge/Greatest-element-of-a-list new file mode 120000 index 0000000000..c5732d8c75 --- /dev/null +++ b/Lang/Befunge/Greatest-element-of-a-list @@ -0,0 +1 @@ +../../Task/Greatest-element-of-a-list/Befunge \ No newline at end of file diff --git a/Lang/Befunge/Hello-world-Newbie b/Lang/Befunge/Hello-world-Newbie new file mode 120000 index 0000000000..05f96c55e6 --- /dev/null +++ b/Lang/Befunge/Hello-world-Newbie @@ -0,0 +1 @@ +../../Task/Hello-world-Newbie/Befunge \ No newline at end of file diff --git a/Lang/Befunge/Repeat-a-string b/Lang/Befunge/Repeat-a-string new file mode 120000 index 0000000000..305a850d4e --- /dev/null +++ b/Lang/Befunge/Repeat-a-string @@ -0,0 +1 @@ +../../Task/Repeat-a-string/Befunge \ No newline at end of file diff --git a/Lang/Befunge/Zeckendorf-number-representation b/Lang/Befunge/Zeckendorf-number-representation new file mode 120000 index 0000000000..a6213264a2 --- /dev/null +++ b/Lang/Befunge/Zeckendorf-number-representation @@ -0,0 +1 @@ +../../Task/Zeckendorf-number-representation/Befunge \ No newline at end of file diff --git a/Lang/Bracmat/XML-DOM-serialization b/Lang/Bracmat/XML-DOM-serialization new file mode 120000 index 0000000000..4c750952fd --- /dev/null +++ b/Lang/Bracmat/XML-DOM-serialization @@ -0,0 +1 @@ +../../Task/XML-DOM-serialization/Bracmat \ No newline at end of file diff --git a/Lang/Bracmat/XML-XPath b/Lang/Bracmat/XML-XPath new file mode 120000 index 0000000000..a20062b008 --- /dev/null +++ b/Lang/Bracmat/XML-XPath @@ -0,0 +1 @@ +../../Task/XML-XPath/Bracmat \ No newline at end of file diff --git a/Lang/Brainf---/Arrays b/Lang/Brainf---/Arrays new file mode 120000 index 0000000000..46c2d650a5 --- /dev/null +++ b/Lang/Brainf---/Arrays @@ -0,0 +1 @@ +../../Task/Arrays/Brainf--- \ No newline at end of file diff --git a/Lang/Brainf---/Mandelbrot-set b/Lang/Brainf---/Mandelbrot-set new file mode 120000 index 0000000000..248b044024 --- /dev/null +++ b/Lang/Brainf---/Mandelbrot-set @@ -0,0 +1 @@ +../../Task/Mandelbrot-set/Brainf--- \ No newline at end of file diff --git a/Lang/Brat/Least-common-multiple b/Lang/Brat/Least-common-multiple new file mode 120000 index 0000000000..dc09ad3a0f --- /dev/null +++ b/Lang/Brat/Least-common-multiple @@ -0,0 +1 @@ +../../Task/Least-common-multiple/Brat \ No newline at end of file diff --git a/Lang/C++/Almost-prime b/Lang/C++/Almost-prime new file mode 120000 index 0000000000..20fd24ccab --- /dev/null +++ b/Lang/C++/Almost-prime @@ -0,0 +1 @@ +../../Task/Almost-prime/C++ \ No newline at end of file diff --git a/Lang/C++/Amicable-pairs b/Lang/C++/Amicable-pairs new file mode 120000 index 0000000000..4fa177c202 --- /dev/null +++ b/Lang/C++/Amicable-pairs @@ -0,0 +1 @@ +../../Task/Amicable-pairs/C++ \ No newline at end of file diff --git a/Lang/C++/Case-sensitivity-of-identifiers b/Lang/C++/Case-sensitivity-of-identifiers new file mode 120000 index 0000000000..a3bc9dd019 --- /dev/null +++ b/Lang/C++/Case-sensitivity-of-identifiers @@ -0,0 +1 @@ +../../Task/Case-sensitivity-of-identifiers/C++ \ No newline at end of file diff --git a/Lang/C++/DNS-query b/Lang/C++/DNS-query new file mode 120000 index 0000000000..39abcfc09b --- /dev/null +++ b/Lang/C++/DNS-query @@ -0,0 +1 @@ +../../Task/DNS-query/C++ \ No newline at end of file diff --git a/Lang/C++/Hello-world-Newbie b/Lang/C++/Hello-world-Newbie new file mode 120000 index 0000000000..1e051297df --- /dev/null +++ b/Lang/C++/Hello-world-Newbie @@ -0,0 +1 @@ +../../Task/Hello-world-Newbie/C++ \ No newline at end of file diff --git a/Lang/C++/Hofstadter-Figure-Figure-sequences b/Lang/C++/Hofstadter-Figure-Figure-sequences new file mode 120000 index 0000000000..11aac37485 --- /dev/null +++ b/Lang/C++/Hofstadter-Figure-Figure-sequences @@ -0,0 +1 @@ +../../Task/Hofstadter-Figure-Figure-sequences/C++ \ No newline at end of file diff --git a/Lang/C++/Left-factorials b/Lang/C++/Left-factorials new file mode 120000 index 0000000000..73e32ea6c2 --- /dev/null +++ b/Lang/C++/Left-factorials @@ -0,0 +1 @@ +../../Task/Left-factorials/C++ \ No newline at end of file diff --git a/Lang/C++/Morse-code b/Lang/C++/Morse-code new file mode 120000 index 0000000000..d9507343cd --- /dev/null +++ b/Lang/C++/Morse-code @@ -0,0 +1 @@ +../../Task/Morse-code/C++ \ No newline at end of file diff --git a/Lang/C++/Numeric-error-propagation b/Lang/C++/Numeric-error-propagation new file mode 120000 index 0000000000..b6bb59c0c1 --- /dev/null +++ b/Lang/C++/Numeric-error-propagation @@ -0,0 +1 @@ +../../Task/Numeric-error-propagation/C++ \ No newline at end of file diff --git a/Lang/C++/Numerical-integration-Gauss-Legendre-Quadrature b/Lang/C++/Numerical-integration-Gauss-Legendre-Quadrature new file mode 120000 index 0000000000..81a93d473c --- /dev/null +++ b/Lang/C++/Numerical-integration-Gauss-Legendre-Quadrature @@ -0,0 +1 @@ +../../Task/Numerical-integration-Gauss-Legendre-Quadrature/C++ \ No newline at end of file diff --git a/Lang/C++/Percolation-Bond-percolation b/Lang/C++/Percolation-Bond-percolation new file mode 120000 index 0000000000..45ef262f6d --- /dev/null +++ b/Lang/C++/Percolation-Bond-percolation @@ -0,0 +1 @@ +../../Task/Percolation-Bond-percolation/C++ \ No newline at end of file diff --git a/Lang/C++/Permutation-test b/Lang/C++/Permutation-test new file mode 120000 index 0000000000..da2dfb268d --- /dev/null +++ b/Lang/C++/Permutation-test @@ -0,0 +1 @@ +../../Task/Permutation-test/C++ \ No newline at end of file diff --git a/Lang/C++/Ray-casting-algorithm b/Lang/C++/Ray-casting-algorithm new file mode 120000 index 0000000000..2e357156a3 --- /dev/null +++ b/Lang/C++/Ray-casting-algorithm @@ -0,0 +1 @@ +../../Task/Ray-casting-algorithm/C++ \ No newline at end of file diff --git a/Lang/C++/Runge-Kutta-method b/Lang/C++/Runge-Kutta-method new file mode 120000 index 0000000000..ecb604cd85 --- /dev/null +++ b/Lang/C++/Runge-Kutta-method @@ -0,0 +1 @@ +../../Task/Runge-Kutta-method/C++ \ No newline at end of file diff --git a/Lang/C++/Sierpinski-triangle-Graphical b/Lang/C++/Sierpinski-triangle-Graphical new file mode 120000 index 0000000000..ea502bc6c4 --- /dev/null +++ b/Lang/C++/Sierpinski-triangle-Graphical @@ -0,0 +1 @@ +../../Task/Sierpinski-triangle-Graphical/C++ \ No newline at end of file diff --git a/Lang/C++/Statistics-Basic b/Lang/C++/Statistics-Basic new file mode 120000 index 0000000000..9b49897a57 --- /dev/null +++ b/Lang/C++/Statistics-Basic @@ -0,0 +1 @@ +../../Task/Statistics-Basic/C++ \ No newline at end of file diff --git a/Lang/C++/Twelve-statements b/Lang/C++/Twelve-statements new file mode 120000 index 0000000000..9a34a0974d --- /dev/null +++ b/Lang/C++/Twelve-statements @@ -0,0 +1 @@ +../../Task/Twelve-statements/C++ \ No newline at end of file diff --git a/Lang/C-Shell/00DESCRIPTION b/Lang/C-Shell/00DESCRIPTION index f15c7c3fa6..bde485fa56 100644 --- a/Lang/C-Shell/00DESCRIPTION +++ b/Lang/C-Shell/00DESCRIPTION @@ -14,6 +14,8 @@ C Shell is obsolete. Most scriptwriters prefer a Bourne-compatible shell, and fe [http://www.faqs.org/faqs/unix-faq/shell/csh-whynot/ Csh Programming Considered Harmful] and [http://www.grymoire.com/Unix/CshTop10.txt Top Ten Reasons not to use the C shell] give multiple reasons to avoid C Shell. +tcsh is a later version that fixed many of the problems with csh. It is still actively, if intermittently, maintained and has a following such as on Solaris. + == Syntax == [http://www.openbsd.org/cgi-bin/man.cgi?query=csh&apropos=0&sektion=1&manpath=OpenBSD+Current&arch=i386&format=html The manual for csh(1)] claims that C Shell has "a C-like syntax". Several other languages have a C-like syntax, including [[Java]] and [[Pike]], and Unix utilities [[AWK]] and [[bc]]. C Shell is less like [[C]] than those other languages. diff --git a/Lang/C-sharp/Abundant,-deficient-and-perfect-number-classifications b/Lang/C-sharp/Abundant,-deficient-and-perfect-number-classifications new file mode 120000 index 0000000000..15dc854044 --- /dev/null +++ b/Lang/C-sharp/Abundant,-deficient-and-perfect-number-classifications @@ -0,0 +1 @@ +../../Task/Abundant,-deficient-and-perfect-number-classifications/C-sharp \ No newline at end of file diff --git a/Lang/C-sharp/Amicable-pairs b/Lang/C-sharp/Amicable-pairs new file mode 120000 index 0000000000..b03b384d3a --- /dev/null +++ b/Lang/C-sharp/Amicable-pairs @@ -0,0 +1 @@ +../../Task/Amicable-pairs/C-sharp \ No newline at end of file diff --git a/Lang/C-sharp/Anagrams-Deranged-anagrams b/Lang/C-sharp/Anagrams-Deranged-anagrams new file mode 120000 index 0000000000..bcf296b849 --- /dev/null +++ b/Lang/C-sharp/Anagrams-Deranged-anagrams @@ -0,0 +1 @@ +../../Task/Anagrams-Deranged-anagrams/C-sharp \ No newline at end of file diff --git a/Lang/C-sharp/Circles-of-given-radius-through-two-points b/Lang/C-sharp/Circles-of-given-radius-through-two-points new file mode 120000 index 0000000000..230708c963 --- /dev/null +++ b/Lang/C-sharp/Circles-of-given-radius-through-two-points @@ -0,0 +1 @@ +../../Task/Circles-of-given-radius-through-two-points/C-sharp \ No newline at end of file diff --git a/Lang/C-sharp/Dinesmans-multiple-dwelling-problem b/Lang/C-sharp/Dinesmans-multiple-dwelling-problem new file mode 120000 index 0000000000..cfbe5f8923 --- /dev/null +++ b/Lang/C-sharp/Dinesmans-multiple-dwelling-problem @@ -0,0 +1 @@ +../../Task/Dinesmans-multiple-dwelling-problem/C-sharp \ No newline at end of file diff --git a/Lang/C-sharp/Integer-overflow b/Lang/C-sharp/Integer-overflow new file mode 120000 index 0000000000..140e33f9c5 --- /dev/null +++ b/Lang/C-sharp/Integer-overflow @@ -0,0 +1 @@ +../../Task/Integer-overflow/C-sharp \ No newline at end of file diff --git a/Lang/C-sharp/Ludic-numbers b/Lang/C-sharp/Ludic-numbers new file mode 120000 index 0000000000..93304afc0d --- /dev/null +++ b/Lang/C-sharp/Ludic-numbers @@ -0,0 +1 @@ +../../Task/Ludic-numbers/C-sharp \ No newline at end of file diff --git a/Lang/C-sharp/Map-range b/Lang/C-sharp/Map-range new file mode 120000 index 0000000000..d319ecc678 --- /dev/null +++ b/Lang/C-sharp/Map-range @@ -0,0 +1 @@ +../../Task/Map-range/C-sharp \ No newline at end of file diff --git a/Lang/C-sharp/Phrase-reversals b/Lang/C-sharp/Phrase-reversals new file mode 120000 index 0000000000..707aa4d54e --- /dev/null +++ b/Lang/C-sharp/Phrase-reversals @@ -0,0 +1 @@ +../../Task/Phrase-reversals/C-sharp \ No newline at end of file diff --git a/Lang/C-sharp/Remove-lines-from-a-file b/Lang/C-sharp/Remove-lines-from-a-file new file mode 120000 index 0000000000..7726409209 --- /dev/null +++ b/Lang/C-sharp/Remove-lines-from-a-file @@ -0,0 +1 @@ +../../Task/Remove-lines-from-a-file/C-sharp \ No newline at end of file diff --git a/Lang/C-sharp/Semordnilap b/Lang/C-sharp/Semordnilap new file mode 120000 index 0000000000..16158598aa --- /dev/null +++ b/Lang/C-sharp/Semordnilap @@ -0,0 +1 @@ +../../Task/Semordnilap/C-sharp \ No newline at end of file diff --git a/Lang/C-sharp/Set-consolidation b/Lang/C-sharp/Set-consolidation new file mode 120000 index 0000000000..75d7c52358 --- /dev/null +++ b/Lang/C-sharp/Set-consolidation @@ -0,0 +1 @@ +../../Task/Set-consolidation/C-sharp \ No newline at end of file diff --git a/Lang/C-sharp/Twelve-statements b/Lang/C-sharp/Twelve-statements new file mode 120000 index 0000000000..9a5311e8f0 --- /dev/null +++ b/Lang/C-sharp/Twelve-statements @@ -0,0 +1 @@ +../../Task/Twelve-statements/C-sharp \ No newline at end of file diff --git a/Lang/C/CSV-data-manipulation b/Lang/C/CSV-data-manipulation new file mode 120000 index 0000000000..90ca4b1c27 --- /dev/null +++ b/Lang/C/CSV-data-manipulation @@ -0,0 +1 @@ +../../Task/CSV-data-manipulation/C \ No newline at end of file diff --git a/Lang/C/Catalan-numbers-Pascals-triangle b/Lang/C/Catalan-numbers-Pascals-triangle new file mode 120000 index 0000000000..bbf3edc5fb --- /dev/null +++ b/Lang/C/Catalan-numbers-Pascals-triangle @@ -0,0 +1 @@ +../../Task/Catalan-numbers-Pascals-triangle/C \ No newline at end of file diff --git a/Lang/C/GUI-component-interaction b/Lang/C/GUI-component-interaction new file mode 120000 index 0000000000..7afd96d551 --- /dev/null +++ b/Lang/C/GUI-component-interaction @@ -0,0 +1 @@ +../../Task/GUI-component-interaction/C \ No newline at end of file diff --git a/Lang/C/GUI-enabling-disabling-of-controls b/Lang/C/GUI-enabling-disabling-of-controls new file mode 120000 index 0000000000..92f8b32be6 --- /dev/null +++ b/Lang/C/GUI-enabling-disabling-of-controls @@ -0,0 +1 @@ +../../Task/GUI-enabling-disabling-of-controls/C \ No newline at end of file diff --git a/Lang/C/MD4 b/Lang/C/MD4 new file mode 120000 index 0000000000..3ab2aeab6d --- /dev/null +++ b/Lang/C/MD4 @@ -0,0 +1 @@ +../../Task/MD4/C \ No newline at end of file diff --git a/Lang/C/Make-directory-path b/Lang/C/Make-directory-path new file mode 120000 index 0000000000..6c0820cd81 --- /dev/null +++ b/Lang/C/Make-directory-path @@ -0,0 +1 @@ +../../Task/Make-directory-path/C \ No newline at end of file diff --git a/Lang/C/Universal-Turing-machine b/Lang/C/Universal-Turing-machine new file mode 120000 index 0000000000..1a0bca4b51 --- /dev/null +++ b/Lang/C/Universal-Turing-machine @@ -0,0 +1 @@ +../../Task/Universal-Turing-machine/C \ No newline at end of file diff --git a/Lang/COBOL/00DESCRIPTION b/Lang/COBOL/00DESCRIPTION index 98ece1caa8..b556a11377 100644 --- a/Lang/COBOL/00DESCRIPTION +++ b/Lang/COBOL/00DESCRIPTION @@ -17,7 +17,7 @@ COBOL, an acronym for 'COmmon Business Oriented Language', is one of the oldest * '''COBOL 1974''' added a few more features to the language, including the ability to ACCEPT the date, day and time, and the file organization clause. * '''COBOL 1985''' added many new features to COBOL, notably including: scope terminators (END-IF, END-READ, etc.), the EVALUATE verb, the CONTINUE verb, inline PERFORM statements, the ability to pass arguments by content, and the deprecation of the infamous ALTER verb. This standard was followed by the intrinsic functions amendment and a clarifications amendment in 1989 and 1991, respectively. * '''COBOL 2002''' is the current version of COBOL and was published by [[ISO]] as ISO/IEC 1989. It included a host of new features, most notably including object-oriented programming. However, there were also other features, including: floating-point support, portable arithmetic results, pointers, calling conventions to other languages, function prototypes, [[XML]] facilities and support for execution within framework environments. This standard has suffered from poor vendor support, due to little commercial demand for the new features.John Billman & Huib Klink, 'Thoughts on the Future of COBOL Standardization', [https://www.cobolstandard.info/j4/files/08-0034.pdf] -* '''COBOL 201X''' is the next version of the standard version of the standard and is expected to be published in early 2014.ISO, 'ISO/IEC 1989', [https://www.iso.org/iso/home/store/catalogue_tc/catalogue_detail.htm?csnumber=51416] It will likely include outstanding technical reports which include object finalization and a collection class library. +* '''COBOL 2014''' is the latest version of the standard, published on July 8th, 2014 and accepted by [[ISO]] early that summer, and then adopted by [[ANSI]] on Oct 31st, 2014. ISO/IEC 1989:2014 Information technology – Programming languages, their environments and system software interfaces – Programming language COBOL', [https://www.iso.org/iso/home/store/catalogue_tc/catalogue_detail.htm?csnumber=51416] It includes numeric definitions following the [[IEEE]] 754 standard. ===References=== diff --git a/Lang/COBOL/24-game b/Lang/COBOL/24-game new file mode 120000 index 0000000000..2192c112c3 --- /dev/null +++ b/Lang/COBOL/24-game @@ -0,0 +1 @@ +../../Task/24-game/COBOL \ No newline at end of file diff --git a/Lang/COBOL/24-game-Solve b/Lang/COBOL/24-game-Solve new file mode 120000 index 0000000000..79ddd4192d --- /dev/null +++ b/Lang/COBOL/24-game-Solve @@ -0,0 +1 @@ +../../Task/24-game-Solve/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Anagrams b/Lang/COBOL/Anagrams new file mode 120000 index 0000000000..9ff573e495 --- /dev/null +++ b/Lang/COBOL/Anagrams @@ -0,0 +1 @@ +../../Task/Anagrams/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Append-a-record-to-the-end-of-a-text-file b/Lang/COBOL/Append-a-record-to-the-end-of-a-text-file new file mode 120000 index 0000000000..4261fa63f8 --- /dev/null +++ b/Lang/COBOL/Append-a-record-to-the-end-of-a-text-file @@ -0,0 +1 @@ +../../Task/Append-a-record-to-the-end-of-a-text-file/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Arbitrary-precision-integers--included- b/Lang/COBOL/Arbitrary-precision-integers--included- new file mode 120000 index 0000000000..f81c8b0684 --- /dev/null +++ b/Lang/COBOL/Arbitrary-precision-integers--included- @@ -0,0 +1 @@ +../../Task/Arbitrary-precision-integers--included-/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Arithmetic-geometric-mean b/Lang/COBOL/Arithmetic-geometric-mean new file mode 120000 index 0000000000..6fd8898438 --- /dev/null +++ b/Lang/COBOL/Arithmetic-geometric-mean @@ -0,0 +1 @@ +../../Task/Arithmetic-geometric-mean/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Array-concatenation b/Lang/COBOL/Array-concatenation new file mode 120000 index 0000000000..36accc9a2f --- /dev/null +++ b/Lang/COBOL/Array-concatenation @@ -0,0 +1 @@ +../../Task/Array-concatenation/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Averages-Root-mean-square b/Lang/COBOL/Averages-Root-mean-square new file mode 120000 index 0000000000..f966c7813b --- /dev/null +++ b/Lang/COBOL/Averages-Root-mean-square @@ -0,0 +1 @@ +../../Task/Averages-Root-mean-square/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Box-the-compass b/Lang/COBOL/Box-the-compass new file mode 120000 index 0000000000..4599f03b64 --- /dev/null +++ b/Lang/COBOL/Box-the-compass @@ -0,0 +1 @@ +../../Task/Box-the-compass/COBOL \ No newline at end of file diff --git a/Lang/COBOL/CRC-32 b/Lang/COBOL/CRC-32 new file mode 120000 index 0000000000..ec7ce2ee0c --- /dev/null +++ b/Lang/COBOL/CRC-32 @@ -0,0 +1 @@ +../../Task/CRC-32/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Call-a-foreign-language-function b/Lang/COBOL/Call-a-foreign-language-function new file mode 120000 index 0000000000..f2c6075e3f --- /dev/null +++ b/Lang/COBOL/Call-a-foreign-language-function @@ -0,0 +1 @@ +../../Task/Call-a-foreign-language-function/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Call-a-function-in-a-shared-library b/Lang/COBOL/Call-a-function-in-a-shared-library new file mode 120000 index 0000000000..6435d47c27 --- /dev/null +++ b/Lang/COBOL/Call-a-function-in-a-shared-library @@ -0,0 +1 @@ +../../Task/Call-a-function-in-a-shared-library/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Character-codes b/Lang/COBOL/Character-codes new file mode 120000 index 0000000000..8982a23559 --- /dev/null +++ b/Lang/COBOL/Character-codes @@ -0,0 +1 @@ +../../Task/Character-codes/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Check-that-file-exists b/Lang/COBOL/Check-that-file-exists new file mode 120000 index 0000000000..456a53dd7b --- /dev/null +++ b/Lang/COBOL/Check-that-file-exists @@ -0,0 +1 @@ +../../Task/Check-that-file-exists/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Collections b/Lang/COBOL/Collections new file mode 120000 index 0000000000..2439a4efcb --- /dev/null +++ b/Lang/COBOL/Collections @@ -0,0 +1 @@ +../../Task/Collections/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Continued-fraction b/Lang/COBOL/Continued-fraction new file mode 120000 index 0000000000..0cb2ff86cf --- /dev/null +++ b/Lang/COBOL/Continued-fraction @@ -0,0 +1 @@ +../../Task/Continued-fraction/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Conways-Game-of-Life b/Lang/COBOL/Conways-Game-of-Life new file mode 120000 index 0000000000..d52fe6b208 --- /dev/null +++ b/Lang/COBOL/Conways-Game-of-Life @@ -0,0 +1 @@ +../../Task/Conways-Game-of-Life/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Create-a-file b/Lang/COBOL/Create-a-file new file mode 120000 index 0000000000..a43a53b188 --- /dev/null +++ b/Lang/COBOL/Create-a-file @@ -0,0 +1 @@ +../../Task/Create-a-file/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Date-manipulation b/Lang/COBOL/Date-manipulation new file mode 120000 index 0000000000..86e068a39c --- /dev/null +++ b/Lang/COBOL/Date-manipulation @@ -0,0 +1 @@ +../../Task/Date-manipulation/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Documentation b/Lang/COBOL/Documentation new file mode 120000 index 0000000000..48a434b180 --- /dev/null +++ b/Lang/COBOL/Documentation @@ -0,0 +1 @@ +../../Task/Documentation/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Dragon-curve b/Lang/COBOL/Dragon-curve new file mode 120000 index 0000000000..a3ae016f90 --- /dev/null +++ b/Lang/COBOL/Dragon-curve @@ -0,0 +1 @@ +../../Task/Dragon-curve/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Evolutionary-algorithm b/Lang/COBOL/Evolutionary-algorithm new file mode 120000 index 0000000000..a05621efdc --- /dev/null +++ b/Lang/COBOL/Evolutionary-algorithm @@ -0,0 +1 @@ +../../Task/Evolutionary-algorithm/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Factors-of-an-integer b/Lang/COBOL/Factors-of-an-integer new file mode 120000 index 0000000000..dc7c835360 --- /dev/null +++ b/Lang/COBOL/Factors-of-an-integer @@ -0,0 +1 @@ +../../Task/Factors-of-an-integer/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Find-the-last-Sunday-of-each-month b/Lang/COBOL/Find-the-last-Sunday-of-each-month new file mode 120000 index 0000000000..9ded47228f --- /dev/null +++ b/Lang/COBOL/Find-the-last-Sunday-of-each-month @@ -0,0 +1 @@ +../../Task/Find-the-last-Sunday-of-each-month/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Five-weekends b/Lang/COBOL/Five-weekends new file mode 120000 index 0000000000..a05342881c --- /dev/null +++ b/Lang/COBOL/Five-weekends @@ -0,0 +1 @@ +../../Task/Five-weekends/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Fork b/Lang/COBOL/Fork new file mode 120000 index 0000000000..96cb8a355d --- /dev/null +++ b/Lang/COBOL/Fork @@ -0,0 +1 @@ +../../Task/Fork/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Formatted-numeric-output b/Lang/COBOL/Formatted-numeric-output new file mode 120000 index 0000000000..ac7d4d9c3a --- /dev/null +++ b/Lang/COBOL/Formatted-numeric-output @@ -0,0 +1 @@ +../../Task/Formatted-numeric-output/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Four-bit-adder b/Lang/COBOL/Four-bit-adder new file mode 120000 index 0000000000..ffc7410864 --- /dev/null +++ b/Lang/COBOL/Four-bit-adder @@ -0,0 +1 @@ +../../Task/Four-bit-adder/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Generate-lower-case-ASCII-alphabet b/Lang/COBOL/Generate-lower-case-ASCII-alphabet new file mode 120000 index 0000000000..619850a67d --- /dev/null +++ b/Lang/COBOL/Generate-lower-case-ASCII-alphabet @@ -0,0 +1 @@ +../../Task/Generate-lower-case-ASCII-alphabet/COBOL \ No newline at end of file diff --git a/Lang/COBOL/HTTP b/Lang/COBOL/HTTP new file mode 120000 index 0000000000..e7f7a5a3a6 --- /dev/null +++ b/Lang/COBOL/HTTP @@ -0,0 +1 @@ +../../Task/HTTP/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Hailstone-sequence b/Lang/COBOL/Hailstone-sequence new file mode 120000 index 0000000000..84b857c62b --- /dev/null +++ b/Lang/COBOL/Hailstone-sequence @@ -0,0 +1 @@ +../../Task/Hailstone-sequence/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Handle-a-signal b/Lang/COBOL/Handle-a-signal new file mode 120000 index 0000000000..5e3ae9dae2 --- /dev/null +++ b/Lang/COBOL/Handle-a-signal @@ -0,0 +1 @@ +../../Task/Handle-a-signal/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Integer-overflow b/Lang/COBOL/Integer-overflow new file mode 120000 index 0000000000..f7ceb187d4 --- /dev/null +++ b/Lang/COBOL/Integer-overflow @@ -0,0 +1 @@ +../../Task/Integer-overflow/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Jump-anywhere b/Lang/COBOL/Jump-anywhere new file mode 120000 index 0000000000..a56adee04e --- /dev/null +++ b/Lang/COBOL/Jump-anywhere @@ -0,0 +1 @@ +../../Task/Jump-anywhere/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Last-Friday-of-each-month b/Lang/COBOL/Last-Friday-of-each-month new file mode 120000 index 0000000000..93228a8825 --- /dev/null +++ b/Lang/COBOL/Last-Friday-of-each-month @@ -0,0 +1 @@ +../../Task/Last-Friday-of-each-month/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Literals-Integer b/Lang/COBOL/Literals-Integer new file mode 120000 index 0000000000..1b80e78a0f --- /dev/null +++ b/Lang/COBOL/Literals-Integer @@ -0,0 +1 @@ +../../Task/Literals-Integer/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Mandelbrot-set b/Lang/COBOL/Mandelbrot-set new file mode 120000 index 0000000000..a3472d9c8b --- /dev/null +++ b/Lang/COBOL/Mandelbrot-set @@ -0,0 +1 @@ +../../Task/Mandelbrot-set/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Multiplication-tables b/Lang/COBOL/Multiplication-tables new file mode 120000 index 0000000000..2b55813420 --- /dev/null +++ b/Lang/COBOL/Multiplication-tables @@ -0,0 +1 @@ +../../Task/Multiplication-tables/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Nth b/Lang/COBOL/Nth new file mode 120000 index 0000000000..8ae5f47d42 --- /dev/null +++ b/Lang/COBOL/Nth @@ -0,0 +1 @@ +../../Task/Nth/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Null-object b/Lang/COBOL/Null-object new file mode 120000 index 0000000000..325323fbf9 --- /dev/null +++ b/Lang/COBOL/Null-object @@ -0,0 +1 @@ +../../Task/Null-object/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Old-lady-swallowed-a-fly b/Lang/COBOL/Old-lady-swallowed-a-fly new file mode 120000 index 0000000000..d8ca7a6355 --- /dev/null +++ b/Lang/COBOL/Old-lady-swallowed-a-fly @@ -0,0 +1 @@ +../../Task/Old-lady-swallowed-a-fly/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Palindrome-detection b/Lang/COBOL/Palindrome-detection new file mode 120000 index 0000000000..281c65e534 --- /dev/null +++ b/Lang/COBOL/Palindrome-detection @@ -0,0 +1 @@ +../../Task/Palindrome-detection/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Pangram-checker b/Lang/COBOL/Pangram-checker new file mode 120000 index 0000000000..08de831edf --- /dev/null +++ b/Lang/COBOL/Pangram-checker @@ -0,0 +1 @@ +../../Task/Pangram-checker/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Phrase-reversals b/Lang/COBOL/Phrase-reversals new file mode 120000 index 0000000000..7451b9d287 --- /dev/null +++ b/Lang/COBOL/Phrase-reversals @@ -0,0 +1 @@ +../../Task/Phrase-reversals/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Playing-cards b/Lang/COBOL/Playing-cards new file mode 120000 index 0000000000..471f1200a2 --- /dev/null +++ b/Lang/COBOL/Playing-cards @@ -0,0 +1 @@ +../../Task/Playing-cards/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Repeat-a-string b/Lang/COBOL/Repeat-a-string new file mode 120000 index 0000000000..2093053d65 --- /dev/null +++ b/Lang/COBOL/Repeat-a-string @@ -0,0 +1 @@ +../../Task/Repeat-a-string/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Return-multiple-values b/Lang/COBOL/Return-multiple-values new file mode 120000 index 0000000000..b8a35bc81a --- /dev/null +++ b/Lang/COBOL/Return-multiple-values @@ -0,0 +1 @@ +../../Task/Return-multiple-values/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Reverse-words-in-a-string b/Lang/COBOL/Reverse-words-in-a-string new file mode 120000 index 0000000000..3060cfd6be --- /dev/null +++ b/Lang/COBOL/Reverse-words-in-a-string @@ -0,0 +1 @@ +../../Task/Reverse-words-in-a-string/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Shell-one-liner b/Lang/COBOL/Shell-one-liner new file mode 120000 index 0000000000..00324d7102 --- /dev/null +++ b/Lang/COBOL/Shell-one-liner @@ -0,0 +1 @@ +../../Task/Shell-one-liner/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Sierpinski-triangle b/Lang/COBOL/Sierpinski-triangle new file mode 120000 index 0000000000..144d0ea564 --- /dev/null +++ b/Lang/COBOL/Sierpinski-triangle @@ -0,0 +1 @@ +../../Task/Sierpinski-triangle/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Sorting-algorithms-Bead-sort b/Lang/COBOL/Sorting-algorithms-Bead-sort new file mode 120000 index 0000000000..4addb7db80 --- /dev/null +++ b/Lang/COBOL/Sorting-algorithms-Bead-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Bead-sort/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Sorting-algorithms-Bogosort b/Lang/COBOL/Sorting-algorithms-Bogosort new file mode 120000 index 0000000000..84d7ef8381 --- /dev/null +++ b/Lang/COBOL/Sorting-algorithms-Bogosort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Bogosort/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Sorting-algorithms-Heapsort b/Lang/COBOL/Sorting-algorithms-Heapsort new file mode 120000 index 0000000000..10201f2ba3 --- /dev/null +++ b/Lang/COBOL/Sorting-algorithms-Heapsort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Heapsort/COBOL \ No newline at end of file diff --git a/Lang/COBOL/String-append b/Lang/COBOL/String-append new file mode 120000 index 0000000000..5e9e75783b --- /dev/null +++ b/Lang/COBOL/String-append @@ -0,0 +1 @@ +../../Task/String-append/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Substring b/Lang/COBOL/Substring new file mode 120000 index 0000000000..e6245bc361 --- /dev/null +++ b/Lang/COBOL/Substring @@ -0,0 +1 @@ +../../Task/Substring/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Tokenize-a-string b/Lang/COBOL/Tokenize-a-string new file mode 120000 index 0000000000..623b837cb2 --- /dev/null +++ b/Lang/COBOL/Tokenize-a-string @@ -0,0 +1 @@ +../../Task/Tokenize-a-string/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Variable-size-Get b/Lang/COBOL/Variable-size-Get new file mode 120000 index 0000000000..8c990ba317 --- /dev/null +++ b/Lang/COBOL/Variable-size-Get @@ -0,0 +1 @@ +../../Task/Variable-size-Get/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Variadic-function b/Lang/COBOL/Variadic-function new file mode 120000 index 0000000000..e698e17055 --- /dev/null +++ b/Lang/COBOL/Variadic-function @@ -0,0 +1 @@ +../../Task/Variadic-function/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Window-creation-X11 b/Lang/COBOL/Window-creation-X11 new file mode 120000 index 0000000000..135c1a6099 --- /dev/null +++ b/Lang/COBOL/Window-creation-X11 @@ -0,0 +1 @@ +../../Task/Window-creation-X11/COBOL \ No newline at end of file diff --git a/Lang/COBOL/Zero-to-the-zero-power b/Lang/COBOL/Zero-to-the-zero-power new file mode 120000 index 0000000000..b3b3e0e945 --- /dev/null +++ b/Lang/COBOL/Zero-to-the-zero-power @@ -0,0 +1 @@ +../../Task/Zero-to-the-zero-power/COBOL \ No newline at end of file diff --git a/Lang/Cache-ObjectScript/00DESCRIPTION b/Lang/Cache-ObjectScript/00DESCRIPTION index 059dfee753..8c52ca52d5 100644 --- a/Lang/Cache-ObjectScript/00DESCRIPTION +++ b/Lang/Cache-ObjectScript/00DESCRIPTION @@ -11,8 +11,11 @@

==Documentation== -''InterSystems Documentation''
+''InterSystems Documentation Overview Page''
http://docs.intersystems.com -''InterSystems Class Reference (Caché 2012.2)''
-http://docs.intersystems.com/cache20122/csp/documatic/%25CSP.Documatic.cls \ No newline at end of file +''InterSystems Product Documentation (Caché and Ensemble)''
+http://docs.intersystems.com/latest/csp/docbook/DocBook.UI.Page.cls + +''InterSystems Class Reference (Caché and Ensemble system, library, and sample classes)''
+http://docs.intersystems.com/latest/csp/documatic/%25CSP.Documatic.cls \ No newline at end of file diff --git a/Lang/Clojure/Almost-prime b/Lang/Clojure/Almost-prime new file mode 120000 index 0000000000..645dae3ffc --- /dev/null +++ b/Lang/Clojure/Almost-prime @@ -0,0 +1 @@ +../../Task/Almost-prime/Clojure \ No newline at end of file diff --git a/Lang/Clojure/Arithmetic-geometric-mean b/Lang/Clojure/Arithmetic-geometric-mean new file mode 120000 index 0000000000..aad55e7b86 --- /dev/null +++ b/Lang/Clojure/Arithmetic-geometric-mean @@ -0,0 +1 @@ +../../Task/Arithmetic-geometric-mean/Clojure \ No newline at end of file diff --git a/Lang/Clojure/Arithmetic-geometric-mean-Calculate-Pi b/Lang/Clojure/Arithmetic-geometric-mean-Calculate-Pi new file mode 120000 index 0000000000..1dcc923dfc --- /dev/null +++ b/Lang/Clojure/Arithmetic-geometric-mean-Calculate-Pi @@ -0,0 +1 @@ +../../Task/Arithmetic-geometric-mean-Calculate-Pi/Clojure \ No newline at end of file diff --git a/Lang/Clojure/Average-loop-length b/Lang/Clojure/Average-loop-length new file mode 120000 index 0000000000..b340c5b023 --- /dev/null +++ b/Lang/Clojure/Average-loop-length @@ -0,0 +1 @@ +../../Task/Average-loop-length/Clojure \ No newline at end of file diff --git a/Lang/Clojure/Bernoulli-numbers b/Lang/Clojure/Bernoulli-numbers new file mode 120000 index 0000000000..3c3647884b --- /dev/null +++ b/Lang/Clojure/Bernoulli-numbers @@ -0,0 +1 @@ +../../Task/Bernoulli-numbers/Clojure \ No newline at end of file diff --git a/Lang/Clojure/CSV-to-HTML-translation b/Lang/Clojure/CSV-to-HTML-translation new file mode 120000 index 0000000000..e5bd68bd17 --- /dev/null +++ b/Lang/Clojure/CSV-to-HTML-translation @@ -0,0 +1 @@ +../../Task/CSV-to-HTML-translation/Clojure \ No newline at end of file diff --git a/Lang/Clojure/Check-Machin-like-formulas b/Lang/Clojure/Check-Machin-like-formulas new file mode 120000 index 0000000000..6a96cd6f12 --- /dev/null +++ b/Lang/Clojure/Check-Machin-like-formulas @@ -0,0 +1 @@ +../../Task/Check-Machin-like-formulas/Clojure \ No newline at end of file diff --git a/Lang/Clojure/Chinese-remainder-theorem b/Lang/Clojure/Chinese-remainder-theorem new file mode 120000 index 0000000000..636957ed54 --- /dev/null +++ b/Lang/Clojure/Chinese-remainder-theorem @@ -0,0 +1 @@ +../../Task/Chinese-remainder-theorem/Clojure \ No newline at end of file diff --git a/Lang/Clojure/Closures-Value-capture b/Lang/Clojure/Closures-Value-capture new file mode 120000 index 0000000000..949e2f808e --- /dev/null +++ b/Lang/Clojure/Closures-Value-capture @@ -0,0 +1 @@ +../../Task/Closures-Value-capture/Clojure \ No newline at end of file diff --git a/Lang/Clojure/Continued-fraction b/Lang/Clojure/Continued-fraction new file mode 120000 index 0000000000..965fec4ae7 --- /dev/null +++ b/Lang/Clojure/Continued-fraction @@ -0,0 +1 @@ +../../Task/Continued-fraction/Clojure \ No newline at end of file diff --git a/Lang/Clojure/Count-in-factors b/Lang/Clojure/Count-in-factors new file mode 120000 index 0000000000..885bf2a1ab --- /dev/null +++ b/Lang/Clojure/Count-in-factors @@ -0,0 +1 @@ +../../Task/Count-in-factors/Clojure \ No newline at end of file diff --git a/Lang/Clojure/Euler-method b/Lang/Clojure/Euler-method new file mode 120000 index 0000000000..bd766c1af8 --- /dev/null +++ b/Lang/Clojure/Euler-method @@ -0,0 +1 @@ +../../Task/Euler-method/Clojure \ No newline at end of file diff --git a/Lang/Clojure/Events b/Lang/Clojure/Events new file mode 120000 index 0000000000..68ca18bfb1 --- /dev/null +++ b/Lang/Clojure/Events @@ -0,0 +1 @@ +../../Task/Events/Clojure \ No newline at end of file diff --git a/Lang/Clojure/Extensible-prime-generator b/Lang/Clojure/Extensible-prime-generator new file mode 120000 index 0000000000..cf5bc137df --- /dev/null +++ b/Lang/Clojure/Extensible-prime-generator @@ -0,0 +1 @@ +../../Task/Extensible-prime-generator/Clojure \ No newline at end of file diff --git a/Lang/Clojure/Factors-of-a-Mersenne-number b/Lang/Clojure/Factors-of-a-Mersenne-number new file mode 120000 index 0000000000..ea3b31a35c --- /dev/null +++ b/Lang/Clojure/Factors-of-a-Mersenne-number @@ -0,0 +1 @@ +../../Task/Factors-of-a-Mersenne-number/Clojure \ No newline at end of file diff --git a/Lang/Clojure/Generate-Chess960-starting-position b/Lang/Clojure/Generate-Chess960-starting-position new file mode 120000 index 0000000000..d80352d843 --- /dev/null +++ b/Lang/Clojure/Generate-Chess960-starting-position @@ -0,0 +1 @@ +../../Task/Generate-Chess960-starting-position/Clojure \ No newline at end of file diff --git a/Lang/Clojure/I-before-E-except-after-C b/Lang/Clojure/I-before-E-except-after-C new file mode 120000 index 0000000000..31640789f3 --- /dev/null +++ b/Lang/Clojure/I-before-E-except-after-C @@ -0,0 +1 @@ +../../Task/I-before-E-except-after-C/Clojure \ No newline at end of file diff --git a/Lang/Clojure/Iterated-digits-squaring b/Lang/Clojure/Iterated-digits-squaring new file mode 120000 index 0000000000..ab0a930b58 --- /dev/null +++ b/Lang/Clojure/Iterated-digits-squaring @@ -0,0 +1 @@ +../../Task/Iterated-digits-squaring/Clojure \ No newline at end of file diff --git a/Lang/Clojure/Knapsack-problem-Bounded b/Lang/Clojure/Knapsack-problem-Bounded new file mode 120000 index 0000000000..9b754c6ca6 --- /dev/null +++ b/Lang/Clojure/Knapsack-problem-Bounded @@ -0,0 +1 @@ +../../Task/Knapsack-problem-Bounded/Clojure \ No newline at end of file diff --git a/Lang/Clojure/Left-factorials b/Lang/Clojure/Left-factorials new file mode 120000 index 0000000000..0bc2d8d01d --- /dev/null +++ b/Lang/Clojure/Left-factorials @@ -0,0 +1 @@ +../../Task/Left-factorials/Clojure \ No newline at end of file diff --git a/Lang/Clojure/Longest-string-challenge b/Lang/Clojure/Longest-string-challenge new file mode 120000 index 0000000000..ef8f9e5bd4 --- /dev/null +++ b/Lang/Clojure/Longest-string-challenge @@ -0,0 +1 @@ +../../Task/Longest-string-challenge/Clojure \ No newline at end of file diff --git a/Lang/Clojure/Mad-Libs b/Lang/Clojure/Mad-Libs new file mode 120000 index 0000000000..90cb120fc8 --- /dev/null +++ b/Lang/Clojure/Mad-Libs @@ -0,0 +1 @@ +../../Task/Mad-Libs/Clojure \ No newline at end of file diff --git a/Lang/Clojure/Modular-inverse b/Lang/Clojure/Modular-inverse new file mode 120000 index 0000000000..519b45c967 --- /dev/null +++ b/Lang/Clojure/Modular-inverse @@ -0,0 +1 @@ +../../Task/Modular-inverse/Clojure \ No newline at end of file diff --git a/Lang/Clojure/Nth-root b/Lang/Clojure/Nth-root new file mode 120000 index 0000000000..ddd4fd24cf --- /dev/null +++ b/Lang/Clojure/Nth-root @@ -0,0 +1 @@ +../../Task/Nth-root/Clojure \ No newline at end of file diff --git a/Lang/Clojure/Pernicious-numbers b/Lang/Clojure/Pernicious-numbers new file mode 120000 index 0000000000..975cb67a78 --- /dev/null +++ b/Lang/Clojure/Pernicious-numbers @@ -0,0 +1 @@ +../../Task/Pernicious-numbers/Clojure \ No newline at end of file diff --git a/Lang/Clojure/Pi b/Lang/Clojure/Pi new file mode 120000 index 0000000000..93cdc5e28a --- /dev/null +++ b/Lang/Clojure/Pi @@ -0,0 +1 @@ +../../Task/Pi/Clojure \ No newline at end of file diff --git a/Lang/Clojure/Sequence-of-primes-by-Trial-Division b/Lang/Clojure/Sequence-of-primes-by-Trial-Division new file mode 120000 index 0000000000..a8495dea9e --- /dev/null +++ b/Lang/Clojure/Sequence-of-primes-by-Trial-Division @@ -0,0 +1 @@ +../../Task/Sequence-of-primes-by-Trial-Division/Clojure \ No newline at end of file diff --git a/Lang/CoffeeScript/Averages-Pythagorean-means b/Lang/CoffeeScript/Averages-Pythagorean-means new file mode 120000 index 0000000000..e42e147812 --- /dev/null +++ b/Lang/CoffeeScript/Averages-Pythagorean-means @@ -0,0 +1 @@ +../../Task/Averages-Pythagorean-means/CoffeeScript \ No newline at end of file diff --git a/Lang/CoffeeScript/Even-or-odd b/Lang/CoffeeScript/Even-or-odd new file mode 120000 index 0000000000..b60ca3a855 --- /dev/null +++ b/Lang/CoffeeScript/Even-or-odd @@ -0,0 +1 @@ +../../Task/Even-or-odd/CoffeeScript \ No newline at end of file diff --git a/Lang/CoffeeScript/Floyds-triangle b/Lang/CoffeeScript/Floyds-triangle new file mode 120000 index 0000000000..b44b240c78 --- /dev/null +++ b/Lang/CoffeeScript/Floyds-triangle @@ -0,0 +1 @@ +../../Task/Floyds-triangle/CoffeeScript \ No newline at end of file diff --git a/Lang/CoffeeScript/Hello-world-Newline-omission b/Lang/CoffeeScript/Hello-world-Newline-omission new file mode 120000 index 0000000000..f584e81d8d --- /dev/null +++ b/Lang/CoffeeScript/Hello-world-Newline-omission @@ -0,0 +1 @@ +../../Task/Hello-world-Newline-omission/CoffeeScript \ No newline at end of file diff --git a/Lang/CoffeeScript/Heronian-triangles b/Lang/CoffeeScript/Heronian-triangles new file mode 120000 index 0000000000..acb85e3390 --- /dev/null +++ b/Lang/CoffeeScript/Heronian-triangles @@ -0,0 +1 @@ +../../Task/Heronian-triangles/CoffeeScript \ No newline at end of file diff --git a/Lang/CoffeeScript/Hofstadter-Figure-Figure-sequences b/Lang/CoffeeScript/Hofstadter-Figure-Figure-sequences new file mode 120000 index 0000000000..13393f1fdf --- /dev/null +++ b/Lang/CoffeeScript/Hofstadter-Figure-Figure-sequences @@ -0,0 +1 @@ +../../Task/Hofstadter-Figure-Figure-sequences/CoffeeScript \ No newline at end of file diff --git a/Lang/CoffeeScript/Hofstadter-Q-sequence b/Lang/CoffeeScript/Hofstadter-Q-sequence new file mode 120000 index 0000000000..b972831710 --- /dev/null +++ b/Lang/CoffeeScript/Hofstadter-Q-sequence @@ -0,0 +1 @@ +../../Task/Hofstadter-Q-sequence/CoffeeScript \ No newline at end of file diff --git a/Lang/CoffeeScript/Kaprekar-numbers b/Lang/CoffeeScript/Kaprekar-numbers new file mode 120000 index 0000000000..afb0bca23f --- /dev/null +++ b/Lang/CoffeeScript/Kaprekar-numbers @@ -0,0 +1 @@ +../../Task/Kaprekar-numbers/CoffeeScript \ No newline at end of file diff --git a/Lang/CoffeeScript/Loops-Break b/Lang/CoffeeScript/Loops-Break new file mode 120000 index 0000000000..d7123b432a --- /dev/null +++ b/Lang/CoffeeScript/Loops-Break @@ -0,0 +1 @@ +../../Task/Loops-Break/CoffeeScript \ No newline at end of file diff --git a/Lang/CoffeeScript/Remove-duplicate-elements b/Lang/CoffeeScript/Remove-duplicate-elements new file mode 120000 index 0000000000..25458632a5 --- /dev/null +++ b/Lang/CoffeeScript/Remove-duplicate-elements @@ -0,0 +1 @@ +../../Task/Remove-duplicate-elements/CoffeeScript \ No newline at end of file diff --git a/Lang/CoffeeScript/Reverse-words-in-a-string b/Lang/CoffeeScript/Reverse-words-in-a-string new file mode 120000 index 0000000000..c73f1f0732 --- /dev/null +++ b/Lang/CoffeeScript/Reverse-words-in-a-string @@ -0,0 +1 @@ +../../Task/Reverse-words-in-a-string/CoffeeScript \ No newline at end of file diff --git a/Lang/CoffeeScript/String-append b/Lang/CoffeeScript/String-append new file mode 120000 index 0000000000..ac83155f1f --- /dev/null +++ b/Lang/CoffeeScript/String-append @@ -0,0 +1 @@ +../../Task/String-append/CoffeeScript \ No newline at end of file diff --git a/Lang/Common-Lisp/Aliquot-sequence-classifications b/Lang/Common-Lisp/Aliquot-sequence-classifications new file mode 120000 index 0000000000..3c1b8cde3a --- /dev/null +++ b/Lang/Common-Lisp/Aliquot-sequence-classifications @@ -0,0 +1 @@ +../../Task/Aliquot-sequence-classifications/Common-Lisp \ No newline at end of file diff --git a/Lang/Common-Lisp/Arithmetic-geometric-mean-Calculate-Pi b/Lang/Common-Lisp/Arithmetic-geometric-mean-Calculate-Pi new file mode 120000 index 0000000000..470db0e19d --- /dev/null +++ b/Lang/Common-Lisp/Arithmetic-geometric-mean-Calculate-Pi @@ -0,0 +1 @@ +../../Task/Arithmetic-geometric-mean-Calculate-Pi/Common-Lisp \ No newline at end of file diff --git a/Lang/Common-Lisp/Combinations-and-permutations b/Lang/Common-Lisp/Combinations-and-permutations new file mode 120000 index 0000000000..b6b324326e --- /dev/null +++ b/Lang/Common-Lisp/Combinations-and-permutations @@ -0,0 +1 @@ +../../Task/Combinations-and-permutations/Common-Lisp \ No newline at end of file diff --git a/Lang/Common-Lisp/Conjugate-transpose b/Lang/Common-Lisp/Conjugate-transpose new file mode 120000 index 0000000000..cc47e34abe --- /dev/null +++ b/Lang/Common-Lisp/Conjugate-transpose @@ -0,0 +1 @@ +../../Task/Conjugate-transpose/Common-Lisp \ No newline at end of file diff --git a/Lang/Common-Lisp/Five-weekends b/Lang/Common-Lisp/Five-weekends new file mode 120000 index 0000000000..605411d745 --- /dev/null +++ b/Lang/Common-Lisp/Five-weekends @@ -0,0 +1 @@ +../../Task/Five-weekends/Common-Lisp \ No newline at end of file diff --git a/Lang/Common-Lisp/Function-frequency b/Lang/Common-Lisp/Function-frequency new file mode 120000 index 0000000000..2c8acdd84b --- /dev/null +++ b/Lang/Common-Lisp/Function-frequency @@ -0,0 +1 @@ +../../Task/Function-frequency/Common-Lisp \ No newline at end of file diff --git a/Lang/Common-Lisp/Gaussian-elimination b/Lang/Common-Lisp/Gaussian-elimination new file mode 120000 index 0000000000..8be2023690 --- /dev/null +++ b/Lang/Common-Lisp/Gaussian-elimination @@ -0,0 +1 @@ +../../Task/Gaussian-elimination/Common-Lisp \ No newline at end of file diff --git a/Lang/Common-Lisp/History-variables b/Lang/Common-Lisp/History-variables new file mode 120000 index 0000000000..d2baab482e --- /dev/null +++ b/Lang/Common-Lisp/History-variables @@ -0,0 +1 @@ +../../Task/History-variables/Common-Lisp \ No newline at end of file diff --git a/Lang/Common-Lisp/Old-lady-swallowed-a-fly b/Lang/Common-Lisp/Old-lady-swallowed-a-fly new file mode 120000 index 0000000000..281ebc242c --- /dev/null +++ b/Lang/Common-Lisp/Old-lady-swallowed-a-fly @@ -0,0 +1 @@ +../../Task/Old-lady-swallowed-a-fly/Common-Lisp \ No newline at end of file diff --git a/Lang/Common-Lisp/Parsing-RPN-to-infix-conversion b/Lang/Common-Lisp/Parsing-RPN-to-infix-conversion new file mode 120000 index 0000000000..1247e345bf --- /dev/null +++ b/Lang/Common-Lisp/Parsing-RPN-to-infix-conversion @@ -0,0 +1 @@ +../../Task/Parsing-RPN-to-infix-conversion/Common-Lisp \ No newline at end of file diff --git a/Lang/Common-Lisp/Parsing-Shunting-yard-algorithm b/Lang/Common-Lisp/Parsing-Shunting-yard-algorithm new file mode 120000 index 0000000000..a6f169a3de --- /dev/null +++ b/Lang/Common-Lisp/Parsing-Shunting-yard-algorithm @@ -0,0 +1 @@ +../../Task/Parsing-Shunting-yard-algorithm/Common-Lisp \ No newline at end of file diff --git a/Lang/Common-Lisp/Phrase-reversals b/Lang/Common-Lisp/Phrase-reversals new file mode 120000 index 0000000000..53ea0f941c --- /dev/null +++ b/Lang/Common-Lisp/Phrase-reversals @@ -0,0 +1 @@ +../../Task/Phrase-reversals/Common-Lisp \ No newline at end of file diff --git a/Lang/Common-Lisp/Rep-string b/Lang/Common-Lisp/Rep-string new file mode 120000 index 0000000000..054216379b --- /dev/null +++ b/Lang/Common-Lisp/Rep-string @@ -0,0 +1 @@ +../../Task/Rep-string/Common-Lisp \ No newline at end of file diff --git a/Lang/Common-Lisp/Sequence-of-primes-by-Trial-Division b/Lang/Common-Lisp/Sequence-of-primes-by-Trial-Division new file mode 120000 index 0000000000..d859c3d9cb --- /dev/null +++ b/Lang/Common-Lisp/Sequence-of-primes-by-Trial-Division @@ -0,0 +1 @@ +../../Task/Sequence-of-primes-by-Trial-Division/Common-Lisp \ No newline at end of file diff --git a/Lang/Common-Lisp/The-ISAAC-Cipher b/Lang/Common-Lisp/The-ISAAC-Cipher new file mode 120000 index 0000000000..a21ea16850 --- /dev/null +++ b/Lang/Common-Lisp/The-ISAAC-Cipher @@ -0,0 +1 @@ +../../Task/The-ISAAC-Cipher/Common-Lisp \ No newline at end of file diff --git a/Lang/Common-Lisp/The-Twelve-Days-of-Christmas b/Lang/Common-Lisp/The-Twelve-Days-of-Christmas new file mode 120000 index 0000000000..86d4599e3d --- /dev/null +++ b/Lang/Common-Lisp/The-Twelve-Days-of-Christmas @@ -0,0 +1 @@ +../../Task/The-Twelve-Days-of-Christmas/Common-Lisp \ No newline at end of file diff --git a/Lang/Common-Lisp/Unix-ls b/Lang/Common-Lisp/Unix-ls new file mode 120000 index 0000000000..01dd8ff8e5 --- /dev/null +++ b/Lang/Common-Lisp/Unix-ls @@ -0,0 +1 @@ +../../Task/Unix-ls/Common-Lisp \ No newline at end of file diff --git a/Lang/Common-Lisp/Word-wrap b/Lang/Common-Lisp/Word-wrap new file mode 120000 index 0000000000..5b226cfa64 --- /dev/null +++ b/Lang/Common-Lisp/Word-wrap @@ -0,0 +1 @@ +../../Task/Word-wrap/Common-Lisp \ No newline at end of file diff --git a/Lang/Component-Pascal/Greyscale-bars-Display b/Lang/Component-Pascal/Greyscale-bars-Display new file mode 120000 index 0000000000..01ddd1a11a --- /dev/null +++ b/Lang/Component-Pascal/Greyscale-bars-Display @@ -0,0 +1 @@ +../../Task/Greyscale-bars-Display/Component-Pascal \ No newline at end of file diff --git a/Lang/D/00DESCRIPTION b/Lang/D/00DESCRIPTION index e9941092f0..4fad299405 100644 --- a/Lang/D/00DESCRIPTION +++ b/Lang/D/00DESCRIPTION @@ -1,4 +1,5 @@ {{language|D +|exec=machine |strength=strong |gc=yes |safety=both @@ -13,7 +14,7 @@ {{language programming paradigm|object-oriented}} {{language programming paradigm|Functional}} {{language programming paradigm|generic}} -'''D''' is an [[object-oriented]], [[imperative programming|imperative]], multi-[[:Category:Programming Paradigms|paradigm]] system programming language by Walter Bright of Digital Mars. It originated as a re-engineering of [[C++]], but even though it is predominantly influenced by that language, it is not a variant of C++. D has redesigned some C++ features and has been influenced by concepts used in other programming languages, such as [[Python]], [[Java]], [[C sharp|C#]] and [[Eiffel]]. +'''D''' is an [[object-oriented]], [[imperative programming|imperative]], multi-[[:Category:Programming Paradigms|paradigm]] systems programming language designed by Walter Bright of Digital Mars. Although it originated as a re-engineering of [[C++]], and is thus predominantly influenced by that language, it is not a variant of C++. Rather, D redesigns some C++ features and is influenced by concepts from other programming languages such as [[Python]], [[Java]], [[C sharp|C#]] and [[Eiffel]]. ==Citations== * [[wp:D (programming language)|Wikipedia:D (programming language)]] \ No newline at end of file diff --git a/Lang/D/Chat-server b/Lang/D/Chat-server new file mode 120000 index 0000000000..46db52c829 --- /dev/null +++ b/Lang/D/Chat-server @@ -0,0 +1 @@ +../../Task/Chat-server/D \ No newline at end of file diff --git a/Lang/D/Morse-code b/Lang/D/Morse-code new file mode 120000 index 0000000000..b60d84fff9 --- /dev/null +++ b/Lang/D/Morse-code @@ -0,0 +1 @@ +../../Task/Morse-code/D \ No newline at end of file diff --git a/Lang/DWScript/Range-expansion b/Lang/DWScript/Range-expansion new file mode 120000 index 0000000000..e5cede73b9 --- /dev/null +++ b/Lang/DWScript/Range-expansion @@ -0,0 +1 @@ +../../Task/Range-expansion/DWScript \ No newline at end of file diff --git a/Lang/DWScript/SHA-1 b/Lang/DWScript/SHA-1 new file mode 120000 index 0000000000..18dc243b4e --- /dev/null +++ b/Lang/DWScript/SHA-1 @@ -0,0 +1 @@ +../../Task/SHA-1/DWScript \ No newline at end of file diff --git a/Lang/DWScript/SHA-256 b/Lang/DWScript/SHA-256 new file mode 120000 index 0000000000..ed8a2e1ad5 --- /dev/null +++ b/Lang/DWScript/SHA-256 @@ -0,0 +1 @@ +../../Task/SHA-256/DWScript \ No newline at end of file diff --git a/Lang/Dc/99-Bottles-of-Beer b/Lang/Dc/99-Bottles-of-Beer new file mode 120000 index 0000000000..f29dc2b412 --- /dev/null +++ b/Lang/Dc/99-Bottles-of-Beer @@ -0,0 +1 @@ +../../Task/99-Bottles-of-Beer/Dc \ No newline at end of file diff --git a/Lang/Delphi/Morse-code b/Lang/Delphi/Morse-code new file mode 120000 index 0000000000..8b9d013a23 --- /dev/null +++ b/Lang/Delphi/Morse-code @@ -0,0 +1 @@ +../../Task/Morse-code/Delphi \ No newline at end of file diff --git a/Lang/Delphi/Voronoi-diagram b/Lang/Delphi/Voronoi-diagram new file mode 120000 index 0000000000..9c14fb8da4 --- /dev/null +++ b/Lang/Delphi/Voronoi-diagram @@ -0,0 +1 @@ +../../Task/Voronoi-diagram/Delphi \ No newline at end of file diff --git a/Lang/EC/00DESCRIPTION b/Lang/EC/00DESCRIPTION index da088ab50c..475480e0c2 100644 --- a/Lang/EC/00DESCRIPTION +++ b/Lang/EC/00DESCRIPTION @@ -50,7 +50,6 @@ The Ecere SDK is completely free and includes a full-featured [[Ecere IDE|Integr pen.color = ColorCMYK { 0, 100, 100, 0 }; ==External links== -*[http://www.ecere.com/technologies.html#eC Description of eC language on official web site] -*[http://www.ecere.com/ Ecere Corporation's web site] -*[http://zerotri.net/wiki/doku.php?id=ecere_review Review of eC language and SDK by zerotri] +*[http://ec-lang.org/overview Description of eC language on official web site] +*[http://ecere.ca/ Ecere Corporation's web site] *[http://freshmeat.net/projects/ecere/ Ecere SDK project on FreshMeat] \ No newline at end of file diff --git a/Lang/Eiffel/00DESCRIPTION b/Lang/Eiffel/00DESCRIPTION index bdfb45c236..3de80af8d0 100644 --- a/Lang/Eiffel/00DESCRIPTION +++ b/Lang/Eiffel/00DESCRIPTION @@ -1,7 +1,9 @@ -{{Stub}}{{language|Eiffel +{{language|Eiffel |strength=strong |safety=safe |compat=nominative |checking=static |gc=yes -|LCT=yes}} \ No newline at end of file +|LCT=yes}}'''Eiffel''' is an [[ISO]]-standardized, [[object-oriented]] programming language designed by Bertrand Meyer and Eiffel Software. The design of the language is closely connected with the Eiffel programming method, a set of principles consisting of [[wp:Design_by_contract|design by contract]], [[wp:Command-query_separation|command query separation]], the [[wp:Uniform_access_principle|uniform access principle]], the [[wp:Single-choice_principle|single-choice principle]], the [[wp:Open-Closed_principle|open-closed principle]], and the [[wp:Option-operand_separation|option-operand separation principle]]. + +Many concepts initially introduced by Eiffel later found their way into, among others, [[Java]] and [[C#]]. New language design ideas, particularly through the Ecma/ISO standardization process, continue to be incorporated into the Eiffel language. \ No newline at end of file diff --git a/Lang/Eiffel/Active-Directory-Search-for-a-user b/Lang/Eiffel/Active-Directory-Search-for-a-user new file mode 120000 index 0000000000..2c1701fa7b --- /dev/null +++ b/Lang/Eiffel/Active-Directory-Search-for-a-user @@ -0,0 +1 @@ +../../Task/Active-Directory-Search-for-a-user/Eiffel \ No newline at end of file diff --git a/Lang/Eiffel/Hello-world-Newbie b/Lang/Eiffel/Hello-world-Newbie new file mode 120000 index 0000000000..7d3e045e04 --- /dev/null +++ b/Lang/Eiffel/Hello-world-Newbie @@ -0,0 +1 @@ +../../Task/Hello-world-Newbie/Eiffel \ No newline at end of file diff --git a/Lang/Ela/00DESCRIPTION b/Lang/Ela/00DESCRIPTION index d60e29e01a..c1790d255a 100644 --- a/Lang/Ela/00DESCRIPTION +++ b/Lang/Ela/00DESCRIPTION @@ -10,5 +10,5 @@ |parampass=value }} {{language programming paradigm|functional}} -Ela is a pure functional language. Ela supports both strict and non-strict evaluation but is strict by default. Ela has a layout based, [[Haskell]] style syntax. Features supported by Ela include first class functions, pattern matching, lazy evaluation, algebraic data types (including open algebraic data types), type classes. +[http://elalang.net/ Ela] is a pure functional language. Ela supports both strict and non-strict evaluation but is strict by default. Ela has a layout-based, [[Haskell]]-style syntax. Features supported by Ela include first class functions, pattern matching, lazy evaluation, algebraic data types (including open algebraic data types), and type classes. Ela runs on its own virtual machine but currently requires [[.NET]] or [[Mono]]. \ No newline at end of file diff --git a/Lang/Ela/ABC-Problem b/Lang/Ela/ABC-Problem new file mode 120000 index 0000000000..53482796d1 --- /dev/null +++ b/Lang/Ela/ABC-Problem @@ -0,0 +1 @@ +../../Task/ABC-Problem/Ela \ No newline at end of file diff --git a/Lang/Ela/Abundant,-deficient-and-perfect-number-classifications b/Lang/Ela/Abundant,-deficient-and-perfect-number-classifications new file mode 120000 index 0000000000..7bbf5d31ad --- /dev/null +++ b/Lang/Ela/Abundant,-deficient-and-perfect-number-classifications @@ -0,0 +1 @@ +../../Task/Abundant,-deficient-and-perfect-number-classifications/Ela \ No newline at end of file diff --git a/Lang/Ela/Amicable-pairs b/Lang/Ela/Amicable-pairs new file mode 120000 index 0000000000..ce00339d4a --- /dev/null +++ b/Lang/Ela/Amicable-pairs @@ -0,0 +1 @@ +../../Task/Amicable-pairs/Ela \ No newline at end of file diff --git a/Lang/Ela/Anagrams b/Lang/Ela/Anagrams new file mode 120000 index 0000000000..429163611d --- /dev/null +++ b/Lang/Ela/Anagrams @@ -0,0 +1 @@ +../../Task/Anagrams/Ela \ No newline at end of file diff --git a/Lang/Ela/Array-concatenation b/Lang/Ela/Array-concatenation new file mode 120000 index 0000000000..e5177bf108 --- /dev/null +++ b/Lang/Ela/Array-concatenation @@ -0,0 +1 @@ +../../Task/Array-concatenation/Ela \ No newline at end of file diff --git a/Lang/Ela/Caesar-cipher b/Lang/Ela/Caesar-cipher new file mode 120000 index 0000000000..321637f512 --- /dev/null +++ b/Lang/Ela/Caesar-cipher @@ -0,0 +1 @@ +../../Task/Caesar-cipher/Ela \ No newline at end of file diff --git a/Lang/Ela/Exponentiation-operator b/Lang/Ela/Exponentiation-operator new file mode 120000 index 0000000000..bc6cc02615 --- /dev/null +++ b/Lang/Ela/Exponentiation-operator @@ -0,0 +1 @@ +../../Task/Exponentiation-operator/Ela \ No newline at end of file diff --git a/Lang/Ela/Literals-String b/Lang/Ela/Literals-String new file mode 120000 index 0000000000..201fc1c491 --- /dev/null +++ b/Lang/Ela/Literals-String @@ -0,0 +1 @@ +../../Task/Literals-String/Ela \ No newline at end of file diff --git a/Lang/Ela/Matrix-multiplication b/Lang/Ela/Matrix-multiplication new file mode 120000 index 0000000000..b5b26e3f28 --- /dev/null +++ b/Lang/Ela/Matrix-multiplication @@ -0,0 +1 @@ +../../Task/Matrix-multiplication/Ela \ No newline at end of file diff --git a/Lang/Ela/Prime-decomposition b/Lang/Ela/Prime-decomposition new file mode 120000 index 0000000000..7ee0608b1f --- /dev/null +++ b/Lang/Ela/Prime-decomposition @@ -0,0 +1 @@ +../../Task/Prime-decomposition/Ela \ No newline at end of file diff --git a/Lang/Ela/Reverse-a-string b/Lang/Ela/Reverse-a-string new file mode 120000 index 0000000000..bd3cffee2e --- /dev/null +++ b/Lang/Ela/Reverse-a-string @@ -0,0 +1 @@ +../../Task/Reverse-a-string/Ela \ No newline at end of file diff --git a/Lang/Ela/Roman-numerals-Encode b/Lang/Ela/Roman-numerals-Encode new file mode 120000 index 0000000000..ff04448c46 --- /dev/null +++ b/Lang/Ela/Roman-numerals-Encode @@ -0,0 +1 @@ +../../Task/Roman-numerals-Encode/Ela \ No newline at end of file diff --git a/Lang/Ela/String-concatenation b/Lang/Ela/String-concatenation new file mode 120000 index 0000000000..bc4098de16 --- /dev/null +++ b/Lang/Ela/String-concatenation @@ -0,0 +1 @@ +../../Task/String-concatenation/Ela \ No newline at end of file diff --git a/Lang/Ela/Towers-of-Hanoi b/Lang/Ela/Towers-of-Hanoi new file mode 120000 index 0000000000..878a930b77 --- /dev/null +++ b/Lang/Ela/Towers-of-Hanoi @@ -0,0 +1 @@ +../../Task/Towers-of-Hanoi/Ela \ No newline at end of file diff --git a/Lang/Elena/99-Bottles-of-Beer b/Lang/Elena/99-Bottles-of-Beer new file mode 120000 index 0000000000..71a89c51f2 --- /dev/null +++ b/Lang/Elena/99-Bottles-of-Beer @@ -0,0 +1 @@ +../../Task/99-Bottles-of-Beer/Elena \ No newline at end of file diff --git a/Lang/Elena/ABC-Problem b/Lang/Elena/ABC-Problem new file mode 120000 index 0000000000..1562790317 --- /dev/null +++ b/Lang/Elena/ABC-Problem @@ -0,0 +1 @@ +../../Task/ABC-Problem/Elena \ No newline at end of file diff --git a/Lang/Elena/Call-an-object-method b/Lang/Elena/Call-an-object-method new file mode 120000 index 0000000000..8ad79a81e1 --- /dev/null +++ b/Lang/Elena/Call-an-object-method @@ -0,0 +1 @@ +../../Task/Call-an-object-method/Elena \ No newline at end of file diff --git a/Lang/Elena/Catamorphism b/Lang/Elena/Catamorphism new file mode 120000 index 0000000000..8b765797e3 --- /dev/null +++ b/Lang/Elena/Catamorphism @@ -0,0 +1 @@ +../../Task/Catamorphism/Elena \ No newline at end of file diff --git a/Lang/Elena/Check-that-file-exists b/Lang/Elena/Check-that-file-exists new file mode 120000 index 0000000000..7ac12e2f9a --- /dev/null +++ b/Lang/Elena/Check-that-file-exists @@ -0,0 +1 @@ +../../Task/Check-that-file-exists/Elena \ No newline at end of file diff --git a/Lang/Elena/Classes b/Lang/Elena/Classes new file mode 120000 index 0000000000..b285c44853 --- /dev/null +++ b/Lang/Elena/Classes @@ -0,0 +1 @@ +../../Task/Classes/Elena \ No newline at end of file diff --git a/Lang/Elena/Closures-Value-capture b/Lang/Elena/Closures-Value-capture new file mode 120000 index 0000000000..f783466276 --- /dev/null +++ b/Lang/Elena/Closures-Value-capture @@ -0,0 +1 @@ +../../Task/Closures-Value-capture/Elena \ No newline at end of file diff --git a/Lang/Elena/Collections b/Lang/Elena/Collections new file mode 120000 index 0000000000..41b1fbb479 --- /dev/null +++ b/Lang/Elena/Collections @@ -0,0 +1 @@ +../../Task/Collections/Elena \ No newline at end of file diff --git a/Lang/Elena/Command-line-arguments b/Lang/Elena/Command-line-arguments new file mode 120000 index 0000000000..5d0e538aa1 --- /dev/null +++ b/Lang/Elena/Command-line-arguments @@ -0,0 +1 @@ +../../Task/Command-line-arguments/Elena \ No newline at end of file diff --git a/Lang/Elena/Comments b/Lang/Elena/Comments new file mode 120000 index 0000000000..436f1473d3 --- /dev/null +++ b/Lang/Elena/Comments @@ -0,0 +1 @@ +../../Task/Comments/Elena \ No newline at end of file diff --git a/Lang/Elena/Copy-a-string b/Lang/Elena/Copy-a-string new file mode 120000 index 0000000000..b52c431536 --- /dev/null +++ b/Lang/Elena/Copy-a-string @@ -0,0 +1 @@ +../../Task/Copy-a-string/Elena \ No newline at end of file diff --git a/Lang/Elena/Create-a-file b/Lang/Elena/Create-a-file new file mode 120000 index 0000000000..753bec128e --- /dev/null +++ b/Lang/Elena/Create-a-file @@ -0,0 +1 @@ +../../Task/Create-a-file/Elena \ No newline at end of file diff --git a/Lang/Elena/Create-a-two-dimensional-array-at-runtime b/Lang/Elena/Create-a-two-dimensional-array-at-runtime new file mode 120000 index 0000000000..5f53e44601 --- /dev/null +++ b/Lang/Elena/Create-a-two-dimensional-array-at-runtime @@ -0,0 +1 @@ +../../Task/Create-a-two-dimensional-array-at-runtime/Elena \ No newline at end of file diff --git a/Lang/Elena/Delegates b/Lang/Elena/Delegates new file mode 120000 index 0000000000..a721b9ccfa --- /dev/null +++ b/Lang/Elena/Delegates @@ -0,0 +1 @@ +../../Task/Delegates/Elena \ No newline at end of file diff --git a/Lang/Elena/Delete-a-file b/Lang/Elena/Delete-a-file new file mode 120000 index 0000000000..e462856745 --- /dev/null +++ b/Lang/Elena/Delete-a-file @@ -0,0 +1 @@ +../../Task/Delete-a-file/Elena \ No newline at end of file diff --git a/Lang/Elena/Dynamic-variable-names b/Lang/Elena/Dynamic-variable-names new file mode 120000 index 0000000000..f818da2f7f --- /dev/null +++ b/Lang/Elena/Dynamic-variable-names @@ -0,0 +1 @@ +../../Task/Dynamic-variable-names/Elena \ No newline at end of file diff --git a/Lang/Elena/Empty-program b/Lang/Elena/Empty-program new file mode 120000 index 0000000000..2daf5a38b8 --- /dev/null +++ b/Lang/Elena/Empty-program @@ -0,0 +1 @@ +../../Task/Empty-program/Elena \ No newline at end of file diff --git a/Lang/Elena/Empty-string b/Lang/Elena/Empty-string new file mode 120000 index 0000000000..9e5b1bc1ab --- /dev/null +++ b/Lang/Elena/Empty-string @@ -0,0 +1 @@ +../../Task/Empty-string/Elena \ No newline at end of file diff --git a/Lang/Elena/Evolutionary-algorithm b/Lang/Elena/Evolutionary-algorithm new file mode 120000 index 0000000000..88ec177d81 --- /dev/null +++ b/Lang/Elena/Evolutionary-algorithm @@ -0,0 +1 @@ +../../Task/Evolutionary-algorithm/Elena \ No newline at end of file diff --git a/Lang/Elena/File-size b/Lang/Elena/File-size new file mode 120000 index 0000000000..7692752791 --- /dev/null +++ b/Lang/Elena/File-size @@ -0,0 +1 @@ +../../Task/File-size/Elena \ No newline at end of file diff --git a/Lang/Elena/First-class-functions b/Lang/Elena/First-class-functions new file mode 120000 index 0000000000..f367a12183 --- /dev/null +++ b/Lang/Elena/First-class-functions @@ -0,0 +1 @@ +../../Task/First-class-functions/Elena \ No newline at end of file diff --git a/Lang/Elena/Identity-matrix b/Lang/Elena/Identity-matrix new file mode 120000 index 0000000000..b48c4389dc --- /dev/null +++ b/Lang/Elena/Identity-matrix @@ -0,0 +1 @@ +../../Task/Identity-matrix/Elena \ No newline at end of file diff --git a/Lang/Elena/Inheritance-Multiple b/Lang/Elena/Inheritance-Multiple new file mode 120000 index 0000000000..ca2810b38b --- /dev/null +++ b/Lang/Elena/Inheritance-Multiple @@ -0,0 +1 @@ +../../Task/Inheritance-Multiple/Elena \ No newline at end of file diff --git a/Lang/Elena/Inheritance-Single b/Lang/Elena/Inheritance-Single new file mode 120000 index 0000000000..a345ab6b8b --- /dev/null +++ b/Lang/Elena/Inheritance-Single @@ -0,0 +1 @@ +../../Task/Inheritance-Single/Elena \ No newline at end of file diff --git a/Lang/Elena/Input-loop b/Lang/Elena/Input-loop new file mode 120000 index 0000000000..1835658bcf --- /dev/null +++ b/Lang/Elena/Input-loop @@ -0,0 +1 @@ +../../Task/Input-loop/Elena \ No newline at end of file diff --git a/Lang/Elena/Integer-comparison b/Lang/Elena/Integer-comparison new file mode 120000 index 0000000000..21a9ed38a1 --- /dev/null +++ b/Lang/Elena/Integer-comparison @@ -0,0 +1 @@ +../../Task/Integer-comparison/Elena \ No newline at end of file diff --git a/Lang/Elena/JSON b/Lang/Elena/JSON new file mode 120000 index 0000000000..04fd798a61 --- /dev/null +++ b/Lang/Elena/JSON @@ -0,0 +1 @@ +../../Task/JSON/Elena \ No newline at end of file diff --git a/Lang/Elena/Knuth-shuffle b/Lang/Elena/Knuth-shuffle new file mode 120000 index 0000000000..7550749215 --- /dev/null +++ b/Lang/Elena/Knuth-shuffle @@ -0,0 +1 @@ +../../Task/Knuth-shuffle/Elena \ No newline at end of file diff --git a/Lang/Elena/Knuths-algorithm-S b/Lang/Elena/Knuths-algorithm-S new file mode 120000 index 0000000000..bc40671393 --- /dev/null +++ b/Lang/Elena/Knuths-algorithm-S @@ -0,0 +1 @@ +../../Task/Knuths-algorithm-S/Elena \ No newline at end of file diff --git a/Lang/Elena/Literals-Integer b/Lang/Elena/Literals-Integer new file mode 120000 index 0000000000..735b914c51 --- /dev/null +++ b/Lang/Elena/Literals-Integer @@ -0,0 +1 @@ +../../Task/Literals-Integer/Elena \ No newline at end of file diff --git a/Lang/Elena/Literals-String b/Lang/Elena/Literals-String new file mode 120000 index 0000000000..87aa50ee55 --- /dev/null +++ b/Lang/Elena/Literals-String @@ -0,0 +1 @@ +../../Task/Literals-String/Elena \ No newline at end of file diff --git a/Lang/Elena/Loop-over-multiple-arrays-simultaneously b/Lang/Elena/Loop-over-multiple-arrays-simultaneously new file mode 120000 index 0000000000..3fa086f4b9 --- /dev/null +++ b/Lang/Elena/Loop-over-multiple-arrays-simultaneously @@ -0,0 +1 @@ +../../Task/Loop-over-multiple-arrays-simultaneously/Elena \ No newline at end of file diff --git a/Lang/Elena/Loops-For b/Lang/Elena/Loops-For new file mode 120000 index 0000000000..a9f9bd4be5 --- /dev/null +++ b/Lang/Elena/Loops-For @@ -0,0 +1 @@ +../../Task/Loops-For/Elena \ No newline at end of file diff --git a/Lang/Elena/Loops-For-with-a-specified-step b/Lang/Elena/Loops-For-with-a-specified-step new file mode 120000 index 0000000000..cf11fe6e87 --- /dev/null +++ b/Lang/Elena/Loops-For-with-a-specified-step @@ -0,0 +1 @@ +../../Task/Loops-For-with-a-specified-step/Elena \ No newline at end of file diff --git a/Lang/Elena/Loops-Foreach b/Lang/Elena/Loops-Foreach new file mode 120000 index 0000000000..301ac47ddf --- /dev/null +++ b/Lang/Elena/Loops-Foreach @@ -0,0 +1 @@ +../../Task/Loops-Foreach/Elena \ No newline at end of file diff --git a/Lang/Elena/Loops-Infinite b/Lang/Elena/Loops-Infinite new file mode 120000 index 0000000000..c12895de4b --- /dev/null +++ b/Lang/Elena/Loops-Infinite @@ -0,0 +1 @@ +../../Task/Loops-Infinite/Elena \ No newline at end of file diff --git a/Lang/Elena/Loops-While b/Lang/Elena/Loops-While new file mode 120000 index 0000000000..d66e0b21d9 --- /dev/null +++ b/Lang/Elena/Loops-While @@ -0,0 +1 @@ +../../Task/Loops-While/Elena \ No newline at end of file diff --git a/Lang/Elena/Man-or-boy-test b/Lang/Elena/Man-or-boy-test new file mode 120000 index 0000000000..e8de7722dd --- /dev/null +++ b/Lang/Elena/Man-or-boy-test @@ -0,0 +1 @@ +../../Task/Man-or-boy-test/Elena \ No newline at end of file diff --git a/Lang/Elena/Number-reversal-game b/Lang/Elena/Number-reversal-game new file mode 120000 index 0000000000..8b5e8cba8d --- /dev/null +++ b/Lang/Elena/Number-reversal-game @@ -0,0 +1 @@ +../../Task/Number-reversal-game/Elena \ No newline at end of file diff --git a/Lang/Elena/Old-lady-swallowed-a-fly b/Lang/Elena/Old-lady-swallowed-a-fly new file mode 120000 index 0000000000..b8c858a153 --- /dev/null +++ b/Lang/Elena/Old-lady-swallowed-a-fly @@ -0,0 +1 @@ +../../Task/Old-lady-swallowed-a-fly/Elena \ No newline at end of file diff --git a/Lang/Elena/Perfect-numbers b/Lang/Elena/Perfect-numbers new file mode 120000 index 0000000000..c10dedf543 --- /dev/null +++ b/Lang/Elena/Perfect-numbers @@ -0,0 +1 @@ +../../Task/Perfect-numbers/Elena \ No newline at end of file diff --git a/Lang/Elena/Pick-random-element b/Lang/Elena/Pick-random-element new file mode 120000 index 0000000000..256d1dd9f7 --- /dev/null +++ b/Lang/Elena/Pick-random-element @@ -0,0 +1 @@ +../../Task/Pick-random-element/Elena \ No newline at end of file diff --git a/Lang/Elena/Program-name b/Lang/Elena/Program-name new file mode 120000 index 0000000000..6bbb1b6eb4 --- /dev/null +++ b/Lang/Elena/Program-name @@ -0,0 +1 @@ +../../Task/Program-name/Elena \ No newline at end of file diff --git a/Lang/Elena/Queue-Usage b/Lang/Elena/Queue-Usage new file mode 120000 index 0000000000..f419247e20 --- /dev/null +++ b/Lang/Elena/Queue-Usage @@ -0,0 +1 @@ +../../Task/Queue-Usage/Elena \ No newline at end of file diff --git a/Lang/Elena/Read-a-file-line-by-line b/Lang/Elena/Read-a-file-line-by-line new file mode 120000 index 0000000000..cccbcb415c --- /dev/null +++ b/Lang/Elena/Read-a-file-line-by-line @@ -0,0 +1 @@ +../../Task/Read-a-file-line-by-line/Elena \ No newline at end of file diff --git a/Lang/Elena/Repeat-a-string b/Lang/Elena/Repeat-a-string new file mode 120000 index 0000000000..d68b3f5315 --- /dev/null +++ b/Lang/Elena/Repeat-a-string @@ -0,0 +1 @@ +../../Task/Repeat-a-string/Elena \ No newline at end of file diff --git a/Lang/Elena/Reverse-a-string b/Lang/Elena/Reverse-a-string new file mode 120000 index 0000000000..c02f3e21d0 --- /dev/null +++ b/Lang/Elena/Reverse-a-string @@ -0,0 +1 @@ +../../Task/Reverse-a-string/Elena \ No newline at end of file diff --git a/Lang/Elena/Reverse-words-in-a-string b/Lang/Elena/Reverse-words-in-a-string new file mode 120000 index 0000000000..bf39d33709 --- /dev/null +++ b/Lang/Elena/Reverse-words-in-a-string @@ -0,0 +1 @@ +../../Task/Reverse-words-in-a-string/Elena \ No newline at end of file diff --git a/Lang/Elena/Search-a-list b/Lang/Elena/Search-a-list new file mode 120000 index 0000000000..f75aab8b69 --- /dev/null +++ b/Lang/Elena/Search-a-list @@ -0,0 +1 @@ +../../Task/Search-a-list/Elena \ No newline at end of file diff --git a/Lang/Elena/Send-an-unknown-method-call b/Lang/Elena/Send-an-unknown-method-call new file mode 120000 index 0000000000..262496dec7 --- /dev/null +++ b/Lang/Elena/Send-an-unknown-method-call @@ -0,0 +1 @@ +../../Task/Send-an-unknown-method-call/Elena \ No newline at end of file diff --git a/Lang/Elena/Set-of-real-numbers b/Lang/Elena/Set-of-real-numbers new file mode 120000 index 0000000000..8a15ef8698 --- /dev/null +++ b/Lang/Elena/Set-of-real-numbers @@ -0,0 +1 @@ +../../Task/Set-of-real-numbers/Elena \ No newline at end of file diff --git a/Lang/Elena/Short-circuit-evaluation b/Lang/Elena/Short-circuit-evaluation new file mode 120000 index 0000000000..ddad794abc --- /dev/null +++ b/Lang/Elena/Short-circuit-evaluation @@ -0,0 +1 @@ +../../Task/Short-circuit-evaluation/Elena \ No newline at end of file diff --git a/Lang/Elena/Singleton b/Lang/Elena/Singleton new file mode 120000 index 0000000000..9ccedb0ecd --- /dev/null +++ b/Lang/Elena/Singleton @@ -0,0 +1 @@ +../../Task/Singleton/Elena \ No newline at end of file diff --git a/Lang/Elena/Sort-an-array-of-composite-structures b/Lang/Elena/Sort-an-array-of-composite-structures new file mode 120000 index 0000000000..fada06a584 --- /dev/null +++ b/Lang/Elena/Sort-an-array-of-composite-structures @@ -0,0 +1 @@ +../../Task/Sort-an-array-of-composite-structures/Elena \ No newline at end of file diff --git a/Lang/Elena/Sort-an-integer-array b/Lang/Elena/Sort-an-integer-array new file mode 120000 index 0000000000..d979c1eec8 --- /dev/null +++ b/Lang/Elena/Sort-an-integer-array @@ -0,0 +1 @@ +../../Task/Sort-an-integer-array/Elena \ No newline at end of file diff --git a/Lang/Elena/Stack b/Lang/Elena/Stack new file mode 120000 index 0000000000..247d357e3a --- /dev/null +++ b/Lang/Elena/Stack @@ -0,0 +1 @@ +../../Task/Stack/Elena \ No newline at end of file diff --git a/Lang/Elena/String-length b/Lang/Elena/String-length new file mode 120000 index 0000000000..d97a4e9a7d --- /dev/null +++ b/Lang/Elena/String-length @@ -0,0 +1 @@ +../../Task/String-length/Elena \ No newline at end of file diff --git a/Lang/Elena/Substring b/Lang/Elena/Substring new file mode 120000 index 0000000000..636c457493 --- /dev/null +++ b/Lang/Elena/Substring @@ -0,0 +1 @@ +../../Task/Substring/Elena \ No newline at end of file diff --git a/Lang/Elena/Sum-and-product-of-an-array b/Lang/Elena/Sum-and-product-of-an-array new file mode 120000 index 0000000000..6dd83667af --- /dev/null +++ b/Lang/Elena/Sum-and-product-of-an-array @@ -0,0 +1 @@ +../../Task/Sum-and-product-of-an-array/Elena \ No newline at end of file diff --git a/Lang/Elena/Tokenize-a-string b/Lang/Elena/Tokenize-a-string new file mode 120000 index 0000000000..6c2aa53996 --- /dev/null +++ b/Lang/Elena/Tokenize-a-string @@ -0,0 +1 @@ +../../Task/Tokenize-a-string/Elena \ No newline at end of file diff --git a/Lang/Elena/Top-rank-per-group b/Lang/Elena/Top-rank-per-group new file mode 120000 index 0000000000..d2fb7a2b22 --- /dev/null +++ b/Lang/Elena/Top-rank-per-group @@ -0,0 +1 @@ +../../Task/Top-rank-per-group/Elena \ No newline at end of file diff --git a/Lang/Elena/Trigonometric-functions b/Lang/Elena/Trigonometric-functions new file mode 120000 index 0000000000..019feea310 --- /dev/null +++ b/Lang/Elena/Trigonometric-functions @@ -0,0 +1 @@ +../../Task/Trigonometric-functions/Elena \ No newline at end of file diff --git a/Lang/Elena/Truncatable-primes b/Lang/Elena/Truncatable-primes new file mode 120000 index 0000000000..798fbf0980 --- /dev/null +++ b/Lang/Elena/Truncatable-primes @@ -0,0 +1 @@ +../../Task/Truncatable-primes/Elena \ No newline at end of file diff --git a/Lang/Elena/Truncate-a-file b/Lang/Elena/Truncate-a-file new file mode 120000 index 0000000000..7a06ba0426 --- /dev/null +++ b/Lang/Elena/Truncate-a-file @@ -0,0 +1 @@ +../../Task/Truncate-a-file/Elena \ No newline at end of file diff --git a/Lang/Elena/Twelve-statements b/Lang/Elena/Twelve-statements new file mode 120000 index 0000000000..86833fccd6 --- /dev/null +++ b/Lang/Elena/Twelve-statements @@ -0,0 +1 @@ +../../Task/Twelve-statements/Elena \ No newline at end of file diff --git a/Lang/Elena/Unicode-strings b/Lang/Elena/Unicode-strings new file mode 120000 index 0000000000..329b1cc60d --- /dev/null +++ b/Lang/Elena/Unicode-strings @@ -0,0 +1 @@ +../../Task/Unicode-strings/Elena \ No newline at end of file diff --git a/Lang/Elena/Unicode-variable-names b/Lang/Elena/Unicode-variable-names new file mode 120000 index 0000000000..d9ef2dac0d --- /dev/null +++ b/Lang/Elena/Unicode-variable-names @@ -0,0 +1 @@ +../../Task/Unicode-variable-names/Elena \ No newline at end of file diff --git a/Lang/Elena/User-input-Text b/Lang/Elena/User-input-Text new file mode 120000 index 0000000000..2759bc8e29 --- /dev/null +++ b/Lang/Elena/User-input-Text @@ -0,0 +1 @@ +../../Task/User-input-Text/Elena \ No newline at end of file diff --git a/Lang/Elena/Variables b/Lang/Elena/Variables new file mode 120000 index 0000000000..c1bb097499 --- /dev/null +++ b/Lang/Elena/Variables @@ -0,0 +1 @@ +../../Task/Variables/Elena \ No newline at end of file diff --git a/Lang/Elena/Visualize-a-tree b/Lang/Elena/Visualize-a-tree new file mode 120000 index 0000000000..e6a1b5a670 --- /dev/null +++ b/Lang/Elena/Visualize-a-tree @@ -0,0 +1 @@ +../../Task/Visualize-a-tree/Elena \ No newline at end of file diff --git a/Lang/Elixir/24-game b/Lang/Elixir/24-game new file mode 120000 index 0000000000..08a8802174 --- /dev/null +++ b/Lang/Elixir/24-game @@ -0,0 +1 @@ +../../Task/24-game/Elixir \ No newline at end of file diff --git a/Lang/Elixir/24-game-Solve b/Lang/Elixir/24-game-Solve new file mode 120000 index 0000000000..5e33c638b7 --- /dev/null +++ b/Lang/Elixir/24-game-Solve @@ -0,0 +1 @@ +../../Task/24-game-Solve/Elixir \ No newline at end of file diff --git a/Lang/Elixir/9-billion-names-of-God-the-integer b/Lang/Elixir/9-billion-names-of-God-the-integer new file mode 120000 index 0000000000..1ec79b01ad --- /dev/null +++ b/Lang/Elixir/9-billion-names-of-God-the-integer @@ -0,0 +1 @@ +../../Task/9-billion-names-of-God-the-integer/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Abundant,-deficient-and-perfect-number-classifications b/Lang/Elixir/Abundant,-deficient-and-perfect-number-classifications new file mode 120000 index 0000000000..fc87646030 --- /dev/null +++ b/Lang/Elixir/Abundant,-deficient-and-perfect-number-classifications @@ -0,0 +1 @@ +../../Task/Abundant,-deficient-and-perfect-number-classifications/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Accumulator-factory b/Lang/Elixir/Accumulator-factory new file mode 120000 index 0000000000..66d4bb80f8 --- /dev/null +++ b/Lang/Elixir/Accumulator-factory @@ -0,0 +1 @@ +../../Task/Accumulator-factory/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Aliquot-sequence-classifications b/Lang/Elixir/Aliquot-sequence-classifications new file mode 120000 index 0000000000..0f5531cbfb --- /dev/null +++ b/Lang/Elixir/Aliquot-sequence-classifications @@ -0,0 +1 @@ +../../Task/Aliquot-sequence-classifications/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Amicable-pairs b/Lang/Elixir/Amicable-pairs new file mode 120000 index 0000000000..a15ca8a724 --- /dev/null +++ b/Lang/Elixir/Amicable-pairs @@ -0,0 +1 @@ +../../Task/Amicable-pairs/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Anagrams-Deranged-anagrams b/Lang/Elixir/Anagrams-Deranged-anagrams new file mode 120000 index 0000000000..939537b0a1 --- /dev/null +++ b/Lang/Elixir/Anagrams-Deranged-anagrams @@ -0,0 +1 @@ +../../Task/Anagrams-Deranged-anagrams/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Append-a-record-to-the-end-of-a-text-file b/Lang/Elixir/Append-a-record-to-the-end-of-a-text-file new file mode 120000 index 0000000000..41b018f05a --- /dev/null +++ b/Lang/Elixir/Append-a-record-to-the-end-of-a-text-file @@ -0,0 +1 @@ +../../Task/Append-a-record-to-the-end-of-a-text-file/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Apply-a-callback-to-an-array b/Lang/Elixir/Apply-a-callback-to-an-array new file mode 120000 index 0000000000..72ac23e78a --- /dev/null +++ b/Lang/Elixir/Apply-a-callback-to-an-array @@ -0,0 +1 @@ +../../Task/Apply-a-callback-to-an-array/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Arithmetic-Complex b/Lang/Elixir/Arithmetic-Complex new file mode 120000 index 0000000000..cf53228357 --- /dev/null +++ b/Lang/Elixir/Arithmetic-Complex @@ -0,0 +1 @@ +../../Task/Arithmetic-Complex/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Arithmetic-Rational b/Lang/Elixir/Arithmetic-Rational new file mode 120000 index 0000000000..1a46991ff6 --- /dev/null +++ b/Lang/Elixir/Arithmetic-Rational @@ -0,0 +1 @@ +../../Task/Arithmetic-Rational/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Arrays b/Lang/Elixir/Arrays new file mode 120000 index 0000000000..8c89dd1c68 --- /dev/null +++ b/Lang/Elixir/Arrays @@ -0,0 +1 @@ +../../Task/Arrays/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Assertions b/Lang/Elixir/Assertions new file mode 120000 index 0000000000..8cc96f5f11 --- /dev/null +++ b/Lang/Elixir/Assertions @@ -0,0 +1 @@ +../../Task/Assertions/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Averages-Mean-angle b/Lang/Elixir/Averages-Mean-angle new file mode 120000 index 0000000000..03b09a00ae --- /dev/null +++ b/Lang/Elixir/Averages-Mean-angle @@ -0,0 +1 @@ +../../Task/Averages-Mean-angle/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Averages-Simple-moving-average b/Lang/Elixir/Averages-Simple-moving-average new file mode 120000 index 0000000000..566eab2880 --- /dev/null +++ b/Lang/Elixir/Averages-Simple-moving-average @@ -0,0 +1 @@ +../../Task/Averages-Simple-moving-average/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Bernoulli-numbers b/Lang/Elixir/Bernoulli-numbers new file mode 120000 index 0000000000..f13858ed89 --- /dev/null +++ b/Lang/Elixir/Bernoulli-numbers @@ -0,0 +1 @@ +../../Task/Bernoulli-numbers/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Bulls-and-cows b/Lang/Elixir/Bulls-and-cows new file mode 120000 index 0000000000..cf1c919d55 --- /dev/null +++ b/Lang/Elixir/Bulls-and-cows @@ -0,0 +1 @@ +../../Task/Bulls-and-cows/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Bulls-and-cows-Player b/Lang/Elixir/Bulls-and-cows-Player new file mode 120000 index 0000000000..30346aa4ac --- /dev/null +++ b/Lang/Elixir/Bulls-and-cows-Player @@ -0,0 +1 @@ +../../Task/Bulls-and-cows-Player/Elixir \ No newline at end of file diff --git a/Lang/Elixir/CSV-data-manipulation b/Lang/Elixir/CSV-data-manipulation new file mode 120000 index 0000000000..4608ed9a9d --- /dev/null +++ b/Lang/Elixir/CSV-data-manipulation @@ -0,0 +1 @@ +../../Task/CSV-data-manipulation/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Call-a-function b/Lang/Elixir/Call-a-function new file mode 120000 index 0000000000..a530c5f479 --- /dev/null +++ b/Lang/Elixir/Call-a-function @@ -0,0 +1 @@ +../../Task/Call-a-function/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Call-an-object-method b/Lang/Elixir/Call-an-object-method new file mode 120000 index 0000000000..97fd589385 --- /dev/null +++ b/Lang/Elixir/Call-an-object-method @@ -0,0 +1 @@ +../../Task/Call-an-object-method/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Closures-Value-capture b/Lang/Elixir/Closures-Value-capture new file mode 120000 index 0000000000..1c79e8e79c --- /dev/null +++ b/Lang/Elixir/Closures-Value-capture @@ -0,0 +1 @@ +../../Task/Closures-Value-capture/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Combinations-and-permutations b/Lang/Elixir/Combinations-and-permutations new file mode 120000 index 0000000000..293ef07828 --- /dev/null +++ b/Lang/Elixir/Combinations-and-permutations @@ -0,0 +1 @@ +../../Task/Combinations-and-permutations/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Command-line-arguments b/Lang/Elixir/Command-line-arguments new file mode 120000 index 0000000000..1128f6dd97 --- /dev/null +++ b/Lang/Elixir/Command-line-arguments @@ -0,0 +1 @@ +../../Task/Command-line-arguments/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Compound-data-type b/Lang/Elixir/Compound-data-type new file mode 120000 index 0000000000..c62a039b06 --- /dev/null +++ b/Lang/Elixir/Compound-data-type @@ -0,0 +1 @@ +../../Task/Compound-data-type/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Concurrent-computing b/Lang/Elixir/Concurrent-computing new file mode 120000 index 0000000000..ed6d558b9b --- /dev/null +++ b/Lang/Elixir/Concurrent-computing @@ -0,0 +1 @@ +../../Task/Concurrent-computing/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Conways-Game-of-Life b/Lang/Elixir/Conways-Game-of-Life new file mode 120000 index 0000000000..fd18794aee --- /dev/null +++ b/Lang/Elixir/Conways-Game-of-Life @@ -0,0 +1 @@ +../../Task/Conways-Game-of-Life/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Create-a-two-dimensional-array-at-runtime b/Lang/Elixir/Create-a-two-dimensional-array-at-runtime new file mode 120000 index 0000000000..fdc6e55aa9 --- /dev/null +++ b/Lang/Elixir/Create-a-two-dimensional-array-at-runtime @@ -0,0 +1 @@ +../../Task/Create-a-two-dimensional-array-at-runtime/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Cut-a-rectangle b/Lang/Elixir/Cut-a-rectangle new file mode 120000 index 0000000000..0cea7d4ec7 --- /dev/null +++ b/Lang/Elixir/Cut-a-rectangle @@ -0,0 +1 @@ +../../Task/Cut-a-rectangle/Elixir \ No newline at end of file diff --git a/Lang/Elixir/First-class-functions b/Lang/Elixir/First-class-functions new file mode 120000 index 0000000000..0373385e7e --- /dev/null +++ b/Lang/Elixir/First-class-functions @@ -0,0 +1 @@ +../../Task/First-class-functions/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Flipping-bits-game b/Lang/Elixir/Flipping-bits-game new file mode 120000 index 0000000000..b619ab9d11 --- /dev/null +++ b/Lang/Elixir/Flipping-bits-game @@ -0,0 +1 @@ +../../Task/Flipping-bits-game/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Four-bit-adder b/Lang/Elixir/Four-bit-adder new file mode 120000 index 0000000000..2c39efae55 --- /dev/null +++ b/Lang/Elixir/Four-bit-adder @@ -0,0 +1 @@ +../../Task/Four-bit-adder/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Fractran b/Lang/Elixir/Fractran new file mode 120000 index 0000000000..6e7583875d --- /dev/null +++ b/Lang/Elixir/Fractran @@ -0,0 +1 @@ +../../Task/Fractran/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Generate-Chess960-starting-position b/Lang/Elixir/Generate-Chess960-starting-position new file mode 120000 index 0000000000..05dfc7cad9 --- /dev/null +++ b/Lang/Elixir/Generate-Chess960-starting-position @@ -0,0 +1 @@ +../../Task/Generate-Chess960-starting-position/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Generator-Exponential b/Lang/Elixir/Generator-Exponential new file mode 120000 index 0000000000..3a7956031b --- /dev/null +++ b/Lang/Elixir/Generator-Exponential @@ -0,0 +1 @@ +../../Task/Generator-Exponential/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Hofstadter-Q-sequence b/Lang/Elixir/Hofstadter-Q-sequence new file mode 120000 index 0000000000..b5d58ac423 --- /dev/null +++ b/Lang/Elixir/Hofstadter-Q-sequence @@ -0,0 +1 @@ +../../Task/Hofstadter-Q-sequence/Elixir \ No newline at end of file diff --git a/Lang/Elixir/IBAN b/Lang/Elixir/IBAN new file mode 120000 index 0000000000..7aaeed52c3 --- /dev/null +++ b/Lang/Elixir/IBAN @@ -0,0 +1 @@ +../../Task/IBAN/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Knights-tour b/Lang/Elixir/Knights-tour new file mode 120000 index 0000000000..023372bc78 --- /dev/null +++ b/Lang/Elixir/Knights-tour @@ -0,0 +1 @@ +../../Task/Knights-tour/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Knuths-algorithm-S b/Lang/Elixir/Knuths-algorithm-S new file mode 120000 index 0000000000..f46cead22d --- /dev/null +++ b/Lang/Elixir/Knuths-algorithm-S @@ -0,0 +1 @@ +../../Task/Knuths-algorithm-S/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Longest-increasing-subsequence b/Lang/Elixir/Longest-increasing-subsequence new file mode 120000 index 0000000000..c0f84aec66 --- /dev/null +++ b/Lang/Elixir/Longest-increasing-subsequence @@ -0,0 +1 @@ +../../Task/Longest-increasing-subsequence/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Mandelbrot-set b/Lang/Elixir/Mandelbrot-set new file mode 120000 index 0000000000..c82260848a --- /dev/null +++ b/Lang/Elixir/Mandelbrot-set @@ -0,0 +1 @@ +../../Task/Mandelbrot-set/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Matrix-multiplication b/Lang/Elixir/Matrix-multiplication new file mode 120000 index 0000000000..84e809e2a0 --- /dev/null +++ b/Lang/Elixir/Matrix-multiplication @@ -0,0 +1 @@ +../../Task/Matrix-multiplication/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Menu b/Lang/Elixir/Menu new file mode 120000 index 0000000000..e510592e9c --- /dev/null +++ b/Lang/Elixir/Menu @@ -0,0 +1 @@ +../../Task/Menu/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Modular-inverse b/Lang/Elixir/Modular-inverse new file mode 120000 index 0000000000..0d871583b6 --- /dev/null +++ b/Lang/Elixir/Modular-inverse @@ -0,0 +1 @@ +../../Task/Modular-inverse/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Named-parameters b/Lang/Elixir/Named-parameters new file mode 120000 index 0000000000..577809b6cb --- /dev/null +++ b/Lang/Elixir/Named-parameters @@ -0,0 +1 @@ +../../Task/Named-parameters/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Natural-sorting b/Lang/Elixir/Natural-sorting new file mode 120000 index 0000000000..32b01bba20 --- /dev/null +++ b/Lang/Elixir/Natural-sorting @@ -0,0 +1 @@ +../../Task/Natural-sorting/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Non-continuous-subsequences b/Lang/Elixir/Non-continuous-subsequences new file mode 120000 index 0000000000..5c965fee80 --- /dev/null +++ b/Lang/Elixir/Non-continuous-subsequences @@ -0,0 +1 @@ +../../Task/Non-continuous-subsequences/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Number-reversal-game b/Lang/Elixir/Number-reversal-game new file mode 120000 index 0000000000..c6bb0a1d97 --- /dev/null +++ b/Lang/Elixir/Number-reversal-game @@ -0,0 +1 @@ +../../Task/Number-reversal-game/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Odd-word-problem b/Lang/Elixir/Odd-word-problem new file mode 120000 index 0000000000..90e73331ff --- /dev/null +++ b/Lang/Elixir/Odd-word-problem @@ -0,0 +1 @@ +../../Task/Odd-word-problem/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Old-lady-swallowed-a-fly b/Lang/Elixir/Old-lady-swallowed-a-fly new file mode 120000 index 0000000000..9c83ec2c70 --- /dev/null +++ b/Lang/Elixir/Old-lady-swallowed-a-fly @@ -0,0 +1 @@ +../../Task/Old-lady-swallowed-a-fly/Elixir \ No newline at end of file diff --git a/Lang/Elixir/One-of-n-lines-in-a-file b/Lang/Elixir/One-of-n-lines-in-a-file new file mode 120000 index 0000000000..c1fbee26ba --- /dev/null +++ b/Lang/Elixir/One-of-n-lines-in-a-file @@ -0,0 +1 @@ +../../Task/One-of-n-lines-in-a-file/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Optional-parameters b/Lang/Elixir/Optional-parameters new file mode 120000 index 0000000000..a29f9aef25 --- /dev/null +++ b/Lang/Elixir/Optional-parameters @@ -0,0 +1 @@ +../../Task/Optional-parameters/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Order-disjoint-list-items b/Lang/Elixir/Order-disjoint-list-items new file mode 120000 index 0000000000..ff767bf0bf --- /dev/null +++ b/Lang/Elixir/Order-disjoint-list-items @@ -0,0 +1 @@ +../../Task/Order-disjoint-list-items/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Order-two-numerical-lists b/Lang/Elixir/Order-two-numerical-lists new file mode 120000 index 0000000000..65712b2542 --- /dev/null +++ b/Lang/Elixir/Order-two-numerical-lists @@ -0,0 +1 @@ +../../Task/Order-two-numerical-lists/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Ordered-Partitions b/Lang/Elixir/Ordered-Partitions new file mode 120000 index 0000000000..50931ce4a4 --- /dev/null +++ b/Lang/Elixir/Ordered-Partitions @@ -0,0 +1 @@ +../../Task/Ordered-Partitions/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Pattern-matching b/Lang/Elixir/Pattern-matching new file mode 120000 index 0000000000..e619c68948 --- /dev/null +++ b/Lang/Elixir/Pattern-matching @@ -0,0 +1 @@ +../../Task/Pattern-matching/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Penneys-game b/Lang/Elixir/Penneys-game new file mode 120000 index 0000000000..6b23af612c --- /dev/null +++ b/Lang/Elixir/Penneys-game @@ -0,0 +1 @@ +../../Task/Penneys-game/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Playing-cards b/Lang/Elixir/Playing-cards new file mode 120000 index 0000000000..1034da4b5b --- /dev/null +++ b/Lang/Elixir/Playing-cards @@ -0,0 +1 @@ +../../Task/Playing-cards/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Polynomial-long-division b/Lang/Elixir/Polynomial-long-division new file mode 120000 index 0000000000..31f6e14a61 --- /dev/null +++ b/Lang/Elixir/Polynomial-long-division @@ -0,0 +1 @@ +../../Task/Polynomial-long-division/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Priority-queue b/Lang/Elixir/Priority-queue new file mode 120000 index 0000000000..995bf4b645 --- /dev/null +++ b/Lang/Elixir/Priority-queue @@ -0,0 +1 @@ +../../Task/Priority-queue/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Probabilistic-choice b/Lang/Elixir/Probabilistic-choice new file mode 120000 index 0000000000..4e223af0b1 --- /dev/null +++ b/Lang/Elixir/Probabilistic-choice @@ -0,0 +1 @@ +../../Task/Probabilistic-choice/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Quickselect-algorithm b/Lang/Elixir/Quickselect-algorithm new file mode 120000 index 0000000000..35f3a54f5f --- /dev/null +++ b/Lang/Elixir/Quickselect-algorithm @@ -0,0 +1 @@ +../../Task/Quickselect-algorithm/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Ranking-methods b/Lang/Elixir/Ranking-methods new file mode 120000 index 0000000000..519b84d03a --- /dev/null +++ b/Lang/Elixir/Ranking-methods @@ -0,0 +1 @@ +../../Task/Ranking-methods/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Read-a-configuration-file b/Lang/Elixir/Read-a-configuration-file new file mode 120000 index 0000000000..3818d04c78 --- /dev/null +++ b/Lang/Elixir/Read-a-configuration-file @@ -0,0 +1 @@ +../../Task/Read-a-configuration-file/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Real-constants-and-functions b/Lang/Elixir/Real-constants-and-functions new file mode 120000 index 0000000000..b7844e6191 --- /dev/null +++ b/Lang/Elixir/Real-constants-and-functions @@ -0,0 +1 @@ +../../Task/Real-constants-and-functions/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Remove-lines-from-a-file b/Lang/Elixir/Remove-lines-from-a-file new file mode 120000 index 0000000000..b3331d7ffa --- /dev/null +++ b/Lang/Elixir/Remove-lines-from-a-file @@ -0,0 +1 @@ +../../Task/Remove-lines-from-a-file/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Rename-a-file b/Lang/Elixir/Rename-a-file new file mode 120000 index 0000000000..665365246a --- /dev/null +++ b/Lang/Elixir/Rename-a-file @@ -0,0 +1 @@ +../../Task/Rename-a-file/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Rep-string b/Lang/Elixir/Rep-string new file mode 120000 index 0000000000..7b117fa72b --- /dev/null +++ b/Lang/Elixir/Rep-string @@ -0,0 +1 @@ +../../Task/Rep-string/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Rock-paper-scissors b/Lang/Elixir/Rock-paper-scissors new file mode 120000 index 0000000000..e5394da3ad --- /dev/null +++ b/Lang/Elixir/Rock-paper-scissors @@ -0,0 +1 @@ +../../Task/Rock-paper-scissors/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Runtime-evaluation b/Lang/Elixir/Runtime-evaluation new file mode 120000 index 0000000000..ad8fba8def --- /dev/null +++ b/Lang/Elixir/Runtime-evaluation @@ -0,0 +1 @@ +../../Task/Runtime-evaluation/Elixir \ No newline at end of file diff --git a/Lang/Elixir/SEDOLs b/Lang/Elixir/SEDOLs new file mode 120000 index 0000000000..a45f773aa9 --- /dev/null +++ b/Lang/Elixir/SEDOLs @@ -0,0 +1 @@ +../../Task/SEDOLs/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Self-describing-numbers b/Lang/Elixir/Self-describing-numbers new file mode 120000 index 0000000000..7f273dea89 --- /dev/null +++ b/Lang/Elixir/Self-describing-numbers @@ -0,0 +1 @@ +../../Task/Self-describing-numbers/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Semiprime b/Lang/Elixir/Semiprime new file mode 120000 index 0000000000..a00f892787 --- /dev/null +++ b/Lang/Elixir/Semiprime @@ -0,0 +1 @@ +../../Task/Semiprime/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Semordnilap b/Lang/Elixir/Semordnilap new file mode 120000 index 0000000000..607b88ab2f --- /dev/null +++ b/Lang/Elixir/Semordnilap @@ -0,0 +1 @@ +../../Task/Semordnilap/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Sequence-of-non-squares b/Lang/Elixir/Sequence-of-non-squares new file mode 120000 index 0000000000..2f32ac9d3f --- /dev/null +++ b/Lang/Elixir/Sequence-of-non-squares @@ -0,0 +1 @@ +../../Task/Sequence-of-non-squares/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Sequence-of-primes-by-Trial-Division b/Lang/Elixir/Sequence-of-primes-by-Trial-Division new file mode 120000 index 0000000000..f4295be7a3 --- /dev/null +++ b/Lang/Elixir/Sequence-of-primes-by-Trial-Division @@ -0,0 +1 @@ +../../Task/Sequence-of-primes-by-Trial-Division/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Set-consolidation b/Lang/Elixir/Set-consolidation new file mode 120000 index 0000000000..4af6937313 --- /dev/null +++ b/Lang/Elixir/Set-consolidation @@ -0,0 +1 @@ +../../Task/Set-consolidation/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Set-puzzle b/Lang/Elixir/Set-puzzle new file mode 120000 index 0000000000..8fa7df715d --- /dev/null +++ b/Lang/Elixir/Set-puzzle @@ -0,0 +1 @@ +../../Task/Set-puzzle/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Sleep b/Lang/Elixir/Sleep new file mode 120000 index 0000000000..9951896703 --- /dev/null +++ b/Lang/Elixir/Sleep @@ -0,0 +1 @@ +../../Task/Sleep/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Sockets b/Lang/Elixir/Sockets new file mode 120000 index 0000000000..c95f661c1f --- /dev/null +++ b/Lang/Elixir/Sockets @@ -0,0 +1 @@ +../../Task/Sockets/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Sokoban b/Lang/Elixir/Sokoban new file mode 120000 index 0000000000..dc8350cfa0 --- /dev/null +++ b/Lang/Elixir/Sokoban @@ -0,0 +1 @@ +../../Task/Sokoban/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Solve-a-Hidato-puzzle b/Lang/Elixir/Solve-a-Hidato-puzzle new file mode 120000 index 0000000000..111ffc147d --- /dev/null +++ b/Lang/Elixir/Solve-a-Hidato-puzzle @@ -0,0 +1 @@ +../../Task/Solve-a-Hidato-puzzle/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Solve-a-Holy-Knights-tour b/Lang/Elixir/Solve-a-Holy-Knights-tour new file mode 120000 index 0000000000..01c7ab58f5 --- /dev/null +++ b/Lang/Elixir/Solve-a-Holy-Knights-tour @@ -0,0 +1 @@ +../../Task/Solve-a-Holy-Knights-tour/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Solve-a-Hopido-puzzle b/Lang/Elixir/Solve-a-Hopido-puzzle new file mode 120000 index 0000000000..a867198da0 --- /dev/null +++ b/Lang/Elixir/Solve-a-Hopido-puzzle @@ -0,0 +1 @@ +../../Task/Solve-a-Hopido-puzzle/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Solve-a-Numbrix-puzzle b/Lang/Elixir/Solve-a-Numbrix-puzzle new file mode 120000 index 0000000000..ed16cb7d9e --- /dev/null +++ b/Lang/Elixir/Solve-a-Numbrix-puzzle @@ -0,0 +1 @@ +../../Task/Solve-a-Numbrix-puzzle/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Solve-the-no-connection-puzzle b/Lang/Elixir/Solve-the-no-connection-puzzle new file mode 120000 index 0000000000..a514b2584b --- /dev/null +++ b/Lang/Elixir/Solve-the-no-connection-puzzle @@ -0,0 +1 @@ +../../Task/Solve-the-no-connection-puzzle/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Sort-using-a-custom-comparator b/Lang/Elixir/Sort-using-a-custom-comparator new file mode 120000 index 0000000000..5759c13a85 --- /dev/null +++ b/Lang/Elixir/Sort-using-a-custom-comparator @@ -0,0 +1 @@ +../../Task/Sort-using-a-custom-comparator/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Sorting-algorithms-Comb-sort b/Lang/Elixir/Sorting-algorithms-Comb-sort new file mode 120000 index 0000000000..dcdbd601ab --- /dev/null +++ b/Lang/Elixir/Sorting-algorithms-Comb-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Comb-sort/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Sorting-algorithms-Heapsort b/Lang/Elixir/Sorting-algorithms-Heapsort new file mode 120000 index 0000000000..68156714ca --- /dev/null +++ b/Lang/Elixir/Sorting-algorithms-Heapsort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Heapsort/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Sorting-algorithms-Permutation-sort b/Lang/Elixir/Sorting-algorithms-Permutation-sort new file mode 120000 index 0000000000..6f0d01c44f --- /dev/null +++ b/Lang/Elixir/Sorting-algorithms-Permutation-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Permutation-sort/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Sorting-algorithms-Shell-sort b/Lang/Elixir/Sorting-algorithms-Shell-sort new file mode 120000 index 0000000000..6a6583e7bd --- /dev/null +++ b/Lang/Elixir/Sorting-algorithms-Shell-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Shell-sort/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Sorting-algorithms-Sleep-sort b/Lang/Elixir/Sorting-algorithms-Sleep-sort new file mode 120000 index 0000000000..5d41b3ca86 --- /dev/null +++ b/Lang/Elixir/Sorting-algorithms-Sleep-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Sleep-sort/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Sorting-algorithms-Stooge-sort b/Lang/Elixir/Sorting-algorithms-Stooge-sort new file mode 120000 index 0000000000..4632a56370 --- /dev/null +++ b/Lang/Elixir/Sorting-algorithms-Stooge-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Stooge-sort/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Sorting-algorithms-Strand-sort b/Lang/Elixir/Sorting-algorithms-Strand-sort new file mode 120000 index 0000000000..435b1797e3 --- /dev/null +++ b/Lang/Elixir/Sorting-algorithms-Strand-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Strand-sort/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Soundex b/Lang/Elixir/Soundex new file mode 120000 index 0000000000..44dbabf5b7 --- /dev/null +++ b/Lang/Elixir/Soundex @@ -0,0 +1 @@ +../../Task/Soundex/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Stack-traces b/Lang/Elixir/Stack-traces new file mode 120000 index 0000000000..1e9f276c7f --- /dev/null +++ b/Lang/Elixir/Stack-traces @@ -0,0 +1 @@ +../../Task/Stack-traces/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Stair-climbing-puzzle b/Lang/Elixir/Stair-climbing-puzzle new file mode 120000 index 0000000000..ec3edf9ff2 --- /dev/null +++ b/Lang/Elixir/Stair-climbing-puzzle @@ -0,0 +1 @@ +../../Task/Stair-climbing-puzzle/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Statistics-Basic b/Lang/Elixir/Statistics-Basic new file mode 120000 index 0000000000..0179a1c909 --- /dev/null +++ b/Lang/Elixir/Statistics-Basic @@ -0,0 +1 @@ +../../Task/Statistics-Basic/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Stern-Brocot-sequence b/Lang/Elixir/Stern-Brocot-sequence new file mode 120000 index 0000000000..2f6c49b999 --- /dev/null +++ b/Lang/Elixir/Stern-Brocot-sequence @@ -0,0 +1 @@ +../../Task/Stern-Brocot-sequence/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Subtractive-generator b/Lang/Elixir/Subtractive-generator new file mode 120000 index 0000000000..28184f1aa8 --- /dev/null +++ b/Lang/Elixir/Subtractive-generator @@ -0,0 +1 @@ +../../Task/Subtractive-generator/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Sutherland-Hodgman-polygon-clipping b/Lang/Elixir/Sutherland-Hodgman-polygon-clipping new file mode 120000 index 0000000000..05243dfd01 --- /dev/null +++ b/Lang/Elixir/Sutherland-Hodgman-polygon-clipping @@ -0,0 +1 @@ +../../Task/Sutherland-Hodgman-polygon-clipping/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Synchronous-concurrency b/Lang/Elixir/Synchronous-concurrency new file mode 120000 index 0000000000..0e3f49b996 --- /dev/null +++ b/Lang/Elixir/Synchronous-concurrency @@ -0,0 +1 @@ +../../Task/Synchronous-concurrency/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Take-notes-on-the-command-line b/Lang/Elixir/Take-notes-on-the-command-line new file mode 120000 index 0000000000..71170e208d --- /dev/null +++ b/Lang/Elixir/Take-notes-on-the-command-line @@ -0,0 +1 @@ +../../Task/Take-notes-on-the-command-line/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Topological-sort b/Lang/Elixir/Topological-sort new file mode 120000 index 0000000000..e0ab7dbdc6 --- /dev/null +++ b/Lang/Elixir/Topological-sort @@ -0,0 +1 @@ +../../Task/Topological-sort/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Topswops b/Lang/Elixir/Topswops new file mode 120000 index 0000000000..5f9b435d9e --- /dev/null +++ b/Lang/Elixir/Topswops @@ -0,0 +1 @@ +../../Task/Topswops/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Trabb-Pardo-Knuth-algorithm b/Lang/Elixir/Trabb-Pardo-Knuth-algorithm new file mode 120000 index 0000000000..47915268e5 --- /dev/null +++ b/Lang/Elixir/Trabb-Pardo-Knuth-algorithm @@ -0,0 +1 @@ +../../Task/Trabb-Pardo-Knuth-algorithm/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Tree-traversal b/Lang/Elixir/Tree-traversal new file mode 120000 index 0000000000..088bc34d36 --- /dev/null +++ b/Lang/Elixir/Tree-traversal @@ -0,0 +1 @@ +../../Task/Tree-traversal/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Truncatable-primes b/Lang/Elixir/Truncatable-primes new file mode 120000 index 0000000000..1342cea83b --- /dev/null +++ b/Lang/Elixir/Truncatable-primes @@ -0,0 +1 @@ +../../Task/Truncatable-primes/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Unix-ls b/Lang/Elixir/Unix-ls new file mode 120000 index 0000000000..eba6018ad3 --- /dev/null +++ b/Lang/Elixir/Unix-ls @@ -0,0 +1 @@ +../../Task/Unix-ls/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Vampire-number b/Lang/Elixir/Vampire-number new file mode 120000 index 0000000000..746b135383 --- /dev/null +++ b/Lang/Elixir/Vampire-number @@ -0,0 +1 @@ +../../Task/Vampire-number/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Variable-size-Get b/Lang/Elixir/Variable-size-Get new file mode 120000 index 0000000000..dda2f94922 --- /dev/null +++ b/Lang/Elixir/Variable-size-Get @@ -0,0 +1 @@ +../../Task/Variable-size-Get/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Vector-products b/Lang/Elixir/Vector-products new file mode 120000 index 0000000000..7b5bbca5ed --- /dev/null +++ b/Lang/Elixir/Vector-products @@ -0,0 +1 @@ +../../Task/Vector-products/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Verify-distribution-uniformity-Chi-squared-test b/Lang/Elixir/Verify-distribution-uniformity-Chi-squared-test new file mode 120000 index 0000000000..b7cb2dff29 --- /dev/null +++ b/Lang/Elixir/Verify-distribution-uniformity-Chi-squared-test @@ -0,0 +1 @@ +../../Task/Verify-distribution-uniformity-Chi-squared-test/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Vigen-re-cipher b/Lang/Elixir/Vigen-re-cipher new file mode 120000 index 0000000000..9457c06047 --- /dev/null +++ b/Lang/Elixir/Vigen-re-cipher @@ -0,0 +1 @@ +../../Task/Vigen-re-cipher/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Walk-a-directory-Non-recursively b/Lang/Elixir/Walk-a-directory-Non-recursively new file mode 120000 index 0000000000..debe23f430 --- /dev/null +++ b/Lang/Elixir/Walk-a-directory-Non-recursively @@ -0,0 +1 @@ +../../Task/Walk-a-directory-Non-recursively/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Walk-a-directory-Recursively b/Lang/Elixir/Walk-a-directory-Recursively new file mode 120000 index 0000000000..9e4cb3554c --- /dev/null +++ b/Lang/Elixir/Walk-a-directory-Recursively @@ -0,0 +1 @@ +../../Task/Walk-a-directory-Recursively/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Wireworld b/Lang/Elixir/Wireworld new file mode 120000 index 0000000000..287bde1483 --- /dev/null +++ b/Lang/Elixir/Wireworld @@ -0,0 +1 @@ +../../Task/Wireworld/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Write-float-arrays-to-a-text-file b/Lang/Elixir/Write-float-arrays-to-a-text-file new file mode 120000 index 0000000000..f58f2ec175 --- /dev/null +++ b/Lang/Elixir/Write-float-arrays-to-a-text-file @@ -0,0 +1 @@ +../../Task/Write-float-arrays-to-a-text-file/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Zebra-puzzle b/Lang/Elixir/Zebra-puzzle new file mode 120000 index 0000000000..0cc761d6a9 --- /dev/null +++ b/Lang/Elixir/Zebra-puzzle @@ -0,0 +1 @@ +../../Task/Zebra-puzzle/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Zeckendorf-number-representation b/Lang/Elixir/Zeckendorf-number-representation new file mode 120000 index 0000000000..28b2a75a29 --- /dev/null +++ b/Lang/Elixir/Zeckendorf-number-representation @@ -0,0 +1 @@ +../../Task/Zeckendorf-number-representation/Elixir \ No newline at end of file diff --git a/Lang/Elixir/Zhang-Suen-thinning-algorithm b/Lang/Elixir/Zhang-Suen-thinning-algorithm new file mode 120000 index 0000000000..f5943f9530 --- /dev/null +++ b/Lang/Elixir/Zhang-Suen-thinning-algorithm @@ -0,0 +1 @@ +../../Task/Zhang-Suen-thinning-algorithm/Elixir \ No newline at end of file diff --git a/Lang/Emacs-Lisp/Arithmetic-evaluation b/Lang/Emacs-Lisp/Arithmetic-evaluation new file mode 120000 index 0000000000..8170bb20ba --- /dev/null +++ b/Lang/Emacs-Lisp/Arithmetic-evaluation @@ -0,0 +1 @@ +../../Task/Arithmetic-evaluation/Emacs-Lisp \ No newline at end of file diff --git a/Lang/Emacs-Lisp/Array-concatenation b/Lang/Emacs-Lisp/Array-concatenation new file mode 120000 index 0000000000..921ba449dc --- /dev/null +++ b/Lang/Emacs-Lisp/Array-concatenation @@ -0,0 +1 @@ +../../Task/Array-concatenation/Emacs-Lisp \ No newline at end of file diff --git a/Lang/Emacs-Lisp/Combinations b/Lang/Emacs-Lisp/Combinations new file mode 120000 index 0000000000..bf4547628c --- /dev/null +++ b/Lang/Emacs-Lisp/Combinations @@ -0,0 +1 @@ +../../Task/Combinations/Emacs-Lisp \ No newline at end of file diff --git a/Lang/Emacs-Lisp/Conways-Game-of-Life b/Lang/Emacs-Lisp/Conways-Game-of-Life new file mode 120000 index 0000000000..ec6023c351 --- /dev/null +++ b/Lang/Emacs-Lisp/Conways-Game-of-Life @@ -0,0 +1 @@ +../../Task/Conways-Game-of-Life/Emacs-Lisp \ No newline at end of file diff --git a/Lang/Emacs-Lisp/Date-format b/Lang/Emacs-Lisp/Date-format new file mode 120000 index 0000000000..5ebbba386f --- /dev/null +++ b/Lang/Emacs-Lisp/Date-format @@ -0,0 +1 @@ +../../Task/Date-format/Emacs-Lisp \ No newline at end of file diff --git a/Lang/Emacs-Lisp/Forest-fire b/Lang/Emacs-Lisp/Forest-fire new file mode 120000 index 0000000000..bf1c104b41 --- /dev/null +++ b/Lang/Emacs-Lisp/Forest-fire @@ -0,0 +1 @@ +../../Task/Forest-fire/Emacs-Lisp \ No newline at end of file diff --git a/Lang/Emacs-Lisp/Walk-a-directory-Recursively b/Lang/Emacs-Lisp/Walk-a-directory-Recursively new file mode 120000 index 0000000000..f9eea4a265 --- /dev/null +++ b/Lang/Emacs-Lisp/Walk-a-directory-Recursively @@ -0,0 +1 @@ +../../Task/Walk-a-directory-Recursively/Emacs-Lisp \ No newline at end of file diff --git a/Lang/Erlang/Euler-method b/Lang/Erlang/Euler-method new file mode 120000 index 0000000000..dba7dcc25b --- /dev/null +++ b/Lang/Erlang/Euler-method @@ -0,0 +1 @@ +../../Task/Euler-method/Erlang \ No newline at end of file diff --git a/Lang/Erlang/Fractran b/Lang/Erlang/Fractran new file mode 120000 index 0000000000..561f423277 --- /dev/null +++ b/Lang/Erlang/Fractran @@ -0,0 +1 @@ +../../Task/Fractran/Erlang \ No newline at end of file diff --git a/Lang/Erlang/Holidays-related-to-Easter b/Lang/Erlang/Holidays-related-to-Easter new file mode 120000 index 0000000000..e7fea7901c --- /dev/null +++ b/Lang/Erlang/Holidays-related-to-Easter @@ -0,0 +1 @@ +../../Task/Holidays-related-to-Easter/Erlang \ No newline at end of file diff --git a/Lang/Erlang/Knapsack-problem-0-1 b/Lang/Erlang/Knapsack-problem-0-1 new file mode 120000 index 0000000000..08c079c2cb --- /dev/null +++ b/Lang/Erlang/Knapsack-problem-0-1 @@ -0,0 +1 @@ +../../Task/Knapsack-problem-0-1/Erlang \ No newline at end of file diff --git a/Lang/Erlang/The-Twelve-Days-of-Christmas b/Lang/Erlang/The-Twelve-Days-of-Christmas new file mode 120000 index 0000000000..4db392ab67 --- /dev/null +++ b/Lang/Erlang/The-Twelve-Days-of-Christmas @@ -0,0 +1 @@ +../../Task/The-Twelve-Days-of-Christmas/Erlang \ No newline at end of file diff --git a/Lang/Excel/Averages-Pythagorean-means b/Lang/Excel/Averages-Pythagorean-means new file mode 120000 index 0000000000..6d016f3dbb --- /dev/null +++ b/Lang/Excel/Averages-Pythagorean-means @@ -0,0 +1 @@ +../../Task/Averages-Pythagorean-means/Excel \ No newline at end of file diff --git a/Lang/Excel/Even-or-odd b/Lang/Excel/Even-or-odd new file mode 120000 index 0000000000..b189d4dfaa --- /dev/null +++ b/Lang/Excel/Even-or-odd @@ -0,0 +1 @@ +../../Task/Even-or-odd/Excel \ No newline at end of file diff --git a/Lang/Excel/Greatest-element-of-a-list b/Lang/Excel/Greatest-element-of-a-list new file mode 120000 index 0000000000..a5bfc4c299 --- /dev/null +++ b/Lang/Excel/Greatest-element-of-a-list @@ -0,0 +1 @@ +../../Task/Greatest-element-of-a-list/Excel \ No newline at end of file diff --git a/Lang/F-Sharp/Calendar b/Lang/F-Sharp/Calendar new file mode 120000 index 0000000000..91cb3c03cc --- /dev/null +++ b/Lang/F-Sharp/Calendar @@ -0,0 +1 @@ +../../Task/Calendar/F-Sharp \ No newline at end of file diff --git a/Lang/Factor/Evaluate-binomial-coefficients b/Lang/Factor/Evaluate-binomial-coefficients new file mode 120000 index 0000000000..864bffa4ed --- /dev/null +++ b/Lang/Factor/Evaluate-binomial-coefficients @@ -0,0 +1 @@ +../../Task/Evaluate-binomial-coefficients/Factor \ No newline at end of file diff --git a/Lang/Factor/Nth b/Lang/Factor/Nth new file mode 120000 index 0000000000..ca9976cb70 --- /dev/null +++ b/Lang/Factor/Nth @@ -0,0 +1 @@ +../../Task/Nth/Factor \ No newline at end of file diff --git a/Lang/Fantom/00DESCRIPTION b/Lang/Fantom/00DESCRIPTION index 223fcc0a51..2ddf454f10 100644 --- a/Lang/Fantom/00DESCRIPTION +++ b/Lang/Fantom/00DESCRIPTION @@ -6,7 +6,7 @@ {{language programming paradigm|object-oriented}} {{language programming paradigm|functional}} -Fantom is a general purpose [[:Category:Programming paradigm/Object-oriented|object-oriented]] programming language that runs on the [[runs on vm::Java Virtual Machine|JRE]], [[.Net Framework|.NET]] [[runs on vm::Common Language Runtime|CLR]], and [[:Category:Javascript|Javascript]]. The language supports [[:Category:Programming paradigm/Functional|functional programming]] through closures and concurrency through the [[wp:Actor model|Actor model]]. Fantom takes a "middle of the road" approach to its type system, blending together aspects of both [[:Category:Typing/Checking/Static|static]] and [[:Category:Typing/Checking/Dynamic|dynamic typing]]. Like [[:Category:C sharp|C#]] and [[:Category:Java|Java]], Fantom uses a curly brace syntax. +Fantom is a general purpose [[:Category:Programming paradigm/Object-oriented|object-oriented]] programming language that runs on the [[runs on vm::Java Virtual Machine|JRE]], [[.Net Framework|.NET]] [[runs on vm::Common Language Runtime|CLR]], and [[JavaScript]]. The language supports [[:Category:Programming paradigm/Functional|functional programming]] through closures and concurrency through the [[wp:Actor model|Actor model]]. Fantom takes a "middle of the road" approach to its type system, blending together aspects of both [[:Category:Typing/Checking/Static|static]] and [[:Category:Typing/Checking/Dynamic|dynamic typing]]. Like [[:Category:C sharp|C#]] and [[:Category:Java|Java]], Fantom uses a curly brace syntax. ==See also== *[http://www.fantom.org/ Fantom homepage] diff --git a/Lang/Fish/Factors-of-an-integer b/Lang/Fish/Factors-of-an-integer new file mode 120000 index 0000000000..c86f078635 --- /dev/null +++ b/Lang/Fish/Factors-of-an-integer @@ -0,0 +1 @@ +../../Task/Factors-of-an-integer/Fish \ No newline at end of file diff --git a/Lang/Forth/CRC-32 b/Lang/Forth/CRC-32 new file mode 120000 index 0000000000..c59d6ff86f --- /dev/null +++ b/Lang/Forth/CRC-32 @@ -0,0 +1 @@ +../../Task/CRC-32/Forth \ No newline at end of file diff --git a/Lang/Forth/Case-sensitivity-of-identifiers b/Lang/Forth/Case-sensitivity-of-identifiers new file mode 120000 index 0000000000..f9ddc6ada8 --- /dev/null +++ b/Lang/Forth/Case-sensitivity-of-identifiers @@ -0,0 +1 @@ +../../Task/Case-sensitivity-of-identifiers/Forth \ No newline at end of file diff --git a/Lang/Forth/Catamorphism b/Lang/Forth/Catamorphism new file mode 120000 index 0000000000..e553c2d134 --- /dev/null +++ b/Lang/Forth/Catamorphism @@ -0,0 +1 @@ +../../Task/Catamorphism/Forth \ No newline at end of file diff --git a/Lang/Forth/Closures-Value-capture b/Lang/Forth/Closures-Value-capture new file mode 120000 index 0000000000..2f013a1495 --- /dev/null +++ b/Lang/Forth/Closures-Value-capture @@ -0,0 +1 @@ +../../Task/Closures-Value-capture/Forth \ No newline at end of file diff --git a/Lang/Forth/Comma-quibbling b/Lang/Forth/Comma-quibbling new file mode 120000 index 0000000000..5407d730de --- /dev/null +++ b/Lang/Forth/Comma-quibbling @@ -0,0 +1 @@ +../../Task/Comma-quibbling/Forth \ No newline at end of file diff --git a/Lang/Forth/Convert-decimal-number-to-rational b/Lang/Forth/Convert-decimal-number-to-rational new file mode 120000 index 0000000000..b80e26593a --- /dev/null +++ b/Lang/Forth/Convert-decimal-number-to-rational @@ -0,0 +1 @@ +../../Task/Convert-decimal-number-to-rational/Forth \ No newline at end of file diff --git a/Lang/Forth/Create-an-HTML-table b/Lang/Forth/Create-an-HTML-table new file mode 120000 index 0000000000..b0ccdf1bd5 --- /dev/null +++ b/Lang/Forth/Create-an-HTML-table @@ -0,0 +1 @@ +../../Task/Create-an-HTML-table/Forth \ No newline at end of file diff --git a/Lang/Forth/Generate-Chess960-starting-position b/Lang/Forth/Generate-Chess960-starting-position new file mode 120000 index 0000000000..bf5e8d23dd --- /dev/null +++ b/Lang/Forth/Generate-Chess960-starting-position @@ -0,0 +1 @@ +../../Task/Generate-Chess960-starting-position/Forth \ No newline at end of file diff --git a/Lang/Forth/Guess-the-number b/Lang/Forth/Guess-the-number new file mode 120000 index 0000000000..0f876badff --- /dev/null +++ b/Lang/Forth/Guess-the-number @@ -0,0 +1 @@ +../../Task/Guess-the-number/Forth \ No newline at end of file diff --git a/Lang/Forth/Hash-join b/Lang/Forth/Hash-join new file mode 120000 index 0000000000..8b201aad1e --- /dev/null +++ b/Lang/Forth/Hash-join @@ -0,0 +1 @@ +../../Task/Hash-join/Forth \ No newline at end of file diff --git a/Lang/Forth/Hello-world-Line-printer b/Lang/Forth/Hello-world-Line-printer new file mode 120000 index 0000000000..aaef9833ea --- /dev/null +++ b/Lang/Forth/Hello-world-Line-printer @@ -0,0 +1 @@ +../../Task/Hello-world-Line-printer/Forth \ No newline at end of file diff --git a/Lang/Forth/Morse-code b/Lang/Forth/Morse-code new file mode 120000 index 0000000000..d8f9d770e5 --- /dev/null +++ b/Lang/Forth/Morse-code @@ -0,0 +1 @@ +../../Task/Morse-code/Forth \ No newline at end of file diff --git a/Lang/Forth/Multifactorial b/Lang/Forth/Multifactorial new file mode 120000 index 0000000000..d6e4006775 --- /dev/null +++ b/Lang/Forth/Multifactorial @@ -0,0 +1 @@ +../../Task/Multifactorial/Forth \ No newline at end of file diff --git a/Lang/Forth/Queue-Usage b/Lang/Forth/Queue-Usage new file mode 120000 index 0000000000..edf388450d --- /dev/null +++ b/Lang/Forth/Queue-Usage @@ -0,0 +1 @@ +../../Task/Queue-Usage/Forth \ No newline at end of file diff --git a/Lang/Forth/Read-a-configuration-file b/Lang/Forth/Read-a-configuration-file new file mode 120000 index 0000000000..4fba38b0c1 --- /dev/null +++ b/Lang/Forth/Read-a-configuration-file @@ -0,0 +1 @@ +../../Task/Read-a-configuration-file/Forth \ No newline at end of file diff --git a/Lang/Forth/Reverse-words-in-a-string b/Lang/Forth/Reverse-words-in-a-string new file mode 120000 index 0000000000..002f41ae8d --- /dev/null +++ b/Lang/Forth/Reverse-words-in-a-string @@ -0,0 +1 @@ +../../Task/Reverse-words-in-a-string/Forth \ No newline at end of file diff --git a/Lang/Forth/Semordnilap b/Lang/Forth/Semordnilap new file mode 120000 index 0000000000..91849fd956 --- /dev/null +++ b/Lang/Forth/Semordnilap @@ -0,0 +1 @@ +../../Task/Semordnilap/Forth \ No newline at end of file diff --git a/Lang/Forth/Set b/Lang/Forth/Set new file mode 120000 index 0000000000..486af3bc87 --- /dev/null +++ b/Lang/Forth/Set @@ -0,0 +1 @@ +../../Task/Set/Forth \ No newline at end of file diff --git a/Lang/Forth/String-prepend b/Lang/Forth/String-prepend new file mode 120000 index 0000000000..a5b5c137c3 --- /dev/null +++ b/Lang/Forth/String-prepend @@ -0,0 +1 @@ +../../Task/String-prepend/Forth \ No newline at end of file diff --git a/Lang/Forth/The-Twelve-Days-of-Christmas b/Lang/Forth/The-Twelve-Days-of-Christmas new file mode 120000 index 0000000000..ae0b230473 --- /dev/null +++ b/Lang/Forth/The-Twelve-Days-of-Christmas @@ -0,0 +1 @@ +../../Task/The-Twelve-Days-of-Christmas/Forth \ No newline at end of file diff --git a/Lang/Forth/Topological-sort b/Lang/Forth/Topological-sort new file mode 120000 index 0000000000..aee35359d7 --- /dev/null +++ b/Lang/Forth/Topological-sort @@ -0,0 +1 @@ +../../Task/Topological-sort/Forth \ No newline at end of file diff --git a/Lang/Forth/Write-language-name-in-3D-ASCII b/Lang/Forth/Write-language-name-in-3D-ASCII new file mode 120000 index 0000000000..be58c88a02 --- /dev/null +++ b/Lang/Forth/Write-language-name-in-3D-ASCII @@ -0,0 +1 @@ +../../Task/Write-language-name-in-3D-ASCII/Forth \ No newline at end of file diff --git a/Lang/Forth/Y-combinator b/Lang/Forth/Y-combinator new file mode 120000 index 0000000000..ba5dd17ee7 --- /dev/null +++ b/Lang/Forth/Y-combinator @@ -0,0 +1 @@ +../../Task/Y-combinator/Forth \ No newline at end of file diff --git a/Lang/Fortran/00DESCRIPTION b/Lang/Fortran/00DESCRIPTION index ffa37bc6aa..31b2e35530 100644 --- a/Lang/Fortran/00DESCRIPTION +++ b/Lang/Fortran/00DESCRIPTION @@ -7,7 +7,7 @@ |LCT=yes |tags=fortran |bnf=http://fortran.comsci.us/syntax/statement/index.html}}{{language programming paradigm|Imperative}}{{Language programming paradigm|Procedural}}{{Language programming paradigm|Object-oriented}}{{Language programming paradigm|Concurrent}} -Fortran is the oldest programming language still in widespread use. The language has evolved considerably since it was first released in 1957. Fortran was original developed for scientific and engineering applications, and remains especially suited to numeric computation and scientific computing. By convention, versions before Fortran 90 are spelled with all uppercase letters (e.g. FORTRAN 66, FORTRAN 77), while starting with Fortran 90, the mixed case spelling is used (i.e. Fortran 90, Fortran 95, Fortran 2003 and Fortran 2008). The most recent standard is Fortran 2008 (ISO/IEC 1539-1:2010). +Fortran is the oldest programming language still in widespread use. The language has evolved considerably since it was first released in 1957. Fortran was original developed for scientific and engineering applications, and remains especially suited to numeric computation and scientific computing. By convention, versions before Fortran 90 are spelled with all uppercase letters (e.g. FORTRAN 66, FORTRAN 77), while starting with Fortran 90, the mixed case spelling is used (i.e. Fortran 90, Fortran 95, Fortran 2003 and [http://j3-fortran.org/doc/year/12/12-007.pdf Fortran 2008]). The most recent standard is Fortran 2008 (ISO/IEC 1539-1:2010). The next, informally known as [http://j3-fortran.org/doc/year/16/16-007r2.pdf Fortran 2015], is underway. FORTRAN 77, being quite old, lacks almost everything one expects from a modern programming language. It uses a fixed-length line and column oriented line format which was motivated by punch cards. Due to its age, and since FORTRAN compilers generally gave very good performance for numerical code, a lot of code, especially scientific code, was written in FORTRAN. Also, for quite a while there was no free Fortran 90 compiler, which also caused a lot of FORTRAN 77 code to be written even quite some time after Fortran 90 was standardized. Because of the large body of code written in FORTRAN 77 it remains relevant today. Indeed, every modern Fortran compiler still accepts FORTRAN 77 code. diff --git a/Lang/Fortran/Align-columns b/Lang/Fortran/Align-columns new file mode 120000 index 0000000000..2aac28e986 --- /dev/null +++ b/Lang/Fortran/Align-columns @@ -0,0 +1 @@ +../../Task/Align-columns/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Append-a-record-to-the-end-of-a-text-file b/Lang/Fortran/Append-a-record-to-the-end-of-a-text-file new file mode 120000 index 0000000000..b43a38e067 --- /dev/null +++ b/Lang/Fortran/Append-a-record-to-the-end-of-a-text-file @@ -0,0 +1 @@ +../../Task/Append-a-record-to-the-end-of-a-text-file/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Arbitrary-precision-integers--included- b/Lang/Fortran/Arbitrary-precision-integers--included- new file mode 120000 index 0000000000..5abd63a01b --- /dev/null +++ b/Lang/Fortran/Arbitrary-precision-integers--included- @@ -0,0 +1 @@ +../../Task/Arbitrary-precision-integers--included-/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Arena-storage-pool b/Lang/Fortran/Arena-storage-pool new file mode 120000 index 0000000000..7565b6bb64 --- /dev/null +++ b/Lang/Fortran/Arena-storage-pool @@ -0,0 +1 @@ +../../Task/Arena-storage-pool/Fortran \ No newline at end of file diff --git a/Lang/Fortran/CRC-32 b/Lang/Fortran/CRC-32 new file mode 120000 index 0000000000..470a28522f --- /dev/null +++ b/Lang/Fortran/CRC-32 @@ -0,0 +1 @@ +../../Task/CRC-32/Fortran \ No newline at end of file diff --git a/Lang/Fortran/CSV-data-manipulation b/Lang/Fortran/CSV-data-manipulation new file mode 120000 index 0000000000..fa1c3ee65c --- /dev/null +++ b/Lang/Fortran/CSV-data-manipulation @@ -0,0 +1 @@ +../../Task/CSV-data-manipulation/Fortran \ No newline at end of file diff --git a/Lang/Fortran/CSV-to-HTML-translation b/Lang/Fortran/CSV-to-HTML-translation new file mode 120000 index 0000000000..56ab6479de --- /dev/null +++ b/Lang/Fortran/CSV-to-HTML-translation @@ -0,0 +1 @@ +../../Task/CSV-to-HTML-translation/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Carmichael-3-strong-pseudoprimes b/Lang/Fortran/Carmichael-3-strong-pseudoprimes new file mode 120000 index 0000000000..8211909df0 --- /dev/null +++ b/Lang/Fortran/Carmichael-3-strong-pseudoprimes @@ -0,0 +1 @@ +../../Task/Carmichael-3-strong-pseudoprimes/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Comma-quibbling b/Lang/Fortran/Comma-quibbling new file mode 120000 index 0000000000..dbfaed3e62 --- /dev/null +++ b/Lang/Fortran/Comma-quibbling @@ -0,0 +1 @@ +../../Task/Comma-quibbling/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Constrained-genericity b/Lang/Fortran/Constrained-genericity new file mode 120000 index 0000000000..7c64ce0ff6 --- /dev/null +++ b/Lang/Fortran/Constrained-genericity @@ -0,0 +1 @@ +../../Task/Constrained-genericity/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Convert-decimal-number-to-rational b/Lang/Fortran/Convert-decimal-number-to-rational new file mode 120000 index 0000000000..a85711700a --- /dev/null +++ b/Lang/Fortran/Convert-decimal-number-to-rational @@ -0,0 +1 @@ +../../Task/Convert-decimal-number-to-rational/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Create-an-HTML-table b/Lang/Fortran/Create-an-HTML-table new file mode 120000 index 0000000000..85ccdb7b17 --- /dev/null +++ b/Lang/Fortran/Create-an-HTML-table @@ -0,0 +1 @@ +../../Task/Create-an-HTML-table/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Documentation b/Lang/Fortran/Documentation new file mode 120000 index 0000000000..1d319c8307 --- /dev/null +++ b/Lang/Fortran/Documentation @@ -0,0 +1 @@ +../../Task/Documentation/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Execute-Brain---- b/Lang/Fortran/Execute-Brain---- new file mode 120000 index 0000000000..9335fe2292 --- /dev/null +++ b/Lang/Fortran/Execute-Brain---- @@ -0,0 +1 @@ +../../Task/Execute-Brain----/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Extensible-prime-generator b/Lang/Fortran/Extensible-prime-generator new file mode 120000 index 0000000000..1d72090180 --- /dev/null +++ b/Lang/Fortran/Extensible-prime-generator @@ -0,0 +1 @@ +../../Task/Extensible-prime-generator/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Extreme-floating-point-values b/Lang/Fortran/Extreme-floating-point-values new file mode 120000 index 0000000000..5b3a5beb46 --- /dev/null +++ b/Lang/Fortran/Extreme-floating-point-values @@ -0,0 +1 @@ +../../Task/Extreme-floating-point-values/Fortran \ No newline at end of file diff --git a/Lang/Fortran/File-size b/Lang/Fortran/File-size new file mode 120000 index 0000000000..766097ce99 --- /dev/null +++ b/Lang/Fortran/File-size @@ -0,0 +1 @@ +../../Task/File-size/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Find-the-last-Sunday-of-each-month b/Lang/Fortran/Find-the-last-Sunday-of-each-month new file mode 120000 index 0000000000..fd6c31bc80 --- /dev/null +++ b/Lang/Fortran/Find-the-last-Sunday-of-each-month @@ -0,0 +1 @@ +../../Task/Find-the-last-Sunday-of-each-month/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Flow-control-structures b/Lang/Fortran/Flow-control-structures new file mode 120000 index 0000000000..1a431aa2bb --- /dev/null +++ b/Lang/Fortran/Flow-control-structures @@ -0,0 +1 @@ +../../Task/Flow-control-structures/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Fractran b/Lang/Fortran/Fractran new file mode 120000 index 0000000000..0e27c16d86 --- /dev/null +++ b/Lang/Fortran/Fractran @@ -0,0 +1 @@ +../../Task/Fractran/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Function-composition b/Lang/Fortran/Function-composition new file mode 120000 index 0000000000..7ac91fed0e --- /dev/null +++ b/Lang/Fortran/Function-composition @@ -0,0 +1 @@ +../../Task/Function-composition/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Generate-Chess960-starting-position b/Lang/Fortran/Generate-Chess960-starting-position new file mode 120000 index 0000000000..183803d817 --- /dev/null +++ b/Lang/Fortran/Generate-Chess960-starting-position @@ -0,0 +1 @@ +../../Task/Generate-Chess960-starting-position/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Globally-replace-text-in-several-files b/Lang/Fortran/Globally-replace-text-in-several-files new file mode 120000 index 0000000000..47063a8957 --- /dev/null +++ b/Lang/Fortran/Globally-replace-text-in-several-files @@ -0,0 +1 @@ +../../Task/Globally-replace-text-in-several-files/Fortran \ No newline at end of file diff --git a/Lang/Fortran/HTTPS b/Lang/Fortran/HTTPS new file mode 120000 index 0000000000..86feed7978 --- /dev/null +++ b/Lang/Fortran/HTTPS @@ -0,0 +1 @@ +../../Task/HTTPS/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Hello-world-Graphical b/Lang/Fortran/Hello-world-Graphical new file mode 120000 index 0000000000..54c3a933d8 --- /dev/null +++ b/Lang/Fortran/Hello-world-Graphical @@ -0,0 +1 @@ +../../Task/Hello-world-Graphical/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Hello-world-Web-server b/Lang/Fortran/Hello-world-Web-server new file mode 120000 index 0000000000..983c34542d --- /dev/null +++ b/Lang/Fortran/Hello-world-Web-server @@ -0,0 +1 @@ +../../Task/Hello-world-Web-server/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Here-document b/Lang/Fortran/Here-document new file mode 120000 index 0000000000..288332006b --- /dev/null +++ b/Lang/Fortran/Here-document @@ -0,0 +1 @@ +../../Task/Here-document/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Inverted-syntax b/Lang/Fortran/Inverted-syntax new file mode 120000 index 0000000000..d3a96ee814 --- /dev/null +++ b/Lang/Fortran/Inverted-syntax @@ -0,0 +1 @@ +../../Task/Inverted-syntax/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Jensens-Device b/Lang/Fortran/Jensens-Device new file mode 120000 index 0000000000..5e99d9a6b1 --- /dev/null +++ b/Lang/Fortran/Jensens-Device @@ -0,0 +1 @@ +../../Task/Jensens-Device/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Keyboard-input-Obtain-a-Y-or-N-response b/Lang/Fortran/Keyboard-input-Obtain-a-Y-or-N-response new file mode 120000 index 0000000000..6d16cf002e --- /dev/null +++ b/Lang/Fortran/Keyboard-input-Obtain-a-Y-or-N-response @@ -0,0 +1 @@ +../../Task/Keyboard-input-Obtain-a-Y-or-N-response/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Largest-int-from-concatenated-ints b/Lang/Fortran/Largest-int-from-concatenated-ints new file mode 120000 index 0000000000..bbe8346190 --- /dev/null +++ b/Lang/Fortran/Largest-int-from-concatenated-ints @@ -0,0 +1 @@ +../../Task/Largest-int-from-concatenated-ints/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Literals-String b/Lang/Fortran/Literals-String new file mode 120000 index 0000000000..7b0aeb09bf --- /dev/null +++ b/Lang/Fortran/Literals-String @@ -0,0 +1 @@ +../../Task/Literals-String/Fortran \ No newline at end of file diff --git a/Lang/Fortran/MD5 b/Lang/Fortran/MD5 new file mode 120000 index 0000000000..0e3565b816 --- /dev/null +++ b/Lang/Fortran/MD5 @@ -0,0 +1 @@ +../../Task/MD5/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Memory-layout-of-a-data-structure b/Lang/Fortran/Memory-layout-of-a-data-structure new file mode 120000 index 0000000000..98524b62f9 --- /dev/null +++ b/Lang/Fortran/Memory-layout-of-a-data-structure @@ -0,0 +1 @@ +../../Task/Memory-layout-of-a-data-structure/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Multifactorial b/Lang/Fortran/Multifactorial new file mode 120000 index 0000000000..ecb4c1cb64 --- /dev/null +++ b/Lang/Fortran/Multifactorial @@ -0,0 +1 @@ +../../Task/Multifactorial/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Numeric-error-propagation b/Lang/Fortran/Numeric-error-propagation new file mode 120000 index 0000000000..620aee7a27 --- /dev/null +++ b/Lang/Fortran/Numeric-error-propagation @@ -0,0 +1 @@ +../../Task/Numeric-error-propagation/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Odd-word-problem b/Lang/Fortran/Odd-word-problem new file mode 120000 index 0000000000..a4568c1c36 --- /dev/null +++ b/Lang/Fortran/Odd-word-problem @@ -0,0 +1 @@ +../../Task/Odd-word-problem/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Parsing-RPN-calculator-algorithm b/Lang/Fortran/Parsing-RPN-calculator-algorithm new file mode 120000 index 0000000000..7d70404103 --- /dev/null +++ b/Lang/Fortran/Parsing-RPN-calculator-algorithm @@ -0,0 +1 @@ +../../Task/Parsing-RPN-calculator-algorithm/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Parsing-Shunting-yard-algorithm b/Lang/Fortran/Parsing-Shunting-yard-algorithm new file mode 120000 index 0000000000..d3938ad519 --- /dev/null +++ b/Lang/Fortran/Parsing-Shunting-yard-algorithm @@ -0,0 +1 @@ +../../Task/Parsing-Shunting-yard-algorithm/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Phrase-reversals b/Lang/Fortran/Phrase-reversals new file mode 120000 index 0000000000..d4faa62c3e --- /dev/null +++ b/Lang/Fortran/Phrase-reversals @@ -0,0 +1 @@ +../../Task/Phrase-reversals/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Pi b/Lang/Fortran/Pi new file mode 120000 index 0000000000..a12791827a --- /dev/null +++ b/Lang/Fortran/Pi @@ -0,0 +1 @@ +../../Task/Pi/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Quickselect-algorithm b/Lang/Fortran/Quickselect-algorithm new file mode 120000 index 0000000000..622b84bd42 --- /dev/null +++ b/Lang/Fortran/Quickselect-algorithm @@ -0,0 +1 @@ +../../Task/Quickselect-algorithm/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Range-expansion b/Lang/Fortran/Range-expansion new file mode 120000 index 0000000000..a74f9d7ee7 --- /dev/null +++ b/Lang/Fortran/Range-expansion @@ -0,0 +1 @@ +../../Task/Range-expansion/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Range-extraction b/Lang/Fortran/Range-extraction new file mode 120000 index 0000000000..92570c94e7 --- /dev/null +++ b/Lang/Fortran/Range-extraction @@ -0,0 +1 @@ +../../Task/Range-extraction/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Read-a-file-line-by-line b/Lang/Fortran/Read-a-file-line-by-line new file mode 120000 index 0000000000..d9c3939e57 --- /dev/null +++ b/Lang/Fortran/Read-a-file-line-by-line @@ -0,0 +1 @@ +../../Task/Read-a-file-line-by-line/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Read-a-specific-line-from-a-file b/Lang/Fortran/Read-a-specific-line-from-a-file new file mode 120000 index 0000000000..2b94345edf --- /dev/null +++ b/Lang/Fortran/Read-a-specific-line-from-a-file @@ -0,0 +1 @@ +../../Task/Read-a-specific-line-from-a-file/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Read-entire-file b/Lang/Fortran/Read-entire-file new file mode 120000 index 0000000000..6043e67796 --- /dev/null +++ b/Lang/Fortran/Read-entire-file @@ -0,0 +1 @@ +../../Task/Read-entire-file/Fortran \ No newline at end of file diff --git a/Lang/Fortran/SHA-1 b/Lang/Fortran/SHA-1 new file mode 120000 index 0000000000..ae9931027a --- /dev/null +++ b/Lang/Fortran/SHA-1 @@ -0,0 +1 @@ +../../Task/SHA-1/Fortran \ No newline at end of file diff --git a/Lang/Fortran/SHA-256 b/Lang/Fortran/SHA-256 new file mode 120000 index 0000000000..a7770c5275 --- /dev/null +++ b/Lang/Fortran/SHA-256 @@ -0,0 +1 @@ +../../Task/SHA-256/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Secure-temporary-file b/Lang/Fortran/Secure-temporary-file new file mode 120000 index 0000000000..829930cd62 --- /dev/null +++ b/Lang/Fortran/Secure-temporary-file @@ -0,0 +1 @@ +../../Task/Secure-temporary-file/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Send-email b/Lang/Fortran/Send-email new file mode 120000 index 0000000000..9dc899cc43 --- /dev/null +++ b/Lang/Fortran/Send-email @@ -0,0 +1 @@ +../../Task/Send-email/Fortran \ No newline at end of file diff --git a/Lang/Fortran/String-prepend b/Lang/Fortran/String-prepend new file mode 120000 index 0000000000..9ce3ce7f0e --- /dev/null +++ b/Lang/Fortran/String-prepend @@ -0,0 +1 @@ +../../Task/String-prepend/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Strip-block-comments b/Lang/Fortran/Strip-block-comments new file mode 120000 index 0000000000..bc88ba2e8a --- /dev/null +++ b/Lang/Fortran/Strip-block-comments @@ -0,0 +1 @@ +../../Task/Strip-block-comments/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Terminal-control-Coloured-text b/Lang/Fortran/Terminal-control-Coloured-text new file mode 120000 index 0000000000..b20a9de7e1 --- /dev/null +++ b/Lang/Fortran/Terminal-control-Coloured-text @@ -0,0 +1 @@ +../../Task/Terminal-control-Coloured-text/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Terminal-control-Cursor-positioning b/Lang/Fortran/Terminal-control-Cursor-positioning new file mode 120000 index 0000000000..4f80f25525 --- /dev/null +++ b/Lang/Fortran/Terminal-control-Cursor-positioning @@ -0,0 +1 @@ +../../Task/Terminal-control-Cursor-positioning/Fortran \ No newline at end of file diff --git a/Lang/Fortran/The-Twelve-Days-of-Christmas b/Lang/Fortran/The-Twelve-Days-of-Christmas new file mode 120000 index 0000000000..0687cc91e2 --- /dev/null +++ b/Lang/Fortran/The-Twelve-Days-of-Christmas @@ -0,0 +1 @@ +../../Task/The-Twelve-Days-of-Christmas/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Tree-traversal b/Lang/Fortran/Tree-traversal new file mode 120000 index 0000000000..35a6776330 --- /dev/null +++ b/Lang/Fortran/Tree-traversal @@ -0,0 +1 @@ +../../Task/Tree-traversal/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Truncate-a-file b/Lang/Fortran/Truncate-a-file new file mode 120000 index 0000000000..76c0aa497d --- /dev/null +++ b/Lang/Fortran/Truncate-a-file @@ -0,0 +1 @@ +../../Task/Truncate-a-file/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Universal-Turing-machine b/Lang/Fortran/Universal-Turing-machine new file mode 120000 index 0000000000..178c36c503 --- /dev/null +++ b/Lang/Fortran/Universal-Turing-machine @@ -0,0 +1 @@ +../../Task/Universal-Turing-machine/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Unix-ls b/Lang/Fortran/Unix-ls new file mode 120000 index 0000000000..94755d6e3f --- /dev/null +++ b/Lang/Fortran/Unix-ls @@ -0,0 +1 @@ +../../Task/Unix-ls/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Update-a-configuration-file b/Lang/Fortran/Update-a-configuration-file new file mode 120000 index 0000000000..74717c0a29 --- /dev/null +++ b/Lang/Fortran/Update-a-configuration-file @@ -0,0 +1 @@ +../../Task/Update-a-configuration-file/Fortran \ No newline at end of file diff --git a/Lang/Fortran/Word-wrap b/Lang/Fortran/Word-wrap new file mode 120000 index 0000000000..e81ff30d6e --- /dev/null +++ b/Lang/Fortran/Word-wrap @@ -0,0 +1 @@ +../../Task/Word-wrap/Fortran \ No newline at end of file diff --git a/Lang/Fortran/XML-Input b/Lang/Fortran/XML-Input new file mode 120000 index 0000000000..f081e9e035 --- /dev/null +++ b/Lang/Fortran/XML-Input @@ -0,0 +1 @@ +../../Task/XML-Input/Fortran \ No newline at end of file diff --git a/Lang/Frege/Fractal-tree b/Lang/Frege/Fractal-tree new file mode 120000 index 0000000000..c3d7282016 --- /dev/null +++ b/Lang/Frege/Fractal-tree @@ -0,0 +1 @@ +../../Task/Fractal-tree/Frege \ No newline at end of file diff --git a/Lang/Frege/Greatest-common-divisor b/Lang/Frege/Greatest-common-divisor new file mode 120000 index 0000000000..890ee07a89 --- /dev/null +++ b/Lang/Frege/Greatest-common-divisor @@ -0,0 +1 @@ +../../Task/Greatest-common-divisor/Frege \ No newline at end of file diff --git a/Lang/Frege/Hello-world-Graphical b/Lang/Frege/Hello-world-Graphical new file mode 120000 index 0000000000..f304e9061d --- /dev/null +++ b/Lang/Frege/Hello-world-Graphical @@ -0,0 +1 @@ +../../Task/Hello-world-Graphical/Frege \ No newline at end of file diff --git a/Lang/Frink/00DESCRIPTION b/Lang/Frink/00DESCRIPTION index 9031493c2c..4d100df873 100644 --- a/Lang/Frink/00DESCRIPTION +++ b/Lang/Frink/00DESCRIPTION @@ -11,10 +11,10 @@ Frink runs on the JVM and on Android, and is available in the Android Market. ==See Also== -*[http://futureboy.us/frinkdocs/ Frink] homepage, including full documentation. -*[http://futureboy.us/frink/ Frink web-based interface] -*[http://futureboy.us/frinkdocs/faq.html Frequently Asked Questions] -*[http://futureboy.us/frinkdocs/fspdocs.html Frink Server Pages Documentation] -*[http://futureboy.us/fsp/samples.fsp Sample Programs] -*[http://futureboy.us/frinkdocs/LL4.html Presentation at Lightweight Languages 4, MIT] +*[https://frinklang.org/ Frink] homepage, including full documentation. +*[https://frinklang.org/frink/ Frink web-based interface] +*[https://frinklang.org/faq.html Frequently Asked Questions] +*[https://frinklang.org/fspdocs.html Frink Server Pages Documentation] +*[https://frinklang.org/fsp/samples.fsp Sample Programs] +*[https://frinklang.org/LL4.html Presentation at Lightweight Languages 4, MIT] *[http://confreaks.net/videos/120-elcamp2010-frink Presentation at Emerging Languages Camp, 2010] \ No newline at end of file diff --git a/Lang/Frink/Arithmetic-Rational b/Lang/Frink/Arithmetic-Rational new file mode 120000 index 0000000000..6e09d160f5 --- /dev/null +++ b/Lang/Frink/Arithmetic-Rational @@ -0,0 +1 @@ +../../Task/Arithmetic-Rational/Frink \ No newline at end of file diff --git a/Lang/Frink/Execute-a-system-command b/Lang/Frink/Execute-a-system-command new file mode 120000 index 0000000000..2a7c1e9c66 --- /dev/null +++ b/Lang/Frink/Execute-a-system-command @@ -0,0 +1 @@ +../../Task/Execute-a-system-command/Frink \ No newline at end of file diff --git a/Lang/Frink/Hailstone-sequence b/Lang/Frink/Hailstone-sequence new file mode 120000 index 0000000000..0301ffc11c --- /dev/null +++ b/Lang/Frink/Hailstone-sequence @@ -0,0 +1 @@ +../../Task/Hailstone-sequence/Frink \ No newline at end of file diff --git a/Lang/Frink/Loops-Do-while b/Lang/Frink/Loops-Do-while new file mode 120000 index 0000000000..39a6eacc16 --- /dev/null +++ b/Lang/Frink/Loops-Do-while @@ -0,0 +1 @@ +../../Task/Loops-Do-while/Frink \ No newline at end of file diff --git a/Lang/Frink/Percentage-difference-between-images b/Lang/Frink/Percentage-difference-between-images new file mode 120000 index 0000000000..10ad395dd1 --- /dev/null +++ b/Lang/Frink/Percentage-difference-between-images @@ -0,0 +1 @@ +../../Task/Percentage-difference-between-images/Frink \ No newline at end of file diff --git a/Lang/GAP/Bernoulli-numbers b/Lang/GAP/Bernoulli-numbers new file mode 120000 index 0000000000..af991174cf --- /dev/null +++ b/Lang/GAP/Bernoulli-numbers @@ -0,0 +1 @@ +../../Task/Bernoulli-numbers/GAP \ No newline at end of file diff --git a/Lang/GAP/Check-Machin-like-formulas b/Lang/GAP/Check-Machin-like-formulas new file mode 120000 index 0000000000..a79aca68c5 --- /dev/null +++ b/Lang/GAP/Check-Machin-like-formulas @@ -0,0 +1 @@ +../../Task/Check-Machin-like-formulas/GAP \ No newline at end of file diff --git a/Lang/GML/Wireworld b/Lang/GML/Wireworld new file mode 120000 index 0000000000..c1cbf452c3 --- /dev/null +++ b/Lang/GML/Wireworld @@ -0,0 +1 @@ +../../Task/Wireworld/GML \ No newline at end of file diff --git a/Lang/Gambas/00DESCRIPTION b/Lang/Gambas/00DESCRIPTION index 3bfe141f2a..1801824bc0 100644 --- a/Lang/Gambas/00DESCRIPTION +++ b/Lang/Gambas/00DESCRIPTION @@ -11,5 +11,4 @@ Gambas is a free development environment based on a [[Basic]] interpreter with object extensions, a bit like Visual Basic™ (but it is NOT a clone !). -With Gambas, you can quickly design your program [[GUI]] with QT or GTK+, access [[MySQL]], [[PostgreSQL]], Firebird, ODBC and [[SQLite]] databases, pilot KDE applications with DCOP, translate your program into any language, create network applications easily, make 3D [[OpenGL]] applications, make CGI web applications, and so on... -[http://www.papdan.com/seo-services-search-engine-optimisation.php Melbourne SEO Services] | [http://www.papdan.com/ Melbourne Web Developer] | [http://www.usapropertyinvestors.com.au USA Property Investment] | [http://www.phillro.com.au/p/industrial-2/airless-spray-packages-2/ Airless Spray] \ No newline at end of file +With Gambas, you can quickly design your program [[GUI]] with QT or GTK+, access [[MySQL]], [[PostgreSQL]], Firebird, ODBC and [[SQLite]] databases, pilot KDE applications with DCOP, translate your program into any language, create network applications easily, make 3D [[OpenGL]] applications, make CGI web applications, and so on... \ No newline at end of file diff --git a/Lang/Glee/Repeat-a-string b/Lang/Glee/Repeat-a-string new file mode 120000 index 0000000000..e92b219395 --- /dev/null +++ b/Lang/Glee/Repeat-a-string @@ -0,0 +1 @@ +../../Task/Repeat-a-string/Glee \ No newline at end of file diff --git a/Lang/Go/00DESCRIPTION b/Lang/Go/00DESCRIPTION index 026db41f29..5d3553ff07 100644 --- a/Lang/Go/00DESCRIPTION +++ b/Lang/Go/00DESCRIPTION @@ -19,10 +19,8 @@ Go is distributed under a [http://golang.org/LICENSE BSD-style license]. Not to be confused with [[:Category:Go!|Go!]] ==Links== -*[[wp:Go (programming language)|Go in Wikipedia]] +* [[wp:Go (programming language)|Go in Wikipedia]] * [http://tour.golang.org/ Go Tour and Tutorial] -* [http://golang.org/doc/devel/release.html Release History] -** Release Notes: [http://golang.org/doc/go1.4 1.4], [http://golang.org/doc/go1.3 1.3], [http://golang.org/doc/go1.2 1.2], [http://golang.org/doc/go1.1 1.1], [http://golang.org/doc/go1 1.0] * [http://golang.org/ref/spec Go language specification] * [http://golang.org/pkg/ Go standard library documentation] -* [http://go-lang.cat-v.org/ Go Language Resources] \ No newline at end of file +* [https://github.com/golang/go/wiki/ Community maintained Go wiki] \ No newline at end of file diff --git a/Lang/Go/Animation b/Lang/Go/Animation new file mode 120000 index 0000000000..80017c7cd2 --- /dev/null +++ b/Lang/Go/Animation @@ -0,0 +1 @@ +../../Task/Animation/Go \ No newline at end of file diff --git a/Lang/Go/Compare-sorting-algorithms-performance b/Lang/Go/Compare-sorting-algorithms-performance new file mode 120000 index 0000000000..f5c0d0191f --- /dev/null +++ b/Lang/Go/Compare-sorting-algorithms-performance @@ -0,0 +1 @@ +../../Task/Compare-sorting-algorithms-performance/Go \ No newline at end of file diff --git a/Lang/Go/Dinesmans-multiple-dwelling-problem b/Lang/Go/Dinesmans-multiple-dwelling-problem new file mode 120000 index 0000000000..1a632660d5 --- /dev/null +++ b/Lang/Go/Dinesmans-multiple-dwelling-problem @@ -0,0 +1 @@ +../../Task/Dinesmans-multiple-dwelling-problem/Go \ No newline at end of file diff --git a/Lang/Go/Heronian-triangles b/Lang/Go/Heronian-triangles new file mode 120000 index 0000000000..49a357c1ee --- /dev/null +++ b/Lang/Go/Heronian-triangles @@ -0,0 +1 @@ +../../Task/Heronian-triangles/Go \ No newline at end of file diff --git a/Lang/Go/Percolation-Mean-cluster-density b/Lang/Go/Percolation-Mean-cluster-density new file mode 120000 index 0000000000..53629df1d8 --- /dev/null +++ b/Lang/Go/Percolation-Mean-cluster-density @@ -0,0 +1 @@ +../../Task/Percolation-Mean-cluster-density/Go \ No newline at end of file diff --git a/Lang/Go/Percolation-Mean-run-density b/Lang/Go/Percolation-Mean-run-density new file mode 120000 index 0000000000..25b05d3662 --- /dev/null +++ b/Lang/Go/Percolation-Mean-run-density @@ -0,0 +1 @@ +../../Task/Percolation-Mean-run-density/Go \ No newline at end of file diff --git a/Lang/Go/Speech-synthesis b/Lang/Go/Speech-synthesis new file mode 120000 index 0000000000..0e79792a10 --- /dev/null +++ b/Lang/Go/Speech-synthesis @@ -0,0 +1 @@ +../../Task/Speech-synthesis/Go \ No newline at end of file diff --git a/Lang/Go/Topic-variable b/Lang/Go/Topic-variable new file mode 120000 index 0000000000..31ae4e7e8d --- /dev/null +++ b/Lang/Go/Topic-variable @@ -0,0 +1 @@ +../../Task/Topic-variable/Go \ No newline at end of file diff --git a/Lang/Go/Ulam-spiral--for-primes- b/Lang/Go/Ulam-spiral--for-primes- new file mode 120000 index 0000000000..67d395ba90 --- /dev/null +++ b/Lang/Go/Ulam-spiral--for-primes- @@ -0,0 +1 @@ +../../Task/Ulam-spiral--for-primes-/Go \ No newline at end of file diff --git a/Lang/Gosu/00DESCRIPTION b/Lang/Gosu/00DESCRIPTION index fd83f91c6d..95b39e193f 100644 --- a/Lang/Gosu/00DESCRIPTION +++ b/Lang/Gosu/00DESCRIPTION @@ -5,5 +5,5 @@ {{Language programming paradigm|object-oriented}} '''Gosu''' is [[runs on vm::JVM]]-based an imperative statically-typed object-oriented programming language that is designed to be expressive, easy-to-read, and reasonably fast. It started in 2002 in company called [http://guidewire.com/ Guidewire] as a internal language and was released in 2010 to the opensource world. -* [http://lazygosu.org/ LazyGosu.org - nice community tutorial] +* [http://lazygosu.github.io/ LazyGosu - nice community tutorial] * [http://developers.slashdot.org/story/10/11/09/0510258/Gosu-Programming-Language-Released-To-Public Slashdot finds Gosu] \ No newline at end of file diff --git a/Lang/Groovy/Abundant,-deficient-and-perfect-number-classifications b/Lang/Groovy/Abundant,-deficient-and-perfect-number-classifications new file mode 120000 index 0000000000..cfbd88a9a6 --- /dev/null +++ b/Lang/Groovy/Abundant,-deficient-and-perfect-number-classifications @@ -0,0 +1 @@ +../../Task/Abundant,-deficient-and-perfect-number-classifications/Groovy \ No newline at end of file diff --git a/Lang/Groovy/Catamorphism b/Lang/Groovy/Catamorphism new file mode 120000 index 0000000000..b917e155b3 --- /dev/null +++ b/Lang/Groovy/Catamorphism @@ -0,0 +1 @@ +../../Task/Catamorphism/Groovy \ No newline at end of file diff --git a/Lang/Groovy/Fibonacci-n-step-number-sequences b/Lang/Groovy/Fibonacci-n-step-number-sequences new file mode 120000 index 0000000000..a31b034106 --- /dev/null +++ b/Lang/Groovy/Fibonacci-n-step-number-sequences @@ -0,0 +1 @@ +../../Task/Fibonacci-n-step-number-sequences/Groovy \ No newline at end of file diff --git a/Lang/Groovy/First-class-functions-Use-numbers-analogously b/Lang/Groovy/First-class-functions-Use-numbers-analogously new file mode 120000 index 0000000000..66bb4387c3 --- /dev/null +++ b/Lang/Groovy/First-class-functions-Use-numbers-analogously @@ -0,0 +1 @@ +../../Task/First-class-functions-Use-numbers-analogously/Groovy \ No newline at end of file diff --git a/Lang/Groovy/Guess-the-number-With-feedback b/Lang/Groovy/Guess-the-number-With-feedback new file mode 120000 index 0000000000..4eea17ca8e --- /dev/null +++ b/Lang/Groovy/Guess-the-number-With-feedback @@ -0,0 +1 @@ +../../Task/Guess-the-number-With-feedback/Groovy \ No newline at end of file diff --git a/Lang/Groovy/Hello-world-Newbie b/Lang/Groovy/Hello-world-Newbie new file mode 120000 index 0000000000..3e74eb958f --- /dev/null +++ b/Lang/Groovy/Hello-world-Newbie @@ -0,0 +1 @@ +../../Task/Hello-world-Newbie/Groovy \ No newline at end of file diff --git a/Lang/Groovy/Window-creation-X11 b/Lang/Groovy/Window-creation-X11 new file mode 120000 index 0000000000..45cc71e8f7 --- /dev/null +++ b/Lang/Groovy/Window-creation-X11 @@ -0,0 +1 @@ +../../Task/Window-creation-X11/Groovy \ No newline at end of file diff --git a/Lang/Haskell/Casting-out-nines b/Lang/Haskell/Casting-out-nines new file mode 120000 index 0000000000..66bf458465 --- /dev/null +++ b/Lang/Haskell/Casting-out-nines @@ -0,0 +1 @@ +../../Task/Casting-out-nines/Haskell \ No newline at end of file diff --git a/Lang/Haskell/Colour-bars-Display b/Lang/Haskell/Colour-bars-Display new file mode 120000 index 0000000000..536edf20c7 --- /dev/null +++ b/Lang/Haskell/Colour-bars-Display @@ -0,0 +1 @@ +../../Task/Colour-bars-Display/Haskell \ No newline at end of file diff --git a/Lang/Haskell/Conjugate-transpose b/Lang/Haskell/Conjugate-transpose new file mode 120000 index 0000000000..105c118f64 --- /dev/null +++ b/Lang/Haskell/Conjugate-transpose @@ -0,0 +1 @@ +../../Task/Conjugate-transpose/Haskell \ No newline at end of file diff --git a/Lang/Haskell/Find-the-last-Sunday-of-each-month b/Lang/Haskell/Find-the-last-Sunday-of-each-month new file mode 120000 index 0000000000..ba8f46736e --- /dev/null +++ b/Lang/Haskell/Find-the-last-Sunday-of-each-month @@ -0,0 +1 @@ +../../Task/Find-the-last-Sunday-of-each-month/Haskell \ No newline at end of file diff --git a/Lang/Haskell/First-class-environments b/Lang/Haskell/First-class-environments new file mode 120000 index 0000000000..6742816a18 --- /dev/null +++ b/Lang/Haskell/First-class-environments @@ -0,0 +1 @@ +../../Task/First-class-environments/Haskell \ No newline at end of file diff --git a/Lang/Haskell/Galton-box-animation b/Lang/Haskell/Galton-box-animation new file mode 120000 index 0000000000..12810e6a48 --- /dev/null +++ b/Lang/Haskell/Galton-box-animation @@ -0,0 +1 @@ +../../Task/Galton-box-animation/Haskell \ No newline at end of file diff --git a/Lang/Haskell/Gaussian-elimination b/Lang/Haskell/Gaussian-elimination new file mode 120000 index 0000000000..bb0e84535b --- /dev/null +++ b/Lang/Haskell/Gaussian-elimination @@ -0,0 +1 @@ +../../Task/Gaussian-elimination/Haskell \ No newline at end of file diff --git a/Lang/Haskell/Jump-anywhere b/Lang/Haskell/Jump-anywhere new file mode 120000 index 0000000000..b9f08fc0e3 --- /dev/null +++ b/Lang/Haskell/Jump-anywhere @@ -0,0 +1 @@ +../../Task/Jump-anywhere/Haskell \ No newline at end of file diff --git a/Lang/Haskell/K-means++-clustering b/Lang/Haskell/K-means++-clustering new file mode 120000 index 0000000000..8dd6f22b26 --- /dev/null +++ b/Lang/Haskell/K-means++-clustering @@ -0,0 +1 @@ +../../Task/K-means++-clustering/Haskell \ No newline at end of file diff --git a/Lang/Haskell/Matrix-arithmetic b/Lang/Haskell/Matrix-arithmetic new file mode 120000 index 0000000000..b1d9124e8a --- /dev/null +++ b/Lang/Haskell/Matrix-arithmetic @@ -0,0 +1 @@ +../../Task/Matrix-arithmetic/Haskell \ No newline at end of file diff --git a/Lang/Haskell/Numerical-integration-Gauss-Legendre-Quadrature b/Lang/Haskell/Numerical-integration-Gauss-Legendre-Quadrature new file mode 120000 index 0000000000..8ec0dc6e70 --- /dev/null +++ b/Lang/Haskell/Numerical-integration-Gauss-Legendre-Quadrature @@ -0,0 +1 @@ +../../Task/Numerical-integration-Gauss-Legendre-Quadrature/Haskell \ No newline at end of file diff --git a/Lang/Haskell/Order-disjoint-list-items b/Lang/Haskell/Order-disjoint-list-items new file mode 120000 index 0000000000..13cb18429d --- /dev/null +++ b/Lang/Haskell/Order-disjoint-list-items @@ -0,0 +1 @@ +../../Task/Order-disjoint-list-items/Haskell \ No newline at end of file diff --git a/Lang/Haskell/Resistor-mesh b/Lang/Haskell/Resistor-mesh new file mode 120000 index 0000000000..53f4ff85de --- /dev/null +++ b/Lang/Haskell/Resistor-mesh @@ -0,0 +1 @@ +../../Task/Resistor-mesh/Haskell \ No newline at end of file diff --git a/Lang/Haskell/Statistics-Basic b/Lang/Haskell/Statistics-Basic new file mode 120000 index 0000000000..5792077697 --- /dev/null +++ b/Lang/Haskell/Statistics-Basic @@ -0,0 +1 @@ +../../Task/Statistics-Basic/Haskell \ No newline at end of file diff --git a/Lang/Haskell/Update-a-configuration-file b/Lang/Haskell/Update-a-configuration-file new file mode 120000 index 0000000000..51b08403bf --- /dev/null +++ b/Lang/Haskell/Update-a-configuration-file @@ -0,0 +1 @@ +../../Task/Update-a-configuration-file/Haskell \ No newline at end of file diff --git a/Lang/Haskell/Variable-size-Set b/Lang/Haskell/Variable-size-Set new file mode 120000 index 0000000000..c292c767c1 --- /dev/null +++ b/Lang/Haskell/Variable-size-Set @@ -0,0 +1 @@ +../../Task/Variable-size-Set/Haskell \ No newline at end of file diff --git a/Lang/Haxe/Matrix-transposition b/Lang/Haxe/Matrix-transposition new file mode 120000 index 0000000000..6534fbfeb5 --- /dev/null +++ b/Lang/Haxe/Matrix-transposition @@ -0,0 +1 @@ +../../Task/Matrix-transposition/Haxe \ No newline at end of file diff --git a/Lang/Icon/Animation b/Lang/Icon/Animation new file mode 120000 index 0000000000..b27c2b8b64 --- /dev/null +++ b/Lang/Icon/Animation @@ -0,0 +1 @@ +../../Task/Animation/Icon \ No newline at end of file diff --git a/Lang/Icon/Draw-a-clock b/Lang/Icon/Draw-a-clock new file mode 120000 index 0000000000..491889e47a --- /dev/null +++ b/Lang/Icon/Draw-a-clock @@ -0,0 +1 @@ +../../Task/Draw-a-clock/Icon \ No newline at end of file diff --git a/Lang/Icon/Terminal-control-Cursor-positioning b/Lang/Icon/Terminal-control-Cursor-positioning new file mode 120000 index 0000000000..ed3757bd0d --- /dev/null +++ b/Lang/Icon/Terminal-control-Cursor-positioning @@ -0,0 +1 @@ +../../Task/Terminal-control-Cursor-positioning/Icon \ No newline at end of file diff --git a/Lang/Io/Accumulator-factory b/Lang/Io/Accumulator-factory new file mode 120000 index 0000000000..807a49c1f1 --- /dev/null +++ b/Lang/Io/Accumulator-factory @@ -0,0 +1 @@ +../../Task/Accumulator-factory/Io \ No newline at end of file diff --git a/Lang/Io/Anonymous-recursion b/Lang/Io/Anonymous-recursion new file mode 120000 index 0000000000..10e6752b72 --- /dev/null +++ b/Lang/Io/Anonymous-recursion @@ -0,0 +1 @@ +../../Task/Anonymous-recursion/Io \ No newline at end of file diff --git a/Lang/Io/Associative-array-Iteration b/Lang/Io/Associative-array-Iteration new file mode 120000 index 0000000000..762ce217e4 --- /dev/null +++ b/Lang/Io/Associative-array-Iteration @@ -0,0 +1 @@ +../../Task/Associative-array-Iteration/Io \ No newline at end of file diff --git a/Lang/Io/Character-codes b/Lang/Io/Character-codes new file mode 120000 index 0000000000..b7b8f875f0 --- /dev/null +++ b/Lang/Io/Character-codes @@ -0,0 +1 @@ +../../Task/Character-codes/Io \ No newline at end of file diff --git a/Lang/Io/Closures-Value-capture b/Lang/Io/Closures-Value-capture new file mode 120000 index 0000000000..3525ee93ce --- /dev/null +++ b/Lang/Io/Closures-Value-capture @@ -0,0 +1 @@ +../../Task/Closures-Value-capture/Io \ No newline at end of file diff --git a/Lang/Io/Delegates b/Lang/Io/Delegates new file mode 120000 index 0000000000..06f0c407b3 --- /dev/null +++ b/Lang/Io/Delegates @@ -0,0 +1 @@ +../../Task/Delegates/Io \ No newline at end of file diff --git a/Lang/Io/Exceptions-Catch-an-exception-thrown-in-a-nested-call b/Lang/Io/Exceptions-Catch-an-exception-thrown-in-a-nested-call new file mode 120000 index 0000000000..11523662cc --- /dev/null +++ b/Lang/Io/Exceptions-Catch-an-exception-thrown-in-a-nested-call @@ -0,0 +1 @@ +../../Task/Exceptions-Catch-an-exception-thrown-in-a-nested-call/Io \ No newline at end of file diff --git a/Lang/Io/Executable-library b/Lang/Io/Executable-library new file mode 120000 index 0000000000..5d57c687a4 --- /dev/null +++ b/Lang/Io/Executable-library @@ -0,0 +1 @@ +../../Task/Executable-library/Io \ No newline at end of file diff --git a/Lang/Io/Increment-a-numerical-string b/Lang/Io/Increment-a-numerical-string new file mode 120000 index 0000000000..7aea379565 --- /dev/null +++ b/Lang/Io/Increment-a-numerical-string @@ -0,0 +1 @@ +../../Task/Increment-a-numerical-string/Io \ No newline at end of file diff --git a/Lang/Io/Inheritance-Multiple b/Lang/Io/Inheritance-Multiple new file mode 120000 index 0000000000..05b671dadb --- /dev/null +++ b/Lang/Io/Inheritance-Multiple @@ -0,0 +1 @@ +../../Task/Inheritance-Multiple/Io \ No newline at end of file diff --git a/Lang/Io/Levenshtein-distance b/Lang/Io/Levenshtein-distance new file mode 120000 index 0000000000..3846060275 --- /dev/null +++ b/Lang/Io/Levenshtein-distance @@ -0,0 +1 @@ +../../Task/Levenshtein-distance/Io \ No newline at end of file diff --git a/Lang/Io/Loops-Break b/Lang/Io/Loops-Break new file mode 120000 index 0000000000..deff27a73c --- /dev/null +++ b/Lang/Io/Loops-Break @@ -0,0 +1 @@ +../../Task/Loops-Break/Io \ No newline at end of file diff --git a/Lang/Io/Loops-Continue b/Lang/Io/Loops-Continue new file mode 120000 index 0000000000..ce6b4223ef --- /dev/null +++ b/Lang/Io/Loops-Continue @@ -0,0 +1 @@ +../../Task/Loops-Continue/Io \ No newline at end of file diff --git a/Lang/Io/Loops-Downward-for b/Lang/Io/Loops-Downward-for new file mode 120000 index 0000000000..0d0ef6b135 --- /dev/null +++ b/Lang/Io/Loops-Downward-for @@ -0,0 +1 @@ +../../Task/Loops-Downward-for/Io \ No newline at end of file diff --git a/Lang/Io/Loops-For-with-a-specified-step b/Lang/Io/Loops-For-with-a-specified-step new file mode 120000 index 0000000000..211e16693a --- /dev/null +++ b/Lang/Io/Loops-For-with-a-specified-step @@ -0,0 +1 @@ +../../Task/Loops-For-with-a-specified-step/Io \ No newline at end of file diff --git a/Lang/Io/Ordered-words b/Lang/Io/Ordered-words new file mode 120000 index 0000000000..c6867509a0 --- /dev/null +++ b/Lang/Io/Ordered-words @@ -0,0 +1 @@ +../../Task/Ordered-words/Io \ No newline at end of file diff --git a/Lang/Io/Pangram-checker b/Lang/Io/Pangram-checker new file mode 120000 index 0000000000..447c4ea7bf --- /dev/null +++ b/Lang/Io/Pangram-checker @@ -0,0 +1 @@ +../../Task/Pangram-checker/Io \ No newline at end of file diff --git a/Lang/Io/Respond-to-an-unknown-method-call b/Lang/Io/Respond-to-an-unknown-method-call new file mode 120000 index 0000000000..60e0b3b496 --- /dev/null +++ b/Lang/Io/Respond-to-an-unknown-method-call @@ -0,0 +1 @@ +../../Task/Respond-to-an-unknown-method-call/Io \ No newline at end of file diff --git a/Lang/Io/Search-a-list b/Lang/Io/Search-a-list new file mode 120000 index 0000000000..8f5d47e37b --- /dev/null +++ b/Lang/Io/Search-a-list @@ -0,0 +1 @@ +../../Task/Search-a-list/Io \ No newline at end of file diff --git a/Lang/Io/Send-an-unknown-method-call b/Lang/Io/Send-an-unknown-method-call new file mode 120000 index 0000000000..873fefd943 --- /dev/null +++ b/Lang/Io/Send-an-unknown-method-call @@ -0,0 +1 @@ +../../Task/Send-an-unknown-method-call/Io \ No newline at end of file diff --git a/Lang/Io/Short-circuit-evaluation b/Lang/Io/Short-circuit-evaluation new file mode 120000 index 0000000000..fcb4afc2d1 --- /dev/null +++ b/Lang/Io/Short-circuit-evaluation @@ -0,0 +1 @@ +../../Task/Short-circuit-evaluation/Io \ No newline at end of file diff --git a/Lang/Io/Sierpinski-carpet b/Lang/Io/Sierpinski-carpet new file mode 120000 index 0000000000..56d1141d4f --- /dev/null +++ b/Lang/Io/Sierpinski-carpet @@ -0,0 +1 @@ +../../Task/Sierpinski-carpet/Io \ No newline at end of file diff --git a/Lang/Io/Sort-disjoint-sublist b/Lang/Io/Sort-disjoint-sublist new file mode 120000 index 0000000000..c1109b03fc --- /dev/null +++ b/Lang/Io/Sort-disjoint-sublist @@ -0,0 +1 @@ +../../Task/Sort-disjoint-sublist/Io \ No newline at end of file diff --git a/Lang/Io/Textonyms b/Lang/Io/Textonyms new file mode 120000 index 0000000000..24240b93cb --- /dev/null +++ b/Lang/Io/Textonyms @@ -0,0 +1 @@ +../../Task/Textonyms/Io \ No newline at end of file diff --git a/Lang/J/00DESCRIPTION b/Lang/J/00DESCRIPTION index a4c5cf1794..def3c6335b 100644 --- a/Lang/J/00DESCRIPTION +++ b/Lang/J/00DESCRIPTION @@ -75,13 +75,13 @@ Discussion of the goals of the J community on RC and general guidelines for pres == Jedi on RosettaCode == -*[[User:Roger_Hui|Roger Hui]]: [[Special:Contributions/Roger_Hui|contributions]], [[j:RogerHui|J wiki]] -*[[User:TBH|Tracy Harms]]: [[Special:Contributions/TBH|contributions]], [[j:TracyHarms|J wiki]] -*[[User:DanBron|Dan Bron]]: [[Special:Contributions/DanBron|contributions]], [[j:DanBron|J wiki]] +*[[User:Roger_Hui|Roger Hui]]: [[Special:Contributions/Roger_Hui|contributions]], [[j:User:RogerHui|J wiki]] +*[[User:TBH|Tracy Harms]]: [[Special:Contributions/TBH|contributions]], [[j:User:TracyHarms|J wiki]] +*[[User:DanBron|Dan Bron]]: [[Special:Contributions/DanBron|contributions]], [[j:User:DanBron|J wiki]] *[[User:Gaaijz|Arie Groeneveld]]: [[Special:Contributions/Gaaijz|contributions]] -*[[User:Rdm|Raul Miller]]: [[Special:Contributions/Rdm|contributions]], [[j:Raul_Miller|J wiki]] +*[[User:Rdm|Raul Miller]]: [[Special:Contributions/Rdm|contributions]], [[j:User:Raul_Miller|J wiki]] *[[User:96.57.161.34|Jose Quintana]]: [[Special:Contributions/96.57.161.34|contributions]], [[j:Stories/JoseQuintana|J wiki]] -*[[User:tikkanz|Ric Sherlock]]: [[Special:Contributions/tikkanz|contributions]], [[j:RicSherlock|J wiki]] +*[[User:tikkanz|Ric Sherlock]]: [[Special:Contributions/tikkanz|contributions]], [[j:User:RicSherlock|J wiki]] *[[User:Avmich|Avmich]]: [[Special:Contributions/Avmich|contributions]] *[[User:VZC|VZC]]: [[Special:Contributions/VZC|contributions]] *[[User:Bathala|Alex 'bathala' Rufon]]: [[Special:Contributions/Bathala|contributions]], [[j:bathala|J wiki]] diff --git a/Lang/J/Metronome b/Lang/J/Metronome new file mode 120000 index 0000000000..1dae0ebafe --- /dev/null +++ b/Lang/J/Metronome @@ -0,0 +1 @@ +../../Task/Metronome/J \ No newline at end of file diff --git a/Lang/J/SHA-256 b/Lang/J/SHA-256 new file mode 120000 index 0000000000..ad914e85e8 --- /dev/null +++ b/Lang/J/SHA-256 @@ -0,0 +1 @@ +../../Task/SHA-256/J \ No newline at end of file diff --git a/Lang/J/Scope-Function-names-and-labels b/Lang/J/Scope-Function-names-and-labels new file mode 120000 index 0000000000..83ae317a58 --- /dev/null +++ b/Lang/J/Scope-Function-names-and-labels @@ -0,0 +1 @@ +../../Task/Scope-Function-names-and-labels/J \ No newline at end of file diff --git a/Lang/Java/9-billion-names-of-God-the-integer b/Lang/Java/9-billion-names-of-God-the-integer new file mode 120000 index 0000000000..172e989f0d --- /dev/null +++ b/Lang/Java/9-billion-names-of-God-the-integer @@ -0,0 +1 @@ +../../Task/9-billion-names-of-God-the-integer/Java \ No newline at end of file diff --git a/Lang/Java/Abundant,-deficient-and-perfect-number-classifications b/Lang/Java/Abundant,-deficient-and-perfect-number-classifications new file mode 120000 index 0000000000..634879cabf --- /dev/null +++ b/Lang/Java/Abundant,-deficient-and-perfect-number-classifications @@ -0,0 +1 @@ +../../Task/Abundant,-deficient-and-perfect-number-classifications/Java \ No newline at end of file diff --git a/Lang/Java/Aliquot-sequence-classifications b/Lang/Java/Aliquot-sequence-classifications new file mode 120000 index 0000000000..ac989b28df --- /dev/null +++ b/Lang/Java/Aliquot-sequence-classifications @@ -0,0 +1 @@ +../../Task/Aliquot-sequence-classifications/Java \ No newline at end of file diff --git a/Lang/Java/Amicable-pairs b/Lang/Java/Amicable-pairs new file mode 120000 index 0000000000..aa3d62cb23 --- /dev/null +++ b/Lang/Java/Amicable-pairs @@ -0,0 +1 @@ +../../Task/Amicable-pairs/Java \ No newline at end of file diff --git a/Lang/Java/Average-loop-length b/Lang/Java/Average-loop-length new file mode 120000 index 0000000000..529e06c2f1 --- /dev/null +++ b/Lang/Java/Average-loop-length @@ -0,0 +1 @@ +../../Task/Average-loop-length/Java \ No newline at end of file diff --git a/Lang/Java/Bernoulli-numbers b/Lang/Java/Bernoulli-numbers new file mode 120000 index 0000000000..153a1f15d0 --- /dev/null +++ b/Lang/Java/Bernoulli-numbers @@ -0,0 +1 @@ +../../Task/Bernoulli-numbers/Java \ No newline at end of file diff --git a/Lang/Java/Bitmap-Histogram b/Lang/Java/Bitmap-Histogram new file mode 120000 index 0000000000..3ca904f913 --- /dev/null +++ b/Lang/Java/Bitmap-Histogram @@ -0,0 +1 @@ +../../Task/Bitmap-Histogram/Java \ No newline at end of file diff --git a/Lang/Java/Carmichael-3-strong-pseudoprimes b/Lang/Java/Carmichael-3-strong-pseudoprimes new file mode 120000 index 0000000000..1d81c7aaa9 --- /dev/null +++ b/Lang/Java/Carmichael-3-strong-pseudoprimes @@ -0,0 +1 @@ +../../Task/Carmichael-3-strong-pseudoprimes/Java \ No newline at end of file diff --git a/Lang/Java/Casting-out-nines b/Lang/Java/Casting-out-nines new file mode 120000 index 0000000000..efeb6a08e2 --- /dev/null +++ b/Lang/Java/Casting-out-nines @@ -0,0 +1 @@ +../../Task/Casting-out-nines/Java \ No newline at end of file diff --git a/Lang/Java/Catalan-numbers-Pascals-triangle b/Lang/Java/Catalan-numbers-Pascals-triangle new file mode 120000 index 0000000000..945ca0307e --- /dev/null +++ b/Lang/Java/Catalan-numbers-Pascals-triangle @@ -0,0 +1 @@ +../../Task/Catalan-numbers-Pascals-triangle/Java \ No newline at end of file diff --git a/Lang/Java/Chinese-remainder-theorem b/Lang/Java/Chinese-remainder-theorem new file mode 120000 index 0000000000..a7c57aeeaa --- /dev/null +++ b/Lang/Java/Chinese-remainder-theorem @@ -0,0 +1 @@ +../../Task/Chinese-remainder-theorem/Java \ No newline at end of file diff --git a/Lang/Java/Continued-fraction b/Lang/Java/Continued-fraction new file mode 120000 index 0000000000..8093f7578c --- /dev/null +++ b/Lang/Java/Continued-fraction @@ -0,0 +1 @@ +../../Task/Continued-fraction/Java \ No newline at end of file diff --git a/Lang/Java/Convert-decimal-number-to-rational b/Lang/Java/Convert-decimal-number-to-rational new file mode 120000 index 0000000000..3fcc28ced9 --- /dev/null +++ b/Lang/Java/Convert-decimal-number-to-rational @@ -0,0 +1 @@ +../../Task/Convert-decimal-number-to-rational/Java \ No newline at end of file diff --git a/Lang/Java/Cut-a-rectangle b/Lang/Java/Cut-a-rectangle new file mode 120000 index 0000000000..ca4a2550ed --- /dev/null +++ b/Lang/Java/Cut-a-rectangle @@ -0,0 +1 @@ +../../Task/Cut-a-rectangle/Java \ No newline at end of file diff --git a/Lang/Java/Death-Star b/Lang/Java/Death-Star new file mode 120000 index 0000000000..2b8b6ea082 --- /dev/null +++ b/Lang/Java/Death-Star @@ -0,0 +1 @@ +../../Task/Death-Star/Java \ No newline at end of file diff --git a/Lang/Java/Element-wise-operations b/Lang/Java/Element-wise-operations new file mode 120000 index 0000000000..a609a8c302 --- /dev/null +++ b/Lang/Java/Element-wise-operations @@ -0,0 +1 @@ +../../Task/Element-wise-operations/Java \ No newline at end of file diff --git a/Lang/Java/Fast-Fourier-transform b/Lang/Java/Fast-Fourier-transform new file mode 120000 index 0000000000..71b5150020 --- /dev/null +++ b/Lang/Java/Fast-Fourier-transform @@ -0,0 +1 @@ +../../Task/Fast-Fourier-transform/Java \ No newline at end of file diff --git a/Lang/Java/Fibonacci-word-fractal b/Lang/Java/Fibonacci-word-fractal new file mode 120000 index 0000000000..edcc184cb3 --- /dev/null +++ b/Lang/Java/Fibonacci-word-fractal @@ -0,0 +1 @@ +../../Task/Fibonacci-word-fractal/Java \ No newline at end of file diff --git a/Lang/Java/Flipping-bits-game b/Lang/Java/Flipping-bits-game new file mode 120000 index 0000000000..2cfe0f4ec4 --- /dev/null +++ b/Lang/Java/Flipping-bits-game @@ -0,0 +1 @@ +../../Task/Flipping-bits-game/Java \ No newline at end of file diff --git a/Lang/Java/Generator-Exponential b/Lang/Java/Generator-Exponential new file mode 120000 index 0000000000..9bbe4fbbbe --- /dev/null +++ b/Lang/Java/Generator-Exponential @@ -0,0 +1 @@ +../../Task/Generator-Exponential/Java \ No newline at end of file diff --git a/Lang/Java/Hash-join b/Lang/Java/Hash-join new file mode 120000 index 0000000000..666d84bbc3 --- /dev/null +++ b/Lang/Java/Hash-join @@ -0,0 +1 @@ +../../Task/Hash-join/Java \ No newline at end of file diff --git a/Lang/Java/Hickerson-series-of-almost-integers b/Lang/Java/Hickerson-series-of-almost-integers new file mode 120000 index 0000000000..b5a3d5010d --- /dev/null +++ b/Lang/Java/Hickerson-series-of-almost-integers @@ -0,0 +1 @@ +../../Task/Hickerson-series-of-almost-integers/Java \ No newline at end of file diff --git a/Lang/Java/Keyboard-input-Keypress-check b/Lang/Java/Keyboard-input-Keypress-check new file mode 120000 index 0000000000..b6c840ccc9 --- /dev/null +++ b/Lang/Java/Keyboard-input-Keypress-check @@ -0,0 +1 @@ +../../Task/Keyboard-input-Keypress-check/Java \ No newline at end of file diff --git a/Lang/Java/LU-decomposition b/Lang/Java/LU-decomposition new file mode 120000 index 0000000000..138b2cf68c --- /dev/null +++ b/Lang/Java/LU-decomposition @@ -0,0 +1 @@ +../../Task/LU-decomposition/Java \ No newline at end of file diff --git a/Lang/Java/Linear-congruential-generator b/Lang/Java/Linear-congruential-generator new file mode 120000 index 0000000000..d6495276d6 --- /dev/null +++ b/Lang/Java/Linear-congruential-generator @@ -0,0 +1 @@ +../../Task/Linear-congruential-generator/Java \ No newline at end of file diff --git a/Lang/Java/Matrix-arithmetic b/Lang/Java/Matrix-arithmetic new file mode 120000 index 0000000000..453a880a39 --- /dev/null +++ b/Lang/Java/Matrix-arithmetic @@ -0,0 +1 @@ +../../Task/Matrix-arithmetic/Java \ No newline at end of file diff --git a/Lang/Java/Metronome b/Lang/Java/Metronome new file mode 120000 index 0000000000..d39410b41f --- /dev/null +++ b/Lang/Java/Metronome @@ -0,0 +1 @@ +../../Task/Metronome/Java \ No newline at end of file diff --git a/Lang/Java/Morse-code b/Lang/Java/Morse-code new file mode 120000 index 0000000000..a95577c1a4 --- /dev/null +++ b/Lang/Java/Morse-code @@ -0,0 +1 @@ +../../Task/Morse-code/Java \ No newline at end of file diff --git a/Lang/Java/Numerical-integration-Gauss-Legendre-Quadrature b/Lang/Java/Numerical-integration-Gauss-Legendre-Quadrature new file mode 120000 index 0000000000..ac657cc937 --- /dev/null +++ b/Lang/Java/Numerical-integration-Gauss-Legendre-Quadrature @@ -0,0 +1 @@ +../../Task/Numerical-integration-Gauss-Legendre-Quadrature/Java \ No newline at end of file diff --git a/Lang/Java/Paraffins b/Lang/Java/Paraffins new file mode 120000 index 0000000000..873d014c09 --- /dev/null +++ b/Lang/Java/Paraffins @@ -0,0 +1 @@ +../../Task/Paraffins/Java \ No newline at end of file diff --git a/Lang/Java/Rate-counter b/Lang/Java/Rate-counter new file mode 120000 index 0000000000..99688df6c5 --- /dev/null +++ b/Lang/Java/Rate-counter @@ -0,0 +1 @@ +../../Task/Rate-counter/Java \ No newline at end of file diff --git a/Lang/Java/Ray-casting-algorithm b/Lang/Java/Ray-casting-algorithm new file mode 120000 index 0000000000..e89f41dfe4 --- /dev/null +++ b/Lang/Java/Ray-casting-algorithm @@ -0,0 +1 @@ +../../Task/Ray-casting-algorithm/Java \ No newline at end of file diff --git a/Lang/Java/Runge-Kutta-method b/Lang/Java/Runge-Kutta-method new file mode 120000 index 0000000000..63afb65a4c --- /dev/null +++ b/Lang/Java/Runge-Kutta-method @@ -0,0 +1 @@ +../../Task/Runge-Kutta-method/Java \ No newline at end of file diff --git a/Lang/Java/Sequence-of-primes-by-Trial-Division b/Lang/Java/Sequence-of-primes-by-Trial-Division new file mode 120000 index 0000000000..0b9491dfb7 --- /dev/null +++ b/Lang/Java/Sequence-of-primes-by-Trial-Division @@ -0,0 +1 @@ +../../Task/Sequence-of-primes-by-Trial-Division/Java \ No newline at end of file diff --git a/Lang/Java/Sokoban b/Lang/Java/Sokoban new file mode 120000 index 0000000000..74730d7839 --- /dev/null +++ b/Lang/Java/Sokoban @@ -0,0 +1 @@ +../../Task/Sokoban/Java \ No newline at end of file diff --git a/Lang/Java/Solve-a-Holy-Knights-tour b/Lang/Java/Solve-a-Holy-Knights-tour new file mode 120000 index 0000000000..a93e5727b2 --- /dev/null +++ b/Lang/Java/Solve-a-Holy-Knights-tour @@ -0,0 +1 @@ +../../Task/Solve-a-Holy-Knights-tour/Java \ No newline at end of file diff --git a/Lang/Java/Solve-a-Hopido-puzzle b/Lang/Java/Solve-a-Hopido-puzzle new file mode 120000 index 0000000000..2245c9e700 --- /dev/null +++ b/Lang/Java/Solve-a-Hopido-puzzle @@ -0,0 +1 @@ +../../Task/Solve-a-Hopido-puzzle/Java \ No newline at end of file diff --git a/Lang/Java/Solve-a-Numbrix-puzzle b/Lang/Java/Solve-a-Numbrix-puzzle new file mode 120000 index 0000000000..923e996531 --- /dev/null +++ b/Lang/Java/Solve-a-Numbrix-puzzle @@ -0,0 +1 @@ +../../Task/Solve-a-Numbrix-puzzle/Java \ No newline at end of file diff --git a/Lang/Java/Solve-the-no-connection-puzzle b/Lang/Java/Solve-the-no-connection-puzzle new file mode 120000 index 0000000000..fb99b65e06 --- /dev/null +++ b/Lang/Java/Solve-the-no-connection-puzzle @@ -0,0 +1 @@ +../../Task/Solve-the-no-connection-puzzle/Java \ No newline at end of file diff --git a/Lang/Java/Statistics-Basic b/Lang/Java/Statistics-Basic new file mode 120000 index 0000000000..12c4616d11 --- /dev/null +++ b/Lang/Java/Statistics-Basic @@ -0,0 +1 @@ +../../Task/Statistics-Basic/Java \ No newline at end of file diff --git a/Lang/Java/Subtractive-generator b/Lang/Java/Subtractive-generator new file mode 120000 index 0000000000..ee3828d506 --- /dev/null +++ b/Lang/Java/Subtractive-generator @@ -0,0 +1 @@ +../../Task/Subtractive-generator/Java \ No newline at end of file diff --git a/Lang/Java/Thieles-interpolation-formula b/Lang/Java/Thieles-interpolation-formula new file mode 120000 index 0000000000..51bf1293a8 --- /dev/null +++ b/Lang/Java/Thieles-interpolation-formula @@ -0,0 +1 @@ +../../Task/Thieles-interpolation-formula/Java \ No newline at end of file diff --git a/Lang/Java/Total-circles-area b/Lang/Java/Total-circles-area new file mode 120000 index 0000000000..6040cbdf6a --- /dev/null +++ b/Lang/Java/Total-circles-area @@ -0,0 +1 @@ +../../Task/Total-circles-area/Java \ No newline at end of file diff --git a/Lang/Java/Verify-distribution-uniformity-Chi-squared-test b/Lang/Java/Verify-distribution-uniformity-Chi-squared-test new file mode 120000 index 0000000000..ecbdb44b34 --- /dev/null +++ b/Lang/Java/Verify-distribution-uniformity-Chi-squared-test @@ -0,0 +1 @@ +../../Task/Verify-distribution-uniformity-Chi-squared-test/Java \ No newline at end of file diff --git a/Lang/Java/Verify-distribution-uniformity-Naive b/Lang/Java/Verify-distribution-uniformity-Naive new file mode 120000 index 0000000000..aa6e9736ec --- /dev/null +++ b/Lang/Java/Verify-distribution-uniformity-Naive @@ -0,0 +1 @@ +../../Task/Verify-distribution-uniformity-Naive/Java \ No newline at end of file diff --git a/Lang/Java/Xiaolin-Wus-line-algorithm b/Lang/Java/Xiaolin-Wus-line-algorithm new file mode 120000 index 0000000000..d7b74f59f0 --- /dev/null +++ b/Lang/Java/Xiaolin-Wus-line-algorithm @@ -0,0 +1 @@ +../../Task/Xiaolin-Wus-line-algorithm/Java \ No newline at end of file diff --git a/Lang/JavaScript/00DESCRIPTION b/Lang/JavaScript/00DESCRIPTION index 588942c5e5..3906eaab39 100644 --- a/Lang/JavaScript/00DESCRIPTION +++ b/Lang/JavaScript/00DESCRIPTION @@ -19,10 +19,13 @@ Once largely confined to browser environments, and typically isolated from acces At the same time, mainly because of JavaScript's role in the web, there is a growing number of other languages which [https://github.com/jashkenas/coffeescript/wiki/list-of-languages-that-compile-to-js compile to JavaScript]. +The inclusion of '''tail-call optimisation''' in the ES6 standard reflects increased interest in functional approaches to the composition of JavaScript code, expressed for example, in significant adoption of libraries like Underscore and Lodash. If ES6 tail-call optimisation is widely implemented by JavaScript engines (so far this has mainly been achieved only by Apple's Safari engine) it will make JavaScript a more efficient and more natural environment for coding in a functional idiom. + ==Citations== * [[wp:Javascript|Wikipedia:Javascript]] * [https://nodejs.org/en/ Node.js] Event-driven I/O server-side JavaScript environment based on V8 * [https://www.npmjs.com npm – Node.js Package Manager] Claims to be the largest ecosystem of open source libraries in the world * [https://developer.apple.com/library/mac/releasenotes/InterapplicationCommunication/RN-JavaScriptForAutomation/Articles/Introduction.html OS X JavaScript for Applications] JavaScript as an OS X scripting language – supported by the Safari debugger * [https://developer.mozilla.org/en-US/docs/Web/JavaScript/Shells Other JavaScript shells] List maintained by Mozilla -* [https://github.com/jashkenas/coffeescript/wiki/list-of-languages-that-compile-to-js List of languages that compile to JS] maintained on Github by Jeremy Ashenas – author of CoffeeScript, Underscore and Backbone \ No newline at end of file +* [https://github.com/jashkenas/coffeescript/wiki/list-of-languages-that-compile-to-js List of languages that compile to JS] maintained on Github by Jeremy Ashenas – author of CoffeeScript, Underscore and Backbone +* [http://shop.oreilly.com/product/0636920028857.do Functional JavaScript] – Michael Fogus, O'Reilly 2013 \ No newline at end of file diff --git a/Lang/JavaScript/CSV-data-manipulation b/Lang/JavaScript/CSV-data-manipulation new file mode 120000 index 0000000000..a277627be2 --- /dev/null +++ b/Lang/JavaScript/CSV-data-manipulation @@ -0,0 +1 @@ +../../Task/CSV-data-manipulation/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/Casting-out-nines b/Lang/JavaScript/Casting-out-nines new file mode 120000 index 0000000000..c17cdf253a --- /dev/null +++ b/Lang/JavaScript/Casting-out-nines @@ -0,0 +1 @@ +../../Task/Casting-out-nines/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/Dinesmans-multiple-dwelling-problem b/Lang/JavaScript/Dinesmans-multiple-dwelling-problem new file mode 120000 index 0000000000..86102d1c70 --- /dev/null +++ b/Lang/JavaScript/Dinesmans-multiple-dwelling-problem @@ -0,0 +1 @@ +../../Task/Dinesmans-multiple-dwelling-problem/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/Extensible-prime-generator b/Lang/JavaScript/Extensible-prime-generator new file mode 120000 index 0000000000..093e8740a2 --- /dev/null +++ b/Lang/JavaScript/Extensible-prime-generator @@ -0,0 +1 @@ +../../Task/Extensible-prime-generator/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/Fibonacci-word-fractal b/Lang/JavaScript/Fibonacci-word-fractal new file mode 120000 index 0000000000..a23f13aa6e --- /dev/null +++ b/Lang/JavaScript/Fibonacci-word-fractal @@ -0,0 +1 @@ +../../Task/Fibonacci-word-fractal/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/Flipping-bits-game b/Lang/JavaScript/Flipping-bits-game new file mode 120000 index 0000000000..2999312e48 --- /dev/null +++ b/Lang/JavaScript/Flipping-bits-game @@ -0,0 +1 @@ +../../Task/Flipping-bits-game/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/Generate-Chess960-starting-position b/Lang/JavaScript/Generate-Chess960-starting-position new file mode 120000 index 0000000000..615ec81399 --- /dev/null +++ b/Lang/JavaScript/Generate-Chess960-starting-position @@ -0,0 +1 @@ +../../Task/Generate-Chess960-starting-position/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/Hash-join b/Lang/JavaScript/Hash-join new file mode 120000 index 0000000000..9c4122ce63 --- /dev/null +++ b/Lang/JavaScript/Hash-join @@ -0,0 +1 @@ +../../Task/Hash-join/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/Hello-world-Newline-omission b/Lang/JavaScript/Hello-world-Newline-omission new file mode 120000 index 0000000000..acc4f55196 --- /dev/null +++ b/Lang/JavaScript/Hello-world-Newline-omission @@ -0,0 +1 @@ +../../Task/Hello-world-Newline-omission/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/IBAN b/Lang/JavaScript/IBAN new file mode 120000 index 0000000000..ccf82f3b4a --- /dev/null +++ b/Lang/JavaScript/IBAN @@ -0,0 +1 @@ +../../Task/IBAN/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/Kaprekar-numbers b/Lang/JavaScript/Kaprekar-numbers new file mode 120000 index 0000000000..ff196b7b2e --- /dev/null +++ b/Lang/JavaScript/Kaprekar-numbers @@ -0,0 +1 @@ +../../Task/Kaprekar-numbers/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/Largest-int-from-concatenated-ints b/Lang/JavaScript/Largest-int-from-concatenated-ints new file mode 120000 index 0000000000..d197bb3217 --- /dev/null +++ b/Lang/JavaScript/Largest-int-from-concatenated-ints @@ -0,0 +1 @@ +../../Task/Largest-int-from-concatenated-ints/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/Modular-inverse b/Lang/JavaScript/Modular-inverse new file mode 120000 index 0000000000..482fe3b769 --- /dev/null +++ b/Lang/JavaScript/Modular-inverse @@ -0,0 +1 @@ +../../Task/Modular-inverse/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/Order-disjoint-list-items b/Lang/JavaScript/Order-disjoint-list-items new file mode 120000 index 0000000000..db60f4ab93 --- /dev/null +++ b/Lang/JavaScript/Order-disjoint-list-items @@ -0,0 +1 @@ +../../Task/Order-disjoint-list-items/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/Order-two-numerical-lists b/Lang/JavaScript/Order-two-numerical-lists new file mode 120000 index 0000000000..d84ae595ed --- /dev/null +++ b/Lang/JavaScript/Order-two-numerical-lists @@ -0,0 +1 @@ +../../Task/Order-two-numerical-lists/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/Ordered-Partitions b/Lang/JavaScript/Ordered-Partitions new file mode 120000 index 0000000000..6c3e3c8cde --- /dev/null +++ b/Lang/JavaScript/Ordered-Partitions @@ -0,0 +1 @@ +../../Task/Ordered-Partitions/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/Parsing-RPN-to-infix-conversion b/Lang/JavaScript/Parsing-RPN-to-infix-conversion new file mode 120000 index 0000000000..061e2c5139 --- /dev/null +++ b/Lang/JavaScript/Parsing-RPN-to-infix-conversion @@ -0,0 +1 @@ +../../Task/Parsing-RPN-to-infix-conversion/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/Pi b/Lang/JavaScript/Pi new file mode 120000 index 0000000000..515c5ca53e --- /dev/null +++ b/Lang/JavaScript/Pi @@ -0,0 +1 @@ +../../Task/Pi/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/Read-a-file-line-by-line b/Lang/JavaScript/Read-a-file-line-by-line new file mode 120000 index 0000000000..f1cb6cac75 --- /dev/null +++ b/Lang/JavaScript/Read-a-file-line-by-line @@ -0,0 +1 @@ +../../Task/Read-a-file-line-by-line/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/Sorting-algorithms-Cocktail-sort b/Lang/JavaScript/Sorting-algorithms-Cocktail-sort new file mode 120000 index 0000000000..150bb2ee36 --- /dev/null +++ b/Lang/JavaScript/Sorting-algorithms-Cocktail-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Cocktail-sort/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/Sorting-algorithms-Comb-sort b/Lang/JavaScript/Sorting-algorithms-Comb-sort new file mode 120000 index 0000000000..06255b8329 --- /dev/null +++ b/Lang/JavaScript/Sorting-algorithms-Comb-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Comb-sort/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/Sorting-algorithms-Selection-sort b/Lang/JavaScript/Sorting-algorithms-Selection-sort new file mode 120000 index 0000000000..066834ca91 --- /dev/null +++ b/Lang/JavaScript/Sorting-algorithms-Selection-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Selection-sort/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/Sorting-algorithms-Stooge-sort b/Lang/JavaScript/Sorting-algorithms-Stooge-sort new file mode 120000 index 0000000000..69e8b907a2 --- /dev/null +++ b/Lang/JavaScript/Sorting-algorithms-Stooge-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Stooge-sort/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/Sparkline-in-unicode b/Lang/JavaScript/Sparkline-in-unicode new file mode 120000 index 0000000000..da57479d5d --- /dev/null +++ b/Lang/JavaScript/Sparkline-in-unicode @@ -0,0 +1 @@ +../../Task/Sparkline-in-unicode/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/Strip-control-codes-and-extended-characters-from-a-string b/Lang/JavaScript/Strip-control-codes-and-extended-characters-from-a-string new file mode 120000 index 0000000000..7a9b3c050e --- /dev/null +++ b/Lang/JavaScript/Strip-control-codes-and-extended-characters-from-a-string @@ -0,0 +1 @@ +../../Task/Strip-control-codes-and-extended-characters-from-a-string/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/Sum-digits-of-an-integer b/Lang/JavaScript/Sum-digits-of-an-integer new file mode 120000 index 0000000000..05f77485c1 --- /dev/null +++ b/Lang/JavaScript/Sum-digits-of-an-integer @@ -0,0 +1 @@ +../../Task/Sum-digits-of-an-integer/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/Ternary-logic b/Lang/JavaScript/Ternary-logic new file mode 120000 index 0000000000..d49124d596 --- /dev/null +++ b/Lang/JavaScript/Ternary-logic @@ -0,0 +1 @@ +../../Task/Ternary-logic/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/Universal-Turing-machine b/Lang/JavaScript/Universal-Turing-machine new file mode 120000 index 0000000000..9bea53a5f8 --- /dev/null +++ b/Lang/JavaScript/Universal-Turing-machine @@ -0,0 +1 @@ +../../Task/Universal-Turing-machine/JavaScript \ No newline at end of file diff --git a/Lang/JavaScript/Zeckendorf-number-representation b/Lang/JavaScript/Zeckendorf-number-representation new file mode 120000 index 0000000000..c979f140cf --- /dev/null +++ b/Lang/JavaScript/Zeckendorf-number-representation @@ -0,0 +1 @@ +../../Task/Zeckendorf-number-representation/JavaScript \ No newline at end of file diff --git a/Lang/Julia/Bernoulli-numbers b/Lang/Julia/Bernoulli-numbers new file mode 120000 index 0000000000..442ec35ee6 --- /dev/null +++ b/Lang/Julia/Bernoulli-numbers @@ -0,0 +1 @@ +../../Task/Bernoulli-numbers/Julia \ No newline at end of file diff --git a/Lang/Julia/N-queens-problem b/Lang/Julia/N-queens-problem new file mode 120000 index 0000000000..6e1cadb6b8 --- /dev/null +++ b/Lang/Julia/N-queens-problem @@ -0,0 +1 @@ +../../Task/N-queens-problem/Julia \ No newline at end of file diff --git a/Lang/K/A+B b/Lang/K/A+B new file mode 120000 index 0000000000..8f6bc02168 --- /dev/null +++ b/Lang/K/A+B @@ -0,0 +1 @@ +../../Task/A+B/K \ No newline at end of file diff --git a/Lang/K/Amicable-pairs b/Lang/K/Amicable-pairs new file mode 120000 index 0000000000..07c0393d96 --- /dev/null +++ b/Lang/K/Amicable-pairs @@ -0,0 +1 @@ +../../Task/Amicable-pairs/K \ No newline at end of file diff --git a/Lang/K/Averages-Median b/Lang/K/Averages-Median new file mode 120000 index 0000000000..0d9ef99e72 --- /dev/null +++ b/Lang/K/Averages-Median @@ -0,0 +1 @@ +../../Task/Averages-Median/K \ No newline at end of file diff --git a/Lang/K/Averages-Pythagorean-means b/Lang/K/Averages-Pythagorean-means new file mode 120000 index 0000000000..7de8d806f3 --- /dev/null +++ b/Lang/K/Averages-Pythagorean-means @@ -0,0 +1 @@ +../../Task/Averages-Pythagorean-means/K \ No newline at end of file diff --git a/Lang/K/Averages-Root-mean-square b/Lang/K/Averages-Root-mean-square new file mode 120000 index 0000000000..89e1c5e285 --- /dev/null +++ b/Lang/K/Averages-Root-mean-square @@ -0,0 +1 @@ +../../Task/Averages-Root-mean-square/K \ No newline at end of file diff --git a/Lang/K/Averages-Simple-moving-average b/Lang/K/Averages-Simple-moving-average new file mode 120000 index 0000000000..e3d601b10c --- /dev/null +++ b/Lang/K/Averages-Simple-moving-average @@ -0,0 +1 @@ +../../Task/Averages-Simple-moving-average/K \ No newline at end of file diff --git a/Lang/K/Balanced-brackets b/Lang/K/Balanced-brackets new file mode 120000 index 0000000000..79c3d4c021 --- /dev/null +++ b/Lang/K/Balanced-brackets @@ -0,0 +1 @@ +../../Task/Balanced-brackets/K \ No newline at end of file diff --git a/Lang/K/Binary-search b/Lang/K/Binary-search new file mode 120000 index 0000000000..1db86f034c --- /dev/null +++ b/Lang/K/Binary-search @@ -0,0 +1 @@ +../../Task/Binary-search/K \ No newline at end of file diff --git a/Lang/K/Caesar-cipher b/Lang/K/Caesar-cipher new file mode 120000 index 0000000000..699bb385d5 --- /dev/null +++ b/Lang/K/Caesar-cipher @@ -0,0 +1 @@ +../../Task/Caesar-cipher/K \ No newline at end of file diff --git a/Lang/K/Combinations b/Lang/K/Combinations new file mode 120000 index 0000000000..fc43c6ed5f --- /dev/null +++ b/Lang/K/Combinations @@ -0,0 +1 @@ +../../Task/Combinations/K \ No newline at end of file diff --git a/Lang/K/Generate-lower-case-ASCII-alphabet b/Lang/K/Generate-lower-case-ASCII-alphabet new file mode 120000 index 0000000000..f48b3ef46f --- /dev/null +++ b/Lang/K/Generate-lower-case-ASCII-alphabet @@ -0,0 +1 @@ +../../Task/Generate-lower-case-ASCII-alphabet/K \ No newline at end of file diff --git a/Lang/K/Sequence-of-non-squares b/Lang/K/Sequence-of-non-squares new file mode 120000 index 0000000000..97e231cb34 --- /dev/null +++ b/Lang/K/Sequence-of-non-squares @@ -0,0 +1 @@ +../../Task/Sequence-of-non-squares/K \ No newline at end of file diff --git a/Lang/K/Stack b/Lang/K/Stack new file mode 120000 index 0000000000..2f0d95a735 --- /dev/null +++ b/Lang/K/Stack @@ -0,0 +1 @@ +../../Task/Stack/K \ No newline at end of file diff --git a/Lang/K/String-case b/Lang/K/String-case new file mode 120000 index 0000000000..c911391113 --- /dev/null +++ b/Lang/K/String-case @@ -0,0 +1 @@ +../../Task/String-case/K \ No newline at end of file diff --git a/Lang/K/Sum-and-product-of-an-array b/Lang/K/Sum-and-product-of-an-array new file mode 120000 index 0000000000..65f7ba9183 --- /dev/null +++ b/Lang/K/Sum-and-product-of-an-array @@ -0,0 +1 @@ +../../Task/Sum-and-product-of-an-array/K \ No newline at end of file diff --git a/Lang/Kotlin/9-billion-names-of-God-the-integer b/Lang/Kotlin/9-billion-names-of-God-the-integer new file mode 120000 index 0000000000..13da09cecf --- /dev/null +++ b/Lang/Kotlin/9-billion-names-of-God-the-integer @@ -0,0 +1 @@ +../../Task/9-billion-names-of-God-the-integer/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/ABC-Problem b/Lang/Kotlin/ABC-Problem new file mode 120000 index 0000000000..752b66ce2d --- /dev/null +++ b/Lang/Kotlin/ABC-Problem @@ -0,0 +1 @@ +../../Task/ABC-Problem/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Almost-prime b/Lang/Kotlin/Almost-prime new file mode 120000 index 0000000000..b9bfd47bfe --- /dev/null +++ b/Lang/Kotlin/Almost-prime @@ -0,0 +1 @@ +../../Task/Almost-prime/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Apply-a-callback-to-an-array b/Lang/Kotlin/Apply-a-callback-to-an-array new file mode 120000 index 0000000000..28bd472513 --- /dev/null +++ b/Lang/Kotlin/Apply-a-callback-to-an-array @@ -0,0 +1 @@ +../../Task/Apply-a-callback-to-an-array/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Arrays b/Lang/Kotlin/Arrays new file mode 120000 index 0000000000..65a28891c4 --- /dev/null +++ b/Lang/Kotlin/Arrays @@ -0,0 +1 @@ +../../Task/Arrays/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Associative-array-Creation b/Lang/Kotlin/Associative-array-Creation new file mode 120000 index 0000000000..91c783898a --- /dev/null +++ b/Lang/Kotlin/Associative-array-Creation @@ -0,0 +1 @@ +../../Task/Associative-array-Creation/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Associative-array-Iteration b/Lang/Kotlin/Associative-array-Iteration new file mode 120000 index 0000000000..5590885c17 --- /dev/null +++ b/Lang/Kotlin/Associative-array-Iteration @@ -0,0 +1 @@ +../../Task/Associative-array-Iteration/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Averages-Arithmetic-mean b/Lang/Kotlin/Averages-Arithmetic-mean new file mode 120000 index 0000000000..4b6a1b27a4 --- /dev/null +++ b/Lang/Kotlin/Averages-Arithmetic-mean @@ -0,0 +1 @@ +../../Task/Averages-Arithmetic-mean/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Averages-Median b/Lang/Kotlin/Averages-Median new file mode 120000 index 0000000000..190395c488 --- /dev/null +++ b/Lang/Kotlin/Averages-Median @@ -0,0 +1 @@ +../../Task/Averages-Median/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Averages-Pythagorean-means b/Lang/Kotlin/Averages-Pythagorean-means new file mode 120000 index 0000000000..65d6eef080 --- /dev/null +++ b/Lang/Kotlin/Averages-Pythagorean-means @@ -0,0 +1 @@ +../../Task/Averages-Pythagorean-means/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Bernoulli-numbers b/Lang/Kotlin/Bernoulli-numbers new file mode 120000 index 0000000000..b03db87cdb --- /dev/null +++ b/Lang/Kotlin/Bernoulli-numbers @@ -0,0 +1 @@ +../../Task/Bernoulli-numbers/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Binary-search b/Lang/Kotlin/Binary-search new file mode 120000 index 0000000000..4b39505448 --- /dev/null +++ b/Lang/Kotlin/Binary-search @@ -0,0 +1 @@ +../../Task/Binary-search/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Calendar b/Lang/Kotlin/Calendar new file mode 120000 index 0000000000..84f9fcfe00 --- /dev/null +++ b/Lang/Kotlin/Calendar @@ -0,0 +1 @@ +../../Task/Calendar/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Carmichael-3-strong-pseudoprimes b/Lang/Kotlin/Carmichael-3-strong-pseudoprimes new file mode 120000 index 0000000000..e7f04f4981 --- /dev/null +++ b/Lang/Kotlin/Carmichael-3-strong-pseudoprimes @@ -0,0 +1 @@ +../../Task/Carmichael-3-strong-pseudoprimes/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Catalan-numbers b/Lang/Kotlin/Catalan-numbers new file mode 120000 index 0000000000..b0cd7882a6 --- /dev/null +++ b/Lang/Kotlin/Catalan-numbers @@ -0,0 +1 @@ +../../Task/Catalan-numbers/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Command-line-arguments b/Lang/Kotlin/Command-line-arguments new file mode 120000 index 0000000000..1a944f7332 --- /dev/null +++ b/Lang/Kotlin/Command-line-arguments @@ -0,0 +1 @@ +../../Task/Command-line-arguments/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Copy-a-string b/Lang/Kotlin/Copy-a-string new file mode 120000 index 0000000000..522d4ef280 --- /dev/null +++ b/Lang/Kotlin/Copy-a-string @@ -0,0 +1 @@ +../../Task/Copy-a-string/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Create-a-two-dimensional-array-at-runtime b/Lang/Kotlin/Create-a-two-dimensional-array-at-runtime new file mode 120000 index 0000000000..f75be9cb63 --- /dev/null +++ b/Lang/Kotlin/Create-a-two-dimensional-array-at-runtime @@ -0,0 +1 @@ +../../Task/Create-a-two-dimensional-array-at-runtime/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Discordian-date b/Lang/Kotlin/Discordian-date new file mode 120000 index 0000000000..bddf434f09 --- /dev/null +++ b/Lang/Kotlin/Discordian-date @@ -0,0 +1 @@ +../../Task/Discordian-date/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Dot-product b/Lang/Kotlin/Dot-product new file mode 120000 index 0000000000..9882b41569 --- /dev/null +++ b/Lang/Kotlin/Dot-product @@ -0,0 +1 @@ +../../Task/Dot-product/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Empty-program b/Lang/Kotlin/Empty-program new file mode 120000 index 0000000000..e6b49b7722 --- /dev/null +++ b/Lang/Kotlin/Empty-program @@ -0,0 +1 @@ +../../Task/Empty-program/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Empty-string b/Lang/Kotlin/Empty-string new file mode 120000 index 0000000000..f36886a548 --- /dev/null +++ b/Lang/Kotlin/Empty-string @@ -0,0 +1 @@ +../../Task/Empty-string/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Factorial b/Lang/Kotlin/Factorial new file mode 120000 index 0000000000..a04269c11f --- /dev/null +++ b/Lang/Kotlin/Factorial @@ -0,0 +1 @@ +../../Task/Factorial/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Floyds-triangle b/Lang/Kotlin/Floyds-triangle new file mode 120000 index 0000000000..33564efd72 --- /dev/null +++ b/Lang/Kotlin/Floyds-triangle @@ -0,0 +1 @@ +../../Task/Floyds-triangle/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Function-definition b/Lang/Kotlin/Function-definition new file mode 120000 index 0000000000..2c19a66858 --- /dev/null +++ b/Lang/Kotlin/Function-definition @@ -0,0 +1 @@ +../../Task/Function-definition/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Generate-Chess960-starting-position b/Lang/Kotlin/Generate-Chess960-starting-position new file mode 120000 index 0000000000..0036d42015 --- /dev/null +++ b/Lang/Kotlin/Generate-Chess960-starting-position @@ -0,0 +1 @@ +../../Task/Generate-Chess960-starting-position/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Greatest-common-divisor b/Lang/Kotlin/Greatest-common-divisor new file mode 120000 index 0000000000..00668dba07 --- /dev/null +++ b/Lang/Kotlin/Greatest-common-divisor @@ -0,0 +1 @@ +../../Task/Greatest-common-divisor/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Hello-world-Graphical b/Lang/Kotlin/Hello-world-Graphical new file mode 120000 index 0000000000..c9465edd2f --- /dev/null +++ b/Lang/Kotlin/Hello-world-Graphical @@ -0,0 +1 @@ +../../Task/Hello-world-Graphical/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Hello-world-Newline-omission b/Lang/Kotlin/Hello-world-Newline-omission new file mode 120000 index 0000000000..3da6099743 --- /dev/null +++ b/Lang/Kotlin/Hello-world-Newline-omission @@ -0,0 +1 @@ +../../Task/Hello-world-Newline-omission/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Heronian-triangles b/Lang/Kotlin/Heronian-triangles new file mode 120000 index 0000000000..153ce68795 --- /dev/null +++ b/Lang/Kotlin/Heronian-triangles @@ -0,0 +1 @@ +../../Task/Heronian-triangles/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Higher-order-functions b/Lang/Kotlin/Higher-order-functions new file mode 120000 index 0000000000..e39f24d953 --- /dev/null +++ b/Lang/Kotlin/Higher-order-functions @@ -0,0 +1 @@ +../../Task/Higher-order-functions/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Hough-transform b/Lang/Kotlin/Hough-transform new file mode 120000 index 0000000000..b41668a58f --- /dev/null +++ b/Lang/Kotlin/Hough-transform @@ -0,0 +1 @@ +../../Task/Hough-transform/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Huffman-coding b/Lang/Kotlin/Huffman-coding new file mode 120000 index 0000000000..c80aa1aced --- /dev/null +++ b/Lang/Kotlin/Huffman-coding @@ -0,0 +1 @@ +../../Task/Huffman-coding/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Infinity b/Lang/Kotlin/Infinity new file mode 120000 index 0000000000..4c96c4fe9c --- /dev/null +++ b/Lang/Kotlin/Infinity @@ -0,0 +1 @@ +../../Task/Infinity/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Inheritance-Multiple b/Lang/Kotlin/Inheritance-Multiple new file mode 120000 index 0000000000..2168e25a76 --- /dev/null +++ b/Lang/Kotlin/Inheritance-Multiple @@ -0,0 +1 @@ +../../Task/Inheritance-Multiple/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Integer-comparison b/Lang/Kotlin/Integer-comparison new file mode 120000 index 0000000000..2e884c6564 --- /dev/null +++ b/Lang/Kotlin/Integer-comparison @@ -0,0 +1 @@ +../../Task/Integer-comparison/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Jensens-Device b/Lang/Kotlin/Jensens-Device new file mode 120000 index 0000000000..3d018bcf01 --- /dev/null +++ b/Lang/Kotlin/Jensens-Device @@ -0,0 +1 @@ +../../Task/Jensens-Device/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Kaprekar-numbers b/Lang/Kotlin/Kaprekar-numbers new file mode 120000 index 0000000000..d10efeb716 --- /dev/null +++ b/Lang/Kotlin/Kaprekar-numbers @@ -0,0 +1 @@ +../../Task/Kaprekar-numbers/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Knuth-shuffle b/Lang/Kotlin/Knuth-shuffle new file mode 120000 index 0000000000..d828e993de --- /dev/null +++ b/Lang/Kotlin/Knuth-shuffle @@ -0,0 +1 @@ +../../Task/Knuth-shuffle/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Leap-year b/Lang/Kotlin/Leap-year new file mode 120000 index 0000000000..1c6f232737 --- /dev/null +++ b/Lang/Kotlin/Leap-year @@ -0,0 +1 @@ +../../Task/Leap-year/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Least-common-multiple b/Lang/Kotlin/Least-common-multiple new file mode 120000 index 0000000000..d0e8489b9c --- /dev/null +++ b/Lang/Kotlin/Least-common-multiple @@ -0,0 +1 @@ +../../Task/Least-common-multiple/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Literals-Floating-point b/Lang/Kotlin/Literals-Floating-point new file mode 120000 index 0000000000..19526ee1ec --- /dev/null +++ b/Lang/Kotlin/Literals-Floating-point @@ -0,0 +1 @@ +../../Task/Literals-Floating-point/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Long-multiplication b/Lang/Kotlin/Long-multiplication new file mode 120000 index 0000000000..e31bc4592b --- /dev/null +++ b/Lang/Kotlin/Long-multiplication @@ -0,0 +1 @@ +../../Task/Long-multiplication/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Loops-Break b/Lang/Kotlin/Loops-Break new file mode 120000 index 0000000000..5bbede5598 --- /dev/null +++ b/Lang/Kotlin/Loops-Break @@ -0,0 +1 @@ +../../Task/Loops-Break/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Loops-For b/Lang/Kotlin/Loops-For new file mode 120000 index 0000000000..14c4e7d796 --- /dev/null +++ b/Lang/Kotlin/Loops-For @@ -0,0 +1 @@ +../../Task/Loops-For/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Loops-Nested b/Lang/Kotlin/Loops-Nested new file mode 120000 index 0000000000..17b558e771 --- /dev/null +++ b/Lang/Kotlin/Loops-Nested @@ -0,0 +1 @@ +../../Task/Loops-Nested/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Maze-generation b/Lang/Kotlin/Maze-generation new file mode 120000 index 0000000000..2f659d55e4 --- /dev/null +++ b/Lang/Kotlin/Maze-generation @@ -0,0 +1 @@ +../../Task/Maze-generation/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Middle-three-digits b/Lang/Kotlin/Middle-three-digits new file mode 120000 index 0000000000..faae414863 --- /dev/null +++ b/Lang/Kotlin/Middle-three-digits @@ -0,0 +1 @@ +../../Task/Middle-three-digits/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Multifactorial b/Lang/Kotlin/Multifactorial new file mode 120000 index 0000000000..40631c6f05 --- /dev/null +++ b/Lang/Kotlin/Multifactorial @@ -0,0 +1 @@ +../../Task/Multifactorial/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Nth b/Lang/Kotlin/Nth new file mode 120000 index 0000000000..7a77c2bbc6 --- /dev/null +++ b/Lang/Kotlin/Nth @@ -0,0 +1 @@ +../../Task/Nth/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Numeric-error-propagation b/Lang/Kotlin/Numeric-error-propagation new file mode 120000 index 0000000000..13ec902292 --- /dev/null +++ b/Lang/Kotlin/Numeric-error-propagation @@ -0,0 +1 @@ +../../Task/Numeric-error-propagation/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Numerical-integration-Gauss-Legendre-Quadrature b/Lang/Kotlin/Numerical-integration-Gauss-Legendre-Quadrature new file mode 120000 index 0000000000..b89eefcdda --- /dev/null +++ b/Lang/Kotlin/Numerical-integration-Gauss-Legendre-Quadrature @@ -0,0 +1 @@ +../../Task/Numerical-integration-Gauss-Legendre-Quadrature/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Ordered-words b/Lang/Kotlin/Ordered-words new file mode 120000 index 0000000000..aa98227c56 --- /dev/null +++ b/Lang/Kotlin/Ordered-words @@ -0,0 +1 @@ +../../Task/Ordered-words/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Priority-queue b/Lang/Kotlin/Priority-queue new file mode 120000 index 0000000000..4a822c4598 --- /dev/null +++ b/Lang/Kotlin/Priority-queue @@ -0,0 +1 @@ +../../Task/Priority-queue/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/RIPEMD-160 b/Lang/Kotlin/RIPEMD-160 new file mode 120000 index 0000000000..d7f7e4e104 --- /dev/null +++ b/Lang/Kotlin/RIPEMD-160 @@ -0,0 +1 @@ +../../Task/RIPEMD-160/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Ray-casting-algorithm b/Lang/Kotlin/Ray-casting-algorithm new file mode 120000 index 0000000000..69b18c8a1d --- /dev/null +++ b/Lang/Kotlin/Ray-casting-algorithm @@ -0,0 +1 @@ +../../Task/Ray-casting-algorithm/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Remove-duplicate-elements b/Lang/Kotlin/Remove-duplicate-elements new file mode 120000 index 0000000000..d5027f13cf --- /dev/null +++ b/Lang/Kotlin/Remove-duplicate-elements @@ -0,0 +1 @@ +../../Task/Remove-duplicate-elements/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Reverse-a-string b/Lang/Kotlin/Reverse-a-string new file mode 120000 index 0000000000..5ea632230a --- /dev/null +++ b/Lang/Kotlin/Reverse-a-string @@ -0,0 +1 @@ +../../Task/Reverse-a-string/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Roman-numerals-Encode b/Lang/Kotlin/Roman-numerals-Encode new file mode 120000 index 0000000000..b2248ddc49 --- /dev/null +++ b/Lang/Kotlin/Roman-numerals-Encode @@ -0,0 +1 @@ +../../Task/Roman-numerals-Encode/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Roots-of-a-quadratic-function b/Lang/Kotlin/Roots-of-a-quadratic-function new file mode 120000 index 0000000000..dadcb3d46e --- /dev/null +++ b/Lang/Kotlin/Roots-of-a-quadratic-function @@ -0,0 +1 @@ +../../Task/Roots-of-a-quadratic-function/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Roots-of-unity b/Lang/Kotlin/Roots-of-unity new file mode 120000 index 0000000000..ccc5e04200 --- /dev/null +++ b/Lang/Kotlin/Roots-of-unity @@ -0,0 +1 @@ +../../Task/Roots-of-unity/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Rot-13 b/Lang/Kotlin/Rot-13 new file mode 120000 index 0000000000..2d03662429 --- /dev/null +++ b/Lang/Kotlin/Rot-13 @@ -0,0 +1 @@ +../../Task/Rot-13/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Sieve-of-Eratosthenes b/Lang/Kotlin/Sieve-of-Eratosthenes new file mode 120000 index 0000000000..d7316e4d85 --- /dev/null +++ b/Lang/Kotlin/Sieve-of-Eratosthenes @@ -0,0 +1 @@ +../../Task/Sieve-of-Eratosthenes/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Singly-linked-list-Traversal b/Lang/Kotlin/Singly-linked-list-Traversal new file mode 120000 index 0000000000..ff10b213c2 --- /dev/null +++ b/Lang/Kotlin/Singly-linked-list-Traversal @@ -0,0 +1 @@ +../../Task/Singly-linked-list-Traversal/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Sort-using-a-custom-comparator b/Lang/Kotlin/Sort-using-a-custom-comparator new file mode 120000 index 0000000000..442bb6c8b5 --- /dev/null +++ b/Lang/Kotlin/Sort-using-a-custom-comparator @@ -0,0 +1 @@ +../../Task/Sort-using-a-custom-comparator/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Sorting-algorithms-Insertion-sort b/Lang/Kotlin/Sorting-algorithms-Insertion-sort new file mode 120000 index 0000000000..36059cb5a9 --- /dev/null +++ b/Lang/Kotlin/Sorting-algorithms-Insertion-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Insertion-sort/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Sorting-algorithms-Merge-sort b/Lang/Kotlin/Sorting-algorithms-Merge-sort new file mode 120000 index 0000000000..8a1c419024 --- /dev/null +++ b/Lang/Kotlin/Sorting-algorithms-Merge-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Merge-sort/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Sorting-algorithms-Selection-sort b/Lang/Kotlin/Sorting-algorithms-Selection-sort new file mode 120000 index 0000000000..8b20383cd8 --- /dev/null +++ b/Lang/Kotlin/Sorting-algorithms-Selection-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Selection-sort/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Sparkline-in-unicode b/Lang/Kotlin/Sparkline-in-unicode new file mode 120000 index 0000000000..f2f06ef5ed --- /dev/null +++ b/Lang/Kotlin/Sparkline-in-unicode @@ -0,0 +1 @@ +../../Task/Sparkline-in-unicode/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Stable-marriage-problem b/Lang/Kotlin/Stable-marriage-problem new file mode 120000 index 0000000000..f46875f823 --- /dev/null +++ b/Lang/Kotlin/Stable-marriage-problem @@ -0,0 +1 @@ +../../Task/Stable-marriage-problem/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/String-append b/Lang/Kotlin/String-append new file mode 120000 index 0000000000..051e40d37d --- /dev/null +++ b/Lang/Kotlin/String-append @@ -0,0 +1 @@ +../../Task/String-append/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/String-concatenation b/Lang/Kotlin/String-concatenation new file mode 120000 index 0000000000..1ef1d028d8 --- /dev/null +++ b/Lang/Kotlin/String-concatenation @@ -0,0 +1 @@ +../../Task/String-concatenation/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/The-Twelve-Days-of-Christmas b/Lang/Kotlin/The-Twelve-Days-of-Christmas new file mode 120000 index 0000000000..921abd08e6 --- /dev/null +++ b/Lang/Kotlin/The-Twelve-Days-of-Christmas @@ -0,0 +1 @@ +../../Task/The-Twelve-Days-of-Christmas/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Tree-traversal b/Lang/Kotlin/Tree-traversal new file mode 120000 index 0000000000..bf46468849 --- /dev/null +++ b/Lang/Kotlin/Tree-traversal @@ -0,0 +1 @@ +../../Task/Tree-traversal/Kotlin \ No newline at end of file diff --git a/Lang/Kotlin/Ulam-spiral--for-primes- b/Lang/Kotlin/Ulam-spiral--for-primes- new file mode 120000 index 0000000000..0f210ed995 --- /dev/null +++ b/Lang/Kotlin/Ulam-spiral--for-primes- @@ -0,0 +1 @@ +../../Task/Ulam-spiral--for-primes-/Kotlin \ No newline at end of file diff --git a/Lang/LOLCODE/Factorial b/Lang/LOLCODE/Factorial new file mode 120000 index 0000000000..41f1a0b508 --- /dev/null +++ b/Lang/LOLCODE/Factorial @@ -0,0 +1 @@ +../../Task/Factorial/LOLCODE \ No newline at end of file diff --git a/Lang/LOLCODE/Leap-year b/Lang/LOLCODE/Leap-year new file mode 120000 index 0000000000..f6842fae45 --- /dev/null +++ b/Lang/LOLCODE/Leap-year @@ -0,0 +1 @@ +../../Task/Leap-year/LOLCODE \ No newline at end of file diff --git a/Lang/LaTeX/Hello-world-Text b/Lang/LaTeX/Hello-world-Text new file mode 120000 index 0000000000..2c1d5a2d45 --- /dev/null +++ b/Lang/LaTeX/Hello-world-Text @@ -0,0 +1 @@ +../../Task/Hello-world-Text/LaTeX \ No newline at end of file diff --git a/Lang/Liberty-BASIC/ABC-Problem b/Lang/Liberty-BASIC/ABC-Problem new file mode 120000 index 0000000000..c93ba487a0 --- /dev/null +++ b/Lang/Liberty-BASIC/ABC-Problem @@ -0,0 +1 @@ +../../Task/ABC-Problem/Liberty-BASIC \ No newline at end of file diff --git a/Lang/Liberty-BASIC/Abundant,-deficient-and-perfect-number-classifications b/Lang/Liberty-BASIC/Abundant,-deficient-and-perfect-number-classifications new file mode 120000 index 0000000000..8789542507 --- /dev/null +++ b/Lang/Liberty-BASIC/Abundant,-deficient-and-perfect-number-classifications @@ -0,0 +1 @@ +../../Task/Abundant,-deficient-and-perfect-number-classifications/Liberty-BASIC \ No newline at end of file diff --git a/Lang/Liberty-BASIC/Aliquot-sequence-classifications b/Lang/Liberty-BASIC/Aliquot-sequence-classifications new file mode 120000 index 0000000000..ece4da5129 --- /dev/null +++ b/Lang/Liberty-BASIC/Aliquot-sequence-classifications @@ -0,0 +1 @@ +../../Task/Aliquot-sequence-classifications/Liberty-BASIC \ No newline at end of file diff --git a/Lang/Liberty-BASIC/Find-the-last-Sunday-of-each-month b/Lang/Liberty-BASIC/Find-the-last-Sunday-of-each-month new file mode 120000 index 0000000000..166668a2b8 --- /dev/null +++ b/Lang/Liberty-BASIC/Find-the-last-Sunday-of-each-month @@ -0,0 +1 @@ +../../Task/Find-the-last-Sunday-of-each-month/Liberty-BASIC \ No newline at end of file diff --git a/Lang/Liberty-BASIC/Honeycombs b/Lang/Liberty-BASIC/Honeycombs new file mode 120000 index 0000000000..89b44d6fcd --- /dev/null +++ b/Lang/Liberty-BASIC/Honeycombs @@ -0,0 +1 @@ +../../Task/Honeycombs/Liberty-BASIC \ No newline at end of file diff --git a/Lang/Liberty-BASIC/Sequence-of-primes-by-Trial-Division b/Lang/Liberty-BASIC/Sequence-of-primes-by-Trial-Division new file mode 120000 index 0000000000..a42b9c3686 --- /dev/null +++ b/Lang/Liberty-BASIC/Sequence-of-primes-by-Trial-Division @@ -0,0 +1 @@ +../../Task/Sequence-of-primes-by-Trial-Division/Liberty-BASIC \ No newline at end of file diff --git a/Lang/Logo/Reverse-words-in-a-string b/Lang/Logo/Reverse-words-in-a-string new file mode 120000 index 0000000000..aeddcf2e78 --- /dev/null +++ b/Lang/Logo/Reverse-words-in-a-string @@ -0,0 +1 @@ +../../Task/Reverse-words-in-a-string/Logo \ No newline at end of file diff --git a/Lang/Logo/Zeckendorf-number-representation b/Lang/Logo/Zeckendorf-number-representation new file mode 120000 index 0000000000..46ce21599a --- /dev/null +++ b/Lang/Logo/Zeckendorf-number-representation @@ -0,0 +1 @@ +../../Task/Zeckendorf-number-representation/Logo \ No newline at end of file diff --git a/Lang/Lua/ABC-Problem b/Lang/Lua/ABC-Problem new file mode 120000 index 0000000000..f367aa82b0 --- /dev/null +++ b/Lang/Lua/ABC-Problem @@ -0,0 +1 @@ +../../Task/ABC-Problem/Lua \ No newline at end of file diff --git a/Lang/Lua/Almost-prime b/Lang/Lua/Almost-prime new file mode 120000 index 0000000000..dd6364d57d --- /dev/null +++ b/Lang/Lua/Almost-prime @@ -0,0 +1 @@ +../../Task/Almost-prime/Lua \ No newline at end of file diff --git a/Lang/Lua/Amicable-pairs b/Lang/Lua/Amicable-pairs new file mode 120000 index 0000000000..471a3f1271 --- /dev/null +++ b/Lang/Lua/Amicable-pairs @@ -0,0 +1 @@ +../../Task/Amicable-pairs/Lua \ No newline at end of file diff --git a/Lang/Lua/Calendar b/Lang/Lua/Calendar new file mode 120000 index 0000000000..1728fc03ce --- /dev/null +++ b/Lang/Lua/Calendar @@ -0,0 +1 @@ +../../Task/Calendar/Lua \ No newline at end of file diff --git a/Lang/Lua/Calendar---for-REAL-programmers b/Lang/Lua/Calendar---for-REAL-programmers new file mode 120000 index 0000000000..a18ba102bf --- /dev/null +++ b/Lang/Lua/Calendar---for-REAL-programmers @@ -0,0 +1 @@ +../../Task/Calendar---for-REAL-programmers/Lua \ No newline at end of file diff --git a/Lang/Lua/Catalan-numbers-Pascals-triangle b/Lang/Lua/Catalan-numbers-Pascals-triangle new file mode 120000 index 0000000000..f86bd7642e --- /dev/null +++ b/Lang/Lua/Catalan-numbers-Pascals-triangle @@ -0,0 +1 @@ +../../Task/Catalan-numbers-Pascals-triangle/Lua \ No newline at end of file diff --git a/Lang/Lua/Catamorphism b/Lang/Lua/Catamorphism new file mode 120000 index 0000000000..75eff3516d --- /dev/null +++ b/Lang/Lua/Catamorphism @@ -0,0 +1 @@ +../../Task/Catamorphism/Lua \ No newline at end of file diff --git a/Lang/Lua/Comma-quibbling b/Lang/Lua/Comma-quibbling new file mode 120000 index 0000000000..c25be610ed --- /dev/null +++ b/Lang/Lua/Comma-quibbling @@ -0,0 +1 @@ +../../Task/Comma-quibbling/Lua \ No newline at end of file diff --git a/Lang/Lua/Count-the-coins b/Lang/Lua/Count-the-coins new file mode 120000 index 0000000000..4d7eb48c41 --- /dev/null +++ b/Lang/Lua/Count-the-coins @@ -0,0 +1 @@ +../../Task/Count-the-coins/Lua \ No newline at end of file diff --git a/Lang/Lua/Create-an-HTML-table b/Lang/Lua/Create-an-HTML-table new file mode 120000 index 0000000000..0103169071 --- /dev/null +++ b/Lang/Lua/Create-an-HTML-table @@ -0,0 +1 @@ +../../Task/Create-an-HTML-table/Lua \ No newline at end of file diff --git a/Lang/Lua/Currying b/Lang/Lua/Currying new file mode 120000 index 0000000000..7b78b3e31a --- /dev/null +++ b/Lang/Lua/Currying @@ -0,0 +1 @@ +../../Task/Currying/Lua \ No newline at end of file diff --git a/Lang/Lua/Deepcopy b/Lang/Lua/Deepcopy new file mode 120000 index 0000000000..6b22987bc3 --- /dev/null +++ b/Lang/Lua/Deepcopy @@ -0,0 +1 @@ +../../Task/Deepcopy/Lua \ No newline at end of file diff --git a/Lang/Lua/Echo-server b/Lang/Lua/Echo-server new file mode 120000 index 0000000000..e96bbb4cb4 --- /dev/null +++ b/Lang/Lua/Echo-server @@ -0,0 +1 @@ +../../Task/Echo-server/Lua \ No newline at end of file diff --git a/Lang/Lua/Empty-directory b/Lang/Lua/Empty-directory new file mode 120000 index 0000000000..da7f0a6015 --- /dev/null +++ b/Lang/Lua/Empty-directory @@ -0,0 +1 @@ +../../Task/Empty-directory/Lua \ No newline at end of file diff --git a/Lang/Lua/Entropy b/Lang/Lua/Entropy new file mode 120000 index 0000000000..489499754d --- /dev/null +++ b/Lang/Lua/Entropy @@ -0,0 +1 @@ +../../Task/Entropy/Lua \ No newline at end of file diff --git a/Lang/Lua/Fast-Fourier-transform b/Lang/Lua/Fast-Fourier-transform new file mode 120000 index 0000000000..c5a8f89bea --- /dev/null +++ b/Lang/Lua/Fast-Fourier-transform @@ -0,0 +1 @@ +../../Task/Fast-Fourier-transform/Lua \ No newline at end of file diff --git a/Lang/Lua/Fibonacci-n-step-number-sequences b/Lang/Lua/Fibonacci-n-step-number-sequences new file mode 120000 index 0000000000..d5508efe44 --- /dev/null +++ b/Lang/Lua/Fibonacci-n-step-number-sequences @@ -0,0 +1 @@ +../../Task/Fibonacci-n-step-number-sequences/Lua \ No newline at end of file diff --git a/Lang/Lua/Fibonacci-word b/Lang/Lua/Fibonacci-word new file mode 120000 index 0000000000..d1bbda0267 --- /dev/null +++ b/Lang/Lua/Fibonacci-word @@ -0,0 +1 @@ +../../Task/Fibonacci-word/Lua \ No newline at end of file diff --git a/Lang/Lua/Find-the-last-Sunday-of-each-month b/Lang/Lua/Find-the-last-Sunday-of-each-month new file mode 120000 index 0000000000..ceba411c96 --- /dev/null +++ b/Lang/Lua/Find-the-last-Sunday-of-each-month @@ -0,0 +1 @@ +../../Task/Find-the-last-Sunday-of-each-month/Lua \ No newline at end of file diff --git a/Lang/Lua/Find-the-missing-permutation b/Lang/Lua/Find-the-missing-permutation new file mode 120000 index 0000000000..b7d8ad2b4e --- /dev/null +++ b/Lang/Lua/Find-the-missing-permutation @@ -0,0 +1 @@ +../../Task/Find-the-missing-permutation/Lua \ No newline at end of file diff --git a/Lang/Lua/First-class-functions-Use-numbers-analogously b/Lang/Lua/First-class-functions-Use-numbers-analogously new file mode 120000 index 0000000000..05ac864554 --- /dev/null +++ b/Lang/Lua/First-class-functions-Use-numbers-analogously @@ -0,0 +1 @@ +../../Task/First-class-functions-Use-numbers-analogously/Lua \ No newline at end of file diff --git a/Lang/Lua/Five-weekends b/Lang/Lua/Five-weekends new file mode 120000 index 0000000000..12cba7693a --- /dev/null +++ b/Lang/Lua/Five-weekends @@ -0,0 +1 @@ +../../Task/Five-weekends/Lua \ No newline at end of file diff --git a/Lang/Lua/Generate-Chess960-starting-position b/Lang/Lua/Generate-Chess960-starting-position new file mode 120000 index 0000000000..20373e2d91 --- /dev/null +++ b/Lang/Lua/Generate-Chess960-starting-position @@ -0,0 +1 @@ +../../Task/Generate-Chess960-starting-position/Lua \ No newline at end of file diff --git a/Lang/Lua/Hello-world-Newbie b/Lang/Lua/Hello-world-Newbie new file mode 120000 index 0000000000..8a97c1e7b2 --- /dev/null +++ b/Lang/Lua/Hello-world-Newbie @@ -0,0 +1 @@ +../../Task/Hello-world-Newbie/Lua \ No newline at end of file diff --git a/Lang/Lua/Heronian-triangles b/Lang/Lua/Heronian-triangles new file mode 120000 index 0000000000..5f86b8248b --- /dev/null +++ b/Lang/Lua/Heronian-triangles @@ -0,0 +1 @@ +../../Task/Heronian-triangles/Lua \ No newline at end of file diff --git a/Lang/Lua/Holidays-related-to-Easter b/Lang/Lua/Holidays-related-to-Easter new file mode 120000 index 0000000000..10a7cf9e24 --- /dev/null +++ b/Lang/Lua/Holidays-related-to-Easter @@ -0,0 +1 @@ +../../Task/Holidays-related-to-Easter/Lua \ No newline at end of file diff --git a/Lang/Lua/I-before-E-except-after-C b/Lang/Lua/I-before-E-except-after-C new file mode 120000 index 0000000000..ba30018101 --- /dev/null +++ b/Lang/Lua/I-before-E-except-after-C @@ -0,0 +1 @@ +../../Task/I-before-E-except-after-C/Lua \ No newline at end of file diff --git a/Lang/Lua/IBAN b/Lang/Lua/IBAN new file mode 120000 index 0000000000..ccf2b23903 --- /dev/null +++ b/Lang/Lua/IBAN @@ -0,0 +1 @@ +../../Task/IBAN/Lua \ No newline at end of file diff --git a/Lang/Lua/Kaprekar-numbers b/Lang/Lua/Kaprekar-numbers new file mode 120000 index 0000000000..95871925bd --- /dev/null +++ b/Lang/Lua/Kaprekar-numbers @@ -0,0 +1 @@ +../../Task/Kaprekar-numbers/Lua \ No newline at end of file diff --git a/Lang/Lua/LZW-compression b/Lang/Lua/LZW-compression new file mode 120000 index 0000000000..4b61c84f61 --- /dev/null +++ b/Lang/Lua/LZW-compression @@ -0,0 +1 @@ +../../Task/LZW-compression/Lua \ No newline at end of file diff --git a/Lang/Lua/Last-Friday-of-each-month b/Lang/Lua/Last-Friday-of-each-month new file mode 120000 index 0000000000..9770ddff14 --- /dev/null +++ b/Lang/Lua/Last-Friday-of-each-month @@ -0,0 +1 @@ +../../Task/Last-Friday-of-each-month/Lua \ No newline at end of file diff --git a/Lang/Lua/Left-factorials b/Lang/Lua/Left-factorials new file mode 120000 index 0000000000..d935487376 --- /dev/null +++ b/Lang/Lua/Left-factorials @@ -0,0 +1 @@ +../../Task/Left-factorials/Lua \ No newline at end of file diff --git a/Lang/Lua/Ludic-numbers b/Lang/Lua/Ludic-numbers new file mode 120000 index 0000000000..89ecea8a65 --- /dev/null +++ b/Lang/Lua/Ludic-numbers @@ -0,0 +1 @@ +../../Task/Ludic-numbers/Lua \ No newline at end of file diff --git a/Lang/Lua/Matrix-arithmetic b/Lang/Lua/Matrix-arithmetic new file mode 120000 index 0000000000..282cb96da0 --- /dev/null +++ b/Lang/Lua/Matrix-arithmetic @@ -0,0 +1 @@ +../../Task/Matrix-arithmetic/Lua \ No newline at end of file diff --git a/Lang/Lua/Move-to-front-algorithm b/Lang/Lua/Move-to-front-algorithm new file mode 120000 index 0000000000..3bae429cce --- /dev/null +++ b/Lang/Lua/Move-to-front-algorithm @@ -0,0 +1 @@ +../../Task/Move-to-front-algorithm/Lua \ No newline at end of file diff --git a/Lang/Lua/Multifactorial b/Lang/Lua/Multifactorial new file mode 120000 index 0000000000..40a398113d --- /dev/null +++ b/Lang/Lua/Multifactorial @@ -0,0 +1 @@ +../../Task/Multifactorial/Lua \ No newline at end of file diff --git a/Lang/Lua/Multiple-distinct-objects b/Lang/Lua/Multiple-distinct-objects new file mode 120000 index 0000000000..7fc63235da --- /dev/null +++ b/Lang/Lua/Multiple-distinct-objects @@ -0,0 +1 @@ +../../Task/Multiple-distinct-objects/Lua \ No newline at end of file diff --git a/Lang/Lua/Multisplit b/Lang/Lua/Multisplit new file mode 120000 index 0000000000..6a302d8a46 --- /dev/null +++ b/Lang/Lua/Multisplit @@ -0,0 +1 @@ +../../Task/Multisplit/Lua \ No newline at end of file diff --git a/Lang/Lua/Narcissistic-decimal-number b/Lang/Lua/Narcissistic-decimal-number new file mode 120000 index 0000000000..7a2af5a2d9 --- /dev/null +++ b/Lang/Lua/Narcissistic-decimal-number @@ -0,0 +1 @@ +../../Task/Narcissistic-decimal-number/Lua \ No newline at end of file diff --git a/Lang/Lua/Non-decimal-radices-Convert b/Lang/Lua/Non-decimal-radices-Convert new file mode 120000 index 0000000000..85446e26cf --- /dev/null +++ b/Lang/Lua/Non-decimal-radices-Convert @@ -0,0 +1 @@ +../../Task/Non-decimal-radices-Convert/Lua \ No newline at end of file diff --git a/Lang/Lua/Optional-parameters b/Lang/Lua/Optional-parameters new file mode 120000 index 0000000000..a6a2e3d821 --- /dev/null +++ b/Lang/Lua/Optional-parameters @@ -0,0 +1 @@ +../../Task/Optional-parameters/Lua \ No newline at end of file diff --git a/Lang/Lua/Order-disjoint-list-items b/Lang/Lua/Order-disjoint-list-items new file mode 120000 index 0000000000..e602588956 --- /dev/null +++ b/Lang/Lua/Order-disjoint-list-items @@ -0,0 +1 @@ +../../Task/Order-disjoint-list-items/Lua \ No newline at end of file diff --git a/Lang/Lua/Permutations-Derangements b/Lang/Lua/Permutations-Derangements new file mode 120000 index 0000000000..a4c0ae5589 --- /dev/null +++ b/Lang/Lua/Permutations-Derangements @@ -0,0 +1 @@ +../../Task/Permutations-Derangements/Lua \ No newline at end of file diff --git a/Lang/Lua/Permutations-by-swapping b/Lang/Lua/Permutations-by-swapping new file mode 120000 index 0000000000..1d199962c6 --- /dev/null +++ b/Lang/Lua/Permutations-by-swapping @@ -0,0 +1 @@ +../../Task/Permutations-by-swapping/Lua \ No newline at end of file diff --git a/Lang/Lua/Pernicious-numbers b/Lang/Lua/Pernicious-numbers new file mode 120000 index 0000000000..6194177181 --- /dev/null +++ b/Lang/Lua/Pernicious-numbers @@ -0,0 +1 @@ +../../Task/Pernicious-numbers/Lua \ No newline at end of file diff --git a/Lang/Lua/Phrase-reversals b/Lang/Lua/Phrase-reversals new file mode 120000 index 0000000000..73e633751e --- /dev/null +++ b/Lang/Lua/Phrase-reversals @@ -0,0 +1 @@ +../../Task/Phrase-reversals/Lua \ No newline at end of file diff --git a/Lang/Lua/Pig-the-dice-game b/Lang/Lua/Pig-the-dice-game new file mode 120000 index 0000000000..a772fe1367 --- /dev/null +++ b/Lang/Lua/Pig-the-dice-game @@ -0,0 +1 @@ +../../Task/Pig-the-dice-game/Lua \ No newline at end of file diff --git a/Lang/Lua/Price-fraction b/Lang/Lua/Price-fraction new file mode 120000 index 0000000000..9c6232e043 --- /dev/null +++ b/Lang/Lua/Price-fraction @@ -0,0 +1 @@ +../../Task/Price-fraction/Lua \ No newline at end of file diff --git a/Lang/Lua/Quickselect-algorithm b/Lang/Lua/Quickselect-algorithm new file mode 120000 index 0000000000..51f7497537 --- /dev/null +++ b/Lang/Lua/Quickselect-algorithm @@ -0,0 +1 @@ +../../Task/Quickselect-algorithm/Lua \ No newline at end of file diff --git a/Lang/Lua/Range-extraction b/Lang/Lua/Range-extraction new file mode 120000 index 0000000000..4233532ef8 --- /dev/null +++ b/Lang/Lua/Range-extraction @@ -0,0 +1 @@ +../../Task/Range-extraction/Lua \ No newline at end of file diff --git a/Lang/Lua/Roots-of-a-function b/Lang/Lua/Roots-of-a-function new file mode 120000 index 0000000000..e0f318b43c --- /dev/null +++ b/Lang/Lua/Roots-of-a-function @@ -0,0 +1 @@ +../../Task/Roots-of-a-function/Lua \ No newline at end of file diff --git a/Lang/Lua/Self-referential-sequence b/Lang/Lua/Self-referential-sequence new file mode 120000 index 0000000000..6fd98eda14 --- /dev/null +++ b/Lang/Lua/Self-referential-sequence @@ -0,0 +1 @@ +../../Task/Self-referential-sequence/Lua \ No newline at end of file diff --git a/Lang/Lua/Semiprime b/Lang/Lua/Semiprime new file mode 120000 index 0000000000..cbb6c886e8 --- /dev/null +++ b/Lang/Lua/Semiprime @@ -0,0 +1 @@ +../../Task/Semiprime/Lua \ No newline at end of file diff --git a/Lang/Lua/Set b/Lang/Lua/Set new file mode 120000 index 0000000000..bc7b7bf81f --- /dev/null +++ b/Lang/Lua/Set @@ -0,0 +1 @@ +../../Task/Set/Lua \ No newline at end of file diff --git a/Lang/Lua/Show-the-epoch b/Lang/Lua/Show-the-epoch new file mode 120000 index 0000000000..d429f57034 --- /dev/null +++ b/Lang/Lua/Show-the-epoch @@ -0,0 +1 @@ +../../Task/Show-the-epoch/Lua \ No newline at end of file diff --git a/Lang/Lua/Sierpinski-triangle-Graphical b/Lang/Lua/Sierpinski-triangle-Graphical new file mode 120000 index 0000000000..6ecb79b00d --- /dev/null +++ b/Lang/Lua/Sierpinski-triangle-Graphical @@ -0,0 +1 @@ +../../Task/Sierpinski-triangle-Graphical/Lua \ No newline at end of file diff --git a/Lang/Lua/Sorting-algorithms-Bead-sort b/Lang/Lua/Sorting-algorithms-Bead-sort new file mode 120000 index 0000000000..630991817e --- /dev/null +++ b/Lang/Lua/Sorting-algorithms-Bead-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Bead-sort/Lua \ No newline at end of file diff --git a/Lang/Lua/Sorting-algorithms-Merge-sort b/Lang/Lua/Sorting-algorithms-Merge-sort new file mode 120000 index 0000000000..7697427748 --- /dev/null +++ b/Lang/Lua/Sorting-algorithms-Merge-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Merge-sort/Lua \ No newline at end of file diff --git a/Lang/Lua/Sorting-algorithms-Pancake-sort b/Lang/Lua/Sorting-algorithms-Pancake-sort new file mode 120000 index 0000000000..61d93e4b1c --- /dev/null +++ b/Lang/Lua/Sorting-algorithms-Pancake-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Pancake-sort/Lua \ No newline at end of file diff --git a/Lang/Lua/Stern-Brocot-sequence b/Lang/Lua/Stern-Brocot-sequence new file mode 120000 index 0000000000..b607fd5218 --- /dev/null +++ b/Lang/Lua/Stern-Brocot-sequence @@ -0,0 +1 @@ +../../Task/Stern-Brocot-sequence/Lua \ No newline at end of file diff --git a/Lang/Lua/String-append b/Lang/Lua/String-append new file mode 120000 index 0000000000..ffa0c223b2 --- /dev/null +++ b/Lang/Lua/String-append @@ -0,0 +1 @@ +../../Task/String-append/Lua \ No newline at end of file diff --git a/Lang/Lua/Textonyms b/Lang/Lua/Textonyms new file mode 120000 index 0000000000..6a5c7dc48e --- /dev/null +++ b/Lang/Lua/Textonyms @@ -0,0 +1 @@ +../../Task/Textonyms/Lua \ No newline at end of file diff --git a/Lang/Lua/Topswops b/Lang/Lua/Topswops new file mode 120000 index 0000000000..db0f12cd16 --- /dev/null +++ b/Lang/Lua/Topswops @@ -0,0 +1 @@ +../../Task/Topswops/Lua \ No newline at end of file diff --git a/Lang/Lua/Trabb-Pardo-Knuth-algorithm b/Lang/Lua/Trabb-Pardo-Knuth-algorithm new file mode 120000 index 0000000000..547ad51151 --- /dev/null +++ b/Lang/Lua/Trabb-Pardo-Knuth-algorithm @@ -0,0 +1 @@ +../../Task/Trabb-Pardo-Knuth-algorithm/Lua \ No newline at end of file diff --git a/Lang/Lua/Truncate-a-file b/Lang/Lua/Truncate-a-file new file mode 120000 index 0000000000..b9408eae8b --- /dev/null +++ b/Lang/Lua/Truncate-a-file @@ -0,0 +1 @@ +../../Task/Truncate-a-file/Lua \ No newline at end of file diff --git a/Lang/Lua/Universal-Turing-machine b/Lang/Lua/Universal-Turing-machine new file mode 120000 index 0000000000..6d5d8b28f3 --- /dev/null +++ b/Lang/Lua/Universal-Turing-machine @@ -0,0 +1 @@ +../../Task/Universal-Turing-machine/Lua \ No newline at end of file diff --git a/Lang/Lua/Unix-ls b/Lang/Lua/Unix-ls new file mode 120000 index 0000000000..b44add93f6 --- /dev/null +++ b/Lang/Lua/Unix-ls @@ -0,0 +1 @@ +../../Task/Unix-ls/Lua \ No newline at end of file diff --git a/Lang/Lua/Web-scraping b/Lang/Lua/Web-scraping new file mode 120000 index 0000000000..88f8e7517e --- /dev/null +++ b/Lang/Lua/Web-scraping @@ -0,0 +1 @@ +../../Task/Web-scraping/Lua \ No newline at end of file diff --git a/Lang/Lua/XML-DOM-serialization b/Lang/Lua/XML-DOM-serialization new file mode 120000 index 0000000000..235c751dbe --- /dev/null +++ b/Lang/Lua/XML-DOM-serialization @@ -0,0 +1 @@ +../../Task/XML-DOM-serialization/Lua \ No newline at end of file diff --git a/Lang/Lua/XML-Output b/Lang/Lua/XML-Output new file mode 120000 index 0000000000..f8a9907e24 --- /dev/null +++ b/Lang/Lua/XML-Output @@ -0,0 +1 @@ +../../Task/XML-Output/Lua \ No newline at end of file diff --git a/Lang/Lua/Zeckendorf-number-representation b/Lang/Lua/Zeckendorf-number-representation new file mode 120000 index 0000000000..e34686db12 --- /dev/null +++ b/Lang/Lua/Zeckendorf-number-representation @@ -0,0 +1 @@ +../../Task/Zeckendorf-number-representation/Lua \ No newline at end of file diff --git a/Lang/MATLAB/Documentation b/Lang/MATLAB/Documentation new file mode 120000 index 0000000000..370bdbc7a8 --- /dev/null +++ b/Lang/MATLAB/Documentation @@ -0,0 +1 @@ +../../Task/Documentation/MATLAB \ No newline at end of file diff --git a/Lang/MIPS-Assembly/99-Bottles-of-Beer b/Lang/MIPS-Assembly/99-Bottles-of-Beer new file mode 120000 index 0000000000..e82de5184b --- /dev/null +++ b/Lang/MIPS-Assembly/99-Bottles-of-Beer @@ -0,0 +1 @@ +../../Task/99-Bottles-of-Beer/MIPS-Assembly \ No newline at end of file diff --git a/Lang/MIPS-Assembly/Arrays b/Lang/MIPS-Assembly/Arrays new file mode 120000 index 0000000000..5df63102ef --- /dev/null +++ b/Lang/MIPS-Assembly/Arrays @@ -0,0 +1 @@ +../../Task/Arrays/MIPS-Assembly \ No newline at end of file diff --git a/Lang/MIPS-Assembly/Copy-a-string b/Lang/MIPS-Assembly/Copy-a-string new file mode 120000 index 0000000000..646856f82a --- /dev/null +++ b/Lang/MIPS-Assembly/Copy-a-string @@ -0,0 +1 @@ +../../Task/Copy-a-string/MIPS-Assembly \ No newline at end of file diff --git a/Lang/MIPS-Assembly/Determine-if-a-string-is-numeric b/Lang/MIPS-Assembly/Determine-if-a-string-is-numeric new file mode 120000 index 0000000000..09c4885170 --- /dev/null +++ b/Lang/MIPS-Assembly/Determine-if-a-string-is-numeric @@ -0,0 +1 @@ +../../Task/Determine-if-a-string-is-numeric/MIPS-Assembly \ No newline at end of file diff --git a/Lang/MIPS-Assembly/Empty-program b/Lang/MIPS-Assembly/Empty-program new file mode 120000 index 0000000000..e421bd976d --- /dev/null +++ b/Lang/MIPS-Assembly/Empty-program @@ -0,0 +1 @@ +../../Task/Empty-program/MIPS-Assembly \ No newline at end of file diff --git a/Lang/MIPS-Assembly/Even-or-odd b/Lang/MIPS-Assembly/Even-or-odd new file mode 120000 index 0000000000..71da68582b --- /dev/null +++ b/Lang/MIPS-Assembly/Even-or-odd @@ -0,0 +1 @@ +../../Task/Even-or-odd/MIPS-Assembly \ No newline at end of file diff --git a/Lang/MIPS-Assembly/Factorial b/Lang/MIPS-Assembly/Factorial new file mode 120000 index 0000000000..a3a742d000 --- /dev/null +++ b/Lang/MIPS-Assembly/Factorial @@ -0,0 +1 @@ +../../Task/Factorial/MIPS-Assembly \ No newline at end of file diff --git a/Lang/MIPS-Assembly/Fibonacci-sequence b/Lang/MIPS-Assembly/Fibonacci-sequence new file mode 120000 index 0000000000..dc6aa3bd17 --- /dev/null +++ b/Lang/MIPS-Assembly/Fibonacci-sequence @@ -0,0 +1 @@ +../../Task/Fibonacci-sequence/MIPS-Assembly \ No newline at end of file diff --git a/Lang/MIPS-Assembly/FizzBuzz b/Lang/MIPS-Assembly/FizzBuzz new file mode 120000 index 0000000000..fe96af6d1d --- /dev/null +++ b/Lang/MIPS-Assembly/FizzBuzz @@ -0,0 +1 @@ +../../Task/FizzBuzz/MIPS-Assembly \ No newline at end of file diff --git a/Lang/MIPS-Assembly/Guess-the-number b/Lang/MIPS-Assembly/Guess-the-number new file mode 120000 index 0000000000..399b9c35e1 --- /dev/null +++ b/Lang/MIPS-Assembly/Guess-the-number @@ -0,0 +1 @@ +../../Task/Guess-the-number/MIPS-Assembly \ No newline at end of file diff --git a/Lang/MIPS-Assembly/Loops-Do-while b/Lang/MIPS-Assembly/Loops-Do-while new file mode 120000 index 0000000000..cffdebcf4c --- /dev/null +++ b/Lang/MIPS-Assembly/Loops-Do-while @@ -0,0 +1 @@ +../../Task/Loops-Do-while/MIPS-Assembly \ No newline at end of file diff --git a/Lang/MIPS-Assembly/Reverse-a-string b/Lang/MIPS-Assembly/Reverse-a-string new file mode 120000 index 0000000000..45911eb6a6 --- /dev/null +++ b/Lang/MIPS-Assembly/Reverse-a-string @@ -0,0 +1 @@ +../../Task/Reverse-a-string/MIPS-Assembly \ No newline at end of file diff --git a/Lang/MIPS-Assembly/String-length b/Lang/MIPS-Assembly/String-length new file mode 120000 index 0000000000..da295c8b7f --- /dev/null +++ b/Lang/MIPS-Assembly/String-length @@ -0,0 +1 @@ +../../Task/String-length/MIPS-Assembly \ No newline at end of file diff --git a/Lang/MUMPS/Middle-three-digits b/Lang/MUMPS/Middle-three-digits new file mode 120000 index 0000000000..165894891a --- /dev/null +++ b/Lang/MUMPS/Middle-three-digits @@ -0,0 +1 @@ +../../Task/Middle-three-digits/MUMPS \ No newline at end of file diff --git a/Lang/Maple/24-game b/Lang/Maple/24-game new file mode 120000 index 0000000000..490858a6cb --- /dev/null +++ b/Lang/Maple/24-game @@ -0,0 +1 @@ +../../Task/24-game/Maple \ No newline at end of file diff --git a/Lang/Maple/ABC-Problem b/Lang/Maple/ABC-Problem new file mode 120000 index 0000000000..e189d2379d --- /dev/null +++ b/Lang/Maple/ABC-Problem @@ -0,0 +1 @@ +../../Task/ABC-Problem/Maple \ No newline at end of file diff --git a/Lang/Maple/Address-of-a-variable b/Lang/Maple/Address-of-a-variable new file mode 120000 index 0000000000..4dd50e704c --- /dev/null +++ b/Lang/Maple/Address-of-a-variable @@ -0,0 +1 @@ +../../Task/Address-of-a-variable/Maple \ No newline at end of file diff --git a/Lang/Maple/Arrays b/Lang/Maple/Arrays new file mode 120000 index 0000000000..b960144c5d --- /dev/null +++ b/Lang/Maple/Arrays @@ -0,0 +1 @@ +../../Task/Arrays/Maple \ No newline at end of file diff --git a/Lang/Maple/Bulls-and-cows b/Lang/Maple/Bulls-and-cows new file mode 120000 index 0000000000..acaf617f2a --- /dev/null +++ b/Lang/Maple/Bulls-and-cows @@ -0,0 +1 @@ +../../Task/Bulls-and-cows/Maple \ No newline at end of file diff --git a/Lang/Maple/Circles-of-given-radius-through-two-points b/Lang/Maple/Circles-of-given-radius-through-two-points new file mode 120000 index 0000000000..b666d5e66d --- /dev/null +++ b/Lang/Maple/Circles-of-given-radius-through-two-points @@ -0,0 +1 @@ +../../Task/Circles-of-given-radius-through-two-points/Maple \ No newline at end of file diff --git a/Lang/Maple/Count-in-factors b/Lang/Maple/Count-in-factors new file mode 120000 index 0000000000..70dccd4a98 --- /dev/null +++ b/Lang/Maple/Count-in-factors @@ -0,0 +1 @@ +../../Task/Count-in-factors/Maple \ No newline at end of file diff --git a/Lang/Maple/Determine-if-a-string-is-numeric b/Lang/Maple/Determine-if-a-string-is-numeric new file mode 120000 index 0000000000..efae507cd0 --- /dev/null +++ b/Lang/Maple/Determine-if-a-string-is-numeric @@ -0,0 +1 @@ +../../Task/Determine-if-a-string-is-numeric/Maple \ No newline at end of file diff --git a/Lang/Maple/Discordian-date b/Lang/Maple/Discordian-date new file mode 120000 index 0000000000..5a6b47b532 --- /dev/null +++ b/Lang/Maple/Discordian-date @@ -0,0 +1 @@ +../../Task/Discordian-date/Maple \ No newline at end of file diff --git a/Lang/Maple/Draw-a-sphere b/Lang/Maple/Draw-a-sphere new file mode 120000 index 0000000000..795c0e3729 --- /dev/null +++ b/Lang/Maple/Draw-a-sphere @@ -0,0 +1 @@ +../../Task/Draw-a-sphere/Maple \ No newline at end of file diff --git a/Lang/Maple/Fibonacci-n-step-number-sequences b/Lang/Maple/Fibonacci-n-step-number-sequences new file mode 120000 index 0000000000..264beff539 --- /dev/null +++ b/Lang/Maple/Fibonacci-n-step-number-sequences @@ -0,0 +1 @@ +../../Task/Fibonacci-n-step-number-sequences/Maple \ No newline at end of file diff --git a/Lang/Maple/Fibonacci-sequence b/Lang/Maple/Fibonacci-sequence new file mode 120000 index 0000000000..aca34e50df --- /dev/null +++ b/Lang/Maple/Fibonacci-sequence @@ -0,0 +1 @@ +../../Task/Fibonacci-sequence/Maple \ No newline at end of file diff --git a/Lang/Maple/File-size b/Lang/Maple/File-size new file mode 120000 index 0000000000..02101611bb --- /dev/null +++ b/Lang/Maple/File-size @@ -0,0 +1 @@ +../../Task/File-size/Maple \ No newline at end of file diff --git a/Lang/Maple/Flipping-bits-game b/Lang/Maple/Flipping-bits-game new file mode 120000 index 0000000000..dd568f09b3 --- /dev/null +++ b/Lang/Maple/Flipping-bits-game @@ -0,0 +1 @@ +../../Task/Flipping-bits-game/Maple \ No newline at end of file diff --git a/Lang/Maple/Floyds-triangle b/Lang/Maple/Floyds-triangle new file mode 120000 index 0000000000..9f74710ad7 --- /dev/null +++ b/Lang/Maple/Floyds-triangle @@ -0,0 +1 @@ +../../Task/Floyds-triangle/Maple \ No newline at end of file diff --git a/Lang/Maple/Formatted-numeric-output b/Lang/Maple/Formatted-numeric-output new file mode 120000 index 0000000000..ec93401f2e --- /dev/null +++ b/Lang/Maple/Formatted-numeric-output @@ -0,0 +1 @@ +../../Task/Formatted-numeric-output/Maple \ No newline at end of file diff --git a/Lang/Maple/Function-definition b/Lang/Maple/Function-definition new file mode 120000 index 0000000000..fa41c47168 --- /dev/null +++ b/Lang/Maple/Function-definition @@ -0,0 +1 @@ +../../Task/Function-definition/Maple \ No newline at end of file diff --git a/Lang/Maple/Increment-a-numerical-string b/Lang/Maple/Increment-a-numerical-string new file mode 120000 index 0000000000..9aa2ec26b9 --- /dev/null +++ b/Lang/Maple/Increment-a-numerical-string @@ -0,0 +1 @@ +../../Task/Increment-a-numerical-string/Maple \ No newline at end of file diff --git a/Lang/Maple/Integer-comparison b/Lang/Maple/Integer-comparison new file mode 120000 index 0000000000..b55960e706 --- /dev/null +++ b/Lang/Maple/Integer-comparison @@ -0,0 +1 @@ +../../Task/Integer-comparison/Maple \ No newline at end of file diff --git a/Lang/Maple/Leap-year b/Lang/Maple/Leap-year new file mode 120000 index 0000000000..a1f9e18d3f --- /dev/null +++ b/Lang/Maple/Leap-year @@ -0,0 +1 @@ +../../Task/Leap-year/Maple \ No newline at end of file diff --git a/Lang/Maple/Middle-three-digits b/Lang/Maple/Middle-three-digits new file mode 120000 index 0000000000..b9d2de1b87 --- /dev/null +++ b/Lang/Maple/Middle-three-digits @@ -0,0 +1 @@ +../../Task/Middle-three-digits/Maple \ No newline at end of file diff --git a/Lang/Maple/Multiplication-tables b/Lang/Maple/Multiplication-tables new file mode 120000 index 0000000000..6906bb4449 --- /dev/null +++ b/Lang/Maple/Multiplication-tables @@ -0,0 +1 @@ +../../Task/Multiplication-tables/Maple \ No newline at end of file diff --git a/Lang/Maple/Named-parameters b/Lang/Maple/Named-parameters new file mode 120000 index 0000000000..f9b52686a9 --- /dev/null +++ b/Lang/Maple/Named-parameters @@ -0,0 +1 @@ +../../Task/Named-parameters/Maple \ No newline at end of file diff --git a/Lang/Maple/Nth b/Lang/Maple/Nth new file mode 120000 index 0000000000..d28fb45641 --- /dev/null +++ b/Lang/Maple/Nth @@ -0,0 +1 @@ +../../Task/Nth/Maple \ No newline at end of file diff --git a/Lang/Maple/Null-object b/Lang/Maple/Null-object new file mode 120000 index 0000000000..fdf1f4fb63 --- /dev/null +++ b/Lang/Maple/Null-object @@ -0,0 +1 @@ +../../Task/Null-object/Maple \ No newline at end of file diff --git a/Lang/Maple/Old-lady-swallowed-a-fly b/Lang/Maple/Old-lady-swallowed-a-fly new file mode 120000 index 0000000000..edaa030bec --- /dev/null +++ b/Lang/Maple/Old-lady-swallowed-a-fly @@ -0,0 +1 @@ +../../Task/Old-lady-swallowed-a-fly/Maple \ No newline at end of file diff --git a/Lang/Maple/Pascals-triangle b/Lang/Maple/Pascals-triangle new file mode 120000 index 0000000000..8187dc7bcd --- /dev/null +++ b/Lang/Maple/Pascals-triangle @@ -0,0 +1 @@ +../../Task/Pascals-triangle/Maple \ No newline at end of file diff --git a/Lang/Maple/Pick-random-element b/Lang/Maple/Pick-random-element new file mode 120000 index 0000000000..52e2787f9d --- /dev/null +++ b/Lang/Maple/Pick-random-element @@ -0,0 +1 @@ +../../Task/Pick-random-element/Maple \ No newline at end of file diff --git a/Lang/Maple/Pig-the-dice-game b/Lang/Maple/Pig-the-dice-game new file mode 120000 index 0000000000..dea24cf48c --- /dev/null +++ b/Lang/Maple/Pig-the-dice-game @@ -0,0 +1 @@ +../../Task/Pig-the-dice-game/Maple \ No newline at end of file diff --git a/Lang/Maple/Price-fraction b/Lang/Maple/Price-fraction new file mode 120000 index 0000000000..82632d74bd --- /dev/null +++ b/Lang/Maple/Price-fraction @@ -0,0 +1 @@ +../../Task/Price-fraction/Maple \ No newline at end of file diff --git a/Lang/Maple/Random-numbers b/Lang/Maple/Random-numbers new file mode 120000 index 0000000000..556275d5cc --- /dev/null +++ b/Lang/Maple/Random-numbers @@ -0,0 +1 @@ +../../Task/Random-numbers/Maple \ No newline at end of file diff --git a/Lang/Maple/Roman-numerals-Decode b/Lang/Maple/Roman-numerals-Decode new file mode 120000 index 0000000000..519d2d3fe7 --- /dev/null +++ b/Lang/Maple/Roman-numerals-Decode @@ -0,0 +1 @@ +../../Task/Roman-numerals-Decode/Maple \ No newline at end of file diff --git a/Lang/Maple/Sierpinski-triangle b/Lang/Maple/Sierpinski-triangle new file mode 120000 index 0000000000..592055611e --- /dev/null +++ b/Lang/Maple/Sierpinski-triangle @@ -0,0 +1 @@ +../../Task/Sierpinski-triangle/Maple \ No newline at end of file diff --git a/Lang/Maple/Statistics-Basic b/Lang/Maple/Statistics-Basic new file mode 120000 index 0000000000..8d81cd428d --- /dev/null +++ b/Lang/Maple/Statistics-Basic @@ -0,0 +1 @@ +../../Task/Statistics-Basic/Maple \ No newline at end of file diff --git a/Lang/Maple/String-append b/Lang/Maple/String-append new file mode 120000 index 0000000000..a69a0a4821 --- /dev/null +++ b/Lang/Maple/String-append @@ -0,0 +1 @@ +../../Task/String-append/Maple \ No newline at end of file diff --git a/Lang/Maple/String-prepend b/Lang/Maple/String-prepend new file mode 120000 index 0000000000..6281b98d98 --- /dev/null +++ b/Lang/Maple/String-prepend @@ -0,0 +1 @@ +../../Task/String-prepend/Maple \ No newline at end of file diff --git a/Lang/Maple/Sum-and-product-of-an-array b/Lang/Maple/Sum-and-product-of-an-array new file mode 120000 index 0000000000..f441bc7585 --- /dev/null +++ b/Lang/Maple/Sum-and-product-of-an-array @@ -0,0 +1 @@ +../../Task/Sum-and-product-of-an-array/Maple \ No newline at end of file diff --git a/Lang/Maple/Sum-digits-of-an-integer b/Lang/Maple/Sum-digits-of-an-integer new file mode 120000 index 0000000000..26a4520677 --- /dev/null +++ b/Lang/Maple/Sum-digits-of-an-integer @@ -0,0 +1 @@ +../../Task/Sum-digits-of-an-integer/Maple \ No newline at end of file diff --git a/Lang/Maple/Temperature-conversion b/Lang/Maple/Temperature-conversion new file mode 120000 index 0000000000..428d3e151b --- /dev/null +++ b/Lang/Maple/Temperature-conversion @@ -0,0 +1 @@ +../../Task/Temperature-conversion/Maple \ No newline at end of file diff --git a/Lang/Maple/The-Twelve-Days-of-Christmas b/Lang/Maple/The-Twelve-Days-of-Christmas new file mode 120000 index 0000000000..4a778b3989 --- /dev/null +++ b/Lang/Maple/The-Twelve-Days-of-Christmas @@ -0,0 +1 @@ +../../Task/The-Twelve-Days-of-Christmas/Maple \ No newline at end of file diff --git a/Lang/Maple/Time-a-function b/Lang/Maple/Time-a-function new file mode 120000 index 0000000000..b7969907c0 --- /dev/null +++ b/Lang/Maple/Time-a-function @@ -0,0 +1 @@ +../../Task/Time-a-function/Maple \ No newline at end of file diff --git a/Lang/Maple/User-input-Text b/Lang/Maple/User-input-Text new file mode 120000 index 0000000000..3eefa820eb --- /dev/null +++ b/Lang/Maple/User-input-Text @@ -0,0 +1 @@ +../../Task/User-input-Text/Maple \ No newline at end of file diff --git a/Lang/Maple/Variables b/Lang/Maple/Variables new file mode 120000 index 0000000000..135a249300 --- /dev/null +++ b/Lang/Maple/Variables @@ -0,0 +1 @@ +../../Task/Variables/Maple \ No newline at end of file diff --git a/Lang/Mathematica/Percolation-Mean-run-density b/Lang/Mathematica/Percolation-Mean-run-density new file mode 120000 index 0000000000..b942fb423f --- /dev/null +++ b/Lang/Mathematica/Percolation-Mean-run-density @@ -0,0 +1 @@ +../../Task/Percolation-Mean-run-density/Mathematica \ No newline at end of file diff --git a/Lang/Mathematica/Ranking-methods b/Lang/Mathematica/Ranking-methods new file mode 120000 index 0000000000..84678071a4 --- /dev/null +++ b/Lang/Mathematica/Ranking-methods @@ -0,0 +1 @@ +../../Task/Ranking-methods/Mathematica \ No newline at end of file diff --git a/Lang/Mercury/99-Bottles-of-Beer b/Lang/Mercury/99-Bottles-of-Beer new file mode 120000 index 0000000000..7c9ea61302 --- /dev/null +++ b/Lang/Mercury/99-Bottles-of-Beer @@ -0,0 +1 @@ +../../Task/99-Bottles-of-Beer/Mercury \ No newline at end of file diff --git a/Lang/Mercury/Read-a-file-line-by-line b/Lang/Mercury/Read-a-file-line-by-line new file mode 120000 index 0000000000..0bf01a153d --- /dev/null +++ b/Lang/Mercury/Read-a-file-line-by-line @@ -0,0 +1 @@ +../../Task/Read-a-file-line-by-line/Mercury \ No newline at end of file diff --git a/Lang/Mercury/Write-float-arrays-to-a-text-file b/Lang/Mercury/Write-float-arrays-to-a-text-file new file mode 120000 index 0000000000..212d64f0be --- /dev/null +++ b/Lang/Mercury/Write-float-arrays-to-a-text-file @@ -0,0 +1 @@ +../../Task/Write-float-arrays-to-a-text-file/Mercury \ No newline at end of file diff --git a/Lang/Modula-2/Permutations b/Lang/Modula-2/Permutations new file mode 120000 index 0000000000..bde8efe166 --- /dev/null +++ b/Lang/Modula-2/Permutations @@ -0,0 +1 @@ +../../Task/Permutations/Modula-2 \ No newline at end of file diff --git a/Lang/Neko/Even-or-odd b/Lang/Neko/Even-or-odd new file mode 120000 index 0000000000..9a29685aa8 --- /dev/null +++ b/Lang/Neko/Even-or-odd @@ -0,0 +1 @@ +../../Task/Even-or-odd/Neko \ No newline at end of file diff --git a/Lang/Neko/Factorial b/Lang/Neko/Factorial new file mode 120000 index 0000000000..ffc440250b --- /dev/null +++ b/Lang/Neko/Factorial @@ -0,0 +1 @@ +../../Task/Factorial/Neko \ No newline at end of file diff --git a/Lang/NetLogo/Universal-Turing-machine b/Lang/NetLogo/Universal-Turing-machine new file mode 120000 index 0000000000..c993665632 --- /dev/null +++ b/Lang/NetLogo/Universal-Turing-machine @@ -0,0 +1 @@ +../../Task/Universal-Turing-machine/NetLogo \ No newline at end of file diff --git a/Lang/NewLISP/100-doors b/Lang/NewLISP/100-doors new file mode 120000 index 0000000000..b646e267d9 --- /dev/null +++ b/Lang/NewLISP/100-doors @@ -0,0 +1 @@ +../../Task/100-doors/NewLISP \ No newline at end of file diff --git a/Lang/NewLISP/Five-weekends b/Lang/NewLISP/Five-weekends new file mode 120000 index 0000000000..a94f13a8a6 --- /dev/null +++ b/Lang/NewLISP/Five-weekends @@ -0,0 +1 @@ +../../Task/Five-weekends/NewLISP \ No newline at end of file diff --git a/Lang/NewLISP/Make-directory-path b/Lang/NewLISP/Make-directory-path new file mode 120000 index 0000000000..6baf4f9c80 --- /dev/null +++ b/Lang/NewLISP/Make-directory-path @@ -0,0 +1 @@ +../../Task/Make-directory-path/NewLISP \ No newline at end of file diff --git a/Lang/NewLISP/Pangram-checker b/Lang/NewLISP/Pangram-checker new file mode 120000 index 0000000000..1ca5616c85 --- /dev/null +++ b/Lang/NewLISP/Pangram-checker @@ -0,0 +1 @@ +../../Task/Pangram-checker/NewLISP \ No newline at end of file diff --git a/Lang/NewLISP/Remove-lines-from-a-file b/Lang/NewLISP/Remove-lines-from-a-file new file mode 120000 index 0000000000..b997d1471a --- /dev/null +++ b/Lang/NewLISP/Remove-lines-from-a-file @@ -0,0 +1 @@ +../../Task/Remove-lines-from-a-file/NewLISP \ No newline at end of file diff --git a/Lang/NewLISP/Sockets b/Lang/NewLISP/Sockets new file mode 120000 index 0000000000..50a06f2297 --- /dev/null +++ b/Lang/NewLISP/Sockets @@ -0,0 +1 @@ +../../Task/Sockets/NewLISP \ No newline at end of file diff --git a/Lang/NewLISP/Zero-to-the-zero-power b/Lang/NewLISP/Zero-to-the-zero-power new file mode 120000 index 0000000000..e86c9a30d7 --- /dev/null +++ b/Lang/NewLISP/Zero-to-the-zero-power @@ -0,0 +1 @@ +../../Task/Zero-to-the-zero-power/NewLISP \ No newline at end of file diff --git a/Lang/OCaml/AKS-test-for-primes b/Lang/OCaml/AKS-test-for-primes new file mode 120000 index 0000000000..745b4b349a --- /dev/null +++ b/Lang/OCaml/AKS-test-for-primes @@ -0,0 +1 @@ +../../Task/AKS-test-for-primes/OCaml \ No newline at end of file diff --git a/Lang/OCaml/Benfords-law b/Lang/OCaml/Benfords-law new file mode 120000 index 0000000000..6b80acbbea --- /dev/null +++ b/Lang/OCaml/Benfords-law @@ -0,0 +1 @@ +../../Task/Benfords-law/OCaml \ No newline at end of file diff --git a/Lang/OCaml/Fractran b/Lang/OCaml/Fractran new file mode 120000 index 0000000000..3773695965 --- /dev/null +++ b/Lang/OCaml/Fractran @@ -0,0 +1 @@ +../../Task/Fractran/OCaml \ No newline at end of file diff --git a/Lang/OCaml/Hamming-numbers b/Lang/OCaml/Hamming-numbers new file mode 120000 index 0000000000..76d8b6e1a4 --- /dev/null +++ b/Lang/OCaml/Hamming-numbers @@ -0,0 +1 @@ +../../Task/Hamming-numbers/OCaml \ No newline at end of file diff --git a/Lang/OCaml/IBAN b/Lang/OCaml/IBAN new file mode 120000 index 0000000000..bf5f1f769d --- /dev/null +++ b/Lang/OCaml/IBAN @@ -0,0 +1 @@ +../../Task/IBAN/OCaml \ No newline at end of file diff --git a/Lang/Oberon-2/Apply-a-callback-to-an-array b/Lang/Oberon-2/Apply-a-callback-to-an-array new file mode 120000 index 0000000000..6a0d530bd3 --- /dev/null +++ b/Lang/Oberon-2/Apply-a-callback-to-an-array @@ -0,0 +1 @@ +../../Task/Apply-a-callback-to-an-array/Oberon-2 \ No newline at end of file diff --git a/Lang/Oberon-2/Arithmetic-geometric-mean b/Lang/Oberon-2/Arithmetic-geometric-mean new file mode 120000 index 0000000000..7950991d82 --- /dev/null +++ b/Lang/Oberon-2/Arithmetic-geometric-mean @@ -0,0 +1 @@ +../../Task/Arithmetic-geometric-mean/Oberon-2 \ No newline at end of file diff --git a/Lang/Oberon-2/Averages-Mean-time-of-day b/Lang/Oberon-2/Averages-Mean-time-of-day new file mode 120000 index 0000000000..2e45ca3c9b --- /dev/null +++ b/Lang/Oberon-2/Averages-Mean-time-of-day @@ -0,0 +1 @@ +../../Task/Averages-Mean-time-of-day/Oberon-2 \ No newline at end of file diff --git a/Lang/Oberon-2/Averages-Mode b/Lang/Oberon-2/Averages-Mode new file mode 120000 index 0000000000..48dd9cf166 --- /dev/null +++ b/Lang/Oberon-2/Averages-Mode @@ -0,0 +1 @@ +../../Task/Averages-Mode/Oberon-2 \ No newline at end of file diff --git a/Lang/Oberon-2/Balanced-brackets b/Lang/Oberon-2/Balanced-brackets new file mode 120000 index 0000000000..be20230b44 --- /dev/null +++ b/Lang/Oberon-2/Balanced-brackets @@ -0,0 +1 @@ +../../Task/Balanced-brackets/Oberon-2 \ No newline at end of file diff --git a/Lang/Oberon-2/Benfords-law b/Lang/Oberon-2/Benfords-law new file mode 120000 index 0000000000..6df7ec4d7e --- /dev/null +++ b/Lang/Oberon-2/Benfords-law @@ -0,0 +1 @@ +../../Task/Benfords-law/Oberon-2 \ No newline at end of file diff --git a/Lang/Oberon-2/Bitwise-operations b/Lang/Oberon-2/Bitwise-operations new file mode 120000 index 0000000000..b0ac99b523 --- /dev/null +++ b/Lang/Oberon-2/Bitwise-operations @@ -0,0 +1 @@ +../../Task/Bitwise-operations/Oberon-2 \ No newline at end of file diff --git a/Lang/Oberon-2/Comma-quibbling b/Lang/Oberon-2/Comma-quibbling new file mode 120000 index 0000000000..ad57987046 --- /dev/null +++ b/Lang/Oberon-2/Comma-quibbling @@ -0,0 +1 @@ +../../Task/Comma-quibbling/Oberon-2 \ No newline at end of file diff --git a/Lang/Oberon-2/Count-in-octal b/Lang/Oberon-2/Count-in-octal new file mode 120000 index 0000000000..f716bfe8ff --- /dev/null +++ b/Lang/Oberon-2/Count-in-octal @@ -0,0 +1 @@ +../../Task/Count-in-octal/Oberon-2 \ No newline at end of file diff --git a/Lang/Oberon-2/DNS-query b/Lang/Oberon-2/DNS-query new file mode 120000 index 0000000000..6ae2231fbb --- /dev/null +++ b/Lang/Oberon-2/DNS-query @@ -0,0 +1 @@ +../../Task/DNS-query/Oberon-2 \ No newline at end of file diff --git a/Lang/Oberon-2/Dot-product b/Lang/Oberon-2/Dot-product new file mode 120000 index 0000000000..af9fc791a5 --- /dev/null +++ b/Lang/Oberon-2/Dot-product @@ -0,0 +1 @@ +../../Task/Dot-product/Oberon-2 \ No newline at end of file diff --git a/Lang/Oberon-2/Even-or-odd b/Lang/Oberon-2/Even-or-odd new file mode 120000 index 0000000000..9337f5c322 --- /dev/null +++ b/Lang/Oberon-2/Even-or-odd @@ -0,0 +1 @@ +../../Task/Even-or-odd/Oberon-2 \ No newline at end of file diff --git a/Lang/Oberon-2/Fibonacci-sequence b/Lang/Oberon-2/Fibonacci-sequence new file mode 120000 index 0000000000..eece6514a5 --- /dev/null +++ b/Lang/Oberon-2/Fibonacci-sequence @@ -0,0 +1 @@ +../../Task/Fibonacci-sequence/Oberon-2 \ No newline at end of file diff --git a/Lang/Oberon-2/Horners-rule-for-polynomial-evaluation b/Lang/Oberon-2/Horners-rule-for-polynomial-evaluation new file mode 120000 index 0000000000..81a9029231 --- /dev/null +++ b/Lang/Oberon-2/Horners-rule-for-polynomial-evaluation @@ -0,0 +1 @@ +../../Task/Horners-rule-for-polynomial-evaluation/Oberon-2 \ No newline at end of file diff --git a/Lang/Oberon-2/Huffman-coding b/Lang/Oberon-2/Huffman-coding new file mode 120000 index 0000000000..08c4694c40 --- /dev/null +++ b/Lang/Oberon-2/Huffman-coding @@ -0,0 +1 @@ +../../Task/Huffman-coding/Oberon-2 \ No newline at end of file diff --git a/Lang/Oberon-2/Null-object b/Lang/Oberon-2/Null-object new file mode 120000 index 0000000000..786dd0d880 --- /dev/null +++ b/Lang/Oberon-2/Null-object @@ -0,0 +1 @@ +../../Task/Null-object/Oberon-2 \ No newline at end of file diff --git a/Lang/Oberon-2/Stack b/Lang/Oberon-2/Stack new file mode 120000 index 0000000000..72fc2d1dd2 --- /dev/null +++ b/Lang/Oberon-2/Stack @@ -0,0 +1 @@ +../../Task/Stack/Oberon-2 \ No newline at end of file diff --git a/Lang/Objeck/99-Bottles-of-Beer b/Lang/Objeck/99-Bottles-of-Beer new file mode 120000 index 0000000000..7462432663 --- /dev/null +++ b/Lang/Objeck/99-Bottles-of-Beer @@ -0,0 +1 @@ +../../Task/99-Bottles-of-Beer/Objeck \ No newline at end of file diff --git a/Lang/Objeck/Catamorphism b/Lang/Objeck/Catamorphism new file mode 120000 index 0000000000..da1d636d59 --- /dev/null +++ b/Lang/Objeck/Catamorphism @@ -0,0 +1 @@ +../../Task/Catamorphism/Objeck \ No newline at end of file diff --git a/Lang/Objeck/Empty-directory b/Lang/Objeck/Empty-directory new file mode 120000 index 0000000000..5c99bf1c88 --- /dev/null +++ b/Lang/Objeck/Empty-directory @@ -0,0 +1 @@ +../../Task/Empty-directory/Objeck \ No newline at end of file diff --git a/Lang/Objeck/Towers-of-Hanoi b/Lang/Objeck/Towers-of-Hanoi new file mode 120000 index 0000000000..9c542d8c34 --- /dev/null +++ b/Lang/Objeck/Towers-of-Hanoi @@ -0,0 +1 @@ +../../Task/Towers-of-Hanoi/Objeck \ No newline at end of file diff --git a/Lang/Onyx/100-doors b/Lang/Onyx/100-doors new file mode 120000 index 0000000000..c2018de3ae --- /dev/null +++ b/Lang/Onyx/100-doors @@ -0,0 +1 @@ +../../Task/100-doors/Onyx \ No newline at end of file diff --git a/Lang/Onyx/99-Bottles-of-Beer b/Lang/Onyx/99-Bottles-of-Beer new file mode 120000 index 0000000000..fb1ed8ca55 --- /dev/null +++ b/Lang/Onyx/99-Bottles-of-Beer @@ -0,0 +1 @@ +../../Task/99-Bottles-of-Beer/Onyx \ No newline at end of file diff --git a/Lang/Onyx/A+B b/Lang/Onyx/A+B new file mode 120000 index 0000000000..7683790576 --- /dev/null +++ b/Lang/Onyx/A+B @@ -0,0 +1 @@ +../../Task/A+B/Onyx \ No newline at end of file diff --git a/Lang/Onyx/Arithmetic-Integer b/Lang/Onyx/Arithmetic-Integer new file mode 120000 index 0000000000..58acce76aa --- /dev/null +++ b/Lang/Onyx/Arithmetic-Integer @@ -0,0 +1 @@ +../../Task/Arithmetic-Integer/Onyx \ No newline at end of file diff --git a/Lang/Onyx/Array-concatenation b/Lang/Onyx/Array-concatenation new file mode 120000 index 0000000000..63ae36cb33 --- /dev/null +++ b/Lang/Onyx/Array-concatenation @@ -0,0 +1 @@ +../../Task/Array-concatenation/Onyx \ No newline at end of file diff --git a/Lang/Onyx/Loops-For b/Lang/Onyx/Loops-For new file mode 120000 index 0000000000..fcf9a742a0 --- /dev/null +++ b/Lang/Onyx/Loops-For @@ -0,0 +1 @@ +../../Task/Loops-For/Onyx \ No newline at end of file diff --git a/Lang/OoRexx/Horizontal-sundial-calculations b/Lang/OoRexx/Horizontal-sundial-calculations new file mode 120000 index 0000000000..91ade97771 --- /dev/null +++ b/Lang/OoRexx/Horizontal-sundial-calculations @@ -0,0 +1 @@ +../../Task/Horizontal-sundial-calculations/OoRexx \ No newline at end of file diff --git a/Lang/OoRexx/Nautical-bell b/Lang/OoRexx/Nautical-bell new file mode 120000 index 0000000000..74b0cce0d7 --- /dev/null +++ b/Lang/OoRexx/Nautical-bell @@ -0,0 +1 @@ +../../Task/Nautical-bell/OoRexx \ No newline at end of file diff --git a/Lang/OoRexx/Roots-of-unity b/Lang/OoRexx/Roots-of-unity new file mode 120000 index 0000000000..63fe2a78bd --- /dev/null +++ b/Lang/OoRexx/Roots-of-unity @@ -0,0 +1 @@ +../../Task/Roots-of-unity/OoRexx \ No newline at end of file diff --git a/Lang/OpenEdge-Progress/ABC-Problem b/Lang/OpenEdge-Progress/ABC-Problem new file mode 120000 index 0000000000..4f9cc249f0 --- /dev/null +++ b/Lang/OpenEdge-Progress/ABC-Problem @@ -0,0 +1 @@ +../../Task/ABC-Problem/OpenEdge-Progress \ No newline at end of file diff --git a/Lang/OpenEdge-Progress/Mandelbrot-set b/Lang/OpenEdge-Progress/Mandelbrot-set new file mode 120000 index 0000000000..2f900b1f04 --- /dev/null +++ b/Lang/OpenEdge-Progress/Mandelbrot-set @@ -0,0 +1 @@ +../../Task/Mandelbrot-set/OpenEdge-Progress \ No newline at end of file diff --git a/Lang/Openscad/Dragon-curve b/Lang/Openscad/Dragon-curve new file mode 120000 index 0000000000..1fec07472a --- /dev/null +++ b/Lang/Openscad/Dragon-curve @@ -0,0 +1 @@ +../../Task/Dragon-curve/Openscad \ No newline at end of file diff --git a/Lang/Oz/00DESCRIPTION b/Lang/Oz/00DESCRIPTION index 3e8d0187a6..31a6626c9c 100644 --- a/Lang/Oz/00DESCRIPTION +++ b/Lang/Oz/00DESCRIPTION @@ -20,5 +20,5 @@ All examples that start with declare can be used directly in the Em Some examples are functor definitions and must be compiled. If a makefile.oz is supplied, execute ozmake to build the project. Otherwise call the compiler directly: ozc -c filename.oz. Execute a compiled functor with ozengine filename.ozf. ==Citation== -#[http://www.mozart-oz.org/documentation/tutorial/index.html Tutorial of Oz] +#[https://mozart.github.io/mozart-v1/doc-1.4.0/tutorial/index.html Tutorial of Oz] #[[wp:Oz_%28programming_language%29|Wikipedia:Oz (programming language)]] \ No newline at end of file diff --git a/Lang/PARI-GP/00DESCRIPTION b/Lang/PARI-GP/00DESCRIPTION index 12cf8c2691..cf4ba59ba3 100644 --- a/Lang/PARI-GP/00DESCRIPTION +++ b/Lang/PARI-GP/00DESCRIPTION @@ -17,38 +17,40 @@ PARI/GP is a widely used computer algebra system designed for fast computations PARI/GP is composed of two parts: a [[C]] library called PARI and an interface, gp, to this library. GP scripts are concise, easy to write, and resemble mathematical language. (Terminology: the scripting language of gp is called GP.) -PARI was written by Henri Cohen and others at Université Bordeaux I and is now maintained by Karim Belabas. gp was originally written by Dominique Bernardi, then maintained and enhanced by Karim Belabas and Ilya Zakharevich, and finally rewritten by Bill Allombert. +PARI was written by Henri Cohen and others at Université de Bordeaux and is now maintained by Karim Belabas. gp was originally written by Dominique Bernardi, then maintained and enhanced by Karim Belabas and Ilya Zakharevich, and finally rewritten by Bill Allombert. == Using PARI/GP == PARI/GP can be downloaded at its official website's [http://pari.math.u-bordeaux.fr/download.html download page]. -Windows precompiled binaries are available: an installer, stand-alone stable and development versions, plus a nightly build with the very latest changes. - -Mac users may find it convenient to download the version from [http://pdb.finkproject.org/pdb/package.php/pari-gp Fink]. - -Linux users can install PARI/GP with their favorite package manager (RPM, dpkg, apt, etc.) or build it from source. [http://math.crg4.com/software.html#pari Instructions] are available for compiling. +Windows precompiled binaries are available: an installer, stand-alone stable and development versions, plus a nightly build with the very latest changes. [http://pari.math.u-bordeaux.fr/pub/pari/mac/snapshots/ Mac snapshots] are also available. Linux users can install PARI/GP with their favorite package manager (RPM, dpkg, apt, etc.) or build it from source. [http://math.crg4.com/software.html#pari Instructions] are available for compiling. Android phones and tablets can use [https://code.google.com/p/paridroid/ paridroid] (also [https://github.com/FreeMonad/paridroid on github]). -While an iPhone/iPad version has not been developed, [https://itunes.apple.com/us/app/sage-math/id496492945?mt=8 sage-math] includes PARI and GP commands can be invoked with the wrapper function pari. +While an iPhone/iPad version has not been developed, [https://itunes.apple.com/us/app/sage-math/id496492945?mt=8 sage-math] includes gp. Click the "+" in the top-right to start a new program, then click and hold on "Sage" at the top until the "Select Language" dropdown appears, then choose GP. (You can also use the wrapper function pari in a Sage snippet.) -Finally, gp can be used online through [http://www.compileonline.com/execute_pari_online.php compile online] or the [https://cloud.sagemath.com/ SageMath cloud] (see [http://youtu.be/CzB6T7Nvc-s How to use PARI/GP in the SageMathCloud]). +Finally, gp can be used online through [http://pari.math.u-bordeaux.fr/gp.html the PARI/GP site] (via Emscripten), [http://www.compileonline.com/execute_pari_online.php compile online] or the [https://cloud.sagemath.com/ SageMath cloud] (see [http://youtu.be/CzB6T7Nvc-s How to use PARI/GP in the SageMathCloud]). == Coding with PARI == The most common way to use PARI is through the gp calculator, using its own scripting language, GP. But there are other interfaces to PARI beside gp: -* [http://math.univ-lille1.fr/~ramare/ServeurPerso/GP-PARI/ PariEmacs] +* [http://www.emacswiki.org/emacs/PariGP PariGP on EmacsWiki], [http://math.univ-lille1.fr/~ramare/ServeurPerso/GP-PARI/ PariEmacs] * [http://go.helms-net.de/sw/paritty/pari_tty_einf_en.html Pari-tty] * [http://www.skalatan.de/pariguide/ pariGUIde] -* [https://github.com/baruchel/vim-notebook vim-notebook] +* [https://github.com/baruchel/vim-notebook vim-notebook] (see also [https://www.youtube.com/watch?v=vHiCpRQiJuU the author's video on using gp from vim]) * [https://github.com/jdemeyer/pari_jupyter Jupyter kernel] -If you want to write a program rather than script a calculator, many languages are supported: -* [[C]]: PARI is written in C, so it's very easy to either write your own programs or extend gp using C. +If you want to program with PARI, many languages are supported: +* [[C]]: PARI is written in C, so it's very easy to either write your own programs or extend gp using C. The [http://pari.math.u-bordeaux.fr/pub/pari/manuals/gp2c/gp2c.html gp2c] utility converts GP scripts into executable C code. ** For use with the Gnu Mpc library, there is also [http://www.multiprecision.org/?prog=pari-gnump Pari-Gnump]. * [[C++]]: PARI can be used directly in C++. The code is intentionally written in a C++-compatible style. -fpermissive is sometimes useful when compiling with g++. -* [[Python]]: [http://www.sagemath.org/ SAGE] is a Python-based system that includes PARI among others; there is a [http://code.google.com/p/pari-python/ pari-python] library as well. -* [[Perl]]: Use [http://search.cpan.org/dist/Math-Pari/ Math::Pari] or [https://github.com/FreeMonad/GPP GPP]. +* [[Python]]: +** [http://www.sagemath.org/ SageMath] (or SAGE) is a Python-based system that includes GP among others +** [http://code.google.com/p/pari-python/ pari-python] +** [https://pypi.python.org/pypi/cypari/ cypari] is a fork of the GP component of SageMath +* [[Perl]]: +** [http://search.cpan.org/dist/Math-Pari/ Math::Pari] +** [https://github.com/FreeMonad/GPP GPP] * [[Common Lisp]]: Use [http://clisp.sourceforge.net/impnotes/pari.html Pari] ([[CLISP]]). +* [[Mathematica]]: A [http://pari.math.u-bordeaux.fr/dochtml/mathlink.html quick tutorial using MathLink] is available. == See also == *[[wp:PARI/GP|Wikipedia:PARI/GP]] @@ -56,25 +58,29 @@ If you want to write a program rather than script a calculator, many languages a == Resources == === General === *[http://www.math.utah.edu/faq/pari/pari.html PARI/GP FAQ] -*[http://www.math.u-bordeaux1.fr/~belabas/pari/ Resources for PARI/GP] -*[http://pari.math.u-bordeaux1.fr/Events/PARI2012/ Atelier PARI/GP 2012]: Conference slides +*[http://pari.math.u-bordeaux.fr/ateliers.html Ateliers PARI/GP]: Conference slides and other resources +*[http://hyperpolyglot.org/more-computer-algebra Comparison with Magma, GAP, and Singular] === Tutorials === -*[http://pari.math.u-bordeaux.fr/pub/pari/manuals/2.5.0/tutorial.pdf Official tutorial] by C. Batut, K. Belabas, D. Bernardi, H. Cohen, M. Olivier (52 pp., 2011) +*[http://pari.math.u-bordeaux.fr/pub/pari/manuals/2.7.0/tutorial.pdf Official tutorial] by The PARI Group (52 pp., 2014) +*[http://www.math.u-bordeaux.fr/~ballombe/talks/bordeaux-20150924.pdf Tutorial on Elliptic Curves] by Bill Allombert and Karim Belabas (5 pp., 2016) *[http://www.math.psu.edu/wdb/467/pariinfo.pdf Beginning PARI Programming for CSE/MATH 467] by W. Dale Brownawell (7 pp., 2014) *[http://www.math.uiuc.edu/~r-ash/GPTutorial.pdf Tutorial] by Robert B. Ash (20 pp., 2007) -*[http://www.math.umass.edu/~siman/09.791N/tutorial.pdf Tutorial] by Siman Wong (6 pp., 2009) +*[http://people.math.umass.edu/~siman/09.791N/tutorial.pdf Tutorial] by Siman Wong (6 pp., 2009) *[http://www.math.uconn.edu/~kconrad/math5230f08/parihandout.pdf Introduction] by Keith Conrad (7 pp., 2008) *[http://www.linuxjournal.com/article/1068 The Pari Package On Linux], by Klaus-Peter Nischke (3 pp., 1995) -*[http://mvngu.wordpress.com/2008/08/01/parigp-programming-for-basic-cryptography/ PARI/GP programming for basic cryptography] by Minh Van Nguyen (appx. 3 pp., 2008); also appears in an [https://bbuseruploads.s3.amazonaws.com/mvngu/www/downloads/2008-11-25_numtheory-crypto-gp.pdf?Signature=3c1KatVUdnnTc4lOtzpOgsJg6Fw%3D&Expires=1411628731&AWSAccessKeyId=0EMWEFSGA12Z1HF1TZ82 extended version] lacking a stable URL (9 pp., 2008) +*[http://mvngu.wordpress.com/2008/08/01/parigp-programming-for-basic-cryptography/ PARI/GP programming for basic cryptography] by Minh Van Nguyen (appx. 3 pp., 2008); also appears in an [https://bitbucket.org/mvngu/www/downloads/2008-11-25_numtheory-crypto-gp.pdf extended version] (9 pp., 2008) *[http://www.exploringbinary.com/exploring-binary-numbers-with-parigp-calculator/ Exploring binary numbers with PARI/GP calculator] by Rick Regan (appx. 4 pp., 2009) *Video tutorials, parts [http://www.youtube.com/watch?v=0G-9JzlrzBM 1] [http://www.youtube.com/watch?v=d7i0rv59hns 2] [http://www.youtube.com/watch?v=wCyU2n-G-pk 3] [http://www.youtube.com/watch?v=WOCuBvK8O6Q 4] (appx. 20 minutes, 2011) *[http://w3.countnumber.de/fischer/res-ZT2007/PariByExample.pdf Erste Schritte mit PARI/GP] by Lars Fischer (13 pp., 2007; German) *[http://www.maths.tcd.ie/~vlasenko/MA2316/ Class notes] including PARI/GP tutorial and sample code by Masha Vlasenko (2013) * Class notes, parts [http://myweb.csuchico.edu/~blevitt/math230/230coursedocs/230notes/230notes_01.pdf 1][http://myweb.csuchico.edu/~blevitt/math230/230coursedocs/230notes/230notes_02.pdf 2][http://myweb.csuchico.edu/~blevitt/math230/230coursedocs/230notes/230notes_03.pdf 3][http://myweb.csuchico.edu/~blevitt/math230/230coursedocs/230notes/230notes_04.pdf 4][http://myweb.csuchico.edu/~blevitt/math230/230coursedocs/230notes/230notes_05.pdf 5][http://myweb.csuchico.edu/~blevitt/math230/230coursedocs/230notes/230notes_sieve.pdf sieve] by Benjamin L. Levitt (41 pp., 2009; now offline?) +*[http://users.aims.ac.za/~richard/faq/index.php Pari/GP Tutorial] by Akinola Richard Olatokunbo +*[https://www.youtube.com/watch?v=FeG0BYRrDOE&t=12m Video demo of RSA in PARI/GP] by Maren1955 (2014, 17:39) === Papers on PARI/GP === * Bill Alombert, [http://www.math.u-bordeaux.fr/~allomber/darkpaper.pdf A new interpretor for PARI/GP], ''Journal de Théorie des Nombres de Bordeaux'' '''20''':3 (2008), pp. 531–541. (English) * Paul Zimmermann, [http://www.loria.fr/~zimmerma/talks/henri.pdf The Ups and Downs of PARI/GP in the last 20 years], Explicit Methods in Number Theory, October 15th-19th 2007 +* Robert H. Lewis and Michael Wester, [https://home.bway.net/lewis/cacomp.ps Comparison of polynomial-oriented computer algebra systems], ''ACM SIGSAM Bulletin'' '''33''':4 (1999), pp. 5-13. [[Category:Mathematical programming languages]] \ No newline at end of file diff --git a/Lang/PARI-GP/9-billion-names-of-God-the-integer b/Lang/PARI-GP/9-billion-names-of-God-the-integer new file mode 120000 index 0000000000..45e86c4a2f --- /dev/null +++ b/Lang/PARI-GP/9-billion-names-of-God-the-integer @@ -0,0 +1 @@ +../../Task/9-billion-names-of-God-the-integer/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/ABC-Problem b/Lang/PARI-GP/ABC-Problem new file mode 120000 index 0000000000..0bcb00d15c --- /dev/null +++ b/Lang/PARI-GP/ABC-Problem @@ -0,0 +1 @@ +../../Task/ABC-Problem/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Anagrams-Deranged-anagrams b/Lang/PARI-GP/Anagrams-Deranged-anagrams new file mode 120000 index 0000000000..8ba66c5782 --- /dev/null +++ b/Lang/PARI-GP/Anagrams-Deranged-anagrams @@ -0,0 +1 @@ +../../Task/Anagrams-Deranged-anagrams/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Brownian-tree b/Lang/PARI-GP/Brownian-tree new file mode 120000 index 0000000000..61c1cc2fcd --- /dev/null +++ b/Lang/PARI-GP/Brownian-tree @@ -0,0 +1 @@ +../../Task/Brownian-tree/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/CRC-32 b/Lang/PARI-GP/CRC-32 new file mode 120000 index 0000000000..b1cbe759b7 --- /dev/null +++ b/Lang/PARI-GP/CRC-32 @@ -0,0 +1 @@ +../../Task/CRC-32/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/CSV-data-manipulation b/Lang/PARI-GP/CSV-data-manipulation new file mode 120000 index 0000000000..510a6ff1b2 --- /dev/null +++ b/Lang/PARI-GP/CSV-data-manipulation @@ -0,0 +1 @@ +../../Task/CSV-data-manipulation/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Cholesky-decomposition b/Lang/PARI-GP/Cholesky-decomposition new file mode 120000 index 0000000000..771d4a5d9f --- /dev/null +++ b/Lang/PARI-GP/Cholesky-decomposition @@ -0,0 +1 @@ +../../Task/Cholesky-decomposition/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Combinations-and-permutations b/Lang/PARI-GP/Combinations-and-permutations new file mode 120000 index 0000000000..e0ad06bbd2 --- /dev/null +++ b/Lang/PARI-GP/Combinations-and-permutations @@ -0,0 +1 @@ +../../Task/Combinations-and-permutations/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Create-a-file b/Lang/PARI-GP/Create-a-file new file mode 120000 index 0000000000..ef0533f9ed --- /dev/null +++ b/Lang/PARI-GP/Create-a-file @@ -0,0 +1 @@ +../../Task/Create-a-file/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Digital-root-Multiplicative-digital-root b/Lang/PARI-GP/Digital-root-Multiplicative-digital-root new file mode 120000 index 0000000000..aea98a97cf --- /dev/null +++ b/Lang/PARI-GP/Digital-root-Multiplicative-digital-root @@ -0,0 +1 @@ +../../Task/Digital-root-Multiplicative-digital-root/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Draw-a-cuboid b/Lang/PARI-GP/Draw-a-cuboid new file mode 120000 index 0000000000..ed7423b393 --- /dev/null +++ b/Lang/PARI-GP/Draw-a-cuboid @@ -0,0 +1 @@ +../../Task/Draw-a-cuboid/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Empty-directory b/Lang/PARI-GP/Empty-directory new file mode 120000 index 0000000000..d7ddfae180 --- /dev/null +++ b/Lang/PARI-GP/Empty-directory @@ -0,0 +1 @@ +../../Task/Empty-directory/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Evolutionary-algorithm b/Lang/PARI-GP/Evolutionary-algorithm new file mode 120000 index 0000000000..0933ae556c --- /dev/null +++ b/Lang/PARI-GP/Evolutionary-algorithm @@ -0,0 +1 @@ +../../Task/Evolutionary-algorithm/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Exceptions-Catch-an-exception-thrown-in-a-nested-call b/Lang/PARI-GP/Exceptions-Catch-an-exception-thrown-in-a-nested-call new file mode 120000 index 0000000000..ec07f233c7 --- /dev/null +++ b/Lang/PARI-GP/Exceptions-Catch-an-exception-thrown-in-a-nested-call @@ -0,0 +1 @@ +../../Task/Exceptions-Catch-an-exception-thrown-in-a-nested-call/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Executable-library b/Lang/PARI-GP/Executable-library new file mode 120000 index 0000000000..828321f9fe --- /dev/null +++ b/Lang/PARI-GP/Executable-library @@ -0,0 +1 @@ +../../Task/Executable-library/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Fibonacci-word-fractal b/Lang/PARI-GP/Fibonacci-word-fractal new file mode 120000 index 0000000000..2b8a1c845b --- /dev/null +++ b/Lang/PARI-GP/Fibonacci-word-fractal @@ -0,0 +1 @@ +../../Task/Fibonacci-word-fractal/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Find-the-last-Sunday-of-each-month b/Lang/PARI-GP/Find-the-last-Sunday-of-each-month new file mode 120000 index 0000000000..b562f9d892 --- /dev/null +++ b/Lang/PARI-GP/Find-the-last-Sunday-of-each-month @@ -0,0 +1 @@ +../../Task/Find-the-last-Sunday-of-each-month/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Fractal-tree b/Lang/PARI-GP/Fractal-tree new file mode 120000 index 0000000000..e5bd51d012 --- /dev/null +++ b/Lang/PARI-GP/Fractal-tree @@ -0,0 +1 @@ +../../Task/Fractal-tree/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Fractran b/Lang/PARI-GP/Fractran new file mode 120000 index 0000000000..ae6bae2040 --- /dev/null +++ b/Lang/PARI-GP/Fractran @@ -0,0 +1 @@ +../../Task/Fractran/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Generate-lower-case-ASCII-alphabet b/Lang/PARI-GP/Generate-lower-case-ASCII-alphabet new file mode 120000 index 0000000000..f3231a1049 --- /dev/null +++ b/Lang/PARI-GP/Generate-lower-case-ASCII-alphabet @@ -0,0 +1 @@ +../../Task/Generate-lower-case-ASCII-alphabet/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Hash-from-two-arrays b/Lang/PARI-GP/Hash-from-two-arrays new file mode 120000 index 0000000000..b3d33fffa9 --- /dev/null +++ b/Lang/PARI-GP/Hash-from-two-arrays @@ -0,0 +1 @@ +../../Task/Hash-from-two-arrays/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Iterated-digits-squaring b/Lang/PARI-GP/Iterated-digits-squaring new file mode 120000 index 0000000000..259bc2bcb1 --- /dev/null +++ b/Lang/PARI-GP/Iterated-digits-squaring @@ -0,0 +1 @@ +../../Task/Iterated-digits-squaring/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/LU-decomposition b/Lang/PARI-GP/LU-decomposition new file mode 120000 index 0000000000..1c0e0fc513 --- /dev/null +++ b/Lang/PARI-GP/LU-decomposition @@ -0,0 +1 @@ +../../Task/LU-decomposition/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Last-Friday-of-each-month b/Lang/PARI-GP/Last-Friday-of-each-month new file mode 120000 index 0000000000..924c7021f4 --- /dev/null +++ b/Lang/PARI-GP/Last-Friday-of-each-month @@ -0,0 +1 @@ +../../Task/Last-Friday-of-each-month/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Levenshtein-distance b/Lang/PARI-GP/Levenshtein-distance new file mode 120000 index 0000000000..7b971c1850 --- /dev/null +++ b/Lang/PARI-GP/Levenshtein-distance @@ -0,0 +1 @@ +../../Task/Levenshtein-distance/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Ludic-numbers b/Lang/PARI-GP/Ludic-numbers new file mode 120000 index 0000000000..2891c8deab --- /dev/null +++ b/Lang/PARI-GP/Ludic-numbers @@ -0,0 +1 @@ +../../Task/Ludic-numbers/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/MD4 b/Lang/PARI-GP/MD4 new file mode 120000 index 0000000000..bc2bbbda69 --- /dev/null +++ b/Lang/PARI-GP/MD4 @@ -0,0 +1 @@ +../../Task/MD4/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/MD5 b/Lang/PARI-GP/MD5 new file mode 120000 index 0000000000..562463c424 --- /dev/null +++ b/Lang/PARI-GP/MD5 @@ -0,0 +1 @@ +../../Task/MD5/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Magic-squares-of-odd-order b/Lang/PARI-GP/Magic-squares-of-odd-order new file mode 120000 index 0000000000..9a57704716 --- /dev/null +++ b/Lang/PARI-GP/Magic-squares-of-odd-order @@ -0,0 +1 @@ +../../Task/Magic-squares-of-odd-order/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Narcissist b/Lang/PARI-GP/Narcissist new file mode 120000 index 0000000000..46df19394a --- /dev/null +++ b/Lang/PARI-GP/Narcissist @@ -0,0 +1 @@ +../../Task/Narcissist/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Narcissistic-decimal-number b/Lang/PARI-GP/Narcissistic-decimal-number new file mode 120000 index 0000000000..819da34a07 --- /dev/null +++ b/Lang/PARI-GP/Narcissistic-decimal-number @@ -0,0 +1 @@ +../../Task/Narcissistic-decimal-number/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/One-of-n-lines-in-a-file b/Lang/PARI-GP/One-of-n-lines-in-a-file new file mode 120000 index 0000000000..acaa5440c1 --- /dev/null +++ b/Lang/PARI-GP/One-of-n-lines-in-a-file @@ -0,0 +1 @@ +../../Task/One-of-n-lines-in-a-file/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Ordered-words b/Lang/PARI-GP/Ordered-words new file mode 120000 index 0000000000..fb0e1171cd --- /dev/null +++ b/Lang/PARI-GP/Ordered-words @@ -0,0 +1 @@ +../../Task/Ordered-words/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Quine b/Lang/PARI-GP/Quine new file mode 120000 index 0000000000..0ecf2943ba --- /dev/null +++ b/Lang/PARI-GP/Quine @@ -0,0 +1 @@ +../../Task/Quine/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/RIPEMD-160 b/Lang/PARI-GP/RIPEMD-160 new file mode 120000 index 0000000000..542a3d7781 --- /dev/null +++ b/Lang/PARI-GP/RIPEMD-160 @@ -0,0 +1 @@ +../../Task/RIPEMD-160/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/RSA-code b/Lang/PARI-GP/RSA-code new file mode 120000 index 0000000000..4daa2fee18 --- /dev/null +++ b/Lang/PARI-GP/RSA-code @@ -0,0 +1 @@ +../../Task/RSA-code/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Ranking-methods b/Lang/PARI-GP/Ranking-methods new file mode 120000 index 0000000000..cdc7441bcc --- /dev/null +++ b/Lang/PARI-GP/Ranking-methods @@ -0,0 +1 @@ +../../Task/Ranking-methods/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Sierpinski-carpet b/Lang/PARI-GP/Sierpinski-carpet new file mode 120000 index 0000000000..8fa12834e3 --- /dev/null +++ b/Lang/PARI-GP/Sierpinski-carpet @@ -0,0 +1 @@ +../../Task/Sierpinski-carpet/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Sierpinski-triangle-Graphical b/Lang/PARI-GP/Sierpinski-triangle-Graphical new file mode 120000 index 0000000000..940a9a2dac --- /dev/null +++ b/Lang/PARI-GP/Sierpinski-triangle-Graphical @@ -0,0 +1 @@ +../../Task/Sierpinski-triangle-Graphical/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Speech-synthesis b/Lang/PARI-GP/Speech-synthesis new file mode 120000 index 0000000000..105685c88c --- /dev/null +++ b/Lang/PARI-GP/Speech-synthesis @@ -0,0 +1 @@ +../../Task/Speech-synthesis/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Spiral-matrix b/Lang/PARI-GP/Spiral-matrix new file mode 120000 index 0000000000..c5400a4767 --- /dev/null +++ b/Lang/PARI-GP/Spiral-matrix @@ -0,0 +1 @@ +../../Task/Spiral-matrix/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Stern-Brocot-sequence b/Lang/PARI-GP/Stern-Brocot-sequence new file mode 120000 index 0000000000..1f15606621 --- /dev/null +++ b/Lang/PARI-GP/Stern-Brocot-sequence @@ -0,0 +1 @@ +../../Task/Stern-Brocot-sequence/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Substring b/Lang/PARI-GP/Substring new file mode 120000 index 0000000000..03e3e7ce94 --- /dev/null +++ b/Lang/PARI-GP/Substring @@ -0,0 +1 @@ +../../Task/Substring/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Sudoku b/Lang/PARI-GP/Sudoku new file mode 120000 index 0000000000..465bb8157f --- /dev/null +++ b/Lang/PARI-GP/Sudoku @@ -0,0 +1 @@ +../../Task/Sudoku/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Terminal-control-Coloured-text b/Lang/PARI-GP/Terminal-control-Coloured-text new file mode 120000 index 0000000000..fa14da54e1 --- /dev/null +++ b/Lang/PARI-GP/Terminal-control-Coloured-text @@ -0,0 +1 @@ +../../Task/Terminal-control-Coloured-text/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Terminal-control-Ringing-the-terminal-bell b/Lang/PARI-GP/Terminal-control-Ringing-the-terminal-bell new file mode 120000 index 0000000000..356b5cb496 --- /dev/null +++ b/Lang/PARI-GP/Terminal-control-Ringing-the-terminal-bell @@ -0,0 +1 @@ +../../Task/Terminal-control-Ringing-the-terminal-bell/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/The-Twelve-Days-of-Christmas b/Lang/PARI-GP/The-Twelve-Days-of-Christmas new file mode 120000 index 0000000000..d9b72ebdd8 --- /dev/null +++ b/Lang/PARI-GP/The-Twelve-Days-of-Christmas @@ -0,0 +1 @@ +../../Task/The-Twelve-Days-of-Christmas/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Tokenize-a-string b/Lang/PARI-GP/Tokenize-a-string new file mode 120000 index 0000000000..3efa17caa9 --- /dev/null +++ b/Lang/PARI-GP/Tokenize-a-string @@ -0,0 +1 @@ +../../Task/Tokenize-a-string/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Topswops b/Lang/PARI-GP/Topswops new file mode 120000 index 0000000000..748a0625de --- /dev/null +++ b/Lang/PARI-GP/Topswops @@ -0,0 +1 @@ +../../Task/Topswops/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Towers-of-Hanoi b/Lang/PARI-GP/Towers-of-Hanoi new file mode 120000 index 0000000000..92c00b1aad --- /dev/null +++ b/Lang/PARI-GP/Towers-of-Hanoi @@ -0,0 +1 @@ +../../Task/Towers-of-Hanoi/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Truncate-a-file b/Lang/PARI-GP/Truncate-a-file new file mode 120000 index 0000000000..337be0f1f6 --- /dev/null +++ b/Lang/PARI-GP/Truncate-a-file @@ -0,0 +1 @@ +../../Task/Truncate-a-file/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Ulam-spiral--for-primes- b/Lang/PARI-GP/Ulam-spiral--for-primes- new file mode 120000 index 0000000000..fe16b5a85c --- /dev/null +++ b/Lang/PARI-GP/Ulam-spiral--for-primes- @@ -0,0 +1 @@ +../../Task/Ulam-spiral--for-primes-/PARI-GP \ No newline at end of file diff --git a/Lang/PARI-GP/Use-another-language-to-call-a-function b/Lang/PARI-GP/Use-another-language-to-call-a-function new file mode 120000 index 0000000000..830e693f48 --- /dev/null +++ b/Lang/PARI-GP/Use-another-language-to-call-a-function @@ -0,0 +1 @@ +../../Task/Use-another-language-to-call-a-function/PARI-GP \ No newline at end of file diff --git a/Lang/PHP/Averages-Mean-time-of-day b/Lang/PHP/Averages-Mean-time-of-day new file mode 120000 index 0000000000..da3038b95d --- /dev/null +++ b/Lang/PHP/Averages-Mean-time-of-day @@ -0,0 +1 @@ +../../Task/Averages-Mean-time-of-day/PHP \ No newline at end of file diff --git a/Lang/PHP/Averages-Pythagorean-means b/Lang/PHP/Averages-Pythagorean-means new file mode 120000 index 0000000000..95d023bf9b --- /dev/null +++ b/Lang/PHP/Averages-Pythagorean-means @@ -0,0 +1 @@ +../../Task/Averages-Pythagorean-means/PHP \ No newline at end of file diff --git a/Lang/PHP/Averages-Root-mean-square b/Lang/PHP/Averages-Root-mean-square new file mode 120000 index 0000000000..440ccfb67f --- /dev/null +++ b/Lang/PHP/Averages-Root-mean-square @@ -0,0 +1 @@ +../../Task/Averages-Root-mean-square/PHP \ No newline at end of file diff --git a/Lang/PHP/Combinations b/Lang/PHP/Combinations new file mode 120000 index 0000000000..1670380233 --- /dev/null +++ b/Lang/PHP/Combinations @@ -0,0 +1 @@ +../../Task/Combinations/PHP \ No newline at end of file diff --git a/Lang/PHP/Find-the-last-Sunday-of-each-month b/Lang/PHP/Find-the-last-Sunday-of-each-month new file mode 120000 index 0000000000..6b918bcc0e --- /dev/null +++ b/Lang/PHP/Find-the-last-Sunday-of-each-month @@ -0,0 +1 @@ +../../Task/Find-the-last-Sunday-of-each-month/PHP \ No newline at end of file diff --git a/Lang/PHP/Generator-Exponential b/Lang/PHP/Generator-Exponential new file mode 120000 index 0000000000..ab63db8fe0 --- /dev/null +++ b/Lang/PHP/Generator-Exponential @@ -0,0 +1 @@ +../../Task/Generator-Exponential/PHP \ No newline at end of file diff --git a/Lang/PHP/Inverted-index b/Lang/PHP/Inverted-index new file mode 120000 index 0000000000..f4508ace96 --- /dev/null +++ b/Lang/PHP/Inverted-index @@ -0,0 +1 @@ +../../Task/Inverted-index/PHP \ No newline at end of file diff --git a/Lang/PHP/Permutations b/Lang/PHP/Permutations new file mode 120000 index 0000000000..55fefbf034 --- /dev/null +++ b/Lang/PHP/Permutations @@ -0,0 +1 @@ +../../Task/Permutations/PHP \ No newline at end of file diff --git a/Lang/PHP/Reverse-words-in-a-string b/Lang/PHP/Reverse-words-in-a-string new file mode 120000 index 0000000000..f62f66a96f --- /dev/null +++ b/Lang/PHP/Reverse-words-in-a-string @@ -0,0 +1 @@ +../../Task/Reverse-words-in-a-string/PHP \ No newline at end of file diff --git a/Lang/PHP/Sudoku b/Lang/PHP/Sudoku new file mode 120000 index 0000000000..e9301c9074 --- /dev/null +++ b/Lang/PHP/Sudoku @@ -0,0 +1 @@ +../../Task/Sudoku/PHP \ No newline at end of file diff --git a/Lang/PHP/Sutherland-Hodgman-polygon-clipping b/Lang/PHP/Sutherland-Hodgman-polygon-clipping new file mode 120000 index 0000000000..19f134f03a --- /dev/null +++ b/Lang/PHP/Sutherland-Hodgman-polygon-clipping @@ -0,0 +1 @@ +../../Task/Sutherland-Hodgman-polygon-clipping/PHP \ No newline at end of file diff --git a/Lang/PL-I/00DESCRIPTION b/Lang/PL-I/00DESCRIPTION index 0d97a07077..8a8663f8ca 100644 --- a/Lang/PL-I/00DESCRIPTION +++ b/Lang/PL-I/00DESCRIPTION @@ -14,54 +14,69 @@ PL/I is a general purpose programming language suitable for commercial, scientific, non-scientific, and system programming. + It provides the following data types: -* Floating-point, -* Decimal integer, -* Binary integer, -* Fixed-point decimal (with fractional part), -* Fixed-point binary (that is, with fractional part), -* Pointers, -* Character strings of two kinds: -# fixed-length, and -# varying-length. -* Bit strings of two kinds: -# fixed-length, and -# varying length. +::*   Floating-point, +::*   Decimal integer, +::*   Binary integer, +::*   Fixed-point decimal   (with a fractional part), +::*   Fixed-point binary   (that is, with a fractional part), +::*   Pointers, +::*   Character strings of two kinds: +::::#   fixed-length,   and +::::#   varying-length. +::*   Bit strings of two kinds: +::::#   fixed-length,   and +::::#   varying length. + +
+The   float,   integer,   and   fixed-point   types can be   real   or   complex. -The float, integer,and fixed-point types can be real or complex. Multiple precisions are available for binary fixed-point: -* 8 bits, -* 16 bits, -* 32 bits, and -* 64 bits. +::*   8 bits, +::*   16 bits, +::*   32 bits,   and +::*   64 bits. + Multiple precisions are available for floating point: -* 32 bits, -* 64 bits, and -* 80 bits. +::*   32 bits, +::*   64 bits,   and +::*   80 bits. -The language provides for static and dynamic arrays. Of the latter, there are automatic, controlled, and based. + +The language provides for static and dynamic arrays.   Of the latter, there are   automatic,   controlled,   and   based. -Controlled can be applied to any data type, including scalar, structure, as well as arrays. With controlled, a push-down and pop-up stack is automatically used. +Controlled can be applied to any data type, including scalar, structure, as well as arrays.   With controlled, a push-down and pop-up stack is automatically used. + PL/I has four kinds of I/O: -# For simple I/O commands, list-directed input and output requires only the names of the variables. Default format is used, based on the variable's declaration. -# For simple I/O commands, data-directed input and output requires only the names of the variables. For this form, both the names of the variables and their values are transmitted. -# When precise layouts of input and output data is required, edit-directed I/O is used. A format is specified by the user. The format is flexible, and permits the number of digits, and the number of places after the decimal point to be specified dynamically. The format may also be specified in picture form. -# for files held on storage media, record-oriented transmission is often used, either for sequential or random access. +::#   For simple I/O commands, list-directed input and output requires only the names of the variables.   Default format is used, based on the variable's declaration. +::#   For simple I/O commands, data-directed input and output requires only the names of the variables.   For this form, both the names of the variables and their values are transmitted. +::#   When precise layouts of input and output data is required, edit-directed I/O is used.   A format is specified by the user.   The format is flexible, and permits the number of digits, and the number of places after the decimal point to be specified dynamically.   The format may also be specified in picture form. +::#   For files held on storage media, record-oriented transmission is often used, either for   sequential   or   random access. + PL/I has built-in checking for such programmer conditions including -* subscript-range checking, -* floating-point overflow, -* fixed-point overflow, -* division by zero, -* sub-string range checking, and -* string-size checking. +::*   subscript-range checking, +::*   floating-point overflow, +::*   fixed-point overflow, +::*   division by zero, +::*   sub-string range checking,   and +::*   string-size checking. +
Any of those may be enabled or disabled by the user. -When any of those conditions occurs, the user may trap them and recover from them and continue execution. +When any of those conditions occurs, the user/programmer may trap them and recover from them and continue execution. -PL/I has a unique and powerful pre-processor which is a subset of the full PL/I language so it can be used to perform source file inclusion, conditional compilation, and macro expansion. The pre-processor keywords are prefixed with %. \ No newline at end of file +PL/I has a unique and powerful pre-processor which is a subset of the full PL/I language so it can be used to perform   (among other things): +::*   source file inclusion, +::*   conditional compilation,   and +::*   macro expansion. + +
+The pre-processor keywords are prefixed with a   %   (percent symbol). +

\ No newline at end of file diff --git a/Lang/PL-I/Dragon-curve b/Lang/PL-I/Dragon-curve new file mode 120000 index 0000000000..94c53ed49d --- /dev/null +++ b/Lang/PL-I/Dragon-curve @@ -0,0 +1 @@ +../../Task/Dragon-curve/PL-I \ No newline at end of file diff --git a/Lang/PL-I/N-queens-problem b/Lang/PL-I/N-queens-problem new file mode 120000 index 0000000000..63a6f65d95 --- /dev/null +++ b/Lang/PL-I/N-queens-problem @@ -0,0 +1 @@ +../../Task/N-queens-problem/PL-I \ No newline at end of file diff --git a/Lang/PL-I/Pragmatic-directives b/Lang/PL-I/Pragmatic-directives new file mode 120000 index 0000000000..855db8ea74 --- /dev/null +++ b/Lang/PL-I/Pragmatic-directives @@ -0,0 +1 @@ +../../Task/Pragmatic-directives/PL-I \ No newline at end of file diff --git a/Lang/Pascal/ABC-Problem b/Lang/Pascal/ABC-Problem new file mode 120000 index 0000000000..dadba5abb5 --- /dev/null +++ b/Lang/Pascal/ABC-Problem @@ -0,0 +1 @@ +../../Task/ABC-Problem/Pascal \ No newline at end of file diff --git a/Lang/Pascal/Benfords-law b/Lang/Pascal/Benfords-law new file mode 120000 index 0000000000..7b870f77c6 --- /dev/null +++ b/Lang/Pascal/Benfords-law @@ -0,0 +1 @@ +../../Task/Benfords-law/Pascal \ No newline at end of file diff --git a/Lang/Pascal/Binary-digits b/Lang/Pascal/Binary-digits new file mode 120000 index 0000000000..8fd96c36da --- /dev/null +++ b/Lang/Pascal/Binary-digits @@ -0,0 +1 @@ +../../Task/Binary-digits/Pascal \ No newline at end of file diff --git a/Lang/Pascal/Closest-pair-problem b/Lang/Pascal/Closest-pair-problem new file mode 120000 index 0000000000..b0108fe705 --- /dev/null +++ b/Lang/Pascal/Closest-pair-problem @@ -0,0 +1 @@ +../../Task/Closest-pair-problem/Pascal \ No newline at end of file diff --git a/Lang/Pascal/Create-an-object-at-a-given-address b/Lang/Pascal/Create-an-object-at-a-given-address new file mode 120000 index 0000000000..ce0a3db316 --- /dev/null +++ b/Lang/Pascal/Create-an-object-at-a-given-address @@ -0,0 +1 @@ +../../Task/Create-an-object-at-a-given-address/Pascal \ No newline at end of file diff --git a/Lang/Pascal/Greatest-element-of-a-list b/Lang/Pascal/Greatest-element-of-a-list new file mode 120000 index 0000000000..7038bd59f3 --- /dev/null +++ b/Lang/Pascal/Greatest-element-of-a-list @@ -0,0 +1 @@ +../../Task/Greatest-element-of-a-list/Pascal \ No newline at end of file diff --git a/Lang/Pascal/Heronian-triangles b/Lang/Pascal/Heronian-triangles new file mode 120000 index 0000000000..283dceb1b5 --- /dev/null +++ b/Lang/Pascal/Heronian-triangles @@ -0,0 +1 @@ +../../Task/Heronian-triangles/Pascal \ No newline at end of file diff --git a/Lang/Pascal/Increment-a-numerical-string b/Lang/Pascal/Increment-a-numerical-string new file mode 120000 index 0000000000..c3fcfc6de6 --- /dev/null +++ b/Lang/Pascal/Increment-a-numerical-string @@ -0,0 +1 @@ +../../Task/Increment-a-numerical-string/Pascal \ No newline at end of file diff --git a/Lang/Pascal/Jensens-Device b/Lang/Pascal/Jensens-Device new file mode 120000 index 0000000000..e62fed1676 --- /dev/null +++ b/Lang/Pascal/Jensens-Device @@ -0,0 +1 @@ +../../Task/Jensens-Device/Pascal \ No newline at end of file diff --git a/Lang/Pascal/Leap-year b/Lang/Pascal/Leap-year new file mode 120000 index 0000000000..5eb674ed97 --- /dev/null +++ b/Lang/Pascal/Leap-year @@ -0,0 +1 @@ +../../Task/Leap-year/Pascal \ No newline at end of file diff --git a/Lang/Pascal/Literals-Integer b/Lang/Pascal/Literals-Integer new file mode 120000 index 0000000000..6051260188 --- /dev/null +++ b/Lang/Pascal/Literals-Integer @@ -0,0 +1 @@ +../../Task/Literals-Integer/Pascal \ No newline at end of file diff --git a/Lang/Pascal/Ludic-numbers b/Lang/Pascal/Ludic-numbers new file mode 120000 index 0000000000..183fcd13ba --- /dev/null +++ b/Lang/Pascal/Ludic-numbers @@ -0,0 +1 @@ +../../Task/Ludic-numbers/Pascal \ No newline at end of file diff --git a/Lang/Pascal/Middle-three-digits b/Lang/Pascal/Middle-three-digits new file mode 120000 index 0000000000..3cee5bf596 --- /dev/null +++ b/Lang/Pascal/Middle-three-digits @@ -0,0 +1 @@ +../../Task/Middle-three-digits/Pascal \ No newline at end of file diff --git a/Lang/Pascal/Monty-Hall-problem b/Lang/Pascal/Monty-Hall-problem new file mode 120000 index 0000000000..1ad5754ce8 --- /dev/null +++ b/Lang/Pascal/Monty-Hall-problem @@ -0,0 +1 @@ +../../Task/Monty-Hall-problem/Pascal \ No newline at end of file diff --git a/Lang/Pascal/Nth b/Lang/Pascal/Nth new file mode 120000 index 0000000000..8850663a3d --- /dev/null +++ b/Lang/Pascal/Nth @@ -0,0 +1 @@ +../../Task/Nth/Pascal \ No newline at end of file diff --git a/Lang/Pascal/Percolation-Mean-run-density b/Lang/Pascal/Percolation-Mean-run-density new file mode 120000 index 0000000000..95175a5ade --- /dev/null +++ b/Lang/Pascal/Percolation-Mean-run-density @@ -0,0 +1 @@ +../../Task/Percolation-Mean-run-density/Pascal \ No newline at end of file diff --git a/Lang/Pascal/Read-a-file-line-by-line b/Lang/Pascal/Read-a-file-line-by-line new file mode 120000 index 0000000000..553d8a7d5c --- /dev/null +++ b/Lang/Pascal/Read-a-file-line-by-line @@ -0,0 +1 @@ +../../Task/Read-a-file-line-by-line/Pascal \ No newline at end of file diff --git a/Lang/Pascal/Reverse-words-in-a-string b/Lang/Pascal/Reverse-words-in-a-string new file mode 120000 index 0000000000..61bcfb59e3 --- /dev/null +++ b/Lang/Pascal/Reverse-words-in-a-string @@ -0,0 +1 @@ +../../Task/Reverse-words-in-a-string/Pascal \ No newline at end of file diff --git a/Lang/Pascal/Stern-Brocot-sequence b/Lang/Pascal/Stern-Brocot-sequence new file mode 120000 index 0000000000..74d1cb7be7 --- /dev/null +++ b/Lang/Pascal/Stern-Brocot-sequence @@ -0,0 +1 @@ +../../Task/Stern-Brocot-sequence/Pascal \ No newline at end of file diff --git a/Lang/Pascal/Sudoku b/Lang/Pascal/Sudoku new file mode 120000 index 0000000000..e04b54cf05 --- /dev/null +++ b/Lang/Pascal/Sudoku @@ -0,0 +1 @@ +../../Task/Sudoku/Pascal \ No newline at end of file diff --git a/Lang/Pascal/The-Twelve-Days-of-Christmas b/Lang/Pascal/The-Twelve-Days-of-Christmas new file mode 120000 index 0000000000..5650cbfc5a --- /dev/null +++ b/Lang/Pascal/The-Twelve-Days-of-Christmas @@ -0,0 +1 @@ +../../Task/The-Twelve-Days-of-Christmas/Pascal \ No newline at end of file diff --git a/Lang/Perl-6/00DESCRIPTION b/Lang/Perl-6/00DESCRIPTION index 16a7c82b3a..aeb9c70e54 100644 --- a/Lang/Perl-6/00DESCRIPTION +++ b/Lang/Perl-6/00DESCRIPTION @@ -14,14 +14,15 @@ {{language programming paradigm|functional}} {{language programming paradigm|object-oriented}} {{language programming paradigm|generic}} -Perl 6 is the up-and-coming little sister to Perl 5. Though it resembles previous versions of [[Perl]] to no small degree, Perl 6 is substantially a new language; by design, it isn't backwards-compatible with Perl 5. In development since 2000, Perl 6 still lacks a complete implementation of its specification, the [http://perlcabal.org/syn/ Synopses]. +Perl 6 is the up-and-coming little sister to Perl 5. Though it resembles previous versions of [[Perl]] to no small degree, Perl 6 is substantially a new language; by design, it isn't backwards-compatible with Perl 5. The first official release was at Christmas of 2015. Damian Conway described the basic philosophy of Perl 6 as follows:
The Perl 6 design process is about keeping what works in Perl 5, fixing what doesn't, and adding what's missing. That means there will be a few fundamental changes to the language, a large number of extensions to existing features, and a handful of completely new ideas. These modifications, enhancements, and innovations will work together to make the future Perl even more insanely great -- without, we hope, making it even more greatly insane.
-Major new features include multiple dispatch, declarative classes, grammars, formal parameters to subroutines, type constraints on variables, lazy evaluation, junctions, meta-operators, and the ability to change Perl's syntax at will with hygienic macros and user-defined operators. +Major new features include multiple dispatch, declarative classes, grammars, formal parameters to subroutines, type constraints on variables, lazy evaluation, junctions, meta-operators, and the ability to change Perl's syntax at will. -There are several different partial implementations of Perl 6. They vary widely in design goals, degree of completeness, and current development activity. At present, the implementation closest to matching the specification is [[Rakudo]]. +The definition of Perl 6 is specified entirely by a test suite, so we could in theory have multiple implementations. +The current version of the language is 6.c (short for 6.christmas), as defined by the test suite known as "roast" (Repository Of All Spec Tests). Compiler releases have date-based versions, and these are typically used in Rosetta Code entries for the "works with" fields. The only compiler implementing the full test suite, rakudo, currently runs on either MoarVM or JVM. Subsequent language revisions are planned (with provisional names of "Diwali", "Eid", and other such celebrations), but these will only come out once a year or so. In 2016 we are primarily working on performance and documentation of the stable 6.c version.
\ No newline at end of file diff --git a/Lang/Perl-6/Atomic-updates b/Lang/Perl-6/Atomic-updates new file mode 120000 index 0000000000..3900d36c11 --- /dev/null +++ b/Lang/Perl-6/Atomic-updates @@ -0,0 +1 @@ +../../Task/Atomic-updates/Perl-6 \ No newline at end of file diff --git a/Lang/Perl-6/Chat-server b/Lang/Perl-6/Chat-server new file mode 120000 index 0000000000..a08225809d --- /dev/null +++ b/Lang/Perl-6/Chat-server @@ -0,0 +1 @@ +../../Task/Chat-server/Perl-6 \ No newline at end of file diff --git a/Lang/Perl-6/Conjugate-transpose b/Lang/Perl-6/Conjugate-transpose new file mode 120000 index 0000000000..e6438962c1 --- /dev/null +++ b/Lang/Perl-6/Conjugate-transpose @@ -0,0 +1 @@ +../../Task/Conjugate-transpose/Perl-6 \ No newline at end of file diff --git a/Lang/Perl-6/Deepcopy b/Lang/Perl-6/Deepcopy new file mode 120000 index 0000000000..279cdf6639 --- /dev/null +++ b/Lang/Perl-6/Deepcopy @@ -0,0 +1 @@ +../../Task/Deepcopy/Perl-6 \ No newline at end of file diff --git a/Lang/Perl-6/Jump-anywhere b/Lang/Perl-6/Jump-anywhere new file mode 120000 index 0000000000..6e4ff86258 --- /dev/null +++ b/Lang/Perl-6/Jump-anywhere @@ -0,0 +1 @@ +../../Task/Jump-anywhere/Perl-6 \ No newline at end of file diff --git a/Lang/Perl-6/LU-decomposition b/Lang/Perl-6/LU-decomposition new file mode 120000 index 0000000000..c8061ebb51 --- /dev/null +++ b/Lang/Perl-6/LU-decomposition @@ -0,0 +1 @@ +../../Task/LU-decomposition/Perl-6 \ No newline at end of file diff --git a/Lang/Perl-6/Multiple-regression b/Lang/Perl-6/Multiple-regression new file mode 120000 index 0000000000..3eb6bee1fa --- /dev/null +++ b/Lang/Perl-6/Multiple-regression @@ -0,0 +1 @@ +../../Task/Multiple-regression/Perl-6 \ No newline at end of file diff --git a/Lang/Perl-6/Permutations-Rank-of-a-permutation b/Lang/Perl-6/Permutations-Rank-of-a-permutation new file mode 120000 index 0000000000..3a8f399f8d --- /dev/null +++ b/Lang/Perl-6/Permutations-Rank-of-a-permutation @@ -0,0 +1 @@ +../../Task/Permutations-Rank-of-a-permutation/Perl-6 \ No newline at end of file diff --git a/Lang/Perl-6/Polynomial-regression b/Lang/Perl-6/Polynomial-regression new file mode 120000 index 0000000000..5cc44ee11b --- /dev/null +++ b/Lang/Perl-6/Polynomial-regression @@ -0,0 +1 @@ +../../Task/Polynomial-regression/Perl-6 \ No newline at end of file diff --git a/Lang/Perl-6/Rendezvous b/Lang/Perl-6/Rendezvous new file mode 120000 index 0000000000..dd89db83c8 --- /dev/null +++ b/Lang/Perl-6/Rendezvous @@ -0,0 +1 @@ +../../Task/Rendezvous/Perl-6 \ No newline at end of file diff --git a/Lang/Perl/Chat-server b/Lang/Perl/Chat-server new file mode 120000 index 0000000000..b6bab0a684 --- /dev/null +++ b/Lang/Perl/Chat-server @@ -0,0 +1 @@ +../../Task/Chat-server/Perl \ No newline at end of file diff --git a/Lang/Perl/Conjugate-transpose b/Lang/Perl/Conjugate-transpose new file mode 120000 index 0000000000..5135637356 --- /dev/null +++ b/Lang/Perl/Conjugate-transpose @@ -0,0 +1 @@ +../../Task/Conjugate-transpose/Perl \ No newline at end of file diff --git a/Lang/Perl/Function-frequency b/Lang/Perl/Function-frequency new file mode 120000 index 0000000000..0a5ec10ae3 --- /dev/null +++ b/Lang/Perl/Function-frequency @@ -0,0 +1 @@ +../../Task/Function-frequency/Perl \ No newline at end of file diff --git a/Lang/Perl/MD5-Implementation b/Lang/Perl/MD5-Implementation new file mode 120000 index 0000000000..9cd034d5e4 --- /dev/null +++ b/Lang/Perl/MD5-Implementation @@ -0,0 +1 @@ +../../Task/MD5-Implementation/Perl \ No newline at end of file diff --git a/Lang/Perl/Set-consolidation b/Lang/Perl/Set-consolidation new file mode 120000 index 0000000000..c4b4b08f62 --- /dev/null +++ b/Lang/Perl/Set-consolidation @@ -0,0 +1 @@ +../../Task/Set-consolidation/Perl \ No newline at end of file diff --git a/Lang/Perl/Singly-linked-list-Traversal b/Lang/Perl/Singly-linked-list-Traversal new file mode 120000 index 0000000000..c6b0dfe2fe --- /dev/null +++ b/Lang/Perl/Singly-linked-list-Traversal @@ -0,0 +1 @@ +../../Task/Singly-linked-list-Traversal/Perl \ No newline at end of file diff --git a/Lang/Perl/Solve-a-Holy-Knights-tour b/Lang/Perl/Solve-a-Holy-Knights-tour new file mode 120000 index 0000000000..8e6f567491 --- /dev/null +++ b/Lang/Perl/Solve-a-Holy-Knights-tour @@ -0,0 +1 @@ +../../Task/Solve-a-Holy-Knights-tour/Perl \ No newline at end of file diff --git a/Lang/Perl/Unix-ls b/Lang/Perl/Unix-ls new file mode 120000 index 0000000000..aa93a3c4e4 --- /dev/null +++ b/Lang/Perl/Unix-ls @@ -0,0 +1 @@ +../../Task/Unix-ls/Perl \ No newline at end of file diff --git a/Lang/PicoLisp/Hash-join b/Lang/PicoLisp/Hash-join new file mode 120000 index 0000000000..a156f8e318 --- /dev/null +++ b/Lang/PicoLisp/Hash-join @@ -0,0 +1 @@ +../../Task/Hash-join/PicoLisp \ No newline at end of file diff --git a/Lang/PicoLisp/I-before-E-except-after-C b/Lang/PicoLisp/I-before-E-except-after-C new file mode 120000 index 0000000000..c99e0b9c3d --- /dev/null +++ b/Lang/PicoLisp/I-before-E-except-after-C @@ -0,0 +1 @@ +../../Task/I-before-E-except-after-C/PicoLisp \ No newline at end of file diff --git a/Lang/PicoLisp/Iterated-digits-squaring b/Lang/PicoLisp/Iterated-digits-squaring new file mode 120000 index 0000000000..fe8daa36c8 --- /dev/null +++ b/Lang/PicoLisp/Iterated-digits-squaring @@ -0,0 +1 @@ +../../Task/Iterated-digits-squaring/PicoLisp \ No newline at end of file diff --git a/Lang/PicoLisp/Machine-code b/Lang/PicoLisp/Machine-code new file mode 120000 index 0000000000..ea28130eb2 --- /dev/null +++ b/Lang/PicoLisp/Machine-code @@ -0,0 +1 @@ +../../Task/Machine-code/PicoLisp \ No newline at end of file diff --git a/Lang/PicoLisp/Make-directory-path b/Lang/PicoLisp/Make-directory-path new file mode 120000 index 0000000000..3b94fb9e4f --- /dev/null +++ b/Lang/PicoLisp/Make-directory-path @@ -0,0 +1 @@ +../../Task/Make-directory-path/PicoLisp \ No newline at end of file diff --git a/Lang/PicoLisp/Move-to-front-algorithm b/Lang/PicoLisp/Move-to-front-algorithm new file mode 120000 index 0000000000..1755e5c181 --- /dev/null +++ b/Lang/PicoLisp/Move-to-front-algorithm @@ -0,0 +1 @@ +../../Task/Move-to-front-algorithm/PicoLisp \ No newline at end of file diff --git a/Lang/PicoLisp/Multifactorial b/Lang/PicoLisp/Multifactorial new file mode 120000 index 0000000000..8dabbdd2ec --- /dev/null +++ b/Lang/PicoLisp/Multifactorial @@ -0,0 +1 @@ +../../Task/Multifactorial/PicoLisp \ No newline at end of file diff --git a/Lang/PicoLisp/Order-disjoint-list-items b/Lang/PicoLisp/Order-disjoint-list-items new file mode 120000 index 0000000000..aa8535d337 --- /dev/null +++ b/Lang/PicoLisp/Order-disjoint-list-items @@ -0,0 +1 @@ +../../Task/Order-disjoint-list-items/PicoLisp \ No newline at end of file diff --git a/Lang/PicoLisp/Pernicious-numbers b/Lang/PicoLisp/Pernicious-numbers new file mode 120000 index 0000000000..d588a862b8 --- /dev/null +++ b/Lang/PicoLisp/Pernicious-numbers @@ -0,0 +1 @@ +../../Task/Pernicious-numbers/PicoLisp \ No newline at end of file diff --git a/Lang/PicoLisp/Phrase-reversals b/Lang/PicoLisp/Phrase-reversals new file mode 120000 index 0000000000..21340ddec6 --- /dev/null +++ b/Lang/PicoLisp/Phrase-reversals @@ -0,0 +1 @@ +../../Task/Phrase-reversals/PicoLisp \ No newline at end of file diff --git a/Lang/PicoLisp/Rep-string b/Lang/PicoLisp/Rep-string new file mode 120000 index 0000000000..e6fefc38cd --- /dev/null +++ b/Lang/PicoLisp/Rep-string @@ -0,0 +1 @@ +../../Task/Rep-string/PicoLisp \ No newline at end of file diff --git a/Lang/PicoLisp/Sparkline-in-unicode b/Lang/PicoLisp/Sparkline-in-unicode new file mode 120000 index 0000000000..1cc6b503ab --- /dev/null +++ b/Lang/PicoLisp/Sparkline-in-unicode @@ -0,0 +1 @@ +../../Task/Sparkline-in-unicode/PicoLisp \ No newline at end of file diff --git a/Lang/PicoLisp/Topswops b/Lang/PicoLisp/Topswops new file mode 120000 index 0000000000..b2c597983a --- /dev/null +++ b/Lang/PicoLisp/Topswops @@ -0,0 +1 @@ +../../Task/Topswops/PicoLisp \ No newline at end of file diff --git a/Lang/PicoLisp/Ulam-spiral--for-primes- b/Lang/PicoLisp/Ulam-spiral--for-primes- new file mode 120000 index 0000000000..457a84d81b --- /dev/null +++ b/Lang/PicoLisp/Ulam-spiral--for-primes- @@ -0,0 +1 @@ +../../Task/Ulam-spiral--for-primes-/PicoLisp \ No newline at end of file diff --git a/Lang/PicoLisp/Unix-ls b/Lang/PicoLisp/Unix-ls new file mode 120000 index 0000000000..d89a2428e7 --- /dev/null +++ b/Lang/PicoLisp/Unix-ls @@ -0,0 +1 @@ +../../Task/Unix-ls/PicoLisp \ No newline at end of file diff --git a/Lang/PlainTeX/Guess-the-number b/Lang/PlainTeX/Guess-the-number new file mode 120000 index 0000000000..23f10162b5 --- /dev/null +++ b/Lang/PlainTeX/Guess-the-number @@ -0,0 +1 @@ +../../Task/Guess-the-number/PlainTeX \ No newline at end of file diff --git a/Lang/PlainTeX/String-prepend b/Lang/PlainTeX/String-prepend new file mode 120000 index 0000000000..f93b9f52f8 --- /dev/null +++ b/Lang/PlainTeX/String-prepend @@ -0,0 +1 @@ +../../Task/String-prepend/PlainTeX \ No newline at end of file diff --git a/Lang/PlainTeX/Zig-zag-matrix b/Lang/PlainTeX/Zig-zag-matrix new file mode 120000 index 0000000000..1ce60c0b76 --- /dev/null +++ b/Lang/PlainTeX/Zig-zag-matrix @@ -0,0 +1 @@ +../../Task/Zig-zag-matrix/PlainTeX \ No newline at end of file diff --git a/Lang/PowerShell/Abstract-type b/Lang/PowerShell/Abstract-type new file mode 120000 index 0000000000..9390180c20 --- /dev/null +++ b/Lang/PowerShell/Abstract-type @@ -0,0 +1 @@ +../../Task/Abstract-type/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Accumulator-factory b/Lang/PowerShell/Accumulator-factory new file mode 120000 index 0000000000..16ca6ab4fd --- /dev/null +++ b/Lang/PowerShell/Accumulator-factory @@ -0,0 +1 @@ +../../Task/Accumulator-factory/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Align-columns b/Lang/PowerShell/Align-columns new file mode 120000 index 0000000000..214a3531e2 --- /dev/null +++ b/Lang/PowerShell/Align-columns @@ -0,0 +1 @@ +../../Task/Align-columns/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Aliquot-sequence-classifications b/Lang/PowerShell/Aliquot-sequence-classifications new file mode 120000 index 0000000000..13795d384b --- /dev/null +++ b/Lang/PowerShell/Aliquot-sequence-classifications @@ -0,0 +1 @@ +../../Task/Aliquot-sequence-classifications/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Amicable-pairs b/Lang/PowerShell/Amicable-pairs new file mode 120000 index 0000000000..6b3302d451 --- /dev/null +++ b/Lang/PowerShell/Amicable-pairs @@ -0,0 +1 @@ +../../Task/Amicable-pairs/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Append-a-record-to-the-end-of-a-text-file b/Lang/PowerShell/Append-a-record-to-the-end-of-a-text-file new file mode 120000 index 0000000000..63953d0624 --- /dev/null +++ b/Lang/PowerShell/Append-a-record-to-the-end-of-a-text-file @@ -0,0 +1 @@ +../../Task/Append-a-record-to-the-end-of-a-text-file/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Arbitrary-precision-integers--included- b/Lang/PowerShell/Arbitrary-precision-integers--included- new file mode 120000 index 0000000000..2230a9c96f --- /dev/null +++ b/Lang/PowerShell/Arbitrary-precision-integers--included- @@ -0,0 +1 @@ +../../Task/Arbitrary-precision-integers--included-/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Arithmetic-Complex b/Lang/PowerShell/Arithmetic-Complex new file mode 120000 index 0000000000..af92b2c782 --- /dev/null +++ b/Lang/PowerShell/Arithmetic-Complex @@ -0,0 +1 @@ +../../Task/Arithmetic-Complex/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Average-loop-length b/Lang/PowerShell/Average-loop-length new file mode 120000 index 0000000000..3a792e9d99 --- /dev/null +++ b/Lang/PowerShell/Average-loop-length @@ -0,0 +1 @@ +../../Task/Average-loop-length/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Averages-Mean-time-of-day b/Lang/PowerShell/Averages-Mean-time-of-day new file mode 120000 index 0000000000..598448f51e --- /dev/null +++ b/Lang/PowerShell/Averages-Mean-time-of-day @@ -0,0 +1 @@ +../../Task/Averages-Mean-time-of-day/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Averages-Median b/Lang/PowerShell/Averages-Median new file mode 120000 index 0000000000..110aae1065 --- /dev/null +++ b/Lang/PowerShell/Averages-Median @@ -0,0 +1 @@ +../../Task/Averages-Median/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Balanced-brackets b/Lang/PowerShell/Balanced-brackets new file mode 120000 index 0000000000..2dc56da900 --- /dev/null +++ b/Lang/PowerShell/Balanced-brackets @@ -0,0 +1 @@ +../../Task/Balanced-brackets/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Benfords-law b/Lang/PowerShell/Benfords-law new file mode 120000 index 0000000000..d9a20cfabb --- /dev/null +++ b/Lang/PowerShell/Benfords-law @@ -0,0 +1 @@ +../../Task/Benfords-law/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Binary-strings b/Lang/PowerShell/Binary-strings new file mode 120000 index 0000000000..6957299e86 --- /dev/null +++ b/Lang/PowerShell/Binary-strings @@ -0,0 +1 @@ +../../Task/Binary-strings/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Box-the-compass b/Lang/PowerShell/Box-the-compass new file mode 120000 index 0000000000..decc96b1e7 --- /dev/null +++ b/Lang/PowerShell/Box-the-compass @@ -0,0 +1 @@ +../../Task/Box-the-compass/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Bulls-and-cows b/Lang/PowerShell/Bulls-and-cows new file mode 120000 index 0000000000..11c1c4463c --- /dev/null +++ b/Lang/PowerShell/Bulls-and-cows @@ -0,0 +1 @@ +../../Task/Bulls-and-cows/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/CSV-data-manipulation b/Lang/PowerShell/CSV-data-manipulation new file mode 120000 index 0000000000..d035edb53b --- /dev/null +++ b/Lang/PowerShell/CSV-data-manipulation @@ -0,0 +1 @@ +../../Task/CSV-data-manipulation/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Case-sensitivity-of-identifiers b/Lang/PowerShell/Case-sensitivity-of-identifiers new file mode 120000 index 0000000000..0ea2c18e20 --- /dev/null +++ b/Lang/PowerShell/Case-sensitivity-of-identifiers @@ -0,0 +1 @@ +../../Task/Case-sensitivity-of-identifiers/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Catalan-numbers b/Lang/PowerShell/Catalan-numbers new file mode 120000 index 0000000000..20d69768f2 --- /dev/null +++ b/Lang/PowerShell/Catalan-numbers @@ -0,0 +1 @@ +../../Task/Catalan-numbers/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Catamorphism b/Lang/PowerShell/Catamorphism new file mode 120000 index 0000000000..b4f41ddba2 --- /dev/null +++ b/Lang/PowerShell/Catamorphism @@ -0,0 +1 @@ +../../Task/Catamorphism/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Cholesky-decomposition b/Lang/PowerShell/Cholesky-decomposition new file mode 120000 index 0000000000..e432621b0f --- /dev/null +++ b/Lang/PowerShell/Cholesky-decomposition @@ -0,0 +1 @@ +../../Task/Cholesky-decomposition/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Classes b/Lang/PowerShell/Classes new file mode 120000 index 0000000000..31a6108e2b --- /dev/null +++ b/Lang/PowerShell/Classes @@ -0,0 +1 @@ +../../Task/Classes/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Closures-Value-capture b/Lang/PowerShell/Closures-Value-capture new file mode 120000 index 0000000000..5575c21e33 --- /dev/null +++ b/Lang/PowerShell/Closures-Value-capture @@ -0,0 +1 @@ +../../Task/Closures-Value-capture/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Colour-bars-Display b/Lang/PowerShell/Colour-bars-Display new file mode 120000 index 0000000000..b17e41c8d8 --- /dev/null +++ b/Lang/PowerShell/Colour-bars-Display @@ -0,0 +1 @@ +../../Task/Colour-bars-Display/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Combinations b/Lang/PowerShell/Combinations new file mode 120000 index 0000000000..98208e6735 --- /dev/null +++ b/Lang/PowerShell/Combinations @@ -0,0 +1 @@ +../../Task/Combinations/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Comma-quibbling b/Lang/PowerShell/Comma-quibbling new file mode 120000 index 0000000000..bd478096b4 --- /dev/null +++ b/Lang/PowerShell/Comma-quibbling @@ -0,0 +1 @@ +../../Task/Comma-quibbling/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Compound-data-type b/Lang/PowerShell/Compound-data-type new file mode 120000 index 0000000000..142de44ca6 --- /dev/null +++ b/Lang/PowerShell/Compound-data-type @@ -0,0 +1 @@ +../../Task/Compound-data-type/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Conjugate-transpose b/Lang/PowerShell/Conjugate-transpose new file mode 120000 index 0000000000..29713ae272 --- /dev/null +++ b/Lang/PowerShell/Conjugate-transpose @@ -0,0 +1 @@ +../../Task/Conjugate-transpose/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Constrained-random-points-on-a-circle b/Lang/PowerShell/Constrained-random-points-on-a-circle new file mode 120000 index 0000000000..6fa1faf1c2 --- /dev/null +++ b/Lang/PowerShell/Constrained-random-points-on-a-circle @@ -0,0 +1 @@ +../../Task/Constrained-random-points-on-a-circle/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Create-a-two-dimensional-array-at-runtime b/Lang/PowerShell/Create-a-two-dimensional-array-at-runtime new file mode 120000 index 0000000000..bc58938c1d --- /dev/null +++ b/Lang/PowerShell/Create-a-two-dimensional-array-at-runtime @@ -0,0 +1 @@ +../../Task/Create-a-two-dimensional-array-at-runtime/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Currying b/Lang/PowerShell/Currying new file mode 120000 index 0000000000..7c5e1e239a --- /dev/null +++ b/Lang/PowerShell/Currying @@ -0,0 +1 @@ +../../Task/Currying/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Define-a-primitive-data-type b/Lang/PowerShell/Define-a-primitive-data-type new file mode 120000 index 0000000000..3cbbbe06ed --- /dev/null +++ b/Lang/PowerShell/Define-a-primitive-data-type @@ -0,0 +1 @@ +../../Task/Define-a-primitive-data-type/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Determine-if-only-one-instance-is-running b/Lang/PowerShell/Determine-if-only-one-instance-is-running new file mode 120000 index 0000000000..d3ad088603 --- /dev/null +++ b/Lang/PowerShell/Determine-if-only-one-instance-is-running @@ -0,0 +1 @@ +../../Task/Determine-if-only-one-instance-is-running/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Dinesmans-multiple-dwelling-problem b/Lang/PowerShell/Dinesmans-multiple-dwelling-problem new file mode 120000 index 0000000000..b9f491a0d3 --- /dev/null +++ b/Lang/PowerShell/Dinesmans-multiple-dwelling-problem @@ -0,0 +1 @@ +../../Task/Dinesmans-multiple-dwelling-problem/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Discordian-date b/Lang/PowerShell/Discordian-date new file mode 120000 index 0000000000..92212230c2 --- /dev/null +++ b/Lang/PowerShell/Discordian-date @@ -0,0 +1 @@ +../../Task/Discordian-date/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Documentation b/Lang/PowerShell/Documentation new file mode 120000 index 0000000000..d3ea2cc3ec --- /dev/null +++ b/Lang/PowerShell/Documentation @@ -0,0 +1 @@ +../../Task/Documentation/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Doubly-linked-list-Definition b/Lang/PowerShell/Doubly-linked-list-Definition new file mode 120000 index 0000000000..619c280a03 --- /dev/null +++ b/Lang/PowerShell/Doubly-linked-list-Definition @@ -0,0 +1 @@ +../../Task/Doubly-linked-list-Definition/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Dutch-national-flag-problem b/Lang/PowerShell/Dutch-national-flag-problem new file mode 120000 index 0000000000..a1f36fe2ed --- /dev/null +++ b/Lang/PowerShell/Dutch-national-flag-problem @@ -0,0 +1 @@ +../../Task/Dutch-national-flag-problem/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Empty-program b/Lang/PowerShell/Empty-program new file mode 120000 index 0000000000..e44b1ed6ac --- /dev/null +++ b/Lang/PowerShell/Empty-program @@ -0,0 +1 @@ +../../Task/Empty-program/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Enumerations b/Lang/PowerShell/Enumerations new file mode 120000 index 0000000000..05343e5109 --- /dev/null +++ b/Lang/PowerShell/Enumerations @@ -0,0 +1 @@ +../../Task/Enumerations/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Execute-HQ9+ b/Lang/PowerShell/Execute-HQ9+ new file mode 120000 index 0000000000..f0e0dc0c29 --- /dev/null +++ b/Lang/PowerShell/Execute-HQ9+ @@ -0,0 +1 @@ +../../Task/Execute-HQ9+/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Extend-your-language b/Lang/PowerShell/Extend-your-language new file mode 120000 index 0000000000..a83e6d8416 --- /dev/null +++ b/Lang/PowerShell/Extend-your-language @@ -0,0 +1 @@ +../../Task/Extend-your-language/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Find-the-last-Sunday-of-each-month b/Lang/PowerShell/Find-the-last-Sunday-of-each-month new file mode 120000 index 0000000000..e887d9e2d1 --- /dev/null +++ b/Lang/PowerShell/Find-the-last-Sunday-of-each-month @@ -0,0 +1 @@ +../../Task/Find-the-last-Sunday-of-each-month/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Gamma-function b/Lang/PowerShell/Gamma-function new file mode 120000 index 0000000000..418db7ae34 --- /dev/null +++ b/Lang/PowerShell/Gamma-function @@ -0,0 +1 @@ +../../Task/Gamma-function/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Gaussian-elimination b/Lang/PowerShell/Gaussian-elimination new file mode 120000 index 0000000000..e62c4692b2 --- /dev/null +++ b/Lang/PowerShell/Gaussian-elimination @@ -0,0 +1 @@ +../../Task/Gaussian-elimination/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Generate-Chess960-starting-position b/Lang/PowerShell/Generate-Chess960-starting-position new file mode 120000 index 0000000000..0b262e0751 --- /dev/null +++ b/Lang/PowerShell/Generate-Chess960-starting-position @@ -0,0 +1 @@ +../../Task/Generate-Chess960-starting-position/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Generate-lower-case-ASCII-alphabet b/Lang/PowerShell/Generate-lower-case-ASCII-alphabet new file mode 120000 index 0000000000..cca76be154 --- /dev/null +++ b/Lang/PowerShell/Generate-lower-case-ASCII-alphabet @@ -0,0 +1 @@ +../../Task/Generate-lower-case-ASCII-alphabet/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Globally-replace-text-in-several-files b/Lang/PowerShell/Globally-replace-text-in-several-files new file mode 120000 index 0000000000..0829e73416 --- /dev/null +++ b/Lang/PowerShell/Globally-replace-text-in-several-files @@ -0,0 +1 @@ +../../Task/Globally-replace-text-in-several-files/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Guess-the-number-With-feedback b/Lang/PowerShell/Guess-the-number-With-feedback new file mode 120000 index 0000000000..78f3a518d7 --- /dev/null +++ b/Lang/PowerShell/Guess-the-number-With-feedback @@ -0,0 +1 @@ +../../Task/Guess-the-number-With-feedback/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Harshad-or-Niven-series b/Lang/PowerShell/Harshad-or-Niven-series new file mode 120000 index 0000000000..ec20e925d8 --- /dev/null +++ b/Lang/PowerShell/Harshad-or-Niven-series @@ -0,0 +1 @@ +../../Task/Harshad-or-Niven-series/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Haversine-formula b/Lang/PowerShell/Haversine-formula new file mode 120000 index 0000000000..ac1a9fb048 --- /dev/null +++ b/Lang/PowerShell/Haversine-formula @@ -0,0 +1 @@ +../../Task/Haversine-formula/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Holidays-related-to-Easter b/Lang/PowerShell/Holidays-related-to-Easter new file mode 120000 index 0000000000..7a02b060d6 --- /dev/null +++ b/Lang/PowerShell/Holidays-related-to-Easter @@ -0,0 +1 @@ +../../Task/Holidays-related-to-Easter/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Horizontal-sundial-calculations b/Lang/PowerShell/Horizontal-sundial-calculations new file mode 120000 index 0000000000..1892485510 --- /dev/null +++ b/Lang/PowerShell/Horizontal-sundial-calculations @@ -0,0 +1 @@ +../../Task/Horizontal-sundial-calculations/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Huffman-coding b/Lang/PowerShell/Huffman-coding new file mode 120000 index 0000000000..39f84fd1b4 --- /dev/null +++ b/Lang/PowerShell/Huffman-coding @@ -0,0 +1 @@ +../../Task/Huffman-coding/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/IBAN b/Lang/PowerShell/IBAN new file mode 120000 index 0000000000..0ef23dc960 --- /dev/null +++ b/Lang/PowerShell/IBAN @@ -0,0 +1 @@ +../../Task/IBAN/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Include-a-file b/Lang/PowerShell/Include-a-file new file mode 120000 index 0000000000..4d04b0dd10 --- /dev/null +++ b/Lang/PowerShell/Include-a-file @@ -0,0 +1 @@ +../../Task/Include-a-file/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Inheritance-Multiple b/Lang/PowerShell/Inheritance-Multiple new file mode 120000 index 0000000000..fd403f990e --- /dev/null +++ b/Lang/PowerShell/Inheritance-Multiple @@ -0,0 +1 @@ +../../Task/Inheritance-Multiple/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Inheritance-Single b/Lang/PowerShell/Inheritance-Single new file mode 120000 index 0000000000..d50efbcfb6 --- /dev/null +++ b/Lang/PowerShell/Inheritance-Single @@ -0,0 +1 @@ +../../Task/Inheritance-Single/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Inverted-index b/Lang/PowerShell/Inverted-index new file mode 120000 index 0000000000..a225bc9ed2 --- /dev/null +++ b/Lang/PowerShell/Inverted-index @@ -0,0 +1 @@ +../../Task/Inverted-index/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Inverted-syntax b/Lang/PowerShell/Inverted-syntax new file mode 120000 index 0000000000..913fe03e6d --- /dev/null +++ b/Lang/PowerShell/Inverted-syntax @@ -0,0 +1 @@ +../../Task/Inverted-syntax/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Jump-anywhere b/Lang/PowerShell/Jump-anywhere new file mode 120000 index 0000000000..3c37b17af1 --- /dev/null +++ b/Lang/PowerShell/Jump-anywhere @@ -0,0 +1 @@ +../../Task/Jump-anywhere/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Kaprekar-numbers b/Lang/PowerShell/Kaprekar-numbers new file mode 120000 index 0000000000..ca229b62e7 --- /dev/null +++ b/Lang/PowerShell/Kaprekar-numbers @@ -0,0 +1 @@ +../../Task/Kaprekar-numbers/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Keyboard-input-Obtain-a-Y-or-N-response b/Lang/PowerShell/Keyboard-input-Obtain-a-Y-or-N-response new file mode 120000 index 0000000000..fd954a5239 --- /dev/null +++ b/Lang/PowerShell/Keyboard-input-Obtain-a-Y-or-N-response @@ -0,0 +1 @@ +../../Task/Keyboard-input-Obtain-a-Y-or-N-response/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Knapsack-problem-Unbounded b/Lang/PowerShell/Knapsack-problem-Unbounded new file mode 120000 index 0000000000..3a67464ab4 --- /dev/null +++ b/Lang/PowerShell/Knapsack-problem-Unbounded @@ -0,0 +1 @@ +../../Task/Knapsack-problem-Unbounded/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Langtons-ant b/Lang/PowerShell/Langtons-ant new file mode 120000 index 0000000000..259493ac90 --- /dev/null +++ b/Lang/PowerShell/Langtons-ant @@ -0,0 +1 @@ +../../Task/Langtons-ant/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Largest-int-from-concatenated-ints b/Lang/PowerShell/Largest-int-from-concatenated-ints new file mode 120000 index 0000000000..43c8a6e659 --- /dev/null +++ b/Lang/PowerShell/Largest-int-from-concatenated-ints @@ -0,0 +1 @@ +../../Task/Largest-int-from-concatenated-ints/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Last-Friday-of-each-month b/Lang/PowerShell/Last-Friday-of-each-month new file mode 120000 index 0000000000..cf4b6977e1 --- /dev/null +++ b/Lang/PowerShell/Last-Friday-of-each-month @@ -0,0 +1 @@ +../../Task/Last-Friday-of-each-month/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Letter-frequency b/Lang/PowerShell/Letter-frequency new file mode 120000 index 0000000000..6355b045ce --- /dev/null +++ b/Lang/PowerShell/Letter-frequency @@ -0,0 +1 @@ +../../Task/Letter-frequency/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Levenshtein-distance b/Lang/PowerShell/Levenshtein-distance new file mode 120000 index 0000000000..acf77dc4c6 --- /dev/null +++ b/Lang/PowerShell/Levenshtein-distance @@ -0,0 +1 @@ +../../Task/Levenshtein-distance/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Longest-common-subsequence b/Lang/PowerShell/Longest-common-subsequence new file mode 120000 index 0000000000..f8aa05ff85 --- /dev/null +++ b/Lang/PowerShell/Longest-common-subsequence @@ -0,0 +1 @@ +../../Task/Longest-common-subsequence/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Longest-increasing-subsequence b/Lang/PowerShell/Longest-increasing-subsequence new file mode 120000 index 0000000000..e50cee75d6 --- /dev/null +++ b/Lang/PowerShell/Longest-increasing-subsequence @@ -0,0 +1 @@ +../../Task/Longest-increasing-subsequence/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Longest-string-challenge b/Lang/PowerShell/Longest-string-challenge new file mode 120000 index 0000000000..e9334d892c --- /dev/null +++ b/Lang/PowerShell/Longest-string-challenge @@ -0,0 +1 @@ +../../Task/Longest-string-challenge/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Loop-over-multiple-arrays-simultaneously b/Lang/PowerShell/Loop-over-multiple-arrays-simultaneously new file mode 120000 index 0000000000..25c3943bba --- /dev/null +++ b/Lang/PowerShell/Loop-over-multiple-arrays-simultaneously @@ -0,0 +1 @@ +../../Task/Loop-over-multiple-arrays-simultaneously/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Lucas-Lehmer-test b/Lang/PowerShell/Lucas-Lehmer-test new file mode 120000 index 0000000000..600811b04c --- /dev/null +++ b/Lang/PowerShell/Lucas-Lehmer-test @@ -0,0 +1 @@ +../../Task/Lucas-Lehmer-test/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Ludic-numbers b/Lang/PowerShell/Ludic-numbers new file mode 120000 index 0000000000..c494f840e8 --- /dev/null +++ b/Lang/PowerShell/Ludic-numbers @@ -0,0 +1 @@ +../../Task/Ludic-numbers/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Luhn-test-of-credit-card-numbers b/Lang/PowerShell/Luhn-test-of-credit-card-numbers new file mode 120000 index 0000000000..b52ff27355 --- /dev/null +++ b/Lang/PowerShell/Luhn-test-of-credit-card-numbers @@ -0,0 +1 @@ +../../Task/Luhn-test-of-credit-card-numbers/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Mad-Libs b/Lang/PowerShell/Mad-Libs new file mode 120000 index 0000000000..ed2f6585b6 --- /dev/null +++ b/Lang/PowerShell/Mad-Libs @@ -0,0 +1 @@ +../../Task/Mad-Libs/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Make-directory-path b/Lang/PowerShell/Make-directory-path new file mode 120000 index 0000000000..685667ee19 --- /dev/null +++ b/Lang/PowerShell/Make-directory-path @@ -0,0 +1 @@ +../../Task/Make-directory-path/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Mandelbrot-set b/Lang/PowerShell/Mandelbrot-set new file mode 120000 index 0000000000..5c63e6e1f4 --- /dev/null +++ b/Lang/PowerShell/Mandelbrot-set @@ -0,0 +1 @@ +../../Task/Mandelbrot-set/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Morse-code b/Lang/PowerShell/Morse-code new file mode 120000 index 0000000000..480555d31a --- /dev/null +++ b/Lang/PowerShell/Morse-code @@ -0,0 +1 @@ +../../Task/Morse-code/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Multiple-distinct-objects b/Lang/PowerShell/Multiple-distinct-objects new file mode 120000 index 0000000000..494d62206f --- /dev/null +++ b/Lang/PowerShell/Multiple-distinct-objects @@ -0,0 +1 @@ +../../Task/Multiple-distinct-objects/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Multiplication-tables b/Lang/PowerShell/Multiplication-tables new file mode 120000 index 0000000000..e30bfe9fae --- /dev/null +++ b/Lang/PowerShell/Multiplication-tables @@ -0,0 +1 @@ +../../Task/Multiplication-tables/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Multisplit b/Lang/PowerShell/Multisplit new file mode 120000 index 0000000000..ddf736d2ca --- /dev/null +++ b/Lang/PowerShell/Multisplit @@ -0,0 +1 @@ +../../Task/Multisplit/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/N-queens-problem b/Lang/PowerShell/N-queens-problem new file mode 120000 index 0000000000..91858a372d --- /dev/null +++ b/Lang/PowerShell/N-queens-problem @@ -0,0 +1 @@ +../../Task/N-queens-problem/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Narcissist b/Lang/PowerShell/Narcissist new file mode 120000 index 0000000000..e28688f02a --- /dev/null +++ b/Lang/PowerShell/Narcissist @@ -0,0 +1 @@ +../../Task/Narcissist/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Narcissistic-decimal-number b/Lang/PowerShell/Narcissistic-decimal-number new file mode 120000 index 0000000000..4af37b2663 --- /dev/null +++ b/Lang/PowerShell/Narcissistic-decimal-number @@ -0,0 +1 @@ +../../Task/Narcissistic-decimal-number/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Nautical-bell b/Lang/PowerShell/Nautical-bell new file mode 120000 index 0000000000..6172aa2fa0 --- /dev/null +++ b/Lang/PowerShell/Nautical-bell @@ -0,0 +1 @@ +../../Task/Nautical-bell/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Number-names b/Lang/PowerShell/Number-names new file mode 120000 index 0000000000..514a36ec6e --- /dev/null +++ b/Lang/PowerShell/Number-names @@ -0,0 +1 @@ +../../Task/Number-names/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/One-of-n-lines-in-a-file b/Lang/PowerShell/One-of-n-lines-in-a-file new file mode 120000 index 0000000000..85c22748d4 --- /dev/null +++ b/Lang/PowerShell/One-of-n-lines-in-a-file @@ -0,0 +1 @@ +../../Task/One-of-n-lines-in-a-file/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Order-two-numerical-lists b/Lang/PowerShell/Order-two-numerical-lists new file mode 120000 index 0000000000..b2d2cc6a69 --- /dev/null +++ b/Lang/PowerShell/Order-two-numerical-lists @@ -0,0 +1 @@ +../../Task/Order-two-numerical-lists/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Ordered-words b/Lang/PowerShell/Ordered-words new file mode 120000 index 0000000000..1c6dc34e94 --- /dev/null +++ b/Lang/PowerShell/Ordered-words @@ -0,0 +1 @@ +../../Task/Ordered-words/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Pangram-checker b/Lang/PowerShell/Pangram-checker new file mode 120000 index 0000000000..4fe04d5081 --- /dev/null +++ b/Lang/PowerShell/Pangram-checker @@ -0,0 +1 @@ +../../Task/Pangram-checker/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Parse-an-IP-Address b/Lang/PowerShell/Parse-an-IP-Address new file mode 120000 index 0000000000..7066102c2c --- /dev/null +++ b/Lang/PowerShell/Parse-an-IP-Address @@ -0,0 +1 @@ +../../Task/Parse-an-IP-Address/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Parsing-RPN-calculator-algorithm b/Lang/PowerShell/Parsing-RPN-calculator-algorithm new file mode 120000 index 0000000000..8fd31f05e7 --- /dev/null +++ b/Lang/PowerShell/Parsing-RPN-calculator-algorithm @@ -0,0 +1 @@ +../../Task/Parsing-RPN-calculator-algorithm/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Pernicious-numbers b/Lang/PowerShell/Pernicious-numbers new file mode 120000 index 0000000000..1be5bb2a31 --- /dev/null +++ b/Lang/PowerShell/Pernicious-numbers @@ -0,0 +1 @@ +../../Task/Pernicious-numbers/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Pragmatic-directives b/Lang/PowerShell/Pragmatic-directives new file mode 120000 index 0000000000..059b42e8a9 --- /dev/null +++ b/Lang/PowerShell/Pragmatic-directives @@ -0,0 +1 @@ +../../Task/Pragmatic-directives/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Problem-of-Apollonius b/Lang/PowerShell/Problem-of-Apollonius new file mode 120000 index 0000000000..f1158b9294 --- /dev/null +++ b/Lang/PowerShell/Problem-of-Apollonius @@ -0,0 +1 @@ +../../Task/Problem-of-Apollonius/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Quaternion-type b/Lang/PowerShell/Quaternion-type new file mode 120000 index 0000000000..60f8156bec --- /dev/null +++ b/Lang/PowerShell/Quaternion-type @@ -0,0 +1 @@ +../../Task/Quaternion-type/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Queue-Definition b/Lang/PowerShell/Queue-Definition new file mode 120000 index 0000000000..335d8da727 --- /dev/null +++ b/Lang/PowerShell/Queue-Definition @@ -0,0 +1 @@ +../../Task/Queue-Definition/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Quickselect-algorithm b/Lang/PowerShell/Quickselect-algorithm new file mode 120000 index 0000000000..841597b433 --- /dev/null +++ b/Lang/PowerShell/Quickselect-algorithm @@ -0,0 +1 @@ +../../Task/Quickselect-algorithm/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Random-numbers b/Lang/PowerShell/Random-numbers new file mode 120000 index 0000000000..616e0e50ec --- /dev/null +++ b/Lang/PowerShell/Random-numbers @@ -0,0 +1 @@ +../../Task/Random-numbers/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Ranking-methods b/Lang/PowerShell/Ranking-methods new file mode 120000 index 0000000000..7ce17949bf --- /dev/null +++ b/Lang/PowerShell/Ranking-methods @@ -0,0 +1 @@ +../../Task/Ranking-methods/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Rate-counter b/Lang/PowerShell/Rate-counter new file mode 120000 index 0000000000..3f9e7f07b9 --- /dev/null +++ b/Lang/PowerShell/Rate-counter @@ -0,0 +1 @@ +../../Task/Rate-counter/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Read-a-configuration-file b/Lang/PowerShell/Read-a-configuration-file new file mode 120000 index 0000000000..068da8958e --- /dev/null +++ b/Lang/PowerShell/Read-a-configuration-file @@ -0,0 +1 @@ +../../Task/Read-a-configuration-file/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/SEDOLs b/Lang/PowerShell/SEDOLs new file mode 120000 index 0000000000..a502dc3177 --- /dev/null +++ b/Lang/PowerShell/SEDOLs @@ -0,0 +1 @@ +../../Task/SEDOLs/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Scope-Function-names-and-labels b/Lang/PowerShell/Scope-Function-names-and-labels new file mode 120000 index 0000000000..b600e47117 --- /dev/null +++ b/Lang/PowerShell/Scope-Function-names-and-labels @@ -0,0 +1 @@ +../../Task/Scope-Function-names-and-labels/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Secure-temporary-file b/Lang/PowerShell/Secure-temporary-file new file mode 120000 index 0000000000..5cce53c9d6 --- /dev/null +++ b/Lang/PowerShell/Secure-temporary-file @@ -0,0 +1 @@ +../../Task/Secure-temporary-file/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Self-describing-numbers b/Lang/PowerShell/Self-describing-numbers new file mode 120000 index 0000000000..6353fe3485 --- /dev/null +++ b/Lang/PowerShell/Self-describing-numbers @@ -0,0 +1 @@ +../../Task/Self-describing-numbers/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Semiprime b/Lang/PowerShell/Semiprime new file mode 120000 index 0000000000..21db1abee7 --- /dev/null +++ b/Lang/PowerShell/Semiprime @@ -0,0 +1 @@ +../../Task/Semiprime/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Semordnilap b/Lang/PowerShell/Semordnilap new file mode 120000 index 0000000000..1043a00e66 --- /dev/null +++ b/Lang/PowerShell/Semordnilap @@ -0,0 +1 @@ +../../Task/Semordnilap/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Send-email b/Lang/PowerShell/Send-email new file mode 120000 index 0000000000..0332bb6212 --- /dev/null +++ b/Lang/PowerShell/Send-email @@ -0,0 +1 @@ +../../Task/Send-email/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Short-circuit-evaluation b/Lang/PowerShell/Short-circuit-evaluation new file mode 120000 index 0000000000..2574f96277 --- /dev/null +++ b/Lang/PowerShell/Short-circuit-evaluation @@ -0,0 +1 @@ +../../Task/Short-circuit-evaluation/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Simple-database b/Lang/PowerShell/Simple-database new file mode 120000 index 0000000000..dc5c387ecd --- /dev/null +++ b/Lang/PowerShell/Simple-database @@ -0,0 +1 @@ +../../Task/Simple-database/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Simulate-input-Keyboard b/Lang/PowerShell/Simulate-input-Keyboard new file mode 120000 index 0000000000..b32b7a12b8 --- /dev/null +++ b/Lang/PowerShell/Simulate-input-Keyboard @@ -0,0 +1 @@ +../../Task/Simulate-input-Keyboard/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Sorting-algorithms-Counting-sort b/Lang/PowerShell/Sorting-algorithms-Counting-sort new file mode 120000 index 0000000000..23f9d99dcf --- /dev/null +++ b/Lang/PowerShell/Sorting-algorithms-Counting-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Counting-sort/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Special-variables b/Lang/PowerShell/Special-variables new file mode 120000 index 0000000000..66a6f93de5 --- /dev/null +++ b/Lang/PowerShell/Special-variables @@ -0,0 +1 @@ +../../Task/Special-variables/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Speech-synthesis b/Lang/PowerShell/Speech-synthesis new file mode 120000 index 0000000000..fb4a07b832 --- /dev/null +++ b/Lang/PowerShell/Speech-synthesis @@ -0,0 +1 @@ +../../Task/Speech-synthesis/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Spiral-matrix b/Lang/PowerShell/Spiral-matrix new file mode 120000 index 0000000000..58c9c545f5 --- /dev/null +++ b/Lang/PowerShell/Spiral-matrix @@ -0,0 +1 @@ +../../Task/Spiral-matrix/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Stack b/Lang/PowerShell/Stack new file mode 120000 index 0000000000..fb73ff6c2c --- /dev/null +++ b/Lang/PowerShell/Stack @@ -0,0 +1 @@ +../../Task/Stack/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Stair-climbing-puzzle b/Lang/PowerShell/Stair-climbing-puzzle new file mode 120000 index 0000000000..3fd2f249a5 --- /dev/null +++ b/Lang/PowerShell/Stair-climbing-puzzle @@ -0,0 +1 @@ +../../Task/Stair-climbing-puzzle/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Stem-and-leaf-plot b/Lang/PowerShell/Stem-and-leaf-plot new file mode 120000 index 0000000000..eae5eef64c --- /dev/null +++ b/Lang/PowerShell/Stem-and-leaf-plot @@ -0,0 +1 @@ +../../Task/Stem-and-leaf-plot/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Stern-Brocot-sequence b/Lang/PowerShell/Stern-Brocot-sequence new file mode 120000 index 0000000000..0032947577 --- /dev/null +++ b/Lang/PowerShell/Stern-Brocot-sequence @@ -0,0 +1 @@ +../../Task/Stern-Brocot-sequence/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Subtractive-generator b/Lang/PowerShell/Subtractive-generator new file mode 120000 index 0000000000..f4920623af --- /dev/null +++ b/Lang/PowerShell/Subtractive-generator @@ -0,0 +1 @@ +../../Task/Subtractive-generator/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Symmetric-difference b/Lang/PowerShell/Symmetric-difference new file mode 120000 index 0000000000..b26eaaaa62 --- /dev/null +++ b/Lang/PowerShell/Symmetric-difference @@ -0,0 +1 @@ +../../Task/Symmetric-difference/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Table-creation-Postal-addresses b/Lang/PowerShell/Table-creation-Postal-addresses new file mode 120000 index 0000000000..0d72fb498c --- /dev/null +++ b/Lang/PowerShell/Table-creation-Postal-addresses @@ -0,0 +1 @@ +../../Task/Table-creation-Postal-addresses/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Terminal-control-Coloured-text b/Lang/PowerShell/Terminal-control-Coloured-text new file mode 120000 index 0000000000..72338610a7 --- /dev/null +++ b/Lang/PowerShell/Terminal-control-Coloured-text @@ -0,0 +1 @@ +../../Task/Terminal-control-Coloured-text/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Text-processing-Max-licenses-in-use b/Lang/PowerShell/Text-processing-Max-licenses-in-use new file mode 120000 index 0000000000..0662ec374b --- /dev/null +++ b/Lang/PowerShell/Text-processing-Max-licenses-in-use @@ -0,0 +1 @@ +../../Task/Text-processing-Max-licenses-in-use/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Textonyms b/Lang/PowerShell/Textonyms new file mode 120000 index 0000000000..38d7d5bc2b --- /dev/null +++ b/Lang/PowerShell/Textonyms @@ -0,0 +1 @@ +../../Task/Textonyms/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Topic-variable b/Lang/PowerShell/Topic-variable new file mode 120000 index 0000000000..3e519105fb --- /dev/null +++ b/Lang/PowerShell/Topic-variable @@ -0,0 +1 @@ +../../Task/Topic-variable/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/URL-decoding b/Lang/PowerShell/URL-decoding new file mode 120000 index 0000000000..ca59b80f9c --- /dev/null +++ b/Lang/PowerShell/URL-decoding @@ -0,0 +1 @@ +../../Task/URL-decoding/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Ulam-spiral--for-primes- b/Lang/PowerShell/Ulam-spiral--for-primes- new file mode 120000 index 0000000000..2c000f65c8 --- /dev/null +++ b/Lang/PowerShell/Ulam-spiral--for-primes- @@ -0,0 +1 @@ +../../Task/Ulam-spiral--for-primes-/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Unbias-a-random-generator b/Lang/PowerShell/Unbias-a-random-generator new file mode 120000 index 0000000000..d033aca41e --- /dev/null +++ b/Lang/PowerShell/Unbias-a-random-generator @@ -0,0 +1 @@ +../../Task/Unbias-a-random-generator/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Undefined-values b/Lang/PowerShell/Undefined-values new file mode 120000 index 0000000000..1b87340778 --- /dev/null +++ b/Lang/PowerShell/Undefined-values @@ -0,0 +1 @@ +../../Task/Undefined-values/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Unicode-variable-names b/Lang/PowerShell/Unicode-variable-names new file mode 120000 index 0000000000..6d64fdc654 --- /dev/null +++ b/Lang/PowerShell/Unicode-variable-names @@ -0,0 +1 @@ +../../Task/Unicode-variable-names/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Update-a-configuration-file b/Lang/PowerShell/Update-a-configuration-file new file mode 120000 index 0000000000..e61498f003 --- /dev/null +++ b/Lang/PowerShell/Update-a-configuration-file @@ -0,0 +1 @@ +../../Task/Update-a-configuration-file/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Vigen-re-cipher b/Lang/PowerShell/Vigen-re-cipher new file mode 120000 index 0000000000..ca557a521d --- /dev/null +++ b/Lang/PowerShell/Vigen-re-cipher @@ -0,0 +1 @@ +../../Task/Vigen-re-cipher/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Write-float-arrays-to-a-text-file b/Lang/PowerShell/Write-float-arrays-to-a-text-file new file mode 120000 index 0000000000..605bf473f0 --- /dev/null +++ b/Lang/PowerShell/Write-float-arrays-to-a-text-file @@ -0,0 +1 @@ +../../Task/Write-float-arrays-to-a-text-file/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/XML-XPath b/Lang/PowerShell/XML-XPath new file mode 120000 index 0000000000..5090a527cc --- /dev/null +++ b/Lang/PowerShell/XML-XPath @@ -0,0 +1 @@ +../../Task/XML-XPath/PowerShell \ No newline at end of file diff --git a/Lang/PowerShell/Zeckendorf-number-representation b/Lang/PowerShell/Zeckendorf-number-representation new file mode 120000 index 0000000000..bd819e6a10 --- /dev/null +++ b/Lang/PowerShell/Zeckendorf-number-representation @@ -0,0 +1 @@ +../../Task/Zeckendorf-number-representation/PowerShell \ No newline at end of file diff --git a/Lang/Processing/100-doors b/Lang/Processing/100-doors new file mode 120000 index 0000000000..f539c8eea6 --- /dev/null +++ b/Lang/Processing/100-doors @@ -0,0 +1 @@ +../../Task/100-doors/Processing \ No newline at end of file diff --git a/Lang/Processing/99-Bottles-of-Beer b/Lang/Processing/99-Bottles-of-Beer new file mode 120000 index 0000000000..a85e7b1a94 --- /dev/null +++ b/Lang/Processing/99-Bottles-of-Beer @@ -0,0 +1 @@ +../../Task/99-Bottles-of-Beer/Processing \ No newline at end of file diff --git a/Lang/Processing/A+B b/Lang/Processing/A+B new file mode 120000 index 0000000000..e71a4fa7cb --- /dev/null +++ b/Lang/Processing/A+B @@ -0,0 +1 @@ +../../Task/A+B/Processing \ No newline at end of file diff --git a/Lang/Processing/Brownian-tree b/Lang/Processing/Brownian-tree new file mode 120000 index 0000000000..d1e3e3f994 --- /dev/null +++ b/Lang/Processing/Brownian-tree @@ -0,0 +1 @@ +../../Task/Brownian-tree/Processing \ No newline at end of file diff --git a/Lang/Processing/Call-an-object-method b/Lang/Processing/Call-an-object-method new file mode 120000 index 0000000000..2338190047 --- /dev/null +++ b/Lang/Processing/Call-an-object-method @@ -0,0 +1 @@ +../../Task/Call-an-object-method/Processing \ No newline at end of file diff --git a/Lang/Processing/Comments b/Lang/Processing/Comments new file mode 120000 index 0000000000..73ca03cf8e --- /dev/null +++ b/Lang/Processing/Comments @@ -0,0 +1 @@ +../../Task/Comments/Processing \ No newline at end of file diff --git a/Lang/Processing/Function-definition b/Lang/Processing/Function-definition new file mode 120000 index 0000000000..9a3caad349 --- /dev/null +++ b/Lang/Processing/Function-definition @@ -0,0 +1 @@ +../../Task/Function-definition/Processing \ No newline at end of file diff --git a/Lang/Processing/Hello-world-Text b/Lang/Processing/Hello-world-Text new file mode 120000 index 0000000000..2a60b8b593 --- /dev/null +++ b/Lang/Processing/Hello-world-Text @@ -0,0 +1 @@ +../../Task/Hello-world-Text/Processing \ No newline at end of file diff --git a/Lang/Prolog/Abundant,-deficient-and-perfect-number-classifications b/Lang/Prolog/Abundant,-deficient-and-perfect-number-classifications new file mode 120000 index 0000000000..817860f6b7 --- /dev/null +++ b/Lang/Prolog/Abundant,-deficient-and-perfect-number-classifications @@ -0,0 +1 @@ +../../Task/Abundant,-deficient-and-perfect-number-classifications/Prolog \ No newline at end of file diff --git a/Lang/Prolog/Soundex b/Lang/Prolog/Soundex new file mode 120000 index 0000000000..806797aca2 --- /dev/null +++ b/Lang/Prolog/Soundex @@ -0,0 +1 @@ +../../Task/Soundex/Prolog \ No newline at end of file diff --git a/Lang/Prolog/The-Twelve-Days-of-Christmas b/Lang/Prolog/The-Twelve-Days-of-Christmas new file mode 120000 index 0000000000..c2d4539ef5 --- /dev/null +++ b/Lang/Prolog/The-Twelve-Days-of-Christmas @@ -0,0 +1 @@ +../../Task/The-Twelve-Days-of-Christmas/Prolog \ No newline at end of file diff --git a/Lang/Prolog/Variables b/Lang/Prolog/Variables new file mode 120000 index 0000000000..1f61549c5a --- /dev/null +++ b/Lang/Prolog/Variables @@ -0,0 +1 @@ +../../Task/Variables/Prolog \ No newline at end of file diff --git a/Lang/Protium/00DESCRIPTION b/Lang/Protium/00DESCRIPTION index bd00fa02bb..e69de29bb2 100644 --- a/Lang/Protium/00DESCRIPTION +++ b/Lang/Protium/00DESCRIPTION @@ -1,8 +0,0 @@ -{{Stub}} -{{language|Protium -|site=http://www.protiumblue.com/ -}} -Protium is a universal, symbolic programming language system, based on a systematic a priori analysis of the tasks required for computation. - -== See Also == -* [http://lambda-the-ultimate.org/node/2586 Lambda the Ultimate Discusion of Protium] \ No newline at end of file diff --git a/Lang/PureBasic/Abundant,-deficient-and-perfect-number-classifications b/Lang/PureBasic/Abundant,-deficient-and-perfect-number-classifications new file mode 120000 index 0000000000..67e7c78059 --- /dev/null +++ b/Lang/PureBasic/Abundant,-deficient-and-perfect-number-classifications @@ -0,0 +1 @@ +../../Task/Abundant,-deficient-and-perfect-number-classifications/PureBasic \ No newline at end of file diff --git a/Lang/PureBasic/Amicable-pairs b/Lang/PureBasic/Amicable-pairs new file mode 120000 index 0000000000..7edef4b433 --- /dev/null +++ b/Lang/PureBasic/Amicable-pairs @@ -0,0 +1 @@ +../../Task/Amicable-pairs/PureBasic \ No newline at end of file diff --git a/Lang/PureBasic/Bitcoin-address-validation b/Lang/PureBasic/Bitcoin-address-validation new file mode 120000 index 0000000000..886d40066c --- /dev/null +++ b/Lang/PureBasic/Bitcoin-address-validation @@ -0,0 +1 @@ +../../Task/Bitcoin-address-validation/PureBasic \ No newline at end of file diff --git a/Lang/PureBasic/CRC-32 b/Lang/PureBasic/CRC-32 new file mode 120000 index 0000000000..4e9d0f73de --- /dev/null +++ b/Lang/PureBasic/CRC-32 @@ -0,0 +1 @@ +../../Task/CRC-32/PureBasic \ No newline at end of file diff --git a/Lang/PureBasic/CSV-data-manipulation b/Lang/PureBasic/CSV-data-manipulation new file mode 120000 index 0000000000..c254e65b4a --- /dev/null +++ b/Lang/PureBasic/CSV-data-manipulation @@ -0,0 +1 @@ +../../Task/CSV-data-manipulation/PureBasic \ No newline at end of file diff --git a/Lang/PureBasic/Comma-quibbling b/Lang/PureBasic/Comma-quibbling new file mode 120000 index 0000000000..841d4e6c2c --- /dev/null +++ b/Lang/PureBasic/Comma-quibbling @@ -0,0 +1 @@ +../../Task/Comma-quibbling/PureBasic \ No newline at end of file diff --git a/Lang/PureBasic/Date-manipulation b/Lang/PureBasic/Date-manipulation new file mode 120000 index 0000000000..4f9748e927 --- /dev/null +++ b/Lang/PureBasic/Date-manipulation @@ -0,0 +1 @@ +../../Task/Date-manipulation/PureBasic \ No newline at end of file diff --git a/Lang/PureBasic/Magic-squares-of-odd-order b/Lang/PureBasic/Magic-squares-of-odd-order new file mode 120000 index 0000000000..86b0471c74 --- /dev/null +++ b/Lang/PureBasic/Magic-squares-of-odd-order @@ -0,0 +1 @@ +../../Task/Magic-squares-of-odd-order/PureBasic \ No newline at end of file diff --git a/Lang/PureBasic/Pernicious-numbers b/Lang/PureBasic/Pernicious-numbers new file mode 120000 index 0000000000..0bff34b62e --- /dev/null +++ b/Lang/PureBasic/Pernicious-numbers @@ -0,0 +1 @@ +../../Task/Pernicious-numbers/PureBasic \ No newline at end of file diff --git a/Lang/PureBasic/Remove-lines-from-a-file b/Lang/PureBasic/Remove-lines-from-a-file new file mode 120000 index 0000000000..00a7578046 --- /dev/null +++ b/Lang/PureBasic/Remove-lines-from-a-file @@ -0,0 +1 @@ +../../Task/Remove-lines-from-a-file/PureBasic \ No newline at end of file diff --git a/Lang/PureBasic/Runge-Kutta-method b/Lang/PureBasic/Runge-Kutta-method new file mode 120000 index 0000000000..34a6f0a7d5 --- /dev/null +++ b/Lang/PureBasic/Runge-Kutta-method @@ -0,0 +1 @@ +../../Task/Runge-Kutta-method/PureBasic \ No newline at end of file diff --git a/Lang/PureBasic/SHA-1 b/Lang/PureBasic/SHA-1 new file mode 120000 index 0000000000..dc27f08421 --- /dev/null +++ b/Lang/PureBasic/SHA-1 @@ -0,0 +1 @@ +../../Task/SHA-1/PureBasic \ No newline at end of file diff --git a/Lang/PureBasic/SHA-256 b/Lang/PureBasic/SHA-256 new file mode 120000 index 0000000000..06b7e243c4 --- /dev/null +++ b/Lang/PureBasic/SHA-256 @@ -0,0 +1 @@ +../../Task/SHA-256/PureBasic \ No newline at end of file diff --git a/Lang/PureBasic/String-comparison b/Lang/PureBasic/String-comparison new file mode 120000 index 0000000000..6e5e38cd0f --- /dev/null +++ b/Lang/PureBasic/String-comparison @@ -0,0 +1 @@ +../../Task/String-comparison/PureBasic \ No newline at end of file diff --git a/Lang/PureBasic/Sum-digits-of-an-integer b/Lang/PureBasic/Sum-digits-of-an-integer new file mode 120000 index 0000000000..b75b0eb0d0 --- /dev/null +++ b/Lang/PureBasic/Sum-digits-of-an-integer @@ -0,0 +1 @@ +../../Task/Sum-digits-of-an-integer/PureBasic \ No newline at end of file diff --git a/Lang/PureBasic/Sum-multiples-of-3-and-5 b/Lang/PureBasic/Sum-multiples-of-3-and-5 new file mode 120000 index 0000000000..80c5797b70 --- /dev/null +++ b/Lang/PureBasic/Sum-multiples-of-3-and-5 @@ -0,0 +1 @@ +../../Task/Sum-multiples-of-3-and-5/PureBasic \ No newline at end of file diff --git a/Lang/PureBasic/Variable-size-Set b/Lang/PureBasic/Variable-size-Set new file mode 120000 index 0000000000..937dad9b10 --- /dev/null +++ b/Lang/PureBasic/Variable-size-Set @@ -0,0 +1 @@ +../../Task/Variable-size-Set/PureBasic \ No newline at end of file diff --git a/Lang/PureBasic/Zero-to-the-zero-power b/Lang/PureBasic/Zero-to-the-zero-power new file mode 120000 index 0000000000..3753e52974 --- /dev/null +++ b/Lang/PureBasic/Zero-to-the-zero-power @@ -0,0 +1 @@ +../../Task/Zero-to-the-zero-power/PureBasic \ No newline at end of file diff --git a/Lang/Python/Calendar---for-REAL-programmers b/Lang/Python/Calendar---for-REAL-programmers new file mode 120000 index 0000000000..298fd17117 --- /dev/null +++ b/Lang/Python/Calendar---for-REAL-programmers @@ -0,0 +1 @@ +../../Task/Calendar---for-REAL-programmers/Python \ No newline at end of file diff --git a/Lang/Python/Pinstripe-Display b/Lang/Python/Pinstripe-Display new file mode 120000 index 0000000000..3b64811267 --- /dev/null +++ b/Lang/Python/Pinstripe-Display @@ -0,0 +1 @@ +../../Task/Pinstripe-Display/Python \ No newline at end of file diff --git a/Lang/Python/Speech-synthesis b/Lang/Python/Speech-synthesis new file mode 120000 index 0000000000..cb808736f5 --- /dev/null +++ b/Lang/Python/Speech-synthesis @@ -0,0 +1 @@ +../../Task/Speech-synthesis/Python \ No newline at end of file diff --git a/Lang/Python/Terminal-control-Unicode-output b/Lang/Python/Terminal-control-Unicode-output new file mode 120000 index 0000000000..81e71f9f6c --- /dev/null +++ b/Lang/Python/Terminal-control-Unicode-output @@ -0,0 +1 @@ +../../Task/Terminal-control-Unicode-output/Python \ No newline at end of file diff --git a/Lang/Q/Death-Star b/Lang/Q/Death-Star new file mode 120000 index 0000000000..406fa13592 --- /dev/null +++ b/Lang/Q/Death-Star @@ -0,0 +1 @@ +../../Task/Death-Star/Q \ No newline at end of file diff --git a/Lang/R/Almost-prime b/Lang/R/Almost-prime new file mode 120000 index 0000000000..2fc2587e6f --- /dev/null +++ b/Lang/R/Almost-prime @@ -0,0 +1 @@ +../../Task/Almost-prime/R \ No newline at end of file diff --git a/Lang/R/Count-in-factors b/Lang/R/Count-in-factors new file mode 120000 index 0000000000..e1d49220d2 --- /dev/null +++ b/Lang/R/Count-in-factors @@ -0,0 +1 @@ +../../Task/Count-in-factors/R \ No newline at end of file diff --git a/Lang/R/Digital-root b/Lang/R/Digital-root new file mode 120000 index 0000000000..a431dcb3dd --- /dev/null +++ b/Lang/R/Digital-root @@ -0,0 +1 @@ +../../Task/Digital-root/R \ No newline at end of file diff --git a/Lang/R/Multifactorial b/Lang/R/Multifactorial new file mode 120000 index 0000000000..f4052b747b --- /dev/null +++ b/Lang/R/Multifactorial @@ -0,0 +1 @@ +../../Task/Multifactorial/R \ No newline at end of file diff --git a/Lang/R/Penneys-game b/Lang/R/Penneys-game new file mode 120000 index 0000000000..367a6a9639 --- /dev/null +++ b/Lang/R/Penneys-game @@ -0,0 +1 @@ +../../Task/Penneys-game/R \ No newline at end of file diff --git a/Lang/R/Send-email b/Lang/R/Send-email new file mode 120000 index 0000000000..cf8c73d7c0 --- /dev/null +++ b/Lang/R/Send-email @@ -0,0 +1 @@ +../../Task/Send-email/R \ No newline at end of file diff --git a/Lang/R/Sorting-algorithms-Comb-sort b/Lang/R/Sorting-algorithms-Comb-sort new file mode 120000 index 0000000000..2263c9672d --- /dev/null +++ b/Lang/R/Sorting-algorithms-Comb-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Comb-sort/R \ No newline at end of file diff --git a/Lang/R/Sorting-algorithms-Stooge-sort b/Lang/R/Sorting-algorithms-Stooge-sort new file mode 120000 index 0000000000..dbb8930d28 --- /dev/null +++ b/Lang/R/Sorting-algorithms-Stooge-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Stooge-sort/R \ No newline at end of file diff --git a/Lang/R/Zero-to-the-zero-power b/Lang/R/Zero-to-the-zero-power new file mode 120000 index 0000000000..9c164f2637 --- /dev/null +++ b/Lang/R/Zero-to-the-zero-power @@ -0,0 +1 @@ +../../Task/Zero-to-the-zero-power/R \ No newline at end of file diff --git a/Lang/REBOL/Hailstone-sequence b/Lang/REBOL/Hailstone-sequence new file mode 120000 index 0000000000..f668d98fe0 --- /dev/null +++ b/Lang/REBOL/Hailstone-sequence @@ -0,0 +1 @@ +../../Task/Hailstone-sequence/REBOL \ No newline at end of file diff --git a/Lang/REBOL/Interactive-programming b/Lang/REBOL/Interactive-programming new file mode 120000 index 0000000000..f0f58b9ac1 --- /dev/null +++ b/Lang/REBOL/Interactive-programming @@ -0,0 +1 @@ +../../Task/Interactive-programming/REBOL \ No newline at end of file diff --git a/Lang/REBOL/Read-a-specific-line-from-a-file b/Lang/REBOL/Read-a-specific-line-from-a-file new file mode 120000 index 0000000000..fc3cb7c086 --- /dev/null +++ b/Lang/REBOL/Read-a-specific-line-from-a-file @@ -0,0 +1 @@ +../../Task/Read-a-specific-line-from-a-file/REBOL \ No newline at end of file diff --git a/Lang/REBOL/Sorting-algorithms-Insertion-sort b/Lang/REBOL/Sorting-algorithms-Insertion-sort new file mode 120000 index 0000000000..5a9f9f2f24 --- /dev/null +++ b/Lang/REBOL/Sorting-algorithms-Insertion-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Insertion-sort/REBOL \ No newline at end of file diff --git a/Lang/REXX/HTTP b/Lang/REXX/HTTP new file mode 120000 index 0000000000..0220301fed --- /dev/null +++ b/Lang/REXX/HTTP @@ -0,0 +1 @@ +../../Task/HTTP/REXX \ No newline at end of file diff --git a/Lang/REXX/Numeric-error-propagation b/Lang/REXX/Numeric-error-propagation new file mode 120000 index 0000000000..27aaef849a --- /dev/null +++ b/Lang/REXX/Numeric-error-propagation @@ -0,0 +1 @@ +../../Task/Numeric-error-propagation/REXX \ No newline at end of file diff --git a/Lang/REXX/Sort-an-array-of-composite-structures b/Lang/REXX/Sort-an-array-of-composite-structures new file mode 120000 index 0000000000..6af7635f24 --- /dev/null +++ b/Lang/REXX/Sort-an-array-of-composite-structures @@ -0,0 +1 @@ +../../Task/Sort-an-array-of-composite-structures/REXX \ No newline at end of file diff --git a/Lang/REXX/Stable-marriage-problem b/Lang/REXX/Stable-marriage-problem new file mode 120000 index 0000000000..f55dc04101 --- /dev/null +++ b/Lang/REXX/Stable-marriage-problem @@ -0,0 +1 @@ +../../Task/Stable-marriage-problem/REXX \ No newline at end of file diff --git a/Lang/REXX/Topological-sort b/Lang/REXX/Topological-sort new file mode 120000 index 0000000000..2d48ac1153 --- /dev/null +++ b/Lang/REXX/Topological-sort @@ -0,0 +1 @@ +../../Task/Topological-sort/REXX \ No newline at end of file diff --git a/Lang/REXX/Unicode-variable-names b/Lang/REXX/Unicode-variable-names new file mode 120000 index 0000000000..966d3f53fd --- /dev/null +++ b/Lang/REXX/Unicode-variable-names @@ -0,0 +1 @@ +../../Task/Unicode-variable-names/REXX \ No newline at end of file diff --git a/Lang/REXX/Zebra-puzzle b/Lang/REXX/Zebra-puzzle new file mode 120000 index 0000000000..53f94c2d55 --- /dev/null +++ b/Lang/REXX/Zebra-puzzle @@ -0,0 +1 @@ +../../Task/Zebra-puzzle/REXX \ No newline at end of file diff --git a/Lang/RPG/MD5 b/Lang/RPG/MD5 new file mode 120000 index 0000000000..cae7058d2b --- /dev/null +++ b/Lang/RPG/MD5 @@ -0,0 +1 @@ +../../Task/MD5/RPG \ No newline at end of file diff --git a/Lang/RPG/MD5-Implementation b/Lang/RPG/MD5-Implementation new file mode 120000 index 0000000000..5798ea1be9 --- /dev/null +++ b/Lang/RPG/MD5-Implementation @@ -0,0 +1 @@ +../../Task/MD5-Implementation/RPG \ No newline at end of file diff --git a/Lang/RPL-2/Averages-Arithmetic-mean b/Lang/RPL-2/Averages-Arithmetic-mean new file mode 120000 index 0000000000..2b38ee3b5e --- /dev/null +++ b/Lang/RPL-2/Averages-Arithmetic-mean @@ -0,0 +1 @@ +../../Task/Averages-Arithmetic-mean/RPL-2 \ No newline at end of file diff --git a/Lang/RapidQ/Binary-digits b/Lang/RapidQ/Binary-digits new file mode 120000 index 0000000000..fce9be7a11 --- /dev/null +++ b/Lang/RapidQ/Binary-digits @@ -0,0 +1 @@ +../../Task/Binary-digits/RapidQ \ No newline at end of file diff --git a/Lang/Ruby/Constrained-genericity b/Lang/Ruby/Constrained-genericity new file mode 120000 index 0000000000..34938e79bb --- /dev/null +++ b/Lang/Ruby/Constrained-genericity @@ -0,0 +1 @@ +../../Task/Constrained-genericity/Ruby \ No newline at end of file diff --git a/Lang/Ruby/Keyboard-input-Keypress-check b/Lang/Ruby/Keyboard-input-Keypress-check new file mode 120000 index 0000000000..d66a894b90 --- /dev/null +++ b/Lang/Ruby/Keyboard-input-Keypress-check @@ -0,0 +1 @@ +../../Task/Keyboard-input-Keypress-check/Ruby \ No newline at end of file diff --git a/Lang/Ruby/RSA-code b/Lang/Ruby/RSA-code new file mode 120000 index 0000000000..3088139995 --- /dev/null +++ b/Lang/Ruby/RSA-code @@ -0,0 +1 @@ +../../Task/RSA-code/Ruby \ No newline at end of file diff --git a/Lang/Run-BASIC/ABC-Problem b/Lang/Run-BASIC/ABC-Problem new file mode 120000 index 0000000000..8c96eac7f0 --- /dev/null +++ b/Lang/Run-BASIC/ABC-Problem @@ -0,0 +1 @@ +../../Task/ABC-Problem/Run-BASIC \ No newline at end of file diff --git a/Lang/Run-BASIC/Amicable-pairs b/Lang/Run-BASIC/Amicable-pairs new file mode 120000 index 0000000000..6d07309192 --- /dev/null +++ b/Lang/Run-BASIC/Amicable-pairs @@ -0,0 +1 @@ +../../Task/Amicable-pairs/Run-BASIC \ No newline at end of file diff --git a/Lang/Run-BASIC/Averages-Mean-time-of-day b/Lang/Run-BASIC/Averages-Mean-time-of-day new file mode 120000 index 0000000000..1657a39356 --- /dev/null +++ b/Lang/Run-BASIC/Averages-Mean-time-of-day @@ -0,0 +1 @@ +../../Task/Averages-Mean-time-of-day/Run-BASIC \ No newline at end of file diff --git a/Lang/Run-BASIC/Averages-Median b/Lang/Run-BASIC/Averages-Median new file mode 120000 index 0000000000..87132d543c --- /dev/null +++ b/Lang/Run-BASIC/Averages-Median @@ -0,0 +1 @@ +../../Task/Averages-Median/Run-BASIC \ No newline at end of file diff --git a/Lang/Run-BASIC/Empty-program b/Lang/Run-BASIC/Empty-program new file mode 120000 index 0000000000..c4848532e7 --- /dev/null +++ b/Lang/Run-BASIC/Empty-program @@ -0,0 +1 @@ +../../Task/Empty-program/Run-BASIC \ No newline at end of file diff --git a/Lang/Run-BASIC/Entropy b/Lang/Run-BASIC/Entropy new file mode 120000 index 0000000000..66cdf189b4 --- /dev/null +++ b/Lang/Run-BASIC/Entropy @@ -0,0 +1 @@ +../../Task/Entropy/Run-BASIC \ No newline at end of file diff --git a/Lang/Run-BASIC/Find-the-last-Sunday-of-each-month b/Lang/Run-BASIC/Find-the-last-Sunday-of-each-month new file mode 120000 index 0000000000..5f33212b3d --- /dev/null +++ b/Lang/Run-BASIC/Find-the-last-Sunday-of-each-month @@ -0,0 +1 @@ +../../Task/Find-the-last-Sunday-of-each-month/Run-BASIC \ No newline at end of file diff --git a/Lang/Run-BASIC/Hash-join b/Lang/Run-BASIC/Hash-join new file mode 120000 index 0000000000..ed63af139a --- /dev/null +++ b/Lang/Run-BASIC/Hash-join @@ -0,0 +1 @@ +../../Task/Hash-join/Run-BASIC \ No newline at end of file diff --git a/Lang/Run-BASIC/Hello-world-Newline-omission b/Lang/Run-BASIC/Hello-world-Newline-omission new file mode 120000 index 0000000000..065039b265 --- /dev/null +++ b/Lang/Run-BASIC/Hello-world-Newline-omission @@ -0,0 +1 @@ +../../Task/Hello-world-Newline-omission/Run-BASIC \ No newline at end of file diff --git a/Lang/Run-BASIC/Linear-congruential-generator b/Lang/Run-BASIC/Linear-congruential-generator new file mode 120000 index 0000000000..061db85eb6 --- /dev/null +++ b/Lang/Run-BASIC/Linear-congruential-generator @@ -0,0 +1 @@ +../../Task/Linear-congruential-generator/Run-BASIC \ No newline at end of file diff --git a/Lang/Run-BASIC/Make-directory-path b/Lang/Run-BASIC/Make-directory-path new file mode 120000 index 0000000000..22db875a57 --- /dev/null +++ b/Lang/Run-BASIC/Make-directory-path @@ -0,0 +1 @@ +../../Task/Make-directory-path/Run-BASIC \ No newline at end of file diff --git a/Lang/Run-BASIC/Multiplication-tables b/Lang/Run-BASIC/Multiplication-tables new file mode 120000 index 0000000000..bc3b7bb172 --- /dev/null +++ b/Lang/Run-BASIC/Multiplication-tables @@ -0,0 +1 @@ +../../Task/Multiplication-tables/Run-BASIC \ No newline at end of file diff --git a/Lang/Run-BASIC/Non-decimal-radices-Output b/Lang/Run-BASIC/Non-decimal-radices-Output new file mode 120000 index 0000000000..dc9d1717cc --- /dev/null +++ b/Lang/Run-BASIC/Non-decimal-radices-Output @@ -0,0 +1 @@ +../../Task/Non-decimal-radices-Output/Run-BASIC \ No newline at end of file diff --git a/Lang/Run-BASIC/Program-termination b/Lang/Run-BASIC/Program-termination new file mode 120000 index 0000000000..a1303f62a7 --- /dev/null +++ b/Lang/Run-BASIC/Program-termination @@ -0,0 +1 @@ +../../Task/Program-termination/Run-BASIC \ No newline at end of file diff --git a/Lang/Run-BASIC/Remove-duplicate-elements b/Lang/Run-BASIC/Remove-duplicate-elements new file mode 120000 index 0000000000..ee50448727 --- /dev/null +++ b/Lang/Run-BASIC/Remove-duplicate-elements @@ -0,0 +1 @@ +../../Task/Remove-duplicate-elements/Run-BASIC \ No newline at end of file diff --git a/Lang/Run-BASIC/Reverse-words-in-a-string b/Lang/Run-BASIC/Reverse-words-in-a-string new file mode 120000 index 0000000000..68099b9905 --- /dev/null +++ b/Lang/Run-BASIC/Reverse-words-in-a-string @@ -0,0 +1 @@ +../../Task/Reverse-words-in-a-string/Run-BASIC \ No newline at end of file diff --git a/Lang/Run-BASIC/Roots-of-unity b/Lang/Run-BASIC/Roots-of-unity new file mode 120000 index 0000000000..b59c37e85c --- /dev/null +++ b/Lang/Run-BASIC/Roots-of-unity @@ -0,0 +1 @@ +../../Task/Roots-of-unity/Run-BASIC \ No newline at end of file diff --git a/Lang/Run-BASIC/Set b/Lang/Run-BASIC/Set new file mode 120000 index 0000000000..1578601469 --- /dev/null +++ b/Lang/Run-BASIC/Set @@ -0,0 +1 @@ +../../Task/Set/Run-BASIC \ No newline at end of file diff --git a/Lang/Run-BASIC/Sierpinski-triangle b/Lang/Run-BASIC/Sierpinski-triangle new file mode 120000 index 0000000000..e46a27ce40 --- /dev/null +++ b/Lang/Run-BASIC/Sierpinski-triangle @@ -0,0 +1 @@ +../../Task/Sierpinski-triangle/Run-BASIC \ No newline at end of file diff --git a/Lang/Run-BASIC/Statistics-Basic b/Lang/Run-BASIC/Statistics-Basic new file mode 120000 index 0000000000..9b9287b21c --- /dev/null +++ b/Lang/Run-BASIC/Statistics-Basic @@ -0,0 +1 @@ +../../Task/Statistics-Basic/Run-BASIC \ No newline at end of file diff --git a/Lang/Run-BASIC/The-Twelve-Days-of-Christmas b/Lang/Run-BASIC/The-Twelve-Days-of-Christmas new file mode 120000 index 0000000000..bb4445be57 --- /dev/null +++ b/Lang/Run-BASIC/The-Twelve-Days-of-Christmas @@ -0,0 +1 @@ +../../Task/The-Twelve-Days-of-Christmas/Run-BASIC \ No newline at end of file diff --git a/Lang/Run-BASIC/Unix-ls b/Lang/Run-BASIC/Unix-ls new file mode 120000 index 0000000000..c64e0cf05f --- /dev/null +++ b/Lang/Run-BASIC/Unix-ls @@ -0,0 +1 @@ +../../Task/Unix-ls/Run-BASIC \ No newline at end of file diff --git a/Lang/Run-BASIC/Walk-a-directory-Non-recursively b/Lang/Run-BASIC/Walk-a-directory-Non-recursively new file mode 120000 index 0000000000..17992cf7bb --- /dev/null +++ b/Lang/Run-BASIC/Walk-a-directory-Non-recursively @@ -0,0 +1 @@ +../../Task/Walk-a-directory-Non-recursively/Run-BASIC \ No newline at end of file diff --git a/Lang/Rust/00DESCRIPTION b/Lang/Rust/00DESCRIPTION index ce935fc36e..e0a3dbfff0 100644 --- a/Lang/Rust/00DESCRIPTION +++ b/Lang/Rust/00DESCRIPTION @@ -13,6 +13,8 @@ Rust is a general purpose, multi-paradigm, systems programming language sponsored by Mozilla. Its goal is to provide a fast, practical, concurrent language with zero-cost abstractions and strong memory safety. It employs a unique model of ownership to eliminate data races. +Solutions to RosettaCode tasks are mirrored on GitHub at [http://github.com/Hoverbear/rust-rosetta Hoverbear/rust-rosetta]. If you implement a solution here, please open a pull request! + == Features == From the official website: * zero-cost abstractions diff --git a/Lang/Rust/24-game b/Lang/Rust/24-game new file mode 120000 index 0000000000..a1e95ee10f --- /dev/null +++ b/Lang/Rust/24-game @@ -0,0 +1 @@ +../../Task/24-game/Rust \ No newline at end of file diff --git a/Lang/Rust/9-billion-names-of-God-the-integer b/Lang/Rust/9-billion-names-of-God-the-integer new file mode 120000 index 0000000000..a0872e7181 --- /dev/null +++ b/Lang/Rust/9-billion-names-of-God-the-integer @@ -0,0 +1 @@ +../../Task/9-billion-names-of-God-the-integer/Rust \ No newline at end of file diff --git a/Lang/Rust/Abstract-type b/Lang/Rust/Abstract-type new file mode 120000 index 0000000000..6dcbe98b3e --- /dev/null +++ b/Lang/Rust/Abstract-type @@ -0,0 +1 @@ +../../Task/Abstract-type/Rust \ No newline at end of file diff --git a/Lang/Rust/Arena-storage-pool b/Lang/Rust/Arena-storage-pool new file mode 120000 index 0000000000..ae56090343 --- /dev/null +++ b/Lang/Rust/Arena-storage-pool @@ -0,0 +1 @@ +../../Task/Arena-storage-pool/Rust \ No newline at end of file diff --git a/Lang/Rust/Arithmetic-Rational b/Lang/Rust/Arithmetic-Rational new file mode 120000 index 0000000000..94acaf63da --- /dev/null +++ b/Lang/Rust/Arithmetic-Rational @@ -0,0 +1 @@ +../../Task/Arithmetic-Rational/Rust \ No newline at end of file diff --git a/Lang/Rust/Array-concatenation b/Lang/Rust/Array-concatenation new file mode 120000 index 0000000000..98c29116db --- /dev/null +++ b/Lang/Rust/Array-concatenation @@ -0,0 +1 @@ +../../Task/Array-concatenation/Rust \ No newline at end of file diff --git a/Lang/Rust/Associative-array-Creation b/Lang/Rust/Associative-array-Creation new file mode 120000 index 0000000000..d47c8882af --- /dev/null +++ b/Lang/Rust/Associative-array-Creation @@ -0,0 +1 @@ +../../Task/Associative-array-Creation/Rust \ No newline at end of file diff --git a/Lang/Rust/Atomic-updates b/Lang/Rust/Atomic-updates new file mode 120000 index 0000000000..c08bc68c6d --- /dev/null +++ b/Lang/Rust/Atomic-updates @@ -0,0 +1 @@ +../../Task/Atomic-updates/Rust \ No newline at end of file diff --git a/Lang/Rust/Average-loop-length b/Lang/Rust/Average-loop-length new file mode 120000 index 0000000000..e7cb405a17 --- /dev/null +++ b/Lang/Rust/Average-loop-length @@ -0,0 +1 @@ +../../Task/Average-loop-length/Rust \ No newline at end of file diff --git a/Lang/Rust/Averages-Mean-angle b/Lang/Rust/Averages-Mean-angle new file mode 120000 index 0000000000..0521baf164 --- /dev/null +++ b/Lang/Rust/Averages-Mean-angle @@ -0,0 +1 @@ +../../Task/Averages-Mean-angle/Rust \ No newline at end of file diff --git a/Lang/Rust/Averages-Mode b/Lang/Rust/Averages-Mode new file mode 120000 index 0000000000..9e8da5ad6f --- /dev/null +++ b/Lang/Rust/Averages-Mode @@ -0,0 +1 @@ +../../Task/Averages-Mode/Rust \ No newline at end of file diff --git a/Lang/Rust/Averages-Pythagorean-means b/Lang/Rust/Averages-Pythagorean-means new file mode 120000 index 0000000000..1e44378195 --- /dev/null +++ b/Lang/Rust/Averages-Pythagorean-means @@ -0,0 +1 @@ +../../Task/Averages-Pythagorean-means/Rust \ No newline at end of file diff --git a/Lang/Rust/Averages-Root-mean-square b/Lang/Rust/Averages-Root-mean-square new file mode 120000 index 0000000000..84664673e2 --- /dev/null +++ b/Lang/Rust/Averages-Root-mean-square @@ -0,0 +1 @@ +../../Task/Averages-Root-mean-square/Rust \ No newline at end of file diff --git a/Lang/Rust/Averages-Simple-moving-average b/Lang/Rust/Averages-Simple-moving-average new file mode 120000 index 0000000000..e39a50da60 --- /dev/null +++ b/Lang/Rust/Averages-Simple-moving-average @@ -0,0 +1 @@ +../../Task/Averages-Simple-moving-average/Rust \ No newline at end of file diff --git a/Lang/Rust/Benfords-law b/Lang/Rust/Benfords-law new file mode 120000 index 0000000000..77351bc402 --- /dev/null +++ b/Lang/Rust/Benfords-law @@ -0,0 +1 @@ +../../Task/Benfords-law/Rust \ No newline at end of file diff --git a/Lang/Rust/Bernoulli-numbers b/Lang/Rust/Bernoulli-numbers new file mode 120000 index 0000000000..0833ddc6db --- /dev/null +++ b/Lang/Rust/Bernoulli-numbers @@ -0,0 +1 @@ +../../Task/Bernoulli-numbers/Rust \ No newline at end of file diff --git a/Lang/Rust/Binary-strings b/Lang/Rust/Binary-strings new file mode 120000 index 0000000000..536ba2c2da --- /dev/null +++ b/Lang/Rust/Binary-strings @@ -0,0 +1 @@ +../../Task/Binary-strings/Rust \ No newline at end of file diff --git a/Lang/Rust/Brownian-tree b/Lang/Rust/Brownian-tree new file mode 120000 index 0000000000..e282f3eeb6 --- /dev/null +++ b/Lang/Rust/Brownian-tree @@ -0,0 +1 @@ +../../Task/Brownian-tree/Rust \ No newline at end of file diff --git a/Lang/Rust/CRC-32 b/Lang/Rust/CRC-32 new file mode 120000 index 0000000000..9432def6a3 --- /dev/null +++ b/Lang/Rust/CRC-32 @@ -0,0 +1 @@ +../../Task/CRC-32/Rust \ No newline at end of file diff --git a/Lang/Rust/Caesar-cipher b/Lang/Rust/Caesar-cipher new file mode 120000 index 0000000000..9f86d1a991 --- /dev/null +++ b/Lang/Rust/Caesar-cipher @@ -0,0 +1 @@ +../../Task/Caesar-cipher/Rust \ No newline at end of file diff --git a/Lang/Rust/Call-a-foreign-language-function b/Lang/Rust/Call-a-foreign-language-function new file mode 120000 index 0000000000..4620732d52 --- /dev/null +++ b/Lang/Rust/Call-a-foreign-language-function @@ -0,0 +1 @@ +../../Task/Call-a-foreign-language-function/Rust \ No newline at end of file diff --git a/Lang/Rust/Call-a-function b/Lang/Rust/Call-a-function new file mode 120000 index 0000000000..5c395a45f7 --- /dev/null +++ b/Lang/Rust/Call-a-function @@ -0,0 +1 @@ +../../Task/Call-a-function/Rust \ No newline at end of file diff --git a/Lang/Rust/Carmichael-3-strong-pseudoprimes b/Lang/Rust/Carmichael-3-strong-pseudoprimes new file mode 120000 index 0000000000..5ea56cc0db --- /dev/null +++ b/Lang/Rust/Carmichael-3-strong-pseudoprimes @@ -0,0 +1 @@ +../../Task/Carmichael-3-strong-pseudoprimes/Rust \ No newline at end of file diff --git a/Lang/Rust/Case-sensitivity-of-identifiers b/Lang/Rust/Case-sensitivity-of-identifiers new file mode 120000 index 0000000000..565ccec8b9 --- /dev/null +++ b/Lang/Rust/Case-sensitivity-of-identifiers @@ -0,0 +1 @@ +../../Task/Case-sensitivity-of-identifiers/Rust \ No newline at end of file diff --git a/Lang/Rust/Check-that-file-exists b/Lang/Rust/Check-that-file-exists new file mode 120000 index 0000000000..d9b2948144 --- /dev/null +++ b/Lang/Rust/Check-that-file-exists @@ -0,0 +1 @@ +../../Task/Check-that-file-exists/Rust \ No newline at end of file diff --git a/Lang/Rust/Collections b/Lang/Rust/Collections new file mode 120000 index 0000000000..64acbd3eae --- /dev/null +++ b/Lang/Rust/Collections @@ -0,0 +1 @@ +../../Task/Collections/Rust \ No newline at end of file diff --git a/Lang/Rust/Compound-data-type b/Lang/Rust/Compound-data-type new file mode 120000 index 0000000000..af942f441d --- /dev/null +++ b/Lang/Rust/Compound-data-type @@ -0,0 +1 @@ +../../Task/Compound-data-type/Rust \ No newline at end of file diff --git a/Lang/Rust/Conjugate-transpose b/Lang/Rust/Conjugate-transpose new file mode 120000 index 0000000000..34ac95bb28 --- /dev/null +++ b/Lang/Rust/Conjugate-transpose @@ -0,0 +1 @@ +../../Task/Conjugate-transpose/Rust \ No newline at end of file diff --git a/Lang/Rust/Continued-fraction b/Lang/Rust/Continued-fraction new file mode 120000 index 0000000000..1c09cbfa64 --- /dev/null +++ b/Lang/Rust/Continued-fraction @@ -0,0 +1 @@ +../../Task/Continued-fraction/Rust \ No newline at end of file diff --git a/Lang/Rust/Continued-fraction-Arithmetic-Construct-from-rational-number b/Lang/Rust/Continued-fraction-Arithmetic-Construct-from-rational-number new file mode 120000 index 0000000000..67d2666eca --- /dev/null +++ b/Lang/Rust/Continued-fraction-Arithmetic-Construct-from-rational-number @@ -0,0 +1 @@ +../../Task/Continued-fraction-Arithmetic-Construct-from-rational-number/Rust \ No newline at end of file diff --git a/Lang/Rust/Copy-a-string b/Lang/Rust/Copy-a-string new file mode 120000 index 0000000000..34b957110d --- /dev/null +++ b/Lang/Rust/Copy-a-string @@ -0,0 +1 @@ +../../Task/Copy-a-string/Rust \ No newline at end of file diff --git a/Lang/Rust/Count-occurrences-of-a-substring b/Lang/Rust/Count-occurrences-of-a-substring new file mode 120000 index 0000000000..07903c3507 --- /dev/null +++ b/Lang/Rust/Count-occurrences-of-a-substring @@ -0,0 +1 @@ +../../Task/Count-occurrences-of-a-substring/Rust \ No newline at end of file diff --git a/Lang/Rust/Date-format b/Lang/Rust/Date-format new file mode 120000 index 0000000000..e267c24e1d --- /dev/null +++ b/Lang/Rust/Date-format @@ -0,0 +1 @@ +../../Task/Date-format/Rust \ No newline at end of file diff --git a/Lang/Rust/Digital-root b/Lang/Rust/Digital-root new file mode 120000 index 0000000000..cb5c8860ae --- /dev/null +++ b/Lang/Rust/Digital-root @@ -0,0 +1 @@ +../../Task/Digital-root/Rust \ No newline at end of file diff --git a/Lang/Rust/Doubly-linked-list-Element-definition b/Lang/Rust/Doubly-linked-list-Element-definition new file mode 120000 index 0000000000..f3685f6399 --- /dev/null +++ b/Lang/Rust/Doubly-linked-list-Element-definition @@ -0,0 +1 @@ +../../Task/Doubly-linked-list-Element-definition/Rust \ No newline at end of file diff --git a/Lang/Rust/Doubly-linked-list-Element-insertion b/Lang/Rust/Doubly-linked-list-Element-insertion new file mode 120000 index 0000000000..d3ee6db4c5 --- /dev/null +++ b/Lang/Rust/Doubly-linked-list-Element-insertion @@ -0,0 +1 @@ +../../Task/Doubly-linked-list-Element-insertion/Rust \ No newline at end of file diff --git a/Lang/Rust/Empty-string b/Lang/Rust/Empty-string new file mode 120000 index 0000000000..8092a45cf8 --- /dev/null +++ b/Lang/Rust/Empty-string @@ -0,0 +1 @@ +../../Task/Empty-string/Rust \ No newline at end of file diff --git a/Lang/Rust/Evaluate-binomial-coefficients b/Lang/Rust/Evaluate-binomial-coefficients new file mode 120000 index 0000000000..82d997bdf7 --- /dev/null +++ b/Lang/Rust/Evaluate-binomial-coefficients @@ -0,0 +1 @@ +../../Task/Evaluate-binomial-coefficients/Rust \ No newline at end of file diff --git a/Lang/Rust/Execute-HQ9+ b/Lang/Rust/Execute-HQ9+ new file mode 120000 index 0000000000..b5046049c0 --- /dev/null +++ b/Lang/Rust/Execute-HQ9+ @@ -0,0 +1 @@ +../../Task/Execute-HQ9+/Rust \ No newline at end of file diff --git a/Lang/Rust/Factors-of-an-integer b/Lang/Rust/Factors-of-an-integer new file mode 120000 index 0000000000..69460bf2f8 --- /dev/null +++ b/Lang/Rust/Factors-of-an-integer @@ -0,0 +1 @@ +../../Task/Factors-of-an-integer/Rust \ No newline at end of file diff --git a/Lang/Rust/First-class-functions b/Lang/Rust/First-class-functions new file mode 120000 index 0000000000..49e62bed76 --- /dev/null +++ b/Lang/Rust/First-class-functions @@ -0,0 +1 @@ +../../Task/First-class-functions/Rust \ No newline at end of file diff --git a/Lang/Rust/First-class-functions-Use-numbers-analogously b/Lang/Rust/First-class-functions-Use-numbers-analogously new file mode 120000 index 0000000000..268e10e636 --- /dev/null +++ b/Lang/Rust/First-class-functions-Use-numbers-analogously @@ -0,0 +1 @@ +../../Task/First-class-functions-Use-numbers-analogously/Rust \ No newline at end of file diff --git a/Lang/Rust/Forest-fire b/Lang/Rust/Forest-fire new file mode 120000 index 0000000000..405cb3914b --- /dev/null +++ b/Lang/Rust/Forest-fire @@ -0,0 +1 @@ +../../Task/Forest-fire/Rust \ No newline at end of file diff --git a/Lang/Rust/Formatted-numeric-output b/Lang/Rust/Formatted-numeric-output new file mode 120000 index 0000000000..3910e9e512 --- /dev/null +++ b/Lang/Rust/Formatted-numeric-output @@ -0,0 +1 @@ +../../Task/Formatted-numeric-output/Rust \ No newline at end of file diff --git a/Lang/Rust/Generate-Chess960-starting-position b/Lang/Rust/Generate-Chess960-starting-position new file mode 120000 index 0000000000..dffd9f20d8 --- /dev/null +++ b/Lang/Rust/Generate-Chess960-starting-position @@ -0,0 +1 @@ +../../Task/Generate-Chess960-starting-position/Rust \ No newline at end of file diff --git a/Lang/Rust/Generate-lower-case-ASCII-alphabet b/Lang/Rust/Generate-lower-case-ASCII-alphabet new file mode 120000 index 0000000000..7dc50bf2cf --- /dev/null +++ b/Lang/Rust/Generate-lower-case-ASCII-alphabet @@ -0,0 +1 @@ +../../Task/Generate-lower-case-ASCII-alphabet/Rust \ No newline at end of file diff --git a/Lang/Rust/Hamming-numbers b/Lang/Rust/Hamming-numbers new file mode 120000 index 0000000000..2b5ee83cac --- /dev/null +++ b/Lang/Rust/Hamming-numbers @@ -0,0 +1 @@ +../../Task/Hamming-numbers/Rust \ No newline at end of file diff --git a/Lang/Rust/Haversine-formula b/Lang/Rust/Haversine-formula new file mode 120000 index 0000000000..3251996b0d --- /dev/null +++ b/Lang/Rust/Haversine-formula @@ -0,0 +1 @@ +../../Task/Haversine-formula/Rust \ No newline at end of file diff --git a/Lang/Rust/Hello-world-Graphical b/Lang/Rust/Hello-world-Graphical new file mode 120000 index 0000000000..6bed3e5541 --- /dev/null +++ b/Lang/Rust/Hello-world-Graphical @@ -0,0 +1 @@ +../../Task/Hello-world-Graphical/Rust \ No newline at end of file diff --git a/Lang/Rust/Hello-world-Line-printer b/Lang/Rust/Hello-world-Line-printer new file mode 120000 index 0000000000..019789cb35 --- /dev/null +++ b/Lang/Rust/Hello-world-Line-printer @@ -0,0 +1 @@ +../../Task/Hello-world-Line-printer/Rust \ No newline at end of file diff --git a/Lang/Rust/Integer-overflow b/Lang/Rust/Integer-overflow new file mode 120000 index 0000000000..8e3b85c4ab --- /dev/null +++ b/Lang/Rust/Integer-overflow @@ -0,0 +1 @@ +../../Task/Integer-overflow/Rust \ No newline at end of file diff --git a/Lang/Rust/K-means++-clustering b/Lang/Rust/K-means++-clustering new file mode 120000 index 0000000000..1171292d4e --- /dev/null +++ b/Lang/Rust/K-means++-clustering @@ -0,0 +1 @@ +../../Task/K-means++-clustering/Rust \ No newline at end of file diff --git a/Lang/Rust/Keyboard-input-Obtain-a-Y-or-N-response b/Lang/Rust/Keyboard-input-Obtain-a-Y-or-N-response new file mode 120000 index 0000000000..65a9e2cd48 --- /dev/null +++ b/Lang/Rust/Keyboard-input-Obtain-a-Y-or-N-response @@ -0,0 +1 @@ +../../Task/Keyboard-input-Obtain-a-Y-or-N-response/Rust \ No newline at end of file diff --git a/Lang/Rust/Left-factorials b/Lang/Rust/Left-factorials new file mode 120000 index 0000000000..eaaa507010 --- /dev/null +++ b/Lang/Rust/Left-factorials @@ -0,0 +1 @@ +../../Task/Left-factorials/Rust \ No newline at end of file diff --git a/Lang/Rust/MD4 b/Lang/Rust/MD4 new file mode 120000 index 0000000000..736667f43e --- /dev/null +++ b/Lang/Rust/MD4 @@ -0,0 +1 @@ +../../Task/MD4/Rust \ No newline at end of file diff --git a/Lang/Rust/Map-range b/Lang/Rust/Map-range new file mode 120000 index 0000000000..91624c7dc3 --- /dev/null +++ b/Lang/Rust/Map-range @@ -0,0 +1 @@ +../../Task/Map-range/Rust \ No newline at end of file diff --git a/Lang/Rust/Metaprogramming b/Lang/Rust/Metaprogramming new file mode 120000 index 0000000000..aa47654d83 --- /dev/null +++ b/Lang/Rust/Metaprogramming @@ -0,0 +1 @@ +../../Task/Metaprogramming/Rust \ No newline at end of file diff --git a/Lang/Rust/Modular-inverse b/Lang/Rust/Modular-inverse new file mode 120000 index 0000000000..9143b5956f --- /dev/null +++ b/Lang/Rust/Modular-inverse @@ -0,0 +1 @@ +../../Task/Modular-inverse/Rust \ No newline at end of file diff --git a/Lang/Rust/Multiplication-tables b/Lang/Rust/Multiplication-tables new file mode 120000 index 0000000000..c65a218b58 --- /dev/null +++ b/Lang/Rust/Multiplication-tables @@ -0,0 +1 @@ +../../Task/Multiplication-tables/Rust \ No newline at end of file diff --git a/Lang/Rust/One-of-n-lines-in-a-file b/Lang/Rust/One-of-n-lines-in-a-file new file mode 120000 index 0000000000..bd215f7264 --- /dev/null +++ b/Lang/Rust/One-of-n-lines-in-a-file @@ -0,0 +1 @@ +../../Task/One-of-n-lines-in-a-file/Rust \ No newline at end of file diff --git a/Lang/Rust/Palindrome-detection b/Lang/Rust/Palindrome-detection new file mode 120000 index 0000000000..be0f3a6d5b --- /dev/null +++ b/Lang/Rust/Palindrome-detection @@ -0,0 +1 @@ +../../Task/Palindrome-detection/Rust \ No newline at end of file diff --git a/Lang/Rust/Pangram-checker b/Lang/Rust/Pangram-checker new file mode 120000 index 0000000000..a7a0906a21 --- /dev/null +++ b/Lang/Rust/Pangram-checker @@ -0,0 +1 @@ +../../Task/Pangram-checker/Rust \ No newline at end of file diff --git a/Lang/Rust/Priority-queue b/Lang/Rust/Priority-queue new file mode 120000 index 0000000000..22a699cbea --- /dev/null +++ b/Lang/Rust/Priority-queue @@ -0,0 +1 @@ +../../Task/Priority-queue/Rust \ No newline at end of file diff --git a/Lang/Rust/Program-termination b/Lang/Rust/Program-termination new file mode 120000 index 0000000000..819dbbaa3a --- /dev/null +++ b/Lang/Rust/Program-termination @@ -0,0 +1 @@ +../../Task/Program-termination/Rust \ No newline at end of file diff --git a/Lang/Rust/Queue-Definition b/Lang/Rust/Queue-Definition new file mode 120000 index 0000000000..a634af8412 --- /dev/null +++ b/Lang/Rust/Queue-Definition @@ -0,0 +1 @@ +../../Task/Queue-Definition/Rust \ No newline at end of file diff --git a/Lang/Rust/Random-number-generator--device- b/Lang/Rust/Random-number-generator--device- new file mode 120000 index 0000000000..9164fade94 --- /dev/null +++ b/Lang/Rust/Random-number-generator--device- @@ -0,0 +1 @@ +../../Task/Random-number-generator--device-/Rust \ No newline at end of file diff --git a/Lang/Rust/Range-extraction b/Lang/Rust/Range-extraction new file mode 120000 index 0000000000..9e4723de57 --- /dev/null +++ b/Lang/Rust/Range-extraction @@ -0,0 +1 @@ +../../Task/Range-extraction/Rust \ No newline at end of file diff --git a/Lang/Rust/Real-constants-and-functions b/Lang/Rust/Real-constants-and-functions new file mode 120000 index 0000000000..a696cd1364 --- /dev/null +++ b/Lang/Rust/Real-constants-and-functions @@ -0,0 +1 @@ +../../Task/Real-constants-and-functions/Rust \ No newline at end of file diff --git a/Lang/Rust/Remove-duplicate-elements b/Lang/Rust/Remove-duplicate-elements new file mode 120000 index 0000000000..26fd501ce4 --- /dev/null +++ b/Lang/Rust/Remove-duplicate-elements @@ -0,0 +1 @@ +../../Task/Remove-duplicate-elements/Rust \ No newline at end of file diff --git a/Lang/Rust/Rename-a-file b/Lang/Rust/Rename-a-file new file mode 120000 index 0000000000..e0813f27aa --- /dev/null +++ b/Lang/Rust/Rename-a-file @@ -0,0 +1 @@ +../../Task/Rename-a-file/Rust \ No newline at end of file diff --git a/Lang/Rust/Shell-one-liner b/Lang/Rust/Shell-one-liner new file mode 120000 index 0000000000..1028749a75 --- /dev/null +++ b/Lang/Rust/Shell-one-liner @@ -0,0 +1 @@ +../../Task/Shell-one-liner/Rust \ No newline at end of file diff --git a/Lang/Rust/Singly-linked-list-Element-insertion b/Lang/Rust/Singly-linked-list-Element-insertion new file mode 120000 index 0000000000..e02bdb28ab --- /dev/null +++ b/Lang/Rust/Singly-linked-list-Element-insertion @@ -0,0 +1 @@ +../../Task/Singly-linked-list-Element-insertion/Rust \ No newline at end of file diff --git a/Lang/Rust/Singly-linked-list-Traversal b/Lang/Rust/Singly-linked-list-Traversal new file mode 120000 index 0000000000..0148d6b57d --- /dev/null +++ b/Lang/Rust/Singly-linked-list-Traversal @@ -0,0 +1 @@ +../../Task/Singly-linked-list-Traversal/Rust \ No newline at end of file diff --git a/Lang/Rust/Sorting-algorithms-Bogosort b/Lang/Rust/Sorting-algorithms-Bogosort new file mode 120000 index 0000000000..395812046d --- /dev/null +++ b/Lang/Rust/Sorting-algorithms-Bogosort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Bogosort/Rust \ No newline at end of file diff --git a/Lang/Rust/Sorting-algorithms-Merge-sort b/Lang/Rust/Sorting-algorithms-Merge-sort new file mode 120000 index 0000000000..52e214045f --- /dev/null +++ b/Lang/Rust/Sorting-algorithms-Merge-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Merge-sort/Rust \ No newline at end of file diff --git a/Lang/Rust/Sorting-algorithms-Stooge-sort b/Lang/Rust/Sorting-algorithms-Stooge-sort new file mode 120000 index 0000000000..018d873ed9 --- /dev/null +++ b/Lang/Rust/Sorting-algorithms-Stooge-sort @@ -0,0 +1 @@ +../../Task/Sorting-algorithms-Stooge-sort/Rust \ No newline at end of file diff --git a/Lang/Rust/Stack b/Lang/Rust/Stack new file mode 120000 index 0000000000..6960a5cd8c --- /dev/null +++ b/Lang/Rust/Stack @@ -0,0 +1 @@ +../../Task/Stack/Rust \ No newline at end of file diff --git a/Lang/Rust/Statistics-Basic b/Lang/Rust/Statistics-Basic new file mode 120000 index 0000000000..1b1550c191 --- /dev/null +++ b/Lang/Rust/Statistics-Basic @@ -0,0 +1 @@ +../../Task/Statistics-Basic/Rust \ No newline at end of file diff --git a/Lang/Rust/String-interpolation--included- b/Lang/Rust/String-interpolation--included- new file mode 120000 index 0000000000..0249b79584 --- /dev/null +++ b/Lang/Rust/String-interpolation--included- @@ -0,0 +1 @@ +../../Task/String-interpolation--included-/Rust \ No newline at end of file diff --git a/Lang/Rust/Tokenize-a-string b/Lang/Rust/Tokenize-a-string new file mode 120000 index 0000000000..88cacbd535 --- /dev/null +++ b/Lang/Rust/Tokenize-a-string @@ -0,0 +1 @@ +../../Task/Tokenize-a-string/Rust \ No newline at end of file diff --git a/Lang/Rust/Tree-traversal b/Lang/Rust/Tree-traversal new file mode 120000 index 0000000000..da2152a3b2 --- /dev/null +++ b/Lang/Rust/Tree-traversal @@ -0,0 +1 @@ +../../Task/Tree-traversal/Rust \ No newline at end of file diff --git a/Lang/Rust/Ulam-spiral--for-primes- b/Lang/Rust/Ulam-spiral--for-primes- new file mode 120000 index 0000000000..5d62adbd1b --- /dev/null +++ b/Lang/Rust/Ulam-spiral--for-primes- @@ -0,0 +1 @@ +../../Task/Ulam-spiral--for-primes-/Rust \ No newline at end of file diff --git a/Lang/Rust/User-input-Text b/Lang/Rust/User-input-Text new file mode 120000 index 0000000000..2ef272b728 --- /dev/null +++ b/Lang/Rust/User-input-Text @@ -0,0 +1 @@ +../../Task/User-input-Text/Rust \ No newline at end of file diff --git a/Lang/Rust/Visualize-a-tree b/Lang/Rust/Visualize-a-tree new file mode 120000 index 0000000000..9ed7f54906 --- /dev/null +++ b/Lang/Rust/Visualize-a-tree @@ -0,0 +1 @@ +../../Task/Visualize-a-tree/Rust \ No newline at end of file diff --git a/Lang/S-lang/00DESCRIPTION b/Lang/S-lang/00DESCRIPTION index 5da579aa67..4cda00e997 100644 --- a/Lang/S-lang/00DESCRIPTION +++ b/Lang/S-lang/00DESCRIPTION @@ -9,5 +9,42 @@ Unlike many interpreters, the S-Lang interpreter supports all of the native C in The S-Lang interpreter has very strong support for array-based operations making it ideal for numerical applications. (from [http://www.jedsoft.org/slang/ the official web site]]) +
+Task Output Notes: + +For simplicity, many of the S-Lang tasks use the print() +function. This is not part of S-Lang per se, but is normally +included in the S-Lang shell "slsh". If it is missing, or you're +using some other S-Lang environment, options include C-like fputs(), +sprintf() and printf(). Their format and parameters work about +like you'd expect in a C-inspired interpreted language. + +sprintf(f, d..) [f=string format, d..=zero or more data items] +returns a string. printf(f, d..) prints to "stdout" and returns +the number of items formatted. fputs(s, fp) prints string s to the +file-pointer fp and returns the string length or -1 on error. Remember S-Lang is a "stack +language", so even if you don't care about the return value, your code +should "eat" it: + + () = printf("S-Lang: %d tasks and counting!\n", 23); + + () = fputs("the quality of mercy is not strnen\n", stdout); +You can approximate print() with the following; NOTE the capital-S, which implicitly calls +the string() function to convert-or-describe non-strings as strings: + + define print(foo) { () = printf("%S\n", foo); } +S-Lang is the extension language for the lightweight Emacs-like +[http://www.jedsoft.org/jed/ programmer's editor Jed]. There, the +output functions include: + + insert(s) write string s into current buffer + vinsert(f,d..) insert(sprintf(f, d..)) ["variable"] equivalent + + message(s) write string s into "mini-buffer" + vmessage(f,d..) message(sprintf(f, d..)) equivalent + + error(s) like message(), but in error-color, then cancel cmd + verror(f, d..) error(sprintf(f, d..)) equivalent + == See Also == [[wp:S-Lang_(programming_language)|Wikipedia:S-Lang(programming language)]] \ No newline at end of file diff --git a/Lang/S-lang/Array-concatenation b/Lang/S-lang/Array-concatenation new file mode 120000 index 0000000000..995f6e3f1b --- /dev/null +++ b/Lang/S-lang/Array-concatenation @@ -0,0 +1 @@ +../../Task/Array-concatenation/S-lang \ No newline at end of file diff --git a/Lang/S-lang/Averages-Mode b/Lang/S-lang/Averages-Mode new file mode 120000 index 0000000000..e67ba38c92 --- /dev/null +++ b/Lang/S-lang/Averages-Mode @@ -0,0 +1 @@ +../../Task/Averages-Mode/S-lang \ No newline at end of file diff --git a/Lang/S-lang/Averages-Root-mean-square b/Lang/S-lang/Averages-Root-mean-square new file mode 120000 index 0000000000..e1091cd062 --- /dev/null +++ b/Lang/S-lang/Averages-Root-mean-square @@ -0,0 +1 @@ +../../Task/Averages-Root-mean-square/S-lang \ No newline at end of file diff --git a/Lang/S-lang/Binary-digits b/Lang/S-lang/Binary-digits new file mode 120000 index 0000000000..e95a0412c0 --- /dev/null +++ b/Lang/S-lang/Binary-digits @@ -0,0 +1 @@ +../../Task/Binary-digits/S-lang \ No newline at end of file diff --git a/Lang/S-lang/Dot-product b/Lang/S-lang/Dot-product new file mode 120000 index 0000000000..cb07956bae --- /dev/null +++ b/Lang/S-lang/Dot-product @@ -0,0 +1 @@ +../../Task/Dot-product/S-lang \ No newline at end of file diff --git a/Lang/S-lang/Generate-lower-case-ASCII-alphabet b/Lang/S-lang/Generate-lower-case-ASCII-alphabet new file mode 120000 index 0000000000..fc17f853fa --- /dev/null +++ b/Lang/S-lang/Generate-lower-case-ASCII-alphabet @@ -0,0 +1 @@ +../../Task/Generate-lower-case-ASCII-alphabet/S-lang \ No newline at end of file diff --git a/Lang/S-lang/Greatest-element-of-a-list b/Lang/S-lang/Greatest-element-of-a-list new file mode 120000 index 0000000000..26884eaeaf --- /dev/null +++ b/Lang/S-lang/Greatest-element-of-a-list @@ -0,0 +1 @@ +../../Task/Greatest-element-of-a-list/S-lang \ No newline at end of file diff --git a/Lang/S-lang/Hailstone-sequence b/Lang/S-lang/Hailstone-sequence new file mode 120000 index 0000000000..df3622c754 --- /dev/null +++ b/Lang/S-lang/Hailstone-sequence @@ -0,0 +1 @@ +../../Task/Hailstone-sequence/S-lang \ No newline at end of file diff --git a/Lang/S-lang/Hello-world-Standard-error b/Lang/S-lang/Hello-world-Standard-error new file mode 120000 index 0000000000..2c95318886 --- /dev/null +++ b/Lang/S-lang/Hello-world-Standard-error @@ -0,0 +1 @@ +../../Task/Hello-world-Standard-error/S-lang \ No newline at end of file diff --git a/Lang/S-lang/Interactive-programming b/Lang/S-lang/Interactive-programming new file mode 120000 index 0000000000..c89a770bfa --- /dev/null +++ b/Lang/S-lang/Interactive-programming @@ -0,0 +1 @@ +../../Task/Interactive-programming/S-lang \ No newline at end of file diff --git a/Lang/S-lang/Loops-Infinite b/Lang/S-lang/Loops-Infinite new file mode 120000 index 0000000000..46572a11c8 --- /dev/null +++ b/Lang/S-lang/Loops-Infinite @@ -0,0 +1 @@ +../../Task/Loops-Infinite/S-lang \ No newline at end of file diff --git a/Lang/S-lang/Loops-N-plus-one-half b/Lang/S-lang/Loops-N-plus-one-half new file mode 120000 index 0000000000..c15bf6ad3c --- /dev/null +++ b/Lang/S-lang/Loops-N-plus-one-half @@ -0,0 +1 @@ +../../Task/Loops-N-plus-one-half/S-lang \ No newline at end of file diff --git a/Lang/S-lang/MD5 b/Lang/S-lang/MD5 new file mode 120000 index 0000000000..c72c88fa97 --- /dev/null +++ b/Lang/S-lang/MD5 @@ -0,0 +1 @@ +../../Task/MD5/S-lang \ No newline at end of file diff --git a/Lang/S-lang/Mutual-recursion b/Lang/S-lang/Mutual-recursion new file mode 120000 index 0000000000..a2d2d29e7c --- /dev/null +++ b/Lang/S-lang/Mutual-recursion @@ -0,0 +1 @@ +../../Task/Mutual-recursion/S-lang \ No newline at end of file diff --git a/Lang/S-lang/Range-expansion b/Lang/S-lang/Range-expansion new file mode 120000 index 0000000000..d85d0de1fc --- /dev/null +++ b/Lang/S-lang/Range-expansion @@ -0,0 +1 @@ +../../Task/Range-expansion/S-lang \ No newline at end of file diff --git a/Lang/S-lang/Reverse-a-string b/Lang/S-lang/Reverse-a-string new file mode 120000 index 0000000000..6424749086 --- /dev/null +++ b/Lang/S-lang/Reverse-a-string @@ -0,0 +1 @@ +../../Task/Reverse-a-string/S-lang \ No newline at end of file diff --git a/Lang/S-lang/Reverse-words-in-a-string b/Lang/S-lang/Reverse-words-in-a-string new file mode 120000 index 0000000000..eb0c3ca313 --- /dev/null +++ b/Lang/S-lang/Reverse-words-in-a-string @@ -0,0 +1 @@ +../../Task/Reverse-words-in-a-string/S-lang \ No newline at end of file diff --git a/Lang/S-lang/Rot-13 b/Lang/S-lang/Rot-13 new file mode 120000 index 0000000000..a7f8199f9f --- /dev/null +++ b/Lang/S-lang/Rot-13 @@ -0,0 +1 @@ +../../Task/Rot-13/S-lang \ No newline at end of file diff --git a/Lang/S-lang/SHA-1 b/Lang/S-lang/SHA-1 new file mode 120000 index 0000000000..55519ec93f --- /dev/null +++ b/Lang/S-lang/SHA-1 @@ -0,0 +1 @@ +../../Task/SHA-1/S-lang \ No newline at end of file diff --git a/Lang/S-lang/Shell-one-liner b/Lang/S-lang/Shell-one-liner new file mode 120000 index 0000000000..4dcb0b0142 --- /dev/null +++ b/Lang/S-lang/Shell-one-liner @@ -0,0 +1 @@ +../../Task/Shell-one-liner/S-lang \ No newline at end of file diff --git a/Lang/S-lang/Sum-and-product-of-an-array b/Lang/S-lang/Sum-and-product-of-an-array new file mode 120000 index 0000000000..a588294aa2 --- /dev/null +++ b/Lang/S-lang/Sum-and-product-of-an-array @@ -0,0 +1 @@ +../../Task/Sum-and-product-of-an-array/S-lang \ No newline at end of file diff --git a/Lang/S-lang/Tokenize-a-string b/Lang/S-lang/Tokenize-a-string new file mode 120000 index 0000000000..9b41c31d43 --- /dev/null +++ b/Lang/S-lang/Tokenize-a-string @@ -0,0 +1 @@ +../../Task/Tokenize-a-string/S-lang \ No newline at end of file diff --git a/Lang/S-lang/Unix-ls b/Lang/S-lang/Unix-ls new file mode 120000 index 0000000000..2fed8926cc --- /dev/null +++ b/Lang/S-lang/Unix-ls @@ -0,0 +1 @@ +../../Task/Unix-ls/S-lang \ No newline at end of file diff --git a/Lang/S-lang/Zero-to-the-zero-power b/Lang/S-lang/Zero-to-the-zero-power new file mode 120000 index 0000000000..c8ae2c9290 --- /dev/null +++ b/Lang/S-lang/Zero-to-the-zero-power @@ -0,0 +1 @@ +../../Task/Zero-to-the-zero-power/S-lang \ No newline at end of file diff --git a/Lang/SAS/CSV-data-manipulation b/Lang/SAS/CSV-data-manipulation new file mode 120000 index 0000000000..4630452a4d --- /dev/null +++ b/Lang/SAS/CSV-data-manipulation @@ -0,0 +1 @@ +../../Task/CSV-data-manipulation/SAS \ No newline at end of file diff --git a/Lang/SAS/Count-the-coins b/Lang/SAS/Count-the-coins new file mode 120000 index 0000000000..05f3ae3707 --- /dev/null +++ b/Lang/SAS/Count-the-coins @@ -0,0 +1 @@ +../../Task/Count-the-coins/SAS \ No newline at end of file diff --git a/Lang/SAS/FizzBuzz b/Lang/SAS/FizzBuzz new file mode 120000 index 0000000000..1dfe5f6af1 --- /dev/null +++ b/Lang/SAS/FizzBuzz @@ -0,0 +1 @@ +../../Task/FizzBuzz/SAS \ No newline at end of file diff --git a/Lang/SAS/Knapsack-problem-0-1 b/Lang/SAS/Knapsack-problem-0-1 new file mode 120000 index 0000000000..fbea490d2c --- /dev/null +++ b/Lang/SAS/Knapsack-problem-0-1 @@ -0,0 +1 @@ +../../Task/Knapsack-problem-0-1/SAS \ No newline at end of file diff --git a/Lang/SAS/Knapsack-problem-Bounded b/Lang/SAS/Knapsack-problem-Bounded new file mode 120000 index 0000000000..182928b5f4 --- /dev/null +++ b/Lang/SAS/Knapsack-problem-Bounded @@ -0,0 +1 @@ +../../Task/Knapsack-problem-Bounded/SAS \ No newline at end of file diff --git a/Lang/SAS/Knapsack-problem-Continuous b/Lang/SAS/Knapsack-problem-Continuous new file mode 120000 index 0000000000..1c9c488009 --- /dev/null +++ b/Lang/SAS/Knapsack-problem-Continuous @@ -0,0 +1 @@ +../../Task/Knapsack-problem-Continuous/SAS \ No newline at end of file diff --git a/Lang/SAS/Sudoku b/Lang/SAS/Sudoku new file mode 120000 index 0000000000..5280fc3d1f --- /dev/null +++ b/Lang/SAS/Sudoku @@ -0,0 +1 @@ +../../Task/Sudoku/SAS \ No newline at end of file diff --git a/Lang/SETL/Associative-array-Creation b/Lang/SETL/Associative-array-Creation new file mode 120000 index 0000000000..1328ee4720 --- /dev/null +++ b/Lang/SETL/Associative-array-Creation @@ -0,0 +1 @@ +../../Task/Associative-array-Creation/SETL \ No newline at end of file diff --git a/Lang/SETL/Case-sensitivity-of-identifiers b/Lang/SETL/Case-sensitivity-of-identifiers new file mode 120000 index 0000000000..2eb94141b4 --- /dev/null +++ b/Lang/SETL/Case-sensitivity-of-identifiers @@ -0,0 +1 @@ +../../Task/Case-sensitivity-of-identifiers/SETL \ No newline at end of file diff --git a/Lang/SETL/Even-or-odd b/Lang/SETL/Even-or-odd new file mode 120000 index 0000000000..0d867b4dca --- /dev/null +++ b/Lang/SETL/Even-or-odd @@ -0,0 +1 @@ +../../Task/Even-or-odd/SETL \ No newline at end of file diff --git a/Lang/SETL/Function-definition b/Lang/SETL/Function-definition new file mode 120000 index 0000000000..ea95d1a59a --- /dev/null +++ b/Lang/SETL/Function-definition @@ -0,0 +1 @@ +../../Task/Function-definition/SETL \ No newline at end of file diff --git a/Lang/SETL/Hello-world-Newline-omission b/Lang/SETL/Hello-world-Newline-omission new file mode 120000 index 0000000000..cf2b6bd886 --- /dev/null +++ b/Lang/SETL/Hello-world-Newline-omission @@ -0,0 +1 @@ +../../Task/Hello-world-Newline-omission/SETL \ No newline at end of file diff --git a/Lang/SETL/Loops-For b/Lang/SETL/Loops-For new file mode 120000 index 0000000000..032c670e13 --- /dev/null +++ b/Lang/SETL/Loops-For @@ -0,0 +1 @@ +../../Task/Loops-For/SETL \ No newline at end of file diff --git a/Lang/SNOBOL4/Arrays b/Lang/SNOBOL4/Arrays new file mode 120000 index 0000000000..a835e180a5 --- /dev/null +++ b/Lang/SNOBOL4/Arrays @@ -0,0 +1 @@ +../../Task/Arrays/SNOBOL4 \ No newline at end of file diff --git a/Lang/SNOBOL4/Case-sensitivity-of-identifiers b/Lang/SNOBOL4/Case-sensitivity-of-identifiers new file mode 120000 index 0000000000..bc78e5a326 --- /dev/null +++ b/Lang/SNOBOL4/Case-sensitivity-of-identifiers @@ -0,0 +1 @@ +../../Task/Case-sensitivity-of-identifiers/SNOBOL4 \ No newline at end of file diff --git a/Lang/SNOBOL4/Empty-string b/Lang/SNOBOL4/Empty-string new file mode 120000 index 0000000000..2f108662fc --- /dev/null +++ b/Lang/SNOBOL4/Empty-string @@ -0,0 +1 @@ +../../Task/Empty-string/SNOBOL4 \ No newline at end of file diff --git a/Lang/SNOBOL4/Even-or-odd b/Lang/SNOBOL4/Even-or-odd new file mode 120000 index 0000000000..d9c92c476a --- /dev/null +++ b/Lang/SNOBOL4/Even-or-odd @@ -0,0 +1 @@ +../../Task/Even-or-odd/SNOBOL4 \ No newline at end of file diff --git a/Lang/SNOBOL4/IBAN b/Lang/SNOBOL4/IBAN new file mode 120000 index 0000000000..1d1b2e5d33 --- /dev/null +++ b/Lang/SNOBOL4/IBAN @@ -0,0 +1 @@ +../../Task/IBAN/SNOBOL4 \ No newline at end of file diff --git a/Lang/SNOBOL4/Include-a-file b/Lang/SNOBOL4/Include-a-file new file mode 120000 index 0000000000..134d035963 --- /dev/null +++ b/Lang/SNOBOL4/Include-a-file @@ -0,0 +1 @@ +../../Task/Include-a-file/SNOBOL4 \ No newline at end of file diff --git a/Lang/SNOBOL4/Loops-Downward-for b/Lang/SNOBOL4/Loops-Downward-for new file mode 120000 index 0000000000..ae9faee828 --- /dev/null +++ b/Lang/SNOBOL4/Loops-Downward-for @@ -0,0 +1 @@ +../../Task/Loops-Downward-for/SNOBOL4 \ No newline at end of file diff --git a/Lang/SNOBOL4/String-append b/Lang/SNOBOL4/String-append new file mode 120000 index 0000000000..360fa9c29d --- /dev/null +++ b/Lang/SNOBOL4/String-append @@ -0,0 +1 @@ +../../Task/String-append/SNOBOL4 \ No newline at end of file diff --git a/Lang/SNOBOL4/String-comparison b/Lang/SNOBOL4/String-comparison new file mode 120000 index 0000000000..5f4c2079a6 --- /dev/null +++ b/Lang/SNOBOL4/String-comparison @@ -0,0 +1 @@ +../../Task/String-comparison/SNOBOL4 \ No newline at end of file diff --git a/Lang/SNOBOL4/String-matching b/Lang/SNOBOL4/String-matching new file mode 120000 index 0000000000..c57a48e434 --- /dev/null +++ b/Lang/SNOBOL4/String-matching @@ -0,0 +1 @@ +../../Task/String-matching/SNOBOL4 \ No newline at end of file diff --git a/Lang/SNOBOL4/String-prepend b/Lang/SNOBOL4/String-prepend new file mode 120000 index 0000000000..97424ec30e --- /dev/null +++ b/Lang/SNOBOL4/String-prepend @@ -0,0 +1 @@ +../../Task/String-prepend/SNOBOL4 \ No newline at end of file diff --git a/Lang/SNOBOL4/Strip-a-set-of-characters-from-a-string b/Lang/SNOBOL4/Strip-a-set-of-characters-from-a-string new file mode 120000 index 0000000000..a07913bc76 --- /dev/null +++ b/Lang/SNOBOL4/Strip-a-set-of-characters-from-a-string @@ -0,0 +1 @@ +../../Task/Strip-a-set-of-characters-from-a-string/SNOBOL4 \ No newline at end of file diff --git a/Lang/SNOBOL4/Strip-whitespace-from-a-string-Top-and-tail b/Lang/SNOBOL4/Strip-whitespace-from-a-string-Top-and-tail new file mode 120000 index 0000000000..1012aa8eb0 --- /dev/null +++ b/Lang/SNOBOL4/Strip-whitespace-from-a-string-Top-and-tail @@ -0,0 +1 @@ +../../Task/Strip-whitespace-from-a-string-Top-and-tail/SNOBOL4 \ No newline at end of file diff --git a/Lang/SPARK/00DESCRIPTION b/Lang/SPARK/00DESCRIPTION index 3dd36e5585..7d49d710a7 100644 --- a/Lang/SPARK/00DESCRIPTION +++ b/Lang/SPARK/00DESCRIPTION @@ -23,7 +23,7 @@ The properties that SPARK code can be analysed for are: *Functional correctness. *Absence of dead paths. -The annotations always begin, on each line, with the Ada comment symbol “--”, so all SPARK programs comply with the [[Ada]] standard. +In older versions, the annotations always began, on each line, with the Ada comment symbol “--”, so all SPARK programs comply with the [[Ada]] standard. Newer versions, starting with SPARK 2014, use the aspect syntax known from Ada 2012. A SPARK program can be compiled by any [[Ada]] compiler or processed by any other [[Ada]] tool. @@ -31,6 +31,6 @@ The annotations state the required properties of a program. Different propertie A description of the SPARK Proof process is [[SPARK_Proof_Process|here]]. -The SPARK tools are freely available under the GNU GPL. The SPARK language definition is proprietary - the main copyright is held by [http://www.sparkada.com/ Altran-Praxis]. +The SPARK tools are freely available under the GNU GPL. The SPARK language definition is available from AdaCore at [http://docs.adacore.com/spark2014-docs/html/lrm/ SPARK 2014 Reference Manual]. The [news:comp.lang.ada comp.lang.ada] [[newsgroup]] ([http://groups.google.com/group/comp.lang.ada/topics access via Google Groups])is the main forum for discussing or asking questions about SPARK. \ No newline at end of file diff --git a/Lang/SQL/Even-or-odd b/Lang/SQL/Even-or-odd new file mode 120000 index 0000000000..47ea3b288c --- /dev/null +++ b/Lang/SQL/Even-or-odd @@ -0,0 +1 @@ +../../Task/Even-or-odd/SQL \ No newline at end of file diff --git a/Lang/SQL/Nth b/Lang/SQL/Nth new file mode 120000 index 0000000000..06fd522eff --- /dev/null +++ b/Lang/SQL/Nth @@ -0,0 +1 @@ +../../Task/Nth/SQL \ No newline at end of file diff --git a/Lang/SQL/Number-names b/Lang/SQL/Number-names new file mode 120000 index 0000000000..00676da142 --- /dev/null +++ b/Lang/SQL/Number-names @@ -0,0 +1 @@ +../../Task/Number-names/SQL \ No newline at end of file diff --git a/Lang/SQL/Write-language-name-in-3D-ASCII b/Lang/SQL/Write-language-name-in-3D-ASCII new file mode 120000 index 0000000000..9afc52872e --- /dev/null +++ b/Lang/SQL/Write-language-name-in-3D-ASCII @@ -0,0 +1 @@ +../../Task/Write-language-name-in-3D-ASCII/SQL \ No newline at end of file diff --git a/Lang/Scala/Bernoulli-numbers b/Lang/Scala/Bernoulli-numbers new file mode 120000 index 0000000000..c3767adda0 --- /dev/null +++ b/Lang/Scala/Bernoulli-numbers @@ -0,0 +1 @@ +../../Task/Bernoulli-numbers/Scala \ No newline at end of file diff --git a/Lang/Scala/Conjugate-transpose b/Lang/Scala/Conjugate-transpose new file mode 120000 index 0000000000..49d8e66cf1 --- /dev/null +++ b/Lang/Scala/Conjugate-transpose @@ -0,0 +1 @@ +../../Task/Conjugate-transpose/Scala \ No newline at end of file diff --git a/Lang/Scala/Equilibrium-index b/Lang/Scala/Equilibrium-index new file mode 120000 index 0000000000..f4c9fb3419 --- /dev/null +++ b/Lang/Scala/Equilibrium-index @@ -0,0 +1 @@ +../../Task/Equilibrium-index/Scala \ No newline at end of file diff --git a/Lang/Scala/Generate-Chess960-starting-position b/Lang/Scala/Generate-Chess960-starting-position new file mode 120000 index 0000000000..33429243e9 --- /dev/null +++ b/Lang/Scala/Generate-Chess960-starting-position @@ -0,0 +1 @@ +../../Task/Generate-Chess960-starting-position/Scala \ No newline at end of file diff --git a/Lang/Scala/Hough-transform b/Lang/Scala/Hough-transform new file mode 120000 index 0000000000..32f18ae63e --- /dev/null +++ b/Lang/Scala/Hough-transform @@ -0,0 +1 @@ +../../Task/Hough-transform/Scala \ No newline at end of file diff --git a/Lang/Scala/Knapsack-problem-Unbounded b/Lang/Scala/Knapsack-problem-Unbounded new file mode 120000 index 0000000000..e42edf910d --- /dev/null +++ b/Lang/Scala/Knapsack-problem-Unbounded @@ -0,0 +1 @@ +../../Task/Knapsack-problem-Unbounded/Scala \ No newline at end of file diff --git a/Lang/Scala/Move-to-front-algorithm b/Lang/Scala/Move-to-front-algorithm new file mode 120000 index 0000000000..43425fc68e --- /dev/null +++ b/Lang/Scala/Move-to-front-algorithm @@ -0,0 +1 @@ +../../Task/Move-to-front-algorithm/Scala \ No newline at end of file diff --git a/Lang/Scala/Multifactorial b/Lang/Scala/Multifactorial new file mode 120000 index 0000000000..aadf067874 --- /dev/null +++ b/Lang/Scala/Multifactorial @@ -0,0 +1 @@ +../../Task/Multifactorial/Scala \ No newline at end of file diff --git a/Lang/Scala/Numeric-error-propagation b/Lang/Scala/Numeric-error-propagation new file mode 120000 index 0000000000..d0413ad7b3 --- /dev/null +++ b/Lang/Scala/Numeric-error-propagation @@ -0,0 +1 @@ +../../Task/Numeric-error-propagation/Scala \ No newline at end of file diff --git a/Lang/Scala/Runge-Kutta-method b/Lang/Scala/Runge-Kutta-method new file mode 120000 index 0000000000..e4b6a342e0 --- /dev/null +++ b/Lang/Scala/Runge-Kutta-method @@ -0,0 +1 @@ +../../Task/Runge-Kutta-method/Scala \ No newline at end of file diff --git a/Lang/Scala/Stable-marriage-problem b/Lang/Scala/Stable-marriage-problem new file mode 120000 index 0000000000..fb540a05d0 --- /dev/null +++ b/Lang/Scala/Stable-marriage-problem @@ -0,0 +1 @@ +../../Task/Stable-marriage-problem/Scala \ No newline at end of file diff --git a/Lang/Scala/Stern-Brocot-sequence b/Lang/Scala/Stern-Brocot-sequence new file mode 120000 index 0000000000..a5338ae0f5 --- /dev/null +++ b/Lang/Scala/Stern-Brocot-sequence @@ -0,0 +1 @@ +../../Task/Stern-Brocot-sequence/Scala \ No newline at end of file diff --git a/Lang/Scala/The-Twelve-Days-of-Christmas b/Lang/Scala/The-Twelve-Days-of-Christmas new file mode 120000 index 0000000000..b5b0aed84c --- /dev/null +++ b/Lang/Scala/The-Twelve-Days-of-Christmas @@ -0,0 +1 @@ +../../Task/The-Twelve-Days-of-Christmas/Scala \ No newline at end of file diff --git a/Lang/Scala/Ulam-spiral--for-primes- b/Lang/Scala/Ulam-spiral--for-primes- new file mode 120000 index 0000000000..34bccfc98c --- /dev/null +++ b/Lang/Scala/Ulam-spiral--for-primes- @@ -0,0 +1 @@ +../../Task/Ulam-spiral--for-primes-/Scala \ No newline at end of file diff --git a/Lang/Sed/Four-bit-adder b/Lang/Sed/Four-bit-adder new file mode 120000 index 0000000000..789a2d9c64 --- /dev/null +++ b/Lang/Sed/Four-bit-adder @@ -0,0 +1 @@ +../../Task/Four-bit-adder/Sed \ No newline at end of file diff --git a/Lang/Simula/Case-sensitivity-of-identifiers b/Lang/Simula/Case-sensitivity-of-identifiers new file mode 120000 index 0000000000..e9bc211519 --- /dev/null +++ b/Lang/Simula/Case-sensitivity-of-identifiers @@ -0,0 +1 @@ +../../Task/Case-sensitivity-of-identifiers/Simula \ No newline at end of file diff --git a/Lang/Simula/Classes b/Lang/Simula/Classes new file mode 120000 index 0000000000..09427ddbb9 --- /dev/null +++ b/Lang/Simula/Classes @@ -0,0 +1 @@ +../../Task/Classes/Simula \ No newline at end of file diff --git a/Lang/Simula/Factorial b/Lang/Simula/Factorial new file mode 120000 index 0000000000..f7648fea5c --- /dev/null +++ b/Lang/Simula/Factorial @@ -0,0 +1 @@ +../../Task/Factorial/Simula \ No newline at end of file diff --git a/Lang/Simula/Fibonacci-sequence b/Lang/Simula/Fibonacci-sequence new file mode 120000 index 0000000000..17803bda53 --- /dev/null +++ b/Lang/Simula/Fibonacci-sequence @@ -0,0 +1 @@ +../../Task/Fibonacci-sequence/Simula \ No newline at end of file diff --git a/Lang/Simula/FizzBuzz b/Lang/Simula/FizzBuzz new file mode 120000 index 0000000000..0310a1d029 --- /dev/null +++ b/Lang/Simula/FizzBuzz @@ -0,0 +1 @@ +../../Task/FizzBuzz/Simula \ No newline at end of file diff --git a/Lang/Simula/Function-definition b/Lang/Simula/Function-definition new file mode 120000 index 0000000000..cf592d9f2e --- /dev/null +++ b/Lang/Simula/Function-definition @@ -0,0 +1 @@ +../../Task/Function-definition/Simula \ No newline at end of file diff --git a/Lang/Simula/Inheritance-Single b/Lang/Simula/Inheritance-Single new file mode 120000 index 0000000000..56204c9fa8 --- /dev/null +++ b/Lang/Simula/Inheritance-Single @@ -0,0 +1 @@ +../../Task/Inheritance-Single/Simula \ No newline at end of file diff --git a/Lang/Simula/Loops-Downward-for b/Lang/Simula/Loops-Downward-for new file mode 120000 index 0000000000..bd6a2eb05b --- /dev/null +++ b/Lang/Simula/Loops-Downward-for @@ -0,0 +1 @@ +../../Task/Loops-Downward-for/Simula \ No newline at end of file diff --git a/Lang/Simula/Loops-For-with-a-specified-step b/Lang/Simula/Loops-For-with-a-specified-step new file mode 120000 index 0000000000..94d6ee1c9d --- /dev/null +++ b/Lang/Simula/Loops-For-with-a-specified-step @@ -0,0 +1 @@ +../../Task/Loops-For-with-a-specified-step/Simula \ No newline at end of file diff --git a/Lang/Simula/Multiplication-tables b/Lang/Simula/Multiplication-tables new file mode 120000 index 0000000000..7c4c2e6448 --- /dev/null +++ b/Lang/Simula/Multiplication-tables @@ -0,0 +1 @@ +../../Task/Multiplication-tables/Simula \ No newline at end of file diff --git a/Lang/Simula/The-Twelve-Days-of-Christmas b/Lang/Simula/The-Twelve-Days-of-Christmas new file mode 120000 index 0000000000..189f9e74bb --- /dev/null +++ b/Lang/Simula/The-Twelve-Days-of-Christmas @@ -0,0 +1 @@ +../../Task/The-Twelve-Days-of-Christmas/Simula \ No newline at end of file diff --git a/Lang/Smalltalk/Find-the-last-Sunday-of-each-month b/Lang/Smalltalk/Find-the-last-Sunday-of-each-month new file mode 120000 index 0000000000..66b42e4866 --- /dev/null +++ b/Lang/Smalltalk/Find-the-last-Sunday-of-each-month @@ -0,0 +1 @@ +../../Task/Find-the-last-Sunday-of-each-month/Smalltalk \ No newline at end of file diff --git a/Lang/Smalltalk/Generate-lower-case-ASCII-alphabet b/Lang/Smalltalk/Generate-lower-case-ASCII-alphabet new file mode 120000 index 0000000000..ab41e0fc0f --- /dev/null +++ b/Lang/Smalltalk/Generate-lower-case-ASCII-alphabet @@ -0,0 +1 @@ +../../Task/Generate-lower-case-ASCII-alphabet/Smalltalk \ No newline at end of file diff --git a/Lang/Smalltalk/Last-Friday-of-each-month b/Lang/Smalltalk/Last-Friday-of-each-month new file mode 120000 index 0000000000..6074683df0 --- /dev/null +++ b/Lang/Smalltalk/Last-Friday-of-each-month @@ -0,0 +1 @@ +../../Task/Last-Friday-of-each-month/Smalltalk \ No newline at end of file diff --git a/Lang/Smalltalk/Substring-Top-and-tail b/Lang/Smalltalk/Substring-Top-and-tail new file mode 120000 index 0000000000..236c6315b2 --- /dev/null +++ b/Lang/Smalltalk/Substring-Top-and-tail @@ -0,0 +1 @@ +../../Task/Substring-Top-and-tail/Smalltalk \ No newline at end of file diff --git a/Lang/Smalltalk/The-Twelve-Days-of-Christmas b/Lang/Smalltalk/The-Twelve-Days-of-Christmas new file mode 120000 index 0000000000..8419248ee3 --- /dev/null +++ b/Lang/Smalltalk/The-Twelve-Days-of-Christmas @@ -0,0 +1 @@ +../../Task/The-Twelve-Days-of-Christmas/Smalltalk \ No newline at end of file diff --git a/Lang/Snobol/The-Twelve-Days-of-Christmas b/Lang/Snobol/The-Twelve-Days-of-Christmas new file mode 120000 index 0000000000..de71d689a5 --- /dev/null +++ b/Lang/Snobol/The-Twelve-Days-of-Christmas @@ -0,0 +1 @@ +../../Task/The-Twelve-Days-of-Christmas/Snobol \ No newline at end of file diff --git a/Lang/Standard-ML/A+B b/Lang/Standard-ML/A+B new file mode 120000 index 0000000000..ed689517c5 --- /dev/null +++ b/Lang/Standard-ML/A+B @@ -0,0 +1 @@ +../../Task/A+B/Standard-ML \ No newline at end of file diff --git a/Lang/Standard-ML/Arithmetic-evaluation b/Lang/Standard-ML/Arithmetic-evaluation new file mode 120000 index 0000000000..890e9564e3 --- /dev/null +++ b/Lang/Standard-ML/Arithmetic-evaluation @@ -0,0 +1 @@ +../../Task/Arithmetic-evaluation/Standard-ML \ No newline at end of file diff --git a/Lang/Standard-ML/Averages-Root-mean-square b/Lang/Standard-ML/Averages-Root-mean-square new file mode 120000 index 0000000000..149381293a --- /dev/null +++ b/Lang/Standard-ML/Averages-Root-mean-square @@ -0,0 +1 @@ +../../Task/Averages-Root-mean-square/Standard-ML \ No newline at end of file diff --git a/Lang/Standard-ML/Balanced-brackets b/Lang/Standard-ML/Balanced-brackets new file mode 120000 index 0000000000..b1efc07c74 --- /dev/null +++ b/Lang/Standard-ML/Balanced-brackets @@ -0,0 +1 @@ +../../Task/Balanced-brackets/Standard-ML \ No newline at end of file diff --git a/Lang/Standard-ML/Case-sensitivity-of-identifiers b/Lang/Standard-ML/Case-sensitivity-of-identifiers new file mode 120000 index 0000000000..3e12caf0ad --- /dev/null +++ b/Lang/Standard-ML/Case-sensitivity-of-identifiers @@ -0,0 +1 @@ +../../Task/Case-sensitivity-of-identifiers/Standard-ML \ No newline at end of file diff --git a/Lang/Standard-ML/Create-an-HTML-table b/Lang/Standard-ML/Create-an-HTML-table new file mode 120000 index 0000000000..838e24e046 --- /dev/null +++ b/Lang/Standard-ML/Create-an-HTML-table @@ -0,0 +1 @@ +../../Task/Create-an-HTML-table/Standard-ML \ No newline at end of file diff --git a/Lang/Standard-ML/Empty-directory b/Lang/Standard-ML/Empty-directory new file mode 120000 index 0000000000..6eee3d1db1 --- /dev/null +++ b/Lang/Standard-ML/Empty-directory @@ -0,0 +1 @@ +../../Task/Empty-directory/Standard-ML \ No newline at end of file diff --git a/Lang/Standard-ML/Even-or-odd b/Lang/Standard-ML/Even-or-odd new file mode 120000 index 0000000000..b9170478a9 --- /dev/null +++ b/Lang/Standard-ML/Even-or-odd @@ -0,0 +1 @@ +../../Task/Even-or-odd/Standard-ML \ No newline at end of file diff --git a/Lang/Standard-ML/Flatten-a-list b/Lang/Standard-ML/Flatten-a-list new file mode 120000 index 0000000000..44691b113e --- /dev/null +++ b/Lang/Standard-ML/Flatten-a-list @@ -0,0 +1 @@ +../../Task/Flatten-a-list/Standard-ML \ No newline at end of file diff --git a/Lang/Standard-ML/Integer-sequence b/Lang/Standard-ML/Integer-sequence new file mode 120000 index 0000000000..19624f54f1 --- /dev/null +++ b/Lang/Standard-ML/Integer-sequence @@ -0,0 +1 @@ +../../Task/Integer-sequence/Standard-ML \ No newline at end of file diff --git a/Lang/Standard-ML/Named-parameters b/Lang/Standard-ML/Named-parameters new file mode 120000 index 0000000000..fadd0943b0 --- /dev/null +++ b/Lang/Standard-ML/Named-parameters @@ -0,0 +1 @@ +../../Task/Named-parameters/Standard-ML \ No newline at end of file diff --git a/Lang/Standard-ML/Parsing-Shunting-yard-algorithm b/Lang/Standard-ML/Parsing-Shunting-yard-algorithm new file mode 120000 index 0000000000..945b438f55 --- /dev/null +++ b/Lang/Standard-ML/Parsing-Shunting-yard-algorithm @@ -0,0 +1 @@ +../../Task/Parsing-Shunting-yard-algorithm/Standard-ML \ No newline at end of file diff --git a/Lang/Standard-ML/Stack b/Lang/Standard-ML/Stack new file mode 120000 index 0000000000..170e31cff9 --- /dev/null +++ b/Lang/Standard-ML/Stack @@ -0,0 +1 @@ +../../Task/Stack/Standard-ML \ No newline at end of file diff --git a/Lang/Standard-ML/Wireworld b/Lang/Standard-ML/Wireworld new file mode 120000 index 0000000000..77759c1c96 --- /dev/null +++ b/Lang/Standard-ML/Wireworld @@ -0,0 +1 @@ +../../Task/Wireworld/Standard-ML \ No newline at end of file diff --git a/Lang/Standard-ML/Zebra-puzzle b/Lang/Standard-ML/Zebra-puzzle new file mode 120000 index 0000000000..e099de5fd3 --- /dev/null +++ b/Lang/Standard-ML/Zebra-puzzle @@ -0,0 +1 @@ +../../Task/Zebra-puzzle/Standard-ML \ No newline at end of file diff --git a/Lang/SuperCollider/00DESCRIPTION b/Lang/SuperCollider/00DESCRIPTION index 2d33371297..f804a4a144 100644 --- a/Lang/SuperCollider/00DESCRIPTION +++ b/Lang/SuperCollider/00DESCRIPTION @@ -1,6 +1,12 @@ {{stub}}{{language |checking=dynamic |exec=interpreted -|site=http://supercollider.sourceforge.net/ +|site=http://supercollider.github.io/ |LCT=no}}{{language programming paradigm|object-oriented}} -SuperCollider is an environment and programming language for real time audio synthesis and algorithmic composition. It provides an interpreted object-oriented language which functions as a network client to a state of the art, realtime sound synthesis server. \ No newline at end of file +SuperCollider is an environment and programming language for real time audio synthesis and algorithmic composition. It provides an interpreted object-oriented language (often called sclang) which functions as a network client to a state of the art, realtime sound synthesis server. It is used by musicians, artists, and researchers working with sound. + +The programming language was originally devised by James McCartney and has been further developed by an interdisciplinary open source community. Its design follows a pure object-oriented design that relies on objects including functions as first-class citizens. It is dynamically typed, and has functions of both lexical and dynamic scope. SuperCollider comes with an interactive programming library for the runtime rewriting of programs, which includes programming as a performance (live coding). There are several purely functional sublanguages embedded in the system. While mostly used for sound, its structure is general purpose. + + +[https://github.com/supercollider/supercollider SuperCollider at GitHub] +[http://supercollider.github.io/ SuperCollider Homepage] \ No newline at end of file diff --git a/Lang/SuperCollider/100-doors b/Lang/SuperCollider/100-doors new file mode 120000 index 0000000000..9254308083 --- /dev/null +++ b/Lang/SuperCollider/100-doors @@ -0,0 +1 @@ +../../Task/100-doors/SuperCollider \ No newline at end of file diff --git a/Lang/SuperCollider/99-Bottles-of-Beer b/Lang/SuperCollider/99-Bottles-of-Beer new file mode 120000 index 0000000000..c3fd043f60 --- /dev/null +++ b/Lang/SuperCollider/99-Bottles-of-Beer @@ -0,0 +1 @@ +../../Task/99-Bottles-of-Beer/SuperCollider \ No newline at end of file diff --git a/Lang/SuperCollider/Active-object b/Lang/SuperCollider/Active-object new file mode 120000 index 0000000000..e0f9247510 --- /dev/null +++ b/Lang/SuperCollider/Active-object @@ -0,0 +1 @@ +../../Task/Active-object/SuperCollider \ No newline at end of file diff --git a/Lang/SuperCollider/Anagrams b/Lang/SuperCollider/Anagrams new file mode 120000 index 0000000000..cfaa505ee8 --- /dev/null +++ b/Lang/SuperCollider/Anagrams @@ -0,0 +1 @@ +../../Task/Anagrams/SuperCollider \ No newline at end of file diff --git a/Lang/SuperCollider/Fibonacci-sequence b/Lang/SuperCollider/Fibonacci-sequence new file mode 120000 index 0000000000..d47dd19491 --- /dev/null +++ b/Lang/SuperCollider/Fibonacci-sequence @@ -0,0 +1 @@ +../../Task/Fibonacci-sequence/SuperCollider \ No newline at end of file diff --git a/Lang/SuperCollider/First-class-functions b/Lang/SuperCollider/First-class-functions new file mode 120000 index 0000000000..74393fb9d1 --- /dev/null +++ b/Lang/SuperCollider/First-class-functions @@ -0,0 +1 @@ +../../Task/First-class-functions/SuperCollider \ No newline at end of file diff --git a/Lang/SuperCollider/Flatten-a-list b/Lang/SuperCollider/Flatten-a-list new file mode 120000 index 0000000000..dd4de79bcf --- /dev/null +++ b/Lang/SuperCollider/Flatten-a-list @@ -0,0 +1 @@ +../../Task/Flatten-a-list/SuperCollider \ No newline at end of file diff --git a/Lang/SuperCollider/Function-composition b/Lang/SuperCollider/Function-composition new file mode 120000 index 0000000000..5ced86c8dc --- /dev/null +++ b/Lang/SuperCollider/Function-composition @@ -0,0 +1 @@ +../../Task/Function-composition/SuperCollider \ No newline at end of file diff --git a/Lang/SuperCollider/Generate-lower-case-ASCII-alphabet b/Lang/SuperCollider/Generate-lower-case-ASCII-alphabet new file mode 120000 index 0000000000..6ae0a205e7 --- /dev/null +++ b/Lang/SuperCollider/Generate-lower-case-ASCII-alphabet @@ -0,0 +1 @@ +../../Task/Generate-lower-case-ASCII-alphabet/SuperCollider \ No newline at end of file diff --git a/Lang/SuperCollider/Generator-Exponential b/Lang/SuperCollider/Generator-Exponential new file mode 120000 index 0000000000..4c31361996 --- /dev/null +++ b/Lang/SuperCollider/Generator-Exponential @@ -0,0 +1 @@ +../../Task/Generator-Exponential/SuperCollider \ No newline at end of file diff --git a/Lang/SuperCollider/Higher-order-functions b/Lang/SuperCollider/Higher-order-functions new file mode 120000 index 0000000000..09e530a08c --- /dev/null +++ b/Lang/SuperCollider/Higher-order-functions @@ -0,0 +1 @@ +../../Task/Higher-order-functions/SuperCollider \ No newline at end of file diff --git a/Lang/SuperCollider/Integer-sequence b/Lang/SuperCollider/Integer-sequence new file mode 120000 index 0000000000..8e1628c959 --- /dev/null +++ b/Lang/SuperCollider/Integer-sequence @@ -0,0 +1 @@ +../../Task/Integer-sequence/SuperCollider \ No newline at end of file diff --git a/Lang/SuperCollider/Maze-generation b/Lang/SuperCollider/Maze-generation new file mode 120000 index 0000000000..a9ea0a6e13 --- /dev/null +++ b/Lang/SuperCollider/Maze-generation @@ -0,0 +1 @@ +../../Task/Maze-generation/SuperCollider \ No newline at end of file diff --git a/Lang/SuperCollider/Permutations-Derangements b/Lang/SuperCollider/Permutations-Derangements new file mode 120000 index 0000000000..035dfb3974 --- /dev/null +++ b/Lang/SuperCollider/Permutations-Derangements @@ -0,0 +1 @@ +../../Task/Permutations-Derangements/SuperCollider \ No newline at end of file diff --git a/Lang/SuperCollider/Respond-to-an-unknown-method-call b/Lang/SuperCollider/Respond-to-an-unknown-method-call new file mode 120000 index 0000000000..6dfa71e6f3 --- /dev/null +++ b/Lang/SuperCollider/Respond-to-an-unknown-method-call @@ -0,0 +1 @@ +../../Task/Respond-to-an-unknown-method-call/SuperCollider \ No newline at end of file diff --git a/Lang/SuperCollider/Semordnilap b/Lang/SuperCollider/Semordnilap new file mode 120000 index 0000000000..ace051dba8 --- /dev/null +++ b/Lang/SuperCollider/Semordnilap @@ -0,0 +1 @@ +../../Task/Semordnilap/SuperCollider \ No newline at end of file diff --git a/Lang/TI-83-BASIC/Dot-product b/Lang/TI-83-BASIC/Dot-product new file mode 120000 index 0000000000..29e1abb598 --- /dev/null +++ b/Lang/TI-83-BASIC/Dot-product @@ -0,0 +1 @@ +../../Task/Dot-product/TI-83-BASIC \ No newline at end of file diff --git a/Lang/TXR/00DESCRIPTION b/Lang/TXR/00DESCRIPTION index 739386c444..a72bb54bed 100644 --- a/Lang/TXR/00DESCRIPTION +++ b/Lang/TXR/00DESCRIPTION @@ -1,7 +1,12 @@ {{language |site=http://www.nongnu.org/txr/}} +{{language programming paradigm|functional}} +{{language programming paradigm|procedural}} +{{language programming paradigm|object-oriented}} +{{language programming paradigm|imperative}} +{{language programming paradigm|declarative}} -TXR is a new language implemented in [[C]], running on POSIX platforms such as [[Linux]], [[Mac OS X]] and on Windows via [[Cygwin]] as well as more natively thanks to [[MinGW]]. +TXR is a new language implemented in [[C]], running on POSIX platforms such as [[Linux]], [[Mac OS X]] and [[Solaris]] as well as on [[Microsoft Windows]]. It is a dynamic, high level language originally intended for "data munging" tasks in Unix-like environments, particularly tasks requiring accurate, robust text scraping from loosely structured documents. The Rosetta Code TXR solutions can be viewed in color, and all on one page with a convenient navigation pane [http://www.nongnu.org/txr/rosetta-solutions.html here]. @@ -9,50 +14,6 @@ TXR started as a language for "reversing here-documents": evaluating a template eval $(txr ...) -TXR remains close to these roots: its main language is the pattern-based text extraction notation well-suited for matching large regions of -entire text documents. That language has become powerful enough to neatly parse grammars, while the tool developed a Lisp dialect to round out the functionality and increase its power. +TXR was internally based, from the beginning, on a data model based on Lisp and eventually exposed a Lisp dialect that came to be known as TXR Lisp. TXR Lisp at first complemented the pattern extraction language, extending its power, but eventually became distinct. Programs can be written in TXR Lisp with no traces of the TXR pattern language, or vice versa. -=== What's with all that @ stuff? === - -About the @ character: this serves as a multi-level escape in TXR. In the fundamental TXR syntax, which is literal text, this character is a signal which indicates that the object which follows is a variable or directive. Then inside a directive, the character indicates that the object which follows is a TXR Lisp expression to be evaluated as such, rather than according to the expression evaluation rules of the pattern language: - -
This is some literal text to be matched.
-@# this is a comment in the pattern language.
-This text matches and binds @variable.
-@(bind y  ;; this is the start of a directive in the TXR pattern language
-   @(> x 42) ;; this is an expression in TXR Lisp
-)
-Back to text.
- -In TXR Lisp, the @ character has more "meta" piled on top of it: @foo denotes (sys:var foo), and @(foo ...) denotes (sys:expr foo>). In any context which needs to separate meta-variables and meta-expressions from variables and expressions, this may come in handy. It's used by the op operator for currying, for instance (op * @1 @1) returns a function of one argument which returns the square of that argument. The implementation of the operator looks for syntax like (sys:var 1) and replaces it with the arguments of the generated lambda function. The @ character also appears in quasiliteral strings, where it interpolates the values of variables and expressions as text. - -TXR is somewhat unusual in that the relationship between a domain-specific language (DSL) and general-purpose host language is reversed. Typically, at least in Lisp systems, DSL's are embedded into the parent language. In TXR, the "outer shell" is the domain-specific language for extracting text, and Lisp is embedded in it as "computational appliance". It doesn't take much to reach the Lisp though: a TXR source file can just consist of a single @(do ...) directive which contains nothing but TXR Lisp forms. Also, TXR Lisp evaluation is available from program invocation via the -e and -p options. - -The second unusual feature in TXR is that the "tokens" in the pattern matching language are essentially themselves Lisp symbols and expressions. These "tokens" are used to create a block-structured language. This is quite odd. For instance a construct might begin with a @(collect :vars (foo)). This is a Lisp expression with interior structure, but to the parser of the pattern language, it's also basically just a token, like a giant keyword. IT begins a collect clause, and is followed by some optional material which may just be literal text, and must be terminated by the @(end) directive: another token-expression entity. - -=== Dual Personality === - -From the solutions below, it is obvious that some of them make heavy use of the pattern language and little or no TXR Lisp. Others are quite the other way around, based entirely or almost entirely on Lisp, whereas others follow strategies of mixing the approaches. - -=== Lisp Innovation === - -Although TXR Lisp is heavily based on prior work and strongly influenced by Common Lisp (for instance, there is a real nil symbol which is a list terminator and means "false", and it's primarily Lisp-2 dialect), TXR Lisp nevertheless manages to innovate within the world of Lisp. - -==== Can't We All Just Get Along? ==== - -One major innovation is the way in which TXR Lisp closes the ages-old gap between Lisp-1 and Lisp-2, and the associated religious sectarian division it has caused. TXR Lisp recognizes that there are advantages both in having separate function and variable namespaces, and in having a single namespace: and it provides support for both approaches. The idea is devilishly simple. A special operator called "dwim" (do what I mean) is provided such that (dwim forms ...) basically denotes (forms ...), but with Lisp-1 style evaluation: any of the forms which are symbols are resolved according to a flattened namespace that combines variable and function bindings (with conflicts resolved in favor of variables). TXR Lisp programmers do not use the dwim operator directly, but rather the square bracket notation [a b c ...] -> (dwim a b c). So for instance, [mapcar list '(1 2 3) '(a b c)] zips together two lists. Using round brackets, it would have to be (mapcar (fun list) '(1 2 3) '(a b c)). Moreover, if foo is a variable that holds a function of one argument, it has to be called using (call foo arg). But with the "dwim brackets", it is just [foo arg]. The "dwim brackets" also support various funcall-extensions, like indexing into arrays and slicing and so on. If h is a hash then [h "a" 42] looks up the string a in the hash and returns the value, or else returns 42 if the key is not found. If a is an array, list or string, then [a 2..3] extracts a slice. On the other hand, "dwim brackets" do not support operators: [let (a b c) ...] is not valid; or rather, it expects a variable or function let to exist, ignoring the let operator. Operators are strictly in the Lisp-2 domain, which is fine because Lisp-2 is a cleaner model with regard to operators anyway! - -==== Polymorphizing the Classics ==== - -In TXR Lisp, classic Lisp operations like mapcar, cdr or append work exactly like they are supposed to, when they operate on lists. Right down to improper lists like (append 42) -> 42 and (append '(1) 2) -> (1 . 2). -However, most of the operations have been extended to also work with strings and vectors. So for instance, (mapcar (op + 1) "abc") nicely yields the string "bcd" where 1 has been added to every character code of the original string. (car "abc") yields #\a, a character, (cdr "abc") yields "bc", and (cdr "c") yields nil (rather than the empty string!) (Almost) everything proceeds from there. - -==== Good Hackers Borrow; Great Ones Steal ==== - -TXR steals ideas from libraries and languages related to Lisp. The op operator is inspired by Goo's op, and the cl-op library for Common Lisp which is also inspired by Goo's op. - -Array and list slices are straight out of Python, right down to the half-open ranges (not including the upper endpoint), and negative values indexing from the tail of the array. The concept is further improved upon by allowing the Lisp symbols nil and t to be used as range indexes. - -Slices, even empty ones, are assignable places in TXR Lisp: we can easily replace a possibly empty section of a string, lisp or vector, with a sequence that is of different length, also possibly empty: for instance, if x contains "abc" then (set [x 1..2] "foo") changes x to contain "afooc". - -The group-by function is a straight rip-off from Ruby. \ No newline at end of file +TXR Lisp is an original dialect that contains many innovative features, which orchestrate together to express neat, compact solutions to everyday data processing problems. Programmers familiar with Common Lisp will be comfortable with TXR Lisp, and there is much to like for those who use Scheme, Racket or Clojure. TXR Lisp incorporates ideas from contemporary scripting languages also; a key motivation in many of its developments is the promotion of succinctness, which is something that often isn't associated with languages in the Lisp family. \ No newline at end of file diff --git a/Lang/TXR/Currying b/Lang/TXR/Currying new file mode 120000 index 0000000000..632d792137 --- /dev/null +++ b/Lang/TXR/Currying @@ -0,0 +1 @@ +../../Task/Currying/TXR \ No newline at end of file diff --git a/Lang/TXR/Generic-swap b/Lang/TXR/Generic-swap new file mode 120000 index 0000000000..f9e8b3ee99 --- /dev/null +++ b/Lang/TXR/Generic-swap @@ -0,0 +1 @@ +../../Task/Generic-swap/TXR \ No newline at end of file diff --git a/Lang/TXR/Man-or-boy-test b/Lang/TXR/Man-or-boy-test new file mode 120000 index 0000000000..68d87335ed --- /dev/null +++ b/Lang/TXR/Man-or-boy-test @@ -0,0 +1 @@ +../../Task/Man-or-boy-test/TXR \ No newline at end of file diff --git a/Lang/TXR/Range-extraction b/Lang/TXR/Range-extraction new file mode 120000 index 0000000000..619dec23c4 --- /dev/null +++ b/Lang/TXR/Range-extraction @@ -0,0 +1 @@ +../../Task/Range-extraction/TXR \ No newline at end of file diff --git a/Lang/TXR/Sleep b/Lang/TXR/Sleep new file mode 120000 index 0000000000..088078f0b7 --- /dev/null +++ b/Lang/TXR/Sleep @@ -0,0 +1 @@ +../../Task/Sleep/TXR \ No newline at end of file diff --git a/Lang/TXR/Sockets b/Lang/TXR/Sockets new file mode 120000 index 0000000000..5b15b84e35 --- /dev/null +++ b/Lang/TXR/Sockets @@ -0,0 +1 @@ +../../Task/Sockets/TXR \ No newline at end of file diff --git a/Lang/TXR/Synchronous-concurrency b/Lang/TXR/Synchronous-concurrency new file mode 120000 index 0000000000..112e655872 --- /dev/null +++ b/Lang/TXR/Synchronous-concurrency @@ -0,0 +1 @@ +../../Task/Synchronous-concurrency/TXR \ No newline at end of file diff --git a/Lang/UNIX-Shell/Narcissist b/Lang/UNIX-Shell/Narcissist new file mode 120000 index 0000000000..5fecccb07d --- /dev/null +++ b/Lang/UNIX-Shell/Narcissist @@ -0,0 +1 @@ +../../Task/Narcissist/UNIX-Shell \ No newline at end of file diff --git a/Lang/UNIX-Shell/Soundex b/Lang/UNIX-Shell/Soundex new file mode 120000 index 0000000000..d1b23e304c --- /dev/null +++ b/Lang/UNIX-Shell/Soundex @@ -0,0 +1 @@ +../../Task/Soundex/UNIX-Shell \ No newline at end of file diff --git a/Lang/UNIX-Shell/Stable-marriage-problem b/Lang/UNIX-Shell/Stable-marriage-problem new file mode 120000 index 0000000000..e95fa15b6b --- /dev/null +++ b/Lang/UNIX-Shell/Stable-marriage-problem @@ -0,0 +1 @@ +../../Task/Stable-marriage-problem/UNIX-Shell \ No newline at end of file diff --git a/Lang/UNIX-Shell/The-Twelve-Days-of-Christmas b/Lang/UNIX-Shell/The-Twelve-Days-of-Christmas new file mode 120000 index 0000000000..b8c24871cf --- /dev/null +++ b/Lang/UNIX-Shell/The-Twelve-Days-of-Christmas @@ -0,0 +1 @@ +../../Task/The-Twelve-Days-of-Christmas/UNIX-Shell \ No newline at end of file diff --git a/Lang/Unicon/HTTPS b/Lang/Unicon/HTTPS new file mode 120000 index 0000000000..149450f34c --- /dev/null +++ b/Lang/Unicon/HTTPS @@ -0,0 +1 @@ +../../Task/HTTPS/Unicon \ No newline at end of file diff --git a/Lang/VBA/Address-of-a-variable b/Lang/VBA/Address-of-a-variable new file mode 120000 index 0000000000..2f97f51866 --- /dev/null +++ b/Lang/VBA/Address-of-a-variable @@ -0,0 +1 @@ +../../Task/Address-of-a-variable/VBA \ No newline at end of file diff --git a/Lang/VBA/Associative-array-Creation b/Lang/VBA/Associative-array-Creation new file mode 120000 index 0000000000..ba8cdcebc5 --- /dev/null +++ b/Lang/VBA/Associative-array-Creation @@ -0,0 +1 @@ +../../Task/Associative-array-Creation/VBA \ No newline at end of file diff --git a/Lang/VBA/Associative-array-Iteration b/Lang/VBA/Associative-array-Iteration new file mode 120000 index 0000000000..558c210c92 --- /dev/null +++ b/Lang/VBA/Associative-array-Iteration @@ -0,0 +1 @@ +../../Task/Associative-array-Iteration/VBA \ No newline at end of file diff --git a/Lang/VBA/Averages-Root-mean-square b/Lang/VBA/Averages-Root-mean-square new file mode 120000 index 0000000000..30574d0e14 --- /dev/null +++ b/Lang/VBA/Averages-Root-mean-square @@ -0,0 +1 @@ +../../Task/Averages-Root-mean-square/VBA \ No newline at end of file diff --git a/Lang/VBA/CSV-data-manipulation b/Lang/VBA/CSV-data-manipulation new file mode 120000 index 0000000000..a74bb3c432 --- /dev/null +++ b/Lang/VBA/CSV-data-manipulation @@ -0,0 +1 @@ +../../Task/CSV-data-manipulation/VBA \ No newline at end of file diff --git a/Lang/VBA/Call-a-function-in-a-shared-library b/Lang/VBA/Call-a-function-in-a-shared-library new file mode 120000 index 0000000000..1c280b32b0 --- /dev/null +++ b/Lang/VBA/Call-a-function-in-a-shared-library @@ -0,0 +1 @@ +../../Task/Call-a-function-in-a-shared-library/VBA \ No newline at end of file diff --git a/Lang/VBA/Loops-For b/Lang/VBA/Loops-For new file mode 120000 index 0000000000..3662d9a3a8 --- /dev/null +++ b/Lang/VBA/Loops-For @@ -0,0 +1 @@ +../../Task/Loops-For/VBA \ No newline at end of file diff --git a/Lang/VBA/Loops-For-with-a-specified-step b/Lang/VBA/Loops-For-with-a-specified-step new file mode 120000 index 0000000000..35f202032d --- /dev/null +++ b/Lang/VBA/Loops-For-with-a-specified-step @@ -0,0 +1 @@ +../../Task/Loops-For-with-a-specified-step/VBA \ No newline at end of file diff --git a/Lang/VBA/Numerical-integration b/Lang/VBA/Numerical-integration new file mode 120000 index 0000000000..29a68ed77d --- /dev/null +++ b/Lang/VBA/Numerical-integration @@ -0,0 +1 @@ +../../Task/Numerical-integration/VBA \ No newline at end of file diff --git a/Lang/VBA/Read-a-file-line-by-line b/Lang/VBA/Read-a-file-line-by-line new file mode 120000 index 0000000000..bb10f58b8e --- /dev/null +++ b/Lang/VBA/Read-a-file-line-by-line @@ -0,0 +1 @@ +../../Task/Read-a-file-line-by-line/VBA \ No newline at end of file diff --git a/Lang/VBA/Send-email b/Lang/VBA/Send-email new file mode 120000 index 0000000000..8f0ba0ea36 --- /dev/null +++ b/Lang/VBA/Send-email @@ -0,0 +1 @@ +../../Task/Send-email/VBA \ No newline at end of file diff --git a/Lang/VBA/Stable-marriage-problem b/Lang/VBA/Stable-marriage-problem new file mode 120000 index 0000000000..2b2a4cfb6f --- /dev/null +++ b/Lang/VBA/Stable-marriage-problem @@ -0,0 +1 @@ +../../Task/Stable-marriage-problem/VBA \ No newline at end of file diff --git a/Lang/VBScript/Averages-Simple-moving-average b/Lang/VBScript/Averages-Simple-moving-average new file mode 120000 index 0000000000..14e5296078 --- /dev/null +++ b/Lang/VBScript/Averages-Simple-moving-average @@ -0,0 +1 @@ +../../Task/Averages-Simple-moving-average/VBScript \ No newline at end of file diff --git a/Lang/VBScript/I-before-E-except-after-C b/Lang/VBScript/I-before-E-except-after-C new file mode 120000 index 0000000000..c1c94f7ba4 --- /dev/null +++ b/Lang/VBScript/I-before-E-except-after-C @@ -0,0 +1 @@ +../../Task/I-before-E-except-after-C/VBScript \ No newline at end of file diff --git a/Lang/VBScript/Input-loop b/Lang/VBScript/Input-loop new file mode 120000 index 0000000000..19668005cf --- /dev/null +++ b/Lang/VBScript/Input-loop @@ -0,0 +1 @@ +../../Task/Input-loop/VBScript \ No newline at end of file diff --git a/Lang/VBScript/Longest-increasing-subsequence b/Lang/VBScript/Longest-increasing-subsequence new file mode 120000 index 0000000000..1cbc082e77 --- /dev/null +++ b/Lang/VBScript/Longest-increasing-subsequence @@ -0,0 +1 @@ +../../Task/Longest-increasing-subsequence/VBScript \ No newline at end of file diff --git a/Lang/VBScript/Loops-For b/Lang/VBScript/Loops-For new file mode 120000 index 0000000000..141d889652 --- /dev/null +++ b/Lang/VBScript/Loops-For @@ -0,0 +1 @@ +../../Task/Loops-For/VBScript \ No newline at end of file diff --git a/Lang/VBScript/Loops-For-with-a-specified-step b/Lang/VBScript/Loops-For-with-a-specified-step new file mode 120000 index 0000000000..9524dfbff7 --- /dev/null +++ b/Lang/VBScript/Loops-For-with-a-specified-step @@ -0,0 +1 @@ +../../Task/Loops-For-with-a-specified-step/VBScript \ No newline at end of file diff --git a/Lang/VBScript/Reverse-words-in-a-string b/Lang/VBScript/Reverse-words-in-a-string new file mode 120000 index 0000000000..425489dc3b --- /dev/null +++ b/Lang/VBScript/Reverse-words-in-a-string @@ -0,0 +1 @@ +../../Task/Reverse-words-in-a-string/VBScript \ No newline at end of file diff --git a/Lang/VBScript/XML-Output b/Lang/VBScript/XML-Output new file mode 120000 index 0000000000..82a4a7bcf3 --- /dev/null +++ b/Lang/VBScript/XML-Output @@ -0,0 +1 @@ +../../Task/XML-Output/VBScript \ No newline at end of file diff --git a/Lang/Vala/Check-that-file-exists b/Lang/Vala/Check-that-file-exists new file mode 120000 index 0000000000..80e37430de --- /dev/null +++ b/Lang/Vala/Check-that-file-exists @@ -0,0 +1 @@ +../../Task/Check-that-file-exists/Vala \ No newline at end of file diff --git a/Lang/Vala/Identity-matrix b/Lang/Vala/Identity-matrix new file mode 120000 index 0000000000..745fefb788 --- /dev/null +++ b/Lang/Vala/Identity-matrix @@ -0,0 +1 @@ +../../Task/Identity-matrix/Vala \ No newline at end of file diff --git a/Lang/Vala/Logical-operations b/Lang/Vala/Logical-operations new file mode 120000 index 0000000000..7212adab82 --- /dev/null +++ b/Lang/Vala/Logical-operations @@ -0,0 +1 @@ +../../Task/Logical-operations/Vala \ No newline at end of file diff --git a/Lang/Vala/Loops-For b/Lang/Vala/Loops-For new file mode 120000 index 0000000000..19952f6162 --- /dev/null +++ b/Lang/Vala/Loops-For @@ -0,0 +1 @@ +../../Task/Loops-For/Vala \ No newline at end of file diff --git a/Lang/Vala/Palindrome-detection b/Lang/Vala/Palindrome-detection new file mode 120000 index 0000000000..81cb915587 --- /dev/null +++ b/Lang/Vala/Palindrome-detection @@ -0,0 +1 @@ +../../Task/Palindrome-detection/Vala \ No newline at end of file diff --git a/Lang/Vala/Reverse-a-string b/Lang/Vala/Reverse-a-string new file mode 120000 index 0000000000..0d9709976f --- /dev/null +++ b/Lang/Vala/Reverse-a-string @@ -0,0 +1 @@ +../../Task/Reverse-a-string/Vala \ No newline at end of file diff --git a/Lang/Vala/Unicode-strings b/Lang/Vala/Unicode-strings new file mode 120000 index 0000000000..f20106d38d --- /dev/null +++ b/Lang/Vala/Unicode-strings @@ -0,0 +1 @@ +../../Task/Unicode-strings/Vala \ No newline at end of file diff --git a/Lang/Vim-Script/Factorial b/Lang/Vim-Script/Factorial new file mode 120000 index 0000000000..a5e9bd2358 --- /dev/null +++ b/Lang/Vim-Script/Factorial @@ -0,0 +1 @@ +../../Task/Factorial/Vim-Script \ No newline at end of file diff --git a/Lang/Vim-Script/Langtons-ant b/Lang/Vim-Script/Langtons-ant new file mode 120000 index 0000000000..726754733a --- /dev/null +++ b/Lang/Vim-Script/Langtons-ant @@ -0,0 +1 @@ +../../Task/Langtons-ant/Vim-Script \ No newline at end of file diff --git a/Lang/Visual-Basic-.NET/Loops-For-with-a-specified-step b/Lang/Visual-Basic-.NET/Loops-For-with-a-specified-step new file mode 120000 index 0000000000..f61c81a637 --- /dev/null +++ b/Lang/Visual-Basic-.NET/Loops-For-with-a-specified-step @@ -0,0 +1 @@ +../../Task/Loops-For-with-a-specified-step/Visual-Basic-.NET \ No newline at end of file diff --git a/Lang/Visual-Basic/Loops-For-with-a-specified-step b/Lang/Visual-Basic/Loops-For-with-a-specified-step new file mode 120000 index 0000000000..bee90576a6 --- /dev/null +++ b/Lang/Visual-Basic/Loops-For-with-a-specified-step @@ -0,0 +1 @@ +../../Task/Loops-For-with-a-specified-step/Visual-Basic \ No newline at end of file diff --git a/Lang/X86-Assembly/Address-of-a-variable b/Lang/X86-Assembly/Address-of-a-variable new file mode 120000 index 0000000000..6ea0512b3c --- /dev/null +++ b/Lang/X86-Assembly/Address-of-a-variable @@ -0,0 +1 @@ +../../Task/Address-of-a-variable/X86-Assembly \ No newline at end of file diff --git a/Lang/X86-Assembly/Dot-product b/Lang/X86-Assembly/Dot-product new file mode 120000 index 0000000000..500a004edb --- /dev/null +++ b/Lang/X86-Assembly/Dot-product @@ -0,0 +1 @@ +../../Task/Dot-product/X86-Assembly \ No newline at end of file diff --git a/Lang/XQuery/Haversine-formula b/Lang/XQuery/Haversine-formula new file mode 120000 index 0000000000..85a7a3e681 --- /dev/null +++ b/Lang/XQuery/Haversine-formula @@ -0,0 +1 @@ +../../Task/Haversine-formula/XQuery \ No newline at end of file diff --git a/Lang/ZED/00DESCRIPTION b/Lang/ZED/00DESCRIPTION index 6627627124..b0cb425a84 100644 --- a/Lang/ZED/00DESCRIPTION +++ b/Lang/ZED/00DESCRIPTION @@ -10,13 +10,10 @@ A version that adds the concept of types also exists to compile ZED into C funct Development of ZEDc is also happening on GitHub: https://github.com/zelah/ZEDc -My latest programming projects are here: http://zedlan.blogspot.com - - -ZED can be seen compiling itself here: http://ideone.com/UHMQco +ZED can be seen compiling itself here: http://ideone.com/ARpMCM Language author on RC: [[User:Zelah|Zelah]] ([[User_talk:Zelah|talk]] | [[Special:Contributions/Zelah|contribs]]) - +165x2 194x2 207x2 . \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/24-game b/Lang/ZX-Spectrum-Basic/24-game new file mode 120000 index 0000000000..fa48dd0e1b --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/24-game @@ -0,0 +1 @@ +../../Task/24-game/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/A+B b/Lang/ZX-Spectrum-Basic/A+B new file mode 120000 index 0000000000..b72c502e7a --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/A+B @@ -0,0 +1 @@ +../../Task/A+B/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/ABC-Problem b/Lang/ZX-Spectrum-Basic/ABC-Problem new file mode 120000 index 0000000000..1e64f865aa --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/ABC-Problem @@ -0,0 +1 @@ +../../Task/ABC-Problem/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Abundant,-deficient-and-perfect-number-classifications b/Lang/ZX-Spectrum-Basic/Abundant,-deficient-and-perfect-number-classifications new file mode 120000 index 0000000000..4fc43932d0 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Abundant,-deficient-and-perfect-number-classifications @@ -0,0 +1 @@ +../../Task/Abundant,-deficient-and-perfect-number-classifications/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Ackermann-function b/Lang/ZX-Spectrum-Basic/Ackermann-function new file mode 120000 index 0000000000..4192be1842 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Ackermann-function @@ -0,0 +1 @@ +../../Task/Ackermann-function/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Align-columns b/Lang/ZX-Spectrum-Basic/Align-columns new file mode 120000 index 0000000000..d7c17d4ffd --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Align-columns @@ -0,0 +1 @@ +../../Task/Align-columns/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Aliquot-sequence-classifications b/Lang/ZX-Spectrum-Basic/Aliquot-sequence-classifications new file mode 120000 index 0000000000..5465db10c0 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Aliquot-sequence-classifications @@ -0,0 +1 @@ +../../Task/Aliquot-sequence-classifications/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Almost-prime b/Lang/ZX-Spectrum-Basic/Almost-prime new file mode 120000 index 0000000000..497b0642d0 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Almost-prime @@ -0,0 +1 @@ +../../Task/Almost-prime/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Amicable-pairs b/Lang/ZX-Spectrum-Basic/Amicable-pairs new file mode 120000 index 0000000000..229bde67dd --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Amicable-pairs @@ -0,0 +1 @@ +../../Task/Amicable-pairs/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Animate-a-pendulum b/Lang/ZX-Spectrum-Basic/Animate-a-pendulum new file mode 120000 index 0000000000..7ab1d07608 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Animate-a-pendulum @@ -0,0 +1 @@ +../../Task/Animate-a-pendulum/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Animation b/Lang/ZX-Spectrum-Basic/Animation new file mode 120000 index 0000000000..3c3bf3a322 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Animation @@ -0,0 +1 @@ +../../Task/Animation/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Anonymous-recursion b/Lang/ZX-Spectrum-Basic/Anonymous-recursion new file mode 120000 index 0000000000..5300a1204f --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Anonymous-recursion @@ -0,0 +1 @@ +../../Task/Anonymous-recursion/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Apply-a-callback-to-an-array b/Lang/ZX-Spectrum-Basic/Apply-a-callback-to-an-array new file mode 120000 index 0000000000..7e12e0b053 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Apply-a-callback-to-an-array @@ -0,0 +1 @@ +../../Task/Apply-a-callback-to-an-array/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Arithmetic-Complex b/Lang/ZX-Spectrum-Basic/Arithmetic-Complex new file mode 120000 index 0000000000..c67f2823f3 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Arithmetic-Complex @@ -0,0 +1 @@ +../../Task/Arithmetic-Complex/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Arithmetic-Integer b/Lang/ZX-Spectrum-Basic/Arithmetic-Integer new file mode 120000 index 0000000000..b30f3473e8 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Arithmetic-Integer @@ -0,0 +1 @@ +../../Task/Arithmetic-Integer/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Arithmetic-evaluation b/Lang/ZX-Spectrum-Basic/Arithmetic-evaluation new file mode 120000 index 0000000000..56de044d73 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Arithmetic-evaluation @@ -0,0 +1 @@ +../../Task/Arithmetic-evaluation/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Arithmetic-geometric-mean b/Lang/ZX-Spectrum-Basic/Arithmetic-geometric-mean new file mode 120000 index 0000000000..22b6e33c41 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Arithmetic-geometric-mean @@ -0,0 +1 @@ +../../Task/Arithmetic-geometric-mean/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Array-concatenation b/Lang/ZX-Spectrum-Basic/Array-concatenation new file mode 120000 index 0000000000..b554c89706 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Array-concatenation @@ -0,0 +1 @@ +../../Task/Array-concatenation/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Arrays b/Lang/ZX-Spectrum-Basic/Arrays new file mode 120000 index 0000000000..f18da20623 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Arrays @@ -0,0 +1 @@ +../../Task/Arrays/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Balanced-brackets b/Lang/ZX-Spectrum-Basic/Balanced-brackets new file mode 120000 index 0000000000..b31b7979ed --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Balanced-brackets @@ -0,0 +1 @@ +../../Task/Balanced-brackets/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Benfords-law b/Lang/ZX-Spectrum-Basic/Benfords-law new file mode 120000 index 0000000000..de8ec5226b --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Benfords-law @@ -0,0 +1 @@ +../../Task/Benfords-law/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Best-shuffle b/Lang/ZX-Spectrum-Basic/Best-shuffle new file mode 120000 index 0000000000..1901ef8a9c --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Best-shuffle @@ -0,0 +1 @@ +../../Task/Best-shuffle/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Binary-search b/Lang/ZX-Spectrum-Basic/Binary-search new file mode 120000 index 0000000000..6152b03645 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Binary-search @@ -0,0 +1 @@ +../../Task/Binary-search/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Box-the-compass b/Lang/ZX-Spectrum-Basic/Box-the-compass new file mode 120000 index 0000000000..969a2e4af3 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Box-the-compass @@ -0,0 +1 @@ +../../Task/Box-the-compass/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Brownian-tree b/Lang/ZX-Spectrum-Basic/Brownian-tree new file mode 120000 index 0000000000..76b62b4b7d --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Brownian-tree @@ -0,0 +1 @@ +../../Task/Brownian-tree/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Bulls-and-cows b/Lang/ZX-Spectrum-Basic/Bulls-and-cows new file mode 120000 index 0000000000..748467032e --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Bulls-and-cows @@ -0,0 +1 @@ +../../Task/Bulls-and-cows/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Caesar-cipher b/Lang/ZX-Spectrum-Basic/Caesar-cipher new file mode 120000 index 0000000000..5c35824846 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Caesar-cipher @@ -0,0 +1 @@ +../../Task/Caesar-cipher/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Carmichael-3-strong-pseudoprimes b/Lang/ZX-Spectrum-Basic/Carmichael-3-strong-pseudoprimes new file mode 120000 index 0000000000..6d7b8e923b --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Carmichael-3-strong-pseudoprimes @@ -0,0 +1 @@ +../../Task/Carmichael-3-strong-pseudoprimes/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Casting-out-nines b/Lang/ZX-Spectrum-Basic/Casting-out-nines new file mode 120000 index 0000000000..b8743ff652 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Casting-out-nines @@ -0,0 +1 @@ +../../Task/Casting-out-nines/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Catalan-numbers b/Lang/ZX-Spectrum-Basic/Catalan-numbers new file mode 120000 index 0000000000..2061ea93cf --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Catalan-numbers @@ -0,0 +1 @@ +../../Task/Catalan-numbers/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Catalan-numbers-Pascals-triangle b/Lang/ZX-Spectrum-Basic/Catalan-numbers-Pascals-triangle new file mode 120000 index 0000000000..a3dbafcb43 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Catalan-numbers-Pascals-triangle @@ -0,0 +1 @@ +../../Task/Catalan-numbers-Pascals-triangle/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Catamorphism b/Lang/ZX-Spectrum-Basic/Catamorphism new file mode 120000 index 0000000000..332fead955 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Catamorphism @@ -0,0 +1 @@ +../../Task/Catamorphism/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Character-codes b/Lang/ZX-Spectrum-Basic/Character-codes new file mode 120000 index 0000000000..8ff3f9f373 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Character-codes @@ -0,0 +1 @@ +../../Task/Character-codes/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Chinese-remainder-theorem b/Lang/ZX-Spectrum-Basic/Chinese-remainder-theorem new file mode 120000 index 0000000000..d29809d2cb --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Chinese-remainder-theorem @@ -0,0 +1 @@ +../../Task/Chinese-remainder-theorem/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Cholesky-decomposition b/Lang/ZX-Spectrum-Basic/Cholesky-decomposition new file mode 120000 index 0000000000..9c7a253f15 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Cholesky-decomposition @@ -0,0 +1 @@ +../../Task/Cholesky-decomposition/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Circles-of-given-radius-through-two-points b/Lang/ZX-Spectrum-Basic/Circles-of-given-radius-through-two-points new file mode 120000 index 0000000000..bd96a56380 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Circles-of-given-radius-through-two-points @@ -0,0 +1 @@ +../../Task/Circles-of-given-radius-through-two-points/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Closest-pair-problem b/Lang/ZX-Spectrum-Basic/Closest-pair-problem new file mode 120000 index 0000000000..bcfebdb28c --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Closest-pair-problem @@ -0,0 +1 @@ +../../Task/Closest-pair-problem/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Combinations-with-repetitions b/Lang/ZX-Spectrum-Basic/Combinations-with-repetitions new file mode 120000 index 0000000000..10778cf1a6 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Combinations-with-repetitions @@ -0,0 +1 @@ +../../Task/Combinations-with-repetitions/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Comma-quibbling b/Lang/ZX-Spectrum-Basic/Comma-quibbling new file mode 120000 index 0000000000..06ff688648 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Comma-quibbling @@ -0,0 +1 @@ +../../Task/Comma-quibbling/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Constrained-random-points-on-a-circle b/Lang/ZX-Spectrum-Basic/Constrained-random-points-on-a-circle new file mode 120000 index 0000000000..21143b160e --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Constrained-random-points-on-a-circle @@ -0,0 +1 @@ +../../Task/Constrained-random-points-on-a-circle/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Continued-fraction b/Lang/ZX-Spectrum-Basic/Continued-fraction new file mode 120000 index 0000000000..f9f2fa1c31 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Continued-fraction @@ -0,0 +1 @@ +../../Task/Continued-fraction/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Conways-Game-of-Life b/Lang/ZX-Spectrum-Basic/Conways-Game-of-Life new file mode 120000 index 0000000000..a062883d2f --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Conways-Game-of-Life @@ -0,0 +1 @@ +../../Task/Conways-Game-of-Life/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Count-in-factors b/Lang/ZX-Spectrum-Basic/Count-in-factors new file mode 120000 index 0000000000..f807df3ee9 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Count-in-factors @@ -0,0 +1 @@ +../../Task/Count-in-factors/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Count-in-octal b/Lang/ZX-Spectrum-Basic/Count-in-octal new file mode 120000 index 0000000000..7eeda86012 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Count-in-octal @@ -0,0 +1 @@ +../../Task/Count-in-octal/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Count-occurrences-of-a-substring b/Lang/ZX-Spectrum-Basic/Count-occurrences-of-a-substring new file mode 120000 index 0000000000..870eda378d --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Count-occurrences-of-a-substring @@ -0,0 +1 @@ +../../Task/Count-occurrences-of-a-substring/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Count-the-coins b/Lang/ZX-Spectrum-Basic/Count-the-coins new file mode 120000 index 0000000000..3d8b39671b --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Count-the-coins @@ -0,0 +1 @@ +../../Task/Count-the-coins/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Day-of-the-week b/Lang/ZX-Spectrum-Basic/Day-of-the-week new file mode 120000 index 0000000000..69a01b0ee2 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Day-of-the-week @@ -0,0 +1 @@ +../../Task/Day-of-the-week/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Digital-root b/Lang/ZX-Spectrum-Basic/Digital-root new file mode 120000 index 0000000000..89029c1fa3 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Digital-root @@ -0,0 +1 @@ +../../Task/Digital-root/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Dinesmans-multiple-dwelling-problem b/Lang/ZX-Spectrum-Basic/Dinesmans-multiple-dwelling-problem new file mode 120000 index 0000000000..1f40978aa8 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Dinesmans-multiple-dwelling-problem @@ -0,0 +1 @@ +../../Task/Dinesmans-multiple-dwelling-problem/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Dot-product b/Lang/ZX-Spectrum-Basic/Dot-product new file mode 120000 index 0000000000..47242a9d0e --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Dot-product @@ -0,0 +1 @@ +../../Task/Dot-product/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Dragon-curve b/Lang/ZX-Spectrum-Basic/Dragon-curve new file mode 120000 index 0000000000..1d9285585f --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Dragon-curve @@ -0,0 +1 @@ +../../Task/Dragon-curve/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Draw-a-cuboid b/Lang/ZX-Spectrum-Basic/Draw-a-cuboid new file mode 120000 index 0000000000..7376c7f429 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Draw-a-cuboid @@ -0,0 +1 @@ +../../Task/Draw-a-cuboid/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Draw-a-sphere b/Lang/ZX-Spectrum-Basic/Draw-a-sphere new file mode 120000 index 0000000000..fd3f93c9f4 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Draw-a-sphere @@ -0,0 +1 @@ +../../Task/Draw-a-sphere/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Dutch-national-flag-problem b/Lang/ZX-Spectrum-Basic/Dutch-national-flag-problem new file mode 120000 index 0000000000..b1c6403067 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Dutch-national-flag-problem @@ -0,0 +1 @@ +../../Task/Dutch-national-flag-problem/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Entropy b/Lang/ZX-Spectrum-Basic/Entropy new file mode 120000 index 0000000000..dafb212b38 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Entropy @@ -0,0 +1 @@ +../../Task/Entropy/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Equilibrium-index b/Lang/ZX-Spectrum-Basic/Equilibrium-index new file mode 120000 index 0000000000..1778b05d2e --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Equilibrium-index @@ -0,0 +1 @@ +../../Task/Equilibrium-index/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Ethiopian-multiplication b/Lang/ZX-Spectrum-Basic/Ethiopian-multiplication new file mode 120000 index 0000000000..c76da97edf --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Ethiopian-multiplication @@ -0,0 +1 @@ +../../Task/Ethiopian-multiplication/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Euler-method b/Lang/ZX-Spectrum-Basic/Euler-method new file mode 120000 index 0000000000..89e8f8b07b --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Euler-method @@ -0,0 +1 @@ +../../Task/Euler-method/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Evaluate-binomial-coefficients b/Lang/ZX-Spectrum-Basic/Evaluate-binomial-coefficients new file mode 120000 index 0000000000..02f55582bf --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Evaluate-binomial-coefficients @@ -0,0 +1 @@ +../../Task/Evaluate-binomial-coefficients/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Even-or-odd b/Lang/ZX-Spectrum-Basic/Even-or-odd new file mode 120000 index 0000000000..9b5ca50cce --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Even-or-odd @@ -0,0 +1 @@ +../../Task/Even-or-odd/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Factors-of-an-integer b/Lang/ZX-Spectrum-Basic/Factors-of-an-integer new file mode 120000 index 0000000000..27cc94a39d --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Factors-of-an-integer @@ -0,0 +1 @@ +../../Task/Factors-of-an-integer/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Fibonacci-sequence b/Lang/ZX-Spectrum-Basic/Fibonacci-sequence new file mode 120000 index 0000000000..bf7cdcd64d --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Fibonacci-sequence @@ -0,0 +1 @@ +../../Task/Fibonacci-sequence/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Fibonacci-word b/Lang/ZX-Spectrum-Basic/Fibonacci-word new file mode 120000 index 0000000000..478faa1caf --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Fibonacci-word @@ -0,0 +1 @@ +../../Task/Fibonacci-word/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Filter b/Lang/ZX-Spectrum-Basic/Filter new file mode 120000 index 0000000000..300015287b --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Filter @@ -0,0 +1 @@ +../../Task/Filter/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Find-the-missing-permutation b/Lang/ZX-Spectrum-Basic/Find-the-missing-permutation new file mode 120000 index 0000000000..c28b2c4980 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Find-the-missing-permutation @@ -0,0 +1 @@ +../../Task/Find-the-missing-permutation/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/FizzBuzz b/Lang/ZX-Spectrum-Basic/FizzBuzz new file mode 120000 index 0000000000..6463f923ed --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/FizzBuzz @@ -0,0 +1 @@ +../../Task/FizzBuzz/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Flatten-a-list b/Lang/ZX-Spectrum-Basic/Flatten-a-list new file mode 120000 index 0000000000..27d8ed3a73 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Flatten-a-list @@ -0,0 +1 @@ +../../Task/Flatten-a-list/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Floyds-triangle b/Lang/ZX-Spectrum-Basic/Floyds-triangle new file mode 120000 index 0000000000..e9609c33a2 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Floyds-triangle @@ -0,0 +1 @@ +../../Task/Floyds-triangle/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Formatted-numeric-output b/Lang/ZX-Spectrum-Basic/Formatted-numeric-output new file mode 120000 index 0000000000..de30e20b09 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Formatted-numeric-output @@ -0,0 +1 @@ +../../Task/Formatted-numeric-output/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Forward-difference b/Lang/ZX-Spectrum-Basic/Forward-difference new file mode 120000 index 0000000000..50bdabbd03 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Forward-difference @@ -0,0 +1 @@ +../../Task/Forward-difference/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Fractal-tree b/Lang/ZX-Spectrum-Basic/Fractal-tree new file mode 120000 index 0000000000..12a6accc2b --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Fractal-tree @@ -0,0 +1 @@ +../../Task/Fractal-tree/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Generate-lower-case-ASCII-alphabet b/Lang/ZX-Spectrum-Basic/Generate-lower-case-ASCII-alphabet new file mode 120000 index 0000000000..dd6309b8a5 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Generate-lower-case-ASCII-alphabet @@ -0,0 +1 @@ +../../Task/Generate-lower-case-ASCII-alphabet/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Greatest-common-divisor b/Lang/ZX-Spectrum-Basic/Greatest-common-divisor new file mode 120000 index 0000000000..20532ea3dc --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Greatest-common-divisor @@ -0,0 +1 @@ +../../Task/Greatest-common-divisor/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Greatest-element-of-a-list b/Lang/ZX-Spectrum-Basic/Greatest-element-of-a-list new file mode 120000 index 0000000000..b00179fd55 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Greatest-element-of-a-list @@ -0,0 +1 @@ +../../Task/Greatest-element-of-a-list/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Greatest-subsequential-sum b/Lang/ZX-Spectrum-Basic/Greatest-subsequential-sum new file mode 120000 index 0000000000..2c3f6c3f10 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Greatest-subsequential-sum @@ -0,0 +1 @@ +../../Task/Greatest-subsequential-sum/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Guess-the-number-With-feedback b/Lang/ZX-Spectrum-Basic/Guess-the-number-With-feedback new file mode 120000 index 0000000000..56265756ae --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Guess-the-number-With-feedback @@ -0,0 +1 @@ +../../Task/Guess-the-number-With-feedback/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Guess-the-number-With-feedback--player- b/Lang/ZX-Spectrum-Basic/Guess-the-number-With-feedback--player- new file mode 120000 index 0000000000..5aeabfa666 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Guess-the-number-With-feedback--player- @@ -0,0 +1 @@ +../../Task/Guess-the-number-With-feedback--player-/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Hailstone-sequence b/Lang/ZX-Spectrum-Basic/Hailstone-sequence new file mode 120000 index 0000000000..62fea84b7a --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Hailstone-sequence @@ -0,0 +1 @@ +../../Task/Hailstone-sequence/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Hamming-numbers b/Lang/ZX-Spectrum-Basic/Hamming-numbers new file mode 120000 index 0000000000..615cb4a123 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Hamming-numbers @@ -0,0 +1 @@ +../../Task/Hamming-numbers/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Happy-numbers b/Lang/ZX-Spectrum-Basic/Happy-numbers new file mode 120000 index 0000000000..9e912a12b9 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Happy-numbers @@ -0,0 +1 @@ +../../Task/Happy-numbers/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Harshad-or-Niven-series b/Lang/ZX-Spectrum-Basic/Harshad-or-Niven-series new file mode 120000 index 0000000000..dfa4d2a8f4 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Harshad-or-Niven-series @@ -0,0 +1 @@ +../../Task/Harshad-or-Niven-series/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Haversine-formula b/Lang/ZX-Spectrum-Basic/Haversine-formula new file mode 120000 index 0000000000..a4672ea5eb --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Haversine-formula @@ -0,0 +1 @@ +../../Task/Haversine-formula/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Higher-order-functions b/Lang/ZX-Spectrum-Basic/Higher-order-functions new file mode 120000 index 0000000000..945d3e3c37 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Higher-order-functions @@ -0,0 +1 @@ +../../Task/Higher-order-functions/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Hofstadter-Conway-$10,000-sequence b/Lang/ZX-Spectrum-Basic/Hofstadter-Conway-$10,000-sequence new file mode 120000 index 0000000000..934453b118 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Hofstadter-Conway-$10,000-sequence @@ -0,0 +1 @@ +../../Task/Hofstadter-Conway-$10,000-sequence/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Hofstadter-Q-sequence b/Lang/ZX-Spectrum-Basic/Hofstadter-Q-sequence new file mode 120000 index 0000000000..681be02d80 --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Hofstadter-Q-sequence @@ -0,0 +1 @@ +../../Task/Hofstadter-Q-sequence/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Horizontal-sundial-calculations b/Lang/ZX-Spectrum-Basic/Horizontal-sundial-calculations new file mode 120000 index 0000000000..df84be983c --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Horizontal-sundial-calculations @@ -0,0 +1 @@ +../../Task/Horizontal-sundial-calculations/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Lang/ZX-Spectrum-Basic/Pythagorean-triples b/Lang/ZX-Spectrum-Basic/Pythagorean-triples new file mode 120000 index 0000000000..fe68243fbc --- /dev/null +++ b/Lang/ZX-Spectrum-Basic/Pythagorean-triples @@ -0,0 +1 @@ +../../Task/Pythagorean-triples/ZX-Spectrum-Basic \ No newline at end of file diff --git a/Task/100-doors/00DESCRIPTION b/Task/100-doors/00DESCRIPTION index 163a84b285..1db5397c00 100644 --- a/Task/100-doors/00DESCRIPTION +++ b/Task/100-doors/00DESCRIPTION @@ -1,11 +1,21 @@ -Problem: You have 100 doors in a row that are all initially closed. -You make 100 [[task feature::Rosetta Code:multiple passes|passes]] by the doors. -The first time through, you visit every door and toggle the door (if the door is closed, you open it; if it is open, you close it). The second time you only visit every 2nd door (door #2, #4, #6, ...). -The third time, every 3rd door (door #3, #6, #9, ...), etc, until you only visit the 100th door. +There are 100 doors in a row that are all initially closed. + +You make 100 [[task feature::Rosetta Code:multiple passes|passes]] by the doors. + +The first time through, visit every door and   ''toggle''   the door   (if the door is closed,   open it;   if it is open,   close it). + +The second time, only visit every 2nd door   (door #2, #4, #6, ...),   and toggle it. + +The third time, visit every 3rd door   (door #3, #6, #9, ...), etc,   until you only visit the 100th door. + + +;Task: +Answer the question:   what state are the doors in after the last pass?   Which are open, which are closed? -Question: What state are the doors in after the last pass? Which are open, which are closed? '''[[task feature::Rosetta Code:extra credit|Alternate]]:''' -As noted in this page's [[Talk:100 doors|discussion page]], the only doors that remain open are whose numbers are perfect squares of integers. -Opening only those doors is an [[task feature::Rosetta Code:optimization|optimization]] that may also be expressed; +As noted in this page's   [[Talk:100 doors|discussion page]],   the only doors that remain open are those whose numbers are perfect squares. + +Opening only those doors is an   [[task feature::Rosetta Code:optimization|optimization]]   that may also be expressed; however, as should be obvious, this defeats the intent of comparing implementations across programming languages. +

diff --git a/Task/100-doors/Agena/100-doors.agena b/Task/100-doors/Agena/100-doors.agena new file mode 100644 index 0000000000..18c9cb1963 --- /dev/null +++ b/Task/100-doors/Agena/100-doors.agena @@ -0,0 +1,19 @@ +# find the first few squares via the unoptimised door flipping method +scope + + local doorMax := 100; + local door; + create register door( doorMax ); + + # set all doors to closed + for i to doorMax do door[ i ] := false od; + + # repeatedly flip the doors + for i to doorMax do + for j from i to doorMax by i do door[ j ] := not door[ j ] od + od; + + # display the results + for i to doorMax do if door[ i ] then write( " ", i ) fi od; print() + +epocs diff --git a/Task/100-doors/AppleScript/100-doors.applescript b/Task/100-doors/AppleScript/100-doors-1.applescript similarity index 100% rename from Task/100-doors/AppleScript/100-doors.applescript rename to Task/100-doors/AppleScript/100-doors-1.applescript diff --git a/Task/100-doors/AppleScript/100-doors-2.applescript b/Task/100-doors/AppleScript/100-doors-2.applescript new file mode 100644 index 0000000000..382a73ed29 --- /dev/null +++ b/Task/100-doors/AppleScript/100-doors-2.applescript @@ -0,0 +1,149 @@ +-- finalDoors :: Int -> [(Int, Bool)] +on finalDoors(n) + + -- toggledCorridor :: [(Int, Bool)] -> (Int, Bool) -> Int -> [(Int, Bool)] + script toggledCorridor + on lambda(a, _, k) + + -- perhapsToggled :: Bool -> Int -> Bool + script perhapsToggled + on lambda(x, i) + if i mod k = 0 then + {i, not item 2 of x} + else + {i, item 2 of x} + end if + end lambda + end script + + map(perhapsToggled, a) + end lambda + end script + + set lstRange to range(1, n) + + foldl(toggledCorridor, ¬ + zip(lstRange, replicate(n, {false})), lstRange) +end finalDoors + +-- TEST +on run + -- isOpenAtEnd :: (Int, Bool) -> Bool + script isOpenAtEnd + on lambda(door) + (item 2 of door) + end lambda + end script + + -- doorNumber :: (Int, Bool) -> Int + script doorNumber + on lambda(door) + (item 1 of door) + end lambda + end script + + map(doorNumber, filter(isOpenAtEnd, finalDoors(100))) + + --> {1, 4, 9, 16, 25, 36, 49, 64, 81, 100} +end run + + + +-- GENERIC FUNCTIONS + +-- 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 + +-- 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 + +-- 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 + +-- zip :: [a] -> [b] -> [(a, b)] +on zip(xs, ys) + script pair + on lambda(x, i) + [x, item i of ys] + end lambda + end script + + if length of xs = length of ys then + map(pair, xs) + else + missing value + end if +end zip + +-- Egyptian multiplication - progressively doubling a list, appending +-- stages of doubling to an accumulator where needed for binary +-- assembly of a target length + +-- replicate :: Int -> a -> [a] +on replicate(n, a) + if class of a is list then + set out to {} + else + set out to "" + end if + if n < 1 then return out + set dbl to a + + repeat while (n > 1) + if (n mod 2) > 0 then set out to out & dbl + set n to (n div 2) + set dbl to (dbl & dbl) + end repeat + return out & dbl +end replicate + +-- range :: Int -> Int -> [Int] +on range(m, n) + set d to 1 + if n < m then set d to -1 + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range + +-- 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 diff --git a/Task/100-doors/AppleScript/100-doors-3.applescript b/Task/100-doors/AppleScript/100-doors-3.applescript new file mode 100644 index 0000000000..831ceff834 --- /dev/null +++ b/Task/100-doors/AppleScript/100-doors-3.applescript @@ -0,0 +1 @@ +{1, 4, 9, 16, 25, 36, 49, 64, 81, 100} diff --git a/Task/100-doors/AppleScript/100-doors-4.applescript b/Task/100-doors/AppleScript/100-doors-4.applescript new file mode 100644 index 0000000000..efe91e4d16 --- /dev/null +++ b/Task/100-doors/AppleScript/100-doors-4.applescript @@ -0,0 +1,5 @@ +map(factorCountMod2, range(1, 100)) + +on factorCountMod2(n) + {n, (length of integerFactors(n)) mod 2 = 1} +end factorCountMod2 diff --git a/Task/100-doors/AppleScript/100-doors-5.applescript b/Task/100-doors/AppleScript/100-doors-5.applescript new file mode 100644 index 0000000000..a0f2e17b5d --- /dev/null +++ b/Task/100-doors/AppleScript/100-doors-5.applescript @@ -0,0 +1,21 @@ +-- perfectSquaresUpTo :: Int -> [Int] +on perfectSquaresUpTo(n) + script squared + -- (Int -> Int) + on lambda(x) + x * x + end lambda + end script + + set realRoot to n ^ (1 / 2) + set intRoot to realRoot as integer + set blnNotPerfectSquare to not (intRoot = realRoot) + + map(squared, range(1, intRoot - (blnNotPerfectSquare as integer))) +end perfectSquaresUpTo + +on run + + perfectSquaresUpTo(100) + +end run diff --git a/Task/100-doors/AppleScript/100-doors-6.applescript b/Task/100-doors/AppleScript/100-doors-6.applescript new file mode 100644 index 0000000000..831ceff834 --- /dev/null +++ b/Task/100-doors/AppleScript/100-doors-6.applescript @@ -0,0 +1 @@ +{1, 4, 9, 16, 25, 36, 49, 64, 81, 100} diff --git a/Task/100-doors/Clojure/100-doors-3.clj b/Task/100-doors/Clojure/100-doors-3.clj index 63f5be1883..89d7d3d6fe 100644 --- a/Task/100-doors/Clojure/100-doors-3.clj +++ b/Task/100-doors/Clojure/100-doors-3.clj @@ -2,7 +2,7 @@ (->> (for [step (range 1 101), occ (range step 101 step)] occ) frequencies (filter (comp odd? val)) - (map first) + keys sort)) (defn print-open-doors [] diff --git a/Task/100-doors/DWScript/100-doors.dw b/Task/100-doors/DWScript/100-doors.dw index f55e6a854b..561644985e 100644 --- a/Task/100-doors/DWScript/100-doors.dw +++ b/Task/100-doors/DWScript/100-doors.dw @@ -4,7 +4,7 @@ var i, j : Integer; for i := 1 to 100 do for j := i to 100 do if (j mod i) = 0 then - doors[j] := not doors[j]; + doors[j] := not doors[j];F for i := 1 to 100 do if doors[i] then diff --git a/Task/100-doors/Elena/100-doors.elena b/Task/100-doors/Elena/100-doors.elena index 9affe761fe..5fc7093148 100644 --- a/Task/100-doors/Elena/100-doors.elena +++ b/Task/100-doors/Elena/100-doors.elena @@ -1,6 +1,6 @@ -#define system. -#define system'routines. -#define extensions. +#import system. +#import system'routines. +#import extensions. #symbol program= [ diff --git a/Task/100-doors/Factor/100-doors-1.factor b/Task/100-doors/Factor/100-doors-1.factor index 6dccd9b759..e9eb7b4c70 100644 --- a/Task/100-doors/Factor/100-doors-1.factor +++ b/Task/100-doors/Factor/100-doors-1.factor @@ -21,3 +21,5 @@ CONSTANT: number-of-doors 100 : main ( -- ) number-of-doors 1 + [ toggle-all-multiples ] [ print-doors ] bi ; + +main diff --git a/Task/100-doors/Fortran/100-doors-1.f b/Task/100-doors/Fortran/100-doors-1.f index e0d194e1ff..b2d4d6c38c 100644 --- a/Task/100-doors/Fortran/100-doors-1.f +++ b/Task/100-doors/Fortran/100-doors-1.f @@ -1,22 +1,15 @@ -PROGRAM DOORS +program doors + implicit none + integer, allocatable :: door(:) + character(6), parameter :: s(0:1) = ["closed", "open "] + integer :: i, n - INTEGER, PARAMETER :: n = 100 ! Number of doors - INTEGER :: i, j - LOGICAL :: door(n) = .TRUE. ! Initially closed - - DO i = 1, n - DO j = i, n, i - door(j) = .NOT. door(j) - END DO - END DO - - DO i = 1, n - WRITE(*,"(A,I3,A)", ADVANCE="NO") "Door ", i, " is " - IF (door(i)) THEN - WRITE(*,"(A)") "closed" - ELSE - WRITE(*,"(A)") "open" - END IF - END DO - -END PROGRAM DOORS + print "(A)", "Number of doors?" + read *, n + allocate (door(n)) + door = 1 + do i = 1, n + door(i:n:i) = 1 - door(i:n:i) + print "(A,G0,2A)", "door ", i, " is ", s(door(i)) + end do +end program diff --git a/Task/100-doors/Java/100-doors-1.java b/Task/100-doors/Java/100-doors-1.java index e215518087..df5e0aee5c 100644 --- a/Task/100-doors/Java/100-doors-1.java +++ b/Task/100-doors/Java/100-doors-1.java @@ -1,13 +1 @@ -public class HundredDoors { - public static void main(String[] args) { - boolean[] doors = new boolean[101]; - for (int i = 1; i <= 100; i++) { - for (int j = i; j <= 100; j++) { - if(j % i == 0) doors[j] = !doors[j]; - } - } - for (int i = 1; i <= 100; i++) { - System.out.printf("Door %d: %s%n", i, doors[i] ? "open" : "closed"); - } - } -} +N.println(IntStream.rangeClosed(1, 100).filter(i -> Math.pow((int) Math.sqrt(i), 2) == i).boxed().join(", ", "Open Doors: ", "")); diff --git a/Task/100-doors/Java/100-doors-2.java b/Task/100-doors/Java/100-doors-2.java index fbc73e7d13..e215518087 100644 --- a/Task/100-doors/Java/100-doors-2.java +++ b/Task/100-doors/Java/100-doors-2.java @@ -1,11 +1,13 @@ -public class Doors -{ - public static void main(String[] args) - { - boolean[] doors=new boolean[100]; - for(int i=0;i<10;i++) - doors[i*(i+2)]=true; - for(int i=0;i<100;i++) - System.out.println("Door #"+(i+1)+" is"+(doors[i]?"open.":" closed.")); - } +public class HundredDoors { + public static void main(String[] args) { + boolean[] doors = new boolean[101]; + for (int i = 1; i <= 100; i++) { + for (int j = i; j <= 100; j++) { + if(j % i == 0) doors[j] = !doors[j]; + } + } + for (int i = 1; i <= 100; i++) { + System.out.printf("Door %d: %s%n", i, doors[i] ? "open" : "closed"); + } + } } diff --git a/Task/100-doors/Java/100-doors-3.java b/Task/100-doors/Java/100-doors-3.java index 7722346acf..fbc73e7d13 100644 --- a/Task/100-doors/Java/100-doors-3.java +++ b/Task/100-doors/Java/100-doors-3.java @@ -2,7 +2,10 @@ public class Doors { public static void main(String[] args) { + boolean[] doors=new boolean[100]; for(int i=0;i<10;i++) - System.out.println("Door #"+(i*(i+2)+1)+" is open."); + doors[i*(i+2)]=true; + for(int i=0;i<100;i++) + System.out.println("Door #"+(i+1)+" is"+(doors[i]?"open.":" closed.")); } } diff --git a/Task/100-doors/Java/100-doors-4.java b/Task/100-doors/Java/100-doors-4.java index 318cd39a24..7722346acf 100644 --- a/Task/100-doors/Java/100-doors-4.java +++ b/Task/100-doors/Java/100-doors-4.java @@ -1,13 +1,8 @@ public class Doors { - public static void main(final String[] args) - { - boolean[] doors = new boolean[100]; - - for (int pass = 0; pass < 10; pass++) - doors[(pass + 1) * (pass + 1) - 1] = true; - - for(int i = 0; i < 100; i++) - System.out.println("Door #" + (i + 1) + " is " + (doors[i] ? "open." : "closed.")); - } + public static void main(String[] args) + { + for(int i=0;i<10;i++) + System.out.println("Door #"+(i*(i+2)+1)+" is open."); + } } diff --git a/Task/100-doors/Java/100-doors-5.java b/Task/100-doors/Java/100-doors-5.java index 2d89ca9dc4..318cd39a24 100644 --- a/Task/100-doors/Java/100-doors-5.java +++ b/Task/100-doors/Java/100-doors-5.java @@ -2,11 +2,12 @@ public class Doors { public static void main(final String[] args) { - StringBuilder sb = new StringBuilder(); + boolean[] doors = new boolean[100]; - for (int i = 1; i <= 10; i++) - sb.append("Door #").append(i*i).append(" is open\n"); + for (int pass = 0; pass < 10; pass++) + doors[(pass + 1) * (pass + 1) - 1] = true; - System.out.println(sb.toString()); + for(int i = 0; i < 100; i++) + System.out.println("Door #" + (i + 1) + " is " + (doors[i] ? "open." : "closed.")); } } diff --git a/Task/100-doors/Java/100-doors-6.java b/Task/100-doors/Java/100-doors-6.java index 4d4b8e884c..2d89ca9dc4 100644 --- a/Task/100-doors/Java/100-doors-6.java +++ b/Task/100-doors/Java/100-doors-6.java @@ -1,13 +1,12 @@ -public class Doors{ - public static void main(String[] args){ - int i; - for(i = 1; i < 101; i++){ - double sqrt = Math.sqrt(i); - if(sqrt != (int)sqrt){ - System.out.println("Door " + i + " is closed"); - }else{ - System.out.println("Door " + i + " is open"); - } - } - } +public class Doors +{ + public static void main(final String[] args) + { + StringBuilder sb = new StringBuilder(); + + for (int i = 1; i <= 10; i++) + sb.append("Door #").append(i*i).append(" is open\n"); + + System.out.println(sb.toString()); + } } diff --git a/Task/100-doors/Java/100-doors-7.java b/Task/100-doors/Java/100-doors-7.java new file mode 100644 index 0000000000..4d4b8e884c --- /dev/null +++ b/Task/100-doors/Java/100-doors-7.java @@ -0,0 +1,13 @@ +public class Doors{ + public static void main(String[] args){ + int i; + for(i = 1; i < 101; i++){ + double sqrt = Math.sqrt(i); + if(sqrt != (int)sqrt){ + System.out.println("Door " + i + " is closed"); + }else{ + System.out.println("Door " + i + " is open"); + } + } + } +} diff --git a/Task/100-doors/JavaScript/100-doors-10.js b/Task/100-doors/JavaScript/100-doors-10.js index 82bffcfb20..7378d4bae5 100644 --- a/Task/100-doors/JavaScript/100-doors-10.js +++ b/Task/100-doors/JavaScript/100-doors-10.js @@ -1,14 +1,9 @@ -(function () { +// Array comprehension style +[ for (i of Array.apply(null, { length: 100 })) i ].forEach((_, i) => { + var door = i + 1 + var sqrt = Math.sqrt(door); - return rng(1, Math.sqrt(100)).map(function (x) { - return x * x; - }); - - // rng(1, 20) --> [1..20] - function rng(m, n) { - return Array.apply(null, Array(n - m + 1)).map(function (x, i) { - return m + i; - }); + if (sqrt === (sqrt | 0)) { + console.log("Door %d is open", door); } - -})(); +}); diff --git a/Task/100-doors/JavaScript/100-doors-11.js b/Task/100-doors/JavaScript/100-doors-11.js index 162c896db8..c2190391c8 100644 --- a/Task/100-doors/JavaScript/100-doors-11.js +++ b/Task/100-doors/JavaScript/100-doors-11.js @@ -1 +1,29 @@ -[1, 4, 9, 16, 25, 36, 49, 64, 81, 100] +(function (n) { + + + // ONLY PERFECT SQUARES HAVE AN ODD NUMBER OF INTEGER FACTORS + // (Leaving the door open at the end of the process) + + return perfectSquaresUpTo(n); + + + // perfectSquaresUpTo :: Int -> [Int] + function perfectSquaresUpTo(n) { + return range(1, Math.floor(Math.sqrt(n))) + .map(x => x * x); + } + + + // GENERIC + + // range(intFrom, intTo, optional intStep) + // Int -> Int -> Maybe Int -> [Int] + function range(m, n, step) { + let d = (step || 1) * (n >= m ? 1 : -1); + + return Array.from({ + length: Math.floor((n - m) / d) + 1 + }, (_, i) => m + (i * d)); + } + +})(100); diff --git a/Task/100-doors/JavaScript/100-doors-12.js b/Task/100-doors/JavaScript/100-doors-12.js index 2e3d824574..162c896db8 100644 --- a/Task/100-doors/JavaScript/100-doors-12.js +++ b/Task/100-doors/JavaScript/100-doors-12.js @@ -1,9 +1 @@ -Array.apply(null, { length: 100 }) - .map((v, i) => i + 1) - .forEach(door => { - var sqrt = Math.sqrt(door); - - if (sqrt === (sqrt | 0)) { - console.log("Door %d is open", door); - } - }); +[1, 4, 9, 16, 25, 36, 49, 64, 81, 100] diff --git a/Task/100-doors/JavaScript/100-doors-2.js b/Task/100-doors/JavaScript/100-doors-2.js index bd5c2b1146..589024f58d 100644 --- a/Task/100-doors/JavaScript/100-doors-2.js +++ b/Task/100-doors/JavaScript/100-doors-2.js @@ -1,41 +1,80 @@ -(function () { - return chain( +(function (n) { + 'use strict'; - // 100 passes ... - rng(0, 99).reduce(function (a, _, i) { - return a.slice(0, i).concat( - a.slice(i).map(function (v, j) { - return (i + j + 1) % (i + 1) ? v : { - door: v.door, - open: !v.open - }; - }) - ) - }, - // 100 closed doors at start - Array.apply(null, Array(100)).map(function (x, i) { - return { - open: false, - door: i + 1 - }; - })), + // finalDoors :: Int -> [(Int, Bool)] + function finalDoors(n) { + var lstRange = range(1, n); - // Filtering by chained function - function (door) { - return door.open ? [door] : []; + return lstRange + .reduce(function (a, _, k) { + var m = k + 1; + + return a.map(function (x, i) { + var j = i + 1; + + return [j, j % m ? x[1] : !x[1]]; + }); + }, zip( + lstRange, + replicate(n, false) + )); + }; + + + + // GENERIC FUNCTIONS + + // zip :: [a] -> [b] -> [(a,b)] + function zip(xs, ys) { + return xs.length === ys.length ? ( + xs.map(function (x, i) { + return [x, ys[i]]; + }) + ) : undefined; } - ) - // Monadic bind (chain) for lists - function chain(xs, f) { - return [].concat.apply([], xs.map(f)); - } + // replicate :: Int -> a -> [a] + function replicate(n, a) { + var v = [a], + o = []; - // range(1, 20) --> [1..20] - function rng(m, n) { - return Array.apply(null, Array(n - m + 1)).map(function (x, i) { - return m + i; - }); - } -})(); + if (n < 1) return o; + while (n > 1) { + if (n & 1) o = o.concat(v); + n >>= 1; + v = v.concat(v); + } + return o.concat(v); + } + + // range(intFrom, intTo, optional intStep) + // Int -> Int -> Maybe Int -> [Int] + function range(m, n, delta) { + var d = delta || 1, + blnUp = n > m, + lng = Math.floor((blnUp ? n - m : m - n) / d) + 1, + a = Array(lng), + i = lng; + + if (blnUp) + while (i--) a[i] = (d * i) + m; + else + while (i--) a[i] = m - (d * i); + + return a; + } + + + return finalDoors(n) + .filter(function (tuple) { + return tuple[1]; + }) + .map(function (tuple) { + return { + door: tuple[0], + open: tuple[1] + }; + }); + +})(100); diff --git a/Task/100-doors/JavaScript/100-doors-6.js b/Task/100-doors/JavaScript/100-doors-6.js index 7a4f61260e..a541d6e13c 100644 --- a/Task/100-doors/JavaScript/100-doors-6.js +++ b/Task/100-doors/JavaScript/100-doors-6.js @@ -1,9 +1,44 @@ -Array.apply(null, { length: 100 }) - .map(function(v, i) { return i + 1; }) - .forEach(function(door) { - var sqrt = Math.sqrt(door); +(function (n) { + 'use strict'; - if (sqrt === (sqrt | 0)) { - console.log("Door %d is open", door); - } - }); + return range(1, 100) + .filter(function (x) { + return integerFactors(x) + .length % 2; + }); + + function integerFactors(n) { + var rRoot = Math.sqrt(n), + intRoot = Math.floor(rRoot), + + lows = range(1, intRoot) + .filter(function (x) { + return (n % x) === 0; + }); + + // for perfect squares, we can drop the head of the 'highs' list + return lows.concat(lows.map(function (x) { + return n / x; + }) + .reverse() + .slice((rRoot === intRoot) | 0)); + } + + // range(intFrom, intTo, optional intStep) + // Int -> Int -> Maybe Int -> [Int] + function range(m, n, delta) { + var d = delta || 1, + blnUp = n > m, + lng = Math.floor((blnUp ? n - m : m - n) / d) + 1, + a = Array(lng), + i = lng; + + if (blnUp) + while (i--) a[i] = (d * i) + m; + else + while (i--) a[i] = m - (d * i); + + return a; + } + +})(100); diff --git a/Task/100-doors/JavaScript/100-doors-7.js b/Task/100-doors/JavaScript/100-doors-7.js index 69f398813c..0a165455b3 100644 --- a/Task/100-doors/JavaScript/100-doors-7.js +++ b/Task/100-doors/JavaScript/100-doors-7.js @@ -1,34 +1,31 @@ -(function () { - return chain( +(function (n) { + 'use strict'; - rng(1, 100), + return perfectSquaresUpTo(100); - function (x) { - var root = Math.sqrt(x); - - return root === Math.floor(root) ? inject(x) : fail(); + function perfectSquaresUpTo(n) { + return range(1, Math.floor(Math.sqrt(n))) + .map(function (x) { + return x * x; + }); } - ); + // GENERIC - /*************************************************************/ + // range(intFrom, intTo, optional intStep) + // Int -> Int -> Maybe Int -> [Int] + function range(m, n, delta) { + var d = delta || 1, + blnUp = n > m, + lng = Math.floor((blnUp ? n - m : m - n) / d) + 1, + a = Array(lng), + i = lng; - // monadic Bind/chain for lists - function chain(xs, f) { - return [].concat.apply([], xs.map(f)); - } + if (blnUp) + while (i--) a[i] = (d * i) + m; + else + while (i--) a[i] = m - (d * i); + return a; + } - // monadic Return/inject for lists - function inject(x) { return [x]; } - - // monadic Fail for lists - function fail() { return []; } - - // rng(1, 20) --> [1..20] - function rng(m, n) { - return Array.apply(null, Array(n - m + 1)).map(function (x, i) { - return m + i; - }); - } - -})(); +})(100); diff --git a/Task/100-doors/JavaScript/100-doors-9.js b/Task/100-doors/JavaScript/100-doors-9.js index d963e627fd..2e3d824574 100644 --- a/Task/100-doors/JavaScript/100-doors-9.js +++ b/Task/100-doors/JavaScript/100-doors-9.js @@ -1,18 +1,9 @@ -(function () { +Array.apply(null, { length: 100 }) + .map((v, i) => i + 1) + .forEach(door => { + var sqrt = Math.sqrt(door); - return rng(1, 100).filter( - function (x) { - var root = Math.sqrt(x); - - return root === Math.floor(root); - } - ); - - // rng(1, 20) --> [1..20] - function rng(m, n) { - return Array.apply(null, Array(n - m + 1)).map(function (x, i) { - return m + i; + if (sqrt === (sqrt | 0)) { + console.log("Door %d is open", door); + } }); - } - -})(); diff --git a/Task/100-doors/Kotlin/100-doors.kotlin b/Task/100-doors/Kotlin/100-doors.kotlin index 8055e822a6..a7a693598e 100644 --- a/Task/100-doors/Kotlin/100-doors.kotlin +++ b/Task/100-doors/Kotlin/100-doors.kotlin @@ -1,11 +1,10 @@ fun oneHundredDoors(): List { - val doors = Array(100, { false }) + val doors = BooleanArray(100, { false }) for (i in 0..99) for (j in i..99 step (i + 1)) doors[j] = !doors[j] - return IndexIterator(doors.iterator()).filter { it.second } - .map { it.first + 1 } - .toList() + return doors.asSequence().mapIndexed { i, b -> i to b }.filter { it.second } + .map { it.first + 1 }.toList() } diff --git a/Task/100-doors/Lua/100-doors.lua b/Task/100-doors/Lua/100-doors.lua index c8c0b476a3..3183bc7730 100644 --- a/Task/100-doors/Lua/100-doors.lua +++ b/Task/100-doors/Lua/100-doors.lua @@ -1,6 +1,4 @@ -is_open = {} - -for door = 1,100 do is_open[door] = false end +local is_open = {} for pass = 1,100 do for door = pass,100,pass do @@ -9,9 +7,5 @@ for pass = 1,100 do end for i,v in next,is_open do - if v then - print ('Door '..i..':','open') - else - print ('Door '..i..':', 'close') - end + print ('Door '..i..':',v and 'open' or 'close') end diff --git a/Task/100-doors/NewLISP/100-doors-1.newlisp b/Task/100-doors/NewLISP/100-doors-1.newlisp new file mode 100644 index 0000000000..ed824eef9d --- /dev/null +++ b/Task/100-doors/NewLISP/100-doors-1.newlisp @@ -0,0 +1,8 @@ +(define (status door-num) + (let ((x (int (sqrt door-num)))) + (if + (= (* x x) door-num) (string "Door " door-num " Open") + (string "Door " door-num " Closed")))) + +(dolist (n (map status (sequence 1 100))) + (println n)) diff --git a/Task/100-doors/NewLISP/100-doors-2.newlisp b/Task/100-doors/NewLISP/100-doors-2.newlisp new file mode 100644 index 0000000000..f50fcefad6 --- /dev/null +++ b/Task/100-doors/NewLISP/100-doors-2.newlisp @@ -0,0 +1,9 @@ +(set 'Doors (array 100)) ;; Default value: nil (Closed) + +(for (x 0 99) + (for (y x 99 (+ 1 x)) + (setf (Doors y) (not (Doors y))))) + +(for (x 0 99) ;; Display open doors + (if (Doors x) + (println (+ x 1) " : Open"))) diff --git a/Task/100-doors/OCaml/100-doors-3.ocaml b/Task/100-doors/OCaml/100-doors-3.ocaml new file mode 100644 index 0000000000..ea9c489c58 --- /dev/null +++ b/Task/100-doors/OCaml/100-doors-3.ocaml @@ -0,0 +1,24 @@ +type door = Open | Closed (* human readable code *) + +let flipdoor = function Open -> Closed | Closed -> Open + +let string_of_door = + function Open -> "is open." | Closed -> "is closed." + +let printdoors ls = + let f i d = Printf.printf "Door %i %s\n" (i + 1) (string_of_door d) + in List.iteri f ls + +let outerlim = 100 +let innerlim = 100 + +let rec outer cnt accu = + let rec inner i door = match i > innerlim with (* define inner loop *) + | true -> door + | false -> inner (i + 1) (if (cnt mod i) = 0 then flipdoor door else door) + in (* define and do outer loop *) + match cnt > outerlim with + | true -> List.rev accu + | false -> outer (cnt + 1) (inner 1 Closed :: accu) (* generate new entries with inner *) + +let () = printdoors (outer 1 []) diff --git a/Task/100-doors/Onyx/100-doors.onyx b/Task/100-doors/Onyx/100-doors.onyx new file mode 100644 index 0000000000..67dff847ce --- /dev/null +++ b/Task/100-doors/Onyx/100-doors.onyx @@ -0,0 +1,9 @@ +$Door dict def +1 1 100 {Door exch false put} for +$Toggle {dup Door exch get not Door up put} def +$EveryNthDoor {dup 100 {Toggle} for} def +$Run {1 1 100 {EveryNthDoor} for} def +$ShowDoor {dup `Door no. ' exch cvs cat ` is ' cat + exch Door exch get {`open.\n'}{`shut.\n'} ifelse cat + print flush} def +Run 1 1 100 {ShowDoor} for diff --git a/Task/100-doors/Perl-6/100-doors-5.pl6 b/Task/100-doors/Perl-6/100-doors-5.pl6 new file mode 100644 index 0000000000..5dbedccd7c --- /dev/null +++ b/Task/100-doors/Perl-6/100-doors-5.pl6 @@ -0,0 +1,26 @@ +sub output( @arr, $max ) { + my $output = 1; + for 1..^$max -> $index { + if @arr[$index] { + printf "%4d", $index; + say '' if $output++ %% 10; + } + } + say ''; +} + +sub MAIN ( Int :$doors = 100 ) { + my $doorcount = $doors + 1; + my @door[$doorcount] = 0 xx ($doorcount); + + INDEX: + for 1...^$doorcount -> $index { + # flip door $index & its multiples, up to last door. + # + for ($index, * + $index ... *)[^$doors] -> $multiple { + next INDEX if $multiple > $doors; + @door[$multiple] = @door[$multiple] ?? 0 !! 1; + } + } + output @door, $doors+1; +} diff --git a/Task/100-doors/Processing/100-doors b/Task/100-doors/Processing/100-doors new file mode 100644 index 0000000000..88c508c22f --- /dev/null +++ b/Task/100-doors/Processing/100-doors @@ -0,0 +1,19 @@ +boolean[] doors = new boolean[100]; + +void setup() { + for (int i = 0; i < 100; i++) { + doors[i] = false; + } + for (int i = 1; i < 100; i++) { + for (int j = 0; j < 100; j += i) { + doors[j] = !doors[j]; + } + } + println("Open:"); + for (int i = 1; i < 100; i++) { + if (doors[i]) { + println(i); + } + } + exit(); +} diff --git a/Task/100-doors/Python/100-doors-1.py b/Task/100-doors/Python/100-doors-1.py index 55ad725caf..b45b458c2c 100644 --- a/Task/100-doors/Python/100-doors-1.py +++ b/Task/100-doors/Python/100-doors-1.py @@ -1,5 +1,5 @@ doors = [False] * 100 -for i in xrange(100): - for j in xrange(i, 100, i+1): - doors[j] = not doors[j] - print "Door %d:" % (i+1), 'open' if doors[i] else 'close' +for i in range(100): + for j in range(i, 100, i+1): + doors[j] = not doors[j] + print("Door %d:" % (i+1), 'open' if doors[i] else 'close') diff --git a/Task/100-doors/REXX/100-doors-1.rexx b/Task/100-doors/REXX/100-doors-1.rexx index f81469ac5e..0ee5ea71a6 100644 --- a/Task/100-doors/REXX/100-doors-1.rexx +++ b/Task/100-doors/REXX/100-doors-1.rexx @@ -1,11 +1,17 @@ -/*rexx*/ -door. = 0 -do inc = 1 to 100 - do d = inc to 100 by inc - door.d = \door.d - end -end -say "The open doors after 100 passes:" -do i = 1 to 100 - if door.i = 1 then say i -end +/*REXX pgm solves the 100 doors puzzle, doing it the hard way by opening/closing doors.*/ +parse arg doors . /*obtain the optional argument from CL.*/ +if doors=='' | doors=="," then doors=100 /*not specified? Then assume 100 doors*/ + /* 0 = the door is closed. */ + /* 1 = " " " open. */ +door.=0 /*assume all doors are closed at start.*/ + do #=1 for doors /*process a pass─through for all doors.*/ + do j=# by # to doors /* ··· every Jth door from this point.*/ + door.j= \door.j /*toggle the "openness" of the door. */ + end /*j*/ + end /*#*/ + +say 'After ' doors " passes, the following doors are open:" +say + do k=1 for doors + if door.k then say right(k, 20) /*add some indentation for the output. */ + end /*k*/ /*stick a fork in it, we're all done. */ diff --git a/Task/100-doors/REXX/100-doors-2.rexx b/Task/100-doors/REXX/100-doors-2.rexx index 88580a4ef5..cf560ab58d 100644 --- a/Task/100-doors/REXX/100-doors-2.rexx +++ b/Task/100-doors/REXX/100-doors-2.rexx @@ -1,18 +1,8 @@ -/*REXX program to solve the 100 door puzzle, the hard-way version. */ -parse arg doors . /*get the first argument (# of doors.) */ -if doors=='' then doors=100 /*not specified? Then assume 100 doors*/ - /* 0 = closed. */ - /* 1 = open. */ -door.=0 /*assume all that all doors are closed.*/ - - do j=1 for doors /*process a pass-through for all doors.*/ - do k=j by j to doors /* ... every Jth door from this point. */ - door.k=\door.k /*toggle the "openness" of the door. */ - end /*k*/ - end /*j*/ +/*REXX pgm solves the 100 doors puzzle, doing it the easy way by calculating squares.*/ +parse arg doors . /*obtain the optional argument from CL.*/ +if doors=='' | doors=="," then doors=100 /*not specified? Then assume 100 doors*/ +say 'After ' doors " passes, the following doors are open:" say -say 'After' doors "passes, the following doors are open:" -say - do n=1 for doors - if door.n then say right(n,20) - end /*n*/ + do #=1 while #**2 <= doors /*process easy pass─through (squares).*/ + say right(#**2, 20) /*add some indentation for the output. */ + end /*#*/ /*stick a fork in it, we're all done. */ diff --git a/Task/100-doors/Rust/100-doors-3.rust b/Task/100-doors/Rust/100-doors-3.rust new file mode 100644 index 0000000000..e263967d6f --- /dev/null +++ b/Task/100-doors/Rust/100-doors-3.rust @@ -0,0 +1,5 @@ +fn main() { + for i in 1u32..11u32{ + println!("Door {} is open", i.pow(2)); + } +} diff --git a/Task/100-doors/SuperCollider/100-doors.supercollider b/Task/100-doors/SuperCollider/100-doors.supercollider new file mode 100644 index 0000000000..cedeb6c654 --- /dev/null +++ b/Task/100-doors/SuperCollider/100-doors.supercollider @@ -0,0 +1,6 @@ +( +var n = 100, doors = false ! n; +var pass = { |j| (0, j .. n-1).do { |i| doors[i] = doors[i].not } }; +(1..n-1).do(pass); +doors.selectIndices { |open| open }; // all are closed except [ 0, 1, 4, 9, 16, 25, 36, 49, 64, 81 ] +) diff --git a/Task/100-doors/VBA/100-doors.vba b/Task/100-doors/VBA/100-doors.vba index d8c760bf4d..671efa391e 100644 --- a/Task/100-doors/VBA/100-doors.vba +++ b/Task/100-doors/VBA/100-doors.vba @@ -11,3 +11,42 @@ For i = 1 To 100 Step 1 End If Next i End Sub + + +*** USE THIS ONE, SEE COMMENTED LINES, DONT KNOW WHY EVERYBODY FOLLOWED OTHERS ANSWERS AND CODED THE PROBLEM DIFFERENTLY *** +*** ALWAYS USE AND TEST A READABLE, EASY TO COMPREHEND CODING BEFORE 'OPTIMIZING' YOUR CODE AND TEST THE 'OPTIMIZED' CODE AGAINST THE 'READABLE' ONE. +Panikkos Savvides. + + +Sub Rosetta_100Doors2() +Dim Door(100) As Boolean, i As Integer, j As Integer +Dim strAns As String +' There are 100 doors in a row that are all initially closed. +' You make 100 passes by the doors. +For j = 1 To 100 + ' The first time through, visit every door and toggle the door + ' (if the door is closed, open it; if it is open, close it). + For i = 1 To 100 Step 1 + Door(i) = Not Door(i) + Next i + ' The second time, only visit every 2nd door (door #2, #4, #6, ...), and toggle it. + For i = 2 To 100 Step 2 + Door(i) = Not Door(i) + Next i + ' The third time, visit every 3rd door (door #3, #6, #9, ...), etc, until you only visit the 100th door. + For i = 3 To 100 Step 3 + Door(i) = Not Door(i) + Next i +Next j + +For j = 1 To 100 + If Door(j) = True Then + strAns = j & strAns & ", " + End If +Next j + +If Right(strAns, 2) = ", " Then strAns = Left(strAns, Len(strAns) - 2) +If Len(strAns) = 0 Then strAns = "0" +Debug.Print "Doors [" & strAns & "] are open, the rest are closed." +' Doors [0] are open, the rest are closed., AKA ZERO DOORS OPEN +End Sub diff --git a/Task/24-game-Solve/00DESCRIPTION b/Task/24-game-Solve/00DESCRIPTION index 3828d70f94..94a27b24cc 100644 --- a/Task/24-game-Solve/00DESCRIPTION +++ b/Task/24-game-Solve/00DESCRIPTION @@ -1,5 +1,9 @@ +;task: Write a program that takes four digits, either from user input or by random generation, and computes arithmetic expressions following the rules of the [[24 game]]. Show examples of solutions generated by the program. -C.F: [[Arithmetic Evaluator]] + +;Related task: +*   [[Arithmetic Evaluator]] +

diff --git a/Task/24-game-Solve/COBOL/24-game-solve.cobol b/Task/24-game-Solve/COBOL/24-game-solve.cobol new file mode 100644 index 0000000000..086cf6c30b --- /dev/null +++ b/Task/24-game-Solve/COBOL/24-game-solve.cobol @@ -0,0 +1,446 @@ + >>SOURCE FORMAT FREE +*> This code is dedicated to the public domain +*> This is GNUCobol 2.0 +identification division. +program-id. twentyfoursolve. +environment division. +configuration section. +repository. function all intrinsic. +input-output section. +file-control. + select count-file + assign to count-file-name + file status count-file-status + organization line sequential. +data division. +file section. +fd count-file. +01 count-record pic x(7). + +working-storage section. +01 count-file-name pic x(64) value 'solutioncounts'. +01 count-file-status pic xx. + +01 command-area. + 03 nd pic 9. + 03 number-definition. + 05 n occurs 4 pic 9. + 03 number-definition-9 redefines number-definition + pic 9(4). + 03 command-input pic x(16). + 03 command pic x(5). + 03 number-count pic 9999. + 03 l1 pic 99. + 03 l2 pic 99. + 03 expressions pic zzz,zzz,zz9. + +01 number-validation. + 03 px pic 99. + 03 permutations value + '1234' + & '1243' + & '1324' + & '1342' + & '1423' + & '1432' + + & '2134' + & '2143' + & '2314' + & '2341' + & '2413' + & '2431' + + & '3124' + & '3142' + & '3214' + & '3241' + & '3423' + & '3432' + + & '4123' + & '4132' + & '4213' + & '4231' + & '4312' + & '4321'. + 05 permutation occurs 24 pic x(4). + 03 cpx pic 9. + 03 current-permutation pic x(4). + 03 od1 pic 9. + 03 od2 pic 9. + 03 od3 pic 9. + 03 operator-definitions pic x(4) value '+-*/'. + 03 cox pic 9. + 03 current-operators pic x(3). + 03 rpn-forms value + 'nnonono' + & 'nnonnoo' + & 'nnnonoo' + & 'nnnoono' + & 'nnnnooo'. + 05 rpn-form occurs 5 pic x(7). + 03 rpx pic 9. + 03 current-rpn-form pic x(7). + +01 calculation-area. + 03 oqx pic 99. + 03 output-queue pic x(7). + 03 work-number pic s9999. + 03 top-numerator pic s9999 sign leading separate. + 03 top-denominator pic s9999 sign leading separate. + 03 rsx pic 9. + 03 result-stack occurs 8. + 05 numerator pic s9999. + 05 denominator pic s9999. + 03 divide-by-zero-error pic x. + +01 totals. + 03 s pic 999. + 03 s-lim pic 999 value 600. + 03 s-max pic 999 value 0. + 03 solution occurs 600 pic x(7). + 03 sc pic 999. + 03 sc1 pic 999. + 03 sc2 pic 9. + 03 sc-max pic 999 value 0. + 03 sc-lim pic 999 value 600. + 03 solution-counts value zeros. + 05 solution-count occurs 600 pic 999. + 03 ns pic 9999. + 03 ns-max pic 9999 value 0. + 03 ns-lim pic 9999 value 6561. + 03 number-solutions occurs 6561. + 05 ns-number pic x(4). + 05 ns-count pic 999. + 03 record-counts pic 9999. + 03 total-solutions pic 9999. + +01 infix-area. + 03 i pic 9. + 03 i-s pic 9. + 03 i-s1 pic 9. + 03 i-work pic x(16). + 03 i-stack occurs 7 pic x(13). + +procedure division. +start-twentyfoursolve. + display 'start twentyfoursolve' + perform display-instructions + perform get-command + perform until command-input = spaces + display space + initialize command number-count + unstring command-input delimited by all space + into command number-count + move command-input to number-definition + move spaces to command-input + evaluate command + when 'h' + when 'help' + perform display-instructions + when 'list' + if ns-max = 0 + perform load-solution-counts + end-if + perform list-counts + when 'show' + if ns-max = 0 + perform load-solution-counts + end-if + perform show-numbers + when other + if number-definition-9 not numeric + display 'invalid number' + else + perform get-solutions + perform display-solutions + end-if + end-evaluate + if command-input = spaces + perform get-command + end-if + end-perform + display 'exit twentyfoursolve' + stop run + . +display-instructions. + display space + display 'enter a number as four integers from 1-9 to see its solutions' + display 'enter list to see counts of solutions for all numbers' + display 'enter show to see numbers having solutions' + display ' ends the program' + . +get-command. + display space + move spaces to command-input + display '(h for help)?' with no advancing + accept command-input + . +ask-for-more. + display space + move 0 to l1 + add 1 to l2 + if l2 = 10 + display 'more ()?' with no advancing + accept command-input + move 0 to l2 + end-if + . +list-counts. + add 1 to sc-max giving sc + display 'there are ' sc ' solution counts' + display space + display 'solutions/numbers' + move 0 to l1 + move 0 to l2 + perform varying sc from 1 by 1 until sc > sc-max + or command-input <> spaces + if solution-count(sc) > 0 + subtract 1 from sc giving sc1 *> offset to capture zero counts + display sc1 '/' solution-count(sc) space with no advancing + add 1 to l1 + if l1 = 8 + perform ask-for-more + end-if + end-if + end-perform + if l1 > 0 + display space + end-if + . +show-numbers. *> with number-count solutions + add 1 to number-count giving sc1 *> offset for zero count + evaluate true + when number-count >= sc-max + display 'no number has ' number-count ' solutions' + exit paragraph + when solution-count(sc1) = 1 and number-count = 1 + display '1 number has 1 solution' + when solution-count(sc1) = 1 + display '1 number has ' number-count ' solutions' + when number-count = 1 + display solution-count(sc1) ' numbers have 1 solution' + when other + display solution-count(sc1) ' numbers have ' number-count ' solutions' + end-evaluate + display space + move 0 to l1 + move 0 to l2 + perform varying ns from 1 by 1 until ns > ns-max + or command-input <> spaces + if ns-count(ns) = number-count + display ns-number(ns) space with no advancing + add 1 to l1 + if l1 = 14 + perform ask-for-more + end-if + end-if + end-perform + if l1 > 0 + display space + end-if + . +display-solutions. + evaluate s-max + when 0 display number-definition ' has no solutions' + when 1 display number-definition ' has 1 solution' + when other display number-definition ' has ' s-max ' solutions' + end-evaluate + display space + move 0 to l1 + move 0 to l2 + perform varying s from 1 by 1 until s > s-max + or command-input <> spaces + *> convert rpn solution(s) to infix + move 0 to i-s + perform varying i from 1 by 1 until i > 7 + if solution(s)(i:1) >= '1' and <= '9' + add 1 to i-s + move solution(s)(i:1) to i-stack(i-s) + else + subtract 1 from i-s giving i-s1 + move spaces to i-work + string '(' i-stack(i-s1) solution(s)(i:1) i-stack(i-s) ')' + delimited by space into i-work + move i-work to i-stack(i-s1) + subtract 1 from i-s + end-if + end-perform + display solution(s) space i-stack(1) space space with no advancing + add 1 to l1 + if l1 = 3 + perform ask-for-more + end-if + end-perform + if l1 > 0 + display space + end-if + . +load-solution-counts. + move 0 to ns-max *> numbers and their solution count + move 0 to sc-max *> solution counts + move spaces to count-file-status + open input count-file + if count-file-status <> '00' + perform create-count-file + move 0 to ns-max *> numbers and their solution count + move 0 to sc-max *> solution counts + open input count-file + end-if + read count-file + move 0 to record-counts + move zeros to solution-counts + perform until count-file-status <> '00' + add 1 to record-counts + perform increment-ns-max + move count-record to number-solutions(ns-max) + add 1 to ns-count(ns-max) giving sc *> offset 1 for zero counts + if sc > sc-lim + display 'sc ' sc ' exceeds sc-lim ' sc-lim + stop run + end-if + if sc > sc-max + move sc to sc-max + end-if + add 1 to solution-count(sc) + read count-file + end-perform + close count-file + . +create-count-file. + open output count-file + display 'Counting solutions for all numbers' + display 'We will examine 9*9*9*9 numbers' + display 'For each number we will examine 4! permutations of the digits' + display 'For each permutation we will examine 4*4*4 combinations of operators' + display 'For each permutation and combination we will examine 5 rpn forms' + display 'We will count the number of unique solutions for the given number' + display 'Each number and its counts will be written to file ' trim(count-file-name) + compute expressions = 9*9*9*9*factorial(4)*4*4*4*5 + display 'So we will evaluate ' trim(expressions) ' statements' + display 'This will take a few minutes' + display 'In the future if ' trim(count-file-name) ' exists, this step will be bypassed' + move 0 to record-counts + move 0 to total-solutions + perform varying n(1) from 1 by 1 until n(1) = 0 + perform varying n(2) from 1 by 1 until n(2) = 0 + display n(1) n(2) '..' *> show progress + perform varying n(3) from 1 by 1 until n(3) = 0 + perform varying n(4) from 1 by 1 until n(4) = 0 + perform get-solutions + perform increment-ns-max + move number-definition to ns-number(ns-max) + move s-max to ns-count(ns-max) + move number-solutions(ns-max) to count-record + write count-record + add s-max to total-solutions + add 1 to record-counts + add 1 to ns-count(ns-max) giving sc *> offset by 1 for zero counts + if sc > sc-lim + display 'error: ' sc ' solution count exceeds ' sc-lim + stop run + end-if + add 1 to solution-count(sc) + end-perform + end-perform + end-perform + end-perform + close count-file + display record-counts ' numbers and counts written to ' trim(count-file-name) + display total-solutions ' total solutions' + display space + . +increment-ns-max. + if ns-max >= ns-lim + display 'error: numbers exceeds ' ns-lim + stop run + end-if + add 1 to ns-max + . +get-solutions. + move 0 to s-max + perform varying px from 1 by 1 until px > 24 + move permutation(px) to current-permutation + perform varying od1 from 1 by 1 until od1 > 4 + move operator-definitions(od1:1) to current-operators(1:1) + perform varying od2 from 1 by 1 until od2 > 4 + move operator-definitions(od2:1) to current-operators(2:1) + perform varying od3 from 1 by 1 until od3 > 4 + move operator-definitions(od3:1) to current-operators(3:1) + perform varying rpx from 1 by 1 until rpx > 5 + move rpn-form(rpx) to current-rpn-form + move 0 to cpx cox + move spaces to output-queue + perform varying oqx from 1 by 1 until oqx > 7 + if current-rpn-form(oqx:1) = 'n' + add 1 to cpx + move current-permutation(cpx:1) to nd + move n(nd) to output-queue(oqx:1) + else + add 1 to cox + move current-operators(cox:1) to output-queue(oqx:1) + end-if + end-perform + perform evaluate-rpn + if divide-by-zero-error = space + and 24 * top-denominator = top-numerator + perform varying s from 1 by 1 until s > s-max + or solution(s) = output-queue + continue + end-perform + if s > s-max + if s >= s-lim + display 'error: solutions ' s ' for ' number-definition ' exceeds ' s-lim + stop run + end-if + move s to s-max + move output-queue to solution(s-max) + end-if + end-if + end-perform + end-perform + end-perform + end-perform + end-perform + . +evaluate-rpn. + move space to divide-by-zero-error + move 0 to rsx *> stack depth + perform varying oqx from 1 by 1 until oqx > 7 + if output-queue(oqx:1) >= '1' and <= '9' + *> push the digit onto the stack + add 1 to rsx + move top-numerator to numerator(rsx) + move top-denominator to denominator(rsx) + move output-queue(oqx:1) to top-numerator + move 1 to top-denominator + else + *> apply the operation + evaluate output-queue(oqx:1) + when '+' + compute top-numerator = top-numerator * denominator(rsx) + + top-denominator * numerator(rsx) + compute top-denominator = top-denominator * denominator(rsx) + when '-' + compute top-numerator = top-denominator * numerator(rsx) + - top-numerator * denominator(rsx) + compute top-denominator = top-denominator * denominator(rsx) + when '*' + compute top-numerator = top-numerator * numerator(rsx) + compute top-denominator = top-denominator * denominator(rsx) + when '/' + compute work-number = numerator(rsx) * top-denominator + compute top-denominator = denominator(rsx) * top-numerator + if top-denominator = 0 + move 'y' to divide-by-zero-error + exit paragraph + end-if + move work-number to top-numerator + end-evaluate + *> pop the stack + subtract 1 from rsx + end-if + end-perform + . +end program twentyfoursolve. diff --git a/Task/24-game-Solve/Elixir/24-game-solve.elixir b/Task/24-game-Solve/Elixir/24-game-solve.elixir new file mode 100644 index 0000000000..bbb23ef0e6 --- /dev/null +++ b/Task/24-game-Solve/Elixir/24-game-solve.elixir @@ -0,0 +1,46 @@ +defmodule Game24 do + @expressions [ ["((", "", ")", "", ")", ""], + ["(", "(", "", "", "))", ""], + ["(", "", ")", "(", "", ")"], + ["", "((", "", "", ")", ")"], + ["", "(", "", "(", "", "))"] ] + + def solve(digits) do + dig_perm = permute(digits) |> Enum.uniq + operators = perm_rep(~w[+ - * /], 3) + for dig <- dig_perm, ope <- operators, expr <- @expressions, + check?(str = make_expr(dig, ope, expr)), + do: str + end + + defp check?(str) do + try do + {val, _} = Code.eval_string(str) + val == 24 + rescue + ArithmeticError -> false # division by zero + end + end + + defp permute([]), do: [[]] + defp permute(list) do + for x <- list, y <- permute(list -- [x]), do: [x|y] + end + + defp perm_rep([], _), do: [[]] + defp perm_rep(_, 0), do: [[]] + defp perm_rep(list, i) do + for x <- list, y <- perm_rep(list, i-1), do: [x|y] + end + + defp make_expr([a,b,c,d], [x,y,z], [e0,e1,e2,e3,e4,e5]) do + e0 <> a <> x <> e1 <> b <> e2 <> y <> e3 <> c <> e4 <> z <> d <> e5 + end +end + +case Game24.solve(System.argv) do + [] -> IO.puts "no solutions" + solutions -> + IO.puts "found #{length(solutions)} solutions, including #{hd(solutions)}" + IO.inspect Enum.sort(solutions) +end diff --git a/Task/24-game-Solve/Perl-6/24-game-solve.pl6 b/Task/24-game-Solve/Perl-6/24-game-solve.pl6 index ca5fdddfb3..7d0af0d32d 100644 --- a/Task/24-game-Solve/Perl-6/24-game-solve.pl6 +++ b/Task/24-game-Solve/Perl-6/24-game-solve.pl6 @@ -1,18 +1,19 @@ +use MONKEY-SEE-NO-EVAL; + my @digits; my $amount = 4; # Get $amount digits from the user, # ask for more if they don't supply enough while @digits.elems < $amount { - @digits ,= (prompt "Enter {$amount - @digits} digits from 1 to 9, " + @digits.append: (prompt "Enter {$amount - @digits} digits from 1 to 9, " ~ '(repeats allowed): ').comb(/<[1..9]>/); } # Throw away any extras @digits = @digits[^$amount]; # Generate combinations of operators -my @op = <+ - * />; -my @ops = map {my $a = $_; map {my $b = $_; map {[$a,$b,$_]}, @op}, @op}, @op; +my @ops = [X,] <+ - * /> xx 3; # Enough sprintf formats to cover most precedence orderings my @formats = ( @@ -26,34 +27,16 @@ my @formats = ( ); # Brute force test the different permutations -for unique permutations @digits -> @p { +for unique @digits.permutations -> @p { for @ops -> @o { for @formats -> $format { - my $string = sprintf $format, @p[0], @o[0], - @p[1], @o[1], @p[2], @o[2], @p[3]; - my $result = try { EVAL($string) }; + my $string = sprintf $format, flat roundrobin(|@p; |@o); + my $result = EVAL($string); say "$string = 24" and last if $result and $result == 24; } } } -# Perl 6 translation of Fischer-Krause ordered permutation algorithm -sub permutations (@array) { - my @index = ^@array; - my $last = @index[*-1]; - my (@permutations, $rev, $fwd); - loop { - push @permutations, [@array[@index]]; - $rev = $last; - --$rev while $rev and @index[$rev-1] > @index[$rev]; - return @permutations unless $rev; - $fwd = $rev; - push @index, @index.splice($rev).reverse; - ++$fwd while @index[$rev-1] > @index[$fwd]; - @index[$rev-1,$fwd] = @index[$fwd,$rev-1]; - } -} - # Only return unique sub-arrays sub unique (@array) { my %h = map { $_.Str => $_ }, @array; diff --git a/Task/24-game-Solve/Ruby/24-game-solve.rb b/Task/24-game-Solve/Ruby/24-game-solve.rb index c6016c35ad..f183f47d15 100644 --- a/Task/24-game-Solve/Ruby/24-game-solve.rb +++ b/Task/24-game-Solve/Ruby/24-game-solve.rb @@ -1,29 +1,22 @@ -class TwentyFourGamePlayer +class TwentyFourGame EXPRESSIONS = [ - '((%d %s %d) %s %d) %s %d', - '(%d %s (%d %s %d)) %s %d', - '(%d %s %d) %s (%d %s %d)', - '%d %s ((%d %s %d) %s %d)', - '%d %s (%d %s (%d %s %d))', - ].map{|expr| [expr, expr.gsub('%d', 'Rational(%d,1)')]} + '((%dr %s %dr) %s %dr) %s %dr', + '(%dr %s (%dr %s %dr)) %s %dr', + '(%dr %s %dr) %s (%dr %s %dr)', + '%dr %s ((%dr %s %dr) %s %dr)', + '%dr %s (%dr %s (%dr %s %dr))', + ] - OPERATORS = [:+, :-, :*, :/].repeated_permutation(3) - - OBJECTIVE = Rational(24,1) + OPERATORS = [:+, :-, :*, :/].repeated_permutation(3).to_a def self.solve(digits) solutions = [] - digits.permutation.to_a.uniq.each do |a,b,c,d| - OPERATORS.each do |op1,op2,op3| - EXPRESSIONS.each do |expr,expr_rat| - # evaluate using rational arithmetic - test = expr_rat % [a, op1, b, op2, c, op3, d] - value = eval(test) rescue -1 # catch division by zero - if value == OBJECTIVE - solutions << expr % [a, op1, b, op2, c, op3, d] - end - end - end + perms = digits.permutation.to_a.uniq + perms.product(OPERATORS, EXPRESSIONS) do |(a,b,c,d), (op1,op2,op3), expr| + # evaluate using rational arithmetic + text = expr % [a, op1, b, op2, c, op3, d] + value = eval(text) rescue next # catch division by zero + solutions << text.delete("r") if value == 24 end solutions end @@ -39,7 +32,7 @@ digits = ARGV.map do |arg| end digits.size == 4 or raise "error: need 4 digits, only have #{digits.size}" -solutions = TwentyFourGamePlayer.solve(digits) +solutions = TwentyFourGame.solve(digits) if solutions.empty? puts "no solutions" else diff --git a/Task/24-game/00DESCRIPTION b/Task/24-game/00DESCRIPTION index 8e28595bf2..720125f53a 100644 --- a/Task/24-game/00DESCRIPTION +++ b/Task/24-game/00DESCRIPTION @@ -1,18 +1,28 @@ The [[wp:24 Game|24 Game]] tests one's mental arithmetic. -Write a program that [[task feature::Rosetta Code:randomness|randomly]] chooses and [[task feature::Rosetta Code:user output|displays]] four digits, each from one to nine, with repetitions allowed. The program should prompt for the player to enter an arithmetic expression using ''just'' those, and ''all'' of those four digits, used exactly ''once'' each. The program should ''check'' then [[task feature::Rosetta Code:parsing|evaluate the expression]]. -The goal is for the player to [[task feature::Rosetta Code:user input|enter]] an expression that evaluates to '''24'''. -* Only multiplication, division, addition, and subtraction operators/functions are allowed. -* Division should use floating point or rational arithmetic, etc, to preserve remainders. -* Brackets are allowed, if using an infix expression evaluator. -* Forming multiple digit numbers from the supplied digits is ''disallowed''. (So an answer of 12+12 when given 1, 2, 2, and 1 is wrong). -* The order of the digits when given does not have to be preserved. -Note: +;Task +Write a program that [[task feature::Rosetta Code:randomness|randomly]] chooses and [[task feature::Rosetta Code:user output|displays]] four digits, each from 1 ──► 9 (inclusive) with repetitions allowed. + +The program should prompt for the player to enter an arithmetic expression using ''just'' those, and ''all'' of those four digits, used exactly ''once'' each. The program should ''check'' then [[task feature::Rosetta Code:parsing|evaluate the expression]]. + +The goal is for the player to [[task feature::Rosetta Code:user input|enter]] an expression that (numerically) evaluates to '''24'''. +* Only the following operators/functions are allowed: multiplication, division, addition, subtraction +* Division should use floating point or rational arithmetic, etc, to preserve remainders. +* Brackets are allowed, if using an infix expression evaluator. +* Forming multiple digit numbers from the supplied digits is ''disallowed''. (So an answer of 12+12 when given 1, 2, 2, and 1 is wrong). +* The order of the digits when given does not have to be preserved. + +
+;Notes * The type of expression evaluator used is not mandated. An [[wp:Reverse Polish notation|RPN]] evaluator is equally acceptable for example. * The task is not for the program to generate the expression, or test whether an expression is even possible. -C.f: [[24 game Player]] -'''Reference''' -# [http://www.bbc.co.uk/dna/h2g2/A933121 The 24 Game] on h2g2. +;Related tasks +* [[24 game/Solve]] + + +;Reference +* [http://www.bbc.co.uk/dna/h2g2/A933121 The 24 Game] on h2g2. +

diff --git a/Task/24-game/COBOL/24-game.cobol b/Task/24-game/COBOL/24-game.cobol new file mode 100644 index 0000000000..8041901235 --- /dev/null +++ b/Task/24-game/COBOL/24-game.cobol @@ -0,0 +1,843 @@ + >>SOURCE FORMAT FREE +*> This code is dedicated to the public domain +*> This is GNUCobol 2.0 +identification division. +program-id. twentyfour. +environment division. +configuration section. +repository. function all intrinsic. +data division. +working-storage section. +01 p pic 999. +01 p1 pic 999. +01 p-max pic 999 value 38. +01 program-syntax pic x(494) value +*>statement = expression; + '001 001 000 n' + & '002 000 004 =' + & '003 005 000 n' + & '004 000 002 ;' +*>expression = term, {('+'|'-') term,}; + & '005 005 000 n' + & '006 000 016 =' + & '007 017 000 n' + & '008 000 015 {' + & '009 011 013 (' + & '010 001 000 t' + & '011 013 000 |' + & '012 002 000 t' + & '013 000 009 )' + & '014 017 000 n' + & '015 000 008 }' + & '016 000 006 ;' +*>term = factor, {('*'|'/') factor,}; + & '017 017 000 n' + & '018 000 028 =' + & '019 029 000 n' + & '020 000 027 {' + & '021 023 025 (' + & '022 003 000 t' + & '023 025 000 |' + & '024 004 000 t' + & '025 000 021 )' + & '026 029 000 n' + & '027 000 020 }' + & '028 000 018 ;' +*>factor = ('(' expression, ')' | digit,); + & '029 029 000 n' + & '030 000 038 =' + & '031 035 037 (' + & '032 005 000 t' + & '033 005 000 n' + & '034 006 000 t' + & '035 037 000 |' + & '036 000 000 n' + & '037 000 031 )' + & '038 000 030 ;'. +01 filler redefines program-syntax. + 03 p-entry occurs 038. + 05 p-address pic 999. + 05 filler pic x. + 05 p-definition pic 999. + 05 p-alternate redefines p-definition pic 999. + 05 filler pic x. + 05 p-matching pic 999. + 05 filler pic x. + 05 p-symbol pic x. + +01 t pic 999. +01 t-len pic 99 value 6. +01 terminal-symbols + pic x(210) value + '01 + ' + & '01 - ' + & '01 * ' + & '01 / ' + & '01 ( ' + & '01 ) '. +01 filler redefines terminal-symbols. + 03 terminal-symbol-entry occurs 6. + 05 terminal-symbol-len pic 99. + 05 filler pic x. + 05 terminal-symbol pic x(32). + +01 nt pic 999. +01 nt-lim pic 99 value 5. +01 nonterminal-statements pic x(294) value + "000 ....,....,....,....,....,....,....,....,....," + & "001 statement = expression; " + & "005 expression = term, {('+'|'-') term,}; " + & "017 term = factor, {('*'|'/') factor,}; " + & "029 factor = ('(' expression, ')' | digit,); " + & "036 digit; ". +01 filler redefines nonterminal-statements. + 03 nonterminal-statement-entry occurs 5. + 05 nonterminal-statement-number pic 999. + 05 filler pic x. + 05 nonterminal-statement pic x(45). + +01 indent pic x(64) value all '| '. +01 interpreter-stack. + 03 r pic 99. *> previous top of stack + 03 s pic 99. *> current top of stack + 03 s-max pic 99 value 32. + 03 s-entry occurs 32. + 05 filler pic x(2) value 'p='. + 05 s-p pic 999. *> callers return address + 05 filler pic x(4) value ' sc='. + 05 s-start-control pic 999. *> sequence start address + 05 filler pic x(4) value ' ec='. + 05 s-end-control pic 999. *> sequence end address + 05 filler pic x(4) value ' al='. + 05 s-alternate pic 999. *> the next alternate + 05 filler pic x(3) value ' r='. + 05 s-result pic x. *> S success, F failure, N no result + 05 filler pic x(3) value ' c='. + 05 s-count pic 99. *> successes in a sequence + 05 filler pic x(3) value ' x='. + 05 s-repeat pic 99. *> repeats in a {} sequence + 05 filler pic x(4) value ' nt='. + 05 s-nt pic 99. *> current nonterminal + +01 language-area. + 03 l pic 99. + 03 l-lim pic 99. + 03 l-len pic 99 value 1. + 03 nd pic 9. + 03 number-definitions. + 05 n occurs 4 pic 9. + 03 nu pic 9. + 03 number-use. + 05 u occurs 4 pic x. + 03 statement. + 05 c occurs 32. + 07 c9 pic 9. + +01 number-validation. + 03 p4 pic 99. + 03 p4-lim pic 99 value 24. + 03 permutations-4 pic x(96) value + '1234' + & '1243' + & '1324' + & '1342' + & '1423' + & '1432' + & '2134' + & '2143' + & '2314' + & '2341' + & '2413' + & '2431' + & '3124' + & '3142' + & '3214' + & '3241' + & '3423' + & '3432' + & '4123' + & '4132' + & '4213' + & '4231' + & '4312' + & '4321'. + 03 filler redefines permutations-4. + 05 permutation-4 occurs 24 pic x(4). + 03 current-permutation-4 pic x(4). + 03 cpx pic 9. + 03 od1 pic 9. + 03 od2 pic 9. + 03 odx pic 9. + 03 od-lim pic 9 value 4. + 03 operator-definitions pic x(4) value '+-*/'. + 03 current-operators pic x(3). + 03 co3 pic 9. + 03 rpx pic 9. + 03 rpx-lim pic 9 value 4. + 03 valid-rpn-forms pic x(28) value + 'nnonono' + & 'nnnonoo' + & 'nnnoono' + & 'nnnnooo'. + 03 filler redefines valid-rpn-forms. + 05 rpn-form occurs 4 pic x(7). + 03 current-rpn-form pic x(7). + +01 calculation-area. + 03 osx pic 99. + 03 operator-stack pic x(32). + 03 oqx pic 99. + 03 oqx1 pic 99. + 03 output-queue pic x(32). + 03 work-number pic s9999. + 03 top-numerator pic s9999 sign leading separate. + 03 top-denominator pic s9999 sign leading separate. + 03 rsx pic 9. + 03 result-stack occurs 8. + 05 numerator pic s9999. + 05 denominator pic s9999. + +01 error-found pic x. +01 divide-by-zero-error pic x. + +*> diagnostics +01 NL pic x value x'0A'. +01 NL-flag pic x value space. +01 display-level pic x value '0'. +01 loop-lim pic 9999 value 1500. +01 loop-count pic 9999 value 0. +01 message-area value spaces. + 03 message-level pic x. + 03 message-value pic x(128). + +*> input and examples +01 instruction pic x(32) value spaces. +01 tsx pic 99. +01 tsx-lim pic 99 value 14. +01 test-statements. + 03 filler pic x(32) value '1234;1 + 2 + 3 + 4'. + 03 filler pic x(32) value '1234;1 * 2 * 3 * 4'. + 03 filler pic x(32) value '1234;((1)) * (((2 * 3))) * 4'. + 03 filler pic x(32) value '1234;((1)) * ((2 * 3))) * 4'. + 03 filler pic x(32) value '1234;(1 + 2 + 3 + 4'. + 03 filler pic x(32) value '1234;)1 + 2 + 3 + 4'. + 03 filler pic x(32) value '1234;1 * * 2 * 3 * 4'. + 03 filler pic x(32) value '5679;6 - (5 - 7) * 9'. + 03 filler pic x(32) value '1268;((1 * (8 * 6) / 2))'. + 03 filler pic x(32) value '4583;-5-3+(8*4)'. + 03 filler pic x(32) value '4583;8 * 4 - 5 - 3'. + 03 filler pic x(32) value '4583;8 * 4 - (5 + 3)'. + 03 filler pic x(32) value '1223;1 * 3 / (2 - 2)'. + 03 filler pic x(32) value '2468;(6 * 8) / 4 / 2'. +01 filler redefines test-statements. + 03 filler occurs 14. + 05 test-numbers pic x(4). + 05 filler pic x. + 05 test-statement pic x(27). + +procedure division. +start-twentyfour. + display 'start twentyfour' + perform generate-numbers + display 'type h to see instructions' + accept instruction + perform until instruction = spaces or 'q' + evaluate true + when instruction = 'h' + perform display-instructions + when instruction = 'n' + perform generate-numbers + when instruction(1:1) = 'm' + move instruction(2:4) to number-definitions + perform validate-number + if divide-by-zero-error = space + and 24 * top-denominator = top-numerator + display number-definitions ' is solved by ' output-queue(1:oqx) + else + display number-definitions ' is not solvable' + end-if + when instruction = 'd0' or 'd1' or 'd2' or 'd3' + move instruction(2:1) to display-level + when instruction = 'e' + display 'examples:' + perform varying tsx from 1 by 1 + until tsx > tsx-lim + move spaces to statement + move test-numbers(tsx) to number-definitions + move test-statement(tsx) to statement + perform evaluate-statement + perform show-result + end-perform + when other + move instruction to statement + perform evaluate-statement + perform show-result + end-evaluate + move spaces to instruction + display 'instruction? ' with no advancing + accept instruction + end-perform + + display 'exit twentyfour' + stop run + . +generate-numbers. + perform with test after until divide-by-zero-error = space + and 24 * top-denominator = top-numerator + compute n(1) = random(seconds-past-midnight) * 10 *> seed + perform varying nd from 1 by 1 until nd > 4 + compute n(nd) = random() * 10 + perform until n(nd) <> 0 + compute n(nd) = random() * 10 + end-perform + end-perform + perform validate-number + end-perform + display NL 'numbers:' with no advancing + perform varying nd from 1 by 1 until nd > 4 + display space n(nd) with no advancing + end-perform + display space + . +validate-number. + perform varying p4 from 1 by 1 until p4 > p4-lim + move permutation-4(p4) to current-permutation-4 + perform varying od1 from 1 by 1 until od1 > od-lim + move operator-definitions(od1:1) to current-operators(1:1) + perform varying od2 from 1 by 1 until od2 > od-lim + move operator-definitions(od2:1) to current-operators(2:1) + perform varying odx from 1 by 1 until odx > od-lim + move operator-definitions(odx:1) to current-operators(3:1) + perform varying rpx from 1 by 1 until rpx > rpx-lim + move rpn-form(rpx) to current-rpn-form + move 0 to cpx co3 + move spaces to output-queue + move 7 to oqx + perform varying oqx1 from 1 by 1 until oqx1 > oqx + if current-rpn-form(oqx1:1) = 'n' + add 1 to cpx + move current-permutation-4(cpx:1) to nd + move n(nd) to output-queue(oqx1:1) + else + add 1 to co3 + move current-operators(co3:1) to output-queue(oqx1:1) + end-if + end-perform + end-perform + perform evaluate-rpn + if divide-by-zero-error = space + and 24 * top-denominator = top-numerator + exit paragraph + end-if + end-perform + end-perform + end-perform + end-perform + . +display-instructions. + display '1) Type h to repeat these instructions.' + display '2) The program will display four randomly-generated' + display ' single-digit numbers and will then prompt you to enter' + display ' an arithmetic expression followed by to sum' + display ' the given numbers to 24.' + display ' The four numbers may contain duplicates and the entered' + display ' expression must reference all the generated numbers and duplicates.' + display ' Warning: the program converts the entered infix expression' + display ' to a reverse polish notation (rpn) expression' + display ' which is then interpreted from RIGHT to LEFT.' + display ' So, for instance, 8*4 - 5 - 3 will not sum to 24.' + display '3) Type n to generate a new set of four numbers.' + display ' The program will ensure the generated numbers are solvable.' + display '4) Type m#### (e.g. m1234) to create a fixed set of numbers' + display ' for testing purposes.' + display ' The program will test the solvability of the entered numbers.' + display ' For example, m1234 is solvable and m9999 is not solvable.' + display '5) Type d0, d1, d2 or d3 followed by to display none or' + display ' increasingly detailed diagnostic information as the program evaluates' + display ' the entered expression.' + display '6) Type e to see a list of example expressions and results' + display '7) Type or q to exit the program' + . +show-result. + if error-found = 'y' + or divide-by-zero-error = 'y' + exit paragraph + end-if + display 'statement in RPN is' space output-queue + evaluate true + when top-numerator = 0 + when top-denominator = 0 + when 24 * top-denominator <> top-numerator + display 'result (' top-numerator '/' top-denominator ') is not 24' + when other + display 'result is 24' + end-evaluate + . +evaluate-statement. + compute l-lim = length(trim(statement)) + + display NL 'numbers:' space n(1) space n(2) space n(3) space n(4) + move number-definitions to number-use + display 'statement is' space statement + + move 1 to l + move 0 to loop-count + move space to error-found + + move 0 to osx oqx + move spaces to output-queue + + move 1 to p + move 1 to nt + move 0 to s + perform increment-s + perform display-start-nonterminal + perform increment-p + + *>=================================== + *> interpret ebnf + *>=================================== + perform until s = 0 + or error-found = 'y' + + evaluate true + + when p-symbol(p) = 'n' + and p-definition(p) = 000 *> a variable + perform test-variable + if s-result(s) = 'S' + perform increment-l + end-if + perform increment-p + + when p-symbol(p) = 'n' + and p-address(p) <> p-definition(p) *> nonterminal reference + move p to s-p(s) + move p-definition(p) to p + + when p-symbol(p) = 'n' + and p-address(p) = p-definition(p) *> nonterminal definition + perform increment-s + perform display-start-nonterminal + perform increment-p + + when p-symbol(p) = '=' *> nonterminal control + move p to s-start-control(s) + move p-matching(p) to s-end-control(s) + perform increment-p + + when p-symbol(p) = ';' *> end nonterminal + perform display-end-control + perform display-end-nonterminal + perform decrement-s + if s > 0 + evaluate true + when s-result(r) = 'S' + perform set-success + when s-result(r) = 'F' + perform set-failure + end-evaluate + move s-p(s) to p + perform increment-p + perform display-continue-nonterminal + end-if + + when p-symbol(p) = '{' *> start repeat sequence + perform increment-s + perform display-start-control + move p to s-start-control(s) + move p-alternate(p) to s-alternate(s) + move p-matching(p) to s-end-control(s) + move 0 to s-count(s) + perform increment-p + + when p-symbol(p) = '}' *> end repeat sequence + perform display-end-control + evaluate true + when s-result(s) = 'S' *> repeat the sequence + perform display-repeat-control + perform set-nothing + add 1 to s-repeat(s) + move s-start-control(s) to p + perform increment-p + when other + perform decrement-s + evaluate true + when s-result(r) = 'N' + and s-repeat(r) = 0 *> no result + perform increment-p + when s-result(r) = 'N' + and s-repeat(r) > 0 *> no result after success + perform set-success + perform increment-p + when other *> fail the sequence + perform increment-p + end-evaluate + end-evaluate + + when p-symbol(p) = '(' *> start sequence + perform increment-s + perform display-start-control + move p to s-start-control(s) + move p-alternate(p) to s-alternate(s) + move p-matching(p) to s-end-control(s) + move 0 to s-count(s) + perform increment-p + + when p-symbol(p) = ')' *> end sequence + perform display-end-control + perform decrement-s + evaluate true + when s-result(r) = 'S' *> success + perform set-success + perform increment-p + when s-result(r) = 'N' *> no result + perform set-failure + perform increment-p + when other *> fail the sequence + perform set-failure + perform increment-p + end-evaluate + + when p-symbol(p) = '|' *> alternate + evaluate true + when s-result(s) = 'S' *> exit the sequence + perform display-skip-alternate + move s-end-control(s) to p + when other + perform display-take-alternate + move p-alternate(p) to s-alternate(s) *> the next alternate + perform increment-p + perform set-nothing + end-evaluate + + when p-symbol(p) = 't' *> terminal + move p-definition(p) to t + move terminal-symbol-len(t) to t-len + perform display-terminal + evaluate true + when statement(l:t-len) = terminal-symbol(t)(1:t-len) *> successful match + perform set-success + perform display-recognize-terminal + perform process-token + move t-len to l-len + perform increment-l + perform increment-p + when s-alternate(s) <> 000 *> we are in an alternate sequence + move s-alternate(s) to p + when other *> fail the sequence + perform set-failure + move s-end-control(s) to p + end-evaluate + + when other *> end control + perform display-control-failure *> shouldnt happen + + end-evaluate + + end-perform + + evaluate true *> at end of evaluation + when error-found = 'y' + continue + when l <= l-lim *> not all tokens parsed + display 'error: invalid statement' + perform statement-error + when number-use <> spaces + display 'error: not all numbers were used: ' number-use + move 'y' to error-found + end-evaluate + . +increment-l. + evaluate true + when l > l-lim *> end of statement + continue + when other + add l-len to l + perform varying l from l by 1 + until c(l) <> space + or l > l-lim + continue + end-perform + move 1 to l-len + if l > l-lim + perform end-tokens + end-if + end-evaluate + . +increment-p. + evaluate true + when p >= p-max + display 'at' space p ' parse overflow' + space 's=<' s space s-entry(s) '>' + move 'y' to error-found + when other + add 1 to p + perform display-statement + end-evaluate + . +increment-s. + evaluate true + when s >= s-max + display 'at' space p ' stack overflow ' + space 's=<' s space s-entry(s) '>' + move 'y' to error-found + when other + move s to r + add 1 to s + initialize s-entry(s) + move 'N' to s-result(s) + move p to s-p(s) + move nt to s-nt(s) + end-evaluate + . +decrement-s. + if s > 0 + move s to r + subtract 1 from s + if s > 0 + move s-nt(s) to nt + end-if + end-if + . +set-failure. + move 'F' to s-result(s) + if s-count(s) > 0 + display 'sequential parse failure' + perform statement-error + end-if + . +set-success. + move 'S' to s-result(s) + add 1 to s-count(s) + . +set-nothing. + move 'N' to s-result(s) + move 0 to s-count(s) + . +statement-error. + display statement + move spaces to statement + move '^ syntax error' to statement(l:) + display statement + move 'y' to error-found + . +*>===================== +*> twentyfour semantics +*>===================== +test-variable. + *> check validity + perform varying nd from 1 by 1 until nd > 4 + or c(l) = n(nd) + continue + end-perform + *> check usage + perform varying nu from 1 by 1 until nu > 4 + or c(l) = u(nu) + continue + end-perform + evaluate true + when l > l-lim + perform set-failure + when c9(l) not numeric + perform set-failure + when nd > 4 + display 'invalid number' + perform statement-error + when nu > 4 + display 'number already used' + perform statement-error + when other + move space to u(nu) + perform set-success + add 1 to oqx + move c(l) to output-queue(oqx:1) + end-evaluate + . +*> ================================== +*> Dijkstra Shunting-Yard Algorithm +*> to convert infix to rpn +*> ================================== +process-token. + evaluate true + when c(l) = '(' + add 1 to osx + move c(l) to operator-stack(osx:1) + when c(l) = ')' + perform varying osx from osx by -1 until osx < 1 + or operator-stack(osx:1) = '(' + add 1 to oqx + move operator-stack(osx:1) to output-queue(oqx:1) + end-perform + if osx < 1 + display 'parenthesis error' + perform statement-error + exit paragraph + end-if + subtract 1 from osx + when (c(l) = '+' or '-') and (operator-stack(osx:1) = '*' or '/') + *> lesser operator precedence + add 1 to oqx + move operator-stack(osx:1) to output-queue(oqx:1) + move c(l) to operator-stack(osx:1) + when other + *> greater operator precedence + add 1 to osx + move c(l) to operator-stack(osx:1) + end-evaluate + . +end-tokens. + *> 1) copy stacked operators to the output-queue + perform varying osx from osx by -1 until osx < 1 + or operator-stack(osx:1) = '(' + add 1 to oqx + move operator-stack(osx:1) to output-queue(oqx:1) + end-perform + if osx > 0 + display 'parenthesis error' + perform statement-error + exit paragraph + end-if + *> 2) evaluate the rpn statement + perform evaluate-rpn + if divide-by-zero-error = 'y' + display 'divide by zero error' + end-if + . +evaluate-rpn. + move space to divide-by-zero-error + move 0 to rsx *> stack depth + perform varying oqx1 from 1 by 1 until oqx1 > oqx + if output-queue(oqx1:1) >= '1' and <= '9' + *> push current data onto the stack + add 1 to rsx + move top-numerator to numerator(rsx) + move top-denominator to denominator(rsx) + move output-queue(oqx1:1) to top-numerator + move 1 to top-denominator + else + *> apply the operation + evaluate true + when output-queue(oqx1:1) = '+' + compute top-numerator = top-numerator * denominator(rsx) + + top-denominator * numerator(rsx) + compute top-denominator = top-denominator * denominator(rsx) + when output-queue(oqx1:1) = '-' + compute top-numerator = top-denominator * numerator(rsx) + - top-numerator * denominator(rsx) + compute top-denominator = top-denominator * denominator(rsx) + when output-queue(oqx1:1) = '*' + compute top-numerator = top-numerator * numerator(rsx) + compute top-denominator = top-denominator * denominator(rsx) + when output-queue(oqx1:1) = '/' + compute work-number = numerator(rsx) * top-denominator + compute top-denominator = denominator(rsx) * top-numerator + if top-denominator = 0 + move 'y' to divide-by-zero-error + exit paragraph + end-if + move work-number to top-numerator + end-evaluate + *> pop the stack + subtract 1 from rsx + end-if + end-perform + . +*>==================== +*> diagnostic displays +*>==================== +display-start-nonterminal. + perform varying nt from nt-lim by -1 until nt < 1 + or p-definition(p) = nonterminal-statement-number(nt) + continue + end-perform + if nt > 0 + move '1' to NL-flag + string '1' indent(1:s + s) 'at ' s space p ' start ' trim(nonterminal-statement(nt)) + into message-area perform display-message + move nt to s-nt(s) + end-if + . +display-continue-nonterminal. + move s-nt(s) to nt + string '1' indent(1:s + s) 'at ' s space p space p-symbol(p) ' continue ' trim(nonterminal-statement(nt)) ' with result ' s-result(s) + into message-area perform display-message + . +display-end-nonterminal. + move s-nt(s) to nt + move '2' to NL-flag + string '1' indent(1:s + s) 'at ' s space p ' end ' trim(nonterminal-statement(nt)) ' with result ' s-result(s) + into message-area perform display-message + . +display-start-control. + string '2' indent(1:s + s) 'at ' s space p ' start ' p-symbol(p) ' in ' trim(nonterminal-statement(nt)) + into message-area perform display-message + . +display-repeat-control. + string '2' indent(1:s + s) 'at ' s space p ' repeat ' p-symbol(p) ' in ' trim(nonterminal-statement(nt)) ' with result ' s-result(s) + into message-area perform display-message + . +display-end-control. + string '2' indent(1:s + s) 'at ' s space p ' end ' p-symbol(p) ' in ' trim(nonterminal-statement(nt)) ' with result ' s-result(s) + into message-area perform display-message + . +display-take-alternate. + string '2' indent(1:s + s) 'at ' s space p ' take alternate' ' in ' trim(nonterminal-statement(nt)) + into message-area perform display-message + . +display-skip-alternate. + string '2' indent(1:s + s) 'at ' s space p ' skip alternate' ' in ' trim(nonterminal-statement(nt)) + into message-area perform display-message + . +display-terminal. + string '1' indent(1:s + s) 'at ' s space p + ' compare ' statement(l:t-len) ' to ' terminal-symbol(t)(1:t-len) + ' in ' trim(nonterminal-statement(nt)) + into message-area perform display-message + . +display-recognize-terminal. + string '1' indent(1:s + s) 'at ' s space p ' recognize terminal: ' c(l) ' in ' trim(nonterminal-statement(nt)) + into message-area perform display-message + . +display-recognize-variable. + string '1' indent(1:s + s) 'at ' s space p ' recognize digit: ' c(l) ' in ' trim(nonterminal-statement(nt)) + into message-area perform display-message + . +display-statement. + compute p1 = p - s-start-control(s) + string '3' indent(1:s + s) 'at ' s space p + ' statement: ' s-start-control(s) '/' p1 + space p-symbol(p) space s-result(s) + ' in ' trim(nonterminal-statement(nt)) + into message-area perform display-message + . +display-control-failure. + display loop-count space indent(1:s + s) 'at' space p ' control failure' ' in ' trim(nonterminal-statement(nt)) + display loop-count space indent(1:s + s) ' ' 'p=<' p p-entry(p) '>' + display loop-count space indent(1:s + s) ' ' 's=<' s space s-entry(s) '>' + display loop-count space indent(1:s + s) ' ' 'l=<' l space c(l)'>' + perform statement-error + . +display-message. + if display-level = 1 + move space to NL-flag + end-if + evaluate true + when loop-count > loop-lim *> loop control + display 'display count exceeds ' loop-lim + stop run + when message-level <= display-level + evaluate true + when NL-flag = '1' + display NL loop-count space trim(message-value) + when NL-flag = '2' + display loop-count space trim(message-value) NL + when other + display loop-count space trim(message-value) + end-evaluate + end-evaluate + add 1 to loop-count + move spaces to message-area + move space to NL-flag + . +end program twentyfour. diff --git a/Task/24-game/Elixir/24-game.elixir b/Task/24-game/Elixir/24-game.elixir new file mode 100644 index 0000000000..45b27ad843 --- /dev/null +++ b/Task/24-game/Elixir/24-game.elixir @@ -0,0 +1,39 @@ +defmodule Game24 do + def main do + IO.puts "24 Game" + play + end + + defp play do + IO.puts "Generating 4 digits..." + digts = for _ <- 1..4, do: Enum.random(1..9) + IO.puts "Your digits\t#{inspect digts, char_lists: :as_lists}" + read_eval(digts) + play + end + + defp read_eval(digits) do + exp = IO.gets("Your expression: ") |> String.strip + if exp in ["","q"], do: exit(:normal) # give up + case {correct_nums(exp, digits), eval(exp)} do + {:ok, x} when x==24 -> IO.puts "You Win!" + {:ok, x} -> IO.puts "You Lose with #{inspect x}!" + {err, _} -> IO.puts "The following numbers are wrong: #{inspect err, char_lists: :as_lists}" + end + end + + defp correct_nums(exp, digits) do + nums = String.replace(exp, ~r/\D/, " ") |> String.split |> Enum.map(&String.to_integer &1) + if length(nums)==4 and (nums--digits)==[], do: :ok, else: nums + end + + defp eval(exp) do + try do + Code.eval_string(exp) |> elem(0) + rescue + e -> Exception.message(e) + end + end +end + +Game24.main diff --git a/Task/24-game/Haskell/24-game.hs b/Task/24-game/Haskell/24-game.hs index c905ce3bd8..e53c48e3e3 100644 --- a/Task/24-game/Haskell/24-game.hs +++ b/Task/24-game/Haskell/24-game.hs @@ -29,10 +29,9 @@ processGuess digits xs = calc xs >>= check check x = Left (show (fromRational (x :: Rational)) ++ " is wrong") -- A Reverse Polish Notation calculator with full error handling -calc = result [] - where result [n] [] = Right n - result _ [] = Left "Too few operators" - result ns (x:xs) = simplify ns x >>= flip result xs +calc xs = foldM simplify [] xs >>= \ns -> (case ns of + [n] -> Right n + _ -> Left "Too few operators") simplify (a:b:ns) s | isOp s = Right ((fromJust $ lookup s ops) b a : ns) simplify _ s | isOp s = Left ("Too few values before " ++ s) diff --git a/Task/24-game/Maple/24-game.maple b/Task/24-game/Maple/24-game.maple new file mode 100644 index 0000000000..e62d3a9000 --- /dev/null +++ b/Task/24-game/Maple/24-game.maple @@ -0,0 +1,84 @@ +play24 := module() + export ModuleApply; + local cheating; + cheating := proc(input, digits) + local i, j, stringDigits; + use StringTools in + stringDigits := Implode([seq(convert(i, string), i in digits)]); + for i in digits do + for j in digits do + if Search(cat(convert(i, string), j), input) > 0 then + return true, ": Please don't combine digits to form another number." + end if; + end do; + end do; + for i in digits do + if CountCharacterOccurrences(input, convert(i, string)) < CountCharacterOccurrences(stringDigits, convert(i, string)) then + return true, ": Please use all digits."; + end if; + end do; + for i in digits do + if CountCharacterOccurrences(input, convert(i, string)) > CountCharacterOccurrences(stringDigits, convert(i, string)) then + return true, ": Please only use a digit once."; + end if; + end do; + for i in input do + try + if type(parse(i), numeric) and not member(parse(i), digits) then + return true, ": Please only use the digits you were given."; + end if; + catch: + end try; + end do; + return false, ""; + end use; + end proc: + + ModuleApply := proc() + local replay, digits, err, message, answer; + randomize(): + replay := "": + while not replay = "END" do + if not replay = "YES" then + digits := [seq(rand(1..9)(), i = 1..4)]: + end if; + err := true: + while err do + message := ""; + printf("Please make 24 from the digits: %a. Press enter for a new set of numbers or type END to quit\n", digits); + answer := StringTools[UpperCase](readline()); + if not answer = "" and not answer = "END" then + try + if not type(parse(answer), numeric) then + error; + elif cheating(answer, digits)[1] then + message := cheating(answer, digits)[2]; + error; + end if; + err := false; + catch: + printf("Invalid Input%s\n\n", message); + end try; + else + err := false; + end if; + end do: + if not answer = "" and not answer = "END" then + if parse(answer) = 24 then + printf("You win! Do you wish to play another game? (Press enter for a new set of numbers or END to quit.)\n"); + replay := StringTools[UpperCase](readline()); + else + printf("Your expression evaluated to %a. Try again!\n", parse(answer)); + replay := "YES"; + end if; + else + replay := answer; + end if; + + printf("\n"); + end do: + printf("GAME OVER\n"); + end proc: +end module: + +play24(); diff --git a/Task/24-game/Perl-6/24-game.pl6 b/Task/24-game/Perl-6/24-game.pl6 index bef0c6aa5f..3227007d18 100644 --- a/Task/24-game/Perl-6/24-game.pl6 +++ b/Task/24-game/Perl-6/24-game.pl6 @@ -1,3 +1,5 @@ +use MONKEY-SEE-NO-EVAL; + say "Here are your digits: ", constant @digits = (1..9).roll(4)».Str; @@ -9,15 +11,16 @@ grammar Exp24 { } while my $exp = prompt "\n24? " { - if Exp24.parse: $exp { - say "You win :)"; - last; + if try Exp24.parse: $exp { + say "You win :)"; + last; } else { - say pick 1, - 'Sorry. Try again.' xx 20, - 'Try harder.' xx 5, - 'Nope. Not even close.' xx 2, - 'Are you five or something?', - 'Come on, you can do better than that.'; + say ( + 'Sorry. Try again.' xx 20, + 'Try harder.' xx 5, + 'Nope. Not even close.' xx 2, + 'Are you five or something?', + 'Come on, you can do better than that.' + ).flat.pick } } diff --git a/Task/24-game/Python/24-game.py b/Task/24-game/Python/24-game.py index 0d534555e9..0a5a6e38c9 100644 --- a/Task/24-game/Python/24-game.py +++ b/Task/24-game/Python/24-game.py @@ -64,4 +64,5 @@ def main(): if ans == 24: print ("Thats right!") print ("Thank you and goodbye") -main() + +if __name__ == '__main__': main() diff --git a/Task/24-game/REXX/24-game-1.rexx b/Task/24-game/REXX/24-game-1.rexx index 6a11702185..9709af0e5e 100644 --- a/Task/24-game/REXX/24-game-1.rexx +++ b/Task/24-game/REXX/24-game-1.rexx @@ -1,73 +1,68 @@ -/*REXX program which allows a user to play the game of 24 (twenty-four). */ -numeric digits 15 /*allow more leeway when computing #s. */ -parse arg yyy /*get the optional arguments from C.L. */ - yyy = space(yyy,0) /*remove extraneous blanks from YYY. */ -parse var yyy start '-' fin /*get the START and FINish (maybe). */ - fin = word(fin start,1) /*if no FINish specified, use START.*/ - opers = '+-*/' /*define the legal arithmetic operators*/ - ops = length(opers) /* ··· and the count of them (length). */ -groupSymbols = '()[]{}' /*legal grouping symbols for this game.*/ - indent = left('',30) /*used to indent display of solutions. */ - Lpar = '(' /*a string to make the output prettier.*/ - Rpar = ')' /*Ditto. [You can say that again.] */ - digs = 123456789 /*numerals (digits) that can be used. */ - show = 1 /*flag used show solutions (0 = not). */ - do j=1 for ops /*define a version for fast execution. */ - @.j=substr(opers,j,1) /*assign each operation to an array. */ - end /*j*/ -signal on syntax /*enable program to trap syntax errors.*/ -if yyy\=='' then do /*if START (or FINish), then solve 'em.*/ - sols=solve(start,fin) /*solve START ───► FINish. */ - if sols <0 then exit 13 /*Was there a problem with input? */ - if sols==0 then sols='No' /*Englishize the SOLS variable.*/ - say; say sols 'unique solution's(sols) "found for" yyy - exit /*S [↑] does pluralizations. */ - end -show=0 /*stop SOLVE from blabbing solutions.*/ +/*REXX program supports a human to play the game of 24 (twenty-four) with error checking*/ +numeric digits 15 /*allow more leeway when computing #s. */ +parse arg yyy /*get the optional arguments from C.L. */ + yyy = space(yyy, 0) /*remove extraneous blanks from YYY. */ +parse var yyy start '-' fin /*get the START and FINish (maybe). */ + fin = word(fin start, 1) /*if no FINish specified, use START.*/ + ops = '+-*/' ; Lops = length(0ps) /*define the legal arithmetic operators*/ +groupSym = '()[]{}' /*legal grouping symbols for this game.*/ + indent = left('', 30) /*used to indent display of solutions. */ + Lpar = '(' ; Rpar = ')' /*strings to make the output prettier.*/ + digs = 123456789 /*numerals (digits) that can be used. */ + show = 1 /*flag used show solutions (0 = not). */ + do j=1 for Lops; @.j=substr(ops,j,1) /*define a version for fast execution. */ + end /*j*/ +signal on syntax /*enable program to trap syntax errors.*/ +if yyy\=='' then do; sols=solve(start, fin) /*solve from START ───► FINish. */ + if sols <0 then exit 13 /*Was there a problem with the input? */ + if sols==0 then sols='No' /*Englishize the SOLS variable value*/ + say; say sols 'unique solution's(sols) "found for" yyy + exit /*S [↑] does pluralizations. */ + end +show=0 /*stop SOLVE from blabbing solutions.*/ do forever; rrrr=random(1111, 9999) - if pos(0, rrrr)\==0 then iterate /*if contains a zero, ignore it*/ - if solve(rrrr)\==0 then leave /*if solved, then stop looking.*/ + if pos(0, rrrr)\==0 then iterate /*if it contains a zero, then ignore it*/ + if solve(rrrr) \==0 then leave /*if solved, then we can stop looking. */ end /*forever*/ -show=1 /*enable SOLVE to display solutions. */ -rrrr=sort(rrrr) /*sort four digits (for consistency). */ +show=1 /*enable SOLVE to display solutions. */ +rrrr=sort(rrrr); Lrrrr=length(rrrr) /*sort four digits (for consistency). */ $.=0 - do j=1 for length(rrrr) /*digit count for each digit in RRRR. */ - _=substr(rrrr, j, 1) /*pick off one of the digits in RRRR. */ - $._=countDigs(rrrr, _) /*define the count for this digit. */ - end /*j*/ /* [↑] counts duplicates twice, no harm*/ + do j=1 for Lrrrr; _=substr(rrrr,j,1) /*digit count for each digit in RRRR. */ + $._= countDigs(rrrr, _) /*define the count for this digit. */ + end /*j*/ /* [↑] counts duplicates twice, no harm*/ -prompt= 'Using the digits' rrrr", enter an expression that equals 24 (or QUIT):" - /* [↓] ITERATE needs a variable name.*/ - do prompter=0; say; say prompt /*display blank line and the prompt (P)*/ - pull y; y=space(y,0) /*get Y from CL, then remove all blanks*/ - if abbrev('QUIT',y,1) then exit /*Does the user want to quit this game?*/ - _v=verify(y, digs || opers || groupSymbols); a=substr(y, max(1,_v), 1) - if _v\==0 then do; call ger 'invalid character:' a; iterate; end - if pos('**',y) then do; call ger 'invalid ** operator'; iterate; end - if pos('//',y) then do; call ger 'invalid // operator'; iterate; end - yL=length(y) - if y=='' then do; call validate y; iterate; end +__ = copies('─', 9) /*used for output highlighting. */ +prompt= 'Using the digits ' rrrr", enter an expression that equals 24 (or QUIT):" + /* [↓] ITERATE needs a variable name.*/ + do prompter=0; say; say __ prompt /*display blank line and the prompt (P)*/ + pull y; y=space(y, 0) /*get Y from CL, then remove all blanks*/ + if abbrev('QUIT', y, 1) then exit 0 /*Does the user want to quit this game?*/ + _v=verify(y, digs || ops || groupSym); a=substr(y, max(1,_v), 1) + if _v\==0 then do; call ger "invalid character:" a; iterate; end + if pos('**', y) then do; call ger "invalid ** operator"; iterate; end + if pos('//', y) then do; call ger "invalid // operator"; iterate; end + Ly=length(y) + if y=='' then do; call validate y; iterate; end - do j=1 for yL-1; if \datatype(substr(y, j ,1), 'W') then iterate - if \datatype(substr(y, j+1,1), 'W') then iterate + do j=1 for Ly-1; if \datatype(substr(y, j , 1), 'W') then iterate + if \datatype(substr(y, j+1, 1), 'W') then iterate call ger 'invalid use of "digit abuttal".' iterate prompter end /*j*/ - yd=countDigs(y, digs) /*count of the digits 1──►9 (123456789)*/ - if yd<4 then do; call ger 'not enough digits entered.'; iterate prompter; end - if yd>4 then do; call ger 'too many digits entered.' ; iterate prompter; end + yd=countDigs(y, digs) /*count of the digits 1──►9 (123456789)*/ + if yd<4 then do; call ger 'not enough digits entered.'; iterate /*prompter*/; end + if yd>4 then do; call ger 'too many digits entered.' ; iterate /*prompter*/; end - do j=1 for 9; if $.j==0 then iterate - _d=countDigs(y, j); if $.j==_d then iterate - if _d<$.j then call ger 'not enough' j "digits, must be" $.j - else call ger 'too many' j "digits, must be" $.j + do j=1 for 9; if $.j==0 then iterate + _d=countDigs(y, j); if $.j==_d then iterate + if _d<$.j then call ger 'not enough' j "digits, must be" $.j + else call ger 'too many' j "digits, must be" $.j iterate prompter end /*j*/ - y=translate(y, '()()', "[]{}") - interpret 'ans=' y; ans=ans/1; if ans==24 then leave prompter - say 'incorrect, ' y'='ans + interpret 'ans=' translate(y, '()()', "[]{}"); ans=ans/1 + if ans==24 then leave prompter; say 'incorrect, ' y"="ans end /*prompter*/ say; say center('┌─────────────────────┐', 79) @@ -75,84 +70,65 @@ say; say center('┌──────────────── say center('│ congratulations ! │', 79) say center('│ │', 79) say center('└─────────────────────┘', 79) -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────one─liner subroutines─────────────────────*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ countDigs: arg ?; return length(?) - length(space(translate(?, , arg(2)), 0)) -div: if arg(1)=0 then return 7e9; return arg(1) /*if ÷ by 0, fudge result*/ -ger: say; say '***error!*** for argument:' y; say arg(1); say;errCode=1;return 0 -s: if arg(1)==1 then return ''; return 's' /*simple pluralizer.*/ -syntax: call ger 'illegal syntax in' y; exit -/*──────────────────────────────────SOLVE subroutine──────────────────────────*/ -solve: parse arg ssss, ffff /*parse the argument passed to SOLVE. */ -if ffff=='' then ffff=ssss /*create a FFFF if necessary. */ -if \validate(ssss) then return -1 /*validate the SSSS field. */ -if \validate(ffff) then return -1 /* " " FFFF " */ -#=0 /*number of found solutions (so far). */ -!.=0 /*a method to hold unique expressions. */ - /*alternative: indent=copies(' ',30) */ +div: if arg(1)=0 then return 7e9; return arg(1) /*÷ by 0? Fudge result*/ +ger: say; say __ '***error*** for expression:' y; say __ arg(1); say; OK=0; return 0 +s: if arg(1)==1 then return ''; return "s" /*a simple pluralizer.*/ +syntax: call ger 'illegal syntax in' y; exit +/*──────────────────────────────────────────────────────────────────────────────────────*/ +solve: parse arg ssss, ffff /*parse the argument passed to SOLVE. */ + if ffff=='' then ffff=ssss /*create a FFFF if necessary. */ + if \validate(ssss) then return -1 /*validate the SSSS field. */ + if \validate(ffff) then return -1 /* " " FFFF " */ + #=0 /*number of found solutions (so far). */ + !.=0 /*a method to hold unique expressions. */ + /*alternative: indent=copies(' ',30) */ + do g=ssss to ffff /*process a (possible) range of values.*/ + if pos(0, g)\==0 then iterate /*ignore values with zero in them. */ - do g=ssss to ffff /*process a (possible) range of values.*/ - if pos(0, g)\==0 then iterate /*ignore values with zero in them. */ + do j=1 for 4; g.j=substr(g, j, 1) /*define a version for fast execution. */ + end /*j*/ - do j=1 for 4 /*define a version for fast execution. */ - g.j=substr(g, j, 1) /*extract each digit of G into array.*/ - end /*j*/ + do i =1 for Lops /*insert an operator after 1st number. */ + do j =1 for Lops /* " " " " 2nd " */ + do k =1 for Lops /* " " " " 3rd " */ + do m=0 to 3; L.= /*assume no left parenthesis (so far).*/ + do n=m+1 to 4; L.m=Lpar; R.= /*match left paren with a right paren. */ + if m==1 & n==2 then L.= /*special case of : (n) + ··· */ + else if m\==0 then R.n=Rpar /*no (, no )*/ + e= L.1 g.1 @.i L.2 g.2 @.j L.3 g.3 R.3 @.k g.4 R.4 + e=space(e, 0) /*remove all blanks from the expression*/ + yyyE=e /*keep old the version for the display.*/ + /* [↓] change /(yyy) ═══► /div(yyy) */ + if pos('/(', e)\==0 then e=changestr( "/(", e, '/div(' ) + if !.e then iterate /*was this expression already used? */ + !.e=1 /*mark this expression as being used. */ + interpret 'x=' e /*have REXX do all the heavy lifting */ + if x\=24 then iterate /*Is the result incorrect? Try again. */ + #=#+1 /*bump number of found solutions. */ + if show then say indent 'a solution:' translate(yyyE, '][', ")(") + end /*n*/ /* [↑] display a (single) solution. */ + end /*m*/ + end /*k*/ + end /*j*/ + end /*i*/ + end /*g*/ - do i =1 for ops /*insert an operator after 1st number. */ - do j =1 for ops /*insert an operator after 2nd number. */ - do k =1 for ops /*insert an operator after 2nd number. */ - do m=0 to 3; L.= /*assume no left parenthesis so far. */ - do n=m+1 to 4 /*match left paren with a right paren. */ - L.m=Lpar /*define a left paren, m=0 means ignore*/ - R.= /*un-define all right parenthesis. */ - if m==1 & n==2 then L.= /*special case of : (n) + ··· */ - else if m\==0 then R.n=Rpar /*no (, no )*/ - e = L.1 g.1 @.i L.2 g.2 @.j L.3 g.3 R.3 @.k g.4 R.4 - e=space(e, 0) /*remove all blanks from the expression*/ - /* [↓] change expression: */ - /* /(yyy) ═══► /div(yyy) */ - /*Enables to check for division by zero*/ - yyyE=e /*keep old the version for the display.*/ - if pos('/(', e)\==0 then e=changestr( '/(', e, "/div(" ) - /* [↓] INTERPRET stresses REXX's groin,*/ - /* so try to avoid repeated lifting.*/ - if !.e then iterate /*was this expression already used? */ - !.e=1 /*mark this expression as being used. */ - interpret 'x=' e /*have REXX do all the heavy lifting */ - x=x/1 /*remove any trailing decimal point. */ - if x\==24 then iterate /*Is the result incorrect? Try again. */ - #=#+1 /*bump number of found solutions. */ - _=translate(yyyE, '][', ")(") /*display [], not (). */ - if show then say indent 'a solution:' _ - end /*n*/ /* [↑] show a solution.*/ - end /*m*/ - end /*k*/ - end /*j*/ - end /*i*/ - end /*g*/ - -return # -/*──────────────────────────────────SORT subroutine───────────────────────────*/ -sort: procedure; arg nnnn; L=length(nnnn) - - do i=1 for L /*build an array of digits from NNNN. */ - s.i=substr(nnnn, i, 1) /*this enables SORT to sort an array. */ - end /*i*/ - - do j=1 for L; _=s.j - do k=j+1 to L - if s.k<_ then parse value s.j s.k with s.k s.j - end /*k*/ - end /*j*/ -return s.1 || s.2 || s.3 || s.4 -/*──────────────────────────────────VALIDATE subroutine───────────────────────*/ -validate: parse arg y; errCode=0; _v=verify(y,digs) - select - when y=='' then call ger 'no digits entered.' - when length(y)<4 then call ger 'not enough digits entered, must be four.' - when length(y)>4 then call ger 'too many digits entered, must be four.' - when pos(0,y)\==0 then call ger "can't use the digit 0 (zero)." - when _v\==0 then call ger 'illegal character: ' substr(y,_v,1) - otherwise nop - end /*select*/ -return \errCode + return # +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sort: procedure; parse arg #; L=length(#); !.= /*this is a modified bin sort.*/ + do d=1 for L; _=substr(#, d, 1); !.d=!.d || _; end /*d*/ + return space(!.0 !.1 !.2 !.3 !.4 !.5 !.6 !.7 !.8 !.9, 0) /*reconstitute the #.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +validate: parse arg y; OK=1; _v=verify(y,digs); DE='digits entered, there must be four.' + select + when y=='' then call ger "no" DE + when length(y)<4 then call ger "not enough" DE + when length(y)>4 then call ger "too many" DE + when pos(0,y)\==0 then call ger "can't use the digit 0 (zero)." + when _v\==0 then call ger "illegal character: " substr(y, _v, 1) + otherwise nop + end /*select*/ + return OK diff --git a/Task/24-game/Ruby/24-game.rb b/Task/24-game/Ruby/24-game.rb index 1e6ef926b4..fde9726d23 100644 --- a/Task/24-game/Ruby/24-game.rb +++ b/Task/24-game/Ruby/24-game.rb @@ -1,16 +1,14 @@ -def validate(guess, nums) - name, error = - { - invalid_character: ->(str){ !str.scan(%r{[^\d\s()+*/-]}).empty? }, - wrong_number: ->(str){ str.scan(/\d/).map(&:to_i).sort != nums.sort }, - multi_digit_number: ->(str){ str.match(/\d\d/) } - } - .find {|name, validator| validator[guess] } - - error ? puts("Invalid input of a(n) #{name.to_s.tr('_',' ')}!") : true -end - class Guess < String + def self.play + nums = Array.new(4){rand(1..9)} + loop do + result = get(nums).evaluate! + break if result == 24.0 + puts "Try again! That gives #{result}!" + end + puts "You win!" + end + def self.get(nums) loop do print "\nEnter a guess using #{nums}: " @@ -19,24 +17,24 @@ class Guess < String end end + def self.validate(guess, nums) + name, error = + { + invalid_character: ->(str){ !str.scan(%r{[^\d\s()+*/-]}).empty? }, + wrong_number: ->(str){ str.scan(/\d/).map(&:to_i).sort != nums.sort }, + multi_digit_number: ->(str){ str.match(/\d\d/) } + } + .find {|name, validator| validator[guess] } + + error ? puts("Invalid input of a(n) #{name.to_s.tr('_',' ')}!") : true + end + def evaluate! - as_rat = gsub(/(\d)/, 'Rational(\1,1)') - begin - eval "(#{as_rat}).to_f" - rescue SyntaxError - "[syntax error]" - end + as_rat = gsub(/(\d)/, '\1r') # r : Rational suffix + eval "(#{as_rat}).to_f" + rescue SyntaxError + "[syntax error]" end end -def play - nums = Array.new(4){rand(1..9)} - loop do - result = Guess.get(nums).evaluate! - break if result == 24.0 - puts "Try again! That gives #{result}!" - end - puts "You win!" -end - -play +Guess.play diff --git a/Task/24-game/Rust/24-game.rust b/Task/24-game/Rust/24-game.rust new file mode 100644 index 0000000000..bdcad8b01d --- /dev/null +++ b/Task/24-game/Rust/24-game.rust @@ -0,0 +1,102 @@ +use std::io::{self,BufRead}; +extern crate rand; +use rand::Rng; + +fn op_type(x: char) -> i32{ + match x { + '-' | '+' => return 1, + '/' | '*' => return 2, + '(' | ')' => return -1, + _ => return 0, + } +} + +fn to_rpn(input: &mut String){ + + let mut rpn_string : String = String::new(); + let mut rpn_stack : String = String::new(); + let mut last_token = '#'; + for token in input.chars(){ + if token.is_digit(10) { + rpn_string.push(token); + } + else if op_type(token) == 0 { + continue; + } + else if op_type(token) > op_type(last_token) || token == '(' { + rpn_stack.push(token); + last_token=token; + } + else { + while let Some(top) = rpn_stack.pop() { + if top=='(' { + break; + } + rpn_string.push(top); + } + if token != ')'{ + rpn_stack.push(token); + } + } + } + while let Some(top) = rpn_stack.pop() { + rpn_string.push(top); + } + + println!("you formula results in {}", rpn_string); + + *input=rpn_string; +} + +fn calculate(input: &String, list : &mut [u32;4]) -> f32{ + let mut stack : Vec = Vec::new(); + let mut accumulator : f32 = 0.0; + + for token in input.chars(){ + if token.is_digit(10) { + let test = token.to_digit(10).unwrap() as u32; + match list.iter().position(|&x| x == test){ + Some(idx) => list[idx]=10 , + _ => println!(" invalid digit: {} ",test), + } + stack.push(accumulator); + accumulator = test as f32; + }else{ + let a = stack.pop().unwrap(); + accumulator = match token { + '-' => a-accumulator, + '+' => a+accumulator, + '/' => a/accumulator, + '*' => a*accumulator, + _ => {accumulator},//NOP + }; + } + } + println!("you formula results in {}",accumulator); + accumulator +} + +fn main() { + + let mut rng = rand::thread_rng(); + let mut list :[u32;4]=[rng.gen::()%10,rng.gen::()%10,rng.gen::()%10,rng.gen::()%10]; + + println!("form 24 with using + - / * {:?}",list); + //get user input + let mut input = String::new(); + io::stdin().read_line(&mut input).unwrap(); + //convert to rpn + to_rpn(&mut input); + let result = calculate(&input, &mut list); + + if list.iter().any(|&list| list !=10){ + println!("and you used all numbers"); + match result { + 24.0 => println!("you won"), + _ => println!("but your formulla doesn't result in 24"), + } + }else{ + println!("you didn't use all the numbers"); + } + +} diff --git a/Task/24-game/ZX-Spectrum-Basic/24-game.zx b/Task/24-game/ZX-Spectrum-Basic/24-game.zx new file mode 100644 index 0000000000..391a4e21fd --- /dev/null +++ b/Task/24-game/ZX-Spectrum-Basic/24-game.zx @@ -0,0 +1,52 @@ +10 LET n$="" +20 RANDOMIZE +30 FOR i=1 TO 4 +40 LET n$=n$+STR$ (INT (RND*9)+1) +50 NEXT i +60 LET i$="": LET f$="": LET p$="" +70 CLS +80 PRINT "24 game" +90 PRINT "Allowed characters:" +100 LET i$=n$+"+-*/()" +110 PRINT AT 4,0; +120 FOR i=1 TO 10 +130 PRINT i$(i);" "; +140 NEXT i +150 PRINT "(0 to end)" +160 INPUT "Enter the formula";f$ +170 IF f$="0" THEN STOP +180 PRINT AT 6,0;f$;" = "; +190 FOR i=1 TO LEN f$ +200 LET c$=f$(i) +210 IF c$=" " THEN LET f$(i)="": GO TO 250 +220 IF c$="+" OR c$="-" OR c$="*" OR c$="/" THEN LET p$=p$+"o": GO TO 250 +230 IF c$="(" OR c$=")" THEN LET p$=p$+c$: GO TO 250 +240 LET p$=p$+"n" +250 NEXT i +260 RESTORE +270 FOR i=1 TO 11 +280 READ t$ +290 IF t$=p$ THEN LET i=11 +300 NEXT i +310 IF t$<>p$ THEN PRINT INVERSE 1;"Bad construction!": BEEP 1,.1: PAUSE 0: GO TO 60 +320 FOR i=1 TO LEN f$ +330 FOR j=1 TO 10 +340 IF (f$(i)=i$(j)) AND f$(i)>"0" AND f$(i)<="9" THEN LET i$(j)=" " +350 NEXT j +360 NEXT i +370 IF i$( TO 4)<>" " THEN PRINT FLASH 1;"Invalid arguments!": BEEP 1,.01: PAUSE 0: GO TO 60 +380 LET r=VAL f$ +390 PRINT r;" "; +400 IF r<>24 THEN PRINT FLASH 1;"Wrong!": BEEP 1,1: PAUSE 0: GO TO 60 +410 PRINT FLASH 1;"Correct!": PAUSE 0: GO TO 10 +420 DATA "nononon" +430 DATA "(non)onon" +440 DATA "nono(non)" +450 DATA "no(no(non))" +460 DATA "((non)on)on" +470 DATA "no(non)on" +480 DATA "(non)o(non)" +485 DATA "no((non)on)" +490 DATA "(nonon)on" +495 DATA "(no(non))on" +500 DATA "no(nonon)" diff --git a/Task/9-billion-names-of-God-the-integer/00DESCRIPTION b/Task/9-billion-names-of-God-the-integer/00DESCRIPTION index 650f143d7d..12a6cd28e3 100644 --- a/Task/9-billion-names-of-God-the-integer/00DESCRIPTION +++ b/Task/9-billion-names-of-God-the-integer/00DESCRIPTION @@ -1,14 +1,17 @@ This task is a variation of the [[wp:The Nine Billion Names of God#Plot_summary|short story by Arthur C. Clarke]]. + (Solvers should be aware of the consequences of completing this task.) -In detail, to specify what is meant by a “name”: -:The integer 1 has 1 name “1”. -:The integer 2 has 2 names “1+1”, and “2”. -:The integer 3 has 3 names “1+1+1”, “2+1”, and “3”. -:The integer 4 has 5 names “1+1+1+1”, “2+1+1”, “2+2”, “3+1”, “4”. -:The integer 5 has 7 names “1+1+1+1+1”, “2+1+1+1”, “2+2+1”, “3+1+1”, “3+2”, “4+1”, “5”. + +In detail, to specify what is meant by a   “name”: +:The integer 1 has 1 name     “1”. +:The integer 2 has 2 names   “1+1”,   and   “2”. +:The integer 3 has 3 names   “1+1+1”,   “2+1”,   and   “3”. +:The integer 4 has 5 names   “1+1+1+1”,   “2+1+1”,   “2+2”,   “3+1”,   “4”. +:The integer 5 has 7 names   “1+1+1+1+1”,   “2+1+1+1”,   “2+2+1”,   “3+1+1”,   “3+2”,   “4+1”,   “5”. + ;Task -The task is to display the first 25 rows of a number triangle which begins: +Display the first 25 rows of a number triangle which begins:
                                       1
                                     1   1
@@ -18,11 +21,18 @@ The task is to display the first 25 rows of a number triangle which begins:
                             1   3   3   2   1   1
 
-Where row n corresponds to integer n, and each column C in row m from left to right corresponds to the number of names begining with C. +Where row   n   corresponds to integer   n,   and each column   C   in row   m   from left to right corresponds to the number of names beginning with   C. + +A function   G(n)   should return the sum of the   n-th   row. + +Demonstrate this function by displaying:   G(23),   G(123),   G(1234),   and   G(12345). + +Optionally note that the sum of the   n-th   row   P(n)   is the   [http://mathworld.wolfram.com/PartitionFunctionP.html   integer partition function]. + +Demonstrate this is equivalent to   G(n)   by displaying:   P(23),   P(123),   P(1234),   and   P(12345). -A function G(n) should return the sum of the n-th row. Demonstrate this function by displaying: G(23), G(123), G(1234), and G(12345). -Optionally note that the sum of the n-th row P(n) is the [http://mathworld.wolfram.com/PartitionFunctionP.html integer partition function]. Demonstrate this is equivalent to G(n) by displaying: P(23), P(123), P(1234), and P(12345). ;Extra credit -If your environment is able, plot P(n) against n for n=1\ldots 999. +If your environment is able, plot   P(n)   against   n   for   n=1\ldots 999. +

diff --git a/Task/9-billion-names-of-God-the-integer/Elixir/9-billion-names-of-god-the-integer.elixir b/Task/9-billion-names-of-God-the-integer/Elixir/9-billion-names-of-god-the-integer.elixir new file mode 100644 index 0000000000..df84201441 --- /dev/null +++ b/Task/9-billion-names-of-God-the-integer/Elixir/9-billion-names-of-god-the-integer.elixir @@ -0,0 +1,12 @@ +defmodule God do + def g(n,g) when g == 1 or n < g, do: 1 + def g(n,g) do + Enum.reduce(2..g, 1, fn q,res -> + res + (if q > n-g, do: 0, else: g(n-g,q)) + end) + end +end + +Enum.each(1..25, fn n -> + IO.puts Enum.map(1..n, fn g -> "#{God.g(n,g)} " end) +end) diff --git a/Task/9-billion-names-of-God-the-integer/Frink/9-billion-names-of-god-the-integer.frink b/Task/9-billion-names-of-God-the-integer/Frink/9-billion-names-of-god-the-integer-1.frink similarity index 100% rename from Task/9-billion-names-of-God-the-integer/Frink/9-billion-names-of-god-the-integer.frink rename to Task/9-billion-names-of-God-the-integer/Frink/9-billion-names-of-god-the-integer-1.frink diff --git a/Task/9-billion-names-of-God-the-integer/Frink/9-billion-names-of-god-the-integer-2.frink b/Task/9-billion-names-of-God-the-integer/Frink/9-billion-names-of-god-the-integer-2.frink new file mode 100644 index 0000000000..3e352ff030 --- /dev/null +++ b/Task/9-billion-names-of-God-the-integer/Frink/9-billion-names-of-god-the-integer-2.frink @@ -0,0 +1,33 @@ +PrintArray(List([1 .. 25], n -> List([1 .. n], k -> NrPartitions(n, k)))); + +[ [ 1 ], + [ 1, 1 ], + [ 1, 1, 1 ], + [ 1, 2, 1, 1 ], + [ 1, 2, 2, 1, 1 ], + [ 1, 3, 3, 2, 1, 1 ], + [ 1, 3, 4, 3, 2, 1, 1 ], + [ 1, 4, 5, 5, 3, 2, 1, 1 ], + [ 1, 4, 7, 6, 5, 3, 2, 1, 1 ], + [ 1, 5, 8, 9, 7, 5, 3, 2, 1, 1 ], + [ 1, 5, 10, 11, 10, 7, 5, 3, 2, 1, 1 ], + [ 1, 6, 12, 15, 13, 11, 7, 5, 3, 2, 1, 1 ], + [ 1, 6, 14, 18, 18, 14, 11, 7, 5, 3, 2, 1, 1 ], + [ 1, 7, 16, 23, 23, 20, 15, 11, 7, 5, 3, 2, 1, 1 ], + [ 1, 7, 19, 27, 30, 26, 21, 15, 11, 7, 5, 3, 2, 1, 1 ], + [ 1, 8, 21, 34, 37, 35, 28, 22, 15, 11, 7, 5, 3, 2, 1, 1 ], + [ 1, 8, 24, 39, 47, 44, 38, 29, 22, 15, 11, 7, 5, 3, 2, 1, 1 ], + [ 1, 9, 27, 47, 57, 58, 49, 40, 30, 22, 15, 11, 7, 5, 3, 2, 1, 1 ], + [ 1, 9, 30, 54, 70, 71, 65, 52, 41, 30, 22, 15, 11, 7, 5, 3, 2, 1, 1 ], + [ 1, 10, 33, 64, 84, 90, 82, 70, 54, 42, 30, 22, 15, 11, 7, 5, 3, 2, 1, 1 ], + [ 1, 10, 37, 72, 101, 110, 105, 89, 73, 55, 42, 30, 22, 15, 11, 7, 5, 3, 2, 1, 1 ], + [ 1, 11, 40, 84, 119, 136, 131, 116, 94, 75, 56, 42, 30, 22, 15, 11, 7, 5, 3, 2, 1, 1 ], + [ 1, 11, 44, 94, 141, 163, 164, 146, 123, 97, 76, 56, 42, 30, 22, 15, 11, 7, 5, 3, 2, 1, 1 ], + [ 1, 12, 48, 108, 164, 199, 201, 186, 157, 128, 99, 77, 56, 42, 30, 22, 15, 11, 7, 5, 3, 2, 1, 1 ], + [ 1, 12, 52, 120, 192, 235, 248, 230, 201, 164, 131, 100, 77, 56, 42, 30, 22, 15, 11, 7, 5, 3, 2, 1, 1 ] ] + + +List([23, 123, 1234, 12345], NrPartitions); + +[ 1255, 2552338241, 156978797223733228787865722354959930, + 69420357953926116819562977205209384460667673094671463620270321700806074195845953959951425306140971942519870679768681736 ] diff --git a/Task/9-billion-names-of-God-the-integer/J/9-billion-names-of-god-the-integer-4.j b/Task/9-billion-names-of-God-the-integer/J/9-billion-names-of-god-the-integer-4.j index b2c645086a..b3ebb4c029 100644 --- a/Task/9-billion-names-of-God-the-integer/J/9-billion-names-of-god-the-integer-4.j +++ b/Task/9-billion-names-of-God-the-integer/J/9-billion-names-of-god-the-integer-4.j @@ -1,11 +1,11 @@ rowSums=: 3 :0"0 -z=. (y+1){. 1x -for_ks. <\1+i.y do. - n=.{: k=.>ks - r=.#c=. ({.~* i._1:)(n,0.5 _1.5) p. k - s=.#d=.({.~* i._1:)c-r{.k - 'v i'=.|: \:~(c,d),. r ,&({.&k) s - a=. +/(n{z),(_1^1x+2|i) * v{z - z=. a n}z -end. + z=. (y+1){. 1x + for_ks. <\1+i.y do. + n=.{: k=.>ks + r=.#c=. ({.~* i._1:)(n,0.5 _1.5) p. k + s=.#d=.({.~* i._1:)c-r{.k + 'v i'=.|: \:~(c,d),. r ,&({.&k) s + a=. +/(n{z),(_1^1x+2|i) * v{z + z=. a n}z + end. ) diff --git a/Task/9-billion-names-of-God-the-integer/Java/9-billion-names-of-god-the-integer.java b/Task/9-billion-names-of-God-the-integer/Java/9-billion-names-of-god-the-integer.java new file mode 100644 index 0000000000..aab3e6ac94 --- /dev/null +++ b/Task/9-billion-names-of-God-the-integer/Java/9-billion-names-of-god-the-integer.java @@ -0,0 +1,41 @@ +import java.math.BigInteger; +import java.util.*; +import static java.util.Arrays.asList; +import static java.util.stream.Collectors.toList; +import static java.util.stream.IntStream.range; +import static java.lang.Math.min; + +public class Test { + + static List cumu(int n) { + List> cache = new ArrayList<>(); + cache.add(asList(BigInteger.ONE)); + + for (int L = cache.size(); L < n + 1; L++) { + List r = new ArrayList<>(); + r.add(BigInteger.ZERO); + for (int x = 1; x < L + 1; x++) + r.add(r.get(r.size() - 1).add(cache.get(L - x).get(min(x, L - x)))); + cache.add(r); + } + return cache.get(n); + } + + static List row(int n) { + List r = cumu(n); + return range(0, n).mapToObj(i -> r.get(i + 1).subtract(r.get(i))) + .collect(toList()); + } + + public static void main(String[] args) { + System.out.println("Rows:"); + for (int x = 1; x < 11; x++) + System.out.printf("%2d: %s%n", x, row(x)); + + System.out.println("\nSums:"); + for (int x : new int[]{23, 123, 1234}) { + List c = cumu(x); + System.out.printf("%s %s%n", x, c.get(c.size() - 1)); + } + } +} diff --git a/Task/9-billion-names-of-God-the-integer/Kotlin/9-billion-names-of-god-the-integer.kotlin b/Task/9-billion-names-of-God-the-integer/Kotlin/9-billion-names-of-god-the-integer.kotlin new file mode 100644 index 0000000000..063ee350cd --- /dev/null +++ b/Task/9-billion-names-of-God-the-integer/Kotlin/9-billion-names-of-god-the-integer.kotlin @@ -0,0 +1,29 @@ +fun namesOfGod(n: Int): List { + + val cache = ArrayList>() + cache.add(asList(BigInteger.ONE)) + + (cache.size..n).forEach { l -> + val r = ArrayList() + r.add(BigInteger.ZERO) + + (1..l).forEach { x -> + r.add(r[r.size - 1] + cache[l - x][min(x, l - x)]) + } + cache.add(r) + } + return cache[n] +} + +fun row(n: Int) = namesOfGod(n).let { r -> (0..n-1).map { r[it + 1] - r[it] } } + +println("Rows:") +(1..25).forEach { + System.out.printf("%2d: %s%n", it, row(it)) +} + +println("\nSums:") +intArrayOf(23, 123, 1234, 1234).forEach { + val c = namesOfGod(it) + System.out.printf("%s %s%n", it, c[c.size - 1]) +} diff --git a/Task/9-billion-names-of-God-the-integer/PARI-GP/9-billion-names-of-god-the-integer.pari b/Task/9-billion-names-of-God-the-integer/PARI-GP/9-billion-names-of-god-the-integer.pari new file mode 100644 index 0000000000..e1d7a3ee99 --- /dev/null +++ b/Task/9-billion-names-of-God-the-integer/PARI-GP/9-billion-names-of-god-the-integer.pari @@ -0,0 +1,5 @@ +row(n)=my(v=vector(n)); forpart(i=n,v[i[#i]]++); v; +show(n)=for(k=1,n,print(row(k))); +show(25) +apply(numbpart, [23,123,1234,12345]) +plot(x=1,999.9, numbpart(x\1)) diff --git a/Task/9-billion-names-of-God-the-integer/Perl-6/9-billion-names-of-god-the-integer.pl6 b/Task/9-billion-names-of-God-the-integer/Perl-6/9-billion-names-of-god-the-integer.pl6 index d3b8bd70f4..d61874dd56 100644 --- a/Task/9-billion-names-of-God-the-integer/Perl-6/9-billion-names-of-god-the-integer.pl6 +++ b/Task/9-billion-names-of-God-the-integer/Perl-6/9-billion-names-of-god-the-integer.pl6 @@ -1,4 +1,4 @@ -my @todo = [1]; +my @todo = $[1]; my @sums = 0; sub nextrow($n) { for +@todo .. $n -> $l { @@ -24,6 +24,6 @@ say .fmt('%2d'), ": ", nextrow($_)[] for 1..10; say "\nsums:"; -for 23, 123, 1234, 10000 { +for 23, 123, 1234, 12345 { say $_, "\t", [+] nextrow($_)[]; } diff --git a/Task/9-billion-names-of-God-the-integer/REXX/9-billion-names-of-god-the-integer.rexx b/Task/9-billion-names-of-God-the-integer/REXX/9-billion-names-of-god-the-integer.rexx index d47d43180a..04428c8133 100644 --- a/Task/9-billion-names-of-God-the-integer/REXX/9-billion-names-of-god-the-integer.rexx +++ b/Task/9-billion-names-of-God-the-integer/REXX/9-billion-names-of-god-the-integer.rexx @@ -1,52 +1,52 @@ -/*REXX program generates & shows a number triangle for partitions of a number.*/ -numeric digits 400 /*be able to handle larger numbers. */ -parse arg N .; if N=='' then N=25 /*N specified? Then use the default. */ +/*REXX program generates and displays a number triangle for partitions of a number. */ +numeric digits 400 /*be able to handle larger numbers. */ +parse arg N .; if N=='' then N=25 /*N specified? Then use the default. */ @.=0; @.0=1; aN=abs(N) -if N==N+0 then say ' G('aN"):" G(N) /*just for well formed numbers.*/ - say 'partitions('aN"):" partitions(aN) /*do it the easy way*/ -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────G subroutine──────────────────────────────*/ -G: procedure; parse arg nn; !.=0; mx=1; aN=abs(nn); build=nn>0 -!.4.2=2; do j=1 for aN%2; !.j.j=1; end /*j*/ /*gen shortcuts.*/ +if N==N+0 then say ' G('aN"):" G(N) /*just do this for well formed numbers.*/ + say 'partitions('aN"):" partitions(aN) /*do it the easy way.*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +G: procedure; parse arg nn; !.=0; mx=1; aN=abs(nn); build=nn>0 + !.4.2=2; do j=1 for aN%2; !.j.j=1; end /*j*/ /*generate some shortcuts.*/ - do t=1 for 1+build; #.=1 /*gen triangle once or twice ···*/ - do r=1 for aN; #.2=r%2 /*#.2 is a shortcut calculation.*/ - do c=3 to r-2; #.c=gen#(r,c); end /*c*/ - L=length(mx); p=0; __= /*__ will be a row (line) of triangle.*/ - do cc=1 for r /*only sum the last row of numbers. */ - p=p+#.cc /*add the last row of the triangle. */ - if \build then iterate /*should we skip building the triangle?*/ - mx=max(mx,#.cc) /*used to build the symmetric numbers. */ - __=__ right(#.cc,L) /*construct a row (or line) of triangle*/ - end /*cc*/ - if t==1 then iterate /*Is this the 1st time through? No show*/ - say center(strip(__), 2+(aN-1)*(length(mx)+1)) - end /*r*/ /* [↑] center the row of the triangle.*/ - end /*t*/ -return p /*return with the generated number. */ -/*──────────────────────────────────GEN# subroutine───────────────────────────*/ -gen#: procedure expose !.; parse arg x,y /*obtain X and Y arguments. */ -if !.x.y\==0 then return !.x.y /*was number generated before?*/ -if y>x%2 then do; nx=x+1-2*(y-x%2)-(x//2==0); ny=nx%2; !.x.y=!.nx.ny - return !.x.y /*return the calculated number*/ - end /* [↑] right half of triangle*/ -$=1 /* [↓] left " " " */ - do q=2 for y-1; xy=x-y; if q>xy then iterate - if q==2 then $=$+xy%2 - else if q==xy-1 then $=$+1 - else $=$+gen#(xy,q) /*recurse.*/ - end /*q*/ -!.x.y=$; return $ /*use memoization; return with number.*/ -/*──────────────────────────────────PARTITIONS subroutine─────────────────────*/ -partitions: procedure expose @.; parse arg n; if @.n\==0 then return @.n /*◄─┐*/ -$=0 /*Already known? Then return value►───┘*/ - do k=1 for n; _=n-(k*3-1)*k%2; if _<0 then leave - if @._==0 then x=partitions(_) /* [◄] recursive call.*/ - else x=@._ /*value already known. */ - _=_-k; if _<0 then y=0 /*recursive call ►────┐*/ - else if @._==0 then y=partitions(_) /*◄──┘*/ - else y=@._ - if k//2 then $=$+x+y /*utilize this method if K is odd. */ - else $=$2x-y /* " " " " " " even. */ - end /*k*/ /* [↑] Euler's recursive function. */ -@.n=$; return $ /*use memoization; return with number.*/ + do t=1 for 1+build; #.=1 /*generate triangle once or twice. */ + do r=1 for aN; #.2=r%2 /*#.2 is a shortcut calculation. */ + do c=3 to r-2; #.c=gen#(r,c); end /*c*/ + L=length(mx); p=0; __= /*__ will be a row of the triangle*/ + do cc=1 for r /*only sum the last row of numbers.*/ + p=p+#.cc /*add the last row of the triangle.*/ + if \build then iterate /*should we skip building triangle?*/ + mx=max(mx, #.cc) /*used to build the symmetric #s. */ + __=__ right(#.cc, L) /*construct a row of the triangle. */ + end /*cc*/ + if t==1 then iterate /*Is this 1st time through? No show*/ + say center(strip(__), 2+(aN-1)*(length(mx)+1)) + end /*r*/ /* [↑] center row of the triangle.*/ + end /*t*/ + return p /*return with the generated number.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +gen#: procedure expose !.; parse arg x,y /*obtain the X and Y arguments.*/ + if !.x.y\==0 then return !.x.y /*was number generated before ? */ + if y>x%2 then do; nx=x+1-2*(y-x%2)-(x//2==0); ny=nx%2; !.x.y=!.nx.ny + return !.x.y /*return the calculated number. */ + end /* [↑] right half of triangle. */ + $=1 /* [↓] left " " " */ + do q=2 for y-1; xy=x-y; if q>xy then iterate + if q==2 then $=$+xy%2 + else if q==xy-1 then $=$+1 + else $=$+gen#(xy,q) /*recurse.*/ + end /*q*/ + !.x.y=$; return $ /*use memoization; return with #.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +partitions: procedure expose @.; parse arg n; if @.n\==0 then return @.n /* ◄────────┐ */ + $=0 /*Already known? Return ►───┘ */ + do k=1 for n; _=n-(k*3-1)*k%2; if _<0 then leave + if @._==0 then x=partitions(_) /* [◄] recursive call.*/ + else x=@._ /*value already known. */ + _=_-k; if _<0 then y=0 /*recursive call ►────┐*/ + else if @._==0 then y=partitions(_) /*◄──┘*/ + else y=@._ + if k//2 then $=$+x+y /*use this method if K is odd. */ + else $=$-x-y /* " " " " " " even.*/ + end /*k*/ /* [↑] Euler's recursive func.*/ + @.n=$; return $ /*use memoization; return #. */ diff --git a/Task/9-billion-names-of-God-the-integer/Rust/9-billion-names-of-god-the-integer.rust b/Task/9-billion-names-of-God-the-integer/Rust/9-billion-names-of-god-the-integer.rust new file mode 100644 index 0000000000..f7d0da724a --- /dev/null +++ b/Task/9-billion-names-of-God-the-integer/Rust/9-billion-names-of-god-the-integer.rust @@ -0,0 +1,45 @@ +extern crate num; + +use std::cmp; +use num::bigint::BigUint; + +fn cumu(n: usize, cache: &mut Vec>) { + for l in cache.len()..n+1 { + let mut r = vec![BigUint::from(0u32)]; + for x in 1..l+1 { + let prev = r[r.len() - 1].clone(); + r.push(prev + cache[l-x][cmp::min(x, l-x)].clone()); + } + cache.push(r); + } +} + +fn row(n: usize, cache: &mut Vec>) -> Vec { + cumu(n, cache); + let r = &cache[n]; + let mut v: Vec = Vec::new(); + + for i in 0..n { + v.push(&r[i+1] - &r[i]); + } + v +} + +fn main() { + let mut cache = vec![vec![BigUint::from(1u32)]]; + + println!("rows:"); + for x in 1..26 { + let v: Vec = row(x, &mut cache).iter().map(|e| e.to_string()).collect(); + let s: String = v.join(" "); + println!("{}: {}", x, s); + } + + println!("sums:"); + for x in vec![23, 123, 1234, 12345] { + cumu(x, &mut cache); + let v = &cache[x]; + let s = v[v.len() - 1].to_string(); + println!("{}: {}", x, s); + } +} diff --git a/Task/99-Bottles-of-Beer/00DESCRIPTION b/Task/99-Bottles-of-Beer/00DESCRIPTION index b80cf19829..429e8fe81f 100644 --- a/Task/99-Bottles-of-Beer/00DESCRIPTION +++ b/Task/99-Bottles-of-Beer/00DESCRIPTION @@ -1,25 +1,29 @@ -'''The beersong'''
-In this puzzle, write code to print out -the entire "99 bottles of beer on the wall" song. +;Task: +Display the complete lyrics for the song:     '''99 bottles of beer on the wall'''. -For those who do not know the song, the lyrics follow this form: - X bottles of beer on the wall - X bottles of beer - Take one down, pass it around - X-1 bottles of beer on the wall - X-1 bottles of beer on the wall - ... - Take one down, pass it around - 0 bottles of beer on the wall +;The beersong: +The lyrics follow this form: + X bottles of beer on the wall + X bottles of beer + Take one down, pass it around + X-1 bottles of beer on the wall + + X-1 bottles of beer on the wall + ... + Take one down, pass it around + 0 bottles of beer on the wall Where X and X-1 are replaced by numbers of course. + Grammatical support for "1 bottle of beer" is optional. + As with any puzzle, try to do it in as creative/concise/comical a way as possible (simple, obvious solutions allowed, too). + ;See also: * http://99-bottles-of-beer.net/ * [[:Category:99_Bottles_of_Beer]] * [[:Category:Programming language families]] - -
+* [https://en.wikipedia.org/wiki/99_Bottles_of_Beer Wikipedia 99 bottles of beer] +

diff --git a/Task/99-Bottles-of-Beer/AppleScript/99-bottles-of-beer.applescript b/Task/99-Bottles-of-Beer/AppleScript/99-bottles-of-beer-1.applescript similarity index 100% rename from Task/99-Bottles-of-Beer/AppleScript/99-bottles-of-beer.applescript rename to Task/99-Bottles-of-Beer/AppleScript/99-bottles-of-beer-1.applescript diff --git a/Task/99-Bottles-of-Beer/AppleScript/99-bottles-of-beer-2.applescript b/Task/99-Bottles-of-Beer/AppleScript/99-bottles-of-beer-2.applescript new file mode 100644 index 0000000000..064bf47b16 --- /dev/null +++ b/Task/99-Bottles-of-Beer/AppleScript/99-bottles-of-beer-2.applescript @@ -0,0 +1,91 @@ +-- BRIEF + +on run + + intercalate("\n\n", ¬ + map(recitation, range(99, 0))) + +end run + + +-- DECLARATIVE + +script recitation + property coordinates : " on the wall" + property redistribution : "Take one down, pass it around" + property resort : "Better go to the store to buy some more" + property unit : "bottle" + + -- Int -> String + on lambda(n) + if n > 0 then + set reserve to resourceDescriptor(n) + set residue to resourceDescriptor(n - 1) + + intercalate(linefeed, ¬ + {reserve & coordinates, reserve, ¬ + redistribution, residue & coordinates}) + else + resort + end if + end lambda + + -- resourceDescriptor :: Int -> String + on resourceDescriptor(n) + if n ≠ 1 then + (n as string) & space & unit & "s" + else + "1 " & unit + end if + end resourceDescriptor +end script + + + +-- DYSFUNCTIONAL + +-- 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 + +-- range :: Int -> Int -> [Int] +on range(m, n) + if n < m then + set d to -1 + else + set d to 1 + end if + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range + +-- intercalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate + +-- 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 diff --git a/Task/99-Bottles-of-Beer/Bc/99-bottles-of-beer.bc b/Task/99-Bottles-of-Beer/Bc/99-bottles-of-beer.bc new file mode 100644 index 0000000000..50271dd870 --- /dev/null +++ b/Task/99-Bottles-of-Beer/Bc/99-bottles-of-beer.bc @@ -0,0 +1,14 @@ +i = 99; +while (i > -1) { + print i , " bottles of beer on the wall\n"; + print i , " bottles of beer\nTake one down, pass it around\n"; + if (i == 2) { + break + } + print --i , " bottles of beer on the wall\n"; +} + +print --i , " bottle of beer on the wall\n"; +print i , " bottle of beer on the wall\n"; +print i , " bottle of beer\nTake it down, pass it around\nno more bottles of beer on the wall\n"; +quit diff --git a/Task/99-Bottles-of-Beer/Dc/99-bottles-of-beer-1.dc b/Task/99-Bottles-of-Beer/Dc/99-bottles-of-beer-1.dc new file mode 100644 index 0000000000..c58331ca18 --- /dev/null +++ b/Task/99-Bottles-of-Beer/Dc/99-bottles-of-beer-1.dc @@ -0,0 +1,29 @@ +[ + dnrpr + dnlBP + lCP + 1-dnrp + rd2r >L +]sL + +[Take one down, pass it around +]sC +[ bottles of beer +]sB +[ bottles of beer on the wall] +99 + +lLx + +dnrpsA +dnlBP +lCP +1- +dn[ bottle of beer on the wall]p +rdnrpsA +n[ bottle of beer +]P +[Take it down, pass it around +]P +[no more bottles of beer on the wall +]P diff --git a/Task/99-Bottles-of-Beer/Dc/99-bottles-of-beer-2.dc b/Task/99-Bottles-of-Beer/Dc/99-bottles-of-beer-2.dc new file mode 100644 index 0000000000..83fd3b862c --- /dev/null +++ b/Task/99-Bottles-of-Beer/Dc/99-bottles-of-beer-2.dc @@ -0,0 +1,32 @@ +[ + plAP + plBP + lCP + 1-dplAP + d2r >L +]sL + +[Take one down, pass it around +]sC +[bottles of beer +]sB +[bottles of beer on the wall +]sA +99 + +lLx + +plAP +plBP +lCP +1- +p +[bottle of beer on the wall +]P +p +[bottle of beer +]P +[Take it down, pass it around +]P +[no more bottles of beer on the wall +]P diff --git a/Task/99-Bottles-of-Beer/Elena/99-bottles-of-beer.elena b/Task/99-Bottles-of-Beer/Elena/99-bottles-of-beer.elena new file mode 100644 index 0000000000..84959b3420 --- /dev/null +++ b/Task/99-Bottles-of-Beer/Elena/99-bottles-of-beer.elena @@ -0,0 +1,33 @@ +#import system. +#import system'dynamic. +#import system'routines. +#import extensions. +#import extensions'routines. +#import extensions'text. + +#class(extension)bottleOp +{ + #method bottleDescription + = self literal + (self != 1) iif:" bottles":" bottle". + + #method bottleEnumerator = Variable new:self eval &with:target + [ + Enumerator + { + next = target > 0. + + get = StringWriter new + writeLine:(target bottleDescription):" of beer on the wall" + writeLine:(target bottleDescription):" of beer" + writeLine:"Take one down, pass it around" + writeLine:((target -= 1) bottleDescription):" of beer on the wall". + } + ]. +} + +#symbol program = +[ + #var bottles := 99. + + bottles bottleEnumerator run &each:printingLn. +]. diff --git a/Task/99-Bottles-of-Beer/IDL/99-bottles-of-beer-3.idl b/Task/99-Bottles-of-Beer/IDL/99-bottles-of-beer-3.idl new file mode 100644 index 0000000000..cae2872619 --- /dev/null +++ b/Task/99-Bottles-of-Beer/IDL/99-bottles-of-beer-3.idl @@ -0,0 +1,9 @@ +Pro bottles_noloop2 + n_bottles=99 + b1 = reverse(SINDGEN(n_bottles,START=1)) + b2= reverse(SINDGEN(n_bottles)) + wallT=replicate(' bottles of beer on the wall.', n_bottles) + wallT2=replicate(' bottles of beer.', n_bottles) + takeT=replicate('Take one down, pass it around,', n_bottles) + print, b1+wallT+string(10B)+b1+wallT2+string(10B)+takeT+string(10B)+b2+wallT+string(10B) +End diff --git a/Task/99-Bottles-of-Beer/JavaScript/99-bottles-of-beer-3.js b/Task/99-Bottles-of-Beer/JavaScript/99-bottles-of-beer-3.js index 8c8b4a2fca..260c9d448a 100644 --- a/Task/99-Bottles-of-Beer/JavaScript/99-bottles-of-beer-3.js +++ b/Task/99-Bottles-of-Beer/JavaScript/99-bottles-of-beer-3.js @@ -1,2 +1,11 @@ -// Line breaks are in HTML -var beer; while ((beer = typeof beer === "undefined" ? 99 : beer) > 0) document.write( beer + " bottle" + (beer != 1 ? "s" : "") + " of beer on the wall
" + beer + " bottle" + (beer != 1 ? "s" : "") + " of beer
Take one down, pass it around
" + (--beer) + " bottle" + (beer != 1 ? "s" : "") + " of beer on the wall
" ); +var bottles = 99; +var songTemplate = "{X} bottles of beer on the wall \n" + + "{X} bottles of beer \n"+ + "Take one down, pass it around \n"+ + "{X-1} bottles of beer on the wall \n"; + +function song(x, txt) { + return txt.replace(/\{X\}/gi, x).replace(/\{X-1\}/gi, x-1) + (x > 1 ? song(x-1, txt) : ""); +} + +console.log(song(bottles, songTemplate)); diff --git a/Task/99-Bottles-of-Beer/JavaScript/99-bottles-of-beer-4.js b/Task/99-Bottles-of-Beer/JavaScript/99-bottles-of-beer-4.js index f24a6c991d..8c8b4a2fca 100644 --- a/Task/99-Bottles-of-Beer/JavaScript/99-bottles-of-beer-4.js +++ b/Task/99-Bottles-of-Beer/JavaScript/99-bottles-of-beer-4.js @@ -1,25 +1,2 @@ -function Bottles(count) { - this.count = count || 99; -} - -Bottles.prototype.take = function() { - var verse = [ - this.count + " bottles of beer on the wall,", - this.count + " bottles of beer!", - "Take one down, pass it around", - (this.count - 1) + " bottles of beer on the wall!" - ].join("\n"); - - console.log(verse); - - this.count--; -}; - -Bottles.prototype.sing = function() { - while (this.count) { - this.take(); - } -}; - -var bar = new Bottles(99); -bar.sing(); +// Line breaks are in HTML +var beer; while ((beer = typeof beer === "undefined" ? 99 : beer) > 0) document.write( beer + " bottle" + (beer != 1 ? "s" : "") + " of beer on the wall
" + beer + " bottle" + (beer != 1 ? "s" : "") + " of beer
Take one down, pass it around
" + (--beer) + " bottle" + (beer != 1 ? "s" : "") + " of beer on the wall
" ); diff --git a/Task/99-Bottles-of-Beer/JavaScript/99-bottles-of-beer-5.js b/Task/99-Bottles-of-Beer/JavaScript/99-bottles-of-beer-5.js index 036d7f4de0..f24a6c991d 100644 --- a/Task/99-Bottles-of-Beer/JavaScript/99-bottles-of-beer-5.js +++ b/Task/99-Bottles-of-Beer/JavaScript/99-bottles-of-beer-5.js @@ -1,18 +1,25 @@ -function bottleSong(n) { - if (!isFinite(Number(n)) || n == 0) n = 100; - var a = '%% bottles of beer', - b = ' on the wall', - c = 'Take one down, pass it around', - r = '
' - p = document.createElement('p'), - s = [], - re = /%%/g; - - while(n) { - s.push((a+b+r+a+r+c+r).replace(re, n) + (a+b).replace(re, --n)); - } - p.innerHTML = s.join(r+r); - document.body.appendChild(p); +function Bottles(count) { + this.count = count || 99; } -window.onload = bottleSong; +Bottles.prototype.take = function() { + var verse = [ + this.count + " bottles of beer on the wall,", + this.count + " bottles of beer!", + "Take one down, pass it around", + (this.count - 1) + " bottles of beer on the wall!" + ].join("\n"); + + console.log(verse); + + this.count--; +}; + +Bottles.prototype.sing = function() { + while (this.count) { + this.take(); + } +}; + +var bar = new Bottles(99); +bar.sing(); diff --git a/Task/99-Bottles-of-Beer/JavaScript/99-bottles-of-beer-6.js b/Task/99-Bottles-of-Beer/JavaScript/99-bottles-of-beer-6.js new file mode 100644 index 0000000000..036d7f4de0 --- /dev/null +++ b/Task/99-Bottles-of-Beer/JavaScript/99-bottles-of-beer-6.js @@ -0,0 +1,18 @@ +function bottleSong(n) { + if (!isFinite(Number(n)) || n == 0) n = 100; + var a = '%% bottles of beer', + b = ' on the wall', + c = 'Take one down, pass it around', + r = '
' + p = document.createElement('p'), + s = [], + re = /%%/g; + + while(n) { + s.push((a+b+r+a+r+c+r).replace(re, n) + (a+b).replace(re, --n)); + } + p.innerHTML = s.join(r+r); + document.body.appendChild(p); +} + +window.onload = bottleSong; diff --git a/Task/99-Bottles-of-Beer/MIPS-Assembly/99-bottles-of-beer.mips b/Task/99-Bottles-of-Beer/MIPS-Assembly/99-bottles-of-beer.mips new file mode 100644 index 0000000000..75d1ee5c53 --- /dev/null +++ b/Task/99-Bottles-of-Beer/MIPS-Assembly/99-bottles-of-beer.mips @@ -0,0 +1,77 @@ +################################## +# 99 bottles of beer on the wall # +# MIPS Assembly targeting MARS # +# By Keith Stellyes # +# August 24, 2016 # +################################## + +#It is simple, a loop that goes as follows: + +#if accumulator is not 1: +#PRINT INTEGER: accumulator +#PRINT lyrica +#PRINT INTEGER: accumulator +#PRINT lyricb +#PRINT INTEGER: accumulator +#PRINT lyricc +#DECREMENT accumulator + +#else: +#PRINT FINAL LYRICS + +.data + lyrica: .asciiz " bottles of beer on the wall, " + lyricb: " bottles of beer.\nTake one down and pass it around, " + lyricc: " bottles of beer on the wall. \n\n" + + #normally, I don't like going past 80 columns, but that was done here. + # there's an argument to be had for breaking this up. I chose not to + # for simpler instructions. + final_lyrics: "1 bottle of beer on the wall, 1 bottle of beer.\nTake one down and pass it around, no more bottles of beer on the wall.\n\nNo more bottles of beer on the wall, no more bottles of beer.\nGo to the store and buy some more, 99 bottles of beer on the wall." + +.text + #lw $a0,accumulator #load address of accumulator into $a0 (or is it getting val?) + li $a1,99 #set the inital value of the counter to 99 + +loop: + ###99 + li $v0, 1 #specify print integer system service + move $a0,$a1 + syscall #print that integer + + ### bottles of beer on the wall, + la $a0,lyrica + li $v0,4 + syscall + + ###99 + li $v0, 1 #specify print integer system service + move $a0,$a1 + syscall #print that integer + + ### bottles of beer.\n Take one down and pass it around, + la $a0,lyricb + li $v0,4 + syscall + + ###99 + li $v0, 1 #specify print integer system service + move $a0,$a1 + syscall #print that integer + + ### "bottles of beer on the wall. \n\n" + la $a0,lyricc + li $v0,4 + syscall + + #decrement counter, if at 1, print the final and exit. + subi $a1,$a1,1 + bne $a1,1,loop + +### PRINT FINAL LYRIC, THEN TERMINATE. +final: la $a0,final_lyrics + li $v0,4 + syscall + + li $v0,10 + syscall diff --git a/Task/99-Bottles-of-Beer/MUMPS/99-bottles-of-beer-3.mumps b/Task/99-Bottles-of-Beer/MUMPS/99-bottles-of-beer-3.mumps new file mode 100644 index 0000000000..ff289c13b9 --- /dev/null +++ b/Task/99-Bottles-of-Beer/MUMPS/99-bottles-of-beer-3.mumps @@ -0,0 +1,12 @@ +bottles + set template1="i_n_""of beer on the wall. ""_i_n_"" of beer. """ + set template2="""Take""_n2_""down, pass it around. """ + set template3="j_n3_""of beer on the wall.""" + for i=99:-1:1 do write ! hang 1 + . set:i>1 n=" bottles ",n2=" one " set:i=1 n=" bottle ",n2=" it " + . set n3=" bottle " set j=i-1 set:(j>1)!(j=0) n3=" bottles " set:j=0 j="No" + . write @template1,@template2,@template3 + +repeat + write "One more time!",! hang 5 + goto bottles diff --git a/Task/99-Bottles-of-Beer/Mercury/99-bottles-of-beer.mercury b/Task/99-Bottles-of-Beer/Mercury/99-bottles-of-beer.mercury new file mode 100644 index 0000000000..e4552eab5a --- /dev/null +++ b/Task/99-Bottles-of-Beer/Mercury/99-bottles-of-beer.mercury @@ -0,0 +1,60 @@ +% file: beer.m +% author: +% Fergus Henderson Thursday 9th November 1995 +% Re-written with new syntax standard library calls: +% Paul Bone 2015-11-20 +% +% This beer song is more idiomatic Mercury than the original, I feel bad +% saying that since Fergus is a founder of the language. + +:- module beer. +:- interface. +:- import_module io. + +:- pred main(io::di, io::uo) is det. + +:- implementation. + +:- import_module int. +:- import_module list. +:- import_module string. + +main(!IO) :- + beer(99, !IO). + +:- pred beer(int::in, io::di, io::uo) is det. + +beer(N, !IO) :- + io.write_string(beer_stanza(N), !IO), + ( N > 0 -> + io.nl(!IO), + beer(N - 1, !IO) + ; + true + ). + +:- func beer_stanza(int) = string. + +beer_stanza(N) = Stanza :- + ( N = 0 -> + Stanza = "Go to the store and buy some more!\n" + ; + NBottles = bottles_line(N), + N1Bottles = bottles_line(N - 1), + Stanza = + NBottles ++ " on the wall.\n" ++ + NBottles ++ ".\n" ++ + "Take one down, pass it around,\n" ++ + N1Bottles ++ " on the wall.\n" + ). + +:- func bottles_line(int) = string. + +bottles_line(N) = + ( N = 0 -> + "No more bottles of beer" + ; N = 1 -> + "1 bottle of beer" + ; + string.format("%d bottles of beer", [i(N)]) + ). diff --git a/Task/99-Bottles-of-Beer/Objeck/99-bottles-of-beer.objeck b/Task/99-Bottles-of-Beer/Objeck/99-bottles-of-beer.objeck new file mode 100644 index 0000000000..71267a57ec --- /dev/null +++ b/Task/99-Bottles-of-Beer/Objeck/99-bottles-of-beer.objeck @@ -0,0 +1,12 @@ +class Bottles { + function : Main(args : String[]) ~ Nil { + bottles := 99; + do { + "{$bottles} bottles of beer on the wall"->PrintLine(); + "{$bottles} bottles of beer"->PrintLine(); + "Take one down, pass it around"->PrintLine(); + bottles--; + "{$bottles} bottles of beer on the wall"->PrintLine(); + } while(bottles > 0); + } +} diff --git a/Task/99-Bottles-of-Beer/Onyx/99-bottles-of-beer.onyx b/Task/99-Bottles-of-Beer/Onyx/99-bottles-of-beer.onyx new file mode 100644 index 0000000000..38ba9fcc41 --- /dev/null +++ b/Task/99-Bottles-of-Beer/Onyx/99-bottles-of-beer.onyx @@ -0,0 +1,16 @@ +$Bottles { + dup cvs ` bottle' cat exch 1 ne {`s' cat} if + ` of beer' cat +} def + +$GetPronoun { + 1 eq {`it'}{`one'} ifelse cat +} def + +$WriteStanza { + dup dup Bottles ` on the wall. ' cat exch Bottles `.\n' cat cat + exch `Take ' 1 idup GetPronoun ` down. Pass it around.\n' cat + exch dec Bottles ` on the wall.\n\n' 3 {cat} repeat print flush +} def + +99 -1 1 {WriteStanza} for diff --git a/Task/99-Bottles-of-Beer/Processing/99-bottles-of-beer b/Task/99-Bottles-of-Beer/Processing/99-bottles-of-beer new file mode 100644 index 0000000000..f10588ecf0 --- /dev/null +++ b/Task/99-Bottles-of-Beer/Processing/99-bottles-of-beer @@ -0,0 +1,3 @@ +for (int i = 99; i > 0; i--) { + print(i + " bottles of beer on the wall\n" + i + " bottles of beer\nTake one down, pass it around\n" + (i - 1) + " bottles of beer on the wall\n\n"); +} diff --git a/Task/99-Bottles-of-Beer/REXX/99-bottles-of-beer.rexx b/Task/99-Bottles-of-Beer/REXX/99-bottles-of-beer.rexx index 62a56cb038..71b7768580 100644 --- a/Task/99-Bottles-of-Beer/REXX/99-bottles-of-beer.rexx +++ b/Task/99-Bottles-of-Beer/REXX/99-bottles-of-beer.rexx @@ -1,20 +1,20 @@ -/*REXX pgm displays lyrics to the song "99 Bottles of Beer on the Wall".*/ -parse arg N .; if N=='' then N=99 /*let # bottles be specified*/ +/*REXX program displays lyrics to the song "99 Bottles of Beer on the Wall". */ +parse arg N .; if N=='' | N=="," then N=99 /*let number of bottles be given. */ - do j=N by -1 to 1 /*start countdown & singdown*/ - say j 'bottle's(j) "of beer on the wall," /*sing the #bottles of beer.*/ - say j 'bottle's(j) "of beer." /* ··· and the refrain.*/ - say 'Take one down, pass it around,' /*get a bottle and share it.*/ - m=j-1 /*M: # bottles we have now.*/ - if m==0 then m='no' /*use "no" instead of 0. */ - say m 'bottle's(m) "of beer on the wall." /*sing beer bottle inventory*/ - say /*blank line between verses.*/ - end /*j*/ - /*Not tanked? Then sing it.*/ -say 'No more bottles of beer on the wall,' /*Finally! The last verse.*/ -say 'no more bottles of beer.' /*this is so forlorn ··· */ -say 'Go to the store and buy some more,' /*replenishment of the beer.*/ -say N 'bottles of beer on the wall.' /*all is well in the tavern.*/ -exit /*we're done & also sloshed.*/ -/*───────────────────────────────────S subroutine───────────────────────*/ -s: if arg(1)=1 then return ''; return 's' /*simple pluralizer function*/ + do j=N by -1 to 1 /*start the countdown and singdown*/ + say j 'bottle's(j) "of beer on the wall," /*sing the number bottles of beer.*/ + say j 'bottle's(j) "of beer." /* ··· and the song's refrain.*/ + say 'Take one down, pass it around,' /*take a beer bottle and share it.*/ + m=j-1 /*M: number of bottles we have now*/ + if m==0 then m='no' /*use "no" instead of numeric 0.*/ + say m 'bottle's(m) "of beer on the wall." /*sing the beer bottle inventory. */ + say /*a blank line between the verses.*/ + end /*j*/ + /*Not quite tanked? Then sing it.*/ +say 'No more bottles of beer on the wall,' /*Finally! The last verse. */ +say 'no more bottles of beer.' /*this is so forlorn ··· */ +say 'Go to the store and buy some more,' /*obtain replenishment of the beer*/ +say N 'bottles of beer on the wall.' /*all is well in the ole tavern. */ +exit /*we're all done and also sloshed.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +s: if arg(1)=1 then return ''; return 's' /*a simple pluralizer function. */ diff --git a/Task/99-Bottles-of-Beer/Rust/99-bottles-of-beer.rust b/Task/99-Bottles-of-Beer/Rust/99-bottles-of-beer-1.rust similarity index 100% rename from Task/99-Bottles-of-Beer/Rust/99-bottles-of-beer.rust rename to Task/99-Bottles-of-Beer/Rust/99-bottles-of-beer-1.rust diff --git a/Task/99-Bottles-of-Beer/Rust/99-bottles-of-beer-2.rust b/Task/99-Bottles-of-Beer/Rust/99-bottles-of-beer-2.rust new file mode 100644 index 0000000000..31c96e952b --- /dev/null +++ b/Task/99-Bottles-of-Beer/Rust/99-bottles-of-beer-2.rust @@ -0,0 +1,16 @@ +use std::borrow::Cow; + +fn main() { + for i in (0..100).rev().map(|x| beer(x)) { + println!("{}", i) + } +} +fn beer(num: u32) -> Cow<'static, str> { + match num { + 1=> "1 bottle of beer on the wall\n1 bottle of beer\nTake one down, pass it around".into(), + 0 => "better go to the store and buy some more.".into(), + _ => (num.to_string() + " bottles of beer on the wall\n" + + &num.to_string() +" bottles of beer\nTake one down, pass it around\n" + + beer(num - 1).lines().nth(0).unwrap() + "\n").into(), + } +} diff --git a/Task/99-Bottles-of-Beer/SQL/99-bottles-of-beer-4.sql b/Task/99-Bottles-of-Beer/SQL/99-bottles-of-beer-4.sql index 999d56c8a8..0b49048fdc 100644 --- a/Task/99-Bottles-of-Beer/SQL/99-bottles-of-beer-4.sql +++ b/Task/99-Bottles-of-Beer/SQL/99-bottles-of-beer-4.sql @@ -1,19 +1,20 @@ -/*These statements work in PostgreSQL (tested in 9.3)*/ +/*These statements work in PostgreSQL (tested in 9.4)*/ SELECT generate_series || ' bottles of beer on the wall' || chr(10) || generate_series || ' bottles of beer' || chr(10) || 'Take one down, pass it around' || chr(10) || -coalesce(lead(generate_series) OVER (ORDER BY generate_series DESC),0) || ' bottles of beer on the wall' -FROM generate_series(1,100) +coalesce(lead(generate_series) OVER (ORDER BY generate_series DESC),0) || ' bottles of beer on the wall' AS song +FROM generate_series(1,99) ORDER BY generate_series DESC; -/*The next statement takes also into account the grammaticalt support for "1 bottle of beer".*/ +/*The next statement takes also into account the grammatical support for "1 bottle of beer".*/ SELECT generate_series || ' bottle' || CASE WHEN generate_series>1 THEN 's' ELSE '' END || ' of beer on the wall' || chr(10) || generate_series || ' bottle' || CASE WHEN generate_series>1 THEN 's' ELSE '' END || ' of beer' || chr(10) || 'Take one down, pass it around' || chr(10) || -coalesce(lead(generate_series) OVER (ORDER BY generate_series DESC),0) || ' bottle' || CASE WHEN coalesce(lead(generate_series) OVER (ORDER BY generate_series DESC),0) <>1 THEN 's' ELSE '' END || ' of beer on the wall' -FROM generate_series(1,100) +coalesce(lead(generate_series) OVER (ORDER BY generate_series DESC),0) || ' bottle' || CASE WHEN coalesce(lead(generate_series) OVER (ORDER BY +generate_series DESC),0) <>1 THEN 's' ELSE '' END || ' of beer on the wall' AS song +FROM generate_series(1,99) ORDER BY generate_series DESC; /*The next statement uses recursive query.*/ @@ -21,12 +22,12 @@ ORDER BY generate_series DESC; WITH RECURSIVE t(n) AS ( VALUES (1) UNION ALL - SELECT n+1 FROM t WHERE n < 100 + SELECT n+1 FROM t WHERE n < 99 ) SELECT n || ' bottle' || CASE WHEN n>1 THEN 's' ELSE '' END || ' of beer on the wall' || chr(10) || n || ' bottle' || CASE WHEN n>1 THEN 's' ELSE '' END || ' of beer' || chr(10) || 'Take one down, pass it around' || chr(10) || coalesce(lead(n) OVER (ORDER BY n DESC),0) || ' bottle' || -CASE WHEN coalesce(lead(n) OVER (ORDER BY n DESC),0) <>1 THEN 's' ELSE '' END || ' of beer on the wall' +CASE WHEN coalesce(lead(n) OVER (ORDER BY n DESC),0) <>1 THEN 's' ELSE '' END || ' of beer on the wall' AS song FROM t ORDER BY n DESC; diff --git a/Task/99-Bottles-of-Beer/SuperCollider/99-bottles-of-beer.supercollider b/Task/99-Bottles-of-Beer/SuperCollider/99-bottles-of-beer.supercollider new file mode 100644 index 0000000000..5c86850a30 --- /dev/null +++ b/Task/99-Bottles-of-Beer/SuperCollider/99-bottles-of-beer.supercollider @@ -0,0 +1,19 @@ +// post to the REPL directly +( +(99..0).do { |n| + "% bottles of beer on the wall\n% bottles of beer\nTake one down, pass it around\n% bottles of beer on the wall\n".postf(n, n, n) +}; +) + +// post over time +( +fork { + 100.reverseDo { |n| + n.post; " bottles of beer on the wall".postln; 0.5.wait; + n.post; " bottles of beer".postln; 0.5.wait; + "Take one down, pass it around".postln; 0.5.wait; + n.post; " bottles of beer on the wall".postln; 0.5.wait; + 1.wait; + }; +} +) diff --git a/Task/A+B/00DESCRIPTION b/Task/A+B/00DESCRIPTION index 0bcc826b67..89a587458e 100644 --- a/Task/A+B/00DESCRIPTION +++ b/Task/A+B/00DESCRIPTION @@ -1,23 +1,30 @@ -'''A+B''' - in programming contests, classic problem, which is given so contestants can gain familiarity with the online judging system being used. +'''A+B'''   ─── a classic problem in programming contests,   it's given so contestants can gain familiarity with the online judging system being used. -'''Problem statement'''
-Given 2 integer numbers, A and B. One needs to find their sum. -:'''Input data'''
-:Two integer numbers are written in the input stream, separated by space. -:(-1000 \le A,B \le +1000) +;Task: +Given two integer,   '''A''' and '''B'''. -:'''Output data'''
-:The required output is one integer: the sum of A and B. +Their sum needs to be calculated. -:'''Example:'''
+ +;Input data: +Two integers are written in the input stream, separated by space(s): +: (-1000 \le A,B \le +1000) + + +;Output data: +The required output is one integer:   the sum of '''A''' and '''B'''. + + +;Example: ::{|class="standard" - ! Input - ! Output + ! input   + ! output   |- - |2 2 - |4 + | 2 2 + | 4 |- - |3 2 - |5 + | 3 2 + | 5 |} +

diff --git a/Task/A+B/AppleScript/a+b.applescript b/Task/A+B/AppleScript/a+b.applescript index 69a882d9a8..aa54d8cba5 100644 --- a/Task/A+B/AppleScript/a+b.applescript +++ b/Task/A+B/AppleScript/a+b.applescript @@ -1,7 +1,7 @@ on run argv - try - return ((first item of argv) as integer) + (second item of argv) as integer - on error - return "Usage with -1000 <= a,b <= 1000: " & tab & " A+B.scpt a b" - end try + try + return ((first item of argv) as integer) + (second item of argv) as integer + on error + return "Usage with -1000 <= a,b <= 1000: " & tab & " A+B.scpt a b" + end try end run diff --git a/Task/A+B/AutoIt/a+b.autoit b/Task/A+B/AutoIt/a+b-1.autoit similarity index 100% rename from Task/A+B/AutoIt/a+b.autoit rename to Task/A+B/AutoIt/a+b-1.autoit diff --git a/Task/A+B/AutoIt/a+b-2.autoit b/Task/A+B/AutoIt/a+b-2.autoit new file mode 100644 index 0000000000..bb6bfba619 --- /dev/null +++ b/Task/A+B/AutoIt/a+b-2.autoit @@ -0,0 +1,22 @@ +ConsoleWrite("# A+B:" & @CRLF) + +Func Sum($inp) + Local $num = StringSplit($inp, " "), $sum = 0 + For $i = 1 To $num[0] +;~ ConsoleWrite("# num["&$i&"]:" & $num[$i] & @CRLF) ;; + $sum = $sum + $num[$i] + Next + Return $sum +EndFunc ;==>Sum + +$inp = "17 4" +$res = Sum($inp) +ConsoleWrite($inp & " --> " & $res & @CRLF) + +$inp = "999 42 -999" +ConsoleWrite($inp & " --> " & Sum($inp) & @CRLF) + +; In calculations, text counts as 0, +; so the program works correctly even with this input: +Local $inp = "999x y 42 -999", $res = Sum($inp) +ConsoleWrite($inp & " --> " & $res & @CRLF) diff --git a/Task/A+B/DCL/a+b.dcl b/Task/A+B/DCL/a+b.dcl index d98987dd46..de20258d6d 100644 --- a/Task/A+B/DCL/a+b.dcl +++ b/Task/A+B/DCL/a+b.dcl @@ -1,4 +1,4 @@ $ read sys$command line $ a = f$element( 0, " ", line ) $ b = f$element( 1, " ", line ) -$ write sys$output a + b +$ write sys$output a, "+", b, "=", a + b diff --git a/Task/A+B/Delphi/a+b.delphi b/Task/A+B/Delphi/a+b.delphi index 1686668b29..f71a55606a 100644 --- a/Task/A+B/Delphi/a+b.delphi +++ b/Task/A+B/Delphi/a+b.delphi @@ -5,6 +5,7 @@ program SUM; uses SysUtils; +procedure var s1, s2:string; begin diff --git a/Task/A+B/Elena/a+b.elena b/Task/A+B/Elena/a+b.elena index 789a47618e..10d82b0e85 100644 --- a/Task/A+B/Elena/a+b.elena +++ b/Task/A+B/Elena/a+b.elena @@ -1,5 +1,5 @@ -#define system. -#define extensions. +#import system. +#import extensions. #symbol program = [ diff --git a/Task/A+B/K/a+b.k b/Task/A+B/K/a+b.k new file mode 100644 index 0000000000..5e0e676d88 --- /dev/null +++ b/Task/A+B/K/a+b.k @@ -0,0 +1,5 @@ + split:{(a@&~&/' y=/: a:(0,&x=y)_ x) _dv\: y} + ab:{+/0$split[0:`;" "]} + ab[] +2 3 +5 diff --git a/Task/A+B/Onyx/a+b.onyx b/Task/A+B/Onyx/a+b.onyx new file mode 100644 index 0000000000..21336fab00 --- /dev/null +++ b/Task/A+B/Onyx/a+b.onyx @@ -0,0 +1,25 @@ +$Prompt { + `\nEnter two numbers between -1000 and +1000,\nseparated by a space: ' print flush +} def + +$GetNumbers { + mark stdin readline pop # Reads input as a string. Pop gets rid of false. + cvx eval # Convert string to integers. +} def + +$CheckRange { # (n1 n2 -- bool) + dup -1000 ge exch 1000 le and +} def + +$CheckInput { + counttomark 2 ne + {`You have to enter exactly two numbers.\n' print flush quit} if + 2 ndup CheckRange exch CheckRange and not + {`The numbers have to be between -1000 and +1000.\n' print flush quit} if +} def + +$Answer { + add cvs `The sum is ' exch cat `.\n' cat print flush +} def + +Prompt GetNumbers CheckInput Answer diff --git a/Task/A+B/Perl-6/a+b-1.pl6 b/Task/A+B/Perl-6/a+b-1.pl6 index b2bd52e81d..c2d803d141 100644 --- a/Task/A+B/Perl-6/a+b-1.pl6 +++ b/Task/A+B/Perl-6/a+b-1.pl6 @@ -1 +1 @@ -say [+] get.words +get.words.sum.say; diff --git a/Task/A+B/Perl-6/a+b-2.pl6 b/Task/A+B/Perl-6/a+b-2.pl6 index 1ca776638f..d3825a5262 100644 --- a/Task/A+B/Perl-6/a+b-2.pl6 +++ b/Task/A+B/Perl-6/a+b-2.pl6 @@ -1 +1 @@ -$*IN.get.words.reduce(* + *).say +say [+] get.words; diff --git a/Task/A+B/Perl-6/a+b-3.pl6 b/Task/A+B/Perl-6/a+b-3.pl6 index 8d02852753..04c7a5e40a 100644 --- a/Task/A+B/Perl-6/a+b-3.pl6 +++ b/Task/A+B/Perl-6/a+b-3.pl6 @@ -1,2 +1,2 @@ -my ($a,$b) = $*IN.get.split(" "); +my ($a, $b) = $*IN.get.split(" "); say $a + $b; diff --git a/Task/A+B/PowerShell/a+b-3.psh b/Task/A+B/PowerShell/a+b-3.psh new file mode 100644 index 0000000000..a2139f6c26 --- /dev/null +++ b/Task/A+B/PowerShell/a+b-3.psh @@ -0,0 +1,3 @@ +filter add { + return [int]$args[0] + [int]$args[1] +} diff --git a/Task/A+B/PowerShell/a+b-4.psh b/Task/A+B/PowerShell/a+b-4.psh new file mode 100644 index 0000000000..04adb7b18a --- /dev/null +++ b/Task/A+B/PowerShell/a+b-4.psh @@ -0,0 +1 @@ +add 2 3 diff --git a/Task/A+B/Processing/a+b b/Task/A+B/Processing/a+b new file mode 100644 index 0000000000..86c6b72179 --- /dev/null +++ b/Task/A+B/Processing/a+b @@ -0,0 +1,25 @@ +int a = 0; +int b = 0; + +void setup() { + size(200, 200); +} + +void draw() { + fill(255); + rect(0, 0, width, height); + fill(0); + line(width/2, 0, width/2, height * 3 / 4); + line(0, height * 3 / 4, width, height * 3 / 4); + text(a, width / 4, height / 4); + text(b, width * 3 / 4, height / 4); + text("Sum: " + (a + b), width / 4, height * 7 / 8); +} + +void mousePressed() { + if (mouseX < width/2) { + a++; + } else { + b++; + } +} diff --git a/Task/A+B/Python/a+b-1.py b/Task/A+B/Python/a+b-1.py index db1a94e67a..27e6aacf38 100644 --- a/Task/A+B/Python/a+b-1.py +++ b/Task/A+B/Python/a+b-1.py @@ -1,4 +1,4 @@ try: raw_input except: raw_input = input -print(sum(int(x) for x in raw_input().split())) +print(sum(map(int, raw_input().split()))) diff --git a/Task/A+B/Python/a+b-2.py b/Task/A+B/Python/a+b-2.py index 71e8a4ff5c..cfdc38a5f9 100644 --- a/Task/A+B/Python/a+b-2.py +++ b/Task/A+B/Python/a+b-2.py @@ -1,4 +1,4 @@ import sys for line in sys.stdin: - print(sum(int(i) for i in line.split())) + print(sum(map(int, line.split()))) diff --git a/Task/A+B/REXX/a+b-1.rexx b/Task/A+B/REXX/a+b-1.rexx index dbc7c1e614..46a34f359e 100644 --- a/Task/A+B/REXX/a+b-1.rexx +++ b/Task/A+B/REXX/a+b-1.rexx @@ -1,2 +1,4 @@ -parse pull a b -say a+b +/*REXX program obtains two numbers from the input stream (the console), shows their sum.*/ +parse pull a b /*obtain two numbers from input stream.*/ +say a+b /*display the sum to the terminal. */ + /*stick a fork in it, we're all done. */ diff --git a/Task/A+B/REXX/a+b-2.rexx b/Task/A+B/REXX/a+b-2.rexx index 5c6592790f..064640ab38 100644 --- a/Task/A+B/REXX/a+b-2.rexx +++ b/Task/A+B/REXX/a+b-2.rexx @@ -1,2 +1,4 @@ -parse pull a b -say (a+b)/1 /*dividing by 1 normalizes the REXX number.*/ +/*REXX program obtains two numbers from the input stream (the console), shows their sum.*/ +parse pull a b /*obtain two numbers from input stream.*/ +say (a+b) / 1 /*display normalized sum to terminal. */ + /*stick a fork in it, we're all done. */ diff --git a/Task/A+B/REXX/a+b-3.rexx b/Task/A+B/REXX/a+b-3.rexx index 2104c6391a..774178e64d 100644 --- a/Task/A+B/REXX/a+b-3.rexx +++ b/Task/A+B/REXX/a+b-3.rexx @@ -1,4 +1,6 @@ -numeric digits 300 -parse pull a b -z=(a+b)/1 -say z +/*REXX program obtains two numbers from the input stream (the console), shows their sum.*/ +numeric digits 300 /*the default is nine decimal digits.*/ +parse pull a b /*obtain two numbers from input stream.*/ +z= (a+b) / 1 /*add and normalize sum, store it in Z.*/ +say z /*display normalized sum Z to terminal.*/ + /*stick a fork in it, we're all done. */ diff --git a/Task/A+B/REXX/a+b-4.rexx b/Task/A+B/REXX/a+b-4.rexx index 99c303ec95..fa55e73dfc 100644 --- a/Task/A+B/REXX/a+b-4.rexx +++ b/Task/A+B/REXX/a+b-4.rexx @@ -1,9 +1,12 @@ -numeric digits 1000 /*just in case the user gets ka-razy. */ -say 'enter some numbers to be summed:' -parse pull y -many=words(y) -sum=0 - do j=1 for many - sum=sum+word(y,j) - end -say 'sum of' many "numbers = " sum/1 +/*REXX program obtains some numbers from the input stream (the console), shows their sum*/ +numeric digits 1000 /*just in case the user gets ka-razy. */ +say 'enter some numbers to be summed:' /*display a prompt message to terminal.*/ +parse pull y /*obtain all numbers from input stream.*/ +many=words(y) /*obtain the number of numbers entered.*/ +$=0 /*initialize the sum to zero. */ + do j=1 for many /*process each of the numbers. */ + $=$ + word(y, j) /*add one number to the sum. */ + end /*j*/ + +say 'sum of ' many " numbers = " $/1 /*display normalized sum $ to terminal.*/ + /*stick a fork in it, we're all done. */ diff --git a/Task/A+B/Rust/a+b-1.rust b/Task/A+B/Rust/a+b-1.rust new file mode 100644 index 0000000000..7a45d0c3cf --- /dev/null +++ b/Task/A+B/Rust/a+b-1.rust @@ -0,0 +1,12 @@ +use std::io; + +fn main() { + let mut line = String::new(); + io::stdin().read_line(&mut line).expect("reading stdin"); + + let mut i: i64 = 0; + for word in line.split_whitespace() { + i += word.parse::().expect("trying to interpret your input as numbers"); + } + println!("{}", i); +} diff --git a/Task/A+B/Rust/a+b-2.rust b/Task/A+B/Rust/a+b-2.rust new file mode 100644 index 0000000000..7ae5c6b2c3 --- /dev/null +++ b/Task/A+B/Rust/a+b-2.rust @@ -0,0 +1,11 @@ +#![feature(iter_arith)] +use std::io; + +fn main() { + let mut a = String::new(); + io::stdin().read_line(&mut a).expect("reading stdin"); + println!("{}", + a.split_whitespace() + .map(|x| x.parse::().expect("these better be numbers")) + .sum::()); +} diff --git a/Task/A+B/Rust/a+b.rust b/Task/A+B/Rust/a+b.rust deleted file mode 100644 index 7c99355b66..0000000000 --- a/Task/A+B/Rust/a+b.rust +++ /dev/null @@ -1,18 +0,0 @@ -use std::io::{self, Write}; -fn main() { - let mut buf = String::new(); - loop { // Loop until user gives a string of valid numbers - print!("Give me a number: "); - io::stdout().flush().expect("Could not flush stdout"); - io::stdin().read_line(&mut buf).expect("Could not read stdin"); - let res: Result, _> = buf.split_whitespace().map(|num| num.parse()).collect(); - println!("{}", match res { - Ok(vec) => vec.iter().fold(0, |sum, x| sum + x), - Err(e) => { - writeln!(&mut io::stderr(), "Error: {}", e).expect("Could not write to stdout"); - continue; - } - }); - break; - } -} diff --git a/Task/A+B/Standard-ML/a+b.ml b/Task/A+B/Standard-ML/a+b.ml new file mode 100644 index 0000000000..41f0ca01ec --- /dev/null +++ b/Task/A+B/Standard-ML/a+b.ml @@ -0,0 +1,22 @@ +(* + * val split : string -> string list + * splits a string at it spaces + *) +val split = String.fields (fn #" " => true | _ => false) + +(* + * val removeNl : string -> string + * removes the occurence of "\n" in a string + *) +val removeNl = String.translate (fn #"\n" => "" | c => implode [c]) + +(* + * val aplusb : unit -> int + * reads a line and gets the sum of the numbers + *) +fun aplusb () = + let + val input = removeNl (valOf (TextIO.inputLine TextIO.stdIn)) + in + foldl op+ 0 (map (fn s => valOf (Int.fromString s)) (split input)) + end diff --git a/Task/A+B/ZX-Spectrum-Basic/a+b.zx b/Task/A+B/ZX-Spectrum-Basic/a+b.zx new file mode 100644 index 0000000000..a0bbe856ce --- /dev/null +++ b/Task/A+B/ZX-Spectrum-Basic/a+b.zx @@ -0,0 +1,10 @@ +10 PRINT "Input two numbers separated by"'"space(s) " +20 INPUT LINE a$ +30 GO SUB 90 +40 FOR i=1 TO LEN a$ +50 IF a$(i)=" " THEN LET a=VAL a$( TO i): LET b=VAL a$(i TO ): PRINT a;" + ";b;" = ";a+b: GO TO 70 +60 NEXT i +70 STOP +80 REM LTrim operation +90 IF a$(1)=" " THEN LET a$=a$(2 TO ): GO TO 90 +100 RETURN diff --git a/Task/ABC-Problem/00DESCRIPTION b/Task/ABC-Problem/00DESCRIPTION index 13624d5561..037b35bf54 100644 --- a/Task/ABC-Problem/00DESCRIPTION +++ b/Task/ABC-Problem/00DESCRIPTION @@ -1,37 +1,44 @@ -You are given a collection of ABC blocks. Just like the ones you had when you were a kid. There are twenty blocks with two letters on each block. You are guaranteed to have a complete alphabet amongst all sides of the blocks. The sample blocks are: +You are given a collection of ABC blocks   (maybe like the ones you had when you were a kid). + +There are twenty blocks with two letters on each block. + +A complete alphabet is guaranteed amongst all sides of the blocks. + +The sample collection of blocks: + (B O) + (X K) + (D Q) + (C P) + (N A) + (G T) + (R E) + (T G) + (Q D) + (F S) + (J W) + (H U) + (V I) + (A N) + (O B) + (E R) + (F S) + (L Y) + (P C) + (Z M) + + +;Task: +Write a function that takes a string (word) and determines whether the word can be spelled with the given collection of blocks. -:((B O) -: (X K) -: (D Q) -: (C P) -: (N A) -: (G T) -: (R E) -: (T G) -: (Q D) -: (F S) -: (J W) -: (H U) -: (V I) -: (A N) -: (O B) -: (E R) -: (F S) -: (L Y) -: (P C) -: (Z M)) -The goal of this task is to write a function that takes a string and can determine whether you can spell the word with the given collection of blocks. The rules are simple: +::#   Once a letter on a block is used that block cannot be used again +::#   The function should be case-insensitive +::#   Show the output on this page for the following 7 words in the following example -#Once a letter on a block is used that block cannot be used again -#The function should be case-insensitive -# Show your output on this page for the following words: ;Example: - - - >>> can_make_word("A") + >>> can_make_word("A") True >>> can_make_word("BARK") True @@ -44,5 +51,5 @@ The rules are simple: >>> can_make_word("SQUAD") True >>> can_make_word("CONFUSE") - True - + True +

diff --git a/Task/ABC-Problem/BASIC/abc-problem.basic b/Task/ABC-Problem/BASIC/abc-problem.basic new file mode 100644 index 0000000000..2ee941231e --- /dev/null +++ b/Task/ABC-Problem/BASIC/abc-problem.basic @@ -0,0 +1,125 @@ +' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' +' ABC_Problem ' +' ' +' Developed by A. David Garza Marín in VB-DOS for ' +' RosettaCode. November 29, 2016. ' +' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' + +' Comment the following line to run it in QB or QBasic +OPTION EXPLICIT ' Modify to OPTION _EXPLICIT for QB64 + +' SUBs and FUNCTIONs +DECLARE SUB doCleanBlocks () +DECLARE FUNCTION ICanMakeTheWord (WhichWord AS STRING) AS INTEGER +DECLARE SUB doReadBlocks () + +' rBlock Data Type +TYPE regBlock + Block AS STRING * 2 + Used AS INTEGER +END TYPE + +' Initialize +CONST False = 0, True = NOT False, HMBlocks = 20 +DATA "BO", "XK", "DQ", "CP", "NA", "GT","RE", "TG" +DATA "QD", "FS", "JW", "HU", "VI", "AN", "OB", "ER" +DATA "FS", "LY", "PC","ZM" + +DIM rBlock(1 TO HMBlocks) AS regBlock +DIM i AS INTEGER, aWord AS STRING, YorN AS STRING + +doReadBlocks ' Read the data in the blocks + +'-------------- Main program cycle ------------------ +CLS +PRINT "This program has the following blocks: "; +FOR i = 1 TO HMBlocks + PRINT rBlock(i).Block; "|"; +NEXT i +PRINT : PRINT +PRINT "Please, write a word or a short sentence to see if the available" +PRINT "blocks can make it. If so, I will tell you." +DO + doCleanBlocks ' Clean all blocks + PRINT + INPUT "Which is the word"; aWord + aWord = LTRIM$(RTRIM$(aWord)) + + IF aWord <> "" THEN + IF ICanMakeTheWord(aWord) THEN + PRINT "Yes, i can make it." + ELSE + PRINT "No, I can't make it." + END IF + ELSE + PRINT "At least, you need to type a letter." + END IF + + PRINT + PRINT "Do you want to try again (Y/N) "; + DO + YorN = INPUT$(1) + YorN = UCASE$(YorN) + LOOP UNTIL YorN = "Y" OR YorN = "N" + PRINT YorN + +LOOP UNTIL YorN = "N" +' -------------- End of Main program ---------------- +END + +SUB doCleanBlocks () + ' Var + SHARED rBlock() AS regBlock + DIM i AS INTEGER + + ' Will clean the Used status of all blocks + FOR i = 1 TO HMBlocks + rBlock(i).Used = False + NEXT i + +END SUB + +SUB doReadBlocks () + ' Var + SHARED rBlock() AS regBlock + DIM i AS INTEGER + + ' Will read the block values from DATA + FOR i = 1 TO HMBlocks + READ rBlock(i).Block + NEXT i +END SUB + +FUNCTION ICanMakeTheWord (WhichWord AS STRING) AS INTEGER ' Comment AS INTEGER to run in QBasic, QB64 and QuickBASIC + ' Var + SHARED rBlock() AS regBlock + DIM i AS INTEGER, l AS INTEGER, j AS INTEGER, iYesICan AS INTEGER + DIM c AS STRING, sUWord AS STRING + + ' Will evaluate if can make the word + sUWord = UCASE$(WhichWord) + l = LEN(sUWord) + i = 0 + + DO + i = i + 1 + iYesICan = False + c = MID$(sUWord, i, 1) + j = 0 + DO + j = j + 1 + IF NOT rBlock(j).Used THEN + iYesICan = (INSTR(rBlock(j).Block, c) > 0) + rBlock(j).Used = iYesICan + END IF + LOOP UNTIL j >= HMBlocks OR iYesICan + + LOOP UNTIL i >= l OR NOT iYesICan + + ' The result will depend on the last value of + ' iYesICan variable. If the last value is True + ' is because the function found even the last + ' letter analyzed. + ICanMakeTheWord = iYesICan + +END FUNCTION diff --git a/Task/ABC-Problem/CoffeeScript/abc-problem.coffee b/Task/ABC-Problem/CoffeeScript/abc-problem.coffee index 2bc54c4925..edb40cdc3a 100644 --- a/Task/ABC-Problem/CoffeeScript/abc-problem.coffee +++ b/Task/ABC-Problem/CoffeeScript/abc-problem.coffee @@ -1,3 +1,5 @@ +blockList = [ 'BO', 'XK', 'DQ', 'CP', 'NA', 'GT', 'RE', 'TG', 'QD', 'FS', 'JW', 'HU', 'VI', 'AN', 'OB', 'ER', 'FS', 'LY', 'PC', 'ZM' ] + canMakeWord = (word="") -> # Create a shallow clone of the master blockList blocks = blockList.slice 0 @@ -7,9 +9,10 @@ canMakeWord = (word="") -> for block, idx in blocks # If letter is in block, blocks.splice will return an array, which will evaluate as true return blocks.splice idx, 1 if letter.toUpperCase() in block - return false + false # Return true if there are no falsy values - return false not in (checkBlocks letter for letter in word) + false not in (checkBlocks letter for letter in word) # Expect true, true, false, true, false, true, true, true -console.log (canMakeWord word for word in ["A", "BARK", "BOOK", "TREAT", "COMMON", "squad", "CONFUSE", "STORM"]) +for word in ["A", "BARK", "BOOK", "TREAT", "COMMON", "squad", "CONFUSE", "STORM"] + console.log word + " -> " + canMakeWord(word) diff --git a/Task/ABC-Problem/Ela/abc-problem.ela b/Task/ABC-Problem/Ela/abc-problem.ela new file mode 100644 index 0000000000..c9e1bbb59a --- /dev/null +++ b/Task/ABC-Problem/Ela/abc-problem.ela @@ -0,0 +1,17 @@ +open list monad io char + +:::IO + +null = foldr (\_ _ -> false) true + +mapM_ f = foldr ((>>-) << f) (return ()) + +abc _ [] = [[]] +abc blocks (c::cs) = + [b::ans \\ b <- blocks | c `elem` b, ans <- abc (delete b blocks) cs] + +blocks = ["BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS", + "JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM"] + +mapM_ (\w -> putLn (w, not << null $ abc blocks (map char.upper w))) + ["", "A", "BARK", "BoOK", "TrEAT", "COmMoN", "SQUAD", "conFUsE"] diff --git a/Task/ABC-Problem/Elena/abc-problem.elena b/Task/ABC-Problem/Elena/abc-problem.elena new file mode 100644 index 0000000000..c44f073afd --- /dev/null +++ b/Task/ABC-Problem/Elena/abc-problem.elena @@ -0,0 +1,37 @@ +#import system. +#import system'routines. +#import system'collections. +#import extensions. +#import extensions'routines. + +#class(extension)op +{ + #method canMakeWord &from:blocks + [ + #var list := ArrayList new:blocks. + + ^ $nil == self literal upperCase seek &each:ch + [ + #var index := list indexOf:(word [ word indexOf:ch &at:0 != -1 ] asComparer). + + (index>=0) + ? [ list remove &at:index. ^ false. ] + ! [ ^ true. ]. + ]. + ] +} + +#symbol program = +[ + #var blocks := ("BO", "XK", "DQ", "CP", "NA", + "GT", "RE", "TG", "QD", "FS", + "JW", "HU", "VI", "AN", "OB", + "ER", "FS", "LY", "PC", "ZM"). + + #var words := ("", "A", "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "Confuse"). + + words run &each:word + [ + console writeLine:"can make '":word:"' : ":(word canMakeWord &from:blocks). + ]. +]. diff --git a/Task/ABC-Problem/Fortran/abc-problem.f b/Task/ABC-Problem/Fortran/abc-problem-1.f similarity index 100% rename from Task/ABC-Problem/Fortran/abc-problem.f rename to Task/ABC-Problem/Fortran/abc-problem-1.f diff --git a/Task/ABC-Problem/Fortran/abc-problem-2.f b/Task/ABC-Problem/Fortran/abc-problem-2.f new file mode 100644 index 0000000000..0c0d917d24 --- /dev/null +++ b/Task/ABC-Problem/Fortran/abc-problem-2.f @@ -0,0 +1,277 @@ + MODULE PLAYPEN !Messes with a set of alphabet blocks. + INTEGER MSG !Output unit number. + PARAMETER (MSG = 6) !Standard output. + INTEGER MS !I dislike unidentified constants... + PARAMETER (MS = 2) !So this is the maximum number of lettered sides. + INTEGER LETTER(26),SUPPLY(26) !For counting the alphabet. + CONTAINS + SUBROUTINE SWAP(I,J) !This really should be known to the compiler. + INTEGER I,J,K !Which could generate in-place code, + K = I !Using registers, maybe. + I = J !Or maybe, there are special op-codes. + J = K !Rather than this clunkiness. + END SUBROUTINE SWAP !And it should be for any type of thingy. + + INTEGER FUNCTION LSTNB(TEXT) !Sigh. Last Not Blank. +Concocted yet again by R.N.McLean (whom God preserve) December MM. +Code checking reveals that the Compaq compiler generates a copy of the string and then finds the length of that when using the latter-day intrinsic LEN_TRIM. Madness! +Can't DO WHILE (L.GT.0 .AND. TEXT(L:L).LE.' ') !Control chars. regarded as spaces. +Curse the morons who think it good that the compiler MIGHT evaluate logical expressions fully. +Crude GO TO rather than a DO-loop, because compilers use a loop counter as well as updating the index variable. +Comparison runs of GNASH showed a saving of ~3% in its mass-data reading through the avoidance of DO in LSTNB alone. +Crappy code for character comparison of varying lengths is avoided by using ICHAR which is for single characters only. +Checking the indexing of CHARACTER variables for bounds evoked astounding stupidities, such as calculating the length of TEXT(L:L) by subtracting L from L! +Comparison runs of GNASH showed a saving of ~25-30% in its mass data scanning for this, involving all its two-dozen or so single-character comparisons, not just in LSTNB. + CHARACTER*(*),INTENT(IN):: TEXT !The bumf. If there must be copy-in, at least there need not be copy back. + INTEGER L !The length of the bumf. + L = LEN(TEXT) !So, what is it? + 1 IF (L.LE.0) GO TO 2 !Are we there yet? + IF (ICHAR(TEXT(L:L)).GT.ICHAR(" ")) GO TO 2 !Control chars are regarded as spaces also. + L = L - 1 !Step back one. + GO TO 1 !And try again. + 2 LSTNB = L !The last non-blank, possibly zero. + RETURN !Unsafe to use LSTNB as a variable. + END FUNCTION LSTNB !Compilers can bungle it. + + SUBROUTINE LETTERCOUNT(TEXT) !Count the occurrences of A-Z. + CHARACTER*(*) TEXT !The text to inspect. + INTEGER I,K !Assistants. + DO I = 1,LEN(TEXT) !Step through the text. + K = ICHAR(TEXT(I:I)) - ICHAR("A") + 1 !This presumes that A-Z have contiguous codes! + IF (K.GE.1 .AND. K.LE.26) LETTER(K) = LETTER(K) + 1 !Not so with EBCDIC!! + END DO !On to the next letter. + END SUBROUTINE LETTERCOUNT !Be careful with LETTER. + + SUBROUTINE UPCASE(TEXT) !In the absence of an intrinsic... +Converts any lower case letters in TEXT to upper case... +Concocted yet again by R.N.McLean (whom God preserve) December MM. +Converting from a DO loop evades having both an iteration counter to decrement and an index variable to adjust. + CHARACTER*(*) TEXT !The stuff to be modified. +c CHARACTER*26 LOWER,UPPER !Tables. a-z may not be contiguous codes. +c PARAMETER (LOWER = "abcdefghijklmnopqrstuvwxyz") +c PARAMETER (UPPER = "ABCDEFGHIJKLMNOPQRSTUVWXYZ") +CAREFUL!! The below relies on a-z and A-Z being contiguous, as is NOT the case with EBCDIC. + INTEGER I,L,IT !Fingers. + L = LEN(TEXT) !Get a local value, in case LEN engages in oddities. + I = L !Start at the end and work back.. + 1 IF (I.LE.0) RETURN !Are we there yet? Comparison against zero should not require a subtraction. +c IT = INDEX(LOWER,TEXT(I:I)) !Well? +c IF (IT .GT. 0) TEXT(I:I) = UPPER(IT:IT) !One to convert? + IT = ICHAR(TEXT(I:I)) - ICHAR("a") !More symbols precede "a" than "A". + IF (IT.GE.0 .AND. IT.LE.25) TEXT(I:I) = CHAR(IT + ICHAR("A")) !In a-z? Convert! + I = I - 1 !Back one. + GO TO 1 !Inspect.. + END SUBROUTINE UPCASE !Easy. + + SUBROUTINE ORDERSIDE(LETTER) !Puts the letters into order. + CHARACTER*(*) LETTER !The letters. + INTEGER I,N,H !Assistants. + CHARACTER*1 T !A scratchpad. + LOGICAL CURSE !A bit. + N = LEN(LETTER) !So, how many letters? + H = N - 1 !Last - First, and not +1. + IF (H.LE.0) RETURN !Ha ha. + 1 H = MAX(1,H*10/13) !The special feature. + IF (H.EQ.9 .OR. H.EQ.10) H = 11 !A twiddle. + CURSE = .FALSE. !So far, so good. + DO I = N - H,1,-1 !If H = 1, this is a BubbleSort. + IF (LETTER(I:I).LT.LETTER(I + H:I + H)) THEN !One compare. + T = LETTER(I:I) !One swap. + LETTER(I:I) = LETTER(I + H:I + H) !Alas, no SWAP(A,B) + LETTER(I + H:I + H) = T !Is recognised by the compiler. + CURSE = .TRUE. !If once a tiger is seen... + END IF !So much for that comparison. + END DO !On to the next. + IF (CURSE .OR. H.GT.1) GO TO 1!Another pass? + END SUBROUTINE ORDERSIDE !Simple enough. + SUBROUTINE ORDERBLOCKS(N,SOME) !Puts the collection of blocks into order. + INTEGER N !The number of blocks. + CHARACTER*(*) SOME(:) !Their lists of letters. + INTEGER I,H !Assistants. + CHARACTER*(LEN(SOME(1))) T !A scratchpad matching an element of SOME. + LOGICAL CURSE !Since there is still no SWAP(SOME(I),SOME(I + H)). + H = N - 1 !So here comes another CombSort. + IF (H.LE.0) RETURN !With standard suspicion. + 1 H = MAX(1,H*10/13) !This is the outer loop. + IF (H.EQ.9 .OR. H.EQ.10) H = 11 !This is a fiddle. + CURSE = .FALSE. !Start the next pass in hope. + DO I = N - H,1,-1 !Going backwards, just for fun. + IF (SOME(I).LT.SOME(I + H)) THEN !So then? + T = SOME(I) !Disorder. + SOME(I) = SOME(I + H) !So once again, + SOME(I + H) = T !Swap the two miscreants. + CURSE = .TRUE. !And remember. + END IF !So much for that comparison. + END DO !On to the next. + IF (CURSE .OR. H.GT.1) GO TO 1!Are we there yet? + END SUBROUTINE ORDERBLOCKS !Not much code, but ringing the changes is still tedious. + + SUBROUTINE PLAY(N,SOME) !Mess about with the collection of blocks. + INTEGER N !Their number. + CHARACTER*(*) SOME(:) !Their letters. + INTEGER NH,HIT(N) !A list of blocks. + INTEGER B,I,J,K,L,M !Assistants. + CHARACTER*1 C !A letter of the moment. + L = LEN(SOME(1)) !The maximum number of letters to any block. +Cast the collection on to the floor. + WRITE (MSG,1) N,L,SOME !Announce the set as it is supplied. + 1 FORMAT (I7," blocks, with at most",I2," letters:",66(1X,A)) +Change the "orientation" of some blocks. + DO B = 1,N !Step through each block. + CALL UPCASE(SOME(B)) !Paranoia rules. + CALL ORDERSIDE(SOME(B)) !Put its letter list into order. + END DO !On to the next block. + WRITE (MSG,2) SOME !Reveal the orderly array. + 2 FORMAT (6X,"... the letters in reverse order:",66(1X,A)) +Collate the collection of blocks. + CALL ORDERBLOCKS(N,SOME) !Now order the blocks by their letters. + WRITE (MSG,3) SOME !Reveal them in neato order. + 3 FORMAT (7X,"... the blocks in reverse order:",66(1X,A)) +Count the appearances of the letters of the alphabet. + LETTER = 0 !Enough of shuffling blocks around. + DO B = 1,N !Now inspect their collective letters. + CALL LETTERCOUNT(SOME(B)) !A block's worth at a go. + END DO !On to the next block. + SUPPLY = LETTER !Save the counts of supplied letters. + WRITE (MSG,4) (CHAR(ICHAR("A") + I - 1),I = 1,26),SUPPLY !Results. + 4 FORMAT (15X,"Letters of the alphabet:",26A,/, !First, a line with A ... Z. + 1 11X,"... number thereof supplied:",26I) !Then a line of the associated counts. +Check for blocks with duplicated letters. + WRITE (MSG,5) !Announce. + 5 FORMAT (8X,"Blocks with duplicated letters:",$) !Further output impends. + M = 0 !No duplication found. + DO B = 1,N !So step through each block. + JJ:DO J = 2,L !Inspecting successive letters of the block, + IF (SOME(B)(J:J).LE." ") EXIT JJ !Provided they've not run out. + DO K = 1,J - 1 !To see if it has appeared earlier. + IF (SOME(B)(K:K).LE." ") EXIT JJ!Reverse order means that spaces will be at the end! + IF (SOME(B)(J:J).EQ.SOME(B)(K:K)) THEN !Well? + M = M + 1 !A match! + WRITE (MSG,6) SOME(B) !Name the block. + 6 FORMAT (1X,A,$) !With further output still impending, + EXIT JJ !And give up on this block. + END IF !One duplicated letter is sufficient for its downfall. + END DO !Next letter up. + END DO JJ !On to the next letter of the block. + END DO !On to the next block. + CALL HIC(M) !Show the count and end the line. +Check for duplicate blocks, knowing that the array of blocks is ordered. + WRITE (MSG,7) !Announce. + 7 FORMAT (21X,"Duplicated blocks:",$) !Again, leave the line dangling. + K = 0 !No duplication found. + B = 1 !Syncopation. + 70 B = B + 1 !Advance one. + IF (B.GT.N) GO TO 72 !Are we there yet? + IF (SOME(B).NE.SOME(B - 1)) GO TO 70 !No match? Search on. + K = K + 1 !A match is counted. + WRITE (MSG,6) SOME(B) !Name it. + 71 B = B + 1 !And speed through continued matching. + IF (B.GT.N) GO TO 72 !Unless we're of the end. + IF (SOME(B).EQ.SOME(B - 1)) GO TO 71 !Continued matching? + GO TO 70 !Mismatch: resume the normal scan. + 72 CALL HIC(K) !So much for that. +Check for duplicated letters across different blocks. + IF (ALL(SUPPLY.LE.1)) RETURN !Unless there are no duplicated letters. + WRITE (MSG,8) !Announce. + 8 FORMAT ("Duplicated letters on different blocks:",$) !More to come. + K = 0 !Start another count. + DO I = 1,26 !A well-known span. + IF (SUPPLY(I).LE.1) CYCLE !Any duplicated letters? + C = CHAR(ICHAR("A") + I - 1)!Yes. This is the character. + NH = 0 !So, how many blocks contribute? + DO B = 1,N !Find out. + IF (INDEX(SOME(B),C).GT.0) THEN !On this block? + NH = NH + 1 !Yes. + HIT(NH) = B !Keep track of which. + END IF !So much for that block. + END DO !On to the next. + IF (ANY(SOME(HIT(2:NH)) .NE. SOME(HIT(1)))) THEN !All have the same collection of letters? + K = K + 1 !No! + WRITE (MSG,9) C !Name the heterogenously supported letter. + 9 FORMAT (A,$) !Use the same spacing even though one character only. + END IF !So much for that letter's search. + END DO !On to the next letter. + CALL HIC(K) !Finish the line with the count report. + CONTAINS !This is used often enough. + SUBROUTINE HIC(N) !But has very specific context. + INTEGER N !The count. + IF (N.LE.0) WRITE (MSG,*) "None." !Yes, we have no bananas. + IF (N.GT.0) WRITE (MSG,*) N !Either way, end the line. + END SUBROUTINE HIC !This service routine is not needed elsewhere. + END SUBROUTINE PLAY !Look mummy! All the blockses are neatened! + + LOGICAL FUNCTION CANBLOCK(WORD,N,SOME) !Can the blocks spell out the word? +Creates a move tree based on the letters of WORD and for each, the blocks available. + CHARACTER*(*) WORD !The word to spell out. + INTEGER N !The number of blocks. + CHARACTER*(*) SOME(:) !The blocks and their letters. + INTEGER NA,AVAIL(N) !Say not the struggle naught availeth! + INTEGER NMOVE(LEN(WORD)) !I need a list of acceptable blocks, + INTEGER MOVE(LEN(WORD),N) !One list for each letter of WORD. + INTEGER I,L,S !Assistants. + CHARACTER*1 C !The letter of the moment. + CANBLOCK = .FALSE. !Initial pessimism. + L = LSTNB(WORD) !Ignore trailing spaces. + IF (L.GT.N) RETURN !Enough blocks? + LETTER = 0 !To make rabbit stew, + CALL LETTERCOUNT(WORD(1:L)) !First catch your rabbit. + IF (ANY(SUPPLY .LT. LETTER)) RETURN !The larder is lacking. + NA = N !Prepare a list. + FORALL (I = 1:N) AVAIL(I) = I !That fingers every block. + I = 0 !Step through the letters of the WORD. +Chug through the letters of the WORD. + 1 I = I + 1 !One letter after the other. + IF (I.GT.L) GO TO 100 !Yay! We're through! + C = WORD(I:I) !The letter of the moment. + NMOVE(I) = 0 !No moves known at this new level. + DO S = 1,NA !So, look for them amongst the available slots. + IF (INDEX(SOME(AVAIL(S)),C) .GT. 0) THEN !A hit? + NMOVE(I) = NMOVE(I) + 1 !Yes! Count up another possible move. + MOVE(I,NMOVE(I)) = S !Remember its slot. + END IF !So much for that block. + END DO !On to the next. + 2 IF (NMOVE(I).GT.0) THEN !Have we any moves? + S = MOVE(I,NMOVE(I)) !Yes! Recover the last found. + NMOVE(I) = NMOVE(I) - 1 !Uncount, as it is about to be used. + IF (S.NE.NA) CALL SWAP(AVAIL(S),AVAIL(NA)) !This block is no longer available. + NA = NA - 1 !Shift the boundary back. + GO TO 1 !Try the next letter! + END IF !But if we can't find a move at that level... + I = I - 1 !Retreat a level. + IF (I.LE.0) RETURN !Oh dear! + S = MOVE(I,NMOVE(I) + 1) !Undo the move that had been made at this level. + NA = NA + 1 !And make its block is re-available. + IF (S.NE.NA) CALL SWAP(AVAIL(S),AVAIL(NA)) !Move it back. + GO TO 2 !See what moves remain at this level. +Completed! + 100 CANBLOCK = .TRUE. !That's a relief. + END FUNCTION CANBLOCK !Some revisions might have been made. + END MODULE PLAYPEN !No sand here. + + USE PLAYPEN !Just so. + INTEGER HAVE,TESTS !Parameters for the specified problem. + PARAMETER (HAVE = 20, TESTS = 7) !Number of blocks, number of tests. + CHARACTER*(MS) BLOCKS(HAVE) !Have blocks, will juggle. + DATA BLOCKS/"BO","XK","DQ","CP","NA","GT","RE","TG","QD","FS", !The specified set + 1 "JW","HU","VI","AN","OB","ER","FS","LY","PC","ZM"/ !Of letter blocks. + CHARACTER*8 WORD(TESTS) !Now for the specified test words. + LOGICAL ANS(TESTS),T,F !And the given results. + PARAMETER (T = .TRUE., F = .FALSE.) !Enable a more compact specification. + DATA WORD/"A","BARK","BOOK","TREAT","COMMON","SQUAD","CONFUSE"/ !So that these + DATA ANS/ T , T , F , T , F , T , T / !Can be aligned. + LOGICAL YAY + INTEGER I + + WRITE (MSG,1) + 1 FORMAT ("Arranges alphabet blocks, attending only to the ", + 1 "letters on the blocks, and ignoring case and orientation.",/) + + CALL PLAY(HAVE,BLOCKS) !Some fun first. + + WRITE (MSG,'(/"Now to see if some words can be spelled out.")') + DO I = 1,TESTS + CALL UPCASE(WORD(I)) + YAY = CANBLOCK(WORD(I),HAVE,BLOCKS) + WRITE (MSG,*) YAY,ANS(I),YAY.EQ.ANS(I),WORD(I) + END DO + END diff --git a/Task/ABC-Problem/Kotlin/abc-problem.kotlin b/Task/ABC-Problem/Kotlin/abc-problem.kotlin new file mode 100644 index 0000000000..d33d1e9ee6 --- /dev/null +++ b/Task/ABC-Problem/Kotlin/abc-problem.kotlin @@ -0,0 +1,39 @@ +package abc + +object ABC_block_checker { + fun run() { + val blocks = arrayOf("BO", "XK", "DQ", "CP", "NA", "GT", "RE", "TG", "QD", "FS", + "JW", "HU", "VI", "AN", "OB", "ER", "FS", "LY", "PC", "ZM") + + println("\"\": " + blocks.canMakeWord("")) + val words = arrayOf("A", "BARK", "book", "treat", "COMMON", "SQuAd", "CONFUSE") + for (w in words) println("$w: " + blocks.canMakeWord(w)) + } + + private fun Array.swap(i: Int, j: Int) { + val tmp = this[i] + this[i] = this[j] + this[j] = tmp + } + + private fun Array.canMakeWord(word: String): Boolean { + if (word.length == 0) + return true + + val c = Character.toUpperCase(word.first()) + var i = 0 + forEach { b -> + if (b.first().toUpperCase() == c || b[1].toUpperCase() == c) { + swap(0, i) + if (drop(1).toTypedArray().canMakeWord(word.substring(1))) + return true + swap(0, i) + } + i++ + } + + return false + } +} + +fun main(args: Array) = ABC_block_checker.run() diff --git a/Task/ABC-Problem/Liberty-BASIC/abc-problem-1.liberty b/Task/ABC-Problem/Liberty-BASIC/abc-problem-1.liberty new file mode 100644 index 0000000000..1791de412d --- /dev/null +++ b/Task/ABC-Problem/Liberty-BASIC/abc-problem-1.liberty @@ -0,0 +1,42 @@ +print "Rosetta Code - ABC problem (recursive solution)" +print +blocks$="BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM" +data "A" +data "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSE" +data "XYZZY" + +do + read text$ + if text$="XYZZY" then exit do + print ">>> can_make_word("; chr$(34); text$; chr$(34); ")" + if canDo(text$,blocks$) then print "True" else print "False" +loop while 1 +print "Program complete." +end + +function canDo(text$,blocks$) + 'endcase + if len(text$)=1 then canDo=(instr(blocks$,text$)<>0): exit function + 'get next letter + ltr$=left$(text$,1) + 'cut + if instr(blocks$,ltr$)=0 then canDo=0: exit function + 'recursion + text$=mid$(text$,2) 'rest + 'loop by all word in blocks. Need to make "newBlocks" - all but taken + 'optimisation: take only fitting blocks + wrd$="*" + i=0 + while wrd$<>"" + i=i+1 + wrd$=word$(blocks$, i) + if instr(wrd$, ltr$) then + 'newblocks without wrd$ + pos=instr(blocks$,wrd$) + newblocks$=left$(blocks$, pos-1)+mid$(blocks$, pos+3) + canDo=canDo(text$,newblocks$) + 'first found cuts + if canDo then exit while + end if + wend +end function diff --git a/Task/ABC-Problem/Liberty-BASIC/abc-problem-2.liberty b/Task/ABC-Problem/Liberty-BASIC/abc-problem-2.liberty new file mode 100644 index 0000000000..882f4956f9 --- /dev/null +++ b/Task/ABC-Problem/Liberty-BASIC/abc-problem-2.liberty @@ -0,0 +1,133 @@ +print "Rosetta Code - ABC problem (procedural solution)" +print +w$(1)="A" +w$(2)="BARK" +w$(3)="BOOK" +w$(4)="TREAT" +w$(5)="COMMON" +w$(6)="SQUAD" +w$(7)="CONFUSE" + +for x=1 to 7 + print ">>> can_make_word("; chr$(34); w$(x); chr$(34); ")" + if CanMakeWord(w$(x)) then print "True" else print "False" +next x +print "Program complete." +end + +function CanMakeWord(x$) +global DoneWithWord, BlocksUsed, LetterOK, Possibility +dim block$(20,2), block(20,2) +'numeric blocks, col 0 flags used block +block(1,1)=asc("B")-64: block(1,2)=asc("O")-64 +block(2,1)=asc("X")-64: block(2,2)=asc("K")-64 +block(3,1)=asc("D")-64: block(3,2)=asc("Q")-64 +block(4,1)=asc("C")-64: block(4,2)=asc("P")-64 +block(5,1)=asc("N")-64: block(5,2)=asc("A")-64 +block(6,1)=asc("G")-64: block(6,2)=asc("T")-64 +block(7,1)=asc("R")-64: block(7,2)=asc("E")-64 +block(8,1)=asc("T")-64: block(8,2)=asc("G")-64 +block(9,1)=asc("Q")-64: block(9,2)=asc("D")-64 +block(10,1)=asc("F")-64: block(10,2)=asc("S")-64 +block(11,1)=asc("J")-64: block(11,2)=asc("W")-64 +block(12,1)=asc("H")-64: block(12,2)=asc("U")-64 +block(13,1)=asc("V")-64: block(13,2)=asc("I")-64 +block(14,1)=asc("A")-64: block(14,2)=asc("N")-64 +block(15,1)=asc("O")-64: block(15,2)=asc("B")-64 +block(16,1)=asc("E")-64: block(16,2)=asc("R")-64 +block(17,1)=asc("F")-64: block(17,2)=asc("S")-64 +block(18,1)=asc("L")-64: block(18,2)=asc("Y")-64 +block(19,1)=asc("P")-64: block(19,2)=asc("C")-64 +block(20,1)=asc("Z")-64: block(20,2)=asc("M")-64 + +x$=upper$(x$) +for x=1 to len(x$) + y$=mid$(x$,x,1) + if y$>="A" and y$<="Z" then w$=w$+y$ +next x +if w$="" then exit function +DoneWithWord=0: BlocksUsed=0 +l=len(w$) +dim LetterOK(l) +dim alphabet(26,1) 'clear letter-usage array +for x=1 to 20 'load block letters into letter-usage array col 0 + alphabet(block(x,1),0)+=1 + alphabet(block(x,2),0)+=1 +next x +for x=1 to l 'load current word into letter-usage aray col 1 + wl$=mid$(w$,x,1): w=asc(wl$)-64 + alphabet(w,1)+=1 +next x + +for x=1 to 26 ' test for more of any letter in the word than in the blocks + if alphabet(x,1)>alphabet(x,0) then exit function +next x + +[NextLetter] +if wl 2) + THEN RETURN ERROR. + + CREATE ttBlocks. + ASSIGN ttBlocks.ttFaces[1] = SUBSTRING(i-chBlockValue, 1, 1) + ttBlocks.ttFaces[2] = SUBSTRING(i-chBlockValue, 2, 1). +END PROCEDURE. + + +FUNCTION blockInList RETURNS LOGICAL (pChar AS CHARACTER): + /* Find first unused block in list */ + FIND FIRST ttBlocks WHERE (ttBlocks.ttFaces[1] = pChar + OR ttBlocks.ttFaces[2] = pChar) + AND NOT ttBlocks.ttUsed NO-ERROR. + IF (AVAILABLE ttBlocks) THEN DO: + /* found it! set to used and return true */ + ASSIGN ttBlocks.ttUsed = TRUE. + RETURN TRUE. + END. + ELSE RETURN FALSE. +END FUNCTION. + + +FUNCTION canMakeWord RETURNS LOGICAL (INPUT pWord AS CHARACTER): + DEFINE VARIABLE i AS INTEGER NO-UNDO. + DEFINE VARIABLE chChar AS CHARACTER NO-UNDO. + + /* Word has to be valid */ + IF (LENGTH(pWord) = 0) + THEN RETURN FALSE. + + DO i = 1 TO LENGTH(pWord): + /* get the char */ + chChar = SUBSTRING(pWord, i, 1). + + /* Check to see if this is a letter? */ + IF ((ASC(chChar) < 65) OR (ASC(chChar) > 90) AND + (ASC(chChar) < 97) OR (ASC(chChar) > 122)) + THEN RETURN FALSE. + + /* Is block is list (and unused) */ + IF NOT blockInList(chChar) + THEN RETURN FALSE. + END. + + /* Reset all blocks */ + FOR EACH ttBlocks: + ASSIGN ttUsed = FALSE. + END. + RETURN TRUE. +END FUNCTION. diff --git a/Task/ABC-Problem/PARI-GP/abc-problem.pari b/Task/ABC-Problem/PARI-GP/abc-problem.pari new file mode 100644 index 0000000000..8473277932 --- /dev/null +++ b/Task/ABC-Problem/PARI-GP/abc-problem.pari @@ -0,0 +1,18 @@ +BLOCKS = "BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM"; +WORDS = ["A","Bark","BOOK","Treat","COMMON","SQUAD","conFUSE"]; + +can_make_word(w) = check(Vecsmall(BLOCKS), Vecsmall(w)) + +check(B,W,l=1,n=1) = +{ + if (l > #W, return(1), n > #B, return(0)); + + forstep (i = 1, #B-2, 2, + if (B[i] != bitand(W[l],223) && B[i+1] != bitand(W[l],223), next()); + B[i] = B[i+1] = 0; + if (check(B, W, l+1, n+2), return(1)) + ); + 0 +} + +for (i = 1, #WORDS, printf("%s\t%d\n", WORDS[i], can_make_word(WORDS[i]))); diff --git a/Task/ABC-Problem/Pascal/abc-problem.pascal b/Task/ABC-Problem/Pascal/abc-problem.pascal new file mode 100644 index 0000000000..9054ae3fe5 --- /dev/null +++ b/Task/ABC-Problem/Pascal/abc-problem.pascal @@ -0,0 +1,66 @@ +#!/usr/bin/instantfpc +//program ABCProblem; + +{$mode objfpc}{$H+} + +uses SysUtils, Classes; + +const + // every couple of chars is a block + // remove one by replacing its 2 chars by 2 spaces + Blocks = 'BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM'; + BlockSize = 3; + +function can_make_word(Str: String): boolean; +var + wkBlocks: string = Blocks; + c: Char; + iPos : Integer; +begin + // all chars to uppercase + Str := UpperCase(Str); + Result := Str <> ''; + if Result then + begin + for c in Str do + begin + iPos := Pos(c, wkBlocks); + if (iPos > 0) then + begin + // Char found + wkBlocks[iPos] := ' '; + // Remove the other face + if (iPos mod BlockSize = 1) then + wkBlocks[iPos + 1] := ' ' + else + wkBlocks[iPos - 1] := ' '; + end + else + begin + // missed + Result := False; + break; + end; + end; + end; + // Debug... + //WriteLn(Blocks); + //WriteLn(wkBlocks); +End; + +procedure TestABCProblem(Str: String); +const + boolStr : array[boolean] of String = ('False', 'True'); +begin + WriteLn(Format('>>> can_make_word("%s")%s%s', [Str, LineEnding, boolStr[can_make_word(Str)]])); +End; + +begin + TestABCProblem('A'); + TestABCProblem('BARK'); + TestABCProblem('BOOK'); + TestABCProblem('TREAT'); + TestABCProblem('COMMON'); + TestABCProblem('SQUAD'); + TestABCProblem('CONFUSE'); +END. diff --git a/Task/ABC-Problem/Perl-6/abc-problem.pl6 b/Task/ABC-Problem/Perl-6/abc-problem.pl6 index fd9c9b4fa3..9bf7e48ac2 100644 --- a/Task/ABC-Problem/Perl-6/abc-problem.pl6 +++ b/Task/ABC-Problem/Perl-6/abc-problem.pl6 @@ -1,5 +1,5 @@ multi can-spell-word(Str $word, @blocks) { - my @regex = @blocks.map({ EVAL "/{.comb.join('|')}/" }).grep: { .ACCEPTS($word.uc) } + my @regex = @blocks.map({ my @c = .comb; rx/<@c>/ }).grep: { .ACCEPTS($word.uc) } can-spell-word $word.uc.comb.list, @regex; } diff --git a/Task/ABC-Problem/Run-BASIC/abc-problem.run b/Task/ABC-Problem/Run-BASIC/abc-problem.run new file mode 100644 index 0000000000..0c53e56b60 --- /dev/null +++ b/Task/ABC-Problem/Run-BASIC/abc-problem.run @@ -0,0 +1,25 @@ +blocks$ = "BO,XK,DQ,CP,NA,GT,RE,TG,QD,FS,JW,HU,VI,AN,OB,ER,FS,LY,PC,ZM" +makeWord$ = "A,BARK,BOOK,TREAT,COMMON,SQUAD,Confuse" +b = int((len(blocks$) /3) + 1) +dim blk$(b) + +for i = 1 to len(makeWord$) + wrd$ = word$(makeWord$,i,",") + dim hit(b) + n = 0 + if wrd$ = "" then exit for + for k = 1 to len(wrd$) + w$ = upper$(mid$(wrd$,k,1)) + for j = 1 to b + if hit(j) = 0 then + if w$ = left$(word$(blocks$,j,","),1) or w$ = right$(word$(blocks$,j,","),1) then + hit(j) = 1 + n = n + 1 + exit for + end if + end if + next j + next k + print wrd$;chr$(9); + if n = len(wrd$) then print " True" else print " False" +next i diff --git a/Task/ABC-Problem/ZX-Spectrum-Basic/abc-problem.zx b/Task/ABC-Problem/ZX-Spectrum-Basic/abc-problem.zx new file mode 100644 index 0000000000..85e2aba46e --- /dev/null +++ b/Task/ABC-Problem/ZX-Spectrum-Basic/abc-problem.zx @@ -0,0 +1,21 @@ +10 LET b$="BOXKDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM" +20 READ p +30 FOR c=1 TO p +40 READ p$ +50 GO SUB 100 +60 NEXT c +70 STOP +80 DATA 7,"A","BARK","BOOK","TREAT","COMMON","SQUAD","CONFUSE" +90 REM Can make? +100 LET u$=b$ +110 PRINT "Can make word ";p$;"? "; +120 FOR i=1 TO LEN p$ +130 FOR j=1 TO LEN u$ +140 IF p$(i)=u$(j) THEN GO SUB 200: GO TO 160 +150 NEXT j +160 IF j>LEN u$ THEN PRINT "No": RETURN +170 NEXT i +180 PRINT "Yes": RETURN +190 REM Erase pair +200 IF j/2=INT (j/2) THEN LET u$(j-1 TO j)=" ": RETURN +210 LET u$(j TO j+1)=" ": RETURN diff --git a/Task/AKS-test-for-primes/00DESCRIPTION b/Task/AKS-test-for-primes/00DESCRIPTION index c709f6e5bf..66f8fc2c9b 100644 --- a/Task/AKS-test-for-primes/00DESCRIPTION +++ b/Task/AKS-test-for-primes/00DESCRIPTION @@ -1,29 +1,37 @@ -The [http://www.cse.iitk.ac.in/users/manindra/algebra/primality_v6.pdf AKS algorithm] for testing whether a number is prime is a -polynomial-time algorithm based on an elementary theorem about Pascal triangles. +The [http://www.cse.iitk.ac.in/users/manindra/algebra/primality_v6.pdf AKS algorithm] for testing whether a number is prime is a polynomial-time algorithm based on an elementary theorem about Pascal triangles. The theorem on which the test is based can be stated as follows: -* a number p is prime if and only if all the coefficients of the polynomial expansion of -: (x-1)^p - (x^p - 1) -are divisible by p. +*   a number   p   is prime   if and only if   all the coefficients of the polynomial expansion of +::: (x-1)^p - (x^p - 1) +are divisible by   p. -For example, trying p=3: -: (x-1)^3 - (x^3 - 1) -= (x^3 -3x^2 +3x -1) - (x^3 - 1) -= -3x^2 +3x - -:And all the coefficients are divisible by 3 so 3 is prime. +;Example: +Using   p=3: -{{alertbox|#ffe4e4|'''Note:'''
This task is '''not''' the AKS primality test. It is an inefficient exponential time algorithm discovered in the late 1600s and used as an introductory lemma in the AKS derivation.}} + (x-1)^3 - (x^3 - 1) + = (x^3 - 3x^2 + 3x - 1) - (x^3 - 1) + = -3x^2 + 3x + + +And all the coefficients are divisible by '''3''',   so '''3''' is prime. + + +{{alertbox|#ffe4e4|'''Note:'''
This task is '''not''' the AKS primality test.   It is an inefficient exponential time algorithm discovered in the late 1600s and used as an introductory lemma in the AKS derivation.}} + + +;Task: + + +# Create a function/subroutine/method that given   p   generates the coefficients of the expanded polynomial representation of   (x-1)^p. +# Use the function to show here the polynomial expansions of   (x-1)^p   for   p   in the range   '''0'''   to at least   '''7''',   inclusive. +# Use the previous function in creating another function that when given   p   returns whether   p   is prime using the theorem. +# Use your test to generate a list of all primes ''under''   '''35'''. +# '''As a stretch goal''',   generate all primes under   '''50'''   (needs integers larger than 31-bit). -;The task: -# Create a function/subroutine/method that given p generates the coefficients of the expanded polynomial representation of (x-1)^p. -# Use the function to show here the polynomial expansions of (x-1)^p for p in the range 0 to at least 7, inclusive. -# Use the previous function in creating another function that when given p returns whether p is prime using the theorem. -# Use your test to generate a list of all primes ''under'' 35. -# '''As a stretch goal''', generate all primes under 50 (Needs greater than 31 bit integers). ;References: * [https://en.wikipedia.org/wiki/AKS_primality_test Agrawal-Kayal-Saxena (AKS) primality test] (Wikipedia) * [http://www.youtube.com/watch?v=HvMSRWTE2mI Fool-Proof Test for Primes] - Numberphile (Video). The accuracy of this video is disputed -- at best it is an oversimplification. +

diff --git a/Task/AKS-test-for-primes/OCaml/aks-test-for-primes.ocaml b/Task/AKS-test-for-primes/OCaml/aks-test-for-primes.ocaml new file mode 100644 index 0000000000..3018caed33 --- /dev/null +++ b/Task/AKS-test-for-primes/OCaml/aks-test-for-primes.ocaml @@ -0,0 +1,42 @@ +#require "gen" +#require "zarith" +open Z +let range ?(step=one) i j = if i = j then Gen.empty else Gen.unfold (fun k -> + if compare i j = compare k j then Some (k, (add step k)) else None) i + +(* kth coefficient of (x - 1)^n *) +let coeff n k = + let numer = Gen.fold mul one + (range n (sub n k) ~step:minus_one) in + let denom = Gen.fold mul one + (range k zero ~step:minus_one) in + div numer denom |> mul @@ + if + compare k n < 0 && is_even k + then + minus_one + else + one + +(* coefficient series for (x - 1)^n, k=[0..n] *) +let coeff_series n = + Gen.map (coeff n) (range zero (succ n)) + +let middle g = Gen.drop 1 g |> Gen.peek |> Gen.filter_map + (function (_, None) -> None | (e, _) -> Some e) + +let is_mod_p ~p n = rem n p = zero + +let aks p = + coeff_series p |> middle |> Gen.for_all (is_mod_p ~p) + +let _ = + print_endline "coefficient series n (k[0] .. k[n])"; + Gen.iter + (fun n -> Format.printf "%d (%s)\n" (to_int n) + (Gen.map to_string (coeff_series n) |> Gen.to_list |> String.concat " ")) + (range zero (of_int 10)); + print_endline ""; + print_endline ("primes < 50 per AKS: " ^ + (Gen.filter aks (range (of_int 2) (of_int 50)) |> + Gen.map to_string |> Gen.to_list |> String.concat " ")) diff --git a/Task/AKS-test-for-primes/Perl-6/aks-test-for-primes-1.pl6 b/Task/AKS-test-for-primes/Perl-6/aks-test-for-primes-1.pl6 index c79e49e1f9..76f3a8bf07 100644 --- a/Task/AKS-test-for-primes/Perl-6/aks-test-for-primes-1.pl6 +++ b/Task/AKS-test-for-primes/Perl-6/aks-test-for-primes-1.pl6 @@ -1,3 +1,3 @@ -constant expansions = [1], [1,-1], -> @prior { [@prior,0 Z- 0,@prior] } ... *; +constant expansions = [1], [1,-1], -> @prior { [|@prior,0 Z- 0,|@prior] } ... *; sub polyprime($p where 2..*) { so expansions[$p].[1 ..^ */2].all %% $p } diff --git a/Task/AKS-test-for-primes/REXX/aks-test-for-primes-2.rexx b/Task/AKS-test-for-primes/REXX/aks-test-for-primes-2.rexx index f93378cb28..75fa6d9b5a 100644 --- a/Task/AKS-test-for-primes/REXX/aks-test-for-primes-2.rexx +++ b/Task/AKS-test-for-primes/REXX/aks-test-for-primes-2.rexx @@ -1,40 +1,41 @@ -/*REXX pgm calculates primes via the Agrawal-Kayal-Saxena (AKS) primality test*/ -parse arg Z .; if Z=='' then Z=200 /*Z not specified? Then use default.*/ -OZ=Z; tell=Z<0; Z=abs(Z) /*Is Z negative? Then show expression.*/ -numeric digits max(9,Z%3) /*define a dynamic # of decimal digits.*/ -$.0='-'; $.1="+"; @.=1 /*$.x: sign char; default coefficients.*/ -#= /*define list of prime numbers (so far)*/ - do p=3 for Z; pm=p-1; pp=p+1 /*PM & PP: used as a coding convenience*/ - do m=2 for pp%2-1; mm=m-1 /*calculate coefficients for a power. */ - @.p.m=@.pm.mm + @.pm.m; h=pp-m /*calculate left side of coefficients*/ - @.p.h=@.p.m /* " right " " " */ - end /*m*/ /* [↑] The M DO loop creates both */ - end /*p*/ /* sides in the same loop, saving */ - /* a bunch of execution time. */ -if tell then say '(x-1)^0: 1' /*possibly display the first expression*/ - /* [↓] test for primality by division.*/ - do n=2 for Z; nh=n%2; d=n-1 /*create expressions; find the primes.*/ - do k=3 to nh while @.n.k//d==0 /*are coefficients divisible by N-1 ? */ - end /*k*/ /* [↑] skip the 1st & 2nd coefficients*/ - /* [↓] multiple THEN─IF faster than &s*/ - if d\==1 then if d\==4 then if k>nh then #=# d /*add number to prime list.*/ - if \tell then iterate /*Don't tell? Don't show expressions.*/ - y='(x-1)^'d": " /*define first part of the expression. */ - s=1 /*S: is the sign indicator (-1│+1).*/ - do j=n to 2 by -1 /*create the higher powers first. */ - if j==2 then xp='x' /*if power=1, then don't show the power*/ - else xp='x^' || (j-1) /* ··· else show power with ^ */ - if j==n then y=y xp /*no sign (+│-) for the 1st expression.*/ - else y=y $.s @.n.j'∙'xp /*build the expression with sign (+|-).*/ - s=\s /*flip the sign for the next expression*/ - end /*j*/ /* [↑] the sign (now) is either 0 │ 1,*/ - /* and is displayed either - │ + */ - say y $.s 1 /*just show the first N expressions, */ - end /*n*/ /* [↑] ··· but only for negative Z. */ - say /* [↓] Has Z a leading + ? Then show.*/ -is="isn't"; if Z==word(. #,words(#)+1) then is='is' /*is or isn't a prime.*/ -if left(OZ,1)=='+' then say Z is 'prime.' /*tell if OZ has a +. */ - else say 'primes:' # /*display prime # list. */ -say /* [↓] size of big 'un.*/ -say 'Found ' words(#) ' primes and the largest coefficient has' , - length(@.pm.h) "decimal digits." /*stick a fork in it, we're all done. */ +/*REXX program calculates primes via the Agrawal─Kayal─Saxena (AKS) primality test.*/ +parse arg Z .; if Z=='' | Z=="," then Z=200 /*Z not specified? Then use default.*/ +OZ=Z; tell=Z<0; Z=abs(Z) /*Is Z negative? Then show expression.*/ +numeric digits max(9,Z%3) /*define a dynamic # of decimal digits.*/ +$.0='-'; $.1="+"; @.=1 /*$.x: sign char; default coefficients.*/ +#= /*define list of prime numbers (so far)*/ + do p=3 for Z; pm=p-1; pp=p+1 /*PM & PP: used as a coding convenience*/ + do m=2 for pp%2-1; mm=m-1 /*calculate coefficients for a power. */ + @.p.m=@.pm.mm + @.pm.m; h=pp-m /*calculate left side of coefficients*/ + @.p.h=@.p.m /* " right " " " */ + end /*m*/ /* [↑] The M DO loop creates both */ + end /*p*/ /* sides in the same loop, saving */ + /* a bunch of execution time. */ +if tell then say '(x-1)^0: 1' /*possibly display the first expression*/ + /* [↓] test for primality by division.*/ + do n=2 for Z; nh=n%2; d=n-1 /*create expressions; find the primes.*/ + do k=3 to nh while @.n.k//d==0 /*are coefficients divisible by N-1 ? */ + end /*k*/ /* [↑] skip the 1st & 2nd coefficients*/ + /* [↓] multiple THEN─IF faster than &s*/ + if d\==1 then if d\==4 then if k>nh then #=# d /*add a number to prime list.*/ + if \tell then iterate /*Don't tell? Don't show expressions.*/ + y='(x-1)^'d": " /*define the 1st part of the expression*/ + s=1 /*S: is the sign indicator (-1│+1).*/ + do j=n to 2 by -1 /*create the higher powers first. */ + if j==2 then xp='x' /*if power=1, then don't show the power*/ + else xp='x^' || (j-1) /* ··· else show power with ^ */ + if j==n then y=y xp /*no sign (+│-) for the 1st expression.*/ + else y=y $.s @.n.j'∙'xp /*build the expression with sign (+|-).*/ + s=\s /*flip the sign for the next expression*/ + end /*j*/ /* [↑] the sign (now) is either 0 │ 1,*/ + /* and is displayed either - │ + */ + say y $.s 1 /*just show the first N expressions, */ + end /*n*/ /* [↑] ··· but only for negative Z. */ +say /* [↓] Has Z a leading + ? Then show.*/ +if Z==word(. #,words(#)+1) then is='is' /*the number is a prime. */ + else is="isn't" /* " " ain't " " */ +if left(OZ,1)=='+' then say Z is 'prime.' /*show if OZ has a + (plus sign). */ + else say 'primes:' # /*display the prime number list. */ +say /* [↓] the digit length of a big coef.*/ +say 'Found ' words(#) " primes and the largest coefficient has " length(@.pm.h), + " decimal digits." /*stick a fork in it, we're all done. */ diff --git a/Task/Abstract-type/PowerShell/abstract-type-1.psh b/Task/Abstract-type/PowerShell/abstract-type-1.psh new file mode 100644 index 0000000000..c1c82d3b36 --- /dev/null +++ b/Task/Abstract-type/PowerShell/abstract-type-1.psh @@ -0,0 +1,92 @@ +#Requires -Version 5.0 + +Class Player +{ + <# + Properties: Name, Team, Position and Number + #> + [string]$Name + + [ValidateSet("Baltimore Ravens","Cincinnati Bengals","Cleveland Browns","Pittsburgh Steelers", + "Chicago Bears","Detroit Lions","Green Bay Packers","Minnesota Vikings", + "Houston Texans","Indianapolis Colts","Jacksonville Jaguars","Tennessee Titans", + "Atlanta Falcons","Carolina Panthers","New Orleans Saints","Tampa Bay Buccaneers", + "Buffalo Bills","Miami Dolphins","New England Patriots","New York Jets", + "Dallas Cowboys","New York Giants","Philadelphia Eagles","Washington Redskins", + "Denver Broncos","Kansas City Chiefs","Oakland Raiders","San Diego Chargers", + "Arizona Cardinals","Los Angeles Rams","San Francisco 49ers","Seattle Seahawks")] + [string]$Team + + [ValidateSet("C","G","T","QB","RB","WR","TE","DT","DE","ILB","OLB","CB","S","K","H","LS","P","KOS","R")] + [string]$Position + + [ValidateRange(0,99)] + [int]$Number + + <# + Constructor: Creates a new Player object, with the specified Name, Team, Position and Number. + #> + Player([string]$Name, [string]$Team, [string]$Position, [int]$Number) + { + $this.Name = (Get-Culture).TextInfo.ToTitleCase("$Name") + $this.Team = (Get-Culture).TextInfo.ToTitleCase("$Team") + $this.Position = $Position.ToUpper() + $this.Number = $Number + } + + <# + Methods: Trade the player to a different team (optional parameters for methods in PowerShell 5 classes are not available. Boo!!) + An overloaded method is a method with the same name as another method but in a different context, + in this case with different parameters. + #> + Trade([string]$NewTeam) + { + [string[]]$league = "Baltimore Ravens","Cincinnati Bengals","Cleveland Browns","Pittsburgh Steelers", + "Chicago Bears","Detroit Lions","Green Bay Packers","Minnesota Vikings", + "Houston Texans","Indianapolis Colts","Jacksonville Jaguars","Tennessee Titans", + "Atlanta Falcons","Carolina Panthers","New Orleans Saints","Tampa Bay Buccaneers", + "Buffalo Bills","Miami Dolphins","New England Patriots","New York Jets", + "Dallas Cowboys","New York Giants","Philadelphia Eagles","Washington Redskins", + "Denver Broncos","Kansas City Chiefs","Oakland Raiders","San Diego Chargers", + "Arizona Cardinals","Los Angeles Rams","San Francisco 49ers","Seattle Seahawks" + + if ($NewTeam -in $league | Where-Object {$_ -notmatch $this.Team}) + { + $this.Team = (Get-Culture).TextInfo.ToTitleCase("$NewTeam") + } + else + { + throw "Invalid Team" + } + } + + Trade([string]$NewTeam, [int]$NewNumber) + { + [string[]]$league = "Baltimore Ravens","Cincinnati Bengals","Cleveland Browns","Pittsburgh Steelers", + "Chicago Bears","Detroit Lions","Green Bay Packers","Minnesota Vikings", + "Houston Texans","Indianapolis Colts","Jacksonville Jaguars","Tennessee Titans", + "Atlanta Falcons","Carolina Panthers","New Orleans Saints","Tampa Bay Buccaneers", + "Buffalo Bills","Miami Dolphins","New England Patriots","New York Jets", + "Dallas Cowboys","New York Giants","Philadelphia Eagles","Washington Redskins", + "Denver Broncos","Kansas City Chiefs","Oakland Raiders","San Diego Chargers", + "Arizona Cardinals","Los Angeles Rams","San Francisco 49ers","Seattle Seahawks" + + if ($NewTeam -in $league | Where-Object {$_ -notmatch $this.Team}) + { + $this.Team = (Get-Culture).TextInfo.ToTitleCase("$NewTeam") + } + else + { + throw "Invalid Team" + } + + if ($NewNumber -in 0..99) + { + $this.Number = $NewNumber + } + else + { + throw "Invalid Number" + } + } +} diff --git a/Task/Abstract-type/PowerShell/abstract-type-2.psh b/Task/Abstract-type/PowerShell/abstract-type-2.psh new file mode 100644 index 0000000000..a0711e85f9 --- /dev/null +++ b/Task/Abstract-type/PowerShell/abstract-type-2.psh @@ -0,0 +1,2 @@ +$player1 = [Player]::new("sam bradford", "philadelphia eagles", "qb", 7) +$player1 diff --git a/Task/Abstract-type/PowerShell/abstract-type-3.psh b/Task/Abstract-type/PowerShell/abstract-type-3.psh new file mode 100644 index 0000000000..4c2ddc606c --- /dev/null +++ b/Task/Abstract-type/PowerShell/abstract-type-3.psh @@ -0,0 +1,2 @@ +$player1.Trade("minnesota vikings", 8) +$player1 diff --git a/Task/Abstract-type/PowerShell/abstract-type-4.psh b/Task/Abstract-type/PowerShell/abstract-type-4.psh new file mode 100644 index 0000000000..7cd5678d1b --- /dev/null +++ b/Task/Abstract-type/PowerShell/abstract-type-4.psh @@ -0,0 +1,2 @@ +$player2 = [Player]::new("demarco murray", "philadelphia eagles", "rb", 29) +$player2 diff --git a/Task/Abstract-type/PowerShell/abstract-type-5.psh b/Task/Abstract-type/PowerShell/abstract-type-5.psh new file mode 100644 index 0000000000..1b65e884e8 --- /dev/null +++ b/Task/Abstract-type/PowerShell/abstract-type-5.psh @@ -0,0 +1,2 @@ +$player2.Trade("tennessee titans") +$player2 diff --git a/Task/Abstract-type/Rust/abstract-type-1.rust b/Task/Abstract-type/Rust/abstract-type-1.rust new file mode 100644 index 0000000000..c2f21a3b63 --- /dev/null +++ b/Task/Abstract-type/Rust/abstract-type-1.rust @@ -0,0 +1,3 @@ +trait Shape { + fn area(self) -> i32; +} diff --git a/Task/Abstract-type/Rust/abstract-type-2.rust b/Task/Abstract-type/Rust/abstract-type-2.rust new file mode 100644 index 0000000000..e3b34fc67a --- /dev/null +++ b/Task/Abstract-type/Rust/abstract-type-2.rust @@ -0,0 +1,9 @@ +struct Square { + side_length: i32 +} + +impl Shape for Square { + fn area(self) -> i32 { + self.side_length * self.side_length + } +} diff --git a/Task/Abstract-type/Rust/abstract-type-3.rust b/Task/Abstract-type/Rust/abstract-type-3.rust new file mode 100644 index 0000000000..6be8ab9015 --- /dev/null +++ b/Task/Abstract-type/Rust/abstract-type-3.rust @@ -0,0 +1,7 @@ +trait Shape { + fn area(self) -> i32; + + fn is_shape(self) -> bool { + true + } +} diff --git a/Task/Abundant,-deficient-and-perfect-number-classifications/00DESCRIPTION b/Task/Abundant,-deficient-and-perfect-number-classifications/00DESCRIPTION index e0f267b3d9..d9bc0e98a5 100644 --- a/Task/Abundant,-deficient-and-perfect-number-classifications/00DESCRIPTION +++ b/Task/Abundant,-deficient-and-perfect-number-classifications/00DESCRIPTION @@ -1,16 +1,24 @@ -These define three classifications of positive integers based on their [[Proper divisors|proper divisors]]. +These define three classifications of positive integers based on their   [[Proper divisors|proper divisors]]. -Let P(n) be the sum of the proper divisors of n, where the proper divisors of n are all positive divisors of n other than n itself. -* if P(n) < n then n is classed as '''deficient''' ([https://oeis.org/A005100 OEIS A005100]). -* if P(n) == n then n is classed as '''perfect''' ([https://oeis.org/A000396 OEIS A000396]). -* if P(n) > n then n is classed as '''abundant''' ([https://oeis.org/A005101 OEIS A005101]). +Let   P(n)   be the sum of the proper divisors of   '''n'''   where the proper divisors are all positive divisors of   '''n'''   other than   '''n'''   itself. + if P(n) < n then '''n''' is classed as '''deficient''' ([https://oeis.org/A005100 OEIS A005100]). + if P(n) == n then '''n''' is classed as '''perfect''' ([https://oeis.org/A000396 OEIS A000396]). + if P(n) > n then '''n''' is classed as '''abundant''' ([https://oeis.org/A005101 OEIS A005101]). + + +;Example: +'''6'''   has proper divisors of   '''1''',   '''2''',   and   '''3'''. + +'''1 + 2 + 3 = 6''',   so   '''6'''   is classed as a perfect number. -Example: 6 has proper divisors 1, 2, and 3. 1 + 2 + 3 = 6 so 6 is classed as a perfect number. ;Task: -Calculate how many of the integers 1 to 20,000 inclusive are in each of the three classes and show the result here. +Calculate how many of the integers   '''1'''   to   '''20,000'''   (inclusive) are in each of the three classes. -;Cf. -* [[Aliquot sequence classifications]]. (The whole series from which this task is a subset). -* [[Proper divisors]] -* [[Amicable pairs]] +Show the results here. + + +;Related tasks: +*   [[Aliquot sequence classifications]].   (The whole series from which this task is a subset.) +*   [[Proper divisors]] +*   [[Amicable pairs]] diff --git a/Task/Abundant,-deficient-and-perfect-number-classifications/360-Assembly/abundant,-deficient-and-perfect-number-classifications.360 b/Task/Abundant,-deficient-and-perfect-number-classifications/360-Assembly/abundant,-deficient-and-perfect-number-classifications.360 new file mode 100644 index 0000000000..491c0e5fa6 --- /dev/null +++ b/Task/Abundant,-deficient-and-perfect-number-classifications/360-Assembly/abundant,-deficient-and-perfect-number-classifications.360 @@ -0,0 +1,56 @@ +* Abundant, deficient and perfect number 08/05/2016 +ABUNDEFI CSECT + USING ABUNDEFI,R13 set base register +SAVEAR B STM-SAVEAR(R15) skip savearea + DC 17F'0' savearea +STM STM R14,R12,12(R13) save registers + ST R13,4(R15) link backward SA + ST R15,8(R13) link forward SA + LR R13,R15 establish addressability + SR R10,R10 deficient=0 + SR R11,R11 perfect =0 + SR R12,R12 abundant =0 + LA R6,1 i=1 +LOOPI C R6,NN do i=1 to nn + BH ELOOPI + SR R8,R8 sum=0 + LR R9,R6 i + SRA R9,1 i/2 + LA R7,1 j=1 +LOOPJ CR R7,R9 do j=1 to i/2 + BH ELOOPJ + LR R2,R6 i + SRDA R2,32 + DR R2,R7 i//j=0 + LTR R2,R2 if i//j=0 + BNZ NOTMOD + AR R8,R7 sum=sum+j +NOTMOD LA R7,1(R7) j=j+1 + B LOOPJ +ELOOPJ CR R8,R6 if sum?i + BL SLI < + BE SEI = + BH SHI > +SLI LA R10,1(R10) deficient+=1 + B EIF +SEI LA R11,1(R11) perfect +=1 + B EIF +SHI LA R12,1(R12) abundant +=1 +EIF LA R6,1(R6) i=i+1 + B LOOPI +ELOOPI XDECO R10,XDEC edit deficient + MVC PG+10(5),XDEC+7 + XDECO R11,XDEC edit perfect + MVC PG+24(5),XDEC+7 + XDECO R12,XDEC edit abundant + MVC PG+39(5),XDEC+7 + XPRNT PG,80 print buffer + L R13,4(0,R13) restore savearea pointer + LM R14,R12,12(R13) restore registers + XR R15,R15 return code = 0 + BR R14 return to caller +NN DC F'20000' +PG DC CL80'deficient=xxxxx perfect=xxxxx abundant=xxxxx' +XDEC DS CL12 + REGEQU + END ABUNDEFI diff --git a/Task/Abundant,-deficient-and-perfect-number-classifications/ALGOL-68/abundant,-deficient-and-perfect-number-classifications.alg b/Task/Abundant,-deficient-and-perfect-number-classifications/ALGOL-68/abundant,-deficient-and-perfect-number-classifications.alg new file mode 100644 index 0000000000..dc2d461165 --- /dev/null +++ b/Task/Abundant,-deficient-and-perfect-number-classifications/ALGOL-68/abundant,-deficient-and-perfect-number-classifications.alg @@ -0,0 +1,69 @@ +# resturns the sum of the proper divisors of n # +# if n = 1, 0 or -1, we return 0 # +PROC sum proper divisors = ( INT n )INT: + BEGIN + INT result := 0; + INT abs n = ABS n; + IF abs n > 1 THEN + FOR d FROM ENTIER sqrt( abs n ) BY -1 TO 2 DO + IF abs n MOD d = 0 THEN + # found another divisor # + result +:= d; + IF d * d /= n THEN + # include the other divisor # + result +:= n OVER d + FI + FI + OD; + # 1 is always a proper divisor of numbers > 1 # + result +:= 1 + FI; + result + END # sum proper divisors # ; + +# classify the numbers 1 : 20 000 as abudant, deficient or perfect # +INT abundant count := 0; +INT deficient count := 0; +INT perfect count := 0; +INT abundant example := 0; +INT deficient example := 0; +INT perfect example := 0; +INT max number = 20 000; +FOR n TO max number DO + IF INT pd sum = sum proper divisors( n ); + pd sum < n + THEN + # have a deficient number # + deficient count +:= 1; + deficient example := n + ELIF pd sum = n + THEN + # have a perfect number # + perfect count +:= 1; + perfect example := n + ELSE # pd sum > n # + # have an abundant number # + abundant count +:= 1; + abundant example := n + FI +OD; + +# show how many of each type of number there are and an example # + +# displays the classification, count and example # +PROC show result = ( STRING classification, INT count, example )VOID: + print( ( "There are " + , whole( count, -8 ) + , " " + , classification + , " numbers up to " + , whole( max number, 0 ) + , " e.g.: " + , whole( example, 0 ) + , newline + ) + ); + +show result( "abundant ", abundant count, abundant example ); +show result( "deficient", deficient count, deficient example ); +show result( "perfect ", perfect count, perfect example ) diff --git a/Task/Abundant,-deficient-and-perfect-number-classifications/C-sharp/abundant,-deficient-and-perfect-number-classifications.cs b/Task/Abundant,-deficient-and-perfect-number-classifications/C-sharp/abundant,-deficient-and-perfect-number-classifications.cs new file mode 100644 index 0000000000..563eb10179 --- /dev/null +++ b/Task/Abundant,-deficient-and-perfect-number-classifications/C-sharp/abundant,-deficient-and-perfect-number-classifications.cs @@ -0,0 +1,53 @@ +using System; +using System.Linq; + +public class Program +{ + public static void Main() + { + int abundant, deficient, perfect; + ClassifyNumbers.UsingSieve(20000, out abundant, out deficient, out perfect); + Console.WriteLine($"Abundant: {abundant}, Deficient: {deficient}, Perfect: {perfect}"); + + ClassifyNumbers.UsingDivision(20000, out abundant, out deficient, out perfect); + Console.WriteLine($"Abundant: {abundant}, Deficient: {deficient}, Perfect: {perfect}"); + } +} + +public static class ClassifyNumbers +{ + //Fastest way + public static void UsingSieve(int bound, out int abundant, out int deficient, out int perfect) { + int a = 0, d = 0, p = 0; + //For very large bounds, this array can get big. + int[] sum = new int[bound + 1]; + for (int divisor = 1; divisor <= bound / 2; divisor++) { + for (int i = divisor + divisor; i <= bound; i += divisor) { + sum[i] += divisor; + } + } + for (int i = 1; i <= bound; i++) { + if (sum[i] < i) d++; + else if (sum[i] > i) a++; + else p++; + } + abundant = a; + deficient = d; + perfect = p; + } + + //Much slower, but doesn't use storage + public static void UsingDivision(int bound, out int abundant, out int deficient, out int perfect) { + int a = 0, d = 0, p = 0; + for (int i = 1; i < 20001; i++) { + int sum = Enumerable.Range(1, (i + 1) / 2) + .Where(div => div != i && i % div == 0).Sum(); + if (sum < i) d++; + else if (sum > i) a++; + else p++; + } + abundant = a; + deficient = d; + perfect = p; + } +} diff --git a/Task/Abundant,-deficient-and-perfect-number-classifications/Ela/abundant,-deficient-and-perfect-number-classifications.ela b/Task/Abundant,-deficient-and-perfect-number-classifications/Ela/abundant,-deficient-and-perfect-number-classifications.ela new file mode 100644 index 0000000000..1d44220c5b --- /dev/null +++ b/Task/Abundant,-deficient-and-perfect-number-classifications/Ela/abundant,-deficient-and-perfect-number-classifications.ela @@ -0,0 +1,11 @@ +open monad io number list + +divisors n = filter ((0 ==) << (n `mod`)) [1 .. (n `div` 2)] +classOf n = compare (sum $ divisors n) n + +do + let classes = map classOf [1 .. 20000] + let printRes w c = putStrLn $ w ++ (show << length $ filter (== c) classes) + printRes "deficient: " LT + printRes "perfect: " EQ + printRes "abundant: " GT diff --git a/Task/Abundant,-deficient-and-perfect-number-classifications/Elixir/abundant,-deficient-and-perfect-number-classifications.elixir b/Task/Abundant,-deficient-and-perfect-number-classifications/Elixir/abundant,-deficient-and-perfect-number-classifications.elixir new file mode 100644 index 0000000000..b8045fe469 --- /dev/null +++ b/Task/Abundant,-deficient-and-perfect-number-classifications/Elixir/abundant,-deficient-and-perfect-number-classifications.elixir @@ -0,0 +1,19 @@ +defmodule Proper do + def divisors(1), do: [] + def divisors(n), do: [1 | divisors(2,n,:math.sqrt(n))] |> Enum.sort + + defp divisors(k,_n,q) when k>q, do: [] + defp divisors(k,n,q) when rem(n,k)>0, do: divisors(k+1,n,q) + defp divisors(k,n,q) when k * k == n, do: [k | divisors(k+1,n,q)] + defp divisors(k,n,q) , do: [k,div(n,k) | divisors(k+1,n,q)] +end + +{abundant, deficient, perfect} = Enum.reduce(1..20000, {0,0,0}, fn n,{a, d, p} -> + sum = Proper.divisors(n) |> Enum.sum + cond do + n < sum -> {a+1, d, p} + n > sum -> {a, d+1, p} + true -> {a, d, p+1} + end +end) +IO.puts "Deficient: #{deficient} Perfect: #{perfect} Abundant: #{abundant}" diff --git a/Task/Abundant,-deficient-and-perfect-number-classifications/Groovy/abundant,-deficient-and-perfect-number-classifications.groovy b/Task/Abundant,-deficient-and-perfect-number-classifications/Groovy/abundant,-deficient-and-perfect-number-classifications.groovy new file mode 100644 index 0000000000..f82640076e --- /dev/null +++ b/Task/Abundant,-deficient-and-perfect-number-classifications/Groovy/abundant,-deficient-and-perfect-number-classifications.groovy @@ -0,0 +1,15 @@ +def dpaCalc = { factors -> + def n = factors.pop() + def fSum = factors.sum() + fSum < n + ? 'deficient' + : fSum > n + ? 'abundant' + : 'perfect' +} + +(1..20000).inject([deficient:0, perfect:0, abundant:0]) { map, n -> + map[dpaCalc(factorize(n))]++ + map +} +.each { e -> println e } diff --git a/Task/Abundant,-deficient-and-perfect-number-classifications/Java/abundant,-deficient-and-perfect-number-classifications.java b/Task/Abundant,-deficient-and-perfect-number-classifications/Java/abundant,-deficient-and-perfect-number-classifications.java new file mode 100644 index 0000000000..3bd3d9a65b --- /dev/null +++ b/Task/Abundant,-deficient-and-perfect-number-classifications/Java/abundant,-deficient-and-perfect-number-classifications.java @@ -0,0 +1,27 @@ +import static java.util.stream.LongStream.rangeClosed; + +public class NumberClassifications { + + public static void main(String[] args) { + int countDeficient = 0; + int countPerfect = 0; + int countAbundant = 0; + + for (long i = 1; i <= 20_000L; i++) { + long sum = properDivsSum(i); + if (sum < i) + countDeficient++; + else if (sum == i) + countPerfect++; + else + countAbundant++; + } + System.out.println("Deficient: " + countDeficient); + System.out.println("Perfect: " + countPerfect); + System.out.println("Abundant: " + countAbundant); + } + + public static Long properDivsSum(long n) { + return rangeClosed(1, (n + 1) / 2).filter(i -> n % i == 0 && n != i).sum(); + } +} diff --git a/Task/Abundant,-deficient-and-perfect-number-classifications/Liberty-BASIC/abundant,-deficient-and-perfect-number-classifications.liberty b/Task/Abundant,-deficient-and-perfect-number-classifications/Liberty-BASIC/abundant,-deficient-and-perfect-number-classifications.liberty new file mode 100644 index 0000000000..b97a003359 --- /dev/null +++ b/Task/Abundant,-deficient-and-perfect-number-classifications/Liberty-BASIC/abundant,-deficient-and-perfect-number-classifications.liberty @@ -0,0 +1,49 @@ +print "ROSETTA CODE - Abundant, deficient and perfect number classifications" +print +for x=1 to 20000 + x$=NumberClassification$(x) + select case x$ + case "deficient": de=de+1 + case "perfect": pe=pe+1: print x; " is a perfect number" + case "abundant": ab=ab+1 + end select + select case x + case 2000: print "Checking the number classifications of 20,000 integers..." + case 4000: print "Please be patient." + case 7000: print "7,000" + case 10000: print "10,000" + case 12000: print "12,000" + case 14000: print "14,000" + case 16000: print "16,000" + case 18000: print "18,000" + case 19000: print "Almost done..." + end select +next x +print "Deficient numbers = "; de +print "Perfect numbers = "; pe +print "Abundant numbers = "; ab +print "TOTAL = "; pe+de+ab +[Quit] +print "Program complete." +end + +function NumberClassification$(n) + x=ProperDivisorCount(n) + for y=1 to x + PDtotal=PDtotal+ProperDivisor(y) + next y + if PDtotal=n then NumberClassification$="perfect": exit function + if PDtotaln then NumberClassification$="abundant": exit function +end function + +function ProperDivisorCount(n) + n=abs(int(n)): if n=0 or n>20000 then exit function + dim ProperDivisor(100) + for y=2 to n + if (n mod y)=0 then + ProperDivisorCount=ProperDivisorCount+1 + ProperDivisor(ProperDivisorCount)=n/y + end if + next y +end function diff --git a/Task/Abundant,-deficient-and-perfect-number-classifications/Lua/abundant,-deficient-and-perfect-number-classifications.lua b/Task/Abundant,-deficient-and-perfect-number-classifications/Lua/abundant,-deficient-and-perfect-number-classifications.lua index f1d6f342d8..338cf74162 100644 --- a/Task/Abundant,-deficient-and-perfect-number-classifications/Lua/abundant,-deficient-and-perfect-number-classifications.lua +++ b/Task/Abundant,-deficient-and-perfect-number-classifications/Lua/abundant,-deficient-and-perfect-number-classifications.lua @@ -1,21 +1,21 @@ function sumDivs (n) - if n < 2 then return 0 end - local sum, sr = 1, math.sqrt(n) - for d = 2, sr do - if n % d == 0 then - sum = sum + d - if d ~= sr then sum = sum + n / d end - end - end - return sum + if n < 2 then return 0 end + local sum, sr = 1, math.sqrt(n) + for d = 2, sr do + if n % d == 0 then + sum = sum + d + if d ~= sr then sum = sum + n / d end + end + end + return sum end local a, d, p, Pn = 0, 0, 0 for n = 1, 20000 do - Pn = sumDivs(n) - if Pn > n then a = a + 1 end - if Pn < n then d = d + 1 end - if Pn == n then p = p + 1 end + Pn = sumDivs(n) + if Pn > n then a = a + 1 end + if Pn < n then d = d + 1 end + if Pn == n then p = p + 1 end end print("Abundant:", a) print("Deficient:", d) diff --git a/Task/Abundant,-deficient-and-perfect-number-classifications/Perl-6/abundant,-deficient-and-perfect-number-classifications.pl6 b/Task/Abundant,-deficient-and-perfect-number-classifications/Perl-6/abundant,-deficient-and-perfect-number-classifications.pl6 index dfd1f3a358..61ab336e21 100644 --- a/Task/Abundant,-deficient-and-perfect-number-classifications/Perl-6/abundant,-deficient-and-perfect-number-classifications.pl6 +++ b/Task/Abundant,-deficient-and-perfect-number-classifications/Perl-6/abundant,-deficient-and-perfect-number-classifications.pl6 @@ -1,8 +1,8 @@ sub propdivsum (\x) { - [+] (1 if x > 1), gather for 2 .. x.sqrt.floor -> \d { + [+] flat(x > 1, gather for 2 .. x.sqrt.floor -> \d { my \y = x div d; if y * d == x { take d; take y unless y == d } - } + }) } say bag map { propdivsum($_) <=> $_ }, 1..20000 diff --git a/Task/Abundant,-deficient-and-perfect-number-classifications/PowerShell/abundant,-deficient-and-perfect-number-classifications.psh b/Task/Abundant,-deficient-and-perfect-number-classifications/PowerShell/abundant,-deficient-and-perfect-number-classifications.psh index f53d6699e6..010bc23ece 100644 --- a/Task/Abundant,-deficient-and-perfect-number-classifications/PowerShell/abundant,-deficient-and-perfect-number-classifications.psh +++ b/Task/Abundant,-deficient-and-perfect-number-classifications/PowerShell/abundant,-deficient-and-perfect-number-classifications.psh @@ -1,27 +1,33 @@ -new-variable deficient -value 0 -new-variable perfect -value 0 -new-variable abundant -value 0 -new-variable sum +function Get-ProperDivisorSum ( [int]$N ) + { + If ( $N -lt 2 ) { return 0 } -for($i=1;$i -le 20000;$i++){ - $sum=0 - for($n=1;$n -le [System.Math]::Floor([System.Math]::Sqrt($i));$n++){ - if($i%$n -eq 0){ - $sum+=($i/$n) - if($i/$n -ne $n) {$sum+=$n} - } - } - $sum-=$i - if($sum -lt $i){ - $deficient++ - } - elseif($sum -eq $i){ - $perfect++ - } else { - $abundant++ - } -} + $Sum = 1 + If ( $N -gt 3 ) + { + $SqrtN = [math]::Sqrt( $N ) + ForEach ( $Divisor in 2..$SqrtN ) + { + If ( $N % $Divisor -eq 0 ) { $Sum += $Divisor + $N / $Divisor } + } + If ( $N % $SqrtN -eq 0 ) { $Sum -= $SqrtN } + } + return $Sum + } -Write-Host "Deficient = $deficient" -Write-Host "Perfect = $perfect" -Write-Host "Abundant = $abundant" + +$Deficient = $Perfect = $Abundant = 0 + +ForEach ( $N in 1..20000 ) + { + Switch ( [math]::Sign( ( Get-ProperDivisorSum $N ) - $N ) ) + { + -1 { $Deficient++ } + 0 { $Perfect++ } + 1 { $Abundant++ } + } + } + +"Deficient: $Deficient" +"Perfect : $Perfect" +"Abundant : $Abundant" diff --git a/Task/Abundant,-deficient-and-perfect-number-classifications/Prolog/abundant,-deficient-and-perfect-number-classifications.pro b/Task/Abundant,-deficient-and-perfect-number-classifications/Prolog/abundant,-deficient-and-perfect-number-classifications.pro new file mode 100644 index 0000000000..b0a87e05b3 --- /dev/null +++ b/Task/Abundant,-deficient-and-perfect-number-classifications/Prolog/abundant,-deficient-and-perfect-number-classifications.pro @@ -0,0 +1,42 @@ +proper_divisors(1, []) :- !. +proper_divisors(N, [1|L]) :- + FSQRTN is floor(sqrt(N)), + proper_divisors(2, FSQRTN, N, L). + +proper_divisors(M, FSQRTN, _, []) :- + M > FSQRTN, + !. +proper_divisors(M, FSQRTN, N, L) :- + N mod M =:= 0, !, + MO is N//M, % must be integer + L = [M,MO|L1], % both proper divisors + M1 is M+1, + proper_divisors(M1, FSQRTN, N, L1). +proper_divisors(M, FSQRTN, N, L) :- + M1 is M+1, + proper_divisors(M1, FSQRTN, N, L). + +dpa(1, [1], [], []) :- + !. +dpa(N, D, P, A) :- + N > 1, + proper_divisors(N, PN), + sum_list(PN, SPN), + compare(VGL, SPN, N), + dpa(VGL, N, D, P, A). + +dpa(<, N, [N|D], P, A) :- N1 is N-1, dpa(N1, D, P, A). +dpa(=, N, D, [N|P], A) :- N1 is N-1, dpa(N1, D, P, A). +dpa(>, N, D, P, [N|A]) :- N1 is N-1, dpa(N1, D, P, A). + + +dpa(N) :- + T0 is cputime, + dpa(N, D, P, A), + Dur is cputime-T0, + length(D, LD), + length(P, LP), + length(A, LA), + format("deficient: ~d~n abundant: ~d~n perfect: ~d~n", + [LD, LA, LP]), + format("took ~f seconds~n", [Dur]). diff --git a/Task/Abundant,-deficient-and-perfect-number-classifications/PureBasic/abundant,-deficient-and-perfect-number-classifications.purebasic b/Task/Abundant,-deficient-and-perfect-number-classifications/PureBasic/abundant,-deficient-and-perfect-number-classifications.purebasic new file mode 100644 index 0000000000..aefa87df08 --- /dev/null +++ b/Task/Abundant,-deficient-and-perfect-number-classifications/PureBasic/abundant,-deficient-and-perfect-number-classifications.purebasic @@ -0,0 +1,36 @@ +EnableExplicit + +Procedure.i SumProperDivisors(Number) + If Number < 2 : ProcedureReturn 0 : EndIf + Protected i, sum = 0 + For i = 1 To Number / 2 + If Number % i = 0 + sum + i + EndIf + Next + ProcedureReturn sum +EndProcedure + +Define n, sum, deficient, perfect, abundant + +If OpenConsole() + For n = 1 To 20000 + sum = SumProperDivisors(n) + If sum < n + deficient + 1 + ElseIf sum = n + perfect + 1 + Else + abundant + 1 + EndIf + Next + PrintN("The breakdown for the numbers 1 to 20,000 is as follows : ") + PrintN("") + PrintN("Deficient = " + deficient) + PrintN("Pefect = " + perfect) + PrintN("Abundant = " + abundant) + PrintN("") + PrintN("Press any key to close the console") + Repeat: Delay(10) : Until Inkey() <> "" + CloseConsole() +EndIf diff --git a/Task/Abundant,-deficient-and-perfect-number-classifications/REXX/abundant,-deficient-and-perfect-number-classifications-1.rexx b/Task/Abundant,-deficient-and-perfect-number-classifications/REXX/abundant,-deficient-and-perfect-number-classifications-1.rexx index e4c26a1d94..f9c7b40d90 100644 --- a/Task/Abundant,-deficient-and-perfect-number-classifications/REXX/abundant,-deficient-and-perfect-number-classifications-1.rexx +++ b/Task/Abundant,-deficient-and-perfect-number-classifications/REXX/abundant,-deficient-and-perfect-number-classifications-1.rexx @@ -1,24 +1,24 @@ -/*REXX pgm counts the number of abundant/deficient/perfect numbers in a range.*/ -parse arg low high . /*get optional args from C.L. */ -high=word(high low 20000,1); low=word(low 1,1) /*get the LOW and HIGH values.*/ -say center('integers from ' low " to " high, 45, "═") -!.=0 /*define all types of sums to zero. */ - do j=low to high; $=sigma(j) /*find the sigma for an integer range. */ - if $j then !.a=!.a+1 /* " " abundant " */ - else !.p=!.p+1 /* " " perfect " */ - end /*j*/ +/*REXX program counts the number of abundant/deficient/perfect numbers within a range.*/ +parse arg low high . /*obtain optional arguments from the CL*/ +high=word(high low 20000,1); low=word(low 1,1) /*obtain the LOW and HIGH values.*/ +say center('integers from ' low " to " high, 45, "═") /*display a header.*/ +!.=0 /*define all types of sums to zero. */ + do j=low to high; $=sigma(j) /*get sigma for an integer in a range. */ + if $j then !.a=!.a+1 /*Greater? " " abundant " */ + else !.p=!.p+1 /*Equal? " " perfect " */ + end /*j*/ /* [↑] IFs are coded as per likelihood*/ -say ' the number of perfect numbers: ' right(!.p, length(high)) -say ' the number of abundant numbers: ' right(!.a, length(high)) -say ' the number of deficient numbers: ' right(!.d, length(high)) -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -sigma: procedure; parse arg x; if x<2 then return 0; odd=x//2 /*odd? */ -s=1 /* [↓] only use EVEN or ODD integers.*/ - do j=2+odd by 1+odd while j*jj then !.a=!.a+1 /* " " abundant " */ - else !.p=!.p+1 /* " " perfect " */ - end /*j*/ +/*REXX program counts the number of abundant/deficient/perfect numbers within a range.*/ +parse arg low high . /*obtain optional arguments from the CL*/ +high=word(high low 20000,1); low=word(low 1,1) /*obtain the LOW and HIGH values.*/ +say center('integers from ' low " to " high, 45, "═") /*display a header.*/ +!.=0 /*define all types of sums to zero. */ + do j=low to high; $=sigma(j) /*get sigma for an integer in a range. */ + if $j then !.a=!.a+1 /*Greater? " " abundant " */ + else !.p=!.p+1 /*Equal? " " perfect " */ + end /*j*/ /* [↑] IFs are coded as per likelihood*/ -say ' the number of perfect numbers: ' right(!.p, length(high)) -say ' the number of abundant numbers: ' right(!.a, length(high)) -say ' the number of deficient numbers: ' right(!.d, length(high)) -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -iSqrt: procedure; parse arg x; q=1; r=0; do while q<=x; q=q*4; end - do while q>1; q=q%4; _=x-r-q; r=r%2; if _>=0 then do; x=_; r=r+q; end - end /*while ···*/ -return r -/*────────────────────────────────────────────────────────────────────────────*/ -sigma: procedure; parse arg x; if x<5 then return max(0,x-1); sqX=iSqrt(x) -s=1; odd=x//2 /* [↓] only use EVEN or ODD integers.*/ - do j=2+odd by 1+odd to sqX /*divide by all integers up to √ x */ - if x//j==0 then s=s+j+ x%j /*add the two divisors to (sigma) sum. */ - end /*j*/ /* [↑] % is the REXX integer division*/ - /* [↓] adjust for a square. ___*/ -if sqx*sqx==x then s=s-j /*Was X a square? If so, subtract √ x */ -return s /*return (sigma) sum of the divisors. */ +say ' the number of perfect numbers: ' right(!.p, length(high) ) +say ' the number of abundant numbers: ' right(!.a, length(high) ) +say ' the number of deficient numbers: ' right(!.d, length(high) ) +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sigma: procedure; parse arg x 1 z; if x<5 then return max(0,x-1); odd=x//2 /*is X odd?*/ + q=1; r=0; do while q<=z; q=q*4; end /* ◄── | compute the integer sqrt of Z*/ + do while q>1; q=q%4; _=z-r-q; r=r%2; if _>=0 then do; z=_; r=r+q; end + end /*while*/ /*upon completion, R is the sqrt of Z*/ + s=1 /* [↓] only use EVEN | ODD ints. ___*/ + do j=2+odd by 1+odd to r /*divide by all integers up to √ x */ + if x//j==0 then s=s+j+ x%j /*add the two divisors to (sigma) sum. */ + end /*j*/ /* [↑] % is the REXX integer division*/ + /* [↓] adjust for a square. ___*/ + if r*r==x then s=s-j /*Was X a square? If so, subtract √ x */ + return s /*return (sigma) sum of the divisors. */ diff --git a/Task/Abundant,-deficient-and-perfect-number-classifications/ZX-Spectrum-Basic/abundant,-deficient-and-perfect-number-classifications-1.zx b/Task/Abundant,-deficient-and-perfect-number-classifications/ZX-Spectrum-Basic/abundant,-deficient-and-perfect-number-classifications-1.zx new file mode 100644 index 0000000000..2a71951c20 --- /dev/null +++ b/Task/Abundant,-deficient-and-perfect-number-classifications/ZX-Spectrum-Basic/abundant,-deficient-and-perfect-number-classifications-1.zx @@ -0,0 +1,15 @@ + 10 LET nd=1: LET np=0: LET na=0 + 20 FOR i=2 TO 20000 + 30 LET sum=1 + 40 LET max=i/2 + 50 LET n=2: LET l=max-1 + 60 IF n>l THEN GO TO 90 + 70 IF i/n=INT (i/n) THEN LET sum=sum+n: LET max=i/n: IF max<>n THEN LET sum=sum+max: LET l=max-1 + 80 LET n=n+1: GO TO 60 + 90 IF sumj THEN LET sum=sum+j/i + 170 NEXT i + 180 LET sump=sum + 190 RETURN diff --git a/Task/Accumulator-factory/00DESCRIPTION b/Task/Accumulator-factory/00DESCRIPTION index 109491ef80..325e7a8880 100644 --- a/Task/Accumulator-factory/00DESCRIPTION +++ b/Task/Accumulator-factory/00DESCRIPTION @@ -1,5 +1,9 @@ +{{Omit from|MUMPS|Creating a function implies that there is routine somewhere that has the function stored, and that function could be modified}} + A problem posed by [[wp:Paul Graham|Paul Graham]] is that of creating a function that takes a single (numeric) argument and which returns another function that is an accumulator. The returned accumulator function in turn also takes a single numeric argument, and returns the sum of all the numeric values passed in so far to that accumulator (including the initial value passed when the accumulator was created). + +;Rules: The detailed rules are at http://paulgraham.com/accgensub.html and are reproduced here for simplicity (with additions in ''small italic text''). :Before you submit an example, make sure the function @@ -14,7 +18,13 @@ x(5); foo(3); print x(2.3);
: It should print 8.3. ''(There is no need to print the form of the accumulator function returned by foo(3); it's not part of the task at all.)'' -The purpose of this task is to create a function that implements the described rules. It need not handle any special error cases not described above. The simplest way to implement the task as described is typically to use a [[Closures|closure]], providing the language supports them. + + +;Task: +Create a function that implements the described rules. + + +It need not handle any special error cases not described above. The simplest way to implement the task as described is typically to use a [[Closures|closure]], providing the language supports them. Where it is not possible to hold exactly to the constraints above, describe the deviations. -{{Omit from|MUMPS|Creating a function implies that there is routine somewhere that has the function stored, and that function could be modified}} +

diff --git a/Task/Accumulator-factory/AppleScript/accumulator-factory.applescript b/Task/Accumulator-factory/AppleScript/accumulator-factory-1.applescript similarity index 100% rename from Task/Accumulator-factory/AppleScript/accumulator-factory.applescript rename to Task/Accumulator-factory/AppleScript/accumulator-factory-1.applescript diff --git a/Task/Accumulator-factory/AppleScript/accumulator-factory-2.applescript b/Task/Accumulator-factory/AppleScript/accumulator-factory-2.applescript new file mode 100644 index 0000000000..40c157d51d --- /dev/null +++ b/Task/Accumulator-factory/AppleScript/accumulator-factory-2.applescript @@ -0,0 +1,20 @@ +on run + + set x to foo(1) + + x's lambda(5) + + foo(3) + + x's lambda(2.3) + +end run + +-- foo :: Int -> Script +on foo(sum) + script + on lambda(n) + set sum to sum + n + end lambda + end script +end foo diff --git a/Task/Accumulator-factory/Elena/accumulator-factory.elena b/Task/Accumulator-factory/Elena/accumulator-factory.elena index b843af4afd..43975bcceb 100644 --- a/Task/Accumulator-factory/Elena/accumulator-factory.elena +++ b/Task/Accumulator-factory/Elena/accumulator-factory.elena @@ -1,19 +1,22 @@ -#define system. -#define system'dynamic. +#import system. +#import system'dynamic. #symbol Function = - (:x) [ self append:x ]. + (:x) [ this append:x ]. -#symbol Accumulator = (:anInitialValue) - [ Extension(Function, Variable new:anInitialValue) ]. +#class(extension)op +{ + #method accumulator &of:func + = Variable new:self mix &into:func. +} -#symbol Program = +#symbol program = [ - #var x := Accumulator:1. + #var x := 1 accumulator &of:Function. - x:5. + x eval:5. - #var y := Accumulator:3. + #var y := 3 accumulator &of:Function. - console write:(x:2.3r). + console write:(x eval:2.3r). ]. diff --git a/Task/Accumulator-factory/Elixir/accumulator-factory-1.elixir b/Task/Accumulator-factory/Elixir/accumulator-factory-1.elixir new file mode 100644 index 0000000000..eda708be5a --- /dev/null +++ b/Task/Accumulator-factory/Elixir/accumulator-factory-1.elixir @@ -0,0 +1,8 @@ +defmodule AccumulatorFactory do + def new(initial) do + {:ok, pid} = Agent.start_link(fn() -> initial end) + fn (a) -> + Agent.get_and_update(pid, fn(old) -> {a + old, a + old} end) + end + end +end diff --git a/Task/Accumulator-factory/Elixir/accumulator-factory-2.elixir b/Task/Accumulator-factory/Elixir/accumulator-factory-2.elixir new file mode 100644 index 0000000000..5c0d7c2c0b --- /dev/null +++ b/Task/Accumulator-factory/Elixir/accumulator-factory-2.elixir @@ -0,0 +1,11 @@ +defmodule AccumulatorFactoryTest do + use ExUnit.Case + + test "Accumulator basic function" do + foo = AccumulatorFactory.new(1) + foo.(5) + bar = AccumulatorFactory.new(3) + assert bar.(4) == 7 + assert foo.(2.3) == 8.3 + end +end diff --git a/Task/Accumulator-factory/Haskell/accumulator-factory.hs b/Task/Accumulator-factory/Haskell/accumulator-factory-1.hs similarity index 100% rename from Task/Accumulator-factory/Haskell/accumulator-factory.hs rename to Task/Accumulator-factory/Haskell/accumulator-factory-1.hs diff --git a/Task/Accumulator-factory/Haskell/accumulator-factory-2.hs b/Task/Accumulator-factory/Haskell/accumulator-factory-2.hs new file mode 100644 index 0000000000..eff5451665 --- /dev/null +++ b/Task/Accumulator-factory/Haskell/accumulator-factory-2.hs @@ -0,0 +1,2 @@ +accumulator = newSTRef >=> return . factory + where factory s n = modifySTRef s (+ n) >> readSTRef s diff --git a/Task/Accumulator-factory/Io/accumulator-factory.io b/Task/Accumulator-factory/Io/accumulator-factory.io new file mode 100644 index 0000000000..62a9da602e --- /dev/null +++ b/Task/Accumulator-factory/Io/accumulator-factory.io @@ -0,0 +1,7 @@ +accumulator := method(sum, + block(x, sum = sum + x) setIsActivatable(true) +) +x := accumulator(1) +x(5) +accumulator(3) +x(2.3) println // --> 8.3000000000000007 diff --git a/Task/Accumulator-factory/PowerShell/accumulator-factory-1.psh b/Task/Accumulator-factory/PowerShell/accumulator-factory-1.psh new file mode 100644 index 0000000000..9d6b0bc910 --- /dev/null +++ b/Task/Accumulator-factory/PowerShell/accumulator-factory-1.psh @@ -0,0 +1,4 @@ +function Get-Accumulator ([double]$Start) +{ + {param([double]$Plus) return $script:Start += $Plus}.GetNewClosure() +} diff --git a/Task/Accumulator-factory/PowerShell/accumulator-factory-2.psh b/Task/Accumulator-factory/PowerShell/accumulator-factory-2.psh new file mode 100644 index 0000000000..35ce2c8ca6 --- /dev/null +++ b/Task/Accumulator-factory/PowerShell/accumulator-factory-2.psh @@ -0,0 +1,3 @@ +$total = Get-Accumulator -Start 1 +& $total -Plus 5.0 | Out-Null +& $total -Plus 2.3 diff --git a/Task/Accumulator-factory/REXX/accumulator-factory.rexx b/Task/Accumulator-factory/REXX/accumulator-factory.rexx index 4256c1ca7a..adccf861cc 100644 --- a/Task/Accumulator-factory/REXX/accumulator-factory.rexx +++ b/Task/Accumulator-factory/REXX/accumulator-factory.rexx @@ -1,13 +1,13 @@ -/*REXX pgm: acculation factory copied/modeled after the ooRexx program. */ -x=.accumulator(new(1)) /*set accumulater with init val 1*/ +/*REXX program shows one method an accumulator factory could be implemented. */ +x=.accumulator(1) /*initialize accumulator with a 1 value*/ x=call(5) x=call(2.3) -say " X value is now" x /*displays current value of X. */ -say "Accumulator value is now" sum /*displays current value of accum*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────subroutines─────────────────────────*/ -.accumulator: procedure expose sum - if symbol('SUM')=='LIT' then sum=0; sum=sum+arg(1) +say ' X value is now' x /*displays the current value of X. */ +say 'Accumulator value is now' sum /*displays the current value of accum.*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +.accumulator: procedure expose sum; if symbol('SUM')=="LIT" then sum=0 /*1st time?*/ + sum=sum + arg(1) /*add──►sum*/ return sum -call: procedure expose sum; sum=sum+arg(1); return sum /*adds arg1──►sum*/ -new: procedure; return arg(1) /*long way 'round of using one. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +call: procedure expose sum; sum=sum+arg(1); return sum /*add arg1 ──► sum.*/ diff --git a/Task/Accumulator-factory/TXR/accumulator-factory-1.txr b/Task/Accumulator-factory/TXR/accumulator-factory-1.txr index f0d126467c..661e6eb35c 100644 --- a/Task/Accumulator-factory/TXR/accumulator-factory-1.txr +++ b/Task/Accumulator-factory/TXR/accumulator-factory-1.txr @@ -4,6 +4,6 @@ ;; test (for ((f (accumulate 0)) num) - ((set num (read : : nil))) + ((set num (iread : : nil))) ((format t "~s -> ~s\n" num [f num]))) (exit 0) diff --git a/Task/Accumulator-factory/TXR/accumulator-factory-2.txr b/Task/Accumulator-factory/TXR/accumulator-factory-2.txr index c4a9dd7dec..3e8bc7595e 100644 --- a/Task/Accumulator-factory/TXR/accumulator-factory-2.txr +++ b/Task/Accumulator-factory/TXR/accumulator-factory-2.txr @@ -1,2 +1,2 @@ (let ((f (let ((sum 0)) (do inc sum @1)))) - (mapdo (do put-line `@1 -> @[f @1]`) (gun (read : : nil)))) + (mapdo (do put-line `@1 -> @[f @1]`) (gun (iread : : nil)))) diff --git a/Task/Accumulator-factory/TXR/accumulator-factory-3.txr b/Task/Accumulator-factory/TXR/accumulator-factory-3.txr index 42a895e00d..6caa1456df 100644 --- a/Task/Accumulator-factory/TXR/accumulator-factory-3.txr +++ b/Task/Accumulator-factory/TXR/accumulator-factory-3.txr @@ -4,4 +4,4 @@ ((inc sum (yield-from accum sum))))) (let ((f (obtain (accum)))) - (mapdo (do put-line `@1 -> @[f @1]`) (gun (read : : nil)))) + (mapdo (do put-line `@1 -> @[f @1]`) (gun (iread : : nil)))) diff --git a/Task/Accumulator-factory/TXR/accumulator-factory-4.txr b/Task/Accumulator-factory/TXR/accumulator-factory-4.txr new file mode 100644 index 0000000000..a40ce0f52b --- /dev/null +++ b/Task/Accumulator-factory/TXR/accumulator-factory-4.txr @@ -0,0 +1,10 @@ +(defstruct (accum count) nil + (count 0)) + +(defmeth accum lambda (self delta) + (inc self.count delta)) + +;; Identical test code to Yield-Based and Sugared, except for +;; the construction of the function object bound to variable f. +(let ((f (new (accum 0)))) + (mapdo (do put-line `@1 -> @[f @1]`) (gun (iread : : nil)))) diff --git a/Task/Ackermann-function/00DESCRIPTION b/Task/Ackermann-function/00DESCRIPTION index 5a999940ce..cbf33306bc 100644 --- a/Task/Ackermann-function/00DESCRIPTION +++ b/Task/Ackermann-function/00DESCRIPTION @@ -1,7 +1,9 @@ -The '''[[wp:Ackermann function|Ackermann function]]''' is a classic example of a recursive function, notable especially because it is not a [[wp:Primitive_recursive_function|primitive recursive function]]. It grows very quickly in value, as does the size of its call tree. +The '''[[wp:Ackermann function|Ackermann function]]''' is a classic example of a recursive function, notable especially because it is not a [[wp:Primitive_recursive_function|primitive recursive function]]. It grows very quickly in value, as does the size of its call tree. + The Ackermann function is usually defined as follows: + : A(m, n) = \begin{cases} n+1 & \mbox{if } m = 0 \\ @@ -9,9 +11,13 @@ The Ackermann function is usually defined as follows: A(m-1, A(m, n-1)) & \mbox{if } m > 0 \mbox{ and } n > 0. \end{cases} + + Its arguments are never negative and it always terminates. Write a function which returns the value of A(m, n). Arbitrary precision is preferred (since the function grows so quickly), but not required. + ;See also: * [[wp:Conway_chained_arrow_notation#Ackermann_function|Conway chained arrow notation]] for the Ackermann function. +

diff --git a/Task/Ackermann-function/AppleScript/ackermann-function.applescript b/Task/Ackermann-function/AppleScript/ackermann-function.applescript index 21cc254552..40e28fb6ab 100644 --- a/Task/Ackermann-function/AppleScript/ackermann-function.applescript +++ b/Task/Ackermann-function/AppleScript/ackermann-function.applescript @@ -1,5 +1,5 @@ on ackermann(m, n) - if m is equal to 0 then return n + 1 - if n is equal to 0 then return ackermann(m - 1, 1) - return ackermann(m - 1, ackermann(m, n - 1)) + if m is equal to 0 then return n + 1 + if n is equal to 0 then return ackermann(m - 1, 1) + return ackermann(m - 1, ackermann(m, n - 1)) end ackermann diff --git a/Task/Ackermann-function/Coq/ackermann-function.coq b/Task/Ackermann-function/Coq/ackermann-function-1.coq similarity index 100% rename from Task/Ackermann-function/Coq/ackermann-function.coq rename to Task/Ackermann-function/Coq/ackermann-function-1.coq diff --git a/Task/Ackermann-function/Coq/ackermann-function-2.coq b/Task/Ackermann-function/Coq/ackermann-function-2.coq new file mode 100644 index 0000000000..dbba33f6a2 --- /dev/null +++ b/Task/Ackermann-function/Coq/ackermann-function-2.coq @@ -0,0 +1,13 @@ +Require Import Utf8. + +Section FOLD. + Context {A: Type} (f: A → A) (a: A). + Fixpoint fold (n: nat) : A := + match n with + | O => a + | S n' => f (fold n') + end. +End FOLD. + +Definition ackermann : nat → nat → nat := + fold (λ g, fold g (g (S O))) S. diff --git a/Task/Ackermann-function/Elena/ackermann-function.elena b/Task/Ackermann-function/Elena/ackermann-function.elena index 6ceae5c6ee..7c06aeb159 100644 --- a/Task/Ackermann-function/Elena/ackermann-function.elena +++ b/Task/Ackermann-function/Elena/ackermann-function.elena @@ -8,8 +8,8 @@ m => 0 ? [ n + 1 ] > 0 ? [ - n => 0 ? [ ackermann:(m - 1):1 ] - > 0 ? [ ackermann:(m - 1):(ackermann:m:(n-1)) ] + n => 0 ? [ ackermann eval:(m - 1):1 ] + > 0 ? [ ackermann eval:(m - 1):(ackermann eval:m:(n-1)) ] ] ]. @@ -19,7 +19,7 @@ [ 0 to:5 &doEach: (:j) [ - console writeLine:"A(":i:",":j:")=":(ackermann:i:j). + console writeLine:"A(":i:",":j:")=":(ackermann eval:i:j). ]. ]. diff --git a/Task/Ackermann-function/Go/ackermann-function-1.go b/Task/Ackermann-function/Go/ackermann-function-1.go index ea2c7a2614..486ad4b8bb 100644 --- a/Task/Ackermann-function/Go/ackermann-function-1.go +++ b/Task/Ackermann-function/Go/ackermann-function-1.go @@ -1,9 +1,9 @@ func Ackermann(m, n uint) uint { - switch { - case m == 0: - return n + 1 - case n == 0: - return Ackermann(m - 1, 1) - } - return Ackermann(m - 1, Ackermann(m, n - 1)) + switch 0 { + case m: + return n + 1 + case n: + return Ackermann(m - 1, 1) + } + return Ackermann(m - 1, Ackermann(m, n - 1)) } diff --git a/Task/Ackermann-function/Haskell/ackermann-function-2.hs b/Task/Ackermann-function/Haskell/ackermann-function-2.hs index 25b4cbf489..7997efa8f8 100644 --- a/Task/Ackermann-function/Haskell/ackermann-function-2.hs +++ b/Task/Ackermann-function/Haskell/ackermann-function-2.hs @@ -1,9 +1,10 @@ +import Data.List (mapAccumL) + -- everything here are [Int] or [[Int]], which would overflow -- * had it not overrun the stack first * ackermann = iterate ack [1..] where ack a = s where - s = a!!1 : f (tail a) (zipWith (-) s (1:s)) - f a (b:bs) = (head aa) : f aa bs where - aa = drop b a + s = snd $ mapAccumL f (tail a) (1 : zipWith (-) s (1:s)) + f a b = (aa, head aa) where aa = drop b a main = mapM_ print $ map (\n -> take (6 - n) $ ackermann !! n) [0..5] diff --git a/Task/Ackermann-function/Kotlin/ackermann-function.kotlin b/Task/Ackermann-function/Kotlin/ackermann-function.kotlin index 02dc8f33d6..77317662c4 100644 --- a/Task/Ackermann-function/Kotlin/ackermann-function.kotlin +++ b/Task/Ackermann-function/Kotlin/ackermann-function.kotlin @@ -15,17 +15,17 @@ fun main(args: Array) { val N: Long = 20 val r = 0..N for (m in 0..M) { - print("\nA(%d, %s) =".format(m, r)) + print("\nA($m, $r) =") var able = true - r forEach { + r.forEach { try { if (able) { val a = A(m, it) print(" %6d".format(a)) } else - print(" %6s".format("?")) + print(" ?") } catch(e: Throwable) { - print(" %6s".format("?")) + print(" ?") able = false } } diff --git a/Task/Ackermann-function/PowerShell/ackermann-function-3.psh b/Task/Ackermann-function/PowerShell/ackermann-function-3.psh new file mode 100644 index 0000000000..cb92013c7d --- /dev/null +++ b/Task/Ackermann-function/PowerShell/ackermann-function-3.psh @@ -0,0 +1,14 @@ +function Get-Ackermann ([int64]$m, [int64]$n) +{ + if ($m -eq 0) + { + return $n + 1 + } + + if ($n -eq 0) + { + return Get-Ackermann ($m - 1) 1 + } + + return (Get-Ackermann ($m - 1) (Get-Ackermann $m ($n - 1))) +} diff --git a/Task/Ackermann-function/PowerShell/ackermann-function-4.psh b/Task/Ackermann-function/PowerShell/ackermann-function-4.psh new file mode 100644 index 0000000000..c43df1d52a --- /dev/null +++ b/Task/Ackermann-function/PowerShell/ackermann-function-4.psh @@ -0,0 +1,3 @@ +$ackermann = 0..3 | ForEach-Object {$m = $_; 0..6 | ForEach-Object {Get-Ackermann $m $_}} + +$ackermann | Format-Wide {"{0,3}" -f $_} -Column 7 -Force diff --git a/Task/Ackermann-function/REXX/ackermann-function-1.rexx b/Task/Ackermann-function/REXX/ackermann-function-1.rexx index 84ebc21c4f..4166968a81 100644 --- a/Task/Ackermann-function/REXX/ackermann-function-1.rexx +++ b/Task/Ackermann-function/REXX/ackermann-function-1.rexx @@ -1,25 +1,25 @@ -/*REXX program calculates and displays some values for the Ackermann function.*/ -/* ╔════════════════════════════════════════════════════════════════════════╗ - ║ Note: the Ackermann function (as implemented here) utilizes deep ║ - ║ recursive and is limited by the largest number that can have ║ - ║ "1" (unity) added to a number (successfully and accurately). ║ - ╚════════════════════════════════════════════════════════════════════════╝ */ +/*REXX program calculates and displays some values for the Ackermann function. */ + /*╔════════════════════════════════════════════════════════════════════════╗ + ║ Note: the Ackermann function (as implemented here) utilizes deep ║ + ║ recursive and is limited by the largest number that can have ║ + ║ "1" (unity) added to a number (successfully and accurately). ║ + ╚════════════════════════════════════════════════════════════════════════╝*/ high=24 - do j=0 to 3; say - do k=0 to high%(max(1,j)) - call Ackermann_tell j,k + do j=0 to 3; say + do k=0 to high % (max(1, j)) + call tell_Ack j, k end /*k*/ end /*j*/ -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────ACKERMANN_TELL subroutine─────────────────*/ -ackermann_tell: parse arg mm,nn; calls=0 /*display an echo message. */ -#=right(nn,length(high)) -say 'Ackermann('mm","#')='right(ackermann(mm,nn),high), - left('',12) 'calls='right(calls,high) -return -/*──────────────────────────────────ACKERMANN subroutine──────────────────────*/ -ackermann: procedure expose calls /*compute value of Ackermann function.*/ -parse arg m,n; calls=calls+1 -if m==0 then return n+1 -if n==0 then return ackermann(m-1,1) - return ackermann(m-1,ackermann(m,n-1)) +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +tell_Ack: parse arg mm,nn; calls=0 /*display an echo message to terminal. */ + #=right(nn,length(high)) + say 'Ackermann('mm", "#')='right(ackermann(mm, nn), high), + left('', 12) 'calls='right(calls, high) + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +ackermann: procedure expose calls /*compute value of Ackermann function. */ + parse arg m,n; calls=calls+1 + if m==0 then return n+1 + if n==0 then return ackermann(m-1, 1) + return ackermann(m-1, ackermann(m, n-1) ) diff --git a/Task/Ackermann-function/REXX/ackermann-function-2.rexx b/Task/Ackermann-function/REXX/ackermann-function-2.rexx index 0ff1d7ddc5..d489d6c82a 100644 --- a/Task/Ackermann-function/REXX/ackermann-function-2.rexx +++ b/Task/Ackermann-function/REXX/ackermann-function-2.rexx @@ -1,21 +1,21 @@ -/*REXX program calculates and displays some values for the Ackermann function.*/ +/*REXX program calculates and displays some values for the Ackermann function. */ high=24 - do j=0 to 3; say - do k=0 to high%(max(1,j)) - call Ackermann_tell j,k + do j=0 to 3; say + do k=0 to high % (max(1, j)) + call tell_Ack j, k end /*k*/ end /*j*/ -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────ACKERMANN_TELL subroutine─────────────────*/ -ackermann_tell: parse arg mm,nn; calls=0 /*display an echo message.*/ -#=right(nn,length(high)) -say 'Ackermann('mm","#')='right(ackermann(mm,nn),high), - left('',12) 'calls='right(calls,high) -return -/*──────────────────────────────────ACKERMANN subroutine──────────────────────*/ -ackermann: procedure expose calls /*compute value of Ackermann function.*/ -parse arg m,n; calls=calls+1 -if m==0 then return n+1 -if n==0 then return ackermann(m-1,1) -if m==2 then return n*2+3 - return ackermann(m-1,ackermann(m,n-1)) +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +tell_Ack: parse arg mm,nn; calls=0 /*display an echo message to terminal. */ + #=right(nn,length(high)) + say 'Ackermann('mm", "#')='right(ackermann(mm, nn), high), + left('', 12) 'calls='right(calls, high) + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +ackermann: procedure expose calls /*compute value of Ackermann function. */ + parse arg m,n; calls=calls+1 + if m==0 then return n + 1 + if n==0 then return ackermann(m-1, 1) + if m==2 then return n + 3 + n + return ackermann(m-1, ackermann(m, n-1) ) diff --git a/Task/Ackermann-function/REXX/ackermann-function-3.rexx b/Task/Ackermann-function/REXX/ackermann-function-3.rexx index 10d1b991c7..46a20892d0 100644 --- a/Task/Ackermann-function/REXX/ackermann-function-3.rexx +++ b/Task/Ackermann-function/REXX/ackermann-function-3.rexx @@ -1,36 +1,36 @@ -/*REXX program calculates and displays some values for the Ackermann function.*/ +/*REXX program calculates and displays some values for the Ackermann function. */ +numeric digits 100 /*use up to 100 decimal digit integers.*/ + /*╔═════════════════════════════════════════════════════════════╗ + ║ When REXX raises a number to an integer power (via the ** ║ + ║ operator, the power can be positive, zero, or negative). ║ + ║ Ackermann(5,1) is a bit impractical to calculate. ║ + ╚═════════════════════════════════════════════════════════════╝*/ high=24 -numeric digits 100 /*have REXX to use up to 100 digit integers.*/ - - /*When REXX raises a number to a power (via */ - /* the ** operator), the power must be an */ - /* integer (positive, zero, or negative). */ - - do j=0 to 4; say /*Ackermann(5,1) is a bit impractical to calc.*/ - do k=0 to high%(max(1,j)) - call Ackermann_tell j,k - if j==4 & k==2 then leave /*there's no sense in going overboard. */ - end /*k*/ - end /*j*/ -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────ACKERMANN_TELL subroutine─────────────────*/ -ackermann_tell: parse arg mm,nn; calls=0 /*display an echo message.*/ -#=right(nn,length(high)) -say 'Ackermann('mm","#')='right(ackermann(mm,nn),high), - left('',12) 'calls='right(calls,high) -return -/*──────────────────────────────────ACKERMANN subroutine──────────────────────*/ -ackermann: procedure expose calls /*compute value of Ackermann function.*/ -parse arg m,n; calls=calls+1 -if m==0 then return n+1 -if m==1 then return n+2 -if m==2 then return n+n+3 -if m==3 then return 2**(n+3)-3 -if m==4 then do; a=2 /* [↓] Ugh! ··· and more ughs. */ - do (n+3)-1 /*This is where the heavy lifting is. */ - a=2**a - end - return a-3 - end -if n==0 then return ackermann(m-1,1) - return ackermann(m-1,ackermann(m,n-1)) + do j=0 to 4; say + do k=0 to high % (max(1, j)) + call tell_Ack j, k + if j==4 & k==2 then leave /*there's no sense in going overboard. */ + end /*k*/ + end /*j*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +tell_Ack: parse arg mm,nn; calls=0 /*display an echo message to terminal. */ + #=right(nn,length(high)) + say 'Ackermann('mm", "#')='right(ackermann(mm, nn), high), + left('', 12) 'calls='right(calls, high) + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +ackermann: procedure expose calls /*compute value of Ackermann function. */ + parse arg m,n; calls=calls+1 + if m==0 then return n + 1 + if m==1 then return n + 2 + if m==2 then return n + 3 + n + if m==3 then return 2**(n+3) - 3 + if m==4 then do; #=2 /* [↓] Ugh! ··· and still more ughs.*/ + do (n+3)-1 /*This is where the heavy lifting is. */ + #=2**# + end + return #-3 + end + if n==0 then return ackermann(m-1, 1) + return ackermann(m-1, ackermann(m, n-1) ) diff --git a/Task/Ackermann-function/Run-BASIC/ackermann-function.run b/Task/Ackermann-function/Run-BASIC/ackermann-function.run index 7d958974f8..f7f68df222 100644 --- a/Task/Ackermann-function/Run-BASIC/ackermann-function.run +++ b/Task/Ackermann-function/Run-BASIC/ackermann-function.run @@ -1,9 +1,7 @@ print ackermann(1, 2) function ackermann(m, n) - if (m < 0) or (n < 0) then goto [exitFunction] if (m = 0) then ackermann = (n + 1) if (m > 0) and (n = 0) then ackermann = ackermann((m - 1), 1) if (m > 0) and (n > 0) then ackermann = ackermann((m - 1), ackermann(m, (n - 1))) -[exitFunction] end function diff --git a/Task/Ackermann-function/ZX-Spectrum-Basic/ackermann-function.zx b/Task/Ackermann-function/ZX-Spectrum-Basic/ackermann-function.zx new file mode 100644 index 0000000000..0c635f5323 --- /dev/null +++ b/Task/Ackermann-function/ZX-Spectrum-Basic/ackermann-function.zx @@ -0,0 +1,19 @@ +10 DIM s(2000,3) +20 LET s(1,1)=3: REM M +30 LET s(1,2)=7: REM N +40 LET lev=1 +50 GO SUB 100 +60 PRINT "A(";s(1,1);",";s(1,2);") = ";s(1,3) +70 STOP +100 IF s(lev,1)=0 THEN LET s(lev,3)=s(lev,2)+1: RETURN +110 IF s(lev,2)=0 THEN LET lev=lev+1: LET s(lev,1)=s(lev-1,1)-1: LET s(lev,2)=1: GO SUB 100: LET s(lev-1,3)=s(lev,3): LET lev=lev-1: RETURN +120 LET lev=lev+1 +130 LET s(lev,1)=s(lev-1,1) +140 LET s(lev,2)=s(lev-1,2)-1 +150 GO SUB 100 +160 LET s(lev,1)=s(lev-1,1)-1 +170 LET s(lev,2)=s(lev,3) +180 GO SUB 100 +190 LET s(lev-1,3)=s(lev,3) +200 LET lev=lev-1 +210 RETURN diff --git a/Task/Active-Directory-Search-for-a-user/Eiffel/active-directory-search-for-a-user-1.e b/Task/Active-Directory-Search-for-a-user/Eiffel/active-directory-search-for-a-user-1.e new file mode 100644 index 0000000000..a83aa4dbb5 --- /dev/null +++ b/Task/Active-Directory-Search-for-a-user/Eiffel/active-directory-search-for-a-user-1.e @@ -0,0 +1,12 @@ +feature -- Validation + + is_user_credential_valid (a_domain, a_username, a_password: READABLE_STRING_GENERAL): BOOLEAN + -- Is the pair `a_username'/`a_password' a valid credential in `a_domain'? + local + l_domain, l_username, l_password: WEL_STRING + do + create l_domain.make (a_domain) + create l_username.make (a_username) + create l_password.make (a_password) + Result := cwel_is_credential_valid (l_domain.item, l_username.item, l_password.item) + end diff --git a/Task/Active-Directory-Search-for-a-user/Eiffel/active-directory-search-for-a-user-2.e b/Task/Active-Directory-Search-for-a-user/Eiffel/active-directory-search-for-a-user-2.e new file mode 100644 index 0000000000..43fa6dc36e --- /dev/null +++ b/Task/Active-Directory-Search-for-a-user/Eiffel/active-directory-search-for-a-user-2.e @@ -0,0 +1,6 @@ + cwel_is_credential_valid (a_domain, a_username, a_password: POINTER): BOOLEAN + external + "C inline use %"wel_user_validation.h%"" + alias + "return cwel_is_credential_valid ((LPTSTR) $a_domain, (LPTSTR) $a_username, (LPTSTR) $a_password);" + end diff --git a/Task/Active-object/SuperCollider/active-object.supercollider b/Task/Active-object/SuperCollider/active-object.supercollider new file mode 100644 index 0000000000..6de4ba0a4f --- /dev/null +++ b/Task/Active-object/SuperCollider/active-object.supercollider @@ -0,0 +1,31 @@ +( +a = TaskProxy { |envir| + envir.use { + ~integral = 0; + ~time = 0; + ~prev = 0; + ~running = true; + loop { + ~val = ~input.(~time); + ~integral = ~integral + (~val + ~prev * ~dt / 2); + ~prev = ~val; + ~time = ~time + ~dt; + ~dt.wait; + } + } +}; +) + +// run the test +( +fork { + a.set(\dt, 0.0001); + a.set(\input, { |t| sin(2pi * 0.5 * t) }); + a.play(quant: 0); // play immediately + 2.wait; + a.set(\input, 0); + 0.5.wait; + a.stop; + a.get(\integral).postln; // answers -7.0263424372343e-15 +} +) diff --git a/Task/Add-a-variable-to-a-class-instance-at-runtime/Forth/add-a-variable-to-a-class-instance-at-runtime.fth b/Task/Add-a-variable-to-a-class-instance-at-runtime/Forth/add-a-variable-to-a-class-instance-at-runtime.fth index c4694a3439..6804a35c5a 100644 --- a/Task/Add-a-variable-to-a-class-instance-at-runtime/Forth/add-a-variable-to-a-class-instance-at-runtime.fth +++ b/Task/Add-a-variable-to-a-class-instance-at-runtime/Forth/add-a-variable-to-a-class-instance-at-runtime.fth @@ -2,9 +2,9 @@ include FMS-SI.f include FMS-SILib.f -\ FMS doesn't have the ability to add instance variables -\ or methods at run time. But it is very simple to add any number of -\ objects of any type to a single object at run time. The added + +\ We can add any number of variables at runtime by adding +\ objects of any type to an instance at run time. The added \ objects are then accessible via an index number. :class foo diff --git a/Task/Address-of-a-variable/00DESCRIPTION b/Task/Address-of-a-variable/00DESCRIPTION index a6bdb20480..15dcd8d07a 100644 --- a/Task/Address-of-a-variable/00DESCRIPTION +++ b/Task/Address-of-a-variable/00DESCRIPTION @@ -1,4 +1,5 @@ {{basic data operation}} -Demonstrate how to get the address of a variable -and how to set the address of a variable. +;Task: +Demonstrate how to get the address of a variable and how to set the address of a variable. +

diff --git a/Task/Address-of-a-variable/360-Assembly/address-of-a-variable-1.360 b/Task/Address-of-a-variable/360-Assembly/address-of-a-variable-1.360 new file mode 100644 index 0000000000..6d02f8a6ca --- /dev/null +++ b/Task/Address-of-a-variable/360-Assembly/address-of-a-variable-1.360 @@ -0,0 +1,3 @@ + LA R3,I load address of I +... +I DS F diff --git a/Task/Address-of-a-variable/360-Assembly/address-of-a-variable-2.360 b/Task/Address-of-a-variable/360-Assembly/address-of-a-variable-2.360 new file mode 100644 index 0000000000..05d2f85795 --- /dev/null +++ b/Task/Address-of-a-variable/360-Assembly/address-of-a-variable-2.360 @@ -0,0 +1,7 @@ + USING MYDSECT,R12 + LA R12,I set @J=@I + L R2,J now J is at the same location as I +... +I DS F +MYDSECT DSECT +J DS F diff --git a/Task/Address-of-a-variable/Maple/address-of-a-variable-1.maple b/Task/Address-of-a-variable/Maple/address-of-a-variable-1.maple new file mode 100644 index 0000000000..99b49375f3 --- /dev/null +++ b/Task/Address-of-a-variable/Maple/address-of-a-variable-1.maple @@ -0,0 +1,2 @@ +> addressof( x ); + 18446884674469911422 diff --git a/Task/Address-of-a-variable/Maple/address-of-a-variable-2.maple b/Task/Address-of-a-variable/Maple/address-of-a-variable-2.maple new file mode 100644 index 0000000000..be2c83587a --- /dev/null +++ b/Task/Address-of-a-variable/Maple/address-of-a-variable-2.maple @@ -0,0 +1,2 @@ +> pointto( 18446884674469911422 ); + x diff --git a/Task/Address-of-a-variable/Maple/address-of-a-variable-3.maple b/Task/Address-of-a-variable/Maple/address-of-a-variable-3.maple new file mode 100644 index 0000000000..35c5e6631a --- /dev/null +++ b/Task/Address-of-a-variable/Maple/address-of-a-variable-3.maple @@ -0,0 +1,6 @@ +> addressof( sin( x )^2 + cos( x )^2 ); + 18446884674469972158 + +> pointto( 18446884674469972158 ); + 2 2 + sin(x) + cos(x) diff --git a/Task/Address-of-a-variable/Perl-6/address-of-a-variable.pl6 b/Task/Address-of-a-variable/Perl-6/address-of-a-variable.pl6 index 31927677c1..75649c90a4 100644 --- a/Task/Address-of-a-variable/Perl-6/address-of-a-variable.pl6 +++ b/Task/Address-of-a-variable/Perl-6/address-of-a-variable.pl6 @@ -1 +1,9 @@ -my $x; say $x.WHERE; +my $x; +say $x.WHERE; + +my $y := $x; # alias +say $y.WHERE; # same address as $x + +say "Same variable" if $y =:= $x; +$x = 42; +say $y; # 42 diff --git a/Task/Address-of-a-variable/VBA/address-of-a-variable.vba b/Task/Address-of-a-variable/VBA/address-of-a-variable.vba new file mode 100644 index 0000000000..95d1877ffb --- /dev/null +++ b/Task/Address-of-a-variable/VBA/address-of-a-variable.vba @@ -0,0 +1,24 @@ +Option Explicit +Declare Sub GetMem1 Lib "msvbvm60" (ByVal ptr As Long, ByRef x As Byte) +Declare Sub GetMem2 Lib "msvbvm60" (ByVal ptr As Long, ByRef x As Integer) +Declare Sub GetMem4 Lib "msvbvm60" (ByVal ptr As Long, ByRef x As Long) +Declare Sub PutMem1 Lib "msvbvm60" (ByVal ptr As Long, ByVal x As Byte) +Declare Sub PutMem2 Lib "msvbvm60" (ByVal ptr As Long, ByVal x As Integer) +Declare Sub PutMem4 Lib "msvbvm60" (ByVal ptr As Long, ByVal x As Long) + +Sub Test() + Dim a As Long, ptr As Long, s As Long + a = 12345678 + + 'Get and print address + ptr = VarPtr(a) + Debug.Print ptr + + 'Peek + Call GetMem4(ptr, s) + Debug.Print s + + 'Poke + Call PutMem4(ptr, 87654321) + Debug.Print a +End Sub diff --git a/Task/Address-of-a-variable/X86-Assembly/address-of-a-variable-1.x86 b/Task/Address-of-a-variable/X86-Assembly/address-of-a-variable-1.x86 new file mode 100644 index 0000000000..f913bf03d9 --- /dev/null +++ b/Task/Address-of-a-variable/X86-Assembly/address-of-a-variable-1.x86 @@ -0,0 +1 @@ + movl my_variable, %eax diff --git a/Task/Address-of-a-variable/X86-Assembly/address-of-a-variable-2.x86 b/Task/Address-of-a-variable/X86-Assembly/address-of-a-variable-2.x86 new file mode 100644 index 0000000000..bcad0d4965 --- /dev/null +++ b/Task/Address-of-a-variable/X86-Assembly/address-of-a-variable-2.x86 @@ -0,0 +1,7 @@ + call eip_to_eax + addl $_GLOBAL_OFFSET_TABLE_, %eax + movl my_variable@GOT(%eax), %eax + ... +eip_to_eax: + movl (%esp), %eax + ret diff --git a/Task/Align-columns/AWK/align-columns.awk b/Task/Align-columns/AWK/align-columns.awk index c4a5961ec0..ef392b6e0c 100644 --- a/Task/Align-columns/AWK/align-columns.awk +++ b/Task/Align-columns/AWK/align-columns.awk @@ -1,34 +1,41 @@ +# syntax: GAWK -f ALIGN_COLUMNS.AWK ALIGN_COLUMNS.TXT BEGIN { - FS="$" - lcounter = 1 - maxfield = 0 - # justification; pick one - #justify = "left" - justify = "center" - #justify = "right" + colsep = " " # separator between columns + report("raw data") } -{ - if ( NF > maxfield ) maxfield = NF; - for(i=1; i <= NF; i++) { - line[lcounter,i] = $i - if ( longest[i] == "" ) longest[i] = 0; - if ( length($i) > longest[i] ) longest[i] = length($i); - } - lcounter++ +{ printf("%s\n",$0) + arr[NR] = $0 + n = split($0,tmp_arr,"$") + for (j=1; j<=n; j++) { + width = max(width,length(tmp_arr[j])) + } } END { - just = (justify == "left") ? "-" : "" - for(i=1; i <= NR; i++) { - for(j=1; j <= maxfield; j++) { - if ( justify != "center" ) { - template = "%" just longest[j] "s " - } else { - v = int((longest[j] - length(line[i,j]))/2) - rt = "%" v+1 "s%%-%ds" - template = sprintf(rt, "", longest[j] - v) - } - printf(template, line[i,j]) - } - print "" - } + report("left justified") + report("right justified") + report("center justified") + exit(0) } +function report(text, diff,i,j,l,n,r,tmp_arr) { + printf("\nreport: %s\n",text) + for (i=1; i<=NR; i++) { + n = split(arr[i],tmp_arr,"$") + if (tmp_arr[n] == "") { n-- } + for (j=1; j<=n; j++) { + if (text ~ /^[Ll]/) { # left + printf("%-*s%s",width,tmp_arr[j],colsep) + } + else if (text ~ /^[Rr]/) { # right + printf("%*s%s",width,tmp_arr[j],colsep) + } + else if (text ~ /^[Cc]/) { # center + diff = width - length(tmp_arr[j]) + l = r = int(diff / 2) + if (diff != l + r) { r++ } + printf("%*s%s%*s%s",l,"",tmp_arr[j],r,"",colsep) + } + } + printf("\n") + } +} +function max(x,y) { return((x > y) ? x : y) } diff --git a/Task/Align-columns/Aime/align-columns.aime b/Task/Align-columns/Aime/align-columns.aime new file mode 100644 index 0000000000..66d07bdeed --- /dev/null +++ b/Task/Align-columns/Aime/align-columns.aime @@ -0,0 +1,55 @@ +data b; +file f; +list c, r, s; +integer a, i, j, k, m, w; + +b_cast(b, "Given$a$text$file$of$many$lines,$where$fields$within$a$line$\n" + "are$delineated$by$a$single$'dollar'$character,$write$a$program\n" + "that$aligns$each$column$of$fields$by$ensuring$that$words$in$each$\n" + "column$are$separated$by$at$least$one$space.\n" + "Further,$allow$for$each$word$in$a$column$to$be$either$left$\n" + "justified,$right$justified,$or$center$justified$within$its$column."); + +f_b_affix(f, b); + +m = 0; + +while (f_news(f, r, 0, 0, "$") ^ -1) { + l_append(c, r); + m = max(m, l_length(r)); +} + +i = 0; +while (i < m) { + w = 0; + j = 0; + while (j < l_length(c)) { + r = c[j]; + if (i < l_length(r)) { + w = max(w, length(r[i])); + } + j += 1; + } + l_append(s, w + 1); + i += 1; +} + +k = 3; +while (k) { + k -= 1; + o_plan(l_effect("right", "center", "left")[k], " justified", "\n"); + j = 0; + while (j < l_length(c)) { + i = 0; + r = c[j]; + while (i < l_length(r)) { + w = s[i]; + m = w - length(r[i]); + o_form("/w~3/~/w~1/", a = k * m >> 1, "", m - a, "", r[i]); + i += 1; + } + o_newline(); + j += 1; + } + o_newline(); +} diff --git a/Task/Align-columns/AppleScript/align-columns.applescript b/Task/Align-columns/AppleScript/align-columns.applescript new file mode 100644 index 0000000000..4b9c3d3d06 --- /dev/null +++ b/Task/Align-columns/AppleScript/align-columns.applescript @@ -0,0 +1,216 @@ +property pstrLines : ¬ + "Given$a$text$file$of$many$lines,$where$fields$within$a$line$\n" & ¬ + "are$delineated$by$a$single$'dollar'$character,$write$a$program\n" & ¬ + "that$aligns$each$column$of$fields$by$ensuring$that$words$in$each$\n" & ¬ + "column$are$separated$by$at$least$one$space.\n" & ¬ + "Further,$allow$for$each$word$in$a$column$to$be$either$left$\n" & ¬ + "justified,$right$justified,$or$center$justified$within$its$column." + +property eLeft : -1 +property eCenter : 0 +property eRight : 1 + +on run + set lstCols to lineColumns("$", pstrLines) + + script testAlignment + on lambda(eAlign) + columnsAligned(eAlign, lstCols) + end lambda + end script + + intercalate(return & return, ¬ + map(testAlignment, {eLeft, eRight, eCenter})) +end run + + +-- columnsAligned :: EnumValue -> [[String]] -> String +on columnsAligned(eAlign, lstCols) + -- padwords :: Int -> [String] -> [[String]] + script padwords + on lambda(n, lstWords) + + -- pad :: String -> String + script pad + on lambda(str) + set lngPad to n - (length of str) + if eAlign = my eCenter then + set lngHalf to lngPad div 2 + {replicate(lngHalf, space), str, ¬ + replicate(lngPad - lngHalf, space)} + else + if eAlign = my eLeft then + {"", str, replicate(lngPad, space)} + else + {replicate(lngPad, space), str, ""} + end if + end if + end lambda + end script + + map(pad, lstWords) + end lambda + end script + + unlines(map(my unwords, ¬ + transpose(zipWith(padwords, ¬ + map(my widest, lstCols), lstCols)))) +end columnsAligned + +-- lineColumns :: String -> String -> String +on lineColumns(strColDelim, strText) + -- _words :: Text -> [Text] + script _words + on lambda(str) + splitOn(strColDelim, str) + end lambda + end script + + set lstRows to map(_words, splitOn(linefeed, pstrLines)) + set nCols to widest(lstRows) + + -- fullRow :: [[a]] -> [[a]] + script fullRow + on lambda(lst) + lst & replicate(nCols - (length of lst), {""}) + end lambda + end script + + transpose(map(fullRow, lstRows)) +end lineColumns + +-- widest [a] -> Int +on widest(xs) + script maxLen + on lambda(a, x) + set lng to length of x + cond(lng > a, lng, a) + end lambda + end script + + foldl(maxLen, 0, xs) +end widest + + + +-- GENERIC LIBRARY FUNCTIONS + +-- Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate + +-- Text -> Text -> [Text] +on splitOn(strDelim, strMain) + set {dlm, my text item delimiters} to {my text item delimiters, strDelim} + set lstParts to text items of strMain + set my text item delimiters to dlm + return lstParts +end splitOn + +-- [Text] -> Text +on unlines(lstLines) + intercalate(linefeed, lstLines) +end unlines + +-- [Text] -> Text +on unwords(lstWords) + intercalate(" ", lstWords) +end unwords + +-- transpose :: [[a]] -> [[a]] +on transpose(xss) + script column + on lambda(_, iCol) + script row + on lambda(xs) + item iCol of xs + end lambda + end script + + map(row, xss) + end lambda + end script + + map(column, item 1 of xss) +end transpose + +-- 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 + +-- 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 + +-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] +on zipWith(f, xs, ys) + set lng to length of xs + if lng is not length of ys then return missing value + + tell mReturn(f) + set lst to {} + 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 zipWith + +-- cond :: Bool -> a -> a -> a +on cond(bool, f, g) + if bool then + f + else + g + end if +end cond + +-- Egyptian multiplication - progressively doubling a list, appending +-- stages of doubling to an accumulator where needed for binary +-- assembly of a target length + +-- replicate :: Int -> a -> [a] +on replicate(n, a) + set out to cond(class of a is string, "", {}) + if n < 1 then return out + set dbl to a + + repeat while (n > 1) + if (n mod 2) > 0 then set out to out & dbl + set n to (n div 2) + set dbl to (dbl & dbl) + end repeat + return out & dbl +end replicate + +-- 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 diff --git a/Task/Align-columns/Batch-File/align-columns.bat b/Task/Align-columns/Batch-File/align-columns.bat new file mode 100644 index 0000000000..1dd72d41b5 --- /dev/null +++ b/Task/Align-columns/Batch-File/align-columns.bat @@ -0,0 +1,84 @@ +@echo off +setlocal enabledelayedexpansion +mode con cols=103 + +echo Given$a$text$file$of$many$lines,$where$fields$within$a$line$ >file.txt +echo are$delineated$by$a$single$'dollar'$character,$write$a$program! >>file.txt +echo that$aligns$each$column$of$fields$by$ensuring$that$words$in$each$>>file.txt +echo column$are$separated$by$at$least$one$space.>>file.txt +echo Further,$allow$for$each$word$in$a$column$to$be$either$left$>>file.txt +echo justified,$right$justified,$or$center$justified$within$its$column.>>file.txt + +for /f "tokens=1-13 delims=$" %%a in ('type file.txt') do ( + call:maxlen %%a %%b %%c %%d %%e %%f %%g %%h %%i %%j %%k %%l %%m ) +echo. +for /f "tokens=1-13 delims=$" %%a in ('type file.txt') do ( + call:align 1 %%a %%b %%c %%d %%e %%f %%g %%h %%i %%j %%k %%l %%m ) +echo. +for /f "tokens=1-13 delims=$" %%a in ('type file.txt') do ( + call:align 2 %%a %%b %%c %%d %%e %%f %%g %%h %%i %%j %%k %%l %%m ) +echo. +for /f "tokens=1-13 delims=$" %%a in ('type file.txt') do ( + call:align 3 %%a %%b %%c %%d %%e %%f %%g %%h %%i %%j %%k %%l %%m ) + +exit /B + +:maxlen &::sets variables len1 to len13 + set "cnt=1" +:loop1 + if "%1"=="" exit /b + call:strlen %1 length + if !len%cnt%! lss !length! set len%cnt%=!length! + set /a cnt+=1 + shift + goto loop1 + +:align + setlocal + set cnt=1 + set print= +:loop2 + if "%2"=="" echo(%print%&endlocal & exit /b + set /a width=len%cnt%,cnt+=1 + set arr=%2 + if %1 equ 1 call:left %width% arr + if %1 equ 2 call:right %width% arr + if %1 equ 3 call:center %width% arr + set "print=%print%%arr% " + shift /2 + goto loop2 + +:left %num% &string + setlocal + set "arr=!%2! " + set arr=!arr:~0,%1! + endlocal & set %2=%arr% +exit /b + +:right %num% &string + setlocal + set "arr= !%2!" + set arr=!arr:~-%1! + endlocal & set %2=%arr% +exit /b + +:center %num% &string +setlocal + set /a width=%1-1 + set arr=!%2! + :loop3 + if "!arr:~%width%,1!"=="" set "arr=%arr% " + if "!arr:~%width%,1!"=="" set "arr= %arr%" + if "!arr:~%width%,1!"=="" goto loop3 +endlocal & set %2=%arr% +exit /b + +:strlen StrVar &RtnVar + setlocal EnableDelayedExpansion + set "s=#%~1" + set "len=0" + for %%N in (4096 2048 1024 512 256 128 64 32 16 8 4 2 1) do ( + if "!s:~%%N,1!" neq "" set /a "len+=%%N" & set "s=!s:~%%N!" + ) + endlocal & set %~2=%len% +exit /b diff --git a/Task/Align-columns/Fortran/align-columns.f b/Task/Align-columns/Fortran/align-columns.f new file mode 100644 index 0000000000..d27d46ac70 --- /dev/null +++ b/Task/Align-columns/Fortran/align-columns.f @@ -0,0 +1,94 @@ + SUBROUTINE RAKE(IN,M,X,WAY) !Casts forth text in fixed-width columns. +Collates column widths so that each column is wide enough for its widest member. + INTEGER IN !Fingers the input file. + INTEGER M !Maximum record length thereof. + CHARACTER*1 X !The delimiter, possibly a comma. + INTEGER WAY !Alignment style. + INTEGER W(M + 1) !If every character were X in the maximum-length record, + INTEGER C(0:M + 1) !Then M + 1 would be the maximum number of fields possible. + CHARACTER*(M) ACARD !A scratchpad big enough for the biggest. + CHARACTER*(28 + 4*M) FORMAT !Guess. Allow for "Ann," per field. + INTEGER I !A stepper. + INTEGER L,LF !Text fingers. + INTEGER NF,MF !Field counts. + CHARACTER*6 WAYNESS(-1:+1) !Some annotation may be helpful. + PARAMETER (WAYNESS = (/"Left","Centre","Right"/)) !Using normal language. + INTEGER LINPR !The mouthpiece. + COMMON LINPR !Used all over. + W = 0 !Maximum field widths so far seen. + MF = 0 !Maximum number of fields to a record. + C(0) = 0 !Syncopation for the first field's predecessor. + WRITE (LINPR,*) !Some separation. + WRITE (LINPR,*) "Align ",WAYNESS(MIN(MAX(WAY,-1),+1)) !Explain, cautiously. + +Chase through the file assessing the lengths of each field. + 10 READ (IN,11,END = 20) L,ACARD(1:L) !Grab a record. + 11 FORMAT (Q,A) !Working only up to its end. + CALL LIZZIEBORDEN !Find the chop points. + W(1:NF) = MAX(W(1:NF),C(1:NF) - C(0:NF - 1) - 1) !Thereby the lengths between. + MF = MAX(MF,NF) !Also want to know the most number of chops. + GO TO 10 !Get the next record. + +Concoct a FORMAT based on the maximum size of each field. Plus one. + 20 REWIND(IN) !Back to the beginning. + WRITE (FORMAT,21) W(1:MF) + 1 !Add one to meet the specified at least one space between columns. + 21 FORMAT ("(",("A",I0,",")) !Generates a sequence of An, items. + LF = INDEX(FORMAT,", ") !The last one has a trailing comma. + IF (LF.LE.0) STOP "Format trouble!" !Or, maybe not! + FORMAT(LF:LF) = ")" !Convert it to the closing bracket. + WRITE (LINPR,*) "Format",FORMAT(1:LF) !Present it. + +Chug afresh, this time knowing the maximum length of each field. + 30 READ (IN,11,END = 40) L,ACARD(1:L) !Place just the record's content. + CALL LIZZIEBORDEN !Find the chop points. + SELECT CASE(WAY) !What is to be done? + CASE(-1) !Shove leftwards by appending spaces. + WRITE (LINPR,FORMAT) (ACARD(C(I - 1) + 1:C(I) - 1)// !The chopped text. + 1 REPEAT(" ",W(I) - C(I) + C(I - 1) + 1),I = 1,NF) !Some spaces. + CASE( 0) !Centre by appending half as many spaces. + WRITE (LINPR,FORMAT) (ACARD(C(I - 1) + 1:C(I) - 1)// !The chopped text. + 1 REPEAT(" ",(W(I) - C(I) + C(I - 1) + 1)/2),I = 1,NF) !Some spaces. + CASE(+1) !Align rightwards is the default style. + WRITE (LINPR,FORMAT) (ACARD(C(I - 1) + 1:C(I) - 1),I = 1,NF) !So, just the texts. + CASE DEFAULT !This shouldn't happen. + WRITE (LINPR,*) "Huh? WAY=",WAY !But if it does, + STOP "Unanticipated value for WAY!" !Explain. + END SELECT !So much for that record. + GO TO 30 !Go for another. +Closedown + 40 REWIND(IN) !Be polite. + CONTAINS !This also marks the end of source for RAKE... + SUBROUTINE LIZZIEBORDEN !Take an axe to ACARD, chopping at X. + NF = 0 !No strokes so far. + DO I = 1,L !So, step away. + IF (ICHAR(ACARD(I:I)).EQ.ICHAR(X)) THEN !Here? + NF = NF + 1 !Yes! + C(NF) = I !The place! + END IF !So much for that. + END DO !On to the next. + NF = NF + 1 !And the end of ACARD is also a chop point. + C(NF) = L + 1 !As if here. + END SUBROUTINE LIZZIEBORDEN !She was aquitted. + END SUBROUTINE RAKE !So much raking over. + + INTEGER L,M,N !To be determined the hard way. + INTEGER LINPR,IN !I/O unit numbers. + COMMON LINPR !Some of general note. + LINPR = 6 !Standard output via this unit number. + IN = 10 !Some unit number for the input file. + OPEN (IN,FILE="Rake.txt",STATUS="OLD",ACTION="READ") !For formatted input. + N = 0 !No records read. + M = 0 !Longest record so far. + + 1 READ (IN,2,END = 10) L !How long is this record? + 2 FORMAT (Q) !Obviously, Q specifies the length, not a content field. + N = N + 1 !Anyway, another record has been read. + M = MAX(M,L) !And this is the longest so far. + GO TO 1 !Go back for more. + + 10 REWIND (IN) !We're ready now. + WRITE (LINPR,*) N,"Recs, longest rec. length is ",M + CALL RAKE(IN,M,"$",-1) !Align left. + CALL RAKE(IN,M,"$", 0) !Centre. + CALL RAKE(IN,M,"$",+1) !Align right. + END !That's all. diff --git a/Task/Align-columns/JavaScript/align-columns-3.js b/Task/Align-columns/JavaScript/align-columns-3.js index 91b889e056..cbee7cf1bc 100644 --- a/Task/Align-columns/JavaScript/align-columns-3.js +++ b/Task/Align-columns/JavaScript/align-columns-3.js @@ -1,63 +1,133 @@ -(function (lines) { +(function (strText) { + 'use strict'; - var LEFT = 0, - CENTRE = 1, - RIGHT = 2; + // [[a]] -> [[a]] + function transpose(lst) { + return lst[0].map(function (_, iCol) { + return lst.map(function (row) { + return row[iCol]; + }) + }); + } - return alignedTable( - lines.map(function (s) { - return s.split('$'); + // (a -> b -> c) -> [a] -> [b] -> [c] + function zipWith(f, xs, ys) { + return xs.length === ys.length ? ( + xs.map(function (x, i) { + return f(x, ys[i]); + }) + ) : undefined; + } + + // (a -> a -> Ordering) -> [a] -> a + function maximumBy(f, xs) { + return xs.reduce(function (a, x) { + return a === undefined ? x : ( + f(x) > f(a) ? x : a + ); + }, undefined) + } + + // [String] -> String + function widest(lst) { + return maximumBy(length, lst) + .length; + } + + // [[a]] -> [[a]] + function fullRow(lst, n) { + return lst.concat(Array.apply(null, Array(n - lst.length)) + .map(function () { + return '' + })); + } + + // String -> Int -> String + function nreps(s, n) { + var o = ''; + if (n < 1) return o; + while (n > 1) { + if (n & 1) o += s; + n >>= 1; + s += s; + } + return o + s; + } + + // [String] -> String + function unwords(xs) { + return xs.join(' '); + } + + // [String] -> String + function unlines(xs) { + return xs.join('\n'); + } + + // [a] -> Int + function length(xs) { + return xs.length; + } + + // -- Int -> [String] -> [[String]] + function padWords(n, lstWords, eAlign) { + return lstWords.map(function (w) { + var lngPad = n - w.length; + + return ( + (eAlign === eCenter) ? (function () { + var lngHalf = Math.floor(lngPad / 2); + + return [ + nreps(' ', lngHalf), w, + nreps(' ', lngPad - lngHalf) + ]; + })() : (eAlign === eLeft) ? + ['', w, nreps(' ', lngPad)] : + [nreps(' ', lngPad), w, ''] + ) + .join(''); + }); + } + + // MAIN + + var eLeft = -1, + eCenter = 0, + eRight = 1; + + var lstRows = strText.split('\n') + .map(function (x) { + return x.split('$'); }), - 2, // minimum gap between cols - LEFT // [LEFT|CENTRE|RIGHT] or [0|1|2] - ) - // TABULATION OF RESULTS IN SPACED AND ALIGNED COLUMNS - // [s] -> n -> enum -> s - function alignedTable(lstRows, lngPad, iAlignment) { + lngCols = widest(lstRows), + lstCols = transpose(lstRows.map(function (r) { + return fullRow(r, lngCols) + })), + lstColWidths = lstCols.map(widest); - // Max width of each column - var lstColWidths = range(0, lstRows.reduce(function (a, x) { - return x.length > a ? x.length : a; - }, 0) - 1).map(function (iCol) { - return lstRows.reduce(function (a, lst) { - var w = lst[iCol] ? lst[iCol].toString().length : 0; - return (w > a) ? w : a; - }, 0); - }); + // THREE PARAGRAPHS, WITH VARIOUS WORD COLUMN ALIGNMENTS: - // Rows padded to equal width - return lstRows.map(function (lstRow) { - return lstRow.map(function (v, i) { - return align(v, lstColWidths[i] + lngPad, iAlignment); - }).join('') - }).join('\n'); - } + return [eLeft, eRight, eCenter] + .map(function (eAlign) { + var fPad = function (n, lstWords) { + return padWords(n, lstWords, eAlign); + }; - // Text padded to left and/or right: aligned (left|centre|right) - // String, number of characters, alignment 0|1|2 - // s -> n -> enum -> s - function align(s, n, a) { - var mid = (1 === a), - gap = n - s.length, - pad = Array(Math.floor((gap + 1) / (mid ? 2 : 1))).join(' '); + return transpose( + zipWith(fPad, lstColWidths, lstCols) + ) + .map(unwords); + }) + .map(unlines) + .join('\n\n'); - return (a ? pad + (!mid || gap % 2 ? '' : ' ') : '') + s + - (2 > a ? pad + (mid ? ' ' : '') : ''); - } - - // [m..n] - function range(m, n) { - return Array.apply(null, Array(n - m + 1)).map(function (x, i) { - return m + i; - }); - } - -})([ - "Given$a$text$file$of$many$lines,$where$fields$within$a$line$", - "are$delineated$by$a$single$'dollar'$character,$write$a$program", - "that$aligns$each$column$of$fields$by$ensuring$that$words$in$each$", - "column$are$separated$by$at$least$one$space.", - "Further,$allow$for$each$word$in$a$column$to$be$either$left$", - "justified,$right$justified,$or$center$justified$within$its$column." -]); +})( + "Given$a$text$file$of$many$lines,$where$fields$within$a$line$\n\ +are$delineated$by$a$single$'dollar'$character,$write$a$program\n\ +that$aligns$each$column$of$fields$by$ensuring$that$words$in$each$\n\ +column$are$separated$by$at$least$one$space.\n\ +Further,$allow$for$each$word$in$a$column$to$be$either$left$\n\ +justified,$right$justified,$or$center$justified$within$its$column." +); diff --git a/Task/Align-columns/Kotlin/align-columns.kotlin b/Task/Align-columns/Kotlin/align-columns.kotlin index c8dc714c8c..a02f891b04 100644 --- a/Task/Align-columns/Kotlin/align-columns.kotlin +++ b/Task/Align-columns/Kotlin/align-columns.kotlin @@ -5,17 +5,11 @@ import java.nio.file.Files import java.nio.file.Paths enum class Align_function { - LEFT { - override fun invoke(s: String, length: Int) = ("%-" + length + 's').format(("%" + s.length() + 's').format(s)) - }, - RIGHT { - override fun invoke(s: String, length: Int) = ("%-" + length + 's').format(("%" + length + 's').format(s)) - }, - CENTER { - override fun invoke(s: String, length: Int) = ("%-" + length + 's').format(("%" + ((length + s.length()) / 2) + 's').format(s)) - }; + LEFT { override fun invoke(s: String, l: Int) = ("%-" + l + 's').format(("%" + s.length + 's').format(s)) }, + RIGHT { override fun invoke(s: String, l: Int) = ("%-" + l + 's').format(("%" + l + 's').format(s)) }, + CENTER { override fun invoke(s: String, l: Int) = ("%-" + l + 's').format(("%" + ((l + s.length) / 2) + 's').format(s)) }; - abstract operator fun invoke(s: String, length: Int): String + abstract operator fun invoke(s: String, l: Int): String } /** Aligns fields into columns, separated by "|". @@ -23,42 +17,42 @@ enum class Align_function { * @property lines Lines in a single string. Empty string does form a column. */ class Column_aligner(val lines: List) { - operator fun invoke(a: Align_function): String { - val result = StringBuilder() + operator fun invoke(a: Align_function) : String { + var result = "" for (lineWords in words) { for (i in lineWords.indices) { if (i == 0) - result.append('|') - result.append(a(lineWords[i], column_widths[i])) - result.append('|') + result += '|' + result += a(lineWords[i], column_widths[i]) + result += '|' } - result.append('\n') + result += '\n' } - return result.toString() + return result } private val words = arrayListOf>() private val column_widths = arrayListOf() init { - lines forEach { + lines.forEach { val lineWords = java.lang.String(it).split("\\$") words += lineWords for (i in lineWords.indices) - if (i >= column_widths.size()) - column_widths += lineWords[i].length() + if (i >= column_widths.size) + column_widths += lineWords[i].length else - column_widths[i] = Math.max(column_widths[i], lineWords[i].length()) + column_widths[i] = Math.max(column_widths[i], lineWords[i].length) } } } fun main(args: Array) { - if (args.size() < 1) + if (args.size < 1) println("Usage: ColumnAligner file [L|R|C]") else { val ca = Column_aligner(Files.readAllLines(Paths.get(args[0]), StandardCharsets.UTF_8)) - val alignment = if (args.size() >= 2) args[1] else "L" + val alignment = if (args.size >= 2) args[1] else "L" when (alignment) { "L" -> print(ca(Align_function.LEFT)) "R" -> print(ca(Align_function.RIGHT)) diff --git a/Task/Align-columns/Perl-6/align-columns-2.pl6 b/Task/Align-columns/Perl-6/align-columns-2.pl6 index 5604b2a43d..4893c7e36c 100644 --- a/Task/Align-columns/Perl-6/align-columns-2.pl6 +++ b/Task/Align-columns/Perl-6/align-columns-2.pl6 @@ -2,7 +2,7 @@ my @lines = slurp("example.txt").lines; my @widths; for @lines { for .split('$').kv { @widths[$^key] max= $^word.chars; } } -for @lines { say .split('$').kv.map: { (align @widths[$^key], $^word) ~ " "; } } +for @lines { say |.split('$').kv.map: { (align @widths[$^key], $^word) ~ " "; } } sub align($column_width, $word, $aligment = @*ARGS[0]) { my $lr = $column_width - $word.chars; diff --git a/Task/Align-columns/Perl-6/align-columns-3.pl6 b/Task/Align-columns/Perl-6/align-columns-3.pl6 new file mode 100644 index 0000000000..1bad12856a --- /dev/null +++ b/Task/Align-columns/Perl-6/align-columns-3.pl6 @@ -0,0 +1,7 @@ +sub MAIN ($alignment where 'left'|'right', $file) { + my @lines := $file.IO.lines.map(*.split: '$').List; + my @widths = roundrobin(|@lines).map(*».chars.max); + my $align = {left=>'-', right=>''}{$alignment}; + my $format = @widths.map({ "%{++$}\${$align}{$_}s" }).join(" ") ~ "\n"; + printf $format, |$_ for @lines; +} diff --git a/Task/Align-columns/PowerShell/align-columns.psh b/Task/Align-columns/PowerShell/align-columns.psh new file mode 100644 index 0000000000..3cfe07a5d2 --- /dev/null +++ b/Task/Align-columns/PowerShell/align-columns.psh @@ -0,0 +1,22 @@ +$file = +@' +Given$a$text$file$of$many$lines,$where$fields$within$a$line$ +are$delineated$by$a$single$'dollar'$character,$write$a$program +that$aligns$each$column$of$fields$by$ensuring$that$words$in$each$ +column$are$separated$by$at$least$one$space. +Further,$allow$for$each$word$in$a$column$to$be$either$left$ +justified,$right$justified,$or$center$justified$within$its$column. +'@.Split("`n") + +$arr = @() +$file | foreach { + $line = $_ + $i = 0 + $hash = [ordered]@{} + $line.split('$') | foreach{ + $hash["$i"] = "$_" + $i++ + } + $arr += @([pscustomobject]$hash) +} +$arr | Format-Table -HideTableHeaders -Wrap * diff --git a/Task/Align-columns/ZX-Spectrum-Basic/align-columns.zx b/Task/Align-columns/ZX-Spectrum-Basic/align-columns.zx new file mode 100644 index 0000000000..089bef3083 --- /dev/null +++ b/Task/Align-columns/ZX-Spectrum-Basic/align-columns.zx @@ -0,0 +1,47 @@ + 5 BORDER 2 +10 DATA 6 +20 DATA "The$problem$of$Speccy$" +30 DATA "is$the$screen.$" +40 DATA "Need$adapt$text$sample$" +50 DATA "for$show$the$result$" +60 DATA "without$problem$,right?$" +70 DATA "But$see$the$code.$" +80 REM First find the maximum length of a 'word' +90 LET max=0: LET d$="$" +100 READ nlines +110 FOR l=1 TO nlines +120 READ t$ +130 GO SUB 1000 +150 NEXT l +155 LET s$=" "( TO max) +160 REM Now display the aligned text: +170 LET m$="l": GO SUB 2000: PRINT +180 LET m$="r": GO SUB 2000: PRINT +190 LET m$="c": GO SUB 2000 +200 STOP +1000 REM Maximum length of a word +1010 LET lt=LEN t$: LET p=1: LET lw=0 +1020 FOR i=1 TO lt +1030 IF t$(i)=d$ THEN LET lw=i-p: LET p=i: IF lw>max THEN LET max=lw +1040 NEXT i +1050 RETURN +2000 REM Show aligned text +2010 RESTORE 20 +2020 FOR l=1 TO nlines +2030 READ t$ +2040 GO SUB 3000 +2050 NEXT l +2060 RETURN +3000 REM Show words +3010 LET lt=LEN t$: LET p=1: LET lw=0 +3020 FOR i=1 TO lt +3030 IF t$(i)<>d$ THEN GO TO 3090 +3035 LET lw=i-p +3040 LET p$=t$(p TO i-1): LET p=i+1: LET z$=s$ +3050 IF m$="l" THEN LET z$( TO lw)=p$ +3060 IF m$="r" THEN LET z$(max-lw+1 TO )=p$ +3070 IF m$="c" THEN LET z$((max/2)-(lw/2) TO )=p$ +3080 PRINT z$; +3090 NEXT i +3095 PRINT +3100 RETURN diff --git a/Task/Aliquot-sequence-classifications/Common-Lisp/aliquot-sequence-classifications.lisp b/Task/Aliquot-sequence-classifications/Common-Lisp/aliquot-sequence-classifications.lisp new file mode 100644 index 0000000000..e49fb73138 --- /dev/null +++ b/Task/Aliquot-sequence-classifications/Common-Lisp/aliquot-sequence-classifications.lisp @@ -0,0 +1,67 @@ +(defparameter *nlimit* 16) +(defparameter *klimit* (expt 2 47)) +(defparameter *asht* (make-hash-table)) +(load "proper-divisors") + +(defun ht-insert (v n) + (setf (gethash v *asht*) n)) + +(defun ht-find (v n) + (let ((nprev (gethash v *asht*))) + (if nprev (- n nprev) nil))) + +(defun ht-list () + (defun sort-keys (&optional (res '())) + (maphash #'(lambda (k v) (push (cons k v) res)) *asht*) + (sort (copy-list res) #'< :key (lambda (p) (cdr p)))) + (let ((sorted (sort-keys))) + (dotimes (i (length sorted)) (format t "~A " (car (nth i sorted)))))) + +(defun aliquot-generator (K1) + "integer->function::fn to generate aliquot sequence" + (let ((Kn K1)) + #'(lambda () (setf Kn (reduce #'+ (proper-divisors-recursive Kn) :initial-value 0))))) + +(defun aliquot (K1) + "integer->symbol|nil::classify aliquot sequence" + (defun aliquot-sym (Kn n) + (let* ((period (ht-find Kn n)) + (sym (if period + (cond ; period event + ((= Kn K1) + (case period (1 'PERF) (2 'AMIC) (otherwise 'SOCI))) + ((= period 1) 'ASPI) + (t 'CYCL)) + (cond ; else check for limit event + ((= Kn 0) 'TERM) + ((> Kn *klimit*) 'TLIM) + ((= n *nlimit*) 'NLIM) + (t nil))))) + ;; if period event store the period, if no event insert the value + (if sym (when period (setf (symbol-plist sym) (list period))) + (ht-insert Kn n)) + sym)) + + (defun aliquot-str (sym &optional (period 0)) + (case sym (TERM "terminating") (PERF "perfect") (AMIC "amicable") (ASPI "aspiring") + (SOCI (format nil "sociable (period ~A)" (car (symbol-plist sym)))) + (CYCL (format nil "cyclic (period ~A)" (car (symbol-plist sym)))) + (NLIM (format nil "non-terminating (no classification before added term limit of ~A)" *nlimit*)) + (TLIM (format nil "non-terminating (term threshold of ~A exceeded)" *klimit*)) + (otherwise "unknown"))) + + (clrhash *asht*) + (let ((fgen (aliquot-generator K1))) + (setf (symbol-function 'aliseq) #'(lambda () (funcall fgen)))) + (ht-insert K1 0) + (do* ((n 1 (1+ n)) + (Kn (aliseq) (aliseq)) + (alisym (aliquot-sym Kn n) (aliquot-sym Kn n))) + (alisym (format t "~A:" (aliquot-str alisym)) (ht-list) (format t "~A~%" Kn) alisym))) + +(defun main () + (princ "The last item in each sequence triggers classification.") (terpri) + (dotimes (k 10) + (aliquot (+ k 1))) + (dolist (k '(11 12 28 496 220 1184 12496 1264460 790 909 562 1064 1488 15355717786080)) + (aliquot k))) diff --git a/Task/Aliquot-sequence-classifications/Elixir/aliquot-sequence-classifications.elixir b/Task/Aliquot-sequence-classifications/Elixir/aliquot-sequence-classifications.elixir new file mode 100644 index 0000000000..e26d249bde --- /dev/null +++ b/Task/Aliquot-sequence-classifications/Elixir/aliquot-sequence-classifications.elixir @@ -0,0 +1,50 @@ +defmodule Proper do + def divisors(1), do: [] + def divisors(n), do: [1 | divisors(2,n,:math.sqrt(n))] |> Enum.sort + + defp divisors(k,_n,q) when k>q, do: [] + defp divisors(k,n,q) when rem(n,k)>0, do: divisors(k+1,n,q) + defp divisors(k,n,q) when k * k == n, do: [k | divisors(k+1,n,q)] + defp divisors(k,n,q) , do: [k,div(n,k) | divisors(k+1,n,q)] +end + +defmodule Aliquot do + def sequence(n, maxlen\\16, maxterm\\140737488355328) + def sequence(0, _maxlen, _maxterm), do: "terminating" + def sequence(n, maxlen, maxterm) do + {msg, s} = sequence(n, maxlen, maxterm, [n]) + {msg, Enum.reverse(s)} + end + + defp sequence(n, maxlen, maxterm, s) when length(s) < maxlen and n < maxterm do + m = Proper.divisors(n) |> Enum.sum + cond do + m in s -> + case {m, List.last(s), hd(s)} do + {x,x,_} -> + case length(s) do + 1 -> {"perfect", s} + 2 -> {"amicable", s} + _ -> {"sociable of length #{length(s)}", s} + end + {x,_,x} -> {"aspiring", [m | s]} + _ -> {"cyclic back to #{m}", [m | s]} + end + m == 0 -> {"terminating", [0 | s]} + true -> sequence(m, maxlen, maxterm, [m | s]) + end + end + defp sequence(_, _, _, s), do: {"non-terminating", s} +end + +Enum.each(1..10, fn n -> + {msg, s} = Aliquot.sequence(n) + :io.fwrite("~7w:~21s: ~p~n", [n, msg, s]) +end) +IO.puts "" +[11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488, 15355717786080] +|> Enum.each(fn n -> + {msg, s} = Aliquot.sequence(n) + if n<10000000, do: :io.fwrite("~7w:~21s: ~p~n", [n, msg, s]), + else: :io.fwrite("~w: ~s: ~p~n", [n, msg, s]) + end) diff --git a/Task/Aliquot-sequence-classifications/J/aliquot-sequence-classifications-1.j b/Task/Aliquot-sequence-classifications/J/aliquot-sequence-classifications-1.j index 89f9521754..875443583e 100644 --- a/Task/Aliquot-sequence-classifications/J/aliquot-sequence-classifications-1.j +++ b/Task/Aliquot-sequence-classifications/J/aliquot-sequence-classifications-1.j @@ -1,5 +1,15 @@ -proper_divisors =: [: */&> [: }: [: , [: { [: <@:({. ^ i.@:>:@:{:)";: [: |: 2 p: x: -aliquot =: ([: +/ proper_divisors) ::0: -rc_aliquot_sequence =: aliquot^:(i.16)&> -rc_classify =: [: {. ([;.1' invalid terminate non-terminating perfect amicable sociable aspiring cyclic') #~ (16 ~: #) , (6 > {:) , (([: +./ (2^47x)&<) +. (16 = #@:~.)) , (1 = #@:~.) , ((8&= , 1&<)@:{.@:(#/.~)) , ([: =/ _2&{.) , 1: -rc_display_aliquot_sequence =: (":,~' ',~rc_classify)@:rc_aliquot_sequence +proper_divisors=: [: */@>@}:@,@{ [: (^ i.@>:)&.>/ 2 p: x: +aliquot=: +/@proper_divisors ::0: +rc_aliquot_sequence=: aliquot^:(i.16)&> +rc_classify=: 3 :0 + if. 16 ~:# y do. ' invalid ' + elseif. 6 > {: y do. ' terminate ' + elseif. (+./y>2^47) +. 16 = #~.y do. ' non-terminating' + elseif. 1=#~. y do. ' perfect ' + elseif. 8= st=. {.#/.~ y do. ' amicable ' + elseif. 1 < st do. ' sociable ' + elseif. =/_2{. y do. ' aspiring ' + elseif. 1 do. ' cyclic ' + end. +) +rc_display_aliquot_sequence=: (rc_classify,' ',":)@:rc_aliquot_sequence diff --git a/Task/Aliquot-sequence-classifications/J/aliquot-sequence-classifications-2.j b/Task/Aliquot-sequence-classifications/J/aliquot-sequence-classifications-2.j index 4a9dda699c..37d370862c 100644 --- a/Task/Aliquot-sequence-classifications/J/aliquot-sequence-classifications-2.j +++ b/Task/Aliquot-sequence-classifications/J/aliquot-sequence-classifications-2.j @@ -11,17 +11,17 @@ terminate 10 8 7 1 0 0 0 0 0 0 0 0 0 0 0 0 rc_display_aliquot_sequence&>11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488, 15355717786080x - terminate 11 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 ... - terminate 12 16 15 9 4 3 1 0 0 0 0 0 0 0 0 0 ... - perfect 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 ... - perfect 496 496 496 496 496 496 496 496 496 496 496 496 496 496 496 496 ... - amicable 220 284 220 284 220 284 220 284 220 284 220 284 220 284 220 284 ... - amicable 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 ... - sociable 12496 14288 15472 14536 14264 12496 14288 15472 14536 14264 12496 14288 15472 14536 14264 12496 ... - sociable 1264460 1547860 1727636 1305184 1264460 1547860 1727636 1305184 1264460 1547860 1727636 1305184 1264460 1547860 1727636 1305184 ... - aspiring 790 650 652 496 496 496 496 496 496 496 496 496 496 496 496 496 ... - aspiring 909 417 143 25 6 6 6 6 6 6 6 6 6 6 6 6 ... - cyclic 562 284 220 284 220 284 220 284 220 284 220 284 220 284 220 284 ... - cyclic 1064 1336 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 ... - non-terminating 1488 2480 3472 4464 8432 9424 10416 21328 22320 55056 95728 96720 236592 459792 881392 882384 ... - non-terminating 15355717786080 44534663601120 144940087464480 471714103310688 1130798979186912 2688948041357088 6050151708497568 13613157922639968 35513546724070632 74727605255142168 162658586225561832 353930992506879768 642678347124409032 112510261154846... + terminate 11 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + terminate 12 16 15 9 4 3 1 0 0 0 0 0 0 0 0 0 + perfect 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 28 + perfect 496 496 496 496 496 496 496 496 496 496 496 496 496 496 496 496 + amicable 220 284 220 284 220 284 220 284 220 284 220 284 220 284 220 284 + amicable 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 + sociable 12496 14288 15472 14536 14264 12496 14288 15472 14536 14264 12496 14288 15472 14536 14264 12496 + sociable 1264460 1547860 1727636 1305184 1264460 1547860 1727636 1305184 1264460 1547860 1727636 1305184 1264460 1547860 1727636 1305184 + aspiring 790 650 652 496 496 496 496 496 496 496 496 496 496 496 496 496 + aspiring 909 417 143 25 6 6 6 6 6 6 6 6 6 6 6 6 + cyclic 562 284 220 284 220 284 220 284 220 284 220 284 220 284 220 284 + cyclic 1064 1336 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 1184 1210 + non-terminating 1488 2480 3472 4464 8432 9424 10416 21328 22320 55056 95728 96720 236592 459792 881392 882384 + non-terminating 15355717786080 44534663601120 144940087464480 471714103310688 1130798979186912 2688948041357088 6050151708497568 13613157922639968 35513546724070632 74727605255142168 162658586225561832 353930992506879768 642678347124409032 1125102611548462968 1977286128289819992 3415126495450394808 diff --git a/Task/Aliquot-sequence-classifications/Java/aliquot-sequence-classifications.java b/Task/Aliquot-sequence-classifications/Java/aliquot-sequence-classifications.java new file mode 100644 index 0000000000..e4de90244e --- /dev/null +++ b/Task/Aliquot-sequence-classifications/Java/aliquot-sequence-classifications.java @@ -0,0 +1,62 @@ +import java.util.*; +import java.util.stream.LongStream; +import static java.util.stream.LongStream.rangeClosed; + +public class AliquotSequenceClassifications { + + public static Long properDivsSum(long n) { + return rangeClosed(1, (n + 1) / 2).filter(i -> n % i == 0 && n != i).sum(); + } + + static boolean aliquot(long n, int maxLen, long maxTerm) { + List s = new ArrayList<>(maxLen); + s.add(n); + long newN = n; + + while (s.size() <= maxLen && newN < maxTerm) { + + newN = properDivsSum(s.get(s.size() - 1)); + + if (s.contains(newN)) { + + if (s.get(0) == newN) { + + switch (s.size()) { + case 1: + return report("Perfect", s); + case 2: + return report("Amicable", s); + default: + return report("Sociable of length " + s.size(), s); + } + + } else if (s.get(s.size() - 1) == newN) { + return report("Aspiring", s); + + } else + return report("Cyclic back to " + newN, s); + + } else { + s.add(newN); + if (newN == 0) + return report("Terminating", s); + } + } + + return report("Non-terminating", s); + } + + static boolean report(String msg, List result) { + System.out.println(msg + ": " + result); + return false; + } + + public static void main(String[] args) { + long[] arr = {11L, 12, 28, 496, 220, 1184, 12496, 1264460, + 790, 909, 562, 1064, 1488}; + + LongStream.rangeClosed(1, 10).forEach(n -> aliquot(n, 16, 1L << 47)); + System.out.println(); + Arrays.stream(arr).forEach(n -> aliquot(n, 16, 1L << 47)); + } +} diff --git a/Task/Aliquot-sequence-classifications/Liberty-BASIC/aliquot-sequence-classifications.liberty b/Task/Aliquot-sequence-classifications/Liberty-BASIC/aliquot-sequence-classifications.liberty new file mode 100644 index 0000000000..3205cbcffa --- /dev/null +++ b/Task/Aliquot-sequence-classifications/Liberty-BASIC/aliquot-sequence-classifications.liberty @@ -0,0 +1,44 @@ +print "ROSETTA CODE - Aliquot sequence classifications" +[Start] +input "Enter an integer: "; K +K=abs(int(K)): if K=0 then goto [Quit] +call PrintAS K +goto [Start] + +[Quit] +print "Program complete." +end + +sub PrintAS K + Length=52 + dim Aseq(Length) + n=K: class=0 + for element=2 to Length + Aseq(element)=PDtotal(n) + print Aseq(element); " "; + select case + case Aseq(element)=0 + print " terminating": class=1: exit for + case Aseq(element)=K and element=2 + print " perfect": class=2: exit for + case Aseq(element)=K and element=3 + print " amicable": class=3: exit for + case Aseq(element)=K and element>3 + print " sociable": class=4: exit for + case Aseq(element)<>K and Aseq(element-1)=Aseq(element) + print " aspiring": class=5: exit for + case Aseq(element)<>K and Aseq(element-2)= Aseq(element) + print " cyclic": class=6: exit for + end select + n=Aseq(element) + if n>priorn then priorn=n: inc=inc+1 else inc=0: priorn=0 + if inc=11 or n>30000000 then exit for + next element + if class=0 then print " non-terminating" +end sub + +function PDtotal(n) + for y=2 to n + if (n mod y)=0 then PDtotal=PDtotal+(n/y) + next +end function diff --git a/Task/Aliquot-sequence-classifications/Perl-6/aliquot-sequence-classifications.pl6 b/Task/Aliquot-sequence-classifications/Perl-6/aliquot-sequence-classifications.pl6 index 1505c05114..b38aea8768 100644 --- a/Task/Aliquot-sequence-classifications/Perl-6/aliquot-sequence-classifications.pl6 +++ b/Task/Aliquot-sequence-classifications/Perl-6/aliquot-sequence-classifications.pl6 @@ -1,8 +1,9 @@ sub propdivsum (\x) { - [+] x > 1, gather for 2 .. x.sqrt.floor -> \d { + my @l = x > 1, gather for 2 .. x.sqrt.floor -> \d { my \y = x div d; if y * d == x { take d; take y unless y == d } } + [+] gather @l.deepmap(*.take); } multi quality (0,1) { 'perfect ' } diff --git a/Task/Aliquot-sequence-classifications/PowerShell/aliquot-sequence-classifications-1.psh b/Task/Aliquot-sequence-classifications/PowerShell/aliquot-sequence-classifications-1.psh new file mode 100644 index 0000000000..1ffa188a7b --- /dev/null +++ b/Task/Aliquot-sequence-classifications/PowerShell/aliquot-sequence-classifications-1.psh @@ -0,0 +1,34 @@ +function Get-NextAliquot ( [int]$X ) + { + If ( $X -gt 1 ) + { + $NextAliquot = 0 + (1..($X/2)).Where{ $x % $_ -eq 0 }.ForEach{ $NextAliquot += $_ }.Where{ $_ } + return $NextAliquot + } + } + +function Get-AliquotSequence ( [int]$K, [int]$N ) + { + $X = $K + $X + (1..($N-1)).ForEach{ $X = Get-NextAliquot $X; $X } + } + +function Classify-AlliquotSequence ( [int[]]$Sequence ) + { + $K = $Sequence[0] + $LastN = $Sequence.Count + If ( $Sequence[-1] -eq 0 ) { return "terminating" } + If ( $Sequence[-1] -eq 1 ) { return "terminating" } + If ( $Sequence[1] -eq $K ) { return "perfect" } + If ( $Sequence[2] -eq $K ) { return "amicable" } + If ( $Sequence[3..($Sequence.Count-1)] -contains $K ) { return "sociable" } + If ( $Sequence[-1] -eq $Sequence[-2] ) { return "aspiring" } + If ( $Sequence.Count -gt ( $Sequence | Select -Unique ).Count ) { return "cyclic" } + return "non-terminating and non-repeating through N = $($Sequence.Count)" + } + +(1..10).ForEach{ [string]$_ + " is " + ( Classify-AlliquotSequence -Sequence ( Get-AliquotSequence -K $_ -N 16 ) ) } + +( 11, 12, 28, 496, 220, 1184, 790, 909, 562, 1064, 1488 ).ForEach{ [string]$_ + " is " + ( Classify-AlliquotSequence -Sequence ( Get-AliquotSequence -K $_ -N 16 ) ) } diff --git a/Task/Aliquot-sequence-classifications/PowerShell/aliquot-sequence-classifications-2.psh b/Task/Aliquot-sequence-classifications/PowerShell/aliquot-sequence-classifications-2.psh new file mode 100644 index 0000000000..33b3d4fa4f --- /dev/null +++ b/Task/Aliquot-sequence-classifications/PowerShell/aliquot-sequence-classifications-2.psh @@ -0,0 +1,63 @@ +function Get-NextAliquot ( [int]$X ) + { + If ( $X -gt 1 ) + { + $NextAliquot = 1 + If ( $X -gt 2 ) + { + $XSquareRoot = [math]::Sqrt( $X ) + + (2..$XSquareRoot).Where{ $X % $_ -eq 0 }.ForEach{ $NextAliquot += $_ + $x / $_ } + + If ( $XSquareRoot % 1 -eq 0 ) { $NextAliquot -= $XSquareRoot } + } + return $NextAliquot + } + } + +function Get-AliquotSequence ( [int]$K, [int]$N ) + { + $X = $K + $X + $i = 1 + While ( $X -and $i -lt $N ) + { + $i++ + $Next = Get-NextAliquot $X + If ( $Next ) + { + If ( $X -eq $Next ) + { + ($i..$N).ForEach{ $X } + $i = $N + } + Else + { + $X = $Next + $X + } + } + Else + { + $i = $N + } + } + } + +function Classify-AlliquotSequence ( [int[]]$Sequence ) + { + $K = $Sequence[0] + $LastN = $Sequence.Count + If ( $Sequence[-1] -eq 0 ) { return "terminating" } + If ( $Sequence[-1] -eq 1 ) { return "terminating" } + If ( $Sequence[1] -eq $K ) { return "perfect" } + If ( $Sequence[2] -eq $K ) { return "amicable" } + If ( $Sequence[3..($Sequence.Count-1)] -contains $K ) { return "sociable" } + If ( $Sequence[-1] -eq $Sequence[-2] ) { return "aspiring" } + If ( $Sequence.Count -gt ( $Sequence | Select -Unique ).Count ) { return "cyclic" } + return "non-terminating and non-repeating through N = $($Sequence.Count)" + } + +(1..10).ForEach{ [string]$_ + " is " + ( Classify-AlliquotSequence -Sequence ( Get-AliquotSequence -K $_ -N 16 ) ) } + +( 11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488 ).ForEach{ [string]$_ + " is " + ( Classify-AlliquotSequence -Sequence ( Get-AliquotSequence -K $_ -N 16 ) ) } diff --git a/Task/Aliquot-sequence-classifications/REXX/aliquot-sequence-classifications.rexx b/Task/Aliquot-sequence-classifications/REXX/aliquot-sequence-classifications.rexx index 0a9274b5e1..c9f0587483 100644 --- a/Task/Aliquot-sequence-classifications/REXX/aliquot-sequence-classifications.rexx +++ b/Task/Aliquot-sequence-classifications/REXX/aliquot-sequence-classifications.rexx @@ -1,63 +1,63 @@ -/*REXX program classifies various positive integers for aliquot sequences. */ -parse arg low high L /*get some optional arguments.*/ -high=word(high low 10,1); low=word(low 1,1) /*get the LOW and HIGH. */ +/*REXX program classifies various positive integers for types of aliquot sequences. */ +parse arg low high L /*obtain optional arguments from the CL*/ +high=word(high low 10,1); low=word(low 1,1) /*obtain the LOW and HIGH (range). */ if L='' then L=11 12 28 496 220 1184 12496 1264460 790 909 562 1064 1488 15355717786080 -big=2**47; NTlimit=16+1 /*seq. non─terminating limit. */ -numeric digits max(9, 1+length(big)) /*be able to handle // oper.*/ -#.=.; #.0=0; #.1=0 /*#. are proper divisor sums.*/ -say center('numbers from ' low " to " high, 79, "═") +big=2**47; NTlimit=16+1 /*limit for a non─terminating sequence.*/ +numeric digits max(9, 1+length(big)) /*be able to handle big numbers for // */ +#.=.; #.0=0; #.1=0 /*#. are the proper divisor sums. */ +say center('numbers from ' low " to " high, 79, "═") - do n=low to high /*process (probably) some low numbers. */ - call classify_aliquot n /*call a subroutine to classify number.*/ - end /*n*/ /* [↑] process a range of integers. */ + do n=low to high /*process (probably) some low numbers. */ + call classify n /*call a subroutine to classify number.*/ + end /*n*/ /* [↑] process a range of integers. */ say say center('first numbers for each classification', 79, "═") -b.=0 /* [↓] ensure one number of each class*/ - do q=1 until b.sociable \== 0 /*the only one that has to be counted. */ - call classify_aliquot -q /*the minus (-) sign indicates ¬ tell. */ - _=what; upper _; b._=b._+1 /*bump the counter for this seq. class.*/ - if b._==1 then call show_class q,$ /*show the first occurrence only.*/ - end /*q*/ /* [↑] process until all classes found*/ +class.=0 /* [↓] ensure one number of each class*/ + do q=1 until class.sociable\==0 /*the only one that has to be counted. */ + call classify -q /*the minus (-) sign indicates ¬ tell. */ + _=what; upper _; class._=class._+1 /*bump counter for this class sequence.*/ + if class._==1 then call show_class q,$ /*only display the first occurrence. */ + end /*q*/ /* [↑] process until all classes found*/ say say center('classifications for specific numbers', 79, "═") - do i=1 for words(L) /*L is a list of "special numbers". */ - call classify_aliquot word(L,i) /*call a subroutine to classify number.*/ - end /*i*/ /* [↑] process a list of integers. */ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -classify_aliquot: parse arg a 1 aa; a=abs(a) /*get what number is to be used.*/ -if #.a\==. then s=#.a /*Was this number been summed before? */ - else s=sigma(a) /*No, then classify number the hard way*/ -#.a=s; $=s /*define sum of the proper divisors. */ -what='terminating' /*assume this kind of classification. */ -c.=0; c.s=1 /*clear all cyclic sequences; set 1st.*/ -if $==a then what='perfect' /*check for a "perfect" number. */ - else do t=1 while s\==0 /*loop until sum isn't 0 or > big.*/ - m=word($, words($)) /*obtain the last number in sequence. */ - if #.m==. then s=sigma(m) /*if not defined, then sum proper divs.*/ - else s=#.m /*use the previously found integer. */ - if m==s & m\==0 then do; what='aspiring' ; leave; end - if word($,2)==a then do; what='amicable' ; leave; end - $=$ s /*append a sum to the integer sequence.*/ - if s==a & t>3 then do; what='sociable' ; leave; end - if c.s & m\==0 then do; what='cyclic' ; leave; end - c.s=1 /*assign another possible cyclic number*/ - /* [↓] Rosetta Code task's limit: >16 */ - if t>NTlimit then do; what='non-terminating'; leave; end - if s>big then do; what='NON-TERMINATING'; leave; end - end /*t*/ /* [↑] only permit within reason. */ -if aa>0 then call show_class a,$ /*only display if A is positive. */ -return -/*────────────────────────────────────────────────────────────────────────────*/ -show_class: say right(arg(1),digits()) 'is' center(what,15) arg(2); return -/*────────────────────────────────────────────────────────────────────────────*/ -sigma: procedure expose #.; parse arg x; if x<2 then return 0; odd=x//2 -s=1 /* [↓] use only EVEN|ODD ints. ___*/ - do j=2+odd by 1+odd while j*j big.*/ + m=word($, words($)) /*obtain the last number in sequence. */ + if #.m==. then s=sigma(m) /*Not defined? Then sum proper divisors*/ + else s=#.m /*use the previously found integer. */ + if m==s & m\==0 then do; what='aspiring' ; leave; end + if word($,2)==a then do; what='amicable' ; leave; end + $=$ s /*append a sum to the integer sequence.*/ + if s==a & t>3 then do; what='sociable' ; leave; end + if c.s & m\==0 then do; what='cyclic' ; leave; end + c.s=1 /*assign another possible cyclic number*/ + /* [↓] Rosetta Code task's limit: >16 */ + if t>NTlimit then do; what='non-terminating'; leave; end + if s>big then do; what='NON-TERMINATING'; leave; end + end /*t*/ /* [↑] only permit within reason. */ + if aa>0 then call show_class a,$ /*only display if A is positive. */ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +show_class: say right(arg(1),digits()) 'is' center(what,15) arg(2); return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sigma: procedure expose #.; parse arg x; if x<2 then return 0; odd=x//2 + s=1 /* [↓] use only EVEN | ODD ints. ___*/ + do j=2+odd by 1+odd while j*j0 THEN GO SUB 2000: PRINT k;" ";s$: GO TO 20 +40 STOP +1000 REM sumprop +1010 IF oldk=1 THEN LET newk=0: RETURN +1020 LET sum=1 +1030 LET root=SQR oldk +1040 FOR i=2 TO root-0.1 +1050 IF oldk/i=INT (oldk/i) THEN LET sum=sum+i+oldk/i +1060 NEXT i +1070 IF oldk/root=INT (oldk/root) THEN LET sum=sum+root +1080 LET newk=sum +1090 RETURN +2000 REM class +2010 LET oldk=k: LET s$=" " +2020 GO SUB 1000 +2030 LET oldk=newk +2040 LET s$=s$+" "+STR$ newk +2050 IF newk=0 THEN LET s$="terminating"+s$: RETURN +2060 IF newk=k THEN LET s$="perfect"+s$: RETURN +2070 GO SUB 1000 +2080 LET oldk=newk +2090 LET s$=s$+" "+STR$ newk +2100 IF newk=0 THEN LET s$="terminating"+s$: RETURN +2110 IF newk=k THEN LET s$="amicable"+s$: RETURN +2120 FOR t=4 TO 16 +2130 GO SUB 1000 +2140 LET s$=s$+" "+STR$ newk +2150 IF newk=0 THEN LET s$="terminating"+s$: RETURN +2160 IF newk=k THEN LET s$="sociable (period "+STR$ (t-1)+")"+s$: RETURN +2170 IF newk=oldk THEN LET s$="aspiring"+s$: RETURN +2180 LET b$=" "+STR$ newk+" ": LET ls=LEN s$: LET lb=LEN b$: LET ls=ls-lb +2190 FOR i=1 TO ls +2200 IF s$(i TO i+lb-1)=b$ THEN LET s$="cyclic (at "+STR$ newk+") "+s$: LET i=ls +2210 NEXT i +2220 IF LEN s$<>(ls+lb) THEN RETURN +2300 IF newk>140737488355328 THEN LET s$="non-terminating (term > 140737488355328)"+s$: RETURN +2310 LET oldk=newk +2320 NEXT t +2330 LET s$="non-terminating (after 16 terms)"+s$ +2340 RETURN diff --git a/Task/Almost-prime/00DESCRIPTION b/Task/Almost-prime/00DESCRIPTION index b48de6f50a..aaa9393c62 100644 --- a/Task/Almost-prime/00DESCRIPTION +++ b/Task/Almost-prime/00DESCRIPTION @@ -1,8 +1,16 @@ -A [[wp:Almost prime|k-Almost-prime]] is a natural number n that is the product of k (possibly identical) primes. -So, for example, 1-almost-primes, where k=1, are the prime numbers themselves; 2-almost-primes are the [[Semiprime|semiprimes]]. +A   [[wp:Almost prime|k-Almost-prime]]   is a natural number   n   that is the product of   k   (possibly identical) primes. -The task is to write a function/method/subroutine/... that generates k-almost primes and use it to create a table here of the first ten members of k-Almost primes for 1 <= K <= 5. -;Cf. -* [[Semiprime]] -* [[:Category:Prime Numbers]] +;Example: +1-almost-primes,   where   k=1,   are the prime numbers themselves. +
2-almost-primes,   where   k=2,   are the   [[Semiprime|semiprimes]]. + + +;Task: +Write a function/method/subroutine/... that generates k-almost primes and use it to create a table here of the first ten members of k-Almost primes for   1 <= K <= 5. + + +;Related tasks: +*   [[Semiprime]] +*   [[:Category:Prime Numbers]] +

diff --git a/Task/Almost-prime/AWK/almost-prime.awk b/Task/Almost-prime/AWK/almost-prime.awk new file mode 100644 index 0000000000..bfba392ca0 --- /dev/null +++ b/Task/Almost-prime/AWK/almost-prime.awk @@ -0,0 +1,25 @@ +# syntax: GAWK -f ALMOST_PRIME.AWK +BEGIN { + for (k=1; k<=5; k++) { + printf("%d:",k) + c = 0 + i = 1 + while (c < 10) { + if (kprime(++i,k)) { + printf(" %d",i) + c++ + } + } + printf("\n") + } + exit(0) +} +function kprime(n,k, f,p) { + for (p=2; f 1) == k) +} diff --git a/Task/Almost-prime/C++/almost-prime.cpp b/Task/Almost-prime/C++/almost-prime.cpp new file mode 100644 index 0000000000..76f0309789 --- /dev/null +++ b/Task/Almost-prime/C++/almost-prime.cpp @@ -0,0 +1,32 @@ +#include +#include +#include +#include +#include + +bool k_prime(unsigned n, unsigned k) { + unsigned f = 0; + for (unsigned p = 2; f < k && p * p <= n; p++) + while (0 == n % p) { n /= p; f++; } + return f + (n > 1 ? 1 : 0) == k; +} + +std::list primes(unsigned k, unsigned n) { + std::list list; + for (unsigned i = 2;list.size() < n;i++) + if (k_prime(i, k)) list.push_back(i); + return list; +} + +int main(const int argc, const char* argv[]) { + using namespace std; + for (unsigned k = 1; k <= 5; k++) { + ostringstream os(""); + const list l = primes(k, 10); + for (list::const_iterator i = l.begin(); i != l.end(); i++) + os << setw(4) << *i; + cout << "k = " << k << ':' << os.str() << endl; + } + + return EXIT_SUCCESS; +} diff --git a/Task/Almost-prime/Clojure/almost-prime.clj b/Task/Almost-prime/Clojure/almost-prime.clj new file mode 100644 index 0000000000..c35a61bd6b --- /dev/null +++ b/Task/Almost-prime/Clojure/almost-prime.clj @@ -0,0 +1,23 @@ +(ns clojure.examples.almostprime + (:gen-class)) + +(defn divisors [n] + " Finds divisors by looping through integers 2, 3,...i.. up to sqrt (n) [note: rather than compute sqrt(), test with i*i <=n] " + (let [div (some #(if (= 0 (mod n %)) % nil) (take-while #(<= (* % %) n) (iterate inc 2)))] + (if div ; div = nil (if no divisor found else its the divisor) + (into [] (concat (divisors div) (divisors (/ n div)))) ; Concat the two divisors of the two divisors + [n]))) ; Number is prime so only itself as a divisor + +(defn divisors-k [k n] + " Finds n numbers with k divisors. Does this by looping through integers 2, 3, ... filtering (passing) ones with k divisors and + taking the first n " + (->> (iterate inc 2) ; infinite sequence of numbers starting at 2 + (map divisors) ; compute divisor of each element of sequence + (filter #(= (count %) k)) ; filter to take only elements with k divisors + (take n) ; take n elements from filtered sequence + (map #(apply * %)))) ; compute number by taking product of divisors + +(println (for [k (range 1 6)] + (println "k:" k (divisors-k k 10)))) + +} diff --git a/Task/Almost-prime/Kotlin/almost-prime.kotlin b/Task/Almost-prime/Kotlin/almost-prime.kotlin new file mode 100644 index 0000000000..0da7e9a380 --- /dev/null +++ b/Task/Almost-prime/Kotlin/almost-prime.kotlin @@ -0,0 +1,25 @@ +fun Int.k_prime(x: Int): Boolean { + var n = x + var f = 0 + var p = 2 + while (f < this && p * p <= n) { + while (0 == n % p) { n /= p; f++ } + p++ + } + return f + (if (n > 1) 1 else 0) == this +} + +fun Int.primes(n : Int) : List { + var i = 2 + var list = listOf() + while (list.size < n) { + if (k_prime(i)) list += i + i++ + } + return list +} + +fun main(args: Array) { + for (k in 1..5) + println("k = $k: " + k.primes(10)) +} diff --git a/Task/Almost-prime/Lua/almost-prime.lua b/Task/Almost-prime/Lua/almost-prime.lua new file mode 100644 index 0000000000..bb818d812d --- /dev/null +++ b/Task/Almost-prime/Lua/almost-prime.lua @@ -0,0 +1,34 @@ +-- Returns boolean indicating whether n is k-almost prime +function almostPrime (n, k) + local divisor, count = 2, 0 + while count < k + 1 and n ~= 1 do + if n % divisor == 0 then + n = n / divisor + count = count + 1 + else + divisor = divisor + 1 + end + end + return count == k +end + +-- Generates table containing first ten k-almost primes for given k +function kList (k) + local n, kTab = 2^k, {} + while #kTab < 10 do + if almostPrime(n, k) then + table.insert(kTab, n) + end + n = n + 1 + end + return kTab +end + +-- Main procedure, displays results from five calls to kList() +for k = 1, 5 do + io.write("k=" .. k .. ": ") + for _, v in pairs(kList(k)) do + io.write(v .. ", ") + end + print("...") +end diff --git a/Task/Almost-prime/Perl-6/almost-prime-1.pl6 b/Task/Almost-prime/Perl-6/almost-prime-1.pl6 index 19356e9e56..84ba4caf40 100644 --- a/Task/Almost-prime/Perl-6/almost-prime-1.pl6 +++ b/Task/Almost-prime/Perl-6/almost-prime-1.pl6 @@ -6,6 +6,6 @@ sub is-k-almost-prime($n is copy, $k) returns Bool { } for 1 .. 5 -> $k { - say .[^10] + say ~.[^10] given grep { is-k-almost-prime($_, $k) }, 2 .. * } diff --git a/Task/Almost-prime/Perl-6/almost-prime-2.pl6 b/Task/Almost-prime/Perl-6/almost-prime-2.pl6 index 56165db9a0..d3858e3b80 100644 --- a/Task/Almost-prime/Perl-6/almost-prime-2.pl6 +++ b/Task/Almost-prime/Perl-6/almost-prime-2.pl6 @@ -1,5 +1,23 @@ -constant factory = 0..* Z=> (0, 0, map { +factors($_) }, 2..*); +constant @primes = 2, |(3, 5, 7 ... *).grep: *.is-prime; -sub almost($n) { map *.key, grep *.value == $n, factory } +multi sub factors(1) { 1 } +multi sub factors(Int $remainder is copy) { + gather for @primes -> $factor { + # if remainder < factor², we're done + if $factor * $factor > $remainder { + take $remainder if $remainder > 1; + last; + } + # How many times can we divide by this prime? + while $remainder %% $factor { + take $factor; + last if ($remainder div= $factor) === 1; + } + } +} -say almost($_)[^10] for 1..5; +constant @factory = lazy 0..* Z=> flat (0, 0, map { +factors($_) }, 2..*); + +sub almost($n) { map *.key, grep *.value == $n, @factory } + +put almost($_)[^10] for 1..5; diff --git a/Task/Almost-prime/R/almost-prime.r b/Task/Almost-prime/R/almost-prime.r new file mode 100644 index 0000000000..93c4426701 --- /dev/null +++ b/Task/Almost-prime/R/almost-prime.r @@ -0,0 +1,49 @@ +#=============================================================== +# Find k-Almost-primes +# R implementation +#=============================================================== +#--------------------------------------------------------------- +# Function for prime factorization from Rosetta Code +#--------------------------------------------------------------- + +findfactors <- function(n) { + d <- c() + div <- 2; nxt <- 3; rest <- n + while( rest != 1 ) { + while( rest%%div == 0 ) { + d <- c(d, div) + rest <- floor(rest / div) + } + div <- nxt + nxt <- nxt + 2 + } + d +} + +#--------------------------------------------------------------- +# Find k-Almost-primes +#--------------------------------------------------------------- + +almost_primes <- function(n = 10, k = 5) { + + # Set up matrix for storing of the results + + res <- matrix(NA, nrow = k, ncol = n) + rownames(res) <- paste("k = ", 1:k, sep = "") + colnames(res) <- rep("", n) + + # Loop over k + + for (i in 1:k) { + + tmp <- 1 + + while (any(is.na(res[i, ]))) { # Keep looping if there are still missing entries in the result-matrix + if (length(findfactors(tmp)) == i) { # Check number of factors + res[i, which.max(is.na(res[i, ]))] <- tmp + } + tmp <- tmp + 1 + } + } + print(res) +} diff --git a/Task/Almost-prime/REXX/almost-prime.rexx b/Task/Almost-prime/REXX/almost-prime.rexx index f3c43280a4..92dc76fe97 100644 --- a/Task/Almost-prime/REXX/almost-prime.rexx +++ b/Task/Almost-prime/REXX/almost-prime.rexx @@ -1,28 +1,32 @@ -/*REXX program computes & displays N numbers of the first K k─almost primes.*/ -parse arg N K . /*get optional arguments from the C.L. */ -if N=='' then N=10 /*N not specified? Then use default.*/ -if K=='' then K= 5; w=length(k) /*K " " " " " */ - /*W: is the width of K, used for output*/ - do m=1 for K; $=2**m; fir=$ /*generate & assign 1st k─almost prime.*/ - #=1; if #==N then leave /*#: k─almost primes; Enough are found?*/ - #=2; $=$ 3*(2**(m-1)) /*generate & append 2nd k─almost prime.*/ - do j=fir+fir+1 until #==N /*process an almost-prime N times.*/ - if #factr(j)\==m then iterate /*not the correct k─almost prime? */ - #=#+1; $=$ j /*bump K─almost counter; append it to $*/ - end /*j*/ /* [↑] generate N k─almost primes.*/ - say right(m,w)"─almost ("N') primes:' $ /*displays " " " " */ - end /*m*/ /* [↑] display a line for each K-prime*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -#factr: procedure; parse arg x 1 z /*defines X and Z to the argument. */ - do f=0 while z//2==0; z=z%2; end /*÷ by 2s.*/ - do f=f while z//3==0; z=z%3; end /*÷ " 3s.*/ - do f=f while z//5==0; z=z%5; end /*÷ " 5s.*/ -j=5 - do y=0 by 2; j=j+2+y//4 /*insure J isn't divisible by three. */ - parse var j '' -1 _ /*obtain the right─most decimal digit. */ - if _==5 then iterate /*fast check for divisible by five. */ - if j>z then leave /*is number reduced to the smallest # ?*/ - do f=f+1 while z//j==0; z=z%j; end; f=f-1 /*÷ by Js.*/ - end /*y*/ /* [↑] find all the factors in X. */ -return max(f,1) /*if prime (f==0), then return 1. */ +/*REXX program computes and displays the first N K─almost primes from 1 ── ►K. */ +parse arg N K . /*get optional arguments from the C.L. */ +if N=='' | N=="," then N=10 /*N not specified? Then use default.*/ +if K=='' | K=="," then K= 5 /*K " " " " " */ + /*W: is the width of K, used for output*/ + do m=1 for K; $=2**m; fir=$ /*generate & assign 1st K─almost prime.*/ + #=1; if #==N then leave /*#: K─almost primes; Enough are found?*/ + #=2; $=$ 3*(2**(m-1)) /*generate & append 2nd K─almost prime.*/ + if #==N then leave /*#: K─almost primes; Enough are found?*/ + if m==1 then _=fir+fir /* [↓] gen & append 3rd K─almost prime*/ + else do; _=9*(2**(m-2)); #=3; $=$ _; end + do j=_+m-1 until #==N /*process an K─almost prime N times.*/ + if #factr()\==m then iterate /*not the correct K─almost prime? */ + #=#+1; $=$ j /*bump K─almost counter; append it to $*/ + end /*j*/ /* [↑] generate N K─almost primes.*/ + say right(m, length(K))"─almost ("N') primes:' $ + end /*m*/ /* [↑] display a line for each K─prime*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +#factr: z=j; do f=0 while z//2==0; z=z%2; end /*divisible by 2. */ + do f=f while z//3==0; z=z%3; end /*divisible " 3. */ + do f=f while z//5==0; z=z%5; end /*divisible " 5. */ + do f=f while z//7==0; z=z%7; end /*divisible " 7. */ + do i=11 by 6 while i<=z /*insure I isn't divisible by three. */ + parse var i '' -1 _ /*obtain the right─most decimal digit. */ + /* [↓] fast check for divisible by 5. */ + if _\==5 then do; do f=f+1 while z//i==0; z=z%i; end; f=f-1; end /*divisible by I. */ + if _==3 then iterate /*fast check for X divisible by five.*/ + x=i+2; do f=f+1 while z//x==0; z=z%x; end; f=f-1 /*divisible by X. */ + end /*i*/ /* [↑] find all the factors in Z. */ + +return max(f, 1) /*if prime (f==0), then return unity.*/ diff --git a/Task/Almost-prime/ZX-Spectrum-Basic/almost-prime.zx b/Task/Almost-prime/ZX-Spectrum-Basic/almost-prime.zx new file mode 100644 index 0000000000..a65f0a4065 --- /dev/null +++ b/Task/Almost-prime/ZX-Spectrum-Basic/almost-prime.zx @@ -0,0 +1,18 @@ +10 FOR k=1 TO 5 +20 PRINT k;":"; +30 LET c=0: LET i=1 +40 IF c=10 THEN GO TO 100 +50 LET i=i+1 +60 GO SUB 1000 +70 IF r THEN PRINT " ";i;: LET c=c+1 +90 GO TO 40 +100 PRINT +110 NEXT k +120 STOP +1000 REM kprime +1010 LET p=2: LET n=i: LET f=0 +1020 IF f=k OR (p*p)>n THEN GO TO 1100 +1030 IF n/p=INT (n/p) THEN LET n=n/p: LET f=f+1: GO TO 1030 +1040 LET p=p+1: GO TO 1020 +1100 LET r=(f+(n>1)=k) +1110 RETURN diff --git a/Task/Amb/Perl-6/amb-1.pl6 b/Task/Amb/Perl-6/amb-1.pl6 index d62d77b93d..d7961a5a0e 100644 --- a/Task/Amb/Perl-6/amb-1.pl6 +++ b/Task/Amb/Perl-6/amb-1.pl6 @@ -1,18 +1,18 @@ -sub infix: ($a,$b) { - next unless try $a.substr(*-1,1) eq $b.substr(0,1); - "$a $b"; +#| an array of four words, that have more possible values. +#| Normally we would want `any' to signify we want any of the values, but well negate later and thus we need `all' +my @a = +(all «the that a»), +(all «frog elephant thing»), +(all «walked treaded grows»), +(all «slowly quickly»); + +sub test (Str $l, Str $r) { + $l.ends-with($r.substr(0,1)) } -multi dethunk(Callable $x) { try take $x() } -multi dethunk( Any $x) { take $x } - -sub amb (*@c) { gather @c».&dethunk } - -say first *, do - amb(, { die 'oops'}) Xlf - amb('frog',{'elephant'},'thing') Xlf - amb() Xlf - amb { die 'poison dart' }, - {'slowly'}, - {'quickly'}, - { die 'fire' }; +(sub ($w1, $w2, $w3, $w4){ + # return if the values are false + return unless [and] test($w1, $w2), test($w2, $w3),test($w3, $w4); + # say the results. If there is one more Container layer around them this doesn't work, this is why we need the arguments here. + say "$w1 $w2 $w3 $w4" +})(|@a); # supply the array as argumetns diff --git a/Task/Amb/Perl-6/amb-2.pl6 b/Task/Amb/Perl-6/amb-2.pl6 index 16c2c2dd70..d62d77b93d 100644 --- a/Task/Amb/Perl-6/amb-2.pl6 +++ b/Task/Amb/Perl-6/amb-2.pl6 @@ -1,22 +1,18 @@ -sub amb($var,*@a) { - "[{ - @a.pick(*).map: {"||\{ $var = '$_' }"} - }]"; +sub infix: ($a,$b) { + next unless try $a.substr(*-1,1) eq $b.substr(0,1); + "$a $b"; } -sub joins ($word1, $word2) { - substr($word1,*-1,1) eq substr($word2,0,1) -} +multi dethunk(Callable $x) { try take $x() } +multi dethunk( Any $x) { take $x } -'' ~~ m/ - :my ($a,$b,$c,$d); - <{ amb '$a', }> - <{ amb '$b', }> - - <{ amb '$c', }> - - <{ amb '$d', }> - - { say "$a $b $c $d" } - -/; +sub amb (*@c) { gather @c».&dethunk } + +say first *, do + amb(, { die 'oops'}) Xlf + amb('frog',{'elephant'},'thing') Xlf + amb() Xlf + amb { die 'poison dart' }, + {'slowly'}, + {'quickly'}, + { die 'fire' }; diff --git a/Task/Amb/Perl-6/amb-3.pl6 b/Task/Amb/Perl-6/amb-3.pl6 new file mode 100644 index 0000000000..16c2c2dd70 --- /dev/null +++ b/Task/Amb/Perl-6/amb-3.pl6 @@ -0,0 +1,22 @@ +sub amb($var,*@a) { + "[{ + @a.pick(*).map: {"||\{ $var = '$_' }"} + }]"; +} + +sub joins ($word1, $word2) { + substr($word1,*-1,1) eq substr($word2,0,1) +} + +'' ~~ m/ + :my ($a,$b,$c,$d); + <{ amb '$a', }> + <{ amb '$b', }> + + <{ amb '$c', }> + + <{ amb '$d', }> + + { say "$a $b $c $d" } + +/; diff --git a/Task/Amicable-pairs/00DESCRIPTION b/Task/Amicable-pairs/00DESCRIPTION index c15152bac6..38c7bb2408 100644 --- a/Task/Amicable-pairs/00DESCRIPTION +++ b/Task/Amicable-pairs/00DESCRIPTION @@ -1,11 +1,18 @@ Two integers N and M are said to be [[wp:Amicable numbers|amicable pairs]] if N \neq M and the sum of the [[Proper divisors|proper divisors]] of N (\mathrm{sum}(\mathrm{propDivs}(N))) = M as well as \mathrm{sum}(\mathrm{propDivs}(M)) = N. -For example 1184 and 1210 are an amicable pair (with proper divisors 1, 2, 4, 8, 16, 32, 37, 74, 148, 296, 592 and 1, 2, 5, 10, 11, 22, 55, 110, 121, 242, 605 respectively). + +;Example: +'''1184''' and '''1210''' are an amicable pair, with proper divisors: +*   1, 2, 4, 8, 16, 32, 37, 74, 148, 296, 592   and +*   1, 2, 5, 10, 11, 22, 55, 110, 121, 242, 605   respectively. + ;Task: Calculate and show here the Amicable pairs below 20,000; (there are eight). -;Cf. + +;Related tasks * [[Proper divisors]] * [[Abundant, deficient and perfect number classifications]] * [[Aliquot sequence classifications]] and its amicable ''classification''. +

diff --git a/Task/Amicable-pairs/ALGOL-68/amicable-pairs.alg b/Task/Amicable-pairs/ALGOL-68/amicable-pairs.alg new file mode 100644 index 0000000000..11f5cffa1c --- /dev/null +++ b/Task/Amicable-pairs/ALGOL-68/amicable-pairs.alg @@ -0,0 +1,43 @@ +# resturns the sum of the proper divisors of n # +# if n = 1, 0 or -1, we return 0 # +PROC sum proper divisors = ( INT n )INT: + BEGIN + INT result := 0; + INT abs n = ABS n; + IF abs n > 1 THEN + FOR d FROM ENTIER sqrt( abs n ) BY -1 TO 2 DO + IF abs n MOD d = 0 THEN + # found another divisor # + result +:= d; + IF d * d /= n THEN + # include the other divisor # + result +:= n OVER d + FI + FI + OD; + # 1 is always a proper divisor of numbers > 1 # + result +:= 1 + FI; + result + END # sum proper divisors # ; + +# construct a table of the sum of the proper divisors of numbers # +# up to 20 000 # +INT max number = 20 000; +[ 1 : max number ]INT proper divisor sum; +FOR n TO UPB proper divisor sum DO proper divisor sum[ n ] := sum proper divisors( n ) OD; + +# returns TRUE if n1 and n2 are an amicable pair FALSE otherwise # +# n1 and n2 are amicable if the sum of the proper diviors # +# n1 = n2 and the sum of the proper divisors of n2 = n1 # +PROC is an amicable pair = ( INT n1, n2 )BOOL: + ( proper divisor sum[ n1 ] = n2 AND proper divisor sum[ n2 ] = n1 ); + +# find the amicable pairs up to 20 000 # +FOR p1 TO max number DO + FOR p2 FROM p1 + 1 TO max number DO + IF is an amicable pair( p1, p2 ) THEN + print( ( whole( p1, -6 ), " and ", whole( p2, -6 ), " are a amicable pair", newline ) ) + FI + OD +OD diff --git a/Task/Amicable-pairs/AppleScript/amicable-pairs-1.applescript b/Task/Amicable-pairs/AppleScript/amicable-pairs-1.applescript new file mode 100644 index 0000000000..e4e6622739 --- /dev/null +++ b/Task/Amicable-pairs/AppleScript/amicable-pairs-1.applescript @@ -0,0 +1,145 @@ +-- amicablePairsUpTo :: Int -> Int +on amicablePairsUpTo(max) + + -- amicable :: [Int] -> Int -> Int -> [Int] -> [Int] + script amicable + on lambda(lstAccumulator, m, n, lstSums) + if (m > n) and (m ≤ max) and ((item m of lstSums) = n) then + lstAccumulator & [[n, m]] + else + lstAccumulator + end if + end lambda + end script + + -- divisorsSummed :: Int -> Int + script divisorsSummed + -- sum :: Int -> Int -> Int + script sum + on lambda(a, b) + a + b + end lambda + end script + + on lambda(n) + foldl(sum, 0, properDivisors(n)) + end lambda + end script + + foldl(amicable, [], ¬ + map(divisorsSummed, range(1, max))) +end amicablePairsUpTo + + +-- TEST + +on run + + amicablePairsUpTo(20000) + +end run + + +-- PROPER DIVISORS + +-- properDivisors :: Int -> [Int] +on properDivisors(n) + + -- isFactor :: Int -> Bool + script isFactor + on lambda(x) + n mod x = 0 + end lambda + end script + + -- integerQuotient :: Int -> Int + script integerQuotient + on lambda(x) + (n / x) as integer + end lambda + end script + + if n = 1 then + {1} + else + set realRoot to n ^ (1 / 2) + set intRoot to realRoot as integer + set blnPerfectSquare to intRoot = realRoot + + -- Factors up to square root of n, + set lows to filter(isFactor, range(1, intRoot)) + + -- and quotients of these factors beyond the square root, + -- excluding n itself (last item) + items 1 thru -2 of (lows & map(integerQuotient, ¬ + items (1 + (blnPerfectSquare as integer)) thru -1 of reverse of lows)) + end if +end properDivisors + + +--------------------------------------------------------------------------- + +-- GENERIC LIBRARY FUNCTIONS + +-- 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 + +-- 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 + +-- 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 + +-- range :: Int -> Int -> [Int] +on range(m, n) + if n < m then + set d to -1 + else + set d to 1 + end if + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range + +-- 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 diff --git a/Task/Amicable-pairs/AppleScript/amicable-pairs-2.applescript b/Task/Amicable-pairs/AppleScript/amicable-pairs-2.applescript new file mode 100644 index 0000000000..cff6092df9 --- /dev/null +++ b/Task/Amicable-pairs/AppleScript/amicable-pairs-2.applescript @@ -0,0 +1,2 @@ +{{220, 284}, {1184, 1210}, {2620, 2924}, {5020, 5564}, +{6232, 6368}, {10744, 10856}, {12285, 14595}, {17296, 18416}} diff --git a/Task/Amicable-pairs/C++/amicable-pairs.cpp b/Task/Amicable-pairs/C++/amicable-pairs.cpp new file mode 100644 index 0000000000..d6874b5eab --- /dev/null +++ b/Task/Amicable-pairs/C++/amicable-pairs.cpp @@ -0,0 +1,48 @@ +#include +#include +#include + +int main() { + std::vector alreadyDiscovered; + std::unordered_map divsumMap; + int count = 0; + + for (int N = 1; N <= 20000; ++N) + { + int divSumN = 0; + + for (int i = 1; i <= N / 2; ++i) + { + if (fmod(N, i) == 0) + { + divSumN += i; + } + } + + // populate map of integers to the sum of their proper divisors + if (divSumN != 1) // do not include primes + divsumMap[N] = divSumN; + + for (std::unordered_map::iterator it = divsumMap.begin(); it != divsumMap.end(); ++it) + { + int M = it->first; + int divSumM = it->second; + int divSumN = divsumMap[N]; + + if (N != M && divSumM == N && divSumN == M) + { + // do not print duplicate pairs + if (std::find(alreadyDiscovered.begin(), alreadyDiscovered.end(), N) != alreadyDiscovered.end()) + break; + + std::cout << "[" << M << ", " << N << "]" << std::endl; + + alreadyDiscovered.push_back(M); + alreadyDiscovered.push_back(N); + count++; + } + } + } + + std::cout << count << " amicable pairs discovered" << std::endl; +} diff --git a/Task/Amicable-pairs/C-sharp/amicable-pairs.cs b/Task/Amicable-pairs/C-sharp/amicable-pairs.cs new file mode 100644 index 0000000000..deb9cacb03 --- /dev/null +++ b/Task/Amicable-pairs/C-sharp/amicable-pairs.cs @@ -0,0 +1,37 @@ +using System; +using System.Collections.Generic; +using System.Linq; + +namespace RosettaCode.AmicablePairs +{ + internal static class Program { + private const int Limit = 20000; + + private static void Main() + { + foreach (var pair in GetPairs(Limit)) + { + Console.WriteLine("{0} {1}", pair.Item1, pair.Item2); + } + } + + private static IEnumerable> GetPairs(int max) + { + List divsums = + Enumerable.Range(0, max + 1).Select(i => ProperDivisors(i).Sum()).ToList(); + for(int i=1; i(i, sum); + } + } + } + + private static IEnumerable ProperDivisors(int number) + { + return + Enumerable.Range(1, number / 2) + .Where(divisor => number % divisor == 0); + } + } +} diff --git a/Task/Amicable-pairs/Ela/amicable-pairs.ela b/Task/Amicable-pairs/Ela/amicable-pairs.ela new file mode 100644 index 0000000000..464645e74b --- /dev/null +++ b/Task/Amicable-pairs/Ela/amicable-pairs.ela @@ -0,0 +1,8 @@ +open monad io number list + +divisors n = filter ((0 ==) << (n `mod`)) [1..(n `div` 2)] +range = [1 .. 20000] +divs = zip range $ map (sum << divisors) range +pairs = [(n, m) \\ (n, nd) <- divs, (m, md) <- divs | n < m && nd == m && md == n] + +do putLn pairs ::: IO diff --git a/Task/Amicable-pairs/Elixir/amicable-pairs.elixir b/Task/Amicable-pairs/Elixir/amicable-pairs.elixir new file mode 100644 index 0000000000..2abea4c098 --- /dev/null +++ b/Task/Amicable-pairs/Elixir/amicable-pairs.elixir @@ -0,0 +1,14 @@ +defmodule Proper do + def divisors(1), do: [] + def divisors(n), do: [1 | divisors(2,n,:math.sqrt(n))] |> Enum.sort + + defp divisors(k,_n,q) when k>q, do: [] + defp divisors(k,n,q) when rem(n,k)>0, do: divisors(k+1,n,q) + defp divisors(k,n,q) when k * k == n, do: [k | divisors(k+1,n,q)] + defp divisors(k,n,q) , do: [k,div(n,k) | divisors(k+1,n,q)] +end + +map = Enum.into(1..20000, %{}, fn n -> {n, Proper.divisors(n) |> Enum.sum} end) +Enum.filter(map, fn {n,sum} -> map[sum] == n and n < sum end) +|> Enum.sort +|> Enum.each(fn {i,j} -> IO.puts "#{i} and #{j}" end) diff --git a/Task/Amicable-pairs/Java/amicable-pairs.java b/Task/Amicable-pairs/Java/amicable-pairs.java new file mode 100644 index 0000000000..e20197426e --- /dev/null +++ b/Task/Amicable-pairs/Java/amicable-pairs.java @@ -0,0 +1,27 @@ +import java.util.Map; +import static java.util.function.Function.*; +import static java.util.stream.Collectors.*; +import static java.util.stream.LongStream.*; + +public class AmicablePairs { + + public static void main(String[] args) { + final int limit = 20_000; + + Map map = rangeClosed(1, limit) + .parallel() + .boxed() + .collect(toMap(identity(), AmicablePairs::properDivsSum)); + + rangeClosed(1, limit) + .forEach(n -> { + long m = map.get(n); + if (m > n && m <= limit && map.get(m) == n) + System.out.printf("%s %s %n", n, m); + }); + } + + public static Long properDivsSum(long n) { + return rangeClosed(1, (n + 1) / 2).filter(i -> n % i == 0).sum(); + } +} diff --git a/Task/Amicable-pairs/JavaScript/amicable-pairs-3.js b/Task/Amicable-pairs/JavaScript/amicable-pairs-3.js new file mode 100644 index 0000000000..928e889293 --- /dev/null +++ b/Task/Amicable-pairs/JavaScript/amicable-pairs-3.js @@ -0,0 +1,46 @@ +(max => { + + // amicablePairsUpTo :: Int -> [(Int, Int)] + let amicablePairsUpTo = max => + range(1, max) + .map(x => properDivisors(x) + .reduce((a, b) => a + b, 0)) + .reduce((a, m, i, lst) => { + let n = i + 1; + + return (m > n) && lst[m - 1] === n ? + a.concat([[n, m]]) : a; + }, []), + + + // properDivisors :: Int -> [Int] + properDivisors = n => { + if (n < 2) return []; + else { + let rRoot = Math.sqrt(n), + intRoot = Math.floor(rRoot), + blnPerfectSquare = rRoot === intRoot, + + lows = range(1, intRoot) + .filter(x => (n % x) === 0); + + return lows.concat(lows.slice(1) + .map(x => n / x) + .reverse() + .slice(blnPerfectSquare | 0)); + } + }, + + // Int -> Int -> Maybe Int -> [Int] + range = (m, n, step) => { + let d = (step || 1) * (n >= m ? 1 : -1); + + return Array.from({ + length: Math.floor((n - m) / d) + 1 + }, (_, i) => m + (i * d)); + } + + + return amicablePairsUpTo(max); + +})(20000); diff --git a/Task/Amicable-pairs/JavaScript/amicable-pairs-4.js b/Task/Amicable-pairs/JavaScript/amicable-pairs-4.js new file mode 100644 index 0000000000..3184c67556 --- /dev/null +++ b/Task/Amicable-pairs/JavaScript/amicable-pairs-4.js @@ -0,0 +1,2 @@ +[[220, 284], [1184, 1210], [2620, 2924], [5020, 5564], +[6232, 6368], [10744, 10856], [12285, 14595], [17296, 18416]] diff --git a/Task/Amicable-pairs/K/amicable-pairs.k b/Task/Amicable-pairs/K/amicable-pairs.k new file mode 100644 index 0000000000..0d574fd1ad --- /dev/null +++ b/Task/Amicable-pairs/K/amicable-pairs.k @@ -0,0 +1,10 @@ + propdivs:{1+&0=x!'1+!x%2} + (8,2)#v@&{(x=+/propdivs[a])&~x=a:+/propdivs[x]}' v:1+!20000 +(220 284 + 1184 1210 + 2620 2924 + 5020 5564 + 6232 6368 + 10744 10856 + 12285 14595 + 17296 18416) diff --git a/Task/Amicable-pairs/Lua/amicable-pairs.lua b/Task/Amicable-pairs/Lua/amicable-pairs.lua new file mode 100644 index 0000000000..1961bf0020 --- /dev/null +++ b/Task/Amicable-pairs/Lua/amicable-pairs.lua @@ -0,0 +1,17 @@ +function sumDivs (n) + local sum = 1 + for d = 2, math.sqrt(n) do + if n % d == 0 then + sum = sum + d + sum = sum + n / d + end + end + return sum +end + +for n = 2, 20000 do + m = sumDivs(n) + if m > n then + if sumDivs(m) == n then print(n, m) end + end +end diff --git a/Task/Amicable-pairs/PowerShell/amicable-pairs.psh b/Task/Amicable-pairs/PowerShell/amicable-pairs.psh new file mode 100644 index 0000000000..1a2282d4a4 --- /dev/null +++ b/Task/Amicable-pairs/PowerShell/amicable-pairs.psh @@ -0,0 +1,29 @@ +function Get-ProperDivisorSum ( [int]$N ) + { + $Sum = 1 + If ( $N -gt 3 ) + { + $SqrtN = [math]::Sqrt( $N ) + ForEach ( $Divisor1 in 2..$SqrtN ) + { + $Divisor2 = $N / $Divisor1 + If ( $Divisor2 -is [int] ) { $Sum += $Divisor1 + $Divisor2 } + } + If ( $SqrtN -is [int] ) { $Sum -= $SqrtN } + } + return $Sum + } + +function Get-AmicablePairs ( $N = 300 ) + { + ForEach ( $X in 1..$N ) + { + $Sum = Get-ProperDivisorSum $X + If ( $Sum -gt $X -and $X -eq ( Get-ProperDivisorSum $Sum ) ) + { + "$X, $Sum" + } + } + } + +Get-AmicablePairs 20000 diff --git a/Task/Amicable-pairs/PureBasic/amicable-pairs.purebasic b/Task/Amicable-pairs/PureBasic/amicable-pairs.purebasic new file mode 100644 index 0000000000..17b0544169 --- /dev/null +++ b/Task/Amicable-pairs/PureBasic/amicable-pairs.purebasic @@ -0,0 +1,34 @@ +EnableExplicit + +Procedure.i SumProperDivisors(Number) + If Number < 2 : ProcedureReturn 0 : EndIf + Protected i, sum = 0 + For i = 1 To Number / 2 + If Number % i = 0 + sum + i + EndIf + Next + ProcedureReturn sum +EndProcedure + +Define n, f +Define Dim sum(19999) + +If OpenConsole() + For n = 1 To 19999 + sum(n) = SumProperDivisors(n) + Next + PrintN("The pairs of amicable numbers below 20,000 are : ") + PrintN("") + For n = 1 To 19998 + f = sum(n) + If f <= n Or f < 1 Or f > 19999 : Continue : EndIf + If f = sum(n) And n = sum(f) + PrintN(RSet(Str(n),5) + " and " + RSet(Str(sum(n)), 5)) + EndIf + Next + PrintN("") + PrintN("Press any key to close the console") + Repeat: Delay(10) : Until Inkey() <> "" + CloseConsole() +EndIf diff --git a/Task/Amicable-pairs/REXX/amicable-pairs-2.rexx b/Task/Amicable-pairs/REXX/amicable-pairs-2.rexx index 5adbef2791..ef205f1716 100644 --- a/Task/Amicable-pairs/REXX/amicable-pairs-2.rexx +++ b/Task/Amicable-pairs/REXX/amicable-pairs-2.rexx @@ -1,30 +1,26 @@ -/*REXX program finds and displays all amicable pairs up to a given number. */ -parse arg H .; if H=='' then H=20000 /*get optional arguments (high limit).*/ -w=length(H) ; low=220 /*W: used for columnar output alignment*/ -@.=. /* [↑] LOW is lowest amicable number. */ - do k=low for H-low; _=sigma(k) /*generate sigma sums for a range of #s*/ - if _>=low then @.k=_ /*only keep the pertinent sigma sums. */ - end /*k*/ /* [↑] process a range of integers. */ -#=0 /*number of amicable pairs found so far*/ - do m=low to H; n=@.m /*start the search at the lowest number*/ - if n==. then iterate /*if not pertinent, then ignore the #.*/ - if m==@.n then do /*If equal, might be an amicable number*/ - if m==n then iterate /*skip any perfect numbers. */ - #=#+1 /*bump amicable pair counter.*/ - say right(m,w) ' and ' right(n,w) " are an amicable pair." - m=n /*start M (DO index) from N.*/ - end - end /*m*/ +/*REXX program calculates and displays all amicable pairs up to a given number. */ +parse arg H .; if H=='' | H=="," then H=20000 /*get optional arguments (high limit).*/ +w=length(H) ; low=220 /*W: used for columnar output alignment*/ +@.=. /* [↑] LOW is lowest amicable number. */ + do k=low for H-low; _=sigma(k) /*generate sigma sums for a range of #s*/ + if _>=low then @.k=_ /*only keep the pertinent sigma sums. */ + end /*k*/ /* [↑] process a range of integers. */ +#=0 /*number of amicable pairs found so far*/ + do m=low to H; n=@.m /*start the search at the lowest number*/ + if m==@.n then do /*If equal, might be an amicable number*/ + if m==n then iterate /*Is this a perfect number? Then skip.*/ + #=#+1 /*bump the amicable pair counter. */ + say right(m,w) ' and ' right(n,w) " are an amicable pair." + m=n /*start M (DO index) from N. */ + end + end /*m*/ say -say # 'amicable pairs found up to' H /*display count of the amicable pairs. */ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -sigma: procedure; parse arg x; od=x//2 /*use either EVEN or ODD integers. */ -s=1 /*set initial sigma sum to one. ___*/ - do j=2+od by 1+od while j*j1; q=q%4; _=x-r-q; r=r%2; if _>=0 then do;x=_;r=r+q; end;end +say # 'amicable pairs found up to' H /*display the count of amicable pairs. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +iSqrt: procedure; parse arg x; r=0; q=1; do while q<=x; q=q*4; end + do while q>1; q=q%4; _=x-r-q; r=r%2; if _>=0 then do;x=_;r=r+q; end; end return r -/*────────────────────────────────────────────────────────────────────────────*/ -sigma: procedure; parse arg x; od=x//2 /*use either EVEN or ODD integers. */ -s=1 /*set initial sigma sum to unity. ___*/ - do j=2+od by 1+od to iSqrt(x) /*divide by all integers up to the √ x */ - if x//j==0 then s=s + j + x%j /*add the two divisors to the sum. */ - end /*j*/ /* [↑] % is REXX integer division. */ -return s /*return the sum of the divisors. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sigma: procedure; parse arg x; od=x//2 /*use either EVEN or ODD integers. */ + s=1 /*set initial sigma sum to unity. ___*/ + do j=2+od by 1+od to iSqrt(x) /*divide by all integers up to the √ x */ + if x//j==0 then s=s + j + x%j /*add the two divisors to the sum. */ + end /*j*/ /* [↑] % is the REXX integer division.*/ + return s /*return the sum of the divisors. */ diff --git a/Task/Amicable-pairs/REXX/amicable-pairs-5.rexx b/Task/Amicable-pairs/REXX/amicable-pairs-5.rexx index 4632a279a3..60b7379be6 100644 --- a/Task/Amicable-pairs/REXX/amicable-pairs-5.rexx +++ b/Task/Amicable-pairs/REXX/amicable-pairs-5.rexx @@ -1,30 +1,27 @@ -/*REXX program finds and displays all amicable pairs up to a given number. */ -parse arg H .; if H=='' then H=20000 /*get optional arguments (high limit).*/ -w=length(H) ; low=220 /*W: used for columnar output alignment*/ -x=220 34765731 6232 87633 284 12285 10856 36939357 6368 5684679 /*S minimums.*/ -y=220 34765731 6232 69615 220 12285 10744 34765731 6232 5357625 /*D minimums.*/ - do i=0 for 10; $.i=word(x,i+1); L.i=word(y,i+1); end /*minimum amicable #s.*/ -#=0 /*number of amicable pairs found so far*/ -@.= /* [↑] LOW is lowest amicable number. */ - do k=low for H-low /*generate sigma sums for a range of #s*/ - parse var k '' -1 D /*obtain last decimal digit of K. */ - if k<$.D then iterate /*if no need to compute, then skip it. */ - od=k//2 /*OD: set to unity if K is odd.*/ - z=k; r=0; q=1; do while q<=z; q=q*4; end /*R will be iSqrt of Z*/ - do while q>1; q=q%4; _=z-r-q; r=r%2; if _>=0 then do;z=_;r=r+q; end;end - s=1 /*set initial sigma sum to unity. ___*/ - do j=2+od by 1+od to r /*divide by all integers up to the √ K */ - if k//j==0 then s=s+ j + k%j /*add the two divisors to the sum. */ - end /*j*/ /* [↑] % is REXX integer division. */ - if s10**digits(); f.p=4**p; end /*p*/ /*calc. pows of 4*/ +#=0 /*number of amicable pairs found so far*/ +@.= /* [↑] LOW is lowest amicable number. */ + do k=low for H-low+1 /*generate sigma sums for a range of #s*/ + parse var k '' -1 D /*obtain last decimal digit of K. */ + if k<$.D then iterate /*if no need to compute, then skip it. */ + od=k//2 /*OD: set to unity if K is odd.*/ + z=k; q=1; do p=0 while f.p<=z; q=f.p; end /*R will end up being the iSqrt of Z.*/ + r=0; do while q>1; q=q%4; _=z-r-q; r=r%2; if _>=0 then do; z=_; r=r+q; end; end + s=1 /*set initial sigma sum to unity. ___*/ + do j=2+od by 1+od to r /*divide by all integers up to the √ K */ + if k//j==0 then s=s+ j + k%j /*add the two divisors to the sum. */ + end /*j*/ /* [↑] % is REXX integer division. */ + @.k=s /*only keep the pertinent sigma sums. */ + if k==@.s then do /*is it a possible amicable number ? */ + if s==k then iterate /*Is it a perfect number? Then skip it*/ + #=#+1 /*bump the amicable pair counter. */ + say right(s,w) ' and ' right(k,w) " are an amicable pair." end - end /*k*/ /* [↑] process a range of integers. */ -say -say # 'amicable pairs found up to' H /*display the count of amicable pairs. */ - /*stick a fork in it, we're all done. */ + end /*k*/ /* [↑] process a range of integers. */ +say /*stick a fork in it, we're all done. */ +say # 'amicable pairs found up to' H /*display the count of amicable pairs. */ diff --git a/Task/Amicable-pairs/Run-BASIC/amicable-pairs.run b/Task/Amicable-pairs/Run-BASIC/amicable-pairs.run new file mode 100644 index 0000000000..8215cdfda8 --- /dev/null +++ b/Task/Amicable-pairs/Run-BASIC/amicable-pairs.run @@ -0,0 +1,12 @@ +size = 18500 +for n = 1 to size + m = amicable(n) + if m > n and amicable(m) = n then print n ; " and " ; m +next + +function amicable(nr) + amicable = 1 + for d = 2 to sqr(nr) + if nr mod d = 0 then amicable = amicable + d + nr / d + next + end function diff --git a/Task/Amicable-pairs/ZX-Spectrum-Basic/amicable-pairs.zx b/Task/Amicable-pairs/ZX-Spectrum-Basic/amicable-pairs.zx new file mode 100644 index 0000000000..bea2fb66d8 --- /dev/null +++ b/Task/Amicable-pairs/ZX-Spectrum-Basic/amicable-pairs.zx @@ -0,0 +1,19 @@ +10 LET limit=20000 +20 PRINT "Amicable pairs < ";limit +30 FOR n=1 TO limit +40 LET num=n: GO SUB 1000 +50 LET m=num +60 GO SUB 1000 +70 IF n=num AND n diff --git a/Task/Anagrams-Deranged-anagrams/ALGOL-68/anagrams-deranged-anagrams.alg b/Task/Anagrams-Deranged-anagrams/ALGOL-68/anagrams-deranged-anagrams.alg new file mode 100644 index 0000000000..94569e7611 --- /dev/null +++ b/Task/Anagrams-Deranged-anagrams/ALGOL-68/anagrams-deranged-anagrams.alg @@ -0,0 +1,124 @@ +# find the largest deranged anagrams in a list of words # +# use the associative array in the Associate array/iteration task # +PR read "aArray.a68" PR + +# returns the length of str # +OP LENGTH = ( STRING str )INT: 1 + ( UPB str - LWB str ); + +# returns TRUE if a and b are the same length and have no # +# identical characters at any position, # +# FALSE otherwise # +PRIO ALLDIFFER = 9; +OP ALLDIFFER = ( STRING a, b )BOOL: + IF LENGTH a /= LENGTH b + THEN + # the two stringa are not the same size # + FALSE + ELSE + # the strings are the same length, check the characters # + BOOL result := TRUE; + INT b pos := LWB b; + FOR a pos FROM LWB a TO UPB a WHILE result := ( a[ a pos ] /= b[ b pos ] ) + DO + b pos +:= 1 + OD; + result + FI # ALLDIFFER # ; + +# returns text with the characters sorted # +OP SORT = ( STRING text )STRING: + BEGIN + STRING sorted := text; + FOR end pos FROM UPB sorted - 1 BY -1 TO LWB sorted + WHILE + BOOL swapped := FALSE; + FOR pos FROM LWB sorted TO end pos DO + IF sorted[ pos ] > sorted[ pos + 1 ] + THEN + CHAR t := sorted[ pos ]; + sorted[ pos ] := sorted[ pos + 1 ]; + sorted[ pos + 1 ] := t; + swapped := TRUE + FI + OD; + swapped + DO SKIP OD; + sorted + END # SORTED # ; + +# read the list of words and find the longest deranged anagrams # + +CHAR separator = "|"; # character that will separate the anagrams # + +IF FILE input file; + STRING file name = "unixdict.txt"; + open( input file, file name, stand in channel ) /= 0 +THEN + # failed to open the file # + print( ( "Unable to open """ + file name + """", newline ) ) +ELSE + # file opened OK # + BOOL at eof := FALSE; + # set the EOF handler for the file # + on logical file end( input file, ( REF FILE f )BOOL: + BEGIN + # note that we reached EOF on the # + # latest read # + at eof := TRUE; + # return TRUE so processing can continue # + TRUE + END + ); + REF AARRAY words := INIT LOC AARRAY; + STRING word; + INT longest derangement := 0; + STRING longest word := ""; + STRING longest anagram := ""; + WHILE NOT at eof + DO + STRING word; + get( input file, ( word, newline ) ); + INT word length = LENGTH word; + IF word length >= longest derangement + THEN + # this word is at least long as the longest derangement # + # found so far - test it # + STRING sorted word = SORT word; + IF ( words // sorted word ) /= "" + THEN + # we already have this sorted word - test for # + # deranged anagrams # + # the word list will have a leading separator # + # and be followed by one or more words separated by # + # the separator # + STRING word list := words // sorted word; + INT list pos := LWB word list + 1; + INT list max = UPB word list; + BOOL is deranged := FALSE; + WHILE list pos < list max + AND NOT is deranged + DO + STRING anagram = word list[ list pos : ( list pos + word length ) - 1 ]; + IF is deranged := word ALLDIFFER anagram + THEN + # have a deranged anagram # + longest derangement := word length; + longest word := word; + longest anagram := anagram + FI; + list pos +:= word length + 1 + OD + FI; + # add the word to the anagram list # + words // sorted word +:= separator + word + FI + OD; + close( input file ); + print( ( "Longest deranged anagrams: " + , longest word + , " and " + , longest anagram + , newline + ) + ) +FI diff --git a/Task/Anagrams-Deranged-anagrams/C-sharp/anagrams-deranged-anagrams.cs b/Task/Anagrams-Deranged-anagrams/C-sharp/anagrams-deranged-anagrams.cs new file mode 100644 index 0000000000..9f79adab9d --- /dev/null +++ b/Task/Anagrams-Deranged-anagrams/C-sharp/anagrams-deranged-anagrams.cs @@ -0,0 +1,20 @@ +public static void Main() +{ + var lookupTable = File.ReadLines("unixdict.txt").ToLookup(line => AnagramKey(line)); + var query = from a in lookupTable + orderby a.Key.Length descending + let deranged = FindDeranged(a) + where deranged != null + select deranged[0] + " " + deranged[1]; + Console.WriteLine(query.FirstOrDefault()); +} + +static string AnagramKey(string word) => new string(word.OrderBy(c => c).ToArray()); + +static string[] FindDeranged(IEnumerable anagrams) => ( + from first in anagrams + from second in anagrams + where !second.Equals(first) + && Enumerable.Range(0, first.Length).All(i => first[i] != second[i]) + select new [] { first, second }) + .FirstOrDefault(); diff --git a/Task/Anagrams-Deranged-anagrams/Elixir/anagrams-deranged-anagrams.elixir b/Task/Anagrams-Deranged-anagrams/Elixir/anagrams-deranged-anagrams.elixir new file mode 100644 index 0000000000..09d9ac346c --- /dev/null +++ b/Task/Anagrams-Deranged-anagrams/Elixir/anagrams-deranged-anagrams.elixir @@ -0,0 +1,30 @@ +defmodule Anagrams do + def deranged(fname) do + File.read!(fname) + |> String.split + |> Enum.group_by(fn word -> String.codepoints(word) |> Enum.sort end) + |> Enum.filter(fn {_,words} -> length(words) > 1 end) + |> Enum.sort_by(fn {key,_} -> -length(key) end) + |> Enum.find(fn {_,words} -> find_derangements(words) end) + end + + defp find_derangements(words) do + comb(words,2) |> Enum.find(fn [a,b] -> deranged?(a,b) end) + end + + defp deranged?(a,b) do + Enum.zip(String.codepoints(a), String.codepoints(b)) + |> Enum.all?(fn {chr_a,chr_b} -> chr_a != chr_b end) + end + + defp comb(_, 0), do: [[]] + defp comb([], _), do: [] + defp comb([h|t], m) do + (for l <- comb(t, m-1), do: [h|l]) ++ comb(t, m) + end +end + +case Anagrams.deranged("/work/unixdict.txt") do + {_, words} -> IO.puts "Longest derangement anagram: #{inspect words}" + _ -> IO.puts "derangement anagram: nothing" +end diff --git a/Task/Anagrams-Deranged-anagrams/Mathematica/anagrams-deranged-anagrams.math b/Task/Anagrams-Deranged-anagrams/Mathematica/anagrams-deranged-anagrams-1.math similarity index 100% rename from Task/Anagrams-Deranged-anagrams/Mathematica/anagrams-deranged-anagrams.math rename to Task/Anagrams-Deranged-anagrams/Mathematica/anagrams-deranged-anagrams-1.math diff --git a/Task/Anagrams-Deranged-anagrams/Mathematica/anagrams-deranged-anagrams-2.math b/Task/Anagrams-Deranged-anagrams/Mathematica/anagrams-deranged-anagrams-2.math new file mode 100644 index 0000000000..2128cb0f03 --- /dev/null +++ b/Task/Anagrams-Deranged-anagrams/Mathematica/anagrams-deranged-anagrams-2.math @@ -0,0 +1,5 @@ +list = Import["http://www.puzzlers.org/pub/wordlists/unixdict.txt","Lines"]; +MaximalBy[ + Select[GatherBy[list, Sort@*Characters], + Length@# > 1 && And @@ MapThread[UnsameQ, Characters /@ #] &], + StringLength@*First] diff --git a/Task/Anagrams-Deranged-anagrams/PARI-GP/anagrams-deranged-anagrams.pari b/Task/Anagrams-Deranged-anagrams/PARI-GP/anagrams-deranged-anagrams.pari new file mode 100644 index 0000000000..f0c18bbb11 --- /dev/null +++ b/Task/Anagrams-Deranged-anagrams/PARI-GP/anagrams-deranged-anagrams.pari @@ -0,0 +1,9 @@ +dict=readstr("unixdict.txt"); +len=apply(s->#s, dict); +getLen(L)=my(v=List()); for(i=1,#dict, if(len[i]==L, listput(v, dict[i]))); Vec(v); +letters(s)=vecsort(Vec(s)); +getAnagrams(v)=my(u=List(),L=apply(letters,v),t,w); for(i=1,#v-1, w=List(); t=L[i]; for(j=i+1,#v, if(L[j]==t, listput(w, v[j]))); if(#w, listput(u, concat([v[i]], Vec(w))))); Vec(u); +deranged(s1,s2)=s1=Vec(s1);s2=Vec(s2); for(i=1,#s1, if(s1[i]==s2[i], return(0))); 1 +getDeranged(v)=my(u=List(),w); for(i=1,#v-1, for(j=i+1,#v, if(deranged(v[i], v[j]), listput(u, [v[i], v[j]])))); Vec(u); +f(n)=my(t=getAnagrams(getLen(n))); if(#t, concat(apply(getDeranged, t)), []); +forstep(n=vecmax(len),1,-1, t=f(n); if(#t, return(t))) diff --git a/Task/Anagrams-Deranged-anagrams/Perl-6/anagrams-deranged-anagrams.pl6 b/Task/Anagrams-Deranged-anagrams/Perl-6/anagrams-deranged-anagrams.pl6 new file mode 100644 index 0000000000..9c5e51f99d --- /dev/null +++ b/Task/Anagrams-Deranged-anagrams/Perl-6/anagrams-deranged-anagrams.pl6 @@ -0,0 +1,15 @@ +my @anagrams = 'unixdict.txt'.IO.words + .map(*.comb.cache) # explode words into lists of characters + .classify(*.sort.join).values # group words with the same characters + .grep(* > 1) # only take groups with more than one word + .sort(-*[0]) # sort by length of the first word +; + +for @anagrams -> @group { + for @group.combinations(2) -> [@a, @b] { + if none @a Zeq @b { + say "{@a.join} {@b.join}"; + exit; + } + } +} diff --git a/Task/Anagrams/00DESCRIPTION b/Task/Anagrams/00DESCRIPTION index 3092c3e883..76cec38222 100644 --- a/Task/Anagrams/00DESCRIPTION +++ b/Task/Anagrams/00DESCRIPTION @@ -1,2 +1,12 @@ -Two or more words can be composed of the same characters, but in a different order. -Using the word list at http://www.puzzlers.org/pub/wordlists/unixdict.txt, find the sets of words that share the same characters that contain the most words in them. +When two or more words are composed of the same characters, but in a different order, they are called [[wp:Anagram|anagrams]]. + +{{task heading}} + +Using the word list at   http://www.puzzlers.org/pub/wordlists/unixdict.txt, +
find the sets of words that share the same characters that contain the most words in them. + +{{task heading|Related tasks}} + +{{Related tasks/Word plays}} + +
diff --git a/Task/Anagrams/ALGOL-68/anagrams.alg b/Task/Anagrams/ALGOL-68/anagrams.alg new file mode 100644 index 0000000000..8fe12076cc --- /dev/null +++ b/Task/Anagrams/ALGOL-68/anagrams.alg @@ -0,0 +1,93 @@ +# find longest list(s) of words that are anagrams in a list of words # +# use the associative array in the Associate array/iteration task # +PR read "aArray.a68" PR + +# returns the number of occurances of ch in text # +PROC count = ( STRING text, CHAR ch )INT: + BEGIN + INT result := 0; + FOR c FROM LWB text TO UPB text DO IF text[ c ] = ch THEN result +:= 1 FI OD; + result + END # count # ; + +# returns text with the characters sorted into ascending order # +PROC char sort = ( STRING text )STRING: + BEGIN + STRING sorted := text; + FOR end pos FROM UPB sorted - 1 BY -1 TO LWB sorted + WHILE + BOOL swapped := FALSE; + FOR pos FROM LWB sorted TO end pos DO + IF sorted[ pos ] > sorted[ pos + 1 ] + THEN + CHAR t := sorted[ pos ]; + sorted[ pos ] := sorted[ pos + 1 ]; + sorted[ pos + 1 ] := t; + swapped := TRUE + FI + OD; + swapped + DO SKIP OD; + sorted + END # char sort # ; + +# read the list of words and store in an associative array # + +CHAR separator = "|"; # character that will separate the anagrams # + +IF FILE input file; + STRING file name = "unixdict.txt"; + open( input file, file name, stand in channel ) /= 0 +THEN + # failed to open the file # + print( ( "Unable to open """ + file name + """", newline ) ) +ELSE + # file opened OK # + BOOL at eof := FALSE; + # set the EOF handler for the file # + on logical file end( input file, ( REF FILE f )BOOL: + BEGIN + # note that we reached EOF on the # + # latest read # + at eof := TRUE; + # return TRUE so processing can continue # + TRUE + END + ); + REF AARRAY words := INIT LOC AARRAY; + STRING word; + WHILE NOT at eof + DO + STRING word; + get( input file, ( word, newline ) ); + words // char sort( word ) +:= separator + word + OD; + # close the file # + close( input file ); + + # find the maximum number of anagrams # + + INT max anagrams := 0; + + REF AAELEMENT e := FIRST words; + WHILE e ISNT nil element DO + IF INT anagrams := count( value OF e, separator ); + anagrams > max anagrams + THEN + max anagrams := anagrams + FI; + e := NEXT words + OD; + + print( ( "Maximum number of anagrams: ", whole( max anagrams, -4 ), newline ) ); + # show the anagrams with the maximum number # + e := FIRST words; + WHILE e ISNT nil element DO + IF INT anagrams := count( value OF e, separator ); + anagrams = max anagrams + THEN + print( ( ( value OF e )[ ( LWB value OF e ) + 1: ], newline ) ) + FI; + e := NEXT words + OD +FI diff --git a/Task/Anagrams/COBOL/anagrams.cobol b/Task/Anagrams/COBOL/anagrams.cobol new file mode 100644 index 0000000000..aab0308efd --- /dev/null +++ b/Task/Anagrams/COBOL/anagrams.cobol @@ -0,0 +1,243 @@ + *> TECTONICS + *> wget http://www.puzzlers.org/pub/wordlists/unixdict.txt + *> or visit https://sourceforge.net/projects/souptonuts/files + *> or snag ftp://ftp.openwall.com/pub/wordlists/all.gz + *> for a 5 million all language word file (a few phrases) + *> cobc -xj anagrams.cob [-DMOSTWORDS -DMOREWORDS -DALLWORDS] + *> *************************************************************** + identification division. + program-id. anagrams. + + environment division. + configuration section. + repository. + function all intrinsic. + + input-output section. + file-control. + select words-in + assign to wordfile + organization is line sequential + status is words-status + . + + REPLACE ==:LETTERS:== BY ==42==. + + data division. + file section. + fd words-in record is varying from 1 to :LETTERS: characters + depending on word-length. + 01 word-record. + 05 word-data pic x occurs 0 to :LETTERS: times + depending on word-length. + + working-storage section. + >>IF ALLWORDS DEFINED + 01 wordfile constant as "/usr/local/share/dict/all.words". + 01 max-words constant as 4802100. + + >>ELSE-IF MOSTWORDS DEFINED + 01 wordfile constant as "/usr/local/share/dict/linux.words". + 01 max-words constant as 628000. + + >>ELSE-IF MOREWORDS DEFINED + 01 wordfile constant as "/usr/share/dict/words". + 01 max-words constant as 100000. + + >>ELSE + 01 wordfile constant as "unixdict.txt". + 01 max-words constant as 26000. + >>END-IF + + *> The 5 million word file needs to restrict the word length + >>IF ALLWORDS DEFINED + 01 max-letters constant as 26. + >>ELSE + 01 max-letters constant as :LETTERS:. + >>END-IF + + 01 word-length pic 99 comp-5. + 01 words-status pic xx. + 88 ok-status values '00' thru '09'. + 88 eof-status value '10'. + + *> sortable word by letter table + 01 letter-index usage index. + 01 letter-table. + 05 letters occurs 1 to max-letters times + depending on word-length + ascending key letter + indexed by letter-index. + 10 letter pic x. + + *> table of words + 01 sorted-index usage index. + 01 word-table. + 05 word-list occurs 0 to max-words times + depending on word-tally + ascending key sorted-word + indexed by sorted-index. + 10 match-count pic 999 comp-5. + 10 this-word pic x(max-letters). + 10 sorted-word pic x(max-letters). + 01 sorted-display pic x(10). + + 01 interest-table. + 05 interest-list pic 9(8) comp-5 + occurs 0 to max-words times + depending on interest-tally. + + 01 outer pic 9(8) comp-5. + 01 inner pic 9(8) comp-5. + 01 starter pic 9(8) comp-5. + 01 ender pic 9(8) comp-5. + 01 word-tally pic 9(8) comp-5. + 01 interest-tally pic 9(8) comp-5. + 01 tally-display pic zz,zzz,zz9. + + 01 most-matches pic 99 comp-5. + 01 matches pic 99 comp-5. + 01 match-display pic z9. + + *> timing display + 01 time-stamp. + 05 filler pic x(11). + 05 timer-hours pic 99. + 05 filler pic x. + 05 timer-minutes pic 99. + 05 filler pic x. + 05 timer-seconds pic 99. + 05 filler pic x. + 05 timer-subsec pic v9(6). + 01 timer-elapsed pic 9(6)v9(6). + 01 timer-value pic 9(6)v9(6). + 01 timer-display pic zzz,zz9.9(6). + + *> *************************************************************** + procedure division. + main-routine. + + >>IF ALLWORDS DEFINED + display "** Words limited to " max-letters " letters **" + >>END-IF + + perform show-time + + perform load-words + perform find-most + perform display-result + + perform show-time + goback + . + + *> *************************************************************** + load-words. + open input words-in + if not ok-status then + display "error opening " wordfile upon syserr + move 1 to return-code + goback + end-if + + perform until exit + read words-in + if eof-status then exit perform end-if + if not ok-status then + display wordfile " read error: " words-status upon syserr + end-if + + if word-length equal zero then exit perform cycle end-if + + >>IF ALLWORDS DEFINED + move min(word-length, max-letters) to word-length + >>END-IF + + add 1 to word-tally + move word-record to this-word(word-tally) letter-table + sort letters ascending key letter + move letter-table to sorted-word(word-tally) + end-perform + + move word-tally to tally-display + display trim(tally-display) " words" with no advancing + + close words-in + if not ok-status then + display "error closing " wordfile upon syserr + move 1 to return-code + end-if + + *> sort word list by anagram check field + sort word-list ascending key sorted-word + . + + *> first entry in a list will end up with highest match count + find-most. + perform varying outer from 1 by 1 until outer > word-tally + move 1 to matches + add 1 to outer giving starter + perform varying inner from starter by 1 + until sorted-word(inner) not equal sorted-word(outer) + add 1 to matches + end-perform + if matches > most-matches then + move matches to most-matches + initialize interest-table all to value + move 0 to interest-tally + end-if + move matches to match-count(outer) + if matches = most-matches then + add 1 to interest-tally + move outer to interest-list(interest-tally) + end-if + end-perform + . + + *> only display the words with the most anagrams + display-result. + move interest-tally to tally-display + move most-matches to match-display + display ", most anagrams: " trim(match-display) + ", with " trim(tally-display) " set" with no advancing + if interest-tally not equal 1 then + display "s" with no advancing + end-if + display " of interest" + + perform varying outer from 1 by 1 until outer > interest-tally + move sorted-word(interest-list(outer)) to sorted-display + display sorted-display + " [" trim(this-word(interest-list(outer))) + with no advancing + add 1 to interest-list(outer) giving starter + add most-matches to interest-list(outer) giving ender + perform varying inner from starter by 1 + until inner = ender + display ", " trim(this-word(inner)) + with no advancing + end-perform + display "]" + end-perform + . + + *> elapsed time + show-time. + move formatted-current-date("YYYY-MM-DDThh:mm:ss.ssssss") + to time-stamp + compute timer-value = timer-hours * 3600 + timer-minutes * 60 + + timer-seconds + timer-subsec + if timer-elapsed = 0 then + display time-stamp + move timer-value to timer-elapsed + else + if timer-value < timer-elapsed then + add 86400 to timer-value + end-if + subtract timer-elapsed from timer-value + move timer-value to timer-display + display time-stamp ", " trim(timer-display) " seconds" + end-if + . + + end program anagrams. diff --git a/Task/Anagrams/Ela/anagrams.ela b/Task/Anagrams/Ela/anagrams.ela new file mode 100644 index 0000000000..db017b097d --- /dev/null +++ b/Task/Anagrams/Ela/anagrams.ela @@ -0,0 +1,14 @@ +open monad io list string + +groupon f x y = f x == f y + +lines = split "\n" << replace "\n\n" "\n" << replace "\r" "\n" + +main = do + fh <- readFile "c:\\test\\unixdict.txt" OpenMode + f <- readLines fh + closeFile fh + let words = lines f + let wix = groupBy (groupon fst) << sort $ zip (map sort words) words + let mxl = maximum $ map length wix + mapM_ (putLn << map snd) << filter ((==mxl) << length) $ wix diff --git a/Task/Anagrams/Elena/anagrams.elena b/Task/Anagrams/Elena/anagrams.elena index 1e7666349c..2779c65908 100644 --- a/Task/Anagrams/Elena/anagrams.elena +++ b/Task/Anagrams/Elena/anagrams.elena @@ -1,9 +1,9 @@ -#define system. -#define system'routines. -#define system'io. -#define system'collections. -#define extensions. -#define extensions'routines. +#import system. +#import system'routines. +#import system'io. +#import system'collections. +#import extensions. +#import extensions'routines. #class(extension) op { @@ -15,7 +15,7 @@ [ #var aDictionary := Dictionary new. - File new &path:"unixdict.txt" run &eachLine: aWord + "unixdict.txt" file_path run &eachLine: aWord [ #var aKey := aWord normalized. #var anItem := aDictionary@aKey. diff --git a/Task/Anagrams/Elixir/anagrams-1.elixir b/Task/Anagrams/Elixir/anagrams-1.elixir index 01cece4228..1f6917b685 100644 --- a/Task/Anagrams/Elixir/anagrams-1.elixir +++ b/Task/Anagrams/Elixir/anagrams-1.elixir @@ -2,24 +2,15 @@ defmodule Anagrams do def find(file) do File.read!(file) |> String.split - |> Enum.map(&String.codepoints &1) - |> sort(%{}) + |> Enum.group_by(fn word -> String.codepoints(word) |> Enum.sort end) |> Enum.group_by(fn {_,v} -> length(v) end) |> Enum.max |> print end - defp sort([],m), do: m - defp sort([word|words],m) do - s = Enum.sort(word) - m = Dict.update(m, s, [word], fn val -> [word|val] end) - sort(words,m) - end - defp print({_,y}) do - Enum.each(y, fn {_,e} -> - Enum.map(e, &Enum.join(&1)) |> Enum.sort |> Enum.join(" ") |> IO.puts - end) + Enum.each(y, fn {_,e} -> Enum.sort(e) |> Enum.join(" ") |> IO.puts end) end end + Anagrams.find("unixdict.txt") diff --git a/Task/Anagrams/Elixir/anagrams-2.elixir b/Task/Anagrams/Elixir/anagrams-2.elixir index 4010deb7a7..7661b9b235 100644 --- a/Task/Anagrams/Elixir/anagrams-2.elixir +++ b/Task/Anagrams/Elixir/anagrams-2.elixir @@ -1,13 +1,8 @@ File.stream!("unixdict.txt") |> Stream.map(&String.strip &1) - |> Stream.map(&{&1, &1 |> String.codepoints |> Enum.sort |> Enum.join}) - |> Enum.group_by(fn {_,y} -> y end) - |> Dict.values - |> Enum.group_by(&length(&1)) + |> Enum.group_by(&String.codepoints(&1) |> Enum.sort) + |> Map.values + |> Enum.group_by(&length &1) |> Enum.max |> elem(1) - |> Enum.each(fn n -> Enum.map(n, fn {y,_} -> y end) - |> Enum.sort - |> Enum.join(" ") - |> IO.puts - end) + |> Enum.each(fn n -> Enum.sort(n) |> Enum.join(" ") |> IO.puts end) diff --git a/Task/Anagrams/Julia/anagrams.julia b/Task/Anagrams/Julia/anagrams.julia index 07e236c335..6f41b834ff 100644 --- a/Task/Anagrams/Julia/anagrams.julia +++ b/Task/Anagrams/Julia/anagrams.julia @@ -1,12 +1,14 @@ url = "http://www.puzzlers.org/pub/wordlists/unixdict.txt" -wordlist = map!(chomp,(open(readlines, download(url)))) ; +wordlist = map!(chomp,(open(readlines, download(url)))) + +wsort(word) = join(sort(collect(word))) function anagram(wordlist) hash = Dict() ; ananum = 0 for word in wordlist - sorted = CharString(sort(collect(word.data))) - hash[sorted] = [ get(hash, sorted, []), word ] + sorted = wsort(word) + hash[sorted] = [ get(hash, sorted, []); word ] ananum = max(length(hash[sorted]), ananum) end collect(values(filter((x,y)-> length(y) == ananum, hash))) diff --git a/Task/Anagrams/Mathematica/anagrams-5.math b/Task/Anagrams/Mathematica/anagrams-5.math new file mode 100644 index 0000000000..9f23ae41ca --- /dev/null +++ b/Task/Anagrams/Mathematica/anagrams-5.math @@ -0,0 +1,2 @@ +list=Import["http://www.puzzlers.org/pub/wordlists/unixdict.txt","Lines"]; +MaximalBy[GatherBy[list, Sort@*Characters], Length] diff --git a/Task/Anagrams/Perl-6/anagrams-1.pl6 b/Task/Anagrams/Perl-6/anagrams-1.pl6 index a28f27a597..1e047758e4 100644 --- a/Task/Anagrams/Perl-6/anagrams-1.pl6 +++ b/Task/Anagrams/Perl-6/anagrams-1.pl6 @@ -1,5 +1,5 @@ -my %anagram = slurp('unixdict.txt').words.classify( { .comb.sort.join } ); +my @anagrams = 'unixdict.txt'.IO.words.classify(*.comb.sort.join).values; -my $max = [max] map { +@($_) }, %anagram.values; +my $max = @anagrams».elems.max; -%anagram.values.grep( { +@($_) >= $max } )».join(' ')».say; +.put for @anagrams.grep(*.elems == $max); diff --git a/Task/Anagrams/Perl-6/anagrams-2.pl6 b/Task/Anagrams/Perl-6/anagrams-2.pl6 index a17d87e4a2..a698001833 100644 --- a/Task/Anagrams/Perl-6/anagrams-2.pl6 +++ b/Task/Anagrams/Perl-6/anagrams-2.pl6 @@ -1,7 +1,6 @@ -.say for # print each element of the array made this way: -slurp('unixdict.txt')\ # load file in memory -.words\ # extract words -.classify( *.comb.sort.join )\ # group by common anagram -.classify( *.value.elems )\ # group by number of anagrams in a group -.max( :by(*.key) ).value\ # get the group with highest number of anagrams -».value # get all groups of anagrams in the group just selected +.put for # print each element of the array made this way: + 'unixdict.txt'.IO.words # load words from file + .classify(*.comb.sort.join) # group by common anagram + .classify(*.value.elems) # group by number of anagrams in a group + .max(*.key).value # get the group with highest number of anagrams + .map(*.value) # get all groups of anagrams in the group just selected diff --git a/Task/Anagrams/REXX/anagrams-1.rexx b/Task/Anagrams/REXX/anagrams-1.rexx index 4768141a96..e45539b983 100644 --- a/Task/Anagrams/REXX/anagrams-1.rexx +++ b/Task/Anagrams/REXX/anagrams-1.rexx @@ -1,30 +1,30 @@ -/*REXX program finds words with the largest set of anagrams (of the same size)*/ -iFID='unixdict.txt' /*the dictionary input File IDentifier.*/ -$=; !.=; #.=0; w=0; uw=0; most=0 /*initialize a bunch of REXX variables.*/ - /* [↓] read the entire file (by lines)*/ - do while lines(iFID)\==0 /*Got any data? Then read a record. */ - @=space(linein(iFID),0) /*pick off a word from the input line. */ - L=length(@); if L<3 then iterate /*onesies and twosies words can't win. */ - if \datatype(@,'M') then iterate /*ignore any non─anagramable words. */ - uw=uw+1 /*count of the (useable) words in file.*/ - z=sortA(@) /*sort the letters in the word. */ - !.z=!.z @; #.z=#.z+1 /*append it to !.z; bump the counter. */ +/*REXX program finds words with the largest set of anagrams (of the same size). */ +iFID= 'unixdict.txt' /*the dictionary input File IDentifier.*/ +$=; !.=; #.=0; w=0; uw=0; most=0 /*initialize a bunch of REXX variables.*/ + /* [↓] read the entire file (by lines)*/ + do while lines(iFID)\==0 /*Got any data? Then read a record. */ + @=space( linein(iFID), 0) /*pick off a word from the input line. */ + L=length(@); if L<3 then iterate /*onesies and twosies words can't win. */ + if \datatype(@, 'M') then iterate /*ignore any non─anagramable words. */ + uw=uw+1 /*count of the (useable) words in file.*/ + z=sortA(@) /*sort the letters in the word. */ + !.z=!.z @; #.z=#.z+1 /*append it to !.z; bump the counter. */ if #.z>most then do; $=z; most=#.z; if L>w then w=L; iterate; end - if #.z==most then $=$ z /*append the sorted word──◄ max anagram*/ - end /*while*/ /*$ ►── list of high count anagrams. */ -say '─────────────────────────' uw 'useable words in the dictionary file: ' iFID + if #.z==most then $=$ z /*append the sorted word──► max anagram*/ + end /*while*/ /*$ ◄── list of high count anagrams. */ +say '─────────────────────────' uw "useable words in the dictionary file: " iFID say - do m=1 for words($); z=subword($,m,1) /*high count of anagrams.*/ - say ' ' left(subword(!.z,1,1),w) ' [anagrams: ' subword(!.z,2)"]" - end /*m*/ /*W is the maximum width of any word.*/ + do m=1 for words($); z=subword($, m, 1) /*the high count of the anagrams. */ + say ' ' left(subword(!.z, 1, 1), w) ' [anagrams: ' subword(!.z, 2)"]" + end /*m*/ /*W is the maximum width of any word.*/ say -say '───── Found' words($) "words (each of which have" #.z-1 'anagrams).' -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────SORTA subroutine──────────────────────────*/ -sortA: procedure; arg char +1 xx,@. /*get the first letter of arg; @.=null*/ -@.char=char /*no need to concatenate the first char*/ - /*[↓] sort/put letters alphabetically.*/ - do length(xx); parse var xx char +1 xx; @.char=@.char || char; end - /*reassemble word with sorted letters. */ -return @.a||@.b||@.c||@.d||@.e||@.f||@.g||@.h||@.i||@.j||@.k||@.l||@.m||, - @.n||@.o||@.p||@.q||@.r||@.s||@.t||@.u||@.v||@.w||@.x||@.y||@.z +say '───── Found' words($) "words (each of which have" #.z-1 'anagrams).' +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sortA: procedure; arg char +1 xx,@. /*get the first letter of arg; @.=null*/ + @.char=char /*no need to concatenate the first char*/ + /*[↓] sort/put letters alphabetically.*/ + do length(xx); parse var xx char +1 xx; @.char=@.char || char; end + /*reassemble word with sorted letters. */ + return @.a||@.b||@.c||@.d||@.e||@.f||@.g||@.h||@.i||@.j||@.k||@.l||@.m||, + @.n||@.o||@.p||@.q||@.r||@.s||@.t||@.u||@.v||@.w||@.x||@.y||@.z diff --git a/Task/Anagrams/REXX/anagrams-2.rexx b/Task/Anagrams/REXX/anagrams-2.rexx index 591e7450c8..d4a6adc963 100644 --- a/Task/Anagrams/REXX/anagrams-2.rexx +++ b/Task/Anagrams/REXX/anagrams-2.rexx @@ -1,28 +1,27 @@ -/*REXX program finds words with the largest set of anagrams (of the same size)*/ -iFID='unixdict.txt' /*the dictionary input File IDentifier.*/ -$=; !.=; #.=0; ww=0; uw=0; most=0 /*initialize a bunch of REXX variables.*/ - /* [↓] read the entire file (by lines)*/ - do while lines(iFID)\==0 /*Got any data? Then read a record. */ - @=space(linein(iFID),0) /*pick off a word from the input line. */ - LL=length(@); if LL<3 then iterate /*onesies and twosies (words) can't win*/ - if \datatype(@,'M') then iterate /*ignore any non─anagramable words. */ - uw=uw+1 /*count of the (useable) words in file.*/ - parse upper var @ _ +1 xx @. /*get uppercase @ and nullify @. */ - @._=_ /*get the first letter (special case). */ - /*[↓] sort/put letters alphabetically.*/ - do LL-1; parse var xx _ +1 xx; @._=@._||_; end /*get rest of word.*/ - /*reassemble word with sorted letters. */ +/*REXX program finds words with the largest set of anagrams (of the same size). */ +iFID= 'unixdict.txt' /*the dictionary input File IDentifier.*/ +$=; !.=; #.=0; ww=0; uw=0; most=0 /*initialize a bunch of REXX variables.*/ + /* [↓] read the entire file (by lines)*/ + do while lines(iFID)\==0 /*Got any data? Then read a record. */ + @=space( linein(iFID), 0) /*pick off a word from the input line. */ + LL=length(@); if LL<3 then iterate /*onesies and twosies (words) can't win*/ + if \datatype(@, 'M') then iterate /*ignore any non─anagramable words. */ + uw=uw+1 /*count of the (useable) words in file.*/ + parse upper var @ _ +1 xx @. /*get uppercase @ and nullify @. */ + @._=_ /*get the first letter (special case). */ + /*[↓] sort/put letters alphabetically.*/ + do LL-1; parse var xx _ +1 xx; @._=@._||_; end /*get the rest of the word.*/ + /*reassemble word with sorted letters. */ zz=@.a||@.b||@.c||@.d||@.e||@.f||@.g||@.h||@.i||@.j||@.k||@.l||@.m||, @.n||@.o||@.p||@.q||@.r||@.s||@.t||@.u||@.v||@.w||@.x||@.y||@.z - !.zz=!.zz @; #.zz=#.zz+1 /*append it to !.zz; bump the counter.*/ - if #.zz>most then do; $=zz; most=#.zz; if LL>ww then ww=LL; iterate; end - if #.zz==most then $=$ zz /*append the sorted word──◄ $ anagrams.*/ + !.zz=!.zz @; #.zz=#.zz+1 /*append it to !.zz; bump the counter.*/ + if #.zz>most then do; $=zz; most=#.zz; if LL>ww then ww=LL; iterate; end + if #.zz==most then $=$ zz /*append the sorted word──► $ anagrams.*/ end /*while*/ -say '─────────────────────────' uw 'useable words in the dictionary file: ' iFID +say '─────────────────────────' uw "useable words in the dictionary file: " iFID say - do m=1 for words($); z=subword($,m,1) /*high count of anagrams.*/ - say ' ' left(subword(!.z,1,1),ww) ' [anagrams: ' subword(!.z,2)"]" - end /*m*/ /*WW is the maximum width of any word.*/ -say -say '───── Found' words($) "words (each of which have" #.z-1 'anagrams).' - /*stick a fork in it, we're all done. */ + do m=1 for words($); z=subword($,m,1) /*the high count of the anagrams. */ + say ' ' left(subword(!.z, 1, 1), ww) " [anagrams: " subword(!.z,2)"]" + end /*m*/ /*WW is the maximum width of any word.*/ +say /*stick a fork in it, we're all done. */ +say '───── Found' words($) "words (each of which have" #.z-1 'anagrams).' diff --git a/Task/Anagrams/REXX/anagrams-3.rexx b/Task/Anagrams/REXX/anagrams-3.rexx index 7ed192ca90..33e17818f5 100644 --- a/Task/Anagrams/REXX/anagrams-3.rexx +++ b/Task/Anagrams/REXX/anagrams-3.rexx @@ -1,28 +1,27 @@ -/*REXX program finds words with the largest set of anagrams (of the same size)*/ -iFID='unixdict.txt' /*the dictionary input File IDentifier.*/ -$=; !.=; #.=0; ww=0; uw=0; most=0 /*initialize a bunch of REXX variables.*/ - /* [↓] read the entire file (by lines)*/ - do while lines(iFID)\==0 /*Got any data? Then read a record. */ - @=space(linein(iFID),0) /*pick off a word from the input line. */ - LL=length(@); if LL<3 then iterate /*onesies and twosies (words) can't win*/ - if \datatype(@,'M') then iterate /*ignore any non─anagramable words. */ - uw=uw+1 /*count of the (useable) words in file.*/ - parse upper var @ _ +1 xx '' @. /*get uppercase @ and nullify @. */ - @._=_ /*get the first letter (special case). */ - /*[↓] sort/put letters alphabetically.*/ - do LL-1; parse var xx _ +1 xx; @._=@._||_; end /*get rest of word.*/ - /*reassemble word with sorted letters. */ - zz=@.a||@.b||@.c||@.d||@.e||@.f||@.g||@.h||@.i||@.j||@.k||@.l||@.m||, - @.n||@.o||@.p||@.q||@.r||@.s||@.t||@.u||@.v||@.w||@.x||@.y||@.z - !.zz=!.zz @; #.zz=#.zz+1 /*append it to !.zz; bump the counter.*/ - if #.zz>most then do; $=zz; most=#.zz; if LL>ww then ww=LL; iterate; end - if #.zz==most then $=$ zz /*append the sorted word──► $ anagrams.*/ +/*REXX program finds words with the largest set of anagrams (of the same size). */ +iFID= 'unixdict.txt' /*the dictionary input File IDentifier.*/ +$=; !.=; #.=0; ww=0; uw=0; most=0 /*initialize a bunch of REXX variables.*/ + /* [↓] read the entire file (by lines)*/ + do while lines(iFID)\==0 /*Got any data? Then read a record. */ + @=space( linein(iFID), 0) /*pick off a word from the input line. */ + LL=length(@); if LL<3 then iterate /*onesies and twosies (words) can't win*/ + if \datatype(@, 'M') then iterate /*ignore any non─anagramable words. */ + uw=uw+1 /*count of the (useable) words in file.*/ + parse upper var @ _ +1 xx . @. /*get uppercase @ and nullify @. */ + @._=_ /*get the first letter (special case). */ + /*[↓] sort/put letters alphabetically.*/ + do LL-1; parse var xx _ +1 xx; @._=@._ || _; end /*get rest of the word*/ + /*reassemble word with sorted letters. */ + zz=@.a|| @.b|| @.c|| @.d|| @.e|| @.f|| @.g|| @.h|| @.i|| @.j|| @.k|| @.l|| @.m ||, + @.n|| @.o|| @.p|| @.q|| @.r|| @.s|| @.t|| @.u|| @.v|| @.w|| @.x|| @.y|| @.z + !.zz=!.zz @; #.zz=#.zz+1 /*append it to !.zz; bump the counter.*/ + if #.zz>most then do; $=zz; most=#.zz; if LL>ww then ww=LL; iterate; end + if #.zz==most then $=$ zz /*append the sorted word──► $ anagrams.*/ end /*while*/ -say '─────────────────────────' uw 'useable words in the dictionary file: ' iFID +say '─────────────────────────' uw 'useable words in the dictionary file: ' iFID say - do m=1 for words($); z=subword($,m,1) /*high count of anagrams.*/ - say ' ' left(subword(!.z,1,1),ww) ' [anagrams: ' subword(!.z,2)"]" - end /*m*/ /*WW is the maximum width of any word.*/ -say -say '───── Found' words($) "words (each of which have" #.z-1 'anagrams).' - /*stick a fork in it, we're all done. */ + do m=1 for words($); z=subword($, m, 1) /*the high count of the anagrams. */ + say ' ' left(subword(!.z, 1, 1), ww) " [anagrams: " subword(!.z, 2)']' + end /*m*/ /*WW is the maximum width of any word.*/ +say /*stick a fork in it, we're all done. */ +say '───── Found' words($) "words (each of which have" #.z-1 'anagrams).' diff --git a/Task/Anagrams/REXX/anagrams-4.rexx b/Task/Anagrams/REXX/anagrams-4.rexx index 07f1775c22..8fef3f9055 100644 --- a/Task/Anagrams/REXX/anagrams-4.rexx +++ b/Task/Anagrams/REXX/anagrams-4.rexx @@ -1,23 +1,23 @@ -u='Halloween' /*the word to be sorted by letter*/ -upper u /*fast method to uppercase a var.*/ - /*another: u = translate(u) */ - /*another: parse upper var u u */ - /*another: u = upper(u) */ - /*not always available [↑] */ +u= 'Halloween' /*word to be sorted by (Latin) letter.*/ +upper u /*fast method to uppercase a variable. */ + /*another: u = translate(u) */ + /*another: parse upper var u u */ + /*another: u = upper(u) */ + /*not always available [↑] */ say 'u=' u _.= - do until u=='' /*keep truckin' until U is null.*/ - parse var u y +1 u /*get the next (first) char in U.*/ - xx = '?'y /*assign a prefixed char to XX. */ - _.xx = _.xx || y /*append it to all the Y chars.*/ - end /*until*/ /*U now has the first char gone.*/ - /*Note: the var U is destroyed.*/ + do until u=='' /*keep truckin' until U is null. */ + parse var u y +1 u /*get the next (first) character in U.*/ + xx='?'y /*assign a prefixed character to XX. */ + _.xx=_.xx || y /*append it to all the Y characters. */ + end /*until*/ /*U now has the first character elided.*/ + /*Note: the variable U is destroyed.*/ - /* [↓] build sorted letter word. */ + /* [↓] constructs a sorted letter word*/ z=_.?a||_.?b||_.?c||_.?d||_.?e||_.?f||_.?g||_.?h||_.?i||_.?j||_.?k||_.?l||_.?m||, _.?n||_.?o||_.?p||_.?q||_.?r||_.?s||_.?t||_.?u||_.?v||_.?w||_.?x||_.?y||_.?z - /*Note: the ? is prefixed to the letter to avoid */ - /*collisions with other REXX one-character variables.*/ + /*Note: the ? is prefixed to the letter to avoid */ + /*collisions with other REXX one-character variables.*/ say 'z=' z diff --git a/Task/Anagrams/REXX/anagrams-5.rexx b/Task/Anagrams/REXX/anagrams-5.rexx index baa6d99a7b..bf3588afb2 100644 --- a/Task/Anagrams/REXX/anagrams-5.rexx +++ b/Task/Anagrams/REXX/anagrams-5.rexx @@ -1,16 +1,16 @@ -u='Halloween' /*the word to be sorted by letter*/ -upper u /*fast method to uppercase a var.*/ -L=length(u) /*get the length of the word. */ +u= 'Halloween' /*word to be sorted by (Latin) letter.*/ +upper u /*fast method to uppercase a variable. */ +L=length(u) /*get the length of the word (in bytes)*/ say 'u=' u say 'L=' L _.= - do k=1 for L /*keep truckin' for L chars. */ - parse var u =(k) y +1 /*get Kth character in U string. */ - xx = '?'y /*assign a prefixed char to XX. */ - _.xx = _.xx || y /*append it to all the Y chars.*/ - end /*do k*/ /*U now has the first char gone.*/ + do k=1 for L /*keep truckin' for L characters. */ + parse var u =(k) y +1 /*get the Kth character in U string.*/ + xx='?'y /*assign a prefixed character to XX. */ + _.xx=_.xx || y /*append it to all the Y characters. */ + end /*do k*/ /*U now has the first character elided.*/ - /* [↓] build sorted letter word. */ + /* [↓] construct a sorted letter word.*/ z=_.?a||_.?b||_.?c||_.?d||_.?e||_.?f||_.?g||_.?h||_.?i||_.?j||_.?k||_.?l||_.?m||, _.?n||_.?o||_.?p||_.?q||_.?r||_.?s||_.?t||_.?u||_.?v||_.?w||_.?x||_.?y||_.?z diff --git a/Task/Anagrams/Run-BASIC/anagrams.run b/Task/Anagrams/Run-BASIC/anagrams.run index ce5e72ff58..feb89f6a37 100644 --- a/Task/Anagrams/Run-BASIC/anagrams.run +++ b/Task/Anagrams/Run-BASIC/anagrams.run @@ -1,67 +1,64 @@ -a$ = httpGet$("http://www.puzzlers.org/pub/wordlists/unixdict.txt") ' get the words from this web - -sqliteconnect #mem, ":memory:" ' create in memory DB -#mem execute("CREATE TABLE words(theWord,sortWord)") - -ii = 1 -while ii - jj = instr(a$,chr$(10),ii + 1) - if jj > 0 then - theWord$ = mid$(a$,ii, jj - ii) ' get each word - - if instr(theWord$,"'") <> 0 then theWord$ = dblQuote$(theWord$) ' eclipse the single quote - sortWord$ = theWord$ - ' ------------------------------------ - ' Sort word using the ol bubble sort - ' ------------------------------------ - j = 1 - while j - j = 0 - for i = 1 to len(sortWord$) - 1 - if mid$(sortWord$,i,1) > mid$(sortWord$,i + 1,1) then - sortWord$ = left$(sortWord$,i - 1) + mid$(sortWord$,i + 1,1) + mid$(sortWord$,i,1) + mid$(sortWord$,i + 2) - j = 1 - end if - next i - wend - ' ---------------------------- - ' place in memory sql table - ' ---------------------------- - #mem execute("INSERT INTO words VALUES('";theWord$;"','";sortWord$;"')") - end if - ii = jj + 1 -wend - -' ----------------------------------------------------------- -' Select matched words in word order and print in html table -' ----------------------------------------------------------- -html "" -mem$ = "SELECT words.theWord, -matchWords.theWord as mWord -FROM words -JOIN words as matchWords -ON matchWords.sortWord = words.sortWord -AND matchWOrds.theWord <> words.theWord -ORDER BY words.theWord" +sqliteconnect #mem, ":memory:" +mem$ = "CREATE TABLE anti(gram,ordr); +CREATE INDEX ord ON anti(ordr)" #mem execute(mem$) -WHILE #mem hasanswer() - #row = #mem #nextrow() - theWord$ = #row theWord$() - mWord$ = #row mWord$() - html "" -WEND -html "
";theWord$;"";mWord$;"
" -end +' read the file +a$ = httpGet$("http://www.puzzlers.org/pub/wordlists/unixdict.txt") -' ----------------------------------------- -' Convert single quotes to double quotes -' ----------------------------------------- -FUNCTION dblQuote$(str$) -i = 1 -qq$ = "" -while (word$(str$,i,"'")) <> "" - dblQuote$ = dblQuote$;qq$;word$(str$,i,"'") - qq$ = "''" - i = i + 1 -WEND -END FUNCTION +' break the file words apart +i = 1 +while i <> 0 + j = instr(a$,chr$(10),i+1) + if j = 0 then exit while + a1$ = mid$(a$,i,j-i) + q = instr(a1$,"'") + if q > 0 then a1$ = left$(a1$,q) + mid$(a1$,q) + ln = len(a1$) + s$ = a1$ + + ' Split the characters of the word and sort them + s = 1 + while s = 1 + s = 0 + for k = 1 to ln -1 + if mid$(s$,k,1) > mid$(s$,k+1,1) then + h$ = mid$(s$,k,1) + h1$ = mid$(s$,k+1,1) + s$ = left$(s$,k-1) + h1$ + h$ + mid$(s$,k+2) + s = 1 + end if + next k + wend + + mem$ = "INSERT INTO anti VALUES('";a1$;"','";ord$;"')" + #mem execute(mem$) + i = j +1 +wend +' find all antigrams +mem$ = "SELECT count(*) as cnt,anti.ordr FROM anti GROUP BY ordr ORDER BY cnt desc" +#mem execute(mem$) +numDups = #mem ROWCOUNT() 'Get the number of rows +dim dups$(numDups) +for i = 1 to numDups + #row = #mem #nextrow() + cnt = #row cnt() + if i = 1 then maxCnt = cnt + if cnt < maxCnt then exit for + dups$(i) = #row ordr$() +next i + +for i = 1 to i -1 + mem$ = "SELECT anti.gram FROM anti + WHERE anti.ordr = '";dups$(i);"' + ORDER BY anti.gram" + #mem execute(mem$) + rows = #mem ROWCOUNT() 'Get the number of rows + + for ii = 1 to rows + #row = #mem #nextrow() + gram$ = #row gram$() + print gram$;chr$(9); + next ii + print +next i +end diff --git a/Task/Anagrams/SuperCollider/anagrams-1.supercollider b/Task/Anagrams/SuperCollider/anagrams-1.supercollider new file mode 100644 index 0000000000..225aae592a --- /dev/null +++ b/Task/Anagrams/SuperCollider/anagrams-1.supercollider @@ -0,0 +1,20 @@ +( +var text, words, sorted, dict = IdentityDictionary.new, findMax; +File.use("unixdict.txt".resolveRelative, "r", { |f| text = f.readAllString }); +words = text.split(Char.nl); +sorted = words.collect { |each| + var key = each.copy.sort.asSymbol; + dict[key] ?? { dict[key] = [] }; + dict[key] = dict[key].add(each) +}; +findMax = { |dict| + var size = 0, max = []; + dict.keysValuesDo { |key, val| + if(val.size == size) { max = max.add(val) } { + if(val.size > size) { max = []; size = val.size } + } + }; + max +}; +findMax.(dict) +) diff --git a/Task/Anagrams/SuperCollider/anagrams-2.supercollider b/Task/Anagrams/SuperCollider/anagrams-2.supercollider new file mode 100644 index 0000000000..6ef5595f71 --- /dev/null +++ b/Task/Anagrams/SuperCollider/anagrams-2.supercollider @@ -0,0 +1 @@ +[ [ angel, angle, galen, glean, lange ], [ caret, carte, cater, crate, trace ], [ elan, lane, lean, lena, neal ], [ evil, levi, live, veil, vile ], [ alger, glare, lager, large, regal ] ] diff --git a/Task/Animate-a-pendulum/Fortran/animate-a-pendulum.f b/Task/Animate-a-pendulum/Fortran/animate-a-pendulum.f index 035fabcff2..afeabc99e6 100644 --- a/Task/Animate-a-pendulum/Fortran/animate-a-pendulum.f +++ b/Task/Animate-a-pendulum/Fortran/animate-a-pendulum.f @@ -14,7 +14,7 @@ do exit end if end do -call system('clear') +call execute_command_line('cls') c_ang = s_ang*pi/180.0D0 p_ang = c_ang @@ -23,7 +23,7 @@ call display(c_ang) do call next_time_step(c_ang,p_ang,g,l,dt,n_ang) if(abs(c_ang-p_ang).ge.0.05D0) then - call system('clear') + call execute_command_line('cls') call display(c_ang) end if end do diff --git a/Task/Animate-a-pendulum/J/animate-a-pendulum-2.j b/Task/Animate-a-pendulum/J/animate-a-pendulum-2.j index 574502bc96..dc0bb6faee 100644 --- a/Task/Animate-a-pendulum/J/animate-a-pendulum-2.j +++ b/Task/Animate-a-pendulum/J/animate-a-pendulum-2.j @@ -9,7 +9,7 @@ VEL =: 0 NB. ms_1 PEND=: noun define pc pend;pn "Pendulum"; -minwh 320 200; cc isi isigraph type flush; +minwh 320 200; cc isi isigraph flush; ) pend_run=: verb define diff --git a/Task/Animate-a-pendulum/JavaScript/animate-a-pendulum.js b/Task/Animate-a-pendulum/JavaScript/animate-a-pendulum-1.js similarity index 100% rename from Task/Animate-a-pendulum/JavaScript/animate-a-pendulum.js rename to Task/Animate-a-pendulum/JavaScript/animate-a-pendulum-1.js diff --git a/Task/Animate-a-pendulum/JavaScript/animate-a-pendulum-2.js b/Task/Animate-a-pendulum/JavaScript/animate-a-pendulum-2.js new file mode 100644 index 0000000000..906b58e578 --- /dev/null +++ b/Task/Animate-a-pendulum/JavaScript/animate-a-pendulum-2.js @@ -0,0 +1,62 @@ + + + Swinging Pendulum Simulation + +
+ + + + +
+ Initial angle:(degrees) +
+ + + + + + diff --git a/Task/Animate-a-pendulum/Kotlin/animate-a-pendulum.kotlin b/Task/Animate-a-pendulum/Kotlin/animate-a-pendulum.kotlin index 4c025063ab..f1f48c97a4 100644 --- a/Task/Animate-a-pendulum/Kotlin/animate-a-pendulum.kotlin +++ b/Task/Animate-a-pendulum/Kotlin/animate-a-pendulum.kotlin @@ -1,5 +1,3 @@ -package pendulum - import java.awt.* import java.util.concurrent.* import javax.swing.* @@ -15,14 +13,16 @@ class Pendulum(private val length: Int) : JPanel(), Runnable { } override fun paint(g: Graphics) { - g.color = Color.WHITE - g.fillRect(0, 0, width, height) - g.color = Color.BLACK - val anchor = Element(width / 2, height / 4) - val ball = Element((anchor.x + Math.sin(angle) * length).toInt(), (anchor.y + Math.cos(angle) * length).toInt()) - g.drawLine(anchor.x, anchor.y, ball.x, ball.y) - g.fillOval(anchor.x - 3, anchor.y - 4, 7, 7) - g.fillOval(ball.x - 7, ball.y - 7, 14, 14) + with(g) { + color = Color.WHITE + fillRect(0, 0, width, height) + color = Color.BLACK + val anchor = Element(width / 2, height / 4) + val ball = Element((anchor.x + Math.sin(angle) * length).toInt(), (anchor.y + Math.cos(angle) * length).toInt()) + drawLine(anchor.x, anchor.y, ball.x, ball.y) + fillOval(anchor.x - 3, anchor.y - 4, 7, 7) + fillOval(ball.x - 7, ball.y - 7, 14, 14) + } } override fun run() { diff --git a/Task/Animate-a-pendulum/Ruby/animate-a-pendulum-3.rb b/Task/Animate-a-pendulum/Ruby/animate-a-pendulum-3.rb new file mode 100644 index 0000000000..f20d574bcd --- /dev/null +++ b/Task/Animate-a-pendulum/Ruby/animate-a-pendulum-3.rb @@ -0,0 +1,104 @@ +#!/bin/ruby + +begin; require 'rubygems'; rescue; end + +require 'gosu' +include Gosu + +# Screen size +W = 640 +H = 480 + +# Full-screen mode +FS = false + +# Screen update rate (Hz) +FPS = 60 + +class Pendulum + + attr_accessor :theta, :friction + + def initialize( win, x, y, length, radius, bob = true, friction = false) + @win = win + @centerX = x + @centerY = y + @length = length + @radius = radius + @bob = bob + @friction = friction + + @theta = 60.0 + @omega = 0.0 + @scale = 2.0 / FPS + end + + def draw + @win.translate(@centerX, @centerY) { + @win.rotate(@theta) { + @win.draw_quad(-1, 0, 0x3F_FF_FF_FF, 1, 0, 0x3F_FF_FF_00, 1, @length, 0x3F_FF_FF_00, -1, @length, 0x3F_FF_FF_FF ) + if @bob + @win.translate(0, @length) { + @win.draw_quad(0, -@radius, Color::RED, @radius, 0, Color::BLUE, 0, @radius, Color::WHITE, -@radius, 0, Color::BLUE ) + } + end + } + } + end + + def update + # Thanks to Hugo Elias for the formula (and explanation thereof) + @theta += @omega + @omega = @omega - (Math.sin(@theta * Math::PI / 180) / (@length * @scale)) + @theta *= 0.999 if @friction + end + +end # Pendulum class + +class GfxWindow < Window + + def initialize + # Initialize the base class + super W, H, FS, 1.0 / FPS * 1000 + # self.caption = "You're getting sleeeeepy..." + self.caption = "Ruby/Gosu Pendulum Simulator (Space toggles friction)" + + @n = 1 # Try changing this number! + @pendulums = [] + (1..@n).each do |i| + @pendulums.push Pendulum.new( self, W / 2, H / 10, H * 0.75 * (i / @n.to_f), H / 60 ) + end + + end + + def draw + @pendulums.each { |pen| pen.draw } + end + + def update + @pendulums.each { |pen| pen.update } + end + + def button_up(id) + if id == KbSpace + @pendulums.each { |pen| + pen.friction = !pen.friction + pen.theta = (pen.theta <=> 0) * 45.0 unless pen.friction + } + else + close + end + end + + def needs_cursor?() + true + end + +end # GfxWindow class + +begin + GfxWindow.new.show +rescue Exception => e + puts e.message, e.backtrace + gets +end diff --git a/Task/Animate-a-pendulum/ZX-Spectrum-Basic/animate-a-pendulum.zx b/Task/Animate-a-pendulum/ZX-Spectrum-Basic/animate-a-pendulum.zx new file mode 100644 index 0000000000..4760f31798 --- /dev/null +++ b/Task/Animate-a-pendulum/ZX-Spectrum-Basic/animate-a-pendulum.zx @@ -0,0 +1,17 @@ +10 OVER 1: CLS +20 LET theta=1 +30 LET g=9.81 +40 LET l=0.5 +50 LET speed=0 +100 LET pivotx=120 +110 LET pivoty=140 +120 LET bobx=pivotx+l*100*SIN (theta) +130 LET boby=pivoty+l*100*COS (theta) +140 GO SUB 1000: PAUSE 1: GO SUB 1000 +190 LET accel=g*SIN (theta)/l/100 +200 LET speed=speed+accel/100 +210 LET theta=theta+speed +220 GO TO 100 +1000 PLOT pivotx,pivoty: DRAW bobx-pivotx,boby-pivoty +1010 CIRCLE bobx,boby,3 +1020 RETURN diff --git a/Task/Animation/00DESCRIPTION b/Task/Animation/00DESCRIPTION index ae07b2fd12..f50a055bae 100644 --- a/Task/Animation/00DESCRIPTION +++ b/Task/Animation/00DESCRIPTION @@ -1,3 +1,10 @@ -'''Animation''' is integral to many parts of [[GUI]]s, including both the fancy effects when things change used in window managers, and of course games. The core of any animation system is a scheme for periodically changing the display while still remaining responsive to the user. This task demonstrates this. +'''Animation''' is integral to many parts of [[GUI]]s, including both the fancy effects when things change used in window managers, and of course games.   The core of any animation system is a scheme for periodically changing the display while still remaining responsive to the user.   This task demonstrates this. -Create a window containing the string "Hello World! " (the trailing space is significant). Make the text appear to be rotating right by periodically removing one letter from the end of the string and attaching it to the front. When the user clicks on the text, it should reverse its direction. + +;Task: +Create a window containing the string "Hello World! " (the trailing space is significant). + +Make the text appear to be rotating right by periodically removing one letter from the end of the string and attaching it to the front. + +When the user clicks on the (windowed) text, it should reverse its direction. +

diff --git a/Task/Animation/Go/animation.go b/Task/Animation/Go/animation.go new file mode 100644 index 0000000000..13c62b51d9 --- /dev/null +++ b/Task/Animation/Go/animation.go @@ -0,0 +1,58 @@ +package main + +import ( + "log" + "time" + + "github.com/gdamore/tcell" +) + +const ( + msg = "Hello World! " + x0, y0 = 8, 3 + shiftsPerSecond = 4 + clicksToExit = 5 +) + +func main() { + s, err := tcell.NewScreen() + if err != nil { + log.Fatal(err) + } + if err = s.Init(); err != nil { + log.Fatal(err) + } + s.Clear() + s.EnableMouse() + tick := time.Tick(time.Second / shiftsPerSecond) + click := make(chan bool) + go func() { + for { + em, ok := s.PollEvent().(*tcell.EventMouse) + if !ok || em.Buttons()&0xFF == tcell.ButtonNone { + continue + } + mx, my := em.Position() + if my == y0 && mx >= x0 && mx < x0+len(msg) { + click <- true + } + } + }() + for inc, shift, clicks := 1, 0, 0; ; { + select { + case <-tick: + shift = (shift + inc) % len(msg) + for i, r := range msg { + s.SetContent(x0+((shift+i)%len(msg)), y0, r, nil, 0) + } + s.Show() + case <-click: + clicks++ + if clicks == clicksToExit { + s.Fini() + return + } + inc = len(msg) - inc + } + } +} diff --git a/Task/Animation/HicEst/animation.hicest b/Task/Animation/HicEst/animation.hicest new file mode 100644 index 0000000000..a510f720fc --- /dev/null +++ b/Task/Animation/HicEst/animation.hicest @@ -0,0 +1,18 @@ +CHARACTER string="Hello World! " + + WINDOW(WINdowhandle=wh, Height=1, X=1, TItle="left/right click to rotate left/right, Y-click-position sets milliseconds period") + AXIS(WINdowhandle=wh, PoinT=20, X=2048, Y, Title='ms', MiN=0, MaX=400, MouSeY=msec, MouSeCall=Mouse_callback, MouSeButton=button_type) + direction = 4 + msec = 100 ! initial milliseconds + DO tic = 1, 1E20 + WRITE(WIN=wh, Align='Center Vertical') string + IF(direction == 4) string = string(LEN(string)) // string ! rotate left + IF(direction == 8) string = string(2:) // string(1) ! rotate right + WRITE(StatusBar, Name) tic, direction, msec + SYSTEM(WAIT=msec) + ENDDO + END + +SUBROUTINE Mouse_callback() + direction = button_type ! 4 == left button up, 8 == right button up + END diff --git a/Task/Animation/Icon/animation-1.icon b/Task/Animation/Icon/animation-1.icon new file mode 100644 index 0000000000..e0fad2322e --- /dev/null +++ b/Task/Animation/Icon/animation-1.icon @@ -0,0 +1,44 @@ +import gui +$include "guih.icn" + +class WindowApp : Dialog (label, direction) + + method rotate_left (msg) + return msg[2:0] || msg[1] + end + + method rotate_right (msg) + return msg[-1:0] || msg[1:-1] + end + + method reverse_direction () + direction := 1-direction + end + + # this method gets called by the ticker, and updates the label + method tick () + static msg := "Hello World! " + if direction = 0 + then msg := rotate_left (msg) + else msg := rotate_right (msg) + label.set_label(msg) + end + + method component_setup () + direction := 1 # start off rotating to the right + label := Label("label=Hello World! ", "pos=0,0") + # respond to a mouse click on the label + label.connect (self, "reverse_direction", MOUSE_RELEASE_EVENT) + add (label) + + connect (self, "dispose", CLOSE_BUTTON_EVENT) + # tick every 100ms + self.set_ticker (100) + end +end + +# create and show the window +procedure main () + w := WindowApp () + w.show_modal () +end diff --git a/Task/Animation/Icon/animation-2.icon b/Task/Animation/Icon/animation-2.icon new file mode 100644 index 0000000000..5bcc046049 --- /dev/null +++ b/Task/Animation/Icon/animation-2.icon @@ -0,0 +1,21 @@ +link graphics + +procedure main() + s := "Hello World! " + WOpen("size=640,400", "label=Animation") + Font("typewriter,60,bold") + direction := 1 + w := TextWidth(s) + h := WAttrib("fheight") + x := (WAttrib("width") - w) / 2 + y := (WAttrib("height") - 20 + h) / 2 + + repeat + { if *Pending() > 0 then if (Event() = &lrelease) & (x < &x < x + w) & (y > &y > y-h) then direction := ixor(direction, 1) + s := s[2 - 3 * direction:0] || s[1:2 - 3 * direction] + EraseArea(x, y, w, -h) + DrawString(x,y - WAttrib("descent")-1,s) + WFlush() + delay(250) + } +end diff --git a/Task/Animation/ZX-Spectrum-Basic/animation.zx b/Task/Animation/ZX-Spectrum-Basic/animation.zx new file mode 100644 index 0000000000..0bcf23bfe0 --- /dev/null +++ b/Task/Animation/ZX-Spectrum-Basic/animation.zx @@ -0,0 +1,7 @@ +10 LET t$="Hello world! ": LET lt=LEN t$ +20 LET direction=1 +30 PRINT AT 0,0;t$ +40 IF direction THEN LET t$=t$(2 TO )+t$(1): GO TO 60 +50 LET t$=t$(lt)+t$( TO lt-1) +60 IF INKEY$<>"" THEN LET direction=NOT direction +70 PAUSE 5: GO TO 30 diff --git a/Task/Anonymous-recursion/00DESCRIPTION b/Task/Anonymous-recursion/00DESCRIPTION index 0a0f286b5e..2d124b9077 100644 --- a/Task/Anonymous-recursion/00DESCRIPTION +++ b/Task/Anonymous-recursion/00DESCRIPTION @@ -1,15 +1,18 @@ -While implementing a recursive function, it often happens that we must resort to a separate "helper function" to handle the actual recursion. +While implementing a recursive function, it often happens that we must resort to a separate   ''helper function''   to handle the actual recursion. -This is usually the case when directly calling the current function would waste too many resources (stack space, execution time), cause unwanted side-effects, and/or the function doesn't have the right arguments and/or return values. +This is usually the case when directly calling the current function would waste too many resources (stack space, execution time), causing unwanted side-effects,   and/or the function doesn't have the right arguments and/or return values. -So we end up inventing some silly name like "foo2" or "foo_helper". I have always found it painful to come up with a proper name, and see a quite some disadvantages: +So we end up inventing some silly name like   '''foo2'''   or   '''foo_helper'''.   I have always found it painful to come up with a proper name, and see some disadvantages: -* You have to think up a name, which then pollutes the namespace -* A function is created which is called from nowhere else -* The program flow in the source code is interrupted +::*   You have to think up a name, which then pollutes the namespace +::*   Function is created which is called from nowhere else +::*   The program flow in the source code is interrupted -Some languages allow you to embed recursion directly in-place. This might work via a label, a local ''gosub'' instruction, or some special keyword. +Some languages allow you to embed recursion directly in-place.   This might work via a label, a local ''gosub'' instruction, or some special keyword. -Anonymous recursion can also be accomplished using the [[Y combinator]]. +Anonymous recursion can also be accomplished using the   [[Y combinator]]. -If possible, demonstrate this by writing the recursive version of the fibonacci function (see [[Fibonacci sequence]]) which checks for a negative argument before doing the actual recursion. + +;Task: +If possible, demonstrate this by writing the recursive version of the fibonacci function   (see [[Fibonacci sequence]])   which checks for a negative argument before doing the actual recursion. +

diff --git a/Task/Anonymous-recursion/ALGOL-68/anonymous-recursion.alg b/Task/Anonymous-recursion/ALGOL-68/anonymous-recursion.alg new file mode 100644 index 0000000000..76bbab5795 --- /dev/null +++ b/Task/Anonymous-recursion/ALGOL-68/anonymous-recursion.alg @@ -0,0 +1,15 @@ +PROC fibonacci = ( INT x )INT: + IF x < 0 + THEN + print( ( "negative parameter to fibonacci", newline ) ); + stop + ELSE + PROC actual fibonacci = ( INT n )INT: + IF n < 2 + THEN + n + ELSE + actual fibonacci( n - 1 ) + actual fibonacci( n - 2 ) + FI; + actual fibonacci( x ) + FI; diff --git a/Task/Anonymous-recursion/Elena/anonymous-recursion.elena b/Task/Anonymous-recursion/Elena/anonymous-recursion.elena index a4ff364c13..d1f82c10b0 100644 --- a/Task/Anonymous-recursion/Elena/anonymous-recursion.elena +++ b/Task/Anonymous-recursion/Elena/anonymous-recursion.elena @@ -1,13 +1,20 @@ -#define system. -#define extensions. +#import system. +#import extensions. -#symbol fibo = (:n) -[ - (n < 0) - ? [ #throw InvalidArgumentException new &message:"Must be non negative". ]. +#class(extension)mathOp +{ + #method fib + [ + (self < 0) + ? [ #throw InvalidArgumentException new &message:"Must be non negative". ]. - ^ { eval:n [ ^ (n > 1) ? [ ($self:(n - 2)) + ($self:(n - 1)) ] ! [ n ]. ] }:n. -]. + ^ control eval:self &for: + (:n) + [ + (n > 1) ? [ this eval:(n - 2) + this eval:(n - 1) ] ! [ n ] + ]. + ] +} #symbol program = [ @@ -15,7 +22,7 @@ [ console writeLiteral:"fib(":i:")=". - console writeLine:(fibo:i) | if &InvalidArgumentError: e + console writeLine:(i fib) | if &InvalidArgumentError: e [ console writeLine:"invalid". ]. diff --git a/Task/Anonymous-recursion/Io/anonymous-recursion.io b/Task/Anonymous-recursion/Io/anonymous-recursion.io new file mode 100644 index 0000000000..2119aacdac --- /dev/null +++ b/Task/Anonymous-recursion/Io/anonymous-recursion.io @@ -0,0 +1,7 @@ +fib := method(x, + if(x < 0, Exception raise("Negative argument not allowed!")) + fib2 := method(n, + if(n < 2, n, fib2(n-1) + fib2(n-2)) + ) + fib2(x floor) +) diff --git a/Task/Anonymous-recursion/REXX/anonymous-recursion-1.rexx b/Task/Anonymous-recursion/REXX/anonymous-recursion-1.rexx new file mode 100644 index 0000000000..0052921a0d --- /dev/null +++ b/Task/Anonymous-recursion/REXX/anonymous-recursion-1.rexx @@ -0,0 +1,13 @@ +/*REXX program to show anonymous recursion (of a function or subroutine). */ +numeric digits 1e6 /*in case the user goes ka-razy. */ +parse arg x . /*obtain the optional argument from CL.*/ +if x=='' | x=="," then x=12 /*Not specified? Then use the default.*/ +w=length(x) /*W: used for formatting the output. */ + do j=0 to x; jj=right(j, w) /*use the argument as an upper limit.*/ + say 'fibonacci('jj") =" fib(j) /*show the Fibonacci sequence: 0 ──► x */ + end /*j*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +fib: procedure; parse arg z; if z>=0 then return .(z) + say "***error*** argument can't be negative."; exit +.: procedure; parse arg #; if #<2 then return #; return .(#-1) + .(#-2) diff --git a/Task/Anonymous-recursion/REXX/anonymous-recursion-2.rexx b/Task/Anonymous-recursion/REXX/anonymous-recursion-2.rexx new file mode 100644 index 0000000000..dff9575bbe --- /dev/null +++ b/Task/Anonymous-recursion/REXX/anonymous-recursion-2.rexx @@ -0,0 +1,14 @@ +/*REXX program to show anonymous recursion of a function or subroutine with memoization.*/ +numeric digits 1e6 /*in case the user goes ka-razy. */ +parse arg x . /*obtain the optional argument from CL.*/ +if x=='' | x=="," then x=12 /*Not specified? Then use the default.*/ +@.=.; @.0=0; @.1=1 /*used to implement memoization for FIB*/ +w=length(x) /*W: used for formatting the output. */ + do j=0 to x; jj=right(j, w) /*use the argument as an upper limit.*/ + say 'fibonacci('jj") =" fib(j) /*show the Fibonacci sequence: 0 ──► x */ + end /*j*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +fib: procedure expose @.; arg z; if z>=0 then return .(z) + say "***error*** argument can't be negative."; exit +.: procedure expose @.; arg #; if @.#\==. then return @.#; @.#=.(#-1)+.(#-2); return @.# diff --git a/Task/Anonymous-recursion/REXX/anonymous-recursion.rexx b/Task/Anonymous-recursion/REXX/anonymous-recursion.rexx deleted file mode 100644 index 2d77316544..0000000000 --- a/Task/Anonymous-recursion/REXX/anonymous-recursion.rexx +++ /dev/null @@ -1,11 +0,0 @@ -/*REXX program to show anonymous recursion (of a function/subroutine). */ -numeric digits 1e6 /*in case the user goes kaa-razy.*/ - - do j=0 to word(arg(1) 12, 1) /*use argument or the default: 12*/ - say 'fibonacci('j") =" fib(j) /*show Fibonacci sequence: 0──►x */ - end /*j*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────subroutines─────────────────────────*/ -fib: procedure; if arg(1)>=0 then return .(arg(1)) - say "***error!*** argument can't be negative."; exit -.:procedure; arg _; if _<2 then return _; return .(_-1)+.(_-2) diff --git a/Task/Anonymous-recursion/ZX-Spectrum-Basic/anonymous-recursion.zx b/Task/Anonymous-recursion/ZX-Spectrum-Basic/anonymous-recursion.zx new file mode 100644 index 0000000000..5a39fe6673 --- /dev/null +++ b/Task/Anonymous-recursion/ZX-Spectrum-Basic/anonymous-recursion.zx @@ -0,0 +1,12 @@ +10 INPUT "Enter a number: ";n +20 LET t=0 +30 GO SUB 60 +40 PRINT t +50 STOP +60 LET nold1=1: LET nold2=0 +70 IF n<0 THEN PRINT "Positive argument required!": RETURN +80 IF n=0 THEN LET t=nold2: RETURN +90 IF n=1 THEN LET t=nold1: RETURN +100 LET t=nold2+nold1 +110 IF n>2 THEN LET n=n-1: LET nold2=nold1: LET nold1=t: GO SUB 100 +120 RETURN diff --git a/Task/Append-a-record-to-the-end-of-a-text-file/00DESCRIPTION b/Task/Append-a-record-to-the-end-of-a-text-file/00DESCRIPTION index 34ab44e60d..f1dc5e9517 100644 --- a/Task/Append-a-record-to-the-end-of-a-text-file/00DESCRIPTION +++ b/Task/Append-a-record-to-the-end-of-a-text-file/00DESCRIPTION @@ -2,7 +2,8 @@ Many systems offer the ability to open a file for writing, such that any data wr This feature is most useful in the case of log files, where many jobs may be appending to the log file at the same time, or where care ''must'' be taken to avoid concurrently overwriting the same record from another job. -'''Task:''' + +;Task: Given a two record sample for a mythical "passwd" file: * Write these records out in the typical system format. ** Ideally these records will have named fields of various types. @@ -56,3 +57,4 @@ Appended record: xyz:x:1003:1000:X Yz,Room 1003,(234)555-8913,(234)555-0033,xyz@ |} Alternatively: If the language's appends can not guarantee its writes will '''always''' append, then note this restriction in the table. If possible, provide an actual code example (possibly using file/record locking) to guarantee correct concurrent appends. +

diff --git a/Task/Append-a-record-to-the-end-of-a-text-file/AWK/append-a-record-to-the-end-of-a-text-file.awk b/Task/Append-a-record-to-the-end-of-a-text-file/AWK/append-a-record-to-the-end-of-a-text-file.awk new file mode 100644 index 0000000000..3ae75a10b0 --- /dev/null +++ b/Task/Append-a-record-to-the-end-of-a-text-file/AWK/append-a-record-to-the-end-of-a-text-file.awk @@ -0,0 +1,24 @@ +# syntax: GAWK -f APPEND_A_RECORD_TO_THE_END_OF_A_TEXT_FILE.AWK +BEGIN { + fn = "\\etc\\passwd" +# create and populate file + print("account:password:UID:GID:fullname,office,extension,homephone,email:directory:shell") >fn + print("jsmith:x:1001:1000:Joe Smith,Room 1007,(234)555-8917,(234)555-0077,jsmith@rosettacode.org:/home/jsmith:/bin/bash") >fn + print("jdoe:x:1002:1000:Jane Doe,Room 1004,(234)555-8914,(234)555-0044,jdoe@rosettacode.org:/home/jdoe:/bin/bash") >fn + close(fn) + show_file("initial file") +# append record + print("xyz:x:1003:1000:X Yz,Room 1003,(234)555-8913,(234)555-0033,xyz@rosettacode.org:/home/xyz:/bin/bash") >>fn + close(fn) + show_file("file after append") + exit(0) +} +function show_file(desc, nr,rec) { + printf("%s:\n",desc) + while (getline rec 0) { + nr++ + printf("%s\n",rec) + } + close(fn) + printf("%d records\n\n",nr) +} diff --git a/Task/Append-a-record-to-the-end-of-a-text-file/COBOL/append-a-record-to-the-end-of-a-text-file.cobol b/Task/Append-a-record-to-the-end-of-a-text-file/COBOL/append-a-record-to-the-end-of-a-text-file.cobol new file mode 100644 index 0000000000..50332e8791 --- /dev/null +++ b/Task/Append-a-record-to-the-end-of-a-text-file/COBOL/append-a-record-to-the-end-of-a-text-file.cobol @@ -0,0 +1,272 @@ + *> Tectonics: + *> cobc -xj append.cob + *> cobc -xjd -DDEBUG append.cob + *> *************************************************************** + identification division. + program-id. append. + + environment division. + configuration section. + repository. + function all intrinsic. + + input-output section. + file-control. + select pass-file + assign to pass-filename + organization is line sequential + status is pass-status. + + REPLACE ==:LRECL:== BY ==2048==. + + data division. + file section. + fd pass-file record varying depending on pass-length. + 01 fd-pass-record. + 05 filler pic x occurs 0 to :LRECL: times + depending on pass-length. + + working-storage section. + 01 pass-filename. + 05 filler value "passfile". + 01 pass-status pic xx. + 88 ok-status values '00' thru '09'. + 88 eof-pass value '10'. + + 01 pass-length usage index. + 01 total-length usage index. + + 77 file-action pic x(11). + + 01 pass-record. + 05 account pic x(64). + 88 key-account value "xyz". + 05 password pic x(64). + 05 uid pic z(4)9. + 05 gid pic z(4)9. + 05 details. + 10 fullname pic x(128). + 10 office pic x(128). + 10 extension pic x(32). + 10 homephone pic x(32). + 10 email pic x(256). + 05 homedir pic x(256). + 05 shell pic x(256). + + 77 colon pic x value ":". + 77 comma-mark pic x value ",". + 77 newline pic x value x"0a". + + *> *************************************************************** + procedure division. + main-routine. + perform initial-fill + + >>IF DEBUG IS DEFINED + display "Initial data:" + perform show-records + >>END-IF + + perform append-record + + >>IF DEBUG IS DEFINED + display newline "After append:" + perform show-records + >>END-IF + + perform verify-append + goback + . + + *> *************************************************************** + initial-fill. + perform open-output-pass-file + + move "jsmith" to account + move "x" to password + move 1001 to uid + move 1000 to gid + move "Joe Smith" to fullname + move "Room 1007" to office + move "(234)555-8917" to extension + move "(234)555-0077" to homephone + move "jsmith@rosettacode.org" to email + move "/home/jsmith" to homedir + move "/bin/bash" to shell + perform write-pass-record + + move "jdoe" to account + move "x" to password + move 1002 to uid + move 1000 to gid + move "Jane Doe" to fullname + move "Room 1004" to office + move "(234)555-8914" to extension + move "(234)555-0044" to homephone + move "jdoe@rosettacode.org" to email + move "/home/jdoe" to homedir + move "/bin/bash" to shell + perform write-pass-record + + perform close-pass-file + . + + *> ********************** + check-pass-file. + if not ok-status then + perform file-error + end-if + . + + *> ********************** + check-pass-with-eof. + if not ok-status and not eof-pass then + perform file-error + end-if + . + + *> ********************** + file-error. + display "error " file-action space pass-filename + space pass-status upon syserr + move 1 to return-code + goback + . + + *> ********************** + append-record. + move "xyz" to account + move "x" to password + move 1003 to uid + move 1000 to gid + move "X Yz" to fullname + move "Room 1003" to office + move "(234)555-8913" to extension + move "(234)555-0033" to homephone + move "xyz@rosettacode.org" to email + move "/home/xyz" to homedir + move "/bin/bash" to shell + + perform open-extend-pass-file + perform write-pass-record + perform close-pass-file + . + + *> ********************** + open-output-pass-file. + open output pass-file with lock + move "open output" to file-action + perform check-pass-file + . + + *> ********************** + open-extend-pass-file. + open extend pass-file with lock + move "open extend" to file-action + perform check-pass-file + . + + *> ********************** + open-input-pass-file. + open input pass-file + move "open input" to file-action + perform check-pass-file + . + + *> ********************** + close-pass-file. + close pass-file + move "closing" to file-action + perform check-pass-file + . + + *> ********************** + write-pass-record. + set total-length to 1 + set pass-length to :LRECL: + string + account delimited by space + colon + password delimited by space + colon + trim(uid leading) delimited by size + colon + trim(gid leading) delimited by size + colon + trim(fullname trailing) delimited by size + comma-mark + trim(office trailing) delimited by size + comma-mark + trim(extension trailing) delimited by size + comma-mark + trim(homephone trailing) delimited by size + comma-mark + email delimited by space + colon + trim(homedir trailing) delimited by size + colon + trim(shell trailing) delimited by size + into fd-pass-record with pointer total-length + on overflow + display "error: fd-pass-record truncated at " + total-length upon syserr + end-string + set pass-length to total-length + set pass-length down by 1 + + write fd-pass-record + move "writing" to file-action + perform check-pass-file + . + + *> ********************** + read-pass-file. + read pass-file + move "reading" to file-action + perform check-pass-with-eof + . + + *> ********************** + show-records. + perform open-input-pass-file + + perform read-pass-file + perform until eof-pass + perform show-pass-record + perform read-pass-file + end-perform + + perform close-pass-file + . + + *> ********************** + show-pass-record. + display fd-pass-record + . + + *> ********************** + verify-append. + perform open-input-pass-file + + move 0 to tally + perform read-pass-file + perform until eof-pass + add 1 to tally + unstring fd-pass-record delimited by colon + into account + if key-account then exit perform end-if + perform read-pass-file + end-perform + if (key-account and tally not > 2) or (not key-account) then + display + "error: appended record not found in correct position" + upon syserr + else + display "Appended record: " with no advancing + perform show-pass-record + end-if + + perform close-pass-file + . + + end program append. diff --git a/Task/Append-a-record-to-the-end-of-a-text-file/Elixir/append-a-record-to-the-end-of-a-text-file.elixir b/Task/Append-a-record-to-the-end-of-a-text-file/Elixir/append-a-record-to-the-end-of-a-text-file.elixir new file mode 100644 index 0000000000..3f49880c9a --- /dev/null +++ b/Task/Append-a-record-to-the-end-of-a-text-file/Elixir/append-a-record-to-the-end-of-a-text-file.elixir @@ -0,0 +1,88 @@ +defmodule Gecos do + defstruct [:fullname, :office, :extension, :homephone, :email] +end + +defmodule Passwd do + defstruct [:account, :password, :uid, :gid, :gecos, :directory, :shell] +end + +defimpl String.Chars, for: Gecos do + def to_string(gecos) do + [:fullname, :office, :extension, :homephone, :email] + |> Enum.map(&Map.get(gecos, &1)) + |> Enum.join(",") + end +end + +defimpl String.Chars, for: Passwd do + def to_string(passwd) do + [:account, :password, :uid, :gid, :gecos, :directory, :shell] + |> Enum.map(&String.Chars.to_string(Map.get(passwd, &1))) + |> Enum.join(":") + end +end + +defmodule Appender do + def write(filename) do + jsmith = %Passwd{ + account: "jsmith", + password: "x", + uid: 1001, + gid: 1000, + gecos: %Gecos{ + fullname: "Joe Smith", + office: "Room 1007", + extension: "(234)555-8917", + homephone: "(234)555-0077", + email: "jsmith@rosettacode.org" + }, + directory: "/home/jsmith", + shell: "/bin/bash" + } + + jdoe = %Passwd{ + account: "jdoe", + password: "x", + uid: 1002, + gid: 1000, + gecos: %Gecos{ + fullname: "Jane Doe", + office: "Room 1004", + extension: "(234)555-8914", + homephone: "(234)555-0044", + email: "jdoe@rosettacode.org" + }, + directory: "/home/jdoe", + shell: "/bin/bash" + } + + xyz = %Passwd{ + account: "xyz", + password: "x", + uid: 1003, + gid: 1000, + gecos: %Gecos{ + fullname: "X Yz", + office: "Room 1003", + extension: "(234)555-8913", + homephone: "(234)555-0033", + email: "xyz@rosettacode.org" + }, + directory: "/home/xyz", + shell: "/bin/bash" + } + + {:ok, file} = File.open(filename, [:write]) + IO.puts(file, jsmith) + IO.puts(file, jdoe) + File.close(file) + + {:ok, file} = File.open(filename, [:append]) + IO.puts(file, xyz) + File.close(file) + + IO.puts File.read!(filename) + end +end + +Appender.write("passwd.txt") diff --git a/Task/Append-a-record-to-the-end-of-a-text-file/Fortran/append-a-record-to-the-end-of-a-text-file.f b/Task/Append-a-record-to-the-end-of-a-text-file/Fortran/append-a-record-to-the-end-of-a-text-file.f new file mode 100644 index 0000000000..f0042d9181 --- /dev/null +++ b/Task/Append-a-record-to-the-end-of-a-text-file/Fortran/append-a-record-to-the-end-of-a-text-file.f @@ -0,0 +1,64 @@ + PROGRAM DEMO !As per the described task, more or less. + TYPE DETAILS !Define a component. + CHARACTER*28 FULLNAME + CHARACTER*12 OFFICE + CHARACTER*16 EXTENSION + CHARACTER*16 HOMEPHONE + CHARACTER*88 EMAIL + END TYPE DETAILS + TYPE USERSTUFF !Define the desired data aggregate. + CHARACTER*8 ACCOUNT + CHARACTER*8 PASSWORD !Plain text!! Eeek!!! + INTEGER*2 UID + INTEGER*2 GID + TYPE(DETAILS) PERSON + CHARACTER*18 DIRECTORY + CHARACTER*12 SHELL + END TYPE USERSTUFF + TYPE(USERSTUFF) NOTE !After all that, I'll have one. + NAMELIST /STUFF/ NOTE !Enables free-format I/O, with names. + INTEGER F,MSG,N + MSG = 6 !Standard output. + F = 10 !Suitable for some arbitrary file. + OPEN(MSG, DELIM = "QUOTE") !Text variables are to be enquoted. + +Create the file and supply its initial content. + OPEN (F, FILE="Staff.txt",STATUS="REPLACE",ACTION="WRITE", + 1 DELIM="QUOTE",RECL=666) !Special parameters for the free-format WRITE working. + + WRITE (F,*) USERSTUFF("jsmith","x",1001,1000, + 1 DETAILS("Joe Smith","Room 1007","(234)555-8917", + 2 "(234)555-0077","jsmith@rosettacode.org"), + 2 "/home/jsmith","/bin/bash") + + WRITE (F,*) USERSTUFF("jdoe","x",1002,1000, + 1 DETAILS("Jane Doe","Room 1004","(234)555-8914", + 2 "(234)555-0044","jdoe@rosettacode.org"), + 3 "home/jdoe","/bin/bash") + CLOSE (F) !The file is now existing. + +Choose the existing file, and append a further record to it. + OPEN (F, FILE="Staff.txt",STATUS="OLD",ACTION="WRITE", + 1 DELIM="QUOTE",RECL=666,ACCESS="APPEND") + + NOTE = USERSTUFF("xyz","x",1003,1000, !Create a new record's worth of stuff. + 1 DETAILS("X Yz","Room 1003","(234)555-8193", + 2 "(234)555-033","xyz@rosettacode.org"), + 3 "/home/xyz","/bin/bash") + WRITE (F,*) NOTE !Append it's content to the file. + CLOSE (F) + +Chase through the file, revealing what had been written.. + OPEN (F, FILE="Staff.txt",STATUS="OLD",ACTION="READ", + 1 DELIM="QUOTE",RECL=666) + N = 0 + 10 READ (F,*,END = 20) NOTE !As it went out, so it comes in. + N = N + 1 !Another record read. + WRITE (MSG,11) N !Announce. + 11 FORMAT (/,"Record ",I0) !Thus without quotes around the text part. + WRITE (MSG,STUFF) !Reveal. + GO TO 10 !Try again. + +Closedown. + 20 CLOSE (F) + END diff --git a/Task/Append-a-record-to-the-end-of-a-text-file/PowerShell/append-a-record-to-the-end-of-a-text-file-1.psh b/Task/Append-a-record-to-the-end-of-a-text-file/PowerShell/append-a-record-to-the-end-of-a-text-file-1.psh new file mode 100644 index 0000000000..a512fd4292 --- /dev/null +++ b/Task/Append-a-record-to-the-end-of-a-text-file/PowerShell/append-a-record-to-the-end-of-a-text-file-1.psh @@ -0,0 +1,163 @@ +function Test-FileLock +{ + Param + ( + [parameter(Mandatory=$true)] + [string] + $Path + ) + + $outFile = New-Object System.IO.FileInfo $Path + + if (-not(Test-Path -Path $Path)) + { + return $false + } + + try + { + $outStream = $outFile.Open([System.IO.FileMode]::Open, [System.IO.FileAccess]::ReadWrite, [System.IO.FileShare]::None) + + if ($outStream) + { + $outStream.Close() + } + + return $false + } + catch + { + # File is locked by a process. + return $true + } +} + +function New-Record +{ + Param + ( + [string]$Account, + [string]$Password, + [int]$UID, + [int]$GID, + [string]$FullName, + [string]$Office, + [string]$Extension, + [string]$HomePhone, + [string]$Email, + [string]$Directory, + [string]$Shell + ) + + $GECOS = [PSCustomObject]@{ + FullName = $FullName + Office = $Office + Extension = $Extension + HomePhone = $HomePhone + Email = $Email + } + + [PSCustomObject]@{ + Account = $Account + Password = $Password + UID = $UID + GID = $GID + GECOS = $GECOS + Directory = $Directory + Shell = $Shell + } +} + + +function Import-File +{ + Param + ( + [Parameter(Mandatory=$false, + ValueFromPipeline=$true, + ValueFromPipelineByPropertyName=$true)] + [string] + $Path = ".\passwd.txt" + ) + + if (-not(Test-Path $Path)) + { + throw [System.IO.FileNotFoundException] + } + + $header = "Account","Password","UID","GID","GECOS","Directory","Shell" + + $csv = Import-Csv -Path $Path -Delimiter ":" -Header $header -Encoding ASCII + $csv | ForEach-Object { + New-Record -Account $_.Account ` + -Password $_.Password ` + -UID $_.UID ` + -GID $_.GID ` + -FullName $_.GECOS.Split(",")[0] ` + -Office $_.GECOS.Split(",")[1] ` + -Extension $_.GECOS.Split(",")[2] ` + -HomePhone $_.GECOS.Split(",")[3] ` + -Email $_.GECOS.Split(",")[4] ` + -Directory $_.Directory ` + -Shell $_.Shell + } +} + + +function Export-File +{ + [CmdletBinding()] + Param + ( + [Parameter(Mandatory=$true, + ValueFromPipeline=$true, + ValueFromPipelineByPropertyName=$true)] + $InputObject, + + [Parameter(Mandatory=$false, + ValueFromPipeline=$true, + ValueFromPipelineByPropertyName=$true)] + [string] + $Path = ".\passwd.txt" + ) + + Begin + { + if (-not(Test-Path $Path)) + { + New-Item -Path . -Name $Path -ItemType File | Out-Null + } + + [string]$recordString = "{0}:{1}:{2}:{3}:{4}:{5}:{6}" + [string]$gecosString = "{0},{1},{2},{3},{4}" + [string[]]$lines = @() + [string[]]$file = Get-Content $Path + } + Process + { + foreach ($object in $InputObject) + { + $lines += $recordString -f $object.Account, + $object.Password, + $object.UID, + $object.GID, + $($gecosString -f $object.GECOS.FullName, + $object.GECOS.Office, + $object.GECOS.Extension, + $object.GECOS.HomePhone, + $object.GECOS.Email), + $object.Directory, + $object.Shell + } + } + End + { + foreach ($line in $lines) + { + if (-not ($line -in $file)) + { + $line | Out-File -FilePath $Path -Encoding ASCII -Append + } + } + } +} diff --git a/Task/Append-a-record-to-the-end-of-a-text-file/PowerShell/append-a-record-to-the-end-of-a-text-file-2.psh b/Task/Append-a-record-to-the-end-of-a-text-file/PowerShell/append-a-record-to-the-end-of-a-text-file-2.psh new file mode 100644 index 0000000000..47fd84d242 --- /dev/null +++ b/Task/Append-a-record-to-the-end-of-a-text-file/PowerShell/append-a-record-to-the-end-of-a-text-file-2.psh @@ -0,0 +1,25 @@ +$records = @() + +$records+= New-Record -Account 'jsmith' ` + -Password 'x' ` + -UID 1001 ` + -GID 1000 ` + -FullName 'Joe Smith' ` + -Office 'Room 1007' ` + -Extension '(234)555-8917' ` + -HomePhone '(234)555-0077' ` + -Email 'jsmith@rosettacode.org' ` + -Directory '/home/jsmith' ` + -Shell '/bin/bash' + +$records+= New-Record -Account 'jdoe' ` + -Password 'x' ` + -UID 1002 ` + -GID 1000 ` + -FullName 'Jane Doe' ` + -Office 'Room 1004' ` + -Extension '(234)555-8914' ` + -HomePhone '(234)555-0044' ` + -Email 'jdoe@rosettacode.org' ` + -Directory '/home/jdoe' ` + -Shell '/bin/bash' diff --git a/Task/Append-a-record-to-the-end-of-a-text-file/PowerShell/append-a-record-to-the-end-of-a-text-file-3.psh b/Task/Append-a-record-to-the-end-of-a-text-file/PowerShell/append-a-record-to-the-end-of-a-text-file-3.psh new file mode 100644 index 0000000000..7a06667901 --- /dev/null +++ b/Task/Append-a-record-to-the-end-of-a-text-file/PowerShell/append-a-record-to-the-end-of-a-text-file-3.psh @@ -0,0 +1 @@ +$records | Format-Table -AutoSize diff --git a/Task/Append-a-record-to-the-end-of-a-text-file/PowerShell/append-a-record-to-the-end-of-a-text-file-4.psh b/Task/Append-a-record-to-the-end-of-a-text-file/PowerShell/append-a-record-to-the-end-of-a-text-file-4.psh new file mode 100644 index 0000000000..cda47a797f --- /dev/null +++ b/Task/Append-a-record-to-the-end-of-a-text-file/PowerShell/append-a-record-to-the-end-of-a-text-file-4.psh @@ -0,0 +1,4 @@ +if (-not(Test-FileLock -Path ".\passwd.txt")) +{ + $records | Export-File -Path ".\passwd.txt" +} diff --git a/Task/Append-a-record-to-the-end-of-a-text-file/PowerShell/append-a-record-to-the-end-of-a-text-file-5.psh b/Task/Append-a-record-to-the-end-of-a-text-file/PowerShell/append-a-record-to-the-end-of-a-text-file-5.psh new file mode 100644 index 0000000000..ff8cd63b12 --- /dev/null +++ b/Task/Append-a-record-to-the-end-of-a-text-file/PowerShell/append-a-record-to-the-end-of-a-text-file-5.psh @@ -0,0 +1 @@ +Get-Content -Path ".\passwd.txt" diff --git a/Task/Append-a-record-to-the-end-of-a-text-file/PowerShell/append-a-record-to-the-end-of-a-text-file-6.psh b/Task/Append-a-record-to-the-end-of-a-text-file/PowerShell/append-a-record-to-the-end-of-a-text-file-6.psh new file mode 100644 index 0000000000..1661e68a11 --- /dev/null +++ b/Task/Append-a-record-to-the-end-of-a-text-file/PowerShell/append-a-record-to-the-end-of-a-text-file-6.psh @@ -0,0 +1,11 @@ +$records+= New-Record -Account 'xyz' ` + -Password 'x' ` + -UID 1003 ` + -GID 1000 ` + -FullName 'X Yz' ` + -Office 'Room 1003' ` + -Extension '(234)555-8913' ` + -HomePhone '(234)555-0033' ` + -Email 'xyz@rosettacode.org' ` + -Directory '/home/xyz' ` + -Shell '/bin/bash' diff --git a/Task/Append-a-record-to-the-end-of-a-text-file/PowerShell/append-a-record-to-the-end-of-a-text-file-7.psh b/Task/Append-a-record-to-the-end-of-a-text-file/PowerShell/append-a-record-to-the-end-of-a-text-file-7.psh new file mode 100644 index 0000000000..c22086c11f --- /dev/null +++ b/Task/Append-a-record-to-the-end-of-a-text-file/PowerShell/append-a-record-to-the-end-of-a-text-file-7.psh @@ -0,0 +1 @@ +$records | Sort-Object { $_.GECOS.FullName.Split(" ")[1] } | Format-Table -AutoSize diff --git a/Task/Append-a-record-to-the-end-of-a-text-file/PowerShell/append-a-record-to-the-end-of-a-text-file-8.psh b/Task/Append-a-record-to-the-end-of-a-text-file/PowerShell/append-a-record-to-the-end-of-a-text-file-8.psh new file mode 100644 index 0000000000..cda47a797f --- /dev/null +++ b/Task/Append-a-record-to-the-end-of-a-text-file/PowerShell/append-a-record-to-the-end-of-a-text-file-8.psh @@ -0,0 +1,4 @@ +if (-not(Test-FileLock -Path ".\passwd.txt")) +{ + $records | Export-File -Path ".\passwd.txt" +} diff --git a/Task/Append-a-record-to-the-end-of-a-text-file/PowerShell/append-a-record-to-the-end-of-a-text-file-9.psh b/Task/Append-a-record-to-the-end-of-a-text-file/PowerShell/append-a-record-to-the-end-of-a-text-file-9.psh new file mode 100644 index 0000000000..ff8cd63b12 --- /dev/null +++ b/Task/Append-a-record-to-the-end-of-a-text-file/PowerShell/append-a-record-to-the-end-of-a-text-file-9.psh @@ -0,0 +1 @@ +Get-Content -Path ".\passwd.txt" diff --git a/Task/Append-a-record-to-the-end-of-a-text-file/REXX/append-a-record-to-the-end-of-a-text-file.rexx b/Task/Append-a-record-to-the-end-of-a-text-file/REXX/append-a-record-to-the-end-of-a-text-file.rexx index 7dfbc98a4e..2c4e553f25 100644 --- a/Task/Append-a-record-to-the-end-of-a-text-file/REXX/append-a-record-to-the-end-of-a-text-file.rexx +++ b/Task/Append-a-record-to-the-end-of-a-text-file/REXX/append-a-record-to-the-end-of-a-text-file.rexx @@ -1,48 +1,39 @@ -/*REXX pgm: writes two records, close file, appends another record. */ -signal on syntax; signal on novalue /*handle REXX program errors. */ -tFID='PASSWD.TXT' /*define the name of the out file*/ -call lineout tFID /*close the file, just in case; */ - /*could be open from calling pgm.*/ -call writeRec tFID,, /*append 1st record to the file. */ +/*REXX program writes (appends) two records, closes the file, appends another record.*/ +signal on syntax; signal on noValue /*handle (if any) REXX program errors.*/ +tFID= 'PASSWD.TXT' /*define the name of the output file.*/ +call lineout tFID /*close the output file, just in case,*/ + /* it could be open from calling pgm.*/ +call writeRec tFID,, /*append the 1st record to the file. */ 'jsmith',"x", 1001, 1000, 'Joe Smith,Room 1007,(234)555-8917,(234)555-0077,jsmith@rosettacode.org', "/home/jsmith", '/bin/bash' -call writeRec tFID,, /*append 2nd record to the file. */ +call writeRec tFID,, /*append the 2nd record to the file. */ 'jdoe', "x", 1002, 1000, 'Jane Doe,Room 1004,(234)555-8914,(234)555-0044,jdoe@rosettacode.org', "/home/jsmith", '/bin/bash' -call lineout fid /*close the file. */ +call lineout fid /*close the outfile (just to be tidy).*/ -call writeRec tFID,, /*append 3rd record to the file. */ +call writeRec tFID,, /*append the 3rd record to the file. */ 'xyz', "x", 1003, 1000, 'X Yz,Room 1003,(234)555-8913,(234)555-0033,xyz@rosettacode.org', "/home/xyz", '/bin/bash' /*─account─pw────uid───gid──────────────fullname,office,extension,homephone,Email────────────────────────directory───────shell──*/ -call lineout fid /*safe programming: close file. */ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────WRITEREC subroutine─────────────────*/ -writeRec: parse arg fid,_ /*get the fileID, and the 1st arg*/ -sep=':' /*field delimiter used in file. */ - /*Note: SEP field should be ··· */ - /*··· unique and can be any size.*/ - do i=3 to arg() /*get each argument and append it*/ - _=_ ||sep|| arg(i) /*to the prev. arg, with a : sep.*/ - end /*i*/ +call lineout fid /*"be safe" programming: close the file*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +err: say; say '***error***'; say; do j=1 for arg(); say arg(j); say; end; exit 13 +s: if arg(1)==1 then return arg(3); return word(arg(2) 's', 1) /*pluralizer*/ +/*──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/ +noValue: syntax: call err 'REXX program' condition("C"), condition("D"), 'REXX source statement (line' sigl"):", sourceline(sigl) +/*──────────────────────────────────────────────────────────────────────────────────────*/ +writeRec: parse arg fid,_ /*get the fileID, and also the 1st arg.*/ + sep=':' /*field delimiter used in file, it ··· */ + /* ··· can be unique and any size.*/ + do i=3 to arg() /*get each argument and append it to */ + _=_ || sep || arg(i) /* the previous arg, with a : sep.*/ + end /*i*/ - do tries=0 for 11 /*keep trying for 66 seconds. */ - r=lineout(fid,_) /*write (append) the new record. */ - if r==0 then return /*Zero? Then record was written.*/ - call sleep tries /*Error: so try again after delay*/ - end /*tries*/ /*Note: not all REXXes have SLEEP*/ - - /*possibly: no write access, */ - /* proper authority, */ - /* permission, etc. */ -call err r 'record's(r) "not written to file" fid -exit 13 -/*───────────────────────────────error handling subroutines and others.─*/ -err: say; say; say center(' error! ',40,"*"); say - do j=1 for arg(); say arg(j); say; end; say; exit 13 - -novalue: syntax: call err 'REXX program' condition('C') "error",, - condition('D'),'REXX source statement (line' sigl"):",, - sourceline(sigl) - -s: if arg(1)==1 then return arg(3);return word(arg(2) 's',1) + do tries=0 for 11 /*keep trying for 66 seconds. */ + r=lineout(fid, _) /*write (append) the new record. */ + if r==0 then return /*Zero? Then record was written. */ + call sleep tries /*Error? So try again after a delay. */ + end /*tries*/ /*Note: not all REXXes have SLEEP. */ + call err r 'record's(r) "not written to file" fid; exit 13 + /*some error causes: no write access, disk is full, file lockout, no authority*/ diff --git a/Task/Apply-a-callback-to-an-array/00DESCRIPTION b/Task/Apply-a-callback-to-an-array/00DESCRIPTION index f292071326..cda9662e66 100644 --- a/Task/Apply-a-callback-to-an-array/00DESCRIPTION +++ b/Task/Apply-a-callback-to-an-array/00DESCRIPTION @@ -1,2 +1,3 @@ -In this task, the goal is to take a combined set of elements -and apply a function to each element. +;Task: +Take a combined set of elements and apply a function to each element. +

diff --git a/Task/Apply-a-callback-to-an-array/AppleScript/apply-a-callback-to-an-array-1.applescript b/Task/Apply-a-callback-to-an-array/AppleScript/apply-a-callback-to-an-array-1.applescript new file mode 100644 index 0000000000..5d2d0779ad --- /dev/null +++ b/Task/Apply-a-callback-to-an-array/AppleScript/apply-a-callback-to-an-array-1.applescript @@ -0,0 +1,11 @@ +on callback for arg + -- Returns a string like "arc has 3 letters" + arg & " has " & (count arg) & " letters" +end callback + +set alist to {"arc", "be", "circle"} +repeat with aref in alist + -- Passes a reference to some item in alist + -- to callback, then speaks the return value. + say (callback for aref) +end repeat diff --git a/Task/Apply-a-callback-to-an-array/AppleScript/apply-a-callback-to-an-array-2.applescript b/Task/Apply-a-callback-to-an-array/AppleScript/apply-a-callback-to-an-array-2.applescript new file mode 100644 index 0000000000..6f71daac88 --- /dev/null +++ b/Task/Apply-a-callback-to-an-array/AppleScript/apply-a-callback-to-an-array-2.applescript @@ -0,0 +1,78 @@ +on run + + set xs to {1, 2, 3, 4, 5, 6, 7, 8, 9, 10} + + {map(square, xs), ¬ + filter(isEven, xs), ¬ + foldl(sum, 0, xs)} + + --> {{1, 4, 9, 16, 25, 36, 49, 64, 81, 100}, {2, 4, 6, 8, 10}, 55} + +end run + +-- square :: Num -> Num -> Num +on square(x) + x * x +end square + +-- sum :: Num -> Num -> Num +on sum(a, b) + a + b +end sum + +-- isEven :: Int -> Bool +on isEven(n) + n mod 2 = 0 +end isEven + + +-- GENERIC HIGHER ORDER FUNCTIONS + +-- 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 + +-- 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 + +-- 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 + +-- 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 diff --git a/Task/Apply-a-callback-to-an-array/AppleScript/apply-a-callback-to-an-array.applescript b/Task/Apply-a-callback-to-an-array/AppleScript/apply-a-callback-to-an-array.applescript deleted file mode 100644 index 855c9661ae..0000000000 --- a/Task/Apply-a-callback-to-an-array/AppleScript/apply-a-callback-to-an-array.applescript +++ /dev/null @@ -1,11 +0,0 @@ -on callback for arg - -- Returns a string like "arc has 3 letters" - arg & " has " & (count arg) & " letters" -end callback - -set alist to {"arc", "be", "circle"} -repeat with aref in alist - -- Passes a reference to some item in alist - -- to callback, then speaks the return value. - say (callback for aref) -end repeat diff --git a/Task/Apply-a-callback-to-an-array/Babel/apply-a-callback-to-an-array-1.pb b/Task/Apply-a-callback-to-an-array/Babel/apply-a-callback-to-an-array-1.pb index 4e9cd2b5d5..20afd40d78 100644 --- a/Task/Apply-a-callback-to-an-array/Babel/apply-a-callback-to-an-array-1.pb +++ b/Task/Apply-a-callback-to-an-array/Babel/apply-a-callback-to-an-array-1.pb @@ -1,6 +1 @@ -((main - { (1 1 2 3 5 8 13 21) dup - {double !} each - {%d ' ' . <<} each}) - -(double { dup 2 * set })) +sq { dup * } < diff --git a/Task/Apply-a-callback-to-an-array/Babel/apply-a-callback-to-an-array-2.pb b/Task/Apply-a-callback-to-an-array/Babel/apply-a-callback-to-an-array-2.pb index 3723d68068..1d33a00ef6 100644 --- a/Task/Apply-a-callback-to-an-array/Babel/apply-a-callback-to-an-array-2.pb +++ b/Task/Apply-a-callback-to-an-array/Babel/apply-a-callback-to-an-array-2.pb @@ -1,9 +1 @@ -((main - { (1 1 2 3 5 8 13 21) - {double !} each - collect ! - {%d ' ' . <<} each}) - -(double { 2 * }) - -(collect { -1 take })) +( 0 1 1 2 3 5 8 13 21 34 ) { sq ! } over ! lsnum ! diff --git a/Task/Apply-a-callback-to-an-array/Elixir/apply-a-callback-to-an-array.elixir b/Task/Apply-a-callback-to-an-array/Elixir/apply-a-callback-to-an-array.elixir new file mode 100644 index 0000000000..84e62078e3 --- /dev/null +++ b/Task/Apply-a-callback-to-an-array/Elixir/apply-a-callback-to-an-array.elixir @@ -0,0 +1 @@ +Enum.map([1, 2, 3], fn(n) -> n * 2 end) diff --git a/Task/Apply-a-callback-to-an-array/Kotlin/apply-a-callback-to-an-array.kotlin b/Task/Apply-a-callback-to-an-array/Kotlin/apply-a-callback-to-an-array.kotlin new file mode 100644 index 0000000000..d833e479fb --- /dev/null +++ b/Task/Apply-a-callback-to-an-array/Kotlin/apply-a-callback-to-an-array.kotlin @@ -0,0 +1,6 @@ +fun main(args: Array) { + val array = arrayOf(1,2,3,4,5,6,7,8,9,10) // build + val function = { i: Int -> i * i } // function to apply + val list = array.map { function(it) } // process each item + println(list) // print results +} diff --git a/Task/Apply-a-callback-to-an-array/Oberon-2/apply-a-callback-to-an-array.oberon-2 b/Task/Apply-a-callback-to-an-array/Oberon-2/apply-a-callback-to-an-array.oberon-2 new file mode 100644 index 0000000000..fe0f598b56 --- /dev/null +++ b/Task/Apply-a-callback-to-an-array/Oberon-2/apply-a-callback-to-an-array.oberon-2 @@ -0,0 +1,88 @@ +MODULE ApplyCallBack; +IMPORT + Out := NPCT:Console; + +TYPE + Fun = PROCEDURE (x: LONGINT): LONGINT; + Ptr2Ary = POINTER TO ARRAY OF LONGINT; + +VAR + a: ARRAY 5 OF LONGINT; + x: ARRAY 3 OF LONGINT; + r: Ptr2Ary; + + PROCEDURE Min(x,y: LONGINT): LONGINT; + BEGIN + IF x <= y THEN RETURN x ELSE RETURN y END; + END Min; + + PROCEDURE Init(VAR a: ARRAY OF LONGINT); + BEGIN + a[0] := 0; + a[1] := 1; + a[2] := 2; + a[3] := 3; + a[4] := 4; + END Init; + + PROCEDURE Fun1(x: LONGINT): LONGINT; + BEGIN + RETURN x * 2 + END Fun1; + + PROCEDURE Fun2(x: LONGINT): LONGINT; + BEGIN + RETURN x DIV 2; + END Fun2; + + PROCEDURE Fun3(x: LONGINT): LONGINT; + BEGIN + RETURN x + 3; + END Fun3; + + PROCEDURE Map(F: Fun; VAR x: ARRAY OF LONGINT); + VAR + i: LONGINT; + BEGIN + FOR i := 0 TO LEN(x) - 1 DO + x[i] := F(x[i]) + END + END Map; + + PROCEDURE Map2(F: Fun; a: ARRAY OF LONGINT; VAR r: ARRAY OF LONGINT); + VAR + i,l: LONGINT; + BEGIN + l := Min(LEN(a),LEN(x)); + FOR i := 0 TO l - 1 DO + r[i] := F(a[i]) + END + END Map2; + + PROCEDURE Map3(F: Fun; a: ARRAY OF LONGINT): Ptr2Ary; + VAR + r: Ptr2Ary; + i: LONGINT; + BEGIN + NEW(r,LEN(a)); + FOR i := 0 TO LEN(a) - 1 DO + r[i] := F(a[i]); + END; + RETURN r + END Map3; + + PROCEDURE Show(a: ARRAY OF LONGINT); + VAR + i: LONGINT; + BEGIN + FOR i := 0 TO LEN(a) - 1 DO + Out.Int(a[i],4) + END; + Out.Ln + END Show; + +BEGIN + Init(a);Map(Fun1,a);Show(a); + Init(a);Map2(Fun2,a,x);Show(x); + Init(a);r := Map3(Fun3,a);Show(r^); +END ApplyCallBack. diff --git a/Task/Apply-a-callback-to-an-array/PARI-GP/apply-a-callback-to-an-array.pari b/Task/Apply-a-callback-to-an-array/PARI-GP/apply-a-callback-to-an-array-1.pari similarity index 100% rename from Task/Apply-a-callback-to-an-array/PARI-GP/apply-a-callback-to-an-array.pari rename to Task/Apply-a-callback-to-an-array/PARI-GP/apply-a-callback-to-an-array-1.pari diff --git a/Task/Apply-a-callback-to-an-array/PARI-GP/apply-a-callback-to-an-array-2.pari b/Task/Apply-a-callback-to-an-array/PARI-GP/apply-a-callback-to-an-array-2.pari new file mode 100644 index 0000000000..73a73bba60 --- /dev/null +++ b/Task/Apply-a-callback-to-an-array/PARI-GP/apply-a-callback-to-an-array-2.pari @@ -0,0 +1 @@ +call(callback, [1,2,3,4,5]) diff --git a/Task/Apply-a-callback-to-an-array/SuperCollider/apply-a-callback-to-an-array-1.supercollider b/Task/Apply-a-callback-to-an-array/SuperCollider/apply-a-callback-to-an-array-1.supercollider index 1e21782702..068e04f3f5 100644 --- a/Task/Apply-a-callback-to-an-array/SuperCollider/apply-a-callback-to-an-array-1.supercollider +++ b/Task/Apply-a-callback-to-an-array/SuperCollider/apply-a-callback-to-an-array-1.supercollider @@ -1 +1 @@ -[1, 2, 3].squared; // returns [1, 4, 9] +[1, 2, 3].squared // returns [1, 4, 9] diff --git a/Task/Apply-a-callback-to-an-array/SuperCollider/apply-a-callback-to-an-array-2.supercollider b/Task/Apply-a-callback-to-an-array/SuperCollider/apply-a-callback-to-an-array-2.supercollider index af02876123..a3864475e7 100644 --- a/Task/Apply-a-callback-to-an-array/SuperCollider/apply-a-callback-to-an-array-2.supercollider +++ b/Task/Apply-a-callback-to-an-array/SuperCollider/apply-a-callback-to-an-array-2.supercollider @@ -1 +1 @@ -[1, 2, 3].collect({ arg x; x*x }); +[1, 2, 3].collect({ | x | x * x }) diff --git a/Task/Apply-a-callback-to-an-array/SuperCollider/apply-a-callback-to-an-array-3.supercollider b/Task/Apply-a-callback-to-an-array/SuperCollider/apply-a-callback-to-an-array-3.supercollider index d15215a55f..4ca917117b 100644 --- a/Task/Apply-a-callback-to-an-array/SuperCollider/apply-a-callback-to-an-array-3.supercollider +++ b/Task/Apply-a-callback-to-an-array/SuperCollider/apply-a-callback-to-an-array-3.supercollider @@ -1,9 +1,5 @@ -var square = { - arg x; - x*x; -}; -var map = { - arg fn, xs; +var square = { |x| x * x }; +var map = { |fn, xs| all {: fn.value(x), x <- xs }; }; -map.value(square,[1,2,3]); +map.value(square, [1, 2, 3]); diff --git a/Task/Apply-a-callback-to-an-array/ZX-Spectrum-Basic/apply-a-callback-to-an-array.zx b/Task/Apply-a-callback-to-an-array/ZX-Spectrum-Basic/apply-a-callback-to-an-array.zx new file mode 100644 index 0000000000..9dbb8e4e16 --- /dev/null +++ b/Task/Apply-a-callback-to-an-array/ZX-Spectrum-Basic/apply-a-callback-to-an-array.zx @@ -0,0 +1,10 @@ +10 LET a$="x+x" +20 LET b$="x*x" +30 LET c$="x+x^2" +40 LET f$=c$: REM Assign a$, b$ or c$ +150 FOR i=1 TO 5 +160 READ x +170 PRINT x;" = ";VAL f$ +180 NEXT i +190 STOP +200 DATA 2,5,6,10,100 diff --git a/Task/Arbitrary-precision-integers--included-/00DESCRIPTION b/Task/Arbitrary-precision-integers--included-/00DESCRIPTION index 0da06c6ecb..32972c33c3 100644 --- a/Task/Arbitrary-precision-integers--included-/00DESCRIPTION +++ b/Task/Arbitrary-precision-integers--included-/00DESCRIPTION @@ -1,14 +1,17 @@ Using the in-built capabilities of your language, calculate the integer value of: -::5^{4^{3^2}} + 5^{4^{3^2}} -* Confirm that the first and last twenty digits of the answer are: 62060698786608744707...92256259918212890625 +* Confirm that the first and last twenty digits of the answer are: + 62060698786608744707...92256259918212890625 * Find and show the number of decimal digits in the answer. -C.F. [[Long multiplication]] - +
Note:
  • Do not submit an ''implementation'' of [[wp:arbitrary precision arithmetic|arbitrary precision arithmetic]]. The intention is to show the capabilities of the language as supplied. If a language has a [[Talk:Arbitrary-precision integers (included)#Use of external libraries|single, overwhelming, library]] of varied modules that is endorsed by its home site – such as [[CPAN]] for Perl or [[Boost]] for C++ – then that ''may'' be used instead.
  • Strictly speaking, this should not be solved by fixed-precision numeric libraries where the precision has to be manually set to a large value; although if this is the '''only''' recourse then it may be used with a note explaining that the precision must be set manually to a large enough value.
+ ;See also: +* [[Long multiplication]] * [[Exponentiation order]] +

diff --git a/Task/Arbitrary-precision-integers--included-/C/arbitrary-precision-integers--included--3.c b/Task/Arbitrary-precision-integers--included-/C/arbitrary-precision-integers--included--3.c new file mode 100644 index 0000000000..882396e319 --- /dev/null +++ b/Task/Arbitrary-precision-integers--included-/C/arbitrary-precision-integers--included--3.c @@ -0,0 +1,69 @@ +/* 5432_pure.c */ +#include +#include +#include +#include + +/* return = a * b. Caller is responsible for freeing memory. + * Handling of negatives, and zeros is not here, since not needed. + */ +unsigned char *str_mult(const unsigned char *A, const unsigned char *B) +{ + int ax = 0, bx = 0, rx = 0, al, bl; + unsigned char *a, *b, *r; /* result */ + + al = strlen(A); bl = strlen(B); + r = calloc(al + bl + 1, 1); + /* convert A and B from ASCII string numbers, into numeric */ + a = malloc(al+1); strcpy(a, A); for (ax = 0; ax < al; ++ax) a[ax] -= '0'; + b = malloc(bl+1); strcpy(b, B); for (bx = 0; bx < bl; ++bx) b[bx] -= '0'; + + /* grade-school method of multiplication */ + for (ax = al - 1; ax >= 0; ax--) { + int carry = 0; + for (bx = bl - 1, rx = ax + bx + 1; bx >= 0; bx--, rx--) { + int n = a[ax] * b[bx] + r[rx] + carry; + r[rx] = (n % 10); + carry = n / 10; + } + r[rx] += carry; + } + /* convert result from numeric into ASCII string numeric */ + for (rx = 0; rx < al + bl; ++rx) + r[rx] += '0'; + while (r[0] == '0') + memmove(r, &r[1], al + bl); + free(b); free(a); + return r; +} + +unsigned char *str_exp(int b, int n) { + unsigned char *r, *tmp, *a; + + r = malloc(2); strcpy(r, "1"); + a = malloc(24); sprintf(a, "%d", b); + + while (n!=1) { + if (n%2==1) { + tmp = str_mult(r, a); + free(r); + r = tmp; + } + n >>= 1; + tmp = str_mult(a, a); + free(a); + a = tmp; + } + free(r); + return a; +} + +/* compute 5^4^3^2 which == 5^262144 */ +int main() { + unsigned char *r = str_exp(5,262144); + printf ("Length of 5^4^3^2 is %d\n", strlen(r)); + printf ("First 20 digits: %20.20s\n", r); + printf ("Last 20 digits: %s\n", &r[strlen(r)-20]); + free(r); + printf ("This took %.2f seconds\n", ((double)clock())/CLOCKS_PER_SEC); +} diff --git a/Task/Arbitrary-precision-integers--included-/COBOL/arbitrary-precision-integers--included-.cobol b/Task/Arbitrary-precision-integers--included-/COBOL/arbitrary-precision-integers--included-.cobol new file mode 100644 index 0000000000..a89dbd222b --- /dev/null +++ b/Task/Arbitrary-precision-integers--included-/COBOL/arbitrary-precision-integers--included-.cobol @@ -0,0 +1,133 @@ + identification division. + program-id. arbitrary-precision-integers. + remarks. Uses opaque libgmp internals that are built into libcob. + + data division. + working-storage section. + 01 gmp-number. + 05 mp-alloc usage binary-long. + 05 mp-size usage binary-long. + 05 mp-limb usage pointer. + 01 gmp-build. + 05 mp-alloc usage binary-long. + 05 mp-size usage binary-long. + 05 mp-limb usage pointer. + + 01 the-int usage binary-c-long unsigned. + 01 the-exponent usage binary-c-long unsigned. + 01 valid-exponent usage binary-long value 1. + 88 cant-use value 0 when set to false 1. + + 01 number-string usage pointer. + 01 number-length usage binary-long. + + 01 window-width constant as 20. + 01 limit-width usage binary-long. + 01 number-buffer pic x(window-width) based. + + procedure division. + arbitrary-main. + + *> calculate 10 ** 19 + perform initialize-integers. + display "10 ** 19 : " with no advancing + move 10 to the-int + move 19 to the-exponent + perform raise-pow-accrete-exponent + perform show-all-or-portion + perform clean-up + + *> calculate 12345 ** 9 + perform initialize-integers. + display "12345 ** 9 : " with no advancing + move 12345 to the-int + move 9 to the-exponent + perform raise-pow-accrete-exponent + perform show-all-or-portion + perform clean-up + + *> calculate 5 ** 4 ** 3 ** 2 + perform initialize-integers. + display "5 ** 4 ** 3 ** 2: " with no advancing + move 3 to the-int + move 2 to the-exponent + perform raise-pow-accrete-exponent + move 4 to the-int + perform raise-pow-accrete-exponent + move 5 to the-int + perform raise-pow-accrete-exponent + perform show-all-or-portion + perform clean-up + goback. + *> ************************************************************** + + initialize-integers. + call "__gmpz_init" using gmp-number returning omitted + call "__gmpz_init" using gmp-build returning omitted + . + + raise-pow-accrete-exponent. + *> check before using previously overflowed exponent intermediate + if cant-use then + display "Error: intermediate overflow occured at " + the-exponent upon syserr + goback + end-if + call "__gmpz_set_ui" using gmp-number by value 0 + returning omitted + call "__gmpz_set_ui" using gmp-build by value the-int + returning omitted + call "__gmpz_pow_ui" using gmp-number gmp-build + by value the-exponent + returning omitted + call "__gmpz_set_ui" using gmp-build by value 0 + returning omitted + call "__gmpz_get_ui" using gmp-number returning the-exponent + call "__gmpz_fits_ulong_p" using gmp-number + returning valid-exponent + . + + *> get string representation, base 10 + show-all-or-portion. + call "__gmpz_sizeinbase" using gmp-number + by value 10 + returning number-length + display "GMP length: " number-length ", " with no advancing + + call "__gmpz_get_str" using null by value 10 + by reference gmp-number + returning number-string + call "strlen" using by value number-string + returning number-length + display "strlen: " number-length + + *> slide based string across first and last of buffer + move window-width to limit-width + set address of number-buffer to number-string + if number-length <= window-width then + move number-length to limit-width + display number-buffer(1:limit-width) + else + display number-buffer with no advancing + subtract window-width from number-length + move function max(0, number-length) to number-length + if number-length <= window-width then + move number-length to limit-width + else + display "..." with no advancing + end-if + set address of number-buffer up by + function max(window-width, number-length) + display number-buffer(1:limit-width) + end-if + . + + clean-up. + call "free" using by value number-string returning omitted + call "__gmpz_clear" using gmp-number returning omitted + call "__gmpz_clear" using gmp-build returning omitted + set address of number-buffer to null + set cant-use to false + . + + end program arbitrary-precision-integers. diff --git a/Task/Arbitrary-precision-integers--included-/Fortran/arbitrary-precision-integers--included-.f b/Task/Arbitrary-precision-integers--included-/Fortran/arbitrary-precision-integers--included-.f new file mode 100644 index 0000000000..c9a8628d02 --- /dev/null +++ b/Task/Arbitrary-precision-integers--included-/Fortran/arbitrary-precision-integers--included-.f @@ -0,0 +1,12 @@ +program bignum + use fmzm + implicit none + type(im) :: a + integer :: n + + call fm_set(50) + a = to_im(5)**(to_im(4)**(to_im(3)**to_im(2))) + n = to_int(floor(log10(to_fm(a)))) + call im_print(a / to_im(10)**(n - 19)) + call im_print(mod(a, to_im(10)**20)) +end program diff --git a/Task/Arbitrary-precision-integers--included-/PowerShell/arbitrary-precision-integers--included-.psh b/Task/Arbitrary-precision-integers--included-/PowerShell/arbitrary-precision-integers--included-.psh new file mode 100644 index 0000000000..5189b471ad --- /dev/null +++ b/Task/Arbitrary-precision-integers--included-/PowerShell/arbitrary-precision-integers--included-.psh @@ -0,0 +1,9 @@ +# Perform calculation +$BigNumber = [BigInt]::Pow( 5, [BigInt]::Pow( 4, [BigInt]::Pow( 3, 2 ) ) ) + +# Display first and last 20 digits +$BigNumberString = [string]$BigNumber +$BigNumberString.Substring( 0, 20 ) + "..." + $BigNumberString.Substring( $BigNumberString.Length - 20, 20 ) + +# Display number of digits +$BigNumberString.Length diff --git a/Task/Arbitrary-precision-integers--included-/REXX/arbitrary-precision-integers--included--1.rexx b/Task/Arbitrary-precision-integers--included-/REXX/arbitrary-precision-integers--included--1.rexx index 5b4292be67..3d15ed71be 100644 --- a/Task/Arbitrary-precision-integers--included-/REXX/arbitrary-precision-integers--included--1.rexx +++ b/Task/Arbitrary-precision-integers--included-/REXX/arbitrary-precision-integers--included--1.rexx @@ -1,14 +1,15 @@ -/*REXX program to calculate and demonstrate arbitrary precision numbers.*/ -numeric digits 200000 +/*REXX program calculates and demonstrates arbitrary precision numbers. */ +numeric digits 200000 /*two hundred thousand decimal digits. */ - n = 5 ** (4 ** (3 ** 2)) /*calc. multiple exponentations. */ + n = 5 ** (4 ** (3 ** 2)) /*calculate multiple exponentiations. */ check = 62060698786608744707...92256259918212890625 -sampl = left(n, 20) || '...' || right(n, 20) +sampl = left(n, 20) || ... || right(n, 20) -say ' check:' check -say 'sample:' sampl +say ' check:' check +say 'sample:' sampl +say 'digits:' length(n) say if check==sampl then say 'passed!' else say 'failed!' - /*stick a fork in it, we're done.*/ + /*stick a fork in it, we're all done. */ diff --git a/Task/Arbitrary-precision-integers--included-/REXX/arbitrary-precision-integers--included--2.rexx b/Task/Arbitrary-precision-integers--included-/REXX/arbitrary-precision-integers--included--2.rexx index 658ada907e..c1694879b2 100644 --- a/Task/Arbitrary-precision-integers--included-/REXX/arbitrary-precision-integers--included--2.rexx +++ b/Task/Arbitrary-precision-integers--included-/REXX/arbitrary-precision-integers--included--2.rexx @@ -1,21 +1,22 @@ -/*REXX program to calculate and demonstrate arbitrary precision numbers.*/ -numeric digits 5 + 1 /*6 is needed (not 5) for ooRexx.*/ - n=5** (4** (3** 2)) /*calc. multiple exponentations. */ +/*REXX program calculates and demonstrates arbitrary precision numbers. */ +numeric digits 5 + 1 /*6 is needed (not 5) for ooRexx. */ -parse var n 'E' pow . /*POW might be null, so N is OK.*/ + n=5** (4** (3** 2)) /*calculate multiple exponentiations. */ -if pow\=='' then do /*general case: POW might be < 0*/ - numeric digits abs(pow)+9 /*recalc. with more digits.*/ - n=5** (4** (3** 2)) /*calc. multiple exponentations. */ +parse var n 'E' pow . /*POW might be null, so N is OK. */ + +if pow\=='' then do /*general case: POW might be < zero.*/ + numeric digits abs(pow)+9 /*recalculate with more digits.*/ + n=5** (4** (3** 2)) /*calculate multiple exponentiations. */ end check = 62060698786608744707...92256259918212890625 sampl = left(n, 20)'...'right(n, 20) -say ' check:' check -say 'sample:' sampl -say 'digits:' length(n) +say ' check:' check +say 'sample:' sampl +say 'digits:' length(n) say if check==sampl then say 'passed!' else say 'failed!' - /*stick a fork in it, we're done.*/ + /*stick a fork in it, we're all done. */ diff --git a/Task/Arena-storage-pool/Fortran/arena-storage-pool.f b/Task/Arena-storage-pool/Fortran/arena-storage-pool.f new file mode 100644 index 0000000000..7ed5d707cc --- /dev/null +++ b/Task/Arena-storage-pool/Fortran/arena-storage-pool.f @@ -0,0 +1,13 @@ + SUBROUTINE CHECK(A,N) !Inspect matrix A. + REAL A(:,:) !The matrix, whatever size it is. + INTEGER N !The order. + REAL B(N,N) !A scratchpad, size known on entry.. + INTEGER, ALLOCATABLE::TROUBLE(:) !But for this, I'll decide later. + INTEGER M + + M = COUNT(A(1:N,1:N).LE.0) !Some maximum number of troublemakers. + + ALLOCATE (TROUBLE(1:M**3)) !Just enough. + + DEALLOCATE(TROUBLE) !Not necessary. + END SUBROUTINE CHECK !As TROUBLE is declared within CHECK. diff --git a/Task/Arena-storage-pool/Rust/arena-storage-pool.rust b/Task/Arena-storage-pool/Rust/arena-storage-pool.rust new file mode 100644 index 0000000000..2b7ea32dc0 --- /dev/null +++ b/Task/Arena-storage-pool/Rust/arena-storage-pool.rust @@ -0,0 +1,27 @@ +#![feature(rustc_private)] + +extern crate arena; + +use arena::TypedArena; + +fn main() { + // Memory is allocated using the default allocator (currently jemalloc). The memory is + // allocated in chunks, and when one chunk is full another is allocated. This ensures that + // references to an arena don't become invalid when the original chunk runs out of space. The + // chunk size is configurable as an argument to TypedArena::with_capacity if necessary. + let arena = TypedArena::new(); + + // The arena crate contains two types of arenas: TypedArena and Arena. Arena is + // reflection-basd and slower, but can allocate objects of any type. TypedArena is faster, and + // can allocate only objects of one type. The type is determined by type inference--if you try + // to allocate an integer, then Rust's compiler knows it is an integer arena. + let v1 = arena.alloc(1i32); + + // TypedArena returns a mutable reference + let v2 = arena.alloc(3); + *v2 += 38; + println!("{}", *v1 + *v2); + + // The arena's destructor is called as it goes out of scope, at which point it deallocates + // everything stored within it at once. +} diff --git a/Task/Arithmetic-Complex/00DESCRIPTION b/Task/Arithmetic-Complex/00DESCRIPTION index 619526418f..2ed1eaf1ab 100644 --- a/Task/Arithmetic-Complex/00DESCRIPTION +++ b/Task/Arithmetic-Complex/00DESCRIPTION @@ -1,7 +1,24 @@ -A '''[[wp:Complex number|complex number]]''' is a number which can be written as "a + b \times i" (sometimes shown as "b + a \times i") where a and b are real numbers and [[wp:Imaginary_unit|i is the square root of -1]]. -Typically, complex numbers are represented as a pair of real numbers called the "imaginary part" and "real part", where the imaginary part is the number to be multiplied by i. +A   '''[[wp:Complex number|complex number]]'''   is a number which can be written as: +a + b \times i +(sometimes shown as: +b + a \times i +where   a   and   b  are real numbers,   and   [[wp:Imaginary_unit|i]]   is   √{{overline| -1 }} -* Show addition, multiplication, negation, and inversion of complex numbers in separate functions. (Subtraction and division operations can be made with pairs of these operations.) Print the results for each operation tested. -* ''Optional:'' Show complex conjugation. By definition, the [[wp:complex conjugate|complex conjugate]] of a + bi is a - bi. -Some languages have complex number libraries available. If your language does, show the operations. If your language does not, also show the definition of this type. +Typically, complex numbers are represented as a pair of real numbers called the "imaginary part" and "real part",   where the imaginary part is the number to be multiplied by i. + + +;Task: +* Show addition, multiplication, negation, and inversion of complex numbers in separate functions. (Subtraction and division operations can be made with pairs of these operations.) +* Print the results for each operation tested. +* ''Optional:'' Show complex conjugation. + +
+By definition, the   [[wp:complex conjugate|complex conjugate]]   of +a + bi +is +a - bi + +
+Some languages have complex number libraries available.   If your language does, show the operations.   If your language does not, also show the definition of this type. +

diff --git a/Task/Arithmetic-Complex/Elixir/arithmetic-complex.elixir b/Task/Arithmetic-Complex/Elixir/arithmetic-complex.elixir new file mode 100644 index 0000000000..1e31b881f6 --- /dev/null +++ b/Task/Arithmetic-Complex/Elixir/arithmetic-complex.elixir @@ -0,0 +1,85 @@ +defmodule Complex do + import Kernel, except: [abs: 1, div: 2] + + defstruct real: 0, imag: 0 + + def new(real, imag) do + %__MODULE__{real: real, imag: imag} + end + + def add(a, b) do + {a, b} = convert(a, b) + new(a.real + b.real, a.imag + b.imag) + end + + def sub(a, b) do + {a, b} = convert(a, b) + new(a.real - b.real, a.imag - b.imag) + end + + def mul(a, b) do + {a, b} = convert(a, b) + new(a.real*b.real - a.imag*b.imag, a.imag*b.real + a.real*b.imag) + end + + def div(a, b) do + {a, b} = convert(a, b) + divisor = abs2(b) + new((a.real*b.real + a.imag*b.imag) / divisor, + (a.imag*b.real - a.real*b.imag) / divisor) + end + + def neg(a) do + a = convert(a) + new(-a.real, -a.imag) + end + + def inv(a) do + a = convert(a) + divisor = abs2(a) + new(a.real / divisor, -a.imag / divisor) + end + + def conj(a) do + a = convert(a) + new(a.real, -a.imag) + end + + def abs(a) do + :math.sqrt(abs2(a)) + end + + defp abs2(a) do + a = convert(a) + a.real*a.real + a.imag*a.imag + end + + defp convert(a) when is_number(a), do: new(a, 0) + defp convert(%__MODULE__{} = a), do: a + + defp convert(a, b), do: {convert(a), convert(b)} + + def task do + a = new(1, 3) + b = new(5, 2) + IO.puts "a = #{a}" + IO.puts "b = #{b}" + IO.puts "add(a,b): #{add(a, b)}" + IO.puts "sub(a,b): #{sub(a, b)}" + IO.puts "mul(a,b): #{mul(a, b)}" + IO.puts "div(a,b): #{div(a, b)}" + IO.puts "div(b,a): #{div(b, a)}" + IO.puts "neg(a) : #{neg(a)}" + IO.puts "inv(a) : #{inv(a)}" + IO.puts "conj(a) : #{conj(a)}" + end +end + +defimpl String.Chars, for: Complex do + def to_string(%Complex{real: real, imag: imag}) do + if imag >= 0, do: "#{real}+#{imag}j", + else: "#{real}#{imag}j" + end +end + +Complex.task diff --git a/Task/Arithmetic-Complex/J/arithmetic-complex.j b/Task/Arithmetic-Complex/J/arithmetic-complex.j index 1e48b12c99..d485f20767 100644 --- a/Task/Arithmetic-Complex/J/arithmetic-complex.j +++ b/Task/Arithmetic-Complex/J/arithmetic-complex.j @@ -1,10 +1,12 @@ x=: 1j1 y=: 3.14159j1.2 - x+y + x+y NB. addition 4.14159j2.2 - x*y + x*y NB. multiplication 1.94159j4.34159 - %x + %x NB. inversion 0.5j_0.5 - -x + -x NB. negation _1j_1 + +x NB. (complex) conjugation +1j_1 diff --git a/Task/Arithmetic-Complex/Java/arithmetic-complex.java b/Task/Arithmetic-Complex/Java/arithmetic-complex.java index c2a2c925a6..a081e4fcfb 100644 --- a/Task/Arithmetic-Complex/Java/arithmetic-complex.java +++ b/Task/Arithmetic-Complex/Java/arithmetic-complex.java @@ -1,44 +1,52 @@ -public class Complex{ - public final double real; - public final double imag; +public class Complex { + public final double real; + public final double imag; - public Complex(){this(0,0)}//default values to 0...force of habit - public Complex(double r, double i){real = r; imag = i;} + public Complex() { + this(0, 0); + } - public Complex add(Complex b){ - return new Complex(this.real + b.real, this.imag + b.imag); - } + public Complex(double r, double i) { + real = r; + imag = i; + } - public Complex mult(Complex b){ - //FOIL of (a+bi)(c+di) with i*i = -1 - return new Complex(this.real * b.real - this.imag * b.imag, this.real * b.imag + this.imag * b.real); - } + public Complex add(Complex b) { + return new Complex(this.real + b.real, this.imag + b.imag); + } - public Complex inv(){ - //1/(a+bi) * (a-bi)/(a-bi) = 1/(a+bi) but it's more workable - double denom = real * real + imag * imag; - return new Complex(real/denom,-imag/denom); - } + public Complex mult(Complex b) { + // FOIL of (a+bi)(c+di) with i*i = -1 + return new Complex(this.real * b.real - this.imag * b.imag, + this.real * b.imag + this.imag * b.real); + } - public Complex neg(){ - return new Complex(-real, -imag); - } + public Complex inv() { + // 1/(a+bi) * (a-bi)/(a-bi) = 1/(a+bi) but it's more workable + double denom = real * real + imag * imag; + return new Complex(real / denom, -imag / denom); + } - public Complex conj(){ - return new Complex(real, -imag); - } + public Complex neg() { + return new Complex(-real, -imag); + } - public String toString(){ //override Object's toString - return real + " + " + imag + " * i"; - } + public Complex conj() { + return new Complex(real, -imag); + } - public static void main(String[] args){ - Complex a = new Complex(Math.PI, -5) //just some numbers - Complex b = new Complex(-1, 2.5); - System.out.println(a.neg()); - System.out.println(a.add(b)); - System.out.println(a.inv()); - System.out.println(a.mult(b)); - System.out.println(a.conj()); - } + @Override + public String toString() { + return real + " + " + imag + " * i"; + } + + public static void main(String[] args) { + Complex a = new Complex(Math.PI, -5); //just some numbers + Complex b = new Complex(-1, 2.5); + System.out.println(a.neg()); + System.out.println(a.add(b)); + System.out.println(a.inv()); + System.out.println(a.mult(b)); + System.out.println(a.conj()); + } } diff --git a/Task/Arithmetic-Complex/PowerShell/arithmetic-complex-1.psh b/Task/Arithmetic-Complex/PowerShell/arithmetic-complex-1.psh new file mode 100644 index 0000000000..eb0ebf6c53 --- /dev/null +++ b/Task/Arithmetic-Complex/PowerShell/arithmetic-complex-1.psh @@ -0,0 +1,39 @@ +class Complex { + [Double]$x + [Double]$y + Complex() { + $this.x = 0 + $this.y = 0 + } + Complex([Double]$x, [Double]$y) { + $this.x = $x + $this.y = $y + } + [Double]abs2() {return $this.x*$this.x + $this.y*$this.y} + [Double]abs() {return [math]::sqrt($this.abs2())} + static [Complex]add([Complex]$m,[Complex]$n) {return [Complex]::new($m.x+$n.x, $m.y+$n.y)} + static [Complex]mul([Complex]$m,[Complex]$n) {return [Complex]::new($m.x*$n.x - $m.y*$n.y, $m.x*$n.y + $n.x*$m.y)} + [Complex]mul([Double]$k) {return [Complex]::new($k*$this.x, $k*$this.y)} + [Complex]negate() {return $this.mul(-1)} + [Complex]conjugate() {return [Complex]::new($this.x, -$this.y)} + [Complex]inverse() {return $this.conjugate().mul(1/$this.abs2())} + [String]show() { + if(0 -ge $this.y) { + return "$($this.x)+$($this.y)i" + } else { + return "$($this.x)$($this.y)i" + } + } + static [String]show([Complex]$other) { + return $other.show() + } +} +$m = [complex]::new(3, 4) +$n = [complex]::new(7, 6) +"`$m: $($m.show())" +"`$n: $($n.show())" +"`$m + `$n: $([complex]::show([complex]::add($m,$n)))" +"`$m * `$n: $([complex]::show([complex]::mul($m,$n)))" +"negate `$m: $($m.negate().show())" +"1/`$m: $([complex]::show($m.inverse()))" +"conjugate `$m: $([complex]::show($m.conjugate()))" diff --git a/Task/Arithmetic-Complex/PowerShell/arithmetic-complex-2.psh b/Task/Arithmetic-Complex/PowerShell/arithmetic-complex-2.psh new file mode 100644 index 0000000000..99e19293c2 --- /dev/null +++ b/Task/Arithmetic-Complex/PowerShell/arithmetic-complex-2.psh @@ -0,0 +1,16 @@ +function show([System.Numerics.Complex]$c) { + if(0 -ge $c.Imginary) { + return "$($c.Real)+$($c.Imaginary)i" + } else { + return "$($c.Real)$($c.Imaginary)i" + } + } +$m = [System.Numerics.Complex]::new(3, 4) +$n = [System.Numerics.Complex]::new(7, 6) +"`$m: $(show $m)" +"`$n: $(show $n)" +"`$m + `$n: $(show ([System.Numerics.Complex]::Add($m,$n)))" +"`$m * `$n: $(show ([System.Numerics.Complex]::Multiply($m,$n)))" +"negate `$m: $(show ([System.Numerics.Complex]::Negate($m)))" +"1/`$m: $(show ([System.Numerics.Complex]::Reciprocal($m)))" +"conjugate `$m: $(show ([System.Numerics.Complex]::Conjugate($m)))" diff --git a/Task/Arithmetic-Complex/REXX/arithmetic-complex.rexx b/Task/Arithmetic-Complex/REXX/arithmetic-complex.rexx index 067037b1a5..e58b2f326c 100644 --- a/Task/Arithmetic-Complex/REXX/arithmetic-complex.rexx +++ b/Task/Arithmetic-Complex/REXX/arithmetic-complex.rexx @@ -1,23 +1,23 @@ -/*REXX pgm demonstrates how to support some math functions for complex numbers*/ -x = '(5,3i)' /*define X ─── can use I i J or j */ -y = "( .5, 6j)" /*define Y " " " " " " " */ +/*REXX program demonstrates how to support some math functions for complex numbers. */ +x = '(5,3i)' /*define X ─── can use I i J or j */ +y = "( .5, 6j)" /*define Y " " " " " " " */ -say ' addition: ' x " + " y ' = ' Cadd(x,y) -say ' subtraction: ' x " - " y ' = ' Csub(x,y) -say 'multiplication: ' x " * " y ' = ' Cmul(x,y) -say ' division: ' x " ÷ " y ' = ' Cdiv(x,y) -say ' inverse: ' x " = " Cinv(x,y) -say ' conjugate of: ' x " = " Conj(x,y) -say ' negation of: ' x " = " Cneg(x,y) -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────one─liner subroutines─────────────────────*/ -Conj: procedure; arg a ',' b,c ',' d; call C#; return C$( a, -b) -Cadd: procedure; arg a ',' b,c ',' d; call C#; return C$(a+c, b+d) -Csub: procedure; arg a ',' b,c ',' d; call C#; return C$(a-c, b-d) -Cmul: procedure; arg a ',' b,c ',' d; call C#; return C$(ac-bd, bc+ad) -Cdiv: procedure; arg a ',' b,c ',' d; call C#; return C$((ac+bd)/s, (bc-ad)/s) +say ' addition: ' x " + " y ' = ' Cadd(x, y) +say ' subtraction: ' x " - " y ' = ' Csub(x, y) +say 'multiplication: ' x " * " y ' = ' Cmul(x, y) +say ' division: ' x " ÷ " y ' = ' Cdiv(x, y) +say ' inverse: ' x " = " Cinv(x, y) +say ' conjugate of: ' x " = " Conj(x, y) +say ' negation of: ' x " = " Cneg(x, y) +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +Conj: procedure; parse arg a ',' b,c ',' d; call C#; return C$( a , -b ) +Cadd: procedure; parse arg a ',' b,c ',' d; call C#; return C$( a+c , b+d ) +Csub: procedure; parse arg a ',' b,c ',' d; call C#; return C$( a-c , b-d ) +Cmul: procedure; parse arg a ',' b,c ',' d; call C#; return C$( ac-bd , bc+ad) +Cdiv: procedure; parse arg a ',' b,c ',' d; call C#; return C$((ac+bd)/s, (bc-ad)/s) Cinv: return Cdiv(1, arg(1)) Cneg: return Cmul(arg(1), -1) -C_: arg __; return word(translate(__, , '{[(JI)]}') 0, 1) /*get # or 0*/ -C#: a=C_(a);b=C_(b);c=C_(c);d=C_(d);ac=a*c;ad=a*d;bc=b*c;bd=b*d;s=c*c+d*d;return -C$: parse arg r,c;_='['r; if c\=0 then _=_','c"j"; return _']' /*uses j*/ +C_: return word(translate(arg(1), , '{[(JjIi)]}') 0, 1) /*get # or 0*/ +C#: a=C_(a); b=C_(b); c=C_(c); d=C_(d); ac=a*c; ad=a*d; bc=b*c; bd=b*d;s=c*c+d*d; return +C$: parse arg r,c; _='['r; if c\=0 then _=_","c'j'; return _"]" /*uses j */ diff --git a/Task/Arithmetic-Complex/ZX-Spectrum-Basic/arithmetic-complex.zx b/Task/Arithmetic-Complex/ZX-Spectrum-Basic/arithmetic-complex.zx new file mode 100644 index 0000000000..fb8f638ed7 --- /dev/null +++ b/Task/Arithmetic-Complex/ZX-Spectrum-Basic/arithmetic-complex.zx @@ -0,0 +1,23 @@ +5 LET complex=2: LET r=1: LET i=2 +10 DIM a(complex): LET a(r)=1.0: LET a(i)=1.0 +20 DIM b(complex): LET b(r)=PI: LET b(i)=1.2 +30 DIM o(complex) +40 REM add +50 LET o(r)=a(r)+b(r) +60 LET o(i)=a(i)+b(i) +70 PRINT "Result of addition is:": GO SUB 1000 +80 REM mult +90 LET o(r)=a(r)*b(r)-a(i)*b(i) +100 LET o(i)=a(i)*b(r)+a(r)*b(i) +110 PRINT "Result of multiplication is:": GO SUB 1000 +120 REM neg +130 LET o(r)=-a(r) +140 LET o(i)=-a(i) +150 PRINT "Result of negation is:": GO SUB 1000 +160 LET denom=a(r)^2+a(i)^2 +170 LET o(r)=a(r)/denom +180 LET o(i)=-a(i)/denom +190 PRINT "Result of inversion is:": GO SUB 1000 +200 STOP +1000 IF o(i)>=0 THEN PRINT o(r);" + ";o(i);"i": RETURN +1010 PRINT o(r);" - ";-o(i);"i": RETURN diff --git a/Task/Arithmetic-Integer/00DESCRIPTION b/Task/Arithmetic-Integer/00DESCRIPTION index 0d641d39be..1aad7ae43a 100644 --- a/Task/Arithmetic-Integer/00DESCRIPTION +++ b/Task/Arithmetic-Integer/00DESCRIPTION @@ -1,7 +1,18 @@ {{basic data operation}} [[Category:Simple]] -Get two integers from the user, and then output the sum, difference, product, integer quotient and remainder of those numbers. -Don't include error handling. -For quotient, indicate how it rounds (e.g. towards 0, towards negative infinity, etc.). -For remainder, indicate whether its sign matches the sign of the first operand or of the second operand, if they are different. -Also include the exponentiation operator if one exists. +;Task: +Get two integers from the user,   and then (for those two integers), display their: +::::*   sum +::::*   difference +::::*   product +::::*   integer quotient +::::*   remainder +::::*   exponentiation   (if the operator exists) + +
+Don't include error handling. + +For quotient, indicate how it rounds   (e.g. towards zero, towards negative infinity, etc.). + +For remainder, indicate whether its sign matches the sign of the first operand or of the second operand, if they are different. +

diff --git a/Task/Arithmetic-Integer/Go/arithmetic-integer.go b/Task/Arithmetic-Integer/Go/arithmetic-integer-1.go similarity index 100% rename from Task/Arithmetic-Integer/Go/arithmetic-integer.go rename to Task/Arithmetic-Integer/Go/arithmetic-integer-1.go diff --git a/Task/Arithmetic-Integer/Go/arithmetic-integer-2.go b/Task/Arithmetic-Integer/Go/arithmetic-integer-2.go new file mode 100644 index 0000000000..5e6e39d8d2 --- /dev/null +++ b/Task/Arithmetic-Integer/Go/arithmetic-integer-2.go @@ -0,0 +1,29 @@ +package main + +import ( + "fmt" + "math/big" +) + +func main() { + var a, b, c big.Int + fmt.Print("enter two integers: ") + fmt.Scan(&a, &b) + fmt.Printf("%d + %d = %d\n", &a, &b, c.Add(&a, &b)) + fmt.Printf("%d - %d = %d\n", &a, &b, c.Sub(&a, &b)) + fmt.Printf("%d * %d = %d\n", &a, &b, c.Mul(&a, &b)) + + // Quo, Rem functions work like Go operators on int: + // quo truncates toward 0, + // and a non-zero rem has the same sign as the first operand. + fmt.Printf("%d quo %d = %d\n", &a, &b, c.Quo(&a, &b)) + fmt.Printf("%d rem %d = %d\n", &a, &b, c.Rem(&a, &b)) + + // Div, Mod functions do Euclidean division: + // the result m = a mod b is always non-negative, + // and for d = a div b, the results d and m give d*y + m = x. + fmt.Printf("%d div %d = %d\n", &a, &b, c.Div(&a, &b)) + fmt.Printf("%d mod %d = %d\n", &a, &b, c.Mod(&a, &b)) + + // as with int, no exponentiation operator +} diff --git a/Task/Arithmetic-Integer/Onyx/arithmetic-integer.onyx b/Task/Arithmetic-Integer/Onyx/arithmetic-integer.onyx new file mode 100644 index 0000000000..6fa3b926f9 --- /dev/null +++ b/Task/Arithmetic-Integer/Onyx/arithmetic-integer.onyx @@ -0,0 +1,43 @@ +# Most of this long script is mere presentation. +# All you really need to do is push two integers onto the stack +# and then execute add, sub, mul, idiv, or pow. + +$ClearScreen { # Using ANSI terminal control + `\e[2J\e[1;1H' print flush +} bind def + +$Say { # string Say - + `\n' cat print flush +} bind def + +$ShowPreamble { +`To show how integer arithmetic in done in Onyx,' Say +`we\'ll use two numbers of your choice, which' Say +`we\'ll call A and B.\n' Say +} bind def + +$Prompt { # stack: string -- + stdout exch write pop flush +} def + +$GetInt { # stack: name -- integer + dup cvs `Enter integer ' exch cat `: ' cat + Prompt stdin readline pop cvx eval def +} bind def + +$Template { # arithmetic_operator_name label_string Template result_string + A cvs ` ' B cvs ` ' 5 ncat over cvs ` gives ' 3 ncat exch + A B dn cvx eval cvs `.' 3 ncat Say +} bind def + +$ShowResults { + $add `Addition: ' Template + $sub `Subtraction: ' Template + $mul `Multiplication: ' Template + $idiv `Division: ' Template + `Note that the result of integer division is rounded toward zero.' Say + $pow `Exponentiation: ' Template + `Note that the result of raising to a negative power always gives a real number.' Say +} bind def + +ClearScreen ShowPreamble $A GetInt $B GetInt ShowResults diff --git a/Task/Arithmetic-Integer/PHP/arithmetic-integer.php b/Task/Arithmetic-Integer/PHP/arithmetic-integer.php index fbf4bb2185..a17e74c59c 100644 --- a/Task/Arithmetic-Integer/PHP/arithmetic-integer.php +++ b/Task/Arithmetic-Integer/PHP/arithmetic-integer.php @@ -8,5 +8,6 @@ echo "product: ", $a * $b, "\n", "truncating quotient: ", (int)($a / $b), "\n", "flooring quotient: ", floor($a / $b), "\n", - "remainder: ", $a % $b, "\n"; + "remainder: ", $a % $b, "\n", + "power: ", $a ** $b, "\n"; // PHP 5.6+ only ?> diff --git a/Task/Arithmetic-Integer/REXX/arithmetic-integer.rexx b/Task/Arithmetic-Integer/REXX/arithmetic-integer.rexx index 452bcd96a1..bdf1dda673 100644 --- a/Task/Arithmetic-Integer/REXX/arithmetic-integer.rexx +++ b/Task/Arithmetic-Integer/REXX/arithmetic-integer.rexx @@ -1,13 +1,13 @@ -/*REXX pgm gets 2 integers from the C,L. or via prompt; shows some operations.*/ -numeric digits 20 /*#s are round at 20th significant dig.*/ -parse arg x y . /*maybe the integers are on the C.L. */ +/*REXX program obtains two integers from the C.L. (a prompt); displays some operations.*/ +numeric digits 20 /*#s are round at 20th significant dig.*/ +parse arg x y . /*maybe the integers are on the C.L. */ - do while \datatype(x,'W') | \datatype(y,'W') /*both X and Y must be ints.*/ + do while \datatype(x,'W') | \datatype(y,'W') /*both X and Y must be integers. */ say "─────Enter two integer values (separated by blanks):" - parse pull x y . /*accept two items from command line. */ - end /*while ··· */ - /* [↓] perform this DO loop twice. */ - do j=1 for 2 /*show A oper B, then B oper A.*/ + parse pull x y . /*accept two thingys from command line.*/ + end /*while*/ + /* [↓] perform this DO loop twice. */ + do j=1 for 2 /*show A oper B, then B oper A.*/ call show 'addition' , "+", x+y call show 'subtraction' , "-", x-y call show 'multiplication' , "*", x*y @@ -16,9 +16,9 @@ parse arg x y . /*maybe the integers are on the C.L. */ call show 'division remainder', "//", x//y, ' [sign from 1st operand]' call show 'power' , "**", x**y - parse value x y with y x /*swap the two values and perform again*/ - if j==1 then say copies('═', 79) /*display a fence after the 1st round. */ + parse value x y with y x /*swap the two values and perform again*/ + if j==1 then say copies('═', 79) /*display a fence after the 1st round. */ end /*j*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -show: parse arg c,o,#,?; say right(c,25)' ' x center(o,4) y ' ───► ' # ?; return +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +show: parse arg c,o,#,?; say right(c,25)' ' x center(o,4) y " ───► " # ?; return diff --git a/Task/Arithmetic-Integer/Racket/arithmetic-integer.rkt b/Task/Arithmetic-Integer/Racket/arithmetic-integer.rkt index 02c4003d95..b4e1a433c1 100644 --- a/Task/Arithmetic-Integer/Racket/arithmetic-integer.rkt +++ b/Task/Arithmetic-Integer/Racket/arithmetic-integer.rkt @@ -1,7 +1,7 @@ -#lang racket +#lang racket/base + (define (arithmetic x y) - (for ([op '(+ - * / quotient remainder modulo max min gcd lcm)]) - (displayln (~a (list op x y) " => " - ((eval op (make-base-namespace)) x y))))) + (for ([op (list + - * / quotient remainder modulo max min gcd lcm)]) + (printf "~s => ~s\n" `(,(object-name op) ,x ,y) (op x y)))) (arithmetic 8 12) diff --git a/Task/Arithmetic-Integer/ZX-Spectrum-Basic/arithmetic-integer.zx b/Task/Arithmetic-Integer/ZX-Spectrum-Basic/arithmetic-integer.zx new file mode 100644 index 0000000000..fe3cd39580 --- /dev/null +++ b/Task/Arithmetic-Integer/ZX-Spectrum-Basic/arithmetic-integer.zx @@ -0,0 +1,7 @@ +5 LET a=5: LET b=3 +10 PRINT a;" + ";b;" = ";a+b +20 PRINT a;" - ";b;" = ";a-b +30 PRINT a;" * ";b;" = ";a*b +40 PRINT a;" / ";b;" = ";INT (a/b) +50 PRINT a;" mod ";b;" = ";a-INT (a/b)*b +60 PRINT a;" to the power of ";b;" = ";a^b diff --git a/Task/Arithmetic-Rational/00DESCRIPTION b/Task/Arithmetic-Rational/00DESCRIPTION index 8937bfbe2e..10bafe19c4 100644 --- a/Task/Arithmetic-Rational/00DESCRIPTION +++ b/Task/Arithmetic-Rational/00DESCRIPTION @@ -1,6 +1,8 @@ -The objective of this task is to create a reasonably complete implementation of rational arithmetic in the particular language using the idioms of the language. +;Task: +Create a reasonably complete implementation of rational arithmetic in the particular language using the idioms of the language. -For example: + +;Example: Define a new type called '''frac''' with binary operator "//" of two integers that returns a '''structure''' made up of the numerator and the denominator (as per a rational number). Further define the appropriate rational unary '''operators''' '''abs''' and '-', with the binary '''operators''' for addition '+', subtraction '-', multiplication '×', division '/', integer division '÷', modulo division, the comparison operators (e.g. '<', '≤', '>', & '≥') and equality operators (e.g. '=' & '≠'). @@ -12,5 +14,7 @@ If space allows, define standard increment and decrement '''operators''' (e.g. ' Finally test the operators: Use the new type '''frac''' to find all [[Perfect Numbers|perfect numbers]] less than 219 by summing the reciprocal of the factors. -'''See also''' -* [[Perfect Numbers]] + +;Related task: +*   [[Perfect Numbers]] +

diff --git a/Task/Arithmetic-Rational/Elixir/arithmetic-rational.elixir b/Task/Arithmetic-Rational/Elixir/arithmetic-rational.elixir new file mode 100644 index 0000000000..f555975001 --- /dev/null +++ b/Task/Arithmetic-Rational/Elixir/arithmetic-rational.elixir @@ -0,0 +1,66 @@ +defmodule Rational do + import Kernel, except: [div: 2] + + defstruct numerator: 0, denominator: 1 + + def new(numerator), do: %Rational{numerator: numerator, denominator: 1} + + def new(numerator, denominator) do + sign = if numerator * denominator < 0, do: -1, else: 1 + {numerator, denominator} = {abs(numerator), abs(denominator)} + gcd = gcd(numerator, denominator) + %Rational{numerator: sign * Kernel.div(numerator, gcd), + denominator: Kernel.div(denominator, gcd)} + end + + def add(a, b) do + {a, b} = convert(a, b) + new(a.numerator * b.denominator + b.numerator * a.denominator, + a.denominator * b.denominator) + end + + def sub(a, b) do + {a, b} = convert(a, b) + new(a.numerator * b.denominator - b.numerator * a.denominator, + a.denominator * b.denominator) + end + + def mult(a, b) do + {a, b} = convert(a, b) + new(a.numerator * b.numerator, a.denominator * b.denominator) + end + + def div(a, b) do + {a, b} = convert(a, b) + new(a.numerator * b.denominator, a.denominator * b.numerator) + end + + defp convert(a), do: if is_integer(a), do: new(a), else: a + + defp convert(a, b), do: {convert(a), convert(b)} + + defp gcd(a, 0), do: a + defp gcd(a, b), do: gcd(b, rem(a, b)) +end + +defimpl Inspect, for: Rational do + def inspect(r, _opts) do + "%Rational<#{r.numerator}/#{r.denominator}>" + end +end + +Enum.each(2..trunc(:math.pow(2,19)), fn candidate -> + sum = 2 .. round(:math.sqrt(candidate)) + |> Enum.reduce(Rational.new(1, candidate), fn factor,sum -> + if rem(candidate, factor) == 0 do + Rational.add(sum, Rational.new(1, factor)) + |> Rational.add(Rational.new(1, div(candidate, factor))) + else + sum + end + end) + if sum.denominator == 1 do + :io.format "Sum of recipr. factors of ~6w = ~w exactly ~s~n", + [candidate, sum.numerator, (if sum.numerator == 1, do: "perfect!", else: "")] + end +end) diff --git a/Task/Arithmetic-Rational/Frink/arithmetic-rational.frink b/Task/Arithmetic-Rational/Frink/arithmetic-rational.frink new file mode 100644 index 0000000000..2545030b76 --- /dev/null +++ b/Task/Arithmetic-Rational/Frink/arithmetic-rational.frink @@ -0,0 +1,11 @@ +1/2 + 2/3 +// 7/6 (approx. 1.1666666666666667) + +1/2 + 1/2 +// 1 + +5/sextillion + 3/quadrillion +// 600001/200000000000000000000 (exactly 3.000005e-15) + +8^(1/3) +// 2 (note the exact integer result.) diff --git a/Task/Arithmetic-Rational/J/arithmetic-rational-1.j b/Task/Arithmetic-Rational/J/arithmetic-rational-1.j index 43410ffad4..662e7db50b 100644 --- a/Task/Arithmetic-Rational/J/arithmetic-rational-1.j +++ b/Task/Arithmetic-Rational/J/arithmetic-rational-1.j @@ -1,2 +1,4 @@ - 3r4*2r5 -3r10 + (x: 3) % (x: -4) +_3r4 + 3 %&x: -4 +_3r4 diff --git a/Task/Arithmetic-Rational/J/arithmetic-rational-10.j b/Task/Arithmetic-Rational/J/arithmetic-rational-10.j new file mode 100644 index 0000000000..4a3f32d884 --- /dev/null +++ b/Task/Arithmetic-Rational/J/arithmetic-rational-10.j @@ -0,0 +1,2 @@ + (#~ is_perfect_rational"0) (* <:@+:) 2^i.10x +6 28 496 8128 diff --git a/Task/Arithmetic-Rational/J/arithmetic-rational-2.j b/Task/Arithmetic-Rational/J/arithmetic-rational-2.j index 69202bf44d..f7e3d1d74d 100644 --- a/Task/Arithmetic-Rational/J/arithmetic-rational-2.j +++ b/Task/Arithmetic-Rational/J/arithmetic-rational-2.j @@ -1 +1,28 @@ - is_perfect_rational=: 2 = (1 + i.) +/@:%@([ #~ 0 = |) ] + | _3r4 NB. absolute value +3r4 + -2r5 NB. negation +_2r5 + 3r4+2r5 NB. addition +23r20 + 3r4-2r5 NB. subtraction +7r20 + 3r4*2r5 NB. multiplication +3r10 + 3r4%2r5 NB. division +15r8 + 3r4 <.@% 2r5 NB. integer division +1 + 3r4 (-~ <.)@% 2r5 NB. remainder +_7r8 + 3r4 < 2r5 NB. less than +0 + 3r4 <: 2r5 NB. less than or equal +0 + 3r4 > 2r5 NB. greater than +1 + 3r4 >: 2r5 NB. greater than or equal +1 + 3r4 = 2r5 NB. equal +0 + 3r4 ~: 2r5 NB. not equal +1 diff --git a/Task/Arithmetic-Rational/J/arithmetic-rational-3.j b/Task/Arithmetic-Rational/J/arithmetic-rational-3.j index 3e4a5cd64e..f0b52bf2fc 100644 --- a/Task/Arithmetic-Rational/J/arithmetic-rational-3.j +++ b/Task/Arithmetic-Rational/J/arithmetic-rational-3.j @@ -1,2 +1,4 @@ -factors=: */&>@{@((^ i.@>:)&.>/)@q:~&__ -is_perfect_rational=: 2= +/@:%@,@factors + x: 3%4 +3r4 + x:inv 3%4 +0.75 diff --git a/Task/Arithmetic-Rational/J/arithmetic-rational-4.j b/Task/Arithmetic-Rational/J/arithmetic-rational-4.j index 22a9cdb013..4c7adf99ea 100644 --- a/Task/Arithmetic-Rational/J/arithmetic-rational-4.j +++ b/Task/Arithmetic-Rational/J/arithmetic-rational-4.j @@ -1,4 +1,4 @@ - I.is_perfect_rational@"0 i.2^19 -6 28 496 8128 - I.is_perfect_rational@x:@"0 i.2^19x -6 28 496 8128 + >: 3r4 +7r4 + <: 3r4 +_1r4 diff --git a/Task/Arithmetic-Rational/J/arithmetic-rational-5.j b/Task/Arithmetic-Rational/J/arithmetic-rational-5.j index 4a3f32d884..24bc4d5ff4 100644 --- a/Task/Arithmetic-Rational/J/arithmetic-rational-5.j +++ b/Task/Arithmetic-Rational/J/arithmetic-rational-5.j @@ -1,2 +1,7 @@ - (#~ is_perfect_rational"0) (* <:@+:) 2^i.10x -6 28 496 8128 +mutadd=:adverb define + (m)=: (".m)+y +) + +mutsub=:adverb define + (m)=: (".m)-y +) diff --git a/Task/Arithmetic-Rational/J/arithmetic-rational-6.j b/Task/Arithmetic-Rational/J/arithmetic-rational-6.j new file mode 100644 index 0000000000..601c47fa5b --- /dev/null +++ b/Task/Arithmetic-Rational/J/arithmetic-rational-6.j @@ -0,0 +1,7 @@ + n=: 3r4 + 'n' mutadd 1 +7r4 + 'n' mutsub 1 +3r4 + 'n' mutsub 1 +_1r4 diff --git a/Task/Arithmetic-Rational/J/arithmetic-rational-7.j b/Task/Arithmetic-Rational/J/arithmetic-rational-7.j new file mode 100644 index 0000000000..69202bf44d --- /dev/null +++ b/Task/Arithmetic-Rational/J/arithmetic-rational-7.j @@ -0,0 +1 @@ + is_perfect_rational=: 2 = (1 + i.) +/@:%@([ #~ 0 = |) ] diff --git a/Task/Arithmetic-Rational/J/arithmetic-rational-8.j b/Task/Arithmetic-Rational/J/arithmetic-rational-8.j new file mode 100644 index 0000000000..3e4a5cd64e --- /dev/null +++ b/Task/Arithmetic-Rational/J/arithmetic-rational-8.j @@ -0,0 +1,2 @@ +factors=: */&>@{@((^ i.@>:)&.>/)@q:~&__ +is_perfect_rational=: 2= +/@:%@,@factors diff --git a/Task/Arithmetic-Rational/J/arithmetic-rational-9.j b/Task/Arithmetic-Rational/J/arithmetic-rational-9.j new file mode 100644 index 0000000000..22a9cdb013 --- /dev/null +++ b/Task/Arithmetic-Rational/J/arithmetic-rational-9.j @@ -0,0 +1,4 @@ + I.is_perfect_rational@"0 i.2^19 +6 28 496 8128 + I.is_perfect_rational@x:@"0 i.2^19x +6 28 496 8128 diff --git a/Task/Arithmetic-Rational/OCaml/arithmetic-rational-3.ocaml b/Task/Arithmetic-Rational/OCaml/arithmetic-rational-3.ocaml new file mode 100644 index 0000000000..efd7a34891 --- /dev/null +++ b/Task/Arithmetic-Rational/OCaml/arithmetic-rational-3.ocaml @@ -0,0 +1,21 @@ +(* interface *) +module type RATIO = + sig + type t + (* construct *) + val frac : int -> int -> t + val from_int : int -> t + + (* integer test *) + val is_int : t -> bool + + (* output *) + val to_string : t -> string + + (* arithmetic *) + val cmp : t -> t -> int + val ( +/ ) : t -> t -> t + val ( -/ ) : t -> t -> t + val ( */ ) : t -> t -> t + val ( // ) : t -> t -> t + end diff --git a/Task/Arithmetic-Rational/OCaml/arithmetic-rational-4.ocaml b/Task/Arithmetic-Rational/OCaml/arithmetic-rational-4.ocaml new file mode 100644 index 0000000000..2e4d612d5c --- /dev/null +++ b/Task/Arithmetic-Rational/OCaml/arithmetic-rational-4.ocaml @@ -0,0 +1,58 @@ +(* implementation conforming to signature *) +module Frac : RATIO = + struct + open Big_int + + type t = { num : big_int; den : big_int } + + (* short aliases for big_int values and functions *) + let zero, one = zero_big_int, unit_big_int + let big, to_int, eq = big_int_of_int, int_of_big_int, eq_big_int + let (+~), (-~), ( *~) = add_big_int, sub_big_int, mult_big_int + + (* helper function *) + let rec norm ({num=n;den=d} as k) = + if lt_big_int d zero then + norm {num=minus_big_int n;den=minus_big_int d} + else + let rec hcf a b = + let q,r = quomod_big_int a b in + if eq r zero then b else hcf b r in + let f = hcf n d in + if eq f one then k else + let div = div_big_int in + { num=div n f; den = div d f } (* inefficient *) + + (* public functions *) + let frac a b = norm { num=big a; den=big b } + + let from_int a = norm { num=big a; den=one } + + let is_int {num=n; den=d} = + eq d one || + eq (mod_big_int n d) zero + + let to_string ({num=n; den=d} as r) = + let r1 = norm r in + let str = string_of_big_int in + if is_int r1 then + str (r1.num) + else + str (r1.num) ^ "/" ^ str (r1.den) + + let cmp a b = + let a1 = norm a and b1 = norm b in + compare_big_int (a1.num*~b1.den) (b1.num*~a1.den) + + let ( */ ) {num=n1; den=d1} {num=n2; den=d2} = + norm { num = n1*~n2; den = d1*~d2 } + + let ( // ) {num=n1; den=d1} {num=n2; den=d2} = + norm { num = n1*~d2; den = d1*~n2 } + + let ( +/ ) {num=n1; den=d1} {num=n2; den=d2} = + norm { num = n1*~d2 +~ n2*~d1; den = d1*~d2 } + + let ( -/ ) {num=n1; den=d1} {num=n2; den=d2} = + norm { num = n1*~d2 -~ n2*~d1; den = d1*~d2 } + end diff --git a/Task/Arithmetic-Rational/OCaml/arithmetic-rational-5.ocaml b/Task/Arithmetic-Rational/OCaml/arithmetic-rational-5.ocaml new file mode 100644 index 0000000000..221602c1e4 --- /dev/null +++ b/Task/Arithmetic-Rational/OCaml/arithmetic-rational-5.ocaml @@ -0,0 +1,14 @@ +(* use the module to calculate perfect numbers *) +let () = + for i = 2 to 1 lsl 19 do + let sum = ref (Frac.frac 1 i) in + for factor = 2 to truncate (sqrt (float i)) do + if i mod factor = 0 then + Frac.( + sum := !sum +/ frac 1 factor +/ frac 1 (i / factor) + ) + done; + if Frac.is_int !sum then + Printf.printf "Sum of reciprocal factors of %d = %s exactly %s\n%!" + i (Frac.to_string !sum) (if Frac.to_string !sum = "1" then "perfect!" else "") + done diff --git a/Task/Arithmetic-Rational/Perl-6/arithmetic-rational-1.pl6 b/Task/Arithmetic-Rational/Perl-6/arithmetic-rational-1.pl6 index de7b6ee512..45d5716c5b 100644 --- a/Task/Arithmetic-Rational/Perl-6/arithmetic-rational-1.pl6 +++ b/Task/Arithmetic-Rational/Perl-6/arithmetic-rational-1.pl6 @@ -5,7 +5,7 @@ for 2..2**19 -> $candidate { $sum += 1 / $factor + 1 / ($candidate / $factor); } } - if $sum.denominator == 1 { + if $sum.nude[1] == 1 { say "Sum of reciprocal factors of $candidate = $sum exactly", ($sum == 1 ?? ", perfect!" !! "."); } } diff --git a/Task/Arithmetic-Rational/Rust/arithmetic-rational.rust b/Task/Arithmetic-Rational/Rust/arithmetic-rational.rust new file mode 100644 index 0000000000..9a19f51aa4 --- /dev/null +++ b/Task/Arithmetic-Rational/Rust/arithmetic-rational.rust @@ -0,0 +1,133 @@ +use std::cmp::Ordering; +use std::ops::{Add, AddAssign, Sub, SubAssign, Mul, MulAssign, Div, DivAssign, Neg}; + +fn gcd(a: i64, b: i64) -> i64 { + match b { + 0 => a, + _ => gcd(b, a % b), + } +} + +fn lcm(a: i64, b: i64) -> i64 { + a / gcd(a, b) * b +} + +#[derive(Clone, Copy, Debug, Eq, PartialEq, Hash, Ord)] +pub struct Rational { + numerator: i64, + denominator: i64, +} + +impl Rational { + fn new(numerator: i64, denominator: i64) -> Self { + let divisor = gcd(numerator, denominator); + Rational { + numerator: numerator / divisor, + denominator: denominator / divisor, + } + } +} + +impl Add for Rational { + type Output = Self; + + fn add(self, other: Self) -> Self { + let multiplier = lcm(self.denominator, other.denominator); + Rational::new(self.numerator * multiplier / self.denominator + + other.numerator * multiplier / other.denominator, + multiplier) + } +} + +impl AddAssign for Rational { + fn add_assign(&mut self, other: Self) { + *self = *self + other; + } +} + +impl Sub for Rational { + type Output = Self; + + fn sub(self, other: Self) -> Self { + self + -other + } +} + +impl SubAssign for Rational { + fn sub_assign(&mut self, other: Self) { + *self = *self - other; + } +} + +impl Mul for Rational { + type Output = Self; + + fn mul(self, other: Self) -> Self { + Rational::new(self.numerator * other.numerator, + self.denominator * other.denominator) + } +} + +impl MulAssign for Rational { + fn mul_assign(&mut self, other: Self) { + *self = *self * other; + } +} + +impl Div for Rational { + type Output = Self; + + fn div(self, other: Self) -> Self { + self * + Rational { + numerator: other.denominator, + denominator: other.numerator, + } + } +} + +impl DivAssign for Rational { + fn div_assign(&mut self, other: Self) { + *self = *self / other; + } +} + +impl Neg for Rational { + type Output = Self; + + fn neg(self) -> Self { + Rational { + numerator: -self.numerator, + denominator: self.denominator, + } + } +} + +impl PartialOrd for Rational { + fn partial_cmp(&self, other: &Self) -> Option { + (self.numerator * other.denominator).partial_cmp(&(self.denominator * other.numerator)) + } +} + +impl> From for Rational { + fn from(value: T) -> Self { + Rational::new(value.into(), 1) + } +} + +fn main() { + let max = 1 << 19; + for candidate in 2..max { + let mut sum = Rational::new(1, candidate); + for factor in 2..(candidate as f64).sqrt().ceil() as i64 { + if candidate % factor == 0 { + sum += Rational::new(1, factor); + sum += Rational::new(1, candidate / factor); + } + } + + if sum == 1.into() { + println!("{} is perfect", candidate); + } + } +} diff --git a/Task/Arithmetic-evaluation/00DESCRIPTION b/Task/Arithmetic-evaluation/00DESCRIPTION index 608fa66217..de76de6aaa 100644 --- a/Task/Arithmetic-evaluation/00DESCRIPTION +++ b/Task/Arithmetic-evaluation/00DESCRIPTION @@ -6,15 +6,17 @@ Create a program which parses and evaluates arithmetic expressions. * The expression will be a string or list of symbols like "(1+3)*7". * The four symbols + - * / must be supported as binary operators with conventional precedence rules. * Precedence-control parentheses must also be supported. +
;Note: For those who don't remember, mathematical precedence is as follows: * Parentheses * Multiplication/Division (left to right) * Addition/Subtraction (left to right) - +
;C.f: * [[24 game Player]]. * [[Parsing/RPN calculator algorithm]]. * [[Parsing/RPN to infix conversion]]. +

diff --git a/Task/Arithmetic-evaluation/Elena/arithmetic-evaluation.elena b/Task/Arithmetic-evaluation/Elena/arithmetic-evaluation.elena index 37c77114ac..9eed08c46f 100644 --- a/Task/Arithmetic-evaluation/Elena/arithmetic-evaluation.elena +++ b/Task/Arithmetic-evaluation/Elena/arithmetic-evaluation.elena @@ -1,6 +1,7 @@ -#define system. -#define system'routines. -#define extensions. +#import system. +#import system'routines. +#import extensions. +#import extensions'text. #class Token { @@ -9,7 +10,7 @@ #constructor new &level:aLevel [ - theValue := String new. + theValue := StringWriter new. theLevel := aLevel + 9. ] @@ -17,10 +18,10 @@ #method append : aChar [ - theValue += aChar. + theValue << aChar. ] - #method number = theValue value toReal. + #method number = theValue get toReal. } #class Node @@ -100,8 +101,6 @@ #method number => theTop. } -// --- States --- - #symbol operatorState = (:ch) [ ch => @@ -219,7 +218,7 @@ #method append:ch [ - ((ch >= 48) and:(ch < 58)) + ((ch >= #48) and:(ch < #58)) ? [ theToken append:ch. ] ! [ #throw InvalidArgumentException new &message:"Invalid expression". ]. ] @@ -320,11 +319,13 @@ #var aText := String new. #var aParser := Parser new. - [ (aText << console readLine) length > 0] doWhile: + [ console readLine save &to:aText length > 0] doWhile: [ console writeLine:"=" :(aParser run:aText) | if &Error:e [ console writeLine:"Invalid Expression". ]. + + aText clear. ]. ]. diff --git a/Task/Arithmetic-evaluation/Emacs-Lisp/arithmetic-evaluation.l b/Task/Arithmetic-evaluation/Emacs-Lisp/arithmetic-evaluation.l new file mode 100644 index 0000000000..8e806350fe --- /dev/null +++ b/Task/Arithmetic-evaluation/Emacs-Lisp/arithmetic-evaluation.l @@ -0,0 +1,93 @@ +#!/usr/bin/env emacs --script +;; -*- mode: emacs-lisp; lexical-binding: t -*- +;;> ./arithmetic-evaluation '(1 + 2) * 3' + +(defun advance () + (let ((rtn (buffer-substring-no-properties (point) (match-end 0)))) + (goto-char (match-end 0)) + rtn)) + +(defvar current-symbol nil) + +(defun next-symbol () + (when (looking-at "[ \t\n]+") + (goto-char (match-end 0))) + + (cond + ((eobp) + (setq current-symbol 'eof)) + ((looking-at "[0-9]+") + (setq current-symbol (string-to-number (advance)))) + ((looking-at "[-+*/()]") + (setq current-symbol (advance))) + ((looking-at ".") + (error "Unknown character '%s'" (advance))))) + +(defun accept (sym) + (when (equal sym current-symbol) + (next-symbol) + t)) + +(defun expect (sym) + (unless (accept sym) + (error "Expected symbol %s, but found %s" sym current-symbol)) + t) + +(defun p-expression () + " expression = term { ('+' | '-') term } . " + (let ((rtn (p-term))) + (while (or (equal current-symbol "+") (equal current-symbol "-")) + (let ((op current-symbol) + (left rtn)) + (next-symbol) + (setq rtn (list op left (p-term))))) + rtn)) + +(defun p-term () + " term = factor { ('*' | '/') factor } . " + (let ((rtn (p-factor))) + (while (or (equal current-symbol "*") (equal current-symbol "/")) + (let ((op current-symbol) + (left rtn)) + (next-symbol) + (setq rtn (list op left (p-factor))))) + rtn)) + +(defun p-factor () + " factor = constant | variable | '(' expression ')' . " + (let (rtn) + (cond + ((numberp current-symbol) + (setq rtn current-symbol) + (next-symbol)) + ((accept "(") + (setq rtn (p-expression)) + (expect ")")) + (t (error "Syntax error"))) + rtn)) + +(defun ast-build (expression) + (let (rtn) + (with-temp-buffer + (insert expression) + (goto-char (point-min)) + (next-symbol) + (setq rtn (p-expression)) + (expect 'eof)) + rtn)) + +(defun ast-eval (v) + (pcase v + ((pred numberp) v) + (`("+" ,a ,b) (+ (ast-eval a) (ast-eval b))) + (`("-" ,a ,b) (- (ast-eval a) (ast-eval b))) + (`("*" ,a ,b) (* (ast-eval a) (ast-eval b))) + (`("/" ,a ,b) (/ (ast-eval a) (float (ast-eval b)))) + (_ (error "Unknown value %s" v)))) + +(dolist (arg command-line-args-left) + (let ((ast (ast-build arg))) + (princ (format " ast = %s\n" ast)) + (princ (format " value = %s\n" (ast-eval ast))) + (terpri))) +(setq command-line-args-left nil) diff --git a/Task/Arithmetic-evaluation/Haskell/arithmetic-evaluation.hs b/Task/Arithmetic-evaluation/Haskell/arithmetic-evaluation.hs index 301404b8a4..bc1030b4cd 100644 --- a/Task/Arithmetic-evaluation/Haskell/arithmetic-evaluation.hs +++ b/Task/Arithmetic-evaluation/Haskell/arithmetic-evaluation.hs @@ -2,6 +2,7 @@ import Text.Parsec import Text.Parsec.Expr import Text.Parsec.Combinator import Data.Functor +import Data.Function (on) data Exp = Num Int | Add Exp Exp @@ -15,15 +16,13 @@ expr = buildExpressionParser table factor op s f assoc = Infix (f <$ string s) assoc factor = (between `on` char) '(' ')' expr <|> (Num . read <$> many1 digit) - on f g = \x y -> f (g x) (g y) eval :: Num a => Exp -> a -eval e = case e of - Num x -> fromIntegral x - Add a b -> eval a + eval b - Sub a b -> eval a - eval b - Mul a b -> eval a * eval b - Div a b -> eval a `div` eval b +eval (Num x) = fromIntegral x +eval (Add a b) = eval a + eval b +eval (Sub a b) = eval a - eval b +eval (Mul a b) = eval a * eval b +eval (Div a b) = eval a `div` eval b solution :: Num a => String -> a solution = either (const (error "Did not parse")) eval . parse expr "" diff --git a/Task/Arithmetic-evaluation/Perl-6/arithmetic-evaluation-1.pl6 b/Task/Arithmetic-evaluation/Perl-6/arithmetic-evaluation-1.pl6 index 8671ee7321..25b8d1a0cf 100644 --- a/Task/Arithmetic-evaluation/Perl-6/arithmetic-evaluation-1.pl6 +++ b/Task/Arithmetic-evaluation/Perl-6/arithmetic-evaluation-1.pl6 @@ -13,13 +13,13 @@ sub ev (Str $s --> Num) { my sub minus ($b) { $b ?? -1 !! +1 } my sub sum ($x) { - [+] product($x), map + [+] flat product($x), map { minus($^y[0] eq '-') * product $^y }, |($x[0] or []) } my sub product ($x) { - [*] factor($x), map + [*] flat factor($x), map { factor($^y) ** minus($^y[0] eq '/') }, |($x[0] or []) } diff --git a/Task/Arithmetic-evaluation/REXX/arithmetic-evaluation.rexx b/Task/Arithmetic-evaluation/REXX/arithmetic-evaluation.rexx index 552f0bee2f..1279c5ecd2 100644 --- a/Task/Arithmetic-evaluation/REXX/arithmetic-evaluation.rexx +++ b/Task/Arithmetic-evaluation/REXX/arithmetic-evaluation.rexx @@ -1,117 +1,116 @@ -/*REXX pgm evaluates an infix-type arithmetic expression & shows result.*/ -nchars = '0123456789.eEdDqQ' /*possible parts of a #, sans ± */ -e='***error!***'; $=' '; doubleOps='&|*/'; z= -parse arg x 1 ox1; if x='' then call serr 'no input was specified.' -x=space(x); L=length(x); x=translate(x,'()()',"[]{}") - -j=0; do forever; j=j+1; if j>L then leave; _=substr(x,j,1); _2=getX() - newT=pos(_,' ()[]{}^÷')\==0; if newT then do; z=z _ $; iterate; end - possDouble=pos(_,doubleOps)\==0 /*is _ a possible double operator*/ - if possDouble then do /*is this a possible double oper?*/ - if _2==_ then do /*yup, it's one of 'em.*/ - _=_||_ /*use a double operator*/ - x=overlay($,x,Nj) /*blank out the*/ - end /* 2nd symbol.*/ - z=z _ $; iterate - end - if _=='+' | _=="-" then do; p_=word(z,words(z)) /*last Z token*/ - if p_=='(' then z=z 0 /*handle unary ±*/ - z=z _ $; iterate +/*REXX program evaluates an infix─type arithmetic expression and displays the result.*/ +nchars = '0123456789.eEdDqQ' /*possible parts of a number, sans ± */ +e='***error***'; $=" "; doubleOps= '&|*/'; z= /*handy─dandy variables.*/ +parse arg x 1 ox1; if x='' then call serr "no input was specified." +x=space(x); L=length(x); x=translate(x, '()()', "[]{}") +j=0 + do forever; j=j+1; if j>L then leave; _=substr(x, j, 1); _2=getX() + newT=pos(_,' ()[]{}^÷')\==0; if newT then do; z=z _ $; iterate; end + possDouble=pos(_,doubleOps)\==0 /*is _ a possible double operator?*/ + if possDouble then do /* " this " " " " */ + if _2==_ then do /*yupper, it's one of a double operator*/ + _=_ || _ /*create and use a double char operator*/ + x=overlay($, x, Nj) /*blank out 2nd symbol.*/ + end + z=z _ $; iterate + end + if _=='+' | _=="-" then do; p_=word(z, max(1,words(z))) /*last Z token. */ + if p_=='(' then z=z 0 /*handle a unary ± */ + z=z _ $; iterate end lets=0; sigs=0; #=_ - do j=j+1 to L; _=substr(x,j,1) /*build a valid number.*/ - if lets==1 & sigs==0 then if _=='+' | _=='-' then do; sigs=1 - #=# || _ - iterate + do j=j+1 to L; _=substr(x,j,1) /*build a valid number.*/ + if lets==1 & sigs==0 then if _=='+' | _=="-" then do; sigs=1 + #=# || _ + iterate end if pos(_,nchars)==0 then leave - lets=lets+datatype(_,'M') /*keep track of # of exponents. */ - #=# || translate(_,'EEEEE','eDdQq') /*keep buildingthe num.*/ + lets=lets+datatype(_,'M') /*keep track of the number of exponents*/ + #=# || translate(_,'EEEEE', "eDdQq") /*keep building the number. */ end /*j*/ j=j-1 - if \datatype(#,'N') then call serr 'invalid number: ' # + if \datatype(#,'N') then call serr "invalid number: " # z=z # $ end /*forever*/ -_=word(z,1); if _=='+' | _=='-' then z=0 z /*handle unary cases.*/ -x='(' space(z) ') '; tokens=words(x) /*force stacking for expression. */ - do i=1 for tokens; @.i=word(x,i); end /*i*/ /*assign input tokens*/ -L=max(20,length(x)) /*use 20 for the min show width. */ -op=')(-+/*^'; rOp=substr(op,3); p.=; s.=; n=length(op); epr=; stack= +_=word(z,1); if _=='+' | _=="-" then z=0 z /*handle the unary cases. */ +x='(' space(z) ")"; tokens=words(x) /*force stacking for the expression. */ + do i=1 for tokens; @.i=word(x,i); end /*i*/ /*assign input tokens. */ +L=max(20,length(x)) /*use 20 for the minimum display width.*/ +op= ')(-+/*^'; Rop=substr(op,3); p.=; s.=; n=length(op); epr=; stack= - do i=1 for n; _=substr(op,i,1); s._=(i+1)%2; p._=s._+(i==n); end /*i*/ - /*[↑] assign operator priorities.*/ - do #=1 for tokens; ?=@.# /*process each token from @. list*/ - if ?=='**' then ?="^" /*convert REXX-type exponentation*/ - select /*@.# is: (, operator, ), operand*/ - when ?=='(' then stack='(' stack - when isOp(?) then do /*is token an operator?*/ + do i=1 for n; _=substr(op,i,1); s._=(i+1)%2; p._=s._ + (i==n); end /*i*/ + /* [↑] assign the operator priorities.*/ + do #=1 for tokens; ?=@.# /*process each token from the @. list.*/ + if ?=='**' then ?="^" /*convert to REXX-type exponentiation. */ + select /*@.# is: ( operator ) operand*/ + when ?=='(' then stack="(" stack + when isOp(?) then do /*is the token an operator ? */ !=word(stack,1) /*get token from stack.*/ - do while !\==')' & s.!>=p.?; epr=epr ! /*add*/ - stack=subword(stack,2); /*del token from stack.*/ - !=word(stack,1) /*get token from stack.*/ - end /*while ···)*/ - stack=? stack /*add token to stack.*/ + do while !\==')' & s.!>=p.?; epr=epr ! /*addition.*/ + stack=subword(stack, 2) /*del token from stack*/ + != word(stack, 1) /*get token from stack*/ + end /*while*/ + stack=? stack /*add token to stack*/ end - when ?==')' then do; !=word(stack,1) /*get token from stack.*/ - do while !\=='('; epr=epr ! /*add to epr.*/ - stack=subword(stack,2) /*del token from stack.*/ - !=word(stack,1) /*get token from stack.*/ - end /*while ···( */ - stack=subword(stack,2) /*del token from stack.*/ + when ?==')' then do; !=word(stack, 1) /*get token from stack*/ + do while !\=='('; epr=epr ! /*append to expression*/ + stack=subword(stack, 2) /*del token from stack*/ + != word(stack, 1) /*get token from stack*/ + end /*while*/ + stack=subword(stack, 2) /*del token from stack*/ end - otherwise epr=epr ? /*add operand to epr. */ + otherwise epr=epr ? /*add operand to epr.*/ end /*select*/ end /*#*/ epr=space(epr stack); tokens=words(epr); x=epr; z=; stack= - do i=1 for tokens; @.i=word(epr,i); end /*i*/ /*assign input tokens*/ -dop='/ // % ÷'; bop='& | &&' /*division ops; binary operands*/ -aop='- + * ^ **' dop bop; lop=aop '||' /*arithmetic ops; legal operands*/ + do i=1 for tokens; @.i=word(epr,i); end /*i*/ /*assign input tokens.*/ +Dop='/ // % ÷'; Bop="& | &&" /*division operands; binary operands.*/ +Aop='- + * ^ **' Dop Bop; Lop=Aop "||" /*arithmetic operands; legal operands.*/ - do #=1 for tokens; ?=@.#; ??=? /*process each token from @. list*/ - w=words(stack); b=word(stack,max(1,w)) /*stack count; last entry.*/ - a=word(stack,max(1,w-1)) /*stack's "first" operand.*/ - division =wordpos(?,dop)\==0 /*flag: doing a division.*/ - arith =wordpos(?,aop)\==0 /*flag: doing arithmetic.*/ - bitOp =wordpos(?,bop)\==0 /*flag: doing binary math*/ - if datatype(?,'N') then do; stack=stack ?; iterate; end - if wordpos(?,lop)==0 then do; z=e 'illegal operator:' ?; leave; end - if w<2 then do; z=e 'illegal epr expression.'; leave; end - if ?=='^' then ??="**" /*REXXify ^ ──► ** (make legal)*/ - if ?=='÷' then ??="/" /*REXXify ÷ ──► / (make legal)*/ - if division & b=0 then do; z=e 'division by zero: ' b; leave; end - if bitOp & \isBit(a) then do; z=e "token isn't logical: " a; leave; end - if bitOp & \isBit(b) then do; z=e "token isn't logical: " b; leave; end - select /*perform arith. operation*/ - when ??=='+' then y = a + b - when ??=='-' then y = a - b - when ??=='*' then y = a * b - when ??=='/' | ??=="÷" then y = a / b - when ??=='//' then y = a // b - when ??=='%' then y = a % b - when ??=='^' | ??=="**" then y = a ** b - when ??=='||' then y = a || b - otherwise z=e 'invalid operator:' ?; leave - end /*select*/ - if datatype(y,'W') then y=y/1 /*normalize number with ÷ by 1.*/ - _=subword(stack,1,w-2); stack=_ y /*rebuild the stack with answer. */ + do #=1 for tokens; ?=@.#; ??=? /*process each token from @. list. */ + w=words(stack); b=word(stack, max(1, w ) ) /*stack count; the last entry. */ + a=word(stack, max(1, w-1) ) /*stack's "first" operand. */ + division =wordpos(?, Dop)\==0 /*flag: doing a division operation. */ + arith =wordpos(?, Aop)\==0 /*flag: doing arithmetic operation. */ + bitOp =wordpos(?, Bop)\==0 /*flag: doing binary mathematics. */ + if datatype(?, 'N') then do; stack=stack ?; iterate; end + if wordpos(?,Lop)==0 then do; z=e "illegal operator:" ?; leave; end + if w<2 then do; z=e "illegal epr expression."; leave; end + if ?=='^' then ??="**" /*REXXify ^ ──► ** (make it legal).*/ + if ?=='÷' then ??="/" /*REXXify ÷ ──► / (make it legal).*/ + if division & b=0 then do; z=e "division by zero" b; leave; end + if bitOp & \isBit(a) then do; z=e "token isn't logical: " a; leave; end + if bitOp & \isBit(b) then do; z=e "token isn't logical: " b; leave; end + select /*perform an arithmetic operation. */ + when ??=='+' then y = a + b + when ??=='-' then y = a - b + when ??=='*' then y = a * b + when ??=='/' | ??=="÷" then y = a / b + when ??=='//' then y = a // b + when ??=='%' then y = a % b + when ??=='^' | ??=="**" then y = a ** b + when ??=='||' then y = a || b + otherwise z=e 'invalid operator:' ?; leave + end /*select*/ + if datatype(y, 'W') then y=y/1 /*normalize the number with ÷ by 1. */ + _=subword(stack, 1, w-2); stack=_ y /*rebuild the stack with the answer. */ end /*#*/ -if word(z,1)==e then stack= /*handle special case of errors. */ -z=space(z stack) /*append any residual entries. */ -say 'answer──►' z /*display the answer (result). */ -parse source upper . how . /*invoked via C.L. or REXX pgm?*/ -if how=='COMMAND' | , - \datatype(z,'W') then exit /*stick a fork in it, we're done.*/ -return z /*return Z ──► invoker (RESULT).*/ -/*──────────────────────────────────subroutines─────────────────────────*/ -isBit: return arg(1)==0 | arg(1)==1 /*returns 1 if arg1 is bin bit.*/ -isOp: return pos(arg(1),rOp)\==0 /*is argument1 a "real" operator?*/ -serr: say; say e arg(1); say; exit 13 /*issue an error message with txt*/ -/*──────────────────────────────────GETX subroutine─────────────────────*/ -getX: do Nj=j+1 to length(x); _n=substr(x,Nj,1); if _n==$ then iterate - return substr(x,Nj,1) /* [↑] ignore any blanks in exp.*/ - end /*Nj*/ -return $ /*reached end-of-tokens, return $*/ +if word(z, 1)==e then stack= /*handle the special case of errors. */ +z=space(z stack) /*append any residual entries. */ +say 'answer──►' z /*display the answer (result). */ +parse source upper . how . /*invoked via C.L. or REXX program ? */ +if how=='COMMAND' | \datatype(z, 'W') then exit /*stick a fork in it, we're all done. */ +return z /*return Z ──► invoker (the RESULT). */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +isBit: return arg(1)==0 | arg(1) == 1 /*returns 1 if 1st argument is binary*/ +isOp: return pos(arg(1), rOp) \== 0 /*is argument 1 a "real" operator? */ +serr: say; say e arg(1); say; exit 13 /*issue an error message with some text*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +getX: do Nj=j+1 to length(x); _n=substr(x, Nj, 1); if _n==$ then iterate + return substr(x, Nj, 1) /* [↑] ignore any blanks in expression*/ + end /*Nj*/ + return $ /*reached end-of-tokens, return $. */ diff --git a/Task/Arithmetic-evaluation/Standard-ML/arithmetic-evaluation.ml b/Task/Arithmetic-evaluation/Standard-ML/arithmetic-evaluation.ml new file mode 100644 index 0000000000..8804fefeff --- /dev/null +++ b/Task/Arithmetic-evaluation/Standard-ML/arithmetic-evaluation.ml @@ -0,0 +1,69 @@ +(* AST *) +datatype expression = + Con of int (* constant *) + | Add of expression * expression (* addition *) + | Mul of expression * expression (* multiplication *) + | Sub of expression * expression (* subtraction *) + | Div of expression * expression (* division *) + +(* Evaluator *) +fun eval (Con x) = x + | eval (Add (x, y)) = (eval x) + (eval y) + | eval (Mul (x, y)) = (eval x) * (eval y) + | eval (Sub (x, y)) = (eval x) - (eval y) + | eval (Div (x, y)) = (eval x) div (eval y) + +(* Lexer *) +datatype token = + CON of int + | ADD + | MUL + | SUB + | DIV + | LPAR + | RPAR + +fun lex nil = nil + | lex (#"+" :: cs) = ADD :: lex cs + | lex (#"*" :: cs) = MUL :: lex cs + | lex (#"-" :: cs) = SUB :: lex cs + | lex (#"/" :: cs) = DIV :: lex cs + | lex (#"(" :: cs) = LPAR :: lex cs + | lex (#")" :: cs) = RPAR :: lex cs + | lex (#"~" :: cs) = if null cs orelse not (Char.isDigit (hd cs)) then raise Domain + else lexDigit (0, cs, ~1) + | lex (c :: cs) = if Char.isDigit c then lexDigit (0, c :: cs, 1) + else raise Domain + +and lexDigit (a, cs, s) = if null cs orelse not (Char.isDigit (hd cs)) then CON (a*s) :: lex cs + else lexDigit (a * 10 + (ord (hd cs))- (ord #"0") , tl cs, s) + +(* Parser *) +exception Error of string + +fun match (a,ts) t = if null ts orelse hd ts <> t + then raise Error "match" + else (a, tl ts) + +fun extend (a,ts) p f = let val (a',tr) = p ts in (f(a,a'), tr) end + +fun parseE ts = parseE' (parseM ts) +and parseE' (e, ADD :: ts) = parseE' (extend (e, ts) parseM Add) + | parseE' (e, SUB :: ts) = parseE' (extend (e, ts) parseM Sub) + | parseE' s = s + +and parseM ts = parseM' (parseP ts) +and parseM' (e, MUL :: ts) = parseM' (extend (e, ts) parseP Mul) + | parseM' (e, DIV :: ts) = parseM' (extend (e, ts) parseP Div) + | parseM' s = s + +and parseP (CON c :: ts) = (Con c, ts) + | parseP (LPAR :: ts) = match (parseE ts) RPAR + | parseP _ = raise Error "parseP" + + +(* Test *) +fun lex_parse_eval (str:string) = + case parseE (lex (explode str)) of + (exp, nil) => eval exp + | _ => raise Error "not parseable stuff at the end" diff --git a/Task/Arithmetic-evaluation/ZX-Spectrum-Basic/arithmetic-evaluation.zx b/Task/Arithmetic-evaluation/ZX-Spectrum-Basic/arithmetic-evaluation.zx new file mode 100644 index 0000000000..eb7f8c4ed7 --- /dev/null +++ b/Task/Arithmetic-evaluation/ZX-Spectrum-Basic/arithmetic-evaluation.zx @@ -0,0 +1,31 @@ +10 PRINT "Use integer numbers and signs"'"+ - * / ( )"'' +20 LET s$="": REM last symbol +30 LET pc=0: REM parenthesis counter +40 LET i$="1+2*(3+(4*5+6*7*8)-9)/10" +50 PRINT "Input = ";i$ +60 FOR n=1 TO LEN i$ +70 LET c$=i$(n) +80 IF c$>="0" AND c$<="9" THEN GO SUB 170: GO TO 130 +90 IF c$="+" OR c$="-" THEN GO SUB 200: GO TO 130 +100 IF c$="*" OR c$="/" THEN GO SUB 200: GO TO 130 +110 IF c$="(" OR c$=")" THEN GO SUB 230: GO TO 130 +120 GO TO 300 +130 NEXT n +140 IF pc>0 THEN PRINT FLASH 1;"Parentheses not paired.": BEEP 1,-25: STOP +150 PRINT "Result = ";VAL i$ +160 STOP +170 IF s$=")" THEN GO TO 300 +180 LET s$=c$ +190 RETURN +200 IF (NOT (s$>="0" AND s$<="9")) AND s$<>")" THEN GO TO 300 +210 LET s$=c$ +220 RETURN +230 IF c$="(" AND ((s$>="0" AND s$<="9") OR s$=")") THEN GO TO 300 +240 IF c$=")" AND ((NOT (s$>="0" AND s$<="9")) OR s$="(") THEN GO TO 300 +250 LET s$=c$ +260 IF c$="(" THEN LET pc=pc+1: RETURN +270 LET pc=pc-1 +280 IF pc<0 THEN GO TO 300 +290 RETURN +300 PRINT FLASH 1;"Invalid symbol ";c$;" detected in pos ";n: BEEP 1,-25 +310 STOP diff --git a/Task/Arithmetic-geometric-mean-Calculate-Pi/00DESCRIPTION b/Task/Arithmetic-geometric-mean-Calculate-Pi/00DESCRIPTION index a18a4854c7..2b4e1a6f01 100644 --- a/Task/Arithmetic-geometric-mean-Calculate-Pi/00DESCRIPTION +++ b/Task/Arithmetic-geometric-mean-Calculate-Pi/00DESCRIPTION @@ -7,7 +7,7 @@ With the same notations used in [[Arithmetic-geometric mean]], we can summarize {1 - \sum\limits_{n=1}^{\infty} 2^{n+1}(a_n^2-g_n^2)} -This allows you to make the approximation, for any large N: +This allows you to make the approximation, for any large   '''N''': \pi \approx \frac{4\; a_N^2} diff --git a/Task/Arithmetic-geometric-mean-Calculate-Pi/Clojure/arithmetic-geometric-mean-calculate-pi.clj b/Task/Arithmetic-geometric-mean-Calculate-Pi/Clojure/arithmetic-geometric-mean-calculate-pi.clj new file mode 100644 index 0000000000..5f21cb7d45 --- /dev/null +++ b/Task/Arithmetic-geometric-mean-Calculate-Pi/Clojure/arithmetic-geometric-mean-calculate-pi.clj @@ -0,0 +1,27 @@ +(ns async-example.core + (:use [criterium.core]) + (:gen-class)) + +; Java Arbitray Precision Library +(import '(org.apfloat Apfloat ApfloatMath)) + +(def precision 8192) + +; Define big constants (i.e. 1, 2, 4, 0.5, .25, 1/sqrt(2)) +(def one (Apfloat. 1M precision)) +(def two (Apfloat. 2M precision)) +(def four (Apfloat. 4M precision)) +(def half (Apfloat. 0.5M precision)) +(def quarter (Apfloat. 0.25M precision)) +(def isqrt2 (.divide one (ApfloatMath/pow two half))) + +(defn compute-pi [iterations] + (loop [i 0, n one, [a g] [one isqrt2], z quarter] + (if (> i iterations) + (.divide (.multiply a a) z) + (let [x [(.multiply (.add a g) half) (ApfloatMath/pow (.multiply a g) half)] + v (.subtract (first x) a)] + (recur (inc i) (.add n n) x (.subtract z (.multiply (.multiply v v) n))))))) + +(doseq [q (partition-all 200 (str (compute-pi 18)))] + (println (apply str q))) diff --git a/Task/Arithmetic-geometric-mean-Calculate-Pi/Common-Lisp/arithmetic-geometric-mean-calculate-pi.lisp b/Task/Arithmetic-geometric-mean-Calculate-Pi/Common-Lisp/arithmetic-geometric-mean-calculate-pi.lisp new file mode 100644 index 0000000000..d36f7e55ff --- /dev/null +++ b/Task/Arithmetic-geometric-mean-Calculate-Pi/Common-Lisp/arithmetic-geometric-mean-calculate-pi.lisp @@ -0,0 +1,18 @@ +(load "bf.fasl") + +;;(setf mma::bigfloat-bin-prec 1000) + +(let ((A (mma:bigfloat-convert 1.0d0)) + (N (mma:bigfloat-convert 1.0d0)) + (Z (mma:bigfloat-convert 0.25d0)) + (G (mma:bigfloat-/ (mma:bigfloat-convert 1.0d0) + (mma:bigfloat-sqrt (mma:bigfloat-convert 2.0d0))))) + (loop repeat 18 do + (let* ((X1 (mma:bigfloat-* (mma:bigfloat-+ A G) (mma:bigfloat-convert 0.5d0))) + (X2 (mma:bigfloat-sqrt (mma:bigfloat-* A G))) + (V (mma:bigfloat-- X1 A))) + (setf Z (mma:bigfloat-- Z (mma:bigfloat-* (mma:bigfloat-/ (mma:bigfloat-* V V) (mma:bigfloat-convert 1.0d0)) N) )) + (setf N (mma:bigfloat-+ N N)) + (setf A X1) + (setf G X2))) + (mma:bigfloat-/ (mma:bigfloat-* A A) Z)) diff --git a/Task/Arithmetic-geometric-mean/00DESCRIPTION b/Task/Arithmetic-geometric-mean/00DESCRIPTION index 3460ed5dae..2a2615e8dd 100644 --- a/Task/Arithmetic-geometric-mean/00DESCRIPTION +++ b/Task/Arithmetic-geometric-mean/00DESCRIPTION @@ -1,4 +1,8 @@ {{wikipedia|Arithmetic-geometric mean}} + + +;task: + Write a function to compute the [[wp:Arithmetic-geometric mean|arithmetic-geometric mean]] of two numbers. [http://mathworld.wolfram.com/Arithmetic-GeometricMean.html] The arithmetic-geometric mean of two numbers can be (usefully) denoted as \mathrm{agm}(a,g), and is equal to the limit of the sequence: @@ -8,3 +12,8 @@ Since the limit of a_n-g_n tends (rapidly) to zero with iterations, Demonstrate the function by calculating: :\mathrm{agm}(1,1/\sqrt{2}) + + +;Also see: +*   [http://mathworld.wolfram.com/Arithmetic-GeometricMean.html mathworld.wolfram.com/Arithmetic-Geometric Mean] +

diff --git a/Task/Arithmetic-geometric-mean/AppleScript/arithmetic-geometric-mean.applescript b/Task/Arithmetic-geometric-mean/AppleScript/arithmetic-geometric-mean.applescript new file mode 100644 index 0000000000..193ec10bc0 --- /dev/null +++ b/Task/Arithmetic-geometric-mean/AppleScript/arithmetic-geometric-mean.applescript @@ -0,0 +1,66 @@ +property tolerance : 1.0E-5 + +-- agm :: Num a => a -> a -> a +on agm(a, g) + script withinTolerance + on lambda(m) + tell m to ((its an) - (its gn)) < tolerance + end lambda + end script + + script nextRefinement + on lambda(m) + tell m + set {an, gn} to {its an, its gn} + {an:(an + gn) / 2, gn:(an * gn) ^ 0.5} + end tell + end lambda + end script + + an of |until|(withinTolerance, ¬ + nextRefinement, {an:(a + g) / 2, gn:(a * g) ^ 0.5}) +end agm + + +-- TEST +on run + + agm(1, 1 / (2 ^ 0.5)) + +end run + + + +-- GENERIC + +-- until :: (a -> Bool) -> (a -> a) -> a -> a +on |until|(p, f, x) + set mp to mReturn(p) + set mf to mReturn(f) + + script + property p : mp's lambda + property f : mf's lambda + + on lambda(v) + repeat until p(v) + set v to f(v) + end repeat + return v + end lambda + end script + + result's lambda(x) +end |until| + +-- 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 diff --git a/Task/Arithmetic-geometric-mean/C++/arithmetic-geometric-mean.cpp b/Task/Arithmetic-geometric-mean/C++/arithmetic-geometric-mean.cpp index 6daecaa99e..e72ad24f16 100644 --- a/Task/Arithmetic-geometric-mean/C++/arithmetic-geometric-mean.cpp +++ b/Task/Arithmetic-geometric-mean/C++/arithmetic-geometric-mean.cpp @@ -1,34 +1,28 @@ -/*Arithmetic Geometric Mean of 1 and 1/sqrt(2) +#include +using namespace std; +#define _cin ios_base::sync_with_stdio(0); cin.tie(0); +#define rep(a, b) for(ll i =a;i<=b;++i) - Nigel_Galloway - February 7th., 2012. -*/ - -#include "gmp.h" - -void agm (const mpf_t in1, const mpf_t in2, mpf_t out1, mpf_t out2) { - mpf_add (out1, in1, in2); - mpf_div_ui (out1, out1, 2); - mpf_mul (out2, in1, in2); - mpf_sqrt (out2, out2); -} - -int main (void) { - mpf_set_default_prec (65568); - mpf_t x0, y0, resA, resB; - - mpf_init_set_ui (y0, 1); - mpf_init_set_d (x0, 0.5); - mpf_sqrt (x0, x0); - mpf_init (resA); - mpf_init (resB); - - for(int i=0; i<7; i++){ - agm(x0, y0, resA, resB); - agm(resA, resB, x0, y0); +double agm(double a, double g) //ARITHMETIC GEOMETRIC MEAN +{ double epsilon = 1.0E-16,a1,g1; + if(a*g<0.0) + { cout<<"Couldn't find arithmetic-geometric mean of these numbers\n"; + exit(1); } - gmp_printf ("%.20000Ff\n", x0); - gmp_printf ("%.20000Ff\n\n", y0); - - return 0; + while(fabs(a-g)>epsilon) + { a1 = (a+g)/2.0; + g1 = sqrt(a*g); + a = a1; + g = g1; + } + return a; +} + +int main() +{ _cin; //fast input-output + double x, y; + cout<<"Enter X and Y: "; //Enter two numbers + cin>>x>>y; + cout<<"\nThe Arithmetic-Geometric Mean of "< cnt MAX-LOOPS)) + an + (recur [(.multiply (.add an gn) half) (ApfloatMath/pow (.multiply an gn) half)] + (inc cnt)))))) + +(println (agm one isqrt2)) diff --git a/Task/Arithmetic-geometric-mean/JavaScript/arithmetic-geometric-mean-1.js b/Task/Arithmetic-geometric-mean/JavaScript/arithmetic-geometric-mean-1.js new file mode 100644 index 0000000000..0b5a7bd0aa --- /dev/null +++ b/Task/Arithmetic-geometric-mean/JavaScript/arithmetic-geometric-mean-1.js @@ -0,0 +1,10 @@ +function agm(a0, g0) { + var an = (a0 + g0) / 2, + gn = Math.sqrt(a0 * g0); + while (Math.abs(an - gn) > tolerance) { + an = (an + gn) / 2, gn = Math.sqrt(an * gn) + } + return an; +} + +agm(1, 1 / Math.sqrt(2)); diff --git a/Task/Arithmetic-geometric-mean/JavaScript/arithmetic-geometric-mean-2.js b/Task/Arithmetic-geometric-mean/JavaScript/arithmetic-geometric-mean-2.js new file mode 100644 index 0000000000..87d917740c --- /dev/null +++ b/Task/Arithmetic-geometric-mean/JavaScript/arithmetic-geometric-mean-2.js @@ -0,0 +1,43 @@ +(() => { + 'use strict'; + + // ARITHMETIC-GEOMETRIC MEAN + + // agm :: Num a => a -> a -> a + let agm = (a, g) => { + let abs = Math.abs, + sqrt = Math.sqrt; + + return until( + m => abs(m.an - m.gn) < tolerance, + m => { + return { + an: (m.an + m.gn) / 2, + gn: sqrt(m.an * m.gn) + }; + }, { + an: (a + g) / 2, + gn: sqrt(a * g) + } + ) + .an; + }, + + // GENERIC + + // until :: (a -> Bool) -> (a -> a) -> a -> a + until = (p, f, x) => { + let v = x; + while (!p(v)) v = f(v); + return v; + }; + + + // TEST + + let tolerance = 0.000001; + + + return agm(1, 1 / Math.sqrt(2)); + +})(); diff --git a/Task/Arithmetic-geometric-mean/JavaScript/arithmetic-geometric-mean-3.js b/Task/Arithmetic-geometric-mean/JavaScript/arithmetic-geometric-mean-3.js new file mode 100644 index 0000000000..309dd71712 --- /dev/null +++ b/Task/Arithmetic-geometric-mean/JavaScript/arithmetic-geometric-mean-3.js @@ -0,0 +1 @@ +0.8472130848351929 diff --git a/Task/Arithmetic-geometric-mean/JavaScript/arithmetic-geometric-mean.js b/Task/Arithmetic-geometric-mean/JavaScript/arithmetic-geometric-mean.js deleted file mode 100644 index ef6963d51c..0000000000 --- a/Task/Arithmetic-geometric-mean/JavaScript/arithmetic-geometric-mean.js +++ /dev/null @@ -1,9 +0,0 @@ -function agm(a0,g0){ -var an=(a0+g0)/2,gn=Math.sqrt(a0*g0); -while(Math.abs(an-gn)>tolerance){ -an=(an+gn)/2,gn=Math.sqrt(an*gn) -} -return an; -} - -agm(1,1/Math.sqrt(2)); diff --git a/Task/Arithmetic-geometric-mean/Oberon-2/arithmetic-geometric-mean.oberon-2 b/Task/Arithmetic-geometric-mean/Oberon-2/arithmetic-geometric-mean.oberon-2 new file mode 100644 index 0000000000..42db0b9125 --- /dev/null +++ b/Task/Arithmetic-geometric-mean/Oberon-2/arithmetic-geometric-mean.oberon-2 @@ -0,0 +1,25 @@ +MODULE Agm; +IMPORT + Math := LRealMath, + Out; + +CONST + epsilon = 1.0E-15; + +PROCEDURE Of*(a,g: LONGREAL): LONGREAL; +VAR + na,ng,og: LONGREAL; +BEGIN + na := a; ng := g; + LOOP + og := ng; + ng := Math.sqrt(na * ng); + na := (na + og) * 0.5; + IF na - ng <= epsilon THEN EXIT END + END; + RETURN ng; +END Of; + +BEGIN + Out.LongReal(Of(1,1 / Math.sqrt(2)),0,0);Out.Ln +END Agm. diff --git a/Task/Arithmetic-geometric-mean/Perl-6/arithmetic-geometric-mean-1.pl6 b/Task/Arithmetic-geometric-mean/Perl-6/arithmetic-geometric-mean-1.pl6 index 5c06eb4b6a..8b2b3119c3 100644 --- a/Task/Arithmetic-geometric-mean/Perl-6/arithmetic-geometric-mean-1.pl6 +++ b/Task/Arithmetic-geometric-mean/Perl-6/arithmetic-geometric-mean-1.pl6 @@ -1,10 +1,6 @@ sub agm( $a is copy, $g is copy ) { - loop { - given ($a + $g)/2, sqrt $a * $g { - return $a if @$_ ~~ ($a, $g); - ($a, $g) = @$_; - } - } + ($a, $g) = ($a + $g)/2, sqrt $a * $g until $a ≅ $g; + return $a; } say agm 1, 1/sqrt 2; diff --git a/Task/Arithmetic-geometric-mean/Perl-6/arithmetic-geometric-mean-2.pl6 b/Task/Arithmetic-geometric-mean/Perl-6/arithmetic-geometric-mean-2.pl6 index c9fed29838..5264b2cb48 100644 --- a/Task/Arithmetic-geometric-mean/Perl-6/arithmetic-geometric-mean-2.pl6 +++ b/Task/Arithmetic-geometric-mean/Perl-6/arithmetic-geometric-mean-2.pl6 @@ -1,5 +1,5 @@ sub agm( $a, $g ) { - @$_ ~~ ($a, $g) ?? $a !! agm(|@$_) + $a ≅ $g ?? $a !! agm(|@$_) given ($a + $g)/2, sqrt $a * $g; } diff --git a/Task/Arithmetic-geometric-mean/REXX/arithmetic-geometric-mean.rexx b/Task/Arithmetic-geometric-mean/REXX/arithmetic-geometric-mean.rexx index 360ef88915..1c21ffd6c1 100644 --- a/Task/Arithmetic-geometric-mean/REXX/arithmetic-geometric-mean.rexx +++ b/Task/Arithmetic-geometric-mean/REXX/arithmetic-geometric-mean.rexx @@ -1,30 +1,28 @@ -/*REXX program calculates the AGM (arithmetic─geometric mean) of two numbers.*/ -parse arg a b digs . /*obtain optional numbers from the C.L.*/ -if digs=='' | digs==',' then digs=100 /*No DIGS specified? Then use default.*/ -numeric digits digs /*REXX will use lots of decimal digits.*/ -if a=='' | a==',' then a=1 /*No A specified? Then use default.*/ -if b=='' | b==',' then b=1/sqrt(2) /*No B specified? " " " */ -say '1st # =' a /*display the A value. */ -say '2nd # =' b /* " " B " */ -say ' AGM =' agm(a, b) /* " " AGM " */ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -agm: procedure: parse arg x,y; if x=y then return x /*equality case?*/ - if y=0 then return 0 /*is Y zero? */ - if x=0 then return y/2 /* " X " */ - d=digits(); numeric digits d+5 /*add 5 more digs to ensure convergence*/ - tiny='1e-' || (digits()-1); /*construct a pretty tiny REXX number. */ +/*REXX program calculates the AGM (arithmetic─geometric mean) of two (real) numbers. */ +parse arg a b digs . /*obtain optional numbers from the C.L.*/ +if digs=='' | digs=="," then digs=110 /*No DIGS specified? Then use default.*/ +numeric digits digs /*REXX will use lots of decimal digits.*/ +if a=='' | a=="," then a=1 /*No A specified? Then use the default*/ +if b=='' | b=="," then b=1/sqrt(2) /* " B " " " " " */ +call AGM a,b /*invoke the AGM function. */ +say '1st # =' a /*display the A value. */ +say '2nd # =' b /* " " B " */ +say ' AGM =' agm(a, b) /* " " AGM " */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +agm: procedure: parse arg x,y; if x=y then return x /*is this an equality case?*/ + if y=0 then return 0 /*is Y equal to zero ? */ + if x=0 then return y/2 /* " X " " " */ + d=digits(); numeric digits d+5 /*add 5 more digs to ensure convergence*/ + tiny='1e-' || ( digits() -1 ) /*construct a pretty tiny REXX number. */ ox=x+1 - do while ox\=x & abs(ox)>tiny; ox=x; oy=y - x=(ox+oy)/2; y=sqrt(ox*oy) - end /*while ··· */ - - numeric digits d /*restore numeric digits to original.*/ - return x/1 /*normalize X to the new digits. */ -/*────────────────────────────────────────────────────────────────────────────*/ -sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); i=; m.=9 - numeric digits 9; numeric form; h=d+6; if x<0 then do; x=-x; i='i'; end - parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_%2 - do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ - do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ - numeric digits d; return (g/1)i /*make complex if X < 0.*/ + do #=1 while ox\=x & abs(ox)>tiny; ox=x; oy=y + x=(ox+oy)/2; y=sqrt(ox*oy) + end /*#*/ + numeric digits d; return x/1 /*restore digs, normalize X to new digs*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); m.=9; numeric form; h=d+6 + numeric digits; parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g *.5'e'_ % 2 + do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ + do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ + return g diff --git a/Task/Arithmetic-geometric-mean/ZX-Spectrum-Basic/arithmetic-geometric-mean.zx b/Task/Arithmetic-geometric-mean/ZX-Spectrum-Basic/arithmetic-geometric-mean.zx new file mode 100644 index 0000000000..e76e376bd0 --- /dev/null +++ b/Task/Arithmetic-geometric-mean/ZX-Spectrum-Basic/arithmetic-geometric-mean.zx @@ -0,0 +1,6 @@ +10 LET a=1: LET g=1/SQR 2 +20 LET ta=a +30 LET a=(a+g)/2 +40 LET g=SQR (ta*g) +50 IF aarray1 + array2, so be it. +

diff --git a/Task/Array-concatenation/AppleScript/array-concatenation-1.applescript b/Task/Array-concatenation/AppleScript/array-concatenation-1.applescript new file mode 100644 index 0000000000..64b4b0e874 --- /dev/null +++ b/Task/Array-concatenation/AppleScript/array-concatenation-1.applescript @@ -0,0 +1,3 @@ +set listA to {1, 2, 3} +set listB to {4, 5, 6} +return listA & listB diff --git a/Task/Array-concatenation/AppleScript/array-concatenation-2.applescript b/Task/Array-concatenation/AppleScript/array-concatenation-2.applescript new file mode 100644 index 0000000000..ac569d6e0d --- /dev/null +++ b/Task/Array-concatenation/AppleScript/array-concatenation-2.applescript @@ -0,0 +1,17 @@ +on run + + concat([["alpha", "beta", "gamma"], ¬ + ["delta", "epsilon", "zeta"], ¬ + ["eta", "theta", "iota"]]) + +end run + + +-- concat :: [[a]] -> [a] +on concat(xxs) + set lst to {} + repeat with xs in xxs + set lst to lst & xs + end repeat + return lst +end concat diff --git a/Task/Array-concatenation/Babel/array-concatenation.pb b/Task/Array-concatenation/Babel/array-concatenation.pb index cb81dcfd58..020ef9ae91 100644 --- a/Task/Array-concatenation/Babel/array-concatenation.pb +++ b/Task/Array-concatenation/Babel/array-concatenation.pb @@ -1 +1 @@ -main : { [val 1 2 3] [val 4 5 6] cat } +[1 2 3] [4 5 6] cat ; diff --git a/Task/Array-concatenation/COBOL/array-concatenation.cobol b/Task/Array-concatenation/COBOL/array-concatenation.cobol new file mode 100644 index 0000000000..aba0804525 --- /dev/null +++ b/Task/Array-concatenation/COBOL/array-concatenation.cobol @@ -0,0 +1,57 @@ + identification division. + program-id. array-concat. + + environment division. + configuration section. + repository. + function all intrinsic. + + data division. + working-storage section. + 01 table-one. + 05 int-field pic 999 occurs 0 to 5 depending on t1. + 01 table-two. + 05 int-field pic 9(4) occurs 0 to 10 depending on t2. + + 77 t1 pic 99. + 77 t2 pic 99. + + 77 show pic z(4). + + procedure division. + array-concat-main. + perform initialize-tables + perform concatenate-tables + perform display-result + goback. + + initialize-tables. + move 4 to t1 + perform varying tally from 1 by 1 until tally > t1 + compute int-field of table-one(tally) = tally * 3 + end-perform + + move 3 to t2 + perform varying tally from 1 by 1 until tally > t2 + compute int-field of table-two(tally) = tally * 6 + end-perform + . + + concatenate-tables. + perform varying tally from 1 by 1 until tally > t1 + add 1 to t2 + move int-field of table-one(tally) + to int-field of table-two(t2) + end-perform + . + + display-result. + perform varying tally from 1 by 1 until tally = t2 + move int-field of table-two(tally) to show + display trim(show) ", " with no advancing + end-perform + move int-field of table-two(tally) to show + display trim(show) + . + + end program array-concat. diff --git a/Task/Array-concatenation/Clojure/array-concatenation.clj b/Task/Array-concatenation/Clojure/array-concatenation-1.clj similarity index 100% rename from Task/Array-concatenation/Clojure/array-concatenation.clj rename to Task/Array-concatenation/Clojure/array-concatenation-1.clj diff --git a/Task/Array-concatenation/Clojure/array-concatenation-2.clj b/Task/Array-concatenation/Clojure/array-concatenation-2.clj new file mode 100644 index 0000000000..724722093d --- /dev/null +++ b/Task/Array-concatenation/Clojure/array-concatenation-2.clj @@ -0,0 +1 @@ +(into [1 2 3] [4 5 6]) diff --git a/Task/Array-concatenation/Ela/array-concatenation.ela b/Task/Array-concatenation/Ela/array-concatenation.ela new file mode 100644 index 0000000000..1925d8210f --- /dev/null +++ b/Task/Array-concatenation/Ela/array-concatenation.ela @@ -0,0 +1,3 @@ +xs = [1,2,3] +ys = [4,5,6] +xs ++ ys diff --git a/Task/Array-concatenation/Emacs-Lisp/array-concatenation.l b/Task/Array-concatenation/Emacs-Lisp/array-concatenation.l new file mode 100644 index 0000000000..f133cb177f --- /dev/null +++ b/Task/Array-concatenation/Emacs-Lisp/array-concatenation.l @@ -0,0 +1,2 @@ +(vconcat '[1 2 3] '[4 5] '[6 7 8 9]) +=> [1 2 3 4 5 6 7 8 9] diff --git a/Task/Array-concatenation/JavaScript/array-concatenation.js b/Task/Array-concatenation/JavaScript/array-concatenation-1.js similarity index 100% rename from Task/Array-concatenation/JavaScript/array-concatenation.js rename to Task/Array-concatenation/JavaScript/array-concatenation-1.js diff --git a/Task/Array-concatenation/JavaScript/array-concatenation-2.js b/Task/Array-concatenation/JavaScript/array-concatenation-2.js new file mode 100644 index 0000000000..ecec080542 --- /dev/null +++ b/Task/Array-concatenation/JavaScript/array-concatenation-2.js @@ -0,0 +1,16 @@ +(function () { + 'use strict'; + + // concat :: [[a]] -> [a] + function concat(xs) { + return [].concat.apply([], xs); + } + + + return concat( + [["alpha", "beta", "gamma"], + ["delta", "epsilon", "zeta"], + ["eta", "theta", "iota"]] + ); + +})(); diff --git a/Task/Array-concatenation/Lua/array-concatenation.lua b/Task/Array-concatenation/Lua/array-concatenation.lua index dd2cd546a4..dd2e3ba1ae 100644 --- a/Task/Array-concatenation/Lua/array-concatenation.lua +++ b/Task/Array-concatenation/Lua/array-concatenation.lua @@ -1,4 +1,8 @@ -a = {1,2,3} -b = {4,5,6} -table.foreach(b,function(i,v)table.insert(a,v)end) -for i,v in next,a do io.write (v..' ') end +a = {1, 2, 3} +b = {4, 5, 6} + +for _, v in pairs(b) do + table.insert(a, v) +end + +print(table.concat(a, ", ")) diff --git a/Task/Array-concatenation/Onyx/array-concatenation.onyx b/Task/Array-concatenation/Onyx/array-concatenation.onyx new file mode 100644 index 0000000000..07416b1dfc --- /dev/null +++ b/Task/Array-concatenation/Onyx/array-concatenation.onyx @@ -0,0 +1,13 @@ +# With two arrays on the stack, cat pops +# them, concatenates them, and pushes the result back +# on the stack. This works with arrays of integers, +# strings, or whatever. For example, + +[1 2 3] [4 5 6] cat # result: [1 2 3 4 5 6] +[`abc' `def'] [`ghi' `jkl'] cat # result: [`abc' `def' `ghi' `jkl'] + +# To concatenate more than two arrays, push the number of arrays +# to concatenate onto the stack and use ncat. For example, + +[1 true `a'] [2 false `b'] [`3rd array'] 3 ncat +# leaves [1 true `a' 2 false `b' `3rd array'] on the stack diff --git a/Task/Array-concatenation/Rust/array-concatenation.rust b/Task/Array-concatenation/Rust/array-concatenation.rust new file mode 100644 index 0000000000..bd0f38811e --- /dev/null +++ b/Task/Array-concatenation/Rust/array-concatenation.rust @@ -0,0 +1,17 @@ +fn main() { + let a_vec: Vec = vec![1, 2, 3, 4, 5]; + let b_vec: Vec = vec![6; 5]; + + let c_vec = concatenate_arrays::(a_vec.as_slice(), b_vec.as_slice()); + + println!("{:?} ~ {:?} => {:?}", a_vec, b_vec, c_vec); +} + +fn concatenate_arrays(x: &[T], y: &[T]) -> Vec { + let mut concat: Vec = vec![x[0].clone(); x.len()]; + + concat.clone_from_slice(x); + concat.extend_from_slice(y); + + concat +} diff --git a/Task/Array-concatenation/S-lang/array-concatenation-1.slang b/Task/Array-concatenation/S-lang/array-concatenation-1.slang new file mode 100644 index 0000000000..105f2c29b2 --- /dev/null +++ b/Task/Array-concatenation/S-lang/array-concatenation-1.slang @@ -0,0 +1,2 @@ +variable a = [1, 2, 3]; +variable b = [4, 5, 6]; diff --git a/Task/Array-concatenation/S-lang/array-concatenation-2.slang b/Task/Array-concatenation/S-lang/array-concatenation-2.slang new file mode 100644 index 0000000000..b0087cb349 --- /dev/null +++ b/Task/Array-concatenation/S-lang/array-concatenation-2.slang @@ -0,0 +1,3 @@ +variable la = length(a), c = _typeof(a)[la+length(b)]; +c[ [:la-1] ] = a; +c[ [la:] ] = b; diff --git a/Task/Array-concatenation/S-lang/array-concatenation-3.slang b/Task/Array-concatenation/S-lang/array-concatenation-3.slang new file mode 100644 index 0000000000..059d4ecdba --- /dev/null +++ b/Task/Array-concatenation/S-lang/array-concatenation-3.slang @@ -0,0 +1,4 @@ +a = {1, 2, 3}; +b = {4, 5, 6}; + +variable c = list_concat(a, b); diff --git a/Task/Array-concatenation/S-lang/array-concatenation-4.slang b/Task/Array-concatenation/S-lang/array-concatenation-4.slang new file mode 100644 index 0000000000..4ac36280cd --- /dev/null +++ b/Task/Array-concatenation/S-lang/array-concatenation-4.slang @@ -0,0 +1 @@ +c = list_to_array(c); diff --git a/Task/Array-concatenation/S-lang/array-concatenation-5.slang b/Task/Array-concatenation/S-lang/array-concatenation-5.slang new file mode 100644 index 0000000000..cde255b214 --- /dev/null +++ b/Task/Array-concatenation/S-lang/array-concatenation-5.slang @@ -0,0 +1 @@ +list_join(a, b); diff --git a/Task/Array-concatenation/ZX-Spectrum-Basic/array-concatenation.zx b/Task/Array-concatenation/ZX-Spectrum-Basic/array-concatenation.zx new file mode 100644 index 0000000000..63d342117d --- /dev/null +++ b/Task/Array-concatenation/ZX-Spectrum-Basic/array-concatenation.zx @@ -0,0 +1,14 @@ +10 LET x=10 +20 LET y=20 +30 DIM a(x) +40 DIM b(y) +50 DIM c(x+y) +60 FOR i=1 TO x +70 LET c(i)=a(i) +80 NEXT i +90 FOR i=1 TO y +100 LET c(x+i)=b(i) +110 NEXT i +120 FOR i=1 TO x+y +130 PRINT c(i);", "; +140 NEXT i diff --git a/Task/Arrays/00DESCRIPTION b/Task/Arrays/00DESCRIPTION index 2066a46b45..f910ffc44e 100644 --- a/Task/Arrays/00DESCRIPTION +++ b/Task/Arrays/00DESCRIPTION @@ -1,14 +1,26 @@ This task is about arrays. + For hashes or associative arrays, please see [[Creating an Associative Array]]. + For a definition and in-depth discussion of what an array is, see [[Array]]. -In this task, the goal is to show basic array syntax in your -language. Basically, create an array, assign a value to it, and -retrieve an element. (if available, show both fixed-length arrays and -dynamic arrays, pushing a value into it.) -Please discuss at Village Pump: {{vp|Arrays}}. Please merge code in from obsolete tasks [[Creating an Array]], [[Assigning Values to an Array]], and [[Retrieving an Element of an Array]]. +;Task: +Show basic array syntax in your language. -'''See also''' -* [[Collections]] -* [[Two-dimensional array (runtime)]] +Basically, create an array, assign a value to it, and retrieve an element   (if available, show both fixed-length arrays and +dynamic arrays, pushing a value into it). + +Please discuss at Village Pump:   {{vp|Arrays}}. + +Please merge code in from these obsolete tasks: +:::*   [[Creating an Array]] +:::*   [[Assigning Values to an Array]] +:::*   [[Retrieving an Element of an Array]] + + +;Related tasks: +*   [[Collections]] +*   [[Creating an Associative Array]] +*   [[Two-dimensional array (runtime)]] +

diff --git a/Task/Arrays/APL/arrays-1.apl b/Task/Arrays/APL/arrays-1.apl new file mode 100644 index 0000000000..c9b6c5a8c6 --- /dev/null +++ b/Task/Arrays/APL/arrays-1.apl @@ -0,0 +1 @@ ++/ 1 2 3 diff --git a/Task/Arrays/APL/arrays-2.apl b/Task/Arrays/APL/arrays-2.apl new file mode 100644 index 0000000000..8138b365ef --- /dev/null +++ b/Task/Arrays/APL/arrays-2.apl @@ -0,0 +1 @@ +1 + 2 + 3 diff --git a/Task/Arrays/APL/arrays-3.apl b/Task/Arrays/APL/arrays-3.apl new file mode 100644 index 0000000000..fd38861632 --- /dev/null +++ b/Task/Arrays/APL/arrays-3.apl @@ -0,0 +1 @@ ++ diff --git a/Task/Arrays/APL/arrays-4.apl b/Task/Arrays/APL/arrays-4.apl new file mode 100644 index 0000000000..b85905ec0b --- /dev/null +++ b/Task/Arrays/APL/arrays-4.apl @@ -0,0 +1 @@ +1 2 3 diff --git a/Task/Arrays/Babel/arrays-1.pb b/Task/Arrays/Babel/arrays-1.pb index 7726202274..946dbd00e8 100644 --- a/Task/Arrays/Babel/arrays-1.pb +++ b/Task/Arrays/Babel/arrays-1.pb @@ -1 +1 @@ -[val 1 2 3] +[1 2 3] diff --git a/Task/Arrays/Babel/arrays-10.pb b/Task/Arrays/Babel/arrays-10.pb new file mode 100644 index 0000000000..5bb1bb35d2 --- /dev/null +++ b/Task/Arrays/Babel/arrays-10.pb @@ -0,0 +1 @@ +(1 2 3) ls2lf ; diff --git a/Task/Arrays/Babel/arrays-11.pb b/Task/Arrays/Babel/arrays-11.pb new file mode 100644 index 0000000000..3aa8a1ea6b --- /dev/null +++ b/Task/Arrays/Babel/arrays-11.pb @@ -0,0 +1 @@ +[ptr 'foo' 'bar' 'baz'] ar2ls lsstr ! diff --git a/Task/Arrays/Babel/arrays-12.pb b/Task/Arrays/Babel/arrays-12.pb new file mode 100644 index 0000000000..8c9ca1e154 --- /dev/null +++ b/Task/Arrays/Babel/arrays-12.pb @@ -0,0 +1 @@ +(1 2 3) bons ; diff --git a/Task/Arrays/Babel/arrays-3.pb b/Task/Arrays/Babel/arrays-3.pb index bef3d4dbc9..fdd45ae166 100644 --- a/Task/Arrays/Babel/arrays-3.pb +++ b/Task/Arrays/Babel/arrays-3.pb @@ -1 +1 @@ -[val 1 2 3] 1 th +[1 2 3] 1 th ; diff --git a/Task/Arrays/Babel/arrays-4.pb b/Task/Arrays/Babel/arrays-4.pb index 626f75e4f0..a90233c0aa 100644 --- a/Task/Arrays/Babel/arrays-4.pb +++ b/Task/Arrays/Babel/arrays-4.pb @@ -1 +1 @@ -[val 1 2 3] 7 1 paste +[1 2 3] dup 1 7 set ; diff --git a/Task/Arrays/Babel/arrays-5.pb b/Task/Arrays/Babel/arrays-5.pb index f47500a0bd..bf0508c996 100644 --- a/Task/Arrays/Babel/arrays-5.pb +++ b/Task/Arrays/Babel/arrays-5.pb @@ -1 +1 @@ -[ptr 1 2 3] [ptr 7] 1 paste +[ptr 1 2 3] dup 1 [ptr 7] set ; diff --git a/Task/Arrays/Babel/arrays-6.pb b/Task/Arrays/Babel/arrays-6.pb index 61d084c5e4..0effc766df 100644 --- a/Task/Arrays/Babel/arrays-6.pb +++ b/Task/Arrays/Babel/arrays-6.pb @@ -1 +1 @@ -[ptr 'foo' 'bar' 'baz' 'bop'] 1 3 slice +[ptr 1 2 3 4 5 6] 1 3 slice ; diff --git a/Task/Arrays/Babel/arrays-7.pb b/Task/Arrays/Babel/arrays-7.pb index d8519d96ee..f05765dd86 100644 --- a/Task/Arrays/Babel/arrays-7.pb +++ b/Task/Arrays/Babel/arrays-7.pb @@ -1,4 +1 @@ - [ptr 1 2 3] dup - <- arlen 1 + newin dup dup -> - 0 paste - [ptr 4] 3 paste +[1 2 3] [4] cat diff --git a/Task/Arrays/Babel/arrays-8.pb b/Task/Arrays/Babel/arrays-8.pb index f89a344f06..20a0f1a502 100644 --- a/Task/Arrays/Babel/arrays-8.pb +++ b/Task/Arrays/Babel/arrays-8.pb @@ -1,2 +1 @@ - [ptr 1 2 3] - ar2ls (4) unshift bons +[ptr 1 2 3] [ptr 4] cat diff --git a/Task/Arrays/Babel/arrays-9.pb b/Task/Arrays/Babel/arrays-9.pb new file mode 100644 index 0000000000..3e59a712c4 --- /dev/null +++ b/Task/Arrays/Babel/arrays-9.pb @@ -0,0 +1 @@ +[1 2 3] ar2ls lsnum ! diff --git a/Task/Arrays/Brainf---/arrays.bf b/Task/Arrays/Brainf---/arrays.bf new file mode 100644 index 0000000000..e950724917 --- /dev/null +++ b/Task/Arrays/Brainf---/arrays.bf @@ -0,0 +1,85 @@ +===========[ +ARRAY DATA STRUCTURE + +AUTHOR: Keith Stellyes +WRITTEN: June 2016 + +This is a zero-based indexing array data structure, it assumes the following +precondition: + +>INDEX<|NULL|VALUE|NULL|VALUE|NULL|VALUE|NULL + +(Where >< mark pointer position, and | separates addresses) + +It relies heavily on [>] and [<] both of which are idioms for +finding the next left/right null + +HOW INDEXING WORKS: +It runs a loop _index_ number of times, setting that many nulls +to a positive, so it can be skipped by the mentioned idioms. +Basically, it places that many "milestones". + +EXAMPLE: +If we seek index 2, and our array is {1 , 2 , 3 , 4 , 5} + +FINDING INDEX 2: + (loop to find next null, set to positive, as a milestone + decrement index) + +index + 2 |0|1|0|2|0|3|0|4|0|5|0 + 1 |0|1|1|2|0|3|0|4|0|5|0 + 0 |0|1|1|2|1|3|0|4|0|5|0 + +===========] + +=======UNIT TEST======= + SET ARRAY {48 49 50} +>>++++++++++++++++++++++++++++++++++++++++++++++++>> ++++++++++++++++++++++++++++++++++++++++++++++++++>> +++++++++++++++++++++++++++++++++++++++++++++++++++ +<<<<<<++ Move back to index and set it to 2 +======================= + +===RETRIEVE ELEMENT AT INDEX=== + +=ACCESS INDEX= +[>>[>]+[<]<-] loop that sets a null to a positive for each iteration + First it moves the pointer from index to first value + Then it uses a simple loop that finds the next null + it sets the null to a positive (1 in this case) + Then it uses that same loop reversed to find the first + null which will always be one right of our index + so we decrement our index + Finally we decrement pointer from the null byte to our + index and decrement it + +>> Move pointer to the first value otherwise we can't loop + +[>]< This will find the next right null which will always be right + of the desired value; then go one left + + +. Output the value (In the unit test this print "2" + +[<[-]<] Reset array + +===ASSIGN VALUE AT INDEX=== + +STILL NEED TO ADJUST UNIT TESTS + +NEWVALUE|>INDEX<|NULL|VALUE etc + +[>>[>]+[<]<-] Like above logic except it empties the value and doesn't reset +>>[>]<[-] + +[<]< Move pointer to desired value note that where the index was stored + is null because of the above loop + +[->>[>]+[<]<] If NEWVALUE is GREATER than 0 then decrement it & then find the + newly emptied cell and increment it + +[>>[>]<+[<]<<-] Move pointer to first value find right null move pointer left + then increment where we want our NEWVALUE to be stored then + return back by finding leftmost null then decrementing pointer + twice then decrement our NEWVALUE cell diff --git a/Task/Arrays/Elena/arrays-3.elena b/Task/Arrays/Elena/arrays-3.elena index 76e5f28de0..ec27ea0589 100644 --- a/Task/Arrays/Elena/arrays-3.elena +++ b/Task/Arrays/Elena/arrays-3.elena @@ -1,4 +1,4 @@ - #var(type:intarray,size:3)aStackAllocatedArray. + #var(int:3)aStackAllocatedArray. aStackAllocatedArray@0 := 1. aStackAllocatedArray@1 := 2. aStackAllocatedArray@2 := 3. diff --git a/Task/Arrays/Elixir/arrays-1.elixir b/Task/Arrays/Elixir/arrays-1.elixir new file mode 100644 index 0000000000..196a6539fa --- /dev/null +++ b/Task/Arrays/Elixir/arrays-1.elixir @@ -0,0 +1 @@ +ret = {:ok, "fun", 3.1415} diff --git a/Task/Arrays/Elixir/arrays-2.elixir b/Task/Arrays/Elixir/arrays-2.elixir new file mode 100644 index 0000000000..3400ff364b --- /dev/null +++ b/Task/Arrays/Elixir/arrays-2.elixir @@ -0,0 +1,4 @@ +elem(ret, 1) == "fun" +elem(ret, 0) == :ok +put_elem(ret, 2, "pi") # => {:ok, "fun", "pi"} +ret == {:ok, "fun", 3.1415} diff --git a/Task/Arrays/Elixir/arrays-3.elixir b/Task/Arrays/Elixir/arrays-3.elixir new file mode 100644 index 0000000000..d652946e23 --- /dev/null +++ b/Task/Arrays/Elixir/arrays-3.elixir @@ -0,0 +1 @@ +Tuple.append(ret, 3.1415) # => {:ok, "fun", "pie", 3.1415} diff --git a/Task/Arrays/Elixir/arrays-4.elixir b/Task/Arrays/Elixir/arrays-4.elixir new file mode 100644 index 0000000000..1d5252df0b --- /dev/null +++ b/Task/Arrays/Elixir/arrays-4.elixir @@ -0,0 +1 @@ +Tuple.insert_at(ret, 1, "new stuff") # => {:ok, "new stuff", "fun", "pie"} diff --git a/Task/Arrays/Elixir/arrays-5.elixir b/Task/Arrays/Elixir/arrays-5.elixir new file mode 100644 index 0000000000..89e820eb45 --- /dev/null +++ b/Task/Arrays/Elixir/arrays-5.elixir @@ -0,0 +1 @@ +[ 1, 2, 3 ] diff --git a/Task/Arrays/Elixir/arrays-6.elixir b/Task/Arrays/Elixir/arrays-6.elixir new file mode 100644 index 0000000000..64176d5ae3 --- /dev/null +++ b/Task/Arrays/Elixir/arrays-6.elixir @@ -0,0 +1,8 @@ +my_list = [1, :two, "three"] +my_list ++ [4, :five] # => [1, :two, "three", 4, :five] + +List.insert_at(my_list, 0, :cool) # => [:cool, 1, :two, "three"] +List.replace_at(my_list, 1, :cool) # => [1, :cool, "three"] +List.delete(my_list, :two) # => [1, "three"] +my_list -- ["three", 1] # => [:two] +my_list # => [1, :two, "three"] diff --git a/Task/Arrays/Elixir/arrays-7.elixir b/Task/Arrays/Elixir/arrays-7.elixir new file mode 100644 index 0000000000..5be62115f5 --- /dev/null +++ b/Task/Arrays/Elixir/arrays-7.elixir @@ -0,0 +1,10 @@ +iex(1)> fruit = [:apple, :banana, :cherry] +[:apple, :banana, :cherry] +iex(2)> hd(fruit) +:apple +iex(3)> tl(fruit) +[:banana, :cherry] +iex(4)> hd(fruit) == :apple +true +iex(5)> tl(fruit) == [:banana, :cherry] +true diff --git a/Task/Arrays/HicEst/arrays.hicest b/Task/Arrays/HicEst/arrays.hicest new file mode 100644 index 0000000000..410727cc4f --- /dev/null +++ b/Task/Arrays/HicEst/arrays.hicest @@ -0,0 +1,11 @@ +REAL :: n = 3, Astat(n), Bdyn(1, 1) + +Astat(2) = 2.22222222 +WRITE(Messagebox, Name) Astat(2) + +ALLOCATE(Bdyn, 2*n, 3*n) +Bdyn(n-1, n) = -123 +WRITE(Row=27) Bdyn(n-1, n) + +ALIAS(Astat, n-1, last2ofAstat, 2) +WRITE(ClipBoard) last2ofAstat ! 2.22222222 0 diff --git a/Task/Arrays/Kotlin/arrays.kotlin b/Task/Arrays/Kotlin/arrays.kotlin new file mode 100644 index 0000000000..98234512da --- /dev/null +++ b/Task/Arrays/Kotlin/arrays.kotlin @@ -0,0 +1,7 @@ +fun main(x: Array) { + var a = arrayOf(1, 2, 3, 4) + println(a.asList()) + a += 5 + println(a.asList()) + println(a.reversedArray().asList()) +} diff --git a/Task/Arrays/MIPS-Assembly/arrays.mips b/Task/Arrays/MIPS-Assembly/arrays.mips new file mode 100644 index 0000000000..e888e63329 --- /dev/null +++ b/Task/Arrays/MIPS-Assembly/arrays.mips @@ -0,0 +1,13 @@ + .data +array: .word 1, 2, 3, 4, 5, 6, 7, 8, 9 # creates an array of 9 32 Bit words. + + .text +main: la $s0, array + li $s1, 25 + sw $s1, 4($s0) # writes $s1 (25) in the second array element +# the four counts thi bytes after the beginning of the address. 1 word = 4 bytes, so 4 acesses the second element + + lw $s2, 20($s0) # $s2 now contains 6 + + li $v0, 10 # end program + syscall diff --git a/Task/Arrays/Maple/arrays.maple b/Task/Arrays/Maple/arrays.maple new file mode 100644 index 0000000000..8f04c2df8d --- /dev/null +++ b/Task/Arrays/Maple/arrays.maple @@ -0,0 +1,17 @@ +#defining an array of a certain length +a := Array (1..5); + a := [ 0 0 0 0 0 ] +#can also define with a list of entries +a := Array ([1, 2, 3, 4, 5]); + a := [ 1 2 3 4 5 ] +a[1] := 9; +a + a[1] := 9 + [ 9 2 3 4 5 ] +a[5]; + 5 +#can only grow arrays using () +a(6) := 6; + a := [ 9 2 3 4 5 6 ] +a[7] := 7; +Error, Array index out of range diff --git a/Task/Arrays/Perl/arrays-1.pl b/Task/Arrays/Perl/arrays-1.pl new file mode 100644 index 0000000000..22105832d2 --- /dev/null +++ b/Task/Arrays/Perl/arrays-1.pl @@ -0,0 +1,8 @@ + my @empty; + my @empty_too = (); + + my @populated = ('This', 'That', 'And', 'The', 'Other'); + print $populated[2]; # And + + my $aref = ['This', 'That', 'And', 'The', 'Other']; + print $aref->[2]; # And diff --git a/Task/Arrays/Perl/arrays.pl b/Task/Arrays/Perl/arrays-2.pl similarity index 100% rename from Task/Arrays/Perl/arrays.pl rename to Task/Arrays/Perl/arrays-2.pl diff --git a/Task/Arrays/Perl/arrays-3.pl b/Task/Arrays/Perl/arrays-3.pl new file mode 100644 index 0000000000..de6de1426e --- /dev/null +++ b/Task/Arrays/Perl/arrays-3.pl @@ -0,0 +1,5 @@ + my @multi_dimensional = ( + [0, 1, 2, 3], + [qw(a b c d e f g)], + [qw(! $ % & *)], + ); diff --git a/Task/Arrays/SNOBOL4/arrays.sno b/Task/Arrays/SNOBOL4/arrays.sno new file mode 100644 index 0000000000..64f34c69cc --- /dev/null +++ b/Task/Arrays/SNOBOL4/arrays.sno @@ -0,0 +1,10 @@ + ar = ARRAY("3,2") ;* 3 rows, 2 columns +fill i = LT(i, 3) i + 1 :F(display) + ar = i + ar = i "-count" :(fill) + +display ;* fail on end of array + j = j + 1 + OUTPUT = "Row " ar ": " ar ++ :S(display) +END diff --git a/Task/Arrays/ZX-Spectrum-Basic/arrays.zx b/Task/Arrays/ZX-Spectrum-Basic/arrays.zx new file mode 100644 index 0000000000..36bf566428 --- /dev/null +++ b/Task/Arrays/ZX-Spectrum-Basic/arrays.zx @@ -0,0 +1,3 @@ +10 DIM a(5) +20 LET a(2)=128 +30 PRINT a(2) diff --git a/Task/Assertions/00DESCRIPTION b/Task/Assertions/00DESCRIPTION index b9fd6eb6b1..16d700d6e9 100644 --- a/Task/Assertions/00DESCRIPTION +++ b/Task/Assertions/00DESCRIPTION @@ -1,3 +1,8 @@ -Assertions are a way of breaking out of code when there is an error or an unexpected input. Some languages throw [[exceptions]] and some treat it as a break point. +Assertions are a way of breaking out of code when there is an error or an unexpected input. -Show an assertion in your language by asserting that an integer variable is equal to 42. +Some languages throw [[exceptions]] and some treat it as a break point. + + +;Task: +Show an assertion in your language by asserting that an integer variable is equal to '''42'''. +

diff --git a/Task/Assertions/Elixir/assertions.elixir b/Task/Assertions/Elixir/assertions.elixir new file mode 100644 index 0000000000..1ef8afe0ea --- /dev/null +++ b/Task/Assertions/Elixir/assertions.elixir @@ -0,0 +1,11 @@ +ExUnit.start + +defmodule AssertionTest do + use ExUnit.Case + + def return_5, do: 5 + + test "not equal" do + assert 42 == return_5 + end +end diff --git a/Task/Assertions/Perl-6/assertions-1.pl6 b/Task/Assertions/Perl-6/assertions-1.pl6 new file mode 100644 index 0000000000..8147aa27e0 --- /dev/null +++ b/Task/Assertions/Perl-6/assertions-1.pl6 @@ -0,0 +1,2 @@ +my $a = (1..100).pick; +$a == 42 or die '$a ain\'t 42'; diff --git a/Task/Assertions/Perl-6/assertions.pl6 b/Task/Assertions/Perl-6/assertions-2.pl6 similarity index 56% rename from Task/Assertions/Perl-6/assertions.pl6 rename to Task/Assertions/Perl-6/assertions-2.pl6 index cf505f0515..e04d73bd94 100644 --- a/Task/Assertions/Perl-6/assertions.pl6 +++ b/Task/Assertions/Perl-6/assertions-2.pl6 @@ -1,8 +1,3 @@ -my $a = (1..100).pick; - # with a (non-hygienic) macro macro assert ($x) { "$x or die 'assertion failed: $x'" } assert('$a == 42'); - -# but usually we just say -$a == 42 or die '$a ain\'t 42'; diff --git a/Task/Associative-array-Creation/00DESCRIPTION b/Task/Associative-array-Creation/00DESCRIPTION index 042d1ea84b..26340c9c7e 100644 --- a/Task/Associative-array-Creation/00DESCRIPTION +++ b/Task/Associative-array-Creation/00DESCRIPTION @@ -1,7 +1,11 @@ -In this task, the goal is to create an [[associative array]] (also known as a dictionary, map, or hash). +;Task: +The goal is to create an [[associative array]] (also known as a dictionary, map, or hash). + Related tasks: * [[Associative arrays/Iteration]] * [[Hash from two arrays]] + {{Template:See also lists}} +

diff --git a/Task/Associative-array-Creation/Babel/associative-array-creation.pb b/Task/Associative-array-Creation/Babel/associative-array-creation.pb index 2801c59285..42d95c64a6 100644 --- a/Task/Associative-array-Creation/Babel/associative-array-creation.pb +++ b/Task/Associative-array-Creation/Babel/associative-array-creation.pb @@ -1,4 +1,3 @@ - [map - ("foo" 13) - ("bar" 42) - ("baz" 77)] + (("foo" 13) + ("bar" 42) + ("baz" 77)) ls2map ! diff --git a/Task/Associative-array-Creation/Elixir/associative-array-creation.elixir b/Task/Associative-array-Creation/Elixir/associative-array-creation.elixir index db3a54960e..694aadf009 100644 --- a/Task/Associative-array-Creation/Elixir/associative-array-creation.elixir +++ b/Task/Associative-array-Creation/Elixir/associative-array-creation.elixir @@ -1,19 +1,17 @@ defmodule RC do - def dict_create(dict_impl \\ Map) do - d = dict_impl.new #=> creates an empty Dict - d1 = Dict.put(d,:foo,1) - d2 = Dict.put(d1,:bar,2) - print_vals(d2) - print_vals(Dict.put(d2,:foo,3)) + def test_create do + IO.puts "< create Map.new >" + m = Map.new #=> creates an empty Map + m1 = Map.put(m,:foo,1) + m2 = Map.put(m1,:bar,2) + print_vals(m2) + print_vals(%{m2 | foo: 3}) end - defp print_vals(d) do - IO.inspect d - Enum.each(d, fn {k,v} -> IO.puts "#{k}: #{v}" end) + defp print_vals(m) do + IO.inspect m + Enum.each(m, fn {k,v} -> IO.puts "#{inspect k} => #{v}" end) end end -IO.puts "< create Map.new >" -RC.dict_create -IO.puts "\n< create HashDict.new >" -RC.dict_create(HashDict) +RC.test_create diff --git a/Task/Associative-array-Creation/Java/associative-array-creation-3.java b/Task/Associative-array-Creation/Java/associative-array-creation-3.java index 185a2119db..54eddb96e0 100644 --- a/Task/Associative-array-Creation/Java/associative-array-creation-3.java +++ b/Task/Associative-array-Creation/Java/associative-array-creation-3.java @@ -1,2 +1,2 @@ -map.get("foo"); // => 5 +map.get("foo"); // => 6 map.get("invalid"); // => null diff --git a/Task/Associative-array-Creation/Kotlin/associative-array-creation.kotlin b/Task/Associative-array-Creation/Kotlin/associative-array-creation.kotlin new file mode 100644 index 0000000000..ecf53f45cb --- /dev/null +++ b/Task/Associative-array-Creation/Kotlin/associative-array-creation.kotlin @@ -0,0 +1,26 @@ +fun main(args: Array) { + // map definition: + val map = mapOf("foo" to 5, + "bar" to 10, + "baz" to 15, + "foo" to 6) + + // retrieval: + println(map["foo"]) // => 6 + println(map["invalid"]) // => null + + // check keys: + println("foo" in map) // => true + println("invalid" in map) // => false + + // iterate over keys: + for (k in map.keys) print("$k ") + println() + + // iterate over values: + for (v in map.values) print("$v ") + println() + + // iterate over key, value pairs: + for ((k, v) in map) println("$k => $v") +} diff --git a/Task/Associative-array-Creation/Rust/associative-array-creation.rust b/Task/Associative-array-Creation/Rust/associative-array-creation.rust new file mode 100644 index 0000000000..4a1b5f356c --- /dev/null +++ b/Task/Associative-array-Creation/Rust/associative-array-creation.rust @@ -0,0 +1,9 @@ +use std::collections::HashMap; +fn main() { + let mut olympic_medals = HashMap::new(); + olympic_medals.insert("United States", (1072, 859, 749)); + olympic_medals.insert("Soviet Union", (473, 376, 355)); + olympic_medals.insert("Great Britain", (246, 276, 284)); + olympic_medals.insert("Germany", (252, 260, 270)); + println!("{:?}", olympic_medals); +} diff --git a/Task/Associative-array-Creation/SETL/associative-array-creation-1.setl b/Task/Associative-array-Creation/SETL/associative-array-creation-1.setl new file mode 100644 index 0000000000..810e98e51e --- /dev/null +++ b/Task/Associative-array-Creation/SETL/associative-array-creation-1.setl @@ -0,0 +1 @@ +m := {['foo', 'a'], ['bar', 'b'], ['baz', 'c']}; diff --git a/Task/Associative-array-Creation/SETL/associative-array-creation-2.setl b/Task/Associative-array-Creation/SETL/associative-array-creation-2.setl new file mode 100644 index 0000000000..f499f1584c --- /dev/null +++ b/Task/Associative-array-Creation/SETL/associative-array-creation-2.setl @@ -0,0 +1 @@ +print( m('bar') ); diff --git a/Task/Associative-array-Creation/SETL/associative-array-creation-3.setl b/Task/Associative-array-Creation/SETL/associative-array-creation-3.setl new file mode 100644 index 0000000000..766b0c337d --- /dev/null +++ b/Task/Associative-array-Creation/SETL/associative-array-creation-3.setl @@ -0,0 +1 @@ +print( m{'bar'} ); diff --git a/Task/Associative-array-Creation/VBA/associative-array-creation.vba b/Task/Associative-array-Creation/VBA/associative-array-creation.vba new file mode 100644 index 0000000000..d2d83c5707 --- /dev/null +++ b/Task/Associative-array-Creation/VBA/associative-array-creation.vba @@ -0,0 +1,16 @@ +Option Explicit +Sub Test() + Dim h As Object + Set h = CreateObject("Scripting.Dictionary") + h.Add "A", 1 + h.Add "B", 2 + h.Add "C", 3 + Debug.Print h.Item("A") + h.Item("C") = 4 + h.Key("C") = "D" + Debug.Print h.exists("C") + h.Remove "B" + Debug.Print h.Count + h.RemoveAll + Debug.Print h.Count +End Sub diff --git a/Task/Associative-array-Iteration/00DESCRIPTION b/Task/Associative-array-Iteration/00DESCRIPTION index ed3f7656d0..c4f15caa5d 100644 --- a/Task/Associative-array-Iteration/00DESCRIPTION +++ b/Task/Associative-array-Iteration/00DESCRIPTION @@ -1,6 +1,7 @@ -Show how to iterate over the key-value pairs of an associative array, -and print each pair out. -Also show how to iterate just over the keys, or the values, -if there is a separate way to do that in your language. +Show how to iterate over the key-value pairs of an associative array, and print each pair out. + +Also show how to iterate just over the keys, or the values, if there is a separate way to do that in your language. + {{Template:See also lists}} +

diff --git a/Task/Associative-array-Iteration/ALGOL-68/associative-array-iteration.alg b/Task/Associative-array-Iteration/ALGOL-68/associative-array-iteration.alg new file mode 100644 index 0000000000..c36a7ecde4 --- /dev/null +++ b/Task/Associative-array-Iteration/ALGOL-68/associative-array-iteration.alg @@ -0,0 +1,155 @@ +# associative array handling using hashing # + +# the modes allowed as associative array element values - change to suit # +MODE AAVALUE = STRING; +# the modes allowed as associative array element keys - change to suit # +MODE AAKEY = STRING; +# nil element value # +REF AAVALUE nil value = NIL; + +# an element of an associative array # +MODE AAELEMENT = STRUCT( AAKEY key, REF AAVALUE value ); +# a list of associative array elements - the element values with a # +# particular hash value are stored in an AAELEMENTLIST # +MODE AAELEMENTLIST = STRUCT( AAELEMENT element, REF AAELEMENTLIST next ); +# nil element list reference # +REF AAELEMENTLIST nil element list = NIL; +# nil element reference # +REF AAELEMENT nil element = NIL; + +# the hash modulus for the associative arrays # +INT hash modulus = 256; + +# generates a hash value from an AAKEY - change to suit # +OP HASH = ( STRING key )INT: +BEGIN + INT result := ABS ( UPB key - LWB key ) MOD hash modulus; + FOR char pos FROM LWB key TO UPB key DO + result PLUSAB ( ABS key[ char pos ] - ABS " " ); + result MODAB hash modulus + OD; + result +END; # HASH # + +# a mode representing an associative array # +MODE AARRAY = STRUCT( [ 0 : hash modulus - 1 ]REF AAELEMENTLIST elements + , INT curr hash + , REF AAELEMENTLIST curr position + ); + +# initialises an associative array so all the hash chains are empty # +OP INIT = ( REF AARRAY array )REF AARRAY: + BEGIN + FOR hash value FROM 0 TO hash modulus - 1 DO ( elements OF array )[ hash value ] := nil element list OD; + array + END; # INIT # + +# gets a reference to the value corresponding to a particular key in an # +# associative array - the element is created if it doesn't exist # +PRIO // = 1; +OP // = ( REF AARRAY array, AAKEY key )REF AAVALUE: +BEGIN + REF AAVALUE result; + INT hash value = HASH key; + # get the hash chain for the key # + REF AAELEMENTLIST element := ( elements OF array )[ hash value ]; + # find the element in the list, if it is there # + BOOL found element := FALSE; + WHILE ( element ISNT nil element list ) + AND NOT found element + DO + found element := ( key OF element OF element = key ); + IF found element + THEN + result := value OF element OF element + ELSE + element := next OF element + FI + OD; + IF NOT found element + THEN + # the element is not in the list # + # - add it to the front of the hash chain # + ( elements OF array )[ hash value ] + := HEAP AAELEMENTLIST + := ( HEAP AAELEMENT := ( key + , HEAP AAVALUE := "" + ) + , ( elements OF array )[ hash value ] + ); + result := value OF element OF ( elements OF array )[ hash value ] + FI; + result +END; # // # + +# returns TRUE if array contains key, FALSE otherwise # +PRIO CONTAINSKEY = 1; +OP CONTAINSKEY = ( REF AARRAY array, AAKEY key )BOOL: +BEGIN + # get the hash chain for the key # + REF AAELEMENTLIST element := ( elements OF array )[ HASH key ]; + # find the element in the list, if it is there # + BOOL found element := FALSE; + WHILE ( element ISNT nil element list ) + AND NOT found element + DO + found element := ( key OF element OF element = key ); + IF NOT found element + THEN + element := next OF element + FI + OD; + found element +END; # CONTAINSKEY # + +# gets the first element (key, value) from the array # +OP FIRST = ( REF AARRAY array )REF AAELEMENT: +BEGIN + curr hash OF array := LWB ( elements OF array ) - 1; + curr position OF array := nil element list; + NEXT array +END; # FIRST # + +# gets the next element (key, value) from the array # +OP NEXT = ( REF AARRAY array )REF AAELEMENT: +BEGIN + WHILE ( curr position OF array IS nil element list ) + AND curr hash OF array < UPB ( elements OF array ) + DO + # reached the end of the current element list - try the next # + curr hash OF array +:= 1; + curr position OF array := ( elements OF array )[ curr hash OF array ] + OD; + IF curr hash OF array > UPB ( elements OF array ) + THEN + # no more elements # + nil element + ELIF curr position OF array IS nil element list + THEN + # reached the end of the table # + nil element + ELSE + # have another element # + REF AAELEMENTLIST found element = curr position OF array; + curr position OF array := next OF curr position OF array; + element OF found element + FI +END; # NEXT # + +# test the associative array # +BEGIN + # create an array and add some values # + REF AARRAY a1 := INIT LOC AARRAY; + a1 // "k1" := "k1 value"; + a1 // "z2" := "z2 value"; + a1 // "k1" := "new k1 value"; + a1 // "k2" := "k2 value"; + a1 // "2j" := "2j value"; + # iterate over the values # + REF AAELEMENT e := FIRST a1; + WHILE e ISNT nil element + DO + print( ( " (" + key OF e + ")[" + value OF e + "]", newline ) ); + e := NEXT a1 + OD +END diff --git a/Task/Associative-array-Iteration/Babel/associative-array-iteration-1.pb b/Task/Associative-array-Iteration/Babel/associative-array-iteration-1.pb new file mode 100644 index 0000000000..bd3128b6ce --- /dev/null +++ b/Task/Associative-array-Iteration/Babel/associative-array-iteration-1.pb @@ -0,0 +1 @@ +births (('Washington' 1732) ('Lincoln' 1809) ('Roosevelt' 1882) ('Kennedy' 1917)) ls2map ! < diff --git a/Task/Associative-array-Iteration/Babel/associative-array-iteration-2.pb b/Task/Associative-array-Iteration/Babel/associative-array-iteration-2.pb new file mode 100644 index 0000000000..31b6c99366 --- /dev/null +++ b/Task/Associative-array-Iteration/Babel/associative-array-iteration-2.pb @@ -0,0 +1 @@ +births cp dup {1 +} overmap ! diff --git a/Task/Associative-array-Iteration/Babel/associative-array-iteration-3.pb b/Task/Associative-array-Iteration/Babel/associative-array-iteration-3.pb new file mode 100644 index 0000000000..bc0ecbb623 --- /dev/null +++ b/Task/Associative-array-Iteration/Babel/associative-array-iteration-3.pb @@ -0,0 +1 @@ +valmap ! lsnum ! diff --git a/Task/Associative-array-Iteration/Babel/associative-array-iteration-4.pb b/Task/Associative-array-Iteration/Babel/associative-array-iteration-4.pb new file mode 100644 index 0000000000..b7756f9cd9 --- /dev/null +++ b/Task/Associative-array-Iteration/Babel/associative-array-iteration-4.pb @@ -0,0 +1 @@ +births ('Roosevelt' 'Kennedy') lumapls ! lsnum ! diff --git a/Task/Associative-array-Iteration/Babel/associative-array-iteration-5.pb b/Task/Associative-array-Iteration/Babel/associative-array-iteration-5.pb new file mode 100644 index 0000000000..16ed75d715 --- /dev/null +++ b/Task/Associative-array-Iteration/Babel/associative-array-iteration-5.pb @@ -0,0 +1 @@ +births map2ls ! diff --git a/Task/Associative-array-Iteration/Babel/associative-array-iteration-6.pb b/Task/Associative-array-Iteration/Babel/associative-array-iteration-6.pb new file mode 100644 index 0000000000..854d9caef3 --- /dev/null +++ b/Task/Associative-array-Iteration/Babel/associative-array-iteration-6.pb @@ -0,0 +1 @@ +{give swap << " " << itod << "\n" <<} each diff --git a/Task/Associative-array-Iteration/Babel/associative-array-iteration-7.pb b/Task/Associative-array-Iteration/Babel/associative-array-iteration-7.pb new file mode 100644 index 0000000000..806eeb15f8 --- /dev/null +++ b/Task/Associative-array-Iteration/Babel/associative-array-iteration-7.pb @@ -0,0 +1,2 @@ +foo (("bar" 17) ("baz" 42)) ls2map ! < +births foo mergemap ! diff --git a/Task/Associative-array-Iteration/Babel/associative-array-iteration-8.pb b/Task/Associative-array-Iteration/Babel/associative-array-iteration-8.pb new file mode 100644 index 0000000000..d0ede89ea9 --- /dev/null +++ b/Task/Associative-array-Iteration/Babel/associative-array-iteration-8.pb @@ -0,0 +1 @@ +births map2ls ! {give swap << " " << itod << "\n" <<} each diff --git a/Task/Associative-array-Iteration/Babel/associative-array-iteration.pb b/Task/Associative-array-Iteration/Babel/associative-array-iteration.pb deleted file mode 100644 index c7a28ec225..0000000000 --- a/Task/Associative-array-Iteration/Babel/associative-array-iteration.pb +++ /dev/null @@ -1,21 +0,0 @@ -((main - { (('foo' 12) - ('bar' 33) - ('baz' 42)) - mkhash ! - - entsha - dup - {1 ith nl <<} each - - "-----\n" << - - {2 ith %d nl <<} each}) - -(mkhash - { <- newha -> - { <- dup -> - dup 1 ith - <- 0 ith -> - inskha } - each })) diff --git a/Task/Associative-array-Iteration/Elixir/associative-array-iteration.elixir b/Task/Associative-array-Iteration/Elixir/associative-array-iteration.elixir index c1f172c244..2f3d42662e 100644 --- a/Task/Associative-array-Iteration/Elixir/associative-array-iteration.elixir +++ b/Task/Associative-array-Iteration/Elixir/associative-array-iteration.elixir @@ -1,18 +1,5 @@ -defmodule RC do - def test_iterate(dict_impl \\ Map) do - d = dict_impl.new |> Dict.put(:foo,1) |> Dict.put(:bar,2) - print_vals(d) - end - - defp print_vals(d) do - IO.inspect d - Enum.each(d, fn {k,v} -> IO.puts "#{k}: #{v}" end) - Enum.each(Dict.keys(d), fn key -> IO.inspect key end) - Enum.each(Dict.values(d), fn value -> IO.inspect value end) - end -end - -IO.puts "< iterate Map >" -RC.test_iterate -IO.puts "\n< iterate HashDict >" -RC.test_iterate(HashDict) +IO.inspect d = Map.new([foo: 1, bar: 2, baz: 3]) +Enum.each(d, fn kv -> IO.inspect kv end) +Enum.each(d, fn {k,v} -> IO.puts "#{inspect k} => #{v}" end) +Enum.each(Map.keys(d), fn key -> IO.inspect key end) +Enum.each(Map.values(d), fn value -> IO.inspect value end) diff --git a/Task/Associative-array-Iteration/Io/associative-array-iteration.io b/Task/Associative-array-Iteration/Io/associative-array-iteration.io new file mode 100644 index 0000000000..27291ec874 --- /dev/null +++ b/Task/Associative-array-Iteration/Io/associative-array-iteration.io @@ -0,0 +1,24 @@ +myDict := Map with( + "hello", 13, + "world", 31, + "!" , 71 +) + +// iterating over key-value pairs: +myDict foreach( key, value, + writeln("key = ", key, ", value = ", value) +) + +// iterating over keys: +myDict keys foreach( key, + writeln("key = ", key) +) + +// iterating over values: +myDict foreach( value, + writeln("value = ", value) +) +// or alternatively: +myDict values foreach( value, + writeln("value = ", value) +) diff --git a/Task/Associative-array-Iteration/Kotlin/associative-array-iteration.kotlin b/Task/Associative-array-Iteration/Kotlin/associative-array-iteration.kotlin new file mode 100644 index 0000000000..f66cdf1f8c --- /dev/null +++ b/Task/Associative-array-Iteration/Kotlin/associative-array-iteration.kotlin @@ -0,0 +1,9 @@ +fun main(a: Array) { + val map = mapOf("hello" to 1, "world" to 2, "!" to 3) + + with(map) { + forEach { println("key = ${it.key}, value = ${it.value}") } + keys.forEach { println("key = $it") } + values.forEach { println("value = $it") } + } +} diff --git a/Task/Associative-array-Iteration/REXX/associative-array-iteration.rexx b/Task/Associative-array-Iteration/REXX/associative-array-iteration.rexx index f1f2dcf6f9..47575099ee 100644 --- a/Task/Associative-array-Iteration/REXX/associative-array-iteration.rexx +++ b/Task/Associative-array-Iteration/REXX/associative-array-iteration.rexx @@ -1,57 +1,55 @@ -/*REXX program shows how to set/display values for an associative array.*/ -/*┌────────────────────────────────────────────────────────────────────┐ - │ The (below) two REXX statements aren't really necessary, but it │ - │ shows how to define any and all entries in a associative array so │ - │ that if a "key" is used that isn't defined, it can be displayed to │ - │ indicate such, or its value can be checked to determine if a │ - │ particular associative array element has been set (defined). │ - └────────────────────────────────────────────────────────────────────┘*/ -stateF.=' [not defined yet] ' /*sets any/all state former caps.*/ -stateN.=' [not defined yet] ' /*sets any/all state names. */ -/*┌────────────────────────────────────────────────────────────────────┐ - │ In REXX, when a "key" is used, it's normally stored (internally) │ - │ as uppercase characters (as in the examples below). Actually, any │ - │ characters can be used, including blank(s) and non-displayable │ - │ characters (including '00'x, 'ff'x, commas, periods, quotes, ···).│ - └────────────────────────────────────────────────────────────────────┘*/ -stateL='' /*list of states (empty now). It's nice to be in alpha-*/ - /*betic order; they'll be listed in this order. With a */ - /*little more code, they could be sorted quite easily. */ +/*REXX program demonstrates how to set and display values for an associative array. */ +/*╔════════════════════════════════════════════════════════════════════════════════════╗ + ║ The (below) two REXX statements aren't really necessary, but it shows how to ║ + ║ define any and all entries in a associative array so that if a "key" is used that ║ + ║ isn't defined, it can be displayed to indicate such, or its value can be checked ║ + ║ to determine if a particular associative array element has been set (defined). ║ + ╚════════════════════════════════════════════════════════════════════════════════════╝*/ +stateF.= ' [not defined yet] ' /*sets any/all state former capitols.*/ +stateN.= ' [not defined yet] ' /*sets any/all state names. */ +w = 0 /*the maximum length of a state name.*/ +stateL= +/*╔════════════════════════════════════════════════════════════════════════════════════╗ + ║ The list of states (empty now). It's convenient to have them in alphabetic order; ║ + ║ they'll be listed in this order. In REXX, when a key is used, it's normally ║ + ║ stored (internally) as as uppercase characters (as in the examples below). ║ + ║ Actually, any characters can be used, including blank(s) and non─displayable ║ + ║ characters (including '00'x, 'ff'x, commas, periods, quotes, ···). ║ + ╚════════════════════════════════════════════════════════════════════════════════════╝*/ +call setSC 'al', "Alabama" , 'Tuscaloosa' +call setSC 'ca', "California" , 'Benicia' +call setSC 'co', "Colorado" , 'Denver City' +call setSC 'ct', "Connecticut" , 'Hartford and New Haven (jointly)' +call setSC 'de', "Delaware" , 'New-Castle' +call setSC 'ga', "Georgia" , 'Milledgeville' +call setSC 'il', "Illinois" , 'Vandalia' +call setSC 'in', "Indiana" , 'Corydon' +call setSC 'ia', "Iowa" , 'Iowa City' +call setSC 'la', "Louisiana" , 'New Orleans' +call setSC 'me', "Maine" , 'Portland' +call setSC 'mi', "Michigan" , 'Detroit' +call setSC 'ms', "Mississippi" , 'Natchez' +call setSC 'mo', "Missouri" , 'Saint Charles' +call setSC 'mt', "Montana" , 'Virginia City' +call setSC 'ne', "Nebraska" , 'Lancaster' +call setSC 'nh', "New Hampshire" , 'Exeter' +call setSC 'ny', "New York" , 'New York' +call setSC 'nc', "North Carolina" , 'Fayetteville' +call setSC 'oh', "Ohio" , 'Chillicothe' +call setSC 'ok', "Oklahoma" , 'Guthrie' +call setSC 'pa', "Pennsylvania" , 'Lancaster' +call setSC 'sc', "South Carolina" , 'Charlestown' +call setSC 'tn', "Tennessee" , 'Murfreesboro' +call setSC 'vt', "Vermont" , 'Windsor' -call setSC 'al', "Alabama" ,'Tuscaloosa' -call setSC 'ca', "California" ,'Benicia' -call setSC 'co', "Colorado" ,'Denver City' -call setSC 'ct', "Connecticut" ,'Hartford and New Haven (joint)' -call setSC 'de', "Delaware" ,'New-Castle' -call setSC 'ga', "Georgia" ,'Milledgeville' -call setSC 'il', "Illinois" ,'Vandalia' -call setSC 'in', "Indiana" ,'Corydon' -call setSC 'ia', "Iowa" ,'Iowa City' -call setSC 'la', "Louisiana" ,'New Orleans' -call setSC 'me', "Maine" ,'Portland' -call setSC 'mi', "Michigan" ,'Detroit' -call setSC 'ms', "Mississippi" ,'Natchez' -call setSC 'mo', "Missoura" ,'Saint Charles' -call setSC 'mt', "Montana" ,'Virginia City' -call setSC 'ne', "Nebraska" ,'Lancaster' -call setSC 'nh', "New Hampshire" ,'Exeter' -call setSC 'ny', "New York" ,'New York' -call setSC 'nc', "North Carolina" ,'Fayetteville' -call setSC 'oh', "Ohio" ,'Chillicothe' -call setSC 'ok', "Oklahoma" ,'Guthrie' -call setSC 'pa', "Pennsylvania" ,'Lancaster' -call setSC 'sc', "South Carolina" ,'Charlestown' -call setSC 'tn', "Tennessee" ,'Murfreesboro' -call setSC 'vt', "Vermont" ,'Windsor' - - do j=1 for words(stateL) /*show all capitals that were set*/ - q=word(stateL,j) /*get the next state in the list.*/ - say 'the former capital of ('q") " stateN.q " was " stateC.q - end /*j*/ /* [↑] display states defined. */ -exit /*stick a fork in it, we're done.*/ -/*─────────────────────────────────────setSC subroutine─────────────────*/ -setSC: arg code; parse arg ,name,cap /*get upper code, get name & cap.*/ -stateL=stateL code /*keep a list of all state codes.*/ -stateN.code=name /*set the state's name. */ -stateC.code=cap /*set the state's capital. */ -return /*return to invoker, SET is done.*/ + do j=1 for words(stateL) /*show all capitols that were defined. */ + q=word(stateL, j) /*get the next (USA) state in the list.*/ + say 'the former capitol of ('q") " left(stateN.q, w) " was " stateC.q + end /*j*/ /* [↑] show states that were defined.*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +setSC: parse arg code,name,cap; upper code /*get code, name & cap.; uppercase code*/ + stateL=stateL code /*keep a list of all the US state codes*/ + stateN.code=name; w=max(w,length(name)) /*define the state's name; max width. */ + stateC.code=cap /* " " " code to the capitol*/ + return /*return to invoker, SETSC is finished.*/ diff --git a/Task/Associative-array-Iteration/Ruby/associative-array-iteration-1.rb b/Task/Associative-array-Iteration/Ruby/associative-array-iteration-1.rb index b834f88bc2..c697d52e9c 100644 --- a/Task/Associative-array-Iteration/Ruby/associative-array-iteration-1.rb +++ b/Task/Associative-array-Iteration/Ruby/associative-array-iteration-1.rb @@ -1,14 +1,14 @@ -myDict = { "hello" => 13, +my_dict = { "hello" => 13, "world" => 31, "!" => 71 } # iterating over key-value pairs: -myDict.each {|key, value| puts "key = #{key}, value = #{value}"} +my_dict.each {|key, value| puts "key = #{key}, value = #{value}"} # or -myDict.each_pair {|key, value| puts "key = #{key}, value = #{value}"} +my_dict.each_pair {|key, value| puts "key = #{key}, value = #{value}"} # iterating over keys: -myDict.each_key {|key| puts "key = #{key}"} +my_dict.each_key {|key| puts "key = #{key}"} # iterating over values: -myDict.each_value {|value| puts "value =#{value}"} +my_dict.each_value {|value| puts "value =#{value}"} diff --git a/Task/Associative-array-Iteration/Ruby/associative-array-iteration-2.rb b/Task/Associative-array-Iteration/Ruby/associative-array-iteration-2.rb index 4d58d8e90c..7063ae785c 100644 --- a/Task/Associative-array-Iteration/Ruby/associative-array-iteration-2.rb +++ b/Task/Associative-array-Iteration/Ruby/associative-array-iteration-2.rb @@ -1,11 +1,11 @@ -for key, value in myDict +for key, value in my_dict puts "key = #{key}, value = #{value}" end -for key in myDict.keys +for key in my_dict.keys puts "key = #{key}" end -for value in myDict.values +for value in my_dict.values puts "value = #{value}" end diff --git a/Task/Associative-array-Iteration/Rust/associative-array-iteration.rust b/Task/Associative-array-Iteration/Rust/associative-array-iteration.rust index 7b2973e8df..b9dea47e4f 100644 --- a/Task/Associative-array-Iteration/Rust/associative-array-iteration.rust +++ b/Task/Associative-array-Iteration/Rust/associative-array-iteration.rust @@ -1,17 +1,13 @@ use std::collections::HashMap; - fn main() { - let mut squares = HashMap::new(); - squares.insert("one", 1); - squares.insert("two", 4); - squares.insert("three", 9); - for key in squares.keys() { - println!("Key {}", key); - } - for value in squares.values() { - println!("Value {}", value); - } - for (key, value) in squares.iter() { - println!("{} => {}", key, value); + let mut olympic_medals = HashMap::new(); + olympic_medals.insert("United States", (1072, 859, 749)); + olympic_medals.insert("Soviet Union", (473, 376, 355)); + olympic_medals.insert("Great Britain", (246, 276, 284)); + olympic_medals.insert("Germany", (252, 260, 270)); + for (country, medals) in olympic_medals { + println!("{} has had {} gold medals, {} silver medals, and {} bronze medals", + country, medals.0, medals.1, medals.2); + } } diff --git a/Task/Associative-array-Iteration/VBA/associative-array-iteration.vba b/Task/Associative-array-Iteration/VBA/associative-array-iteration.vba new file mode 100644 index 0000000000..a677d31b8f --- /dev/null +++ b/Task/Associative-array-Iteration/VBA/associative-array-iteration.vba @@ -0,0 +1,25 @@ +Option Explicit +Sub Test() + Dim h As Object, i As Long, u, v, s + Set h = CreateObject("Scripting.Dictionary") + h.Add "A", 1 + h.Add "B", 2 + h.Add "C", 3 + + 'Iterate on keys + For Each s In h.Keys + Debug.Print s + Next + + 'Iterate on values + For Each s In h.Items + Debug.Print s + Next + + 'Iterate on both keys and values by creating two arrays + u = h.Keys + v = h.Items + For i = 0 To h.Count - 1 + Debug.Print u(i), v(i) + Next +End Sub diff --git a/Task/Atomic-updates/00DESCRIPTION b/Task/Atomic-updates/00DESCRIPTION index 4bbea2d6f8..f1229d14d5 100644 --- a/Task/Atomic-updates/00DESCRIPTION +++ b/Task/Atomic-updates/00DESCRIPTION @@ -1,6 +1,7 @@ -Define a data type consisting of a fixed number of 'buckets', each containing a nonnegative integer value, which supports operations to +;Task: +Define a data type consisting of a fixed number of 'buckets', each containing a nonnegative integer value, which supports operations to: # get the current value of any bucket -# remove a specified amount from one specified bucket and add it to another, preserving the total of all bucket values, and [[wp:Clamping (graphics)|clamping]] the transferred amount to ensure the values remain nonnegative +# remove a specified amount from one specified bucket and add it to another, preserving the total of all bucket values, and [[wp:Clamping (graphics)|clamping]] the transferred amount to ensure the values remain non-negative ---- @@ -9,8 +10,10 @@ In order to exercise this data type, create one set of buckets, and start three # As often as possible, pick two buckets and arbitrarily redistribute their values. # At whatever rate is convenient, display (by any means) the total value and, optionally, the individual values of each bucket. +
The display task need not be explicit; use of e.g. a debugger or trace tool is acceptable provided it is simple to set up to provide the display. ---- -This task is intended as an exercise in ''atomic'' operations. The sum of the bucket values must be preserved even if the two tasks attempt to perform transfers simultaneously, and a straightforward solution is to ensure that at any time, only one transfer is actually occurring — that the transfer operation is ''atomic''. +This task is intended as an exercise in ''atomic'' operations.   The sum of the bucket values must be preserved even if the two tasks attempt to perform transfers simultaneously, and a straightforward solution is to ensure that at any time, only one transfer is actually occurring — that the transfer operation is ''atomic''. +

diff --git a/Task/Atomic-updates/Go/atomic-updates.go b/Task/Atomic-updates/Go/atomic-updates.go new file mode 100644 index 0000000000..4e62753830 --- /dev/null +++ b/Task/Atomic-updates/Go/atomic-updates.go @@ -0,0 +1,150 @@ +package main + +import ( + "fmt" + "math/rand" + "sync" + "time" +) + +const nBuckets = 10 + +type bucketList struct { + b [nBuckets]int // bucket data specified by task + + // transfer counts for each updater, not strictly required by task but + // useful to show that the two updaters get fair chances to run. + tc [2]int + + sync.Mutex // synchronization +} + +// Updater ids, to track number of transfers by updater. +// these can index bucketlist.tc for example. +const ( + idOrder = iota + idChaos +) + +const initialSum = 1000 // sum of all bucket values + +// Constructor. +func newBucketList() *bucketList { + var bl bucketList + // Distribute initialSum across buckets. + for i, dist := nBuckets, initialSum; i > 0; { + v := dist / i + i-- + bl.b[i] = v + dist -= v + } + return &bl +} + +// method 1 required by task, get current value of a bucket +func (bl *bucketList) bucketValue(b int) int { + bl.Lock() // lock before accessing data + r := bl.b[b] + bl.Unlock() + return r +} + +// method 2 required by task +func (bl *bucketList) transfer(b1, b2, a int, ux int) { + // Get access. + bl.Lock() + // Clamping maintains invariant that bucket values remain nonnegative. + if a > bl.b[b1] { + a = bl.b[b1] + } + // Transfer. + bl.b[b1] -= a + bl.b[b2] += a + bl.tc[ux]++ // increment transfer count + bl.Unlock() +} + +// additional useful method +func (bl *bucketList) snapshot(s *[nBuckets]int, tc *[2]int) { + bl.Lock() + *s = bl.b + *tc = bl.tc + bl.tc = [2]int{} // clear transfer counts + bl.Unlock() +} + +var bl = newBucketList() + +func main() { + // Three concurrent tasks. + go order() // make values closer to equal + go chaos() // arbitrarily redistribute values + buddha() // display total value and individual values of each bucket +} + +// The concurrent tasks exercise the data operations by calling bucketList +// methods. The bucketList methods are "threadsafe", by which we really mean +// goroutine-safe. The conconcurrent tasks then do no explicit synchronization +// and are not responsible for maintaining invariants. + +// Exercise 1 required by task: make values more equal. +func order() { + r := rand.New(rand.NewSource(time.Now().UnixNano())) + for { + b1 := r.Intn(nBuckets) + b2 := r.Intn(nBuckets - 1) + if b2 >= b1 { + b2++ + } + v1 := bl.bucketValue(b1) + v2 := bl.bucketValue(b2) + if v1 > v2 { + bl.transfer(b1, b2, (v1-v2)/2, idOrder) + } else { + bl.transfer(b2, b1, (v2-v1)/2, idOrder) + } + } +} + +// Exercise 2 required by task: redistribute values. +func chaos() { + r := rand.New(rand.NewSource(time.Now().Unix())) + for { + b1 := r.Intn(nBuckets) + b2 := r.Intn(nBuckets - 1) + if b2 >= b1 { + b2++ + } + bl.transfer(b1, b2, r.Intn(bl.bucketValue(b1)+1), idChaos) + } +} + +// Exercise 3 requred by task: display total. +func buddha() { + var s [nBuckets]int + var tc [2]int + var total, nTicks int + + fmt.Println("sum ---updates--- mean buckets") + tr := time.Tick(time.Second / 10) + for { + <-tr + bl.snapshot(&s, &tc) + var sum int + for _, l := range s { + if l < 0 { + panic("sob") // invariant not preserved + } + sum += l + } + // Output number of updates per tick and cummulative mean + // updates per tick to demonstrate "as often as possible" + // of task exercises 1 and 2. + total += tc[0] + tc[1] + nTicks++ + fmt.Printf("%d %6d %6d %7d %3d\n", sum, tc[0], tc[1], total/nTicks, s) + if sum != initialSum { + panic("weep") // invariant not preserved + } + } +} diff --git a/Task/Atomic-updates/Perl-6/atomic-updates.pl6 b/Task/Atomic-updates/Perl-6/atomic-updates.pl6 new file mode 100644 index 0000000000..8dae962eb0 --- /dev/null +++ b/Task/Atomic-updates/Perl-6/atomic-updates.pl6 @@ -0,0 +1,69 @@ +#| A collection of non-negative integers, with atomic operations. +class BucketStore { + + has $.elems is required; + has @!buckets = ^1024 .pick xx $!elems; + has $lock = Lock.new; + + #| Returns an array with the contents of all buckets. + method buckets { + $lock.protect: { [@!buckets] } + } + + #| Transfers $amount from bucket at index $from, to bucket at index $to. + method transfer ($amount, :$from!, :$to!) { + return if $from == $to; + + $lock.protect: { + my $clamped = $amount min @!buckets[$from]; + + @!buckets[$from] -= $clamped; + @!buckets[$to] += $clamped; + } + } +} + +# Create bucket store +my $bucket-store = BucketStore.new: elems => 8; +my $initial-sum = $bucket-store.buckets.sum; + +# Start a thread to equalize buckets +Thread.start: { + loop { + my @buckets = $bucket-store.buckets; + + # Pick 2 buckets, so that $to has not more than $from + my ($to, $from) = @buckets.keys.pick(2).sort({ @buckets[$_] }); + + # Transfer half of the difference, rounded down + $bucket-store.transfer: ([-] @buckets[$from, $to]) div 2, :$from, :$to; + } +} + +# Start a thread to distribute values among buckets +Thread.start: { + loop { + my @buckets = $bucket-store.buckets; + + # Pick 2 buckets + my ($to, $from) = @buckets.keys.pick(2); + + # Transfer a random portion + $bucket-store.transfer: ^@buckets[$from] .pick, :$from, :$to; + } +} + +# Loop to display buckets +loop { + sleep 1; + + my @buckets = $bucket-store.buckets; + my $sum = @buckets.sum; + + say "{@buckets.fmt: '%4d'}, total $sum"; + + if $sum != $initial-sum { + note "ERROR: Total changed from $initial-sum to $sum"; + exit 1; + } +} diff --git a/Task/Atomic-updates/Rust/atomic-updates.rust b/Task/Atomic-updates/Rust/atomic-updates.rust new file mode 100644 index 0000000000..a8ccc26fec --- /dev/null +++ b/Task/Atomic-updates/Rust/atomic-updates.rust @@ -0,0 +1,73 @@ +extern crate rand; + +use std::sync::{Arc, Mutex}; +use std::thread; +use std::cmp; +use std::time::Duration; + +use rand::Rng; +use rand::distributions::{IndependentSample, Range}; + +trait Buckets { + fn equalize(&mut self, rng: &mut R); + fn randomize(&mut self, rng: &mut R); + fn print_state(&self); +} + +impl Buckets for [i32] { + fn equalize(&mut self, rng: &mut R) { + let range = Range::new(0,self.len()-1); + let src = range.ind_sample(rng); + let dst = range.ind_sample(rng); + if dst != src { + let amount = cmp::min(((dst + src) / 2) as i32, self[src]); + let multiplier = if amount >= 0 { -1 } else { 1 }; + self[src] += amount * multiplier; + self[dst] -= amount * multiplier; + } + } + fn randomize(&mut self, rng: &mut R) { + let ind_range = Range::new(0,self.len()-1); + let src = ind_range.ind_sample(rng); + let dst = ind_range.ind_sample(rng); + if dst != src { + let amount = cmp::min(Range::new(0,20).ind_sample(rng), self[src]); + self[src] -= amount; + self[dst] += amount; + + } + } + fn print_state(&self) { + println!("{:?} = {}", self, self.iter().sum::()); + } +} + +fn main() { + let e_buckets = Arc::new(Mutex::new([10; 10])); + let r_buckets = e_buckets.clone(); + let p_buckets = e_buckets.clone(); + + thread::spawn(move || { + let mut rng = rand::thread_rng(); + loop { + let mut buckets = e_buckets.lock().unwrap(); + buckets.equalize(&mut rng); + } + }); + thread::spawn(move || { + let mut rng = rand::thread_rng(); + loop { + let mut buckets = r_buckets.lock().unwrap(); + buckets.randomize(&mut rng); + } + }); + + let sleep_time = Duration::new(1,0); + loop { + { + let buckets = p_buckets.lock().unwrap(); + buckets.print_state(); + } + thread::sleep(sleep_time); + } +} diff --git a/Task/Average-loop-length/00DESCRIPTION b/Task/Average-loop-length/00DESCRIPTION index e2934f7bde..089cb2908c 100644 --- a/Task/Average-loop-length/00DESCRIPTION +++ b/Task/Average-loop-length/00DESCRIPTION @@ -1,9 +1,12 @@ Let f be a uniformly-randomly chosen mapping from the numbers 1..N to the numbers 1..N (note: not necessarily a permutation of 1..N; the mapping could produce a number in more than one way or not at all). At some point, the sequence 1, f(1), f(f(1))... will contain a repetition, a number that occurring for the second time in the sequence. + +;Task: Write a program or a script that estimates, for each N, the average length until the first such repetition. Also calculate this expected length using an analytical formula, and optionally compare the simulated result with the theoretical one. + This problem comes from the end of Donald Knuth's [http://www.youtube.com/watch?v=cI6tt9QfRdo Christmas tree lecture 2011]. Example of expected output: @@ -30,3 +33,4 @@ Example of expected output: 18 4.9951 5.0071 ( 0.24%) 19 5.1312 5.1522 ( 0.41%) 20 5.2699 5.2936 ( 0.45%) +
diff --git a/Task/Average-loop-length/Clojure/average-loop-length.clj b/Task/Average-loop-length/Clojure/average-loop-length.clj new file mode 100644 index 0000000000..206967d078 --- /dev/null +++ b/Task/Average-loop-length/Clojure/average-loop-length.clj @@ -0,0 +1,44 @@ +(ns cyclelengths + (:gen-class)) + +(defn factorial [n] + " n! " + (apply *' (range 1 (inc n)))) ; Use *' (vs. *) to allow arbitrary length arithmetic + +(defn pow [n i] + " n^i" + (apply *' (repeat i n))) + +(defn analytical [n] + " Analytical Computation " + (->>(range 1 (inc n)) + (map #(/ (factorial n) (pow n %) (factorial (- n %)))) ;calc n %)) + (reduce + 0))) + +;; Number of random times to test each n +(def TIMES 1000000) + +(defn single-test-cycle-length [n] + " Single random test of cycle length " + (loop [count 0 + bits 0 + x 1] + (if (zero? (bit-and x bits)) + (recur (inc count) (bit-or bits x) (bit-shift-left 1 (rand-int n))) + count))) + +(defn avg-cycle-length [n times] + " Average results of single tests of cycle lengths " + (/ + (reduce + + (for [i (range times)] + (single-test-cycle-length n))) + times)) + +;; Show Results +(println "\tAvg\t\tExp\t\tDiff") +(doseq [q (range 1 21) + :let [anal (double (analytical q)) + avg (double (avg-cycle-length q TIMES)) + diff (Math/abs (* 100 (- 1 (/ avg anal))))]] + (println (format "%3d\t%.4f\t%.4f\t%.2f%%" q avg anal diff))) diff --git a/Task/Average-loop-length/Elixir/average-loop-length.elixir b/Task/Average-loop-length/Elixir/average-loop-length.elixir index b059950f51..39163a1f69 100644 --- a/Task/Average-loop-length/Elixir/average-loop-length.elixir +++ b/Task/Average-loop-length/Elixir/average-loop-length.elixir @@ -2,20 +2,18 @@ defmodule RC do def factorial(0), do: 1 def factorial(n), do: Enum.reduce(1..n, 1, &(&1 * &2)) - def loop_length(n), do: loop_length(n, HashSet.new) + def loop_length(n), do: loop_length(n, MapSet.new) defp loop_length(n, set) do - r = :random.uniform(n) - if Set.member?(set, r), do: Set.size(set), - else: loop_length(n, Set.put(set, r)) + r = :rand.uniform(n) + if r in set, do: MapSet.size(set), else: loop_length(n, MapSet.put(set, r)) end def task(runs) do IO.puts " N average analytical (error) " IO.puts "=== ========= ========== =========" Enum.each(1..20, fn n -> - sum_of_runs = Enum.reduce(1..runs, 0, fn _,sum -> sum + loop_length(n) end) - avg = sum_of_runs / runs + avg = Enum.reduce(1..runs, 0, fn _,sum -> sum + loop_length(n) end) / runs analytical = Enum.reduce(1..n, 0, fn i,sum -> sum + (factorial(n) / :math.pow(n, i) / factorial(n-i)) end) @@ -24,5 +22,5 @@ defmodule RC do end end -runs = 100_000 +runs = 1_000_000 RC.task(runs) diff --git a/Task/Average-loop-length/Java/average-loop-length.java b/Task/Average-loop-length/Java/average-loop-length.java new file mode 100644 index 0000000000..cc0a05240e --- /dev/null +++ b/Task/Average-loop-length/Java/average-loop-length.java @@ -0,0 +1,51 @@ +import java.util.ArrayList; + +public class AverageLoopLength { + private static final int N = 100000; + //analytical(n) = sum_(i=1)^n (n!/(n-i)!/n**i) + public static float analytical(int n){ + float[] factorial = new float[n+1]; + float[] powers = new float[n+1]; + factorial[0] = powers[0] = 1; + for(int i=1;i<=n;i++){ + factorial[i] = factorial[i-1] * i; + powers[i] = powers[i-1] * n; + } + float sum = 0; + //memoized factorial and powers + for(int i=1;i<=n;i++){ + sum += factorial[n]/factorial[n-i]/powers[i]; + } + return sum; + } + public static float average(int n){ + float sum = 0; + for(int a=0;a seen = new ArrayList<>(n); + int current = 0; + int length = 0; + while(true){ + length++; + seen.add(current); + current = random[current]; + if(seen.contains(current)){ + break; + } + } + sum += length; + } + return sum/N; + } + public static void main(String args[]){ + System.out.println(" N average analytical (error)\n=== ========= ============ ========="); + for(int i=1;i<=20;i++){ + float avg = average(i); + float ana = analytical(i); + System.out.println(String.format("%3d %9.4f %12.4f (%6.2f%%)",i,avg,ana,((ana-avg)/ana*100)));; + } + } +} diff --git a/Task/Average-loop-length/Perl-6/average-loop-length.pl6 b/Task/Average-loop-length/Perl-6/average-loop-length.pl6 index cb0f84dd15..b99795f691 100644 --- a/Task/Average-loop-length/Perl-6/average-loop-length.pl6 +++ b/Task/Average-loop-length/Perl-6/average-loop-length.pl6 @@ -4,7 +4,7 @@ constant TRIALS = 100; for 1 .. MAX_N -> $N { my $empiric = TRIALS R/ [+] find-loop(random-mapping($N)).elems xx TRIALS; my $theoric = [+] - map -> $k { $N ** ($k + 1) R/ [*] $k**2, $N - $k + 1 .. $N }, 1 .. $N; + map -> $k { $N ** ($k + 1) R/ [*] flat $k**2, $N - $k + 1 .. $N }, 1 .. $N; FIRST say " N empiric theoric (error)"; FIRST say "=== ========= ============ ========="; @@ -15,4 +15,4 @@ for 1 .. MAX_N -> $N { } sub random-mapping { hash .list Z=> .roll given ^$^size } -sub find-loop { 0, %^mapping{*} ...^ { (state %){$_}++ } } +sub find-loop { 0, | %^mapping{*} ...^ { (%){$_}++ } } diff --git a/Task/Average-loop-length/PowerShell/average-loop-length-1.psh b/Task/Average-loop-length/PowerShell/average-loop-length-1.psh new file mode 100644 index 0000000000..20b6979f45 --- /dev/null +++ b/Task/Average-loop-length/PowerShell/average-loop-length-1.psh @@ -0,0 +1,59 @@ +function Get-AnalyticalLoopAverage ( [int]$N ) + { + # Expected loop average = sum from i = 1 to N of N! / (N-i)! / N^(N-i+1) + # Equivalently, Expected loop average = sum from i = 1 to N of F(i) + # where F(N) = 1, and F(i) = F(i+1)*i/N + + $LoopAverage = $Fi = 1 + + If ( $N -eq 1 ) { return $LoopAverage } + + ForEach ( $i in ($N-1)..1 ) + { + $Fi *= $i / $N + $LoopAverage += $Fi + } + return $LoopAverage + } + +function Get-ExperimentalLoopAverage ( [int]$N, [int]$Tests = 100000 ) + { + If ( $N -eq 1 ) { return 1 } + + # Using 0 through N-1 instead of 1 through N for speed and simplicity + $NMO = $N - 1 + + # Create array to hold mapping function + $F = New-Object int[] ( $N ) + + $Count = 0 + $Random = New-Object System.Random + + ForEach ( $Test in 1..$Tests ) + { + # Map each number to a random number + ForEach ( $i in 0..$NMO ) + { + $F[$i] = $Random.Next( $N ) + } + + # For each number... + ForEach ( $i in 0..$NMO ) + { + # Add the number to the list + $List = @() + $Count++ + $List += $X = $i + + # If loop does not yet exist in list... + While ( $F[$X] -notin $List ) + { + # Go to the next mapped number and add it to the list + $Count++ + $List += $X = $F[$X] + } + } + } + $LoopAvereage = $Count / $N / $Tests + return $LoopAvereage + } diff --git a/Task/Average-loop-length/PowerShell/average-loop-length-2.psh b/Task/Average-loop-length/PowerShell/average-loop-length-2.psh new file mode 100644 index 0000000000..3729fdebcd --- /dev/null +++ b/Task/Average-loop-length/PowerShell/average-loop-length-2.psh @@ -0,0 +1,12 @@ +# Display results for N = 1 through 20 +ForEach ( $N in 1..20 ) + { + $AnalyticalAverage = Get-AnalyticalLoopAverage $N + $ExperimentalAverage = Get-ExperimentalLoopAverage $N + [pscustomobject] @{ + N = $N.ToString().PadLeft( 2, ' ' ) + Analytical = $AnalyticalAverage.ToString( '0.00000000' ) + Experimental = $ExperimentalAverage.ToString( '0.00000000' ) + 'Error (%)' = ( [math]::Abs( $AnalyticalAverage - $ExperimentalAverage ) / $AnalyticalAverage * 100 ).ToString( '0.00000000' ) + } + } diff --git a/Task/Average-loop-length/REXX/average-loop-length.rexx b/Task/Average-loop-length/REXX/average-loop-length.rexx index c5f870c50b..579000f02c 100644 --- a/Task/Average-loop-length/REXX/average-loop-length.rexx +++ b/Task/Average-loop-length/REXX/average-loop-length.rexx @@ -1,37 +1,36 @@ -/*REXX pgm computes average loop length mapping a random field 1..N ───► 1..N */ -parse arg runs tests seed . /*obtain optional arguments from C.L. */ -if runs ==',' | runs =='' then runs = 40 /*number of runs. */ -if tests ==',' | tests =='' then tests= 1000000 /* " " trials. */ -if seed\==',' & seed\=='' then call random ,,seed /*RAND repeatability?*/ -numeric digits 100000; !.=0; !.0=1 /*be able to calculate 25,000! */ -numeric digits max(9,length(!(runs))) /*set the NUMERIC DIGITS for !(runs). */ -say right( runs, 24) 'runs' /*display number of runs we're using.*/ -say right( tests, 24) 'tests' /* " " " tests " " */ -say right( digits(), 24) 'digits' /* " " " digits " " */ +/*REXX program computes the average loop length mapping a random field 1···N ───► 1···N */ +parse arg runs tests seed . /*obtain optional arguments from the CL*/ +if runs =='' | runs =="," then runs = 40 /*Not specified? Then use the default.*/ +if tests =='' | tests =="," then tests= 1000000 /* " " " " " " */ +if datatype(seed,'W') then call random ,, seed /*Is integer? For RAND repeatability.*/ +!.=0; !.0=1 /*used for factorial (!) memoization.*/ +numeric digits 100000 /*be able to calculate 25k! if need be.*/ +numeric digits max(9, length( !(runs) ) ) /*set the NUMERIC DIGITS for !(runs). */ +say right( runs, 24) 'runs' /*display number of runs we're using.*/ +say right( tests, 24) 'tests' /* " " " tests " " */ +say right( digits(), 24) 'digits' /* " " " digits " " */ say -say ' N average exact % error' /*◄──title,header►───┐*/ -h= ' ─── ───────── ───────── ─────────'; pad=left('',3) /*◄──────┘*/ -say h - do #=1 for runs; ##=right(#,9) /*## is used for indenting the output.*/ - avg=fmtD(exact(#)) /*use four digits past decimal point. */ - exa=fmtD(exper(#)) /* " " " " " " */ - err=fmtD(abs(exa-avg)*100/avg) /* " " " " " " */ - say ## pad exa pad avg pad err /*display a line of statistics to term.*/ - end /*#*/ -say h /*display the final header (some bars).*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -!: procedure expose !.; parse arg z; if !.z\==0 then return !.z - !=1; do j=1 for z; !=!*j; !.j=!; end; /*factorial*/ return ! -/*────────────────────────────────────────────────────────────────────────────*/ -exact: parse arg x; s=0; do j=1 for x; s=s+!(x)/!(x-j)/x**j; end; return s -/*────────────────────────────────────────────────────────────────────────────*/ -exper: parse arg n; k=0; do tests; $.=0 /*do it TESTS times.*/ +say " N average exact % error " /* ◄─── title, header ►────────┐ */ +hdr=" ═══ ═════════ ═════════ ═════════"; pad=left('',3) /* ◄────────┘ */ +say hdr + do #=1 for runs; av=fmtD(exact(#)) /*use four digits past decimal point. */ + xa=fmtD(exper(#)) /* " " " " " " */ + say right(#,9) pad xa pad av pad fmtD(abs(xa-av)*100/av) /*display values.*/ + end /*#*/ +say hdr /*display the final header (some bars).*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +!: procedure expose !.; parse arg z; if !.z\==0 then return !.z + !=1; do j=2 for z-1; !=!*j; !.j=!; end; /*factorial*/ return ! +/*──────────────────────────────────────────────────────────────────────────────────────*/ +exact: parse arg x; s=0; do j=1 for x; s=s+!(x)/!(x-j)/x**j; end; return s +/*──────────────────────────────────────────────────────────────────────────────────────*/ +exper: parse arg n; k=0; do tests; $.=0 /*do it TESTS times.*/ do n; r=random(1,n); if $.r then leave - $.r=1; k=k+1 /*bump the counter. */ + $.r=1; k=k+1 /*bump the counter. */ end /*n*/ - end /*tests*/ + end /*tests*/ return k/tests -/*────────────────────────────────────────────────────────────────────────────*/ -fmtD: parse arg y,d; d=word(d 4,1); y=format(y,,d); parse var y w '.' f - if f=0 then return w || left('', d+1); return y +/*──────────────────────────────────────────────────────────────────────────────────────*/ +fmtD: parse arg y,d; d=word(d 4,1); y=format(y,,d); parse var y w '.' f + if f=0 then return w || left('', d+1); return y diff --git a/Task/Average-loop-length/Rust/average-loop-length.rust b/Task/Average-loop-length/Rust/average-loop-length.rust new file mode 100644 index 0000000000..b831a73a14 --- /dev/null +++ b/Task/Average-loop-length/Rust/average-loop-length.rust @@ -0,0 +1,74 @@ +extern crate rand; + +use rand::{ThreadRng, thread_rng}; +use rand::distributions::{IndependentSample, Range}; +use std::collections::HashSet; +use std::env; +use std::process; + +fn help() { + println!("usage: average_loop_length "); +} + +fn main() { + let args: Vec = env::args().collect(); + let mut max_n: u32 = 20; + let mut trials: u32 = 1000; + + match args.len() { + 1 => {} + 3 => { + max_n = args[1].parse::().unwrap(); + trials = args[2].parse::().unwrap(); + } + _ => { + help(); + process::exit(0); + } + } + + let mut rng = thread_rng(); + + println!(" N average analytical (error)"); + println!("=== ========= ============ ========="); + for n in 1..(max_n + 1) { + let the_analytical = analytical(n); + let the_empirical = empirical(n, trials, &mut rng); + println!(" {:>2} {:3.4} {:3.4} ( {:>+1.2}%)", + n, + the_empirical, + the_analytical, + 100f64 * (the_empirical / the_analytical - 1f64)); + } +} + +fn factorial(n: u32) -> f64 { + (1..n + 1).fold(1f64, |p, n| p * n as f64) +} + +fn analytical(n: u32) -> f64 { + let sum: f64 = (1..(n + 1)) + .map(|i| factorial(n) / (n as f64).powi(i as i32) / factorial(n - i)) + .fold(0f64, |a, v| a + v); + sum +} + +fn empirical(n: u32, trials: u32, rng: &mut ThreadRng) -> f64 { + let sum: f64 = (0..trials) + .map(|_t| { + let mut item = 1u32; + let mut seen = HashSet::new(); + let range = Range::new(1u32, n + 1); + + for step in 0..n { + if seen.contains(&item) { + return step as f64; + } + seen.insert(item); + item = range.ind_sample(rng); + } + n as f64 + }) + .fold(0f64, |a, v| a + v); + sum / trials as f64 +} diff --git a/Task/Averages-Arithmetic-mean/00DESCRIPTION b/Task/Averages-Arithmetic-mean/00DESCRIPTION index af27762aef..e984b57478 100644 --- a/Task/Averages-Arithmetic-mean/00DESCRIPTION +++ b/Task/Averages-Arithmetic-mean/00DESCRIPTION @@ -1,3 +1,11 @@ -Write a program to find the [[wp:arithmetic mean|mean]] (arithmetic average) of a numeric vector. In case of a zero-length input, since the mean of an empty set of numbers is ill-defined, the program may choose to behave in any way it deems appropriate, though if the programming language has an established convention for conveying math errors or undefined values, it's preferable to follow it. +{{task heading}} -See also: [[Median]], [[Mode]] +Write a program to find the [[wp:arithmetic mean|mean]] (arithmetic average) of a numeric vector. + +In case of a zero-length input, since the mean of an empty set of numbers is ill-defined, the program may choose to behave in any way it deems appropriate, though if the programming language has an established convention for conveying math errors or undefined values, it's preferable to follow it. + +{{task heading|See also}} + +{{Related tasks/Statistical measures}} + +

diff --git a/Task/Averages-Arithmetic-mean/AWK/averages-arithmetic-mean.awk b/Task/Averages-Arithmetic-mean/AWK/averages-arithmetic-mean.awk index f168a07097..971bb5b97b 100644 --- a/Task/Averages-Arithmetic-mean/AWK/averages-arithmetic-mean.awk +++ b/Task/Averages-Arithmetic-mean/AWK/averages-arithmetic-mean.awk @@ -1,21 +1,17 @@ -# work around a gawk bug in the length extended use: -# so this is a more non-gawk compliant way to get -# how many elements are in an array -function elength(v) -{ - l=0 - for(el in v) l++ - return l -} +cat mean.awk +#!/usr/local/bin/gawk -f -function mean(v) -{ - if (elength(v) < 1) { return 0 } - sum = 0 - for(i=0; i < elength(v); i++) { +# User defined function +function mean(v, i,n,sum) { + for (i in v) { + n++ sum += v[i] } - return sum/elength(v) + if (n>0) { + return(sum/n) + } else { + return("zero-length input !") + } } BEGIN { @@ -24,4 +20,5 @@ BEGIN { vett[i] = rand()*10 } print mean(vett) + print mean(nothing) } diff --git a/Task/Averages-Arithmetic-mean/Applesoft-BASIC/averages-arithmetic-mean.applesoft b/Task/Averages-Arithmetic-mean/Applesoft-BASIC/averages-arithmetic-mean.applesoft new file mode 100644 index 0000000000..cd841e2aea --- /dev/null +++ b/Task/Averages-Arithmetic-mean/Applesoft-BASIC/averages-arithmetic-mean.applesoft @@ -0,0 +1,17 @@ +REM COLLECTION IN DATA STATEMENTS, EMPTY DATA IS THE END OF THE COLLECTION + 0 READ V$ + 1 IF LEN(V$) = 0 THEN END + 2 N = 0 + 3 S = 0 + 4 FOR I = 0 TO 1 STEP 0 + 5 S = S + VAL(V$) + 6 N = N + 1 + 7 READ V$ + 8 IF LEN(V$) THEN NEXT + 9 PRINT S / N +10000 DATA1,2,2.718,3,3.142 +63999 DATA + +REM COLLECTION IN AN ARRAY, ITEM 0 IS THE SIZE OF THE COLLECTION +A(0) = 5 : A(1) = 1 : A(2) = 2 : A(3) = 2.718 : A(4) = 3 : A(5) = 3.142 +N = A(0) : IF N THEN S = 0 : FOR I = 1 TO N : S = S + A(I) : NEXT : ? S / N diff --git a/Task/Averages-Arithmetic-mean/Babel/averages-arithmetic-mean.pb b/Task/Averages-Arithmetic-mean/Babel/averages-arithmetic-mean.pb index c17778a27e..63d1122ae1 100644 --- a/Task/Averages-Arithmetic-mean/Babel/averages-arithmetic-mean.pb +++ b/Task/Averages-Arithmetic-mean/Babel/averages-arithmetic-mean.pb @@ -1,12 +1 @@ -((main { - (2 3 5 7 11 13 17 19 23) - avg ! - %d nl <<}) - -(avg { - dup - <- sum ! -> - len - cudiv }) - -(sum { <- 0 -> {+} each })) +(3 24 18 427 483 49 14 4294 2 41) dup len <- sum ! -> / itod << diff --git a/Task/Averages-Arithmetic-mean/Elixir/averages-arithmetic-mean.elixir b/Task/Averages-Arithmetic-mean/Elixir/averages-arithmetic-mean.elixir index 020fc02d88..9e770488cb 100644 --- a/Task/Averages-Arithmetic-mean/Elixir/averages-arithmetic-mean.elixir +++ b/Task/Averages-Arithmetic-mean/Elixir/averages-arithmetic-mean.elixir @@ -1,3 +1,3 @@ -defmodule RC do - def mean(list), do: Enum.sum(list) / Enum.count(list) +defmodule Average do + def mean(list), do: Enum.sum(list) / length(list) end diff --git a/Task/Averages-Arithmetic-mean/JavaScript/averages-arithmetic-mean-6.js b/Task/Averages-Arithmetic-mean/JavaScript/averages-arithmetic-mean-6.js new file mode 100644 index 0000000000..fcacc4a5f1 --- /dev/null +++ b/Task/Averages-Arithmetic-mean/JavaScript/averages-arithmetic-mean-6.js @@ -0,0 +1,14 @@ +(sample => { + + // mean :: [Num] => (Num | NaN) + let mean = lst => { + let lng = lst.length; + + return lng ? ( + lst.reduce((a, b) => a + b, 0) / lng + ) : NaN; + }; + + return mean(sample); + +})([1, 2, 3, 4, 5, 6, 7, 8, 9]); diff --git a/Task/Averages-Arithmetic-mean/JavaScript/averages-arithmetic-mean-7.js b/Task/Averages-Arithmetic-mean/JavaScript/averages-arithmetic-mean-7.js new file mode 100644 index 0000000000..7ed6ff82de --- /dev/null +++ b/Task/Averages-Arithmetic-mean/JavaScript/averages-arithmetic-mean-7.js @@ -0,0 +1 @@ +5 diff --git a/Task/Averages-Arithmetic-mean/Kotlin/averages-arithmetic-mean.kotlin b/Task/Averages-Arithmetic-mean/Kotlin/averages-arithmetic-mean.kotlin new file mode 100644 index 0000000000..07b4122cea --- /dev/null +++ b/Task/Averages-Arithmetic-mean/Kotlin/averages-arithmetic-mean.kotlin @@ -0,0 +1,2 @@ +val nums = doubleArrayOf(1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0, 9.0, 10.0) +println("average = %f".format(nums.average())) diff --git a/Task/Averages-Arithmetic-mean/REXX/averages-arithmetic-mean.rexx b/Task/Averages-Arithmetic-mean/REXX/averages-arithmetic-mean.rexx index cef807d928..efa4be3b69 100644 --- a/Task/Averages-Arithmetic-mean/REXX/averages-arithmetic-mean.rexx +++ b/Task/Averages-Arithmetic-mean/REXX/averages-arithmetic-mean.rexx @@ -1,22 +1,27 @@ -/*REXX program finds the averages/arithmetic mean of several lists (vectors).*/ +/*REXX program finds the averages/arithmetic mean of several lists (vectors) or CL input*/ +parse arg @.1; if @.1='' then do; #=6 /*vector from the C.L.?*/ @.1 = 10 9 8 7 6 5 4 3 2 1 @.2 = 10 9 8 7 6 5 4 3 2 1 0 0 0 0 .11 @.3 = '10 20 30 40 50 -100 4.7 -11e2' @.4 = '1 2 3 4 five 6 7 8 9 10.1. ±2' @.5 = 'World War I & World War II' - @.6 = /*a null value. */ - do j=1 for 6 - say 'numbers = ' @.j; say "average = " avg(@.j); say copies('═',60) + @.6 = /* ◄─── a null value. */ + end + else #=1 /*number of CL vectors.*/ + do j=1 for # + say ' numbers = ' @.j + say ' average = ' avg(@.j) + say copies('═', 79) end /*t*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -avg: procedure; parse arg x; #=words(x); $=0 /*#: number of items. */ -if #==0 then return 'N/A: ───[null vector.]' /*No words? Return N/A*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +avg: procedure; parse arg x; #=words(x) /*#: number of items.*/ + if #==0 then return 'N/A: ───[null vector.]' /*No words? Return N/A*/ + $=0 + do k=1 for #; _=word(x,k) /*obtain a number. */ + if datatype(_,'N') then do; $=$+_; iterate; end /*if numeric, then add*/ + say left('',40) "***error*** non-numeric: " _; #=#-1 /*error; adjust number*/ + end /*k*/ - do k=1 for #; _=word(x,k) /*obtain a number.*/ - if datatype(_,'N') then do; $=$+_; iterate; end /*if numeric, add.*/ - say left('',20) "***error!*** non-numeric: " _; #=#-1 /*error; adjust #.*/ - end /*k*/ - -if #==0 then return 'N/A: ───[no numeric values.]' /*No nums? Return N/A.*/ -return $/max(1,#) /*return the average. */ + if #==0 then return 'N/A: ───[no numeric values.]' /*No nums? Return N/A*/ + return $ / # /*return the average. */ diff --git a/Task/Averages-Arithmetic-mean/RPL-2/averages-arithmetic-mean.rpl b/Task/Averages-Arithmetic-mean/RPL-2/averages-arithmetic-mean.rpl new file mode 100644 index 0000000000..b9af5aa85a --- /dev/null +++ b/Task/Averages-Arithmetic-mean/RPL-2/averages-arithmetic-mean.rpl @@ -0,0 +1,4 @@ +1 2 3 5 7 +AMEAN + << DEPTH DUP 'N' STO ->LIST ΣLIST N / >> +3.6 diff --git a/Task/Averages-Mean-angle/00DESCRIPTION b/Task/Averages-Mean-angle/00DESCRIPTION index 0a01d2fbb2..10b26a9abc 100644 --- a/Task/Averages-Mean-angle/00DESCRIPTION +++ b/Task/Averages-Mean-angle/00DESCRIPTION @@ -7,17 +7,26 @@ To calculate the mean angle of several angles: # Compute the mean of the complex numbers. # Convert the complex mean to polar coordinates whereupon the phase of the complex mean is the required angular mean. +
(Note that, since the mean is the sum divided by the number of numbers, and division by a positive real number does not affect the angle, you can also simply compute the sum for step 2.) You can alternatively use this formula: -:Given the angles \alpha_1,\dots,\alpha_n the mean is computed by +: Given the angles \alpha_1,\dots,\alpha_n the mean is computed by ::\bar{\alpha} = \operatorname{atan2}\left(\frac{1}{n}\cdot\sum_{j=1}^n \sin\alpha_j, \frac{1}{n}\cdot\sum_{j=1}^n \cos\alpha_j\right) -The task is to: -# write a function/method/subroutine/... that given a list of angles in degrees returns their mean angle. (You should use a built-in function if you have one that does this for degrees or radians). -# Use the function to compute the means of these lists of angles (in degrees): [350, 10], [90, 180, 270, 360], [10, 20, 30]; and show your output here. +{{task heading}} -;See Also -* [[Averages/Mean time of day]] +# write a function/method/subroutine/... that given a list of angles in degrees returns their mean angle.
(You should use a built-in function if you have one that does this for degrees or radians). +# Use the function to compute the means of these lists of angles (in degrees): +#*   [350, 10] +#*   [90, 180, 270, 360] +#*   [10, 20, 30] +# Show your output here. + +{{task heading|See also}} + +{{Related tasks/Statistical measures}} + +

diff --git a/Task/Averages-Mean-angle/ALGOL-68/averages-mean-angle.alg b/Task/Averages-Mean-angle/ALGOL-68/averages-mean-angle.alg new file mode 100644 index 0000000000..8c0dfff38e --- /dev/null +++ b/Task/Averages-Mean-angle/ALGOL-68/averages-mean-angle.alg @@ -0,0 +1,26 @@ +#!/usr/bin/a68g --script # +# -*- coding: utf-8 -*- # + +PROC mean angle = ([]#LONG# REAL angles)#LONG# REAL: +( + INT size = UPB angles - LWB angles + 1; + #LONG# REAL y part := 0, x part := 0; + FOR i FROM LWB angles TO UPB angles DO + x part +:= #long# cos (angles[i] * #long# pi / 180); + y part +:= #long# sin (angles[i] * #long# pi / 180) + OD; + + #long# arc tan2 (y part / size, x part / size) * 180 / #long# pi +); + +main: +( + []#LONG# REAL angle set 1 = ( 350, 10 ); + []#LONG# REAL angle set 2 = ( 90, 180, 270, 360); + []#LONG# REAL angle set 3 = ( 10, 20, 30); + + FORMAT summary fmt=$"Mean angle for "g" set :"-zd.ddddd" degrees"l$; + printf ((summary fmt,"1st", mean angle (angle set 1))); + printf ((summary fmt,"2nd", mean angle (angle set 2))); + printf ((summary fmt,"3rd", mean angle (angle set 3))) +) diff --git a/Task/Averages-Mean-angle/Aime/averages-mean-angle.aime b/Task/Averages-Mean-angle/Aime/averages-mean-angle.aime new file mode 100644 index 0000000000..ad61e5f22e --- /dev/null +++ b/Task/Averages-Mean-angle/Aime/averages-mean-angle.aime @@ -0,0 +1,27 @@ +real +mean(list l) +{ + integer i; + real x, y; + + x = y = 0; + + i = 0; + while (i < l_length(l)) { + x += Gcos(l[i]); + y += Gsin(l[i]); + i += 1; + } + + return Gatan2(y / l_length(l), x / l_length(l)); +} + +integer +main(void) +{ + o_form("mean of 1st set: /d6/\n", mean(l_effect(350, 10))); + o_form("mean of 2nd set: /d6/\n", mean(l_effect(90, 180, 270, 360))); + o_form("mean of 3rd set: /d6/\n", mean(l_effect(10, 20, 30))); + + return 0; +} diff --git a/Task/Averages-Mean-angle/Elixir/averages-mean-angle.elixir b/Task/Averages-Mean-angle/Elixir/averages-mean-angle.elixir new file mode 100644 index 0000000000..cd6df5bee4 --- /dev/null +++ b/Task/Averages-Mean-angle/Elixir/averages-mean-angle.elixir @@ -0,0 +1,21 @@ +defmodule MeanAngle do + def mean_angle(angles) do + rad_angles = Enum.map(angles, °_to_rad/1) + sines = rad_angles |> Enum.map(&:math.sin/1) |> Enum.sum + cosines = rad_angles |> Enum.map(&:math.cos/1) |> Enum.sum + + rad_to_deg(:math.atan2(sines, cosines)) + end + + defp deg_to_rad(a) do + (:math.pi/180) * a + end + + defp rad_to_deg(a) do + (180/:math.pi) * a + end +end + +IO.inspect MeanAngle.mean_angle([10, 350]) +IO.inspect MeanAngle.mean_angle([90, 180, 270, 360]) +IO.inspect MeanAngle.mean_angle([10, 20, 30]) diff --git a/Task/Averages-Mean-angle/Perl-6/averages-mean-angle.pl6 b/Task/Averages-Mean-angle/Perl-6/averages-mean-angle.pl6 index dd7ea230de..c77f451f63 100644 --- a/Task/Averages-Mean-angle/Perl-6/averages-mean-angle.pl6 +++ b/Task/Averages-Mean-angle/Perl-6/averages-mean-angle.pl6 @@ -1,5 +1,7 @@ -sub deg2rad { $^d * pi / 180 } -sub rad2deg { $^r * 180 / pi } +# Of course, you can still use pi and 180. +sub deg2rad { $^d * tau / 360 } +sub rad2deg { $^r * 360 / tau } + sub phase ($c) { my ($mag,$ang) = $c.polar; return NaN if $mag < 1e-16; diff --git a/Task/Averages-Mean-angle/REXX/averages-mean-angle.rexx b/Task/Averages-Mean-angle/REXX/averages-mean-angle.rexx index f94e708a77..b7fe82f987 100644 --- a/Task/Averages-Mean-angle/REXX/averages-mean-angle.rexx +++ b/Task/Averages-Mean-angle/REXX/averages-mean-angle.rexx @@ -1,57 +1,54 @@ -/*REXX program computes the mean angle (the angles expressed in degrees). */ -numeric digits 50 /*use 50 decimal digits of precision,*/ - showDig=10 /* but only display ten decimal digits.*/ -# = 350 10 ; say showit(#, meanAngleD(#) ) -# = 90 180 270 360 ; say showit(#, meanAngleD(#) ) -# = 10 20 30 ; say showit(#, meanAngleD(#) ) -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────subroutines──────────────────────────────────────────────*/ +/*REXX program computes the mean angle for a group of angles (expressed in degrees). */ +call pi /*define the value of pi to some accuracy.*/ +numeric digits length(pi) - 1; showDig=10 /*use PI width decimal digits of precision,*/ + /* but only display 10 decimal digits. */ +#=350 10 ; say show(#, meanAngleD(#) ) +#=90 180 270 360 ; say show(#, meanAngleD(#) ) +#=10 20 30 ; say show(#, meanAngleD(#) ) +exit /*stick a fork in it, we're all done with it*/ +/*───────────────────────────────────────────────────────────────────────────────────────────*/ .sinCos: arg z,_,i; x=x*x; do k=2 by 2 until p=z; p=z; _=-_*x/(k*(k+i)); z=z+_; end; return z $fuzz: return min(arg(1), max(1, digits() - arg(2) ) ) -acos: procedure; parse arg x; return pi() * .5 - asin(x) -atan: parse arg x; if abs(x)=1 then return pi()*.25 * sign(x); return asin(x/sqrt(1 + x*x)) +Acos: procedure; parse arg x; return pi() * .5 - Asin(x) +Atan: parse arg x; if abs(x)=1 then return pi()*.25 * sign(x); return Asin(x/sqrt(1 + x*x)) d2d: return arg(1) // 360 d2r: return r2r(d2d(arg(1)) / 180 * pi() ) r2d: return d2d((r2r(arg(1)) / pi()) * 180) -r2r: return arg(1) // (pi() * 2) +r2r: return arg(1) // (pi() * 2) p: return word(arg(1), 1) pi: pi=3.1415926535897932384626433832795028841971693993751058209749445923078164062862;return pi -asin: procedure; parse arg x 1 z 1 o 1 p; xx=x*x - if xx>=.5 then return sign(x) * acos(sqrt(1-xx)) - do j=2 by 2 until p=z; p=z; o=o*xx*(j-1)/j; z=z+o/(j+1); end - return z /* [↑] compute until no more noise. */ +Asin: procedure; parse arg x 1 z 1 o 1 p; xx=x*x + if xx>=.5 then return sign(x) * Acos(sqrt(1-xx)) + do j=2 by 2 until p=z; p=z; o=o*xx*(j-1)/j; z=z+o/(j+1); end /*j*/ + return z /* [↑] compute until no more noise.*/ -atan2: procedure; parse arg y,x; call pi; s=sign(y) +Atan2: procedure; parse arg y,x; call pi; s=sign(y) select when x=0 then z=s * pi * .5 - when x<0 then if y=0 then z=pi; else z=s*(pi-abs(atan(y/x))) - otherwise z=s * atan(y/x) + when x<0 then if y=0 then z=pi; else z=s * (pi - abs( Atan(y/x) ) ) + otherwise z=s * Atan(y/x) end /*select*/; return z cos: procedure; parse arg x; x=r2r(x); numeric fuzz $fuzz(6, 3) a=abs(x); if a=0 then return 1; if a=pi then return -1 if a=pi*.5 | a=pi*1.5 then return 0; if a=pi/3 then return .5 - if a=pi*2/3 then return -.5; return .sinCos(1, 1, -1) - + if a=pi*2/3 then return -.5; return .sinCos(1, 1, -1) meanAngleD: procedure; parse arg x; numeric digits digits()+digits()%4 - _sin=0; _cos=0; n=words(x); do j=1 for n; !=d2r(word(x,j)) - _sin=_sin + sin(!) - _cos=_cos + cos(!) - end /*j*/ - return r2d(atan2(_sin/n, _cos/n)) + n=words(x); _sin=0; _cos=0 + do j=1 for n; !=d2r(word(x, j)); _sin=_sin+sin(!); _cos=_cos+cos(!); end /*j*/ + return r2d(Atan2(_sin/n, _cos/n)) -showit: procedure expose showDig; numeric digits showDig; parse arg a,mA - return left('angles='a,30) 'mean angle=' format(mA,,showDig,0)/1 +show: parse arg a,mA; _=format(ma, , showDig, 0) / 1 + return left('angles='a, 30) "mean angle=" right(_, max(4, length(_))) sin: procedure; parse arg x; x=r2r(x); numeric fuzz $fuzz(5, 3) if x=pi*.5 then return 1; if x==pi*1.5 then return -1 if abs(x)=pi | x=0 then return 0; return .sinCos(x, x, +1) -sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); i=; m.=9 - numeric digits 9; numeric form; h=d+6; if x<0 then do; x=-x; i='i'; end - parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_%2 - do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ - do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ - numeric digits d; return (g/1)i /*make complex if X < 0.*/ +sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); m.=9; numeric form; h=d+6 + numeric digits; parse value format(x,2,1,,0) 'E0' with g "E" _ .; g=g * .5'e'_ % 2 + do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ + do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ + return g diff --git a/Task/Averages-Mean-angle/Rust/averages-mean-angle.rust b/Task/Averages-Mean-angle/Rust/averages-mean-angle.rust new file mode 100644 index 0000000000..713f61dedd --- /dev/null +++ b/Task/Averages-Mean-angle/Rust/averages-mean-angle.rust @@ -0,0 +1,43 @@ +use std::f64; +// the macro is from +// http://stackoverflow.com/questions/30856285/assert-eq-with-floating- +// point-numbers-and-delta +fn mean_angle(angles: &[f64]) -> f64 { + let length: f64 = angles.len() as f64; + let cos_mean: f64 = angles.iter().fold(0.0, |sum, i| sum + i.to_radians().cos()) / length; + let sin_mean: f64 = angles.iter().fold(0.0, |sum, i| sum + i.to_radians().sin()) / length; + (sin_mean).atan2(cos_mean).to_degrees() +} + +fn main() { + let angles1 = [350.0_f64, 10.0]; + let angles2 = [90.0_f64, 180.0, 270.0, 360.0]; + let angles3 = [10.0_f64, 20.0, 30.0]; + println!("Mean Angle for {:?} is {:.5} degrees", + &angles1, + mean_angle(&angles1)); + println!("Mean Angle for {:?} is {:.5} degrees", + &angles2, + mean_angle(&angles2)); + println!("Mean Angle for {:?} is {:.5} degrees", + &angles3, + mean_angle(&angles3)); +} + +macro_rules! assert_diff{ + ($x: expr,$y : expr, $diff :expr)=>{ + if ( $x - $y ).abs() > $diff { + panic!("floating point difference is to big {}", $x - $y ); + } + } +} + +#[test] +fn calculate() { + let angles1 = [350.0_f64, 10.0]; + let angles2 = [90.0_f64, 180.0, 270.0, 360.0]; + let angles3 = [10.0_f64, 20.0, 30.0]; + assert_diff!(0.0, mean_angle(&angles1), 0.001); + assert_diff!(-90.0, mean_angle(&angles2), 0.001); + assert_diff!(20.0, mean_angle(&angles3), 0.001); +} diff --git a/Task/Averages-Mean-time-of-day/00DESCRIPTION b/Task/Averages-Mean-time-of-day/00DESCRIPTION index db02a1ceaa..6ee996fccf 100644 --- a/Task/Averages-Mean-time-of-day/00DESCRIPTION +++ b/Task/Averages-Mean-time-of-day/00DESCRIPTION @@ -1,3 +1,5 @@ +{{task heading}} + A particular activity of bats occurs at these times of the day: :23:00:17, 23:40:20, 00:12:45, 00:17:19 @@ -7,3 +9,9 @@ map times of day to and from angles; and using the ideas of [[Averages/Mean angle]] compute and show the average time of the nocturnal activity to an accuracy of one second of time. + +{{task heading|See also}} + +{{Related tasks/Statistical measures}} + +
diff --git a/Task/Averages-Mean-time-of-day/Oberon-2/averages-mean-time-of-day.oberon-2 b/Task/Averages-Mean-time-of-day/Oberon-2/averages-mean-time-of-day.oberon-2 new file mode 100644 index 0000000000..81c8436eb0 --- /dev/null +++ b/Task/Averages-Mean-time-of-day/Oberon-2/averages-mean-time-of-day.oberon-2 @@ -0,0 +1,70 @@ +MODULE AvgTimeOfDay; +IMPORT + M := LRealMath, + T := NPCT:Tools, + Out := NPCT:Console; + +CONST + secsDay = 86400; + secsHour = 3600; + secsMin = 60; + + toRads = M.pi / 180; + +VAR + h,m,s: LONGINT; + data: ARRAY 4 OF LONGREAL; + +PROCEDURE TimeToDeg(time: STRING): LONGREAL; +VAR + parts: ARRAY 3 OF STRING; + h,m,s: LONGREAL; +BEGIN + T.Split(time,':',parts); + h := T.StrToInt(parts[0]); + m := T.StrToInt(parts[1]); + s := T.StrToInt(parts[2]); + RETURN (h * secsHour + m * secsMin + s) * 360 / secsDay; +END TimeToDeg; + +PROCEDURE DegToTime(d: LONGREAL; VAR h,m,s: LONGINT); +VAR + ds: LONGREAL; + PROCEDURE Mod(x,y: LONGREAL): LONGREAL; + VAR + c: LONGREAL; + BEGIN + c := ENTIER(x / y); + RETURN x - c * y + END Mod; +BEGIN + ds := Mod(d,360.0) * secsDay / 360.0; + h := ENTIER(ds / secsHour); + m := ENTIER(Mod(ds,secsHour) / secsMin); + s := ENTIER(Mod(ds,secsMin)); +END DegToTime; + +PROCEDURE Mean(g: ARRAY OF LONGREAL): LONGREAL; +VAR + i,l: LONGINT; + sumSin, sumCos: LONGREAL; +BEGIN + i := 0;l := LEN(g);sumSin := 0.0;sumCos := 0.0; + WHILE i < l DO + sumSin := sumSin + M.sin(g[i] * toRads); + sumCos := sumCos + M.cos(g[i] * toRads); + INC(i) + END; + RETURN M.arctan2(sumSin / l,sumCos / l) * 180 / M.pi; +END Mean; + +BEGIN + data[0] := TimeToDeg("23:00:17"); + data[1] := TimeToDeg("23:40:20"); + data[2] := TimeToDeg("00:12:45"); + data[3] := TimeToDeg("00:17:19"); + + DegToTime(Mean(data),h,m,s); + Out.String(":> ");Out.Int(h,0);Out.Char(':');Out.Int(m,0);Out.Char(':');Out.Int(s,0);Out.Ln + +END AvgTimeOfDay. diff --git a/Task/Averages-Mean-time-of-day/PHP/averages-mean-time-of-day.php b/Task/Averages-Mean-time-of-day/PHP/averages-mean-time-of-day.php new file mode 100644 index 0000000000..6314f5adbd --- /dev/null +++ b/Task/Averages-Mean-time-of-day/PHP/averages-mean-time-of-day.php @@ -0,0 +1,37 @@ + diff --git a/Task/Averages-Mean-time-of-day/Perl-6/averages-mean-time-of-day.pl6 b/Task/Averages-Mean-time-of-day/Perl-6/averages-mean-time-of-day.pl6 index 5416be607b..e60cf3976a 100644 --- a/Task/Averages-Mean-time-of-day/Perl-6/averages-mean-time-of-day.pl6 +++ b/Task/Averages-Mean-time-of-day/Perl-6/averages-mean-time-of-day.pl6 @@ -1,7 +1,7 @@ -sub tod2rad($_) { [+](.comb(/\d+/) Z* 3600,60,1) * pi / 43200 } +sub tod2rad($_) { [+](.comb(/\d+/) Z* 3600,60,1) * tau / 86400 } sub rad2tod ($r) { - my $x = $r * 43200 / pi; + my $x = $r * 86400 / tau; (($x xx 3 Z/ 3600,60,1) Z% 24,60,60).fmt('%02d',':'); } @@ -9,5 +9,6 @@ sub phase ($c) { $c.polar[1] } sub mean-time (@t) { rad2tod phase [+] map { cis tod2rad $_ }, @t } -say mean-time($_).fmt("%s is the mean time of "), $_ for - ["23:00:17", "23:40:20", "00:12:45", "00:17:19"]; +my @times = ["23:00:17", "23:40:20", "00:12:45", "00:17:19"]; + +say "{ mean-time(@times) } is the mean time of @times[]"; diff --git a/Task/Averages-Mean-time-of-day/PowerShell/averages-mean-time-of-day-1.psh b/Task/Averages-Mean-time-of-day/PowerShell/averages-mean-time-of-day-1.psh new file mode 100644 index 0000000000..778a83e523 --- /dev/null +++ b/Task/Averages-Mean-time-of-day/PowerShell/averages-mean-time-of-day-1.psh @@ -0,0 +1,66 @@ +function Get-MeanTimeOfDay +{ + [CmdletBinding()] + [OutputType([timespan])] + Param + ( + [Parameter(Mandatory=$true, + ValueFromPipeline=$true, + ValueFromPipelineByPropertyName=$true)] + [ValidatePattern("(?:2[0-3]|[01]?[0-9])[:.][0-5]?[0-9][:.][0-5]?[0-9]")] + [string[]] + $Time + ) + + Begin + { + [double[]]$angles = @() + + function ConvertFrom-Time ([timespan]$Time) + { + [double]((360 * $Time.Hours / 24) + (360 * $Time.Minutes / (24 * 60)) + (360 * $Time.Seconds / (24 * 3600))) + } + + function ConvertTo-Time ([double]$Angle) + { + $t = New-TimeSpan -Hours ([int](24 * 60 * 60 * $Angle / 360) / 3600) ` + -Minutes (([int](24 * 60 * 60 * $Angle / 360) % 3600 - [int](24 * 60 * 60 * $Angle / 360) % 60) / 60) ` + -Seconds ([int]((24 * 60 * 60 * $Angle / 360) % 60)) + + if ($t.Days -gt 0) + { + return ($t - (New-TimeSpan -Hours 1)) + } + + $t + } + + function Get-MeanAngle ([double[]]$Angles) + { + [double]$x,$y = 0 + + for ($i = 0; $i -lt $Angles.Count; $i++) + { + $x += [Math]::Cos($Angles[$i] * [Math]::PI / 180) + $y += [Math]::Sin($Angles[$i] * [Math]::PI / 180) + } + + $result = [Math]::Atan2(($y / $Angles.Count), ($x / $Angles.Count)) * 180 / [Math]::PI + + if ($result -lt 0) + { + return ($result + 360) + } + + $result + } + } + Process + { + $angles += ConvertFrom-Time $_ + } + End + { + ConvertTo-Time (Get-MeanAngle $angles) + } +} diff --git a/Task/Averages-Mean-time-of-day/PowerShell/averages-mean-time-of-day-2.psh b/Task/Averages-Mean-time-of-day/PowerShell/averages-mean-time-of-day-2.psh new file mode 100644 index 0000000000..450ffa6166 --- /dev/null +++ b/Task/Averages-Mean-time-of-day/PowerShell/averages-mean-time-of-day-2.psh @@ -0,0 +1,2 @@ +[timespan]$meanTimeOfDay = "23:00:17","23:40:20","00:12:45","00:17:19" | Get-MeanTimeOfDay +"Mean time is {0}" -f (Get-Date $meanTimeOfDay.ToString()).ToString("hh:mm:ss tt") diff --git a/Task/Averages-Mean-time-of-day/Run-BASIC/averages-mean-time-of-day.run b/Task/Averages-Mean-time-of-day/Run-BASIC/averages-mean-time-of-day.run new file mode 100644 index 0000000000..8aea226353 --- /dev/null +++ b/Task/Averages-Mean-time-of-day/Run-BASIC/averages-mean-time-of-day.run @@ -0,0 +1,44 @@ +global pi +pi = acs(-1) + +Print "Average of:" +for i = 1 to 4 + read t$ + print t$ + a = time2angle(t$) + ss = ss+sin(a) + sc = sc+cos(a) +next +a = atan2(ss,sc) +if a < 0 then a = a + 2 * pi +print "is ";angle2time$(a) +end +data "23:00:17", "23:40:20", "00:12:45", "00:17:19" + +function nn$(n) + nn$ = right$("0";n, 2) +end function + +function angle2time$(a) + a = int(a / 2 / pi * 24 * 60 * 60) + ss = a mod 60 + a = int(a / 60) + mm=a mod 60 + hh=int(a/60) + angle2time$=nn$(hh);":";nn$(mm);":";nn$(ss) +end function + +function time2angle(time$) + hh=val(word$(time$,1,":")) + mm=val(word$(time$,2,":")) + ss=val(word$(time$,3,":")) + time2angle=2*pi*(60*(60*hh+mm)+ss)/24/60/60 +end function + +function atan2(y, x) + if y <> 0 then + atan2 = (2 * (atn((sqr((x * x) + (y * y)) - x)/ y))) + else + atan2 = (y=0)*(x<0)*pi + end if +End Function diff --git a/Task/Averages-Median/00DESCRIPTION b/Task/Averages-Median/00DESCRIPTION index c4639f7b31..60c9239c48 100644 --- a/Task/Averages-Median/00DESCRIPTION +++ b/Task/Averages-Median/00DESCRIPTION @@ -1,5 +1,15 @@ -Write a program to find the [[wp:Median|median]] value of a vector of floating-point numbers. The program need not handle the case where the vector is empty, but ''must'' handle the case where there are an even number of elements. In that case, return the average of the two middle values. +{{task heading}} -There are several approaches to this. One is to sort the elements, and then pick the one(s) in the middle. Sorting would take at least O(''n'' log''n''). Another would be to build a priority queue from the elements, and then extract half of the elements to get to the middle one(s). This would also take O(''n'' log''n''). The best solution is to use the [[wp:Selection algorithm|selection algorithm]] to find the median in O(''n'') time. +Write a program to find the   [[wp:Median|median]]   value of a vector of floating-point numbers. -See also: [[Mean]], [[Mode]] +The program need not handle the case where the vector is empty, but ''must'' handle the case where there are an even number of elements.   In that case, return the average of the two middle values. + +There are several approaches to this.   One is to sort the elements, and then pick the element(s) in the middle. + +Sorting would take at least   O(''n'' log''n'').   Another approach would be to build a priority queue from the elements, and then extract half of the elements to get to the middle element(s).   This would also take   O(''n'' log''n'').   The best solution is to use the   [[wp:Selection algorithm|selection algorithm]]   to find the median in   O(''n'')   time. + +{{task heading|See also}} + +{{Related tasks/Statistical measures}} + +
diff --git a/Task/Averages-Median/AppleScript/averages-median-1.applescript b/Task/Averages-Median/AppleScript/averages-median-1.applescript new file mode 100644 index 0000000000..5ba862cbd5 --- /dev/null +++ b/Task/Averages-Median/AppleScript/averages-median-1.applescript @@ -0,0 +1,44 @@ +set alist to {1, 2, 3, 4, 5, 6, 7, 8} +set med to medi(alist) + +on medi(alist) + + set temp to {} + set lcount to count every item of alist + if lcount is equal to 2 then + return (item (random number from 1 to 2) of alist) + else if lcount is less than 2 then + return item 1 of alist + else --if lcount is greater than 2 + set min to findmin(alist) + set max to findmax(alist) + repeat with x from 1 to lcount + if x is not equal to min and x is not equal to max then set end of temp to item x of alist + end repeat + set med to medi(temp) + end if + return med + +end medi + +on findmin(alist) + + set min to 1 + set alength to count every item of alist + repeat with x from 1 to alength + if item x of alist is less than item min of alist then set min to x + end repeat + return min + +end findmin + +on findmax(alist) + + set max to 1 + set alength to count every item of alist + repeat with x from 1 to alength + if item x of alist is greater than item max of alist then set max to x + end repeat + return max + +end findmax diff --git a/Task/Averages-Median/AppleScript/averages-median-2.applescript b/Task/Averages-Median/AppleScript/averages-median-2.applescript new file mode 100644 index 0000000000..ddb5a66eb7 --- /dev/null +++ b/Task/Averages-Median/AppleScript/averages-median-2.applescript @@ -0,0 +1,107 @@ +-- median :: [Num] -> Num +on median(xs) + -- nth :: [Num] -> Int -> Maybe Num + script nth + on lambda(xxs, n) + if length of xxs > 0 then + set {x, xs} to uncons(xxs) + + script belowX + on lambda(y) + y < x + end lambda + end script + + set {ys, zs} to partition(belowX, xs) + set k to length of ys + if k = n then + x + else + if k > n then + lambda(ys, n) + else + lambda(zs, n - k - 1) + end if + end if + else + missing value + end if + end lambda + end script + + set n to length of xs + if n > 0 then + tell nth + if n mod 2 = 0 then + (lambda(xs, n div 2) + lambda(xs, (n div 2) - 1)) / 2 + else + lambda(xs, n div 2) + end if + end tell + else + missing value + end if +end median + + +-- TEST +on run + + map(median, [¬ + [], ¬ + [5, 3, 4], ¬ + [5, 4, 2, 3], ¬ + [3, 4, 1, -8.4, 7.2, 4, 1, 1.2]]) + + --> {missing value, 4, 3.5, 2.1} +end run + + + +-- GENERIC FUNCTIONS + +-- partition :: predicate -> List -> (Matches, nonMatches) +-- partition :: (a -> Bool) -> [a] -> ([a], [a]) +on partition(f, xs) + tell mReturn(f) + set lst to {{}, {}} + repeat with x in xs + set v to contents of x + set end of item ((lambda(v) as integer) + 1) of lst to v + end repeat + end tell + {item 2 of lst, item 1 of lst} +end partition + +-- uncons :: [a] -> Maybe (a, [a]) +on uncons(xs) + if length of xs > 0 then + {item 1 of xs, rest of xs} + else + missing value + end if +end uncons + +-- 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 + +-- 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 diff --git a/Task/Averages-Median/AppleScript/averages-median-3.applescript b/Task/Averages-Median/AppleScript/averages-median-3.applescript new file mode 100644 index 0000000000..aa24ec99b8 --- /dev/null +++ b/Task/Averages-Median/AppleScript/averages-median-3.applescript @@ -0,0 +1 @@ +{missing value, 4, 3.5, 2.1} diff --git a/Task/Averages-Median/AppleScript/averages-median.applescript b/Task/Averages-Median/AppleScript/averages-median.applescript deleted file mode 100644 index 94dd4eefee..0000000000 --- a/Task/Averages-Median/AppleScript/averages-median.applescript +++ /dev/null @@ -1,44 +0,0 @@ -set alist to {1,2,3,4,5,6,7,8} -set med to medi(alist) - -on medi(alist) - - set temp to {} - set lcount to count every item of alist - if lcount is equal to 2 then - return (item (random number from 1 to 2) of alist) - else if lcount is less than 2 then - return item 1 of alist - else --if lcount is greater than 2 - set min to findmin(alist) - set max to findmax(alist) - repeat with x from 1 to lcount - if x is not equal to min and x is not equal to max then set end of temp to item x of alist - end repeat - set med to medi(temp) - end if - return med - -end medi - -on findmin(alist) - - set min to 1 - set alength to count every item of alist - repeat with x from 1 to alength - if item x of alist is less than item min of alist then set min to x - end repeat - return min - -end findmin - -on findmax(alist) - - set max to 1 - set alength to count every item of alist - repeat with x from 1 to alength - if item x of alist is greater than item max of alist then set max to x - end repeat - return max - -end findmax diff --git a/Task/Averages-Median/Elixir/averages-median.elixir b/Task/Averages-Median/Elixir/averages-median.elixir index 1576442544..a4c8df12f2 100644 --- a/Task/Averages-Median/Elixir/averages-median.elixir +++ b/Task/Averages-Median/Elixir/averages-median.elixir @@ -1,11 +1,11 @@ defmodule Average do def median([]), do: nil def median(list) do - len = Enum.count(list) + len = length(list) sorted = Enum.sort(list) mid = div(len, 2) - rem = rem(len, 2) - (Enum.at(sorted, mid) + Enum.at(sorted, mid + rem - 1)) / 2 + if rem(len,2) == 0, do: (Enum.at(sorted, mid-1) + Enum.at(sorted, mid)) / 2, + else: Enum.at(sorted, mid) end end diff --git a/Task/Averages-Median/Haskell/averages-median-1.hs b/Task/Averages-Median/Haskell/averages-median-1.hs index cdd2d127e4..26464ab25d 100644 --- a/Task/Averages-Median/Haskell/averages-median-1.hs +++ b/Task/Averages-Median/Haskell/averages-median-1.hs @@ -1,7 +1,11 @@ -median xs | null xs = Nothing - | odd len = Just $ xs !! mid - | even len = Just $ meanMedian - where len = length xs - mid = len `div` 2 - meanMedian = (xs !! mid + xs !! (mid+1)) / 2 -median :: Fractional a => [a] -> Maybe a +nth (x:xs) n + | k == n = x + | k > n = nth ys n + | otherwise = nth zs $ n - k - 1 + where (ys, zs) = partition (< x) xs + k = length ys + +median xs | even n = (nth xs (div n 2) + nth xs (div n 2 - 1)) / 2.0 + | otherwise = nth xs (div n 2) + where + n = length xs diff --git a/Task/Averages-Median/JavaScript/averages-median.js b/Task/Averages-Median/JavaScript/averages-median-1.js similarity index 100% rename from Task/Averages-Median/JavaScript/averages-median.js rename to Task/Averages-Median/JavaScript/averages-median-1.js diff --git a/Task/Averages-Median/JavaScript/averages-median-2.js b/Task/Averages-Median/JavaScript/averages-median-2.js new file mode 100644 index 0000000000..e067660e0e --- /dev/null +++ b/Task/Averages-Median/JavaScript/averages-median-2.js @@ -0,0 +1,52 @@ +(() => { + 'use strict'; + + // median :: [Num] -> Num + function median(xs) { + // nth :: [Num] -> Int -> Maybe Num + let nth = (xxs, n) => { + if (xxs.length > 0) { + let [x, xs] = uncons(xxs), + [ys, zs] = partition(y => y < x, xs), + k = ys.length; + + return k === n ? x : ( + k > n ? nth(ys, n) : nth(zs, n - k - 1) + ); + } else return undefined; + }, + n = xs.length; + + return even(n) ? ( + (nth(xs, div(n, 2)) + nth(xs, div(n, 2) - 1)) / 2 + ) : nth(xs, div(n, 2)); + } + + + + // GENERIC + + // partition :: (a -> Bool) -> [a] -> ([a], [a]) + let partition = (p, xs) => + xs.reduce((a, x) => + p(x) ? [a[0].concat(x), a[1]] : [a[0], a[1].concat(x)], [ + [], + [] + ]), + + // uncons :: [a] -> Maybe (a, [a]) + uncons = xs => xs.length ? [xs[0], xs.slice(1)] : undefined, + + // even :: Integral a => a -> Bool + even = n => n % 2 === 0, + + // div :: Num -> Num -> Int + div = (x, y) => Math.floor(x / y); + + return [ + [], + [5, 3, 4], + [5, 4, 2, 3], + [3, 4, 1, -8.4, 7.2, 4, 1, 1.2] + ].map(median); +})(); diff --git a/Task/Averages-Median/JavaScript/averages-median-3.js b/Task/Averages-Median/JavaScript/averages-median-3.js new file mode 100644 index 0000000000..d618fcea6c --- /dev/null +++ b/Task/Averages-Median/JavaScript/averages-median-3.js @@ -0,0 +1,6 @@ +[ + null, + 4, + 3.5, + 2.1 +] diff --git a/Task/Averages-Median/K/averages-median.k b/Task/Averages-Median/K/averages-median.k new file mode 100644 index 0000000000..9d81e96661 --- /dev/null +++ b/Task/Averages-Median/K/averages-median.k @@ -0,0 +1,8 @@ + med:{a:x@) = l.sorted().let { (it[it.size / 2] + it[(it.size - 1) / 2]) / 2 } + +median(listOf(5.0, 3.0, 4.0)).let { println(it) } // 4 +median(listOf(5.0, 4.0, 2.0, 3.0)).let { println(it) } // 3.5 +median(listOf(3.0, 4.0, 1.0, -8.4, 7.2, 4.0, 1.0, 1.2)).let { println(it) } // 2.1 diff --git a/Task/Averages-Median/Perl-6/averages-median-1.pl6 b/Task/Averages-Median/Perl-6/averages-median-1.pl6 index 91de232a45..312f4c551e 100644 --- a/Task/Averages-Median/Perl-6/averages-median-1.pl6 +++ b/Task/Averages-Median/Perl-6/averages-median-1.pl6 @@ -1,4 +1,4 @@ sub median { my @a = sort @_; - return (@a[@a.end / 2] + @a[@a / 2]) / 2; + return (@a[(*-1) div 2] + @a[* div 2]) / 2; } diff --git a/Task/Averages-Median/Perl-6/averages-median-2.pl6 b/Task/Averages-Median/Perl-6/averages-median-2.pl6 index a58faedc98..abc50a57d4 100644 --- a/Task/Averages-Median/Perl-6/averages-median-2.pl6 +++ b/Task/Averages-Median/Perl-6/averages-median-2.pl6 @@ -1 +1 @@ -sub median { 2 R/ [+] @_.sort[@_.end / 2, @_ / 2] } +sub median { @_.sort[(*-1)/2, */2].sum / 2 } diff --git a/Task/Averages-Median/PowerShell/averages-median-1.psh b/Task/Averages-Median/PowerShell/averages-median-1.psh new file mode 100644 index 0000000000..10f1443537 --- /dev/null +++ b/Task/Averages-Median/PowerShell/averages-median-1.psh @@ -0,0 +1,69 @@ +function Measure-Data +{ + [CmdletBinding()] + [OutputType([PSCustomObject])] + Param + ( + [Parameter(Mandatory=$true, + Position=0)] + [double[]] + $Data + ) + + Begin + { + function Get-Mode ([double[]]$Data) + { + if ($Data.Count -gt ($Data | Select-Object -Unique).Count) + { + $groups = $Data | Group-Object | Sort-Object -Property Count -Descending + + return ($groups | Where-Object {[double]$_.Count -eq [double]$groups[0].Count}).Name | ForEach-Object {[double]$_} + } + else + { + return $null + } + } + + function Get-StandardDeviation ([double[]]$Data) + { + $variance = 0 + $average = $Data | Measure-Object -Average | Select-Object -Property Count, Average + + foreach ($number in $Data) + { + $variance += [Math]::Pow(($number - $average.Average),2) + } + + return [Math]::Sqrt($variance / ($average.Count-1)) + } + + function Get-Median ([double[]]$Data) + { + if ($Data.Count % 2) + { + return $Data[[Math]::Floor($Data.Count/2)] + } + else + { + return ($Data[$Data.Count/2], $Data[$Data.Count/2-1] | Measure-Object -Average).Average + } + } + } + Process + { + $Data = $Data | Sort-Object + + $Data | Measure-Object -Maximum -Minimum -Sum -Average | + Select-Object -Property Count, + Sum, + Minimum, + Maximum, + @{Name='Range'; Expression={$_.Maximum - $_.Minimum}}, + @{Name='Mean' ; Expression={$_.Average}} | + Add-Member -MemberType NoteProperty -Name Median -Value (Get-Median $Data) -PassThru | + Add-Member -MemberType NoteProperty -Name StandardDeviation -Value (Get-StandardDeviation $Data) -PassThru | + Add-Member -MemberType NoteProperty -Name Mode -Value (Get-Mode $Data) -PassThru + } +} diff --git a/Task/Averages-Median/PowerShell/averages-median-2.psh b/Task/Averages-Median/PowerShell/averages-median-2.psh new file mode 100644 index 0000000000..96c1411d1a --- /dev/null +++ b/Task/Averages-Median/PowerShell/averages-median-2.psh @@ -0,0 +1,2 @@ +$statistics = Measure-Data 4, 5, 6, 7, 7, 7, 8, 1, 1, 1, 2, 3 +$statistics diff --git a/Task/Averages-Median/PowerShell/averages-median-3.psh b/Task/Averages-Median/PowerShell/averages-median-3.psh new file mode 100644 index 0000000000..2157fc0087 --- /dev/null +++ b/Task/Averages-Median/PowerShell/averages-median-3.psh @@ -0,0 +1 @@ +$statistics.Median diff --git a/Task/Averages-Median/REXX/averages-median.rexx b/Task/Averages-Median/REXX/averages-median.rexx index 05751387c6..a706567eb3 100644 --- a/Task/Averages-Median/REXX/averages-median.rexx +++ b/Task/Averages-Median/REXX/averages-median.rexx @@ -1,32 +1,25 @@ -/*REXX program finds the median of a vector (and displays vector,median)*/ -/*────────vector────────── ───show vector─── ───────show result─────────*/ -v='1 9 2 4' ; say 'vector=' v; say 'median=' median(v); say -v='3 1 4 1 5 9 7 6' ; say 'vector= 'v; say 'median=' median(v); say -v='3 4 1 -8.4 7.2 4 1 1.2'; say 'vector= 'v; say 'median=' median(v); say -v='-1.2345678e99 2.3e+700'; say 'vector= 'v; say 'median=' median(v); say - -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────MEDIAN subroutine───────────────────*/ -median: procedure; parse arg x /*obtain the X argument. */ -call makeArray x /*make into scalar array (faster)*/ -call Esort /*(ESORT is an overkill for this)*/ -m=@.0%2 /* % is REXX integer division. */ -n=m+1 /*N: the next element after M. */ -if @.0//2==1 then return @.n /*(odd?) // is REXX remainder.*/ - return (@.m+@.n)/2 /*process an even─element vector.*/ -/*──────────────────────────────────MAKEARRAY subroutine────────────────*/ -makeArray: procedure expose @.; parse arg v; @.0=words(v) /*make array*/ - do j=1 for @.0; @.j=word(v,j); end /*j*/ -return -/*──────────────────────────────────ESORT subroutine────────────────────*/ -Esort: procedure expose @.; h=@.0 /*@.0 = # entries. */ - do while h>1; h=h%2 /*cut entries by ½. */ - do i=1 for @.0-h; j=i; k=h+i /*sort lower section*/ - do while @.k<@.j /* [↓] swap while <*/ - parse value @.j @.k with @.k @.j /*swap two values. */ - if h>=j then leave /*leave if h≥j */ - j=j-h; k=k-h /*diminish J and K. */ - end /*while @.k<@.j*/ - end /*i*/ - end /*while h>l*/ -return /*exchange sort is finished.*/ +/*REXX program finds the median of a vector (and displays the vector and median).*/ +/* ══════════vector════════════ ══show vector═══ ════════show result═══════════ */ + v= '1 9 2 4 '; say 'vector:' v; say 'median──────►' median(v); say + v= '3 1 4 1 5 9 7 6 '; say 'vector:' v; say 'median──────►' median(v); say + v= '3 4 1 -8.4 7.2 4 1 1.2'; say 'vector:' v; say 'median──────►' median(v); say + v= '-1.2345678e99 2.3e700'; say 'vector:' v; say 'median──────►' median(v); say +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +eSORT: procedure expose @. #; parse arg $; #=words($) /*$: is the vector. */ + do g=1 for #; @.g=word($,g); end /*g*/ /*convert list──►array*/ + h=# /*#: number elements.*/ + do while h>1; h=h % 2 /*cut entries by half.*/ + do i=1 for #-h; j=i; k=h+i /*sort lower section. */ + do while @.k<@.j; parse value @.j @.k with @.k @.j /*swap.*/ + if h>=j then leave; j=j-h; k=k-h /*diminish J and K.*/ + end /*while @.k<@.j*/ + end /*i*/ + end /*while h>l*/ /*end of exchange sort*/ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +median: procedure; call eSORT arg(1) /*obtain the elements of the vector.*/ + m=# % 2 /* % is REXX's integer division.*/ + n=m+1 /*N: the next element after M. */ + if #//2 then return @.n /*(odd?) // is REXX's ÷ remainder.*/ + return (@.m + @.n) / 2 /*process an even─element vector. */ diff --git a/Task/Averages-Median/Run-BASIC/averages-median.run b/Task/Averages-Median/Run-BASIC/averages-median.run new file mode 100644 index 0000000000..8fb0494366 --- /dev/null +++ b/Task/Averages-Median/Run-BASIC/averages-median.run @@ -0,0 +1,30 @@ +sqliteconnect #mem, ":memory:" +mem$ = "CREATE TABLE med (x float)" +#mem execute(mem$) + +a$ ="4.1,5.6,7.2,1.7,9.3,4.4,3.2" :gosub [median] +a$ ="4.1,7.2,1.7,9.3,4.4,3.2" :gosub [median] +a$ ="4.1,4,1.2,6.235,7868.33" :gosub [median] +a$ ="1,5,3,2,4" :gosub [median] +a$ ="1,5,3,6,4,2" :gosub [median] +a$ ="4.4,2.3,-1.7,7.5,6.6,0.0,1.9,8.2,9.3,4.5" :gosub [median]' +end +[median] +#mem execute("DELETE FROM med") +for i = 1 to 100 + v$ = word$( a$, i, ",") + if v$ = "" then exit for + mem$ = "INSERT INTO med values(";v$;")" + #mem execute(mem$) +next i +mem$ = "SELECT AVG(x) as median FROM (SELECT x FROM med +ORDER BY x LIMIT 2 - (SELECT COUNT(*) FROM med) % 2 +OFFSET (SELECT (COUNT(*) - 1) / 2 +FROM med))" + +#mem execute(mem$) + #row = #mem #nextrow() + median = #row median() +print " Median :";median;chr$(9);" Values:";a$ + +RETURN diff --git a/Task/Averages-Median/Rust/averages-median.rust b/Task/Averages-Median/Rust/averages-median.rust index c6b1b27739..90a99e90a9 100644 --- a/Task/Averages-Median/Rust/averages-median.rust +++ b/Task/Averages-Median/Rust/averages-median.rust @@ -3,7 +3,7 @@ fn median(mut xs: Vec) -> f64 { xs.sort_by(|x,y| x.partial_cmp(y).unwrap() ); let n = xs.len(); if n % 2 == 0 { - (xs[n/2] + xs[n/2 + 1]) / 2.0 + (xs[n/2] + xs[n/2 - 1]) / 2.0 } else { xs[n/2] } diff --git a/Task/Averages-Mode/00DESCRIPTION b/Task/Averages-Mode/00DESCRIPTION index 79b7f33e89..7f40faeb30 100644 --- a/Task/Averages-Mode/00DESCRIPTION +++ b/Task/Averages-Mode/00DESCRIPTION @@ -1,5 +1,13 @@ -Write a program to find the [[wp:Mode (statistics)|mode]] value of a collection. The case where the collection is empty may be ignored. Care must be taken to handle the case where the mode is non-unique. +{{task heading}} + +Write a program to find the [[wp:Mode (statistics)|mode]] value of a collection. + +The case where the collection is empty may be ignored. Care must be taken to handle the case where the mode is non-unique. If it is not appropriate or possible to support a general collection, use a vector (array), if possible. If it is not appropriate or possible to support an unspecified value type, use integers. -See also: [[Averages/Arithmetic mean|Mean]], [[Averages/Median|Median]] +{{task heading|See also}} + +{{Related tasks/Statistical measures}} + +
diff --git a/Task/Averages-Mode/APL/averages-mode.apl b/Task/Averages-Mode/APL/averages-mode.apl new file mode 100644 index 0000000000..e509de077a --- /dev/null +++ b/Task/Averages-Mode/APL/averages-mode.apl @@ -0,0 +1 @@ +mode←{{s←⌈/⍵[;2]⋄⊃¨(↓⍵)∩{⍵,s}¨⍵[;1]}{⍺,≢⍵}⌸⍵} diff --git a/Task/Averages-Mode/Lua/averages-mode.lua b/Task/Averages-Mode/Lua/averages-mode.lua index 2f09196d49..d703750457 100644 --- a/Task/Averages-Mode/Lua/averages-mode.lua +++ b/Task/Averages-Mode/Lua/averages-mode.lua @@ -1,30 +1,27 @@ -function mode (numlist) - if type(numlist) ~= 'table' then return numlist end - local sets = {} - local mode - local modeValue = 0 - table.foreach(numlist,function(i,v) if sets[v] then sets[v] = sets[v] + 1 else sets[v] = 1 end end) - for i,v in next,sets do - if v > modeValue then - modeValue = v - mode = i - else - if v == modeValue then - if type(mode) == 'table' then - table.insert(mode,i) - else - mode = {mode,i} - end - end - end - end - return mode +function mode(tbl) -- returns table of modes and count + assert(type(tbl) == 'table') + local counts = { } + for _, val in pairs(tbl) do + -- see http://lua-users.org/wiki/TernaryOperator + counts[val] = counts[val] and counts[val] + 1 or 1 + end + local modes = { } + local modeCount = 0 + for key, val in pairs(counts) do + if val > modeCount then + modeCount = val + modes = {key} + elseif val == modeCount then + table.insert(modes, key) + end + end + return modes, modeCount end -result = mode({1,3,6,6,6,6,7,7,12,12,17}) -print(result) -result = mode({1, 1, 2, 4, 4}) -if type(result) == 'table' then - for i,v in next,result do io.write(v..' ') end - print () -end +modes, count = mode({1,3,6,6,6,6,7,7,12,12,17}) +for _, val in pairs(modes) do io.write(val..' ') end +print("occur(s) ", count, " times") + +modes, count = mode({'a', 'a', 'b', 'd', 'd'}) +for _, val in pairs(modes) do io.write(val..' ') end +print("occur(s) ", count, " times") diff --git a/Task/Averages-Mode/Oberon-2/averages-mode.oberon-2 b/Task/Averages-Mode/Oberon-2/averages-mode.oberon-2 new file mode 100644 index 0000000000..86449c1a90 --- /dev/null +++ b/Task/Averages-Mode/Oberon-2/averages-mode.oberon-2 @@ -0,0 +1,76 @@ +MODULE Mode; +IMPORT + Object:Boxed, + ADT:Dictionary, + ADT:LinkedList, + Out := NPCT:Console; + +TYPE + Key = Boxed.LongInt; + Val = Boxed.LongInt; + + +VAR + x: ARRAY 11 OF LONGINT; + y: ARRAY 5 OF LONGINT; + z: ARRAY 8 OF LONGINT; + + PROCEDURE Show(ll: LinkedList.LinkedList(Key)); + VAR + iter: LinkedList.Iterator(Key); + i: LONGINT; + k: Key; + BEGIN + iter := ll.GetIterator(NIL); + FOR i := 0 TO ll.Size() - 1 DO; + k := iter.Next(); + Out.Int(k.value,0);Out.Ln; + END; + END Show; + + PROCEDURE Mode(x: ARRAY OF LONGINT): LinkedList.LinkedList(Key); + VAR + d: Dictionary.Dictionary(Key,Val); + i: LONGINT; + k: Key; v: Val; + iter: Dictionary.IterKeys(Key,Val); + resp: LinkedList.LinkedList(Key); + max: Boxed.LongInt; + BEGIN + d := NEW(Dictionary.Dictionary(Key,Val)); + FOR i := 0 TO LEN(x) - 1 DO + k := NEW(Key,x[i]); + IF d.Lookup(k,v) THEN + d.Set(k,NEW(Val,v.value + 1)); + ELSE + d.Set(k,NEW(Val,1)) + END + END; + + max := NEW(Boxed.LongInt,0); + resp := NEW(LinkedList.LinkedList(Key)); + iter := d.IterKeys(); + WHILE (iter.Next(k)) DO + v := d.Get(k); + IF v.Cmp(max) > 0 THEN + resp.Clear(); + resp.Append(k);max := v + ELSIF v.Cmp(max) = 0 THEN + resp.Append(k);max := v + END + END; + + RETURN resp + + END Mode; + +BEGIN + x[0] := 1; x[1] := 3; x[2] := 6; x[3] := 6; + x[4] := 6; x[5] := 6; x[6] := 7; x[7] := 7; + x[8] := 12; x[9] := 12; x[10] := 17; + Show(Mode(x));Out.Ln; + y[0] := 1; y[1] := 2; y[2] := 4; y[3] := 4; y[4] := 1; + Show(Mode(y));Out.Ln; + z[0] := 1; z[1] := 2; z[2] := 4; z[3] := 4; z[4] := 1; z[5] := 5; z[6] := 5; z[7] := 5; + Show(Mode(z));Out.Ln; +END Mode. diff --git a/Task/Averages-Mode/Perl-6/averages-mode-1.pl6 b/Task/Averages-Mode/Perl-6/averages-mode-1.pl6 new file mode 100644 index 0000000000..719fb56dab --- /dev/null +++ b/Task/Averages-Mode/Perl-6/averages-mode-1.pl6 @@ -0,0 +1,5 @@ +sub mode (*@a) { + my %counts := @a.Bag; + my $max = %counts.values.max; + return |%counts.grep(*.value == $max).map(*.key); +} diff --git a/Task/Averages-Mode/Perl-6/averages-mode-2.pl6 b/Task/Averages-Mode/Perl-6/averages-mode-2.pl6 new file mode 100644 index 0000000000..7dfa7161fa --- /dev/null +++ b/Task/Averages-Mode/Perl-6/averages-mode-2.pl6 @@ -0,0 +1,2 @@ +say mode [1, 3, 6, 6, 6, 6, 7, 7, 12, 12, 17]; +say mode [1, 1, 2, 4, 4]; diff --git a/Task/Averages-Mode/Perl-6/averages-mode-3.pl6 b/Task/Averages-Mode/Perl-6/averages-mode-3.pl6 new file mode 100644 index 0000000000..580ff72db4 --- /dev/null +++ b/Task/Averages-Mode/Perl-6/averages-mode-3.pl6 @@ -0,0 +1,8 @@ +sub mode (*@a) {= + return |(@a + .Bag # count elements + .classify(*.value) # group elements with the same count + .max(*.key) # get group with the highest count + .value.map(*.key); # get elements in the group + ); +} diff --git a/Task/Averages-Mode/Perl-6/averages-mode.pl6 b/Task/Averages-Mode/Perl-6/averages-mode.pl6 deleted file mode 100644 index 75beb3264a..0000000000 --- a/Task/Averages-Mode/Perl-6/averages-mode.pl6 +++ /dev/null @@ -1,6 +0,0 @@ -sub mode (@a) { - my %counts; - ++%counts{$_} for @a; - my $max = [max] values %counts; - return map { .key }, grep { .value == $max }, %counts.pairs; -} diff --git a/Task/Averages-Mode/REXX/averages-mode-1.rexx b/Task/Averages-Mode/REXX/averages-mode-1.rexx index a21c3e8d56..7d2b5dfc84 100644 --- a/Task/Averages-Mode/REXX/averages-mode-1.rexx +++ b/Task/Averages-Mode/REXX/averages-mode-1.rexx @@ -1,29 +1,26 @@ -/*REXX program finds the mode (most occurring element) of a vector. */ -/*════════vector══════════ ═══show vector═══ ════show result══════ */ -v= 1 8 6 0 1 9 4 6 1 9 9 9 ; say 'vector='v; say 'mode='mode(v); say -v= 1 2 3 4 5 6 7 8 9 11 10 ; say 'vector='v; say 'mode='mode(v); say -v= 8 8 8 2 2 2 ; say 'vector='v; say 'mode='mode(v); say -v='cat kat Cat emu emu Kat' ; say 'vector='v; say 'mode='mode(v); say -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────ESORT subroutine────────────────────*/ -Esort: procedure expose @.; h=@.0 /* [↓] exchange sort. */ - do while h>1; h=h%2 /*% is integer divide.*/ - do i=1 for @.0-h; j=i; k=h+i /* [↓] perform exchange*/ - do while @.k<@.j & h1*/ -return -/*──────────────────────────────────MODE subroutine─────────────────────*/ -mode: procedure expose @.; parse arg x /*finds the MODE of a vector. */ -@.0=words(x) /* [↓] make an array from vector.*/ - do k=1 for @.0; @.k=word(x,k); end /*k*/ -call Esort @.0 /*sort the elements in the array.*/ -?=@.1 /*assume 1st element is the mode.*/ -freq=1 /*the frequency of the occurrence*/ - do j=1 for @.0; _=j-freq /*traipse through the elements. */ - if @.j==@._ then do /*this element same as previous? */ - freq=freq+1 /*bump the frequency counter. */ - ?=@.j /*this element is the mode,so far*/ - end - end /*j*/ -return ? /*return the node to the invoker.*/ +/*REXX program finds the mode (most occurring element) of a vector. */ +/* ════════vector═══════════ ═══show vector═══ ═════show result═════ */ + v= 1 8 6 0 1 9 4 6 1 9 9 9 ; say 'vector='v; say 'mode='mode(v); say + v= 1 2 3 4 5 6 7 8 9 11 10 ; say 'vector='v; say 'mode='mode(v); say + v= 8 8 8 2 2 2 ; say 'vector='v; say 'mode='mode(v); say + v='cat kat Cat emu emu Kat' ; say 'vector='v; say 'mode='mode(v); say +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sort: procedure expose @.; parse arg # 1 h /* [↓] this is an exchange sort. */ + do while h>1; h=h%2 /*In REXX, % is an integer divide.*/ + do i=1 for #-h; j=i; k=h+i /* [↓] perform exchange for elements. */ + do while @.k<@.j & h1*/; return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +mode: procedure expose @.; parse arg x; freq=1 /*function finds the MODE of a vector*/ + #=words(x) /*#: the number of elements in vector.*/ + do k=1 for #; @.k=word(x,k); end /* ◄──── make an array from the vector.*/ + call Sort # /*sort the elements in the array. */ + ?=@.1 /*assume the first element is the mode.*/ + do j=1 for #; _=j-freq /*traipse through the elements in array*/ + if @.j==@._ then do; freq=freq+1 /*is this element the same as previous?*/ + ?=@.j /*this element is the mode (···so far).*/ + end + end /*j*/ + return ? /*return the mode of vector to invoker.*/ diff --git a/Task/Averages-Mode/REXX/averages-mode-2.rexx b/Task/Averages-Mode/REXX/averages-mode-2.rexx index 63242f526f..4fe4bb1b9d 100644 --- a/Task/Averages-Mode/REXX/averages-mode-2.rexx +++ b/Task/Averages-Mode/REXX/averages-mode-2.rexx @@ -1,17 +1,17 @@ /* Rexx */ --- ~~ main ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +/*-- ~~ main ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */ call run_samples return exit --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- returns a comma separated string of mode values from a comma separated input vector string +/*-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */ +/*-- returns a comma separated string of mode values from a comma separated input vector string */ mode: procedure parse arg lvector drop vector. vector. = '' - call makeStem lvector -- this call creates the "vector." stem from the input string + call makeStem lvector /*-- this call creates the "vector." stem from the input string */ seen. = 0 modes. = '' modeMax = 0 @@ -46,8 +46,8 @@ mode: return lmodes --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- pretty-print +/*-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */ +/*-- pretty-print */ show_mode: procedure parse arg lvector @@ -55,8 +55,8 @@ show_mode: say 'Vector: ['space(lvector, 0)'], Mode(s): ['space(lmodes, 0)']' return modes --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- load the "vector." stem from the comma separated input vector string +/*-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */ +/*-- load the "vector." stem from the comma separated input vector string */ makeStem: procedure expose vector. vector.0 = 0 @@ -69,7 +69,7 @@ makeStem: end v_ return vector.0 --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +/*-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */ run_samples: procedure call show_mode '10, 9, 8, 7, 6, 5, 4, 3, 2, 1' -- 10 9 8 7 6 5 4 3 2 1 diff --git a/Task/Averages-Mode/Rust/averages-mode.rust b/Task/Averages-Mode/Rust/averages-mode.rust new file mode 100644 index 0000000000..5c8ff99bcd --- /dev/null +++ b/Task/Averages-Mode/Rust/averages-mode.rust @@ -0,0 +1,31 @@ +use std::collections::HashMap; + +fn main() { + let mode_vec1 = mode(vec![ 1, 3, 6, 6, 6, 6, 7, 7, 12, 12, 17]); + let mode_vec2 = mode(vec![ 1, 1, 2, 4, 4]); + + println!("Mode of vec1 is: {:?}", mode_vec1); + println!("Mode of vec2 is: {:?}", mode_vec2); + + assert!( mode_vec1 == [6], "Error in mode calculation"); + assert!( (mode_vec2 == [1, 4]) || (mode_vec2 == [4,1]), "Error in mode calculation" ); +} + +fn mode(vs: Vec) -> Vec { + let mut vec_mode = Vec::new(); + let mut seen_map = HashMap::new(); + let mut max_val = 0; + for i in vs{ + let ctr = seen_map.entry(i).or_insert(0); + *ctr += 1; + if *ctr > max_val{ + max_val = *ctr; + } + } + for (key, val) in seen_map { + if val == max_val{ + vec_mode.push(key); + } + } + vec_mode +} diff --git a/Task/Averages-Mode/S-lang/averages-mode.slang b/Task/Averages-Mode/S-lang/averages-mode.slang new file mode 100644 index 0000000000..ea84d12d7d --- /dev/null +++ b/Task/Averages-Mode/S-lang/averages-mode.slang @@ -0,0 +1,39 @@ +private variable mx, mxkey, modedat; + +define find_max(key) { + if (modedat[key] > mx) { + mx = modedat[key]; + mxkey = {key}; + } + else if (modedat[key] == mx) { + list_append(mxkey, key); + } +} + +define find_mode(indat) +{ + % reset [file/module-scope] globals: + mx = 0, mxkey = {}, modedat = Assoc_Type[Int_Type, 0]; + + foreach $1 (indat) + modedat[string($1)]++; + + array_map(Void_Type, &find_max, assoc_get_keys(modedat)); + + if (length(mxkey) > 1) { + $2 = 0; + () = printf("{"); + foreach $1 (mxkey) { + () = printf("%s%s", $2 ? ", " : "", $1); + $2 = 1; + } + () = printf("} each have "); + } + else + () = printf("%s has ", mxkey[0], mx); + () = printf("the most entries (%d).\n", mx); +} + +find_mode({"Hungadunga", "Hungadunga", "Hungadunga", "Hungadunga", "McCormick"}); + +find_mode({"foo", "2.3", "bar", "foo", "foobar", "quality", 2.3, "strnen"}); diff --git a/Task/Averages-Mode/Seed7/averages-mode.seed7 b/Task/Averages-Mode/Seed7/averages-mode.seed7 index 888594a6d1..d2523ca8ef 100644 --- a/Task/Averages-Mode/Seed7/averages-mode.seed7 +++ b/Task/Averages-Mode/Seed7/averages-mode.seed7 @@ -28,14 +28,14 @@ const proc: createModeFunction (in type: elemType) is func const func string: str (in array elemType: data) is func result - var string: result is ""; + var string: stri is ""; local var elemType: anElement is elemType.value; begin for anElement range data do - result &:= " " & str(anElement); + stri &:= " " & str(anElement); end for; - result := result[2 ..]; + stri := stri[2 ..]; end func; enable_output(array elemType); diff --git a/Task/Averages-Pythagorean-means/00DESCRIPTION b/Task/Averages-Pythagorean-means/00DESCRIPTION index f5e13f5045..6c99f230d6 100644 --- a/Task/Averages-Pythagorean-means/00DESCRIPTION +++ b/Task/Averages-Pythagorean-means/00DESCRIPTION @@ -1,12 +1,22 @@ -Compute all three of the [[wp:Pythagorean means|Pythagorean means]] of the set of integers 1 through 10. +{{task heading}} -Show that A(x_1,\ldots,x_n) \geq G(x_1,\ldots,x_n) \geq H(x_1,\ldots,x_n) for this set of positive integers. +Compute all three of the [[wp:Pythagorean means|Pythagorean means]] of the set of integers 1 through 10 (inclusive). + +Show that A(x_1,\ldots,x_n) \geq G(x_1,\ldots,x_n) \geq H(x_1,\ldots,x_n) for this set of positive integers. * The most common of the three means, the [[Averages/Arithmetic mean|arithmetic mean]], is the sum of the list divided by its length: -: A(x_1, \ldots, x_n) = \frac{x_1 + \cdots + x_n}{n} -* The [[wp:Geometric mean|geometric mean]] is the nth root of the product of the list: -: G(x_1, \ldots, x_n) = \sqrt[n]{x_1 \cdots x_n} -* The [[wp:Harmonic mean|harmonic mean]] is n divided by the sum of the reciprocal of each item in the list: -: H(x_1, \ldots, x_n) = \frac{n}{\frac{1}{x_1} + \cdots + \frac{1}{x_n}} +: A(x_1, \ldots, x_n) = \frac{x_1 + \cdots + x_n}{n} -C.f. [[Averages/Root mean square]] +* The [[wp:Geometric mean|geometric mean]] is the nth root of the product of the list: +: G(x_1, \ldots, x_n) = \sqrt[n]{x_1 \cdots x_n} + +* The [[wp:Harmonic mean|harmonic mean]] is n divided by the sum of the reciprocal of each item in the list: +: H(x_1, \ldots, x_n) = \frac{n}{\frac{1}{x_1} + \cdots + \frac{1}{x_n}} + + + +{{task heading|See also}} + +{{Related tasks/Statistical measures}} + +

diff --git a/Task/Averages-Pythagorean-means/AppleScript/averages-pythagorean-means-1.applescript b/Task/Averages-Pythagorean-means/AppleScript/averages-pythagorean-means-1.applescript new file mode 100644 index 0000000000..870071f3f7 --- /dev/null +++ b/Task/Averages-Pythagorean-means/AppleScript/averages-pythagorean-means-1.applescript @@ -0,0 +1,98 @@ +-- arithmetic_mean :: [Number] -> Number +on arithmetic_mean(xs) + + -- sum :: Number -> Number -> Number + script sum + on lambda(accumulator, x) + accumulator + x + end lambda + end script + + foldl(sum, 0, xs) / (length of xs) +end arithmetic_mean + + +-- geometric_mean :: [Number] -> Number +on geometric_mean(xs) + + -- product :: Number -> Number -> Number + script product + on lambda(accumulator, x) + accumulator * x + end lambda + end script + + foldl(product, 1, xs) ^ (1 / (length of xs)) +end geometric_mean + + +-- harmonic_mean :: [Number] -> Number +on harmonic_mean(xs) + + -- addInverse :: Number -> Number -> Number + script addInverse + on lambda(accumulator, x) + accumulator + (1 / x) + end lambda + end script + + (length of xs) / (foldl(addInverse, 0, xs)) +end harmonic_mean + + +-- TEST +on run + + script test + on lambda(f) + mReturn(f)'s lambda({1, 2, 3, 4, 5, 6, 7, 8, 9, 10}) + end lambda + end script + + + set {A, G, H} to ¬ + map(test, {arithmetic_mean, geometric_mean, harmonic_mean}) + + {values:{arithmetic:A, geometric:G, harmonic:H}, inequalities:¬ + {|A >= G|:A ≥ G}, |G >= H|:G ≥ H} +end run + + +--------------------------------------------------------------------------- +-- GENERIC FUNCTIONS + +-- 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 + +-- 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 + +-- 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 diff --git a/Task/Averages-Pythagorean-means/AppleScript/averages-pythagorean-means-2.applescript b/Task/Averages-Pythagorean-means/AppleScript/averages-pythagorean-means-2.applescript new file mode 100644 index 0000000000..06da1c37f6 --- /dev/null +++ b/Task/Averages-Pythagorean-means/AppleScript/averages-pythagorean-means-2.applescript @@ -0,0 +1,2 @@ +{values:{arithmetic:5.5, geometric:4.528728688117, harmonic:3.414171521474}, +inequalities:{|A >= G|:true}, |G >= H|:true} diff --git a/Task/Averages-Pythagorean-means/CoffeeScript/averages-pythagorean-means.coffee b/Task/Averages-Pythagorean-means/CoffeeScript/averages-pythagorean-means.coffee new file mode 100644 index 0000000000..eae05d6461 --- /dev/null +++ b/Task/Averages-Pythagorean-means/CoffeeScript/averages-pythagorean-means.coffee @@ -0,0 +1,11 @@ +a = [ 1..10 ] +arithmetic_mean = (a) -> a.reduce(((s, x) -> s + x), 0) / a.length +geometic_mean = (a) -> Math.pow(a.reduce(((s, x) -> s * x), 1), (1 / a.length)) +harmonic_mean = (a) -> a.length / a.reduce(((s, x) -> s + 1 / x), 0) + +A = arithmetic_mean a +G = geometic_mean a +H = harmonic_mean a + +console.log "A = ", A, " G = ", G, " H = ", H +console.log "A >= G : ", A >= G, " G >= H : ", G >= H diff --git a/Task/Averages-Pythagorean-means/Elixir/averages-pythagorean-means.elixir b/Task/Averages-Pythagorean-means/Elixir/averages-pythagorean-means.elixir index 14bb4a7c9d..6878ffeeee 100644 --- a/Task/Averages-Pythagorean-means/Elixir/averages-pythagorean-means.elixir +++ b/Task/Averages-Pythagorean-means/Elixir/averages-pythagorean-means.elixir @@ -1,16 +1,17 @@ defmodule Means do def arithmetic(list) do - Enum.sum(list) / Enum.count(list) + Enum.sum(list) / length(list) end def geometric(list) do - :math.pow(Enum.reduce(list, &(&1 * &2)), 1 / Enum.count(list)) + :math.pow(Enum.reduce(list, &(*/2)), 1 / length(list)) end def harmonic(list) do 1 / arithmetic(Enum.map(list, &(1 / &1))) end end -IO.puts "Arithmetic mean: #{am = Means.arithmetic(1..10)}" -IO.puts "Geometric mean: #{gm = Means.geometric(1..10)}" -IO.puts "Harmonic mean: #{hm = Means.harmonic(1..10)}" +list = Enum.to_list(1..10) +IO.puts "Arithmetic mean: #{am = Means.arithmetic(list)}" +IO.puts "Geometric mean: #{gm = Means.geometric(list)}" +IO.puts "Harmonic mean: #{hm = Means.harmonic(list)}" IO.puts "(#{am} >= #{gm} >= #{hm}) is #{am >= gm and gm >= hm}" diff --git a/Task/Averages-Pythagorean-means/Excel/averages-pythagorean-means.excel b/Task/Averages-Pythagorean-means/Excel/averages-pythagorean-means.excel new file mode 100644 index 0000000000..0cec3149be --- /dev/null +++ b/Task/Averages-Pythagorean-means/Excel/averages-pythagorean-means.excel @@ -0,0 +1,3 @@ +=AVERAGE(1;2;3;4;5;6;7;8;9;10) +=GEOMEAN(1;2;3;4;5;6;7;8;9;10) +=HARMEAN(1;2;3;4;5;6;7;8;9;10) diff --git a/Task/Averages-Pythagorean-means/Java/averages-pythagorean-means.java b/Task/Averages-Pythagorean-means/Java/averages-pythagorean-means-1.java similarity index 100% rename from Task/Averages-Pythagorean-means/Java/averages-pythagorean-means.java rename to Task/Averages-Pythagorean-means/Java/averages-pythagorean-means-1.java diff --git a/Task/Averages-Pythagorean-means/Java/averages-pythagorean-means-2.java b/Task/Averages-Pythagorean-means/Java/averages-pythagorean-means-2.java new file mode 100644 index 0000000000..f80c833954 --- /dev/null +++ b/Task/Averages-Pythagorean-means/Java/averages-pythagorean-means-2.java @@ -0,0 +1,36 @@ + public static double arithmAverage(double array[]){ + if (array == null ||array.length == 0) { + return 0.0; + } + else { + return DoubleStream.of(array).average().getAsDouble(); + } + } + + public static double geomAverage(double array[]){ + if (array == null ||array.length == 0) { + return 0.0; + } + else { + double aver = DoubleStream.of(array).reduce(1, (x, y) -> x * y); + return Math.pow(aver, 1.0 / array.length); + } + } + + public static double harmAverage(double array[]){ + if (array == null ||array.length == 0) { + return 0.0; + } + else { + double aver = DoubleStream.of(array) + // remove null values + .filter(n -> n > 0.0) + // generate 1/n array + .map( n-> 1.0/n) + // accumulating + .reduce(0, (x, y) -> x + y); + // just this reduce is not working- need to do in 2 steps + // .reduce(0, (x, y) -> 1.0/x + 1.0/y); + return array.length / aver ; + } + } diff --git a/Task/Averages-Pythagorean-means/JavaScript/averages-pythagorean-means-1.js b/Task/Averages-Pythagorean-means/JavaScript/averages-pythagorean-means-1.js new file mode 100644 index 0000000000..ae3e3494ec --- /dev/null +++ b/Task/Averages-Pythagorean-means/JavaScript/averages-pythagorean-means-1.js @@ -0,0 +1,60 @@ +(function () { + 'use strict'; + + // arithmetic_mean :: [Number] -> Number + function arithmetic_mean(ns) { + return ( + ns.reduce( // sum + function (sum, n) { + return (sum + n); + }, + 0 + ) / ns.length + ); + } + + // geometric_mean :: [Number] -> Number + function geometric_mean(ns) { + return Math.pow( + ns.reduce( // product + function (product, n) { + return (product * n); + }, + 1 + ), + 1 / ns.length + ); + } + + // harmonic_mean :: [Number] -> Number + function harmonic_mean(ns) { + return ( + ns.length / ns.reduce( // sum of inverses + function (invSum, n) { + return (invSum + (1 / n)); + }, + 0 + ) + ); + } + + var values = [arithmetic_mean, geometric_mean, harmonic_mean] + .map(function (f) { + return f([1, 2, 3, 4, 5, 6, 7, 8, 9, 10]); + }), + mean = { + Arithmetic: values[0], // arithmetic + Geometric: values[1], // geometric + Harmonic: values[2] // harmonic + } + + return JSON.stringify({ + values: mean, + test: "is A >= G >= H ? " + + ( + mean.Arithmetic >= mean.Geometric && + mean.Geometric >= mean.Harmonic ? "yes" : "no" + ) + }, null, 2); + +})(); diff --git a/Task/Averages-Pythagorean-means/JavaScript/averages-pythagorean-means-2.js b/Task/Averages-Pythagorean-means/JavaScript/averages-pythagorean-means-2.js new file mode 100644 index 0000000000..570b8d38d9 --- /dev/null +++ b/Task/Averages-Pythagorean-means/JavaScript/averages-pythagorean-means-2.js @@ -0,0 +1,8 @@ +{ + "values": { + "Arithmetic": 5.5, + "Geometric": 4.528728688116765, + "Harmonic": 3.414171521474055 + }, + "test": "is A >= G >= H ? yes" +} diff --git a/Task/Averages-Pythagorean-means/JavaScript/averages-pythagorean-means-3.js b/Task/Averages-Pythagorean-means/JavaScript/averages-pythagorean-means-3.js new file mode 100644 index 0000000000..dd6a78d198 --- /dev/null +++ b/Task/Averages-Pythagorean-means/JavaScript/averages-pythagorean-means-3.js @@ -0,0 +1,32 @@ +(() => { + + // arithmeticMean :: [Number] -> Number + const arithmeticMean = xs => + xs.reduce((sum, n) => sum + n, 0) / xs.length; + + // geometricMean :: [Number] -> Number + const geometricMean = xs => + Math.pow(xs.reduce((product, x) => product * x, 1), 1 / xs.length); + + // harmonicMean :: [Number] -> Number + const harmonicMean = xs => + xs.length / xs.reduce((invSum, n) => invSum + (1 / n), 0); + + + // TEST + const values = [arithmeticMean, geometricMean, harmonicMean] + .map(f => f([1, 2, 3, 4, 5, 6, 7, 8, 9, 10])), + + mean = { + Arithmetic: values[0], + Geometric: values[1], + Harmonic: values[2] + }; + + return JSON.stringify({ + values: mean, + test: `is A >= G >= H ? ${mean.Arithmetic >= mean.Geometric && + mean.Geometric >= mean.Harmonic ? "yes" : "no"}` + }, null, 2); + +})(); diff --git a/Task/Averages-Pythagorean-means/JavaScript/averages-pythagorean-means-4.js b/Task/Averages-Pythagorean-means/JavaScript/averages-pythagorean-means-4.js new file mode 100644 index 0000000000..570b8d38d9 --- /dev/null +++ b/Task/Averages-Pythagorean-means/JavaScript/averages-pythagorean-means-4.js @@ -0,0 +1,8 @@ +{ + "values": { + "Arithmetic": 5.5, + "Geometric": 4.528728688116765, + "Harmonic": 3.414171521474055 + }, + "test": "is A >= G >= H ? yes" +} diff --git a/Task/Averages-Pythagorean-means/JavaScript/averages-pythagorean-means.js b/Task/Averages-Pythagorean-means/JavaScript/averages-pythagorean-means.js deleted file mode 100644 index 7c00c6efa0..0000000000 --- a/Task/Averages-Pythagorean-means/JavaScript/averages-pythagorean-means.js +++ /dev/null @@ -1,21 +0,0 @@ -function arithmetic_mean(ary) { - var sum = ary.reduce(function(s,x) {return (s+x)}, 0); - return (sum / ary.length); -} - -function geometic_mean(ary) { - var product = ary.reduce(function(s,x) {return (s*x)}, 1); - return Math.pow(product, 1/ary.length); -} - -function harmonic_mean(ary) { - var sum_of_inv = ary.reduce(function(s,x) {return (s + 1/x)}, 0); - return (ary.length / sum_of_inv); -} - -var ary = [1,2,3,4,5,6,7,8,9,10]; -var A = arithmetic_mean(ary); -var G = geometic_mean(ary); -var H = harmonic_mean(ary); - -print("is A >= G >= H ? " + (A >= G && G >= H ? "yes" : "no")); diff --git a/Task/Averages-Pythagorean-means/K/averages-pythagorean-means.k b/Task/Averages-Pythagorean-means/K/averages-pythagorean-means.k new file mode 100644 index 0000000000..424c05683c --- /dev/null +++ b/Task/Averages-Pythagorean-means/K/averages-pythagorean-means.k @@ -0,0 +1,6 @@ + am:{(+/x)%#x} + gm:{(*/x)^(%#x)} + hm:{(#x)%+/%:'x} + + {(am x;gm x;hm x)} 1+!10 +5.5 4.528729 3.414172 diff --git a/Task/Averages-Pythagorean-means/Kotlin/averages-pythagorean-means.kotlin b/Task/Averages-Pythagorean-means/Kotlin/averages-pythagorean-means.kotlin new file mode 100644 index 0000000000..64d0cc7e16 --- /dev/null +++ b/Task/Averages-Pythagorean-means/Kotlin/averages-pythagorean-means.kotlin @@ -0,0 +1,20 @@ +fun Collection.geometricMean() = + if (isEmpty()) + Double.NaN + else Math.pow(reduce { n1, n2 -> n1 * n2 }, 1.0 / size) + +fun Collection.harmonicMean() = + if (isEmpty() || contains(0.0)) + Double.NaN + else + size / reduce { n1, n2 -> n1 + 1.0 / n2 } + +fun main(args: Array) { + val list = listOf(1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0, 9.0, 10.0) + val a = list.average() // arithmetic mean + val g = list.geometricMean() + val h = list.harmonicMean() + println("A = %f G = %f H = %f".format(a, g, h)) + println("A >= G is %b, G >= H is %b".format( a >= g, g >= h)) + require(a >= g && g >= h) +} diff --git a/Task/Averages-Pythagorean-means/PHP/averages-pythagorean-means.php b/Task/Averages-Pythagorean-means/PHP/averages-pythagorean-means.php new file mode 100644 index 0000000000..70d95d70d0 --- /dev/null +++ b/Task/Averages-Pythagorean-means/PHP/averages-pythagorean-means.php @@ -0,0 +1,29 @@ += gmean) && (gmean >= hmean) ), "Incorrect calculation"); + +} diff --git a/Task/Averages-Root-mean-square/00DESCRIPTION b/Task/Averages-Root-mean-square/00DESCRIPTION index 6fde1d5117..4777c27228 100644 --- a/Task/Averages-Root-mean-square/00DESCRIPTION +++ b/Task/Averages-Root-mean-square/00DESCRIPTION @@ -1,8 +1,18 @@ -Compute the [[wp:Root mean square|Root mean square]] of the numbers 1..10. +{{task heading}} -The root mean square is also known by its initial RMS (or rms), and as the '''quadratic mean'''. +Compute the   [[wp:Root mean square|Root mean square]]   of the numbers 1..10. + + +The   ''root mean square''   is also known by its initials RMS (or rms), and as the '''quadratic mean'''. The RMS is calculated as the mean of the squares of the numbers, square-rooted: -: x_{\mathrm{rms}} = \sqrt {{{x_1}^2 + {x_2}^2 + \cdots + {x_n}^2} \over n}. -Cf. [[Averages/Pythagorean means]] + +::: x_{\mathrm{rms}} = \sqrt {{{x_1}^2 + {x_2}^2 + \cdots + {x_n}^2} \over n}. + + +{{task heading|See also}} + +{{Related tasks/Statistical measures}} + +

diff --git a/Task/Averages-Root-mean-square/COBOL/averages-root-mean-square.cobol b/Task/Averages-Root-mean-square/COBOL/averages-root-mean-square.cobol new file mode 100644 index 0000000000..95698c0314 --- /dev/null +++ b/Task/Averages-Root-mean-square/COBOL/averages-root-mean-square.cobol @@ -0,0 +1,21 @@ +IDENTIFICATION DIVISION. +PROGRAM-ID. QUADRATIC-MEAN-PROGRAM. +DATA DIVISION. +WORKING-STORAGE SECTION. +01 QUADRATIC-MEAN-VARS. + 05 N PIC 99 VALUE 0. + 05 N-SQUARED PIC 999. + 05 RUNNING-TOTAL PIC 999 VALUE 0. + 05 MEAN-OF-SQUARES PIC 99V9(16). + 05 QUADRATIC-MEAN PIC 9V9(15). +PROCEDURE DIVISION. +CONTROL-PARAGRAPH. + PERFORM MULTIPLICATION-PARAGRAPH 10 TIMES. + DIVIDE RUNNING-TOTAL BY 10 GIVING MEAN-OF-SQUARES. + COMPUTE QUADRATIC-MEAN = FUNCTION SQRT(MEAN-OF-SQUARES). + DISPLAY QUADRATIC-MEAN UPON CONSOLE. + STOP RUN. +MULTIPLICATION-PARAGRAPH. + ADD 1 TO N. + MULTIPLY N BY N GIVING N-SQUARED. + ADD N-SQUARED TO RUNNING-TOTAL. diff --git a/Task/Averages-Root-mean-square/Elixir/averages-root-mean-square.elixir b/Task/Averages-Root-mean-square/Elixir/averages-root-mean-square.elixir index 98e724a758..62473e149d 100644 --- a/Task/Averages-Root-mean-square/Elixir/averages-root-mean-square.elixir +++ b/Task/Averages-Root-mean-square/Elixir/averages-root-mean-square.elixir @@ -1,7 +1,14 @@ defmodule RC do - def root_mean_square(list) do - :math.sqrt(Enum.reduce(list, 0, &(&2 + &1 * &1)) / Enum.count(list)) + def root_mean_square(enum) do + enum + |> square + |> mean + |> :math.sqrt end + + defp mean(enum), do: Enum.sum(enum) / Enum.count(enum) + + defp square(enum), do: (for x <- enum, do: x * x) end IO.puts RC.root_mean_square(1..10) diff --git a/Task/Averages-Root-mean-square/JavaScript/averages-root-mean-square.js b/Task/Averages-Root-mean-square/JavaScript/averages-root-mean-square-1.js similarity index 100% rename from Task/Averages-Root-mean-square/JavaScript/averages-root-mean-square.js rename to Task/Averages-Root-mean-square/JavaScript/averages-root-mean-square-1.js diff --git a/Task/Averages-Root-mean-square/JavaScript/averages-root-mean-square-2.js b/Task/Averages-Root-mean-square/JavaScript/averages-root-mean-square-2.js new file mode 100644 index 0000000000..cc672c39de --- /dev/null +++ b/Task/Averages-Root-mean-square/JavaScript/averages-root-mean-square-2.js @@ -0,0 +1,18 @@ +(lst => { + 'use strict'; + + + // rootMeanSquare :: [Num] -> Real + let rootMeanSquare = lst => + Math.sqrt( + lst.reduce( + (a, x) => (a + x * x), + 0 + ) / lst.length + ); + + + return rootMeanSquare(lst); + + +})([1, 2, 3, 4, 5, 6, 7, 8, 9, 10]); diff --git a/Task/Averages-Root-mean-square/K/averages-root-mean-square.k b/Task/Averages-Root-mean-square/K/averages-root-mean-square.k new file mode 100644 index 0000000000..eba05e2dea --- /dev/null +++ b/Task/Averages-Root-mean-square/K/averages-root-mean-square.k @@ -0,0 +1,3 @@ + rms:{_sqrt (+/x^2)%#x} + rms 1+!10 +6.204837 diff --git a/Task/Averages-Root-mean-square/PHP/averages-root-mean-square.php b/Task/Averages-Root-mean-square/PHP/averages-root-mean-square.php new file mode 100644 index 0000000000..eb30f299f6 --- /dev/null +++ b/Task/Averages-Root-mean-square/PHP/averages-root-mean-square.php @@ -0,0 +1,15 @@ +9; m.j=h; h=h%2+1; end /*j*/ - do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ - numeric digits d; return (g/1)i /*make complex if X < 0.*/ +/*REXX program computes and displays the root mean square (RMS) of a number sequence. */ +parse arg nums digs show . /*obtain the optional arguments from CL*/ +if nums=='' | nums=="," then nums=10 /*Not specified? Then use the default.*/ +if digs=='' | digs=="," then digs=50 /* " " " " " " */ +if show=='' | show=="," then show=10 /* " " " " " " */ +numeric digits digs /*uses DIGS decimal digits for calc. */ +$=0; do j=1 for nums /*process each of the N integers. */ + $=$ + j**2 /*sum the squares of the integers. */ + end /*j*/ + /* [↓] displays SHOW decimal digits.*/ +rms=format( sqrt($/nums), , show ) / 1 /*divide by N, then calculate the SQRT.*/ +say 'root mean square for 1──►'nums "is: " rms /*display the root mean square (RMS). */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); numeric digits; m.=9 + numeric form; parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g *.5'e'_ % 2 + h=d+6; do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ + do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ + return g diff --git a/Task/Averages-Root-mean-square/Rust/averages-root-mean-square.rust b/Task/Averages-Root-mean-square/Rust/averages-root-mean-square.rust new file mode 100644 index 0000000000..51158e85c4 --- /dev/null +++ b/Task/Averages-Root-mean-square/Rust/averages-root-mean-square.rust @@ -0,0 +1,9 @@ +fn root_mean_square(vec: Vec) -> f32 { + let sum_squares = vec.iter().fold(0, |acc, &x| acc + x.pow(2)); + return ((sum_squares as f32)/(vec.len() as f32)).sqrt(); +} + +fn main() { + let vec = (1..11).collect(); + println!("The root mean square is: {}", root_mean_square(vec)); +} diff --git a/Task/Averages-Root-mean-square/S-lang/averages-root-mean-square.slang b/Task/Averages-Root-mean-square/S-lang/averages-root-mean-square.slang new file mode 100644 index 0000000000..80458421fd --- /dev/null +++ b/Task/Averages-Root-mean-square/S-lang/averages-root-mean-square.slang @@ -0,0 +1,6 @@ +define rms(arr) +{ + return sqrt(sum(sqr(arr)) / length(arr)); +} + +print(rms([1:10])); diff --git a/Task/Averages-Root-mean-square/Standard-ML/averages-root-mean-square.ml b/Task/Averages-Root-mean-square/Standard-ML/averages-root-mean-square.ml new file mode 100644 index 0000000000..d774a60080 --- /dev/null +++ b/Task/Averages-Root-mean-square/Standard-ML/averages-root-mean-square.ml @@ -0,0 +1,9 @@ +fun rms(v: real vector) = + let + val v' = Vector.map (fn x => x*x) v + val sum = Vector.foldl op+ 0.0 v' + in + Math.sqrt( sum/real(Vector.length(v')) ) + end; + +rms(Vector.tabulate(10, fn n => real(n+1))); diff --git a/Task/Averages-Root-mean-square/VBA/averages-root-mean-square.vba b/Task/Averages-Root-mean-square/VBA/averages-root-mean-square.vba new file mode 100644 index 0000000000..afd00b8123 --- /dev/null +++ b/Task/Averages-Root-mean-square/VBA/averages-root-mean-square.vba @@ -0,0 +1,16 @@ +Function rms(iLow As Integer, iHigh As Integer) + Dim i As Integer + If iLow > iHigh Then + i = iLow + iLow = iHigh + iHigh = i + End If + For i = iLow To iHigh + rms = rms + i ^ 2 + Next i + rms = Sqr(rms / (iHigh - iLow + 1)) +End Function + +Sub foo() + Debug.Print rms(1, 10) +End Sub diff --git a/Task/Averages-Simple-moving-average/00DESCRIPTION b/Task/Averages-Simple-moving-average/00DESCRIPTION index ff29f84efa..e2acc36e61 100644 --- a/Task/Averages-Simple-moving-average/00DESCRIPTION +++ b/Task/Averages-Simple-moving-average/00DESCRIPTION @@ -1,18 +1,23 @@ Computing the [[wp:Moving_average#Simple_moving_average|simple moving average]] of a series of numbers. -The task is to: -:''Create a [[wp:Stateful|stateful]] function/class/instance that takes a period and returns a routine that takes a number as argument and returns a simple moving average of its arguments so far.'' +{{task heading}} -'''Description'''
-A simple moving average is a method for computing an average of a stream of numbers by only averaging the last P numbers from the stream, where P is known as the period. -It can be implemented by calling an initialing routine with P as its argument, I(P), which should then return a routine that when called with individual, successive members of a stream of numbers, computes the mean of (up to), the last P of them, lets call this SMA(). +Create a [[wp:Stateful|stateful]] function/class/instance that takes a period and returns a routine that takes a number as argument and returns a simple moving average of its arguments so far. -The word stateful in the task description refers to the need for SMA() to remember certain information between calls to it: -* The period, P -* An ordered container of at least the last P numbers from each of its individual calls. -Stateful also means that successive calls to I(), the initializer, should return separate routines that do ''not'' share saved state so they could be used on two independent streams of data. +{{task heading|Description}} -Pseudocode for an implementation of SMA is: +A simple moving average is a method for computing an average of a stream of numbers by only averaging the last   P   numbers from the stream,   where   P   is known as the period. + +It can be implemented by calling an initialing routine with   P   as its argument,   I(P),   which should then return a routine that when called with individual, successive members of a stream of numbers, computes the mean of (up to), the last   P   of them, lets call this   SMA(). + +The word   ''stateful''   in the task description refers to the need for   SMA()   to remember certain information between calls to it: +*   The period,   P +*   An ordered container of at least the last   P   numbers from each of its individual calls. + +
+''Stateful''   also means that successive calls to   I(),   the initializer,   should return separate routines that do   ''not''   share saved state so they could be used on two independent streams of data. + +Pseudo-code for an implementation of   SMA   is:
 function SMA(number: N):
     stateful integer: P
@@ -30,5 +35,8 @@ function SMA(number: N):
     return average
 
+{{task heading|See also}} -See also: [[Standard Deviation]] +{{Related tasks/Statistical measures}} + +
diff --git a/Task/Averages-Simple-moving-average/Elixir/averages-simple-moving-average-1.elixir b/Task/Averages-Simple-moving-average/Elixir/averages-simple-moving-average-1.elixir new file mode 100644 index 0000000000..9ef538510b --- /dev/null +++ b/Task/Averages-Simple-moving-average/Elixir/averages-simple-moving-average-1.elixir @@ -0,0 +1,42 @@ +$ cat simple-moving-avg.exs +#!/usr/bin/env elixir + +defmodule Math do + def average([]), do: nil + def average(enum) do + Enum.sum(enum) / length(enum) + end +end + +defmodule SMA do + + def sma(l, p \\ 10) do + IO.puts("\nSimple moving average(period=#{p}):") + Enum.chunk(l, p, 1) + |> Enum.map(&(%{"input": &1, "avg": Float.round(Math.average(&1), 3)})) + end + + defmacro gen_func(p) do + quote do + fn l -> SMA.sma(l, unquote(p)) end + end + end + + def read_numeric_input do + IO.stream(:stdio, :line) + |> Enum.map(&(String.split(&1, ~r{\s+}))) + |> List.flatten() + |> Enum.reject(&(is_nil(&1) || String.length(&1) == 0)) + |> Enum.map(&(Integer.parse(&1) |> elem(0))) + end + + def run do + sma_func_10 = gen_func(10) + sma_func_15 = gen_func(15) + numbers = read_numeric_input + sma_func_10.(numbers) |> IO.inspect + sma_func_15.(numbers) |> IO.inspect + end +end + +SMA.run diff --git a/Task/Averages-Simple-moving-average/Elixir/averages-simple-moving-average-2.elixir b/Task/Averages-Simple-moving-average/Elixir/averages-simple-moving-average-2.elixir new file mode 100644 index 0000000000..e788b81806 --- /dev/null +++ b/Task/Averages-Simple-moving-average/Elixir/averages-simple-moving-average-2.elixir @@ -0,0 +1,5 @@ +#!/bin/bash +elixir ./simple-moving-avg.exs < [a] -> a -mean xs = sum xs / (genericLength xs) +mean = divl . foldl' (\(Pair s l) x -> Pair (s+x) (l+1)) (Pair 0.0 0) + where divl (_,0) = 0.0 + divl (s,l) = s / fromIntegral l series = [1,2,3,4,5,5,4,3,2,1] -simple_moving_averager period = do - numsRef <- newIORef [] - return (\x -> do - nums <- readIORef numsRef - let xs = take period (x:nums) - writeIORef numsRef xs - return $ mean xs - ) +mkSMA :: Int -> IO (Double -> IO Double) +mkSMA period = avgr <$> newIORef [] + where avgr nsref x = readIORef nsref >>= (\ns -> + let xs = take period (x:ns) + in writeIORef nsref xs $> mean xs) -main = do - sma3 <- simple_moving_averager 3 - sma5 <- simple_moving_averager 5 - forM_ series (\n -> do - mm3 <- sma3 n - mm5 <- sma5 n - putStrLn $ "Next number = " ++ (show n) ++ ", SMA_3 = " ++ (show mm3) ++ ", SMA_5 = " ++ (show mm5) - ) +main = mkSMA 3 >>= (\sma3 -> mkSMA 5 >>= (\sma5 -> + mapM_ (str <$> pure n <*> sma3 <*> sma5) series)) + where str n mm3 mm5 = + concat ["Next number = ",show n,", SMA_3 = ",show mm3,", SMA_5 = ",show mm5] diff --git a/Task/Averages-Simple-moving-average/Haskell/averages-simple-moving-average-3.hs b/Task/Averages-Simple-moving-average/Haskell/averages-simple-moving-average-3.hs index b3616b06e6..443c5e24ba 100644 --- a/Task/Averages-Simple-moving-average/Haskell/averages-simple-moving-average-3.hs +++ b/Task/Averages-Simple-moving-average/Haskell/averages-simple-moving-average-3.hs @@ -23,6 +23,4 @@ demostrateSMA :: State SMAState [Float] demostrateSMA = mapM computeSMA [1, 2, 3, 4, 5, 5, 4, 3, 2, 1] main :: IO () -main = putStrLn $ (show result) - where - (result, _) = runState demostrateSMA [] +main = print $ evalState demostrateSMA [] diff --git a/Task/Averages-Simple-moving-average/JavaScript/averages-simple-moving-average-2.js b/Task/Averages-Simple-moving-average/JavaScript/averages-simple-moving-average-2.js index de3b3fe6d5..6faeb0efb8 100644 --- a/Task/Averages-Simple-moving-average/JavaScript/averages-simple-moving-average-2.js +++ b/Task/Averages-Simple-moving-average/JavaScript/averages-simple-moving-average-2.js @@ -1,10 +1,19 @@ // single-sided Array.prototype.simpleSMA=function(N) { -return this.map(function(x,i,v) { - if(ii-N; }).reduce(function(a,b){ return a+b; })/N; -}); }; +return this.map( + function(el,index, _arr) { + return _arr.filter( + function(x2,i2) { + return i2 <= index && i2 > index - N; + }) + .reduce( + function(current, last, index, arr){ + return (current + last); + })/index || 1; + }); +}; -g=[1,2,3,4,5,8,5,4]; -console.log(g.simpleSMA(3)) -console.log(g.simpleSMA(5)) +g=[0,1,2,3,4,5,6,7,8,9,10]; +console.log(g.simpleSMA(3)); +console.log(g.simpleSMA(5)); +console.log(g.simpleSMA(g.length)); diff --git a/Task/Averages-Simple-moving-average/K/averages-simple-moving-average-1.k b/Task/Averages-Simple-moving-average/K/averages-simple-moving-average-1.k new file mode 100644 index 0000000000..27e6f30993 --- /dev/null +++ b/Task/Averages-Simple-moving-average/K/averages-simple-moving-average-1.k @@ -0,0 +1,9 @@ + v:v,|v:1+!5 + v +1 2 3 4 5 5 4 3 2 1 + + avg:{(+/x)%#x} + sma:{avg'x@(,\!y),(1+!y)+\:!y} + + sma[v;5] +1 1.5 2 2.5 3 3.8 4.2 4.2 3.8 3 diff --git a/Task/Averages-Simple-moving-average/K/averages-simple-moving-average-2.k b/Task/Averages-Simple-moving-average/K/averages-simple-moving-average-2.k new file mode 100644 index 0000000000..73f76d3a65 --- /dev/null +++ b/Task/Averages-Simple-moving-average/K/averages-simple-moving-average-2.k @@ -0,0 +1,4 @@ + sma:{n::x#_n; {n::1_ n,x; {avg x@&~_n~'x} n}} + + sma[5]' v +1 1.5 2 2.5 3 3.8 4.2 4.2 3.8 3 diff --git a/Task/Averages-Simple-moving-average/Lua/averages-simple-moving-average.lua b/Task/Averages-Simple-moving-average/Lua/averages-simple-moving-average.lua index 623f0cbe66..2b0ca47aea 100644 --- a/Task/Averages-Simple-moving-average/Lua/averages-simple-moving-average.lua +++ b/Task/Averages-Simple-moving-average/Lua/averages-simple-moving-average.lua @@ -1,10 +1,19 @@ -do - local t = {} - function f(a, b, ...) if b then return f(a+b, ...) else return a end end - function average(n) - if #t == 10 then table.remove(t, 1) end - t[#t + 1] = n - return f(unpack(t)) / #t - end +function sma(period) + local t = {} + function sum(a, ...) + if a then return a+sum(...) else return 0 end + end + function average(n) + if #t == period then table.remove(t, 1) end + t[#t + 1] = n + return sum(unpack(t)) / #t + end + return average end -for v=1,30 do print(average(v)) end + +sma5 = sma(5) +sma10 = sma(10) +print("SMA 5") +for v=1,15 do print(sma5(v)) end +print("\nSMA 10") +for v=1,15 do print(sma10(v)) end diff --git a/Task/Averages-Simple-moving-average/Perl-6/averages-simple-moving-average-1.pl6 b/Task/Averages-Simple-moving-average/Perl-6/averages-simple-moving-average-1.pl6 new file mode 100644 index 0000000000..d00cfc844f --- /dev/null +++ b/Task/Averages-Simple-moving-average/Perl-6/averages-simple-moving-average-1.pl6 @@ -0,0 +1,7 @@ +sub sma-generator (Int $P where * > 0) { + sub ($x) { + state @a = 0 xx $P; + @a.push($x).shift; + @a.sum / $P; + } +} diff --git a/Task/Averages-Simple-moving-average/Perl-6/averages-simple-moving-average-2.pl6 b/Task/Averages-Simple-moving-average/Perl-6/averages-simple-moving-average-2.pl6 new file mode 100644 index 0000000000..9451bf0799 --- /dev/null +++ b/Task/Averages-Simple-moving-average/Perl-6/averages-simple-moving-average-2.pl6 @@ -0,0 +1,5 @@ +my &sma = sma-generator 3; + +for 1, 2, 3, 2, 7 { + printf "append $_ --> sma = %.2f (with period 3)\n", sma $_; +} diff --git a/Task/Averages-Simple-moving-average/Perl-6/averages-simple-moving-average.pl6 b/Task/Averages-Simple-moving-average/Perl-6/averages-simple-moving-average.pl6 deleted file mode 100644 index 484870ca1e..0000000000 --- a/Task/Averages-Simple-moving-average/Perl-6/averages-simple-moving-average.pl6 +++ /dev/null @@ -1,7 +0,0 @@ -sub sma(Int \P where * > 0) returns Sub { - sub ($x) { - state @a = 0 xx P; - @a.push($x).shift; - P R/ [+] @a; - } -} diff --git a/Task/Averages-Simple-moving-average/REXX/averages-simple-moving-average.rexx b/Task/Averages-Simple-moving-average/REXX/averages-simple-moving-average.rexx index 7aa911cfe6..ae9579f8ee 100644 --- a/Task/Averages-Simple-moving-average/REXX/averages-simple-moving-average.rexx +++ b/Task/Averages-Simple-moving-average/REXX/averages-simple-moving-average.rexx @@ -1,26 +1,19 @@ -/*REXX program illustrates simple moving average using a constructed list. */ -parse arg p q n . /*get optional arguments from the C.L. */ -if p=='' then p=3 /*the 1st period (the default is: 3).*/ -if q=='' then q=5 /* " 2nd " " " " 5).*/ -if n=='' then n=10 /*the number of items in the list. */ -@.=0 /*define array with initial zero values*/ - /* [↓] build 1st half of list*/ - do j=1 for n%2; @.j=j; end /* ··· increasing values.*/ - /* [↓] build 2nd half of list*/ - do k=n%2 to 1 by -1; @.j=k; j=j+1; end /* ··· decreasing values.*/ +/*REXX program illustrates and displays a simple moving average using a constructed list*/ +parse arg p q n . /*obtain optional arguments from the CL*/ +if p=='' | p=="," then p= 3 /*Not specified? Then use the default.*/ +if q=='' | q=="," then q= 5 /* " " " " " " */ +if n=='' | n=="," then n=10 /* " " " " " " */ +@.=0 /*default value, only needed for odd N.*/ + do j=1 for n%2; @.j=j; end /*build 1st half of list, increasing #s*/ + do k=n%2 by -1 to 1; @.j=k; j=j+1; end /* " 2nd " " " decreasing " */ -say ' ' " SMA with " ' SMA with ' -say ' number ' " period" p' ' ' period' q -say ' ──────── ' "──────────" '──────────' + say ' ' " SMA with " ' SMA with ' + say ' number ' " period" p' ' ' period' q + say ' ──────── ' "──────────" '──────────' - /* [↓] perform a simple moving average*/ - do m=1 for n - say center(@.m, 10) left(sma(p,m), 11) left(sma(q,m), 11) - end /*m*/ /* [↑] show a simple moving average.*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -sma: procedure expose @.; parse arg p,j; s=0; i=0 - do k=max(1,j-p+1) to j+p for p while k<=j; i=i+1 - s=s+@.k - end /*k*/ -return s/i + do m=1 for n; say center(@.m, 10) left(SMA(p, m), 11) left(SMA(q, m), 11); end +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +SMA: procedure expose @.; parse arg p,j; i=0 ; $=0 + do k=max(1, j-p+1) to j+p for p while k<=j; i=i+1; $=$+@.k; end + return $/i diff --git a/Task/Averages-Simple-moving-average/Rust/averages-simple-moving-average-1.rust b/Task/Averages-Simple-moving-average/Rust/averages-simple-moving-average-1.rust new file mode 100644 index 0000000000..da600acc21 --- /dev/null +++ b/Task/Averages-Simple-moving-average/Rust/averages-simple-moving-average-1.rust @@ -0,0 +1,39 @@ +struct SimpleMovingAverage { + period: usize, + numbers: Vec +} + +impl SimpleMovingAverage { + fn new(p: usize) -> SimpleMovingAverage { + SimpleMovingAverage { + period: p, + numbers: Vec::new() + } + } + + fn add_number(&mut self, number: usize) -> f64 { + self.numbers.push(number); + + if self.numbers.len() > self.period { + self.numbers.remove(0); + } + + if self.numbers.is_empty() { + return 0f64; + }else { + let sum = self.numbers.iter().fold(0, |acc, x| acc+x); + return sum as f64 / self.numbers.len() as f64; + } + } +} + +fn main() { + for period in [3, 5].iter() { + println!("Moving average with period {}", period); + + let mut sma = SimpleMovingAverage::new(*period); + for i in [1, 2, 3, 4, 5, 5, 4, 3, 2, 1].iter() { + println!("Number: {} | Average: {}", i, sma.add_number(*i)); + } + } +} diff --git a/Task/Averages-Simple-moving-average/Rust/averages-simple-moving-average-2.rust b/Task/Averages-Simple-moving-average/Rust/averages-simple-moving-average-2.rust new file mode 100644 index 0000000000..ec5bb6abb8 --- /dev/null +++ b/Task/Averages-Simple-moving-average/Rust/averages-simple-moving-average-2.rust @@ -0,0 +1,41 @@ +use std::collections::VecDeque; + +struct SimpleMovingAverage { + period: usize, + numbers: VecDeque +} + +impl SimpleMovingAverage { + fn new(p: usize) -> SimpleMovingAverage { + SimpleMovingAverage { + period: p, + numbers: VecDeque::new() + } + } + + fn add_number(&mut self, number: usize) -> f64 { + self.numbers.push_back(number); + + if self.numbers.len() > self.period { + self.numbers.pop_front(); + } + + if self.numbers.is_empty() { + return 0f64; + }else { + let sum = self.numbers.iter().fold(0, |acc, x| acc+x); + return sum as f64 / self.numbers.len() as f64; + } + } +} + +fn main() { + for period in [3, 5].iter() { + println!("Moving average with period {}", period); + + let mut sma = SimpleMovingAverage::new(*period); + for i in [1, 2, 3, 4, 5, 5, 4, 3, 2, 1].iter() { + println!("Number: {} | Average: {}", i, sma.add_number(*i)); + } + } +} diff --git a/Task/Averages-Simple-moving-average/VBScript/averages-simple-moving-average.vb b/Task/Averages-Simple-moving-average/VBScript/averages-simple-moving-average.vb new file mode 100644 index 0000000000..2fbb368d27 --- /dev/null +++ b/Task/Averages-Simple-moving-average/VBScript/averages-simple-moving-average.vb @@ -0,0 +1,37 @@ +data = "1,2,3,4,5,5,4,3,2,1" +token = Split(data,",") +stream = "" +WScript.StdOut.WriteLine "Number" & vbTab & "SMA3" & vbTab & "SMA5" +For j = LBound(token) To UBound(token) + If Len(stream) = 0 Then + stream = token(j) + Else + stream = stream & "," & token(j) + End If + WScript.StdOut.WriteLine token(j) & vbTab & Round(SMA(stream,3),2) & vbTab & Round(SMA(stream,5),2) +Next + +Function SMA(s,p) + If Len(s) = 0 Then + SMA = 0 + Exit Function + End If + d = Split(s,",") + sum = 0 + If UBound(d) + 1 >= p Then + c = 0 + For i = UBound(d) To LBound(d) Step -1 + sum = sum + Int(d(i)) + c = c + 1 + If c = p Then + Exit For + End If + Next + SMA = sum / p + Else + For i = UBound(d) To LBound(d) Step -1 + sum = sum + Int(d(i)) + Next + SMA = sum / (UBound(d) + 1) + End If +End Function diff --git a/Task/Balanced-brackets/00DESCRIPTION b/Task/Balanced-brackets/00DESCRIPTION index e80789f1d9..23eb9aeafe 100644 --- a/Task/Balanced-brackets/00DESCRIPTION +++ b/Task/Balanced-brackets/00DESCRIPTION @@ -1,10 +1,12 @@ '''Task''': -* Generate a string with \mathrm{N} opening brackets (“[”) and \mathrm{N} closing brackets (“]”), in some arbitrary order. +* Generate a string with   '''N'''   opening brackets   '''['''   and with   '''N'''   closing brackets   ''']''',   in some arbitrary order. * Determine whether the generated string is ''balanced''; that is, whether it consists entirely of pairs of opening/closing brackets (in that order), none of which mis-nest. -'''Examples''': + +;Examples: (empty) OK [] OK ][ NOT OK [][] OK ][][ NOT OK [[][]] OK []][[] NOT OK +

diff --git a/Task/Balanced-brackets/360-Assembly/balanced-brackets.360 b/Task/Balanced-brackets/360-Assembly/balanced-brackets.360 new file mode 100644 index 0000000000..89f0eb2b8c --- /dev/null +++ b/Task/Balanced-brackets/360-Assembly/balanced-brackets.360 @@ -0,0 +1,101 @@ +* Balanced brackets 28/04/2016 +BALANCE CSECT + USING BALANCE,R13 base register and savearea pointer +SAVEAREA B STM-SAVEAREA(R15) + DC 17F'0' +STM STM R14,R12,12(R13) + ST R13,4(R15) + ST R15,8(R13) + LR R13,R15 establish addressability + LA R8,1 i=1 +LOOPI C R8,=F'20' do i=1 to 20 + BH ELOOPI + MVC C(20),=CL20' ' c=' ' + LA R1,1 + LA R2,10 + BAL R14,RANDOMX + LR R11,R0 l=randomx(1,10) + SLA R11,1 l=l*2 + LA R10,1 j=1 +LOOPJ CR R10,R11 do j=1 to 2*l + BH ELOOPJ + LA R1,0 + LA R2,1 + BAL R14,RANDOMX + LR R12,R0 m=randomx(0,1) + LTR R12,R12 if m=0 + BNZ ELSEM + MVI Q,C'[' q='[' + B EIFM +ELSEM MVI Q,C']' q=']' +EIFM LA R14,C-1(R10) @c(j) + MVC 0(1,R14),Q c(j)=q + LA R10,1(R10) j=j+1 + B LOOPJ +ELOOPJ BAL R14,CHECKBAL + LR R2,R0 + C R2,=F'1' if checkbal=1 + BNE ELSEC + MVC PG+24(2),=C'ok' rep='ok' + B EIFC +ELSEC MVC PG+24(2),=C'? ' rep='? ' +EIFC XDECO R8,XDEC i + MVC PG+0(2),XDEC+10 + MVC PG+3(20),C + XPRNT PG,26 + LA R8,1(R8) i=i+1 + B LOOPI +ELOOPI L R13,4(0,R13) + LM R14,R12,12(R13) + XR R15,R15 set return code to 0 + BR R14 -------------- end +CHECKBAL CNOP 0,4 -------------- checkbal + SR R6,R6 n=0 + LA R7,1 k=1 +LOOPK C R7,=F'20' do k=1 to 20 + BH ELOOPK + LR R1,R7 k + LA R4,C-1(R1) @c(k) + MVC CI(1),0(R4) ci=c(k) + CLI CI,C'[' if ci='[' + BNE NOT1 + LA R6,1(R6) n=n+1 +NOT1 CLI CI,C']' if ci=']' + BNE NOT2 + BCTR R6,0 n=n-1 +NOT2 LTR R6,R6 if n<0 + BNM NSUP0 + SR R0,R0 return(0) + B RETCHECK +NSUP0 LA R7,1(R7) k=k+1 + B LOOPK +ELOOPK LTR R6,R6 if n=0 + BNZ ELSEN + LA R0,1 return(1) + B RETCHECK +ELSEN SR R0,R0 return(0) +RETCHECK BR R14 -------------- end checkbal +RANDOMX CNOP 0,4 -------------- randomx + LR R3,R2 i2 + SR R3,R1 ii=i2-i1 + L R5,SEED + M R4,=F'1103515245' + A R5,=F'12345' + SRDL R4,1 shift to improve the algorithm + ST R5,SEED seed=(seed*1103515245+12345)>>1 + LR R6,R3 ii + LA R6,1(R6) ii+1 + L R5,SEED seed + LA R4,0 clear + DR R4,R6 seed//(ii+1) + AR R4,R1 +i1 + LR R0,R4 return(seed//(ii+1)+i1) + BR R14 -------------- end randomx +SEED DC F'903313037' +C DS 20CL1 +Q DS CL1 +CI DS CL1 +PG DC CL80' ' +XDEC DS CL12 + REGS + END BALANCE diff --git a/Task/Balanced-brackets/AppleScript/balanced-brackets.applescript b/Task/Balanced-brackets/AppleScript/balanced-brackets.applescript new file mode 100644 index 0000000000..877f521975 --- /dev/null +++ b/Task/Balanced-brackets/AppleScript/balanced-brackets.applescript @@ -0,0 +1,188 @@ +-- CHECK NESTING OF SQUARE BRACKET SEQUENCES + +-- Zero-based index of the first problem (-1 if none found): + +-- imbalance :: String -> Integer +on imbalance(strBrackets) + script + on errorIndex(xs, iDepth, iIndex) + set lngChars to length of xs + if lngChars > 0 then + set iNext to iDepth + cond(item 1 of xs = "[", 1, -1) + + if iNext < 0 then -- closing bracket unmatched + iIndex + else + if lngChars > 1 then -- continue recursively + errorIndex(items 2 thru -1 of xs, iNext, iIndex + 1) + else -- end of string + cond(iNext = 0, -1, iIndex) + end if + end if + else + cond(iDepth = 0, -1, iIndex) + end if + end errorIndex + end script + + result's errorIndex(characters of strBrackets, 0, 0) +end imbalance + + + +-- TEST + +-- Random bracket sequences for testing +-- brackets :: Int -> String +on brackets(n) + -- bracket :: () -> String + script bracket + on lambda(_) + cond((random number) < 0.5, "[", "]") + end lambda + end script + intercalate("", map(bracket, range(1, n))) +end brackets + +on run + set nPairs to 6 + + -- report :: Int -> String + script report + property strPad : concatReplicate(nPairs * 2 + 4, space) + + on lambda(n) + set w to n * 2 + set s to brackets(w) + set i to imbalance(s) + set blnOK to (i = -1) + + set strStatus to cond(blnOK, "OK", "problem") + + set strLine to "'" & s & "'" & ¬ + (items (w + 2) thru -1 of strPad) & strStatus + + set strPointer to cond(blnOK, "", linefeed & concatReplicate(i + 1, space) & "^") + + intercalate("", {strLine, strPointer}) + end lambda + end script + + linefeed & ¬ + intercalate(linefeed, ¬ + map(report, range(0, nPairs))) & linefeed +end run + + +-- GENERIC LIBRARY FUNCTIONS + +-- 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 + +-- 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 + +-- Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate + +-- concatReplicate :: Int -> String -> String +on concatReplicate(n, s) + concat(replicate(n, s)) +end concatReplicate + +-- Egyptian multiplication - progressively doubling a list, appending +-- stages of doubling to an accumulator where needed for binary +-- assembly of a target length + +-- replicate :: Int -> a -> [a] +on replicate(n, a) + set out to {} + if n < 1 then return out + set dbl to {a} + + repeat while (n > 1) + if (n mod 2) > 0 then set out to out & dbl + set n to (n div 2) + set dbl to (dbl & dbl) + end repeat + return out & dbl +end replicate + +-- concat :: [[a]] -> [a] | [String] -> String +on concat(xs) + script append + on lambda(a, b) + a & b + end lambda + end script + + if length of xs > 0 and class of (item 1 of xs) is string then + foldl(append, "", xs) + else + foldl(append, {}, xs) + end if +end concat + +-- Value of one of two expressions +-- cond :: Bool -> a -> b -> c +on cond(bln, f, g) + if bln then + set e to f + else + set e to g + end if + if class of e is handler then + mReturn(e)'s lambda() + else + e + end if +end cond + +-- range :: Int -> Int -> [Int] +on range(m, n) + if n < m then + set d to -1 + else + set d to 1 + end if + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range + +-- 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 diff --git a/Task/Balanced-brackets/Elixir/balanced-brackets.elixir b/Task/Balanced-brackets/Elixir/balanced-brackets.elixir index 1833406a83..5bdbde59be 100644 --- a/Task/Balanced-brackets/Elixir/balanced-brackets.elixir +++ b/Task/Balanced-brackets/Elixir/balanced-brackets.elixir @@ -1,23 +1,20 @@ defmodule Balanced_brackets do def task do Enum.each(0..5, fn n -> - string = generate(n) - result = is_balanced(string) |> task_balanced - IO.puts "#{string} is #{result}" + brackets = generate(n) + result = is_balanced(brackets) |> task_balanced + IO.puts "#{brackets} is #{result}" end) end - def generate( 0 ), do: [] - def generate( n ) do - for _ <- 1..2*n, do: generate_bracket(:rand.uniform(2)) + defp generate( 0 ), do: [] + defp generate( n ) do + for _ <- 1..2*n, do: Enum.random ["[", "]"] end - defp generate_bracket( 1 ), do: "[" - defp generate_bracket( 2 ), do: "]" + def is_balanced( brackets ), do: is_balanced_loop( brackets, 0 ) - def is_balanced( string ), do: is_balanced_loop( string, 0 ) - - defp is_balanced_loop( _string, n ) when n < 0, do: false + defp is_balanced_loop( _, n ) when n < 0, do: false defp is_balanced_loop( [], 0 ), do: true defp is_balanced_loop( [], _n ), do: false defp is_balanced_loop( ["[" | t], n ), do: is_balanced_loop( t, n + 1 ) diff --git a/Task/Balanced-brackets/JavaScript/balanced-brackets-1.js b/Task/Balanced-brackets/JavaScript/balanced-brackets-1.js index 3c8c523386..6aa56cdb33 100644 --- a/Task/Balanced-brackets/JavaScript/balanced-brackets-1.js +++ b/Task/Balanced-brackets/JavaScript/balanced-brackets-1.js @@ -1,43 +1,17 @@ -function createRandomBracketSequence(maxlen) -{ - var chars = { '0' : '[' , '1' : ']' }; - function getRandomInteger(to) - { - return Math.floor(Math.random() * (to+1)); - } - var n = getRandomInteger(maxlen); - var result = []; - for(var i = 0; i < n; i++) - { - result.push(chars[getRandomInteger(1)]); - } - return result.join(""); +function shuffle(str) { + var a = str.split(''), b, c = a.length, d + while (c) b = Math.random() * c-- | 0, d = a[c], a[c] = a[b], a[b] = d + return a.join('') } -function bracketsAreBalanced(s) -{ - var open = (arguments.length > 1) ? arguments[1] : '['; - var close = (arguments.length > 2) ? arguments[2] : ']'; - var c = 0; - for(var i = 0; i < s.length; i++) - { - var ch = s.charAt(i); - if ( ch == open ) - { - c++; - } - else if ( ch == close ) - { - c--; - if ( c < 0 ) return false; - } - } - return c == 0; +function isBalanced(str) { + var a = str, b + do { b = a, a = a.replace(/\[\]/g, '') } while (a != b) + return !a } -var c = 0; -while ( c < 5 ) { - var seq = createRandomBracketSequence(8); - alert(seq + ':\t' + bracketsAreBalanced(seq)); - c++; +var M = 20 +while (M-- > 0) { + var N = Math.random() * 10 | 0, bs = shuffle('['.repeat(N) + ']'.repeat(N)) + console.log('"' + bs + '" is ' + (isBalanced(bs) ? '' : 'un') + 'balanced') } diff --git a/Task/Balanced-brackets/JavaScript/balanced-brackets-2.js b/Task/Balanced-brackets/JavaScript/balanced-brackets-2.js index 7f6f2b1ff7..6c8dc2cbe5 100644 --- a/Task/Balanced-brackets/JavaScript/balanced-brackets-2.js +++ b/Task/Balanced-brackets/JavaScript/balanced-brackets-2.js @@ -1,29 +1,60 @@ -function checkBalance(i) { - while (i.length % 2 == 0) { - j = i.replace('{}',''); - if (j == i) - break; - i = j; - } - return (i?false:true); -} +(() => { + 'use strict'; -var g = 10; -while (g--) { - var N = 10 - Math.floor(g/2), n=N, o=''; - while (n || N) { - if (N == 0 || n == 0) { - o+=Array(++N).join('}') + Array(++n).join('{'); - break; - } - if (Math.round(Math.random()) == 1) { - o+='}'; - N--; - } - else { - o+='{'; - n--; - } - } - alert(o+": "+checkBalance(o)); -} + // Int -> String + let randomBrackets = n => range(1, n) + .map(() => Math.random() < 0.5 ? '[' : ']') + .join(''); + + // imbalance :: String -> Integer + let imbalance = strBrackets => { + + // iDepth: initial nesting depth (0 = closed) + // iIndex: starting character position + + // errorIndex :: [Char] -> Int -> Int -> Int + let errorIndex = (xs, iDepth, iIndex) => { + if (xs.length > 0) { + let tail = xs.slice(1), + iNext = iDepth + (xs[0] === '[' ? 1 : -1); + + if (iNext < 0) return iIndex; // unmatched closing bracket + else return tail.length ? errorIndex( + tail, iNext, iIndex + 1 + ) : iNext === 0 ? -1 : iIndex; // balanced ? problem index ? + + } else return iDepth === 0 ? -1 : iIndex; + }; + + return errorIndex(strBrackets.split(''), 0, 0); + }; + + + // GENERIC FUNCTION + + // range :: Int -> Int -> [Int] + let range = (m, n) => + Array.from({ + length: Math.floor(n - m) + 1 + }, (_, i) => m + i); + + // TESTING AND FORMATTING OUTPUT + + let lngPairs = 6, + strPad = Array(lngPairs * 2 + 4) + .join(' '); + + return range(0, lngPairs) + .map(n => { + let w = n * 2, + s = randomBrackets(w), + i = imbalance(s), + blnOK = i === -1; + + return "'" + s + "'" + strPad.slice(w + 2) + + (blnOK ? 'OK' : 'problem') + + (blnOK ? '' : '\n' + Array(i + 2) + .join(' ') + '^'); + }) + .join('\n'); +})(); diff --git a/Task/Balanced-brackets/K/balanced-brackets.k b/Task/Balanced-brackets/K/balanced-brackets.k new file mode 100644 index 0000000000..77bf1e339f --- /dev/null +++ b/Task/Balanced-brackets/K/balanced-brackets.k @@ -0,0 +1,14 @@ + gen_brackets:{"[]"@x _draw 2} + check:{r:(-1;1)@"["=x; *(0=+/cs<'0)&(0=-1#cs:+\r)} + + {(x;check x)}' gen_brackets' 2*1+!10 +(("[[";0) + ("[][]";1) + ("][][]]";0) + ("[[][[][]";0) + ("][]][[[[[[";0) + ("]]][[]][]]][";0) + ("[[[]][[[][[[][";0) + ("[[]][[[]][]][][]";1) + ("][[][[]]][[]]]][][";0) + ("]][[[[]]]][][][[]]]]";0)) diff --git a/Task/Balanced-brackets/Oberon-2/balanced-brackets.oberon-2 b/Task/Balanced-brackets/Oberon-2/balanced-brackets.oberon-2 new file mode 100644 index 0000000000..fcd7006d6f --- /dev/null +++ b/Task/Balanced-brackets/Oberon-2/balanced-brackets.oberon-2 @@ -0,0 +1,102 @@ +MODULE BalancedBrackets; +IMPORT + Object, + Object:Boxed, + ADT:LinkedList, + ADT:Storable, + IO, + Out := NPCT:Console; + +TYPE + (* CHAR is not boxed in the standard lib *) + (* so make a boxed char *) + Character* = POINTER TO CharacterDesc; + CharacterDesc* = RECORD + (Boxed.ObjectDesc) + c: CHAR; + END; + +(* Method for a boxed char *) +PROCEDURE (c: Character) INIT*(x: CHAR); +BEGIN + c.c := x; +END INIT; + +PROCEDURE NewCharacter*(c: CHAR): Character; +VAR + x: Character; +BEGIN + NEW(x);x.INIT(c);RETURN x +END NewCharacter; + +PROCEDURE (c: Character) ToString*(): STRING; +BEGIN + RETURN Object.NewLatin1Char(c.c); +END ToString; + +PROCEDURE (c: Character) Load*(r: Storable.Reader) RAISES IO.Error; +BEGIN + r.ReadChar(c.c); +END Load; + +PROCEDURE (c: Character) Store*(w: Storable.Writer) RAISES IO.Error; +BEGIN + w.WriteChar(c.c); +END Store; + +PROCEDURE (c: Character) Cmp*(o: Object.Object): LONGINT; +BEGIN + IF c.c < o(Character).c THEN RETURN -1 + ELSIF c.c = o(Character).c THEN RETURN 0 + ELSE RETURN 1 + END +END Cmp; +(* end of methods for a boxed char *) + +PROCEDURE CheckBalance(str: STRING): BOOLEAN; +VAR + s: LinkedList.LinkedList(Character); + chars: Object.CharsLatin1; + n, x: Boxed.Object; + i,len: LONGINT; +BEGIN + i := 0; + chars := str(Object.String8).CharsLatin1(); + len := str.length; + s := NEW(LinkedList.LinkedList(Character)); + WHILE (i < len) & (chars[i] # 0X) DO + IF s.IsEmpty() THEN + s.Append(NewCharacter(chars[i])) (* Push character *) + ELSE + n := s.GetLast(); (* top character *) + WITH + n: Character DO + IF (chars[i] = ']') & (n.c = '[') THEN + x := s.RemoveLast(); (* Pop character *) + x := NIL + ELSE + s.Append(NewCharacter(chars[i])) + END + ELSE RETURN FALSE + END (* WITH *) + END; + INC(i) + END; + RETURN s.IsEmpty() +END CheckBalance; + +PROCEDURE Do; +VAR + str: STRING; +BEGIN + str := "[]";Out.String(str + ":> "); Out.Bool(CheckBalance(str));Out.Ln; + str := "[][]";Out.String(str + ":> ");Out.Bool(CheckBalance(str));Out.Ln; + str := "[[][]]";Out.String(str + ":> ");Out.Bool(CheckBalance(str));Out.Ln; + str := "][";Out.String(str + ":> ");Out.Bool(CheckBalance(str));Out.Ln; + str := "][][";Out.String(str + ":> ");Out.Bool(CheckBalance(str));Out.Ln; + str := "[]][[]";Out.String(str + ":> ");Out.Bool(CheckBalance(str));Out.Ln; +END Do; + +BEGIN + Do +END BalancedBrackets. diff --git a/Task/Balanced-brackets/Perl-6/balanced-brackets-3.pl6 b/Task/Balanced-brackets/Perl-6/balanced-brackets-3.pl6 index 9e2552ad64..c4271d1f23 100644 --- a/Task/Balanced-brackets/Perl-6/balanced-brackets-3.pl6 +++ b/Task/Balanced-brackets/Perl-6/balanced-brackets-3.pl6 @@ -1,5 +1,5 @@ sub balanced($_ is copy) { - () while s:g/'[]'//; + Nil while s:g/'[]'//; $_ eq ''; } diff --git a/Task/Balanced-brackets/PowerShell/balanced-brackets-1.psh b/Task/Balanced-brackets/PowerShell/balanced-brackets-1.psh new file mode 100644 index 0000000000..1ab6ded8d1 --- /dev/null +++ b/Task/Balanced-brackets/PowerShell/balanced-brackets-1.psh @@ -0,0 +1,18 @@ +function Get-BalanceStatus ( $String ) + { + $Open = 0 + ForEach ( $Character in [char[]]$String ) + { + switch ( $Character ) + { + "[" { $Open++ } + "]" { $Open-- } + default { $Open = -1 } + } + # If Open drops below zero (close before open or non-allowed character) + # Exit loop + If ( $Open -lt 0 ) { Break } + } + $Status = ( "NOT OK", "OK" )[( $Open -eq 0 )] + return $Status + } diff --git a/Task/Balanced-brackets/PowerShell/balanced-brackets-2.psh b/Task/Balanced-brackets/PowerShell/balanced-brackets-2.psh new file mode 100644 index 0000000000..733e1c50e7 --- /dev/null +++ b/Task/Balanced-brackets/PowerShell/balanced-brackets-2.psh @@ -0,0 +1,8 @@ +# Test +$Strings = @( "" ) +$Strings += 1..5 | ForEach { ( [char[]]("[]" * $_) | Get-Random -Count ( $_ * 2 ) ) -join "" } + +ForEach ( $String in $Strings ) + { + $String.PadRight( 12, " " ) + (Get-BalanceStatus $String) + } diff --git a/Task/Balanced-brackets/PowerShell/balanced-brackets-3.psh b/Task/Balanced-brackets/PowerShell/balanced-brackets-3.psh new file mode 100644 index 0000000000..35184e8424 --- /dev/null +++ b/Task/Balanced-brackets/PowerShell/balanced-brackets-3.psh @@ -0,0 +1,57 @@ +function Test-BalancedBracket +{ + <# + .SYNOPSIS + Tests a string for balanced brackets. + .DESCRIPTION + Tests a string for balanced brackets. ("<>", "[]", "{}" or "()") + .EXAMPLE + Test-BalancedBracket -Bracket Brace -String '{abc(def[0]).xyz}' + Test a string for balanced braces. + .EXAMPLE + Test-BalancedBracket -Bracket Curly -String '{abc(def[0]).xyz}' + Test a string for balanced curly braces. + .EXAMPLE + Test-BalancedBracket -Bracket Curly -String ([System.IO.File]::ReadAllText('.\Foo.ps1')) + Test a file for balanced curly braces. + .LINK + http://go.microsoft.com/fwlink/?LinkId=133231 + #> + [CmdletBinding()] + [OutputType([bool])] + Param + ( + [Parameter(Mandatory=$true)] + [ValidateSet("Angle", "Brace", "Curly", "Paren")] + [string] + $Bracket, + + [Parameter(Mandatory=$true)] + [AllowEmptyString()] + [string] + $String + ) + + $notFound = -1 + + $brackets = @{ + Angle = @{Left="<"; Right=">"; Regex="^[^<>]*(?>(?>(?'pair'\<)[^<>]*)+(?>(?'-pair'\>)[^<>]*)+)+(?(pair)(?!))$"} + Brace = @{Left="["; Right="]"; Regex="^[^\[\]]*(?>(?>(?'pair'\[)[^\[\]]*)+(?>(?'-pair'\])[^\[\]]*)+)+(?(pair)(?!))$"} + Curly = @{Left="{"; Right="}"; Regex="^[^{}]*(?>(?>(?'pair'\{)[^{}]*)+(?>(?'-pair'\})[^{}]*)+)+(?(pair)(?!))$"} + Paren = @{Left="("; Right=")"; Regex="^[^()]*(?>(?>(?'pair'\()[^()]*)+(?>(?'-pair'\))[^()]*)+)+(?(pair)(?!))$"} + } + + if ($String.IndexOf($brackets.$Bracket.Left) -eq $notFound -and + $String.IndexOf($brackets.$Bracket.Right) -eq $notFound -or $String -eq [String]::Empty) + { + return $true + } + + $String -match $brackets.$Bracket.Regex +} + + +'', '[]', '][', '[][]', '][][', '[[][]]', '[]][[]' | ForEach-Object { + if ($_ -eq "") { $s = "(Empty)" } else { $s = $_ } + "{0}: {1}" -f $s.PadRight(8), "$(if (Test-BalancedBracket Brace $s) {'Is balanced.'} else {'Is not balanced.'})" +} diff --git a/Task/Balanced-brackets/REXX/balanced-brackets-1.rexx b/Task/Balanced-brackets/REXX/balanced-brackets-1.rexx index 8d28138848..e3501cd4b2 100644 --- a/Task/Balanced-brackets/REXX/balanced-brackets-1.rexx +++ b/Task/Balanced-brackets/REXX/balanced-brackets-1.rexx @@ -1,38 +1,39 @@ -/*REXX program checks for balanced (square) brackets [ ] */ -@.=0; yesNo.0=left('',40) 'unbalanced' /*forty +1 leading blanks.*/ - yesNo.1= 'balanced' -q= ; call checkBal q; say yesNo.result q -q= '[][][][[]]' ; call checkBal q; say yesNo.result q -q= '[][][][[]]][' ; call checkBal q; say yesNo.result q -q= '[' ; call checkBal q; say yesNo.result q -q= ']' ; call checkBal q; say yesNo.result q -q= '[]' ; call checkBal q; say yesNo.result q -q= '][' ; call checkBal q; say yesNo.result q -q= '][][' ; call checkBal q; say yesNo.result q -q= '[[]]' ; call checkBal q; say yesNo.result q -q= '[[[[[[[]]]]]]]' ; call checkBal q; say yesNo.result q -q= '[[[[[]]]][]' ; call checkBal q; say yesNo.result q -q= '[][]' ; call checkBal q; say yesNo.result q -q= '[]][[]' ; call checkBal q; say yesNo.result q -q= ']]][[[[]' ; call checkBal q; say yesNo.result q - - do j=1 for 40 - q=translate(rand(random(1, 8)), '[]', 01) - call checkBal q; if result==-1 then iterate /*skip if duplicated.*/ - say yesNo.result q /*display the result.*/ - end /*j*/ /* [↑] generate 40 random "Q" strings.*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -?: ?=random(0,1); return ? || \? -/*────────────────────────────────────────────────────────────────────────────*/ -rand: ??=copies(?()?(), arg(1)); _=random(2, length(??)) - return left(??, _-1)substr(??, _) -/*────────────────────────────────────────────────────────────────────────────*/ -checkBal: procedure expose @.; parse arg y /*get the "bracket" expression. */ - if @.y then return -1 /*already done this expression ? */ - @.y=1 /*indicate expression processed. */ - !=0; do j=1 for length(y); _=substr(y,j,1) /*get a char.*/ - if _=='[' then !=!+1 /*bump nest #*/ +/*REXX program checks for balanced brackets [ ] ─── some fixed, others random.*/ +parse arg seed . /*obtain optional argument from the CL.*/ +if datatype(seed,'W') then call random ,,seed /*if specified, then use as RANDOM seed*/ +@.=0; yesNo.0= right('not OK', 50) /*for bad expressions, indent 50 spaces*/ + yesNo.1= 'OK' /* [↓] the 14 "fixed" ][ expressions*/ +q= ; call checkBal q; say yesNo.result '«null»' +q= '[][][][[]]' ; call checkBal q; say yesNo.result q +q= '[][][][[]]][' ; call checkBal q; say yesNo.result q +q= '[' ; call checkBal q; say yesNo.result q +q= ']' ; call checkBal q; say yesNo.result q +q= '[]' ; call checkBal q; say yesNo.result q +q= '][' ; call checkBal q; say yesNo.result q +q= '][][' ; call checkBal q; say yesNo.result q +q= '[[]]' ; call checkBal q; say yesNo.result q +q= '[[[[[[[]]]]]]]' ; call checkBal q; say yesNo.result q +q= '[[[[[]]]][]' ; call checkBal q; say yesNo.result q +q= '[][]' ; call checkBal q; say yesNo.result q +q= '[]][[]' ; call checkBal q; say yesNo.result q +q= ']]][[[[]' ; call checkBal q; say yesNo.result q +#=0 /*# additional random expressions*/ + do j=1 until #==26 /*gen 26 unique bracket strings. */ + q=translate( rand( random(1,10) ), '][', 10) /*generate random bracket string.*/ + call checkBal q; if result==-1 then iterate /*skip if duplicated expression. */ + say yesNo.result q /*display the result to console. */ + #=#+1 /*bump the expression counter. */ + end /*j*/ /* [↑] generate 26 random "Q" strings.*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +?: ?=random(0,1); return ? || \? /*REXX BIF*/ +rand: $=copies(?()?(),arg(1)); _=random(2,length($)); return left($,_-1)substr($,_) +/*──────────────────────────────────────────────────────────────────────────────────────*/ +checkBal: procedure expose @.; parse arg y /*obtain the "bracket" expression. */ + if @.y then return -1 /*Done this expression before? Skip it*/ + @.y=1 /*indicate expression was processed. */ + !=0; do j=1 for length(y); _=substr(y,j,1) /*get a character.*/ + if _=='[' then !=!+1 /*bump the nest #.*/ else do; !=!-1; if !<0 then return 0; end end /*j*/ - return !==0 /* [↑] "!" is the nested counter.*/ + return !==0 /* [↑] "!" is the nested ][ counter.*/ diff --git a/Task/Balanced-brackets/REXX/balanced-brackets-3.rexx b/Task/Balanced-brackets/REXX/balanced-brackets-3.rexx index 9bdc0f5e8a..0c898dc38b 100644 --- a/Task/Balanced-brackets/REXX/balanced-brackets-3.rexx +++ b/Task/Balanced-brackets/REXX/balanced-brackets-3.rexx @@ -1,23 +1,21 @@ -/*REXX program checks for numerous generated balanced (square) brackets [ ] */ +/*REXX program checks for around 125,000 generated balanced brackets expressions [ ] */ bals=0 -#=0; do j=1 until length(q)>20 /*generate lots of bracket permutations*/ - q=translate(strip(x2b(d2x(j)),'L',0),"][",01) /*convert ──► []*/ - if countStr(']',q)\==countstr('[',q) then iterate /*is compliant? */ - call checkBal q - end /*j*/ /*have all 20─character possibilities? */ -say -say # " expressions were checked, " bals ' were balanced, ' , - #-bals " were unbalanced." -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -checkBal: procedure expose # bals; parse arg y; #=#+1 /*bump count.*/ -!=0 - do j=1 for length(y) - if substr(y,j,1)=='[' then !=!+1 - else do; !=!-1; if !<0 then leave; end - end /*j*/ -bals=bals + (!==0) -return !==0 -/*────────────────────────────────────────────────────────────────────────────*/ +#=0; do j=1 until L>20 /*generate lots of bracket permutations*/ + q=translate( strip( x2b( d2x(j) ), 'L', 0), "][", 01) /*convert ──► ][*/ + L=length(q) + if countStr(']', q) \== countstr('[', q) then iterate /*not compliant?*/ + #=#+1 /*bump legal Q's*/ + !=0; do k=1 for L; parse var q ? 2 q + if ?=='[' then !=!+1 + else do; !=!-1; if !<0 then iterate j; end + end /*k*/ + + if !==0 then bals=bals+1 + end /*j*/ /*done all 20─character possibilities? */ + +say # " expressions were checked, " bals ' were balanced, ' , + #-bals " were unbalanced." +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ countStr: procedure; parse arg n,h,s; if s=='' then s=1; w=length(n) do r=0 until _==0; _=pos(n,h,s); s=_+w; end; return r diff --git a/Task/Balanced-brackets/Scala/balanced-brackets-4.scala b/Task/Balanced-brackets/Scala/balanced-brackets-4.scala new file mode 100644 index 0000000000..85761bc60c --- /dev/null +++ b/Task/Balanced-brackets/Scala/balanced-brackets-4.scala @@ -0,0 +1,18 @@ +@scala.annotation.tailrec +final def isBalanced( + str: List[Char], + // accumulator|indicator|flag + balance: Int = 0, + options_Map: Map[Char, Int] = Map(('[' -> 1), (']' -> -1)) +): Boolean = if (balance < 0) { + // base case + false +} else { + if (str.isEmpty){ + // base case + balance == 0 + } else { + // recursive step + isBalanced(str.tail, balance + options_Map(str.head)) + } +} diff --git a/Task/Balanced-brackets/Standard-ML/balanced-brackets-1.ml b/Task/Balanced-brackets/Standard-ML/balanced-brackets-1.ml new file mode 100644 index 0000000000..7772a2ba2d --- /dev/null +++ b/Task/Balanced-brackets/Standard-ML/balanced-brackets-1.ml @@ -0,0 +1,7 @@ +fun isBalanced s = checkBrackets 0 (String.explode s) +and checkBrackets 0 [] = true + | checkBrackets _ [] = false + | checkBrackets ~1 _ = false + | checkBrackets counter (#"["::rest) = checkBrackets (counter + 1) rest + | checkBrackets counter (#"]"::rest) = checkBrackets (counter - 1) rest + | checkBrackets counter (_::rest) = checkBrackets counter rest diff --git a/Task/Balanced-brackets/Standard-ML/balanced-brackets-2.ml b/Task/Balanced-brackets/Standard-ML/balanced-brackets-2.ml new file mode 100644 index 0000000000..e8322069d9 --- /dev/null +++ b/Task/Balanced-brackets/Standard-ML/balanced-brackets-2.ml @@ -0,0 +1,11 @@ +val () = + List.app print + (List.map + (* Turn `true' and `false' to `OK' and `NOT OK' respectively *) + (fn s => if isBalanced s + then s ^ "\t\tOK\n" + else s ^ "\t\tNOT OK\n" + ) + (* A set of strings to test *) + ["", "[]", "[][]", "[[][]]", "][", "][][", "[]][[]"] + ) diff --git a/Task/Balanced-brackets/TXR/balanced-brackets.txr b/Task/Balanced-brackets/TXR/balanced-brackets.txr index 4242645417..80187ba156 100644 --- a/Task/Balanced-brackets/TXR/balanced-brackets.txr +++ b/Task/Balanced-brackets/TXR/balanced-brackets.txr @@ -1,15 +1,5 @@ @(define paren)@(maybe)[@(coll)@(paren)@(until)]@(end)]@(end)@(end) @(do (defvar r (make-random-state nil)) - (defun shuffle (list) - (for* ((vec (vector-list list)) - (len (length vec)) - (i 0)) - ((< i len) (list-vector vec)) - ((inc i)) - (let ((j (random r len)) - (temp [vec i])) - (set [vec i] [vec j]) - (set [vec j] temp)))) (defun generate-1 (count) (let ((bkt (repeat "[]" count))) diff --git a/Task/Balanced-brackets/ZX-Spectrum-Basic/balanced-brackets.zx b/Task/Balanced-brackets/ZX-Spectrum-Basic/balanced-brackets.zx new file mode 100644 index 0000000000..2b9223b155 --- /dev/null +++ b/Task/Balanced-brackets/ZX-Spectrum-Basic/balanced-brackets.zx @@ -0,0 +1,17 @@ +10 FOR n=1 TO 7 +20 READ s$ +25 PRINT "The sequence ";s$;" is "; +30 GO SUB 1000 +40 NEXT n +50 STOP +1000 LET s=0 +1010 FOR k=1 TO LEN s$ +1020 LET c$=s$(k) +1030 IF c$="[" THEN LET s=s+1 +1040 IF c$="]" THEN LET s=s-1 +1050 IF s<0 THEN PRINT "Bad!": RETURN +1060 NEXT k +1070 IF s=0 THEN PRINT "Good!": RETURN +1090 PRINT "Bad!" +1100 RETURN +2000 DATA "[]","][","][][","[][]","[][][]","[]][[]","[[[[[]]]]][][][]][][" diff --git a/Task/Balanced-ternary/00DESCRIPTION b/Task/Balanced-ternary/00DESCRIPTION index eed72da3b5..8b5e2bf233 100644 --- a/Task/Balanced-ternary/00DESCRIPTION +++ b/Task/Balanced-ternary/00DESCRIPTION @@ -7,7 +7,7 @@ For this task, implement balanced ternary representation of integers with the fo # Provide ways to convert to and from text strings, using digits '+', '-' and '0' (unless you are already using strings to represent balanced ternary; but see requirement 5). # Provide ways to convert to and from native integer type (unless, improbably, your platform's native integer type ''is'' balanced ternary). If your native integers can't support arbitrary length, overflows during conversion must be indicated. # Provide ways to perform addition, negation and multiplication directly on balanced ternary integers; do ''not'' convert to native integers first. -# Make your implementation efficient, with a reasonable definition of "effcient" (and with a reasonable definition of "reasonable"). +# Make your implementation efficient, with a reasonable definition of "efficient" (and with a reasonable definition of "reasonable"). '''Test case''' With balanced ternaries ''a'' from string "+-0++0+", ''b'' from native integer -436, ''c'' "+-++-": * write out ''a'', ''b'' and ''c'' in decimal notation; diff --git a/Task/Balanced-ternary/Haskell/balanced-ternary.hs b/Task/Balanced-ternary/Haskell/balanced-ternary.hs index 6da454b2a2..e205728be6 100644 --- a/Task/Balanced-ternary/Haskell/balanced-ternary.hs +++ b/Task/Balanced-ternary/Haskell/balanced-ternary.hs @@ -1,10 +1,9 @@ data BalancedTernary = Bt [Int] zeroTrim a = if null s then [0] else s where - s = f [] [] a - f x _ [] = x - f x y (0:zs) = f x (y++[0]) zs - f x y (z:zs) = f (x++y++[z]) [] zs + s = fst $ foldl f ([],[]) a + f (x,y) 0 = (x, y++[0]) + f (x,y) z = (x++y++[z], []) btList (Bt a) = a diff --git a/Task/Balanced-ternary/Perl-6/balanced-ternary.pl6 b/Task/Balanced-ternary/Perl-6/balanced-ternary.pl6 index 5ddee3ec7d..cec0406c55 100644 --- a/Task/Balanced-ternary/Perl-6/balanced-ternary.pl6 +++ b/Task/Balanced-ternary/Perl-6/balanced-ternary.pl6 @@ -5,10 +5,10 @@ class BT { my %bt2co = %co2bt.invert; multi method new (Str $s) { - self.bless(*, coeff => %bt2co{$s.flip.comb}); + self.bless(coeff => %bt2co{$s.flip.comb}); } multi method new (Int $i where $i >= 0) { - self.bless(*, coeff => carry $i.base(3).comb.reverse); + self.bless(coeff => carry $i.base(3).comb.reverse); } multi method new (Int $i where $i < 0) { self.new(-$i).neg; @@ -35,7 +35,7 @@ multi prefix:<-> (BT $x) { $x.neg } multi infix:<+> (BT $x, BT $y) { my ($b,$a) = sort +*.coeff, $x, $y; - BT.new: coeff => carry $a.coeff Z+ $b.coeff, 0 xx *; + BT.new: coeff => carry ($a.coeff Z+ |$b.coeff, |(0 xx $a.coeff - $b.coeff)); } multi infix:<-> (BT $x, BT $y) { $x + $y.neg } @@ -46,7 +46,7 @@ multi infix:<*> (BT $x, BT $y) { my @z = 0 xx @x+@y-1; my @safe; for @x -> $xd { - @z = @z Z+ (@y X* $xd), 0 xx *; + @z = @z Z+ |(@y X* $xd), |(0 xx @z-@y); @safe.push: @z.shift; } BT.new: coeff => carry @safe, @z; diff --git a/Task/Benfords-law/00DESCRIPTION b/Task/Benfords-law/00DESCRIPTION index 246bf34e89..8d16c4716b 100644 --- a/Task/Benfords-law/00DESCRIPTION +++ b/Task/Benfords-law/00DESCRIPTION @@ -1,18 +1,31 @@ {{Wikipedia|Benford's_law}} -'''Benford's law''', also called the '''first-digit law''', refers to the frequency distribution of digits in many (but not all) real-life sources of data. In this distribution, the number 1 occurs as the first digit about 30% of the time, while larger numbers occur in that position less frequently: 9 as the first digit less than 5% of the time. This distribution of first digits is the same as the widths of gridlines on a logarithmic scale. Benford's law also concerns the expected distribution for digits beyond the first, which approach a uniform distribution. + +
+'''Benford's law''', also called the '''first-digit law''', refers to the frequency distribution of digits in many (but not all) real-life sources of data. + +In this distribution, the number 1 occurs as the first digit about 30% of the time, while larger numbers occur in that position less frequently: 9 as the first digit less than 5% of the time. This distribution of first digits is the same as the widths of gridlines on a logarithmic scale. + +Benford's law also concerns the expected distribution for digits beyond the first, which approach a uniform distribution. This result has been found to apply to a wide variety of data sets, including electricity bills, street addresses, stock prices, population numbers, death rates, lengths of rivers, physical and mathematical constants, and processes described by power laws (which are very common in nature). It tends to be most accurate when values are distributed across multiple orders of magnitude. -A set of numbers is said to satisfy Benford's law if the leading digit d (d \in \{1, \ldots, 9\}) occurs with probability +A set of numbers is said to satisfy Benford's law if the leading digit d  (d \in \{1, \ldots, 9\}) occurs with probability -:P(d) = \log_{10}(d+1)-\log_{10}(d) = \log_{10}\left(1+\frac{1}{d}\right) +:::: P(d) = \log_{10}(d+1)-\log_{10}(d) = \log_{10}\left(1+\frac{1}{d}\right) For this task, write (a) routine(s) to calculate the distribution of first significant (non-zero) digits in a collection of numbers, then display the actual vs. expected distribution in the way most convenient for your language (table / graph / histogram / whatever). -Use the first 1000 numbers from the Fibonacci sequence as your data set. No need to show how the Fibonacci numbers are obtained. You can [[Fibonacci sequence|generate]] them or load them [http://www.ibiblio.org/pub/docs/books/gutenberg/etext01/fbncc10.txt from a file]; whichever is easiest. Display your actual vs expected distribution. +Use the first 1000 numbers from the Fibonacci sequence as your data set. No need to show how the Fibonacci numbers are obtained. + +You can [[Fibonacci sequence|generate]] them or load them [http://www.fullbooks.com/The-first-1001-Fibonacci-Numbers.html from a file]; whichever is easiest. + +Display your actual vs expected distribution. + ''For extra credit:'' Show the distribution for one other set of numbers from a page on Wikipedia. State which Wikipedia page it can be obtained from and what the set enumerates. Again, no need to display the actual list of numbers or the code to load them. + ;See also: * [http://www.numberphile.com/videos/benfords_law.html numberphile.com]. * A starting page on Wolfram Mathworld is {{Wolfram|Benfords|Law}}. +

diff --git a/Task/Benfords-law/Kotlin/benfords-law.kotlin b/Task/Benfords-law/Kotlin/benfords-law.kotlin index 7754a2acc5..672999972e 100644 --- a/Task/Benfords-law/Kotlin/benfords-law.kotlin +++ b/Task/Benfords-law/Kotlin/benfords-law.kotlin @@ -1,34 +1,35 @@ -package benford - import java.math.BigInteger interface NumberGenerator { val numbers: Array } -class Benford(val ng: NumberGenerator) { +class Benford(ng: NumberGenerator) { override fun toString() = str private val firstDigits = IntArray(9) - private val count= ng.numbers.size() + private val count = ng.numbers.size.toDouble() private val str: String init { for (n in ng.numbers) firstDigits[n.toString().substring(0, 1).toInt() - 1]++ - val result = StringBuilder() - for (i in firstDigits.indices) { - result.append(i + 1).append('\t').append(firstDigits[i] / count.toDouble()) - result.append('\t').append(Math.log10(1 + 1.0 / (i + 1))).append('\n') + + str = with(StringBuilder()) { + for (i in firstDigits.indices) { + append(i + 1).append('\t').append(firstDigits[i] / count) + append('\t').append(Math.log10(1 + 1.0 / (i + 1))).append('\n') + } + + toString() } - str = result.toString() } } object FibonacciGenerator : NumberGenerator { override val numbers: Array by lazy { val fib = Array(1000, { BigInteger.ONE }) - for (i in 2..fib.size() - 1) + for (i in 2..fib.size - 1) fib[i] = fib[i - 2].add(fib[i - 1]) fib } diff --git a/Task/Benfords-law/OCaml/benfords-law.ocaml b/Task/Benfords-law/OCaml/benfords-law.ocaml new file mode 100644 index 0000000000..3560954f91 --- /dev/null +++ b/Task/Benfords-law/OCaml/benfords-law.ocaml @@ -0,0 +1,30 @@ +open Num + +let fib = + let rec fib_aux f0 f1 = function + | 0 -> f0 + | 1 -> f1 + | n -> fib_aux f1 (f1 +/ f0) (n - 1) + in + fib_aux (num_of_int 0) (num_of_int 1) ;; + +let create_fibo_string = function n -> string_of_num (fib n) ;; +let rec range i j = if i > j then [] else i :: (range (i + 1) j) + +let n_max = 1000 ;; + +let numbers = range 1 n_max in + let get_first_digit = function s -> Char.escaped (String.get s 0) in + let first_digits = List.map get_first_digit (List.map create_fibo_string numbers) in + let data = Array.create 9 0 in + let fill_data vec = function n -> vec.(n - 1) <- vec.(n - 1) + 1 in + List.iter (fill_data data) (List.map int_of_string first_digits) ; + Printf.printf "\nFrequency of the first digits in the Fibonacci sequence:\n" ; + Array.iter (Printf.printf "%f ") + (Array.map (fun x -> (float x) /. float (n_max)) data) ; + +let xvalues = range 1 9 in + let benfords_law = function x -> log10 (1.0 +. 1.0 /. float (x)) in + Printf.printf "\nPrediction of Benford's law:\n " ; + List.iter (Printf.printf "%f ") (List.map benfords_law xvalues) ; + Printf.printf "\n" ;; diff --git a/Task/Benfords-law/Oberon-2/benfords-law.oberon-2 b/Task/Benfords-law/Oberon-2/benfords-law.oberon-2 new file mode 100644 index 0000000000..5ab46a328e --- /dev/null +++ b/Task/Benfords-law/Oberon-2/benfords-law.oberon-2 @@ -0,0 +1,43 @@ +MODULE BenfordLaw; +IMPORT + LRealStr, + LRealMath, + Out := NPCT:Console; + +VAR + r: ARRAY 1000 OF LONGREAL; + d: ARRAY 10 OF LONGINT; + a: LONGREAL; + i: LONGINT; + +PROCEDURE Fibb(VAR r: ARRAY OF LONGREAL); +VAR + i: LONGINT; +BEGIN + r[0] := 1.0;r[1] := 1.0; + FOR i := 2 TO LEN(r) - 1 DO + r[i] := r[i - 2] + r[i - 1] + END +END Fibb; + +PROCEDURE Dist(r [NO_COPY]: ARRAY OF LONGREAL; VAR d: ARRAY OF LONGINT); +VAR + i: LONGINT; + str: ARRAY 256 OF CHAR; +BEGIN + FOR i := 0 TO LEN(r) - 1 DO + LRealStr.RealToStr(r[i],str); + INC(d[ORD(str[0]) - ORD('0')]) + END +END Dist; + +BEGIN + Fibb(r); + Dist(r,d); + Out.String("First 1000 fibonacci numbers: ");Out.Ln; + Out.String(" digit ");Out.String(" observed ");Out.String(" predicted ");Out.Ln; + FOR i := 1 TO LEN(d) - 1 DO + a := LRealMath.ln(1.0 + 1.0 / i ) / LRealMath.ln(10); + Out.Int(i,5);Out.LongRealFix(d[i] / 1000.0,9,3);Out.LongRealFix(a,10,3);Out.Ln + END +END BenfordLaw. diff --git a/Task/Benfords-law/Pascal/benfords-law.pascal b/Task/Benfords-law/Pascal/benfords-law.pascal new file mode 100644 index 0000000000..d89a883b6d --- /dev/null +++ b/Task/Benfords-law/Pascal/benfords-law.pascal @@ -0,0 +1,53 @@ +program fibFirstdigit; +{$IFDEF FPC}{$MODE Delphi}{$ELSE}{$APPTYPE CONSOLE}{$ENDIF} +uses + sysutils; +type + tDigitCount = array[0..9] of LongInt; +var + s: Ansistring; + dgtCnt, + expectedCnt : tDigitCount; + +procedure GetFirstDigitFibonacci(var dgtCnt:tDigitCount;n:LongInt=1000); +//summing up only the first 9 digits +//n = 1000 -> difference to first 9 digits complete fib < 100 == 2 digits +var + a,b,c : LongWord;//about 9.6 decimals +Begin + for a in dgtCnt do dgtCnt[a] := 0; + a := 0;b := 1; + while n > 0 do + Begin + c := a+b; + //overflow? round and divide by base 10 + IF c < a then + Begin a := (a+5) div 10;b := (b+5) div 10;c := a+b;end; + a := b;b := c; + s := IntToStr(a);inc(dgtCnt[Ord(s[1])-Ord('0')]); + dec(n); + end; +end; + +procedure InitExpected(var dgtCnt:tDigitCount;n:LongInt=1000); +var + i: integer; +begin + for i := 1 to 9 do + dgtCnt[i] := trunc(n*ln(1 + 1 / i)/ln(10)); +end; + +var + reldiff: double; + i,cnt: integer; +begin + cnt := 1000; + InitExpected(expectedCnt,cnt); + GetFirstDigitFibonacci(dgtCnt,cnt); + writeln('Digit count expected rel diff'); + For i := 1 to 9 do + Begin + reldiff := 100*(expectedCnt[i]-dgtCnt[i])/expectedCnt[i]; + writeln(i:5,dgtCnt[i]:7,expectedCnt[i]:10,reldiff:10:5,' %'); + end; +end. diff --git a/Task/Benfords-law/Perl-6/benfords-law.pl6 b/Task/Benfords-law/Perl-6/benfords-law.pl6 index 0f265b2d01..88eea5e1ad 100644 --- a/Task/Benfords-law/Perl-6/benfords-law.pl6 +++ b/Task/Benfords-law/Perl-6/benfords-law.pl6 @@ -1,4 +1,4 @@ -sub benford(@a) { bag +« @a».comb: /<( <[ 1..9 ]> )> <[ , . \d ]>*/ } +sub benford(@a) { bag +« @a».substr(0,1) } sub show(%distribution) { printf "%9s %9s %s\n", ; diff --git a/Task/Benfords-law/PowerShell/benfords-law.psh b/Task/Benfords-law/PowerShell/benfords-law.psh new file mode 100644 index 0000000000..32add2876b --- /dev/null +++ b/Task/Benfords-law/PowerShell/benfords-law.psh @@ -0,0 +1,16 @@ +$url = "https://oeis.org/A000045/b000045.txt" +$file = "$env:TEMP\FibonacciNumbers.txt" +(New-Object System.Net.WebClient).DownloadFile($url, $file) + +$benford = Get-Content -Path $file | + Select-Object -Skip 1 -First 1000 | + ForEach-Object {(($_ -split " ")[1].ToString().ToCharArray())[0]} | + Group-Object | + Select-Object -Property @{Name="Digit" ; Expression={[int]($_.Name)}}, + Count, + @{Name="Actual" ; Expression={$_.Count/1000}}, + @{Name="Expected"; Expression={[double]("{0:f5}" -f [Math]::Log10(1 + 1 / $_.Name))}} + +$benford | Sort-Object -Property Digit | Format-Table -AutoSize + +Remove-Item -Path $file -Force -ErrorAction SilentlyContinue diff --git a/Task/Benfords-law/REXX/benfords-law.rexx b/Task/Benfords-law/REXX/benfords-law.rexx index 893b777c59..0599cf225f 100644 --- a/Task/Benfords-law/REXX/benfords-law.rexx +++ b/Task/Benfords-law/REXX/benfords-law.rexx @@ -1,33 +1,34 @@ -/*REXX program demonstrates some common trig functions (30 digits shown)*/ -numeric digits 50 /*use only 50 digits for LN, LOG.*/ -parse arg N .; if N=='' then N=1000 /*allow sample size specification*/ - /*══════════════apply Benford's law to Fibonacci numbers.*/ -@.=1; do j=3 to N; jm1=j-1; jm2=j-2; @.j=@.jm2+@.jm1; end /*j*/ -call show_results "Benford's law applied to" N 'Fibonacci numbers' - /*══════════════apply Benford's law to prime numbers. */ -p=0; do j=2 until p==N; if \isPrime(j) then iterate; p=p+1; @.p=j;end -call show_results "Benford's law applied to" N 'prime numbers' - /*══════════════apply Benford's law to factorials. */ - do j=1 for N; @.j=!(j); end /*j*/ -call show_results "Benford's law applied to" N 'factorial products' -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────SHOW_RESULTS subroutine─────────────*/ -show_results: w1=max(length('observed'),length(N-2)) ; say -pad=' '; w2=max(length('expected' ),length(N )) -say pad 'digit' pad center('observed',w1) pad center('expected',w2) -say pad '─────' pad center('',w1,'─') pad center('',w2,'─') pad arg(1) -!.=0; do j=1 for N; _=left(@.j,1); !._=!._+1; end /*get 1st digits.*/ +/*REXX program demonstrates some common functions (thirty decimal digits are shown). */ +numeric digits 50 /*use only 50 dec digits for LN & LOG.*/ +parse arg N .; if N=='' | N=="," then N=1000 /*allow sample size to be specified. */ +@benny= "Benford's law applied to" /*a handy-dandy literal for some SAYs. */ +w1= max( length('observed'), length(N-2) ); pad=" " /*used for aligning output.*/ +w2= max( length('expected'), length(N ) ) /* " " " " */ - do k=1 for 9 /*show results for Fibonacci nums*/ - say pad center(k,5) pad center(format(!.k/N,,length(N-2)),w1), - pad center(format(log(1+1/k),,length(N)+2),w2) - end /*k*/ -return -/*──────────────────────────────────one─line subroutines───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/ -!: procedure; parse arg x; !=1; do j=2 to x; !=!*j; end /*j*/; return ! -e: return 2.7182818284590452353602874713526624977572470936999595749669676277240766303535 -isprime: procedure; parse arg x; if wordpos(x,'2 3 5 7')\==0 then return 1; if x//2==0 then return 0; if x//3==0 then return 0; do j=5 by 6 until j*j>x; if x//j==0 then return 0; if x//(j+2)==0 then return 0; end; return 1 -ln10:return 2.30258509299404568401799145468436420760110148862877297603332790096757260967735248023599720508959829834196778404228624863340952546508280675666628736909878168948290720832555468084379989482623319852839350530896538 -ln:procedure expose $.;parse arg x,f;if x==10 then do;_=ln10();xx=format(_);if xx\==_ then return xx;end;call e;ig=x>1.5;is=1-2*(ig\==1);ii=0;xx=x;return .ln_comp() -.ln_comp:do while ig&xx>1.5|\ig&xx<.5;_=e();do k=-1;iz=xx*_**-is;if k>=0&(ig&iz<1|\ig&iz>.5) then leave;_=_*_;izz=iz;end;xx=izz;ii=ii+is*2**k;end;x=x*e()**-ii-1;z=0;_=-1;p=z;do k=1;_=-_*x;z=z+_/k;if z=p then leave;p=z;end;return z+ii -log:return ln(arg(1))/ln(10) +@.=1; do j=3 to N; jm1=j-1; jm2=j-2; @.j=@.jm2 + @.jm1; end /*j*/ +call show @benny N 'Fibonacci numbers' +p=1; @.1=2 + do j=3 by 2 until p==N; if \isPrime(j) then iterate; p=p+1; @.p=j; end /*j*/ +call show @benny N 'prime numbers' + + do j=1 for N; @.j=!(j); end /*j*/ +call show @benny N 'factorial products' +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/ +!: procedure; parse arg x; !=1; do j=2 to x; !=!*j; end /*j*/; return ! +e: return 2.7182818284590452353602874713526624977572470936999595749669676277240766303535 +isPrime: procedure; parse arg x; if wordpos(x,'2 3 5 7')\==0 then return 1; if x//2==0 then return 0; if x//3==0 then return 0; do j=5 by 6 until j*j>x; if x//j==0 then return 0; if x//(j+2)==0 then return 0; end; return 1 +ln10: return 2.30258509299404568401799145468436420760110148862877297603332790096757260967735248023599720508959829834196778404228624863340952546508280675666628736909878168948290720832555468084379989482623319852839350530896538 +ln: procedure; parse arg x,f; if x==10 then do; _=ln10(); y=format(_); if y\==_ then return y; end; call e; ig=(x>1.5); is=1 - 2*(ig\==1); ii=0; s=x; return .ln_comp() +.ln_comp: do while ig&s>1.5|\ig&s<.5;_=e();do k=-1;iz=s*_**-is;if k>=0&(ig&iz<1|\ig&iz>.5) then leave;_=_*_;izz=iz;end;s=izz;ii=ii+is*2**k;end;x=x*e()**-ii-1;z=0;_=-1;p=z;do k=1;_=-_*x;z=z+_/k;if z=p then leave;p=z;end;return z+ii +log: return ln( arg(1) ) / ln(10) +/*──────────────────────────────────────────────────────────────────────────────────────*/ +show: say; say pad 'digit' pad center("observed",w1) pad center('expected',w2) + say pad '─────' pad center("",w1,'─') pad center("",w2,'─') pad arg(1) + !.=0; do j=1 for N; _=left(@.j,1); !._=!._+1; end /*get 1st digits.*/ + + do k=1 for 9 /*show results for decimal digits*/ + say pad center(k,5) pad center(format(!.k /N , , length(N-2) ), w1), + pad center(format(log(1+1 /k) , , length(N)+2 ), w2) + end /*k*/ + return diff --git a/Task/Benfords-law/Rust/benfords-law.rust b/Task/Benfords-law/Rust/benfords-law.rust new file mode 100644 index 0000000000..d13ec15026 --- /dev/null +++ b/Task/Benfords-law/Rust/benfords-law.rust @@ -0,0 +1,51 @@ +extern crate num_traits; +extern crate num; + +use num::bigint::{BigInt, ToBigInt}; +use num_traits::{Zero, One}; +use std::collections::HashMap; + +// Return a vector of all fibonacci results from fib(1) to fib(n) +fn fib(n: usize) -> Vec { + let mut result = Vec::with_capacity(n); + let mut a = BigInt::zero(); + let mut b = BigInt::one(); + + result.push(b.clone()); + + for i in 1..n { + let t = b.clone(); + b = a+b; + a = t; + result.push(b.clone()); + } + + result +} + +// Return the first digit of a `BigInt` +fn first_digit(x: &BigInt) -> u8 { + let zero = BigInt::zero(); + assert!(x > &zero); + + let s = x.to_str_radix(10); + + // parse the first digit of the stringified integer + *&s[..1].parse::().unwrap() +} + +fn main() { + const N: usize = 1000; + let mut counter: HashMap = HashMap::new(); + for x in fib(N) { + let d = first_digit(&x); + *counter.entry(d).or_insert(0) += 1; + } + + println!("{:>13} {:>10}", "real", "predicted"); + for y in 1..10 { + println!("{}: {:10.3} v. {:10.3}", y, *counter.get(&y).unwrap_or(&0) as f32 / N as f32, + (1.0 + 1.0 / (y as f32)).log10()); + } + +} diff --git a/Task/Benfords-law/ZX-Spectrum-Basic/benfords-law.zx b/Task/Benfords-law/ZX-Spectrum-Basic/benfords-law.zx new file mode 100644 index 0000000000..a926d6d6da --- /dev/null +++ b/Task/Benfords-law/ZX-Spectrum-Basic/benfords-law.zx @@ -0,0 +1,23 @@ +10 RANDOMIZE +20 DIM b(9) +30 LET n=100 +40 FOR i=1 TO n +50 GO SUB 1000 +60 LET n$=STR$ fiboI +70 LET d=VAL n$(1) +80 LET b(d)=b(d)+1 +90 NEXT i +100 PRINT "Digit";TAB 6;"Actual freq";TAB 18;"Expected freq" +110 FOR i=1 TO 9 +120 LET pdi=(LN (i+1)/LN 10)-(LN i/LN 10) +130 PRINT i;TAB 6;b(i)/n;TAB 18;pdi +140 NEXT i +150 STOP +1000 REM Fibonacci +1010 LET fiboI=0: LET b=1 +1020 FOR j=1 TO i +1030 LET temp=fiboI+b +1040 LET fiboI=b +1050 LET b=temp +1060 NEXT j +1070 RETURN diff --git a/Task/Bernoulli-numbers/00DESCRIPTION b/Task/Bernoulli-numbers/00DESCRIPTION index 44976b1d42..04cc15473b 100644 --- a/Task/Bernoulli-numbers/00DESCRIPTION +++ b/Task/Bernoulli-numbers/00DESCRIPTION @@ -1,11 +1,19 @@ -[[wp:Bernoulli number|Bernoulli numbers]] are used in some series expansions of several functions (trigonometric, hyperbolic, gamma, etc.), and are extremely important in number theory and analysis. Note that there are two definitions of Bernoulli numbers; this task will be using the modern usage (as per the National Institute of Standards and Technology convention). The n'th Bernoulli number is expressed as '''B'''''n''. +[[wp:Bernoulli number|Bernoulli numbers]] are used in some series expansions of several functions (trigonometric, hyperbolic, gamma, etc.), and are extremely important in number theory and analysis. + +Note that there are two definitions of Bernoulli numbers; this task will be using the modern usage (as per the National Institute of Standards and Technology convention). + +The  nth  Bernoulli number is expressed as  '''B'''n. +
;Task -* show the Bernoulli numbers '''B'''0 through '''B'''60, suppressing all output of values which are equal to zero. (Other than '''B'''1, all odd Bernoulli numbers have a value of 0 (zero). -* express the numbers as fractions (most are improper fractions). -** fractions should be reduced. -** index each number in some way so that it can be discerned which number is being displayed. -** align the solidi (/) if used (extra credit). + +:*   show the Bernoulli numbers   '''B'''0   through   '''B'''60. +:*   suppress the output of values which are equal to zero. (Other than   '''B'''1 , all ''odd'' Bernoulli numbers have a value of zero.) +:*   express the Bernoulli numbers as fractions  (most are improper fractions). +:*   the fractions should be reduced. +:*   index each number in some way so that it can be discerned which number is being displayed. +:*   align the solidi   (/)   if used (extra credit). + ;An algorithm The Akiyama–Tanigawa algorithm for the "second Bernoulli numbers" as taken from [[wp:Bernoulli_number#Algorithmic_description|wikipedia]] is as follows: @@ -21,3 +29,4 @@ The Akiyama–Tanigawa algorithm for the "second Bernoulli numbers" as taken fro * Sequence [http://oeis.org/A027642 A027642 Denominator of Bernoulli number B_n] on The On-Line Encyclopedia of Integer Sequences. * Entry [http://mathworld.wolfram.com/BernoulliNumber.html Bernoulli number] on The Eric Weisstein's World of Mathematics (TM). * Luschny's [http://luschny.de/math/zeta/The-Bernoulli-Manifesto.html The Bernoulli Manifesto] for a discussion on B_1 = -½ vs. +½. +

diff --git a/Task/Bernoulli-numbers/Clojure/bernoulli-numbers.clj b/Task/Bernoulli-numbers/Clojure/bernoulli-numbers.clj new file mode 100644 index 0000000000..5d767fb07d --- /dev/null +++ b/Task/Bernoulli-numbers/Clojure/bernoulli-numbers.clj @@ -0,0 +1,24 @@ +ns test-project-intellij.core + (:gen-class)) + +(defn a-t [n] + " Used Akiyama-Tanigawa algorithm with a single loop rather than double nested loop " + " Clojure does fractional arithmetic automatically so that part is easy " + (loop [m 0 + j m + A (vec (map #(/ 1 %) (range 1 (+ n 2))))] ; Prefil A(m) with 1/(m+1), for m = 1 to n + (cond ; Three way conditional allows single loop + (>= j 1) (recur m (dec j) (assoc A (dec j) (* j (- (nth A (dec j)) (nth A j))))) ; A[j-1] ← j×(A[j-1] - A[j]) ; + (< m n) (recur (inc m) (inc m) A) ; increment m, reset j = m + :else (nth A 0)))) + +(defn format-ans [ans] + " Formats answer so that '/' is aligned for all answers " + (if (= ans 1) + (format "%50d / %8d" 1 1) + (format "%50d / %8d" (numerator ans) (denominator ans)))) + +;; Generate a set of results for [0 1 2 4 ... 60] +(doseq [q (flatten [0 1 (range 2 62 2)]) + :let [ans (a-t q)]] + (println q ":" (format-ans ans))) diff --git a/Task/Bernoulli-numbers/Elixir/bernoulli-numbers.elixir b/Task/Bernoulli-numbers/Elixir/bernoulli-numbers.elixir new file mode 100644 index 0000000000..ed5c5d5e78 --- /dev/null +++ b/Task/Bernoulli-numbers/Elixir/bernoulli-numbers.elixir @@ -0,0 +1,55 @@ +defmodule Bernoulli do + defmodule Rational do + import Kernel, except: [div: 2] + + defstruct numerator: 0, denominator: 1 + + def new(numerator, denominator\\1) do + sign = if numerator * denominator < 0, do: -1, else: 1 + {numerator, denominator} = {abs(numerator), abs(denominator)} + gcd = gcd(numerator, denominator) + %Rational{numerator: sign * Kernel.div(numerator, gcd), + denominator: Kernel.div(denominator, gcd)} + end + + def sub(a, b) do + new(a.numerator * b.denominator - b.numerator * a.denominator, + a.denominator * b.denominator) + end + + def mul(a, b) when is_integer(a) do + new(a * b.numerator, b.denominator) + end + + defp gcd(a,0), do: a + defp gcd(a,b), do: gcd(b, rem(a,b)) + end + + def numbers(n) do + Stream.transform(0..n, {}, fn m,acc -> + acc = Tuple.append(acc, Rational.new(1,m+1)) + if m>0 do + new = + Enum.reduce(m..1, acc, fn j,ar -> + put_elem(ar, j-1, Rational.mul(j, Rational.sub(elem(ar,j-1), elem(ar,j)))) + end) + {[elem(new,0)], new} + else + {[elem(acc,0)], acc} + end + end) |> Enum.to_list + end + + def task(n \\ 61) do + b_nums = numbers(n) + width = Enum.map(b_nums, fn b -> b.numerator |> to_string |> String.length end) + |> Enum.max + format = 'B(~2w) = ~#{width}w / ~w~n' + Enum.with_index(b_nums) + |> Enum.each(fn {b,i} -> + if b.numerator != 0, do: :io.fwrite format, [i, b.numerator, b.denominator] + end) + end +end + +Bernoulli.task diff --git a/Task/Bernoulli-numbers/GAP/bernoulli-numbers.gap b/Task/Bernoulli-numbers/GAP/bernoulli-numbers.gap new file mode 100644 index 0000000000..1fdb453219 --- /dev/null +++ b/Task/Bernoulli-numbers/GAP/bernoulli-numbers.gap @@ -0,0 +1,35 @@ +for a in Filtered(List([1 .. 60], n -> [n, Bernoulli(n)]), x -> x[2] <> 0) do + Print(a, "\n"); +od; + +[ 1, -1/2 ] +[ 2, 1/6 ] +[ 4, -1/30 ] +[ 6, 1/42 ] +[ 8, -1/30 ] +[ 10, 5/66 ] +[ 12, -691/2730 ] +[ 14, 7/6 ] +[ 16, -3617/510 ] +[ 18, 43867/798 ] +[ 20, -174611/330 ] +[ 22, 854513/138 ] +[ 24, -236364091/2730 ] +[ 26, 8553103/6 ] +[ 28, -23749461029/870 ] +[ 30, 8615841276005/14322 ] +[ 32, -7709321041217/510 ] +[ 34, 2577687858367/6 ] +[ 36, -26315271553053477373/1919190 ] +[ 38, 2929993913841559/6 ] +[ 40, -261082718496449122051/13530 ] +[ 42, 1520097643918070802691/1806 ] +[ 44, -27833269579301024235023/690 ] +[ 46, 596451111593912163277961/282 ] +[ 48, -5609403368997817686249127547/46410 ] +[ 50, 495057205241079648212477525/66 ] +[ 52, -801165718135489957347924991853/1590 ] +[ 54, 29149963634884862421418123812691/798 ] +[ 56, -2479392929313226753685415739663229/870 ] +[ 58, 84483613348880041862046775994036021/354 ] +[ 60, -1215233140483755572040304994079820246041491/56786730 ] diff --git a/Task/Bernoulli-numbers/Java/bernoulli-numbers.java b/Task/Bernoulli-numbers/Java/bernoulli-numbers.java new file mode 100644 index 0000000000..156881441c --- /dev/null +++ b/Task/Bernoulli-numbers/Java/bernoulli-numbers.java @@ -0,0 +1,22 @@ +import org.apache.commons.math3.fraction.BigFraction; + +public class BernoulliNumbers { + + public static void main(String[] args) { + for (int n = 0; n <= 60; n++) { + BigFraction b = bernouilli(n); + if (!b.equals(BigFraction.ZERO)) + System.out.printf("B(%-2d) = %-1s%n", n , b); + } + } + + static BigFraction bernouilli(int n) { + BigFraction[] A = new BigFraction[n + 1]; + for (int m = 0; m <= n; m++) { + A[m] = new BigFraction(1, (m + 1)); + for (int j = m; j >= 1; j--) + A[j - 1] = (A[j - 1].subtract(A[j])).multiply(new BigFraction(j)); + } + return A[0]; + } +} diff --git a/Task/Bernoulli-numbers/Julia/bernoulli-numbers.julia b/Task/Bernoulli-numbers/Julia/bernoulli-numbers.julia new file mode 100644 index 0000000000..4c5e968d2d --- /dev/null +++ b/Task/Bernoulli-numbers/Julia/bernoulli-numbers.julia @@ -0,0 +1,26 @@ +function bernoulli(n) + A = Vector{Rational{BigInt}}(n + 1) + for m = 0 : n + A[m + 1] = 1 // (m + 1) + for j = m : -1 : 1 + A[j] = j * (A[j] - A[j + 1]) + end + end + return A[1] +end + +function display(n) + B = map(bernoulli, 0 : n) + pad = mapreduce(x -> ndigits(num(x)) + Int(x < 0), max, B) + argdigits = ndigits(n) + for i = 0 : n + if num(B[i + 1]) & 1 == 1 + println( + "B(", lpad(i, argdigits), ") = ", + lpad(num(B[i + 1]), pad), " / ", den(B[i + 1]) + ) + end + end +end + +display(60) diff --git a/Task/Bernoulli-numbers/Kotlin/bernoulli-numbers-1.kotlin b/Task/Bernoulli-numbers/Kotlin/bernoulli-numbers-1.kotlin new file mode 100644 index 0000000000..c63044f3e7 --- /dev/null +++ b/Task/Bernoulli-numbers/Kotlin/bernoulli-numbers-1.kotlin @@ -0,0 +1,22 @@ +import org.apache.commons.math3.fraction.BigFraction + +object Bernoulli { + operator fun invoke(n: Int) : BigFraction { + val A = Array(n + 1, init) + for (m in 0..n) + for (j in m downTo 1) + A[j - 1] = A[j - 1].subtract(A[j]).multiply(integers[j]) + return A.first() + } + + val max = 60 + + private val init = { m: Int -> BigFraction(1, m + 1) } + private val integers = Array(max + 1, { m: Int -> BigFraction(m) } ) +} + +fun main(args: Array) { + for (n in 0..Bernoulli.max) + if (n % 2 == 0 || n == 1) + System.out.printf("B(%-2d) = %-1s%n", n, Bernoulli(n)) +} diff --git a/Task/Bernoulli-numbers/Kotlin/bernoulli-numbers-2.kotlin b/Task/Bernoulli-numbers/Kotlin/bernoulli-numbers-2.kotlin new file mode 100644 index 0000000000..46d0e7c171 --- /dev/null +++ b/Task/Bernoulli-numbers/Kotlin/bernoulli-numbers-2.kotlin @@ -0,0 +1 @@ +System.out.printf("B(%-2d) = %-1s%n", n, Bernoulli(n)) diff --git a/Task/Bernoulli-numbers/REXX/bernoulli-numbers.rexx b/Task/Bernoulli-numbers/REXX/bernoulli-numbers.rexx index a6006e4c0d..0c37af6742 100644 --- a/Task/Bernoulli-numbers/REXX/bernoulli-numbers.rexx +++ b/Task/Bernoulli-numbers/REXX/bernoulli-numbers.rexx @@ -1,52 +1,52 @@ -/*REXX program calculates a number of Bernoulli numbers expressed as fractions*/ -parse arg N .; if N=='' then N=60 /*Not specified? Then use the default.*/ -!.=0; w=max(length(N),4); Nw=N+N%5 /*used for aligning (output) fractions.*/ -say 'B(n)' center('Bernoulli number expressed as a fraction', max(78-w, Nw)) -say copies('─',w) copies('─', max(78-w, Nw + 2*w)) - do #=0 to N /*process the numbers from 0 ──► N. */ - b=bern(#); if b==0 then iterate /*calculate Bernoulli number, skip if 0*/ - indent=max(0, nW-pos('/', b)) /*calculate alignment (indentation). */ - say right(#,w) left('',indent) b /*display the indented Bernoulli number*/ - end /*#*/ /* [↑] align the Bernoulli fractions. */ -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────BERN subroutine───────────────────────────*/ -bern: parse arg x /*obtain the subroutine argument. */ -if x==0 then return '1/1' /*handle the special case of zero. */ -if x==1 then return '-1/2' /* " " " " " one. */ -if x//2 then return 0 /* " " " " " odds. */ - /* [↓] process all numbers up to X, */ - do j=2 to x by 2; jp=j+1; d=j+j /* ··· and set some shortcut vars.*/ - if d>digits() then numeric digits d /*increase the decimal digits if needed*/ - sn=1-j /*set the numerator. */ - sd=2 /* " " denominator. */ - do k=2 to j-1 by 2 /*calculate a SN/SD sequence. */ - parse var @.k bn '/' ad /*get a previously calculated fraction.*/ - an=comb(jp,k)*bn /*use COMBination for the next term. */ - $lcm=lcm(sd,ad) /*use Least Common Denominator function*/ - sn=$lcm%sd*sn; sd=$lcm /*calculate the current numerator. */ - an=$lcm%ad*an; ad=$lcm /* " " next " */ - sn=sn+an /* " " current " */ - end /*k*/ /* [↑] calculate the SN/SD sequence.*/ - sn=-sn /*adjust the sign for the numerator. */ - sd=sd*jp /*calculate the denominator. */ - if sn\==1 then do; _=gcd(sn, sd) /*get the Greatest Common Denominator.*/ - sn=sn%_; sd=sd%_ /*reduce the numerator and denominator.*/ - end /* [↑] done with the reduction(s). */ - @.j=sn'/'sd /*save the result for the next round. */ - end /*j*/ /* [↑] done calculating Bernoulli #'s.*/ +/*REXX program calculates N number of Bernoulli numbers expressed as fractions. */ +parse arg N .; if N=='' then N=60 /*Not specified? Then use the default.*/ +!.=0; w=max(length(N),4); Nw=N+N%5 /*used for aligning (output) fractions.*/ +say 'B(n)' center("Bernoulli number expressed as a fraction", max(78-w, Nw)) /*title*/ +say copies('─',w) copies("─",max(78-w,Nw+2*w)) /*display 2nd line of title, separators*/ + do #=0 to N /*process the numbers from 0 ──► N. */ + b=bern(#); if b==0 then iterate /*calculate Bernoulli number, skip if 0*/ + indent=max(0, nW-pos('/', b)) /*calculate the alignment (indentation)*/ + say right(#, w) left('', indent) b /*display the indented Bernoulli number*/ + end /*#*/ /* [↑] align the Bernoulli fractions. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +bern: parse arg x /*obtain the subroutine argument. */ + if x==0 then return '1/1' /*handle the special case of zero. */ + if x==1 then return '-1/2' /* " " " " " one. */ + if x//2 then return 0 /* " " " " " odds. */ + /* [↓] process all numbers up to X, */ + do j=2 to x by 2; jp=j+1; d=j+j /* ··· and set some shortcut vars.*/ + if d>digits() then numeric digits d /*increase the decimal digits if needed*/ + sn=1-j /*set the numerator. */ + sd=2 /* " " denominator. */ + do k=2 to j-1 by 2 /*calculate a SN/SD sequence. */ + parse var @.k bn '/' ad /*get a previously calculated fraction.*/ + an=comb(jp,k)*bn /*use COMBination for the next term. */ + $lcm=lcm(sd,ad) /*use Least Common Denominator function*/ + sn=$lcm%sd*sn; sd=$lcm /*calculate the current numerator. */ + an=$lcm%ad*an; ad=$lcm /* " " next " */ + sn=sn+an /* " " current " */ + end /*k*/ /* [↑] calculate the SN/SD sequence.*/ + sn=-sn /*adjust the sign for the numerator. */ + sd=sd*jp /*calculate the denominator. */ + if sn\==1 then do; _=gcd(sn, sd) /*get the Greatest Common Denominator.*/ + sn=sn%_; sd=sd%_ /*reduce the numerator and denominator.*/ + end /* [↑] done with the reduction(s). */ + @.j=sn'/'sd /*save the result for the next round. */ + end /*j*/ /* [↑] done calculating Bernoulli #'s.*/ -return sn'/'sd -/*────────────────────────────────────────────────────────────────────────────*/ + return sn'/'sd +/*──────────────────────────────────────────────────────────────────────────────────────*/ comb: procedure expose !.; parse arg x,y; if x==y then return 1 - if !.!c.x.y\==0 then return !.!c.x.y /*combination computed before?*/ + if !.!c.x.y\==0 then return !.!c.x.y /*combination computed before?*/ if x-y, + index: i32 // Counter for iterator implementation +} + +impl Context { + pub fn new() -> Context { + let bigone = 1.to_bigint().unwrap(); + let a_vec: Vec = vec![]; + Context { + bigone_const: bigone, + a: a_vec, + index: -1 + } + } +} + +impl Iterator for Context { + type Item = Bn; + + fn next(&mut self) -> Option { + self.index += 1; + Some(Bn { value: bernoulli(self.index as usize, self), index: self.index }) + } +} + +fn help() { + println!("Usage: bernoulli_numbers "); +} + +fn main() { + let args: Vec = env::args().collect(); + let mut up_to: usize = 60; + + match args.len() { + 1 => {}, + 2 => { + up_to = args[1].parse::().unwrap(); + }, + _ => { + help(); + process::exit(0); + } + } + + let context = Context::new(); + // Collect the solutions by using the Context iterator + // (this is not as fast as calling the optimized function directly). + let res = context.take(up_to + 1).collect::>(); + let width = res.iter().fold(0, |a, r| max(a, r.value.numer().to_string().len())); + + for r in res.iter().filter(|r| r.index % 2 == 0) { + println!("B({:>2}) = {:>2$} / {denom}", r.index, r.value.numer(), width, + denom = r.value.denom()); + } +} + +// Implementation with no reused calculations. +fn _bernoulli_naive(n: usize, c: &mut Context) -> BigRational { + for m in 0..n + 1 { + c.a.push(BigRational::new(c.bigone_const.clone(), (m + 1).to_bigint().unwrap())); + for j in (1..m + 1).rev() { + c.a[j - 1] = (c.a[j - 1].clone().sub(c.a[j].clone())).mul( + BigRational::new(j.to_bigint().unwrap(), c.bigone_const.clone()) + ); + } + } + c.a[0].reduced() +} + +// Implementation with reused calculations (does not require sequential calls). +fn bernoulli(n: usize, c: &mut Context) -> BigRational { + for i in 0..n + 1 { + if i >= c.a.len() { + c.a.push(BigRational::new(c.bigone_const.clone(), (i + 1).to_bigint().unwrap())); + for j in (1..i + 1).rev() { + c.a[j - 1] = (c.a[j - 1].clone().sub(c.a[j].clone())).mul( + BigRational::new(j.to_bigint().unwrap(), c.bigone_const.clone()) + ); + } + } + } + c.a[0].reduced() +} + + +#[cfg(test)] +mod tests { + use super::{Bn, Context, bernoulli, _bernoulli_naive}; + use num::rational::{BigRational}; + use std::str::FromStr; + use test::Bencher; + + // [tests elided] + + #[bench] + fn bench_bernoulli_naive(b: &mut Bencher) { + let mut context = Context::new(); + b.iter(|| { + let mut res: Vec = vec![]; + for n in 0..30 + 1 { + let b = _bernoulli_naive(n, &mut context); + res.push(Bn { value:b.clone(), index: n as i32}); + } + }); + } + + #[bench] + fn bench_bernoulli(b: &mut Bencher) { + let mut context = Context::new(); + b.iter(|| { + let mut res: Vec = vec![]; + for n in 0..30 + 1 { + let b = bernoulli(n, &mut context); + res.push(Bn { value:b.clone(), index: n as i32}); + } + }); + } + + #[bench] + fn bench_bernoulli_iter(b: &mut Bencher) { + b.iter(|| { + let context = Context::new(); + let _res = context.take(30 + 1).collect::>(); + }); + } +} diff --git a/Task/Bernoulli-numbers/Scala/bernoulli-numbers.scala b/Task/Bernoulli-numbers/Scala/bernoulli-numbers.scala new file mode 100644 index 0000000000..2690bc7ebe --- /dev/null +++ b/Task/Bernoulli-numbers/Scala/bernoulli-numbers.scala @@ -0,0 +1,49 @@ +/** Roll our own pared-down BigFraction class just for these Bernoulli Numbers */ +case class BFraction( numerator:BigInt, denominator:BigInt ) { + require( denominator != BigInt(0), "Denominator cannot be zero" ) + + val gcd = numerator.gcd(denominator) + + val num = numerator / gcd + val den = denominator / gcd + + def unary_- = BFraction(-num, den) + def -( that:BFraction ) = that match { + case f if f.num == BigInt(0) => this + case f if f.den == this.den => BFraction(this.num - f.num, this.den) + case f => BFraction(((this.num * f.den) - (f.num * this.den)), this.den * f.den ) + } + + def *( that:Int ) = BFraction( num * that, den ) + + override def toString = num + " / " + den +} + + +def bernoulliB( n:Int ) : BFraction = { + + val aa : Array[BFraction] = Array.ofDim(n+1) + + for( m <- 0 to n ) { + aa(m) = BFraction(1,(m+1)) + + for( n <- m to 1 by -1 ) { + aa(n-1) = (aa(n-1) - aa(n)) * n + } + } + + aa(0) +} + +assert( {val b12 = bernoulliB(12); b12.num == -691 && b12.den == 2730 } ) + +val r = for( n <- 0 to 60; b = bernoulliB(n) if b.num != 0 ) yield (n, b) + +val numeratorSize = r.map(_._2.num.toString.length).max + +// Print the results +r foreach{ case (i,b) => { + val label = f"b($i)" + val num = (" " * (numeratorSize - b.num.toString.length)) + b.num + println( f"$label%-6s $num / ${b.den}" ) +}} diff --git a/Task/Best-shuffle/00DESCRIPTION b/Task/Best-shuffle/00DESCRIPTION index 0b0eb5b4ad..766b35f1d7 100644 --- a/Task/Best-shuffle/00DESCRIPTION +++ b/Task/Best-shuffle/00DESCRIPTION @@ -1,11 +1,29 @@ -Shuffle the characters of a string in such a way that as many of the character values are in a different position as possible. Print the result as follows: original string, shuffled string, (score). The score gives the number of positions whose character value did ''not'' change. - -For example: tree, eetr, (0) +;Task: +Shuffle the characters of a string in such a way that as many of the character values are in a different position as possible. A shuffle that produces a randomized result among the best choices is to be preferred. A deterministic approach that produces the same sequence every time is acceptable as an alternative. -The words to test with are: abracadabra, seesaw, elk, grrrrrr, up, a +Display the result as follows: -;Cf. -* [[Anagrams/Deranged anagrams]] -* [[Permutations/Derangements]] + original string, shuffled string, (score) + +The score gives the number of positions whose character value did ''not'' change. + + +;Example: + tree, eetr, (0) + + +;Test cases: + abracadabra + seesaw + elk + grrrrrr + up + a + + +;Related tasks +*   [[Anagrams/Deranged anagrams]] +*   [[Permutations/Derangements]] +

diff --git a/Task/Best-shuffle/Ada/best-shuffle.ada b/Task/Best-shuffle/Ada/best-shuffle.ada index bbdae01e69..37b1b32286 100644 --- a/Task/Best-shuffle/Ada/best-shuffle.ada +++ b/Task/Best-shuffle/Ada/best-shuffle.ada @@ -1,42 +1,50 @@ with Ada.Text_IO; +with Ada.Strings.Unbounded; procedure Best_Shuffle is - function Best_Shuffle(S: String) return String is - T: String(S'Range) := S; - Tmp: Character; + function Best_Shuffle (S : String) return String; + + function Best_Shuffle (S : String) return String is + T : String (S'Range) := S; + Tmp : Character; begin for I in S'Range loop for J in S'Range loop - if I /= J and S(I) /= T(J) and S(J) /= T(I) then - Tmp := T(I); - T(I) := T(J); - T(J) := Tmp; + if I /= J and S (I) /= T (J) and S (J) /= T (I) then + Tmp := T (I); + T (I) := T (J); + T (J) := Tmp; end if; end loop; end loop; return T; end Best_Shuffle; - Stop : Boolean := False; + Test_Cases : constant array (1 .. 6) + of Ada.Strings.Unbounded.Unbounded_String := + (Ada.Strings.Unbounded.To_Unbounded_String ("abracadabra"), + Ada.Strings.Unbounded.To_Unbounded_String ("seesaw"), + Ada.Strings.Unbounded.To_Unbounded_String ("elk"), + Ada.Strings.Unbounded.To_Unbounded_String ("grrrrrr"), + Ada.Strings.Unbounded.To_Unbounded_String ("up"), + Ada.Strings.Unbounded.To_Unbounded_String ("a")); begin -- main procedure - while not Stop loop + for Test_Case in Test_Cases'Range loop declare - Original: String := Ada.Text_IO.Get_Line; - Shuffle: String := Best_Shuffle(Original); - Score: Natural := 0; + Original : constant String := Ada.Strings.Unbounded.To_String + (Test_Cases (Test_Case)); + Shuffle : constant String := Best_Shuffle (Original); + Score : Natural := 0; begin for I in Original'Range loop - if Original(I) = Shuffle(I) then - Score := Score + 1; + if Original (I) = Shuffle (I) then + Score := Score + 1; end if; end loop; - Ada.Text_Io.Put_Line(Original & ", " & Shuffle & ", (" & - Natural'Image(Score) & " )"); - if Original = "" then - Stop := True; - end if; + Ada.Text_IO.Put_Line (Original & ", " & Shuffle & ", (" & + Natural'Image (Score) & " )"); end; end loop; end Best_Shuffle; diff --git a/Task/Best-shuffle/Haskell/best-shuffle-1.hs b/Task/Best-shuffle/Haskell/best-shuffle-1.hs index 595cfbfb63..d346ca46b9 100644 --- a/Task/Best-shuffle/Haskell/best-shuffle-1.hs +++ b/Task/Best-shuffle/Haskell/best-shuffle-1.hs @@ -1,33 +1,12 @@ -import Data.Function (on) -import Data.List -import Data.Maybe -import Data.Array -import Text.Printf +shufflingQuality l1 l2 = length $ filter id $ zipWith (==) l1 l2 -main = mapM_ f examples - where examples = ["abracadabra", "seesaw", "elk", "grrrrrr", "up", "a"] - f s = printf "%s, %s, (%d)\n" s s' $ score s s' - where s' = bestShuffle s - -score :: Eq a => [a] -> [a] -> Int -score old new = length $ filter id $ zipWith (==) old new - -bestShuffle :: (Ord a, Eq a) => [a] -> [a] -bestShuffle s = elems $ array bs $ f positions letters - where positions = - concat $ sortBy (compare `on` length) $ - map (map fst) $ groupBy ((==) `on` snd) $ - sortBy (compare `on` snd) $ zip [0..] s - letters = map (orig !) positions - - f [] [] = [] - f (p : ps) ls = (p, ls !! i) : f ps (removeAt i ls) - where i = fromMaybe 0 $ findIndex (/= o) ls - o = orig ! p - - orig = listArray bs s - bs = (0, length s - 1) - -removeAt :: Int -> [a] -> [a] -removeAt 0 (x : xs) = xs -removeAt i (x : xs) = x : removeAt (i - 1) xs +printTest prog = mapM_ test texts + where + test s = do + x <- prog s + putStrLn $ unwords $ [ show s + , show x + , show $ shufflingQuality s x] + texts = [ "abba", "abracadabra", "seesaw", "elk" , "grrrrrr" + , "up", "a", "aaaaa.....bbbbb" + , "Rosetta Code is a programming chrestomathy site." ] diff --git a/Task/Best-shuffle/Haskell/best-shuffle-2.hs b/Task/Best-shuffle/Haskell/best-shuffle-2.hs index e15edcc5c5..a3e62f1717 100644 --- a/Task/Best-shuffle/Haskell/best-shuffle-2.hs +++ b/Task/Best-shuffle/Haskell/best-shuffle-2.hs @@ -1,2 +1,20 @@ -bestShuffle :: Eq a => [a] -> [a] -bestShuffle s = minimumBy (compare `on` score s) $ permutations s +import Data.Vector ((//), (!)) +import qualified Data.Vector as V +import Data.List (delete, find) + +swapShuffle :: Eq a => [a] -> [a] -> [a] +swapShuffle lref lst = V.toList $ foldr adjust (V.fromList lst) [0..n-1] + where + vref = V.fromList lref + n = V.length vref + adjust i v = case find alternative [0.. n-1] of + Nothing -> v + Just j -> v // [(j, v!i), (i, v!j)] + where + alternative j = and [ v!i == vref!i + , i /= j + , v!i /= vref!j + , v!j /= vref!i ] + +shuffle :: Eq a => [a] -> [a] +shuffle lst = swapShuffle lst lst diff --git a/Task/Best-shuffle/Haskell/best-shuffle-3.hs b/Task/Best-shuffle/Haskell/best-shuffle-3.hs new file mode 100644 index 0000000000..48b3978cc0 --- /dev/null +++ b/Task/Best-shuffle/Haskell/best-shuffle-3.hs @@ -0,0 +1,11 @@ +perfectShuffle :: [a] -> [a] +perfectShuffle [] = [] +perfectShuffle lst | odd n = b : shuffle (zip bs a) + | even n = shuffle (zip (b:bs) a) + where + n = length lst + (a,b:bs) = splitAt (n `div` 2) lst + shuffle = foldMap (\(x,y) -> [x,y]) + +shuffleP :: Eq a => [a] -> [a] +shuffleP lst = swapShuffle lst $ perfectShuffle lst diff --git a/Task/Best-shuffle/Haskell/best-shuffle-4.hs b/Task/Best-shuffle/Haskell/best-shuffle-4.hs new file mode 100644 index 0000000000..3fde1b44a3 --- /dev/null +++ b/Task/Best-shuffle/Haskell/best-shuffle-4.hs @@ -0,0 +1 @@ +import Control.Monad.Random (getRandomR) diff --git a/Task/Best-shuffle/Haskell/best-shuffle-5.hs b/Task/Best-shuffle/Haskell/best-shuffle-5.hs new file mode 100644 index 0000000000..6f3e796527 --- /dev/null +++ b/Task/Best-shuffle/Haskell/best-shuffle-5.hs @@ -0,0 +1,10 @@ +randomShuffle :: [a] -> IO [a] +randomShuffle [] = return [] +randomShuffle lst = do + i <- getRandomR (0,length lst-1) + let (a, x:b) = splitAt i lst + xs <- randomShuffle $ a ++ b + return (x:xs) + +shuffleR :: Eq a => [a] -> IO [a] +shuffleR lst = swapShuffle lst <$> randomShuffle lst diff --git a/Task/Best-shuffle/Haskell/best-shuffle-6.hs b/Task/Best-shuffle/Haskell/best-shuffle-6.hs new file mode 100644 index 0000000000..37b24d2939 --- /dev/null +++ b/Task/Best-shuffle/Haskell/best-shuffle-6.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE TupleSections, LambdaCase #-} +import Conduit +import Control.Monad.Random (getRandomR) +import Data.List (delete, find) + +shuffleC :: Eq a => Int -> Conduit a IO a +shuffleC 0 = awaitForever yield +shuffleC k = takeC k .| sinkList >>= \v -> delay v .| randomReplace v + +delay :: Monad m => [a] -> Conduit t m (a, [a]) +delay [] = mapC $ \x -> (x,[x]) +delay (b:bs) = await >>= \case + Nothing -> yieldMany (b:bs) .| mapC (,[]) + Just x -> yield (b, [x]) >> delay (bs ++ [x]) + +randomReplace :: Eq a => [a] -> Conduit (a, [a]) IO a +randomReplace vars = awaitForever $ \(x,b) -> do + y <- case filter (/= x) vars of + [] -> pure x + vs -> lift $ (vs !!) <$> getRandomR (0, length vs - 1) + yield y + randomReplace $ b ++ delete y vars + +shuffleW :: Eq a => Int -> [a] -> IO [a] +shuffleW k lst = yieldMany lst =$= shuffleC k $$ sinkList diff --git a/Task/Best-shuffle/Haskell/best-shuffle-7.hs b/Task/Best-shuffle/Haskell/best-shuffle-7.hs new file mode 100644 index 0000000000..7348d7dbbe --- /dev/null +++ b/Task/Best-shuffle/Haskell/best-shuffle-7.hs @@ -0,0 +1,4 @@ +import Data.ByteString.Builder (charUtf8) +import Data.ByteString.Char8 (ByteString, unpack, pack) +import Data.Conduit.ByteString.Builder (builderToByteString) +import System.IO (stdin, stdout) diff --git a/Task/Best-shuffle/Haskell/best-shuffle-8.hs b/Task/Best-shuffle/Haskell/best-shuffle-8.hs new file mode 100644 index 0000000000..7163ef067a --- /dev/null +++ b/Task/Best-shuffle/Haskell/best-shuffle-8.hs @@ -0,0 +1,13 @@ +shuffleBS :: Int -> ByteString -> IO ByteString +shuffleBS n s = + yieldMany (unpack s) + =$ shuffleC n + =$ mapC charUtf8 + =$ builderToByteString + $$ foldC + +main :: IO () +main = + sourceHandle stdin + =$ mapMC (shuffleBS 10) + $$ sinkHandle stdout diff --git a/Task/Best-shuffle/Java/best-shuffle.java b/Task/Best-shuffle/Java/best-shuffle.java index 3cdea1b922..55f5d8ef36 100644 --- a/Task/Best-shuffle/Java/best-shuffle.java +++ b/Task/Best-shuffle/Java/best-shuffle.java @@ -1,6 +1,7 @@ import java.util.Random; public class BestShuffle { + private final static Random rand = new Random(); public static void main(String[] args) { String[] words = {"abracadabra", "seesaw", "grrrrrr", "pop", "up", "a"}; @@ -27,7 +28,6 @@ public class BestShuffle { } public static void shuffle(char[] text) { - Random rand = new Random(); for (int i = text.length - 1; i > 0; i--) { int r = rand.nextInt(i + 1); char tmp = text[i]; diff --git a/Task/Best-shuffle/Kotlin/best-shuffle.kotlin b/Task/Best-shuffle/Kotlin/best-shuffle.kotlin index c15e0f70e0..c7418307d8 100644 --- a/Task/Best-shuffle/Kotlin/best-shuffle.kotlin +++ b/Task/Best-shuffle/Kotlin/best-shuffle.kotlin @@ -31,10 +31,9 @@ object BestShuffle { private fun CharArray.count(s1: String) : Int { var count = 0 for (i in indices) - if (s1[i] == this[i]) - count++ + if (s1[i] == this[i]) count++ return count } } -fun main(words: Array) = words forEach { println(BestShuffle(it)) } +fun main(words: Array) = words.forEach { println(BestShuffle(it)) } diff --git a/Task/Best-shuffle/Perl-6/best-shuffle.pl6 b/Task/Best-shuffle/Perl-6/best-shuffle.pl6 index a47a416c79..e56260950e 100644 --- a/Task/Best-shuffle/Perl-6/best-shuffle.pl6 +++ b/Task/Best-shuffle/Perl-6/best-shuffle.pl6 @@ -1,37 +1,23 @@ -sub best-shuffle (Str $s) { - my @orig = $s.comb; +sub best-shuffle(Str $orig) { - my @pos; - # Fill @pos with positions in the order that we want to fill - # them. (Once Rakudo has &roundrobin, this will be doable in - # one statement.) - { - my %pos = classify { @orig[$^i] }, keys @orig; - my @k = map *.key, sort *.value.elems, %pos; - while %pos { - for @k -> $letter { - %pos{$letter} or next; - push @pos, %pos{$letter}.pop; - %pos{$letter}.elems or %pos.delete: $letter; + my @s = $orig.comb; + my @t = @s.pick(*); + + for ^@s -> $i { + for ^@s -> $j { + if $i != $j and @t[$i] ne @s[$j] and @t[$j] ne @s[$i] { + @t[$i, $j] = @t[$j, $i]; + last; } } - @pos .= reverse; } - my @letters = @orig; - my @new = Any xx $s.chars; - # Now fill in @new with @letters according to each position - # in @pos, but skip ahead in @letters if we can avoid - # matching characters that way. - while @letters { - my ($i, $p) = 0, shift @pos; - ++$i while @letters[$i] eq @orig[$p] and $i < @letters.end; - @new[$p] = splice @letters, $i, 1; + my $count = 0; + for @t.kv -> $k,$v { + ++$count if $v eq @s[$k] } - my $score = elems grep ?*, map * eq *, do @new Z @orig; - - @new.join, $score; + return (@t.join, $count); } printf "%s, %s, (%d)\n", $_, best-shuffle $_ diff --git a/Task/Best-shuffle/PowerShell/best-shuffle-1.psh b/Task/Best-shuffle/PowerShell/best-shuffle-1.psh new file mode 100644 index 0000000000..0bab21590c --- /dev/null +++ b/Task/Best-shuffle/PowerShell/best-shuffle-1.psh @@ -0,0 +1,52 @@ +# Calculate best possible shuffle score for a given string +# (Split out into separate function so we can use it separately in our output) +function Get-BestScore ( [string]$String ) + { + # Convert to array of characters, group identical characters, + # sort by frequecy, get size of first group + $MostRepeats = $String.ToCharArray() | + Group | + Sort Count -Descending | + Select -First 1 -ExpandProperty Count + + # Return count of most repeated character minus all other characters (math simplified) + return [math]::Max( 0, 2 * $MostRepeats - $String.Length ) + } + +function Get-BestShuffle ( [string]$String ) + { + # Convert to arrays of characters, one for comparison, one for manipulation + $S1 = $String.ToCharArray() + $S2 = $String.ToCharArray() + + # Calculate best possible score as our goal + $BestScore = Get-BestScore $String + + # Unshuffled string has score equal to number of characters + $Length = $String.Length + $Score = $Length + + # While still striving for perfection... + While ( $Score -gt $BestScore ) + { + # For each character + ForEach ( $i in 0..($Length-1) ) + { + # If the shuffled character still matches the original character... + If ( $S1[$i] -eq $S2[$i] ) + { + # Swap it with a random character + # (Random character $j may be the same as or may even be + # character $i. The minor impact on speed was traded for + # a simple solution to guarantee randomness.) + $j = Get-Random -Maximum $Length + $S2[$i], $S2[$j] = $S2[$j], $S2[$i] + } + } + # Count the number of indexes where the two arrays match + $Score = ( 0..($Length-1) ).Where({ $S1[$_] -eq $S2[$_] }).Count + } + # Put it back into a string + $Shuffle = ( [string[]]$S2 -join '' ) + return $Shuffle + } diff --git a/Task/Best-shuffle/PowerShell/best-shuffle-2.psh b/Task/Best-shuffle/PowerShell/best-shuffle-2.psh new file mode 100644 index 0000000000..3a491b67ff --- /dev/null +++ b/Task/Best-shuffle/PowerShell/best-shuffle-2.psh @@ -0,0 +1,6 @@ +ForEach ( $String in ( 'abracadabra', 'seesaw', 'elk', 'grrrrrr', 'up', 'a' ) ) + { + $Shuffle = Get-BestShuffle $String + $Score = Get-BestScore $String + "$String, $Shuffle, ($Score)" + } diff --git a/Task/Best-shuffle/PowerShell/best-shuffle.psh b/Task/Best-shuffle/PowerShell/best-shuffle.psh deleted file mode 100644 index 52bcbcd8a3..0000000000 --- a/Task/Best-shuffle/PowerShell/best-shuffle.psh +++ /dev/null @@ -1,10 +0,0 @@ -function Best-Shuffle($strings){ - foreach($string in $strings){ - $sa1 = $string.ToCharArray() - $sa2 = Get-Random -InputObject $sa1 -Count ([int]::MaxValue) - $string = [String]::Join("",$sa2) - echo $string - } -} - -Best-Shuffle "abracadabra", "seesaw", "pop", "grrrrrr", "up", "a" diff --git a/Task/Best-shuffle/REXX/best-shuffle-1.rexx b/Task/Best-shuffle/REXX/best-shuffle-1.rexx index 00882e2e31..070045a39c 100644 --- a/Task/Best-shuffle/REXX/best-shuffle-1.rexx +++ b/Task/Best-shuffle/REXX/best-shuffle-1.rexx @@ -1,41 +1,30 @@ -/*REXX program finds the best shuffle (for any list of words (characters). */ -parse arg @ /*get some words from the command line.*/ -if @='' then @ = 'tree abracadabra seesaw elk grrrrrr up a' /*use default? */ -w=0 /*width of the longest word; for output*/ - do i=1 for words(@) /* [↓] process all the words in list. */ - w=max(w, length(word(@, i))) /*set the maximum word width (so far). */ - end /*i*/ /* [↑] ··· finds the widest word in @.*/ -w=w+9 /*add 9 blanks, the output looks nicer.*/ - do n=1 for words(@) /*process all the words in the @ list. */ - $=word(@,n) /*get the original word in the @ list. */ - new=bestShuffle($) /*get a shufflized version of the word.*/ - say 'original:' left($,w) 'new:' left(new,w) 'count:' kSame($,new) +/*REXX program determines and displays the best shuffle for any list of words/characters*/ +parse arg $ /*get some words from the command line.*/ +if $='' then $= 'tree abracadabra seesaw elk grrrrrr up a' /*use the defaults?*/ +w=0; #=words($) /* [↑] finds the widest word in $ list*/ + do i=1 for #; @.i=word($,i); w=max(w, length(@.i) ); end /*i*/ +w=w+9 /*add 9 blanks for output indentation. */ + do n=1 for #; new=bestShuffle(@.n) /*process the examples in the @ array. */ + same=0; do m=1 for length(@.n) + same=same + (substr(@.n, m, 1) == substr(new, m, 1) ) + end /*m*/ + say 'original:' left(@.n, w) 'new:' left(new,w) 'count:' same end /*n*/ -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────BESTSHUFFLE subroutine────────────────────*/ -bestShuffle: procedure; parse arg x 1 ox; Lx=length(x) -if Lx<3 then return reverse(x) /*fast track these small # of puppies. */ - - do j=1 for Lx-1; jp=j+1 /* [↓] handle any possible replicates.*/ - a=substr(x,j ,1) - b=substr(x,j+1,1); if a\==b then iterate /*ignore replicates.*/ - _=verify(x,a); if _==0 then iterate /*switch 1st replicate with some char. */ - y=substr(x,_,1); x=overlay(a,x,_) - x=overlay(y,x,j) - rx=reverse(x); _=verify(rx,a); if _==0 then iterate /*¬enough uniqueness*/ - y=substr(rx,_,1); _=lastpos(y,x) /*switch 2nd replicate with later char.*/ - x=overlay(a,x,_); x=overlay(y,x,jp) /*OVERLAYs: a fast way to swap chars. */ - end /*j*/ - - do k=1 for Lx /*handle cases of possible replicates. */ - a=substr( x,k,1) - b=substr(ox,k,1); if a\==b then iterate /*skip replicate. */ - if k==Lx then x=left(x,k-2)a || substr(x,k-1,1) /*handle last case*/ - else x=left(x,k-1)substr(x,k+1,1)a || substr(x,k+2) - end /*k*/ -return x -/*──────────────────────────────────KSAME procedure───────────────────────────*/ -kSame: procedure; parse arg x,y; k=0 - do m=1 for min(length(x), length(y)); k=k + (substr(x,m,1) == substr(y,m,1)) - end /*m*/ -return k +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +bestShuffle: procedure; parse arg x 1 ox; L=length(x); if L<3 then return reverse(x) + /*[↑] fast track short strs*/ + do j=1 for L-1; parse var x =(j) a +1 b +1 /*get A,B at Jth & J+1 pos.*/ + if a\==b then iterate /*ignore any replicates. */ + c=verify(x,a); if c==0 then iterate /* " " " */ + x=overlay( substr(x,c,1), overlay(a,x,c), j) /*swap the x,c characters*/ + rx=reverse(x) /*obtain the reverse of X. */ + y=substr(rx, verify(rx,a), 1) /*get 2nd replicated char. */ + x=overlay(y, overlay(a,x, lastpos(y,x)),j+1) /*fast swap of 2 characters*/ + end /*j*/ + do k=1 for L; a=substr(x,k,1) /*handle a possible rep. */ + if a\==substr(ox,k,1) then iterate /*skip non-replications*/ + if k==L then x=left(x,k-2)a || substr(x,k-1,1) /*last case*/ + else x=left(x,k-1)substr(x,k+1,1)a || substr(x, k+2) + end /*k*/ + return x diff --git a/Task/Best-shuffle/REXX/best-shuffle-4.rexx b/Task/Best-shuffle/REXX/best-shuffle-4.rexx new file mode 100644 index 0000000000..e8b8fca8c0 --- /dev/null +++ b/Task/Best-shuffle/REXX/best-shuffle-4.rexx @@ -0,0 +1,135 @@ +extern crate permutohedron; +extern crate rand; + +use std::cmp::{min, Ordering}; +use std::env; +use rand::{thread_rng, Rng}; +use std::str; + +const WORDS: &'static [&'static str] = &["abracadabra", "seesaw", "elk", "grrrrrr", "up", "a"]; + +#[derive(Eq)] +struct Solution { + original: String, + shuffled: String, + score: usize, +} + +// Ordering trait implementations are only needed for the permutations method +impl PartialOrd for Solution { + fn partial_cmp(&self, other: &Solution) -> Option { + match (self.score, other.score) { + (s, o) if s < o => Some(Ordering::Less), + (s, o) if s > o => Some(Ordering::Greater), + (s, o) if s == o => Some(Ordering::Equal), + _ => None, + } + } +} + + +impl PartialEq for Solution { + fn eq(&self, other: &Solution) -> bool { + match (self.score, other.score) { + (s, o) if s == o => true, + _ => false, + } + } +} + +impl Ord for Solution { + fn cmp(&self, other: &Solution) -> Ordering { + match (self.score, other.score) { + (s, o) if s < o => Ordering::Less, + (s, o) if s > o => Ordering::Greater, + _ => Ordering::Equal, + } + } +} + +fn _help() { + println!("Usage: best_shuffle ..."); +} + +fn main() { + let args: Vec = env::args().collect(); + let mut words: Vec = vec![]; + + match args.len() { + 1 => { + for w in WORDS.iter() { + words.push(String::from(*w)); + } + } + _ => { + for w in args.split_at(1).1 { + words.push(w.clone()); + } + } + } + + let solutions = words.iter().map(|w| best_shuffle(w)).collect::>(); + + for s in solutions { + println!("{}, {}, ({})", s.original, s.shuffled, s.score); + } +} + +// Implementation iterating over all permutations +fn _best_shuffle_perm(w: &String) -> Solution { + let mut soln = Solution { + original: w.clone(), + shuffled: w.clone(), + score: w.len(), + }; + let w_bytes: Vec = w.clone().into_bytes(); + let mut permutocopy = w_bytes.clone(); + let mut permutations = permutohedron::Heap::new(&mut permutocopy); + while let Some(p) = permutations.next_permutation() { + let hamm = hamming(&w_bytes, p); + soln = min(soln, + Solution { + original: w.clone(), + shuffled: String::from(str::from_utf8(p).unwrap()), + score: hamm, + }); + // Accept the solution if score 0 found + if hamm == 0 { + break; + } + } + soln +} + +// Quadratic implementation +fn best_shuffle(w: &String) -> Solution { + let w_bytes: Vec = w.clone().into_bytes(); + let mut shuffled_bytes: Vec = w.clone().into_bytes(); + + // Shuffle once + let sh: &mut [u8] = shuffled_bytes.as_mut_slice(); + thread_rng().shuffle(sh); + + // Swap wherever it doesn't decrease the score + for i in 0..sh.len() { + for j in 0..sh.len() { + if (i == j) | (sh[i] == w_bytes[j]) | (sh[j] == w_bytes[i]) | (sh[i] == sh[j]) { + continue; + } + sh.swap(i, j); + break; + } + } + + let res = String::from(str::from_utf8(sh).unwrap()); + let res_bytes: Vec = res.clone().into_bytes(); + Solution { + original: w.clone(), + shuffled: res, + score: hamming(&w_bytes, &res_bytes), + } +} + +fn hamming(w0: &Vec, w1: &Vec) -> usize { + w0.iter().zip(w1.iter()).filter(|z| z.0 == z.1).count() +} diff --git a/Task/Best-shuffle/Racket/best-shuffle.rkt b/Task/Best-shuffle/Racket/best-shuffle.rkt index 5cb2b2e797..3165a35da5 100644 --- a/Task/Best-shuffle/Racket/best-shuffle.rkt +++ b/Task/Best-shuffle/Racket/best-shuffle.rkt @@ -15,6 +15,6 @@ (for/sum ([c1 (in-string s1)] [c2 (in-string s2)]) (if (eq? c1 c2) 1 0))) -(for ([s (in-list '("tree" "abracadabra" "seesaw" "elk" "grrrrrr" "up" "a"))]) +(for ([s (in-list '("abracadabra" "seesaw" "elk" "grrrrrr" "up" "a"))]) (define sh (best-shuffle s)) (printf " ~a, ~a, (~a)\n" s sh (count-same s sh))) diff --git a/Task/Best-shuffle/ZX-Spectrum-Basic/best-shuffle.zx b/Task/Best-shuffle/ZX-Spectrum-Basic/best-shuffle.zx new file mode 100644 index 0000000000..f9b91d4592 --- /dev/null +++ b/Task/Best-shuffle/ZX-Spectrum-Basic/best-shuffle.zx @@ -0,0 +1,19 @@ +10 FOR n=1 TO 6 +20 READ w$ +30 GO SUB 1000 +40 LET count=0 +50 FOR i=1 TO LEN w$ +60 IF w$(i)=b$(i) THEN LET count=count+1 +70 NEXT i +80 PRINT w$;" ";b$;" ";count +90 NEXT n +100 STOP +1000 REM Best shuffle +1010 LET b$=w$ +1020 FOR i=1 TO LEN b$ +1030 FOR j=1 TO LEN b$ +1040 IF (i<>j) AND (b$(i)<>w$(j)) AND (b$(j)<>w$(i)) THEN LET t$=b$(i): LET b$(i)=b$(j): LET b$(j)=t$ +1110 NEXT j +1120 NEXT i +1130 RETURN +2000 DATA "abracadabra","seesaw","elk","grrrrrr","up","a" diff --git a/Task/Binary-digits/00DESCRIPTION b/Task/Binary-digits/00DESCRIPTION index 1726825478..f7f1723ff1 100644 --- a/Task/Binary-digits/00DESCRIPTION +++ b/Task/Binary-digits/00DESCRIPTION @@ -1,7 +1,13 @@ -The task is to output the sequence of binary digits for a given [[wp:Natural number|non-negative integer]]. +;Task: +Create and display the sequence of binary digits for a given   [[wp:Natural number|non-negative integer]]. -The decimal value 5, should produce an output of 101 -The decimal value 50 should produce an output of 110010 -The decimal value 9000 should produce an output of 10001100101000 + The decimal value   '''5'''   should produce an output of   '''101''' + The decimal value   '''50'''   should produce an output of   '''110010''' + The decimal value   '''9000'''   should produce an output of   '''10001100101000''' -The results can be achieved using builtin radix functions within the language, if these are available, or alternatively a user defined function can be used. The output produced should consist just of the binary digits of each number followed by a newline. There should be no other whitespace, radix or sign markers in the produced output, and [[wp:Leading zero|leading zeros]] should not appear in the results. +The results can be achieved using built-in radix functions within the language   (if these are available),   or alternatively a user defined function can be used. + +The output produced should consist just of the binary digits of each number followed by a   ''newline''. + +There should be no other whitespace, radix or sign markers in the produced output, and [[wp:Leading zero|leading zeros]] should not appear in the results. +

diff --git a/Task/Binary-digits/AppleScript/binary-digits.applescript b/Task/Binary-digits/AppleScript/binary-digits.applescript new file mode 100644 index 0000000000..fcf36e0668 --- /dev/null +++ b/Task/Binary-digits/AppleScript/binary-digits.applescript @@ -0,0 +1,80 @@ +-- binaryString :: Int -> String +on binaryString(n) + + showIntAtBase(2, n) + +end binaryString + + +-- showIntAtBase :: Int -> Int -> String +on showIntAtBase(base, n) + if base > 1 then + if n > 0 then + set m to n mod base + set r to n - m + if r > 0 then + set prefix to showIntAtBase(base, r div base) + else + set prefix to "" + end if + + if m < 10 then + set baseCode to 48 -- "0" + else + set baseCode to 55 -- "A" - 10 + end if + + prefix & character id (baseCode + m) + else + "0" + end if + else + missing value + end if +end showIntAtBase + + +-- TEST +on run + + intercalate(linefeed, ¬ + map(binaryString, [5, 50, 9000])) + +end run + + + + +-- GENERIC FUNCTIONS FOR TESTING + +-- 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 + +-- intercalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate + +-- 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 diff --git a/Task/Binary-digits/Applesoft-BASIC/binary-digits.applesoft b/Task/Binary-digits/Applesoft-BASIC/binary-digits.applesoft new file mode 100644 index 0000000000..aa8fc789f1 --- /dev/null +++ b/Task/Binary-digits/Applesoft-BASIC/binary-digits.applesoft @@ -0,0 +1,10 @@ + 0 N = 5: GOSUB 1:N = 50: GOSUB 1:N = 9000: GOSUB 1: END + 1 LET N2 = ABS ( INT (N)) + 2 LET B$ = "" + 3 FOR N1 = N2 TO 0 STEP 0 + 4 LET N2 = INT (N1 / 2) + 5 LET B$ = STR$ (N1 - N2 * 2) + B$ + 6 LET N1 = N2 + 7 NEXT N1 + 8 PRINT B$ + 9 RETURN diff --git a/Task/Binary-digits/C/binary-digits.c b/Task/Binary-digits/C/binary-digits.c new file mode 100644 index 0000000000..787c6f0766 --- /dev/null +++ b/Task/Binary-digits/C/binary-digits.c @@ -0,0 +1,27 @@ +#include +#include +#include +#include + +char *bin(uint32_t x); + +int main(void) +{ + for (size_t i = 0; i < 20; i++) { + char *binstr = bin(i); + printf("%s\n", binstr); + free(binstr); + } +} + +char *bin(uint32_t x) +{ + size_t bits = (x == 0) ? 1 : log10((double) x)/log10(2) + 1; + char *ret = malloc((bits + 1) * sizeof (char)); + for (size_t i = 0; i < bits ; i++) { + ret[bits - i - 1] = (x & 1) ? '1' : '0'; + x >>= 1; + } + ret[bits] = '\0'; + return ret; +} diff --git a/Task/Binary-digits/Common-Lisp/binary-digits.lisp b/Task/Binary-digits/Common-Lisp/binary-digits.lisp index e2ce5c309f..d1a14f294d 100644 --- a/Task/Binary-digits/Common-Lisp/binary-digits.lisp +++ b/Task/Binary-digits/Common-Lisp/binary-digits.lisp @@ -1 +1,5 @@ (format t "~b" 5) + +; or + +(write 5 :base 2) diff --git a/Task/Binary-digits/Component-Pascal/binary-digits.component b/Task/Binary-digits/Component-Pascal/binary-digits.component index e12cb67f87..0053b68e79 100644 --- a/Task/Binary-digits/Component-Pascal/binary-digits.component +++ b/Task/Binary-digits/Component-Pascal/binary-digits.component @@ -5,11 +5,11 @@ PROCEDURE Do*; VAR str : ARRAY 33 OF CHAR; BEGIN - Strings.IntToStringForm(5,2,32,'0',FALSE,str); + Strings.IntToStringForm(5,2, 1,'0',FALSE,str); StdLog.Int(5);StdLog.String(":> " + str);StdLog.Ln; - Strings.IntToStringForm(50,2,32,'0',FALSE,str); + Strings.IntToStringForm(50,2, 1,'0',FALSE,str); StdLog.Int(50);StdLog.String(":> " + str);StdLog.Ln; - Strings.IntToStringForm(9000,2,32,'0',FALSE,str); + Strings.IntToStringForm(9000,2, 1,'0',FALSE,str); StdLog.Int(9000);StdLog.String(":> " + str);StdLog.Ln; END Do; END BinaryDigits. diff --git a/Task/Binary-digits/Delphi/binary-digits.delphi b/Task/Binary-digits/Delphi/binary-digits.delphi index 0c8c72ebb7..6cebd7f310 100644 --- a/Task/Binary-digits/Delphi/binary-digits.delphi +++ b/Task/Binary-digits/Delphi/binary-digits.delphi @@ -1,35 +1,7 @@ -{$IFDEF FPC} - {$MODE DELPHI} - {$OPTIMIZATION ON,Regvar,ASMCSE,CSE,PEEPHOLE} -{$ELSE} - {$APPTYPE CONSOLE} -{$ENDIF} +program BinaryDigit; +{$APPTYPE CONSOLE} uses - sysutils; //only for timing - -function IntToBinStrNew(AInt : LongWord):string; -const - IO : array[0..1] of char = ('.','X'); -var - idx,m : LongWord; - pC : pChar; -begin - IF AInt = 0 then Begin - result := IO[0];EXIT;end; - // search for the first set bit - idx:= 32;m := 1 shl (idx-1); - While ORD((AInt AND m) = 0)+ORD(m>0) = 2 do begin - dec(idx);m := m shr 1;end; - - //set right length and insert one by one - setlength(result,idx); - pC := @result[1]; - repeat - pC^ := IO[ORD((AInt and m) <> 0)]; - m := m shr 1; - inc(pC); - until m=0; -end; + sysutils; function IntToBinStr(AInt : LongWord) : string; begin @@ -40,26 +12,8 @@ begin until (AInt = 0); end; -procedure Binary_Digits; -begin - writeln(' 5: ',IntToBinStr(5)); - writeln(' 5: ',IntToBinStrNew(5)); - writeln(' 50: ',IntToBinStr(50)); - writeln(' 50: ',IntToBinStrNew(50)); - writeln('9000: '+IntToBinStr(9000)); - writeln('9000: '+IntToBinStrNew(9000)); -end; - -var - i: LongInt; - t :TDateTime; Begin - Binary_Digits; - //speed test - t := time; - For i := 1 to 10*1000*1000 do - IntToBinStrNew(i);t := time-t; Writeln(' New ',t*86400.0:6:3); - t := time; - For i := 1 to 10*1000*1000 do - IntToBinStr(i);t := time-t; Writeln(' Old ',t*86400.0:6:3); + writeln(' 5: ',IntToBinStr(5)); + writeln(' 50: ',IntToBinStr(50)); + writeln('9000: '+IntToBinStr(9000)); end. diff --git a/Task/Binary-digits/Elixir/binary-digits-3.elixir b/Task/Binary-digits/Elixir/binary-digits-3.elixir index 448add711b..4664384633 100644 --- a/Task/Binary-digits/Elixir/binary-digits-3.elixir +++ b/Task/Binary-digits/Elixir/binary-digits-3.elixir @@ -1 +1 @@ -[5,50,9000] |> Enum.map(fn n -> IO.puts Integer.to_string(n,2) end) +[5,50,9000] |> Enum.each(fn n -> IO.puts Integer.to_string(n,2) end) diff --git a/Task/Binary-digits/Frink/binary-digits.frink b/Task/Binary-digits/Frink/binary-digits.frink index 66e044f864..1d52ba0586 100644 --- a/Task/Binary-digits/Frink/binary-digits.frink +++ b/Task/Binary-digits/Frink/binary-digits.frink @@ -1,4 +1,4 @@ 9000 -> binary 9000 -> base2 base2[9000] -base[9000. 2] +base[9000, 2] diff --git a/Task/Binary-digits/Haskell/binary-digits.hs b/Task/Binary-digits/Haskell/binary-digits.hs index fcf217e471..3f5ca53c75 100644 --- a/Task/Binary-digits/Haskell/binary-digits.hs +++ b/Task/Binary-digits/Haskell/binary-digits.hs @@ -6,11 +6,11 @@ import Text.Printf toBin n = showIntAtBase 2 ("01" !!) n "" -- Implement our own version. -toBin' 0 = [] -toBin' x = (toBin' $ x `div` 2) ++ (show $ x `mod` 2) +toBin1 0 = [] +toBin1 x = (toBin1 $ x `div` 2) ++ (show $ x `mod` 2) -printToBin n = putStrLn $ printf "%4d %14s %14s" n (toBin n) (toBin' n) +printToBin n = putStrLn $ printf "%4d %14s %14s" n (toBin n) (toBin1 n) main = do - putStrLn $ printf "%4s %14s %14s" "N" "toBin" "toBin'" + putStrLn $ printf "%4s %14s %14s" "N" "toBin" "toBin1" mapM_ printToBin [5, 50, 9000] diff --git a/Task/Binary-digits/Lua/binary-digits.lua b/Task/Binary-digits/Lua/binary-digits.lua index ea7f120bd7..855f5930a5 100644 --- a/Task/Binary-digits/Lua/binary-digits.lua +++ b/Task/Binary-digits/Lua/binary-digits.lua @@ -1,11 +1,10 @@ function dec2bin (n) - local bin, number, bit = "", tonumber(n) -- can pass n as string - while number > 0 do - bit = number % 2 - number = math.floor(number/2) - bin = bit .. bin - end - return bin + local bin = "" + while n > 0 do + bin = n % 2 .. bin + n = math.floor(n / 2) + end + return bin end print(dec2bin(5)) diff --git a/Task/Binary-digits/Oberon-2/binary-digits.oberon-2 b/Task/Binary-digits/Oberon-2/binary-digits.oberon-2 index ea9c264318..5d7982d23a 100644 --- a/Task/Binary-digits/Oberon-2/binary-digits.oberon-2 +++ b/Task/Binary-digits/Oberon-2/binary-digits.oberon-2 @@ -1,85 +1,17 @@ MODULE BinaryDigits; -IMPORT - Object, - SYSTEM, - Out; +IMPORT Out; - PROCEDURE Reverse(VAR str: ARRAY OF CHAR); - VAR - s,e: LONGINT; - c: CHAR; + PROCEDURE OutBin(x: INTEGER); BEGIN - e := LEN(str) - 1; - WHILE (e >= 0) & (str[e] = 0X) DO DEC(e) END; - s := 0; - WHILE (s < e) DO - c := str[s]; - str[s] := str[e]; - str[e] := c; - INC(s);DEC(e) - END - END Reverse; + IF x > 1 THEN OutBin(x DIV 2) END; + Out.Int(x MOD 2, 1); + END OutBin; - PROCEDURE IntToOct*(x: LONGINT):STRING; - VAR - i: LONGINT; - o: ARRAY 12 OF CHAR; - BEGIN - o[LEN(o) - 1] := 0X; - - i := 0; - WHILE (i < LEN(o) - 1) DO - o[i] := CHR(ORD('0') + (x MOD 8)); - INC(i);x := SYSTEM.LSH(x,-3) - END; - Reverse(o); - RETURN Object.NewLatin1(o) - END IntToOct; - - PROCEDURE IntToHex*(x: LONGINT):STRING; - VAR - i: LONGINT; - h: ARRAY 9 OF CHAR; - hexDigit: LONGINT; - BEGIN - h[LEN(h) - 1] := 0X; - - i := 0; - WHILE (i < LEN(h) - 1) DO - hexDigit := x MOD 16; - IF (hexDigit >= 0) & (hexDigit <= 9) THEN - h[i] := CHR(ORD('0') + hexDigit); - ELSE - h[i] := CHR(ORD('A') + (hexDigit - 10)); - END; - INC(i);x := SYSTEM.LSH(x,-4) - END; - Reverse(h); - RETURN Object.NewLatin1(h) - END IntToHex; - - PROCEDURE IntToBin*(x: LONGINT):STRING; - VAR - i: LONGINT; - b: ARRAY 33 OF CHAR; - BEGIN - b[LEN(b) - 1] := 0X; - i := 0; - WHILE (i < LEN(b) - 1) DO - b[i] := CHR(ORD('0') + (x MOD 2)); - INC(i);x := SYSTEM.LSH(x,-1) - END; - - Reverse(b); - RETURN Object.NewLatin1(b); - END IntToBin; - BEGIN - - Out.Object("12 :> " + IntToBin(12));Out.Ln; - Out.Object("-12 :> " + IntToBin(-12));Out.Ln; - Out.Object("MAX(LONGINT) :> " + IntToBin(MAX(LONGINT)));Out.Ln; - Out.Object("MIN(LONGINT) :> " + IntToBin(MIN(LONGINT)));Out.Ln; - + OutBin(0); Out.Ln; + OutBin(1); Out.Ln; + OutBin(2); Out.Ln; + OutBin(3); Out.Ln; + OutBin(42); Out.Ln; END BinaryDigits. diff --git a/Task/Binary-digits/Pascal/binary-digits-1.pascal b/Task/Binary-digits/Pascal/binary-digits-1.pascal new file mode 100644 index 0000000000..42ad82f32a --- /dev/null +++ b/Task/Binary-digits/Pascal/binary-digits-1.pascal @@ -0,0 +1,29 @@ +program IntToBinTest; +{$MODE objFPC} +uses + strutils;//IntToBin +function WholeIntToBin(n: NativeUInt):string; +var + digits: NativeInt; +begin +// BSR?Word -> index of highest set bit but 0 -> 255 ==-1 ) + IF n <> 0 then + Begin +{$ifdef CPU64} + digits:= BSRQWord(NativeInt(n))+1; +{$ELSE} + digits:= BSRDWord(NativeInt(n))+1; +{$ENDIF} + WholeIntToBin := IntToBin(NativeInt(n),digits); + end + else + WholeIntToBin:='0'; +end; +procedure IntBinTest(n: NativeUint); +Begin + writeln(n:12,' ',WholeIntToBin(n)); +end; +BEGIN + IntBinTest(5);IntBinTest(50);IntBinTest(5000); + IntBinTest(0);IntBinTest(NativeUint(-1)); +end. diff --git a/Task/Binary-digits/Pascal/binary-digits-2.pascal b/Task/Binary-digits/Pascal/binary-digits-2.pascal new file mode 100644 index 0000000000..a7ee3bff41 --- /dev/null +++ b/Task/Binary-digits/Pascal/binary-digits-2.pascal @@ -0,0 +1,106 @@ +program IntToPcharTest; +uses + sysutils;//for timing + +const +{$ifdef CPU64} + cBitcnt = 64; +{$ELSE} + cBitcnt = 32; +{$ENDIF} + +procedure IntToBinPchar(AInt : NativeUInt;s:pChar); +//create the Bin-String +//!Beware of endianess ! this is for little endian +const + IO : array[0..1] of char = ('0','1');//('_','X'); as you like + IO4 : array[0..15] of LongWord = // '0000','1000' as LongWord +($30303030,$31303030,$30313030,$31313030, + $30303130,$31303130,$30313130,$31313130, + $30303031,$31303031,$30313031,$31313031, + $30303131,$31303131,$30313131,$31313131); +var + i : NativeInt; + +begin + IF AInt > 0 then + Begin + // Get the index of highest set bit +{$ifdef CPU64} + i := BSRQWord(NativeInt(Aint))+1; +{$ELSE} + i := BSRDWord(NativeInt(Aint))+1; +{$ENDIF} + s[i] := #0; + //get 4 characters at once + dec(i); + while i >= 3 do + Begin + pLongInt(@s[i-3])^ := IO4[Aint AND 15]; + Aint := Aint SHR 4; + dec(i,4) + end; + //the rest one by one + while i >= 0 do + Begin + s[i] := IO[Aint AND 1]; + AInt := Aint shr 1; + dec(i); + end; + end + else + Begin + s[0] := IO[0]; + s[1] := #0; + end; +end; + +procedure Binary_Digits; +var + s: pCHar; +begin + GetMem(s,cBitcnt+4); + fillchar(s[0],cBitcnt+4,#0); + IntToBinPchar( 5,s);writeln(' 5: ',s); + IntToBinPchar( 50,s);writeln(' 50: ',s); + IntToBinPchar(9000,s);writeln('9000: ',s); + IntToBinPchar(NativeUInt(-1),s);writeln(' -1: ',s); + FreeMem(s); +end; + +const + rounds = 10*1000*1000; + +var + s: pChar; + t :TDateTime; + i,l,cnt: NativeInt; + Testfield : array[0..rounds-1] of NativeUint; +Begin + randomize; + cnt := 0; + For i := rounds downto 1 do + Begin + l := random(High(NativeInt)); + Testfield[i] := l; + {$ifdef CPU64} + inc(cnt,BSRQWord(l)); + {$ELSE} + inc(cnt,BSRQWord(l)); + {$ENDIF} + end; + Binary_Digits; + GetMem(s,cBitcnt+4); + fillchar(s[0],cBitcnt+4,#0); + //warm up + For i := 0 to rounds-1 do + IntToBinPchar(Testfield[i],s); + //speed test + t := time; + For i := 1 to rounds do + IntToBinPchar(Testfield[i],s); + t := time-t; + Write(' Time ',t*86400.0:6:3,' secs, average stringlength '); + Writeln(cnt/rounds+1:6:3); + FreeMem(s); +end. diff --git a/Task/Binary-digits/REXX/binary-digits-1.rexx b/Task/Binary-digits/REXX/binary-digits-1.rexx index 1fb6a06e38..c6ae64994f 100644 --- a/Task/Binary-digits/REXX/binary-digits-1.rexx +++ b/Task/Binary-digits/REXX/binary-digits-1.rexx @@ -1,12 +1,11 @@ -/*REXX program demonstrates converting decimal ───► binary. */ -numeric digits 1000 -x.= -x.1 = 0 -x.2 = 5 -x.3 = 50 -x.4 = 9000 - do j=1 while x.j\=='' /*compute until a NULL is found.*/ - y = x2b(d2x(x.j)) + 0 /*force removal of leading zeroes*/ - say right(x.j,20) 'decimal, and in binary:' y - end /*j*/ - /*stick a fork in it, we're done.*/ +/*REXX program to convert several decimal numbers to binary (or base 2). */ + numeric digits 1000 /*ensure we can handle larger numbers. */ +@.=; @.1= 0 + @.2= 5 + @.3= 50 + @.4= 9000 + + do j=1 while @.j\=='' /*compute until a NULL value is found.*/ + y=x2b( d2x(@.j) ) + 0 /*force removal of extra leading zeroes*/ + say right(@.j,20) 'decimal, and in binary:' y /*display the number to the terminal. */ + end /*j*/ /*stick a fork in it, we're all done. */ diff --git a/Task/Binary-digits/REXX/binary-digits-2.rexx b/Task/Binary-digits/REXX/binary-digits-2.rexx index 53b7ddf879..c7526fab19 100644 --- a/Task/Binary-digits/REXX/binary-digits-2.rexx +++ b/Task/Binary-digits/REXX/binary-digits-2.rexx @@ -1,12 +1,11 @@ -/*REXX program demonstrates converting decimal ───► binary. */ -x.= -x.1 = 0 -x.2 = 5 -x.3 = 50 -x.4 = 9000 - do j=1 while x.j\=='' /*compute until a NULL is found.*/ - y = strip( x2b( d2x( x.j )), 'L', 0) - if y=='' then y=0 /*handle special case of 0 (zero)*/ - say right(x.j,20) 'decimal, and in binary:' y - end /*j*/ - /*stick a fork in it, we're done.*/ +/*REXX program to convert several decimal numbers to binary (or base 2). */ +@.=; @.1= 0 + @.2= 5 + @.3= 50 + @.4= 9000 + + do j=1 while @.j\=='' /*compute until a NULL value is found.*/ + y=strip( x2b( d2x( @.j )), 'L', 0) /*force removal of all leading zeroes.*/ + if y=='' then y=0 /*handle the special case of 0 (zero).*/ + say right(@.j,20) 'decimal, and in binary:' y /*display the number to the terminal. */ + end /*j*/ /*stick a fork in it, we're all done. */ diff --git a/Task/Binary-digits/REXX/binary-digits-3.rexx b/Task/Binary-digits/REXX/binary-digits-3.rexx index 687d79d787..3a8e2328be 100644 --- a/Task/Binary-digits/REXX/binary-digits-3.rexx +++ b/Task/Binary-digits/REXX/binary-digits-3.rexx @@ -1,11 +1,10 @@ -/*REXX program demonstrates converting decimal ───► binary. */ -x.= -x.1=0 -x.2=5 -x.3=50 -x.4=9000 - do j=1 while x.j\=='' /*compute until a NULL is found.*/ - y = word( strip( x2b( d2x( x.j )), 'L', 0) 0, 1) - say right(x.j,20) 'decimal, and in binary:' y - end /*j*/ - /*stick a fork in it, we're done.*/ +/*REXX program to convert several decimal numbers to binary (or base 2). */ +@.=; @.1= 0 + @.2= 5 + @.3= 50 + @.4= 9000 + + do j=1 while @.j\=='' /*compute until a NULL value is found.*/ + y=word( strip( x2b( d2x( @.j )), 'L', 0) 0, 1) /*elides all leading 0s, if null, use 0*/ + say right(@.j,20) 'decimal, and in binary:' y /*display the number to the terminal. */ + end /*j*/ /*stick a fork in it, we're all done. */ diff --git a/Task/Binary-digits/REXX/binary-digits-4.rexx b/Task/Binary-digits/REXX/binary-digits-4.rexx index 65e5d7b73a..a6ce30b714 100644 --- a/Task/Binary-digits/REXX/binary-digits-4.rexx +++ b/Task/Binary-digits/REXX/binary-digits-4.rexx @@ -1,16 +1,14 @@ -/*REXX program demonstrates converting decimal ───► binary. */ -numeric digits 200 -x.= -x.1=0 -x.2=5 -x.3=50 -x.4=9000 -x.5=423785674235000123456789 -x.6=1e138 /*one quinquaquadragintillion. */ +/*REXX program to convert several decimal numbers to binary (or base 2). */ + numeric digits 200 /*ensure we can handle larger numbers. */ +@.=; @.1= 0 + @.2= 5 + @.3= 50 + @.4= 9000 + @.5=423785674235000123456789 + @.6= 1e138 /*one quinquaquadragintillion ugh.*/ - do j=1 while x.j\=='' /*compute until a NULL is found.*/ - y = strip( x2b( d2x( x.j )), 'L', 0) - if y=='' then y=0 /*handle special case of 0 (zero)*/ - say y - end /*j*/ - /*stick a fork in it, we're done.*/ + do j=1 while @.j\=='' /*compute until a NULL value is found.*/ + y=strip( x2b( d2x( @.j )), 'L', 0) /*force removal of all leading zeroes.*/ + if y=='' then y=0 /*handle the special case of 0 (zero).*/ + say right(@.j,20) 'decimal, and in binary:' y /*display the number to the terminal. */ + end /*j*/ /*stick a fork in it, we're all done. */ diff --git a/Task/Binary-digits/RapidQ/binary-digits.rapidq b/Task/Binary-digits/RapidQ/binary-digits.rapidq new file mode 100644 index 0000000000..c8e8ea8bd1 --- /dev/null +++ b/Task/Binary-digits/RapidQ/binary-digits.rapidq @@ -0,0 +1,5 @@ +'Convert Integer to binary string +Print "bin 5 = ", bin$(5) +Print "bin 50 = ",bin$(50) +Print "bin 9000 = ",bin$(9000) +sleep 10 diff --git a/Task/Binary-digits/S-lang/binary-digits.slang b/Task/Binary-digits/S-lang/binary-digits.slang new file mode 100644 index 0000000000..f31dfe6f23 --- /dev/null +++ b/Task/Binary-digits/S-lang/binary-digits.slang @@ -0,0 +1,21 @@ +define int_to_bin(d) +{ + variable m = 0x40000000, prn = 0, bs = ""; + do { + if (d & m) { + bs += "1"; + prn = 1; + } + else if (prn) + bs += "0"; + m = m shr 1; + + } while (m); + + if (bs == "") bs = "0"; + return bs; +} + +() = printf("%s\n", int_to_bin(5)); +() = printf("%s\n", int_to_bin(50)); +() = printf("%s\n", int_to_bin(9000)); diff --git a/Task/Binary-search/C/binary-search.c b/Task/Binary-search/C/binary-search.c new file mode 100644 index 0000000000..5f3f02761c --- /dev/null +++ b/Task/Binary-search/C/binary-search.c @@ -0,0 +1,46 @@ +#include + +int bsearch (int *a, int n, int x) { + int i = 0, j = n - 1; + while (i <= j) { + int k = (i + j) / 2; + if (a[k] == x) { + return k; + } + else if (a[k] < x) { + i = k + 1; + } + else { + j = k - 1; + } + } + return -1; +} + +int bsearch_r (int *a, int x, int i, int j) { + if (j < i) { + return -1; + } + int k = (i + j) / 2; + if (a[k] == x) { + return k; + } + else if (a[k] < x) { + return bsearch_r(a, x, k + 1, j); + } + else { + return bsearch_r(a, x, i, k - 1); + } +} + +int main () { + int a[] = {-31, 0, 1, 2, 2, 4, 65, 83, 99, 782}; + int n = sizeof a / sizeof a[0]; + int x = 2; + int i = bsearch(a, n, x); + printf("%d is at index %d\n", x, i); + x = 5; + i = bsearch_r(a, x, 0, n - 1); + printf("%d is at index %d\n", x, i); + return 0; +} diff --git a/Task/Binary-search/Common-Lisp/binary-search-1.lisp b/Task/Binary-search/Common-Lisp/binary-search-1.lisp index 9b4943f3ea..9181fa1cb6 100644 --- a/Task/Binary-search/Common-Lisp/binary-search-1.lisp +++ b/Task/Binary-search/Common-Lisp/binary-search-1.lisp @@ -3,7 +3,7 @@ (high (1- (length array)))) (do () ((< high low) nil) - (let ((middle (floor (/ (+ low high) 2)))) + (let ((middle (floor (+ low high) 2))) (cond ((> (aref array middle) value) (setf high (1- middle))) diff --git a/Task/Binary-search/Common-Lisp/binary-search-2.lisp b/Task/Binary-search/Common-Lisp/binary-search-2.lisp index ca92fe78c4..38492f9ece 100644 --- a/Task/Binary-search/Common-Lisp/binary-search-2.lisp +++ b/Task/Binary-search/Common-Lisp/binary-search-2.lisp @@ -1,7 +1,7 @@ (defun binary-search (value array &optional (low 0) (high (1- (length array)))) (if (< high low) nil - (let ((middle (floor (/ (+ low high) 2)))) + (let ((middle (floor (+ low high) 2))) (cond ((> (aref array middle) value) (binary-search value array low (1- middle))) diff --git a/Task/Binary-search/K/binary-search.k b/Task/Binary-search/K/binary-search.k new file mode 100644 index 0000000000..15927341f9 --- /dev/null +++ b/Task/Binary-search/K/binary-search.k @@ -0,0 +1,14 @@ +bs:{[a;t] + if[0=#a; :_n]; + m:_(#a)%2; + if[t>a@m + tmp:_f[(m+1) _ a;t] + :[_n~tmp; :_n; :1+m+tmp]] + if[t> Array.binarySearch(target: T): Int { + var hi = size - 1 + var lo = 0 + while (hi >= lo) { + val guess = lo + (hi - lo) / 2 + if (this[guess] > target) + hi = guess - 1 + else if (this[guess] < target) + lo = guess + 1 + else + return guess + } + return -1 +} + +// recursive search: +fun > Array.binarySearch(target: T, lo: Int, hi: Int): Int { + if (hi < lo) + return -1 + val guess = (hi + lo) / 2 + return if (this[guess] > target) + binarySearch(target, lo, guess - 1) + else if (this[guess] < target) + binarySearch(target, guess + 1, hi) + else + guess +} + +fun main(args: Array) { + val a = intArrayOf(1, 3, 4, 5, 6, 7, 8, 9, 10) + var t = 6 // target + var r = a.binarySearch(t) + println(if (r < 0) "$t not found" else "$t found at index $r") + t = 250 + r = a.binarySearch(t) + println(if (r < 0) "$t not found" else "$t found at index $r") + + t = 6 + r = a.binarySearch(t, 0, a.size) + println(if (r < 0) "$t not found" else "$t found at index $r") + t = 250 + r = a.binarySearch(t, 0, a.size) + println(if (r < 0) "$t not found" else "$t found at index $r") +} diff --git a/Task/Binary-search/Perl/binary-search-1.pl b/Task/Binary-search/Perl/binary-search-1.pl index 4671b81c4d..383c60d85c 100644 --- a/Task/Binary-search/Perl/binary-search-1.pl +++ b/Task/Binary-search/Perl/binary-search-1.pl @@ -1,15 +1,16 @@ sub binary_search { - my ($array_ref, $value, $left, $right) = @_; - while ($left <= $right) { - my $middle = int(($right + $left) >> 1); - return 1 if ($array_ref->[$middle] == $value); - if ($value == $array_ref->[$middle]) { - return middle; - } elsif ($value < $array_ref->[$middle]) { - $right = $middle - 1; - } else { - $left = $middle + 1; + my ($array_ref, $value, $left, $right) = @_; + while ($left <= $right) { + my $middle = int(($right + $left) >> 1); + if ($value == $array_ref->[$middle]) { + return $middle; + } + elsif ($value < $array_ref->[$middle]) { + $right = $middle - 1; + } + else { + $left = $middle + 1; + } } - } - return 0; + return -1; } diff --git a/Task/Binary-search/Perl/binary-search-2.pl b/Task/Binary-search/Perl/binary-search-2.pl index 7d31f28a7c..6ef92a860b 100644 --- a/Task/Binary-search/Perl/binary-search-2.pl +++ b/Task/Binary-search/Perl/binary-search-2.pl @@ -1,13 +1,14 @@ sub binary_search { - my ($array_ref, $value, $left, $right) = @_; - return 0 if ($right < $left); - my $middle = int(($right + $left) >> 1); - return 1 if ($array_ref->[$middle] == $value); - if ($value == $array_ref->[$middle]) { - return middle; - } elsif ($value < $array_ref->[$middle]) { - binary_search($array_ref, $value, $left, $middle - 1); - } else { - binary_search($array_ref, $value, $middle + 1, $right); - } + my ($array_ref, $value, $left, $right) = @_; + return -1 if ($right < $left); + my $middle = int(($right + $left) >> 1); + if ($value == $array_ref->[$middle]) { + return $middle; + } + elsif ($value < $array_ref->[$middle]) { + binary_search($array_ref, $value, $left, $middle - 1); + } + else { + binary_search($array_ref, $value, $middle + 1, $right); + } } diff --git a/Task/Binary-search/Python/binary-search-2.py b/Task/Binary-search/Python/binary-search-2.py index c92cd43337..08e9c8a1db 100644 --- a/Task/Binary-search/Python/binary-search-2.py +++ b/Task/Binary-search/Python/binary-search-2.py @@ -1,7 +1,7 @@ def binary_search(l, value, low = 0, high = -1): if not l: return -1 if(high == -1): high = len(l)-1 - if low == high: + if low >= high: if l[low] == value: return low else: return -1 mid = (low+high)//2 diff --git a/Task/Binary-search/Ruby/binary-search-1.rb b/Task/Binary-search/Ruby/binary-search-1.rb index 9c6e6cba4a..85c208ce31 100644 --- a/Task/Binary-search/Ruby/binary-search-1.rb +++ b/Task/Binary-search/Ruby/binary-search-1.rb @@ -2,7 +2,7 @@ class Array def binary_search(val, low=0, high=(length - 1)) return nil if high < low mid = (low + high) >> 1 - case var <=> self[mid] + case val <=> self[mid] when -1 binary_search(val, low, mid - 1) when 1 diff --git a/Task/Binary-search/ZX-Spectrum-Basic/binary-search.zx b/Task/Binary-search/ZX-Spectrum-Basic/binary-search.zx new file mode 100644 index 0000000000..24e105fc23 --- /dev/null +++ b/Task/Binary-search/ZX-Spectrum-Basic/binary-search.zx @@ -0,0 +1,19 @@ +10 DATA 2,3,5,6,8,10,11,15,19,20 +20 DIM t(10) +30 FOR i=1 TO 10 +40 READ t(i) +50 NEXT i +60 LET value=4: GO SUB 100 +70 LET value=8: GO SUB 100 +80 LET value=20: GO SUB 100 +90 STOP +100 REM Binary search +110 LET lo=1: LET hi=10 +120 IF lo>hi THEN LET idx=0: GO TO 170 +130 LET middle=INT ((hi+lo)/2) +140 IF valuet(middle) THEN LET lo=middle+1: GO TO 120 +160 LET idx=middle +170 PRINT "Value ";value; +180 IF idx=0 THEN PRINT " not found": RETURN +190 PRINT " found at index ";idx: RETURN diff --git a/Task/Binary-strings/00DESCRIPTION b/Task/Binary-strings/00DESCRIPTION index 11a69294bb..d68465348d 100644 --- a/Task/Binary-strings/00DESCRIPTION +++ b/Task/Binary-strings/00DESCRIPTION @@ -11,4 +11,6 @@ In particular the functions you need to create are: * Replace every occurrence of a byte (or a string) in a string with another string * Join strings +
Possible contexts of use: compression algorithms (like [[LZW compression]]), L-systems (manipulation of symbols), many more. +

diff --git a/Task/Binary-strings/Common-Lisp/binary-strings-5.lisp b/Task/Binary-strings/Common-Lisp/binary-strings-5.lisp index 30eb766732..0e00e6ce28 100644 --- a/Task/Binary-strings/Common-Lisp/binary-strings-5.lisp +++ b/Task/Binary-strings/Common-Lisp/binary-strings-5.lisp @@ -1,4 +1,2 @@ (defun string-empty-p (string) - (cond - ((= 0 (length string))t) - (nil))) + (zerop (length string))) diff --git a/Task/Binary-strings/Icon/binary-strings-1.icon b/Task/Binary-strings/Icon/binary-strings-1.icon index a7df2a4e61..527659ffe6 100644 --- a/Task/Binary-strings/Icon/binary-strings-1.icon +++ b/Task/Binary-strings/Icon/binary-strings-1.icon @@ -1,6 +1,6 @@ s := "\x00" # strings can contain any value, even nulls s := "abc" # create a string -s := &null # destroy a string (well sbsnfon it for garbage collection) +s := &null # destroy a string (garbage collect value of s; set new value to &null) v := s # assignment s == t # expression s equals t s << t # expression s less than t diff --git a/Task/Binary-strings/PowerShell/binary-strings.psh b/Task/Binary-strings/PowerShell/binary-strings.psh new file mode 100644 index 0000000000..fa8b1c8f00 --- /dev/null +++ b/Task/Binary-strings/PowerShell/binary-strings.psh @@ -0,0 +1,67 @@ +Clear-Host + +## String creation (which is string assignment): +Write-Host "`nString creation (which is string assignment):" -ForegroundColor Cyan +Write-Host '[string]$s = "Hello cruel world"' -ForegroundColor Yellow +[string]$s = "Hello cruel world" + +## String (or any variable) destruction: +Write-Host "`nString (or any variable) destruction:" -ForegroundColor Cyan +Write-Host 'Remove-Variable -Name s -Force' -ForegroundColor Yellow +Remove-Variable -Name s -Force + +## Now reassign the variable: +Write-Host "`nNow reassign the variable:" -ForegroundColor Cyan +Write-Host '[string]$s = "Hello cruel world"' -ForegroundColor Yellow +[string]$s = "Hello cruel world" + +Write-Host "`nString comparison -- default is case insensitive:" -ForegroundColor Cyan +Write-Host '$s -eq "HELLO CRUEL WORLD"' -ForegroundColor Yellow +$s -eq "HELLO CRUEL WORLD" +Write-Host '$s -match "HELLO CRUEL WORLD"' -ForegroundColor Yellow +$s -match "HELLO CRUEL WORLD" +Write-Host '$s -cmatch "HELLO CRUEL WORLD"' -ForegroundColor Yellow +$s -cmatch "HELLO CRUEL WORLD" + +## Copy a string: +Write-Host "`nCopy a string:" -ForegroundColor Cyan +Write-Host '$t = $s' -ForegroundColor Yellow +$t = $s + +## Check if a string is empty: +Write-Host "`nCheck if a string is empty:" -ForegroundColor Cyan +Write-Host 'if ($s -eq "") {"String is empty."} else {"String = $s"}' -ForegroundColor Yellow +if ($s -eq "") {"String is empty."} else {"String = $s"} + +## Append a byte to a string: +Write-Host "`nAppend a byte to a string:" -ForegroundColor Cyan +Write-Host "`$s += [char]46`n`$s" -ForegroundColor Yellow +$s += [char]46 +$s + +## Extract (and display) substring from a string: +Write-Host "`nExtract (and display) substring from a string:" -ForegroundColor Cyan +Write-Host '"Is the world $($s.Substring($s.IndexOf("c"),5))?"' -ForegroundColor Yellow +"Is the world $($s.Substring($s.IndexOf("c"),5))?" + +## Replace every occurrence of a byte (or a string) in a string with another string: +Write-Host "`nReplace every occurrence of a byte (or a string) in a string with another string:" -ForegroundColor Cyan +Write-Host "`$t = `$s -replace `"cruel`", `"beautiful`"`n`$t" -ForegroundColor Yellow +$t = $s -replace "cruel", "beautiful" +$t + +## Join strings: +Write-Host "`nJoin strings [1]:" -ForegroundColor Cyan +Write-Host '"Is the world $($s.Split()[1]) or $($t.Split()[1])?"' -ForegroundColor Yellow +"Is the world $($s.Split()[1]) or $($t.Split()[1])?" +Write-Host "`nJoin strings [2]:" -ForegroundColor Cyan +Write-Host '"{0} or {1}... I don''t care." -f (Get-Culture).TextInfo.ToTitleCase($s.Split()[1]), $t.Split()[1]' -ForegroundColor Yellow +"{0} or {1}... I don't care." -f (Get-Culture).TextInfo.ToTitleCase($s.Split()[1]), $t.Split()[1] +Write-Host "`nJoin strings [3] (display an integer array using the -join operater):" -ForegroundColor Cyan +Write-Host '1..12 -join ", "' -ForegroundColor Yellow +1..12 -join ", " + +## Display an integer array in a tablular format: +Write-Host "`nMore string madness... display an integer array in a tablular format:" -ForegroundColor Cyan +Write-Host '1..12 | Format-Wide {$_.ToString().PadLeft(2)}-Column 3 -Force' -NoNewline -ForegroundColor Yellow +1..12 | Format-Wide {$_.ToString().PadLeft(2)} -Column 3 -Force diff --git a/Task/Binary-strings/REXX/binary-strings.rexx b/Task/Binary-strings/REXX/binary-strings.rexx index 1e7136c4d7..ee973cc943 100644 --- a/Task/Binary-strings/REXX/binary-strings.rexx +++ b/Task/Binary-strings/REXX/binary-strings.rexx @@ -1,31 +1,18 @@ -/*REXX program shows ways to use and express binary strings. */ - -dingsta='11110101'b /*4 versions, bit str assignment.*/ -dingsta="11110101"b /*same as above. */ -dingsta='11110101'B /*same as above. */ -dingsta='1111 0101'B /*same as above. */ - -dingst2=dingsta /*clone 1 str to another (copy). */ - -other='1001 0101 1111 0111'b /*another binary (bit) string. */ - -if dingsta=other then say 'they are equal' /*compare two strings.*/ - -if other=='' then say 'OTHER is empty.' /*see if it's empty. */ -if length(other)==0 then say 'OTHER is empty.' /*another version. */ - -otherA=other || '$' /*append a dollar sign to OTHER. */ -otherB=other'$' /*same as above, with less fuss. */ - -guts=substr(c2b(other),10,3) /*get the 10th through 12th bits.*/ - /*see sub below. Some REXXes */ - /*have C2B as a built-in function*/ - -new=changestr('A',other,"Z") /*change the letter A to Z. */ - -tt=changestr('~~',other,";") /*change 2 tildes to a semicolon.*/ - -joined=dignsta || dingst2 /*join 2 strs together (concat). */ -exit /*stick a fork in it, we're done.*/ -/*─────────────────────────────────C2B subroutine───────────────────────*/ -c2b: return x2b(c2x(arg(1))) /*return the string as a binary string. */ +/*REXX program demonstrates methods (code examples) to use and express binary strings.*/ +dingsta= '11110101'b /*four versions, bit string assignment.*/ +dingsta= "11110101"b /*this is the same assignment as above.*/ +dingsta= '11110101'B /* " " " " " " " */ +dingsta= '1111 0101'B /* " " " " " " */ +dingsta2=dingsta /*clone one string to another (a copy).*/ +other= '1001 0101 1111 0111'b /*another binary (or bit) string. */ +if dingsta=other then say 'they are equal' /*compare the two (binary) strings. */ +if other=='' then say 'OTHER is empty.' /*see if the OTHER string is empty.*/ +otherA=other || '$' /*append a dollar sign ($) to OTHER. */ +otherB=other'$' /*same as above, but with less fuss. */ +guts=substr(c2b(other), 10, 3) /*obtain the 10th through 12th bits.*/ +new=changeStr('A', other, "Z") /*change the upper letter A ──► Z. */ +tt=changeStr('~~', other, ";") /*change two tildes ──► one semicolon.*/ +joined=dignsta || dingsta2 /*join two strings together (concat). */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +c2b: return x2b( c2x( arg(1) ) ) /*return the string as a binary string.*/ diff --git a/Task/Binary-strings/Rust/binary-strings.rust b/Task/Binary-strings/Rust/binary-strings.rust new file mode 100644 index 0000000000..5dc8ea1105 --- /dev/null +++ b/Task/Binary-strings/Rust/binary-strings.rust @@ -0,0 +1,72 @@ +use std::str; +fn main() { + //Create new string + let str = String::from("Hello world!"); + println!("{}", str); + assert!(str == "Hello world!", "Incorrect string text"); + + //Create and assign value to string + let mut assigned_str = String::new(); + assert!(assigned_str == "", "Incorrect string creation"); + assigned_str.push_str("Text has been assigned!"); + println!("{}", assigned_str); + assert!(assigned_str == "Text has been assigned!","Incorrect string text"); + + //String comparison, compared lexicographically byte-wise + //same as the asserts above + if str == "Hello world!" && assigned_str == "Text has been assigned!" { + println!("Strings are equal"); + } + + //Cloning -> str can still be used after cloning + let clone_str = str.clone(); + println!("String is:{} and Clone string is: {}", str, clone_str); + assert!(clone_str == str, "Incorrect string creation"); + + //Copying, str won't be usable anymore, accessing it will cause compiler failure + let copy_str = str; + println!("String copied now: {}", copy_str); + + //Check if string is empty + let empty_str = String::new(); + assert!(empty_str.is_empty(), "Error, string should be empty"); + + //Append byte, Rust strings are a stream of UTF-8 bytes + let byte_vec = vec![65]; //contains A + let byte_str = str::from_utf8(&byte_vec).unwrap(); + assert!(byte_str == "A", "Incorrect byte append"); + + //Substrings can be accessed through slices + let test_str = "Blah String"; + let mut sub_str = &test_str[0..11]; + assert!(sub_str == "Blah String", "Error in slicing"); + sub_str = &test_str[1..5]; + assert!(sub_str == "lah ", "Error in slicing"); + sub_str = &test_str[3..]; + assert!(sub_str == "h String", "Error in slicing"); + sub_str = &test_str[..2]; + assert!(sub_str == "Bl", "Error in slicing"); + + //String replace, note string is immutable + let org_str = "Hello"; + assert!( org_str.replace("l", "a") == "Heaao", "Error in replacement"); + assert!( org_str.replace("ll", "r") == "Hero", "Error in replacement"); + + //Joining strings requires a string and an &str or a two string one of which needs an & for coercion + let str1 = "Hi"; + let str2 = " There"; + let fin_str = str1.to_string() + str2; + assert!( fin_str == "Hi There", "Error in concatenation"); + + //Joining strings requires a string and an &str or two strings, one of which needs an & for coercion + let str1 = "Hi"; + let str2 = " There"; + let fin_str = str1.to_string() + str2; + assert!( fin_str == "Hi There", "Error in concatenation"); + + //Splits -- note Rust supports passing patterns to splits + let f_str = "Pooja and Sundar are up in Tumkur"; + let split_str: Vec<&str> = f_str.split(' ').collect(); + assert!( split_str == ["Pooja", "and", "Sundar", "are", "up", "in", "Tumkur"], "Error in string split"); + +} diff --git a/Task/Bitcoin-address-validation/Perl-6/bitcoin-address-validation.pl6 b/Task/Bitcoin-address-validation/Perl-6/bitcoin-address-validation.pl6 index 7458afc849..01b306e591 100644 --- a/Task/Bitcoin-address-validation/Perl-6/bitcoin-address-validation.pl6 +++ b/Task/Bitcoin-address-validation/Perl-6/bitcoin-address-validation.pl6 @@ -1,4 +1,4 @@ -my regex bitcoin-address { +my $bitcoin-address = rx/ <+alnum-[0IOl]> ** 26..* # an address is at least 26 characters long -} +/; -say "Here is a bitcoin address: 1AGNa15ZQXAZUgFiqJ2i7Z2DPU2J6hW62i" ~~ //; +say "Here is a bitcoin address: 1AGNa15ZQXAZUgFiqJ2i7Z2DPU2J6hW62i" ~~ $bitcoin-address; diff --git a/Task/Bitcoin-address-validation/PicoLisp/bitcoin-address-validation.l b/Task/Bitcoin-address-validation/PicoLisp/bitcoin-address-validation.l index c1ba271192..267e840285 100644 --- a/Task/Bitcoin-address-validation/PicoLisp/bitcoin-address-validation.l +++ b/Task/Bitcoin-address-validation/PicoLisp/bitcoin-address-validation.l @@ -1,43 +1,30 @@ +(load "sha256.l") + (setq *Alphabet - (chop "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz")) - -# if returns NIL then adress is already invalid -(de base58 (Str) - (let N 0 - (for L (chop Str) - (setq N - (+ - (* N 58) - (index L *Alphabet) - -1 ) ) ) - - N ) -) - -(de sha256 (Lst) - (native "libcrypto.so" "SHA256" - '(B . 32) - (cons - NIL - (32) - (native "libcrypto.so" "SHA256" '(B . 32) - (cons NIL (32) Lst) (length Lst) '(NIL (32))) ) - 32 - '(NIL (32)) ) ) - -(de bytes25 (N) - (flip - (make - (do 25 - (link (% N 256)) - (setq N (/ N 256)) ) ) ) ) - + (chop "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz") ) +(de unbase58 (Str) + (let (Str (chop Str) Lst (need 25 0) C) + (while (setq C (dec (index (pop 'Str) *Alphabet))) + (for (L Lst L) + (set + L (& (inc 'C (* 58 (car L))) 255) + 'C (/ C 256) ) + (pop 'L) ) ) + (flip Lst) ) ) (de valid (Str) (and - (base58 Str) - (bytes25 @) + (setq @@ (unbase58 Str)) (= - (head 4 (sha256 (head 21 @))) - (tail 4 @) ) ) ) - -(bye) + (head 4 (sha256 (sha256 (head 21 @@)))) + (tail 4 @@) ) ) ) +(test + T + (valid "17NdbrSGoUotzeGCcMMCqnFkEvLymoou9j") ) +(test + T + (= + NIL + (valid "1AGNa15ZQXAZUgFiqJ2i7Z2DPU2J6hW62j") + (valid "1AGNa15ZQXAZUgFiqJ2i7Z2DPU2J6hW62!") + (valid "1AGNa15ZQXAZUgFiqJ2i7Z2DPU2J6hW62iz") + (valid "1AGNa15ZQXAZUgFiqJ2i7Z2DPU2J6hW62izz") ) ) diff --git a/Task/Bitcoin-address-validation/PureBasic/bitcoin-address-validation.purebasic b/Task/Bitcoin-address-validation/PureBasic/bitcoin-address-validation.purebasic new file mode 100644 index 0000000000..e64ae917e2 --- /dev/null +++ b/Task/Bitcoin-address-validation/PureBasic/bitcoin-address-validation.purebasic @@ -0,0 +1,76 @@ +; using PureBasic 5.50 (x64) +EnableExplicit + +Macro IsValid(expression) + If expression + PrintN("Valid") + Else + PrintN("Invalid") + EndIf +EndMacro + +Procedure.i DecodeBase58(Address$, Array result.a(1)) + Protected i, j, p + Protected charSet$ = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz" + Protected c$ + + For i = 1 To Len(Address$) + c$ = Mid(Address$, i, 1) + p = FindString(charSet$, c$) - 1 + If p = -1 : ProcedureReturn #False : EndIf; Address contains invalid Base58 character + For j = 24 To 1 Step -1 + p + 58 * result(j) + result(j) = p % 256 + p / 256 + Next j + If p <> 0 : ProcedureReturn #False : EndIf ; Address is too long + Next i + ProcedureReturn #True +EndProcedure + +Procedure HexToBytes(hex$, Array result.a(1)) + Protected i + For i = 1 To Len(hex$) - 1 Step 2 + result(i/2) = Val("$" + Mid(hex$, i, 2)) + Next +EndProcedure + +Procedure.i IsBitcoinAddressValid(Address$) + Protected format$, digest$ + Protected i, isValid + Protected Dim result.a(24) + Protected Dim result2.a(31) + Protected result$, result2$ + ; Address length must be between 26 and 35 - see 'https://en.bitcoin.it/wiki/Address' + If Len(Address$) < 26 Or Len(Address$) > 35 : ProcedureReturn #False : EndIf + ; and begin with either 1 or 3 which is the format number + format$ = Left(Address$, 1) + If format$ <> "1" And format$ <> "3" : ProcedureReturn #False : EndIf + isValid = DecodeBase58(Address$, result()) + If Not isValid : ProcedureReturn #False : EndIf + UseSHA2Fingerprint(); Using functions from PB's built-in Cipher library + digest$ = Fingerprint(@result(), 21, #PB_Cipher_SHA2, 256); apply SHA2-256 to first 21 bytes + HexToBytes(digest$, result2()); change hex string to ascii array + digest$ = Fingerprint(@result2(), 32, #PB_Cipher_SHA2, 256); apply SHA2-256 again to all 32 bytes + HexToBytes(digest$, result2()) + result$ = PeekS(@result() + 21, 4, #PB_Ascii); last 4 bytes + result2$ = PeekS(@result2(), 4, #PB_Ascii); first 4 bytes + If result$ <> result2$ : ProcedureReturn #False : EndIf + ProcedureReturn #True +EndProcedure + +If OpenConsole() + Define address$ = "1AGNa15ZQXAZUgFiqJ2i7Z2DPU2J6hW62i" + Define address2$ = "1BGNa15ZQXAZUgFiqJ2i7Z2DPU2J6hW62i" + Define address3$ = "1AGNa15ZQXAZUgFiqJ2i7Z2DPU2J6hW62I" + Print(address$ + " -> ") + IsValid(IsBitcoinAddressValid(address$)) + Print(address2$ + " -> ") + IsValid(IsBitcoinAddressValid(address2$)) + Print(address3$ + " -> ") + IsValid(IsBitcoinAddressValid(address3$)) + PrintN("") + PrintN("Press any key to close the console") + Repeat: Delay(10) : Until Inkey() <> "" + CloseConsole() +EndIf diff --git a/Task/Bitcoin-public-point-to-address/Perl-6/bitcoin-public-point-to-address.pl6 b/Task/Bitcoin-public-point-to-address/Perl-6/bitcoin-public-point-to-address.pl6 index fd221b9fdc..f9f959bf1b 100644 --- a/Task/Bitcoin-public-point-to-address/Perl-6/bitcoin-public-point-to-address.pl6 +++ b/Task/Bitcoin-public-point-to-address/Perl-6/bitcoin-public-point-to-address.pl6 @@ -6,19 +6,18 @@ constant BASE58 = < a b c d e f g h i j k m n o p q r s t u v w x y z >; -sub encode(Int $n) { - $n < BASE58 ?? - BASE58[$n] !! - encode($n div 58) ~ BASE58[$n % 58] +sub encode( UInt $n ) { + [R~] BASE58[ $n.polymod: 58 xx * ] } -sub public_point_to_address(Int $x is copy, Int $y is copy) { - my @bytes; - for 1 .. 32 { push @bytes, $y % 256; $y div= 256 } - for 1 .. 32 { push @bytes, $x % 256; $x div= 256 } +sub public_point_to_address( UInt $x, UInt $y ) { + my @bytes = ( + |$y.polymod( 256 xx 32 )[^32], # ignore the extraneous 33rd modulus + |$x.polymod( 256 xx 32 )[^32], + ); my $hash = rmd160 sha256 Blob.new: 4, @bytes.reverse; my $checksum = sha256(sha256 Blob.new: 0, $hash.list).subbuf: 0, 4; - encode reduce * * 256 + * , 0, ($hash, $checksum)».list + encode reduce * * 256 + * , flat 0, ($hash, $checksum)».list } say public_point_to_address diff --git a/Task/Bitcoin-public-point-to-address/Perl/bitcoin-public-point-to-address.pl b/Task/Bitcoin-public-point-to-address/Perl/bitcoin-public-point-to-address.pl index eb38ecba5b..e7d91e5788 100644 --- a/Task/Bitcoin-public-point-to-address/Perl/bitcoin-public-point-to-address.pl +++ b/Task/Bitcoin-public-point-to-address/Perl/bitcoin-public-point-to-address.pl @@ -1,30 +1,20 @@ -use bigint; use Crypt::RIPEMD160; use Digest::SHA qw(sha256); -my @b58 = qw{ - 1 2 3 4 5 6 7 8 9 - A B C D E F G H J K L M N P Q R S T U V W X Y Z - a b c d e f g h i j k m n o p q r s t u v w x y z -}; -my $b58 = qr/[@{[join '', @b58]}]/x; - -sub encode { my $_ = shift; $_ < 58 ? $b58[$_] : encode($_/58) . $b58[$_%58] } +use Encode::Base58::GMP; sub public_point_to_address { - my ($x, $y) = @_; - my @byte; - for (1 .. 32) { push @byte, $y % 256; $y /= 256 } - for (1 .. 32) { push @byte, $x % 256; $x /= 256 } - @byte = (4, reverse @byte); - my $hash = Crypt::RIPEMD160->hash(sha256 join '', map { chr } @byte); - my $checksum = substr sha256(sha256 chr(0).$hash), 0, 4; - my $value = 0; - for ( (chr(0).$hash.$checksum) =~ /./gs ) { $value = $value * 256 + ord } - (sprintf "%33s", encode $value) =~ y/ /1/r; + my $ec = join '', '04', @_; # EC: concat x and y to one string and prepend '04' magic value + + my $octets = pack 'C*', map { hex } unpack('(a2)65', $ec); # transform the hex values string to octets + my $hash = chr(0) . Crypt::RIPEMD160->hash(sha256 $octets); # perform RIPEMD160(SHA256(octets) + my $checksum = substr sha256(sha256 $hash), 0, 4; # build the checksum + my $hex = join '', '0x', # build hex value of hash and checksum + map { sprintf "%02X", $_ } + unpack 'C*', $hash.$checksum; + return '1' . sprintf "%32s", encode_base58($hex, 'bitcoin'); # Do the Base58 encoding, prepend "1" } -print public_point_to_address map {hex "0x$_"} ; - -__DATA__ -50863AD64A87AE8A2FE83C1AF1A8403CB53F53E486D8511DAD8A04887E5B2352 -2CD470243453A299FA9E77237716103ABC11A1DF38855ED6F2EE187E9C582BA6 +say public_point_to_address + '50863AD64A87AE8A2FE83C1AF1A8403CB53F53E486D8511DAD8A04887E5B2352', + '2CD470243453A299FA9E77237716103ABC11A1DF38855ED6F2EE187E9C582BA6' + ; diff --git a/Task/Bitmap-Bresenhams-line-algorithm/00DESCRIPTION b/Task/Bitmap-Bresenhams-line-algorithm/00DESCRIPTION index 53a14ef3a8..58ed56e689 100644 --- a/Task/Bitmap-Bresenhams-line-algorithm/00DESCRIPTION +++ b/Task/Bitmap-Bresenhams-line-algorithm/00DESCRIPTION @@ -1 +1,3 @@ -Using the data storage type defined [[Basic_bitmap_storage|on this page]] for raster graphics images, draw a line given 2 points with the [[wp:Bresenham's line algorithm|Bresenham's line algorithm]]. +;Task: +Using the data storage type defined [[Basic_bitmap_storage|on this page]] for raster graphics images, draw a line given two points with the [[wp:Bresenham's line algorithm|Bresenham's line algorithm]]. +

diff --git a/Task/Bitmap-Bresenhams-line-algorithm/REXX/bitmap-bresenhams-line-algorithm-1.rexx b/Task/Bitmap-Bresenhams-line-algorithm/REXX/bitmap-bresenhams-line-algorithm-1.rexx index a2a311cae6..bd7b3b0e6d 100644 --- a/Task/Bitmap-Bresenhams-line-algorithm/REXX/bitmap-bresenhams-line-algorithm-1.rexx +++ b/Task/Bitmap-Bresenhams-line-algorithm/REXX/bitmap-bresenhams-line-algorithm-1.rexx @@ -1,42 +1,39 @@ -/*REXX program plots/draws line segments using the Bresenham's line algorithm.*/ -@.='·' /*fill the array with middle─dots chars*/ -parse arg data /*allow the data point specifications. */ -if data='' then data= '(1,8) (8,16) (16,8) (8,1) (1,8)' /*◄────rhombus.*/ -data=translate(data,,'()[]{}/,:;') /*elide chaff from the data points. */ - /* [↓] data point pairs ───► !.array. */ - do points=1 while data\='' /*put the data points into an array (!)*/ - parse var data x y data; !.points=x y /*extract the line segments. */ - if points==1 then do; minX=x; maxX=x; minY=y; maxY=y; end /*1st case.*/ - minX=min(minX,x); maxX=max(maxX,x); minY=min(minY,y); maxY=max(maxY,y) - end /*points*/ /* [↑] data points pairs in array !. */ - -border=2 /*border: is extra space around plot. */ -minX=minX-border*2; maxX=maxX+border*2 /*min and max X for the plot display.*/ -minY=minY-border ; maxY=maxY+border /* " " " Y " " " " */ - do x=minX to maxX; @.x.0='─'; end /*draw a dash from left ───► right.*/ - do y=minY to maxY; @.0.y='│'; end /*draw a pipe from lowest ───► highest*/ -@.0.0='┼' /*define the plot's origin axis point. */ - do seg=2 to points-1; _=seg-1 /*obtain the X and Y line coördinates*/ - call draw_line !._, !.seg /*draw (plot) a line segment. */ - end /*seg*/ /* [↑] drawing the line segments. */ - /* [↓] display the plot to terminal. */ - do y=maxY to minY by -1; _= /*display the plot one line at a time. */ - do x=minX to maxX /*build line by examining the X axis.*/ - _=_ || @.x.y /*construct/build a line of the plot. */ - end /*x*/ /* (a line is a "row" of points.) */ - say _ /*display a line of the plot──►terminal*/ - end /*y*/ /* [↑] all done plotting the points. */ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -draw_line: procedure expose @.; parse arg x y,xf yf; plotChar='Θ' -dx=abs(xf-x); if x -dy then do; err=err-dy; x=x+sx; end - if err2 < dx then do; err=err+dx; y=y+sy; end +/*REXX program plots/draws line segments using the Bresenham's line (2D) algorithm. */ +parse arg data /*obtain optional arguments from the CL*/ +if data='' then data= "(1,8) (8,16) (16,8) (8,1) (1,8)" /* ◄──── a rhombus.*/ +data=translate(data, , '()[]{}/,:;') /*elide chaff from the data points. */ +@.='·' /*fill the array with middle─dots chars*/ + do points=1 while data\='' /*put the data points into an array (!)*/ + parse var data x y data; !.points=x y /*extract the line segments. */ + if points==1 then do; minX=x; maxX=x; minY=y; maxY=y; end /*1st case.*/ + minX=min(minX,x); maxX=max(maxX,x); minY=min(minY,y); maxY=max(maxY,y) + end /*points*/ /* [↑] data points pairs in array !. */ +border=2 /*border: is extra space around plot. */ +minX=minX-border*2; maxX=maxX+border*2 /*min and max X for the plot display.*/ +minY=minY-border ; maxY=maxY+border /* " " " Y " " " " */ + do x=minX to maxX; @.x.0='─'; end /*draw a dash from left ───► right.*/ + do y=minY to maxY; @.0.y='│'; end /*draw a pipe from lowest ───► highest*/ +@.0.0='┼' /*define the plot's origin axis point. */ + do seg=2 to points-1; _=seg-1 /*obtain the X and Y line coördinates*/ + call draw_line !._, !.seg /*draw (plot) a line segment. */ + end /*seg*/ /* [↑] drawing the line segments. */ + /* [↓] display the plot to terminal. */ + do y=maxY to minY by -1; _= /*display the plot one line at a time. */ + do x=minX to maxX; _=_ || @.x.y /*construct/build a line of the plot. */ + end /*x*/ /* (a line is a "row" of points.) */ + say _ /*display a line of the plot──►terminal*/ + end /*y*/ /* [↑] all done plotting the points. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +draw_line: procedure expose @.; parse arg x y,xf yf; plotChar='Θ' +dx=abs(xf-x); if x -dy then do; err=err-dy; x=x+sx; end + if err2 < dx then do; err=err+dx; y=y+sy; end end /*forever*/ diff --git a/Task/Bitmap-Flood-fill/Go/bitmap-flood-fill-2.go b/Task/Bitmap-Flood-fill/Go/bitmap-flood-fill-2.go index 0e3bb2afa6..221a1f15a8 100644 --- a/Task/Bitmap-Flood-fill/Go/bitmap-flood-fill-2.go +++ b/Task/Bitmap-Flood-fill/Go/bitmap-flood-fill-2.go @@ -1,20 +1,29 @@ package main import ( - "fmt" + "log" + "os/exec" "raster" ) func main() { b, err := raster.ReadPpmFile("Unfilledcirc.ppm") if err != nil { - fmt.Println(err) - return + log.Fatal(err) } b.Flood(200, 200, raster.Pixel{127, 0, 0}) - err = b.WritePpmFile("flood.ppm") + c := exec.Command("convert", "ppm:-", "flood.png") + pipe, err := c.StdinPipe() if err != nil { - fmt.Println(err) - return + log.Fatal(err) + } + if err = c.Start(); err != nil { + log.Fatal(err) + } + if err = b.WritePpmTo(pipe); err != nil { + log.Fatal(err) + } + if err = pipe.Close(); err != nil { + log.Fatal(err) } } diff --git a/Task/Bitmap-Flood-fill/REXX/bitmap-flood-fill.rexx b/Task/Bitmap-Flood-fill/REXX/bitmap-flood-fill.rexx index 432991af88..1b8853e2e1 100644 --- a/Task/Bitmap-Flood-fill/REXX/bitmap-flood-fill.rexx +++ b/Task/Bitmap-Flood-fill/REXX/bitmap-flood-fill.rexx @@ -1,25 +1,25 @@ -/*REXX program demonstrates a method to perform a flood fill of an area. */ -black= '000000000000000000000000'b /*define the black color (using bits).*/ -red = '000000000000000011111111'b /* " " red " " " */ -green= '000000001111111100000000'b /* " " green " " " */ -white= '111111111111111111111111'b /* " " white " " " */ - /*image is defined to the test image. */ -hx=125; hy=125 /*define limits (x,Y) for the image. */ -area=white; call fill 125, 25, red /*fill the white area in red. */ -area=black; call fill 125, 125, green /*fill the center orb in green. */ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -fill: procedure expose image. hx hy area; parse arg x,y,fill_color -if x<1 | x>hx | y<1 | y>hy then return /*X or Y are outside of the image area*/ -pixel=@(x,y) /*obtain the color of the X,Y pixel. */ -if pixel\==area then return /*the pixel has already been filled */ - /*with the fill_color, or we are not */ - /*within the area to be filled. */ -image.x.y=fill_color /*color desired area with fill_color. */ -pixel=@(x ,y-1); if pixel==area then call fill x , y-1, fill_color /*north*/ -pixel=@(x-1,y ); if pixel==area then call fill x-1, y , fill_color /*west */ -pixel=@(x+1,y ); if pixel==area then call fill x+1, y , fill_color /*east */ -pixel=@(x ,y+1); if pixel==area then call fill x , y+1, fill_color /*south*/ -return -/*────────────────────────────────────────────────────────────────────────────*/ -@: parse arg $x,$y; return image.$x.$y /*return with color of the X,Y pixel.*/ +/*REXX program demonstrates a method to perform a flood fill of an area. */ +black= '000000000000000000000000'b /*define the black color (using bits).*/ +red = '000000000000000011111111'b /* " " red " " " */ +green= '000000001111111100000000'b /* " " green " " " */ +white= '111111111111111111111111'b /* " " white " " " */ + /*image is defined to the test image. */ +hx=125; hy=125 /*define limits (x,Y) for the image. */ +area=white; call fill 125, 25, red /*fill the white area in red. */ +area=black; call fill 125, 125, green /*fill the center orb in green. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +fill: procedure expose image. hx hy area; parse arg x,y,fill_color /*obtain the args.*/ + if x<1 | x>hx | y<1 | y>hy then return /*X or Y are outside of the image area*/ + pixel=@(x, y) /*obtain the color of the X,Y pixel. */ + if pixel\==area then return /*the pixel has already been filled */ + /*with the fill_color, or we are not */ + /*within the area to be filled. */ + image.x.y=fill_color /*color desired area with fill_color. */ + pixel=@(x , y-1); if pixel==area then call fill x , y-1, fill_color /*north*/ + pixel=@(x-1, y ); if pixel==area then call fill x-1, y , fill_color /*west */ + pixel=@(x+1, y ); if pixel==area then call fill x+1, y , fill_color /*east */ + pixel=@(x , y+1); if pixel==area then call fill x , y+1, fill_color /*south*/ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +@: parse arg $x,$y; return image.$x.$y /*return with color of the X,Y pixel.*/ diff --git a/Task/Bitmap-Histogram/Java/bitmap-histogram.java b/Task/Bitmap-Histogram/Java/bitmap-histogram.java new file mode 100644 index 0000000000..5b1c3b96db --- /dev/null +++ b/Task/Bitmap-Histogram/Java/bitmap-histogram.java @@ -0,0 +1,163 @@ +package bitmap; + +import java.util.ArrayList; +import java.util.Arrays; +import java.util.List; +import java.util.Objects; +import java.util.Random; +import java.util.stream.Collectors; +import java.util.stream.Stream; + +/** +* Image processing functions such as histogram, grayscale,.. +* here we assume we have a YUV image. so we process only luma component Y +* the histogram can be called on luma pixel only (values from 0 to 255) +* greyscale is done with a constant middle value of FullRange / 2 = 127 +*/ +public class ImageProc { + + static final private Integer MAX_VAL = 255; + static final private Integer MIN_VAL = 0; + static final private Integer MID_RANGE = (MAX_VAL - MIN_VAL) >> 1; + + private static Integer[] lumaHist(Integer[] luma,Integer length) { + // from input length, select a number of classes (intervalles ) + // usually take sqrt(length) + if ((length == 0 )|| (luma == null)){ + return null; + } + double stepd = Math.sqrt(length); + // define the interval width + int step = (int)stepd ; + Integer width = (int)(length / stepd); + // define step Lists containing only values in one interval + // done with a loop generating a new list that discard lower part + // the luma buff is fist sorted to split the array correctly + // only values greater than width are kept in a new list + + List interv[] = new ArrayList[step]; + Integer hist[] = new Integer[step]; + interv[0] = Arrays.stream(luma) + .parallel() + .sorted() + .filter(value -> value >= width) + .collect(Collectors.toList()); + hist[0] = length - interv[0].size(); + + // here due to a lambda expression limitation + // we can not modify the width value. (should be a final var) + // so we decrease each reaming values with width, and store in a new list + // the filter is than the same across iterations + // histogram is computed in the same loop: the number of data for the interval + // is equal to the previous list size minus the new list size + for (int i =1; i < step; i++){ + + interv[i] = interv[i-1].stream() + .map(value -> value -= width) + .filter(value -> value >= width) + .collect(Collectors.toList()); + hist[i] = interv[i-1].size() - interv[i].size(); + } + + return hist; + } + + private static Integer[] blackAndWhite(Integer[] luma,Integer length) { + + List bwPict ; + // compute the average value of the stream + // need to transform the List in List to transform in int !!! + + double average; + average = Stream.of(luma).map(i -> i.toString()) + .mapToInt(Integer::parseInt) + .average() + .getAsDouble(); + System.out.println("Average value : " +average); + // compare each value with the average + // if less set to 0 (black) if more, set to 255 (black) + bwPict= Arrays.stream(luma) + .parallel() + .map(value -> (value > average) ?MAX_VAL: MIN_VAL) + .collect(Collectors.toList()); + + Integer retPict[] = new Integer[bwPict.size()]; + return bwPict.toArray(retPict); + } + + public static void main (String[] args) + { + Integer[] histo; + Integer img_y[] = new Integer[256]; + // generate ramdom values just for testing algo + Random r = new Random(); + for (int i=0;i< img_y.length; i++) { + img_y[i] = r.nextInt(MAX_VAL); + } + + // ********* compute histogram ******************** + histo = lumaHist(img_y,img_y.length); + + System.out.println("histogram size =:" + histo.length ); + + int sum = 0; + for (int i=0; i< histo.length;i++) { + System.out.println("histo[" + i + "] =:" + histo[i]); + sum +=histo[i]; + } + // check results are ok + // first check nb of elments in histo is 256 + if (sum != img_y.length){ + System.out.println("Error in histogram processing!\n" + + "Numbers of value not coherent"); + } + Integer hist[] = new Integer[16]; + Arrays.fill(hist, 0); + for (int i=0;i< 256; i++) { + if (img_y[i] < 16) hist[0]++; + else if (img_y[i] < 32) hist[1]++; + else if (img_y[i] < 48) hist[2]++; + else if (img_y[i] < 64) hist[3]++; + else if (img_y[i] < 80) hist[4]++; + else if (img_y[i] < 96) hist[5]++; + else if (img_y[i] < 112) hist[6]++; + else if (img_y[i] < 128) hist[7]++; + else if (img_y[i] < 144) hist[8]++; + else if (img_y[i] < 160) hist[9]++; + else if (img_y[i] < 176) hist[10]++; + else if (img_y[i] < 192) hist[11]++; + else if (img_y[i] < 208) hist[12]++; + else if (img_y[i] < 224) hist[13]++; + else if (img_y[i] < 240) hist[14]++; + else hist[15]++; + + } + if (hist.length != histo.length) { + System.out.println("Error in histogram processing!\n" + + "histogram size is wrong "); + return; + } + else { + for (int i=0; i< histo.length;i++) { + if (!Objects.equals(hist[i], histo[i])) { + System.out.println("Error in histogram processing!\n" + + "values are different (interv= " + i + + " computed: " + histo[i] + + " theorical :" + hist[i] + "\n"); + return; + } + } + } + System.out.println("Test OK\n"); + + // ********* compute grayscale image ******************** + Integer pictBW[]; + pictBW = blackAndWhite(img_y,img_y.length); + + for (int i=0;i< img_y.length; i++) { + System.out.println("Original[" + i +"]:" + img_y[i] + + " BandW[" + i +"]:" +pictBW[i] ); + } + + } +} diff --git a/Task/Bitmap-Midpoint-circle-algorithm/REXX/bitmap-midpoint-circle-algorithm.rexx b/Task/Bitmap-Midpoint-circle-algorithm/REXX/bitmap-midpoint-circle-algorithm.rexx index 48607a0130..5b75ae5fc3 100644 --- a/Task/Bitmap-Midpoint-circle-algorithm/REXX/bitmap-midpoint-circle-algorithm.rexx +++ b/Task/Bitmap-Midpoint-circle-algorithm/REXX/bitmap-midpoint-circle-algorithm.rexx @@ -1,43 +1,42 @@ -/*REXX program plots three circles using midpoint/Bresenham's circle algorithm*/ -@. = '·' /*fill the array with middle─dots char.*/ -minX=0; maxX=0; minY=0; maxY=0 /*initialize the minimums and maximums.*/ -call drawCircle 0, 0, 8, '#' /*plot 1st circle with pound character.*/ -call drawCircle 0, 0, 11, '$' /* " 2nd " " dollar " */ -call drawCircle 0, 0, 19, '@' /* " 3rd " " commercial at. */ -border=2 /*BORDER: shows N extra grid points.*/ -minX=minX-border*2; maxX=maxX+border*2 /*adjust min and max X to show border*/ -minY=minY-border ; maxY=maxY+border /* " " " " Y " " " */ -if @.0.0==@. then @.0.0='┼' /*maybe define the plot's axis origin. */ - /*define the plot's horizontal grid──┐ */ - do h=minX to maxX; if @.h.0==@. then @.h.0='─'; end /* ◄───────────┘ */ - do v=minY to maxY; if @.0.v==@. then @.0.v='│'; end /* ◄──────────┐ */ - /*define the plot's vertical grid───┘ */ - do y=maxY by -1 to minY; aRow= /* [↓] draw grid from top ──► bottom.*/ - do x=minX to maxX /* [↓] " " " left ──► right. */ - aRow=aRow || @.x.y /*build a grid row, one char at a time.*/ - end /*x*/ /* [↑] a grid row should be finished. */ - say aRow /*display a single row of the grid. */ - end /*y*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -drawCircle: procedure expose @. minX maxX minY maxY /* [↓] Y is defined as R*/ -parse arg xx,yy,r 1 y,plotChar; f=1-r; fx=1; fy=-2*r /*get the X,Y coördinates*/ - - do x=0 while x=0 then do; y=y-1; fy=fy+2; f=f+fy; end /*▒*/ - fx=fx+2; f=f+fx /*▒*/ - call plotPoint xx+x, yy+y /*▒*/ - call plotPoint xx+y, yy+x /*▒*/ - call plotPoint xx+y, yy-x /*▒*/ - call plotPoint xx+x, yy-y /*▒*/ - call plotPoint xx-y, yy+x /*▒*/ - call plotPoint xx-x, yy+y /*▒*/ - call plotPoint xx-x, yy-y /*▒*/ - call plotPoint xx-y, yy-x /*▒*/ - end /*x*/ /* [↑] place plot points ══► plot.▒▒▒▒▒▒▒▒▒▒▒▒▒*/ -return -/*────────────────────────────────────────────────────────────────────────────*/ -plotPoint: parse arg c,r; @.c.r=plotChar /*assign a character to be plotted.*/ -minX=min(minX,c); maxX=max(maxX,c) /*find the minimum and maximum X. */ -minY=min(minY,r); maxY=max(maxY,r) /* " " " " " Y. */ -return +/*REXX program plots three circles using midpoint/Bresenham's circle algorithm. */ +@.= '·' /*fill the array with middle─dots char.*/ +minX=0; maxX=0; minY=0; maxY=0 /*initialize the minimums and maximums.*/ +call drawCircle 0, 0, 8, '#' /*plot 1st circle with pound character.*/ +call drawCircle 0, 0, 11, '$' /* " 2nd " " dollar " */ +call drawCircle 0, 0, 19, '@' /* " 3rd " " commercial at. */ +border=2 /*BORDER: shows N extra grid points.*/ +minX=minX-border*2; maxX=maxX+border*2 /*adjust min and max X to show border*/ +minY=minY-border ; maxY=maxY+border /* " " " " Y " " " */ +if @.0.0==@. then @.0.0='┼' /*maybe define the plot's axis origin. */ + /*define the plot's horizontal grid──┐ */ + do h=minX to maxX; if @.h.0==@. then @.h.0='─'; end /* ◄───────────┘ */ + do v=minY to maxY; if @.0.v==@. then @.0.v='│'; end /* ◄──────────┐ */ + /*define the plot's vertical grid───┘ */ + do y=maxY by -1 to minY; _= /* [↓] draw grid from top ──► bottom.*/ + do x=minX to maxX; _=_ || @.x.y /* ◄─── " " " left ──► right. */ + end /*x*/ /* [↑] a grid row should be finished. */ + say _ /*display a single row of the grid. */ + end /*y*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +drawCircle: procedure expose @. minX maxX minY maxY + parse arg xx,yy,r 1 y,plotChar; fx=1; fy=-2*r /*get X,Y coördinates*/ + f=1-r + do x=0 while x=0 then do; y=y-1; fy=fy+2; f=f+fy; end /*▒*/ + fx=fx+2; f=f+fx /*▒*/ + call plotPoint xx+x, yy+y /*▒*/ + call plotPoint xx+y, yy+x /*▒*/ + call plotPoint xx+y, yy-x /*▒*/ + call plotPoint xx+x, yy-y /*▒*/ + call plotPoint xx-y, yy+x /*▒*/ + call plotPoint xx-x, yy+y /*▒*/ + call plotPoint xx-x, yy-y /*▒*/ + call plotPoint xx-y, yy-x /*▒*/ + end /*x*/ /* [↑] place plot points ══► plot.▒▒▒▒▒▒▒▒▒▒▒▒▒*/ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +plotPoint: parse arg c,r; @.c.r=plotChar /*assign a character to be plotted. */ + minX=min(minX,c); maxX=max(maxX,c) /*determine the minimum and maximum X.*/ + minY=min(minY,r); maxY=max(maxY,r) /* " " " " " Y.*/ + return diff --git a/Task/Bitmap-Read-an-image-through-a-pipe/Go/bitmap-read-an-image-through-a-pipe.go b/Task/Bitmap-Read-an-image-through-a-pipe/Go/bitmap-read-an-image-through-a-pipe.go index 1848b4216c..69f85f8b5b 100644 --- a/Task/Bitmap-Read-an-image-through-a-pipe/Go/bitmap-read-an-image-through-a-pipe.go +++ b/Task/Bitmap-Read-an-image-through-a-pipe/Go/bitmap-read-an-image-through-a-pipe.go @@ -6,33 +6,25 @@ package main // * Write a PPM file import ( - "fmt" + "log" "os/exec" "raster" ) func main() { - // (A file with this name is output by the Go solution to the task - // "Bitmap/PPM conversion through a pipe," but of course any handy - // jpeg should work.) - c := exec.Command("djpeg", "pipeout.jpg") + c := exec.Command("convert", "Unfilledcirc.png", "-depth", "1", "ppm:-") pipe, err := c.StdoutPipe() if err != nil { - fmt.Println(err) - return + log.Fatal(err) } - err = c.Start() - if err != nil { - fmt.Println(err) - return + if err = c.Start(); err != nil { + log.Fatal(err) } b, err := raster.ReadPpmFrom(pipe) if err != nil { - fmt.Println(err) - return + log.Fatal(err) } - err = b.WritePpmFile("pipein.ppm") - if err != nil { - fmt.Println(err) + if err = b.WritePpmFile("Unfilledcirc.ppm"); err != nil { + log.Fatal(err) } } diff --git a/Task/Bitmap-Write-a-PPM-file/Perl-6/bitmap-write-a-ppm-file.pl6 b/Task/Bitmap-Write-a-PPM-file/Perl-6/bitmap-write-a-ppm-file.pl6 index 657ea991df..3efa08e181 100644 --- a/Task/Bitmap-Write-a-PPM-file/Perl-6/bitmap-write-a-ppm-file.pl6 +++ b/Task/Bitmap-Write-a-PPM-file/Perl-6/bitmap-write-a-ppm-file.pl6 @@ -1,11 +1,29 @@ +class Pixel { has uint8 ($.R, $.G, $.B) } +class Bitmap { + has UInt ($.width, $.height); + has Pixel @!data; + + method fill(Pixel $p) { + @!data = $p.clone xx ($!width*$!height) + } + method pixel( + $i where ^$!width, + $j where ^$!height + --> Pixel + ) is rw { @!data[$i*$!height + $j] } + + method data { @!data } +} + role PPM { method P6 returns Blob { "P6\n{self.width} {self.height}\n255\n".encode('ascii') ~ Blob.new: flat map { .R, .G, .B }, self.data } } -my Bitmap $b = Bitmap.new( width => 125, height => 125) but PPM; -for ^$b.height X ^$b.width -> $i, $j { + +my Bitmap $b = Bitmap.new(width => 125, height => 125) but PPM; +for flat ^$b.height X ^$b.width -> $i, $j { $b.pixel($i, $j) = Pixel.new: :R($i*2), :G($j*2), :B(255-$i*2); } diff --git a/Task/Bitwise-IO/Python/bitwise-io-1.py b/Task/Bitwise-IO/Python/bitwise-io-1.py index 10dd423ebf..d84dab75e8 100644 --- a/Task/Bitwise-IO/Python/bitwise-io-1.py +++ b/Task/Bitwise-IO/Python/bitwise-io-1.py @@ -1,4 +1,4 @@ -class BitWriter: +class BitWriter(object): def __init__(self, f): self.accumulator = 0 self.bcount = 0 @@ -7,48 +7,71 @@ class BitWriter: def __del__(self): try: self.flush() - except ValueError: # I/O operation on closed file + except ValueError: # I/O operation on closed file pass - def writebit(self, bit): - if self.bcount == 8 : + def _writebit(self, bit): + if self.bcount == 8: self.flush() if bit > 0: - self.accumulator |= (1 << (7-self.bcount)) + self.accumulator |= 1 << 7-self.bcount self.bcount += 1 def writebits(self, bits, n): while n > 0: - self.writebit( bits & (1 << (n-1)) ) + self._writebit(bits & 1 << n-1) n -= 1 def flush(self): - self.out.write(chr(self.accumulator)) + self.out.write(bytearray([self.accumulator])) self.accumulator = 0 self.bcount = 0 -class BitReader: +class BitReader(object): def __init__(self, f): self.input = f self.accumulator = 0 self.bcount = 0 self.read = 0 - def readbit(self): - if self.bcount == 0 : + def _readbit(self): + if not self.bcount: a = self.input.read(1) - if ( len(a) > 0 ): + if a: self.accumulator = ord(a) self.bcount = 8 self.read = len(a) - rv = ( self.accumulator & ( 1 << (self.bcount-1) ) ) >> (self.bcount-1) + rv = (self.accumulator & (1 << self.bcount-1)) >> self.bcount-1 self.bcount -= 1 return rv def readbits(self, n): v = 0 while n > 0: - v = (v << 1) | self.readbit() + v = (v << 1) | self._readbit() n -= 1 return v + +if __name__ == '__main__': + import os + import sys + # determine module name from this file's name and import it + module_name = os.path.splitext(os.path.basename(__file__))[0] + bitio = __import__(module_name) + + with open('bitio_test.dat', 'wb') as outfile: + writer = bitio.BitWriter(outfile) + chars = '12345abcde' + for ch in chars: + writer.writebits(ord(ch), 7) + + with open('bitio_test.dat', 'rb') as infile: + reader = bitio.BitReader(infile) + chars = [] + while True: + x = reader.readbits(7) + if reader.read == 0: + break + chars.append(chr(x)) + print(''.join(chars)) diff --git a/Task/Bitwise-IO/Python/bitwise-io-2.py b/Task/Bitwise-IO/Python/bitwise-io-2.py index 48ac05572d..05bed4bf76 100644 --- a/Task/Bitwise-IO/Python/bitwise-io-2.py +++ b/Task/Bitwise-IO/Python/bitwise-io-2.py @@ -1,4 +1,3 @@ -#! /usr/bin/env python import sys import bitio diff --git a/Task/Bitwise-IO/Python/bitwise-io-3.py b/Task/Bitwise-IO/Python/bitwise-io-3.py index c0675c0b90..7ead08f852 100644 --- a/Task/Bitwise-IO/Python/bitwise-io-3.py +++ b/Task/Bitwise-IO/Python/bitwise-io-3.py @@ -1,10 +1,9 @@ -#! /usr/bin/env python import sys import bitio r = bitio.BitReader(sys.stdin) while True: x = r.readbits(7) - if ( r.read == 0 ): + if not r.read: # nothing read break sys.stdout.write(chr(x)) diff --git a/Task/Bitwise-operations/00DESCRIPTION b/Task/Bitwise-operations/00DESCRIPTION index 68465d1ea8..05a0bfe4fb 100644 --- a/Task/Bitwise-operations/00DESCRIPTION +++ b/Task/Bitwise-operations/00DESCRIPTION @@ -1 +1,9 @@ -{{basic data operation}}Write a routine to perform a bitwise AND, OR, and XOR on two integers, a bitwise NOT on the first integer, a left shift, right shift, right arithmetic shift, left rotate, and right rotate. All shifts and rotates should be done on the first integer with a shift/rotate amount of the second integer. If any operation is not available in your language, note it. +{{basic data operation}} + +;Task: +Write a routine to perform a bitwise AND, OR, and XOR on two integers, a bitwise NOT on the first integer, a left shift, right shift, right arithmetic shift, left rotate, and right rotate. + +All shifts and rotates should be done on the first integer with a shift/rotate amount of the second integer. + +If any operation is not available in your language, note it. +

diff --git a/Task/Bitwise-operations/Ada/bitwise-operations.ada b/Task/Bitwise-operations/Ada/bitwise-operations.ada index 234963a93c..c81c073512 100644 --- a/Task/Bitwise-operations/Ada/bitwise-operations.ada +++ b/Task/Bitwise-operations/Ada/bitwise-operations.ada @@ -1,24 +1,23 @@ -with Ada.Text_Io; use Ada.Text_Io; -with Interfaces; use Interfaces; +with Ada.Text_IO, Interfaces; +use Ada.Text_IO, Interfaces; - procedure Bitwise is - subtype Byte is Unsigned_8; - package Byte_Io is new Ada.Text_Io.Modular_Io(Byte); +procedure Bitwise is + subtype Byte is Unsigned_8; + package Byte_IO is new Ada.Text_Io.Modular_IO (Byte); - A : Byte := 255; - B : Byte := 170; - X : Byte := 128; - N : Natural := 1; - - begin - Put_Line("A and B = "); Byte_Io.Put(Item => A and B, Base => 2); - Put_Line("A or B = "); Byte_IO.Put(Item => A or B, Base => 2); - Put_Line("A xor B = "); Byte_Io.Put(Item => A xor B, Base => 2); - Put_Line("Not A = "); Byte_IO.Put(Item => not A, Base => 2); - New_Line(2); - Put_Line(Unsigned_8'Image(Shift_Left(X, N))); -- Left shift - Put_Line(Unsigned_8'Image(Shift_Right(X, N))); -- Right shift - Put_Line(Unsigned_8'Image(Shift_Right_Arithmetic(X, N))); -- Right Shift Arithmetic - Put_Line(Unsigned_8'Image(Rotate_Left(X, N))); -- Left rotate - Put_Line(Unsigned_8'Image(Rotate_Right(X, N))); -- Right rotate - end bitwise; + A : constant Byte := 2#00011110#; + B : constant Byte := 2#11110100#; + X : constant Byte := 128; + N : constant Natural := 1; +begin + Put ("A and B = "); Byte_IO.Put (Item => A and B, Base => 2); New_Line; + Put ("A or B = "); Byte_IO.Put (Item => A or B, Base => 2); New_Line; + Put ("A xor B = "); Byte_IO.Put (Item => A xor B, Base => 2); New_Line; + Put ("not A = "); Byte_IO.Put (Item => not A, Base => 2); New_Line; + New_Line (2); + Put_Line (Unsigned_8'Image (Shift_Left (X, N))); + Put_Line (Unsigned_8'Image (Shift_Right (X, N))); + Put_Line (Unsigned_8'Image (Shift_Right_Arithmetic (X, N))); + Put_Line (Unsigned_8'Image (Rotate_Left (X, N))); + Put_Line (Unsigned_8'Image (Rotate_Right (X, N))); +end Bitwise; diff --git a/Task/Bitwise-operations/BASIC256/bitwise-operations.basic256 b/Task/Bitwise-operations/BASIC256/bitwise-operations.basic256 index c270bfcc40..f88232629e 100644 --- a/Task/Bitwise-operations/BASIC256/bitwise-operations.basic256 +++ b/Task/Bitwise-operations/BASIC256/bitwise-operations.basic256 @@ -2,7 +2,7 @@ a = 0b00010001 b = 0b11110000 print a -print int(a * 2) # right shift (multiply by 2) -print a \ 2 # left shift (integer divide by 2) +print int(a * 2) # shift left (multiply by 2) +print a \ 2 # shift right (integer divide by 2) print a | b # bitwise or on two integer values print a & b # bitwise or on two integer values diff --git a/Task/Bitwise-operations/Babel/bitwise-operations-1.pb b/Task/Bitwise-operations/Babel/bitwise-operations-1.pb index ad3e53c29d..936fc38e47 100644 --- a/Task/Bitwise-operations/Babel/bitwise-operations-1.pb +++ b/Task/Bitwise-operations/Babel/bitwise-operations-1.pb @@ -1,10 +1 @@ -((main { (5 9) foo ! }) - -(foo { - ({cand} {cor} {cnor} {cxor} {cxnor} {cushl} {cushr} {cashr} {curol} {curor}) - { <- dup give -> - eval - %x nl <<} - each - give zap - cnot %x nl <<})) +({5 9}) ({cand} {cor} {cnor} {cxor} {cxnor} {shl} {shr} {ashr} {rol}) cart ! {give <- cp -> compose !} over ! {eval} over ! {;} each diff --git a/Task/Bitwise-operations/Babel/bitwise-operations-2.pb b/Task/Bitwise-operations/Babel/bitwise-operations-2.pb index e2b9e1f9a3..1e0aa4fba9 100644 --- a/Task/Bitwise-operations/Babel/bitwise-operations-2.pb +++ b/Task/Bitwise-operations/Babel/bitwise-operations-2.pb @@ -1,11 +1 @@ -1 -d -fffffff7 -c -fffffff3 -a00 -0 -0 -a00 -2800000 -fffffffa +9 cnot ; diff --git a/Task/Bitwise-operations/Common-Lisp/bitwise-operations.lisp b/Task/Bitwise-operations/Common-Lisp/bitwise-operations-1.lisp similarity index 100% rename from Task/Bitwise-operations/Common-Lisp/bitwise-operations.lisp rename to Task/Bitwise-operations/Common-Lisp/bitwise-operations-1.lisp diff --git a/Task/Bitwise-operations/Common-Lisp/bitwise-operations-2.lisp b/Task/Bitwise-operations/Common-Lisp/bitwise-operations-2.lisp new file mode 100644 index 0000000000..e1b8ae6730 --- /dev/null +++ b/Task/Bitwise-operations/Common-Lisp/bitwise-operations-2.lisp @@ -0,0 +1,9 @@ +(defun shl (x width bits) + "Compute bitwise left shift of x by 'bits' bits, represented on 'width' bits" + (logand (ash x bits) + (1- (ash 1 width)))) + +(defun shr (x width bits) + "Compute bitwise right shift of x by 'bits' bits, represented on 'width' bits" + (logand (ash x (- bits)) + (1- (ash 1 width)))) diff --git a/Task/Bitwise-operations/Common-Lisp/bitwise-operations-3.lisp b/Task/Bitwise-operations/Common-Lisp/bitwise-operations-3.lisp new file mode 100644 index 0000000000..09319f90bf --- /dev/null +++ b/Task/Bitwise-operations/Common-Lisp/bitwise-operations-3.lisp @@ -0,0 +1,13 @@ +(defun rotl (x width bits) + "Compute bitwise left rotation of x by 'bits' bits, represented on 'width' bits" + (logior (logand (ash x (mod bits width)) + (1- (ash 1 width))) + (logand (ash x (- (- width (mod bits width)))) + (1- (ash 1 width))))) + +(defun rotr (x width bits) + "Compute bitwise right rotation of x by 'bits' bits, represented on 'width' bits" + (logior (logand (ash x (- (mod bits width))) + (1- (ash 1 width))) + (logand (ash x (- width (mod bits width))) + (1- (ash 1 width))))) diff --git a/Task/Bitwise-operations/Elena/bitwise-operations.elena b/Task/Bitwise-operations/Elena/bitwise-operations.elena index a8c27f3e83..c6e8df547c 100644 --- a/Task/Bitwise-operations/Elena/bitwise-operations.elena +++ b/Task/Bitwise-operations/Elena/bitwise-operations.elena @@ -1,5 +1,5 @@ -#define system. -#define extensions. +#import system. +#import extensions. #class(extension) testOp { @@ -8,7 +8,7 @@ console writeLine:self:" and ":y:" = ":(self and:y). console writeLine:self:" or ":y:" = ":(self or:y). console writeLine:self:" xor ":y:" = ":(self xor:y). - console writeLine:"not ":self:" = ":(self not). + console writeLine:"not ":self:" = ":(self inverted). console writeLine:self:" shr ":y:" = ":(self shift &index:y). console writeLine:self:" shl ":y:" = ":(self shift &index:(y negative)). ] diff --git a/Task/Bitwise-operations/Fortran/bitwise-operations-3.f b/Task/Bitwise-operations/Fortran/bitwise-operations-3.f index 34113a976e..fbc096434a 100644 --- a/Task/Bitwise-operations/Fortran/bitwise-operations-3.f +++ b/Task/Bitwise-operations/Fortran/bitwise-operations-3.f @@ -15,8 +15,8 @@ write(*,fmt1) 'input a=',a,' b=',b write(*,fmt2) 'and : ', a,' & ',b,' = ',iand(a, b),iand(a, b) write(*,fmt2) 'or : ', a,' | ',b,' = ',ior(a, b),ior(a, b) write(*,fmt2) 'xor : ', a,' ^ ',b,' = ',ieor(a, b),ieor(a, b) -write(*,fmt2) 'lsh : ', a,' << ',b,' = ',ishft(a, abs(b)),ishft(a, abs(b)) -write(*,fmt2) 'rsh : ', a,' >> ',b,' = ',ishft(a, -abs(b)),ishft(a, -abs(b)) +write(*,fmt2) 'lsh : ', a,' << ',b,' = ',shiftl(a,b),shiftl(a,b) !since F2008, otherwise use ishft(a, abs(b)) +write(*,fmt2) 'rsh : ', a,' >> ',b,' = ',shiftr(a,b),shiftr(a,b) !since F2008, otherwise use ishft(a, -abs(b)) write(*,fmt2) 'not : ', a,' ~ ',b,' = ',not(a),not(a) write(*,fmt2) 'rot : ', a,' r ',b,' = ',ishftc(a,-abs(b)),ishftc(a,-abs(b)) diff --git a/Task/Bitwise-operations/Go/bitwise-operations.go b/Task/Bitwise-operations/Go/bitwise-operations.go index 343a41caa4..e55034546a 100644 --- a/Task/Bitwise-operations/Go/bitwise-operations.go +++ b/Task/Bitwise-operations/Go/bitwise-operations.go @@ -2,44 +2,37 @@ package main import "fmt" -func bitwise(a, b int16) (and, or, xor, not, shl, shr, ras, rol, ror int16) { - // the first four are easy - and = a & b - or = a | b - xor = a ^ b - not = ^a +func bitwise(a, b int16) { + fmt.Printf("a: %016b\n", uint16(a)) + fmt.Printf("b: %016b\n", uint16(b)) - // for all shifts, the right operand (shift distance) must be unsigned. - // use abs(b) for a non-negative value. - if b < 0 { - b = -b - } - ub := uint(b) + // Bitwise logical operations + fmt.Printf("and: %016b\n", uint16(a&b)) + fmt.Printf("or: %016b\n", uint16(a|b)) + fmt.Printf("xor: %016b\n", uint16(a^b)) + fmt.Printf("not: %016b\n", uint16(^a)) - shl = a << ub - // for right shifts, if the left operand is unsigned, Go performs - // a logical shift; if signed, an arithmetic shift. - shr = int16(uint16(a) >> ub) - ras = a >> ub + if b < 0 { + fmt.Println("Right operand is negative, but all shifts require an unsigned right operand (shift distance).") + return + } + ua := uint16(a) + ub := uint32(b) - // rotates - rol = a << ub | int16(uint16(a) >> (16-ub)) - ror = int16(uint16(a) >> ub) | a << (16-ub) - return + // Logical shifts (unsigned left operand) + fmt.Printf("shl: %016b\n", uint16(ua<>ub)) + + // Arithmetic shifts (signed left operand) + fmt.Printf("las: %016b\n", uint16(a<>ub)) + + // Rotations + fmt.Printf("rol: %016b\n", uint16(a<>(16-ub)))) + fmt.Printf("ror: %016b\n", uint16(int16(uint16(a)>>ub)|a<<(16-ub))) } func main() { - var a, b int16 = -460, 6 - and, or, xor, not, shl, shr, ras, rol, ror := bitwise(a, b) - fmt.Printf("a: %016b\n", uint16(a)) - fmt.Printf("b: %016b\n", uint16(b)) - fmt.Printf("and: %016b\n", uint16(and)) - fmt.Printf("or: %016b\n", uint16(or)) - fmt.Printf("xor: %016b\n", uint16(xor)) - fmt.Printf("not: %016b\n", uint16(not)) - fmt.Printf("shl: %016b\n", uint16(shl)) - fmt.Printf("shr: %016b\n", uint16(shr)) - fmt.Printf("ras: %016b\n", uint16(ras)) - fmt.Printf("rol: %016b\n", uint16(rol)) - fmt.Printf("ror: %016b\n", uint16(ror)) + var a, b int16 = -460, 6 + bitwise(a, b) } diff --git a/Task/Bitwise-operations/Oberon-2/bitwise-operations.oberon-2 b/Task/Bitwise-operations/Oberon-2/bitwise-operations.oberon-2 new file mode 100644 index 0000000000..29d424787c --- /dev/null +++ b/Task/Bitwise-operations/Oberon-2/bitwise-operations.oberon-2 @@ -0,0 +1,26 @@ +MODULE Bitwise; +IMPORT + SYSTEM, + Out; + +PROCEDURE Do(a,b: LONGINT); +VAR + x,y: SET; +BEGIN + x := SYSTEM.VAL(SET,a);y := SYSTEM.VAL(SET,b); + Out.String("a and b :> ");Out.Int(SYSTEM.VAL(LONGINT,x * y),0);Out.Ln; + Out.String("a or b :> ");Out.Int(SYSTEM.VAL(LONGINT,x + y),0);Out.Ln; + Out.String("a xor b :> ");Out.Int(SYSTEM.VAL(LONGINT,x / y),0);Out.Ln; + Out.String("a and ~b:> ");Out.Int(SYSTEM.VAL(LONGINT,x - y),0);Out.Ln; + Out.String("~a :> ");Out.Int(SYSTEM.VAL(LONGINT,-x),0);Out.Ln; + Out.String("a left shift b :> ");Out.Int(SYSTEM.VAL(LONGINT,SYSTEM.LSH(x,b)),0);Out.Ln; + Out.String("a right shift b :> ");Out.Int(SYSTEM.VAL(LONGINT,SYSTEM.LSH(x,-b)),0);Out.Ln; + Out.String("a left rotate b :> ");Out.Int(SYSTEM.VAL(LONGINT,SYSTEM.ROT(x,b)),0);Out.Ln; + Out.String("a right rotate b :> ");Out.Int(SYSTEM.VAL(LONGINT,SYSTEM.ROT(x,-b)),0);Out.Ln; + Out.String("a arithmetic left shift b :> ");Out.Int(SYSTEM.VAL(LONGINT,ASH(a,b)),0);Out.Ln; + Out.String("a arithmetic right shift b :> ");Out.Int(SYSTEM.VAL(LONGINT,ASH(a,-b)),0);Out.Ln +END Do; + +BEGIN + Do(10,2); +END Bitwise. diff --git a/Task/Bitwise-operations/REXX/bitwise-operations.rexx b/Task/Bitwise-operations/REXX/bitwise-operations.rexx index 72bcc6df26..ea27849cf6 100644 --- a/Task/Bitwise-operations/REXX/bitwise-operations.rexx +++ b/Task/Bitwise-operations/REXX/bitwise-operations.rexx @@ -1,34 +1,27 @@ -/*REXX program performs bitwise operations on integers: & | && ¬ «L »R */ -numeric digits 1000 /*be able to handle big integers.*/ +/*REXX program performs bitwise operations on integers: & | && ¬ «L »R */ +numeric digits 1000 /*be able to handle some big integers. */ +say center('decimal', 9) center("value", 9) center('bits', 50) +say copies('─' , 9) copies("─" , 9) copies('─', 50) -say center('decimal',9) center("value",9) center('bits',50) -say copies('─',9) copies('─',9) copies('─',50) +a = 21 ; call show a , 'A' /* show & tell A */ +b = 3 ; call show b , 'B' /* show & tell B */ -a = 21 ; call show a , 'A' /* show & tell A */ -b = 3 ; call show b , 'B' /* show & tell B */ - - call show bAnd(a,b) , 'A & B' /* and */ - call show bOr( a,b) , 'A | B' /* or */ - call show bXOr(a,b) , 'A && B' /* xor */ - call show bNot(a) , '¬ A' /* not */ - call show bShiftL(a,b) , 'A [«B]' /* shift left */ - call show bShiftR(a,b) , 'A [»B]' /* shirt right */ - /*┌───────────────────────────────────────────────────────────────┐ - │ Since REXX stores numbers (indeed, all values) as characters, │ - │ it makes no sense to "rotate" a value, since there aren't any │ - │ boundries for the value. I.E.: there isn't any 32─bit word │ - │ "container" or "cell" (for instance) to store an integer. │ - └───────────────────────────────────────────────────────────────┘*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────subroutines─────────────────────────*/ + call show bAnd(a,b) , 'A & B' /* and */ + call show bOr( a,b) , 'A | B' /* or */ + call show bXOr(a,b) , 'A && B' /* xor */ + call show bNot(a) , '¬ A' /* not */ + call show bShiftL(a,b) , 'A [«B]' /* shift left */ + call show bShiftR(a,b) , 'A [»B]' /* shirt right */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ show: procedure; parse arg x,t; say right(x,9) center(t,9) right(d2b(x),50); return -d2b: return x2b(d2x(arg(1))) +0 /*some REXXes have the D2B bif.*/ -b2d: return x2d(b2x(arg(1))) /*some REXXes have the B2D bif.*/ -bNot: return b2d(translate(d2b(arg(1)), 10, 01)) +0 /*+0≡normalize.*/ -bShiftL: return (b2d(d2b(arg(1)) || copies(0, arg(2)))) +0 +d2b: return x2b(d2x(arg(1))) +0 /*some REXXes have the D2B BIF. */ +b2d: return x2d(b2x(arg(1))) /* " " " " B2D " */ +bNot: return b2d(translate(d2b(arg(1)), 10, 01)) +0 /*+0 ≡ normalizes the number*/ +bShiftL: return (b2d(d2b(arg(1)) || copies(0, arg(2)))) +0 /* " " " " " */ bAnd: procedure; parse arg x,y; return c2d(bitand(d2c(x), d2c(y))) bOr: procedure; parse arg x,y; return c2d(bitor( d2c(x), d2c(y))) bXor: procedure; parse arg x,y; return c2d(bitxor(d2c(x), d2c(y))) - +/*──────────────────────────────────────────────────────────────────────────────────────*/ bShiftR: procedure; parse arg x,y; $=substr(reverse(d2b(x)), y+1) if $=='' then $=0; return b2d(reverse($)) diff --git a/Task/Boolean-values/00DESCRIPTION b/Task/Boolean-values/00DESCRIPTION index 66ae9f6733..d597e9fb76 100644 --- a/Task/Boolean-values/00DESCRIPTION +++ b/Task/Boolean-values/00DESCRIPTION @@ -1,5 +1,9 @@ -Show how to represent the boolean states "true" and "false" in a language. -If other objects represent "true" or "false" in conditionals, note it. +;Task: +Show how to represent the boolean states "'''true'''" and "'''false'''" in a language. -;Cf. -* [[Logical operations]] +If other objects represent "'''true'''" or "'''false'''" in conditionals, note it. + + +;Related tasks: +*   [[Logical operations]] +

diff --git a/Task/Boolean-values/360-Assembly/boolean-values.360 b/Task/Boolean-values/360-Assembly/boolean-values.360 new file mode 100644 index 0000000000..fdc981dee0 --- /dev/null +++ b/Task/Boolean-values/360-Assembly/boolean-values.360 @@ -0,0 +1,2 @@ +FALSE DC X'00' +TRUE DC X'FF' diff --git a/Task/Box-the-compass/00DESCRIPTION b/Task/Box-the-compass/00DESCRIPTION index 3e75f32e50..30a6f17e69 100644 --- a/Task/Box-the-compass/00DESCRIPTION +++ b/Task/Box-the-compass/00DESCRIPTION @@ -3,12 +3,13 @@ Avast me hearties! There be many a [http://www.talklikeapirate.com/howto.html land lubber] that knows [http://oxforddictionaries.com/view/entry/m_en_gb0550020#m_en_gb0550020 naught] of the pirate ways and gives direction by degree! They know not how to [[wp:Boxing the compass|box the compass]]! -'''Task description''' +;Task description: # Create a function that takes a heading in degrees and returns the correct 32-point compass heading. # Use the function to print and display a table of Index, Compass point, and Degree; rather like the corresponding columns from, the first table of the [[wp:Boxing the compass|wikipedia article]], but use only the following 33 headings as input: :[0.0, 16.87, 16.88, 33.75, 50.62, 50.63, 67.5, 84.37, 84.38, 101.25, 118.12, 118.13, 135.0, 151.87, 151.88, 168.75, 185.62, 185.63, 202.5, 219.37, 219.38, 236.25, 253.12, 253.13, 270.0, 286.87, 286.88, 303.75, 320.62, 320.63, 337.5, 354.37, 354.38]. (They should give the same order of points but are spread throughout the ranges of acceptance). + ;Notes; * The headings and indices can be calculated from this pseudocode:
for i in 0..32 inclusive:
@@ -19,3 +20,4 @@ They know not how to [[wp:Boxing the compass|box the compass]]!
     end
     index = ( i mod 32) + 1
* The column of indices can be thought of as an enumeration of the thirty two cardinal points (see [[Talk:Box the compass#Direction, index, and angle|talk page]]).. +

diff --git a/Task/Box-the-compass/AppleScript/box-the-compass.applescript b/Task/Box-the-compass/AppleScript/box-the-compass.applescript new file mode 100644 index 0000000000..b1378d5285 --- /dev/null +++ b/Task/Box-the-compass/AppleScript/box-the-compass.applescript @@ -0,0 +1,375 @@ +use framework "Foundation" +use scripting additions + +property plstLangs : [{|name|:"English"} & ¬ + {expansions:{N:"north", S:"south", E:"east", W:"west", b:" by "}} & ¬ + {|N|:"N", |NNNE|:"NbE", |NNE|:"N-NE", |NNENE|:"NEbN", |NE|:"NE", |NENEE|:"NEbE"} & ¬ + {|NEE|:"E-NE", |NEEE|:"EbN", |E|:"E", |EEES|:"EbS", |EES|:"E-SE", |EESES|:"SEbE"} & ¬ + {|ES|:"SE", |ESESS|:"SEbS", |ESS|:"S-SE", |ESSS|:"SbE", |S|:"S", |SSSW|:"SbW"} & ¬ + {|SSW|:"S-SW", |SSWSW|:"SWbS", |SW|:"SW", |SWSWW|:"SWbW", |SWW|:"W-SW"} & ¬ + {|SWWW|:"WbS", |W|:"W", |WWWN|:"WbN", |WWN|:"W-NW", |WWNWN|:"NWbW"} & ¬ + {|WN|:"NW", |WNWNN|:"NWbN", |WNN|:"N-NW", |WNNN|:"NbW"}, ¬ + ¬ + {|name|:"Chinese", |N|:"北", |NNNE|:"北微东", |NNE|:"东北偏北"} & ¬ + {|NNENE|:"东北微北", |NE|:"东北", |NENEE|:"东北微东", |NEE|:"东北偏东"} & ¬ + {|NEEE|:"东微北", |E|:"东", |EEES|:"东微南", |EES|:"东南偏东", |EESES|:"东南微东"} & ¬ + {|ES|:"东南", |ESESS|:"东南微南", |ESS|:"东南偏南", |ESSS|:"南微东", |S|:"南"} & ¬ + {|SSSW|:"南微西", |SSW|:"西南偏南", |SSWSW|:"西南微南", |SW|:"西南"} & ¬ + {|SWSWW|:"西南微西", |SWW|:"西南偏西", |SWWW|:"西微南", |W|:"西"} & ¬ + {|WWWN|:"西微北", |WWN|:"西北偏西", |WWNWN|:"西北微西", |WN|:"西北"} & ¬ + {|WNWNN|:"西北微北", |WNN|:"西北偏北", |WNNN|:"北微西"}] + +-- Scale invariant keys for points of the compass +-- (allows us to look up a translation for one scale of compass (32 here) +-- for use in another size of compass (8 or 16 points) +-- (Also semi-serviceable as more or less legible keys without translation) + +-- compassKeys :: Int -> [String] +on compassKeys(intDepth) + -- Simplest compass divides into two hemispheres + -- with one peak of ambiguity to the left, + -- and one to the right (encoded by the commas in this list): + set urCompass to ["N", "S", "N"] + + -- Necessity drives recursive subdivision of broader directions, shrinking + -- boxes down to a workable level of precision: + script subdivision + on lambda(lstCompass, N) + if N ≤ 1 then + lstCompass + else + script subKeys + on lambda(a, x, i, xs) + -- Borders between N and S engender E and W. + -- further subdivisions (boxes) concatenate their two parent keys. + if i > 1 then + cond(N = intDepth, ¬ + a & {cond(x = "N", "W", "E")} & x, ¬ + a & {item (i - 1) of xs & x} & x) + else + a & x + end if + end lambda + end script + + lambda(foldl(subKeys, {}, lstCompass), N - 1) + end if + end lambda + end script + + tell subdivision to items 1 thru -2 of lambda(urCompass, intDepth) +end compassKeys + +-- pointIndex :: Int -> Num -> String +on pointIndex(power, degrees) + set nBoxes to 2 ^ power + set i to round (degrees + (360 / (nBoxes * 2))) mod 360 * nBoxes / 360 rounding up + cond(i > 0, i, 1) +end pointIndex + +-- pointNames :: Int -> Int -> [String] +on pointNames(precision, iBox) + set k to item iBox of compassKeys(precision) + + script translation + on lambda(recLang) + set maybeTrans to keyValue(recLang, k) + set strBrief to cond(maybeTrans is missing value, k, maybeTrans) + + set recExpand to keyValue(recLang, "expansions") + + if recExpand is not missing value then + script expand + on lambda(c) + set t to keyValue(recExpand, c) + cond(t is not missing value, t, c) + end lambda + end script + set strName to (intercalate(cond(precision > 5, " ", ""), ¬ + map(expand, characters of strBrief))) + toUpper(text item 1 of strName) & text items 2 thru -1 of strName + else + strBrief + end if + end lambda + end script + + map(translation, plstLangs) +end pointNames + +-- maxLen :: [String] -> Int +on maxLen(xs) + -- compareByLength = (String, String) -> (-1 | 0 | 1) + script compareByLength + on lambda(a, b) + set {intA, intB} to {length of a, length of b} + cond(intA < intB, -1, cond(intA > intB, 1, 0)) + end lambda + end script + + length of maximumBy(compareByLength, xs) +end maxLen + +-- alignRight :: Int -> String -> String +on alignRight(nWidth, x) + justifyRight(nWidth, space, x) +end alignRight + +-- alignLeft :: Int -> String -> String +on alignLeft(nWidth, x) + justifyLeft(nWidth, space, x) +end alignLeft + +-- show :: asString => a -> Text +on show(x) + x as string +end show + +-- compassTable :: Int -> [Num] -> Maybe String +on compassTable(precision, xs) + if precision < 1 then + missing value + else + set intPad to 2 + set rightAligned to curry(alignRight) + set leftAligned to curry(alignLeft) + set join to curry(my intercalate) + + -- INDEX COLUMN + set lstIndex to map(lambda(precision) of curry(pointIndex), xs) + set lstStrIndex to map(show, lstIndex) + set nIndexWidth to maxLen(lstStrIndex) + set colIndex to map(lambda(nIndexWidth + intPad) of rightAligned, lstStrIndex) + + -- ANGLES COLUMN + script degreeFormat + on lambda(x) + set {c, m} to splitOn(".", x as string) + c & "." & (text 1 thru 2 of (m & "0")) & "°" + end lambda + end script + set lstAngles to map(degreeFormat, xs) + set nAngleWidth to maxLen(lstAngles) + intPad + set colAngles to map(lambda(nAngleWidth) of rightAligned, lstAngles) + + -- NAMES COLUMNS + script precisionNames + on lambda(iBox) + pointNames(precision, iBox) + end lambda + end script + + set lstTrans to transpose(map(precisionNames, lstIndex)) + set lstTransWidths to map(maxLen, lstTrans) + + script spacedNames + on lambda(lstLang, i) + map(lambda((item i of lstTransWidths) + 2) of leftAligned, lstLang) + end lambda + end script + + set colsTrans to map(spacedNames, lstTrans) + + -- TABLE + intercalate(linefeed, ¬ + map(lambda("") of join, ¬ + transpose({colIndex} & {colAngles} & ¬ + {replicate(length of lstIndex, " ")} & colsTrans))) + end if +end compassTable + + + +-- TEST +on run + + set xs to [0.0, 16.87, 16.88, 33.75, 50.62, 50.63, 67.5, 84.37, ¬ + 84.38, 101.25, 118.12, 118.13, 135.0, 151.87, 151.88, 168.75, ¬ + 185.62, 185.63, 202.5, 219.37, 219.38, 236.25, 253.12, 253.13, ¬ + 270.0, 286.87, 286.88, 303.75, 320.62, 320.63, 337.5, 354.37, ¬ + 354.38] + + -- If we supply other precisions, like 4 or 6, (2^n -> 16 or 64 boxes) + -- the bearings will be divided amongst smaller or larger numbers of boxes, + -- either using name translations retrieved by the generic hash + -- or using the keys of the hash itself (combined with any expansions) + -- to substitute for missing names for very finely divided boxes. + + compassTable(5, xs) -- // 2^5 -> 32 boxes + +end run + + +-- GENERIC FUNCTIONS + +-- 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 + +-- 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 + +-- curry :: (Script|Handler) -> Script +on curry(f) + script + on lambda(a) + script + on lambda(b) + lambda(a, b) of mReturn(f) + end lambda + end script + end lambda + end script +end curry + +-- transpose :: [[a]] -> [[a]] +on transpose(xss) + script column + on lambda(_, iCol) + script row + on lambda(xs) + item iCol of xs + end lambda + end script + + map(row, xss) + end lambda + end script + + map(column, item 1 of xss) +end transpose + +-- maximumBy :: (a -> a -> Ordering) -> [a] -> a +on maximumBy(f, xs) + set cmp to mReturn(f) + script max + on lambda(a, b) + if a is missing value or cmp's lambda(a, b) < 0 then + b + else + a + end if + end lambda + end script + + foldl(max, missing value, xs) +end maximumBy + +-- splitOn :: Text -> Text -> [Text] +on splitOn(strDelim, strMain) + set {dlm, my text item delimiters} to {my text item delimiters, strDelim} + set xs to text items of strMain + set my text item delimiters to dlm + return xs +end splitOn + +-- intercalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate + +-- keyValue :: Record -> String -> Maybe String +on keyValue(rec, strKey) + set ca to current application + set v to (ca's NSDictionary's dictionaryWithDictionary:rec)'s objectForKey:strKey + if v is not missing value then + item 1 of ((ca's NSArray's arrayWithObject:v) as list) + else + missing value + end if +end keyValue + +-- toLower :: String -> String +on toLower(str) + set ca to current application + ((ca's NSString's stringWithString:(str))'s ¬ + lowercaseStringWithLocale:(ca's NSLocale's currentLocale())) as text +end toLower + +-- toUpper :: String -> String +on toUpper(str) + set ca to current application + ((ca's NSString's stringWithString:(str))'s ¬ + uppercaseStringWithLocale:(ca's NSLocale's currentLocale())) as text +end toUpper + +-- toTitle :: String -> String +on toTitle(str) + set ca to current application + ((ca's NSString's stringWithString:(str))'s ¬ + capitalizedStringWithLocale:(ca's NSLocale's currentLocale())) as text +end toTitle + + +-- justifyLeft :: Int -> Char -> Text -> Text +on justifyLeft(N, cFiller, strText) + if N > length of strText then + text 1 thru N of (strText & replicate(N, cFiller)) + else + strText + end if +end justifyLeft + +-- justifyRight :: Int -> Char -> Text -> Text +on justifyRight(N, cFiller, strText) + if N > length of strText then + text -N thru -1 of ((replicate(N, cFiller) as text) & strText) + else + strText + end if +end justifyRight + +-- replicate :: Int -> a -> [a] +on replicate(N, a) + set out to {} + if N < 1 then return out + set dbl to {a} + + repeat while (N > 1) + if (N mod 2) > 0 then set out to out & dbl + set N to (N div 2) + set dbl to (dbl & dbl) + end repeat + return out & dbl +end replicate + +-- 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 + +-- cond :: Bool -> a -> a -> a +on cond(bool, f, g) + if bool then + f + else + g + end if +end cond diff --git a/Task/Box-the-compass/COBOL/box-the-compass.cobol b/Task/Box-the-compass/COBOL/box-the-compass.cobol new file mode 100644 index 0000000000..697e53d2db --- /dev/null +++ b/Task/Box-the-compass/COBOL/box-the-compass.cobol @@ -0,0 +1,67 @@ + identification division. + program-id. box-compass. + data division. + working-storage section. + 01 point pic 99. + 01 degrees usage float-short. + 01 degrees-rounded pic 999v99. + 01 show-degrees pic zz9.99. + 01 box pic z9. + 01 fudge pic 9. + 01 compass pic x(4). + 01 compass-point pic x(18). + 01 shortform pic x. + 01 short-names. + 05 short-name pic x(4) occurs 33 times. + 01 overlay. + 05 value "N " & "NbE " & "N-NE" & "NEbN" & "NE " & + "NEbE" & "E-NE" & "EbN " & "E " & "EbS " & + "E-SE" & "SEbE" & "SE " & "SEbS" & "S-SE" & + "SbE " & "S " & "SbW " & "S-SW" & "SWbS" & + "SW " & "SWbW" & "W-SW" & "WbS " & "W " & + "WbN " & "W-NW" & "NWbW" & "NW " & "NWbN" & + "N-NW" & "NbW " & "N ". + + procedure division. + display "Index Compass point Degree" + + move overlay to short-names. + perform varying point from 0 by 1 until point > 32 + compute box = function mod(point 32) + 1 + compute degrees = point * 11.25 + compute fudge = function mod(point 3) + evaluate fudge + when equal 1 + add 5.62 to degrees + when equal 2 + subtract 5.62 from degrees + end-evaluate + + compute degrees-rounded rounded = degrees + move degrees-rounded to show-degrees + inspect show-degrees replacing trailing '00' by '0 ' + inspect show-degrees replacing trailing '50' by '5 ' + + move short-name(point + 1) to compass + move spaces to compass-point + display space box space space space with no advancing + perform varying tally from 1 by 1 until tally > 4 + move compass(tally:1) to shortform + move function concatenate(function trim(compass-point), + function substitute(shortform, + "N", "North", + "E", "East", + "S", "South", + "W", "West", + "b", " byZ", + "-", "-")) + to compass-point + end-perform + move function substitute(compass-point, "Z", " ") + to compass-point + move function lower-case(compass-point) to compass-point + move function upper-case(compass-point(1:1)) + to compass-point(1:1) + display compass-point space show-degrees + end-perform + goback. diff --git a/Task/Box-the-compass/JavaScript/box-the-compass.js b/Task/Box-the-compass/JavaScript/box-the-compass-1.js similarity index 100% rename from Task/Box-the-compass/JavaScript/box-the-compass.js rename to Task/Box-the-compass/JavaScript/box-the-compass-1.js diff --git a/Task/Box-the-compass/JavaScript/box-the-compass-2.js b/Task/Box-the-compass/JavaScript/box-the-compass-2.js new file mode 100644 index 0000000000..096c4c18b4 --- /dev/null +++ b/Task/Box-the-compass/JavaScript/box-the-compass-2.js @@ -0,0 +1,239 @@ +(() => { + 'use strict'; + + // GENERIC FUNCTIONS + + // toTitle :: String -> String + let toTitle = s => s.length ? (s[0].toUpperCase() + s.slice(1)) : ''; + + // COMPASS DATA AND FUNCTIONS + + // Scale invariant keys for points of the compass + // (allows us to look up a translation for one scale of compass (32 here) + // for use in another size of compass (8 or 16 points) + // (Also semi-serviceable as more or less legible keys without translation) + + // compassKeys :: Int -> [String] + let compassKeys = depth => { + let urCompass = ['N', 'S', 'N'], + subdivision = (compass, n) => n <= 1 ? ( + compass + ) : subdivision( // Borders between N and S engender E and W. + // other new boxes concatenate their parent keys. + compass.reduce((a, x, i, xs) => { + if (i > 0) { + return (n === depth) ? ( + a.concat([x === 'N' ? 'W' : 'E'], x) + ) : a.concat([xs[i - 1] + x, x]); + } else return a.concat(x); + }, []), + n - 1 + ); + return subdivision(urCompass, depth) + .slice(0, -1); + }; + + // https://zh.wikipedia.org/wiki/%E7%BD%97%E7%9B%98%E6%96%B9%E4%BD%8D + let lstLangs = [{ + 'name': 'English', + expansions: { + N: 'north', + S: 'south', + E: 'east', + W: 'west', + b: ' by ', + '-': '-' + }, + 'N': 'N', + 'NNNE': 'NbE', + 'NNE': 'N-NE', + 'NNENE': 'NEbN', + 'NE': 'NE', + 'NENEE': 'NEbE', + 'NEE': 'E-NE', + 'NEEE': 'EbN', + 'E': 'E', + 'EEES': 'EbS', + 'EES': 'E-SE', + 'EESES': 'SEbE', + 'ES': 'SE', + 'ESESS': 'SEbS', + 'ESS': 'S-SE', + 'ESSS': 'SbE', + 'S': 'S', + 'SSSW': 'SbW', + 'SSW': 'S-SW', + 'SSWSW': 'SWbS', + 'SW': 'SW', + 'SWSWW': 'SWbW', + 'SWW': 'W-SW', + 'SWWW': 'WbS', + 'W': 'W', + 'WWWN': 'WbN', + 'WWN': 'W-NW', + 'WWNWN': 'NWbW', + 'WN': 'NW', + 'WNWNN': 'NWbN', + 'WNN': 'N-NW', + 'WNNN': 'NbW' + }, { + 'name': 'Chinese', + 'N': '北', + 'NNNE': '北微东', + 'NNE': '东北偏北', + 'NNENE': '东北微北', + 'NE': '东北', + 'NENEE': '东北微东', + 'NEE': '东北偏东', + 'NEEE': '东微北', + 'E': '东', + 'EEES': '东微南', + 'EES': '东南偏东', + 'EESES': '东南微东', + 'ES': '东南', + 'ESESS': '东南微南', + 'ESS': '东南偏南', + 'ESSS': '南微东', + 'S': '南', + 'SSSW': '南微西', + 'SSW': '西南偏南', + 'SSWSW': '西南微南', + 'SW': '西南', + 'SWSWW': '西南微西', + 'SWW': '西南偏西', + 'SWWW': '西微南', + 'W': '西', + 'WWWN': '西微北', + 'WWN': '西北偏西', + 'WWNWN': '西北微西', + 'WN': '西北', + 'WNWNN': '西北微北', + 'WNN': '西北偏北', + 'WNNN': '北微西' + }]; + + // pointIndex :: Int -> Num -> Int + let pointIndex = (power, degrees) => { + let nBoxes = (power ? Math.pow(2, power) : 32); + return Math.ceil( + (degrees + (360 / (nBoxes * 2))) % 360 * nBoxes / 360 + ) || 1; + }; + + // pointNames :: Int -> Int -> [String] + let pointNames = (precision, iBox) => { + let k = compassKeys(precision)[iBox - 1]; + return lstLangs.map(dctLang => { + let s = dctLang[k] || k, // fallback to key if no translation + dctEx = dctLang.expansions; + + return dctEx ? toTitle(s.split('') + .map(c => dctEx[c]) + .join(precision > 5 ? ' ' : '')) + .replace(/ /g, ' ') : s; + }); + }; + + // maximumBy :: (a -> a -> Ordering) -> [a] -> a + let maximumBy = (f, xs) => + xs.reduce((a, x) => a === undefined ? x : ( + f(x, a) > 0 ? x : a + ), undefined); + + // justifyLeft :: Int -> Char -> Text -> Text + let justifyLeft = (n, cFiller, strText) => + n > strText.length ? ( + (strText + replicate(n, cFiller) + .join('')) + .substr(0, n) + ) : strText; + + // justifyRight :: Int -> Char -> Text -> Text + let justifyRight = (n, cFiller, strText) => + n > strText.length ? ( + (replicate(n, cFiller) + .join('') + strText) + .slice(-n) + ) : strText; + + // replicate :: Int -> a -> [a] + let replicate = (n, a) => { + let v = [a], + o = []; + if (n < 1) return o; + while (n > 1) { + if (n & 1) o = o.concat(v); + n >>= 1; + v = v.concat(v); + } + return o.concat(v); + }; + + // transpose :: [[a]] -> [[a]] + let transpose = xs => + xs[0].map((_, iCol) => xs.map((row) => row[iCol])); + + // length :: [a] -> Int + // length :: Text -> Int + let length = xs => xs.length; + + // compareByLength = (a, a) -> (-1 | 0 | 1) + let compareByLength = (a, b) => { + let [na, nb] = [a, b].map(length); + return na < nb ? -1 : na > nb ? 1 : 0; + }; + + // maxLen :: [String] -> Int + let maxLen = xs => maximumBy(compareByLength, xs) + .length; + + // compassTable :: Int -> [Num] -> Maybe String + let compassTable = (precision, xs) => { + if (precision < 1) return undefined; + else { + let intPad = 2; + + let lstIndex = xs.map(x => pointIndex(precision, x)), + lstStrIndex = lstIndex.map(x => x.toString()), + nIndexWidth = maxLen(lstStrIndex), + colIndex = lstStrIndex.map( + x => justifyRight(nIndexWidth, ' ', x) + ); + + let lstAngles = xs.map(x => x.toFixed(2) + '°'), + nAngleWidth = maxLen(lstAngles) + intPad, + colAngles = lstAngles.map(x => justifyRight(nAngleWidth, ' ', x)); + + let lstTrans = transpose( + lstIndex.map(i => pointNames(precision, i)) + ), + lstTransWidths = lstTrans.map(x => maxLen(x) + 2), + colsTrans = lstTrans + .map((lstLang, i) => lstLang + .map(x => justifyLeft(lstTransWidths[i], ' ', x)) + ); + + return transpose([colIndex] + .concat([colAngles], [replicate(lstIndex.length, " ")]) + .concat(colsTrans)) + .map(x => x.join('')) + .join('\n'); + } + } + + // TEST + let xs = [0.0, 16.87, 16.88, 33.75, 50.62, 50.63, 67.5, 84.37, + 84.38, 101.25, 118.12, 118.13, 135.0, 151.87, 151.88, 168.75, + 185.62, 185.63, 202.5, 219.37, 219.38, 236.25, 253.12, 253.13, + 270.0, 286.87, 286.88, 303.75, 320.62, 320.63, 337.5, 354.37, + 354.38 + ]; + + // If we supply other precisions, like 4 or 6, (2^n -> 16 or 64 boxes) + // the bearings will be divided amongst smaller or larger numbers of boxes, + // either using name translations retrieved by the generic hash + // or using the hash itself (combined with any expansions) + // to substitute for missing names for very finely divided boxes. + + return compassTable(5, xs); // 2^5 -> 32 boxes +})(); diff --git a/Task/Box-the-compass/PowerShell/box-the-compass-1.psh b/Task/Box-the-compass/PowerShell/box-the-compass-1.psh new file mode 100644 index 0000000000..7fbf594f28 --- /dev/null +++ b/Task/Box-the-compass/PowerShell/box-the-compass-1.psh @@ -0,0 +1,16 @@ +function Convert-DegreeToDirection ( [double]$Degree ) + { + + $Directions = @( 'n','n by e','n-ne','ne by n','ne','ne by e','e-ne','e by n', + 'e','e by s','e-se','se by e','se','se by s','s-se','s by e', + 's','s by w','s-sw','sw by s','sw','sw by w','w-sw','w by s', + 'w','w by n','w-nw','nw by w','nw','nw by n','n-nw','n by w', + 'n' + ).Replace( 's', 'south' ).Replace( 'e', 'east' ).Replace( 'n', 'north' ).Replace( 'w', 'west' ) + + $Directions[[math]::floor(( $Degree % 360 ) / 11.25 + 0.5 )] + } + +$x = 0.0, 16.87, 16.88, 33.75, 50.62, 50.63, 67.5, 84.37, 84.38, 101.25, 118.12, 118.13, 135.0, 151.87, 151.88, 168.75, 185.62, 185.63, 202.5, 219.37, 219.38, 236.25, 253.12, 253.13, 270.0, 286.87, 286.88, 303.75, 320.62, 320.63, 337.5, 354.37, 354.38 + +$x | % { Convert-DegreeToDirection -Degree $_ } diff --git a/Task/Box-the-compass/PowerShell/box-the-compass-2.psh b/Task/Box-the-compass/PowerShell/box-the-compass-2.psh new file mode 100644 index 0000000000..5c1ab4244e --- /dev/null +++ b/Task/Box-the-compass/PowerShell/box-the-compass-2.psh @@ -0,0 +1,23 @@ +function Convert-DegreeToDirection ( [double]$Degree, [int]$Points ) + { + + $Directions = @( 'n','n by e','n-ne','ne by n','ne','ne by e','e-ne','e by n', + 'e','e by s','e-se','se by e','se','se by s','s-se','s by e', + 's','s by w','s-sw','sw by s','sw','sw by w','w-sw','w by s', + 'w','w by n','w-nw','nw by w','nw','nw by n','n-nw','n by w', + 'n' + ).Replace( 's', 'south' ).Replace( 'e', 'east' ).Replace( 'n', 'north' ).Replace( 'w', 'west' ) + + $Directions[[math]::floor((( $Degree % 360 ) * $Points / 360 + 0.5 )) * 32 / $Points ] + } + +$x = 0.0, 16.87, 16.88, 33.75, 50.62, 50.63, 67.5, 84.37, 84.38, 101.25, 118.12, 118.13, 135.0, 151.87, 151.88, 168.75, 185.62, 185.63, 202.5, 219.37, 219.38, 236.25, 253.12, 253.13, 270.0, 286.87, 286.88, 303.75, 320.62, 320.63, 337.5, 354.37, 354.38 + + +$Values = @() +ForEach ( $Degree in $X ) { $Values += [pscustomobject]@{ Degree = $Degree + 32 = ( Convert-DegreeToDirection -Degree $Degree -Points 32 ) + 16 = ( Convert-DegreeToDirection -Degree $Degree -Points 16 ) + 8 = ( Convert-DegreeToDirection -Degree $Degree -Points 8 ) + 4 = ( Convert-DegreeToDirection -Degree $Degree -Points 4 ) } } +$Values | Format-Table diff --git a/Task/Box-the-compass/REXX/box-the-compass.rexx b/Task/Box-the-compass/REXX/box-the-compass.rexx index 9e3b4d32d7..0b4228a0d2 100644 --- a/Task/Box-the-compass/REXX/box-the-compass.rexx +++ b/Task/Box-the-compass/REXX/box-the-compass.rexx @@ -1,29 +1,29 @@ -/*REXX program "boxes the compass" (from º headings ───► a 32 point set).*/ -parse arg # /*allow a º heading to be specified.*/ -if #='' then #= 0 16.87 16.88 33.75 50.62 50.63 67.5 84.37 84.38 101.25 118.12, - 118.13 135 151.87 151.88 168.75 185.62 185.63 202.5 219.37, - 219.38 236.25 253.12 253.13 270 286.87 286.88 303.75 320.62, - 320.63 337.5 354.37 354.38 /* [↑] use default in degrees.*/ +/*REXX program "boxes the compass" [from degree (º) headings ───► a 32 point set]. */ +parse arg $ /*allow a º heading to be specified. */ +if $='' then $= 0 16.87 16.88 33.75 50.62 50.63 67.5 84.37 84.38 101.25 118.12 118.13 , + 135 151.87 151.88 168.75 185.62 185.63 202.5 219.37 219.38 236.25 , + 253.12 253.13 270 286.87 286.88 303.75 320.62 320.63 337.5 354.37 354.38 + /* [↑] use default, they're in degrees*/ +@pts= 'n nbe n-ne nebn ne nebe e-ne ebn e ebs e-se sebe se sebs s-se sbe', + "s sbw s-sw swbs sw swbw w-sw wbs w wbn w-nw nwbw nw nwbn n-nw nbw" -points= 'n nbe n-ne nebn ne nebe e-ne ebn e ebs e-se sebe se sebs s-se sbe', - 's sbw s-sw swbs sw swbw w-sw wbs w wbn w-nw nwbw nw nwbn n-nw nbw' +#=words(@pts) + 1 /*#: used for integer ÷ remainder (//)*/ +dirs= 'north south east west' /*define cardinal compass directions. */ + /* [↓] choose a glyph for degree (°).*/ +if 4=='f4'x then degSym= "a1"x /*is this system an EBCDIC system? */ + else degSym= "a7"x /*'f8'x is the degree symbol: ° vs º */ + /*──────────────────────────── f8 vs a7*/ +say right(degSym'heading', 30) center("compass heading", 20) +say right( '════════', 30) copies( "═", 20) -dirs= 'north south east west' /*define cardinal compass directions.*/ - /* [↓] choose a degree (°) glyph. */ -if 4=='f4'x then degSym='a1'x /*is this system an EBCDIC system? */ - else degSym='f8'x /*although 'a7'x looks better: ° vs º*/ - /*─────────────────────────── f8 a7*/ -say right(degSym'heading',30) center('compass heading',20) -say right( '────────',30) copies('─' ,20) - - do j=1 for words(#); x=word(#,j) /*get one of the degree headings*/ - say right(format(x,,2)degSym,30-1) ' ' boxHeading(x) + do j=1 for words($); x=word($, j) /*obtain one of the degree headings. */ + say right(format(x, , 2)degSym, 30-1) ' ' boxHeading(x) end /*j*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -boxHeading: _=arg(1)//360; if _<0 then _=360-_ /*normalize the heading.*/ -_=word(points,trunc(max(1,(_/11.25+1.5)//33))) - do k=1 for words(dirs); d=word(dirs,k) - _=changestr(left(d,1), _, d) - end /*k*/ -return changestr('b', _, " by ") /*expand "b" ──► "by"*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +boxHeading: y=arg(1)//360; if y<0 then y=360 - y /*normalize heading within unit circle.*/ + z=word(@pts, trunc(max(1, (y/11.25+1.5) // #))) /*convert degrees─►heading*/ + do k=1 for words(dirs); d=word(dirs, k) + z=changestr( left(d,1), z, d) + end /*k*/ /* [↑] old, haystack, new*/ + return changestr('b', z, " by ") /*expand "b" ──► " by " */ diff --git a/Task/Box-the-compass/ZX-Spectrum-Basic/box-the-compass.zx b/Task/Box-the-compass/ZX-Spectrum-Basic/box-the-compass.zx new file mode 100644 index 0000000000..4f3f02463f --- /dev/null +++ b/Task/Box-the-compass/ZX-Spectrum-Basic/box-the-compass.zx @@ -0,0 +1,26 @@ +10 DATA "North","North by east","North-northeast" +20 DATA "Northeast by north","Northeast","Northeast by east","East-northeast" +30 DATA "East by north","East","East by south","East-southeast" +40 DATA "Southeast by east","Southeast","Southeast by south","South-southeast" +50 DATA "South by east","South","South by west","South-southwest" +60 DATA "Southwest by south","Southwest","Southwest by west","West-southwest" +70 DATA "West by south","West","West by north","West-northwest" +80 DATA "Northwest by west","Northwest","Northwest by north","North-northwest" +90 DATA "North by west" +100 DIM p$(32,18) +110 FOR i=1 TO 32 +120 READ p$(i) +130 NEXT i +140 FOR i=0 TO 32 +150 LET h=i*11.25 +160 LET r=FN m(i,3) +170 IF r=1 THEN LET h=h+5.62: GO TO 190 +180 IF r=2 THEN LET h=h-5.62 +190 LET ind=FN m(i,32)+1 +200 PRINT ind;TAB 4; +210 LET x=h/11.25+1.5 +220 IF x>=33 THEN LET x=x-32 +230 PRINT p$(INT x);TAB 25;h +240 NEXT i +250 STOP +260 DEF FN m(i,n)=((i/n)-INT (i/n))*n : REM modulus function diff --git a/Task/Break-OO-privacy/Forth/break-oo-privacy.fth b/Task/Break-OO-privacy/Forth/break-oo-privacy.fth index c457e5915a..f274096981 100644 --- a/Task/Break-OO-privacy/Forth/break-oo-privacy.fth +++ b/Task/Break-OO-privacy/Forth/break-oo-privacy.fth @@ -9,7 +9,7 @@ include FMS-SI.f ;class foo f1 \ instantiate a foo object -f1 print \ 10 +f1 print \ 10 access the private x with the print message x . \ 99 x is a globally scoped name diff --git a/Task/Break-OO-privacy/Ruby/break-oo-privacy.rb b/Task/Break-OO-privacy/Ruby/break-oo-privacy.rb index 1be585dd15..91fd089da6 100644 --- a/Task/Break-OO-privacy/Ruby/break-oo-privacy.rb +++ b/Task/Break-OO-privacy/Ruby/break-oo-privacy.rb @@ -1,15 +1,17 @@ ->> class Example ->> private ->> def name ->> "secret" ->> end ->> end -=> nil ->> example = Example.new -=> # ->> example.name -NoMethodError: private method `name' called for # - from (irb):10 - from :0 ->> example.send(:name) -=> "secret" +class Example + def initialize + @private_data = "nothing" # instance variables are always private + end + private + def hidden_method + "secret" + end +end +example = Example.new +p example.private_methods(false) # => [:hidden_method] +#p example.hidden_method # => NoMethodError: private method `name' called for # +p example.send(:hidden_method) # => "secret" +p example.instance_variables # => [:@private_data] +p example.instance_variable_get :@private_data # => "nothing" +p example.instance_variable_set :@private_data, 42 # => 42 +p example.instance_variable_get :@private_data # => 42 diff --git a/Task/Brownian-tree/00DESCRIPTION b/Task/Brownian-tree/00DESCRIPTION index 25d48e3f8c..0a9e3c8e7c 100644 --- a/Task/Brownian-tree/00DESCRIPTION +++ b/Task/Brownian-tree/00DESCRIPTION @@ -1,4 +1,9 @@ -Generate and draw a [[wp:Brownian tree|Brownian Tree]]. +[[File:Brownian_tree.jpg|600px||right]] + + +;Task: +Generate and draw a   [[wp:Brownian tree|Brownian Tree]]. + A Brownian Tree is generated as a result of an initial seed, followed by the interaction of two processes. @@ -6,4 +11,4 @@ A Brownian Tree is generated as a result of an initial seed, followed by the int # Particles are injected into the field, and are individually given a (typically random) motion pattern. # When a particle collides with the seed or tree, its position is fixed, and it's considered to be part of the tree. -Because of the lax rules governing the random nature of the particle's placement and motion, no two resulting trees are really expected to be the same, or even necessarily have the same general shape. +
Because of the lax rules governing the random nature of the particle's placement and motion, no two resulting trees are really expected to be the same, or even necessarily have the same general shape.

diff --git a/Task/Brownian-tree/PARI-GP/brownian-tree-1.pari b/Task/Brownian-tree/PARI-GP/brownian-tree-1.pari new file mode 100644 index 0000000000..2e40ef4b4f --- /dev/null +++ b/Task/Brownian-tree/PARI-GP/brownian-tree-1.pari @@ -0,0 +1,11 @@ +\\ 2 plotting helper functions 3/2/16 aev +\\ insm(): x,y are inside matrix mat (+/- p deep). +insm(mat,x,y,p=0)={my(xz=#mat[1,],yz=#mat[,1]); + return(x+p>0 && x+p<=xz && y+p>0 && y+p<=yz && x-p>0 && x-p<=xz && y-p>0 && y-p<=yz)} +\\ plotmat(): Simple plotting using matrix mat (filled with 0/1). +plotmat(mat)={ +my(xz=#mat[1,],yz=#mat[,1],vx=List(),vy=vx,x,y); +for(i=1,yz, for(j=1,xz, if(mat[i,j]==0, next, listput(vx,i); listput(vy,j)))); +plothraw(Vec(vx),Vec(vy)); +print(" *** matrix(",xz,"x",yz,") ",#vy, " DOTS"); +} diff --git a/Task/Brownian-tree/PARI-GP/brownian-tree-2.pari b/Task/Brownian-tree/PARI-GP/brownian-tree-2.pari new file mode 100644 index 0000000000..015ff3fa0d --- /dev/null +++ b/Task/Brownian-tree/PARI-GP/brownian-tree-2.pari @@ -0,0 +1,20 @@ +\\ 3/8/2016 +BrownianTree1(size,lim)={ +my(Myx=matrix(size,size),sz=size-1,sz2=sz\2,x,y,ox,oy); +x=sz2; y=sz2; Myx[y,x]=1; \\ seed in center +print(" *** START: ",x,"/",y); +for(i=1,lim, + x=random(sz)+1; y=random(sz)+1; + while(1, + ox=x; oy=y; + x+=random(3)-1; y+=random(3)-1; + if(insm(Myx,x,y)&&Myx[y,x], + if(insm(Myx,ox,oy), Myx[oy,ox]=1; break)); + if(!insm(Myx,x,y), break); + );\\wend +);\\ fend i +plotmat(Myx); +} +{\\ Executing: +BrownianTree1(400,15000); +} diff --git a/Task/Brownian-tree/PARI-GP/brownian-tree-3.pari b/Task/Brownian-tree/PARI-GP/brownian-tree-3.pari new file mode 100644 index 0000000000..818483400f --- /dev/null +++ b/Task/Brownian-tree/PARI-GP/brownian-tree-3.pari @@ -0,0 +1,18 @@ +\\ 3/11/2016 +BrownianTree2(size,lim)={ +my(Myx=matrix(size,size),sz=size-1,dx,dy,x,y); +x=random(sz); y=random(sz); Myx[y,x]=1; \\ random seed +print(" *** START: ",x,"/",y); +for(i=1,lim, + x=random(sz)+1; y=random(sz)+1; + while(1, + dx=random(3)-1; dy=random(3)-1; + if(!insm(Myx,x+dx,y+dy), x=random(sz)+1; y=random(sz)+1, + if(Myx[y+dy,x+dx], Myx[y,x]=1; break, x+=dx; y+=dy)); + );\\wend +);\\fend i +plotmat(Myx); +} +{\\ Executing: +BrownianTree2(1000,3000); +} diff --git a/Task/Brownian-tree/PARI-GP/brownian-tree-4.pari b/Task/Brownian-tree/PARI-GP/brownian-tree-4.pari new file mode 100644 index 0000000000..bc1ecc6fb5 --- /dev/null +++ b/Task/Brownian-tree/PARI-GP/brownian-tree-4.pari @@ -0,0 +1,20 @@ +\\ 3/14/2016 +BrownianTree3(size,lim)={ +my(Myx=matrix(size,size),sz=size-2,x,y,dx,dy,b=0); +x=random(sz); y=random(sz); Myx[y,x]=1; \\ random seed +print("*** START: ", x,"/",y); +for(i=1,lim, + x=random(sz); y=random(sz); + b=0; \\ bumped not + while(!b, + dx=random(3)-1; dy=random(3)-1; + if(!insm(Myx,x+dx,y+dy), x=random(sz); y=random(sz), + if(Myx[y+dy,x+dx]==1, Myx[y,x]=1; b=1, x+=dx; y+=dy); + ); + );\\wend +);\\fend i +plotmat(Myx); +} +{\\ Executing: +BrownianTree3(400,5000); +} diff --git a/Task/Brownian-tree/PARI-GP/brownian-tree-5.pari b/Task/Brownian-tree/PARI-GP/brownian-tree-5.pari new file mode 100644 index 0000000000..11e837dff1 --- /dev/null +++ b/Task/Brownian-tree/PARI-GP/brownian-tree-5.pari @@ -0,0 +1,27 @@ +\\ 3/17/2016 +\\ s=1/2(random seed/seed in the center); p=0..n (level of the "deep" checking). +BrownianTree4(size,lim,s=1,p=0)={ +my(Myx=matrix(size,size),sz=size-3,x,y); +\\ seed s=1 for BTPB1, s=2 for BTPB2, BTPB3 +if(s==1,x=random(sz); y=random(sz), x=sz\2; y=sz\2); Myx[y,x]=1; +print(" *** START: ",x,"/",y); +for(i=1,lim, + if(!(i==1&&s==2), x=random(sz)+1; y=random(sz)+1); + while(insm(Myx,x,y,1)&& + (Myx[y+1,x+1]+Myx[y+1,x]+Myx[y+1,x-1]+Myx[y,x+1]+ + Myx[y-1,x-1]+Myx[y,x-1]+Myx[y-1,x]+Myx[y-1,x+1])==0, + x+=random(3)-1; y+=random(3)-1; + \\ p=0 for BTPB1, BTPB2; p=5 for BTPB3 + if(!insm(Myx,x,y,p), x=random(sz)+1; y=random(sz)+1;); + );\\wend + Myx[y,x]=1; +);\\fend i +plotmat(Myx); +} + +{ +\\ Executing: +BrownianTree4(200,4000); \\BTPB1.png +BrownianTree4(200,4000,2); \\BTPB2.png +BrownianTree4(200,4000,2,5); \\BTPB3.png +} diff --git a/Task/Brownian-tree/Processing/brownian-tree b/Task/Brownian-tree/Processing/brownian-tree new file mode 100644 index 0000000000..95842c3c2f --- /dev/null +++ b/Task/Brownian-tree/Processing/brownian-tree @@ -0,0 +1,37 @@ +boolean SIDESTICK = false; +boolean[][] isTaken; + +void setup() { + size(512, 512); + isTaken = new boolean[width][height]; + isTaken[width/2][height/2] = true; +} + +void draw() { + for (int i = 0; i < width*height; i++) { + int x = floor(random(width)); + int y = floor(random(height)); + if (isTaken[x][y]) { continue; } + while (true) { + int xp = x + floor(random(-1, 2)); + int yp = y + floor(random(-1, 2)); + boolean iscontained = ( + 0 <= xp && xp < width && + 0 <= yp && yp < height + ); + if (iscontained && !isTaken[xp][yp]) { + x = xp; + y = yp; + continue; + } + else { + if (SIDESTICK || (iscontained && isTaken[xp][yp])) { + isTaken[x][y] = true; + set(x, y, #000000); + } + break; + } + } + } + noLoop(); +} diff --git a/Task/Brownian-tree/REXX/brownian-tree.rexx b/Task/Brownian-tree/REXX/brownian-tree.rexx index d0069c4493..8461ed4b69 100644 --- a/Task/Brownian-tree/REXX/brownian-tree.rexx +++ b/Task/Brownian-tree/REXX/brownian-tree.rexx @@ -1,105 +1,105 @@ -/*REXX program shows Brownian motion of dust in a field with one seed.*/ -parse arg height width motes randSeed . /*get args from the C.L. */ -if height=='' | height==',' then height=0 /*None? Use the default*/ -if width=='' | width==',' then width=0 /* " " " " */ -if motes=='' | motes==',' then motes='10%' /*% dust motes in field, */ - /* ··· otherwise just the number.*/ -tree = '*' /*an affixed dust speck (tree). */ -mote = '·' /*char for a loose mote (of dust)*/ -hole = ' ' /*char for an empty spot in field*/ -clearScr = 'CLS' /*(DOS?) command to clear screen.*/ -eons = 1000000 /* # cycles for Brownian movement*/ -snapshot = 0 /*every n winks, show snapshot.*/ -snaptime = 1 /*every n secs, show snapshot.*/ -seedPos = 30 45 /*place seed in this field pos. */ -seedPos = 0 /*if =0, use middle of the field.*/ - /*if -1, use a random placement. */ - /*otherwise, place it at seedPos.*/ - /*set RANDSEED for repeatability.*/ -if datatype(randSeed,'W') then call random ,,randSeed /*if #, use it*/ - /* [↑] set the 1st random number*/ -if height==0 | width==0 then _=scrsize() /*not all REXXes have SCRSIZE.*/ -if height==0 then height=word(_,1)-3 /*adjust for border.*/ -if width==0 then width=word(_,2)-1 /* " " " */ +/*REXX program animates and displays Brownian motion of dust in a field (with one seed).*/ +parse arg height width motes randSeed . /*get args from the C.L. */ +if height=='' | height=="," then height=0 /*Not specified? Then use the default.*/ +if width=='' | width=="," then width=0 /* " " " " " " */ +if motes=='' | motes=="," then motes='10%' /*The % dust motes in the field, */ + /* [↑] either a # -or- a # with a %.*/ +tree = '*' /*an affixed dust speck, start of tree.*/ +mote = '·' /*character for a loose mote (of dust).*/ +hole = ' ' /* " " an empty spot in field.*/ +clearScr = 'CLS' /*(DOS) command to clear the screen. */ +eons = 1000000 /*number cycles for Brownian movement.*/ +snapshot = 0 /*every N winks, display a snapshot.*/ +snaptime = 1 /* " " secs, " " " */ +seedPos = 30 45 /*place a seed in this field position. */ +seedPos = 0 /*if =0, then use middle of the field.*/ + /* " -1, " " a random placement.*/ + /*otherwise, place the seed at seedPos.*/ + /*use RANDSEED for RANDOM repeatability*/ +if datatype(randSeed,'W') then call random ,,randSeed /*if an integer, use the seed.*/ + /* [↑] set the first random number. */ +if height==0 | width==0 then _=scrsize() /*Note: not all REXXes have SCRSIZE BIF*/ +if height==0 then height=word(_,1)-3 /*adjust useable height for the border.*/ +if width==0 then width=word(_,2)-1 /* " " width " " " */ seedAt=seedPos -if seedPos== 0 then seedAt=width%2 height%2 -if seedPos==-1 then seedAt=random(1,width) random(1,height) -parse var seedAt xs ys . /*obtain X & Y seed coördinates*/ - /* [↓] if right-most≡'%', use %.*/ -if right(motes,1)=='%' then motes=height * width * strip(motes,,'%') %100 -@.=hole /*create the field, all empty. */ +if seedPos== 0 then seedAt=width%2 height%2 /*if it's a zero, start in the middle.*/ +if seedPos==-1 then seedAt=random(1,width) random(1,height) /*if negative, use random.*/ +parse var seedAt xs ys . /*obtain the X and Y seed coördinates*/ + /* [↓] if right-most ≡ '%', then use %*/ +if right(motes,1)=='%' then motes=height * width * strip(motes,,'%') % 100 +@.=hole /*create the Brownian field, all empty.*/ - do j=1 for motes /*sprinkle # dust motes randomly.*/ + do j=1 for motes /*sprinkle a # of dust motes randomly.*/ rx=random(1, width); ry=random(1,height); @.rx.ry=mote - end /*j*/ /* [↑] place a mote at random. */ - /*plant the seed from which the */ - /*tree will grow from dust motes */ -@.xs.ys=tree /*that affixed themselves. */ -call show /*show field before we mess it up*/ -tim=0 /*the time (in secs) of last show*/ -loX=1; hiX= width /*used to optimize mote searching*/ -loY=1; hiY=height /* " " " " " */ + end /*j*/ /* [↑] place a mote at random in field*/ + /*plant the seed from which the tree */ + /* will grow from dust motes that */ +@.xs.ys=tree /* affixed themselves to others. */ +call show /*show field before we mess it up again*/ +tim=0 /*the time in seconds of last display. */ +loX=1; hiX= width /*used to optimize the mote searching.*/ +loY=1; hiY=height /* " " " " " " */ - /*═════════════════════════════soooo, this is Brownian motion.*/ - do winks=1 for eons until \motion /*EONs is used instead of ∞. */ - motion=0 /*turn off Brownian motion flag. */ + /*═══════════════════════════════════════ soooo, this is Brownian motion. */ + do winks=1 for eons until \motion /*EONs is used instead of ∞, close 'nuf*/ + motion=0 /*turn off the Brownian motion flag. */ if snapshot\==0 then if winks//snapshot==0 then call show if snaptime\==0 then do; t=time('S') - if t\==tim & t//snaptime==0 then do - tim=time('s') - call show - end + if t\==tim & t//snaptime==0 then do; tim=time('s') + call show + end end - minX=loX; maxX=hiX /*as the tree grows, the search */ - minY=loY; maxY=hiY /* for dust motes gets faster. */ - loX= width; hiX=1 /*used to limit mote searching. */ - loY=height; hiY=1 /* " " " " " */ + minX=loX; maxX=hiX /*as the tree grows, the search for */ + minY=loY; maxY=hiY /* dust motes gets faster. */ + loX= width; hiX=1 /*used to limit the mote searching. */ + loY=height; hiY=1 /* " " " " " " */ - do x =minX to maxX; xm=x-1; xp=x+1 - do y=minY to maxY; if @.x.y\==mote then iterate - if xhiX then hiX=x /*is faster than: hiX=max(X hiX) */ - if yhiY then hiY=y /*is faster than: hiY=max(y hiY) */ - if @.xm.y ==tree then do; @.x.y=tree; iterate; end /*neighbor?*/ - if @.xp.y ==tree then do; @.x.y=tree; iterate; end /*neighbor?*/ + do x =minX to maxX; xm=x-1; xp=x+1 /*a couple handy-dandy values*/ + do y=minY to maxY; if @.x.y\==mote then iterate /*Not a mote: keep looking. */ + if xhiX then hiX=x /*faster than: hiX=max(X hiX)*/ + if yhiY then hiY=y /*faster than: hiY=max(y hiY)*/ + if @.xm.y ==tree then do; @.x.y=tree; iterate; end /*neighbor?*/ + if @.xp.y ==tree then do; @.x.y=tree; iterate; end /*neighbor?*/ ym=y-1 - if @.x.ym ==tree then do; @.x.y=tree; iterate; end /*neighbor?*/ - if @.xm.ym==tree then do; @.x.y=tree; iterate; end /*neighbor?*/ - if @.xp.ym==tree then do; @.x.y=tree; iterate; end /*neighbor?*/ + if @.x.ym ==tree then do; @.x.y=tree; iterate; end /*neighbor?*/ + if @.xm.ym==tree then do; @.x.y=tree; iterate; end /*neighbor?*/ + if @.xp.ym==tree then do; @.x.y=tree; iterate; end /*neighbor?*/ yp=y+1 - if @.x.yp ==tree then do; @.x.y=tree; iterate; end /*neighbor?*/ - if @.xm.yp==tree then do; @.x.y=tree; iterate; end /*neighbor?*/ - if @.xp.yp==tree then do; @.x.y=tree; iterate; end /*neighbor?*/ - motion=1 /* [↓] Brownian motion is coming.*/ - xb=x+random(1,3)-2 /* apply Brownian motion for X.*/ - yb=y+random(1,3)-2 /* " " " " Y.*/ - if @.xb.yb\==hole then iterate /*can mote actually move there ? */ - @.x.y=hole /*empty out the old mote position*/ - @.xb.yb=mote /*move the mote (or possibly not)*/ - if xbhiX then hiX=min( width, xb) - if ybhiY then hiY=min(height, yb) - end /*y*/ /* [↑] limit the motes movement.*/ + if @.x.yp ==tree then do; @.x.y=tree; iterate; end /*neighbor?*/ + if @.xm.yp==tree then do; @.x.y=tree; iterate; end /*neighbor?*/ + if @.xp.yp==tree then do; @.x.y=tree; iterate; end /*neighbor?*/ + motion=1 /* [↓] Brownian motion is coming. */ + xb=x + random(1, 3) - 2 /* apply Brownian motion for X. */ + yb=y + random(1, 3) - 2 /* " " " " Y. */ + if @.xb.yb\==hole then iterate /*can the mote actually move to there ?*/ + @.x.y=hole /*"empty out" the old mote position. */ + @.xb.yb=mote /*move the mote (or possibly not). */ + if xbhiX then hiX=min( width, xb) + if ybhiY then hiY=min(height, yb) + end /*y*/ /* [↑] limit mote's movement to field.*/ end /*x*/ - call crop /*crops/truncates the mote field.*/ + + call crop /*crops (or truncates) the mote field.*/ end /*winks*/ call show -exit /*stick a fork in it, we're done.*/ -/*────────────────────────────────CROP subroutine───────────────────────*/ -crop: if loX>1 & hiX1 & hiY1 & hiX1 & hiY 200 Or y < 1 Or y > 200 then @@ -14,13 +15,7 @@ for i = 1 To numParticles end if wend canvas(x,y) = 1 + #g "color green ; set "; x; " "; y next i - -graphic #g, 200,200 -for x = 1 to 200 - for y = 1 to 200 - if canvas(x,y) = 1 then #g "color green ; set "; x; " "; y else #g "color blue ; set "; x; " "; y - next y -next x render #g #g "flush" diff --git a/Task/Brownian-tree/Rust/brownian-tree.rust b/Task/Brownian-tree/Rust/brownian-tree.rust new file mode 100644 index 0000000000..a29a72b8a8 --- /dev/null +++ b/Task/Brownian-tree/Rust/brownian-tree.rust @@ -0,0 +1,107 @@ +extern crate image; +extern crate rand; + +use image::ColorType; +use rand::distributions::{IndependentSample, Range}; +use std::cmp::{min, max}; +use std::env; +use std::path::Path; +use std::process; + +fn help() { + println!("Usage: brownian_tree "); +} + +fn main() { + let args: Vec = env::args().collect(); + let mut output_path = Path::new("out.png"); + let mut mote_count: u32 = 10000; + let mut width: usize = 512; + let mut height: usize = 512; + + match args.len() { + 1 => {} + 4 => { + output_path = Path::new(&args[1]); + mote_count = args[2].parse::().unwrap(); + width = args[3].parse::().unwrap(); + height = width; + } + _ => { + help(); + process::exit(0); + } + } + + assert!(width >= 2); + + // Base 1d array + let mut field_raw = vec![0u8; width * height]; + populate_tree(&mut field_raw, width, height, mote_count); + + // Balance image for 8-bit grayscale + let our_max = field_raw.iter().fold(0u8, |champ, e| max(champ, *e)); + let fudge = std::u8::MAX / our_max; + let balanced: Vec = field_raw.iter().map(|e| e * fudge).collect(); + + match image::save_buffer(output_path, + &balanced, + width as u32, + height as u32, + ColorType::Gray(8)) { + Err(e) => println!("Error writing output image:\n{}", e), + Ok(_) => println!("Output written to:\n{}", output_path.to_str().unwrap()), + } +} + + +fn populate_tree(raw: &mut Vec, width: usize, height: usize, mc: u32) { + // Vector of 'width' elements slices + let mut field_base: Vec<_> = raw.as_mut_slice().chunks_mut(width).collect(); + // Addressable 2d vector + let mut field: &mut [&mut [u8]] = field_base.as_mut_slice(); + + // Seed mote + field[width / 2][height / 2] = 1; + + let walk_range = Range::new(-1i32, 2i32); + let x_spawn_range = Range::new(1usize, width - 1); + let y_spawn_range = Range::new(1usize, height - 1); + let mut rng = rand::thread_rng(); + + for i in 0..mc { + if i % 100 == 0 { + println!("{}", i) + } + + // Spawn mote + let mut x = x_spawn_range.ind_sample(&mut rng); + let mut y = y_spawn_range.ind_sample(&mut rng); + + // Increment field value when motes spawn on top of the structure + if field[x][y] > 0 { + field[x][y] = min(field[x][y] as u32 + 1, std::u8::MAX as u32) as u8; + continue; + } + + loop { + let contacts = field[x - 1][y - 1] + field[x][y - 1] + field[x + 1][y - 1] + + field[x - 1][y] + field[x + 1][y] + + field[x - 1][y + 1] + field[x][y + 1] + + field[x + 1][y + 1]; + + if contacts > 0 { + field[x][y] = 1; + break; + } else { + let xw = walk_range.ind_sample(&mut rng) + x as i32; + let yw = walk_range.ind_sample(&mut rng) + y as i32; + if xw < 1 || xw >= (width as i32 - 1) || yw < 1 || yw >= (height as i32 - 1) { + break; + } + x = xw as usize; + y = yw as usize; + } + } + } +} diff --git a/Task/Brownian-tree/ZX-Spectrum-Basic/brownian-tree.zx b/Task/Brownian-tree/ZX-Spectrum-Basic/brownian-tree.zx new file mode 100644 index 0000000000..fabe6e79dd --- /dev/null +++ b/Task/Brownian-tree/ZX-Spectrum-Basic/brownian-tree.zx @@ -0,0 +1,16 @@ +10 LET np=1000 +20 PAPER 0: INK 4: CLS +30 PLOT 128,88 +40 FOR i=1 TO np +50 GO SUB 1000 +60 IF NOT ((POINT (x+1,y+1)+POINT (x,y+1)+POINT (x+1,y)+POINT (x-1,y-1)+POINT (x-1,y)+POINT (x,y-1))=0) THEN GO TO 100 +70 LET x=x+RND*2-1: LET y=y+RND*2-1 +80 IF x<1 OR x>254 OR y<1 OR y>174 THEN GO SUB 1000 +90 GO TO 60 +100 PLOT x,y +110 NEXT i +120 STOP +1000 REM Calculate new pos +1010 LET x=RND*254 +1020 LET y=RND*174 +1030 RETURN diff --git a/Task/Bulls-and-cows-Player/00DESCRIPTION b/Task/Bulls-and-cows-Player/00DESCRIPTION index 67901ab1d9..ca55894f06 100644 --- a/Task/Bulls-and-cows-Player/00DESCRIPTION +++ b/Task/Bulls-and-cows-Player/00DESCRIPTION @@ -1,9 +1,12 @@ -The task is to write a ''player'' of the [[Bulls and cows|Bulls and Cows game]], rather than a scorer. The player should give intermediate answers that respect the scores to previous attempts. +;Task: +Write a ''player'' of the [[Bulls and cows|Bulls and Cows game]], rather than a scorer. The player should give intermediate answers that respect the scores to previous attempts. One method is to generate a list of all possible numbers that could be the answer, then to prune the list by keeping only those numbers that would give an equivalent score to how your last guess was scored. Your next guess can be any number from the pruned list.
Either you guess correctly or run out of numbers to guess, which indicates a problem with the scoring. -;Cf, -* [[Bulls and cows]] -* [[Guess the number]] -* [[Guess the number/With Feedback (Player)]] + +;Related tasks: +*   [[Bulls and cows]] +*   [[Guess the number]] +*   [[Guess the number/With Feedback (Player)]] +

diff --git a/Task/Bulls-and-cows-Player/Elixir/bulls-and-cows-player.elixir b/Task/Bulls-and-cows-Player/Elixir/bulls-and-cows-player.elixir new file mode 100644 index 0000000000..871fc9ca45 --- /dev/null +++ b/Task/Bulls-and-cows-Player/Elixir/bulls-and-cows-player.elixir @@ -0,0 +1,47 @@ +defmodule Bulls_and_cows do + def player(size \\ 4) do + possibility = permute(size) |> Enum.shuffle + player(size, possibility, 1) + end + + def player(size, possibility, i) do + guess = hd(possibility) + IO.puts "Guess #{i} is #{Enum.join(guess)} (from #{length(possibility)} possibilities)" + case get_score(size) do + {^size, 0} -> IO.puts "Solved!" + score -> + selected = select(size, possibility, guess, score) + if selected==[] do + IO.puts "Sorry! I can't find a solution. Possible mistake in the scoring." + else + player(size, selected, i+1) + end + end + end + + defp get_score(size) do + IO.gets("Answer (Bulls, cows)? ") + |> String.split(~r/\D/, trim: true) + |> Enum.map(&String.to_integer/1) + |> case do + [bulls, cows] when bulls+cows in 0..size -> {bulls, cows} + _ -> get_score(size) + end + end + + defp select(size, possibility, guess, score) do + Enum.filter(possibility, fn x -> + bulls = Enum.zip(x, guess) |> Enum.count(fn {n,g} -> n==g end) + cows = size - length(x -- guess) - bulls + {bulls, cows} == score + end) + end + + defp permute(size), do: permute(size, Enum.to_list(1..9)) + defp permute(0, _), do: [[]] + defp permute(size, list) do + for x <- list, y <- permute(size-1, list--[x]), do: [x|y] + end +end + +Bulls_and_cows.player diff --git a/Task/Bulls-and-cows/00DESCRIPTION b/Task/Bulls-and-cows/00DESCRIPTION index 5799e899ea..0081809611 100644 --- a/Task/Bulls-and-cows/00DESCRIPTION +++ b/Task/Bulls-and-cows/00DESCRIPTION @@ -1,14 +1,23 @@ -[[wp:Bulls and Cows|This]] is an old game played with pencil and paper that was later implemented on computer. +[[wp:Bulls and Cows|Bulls and Cows]]   is an old game played with pencil and paper that was later implemented using computers. + + +;Task: +Create a four digit random number from the digits   '''1'''   to   '''9''',   without duplication. + +The program should: +::::::*   ask for guesses to this number +::::::*   reject guesses that are malformed +::::::*   print the score for the guess -The task is for the program to create a four digit random number from the digits 1 to 9, without duplication. -The program should ask for guesses to this number, reject guesses that are malformed, then print the score for the guess. The score is computed as: # The player wins if the guess is the same as the randomly chosen number, and the program ends. # A score of one '''bull''' is accumulated for each digit in the guess that equals the corresponding digit in the randomly chosen initial number. # A score of one '''cow''' is accumulated for each digit in the guess that also appears in the randomly chosen number, but in the wrong position. -;Cf, -* [[Bulls and cows/Player]] -* [[Guess the number]] -* [[Guess the number/With Feedback]] + +;Related tasks: +*   [[Bulls and cows/Player]] +*   [[Guess the number]] +*   [[Guess the number/With Feedback]] +

diff --git a/Task/Bulls-and-cows/AppleScript/bulls-and-cows.applescript b/Task/Bulls-and-cows/AppleScript/bulls-and-cows.applescript new file mode 100644 index 0000000000..52cd2b30d4 --- /dev/null +++ b/Task/Bulls-and-cows/AppleScript/bulls-and-cows.applescript @@ -0,0 +1,58 @@ +on pickNumber() + set theNumber to "" + repeat 4 times + set theDigit to (random number from 1 to 9) as string + repeat while (offset of theDigit in theNumber) > 0 + set theDigit to (random number from 1 to 9) as string + end repeat + set theNumber to theNumber & theDigit + end repeat +end pickNumber + +to bulls of theGuess given key:theKey + set bullCount to 0 + repeat with theIndex from 1 to 4 + if text theIndex of theGuess = text theIndex of theKey then + set bullCount to bullCount + 1 + end if + end repeat + return bullCount +end bulls + +to cows of theGuess given key:theKey, bulls:bullCount + set cowCount to -bullCount + repeat with theIndex from 1 to 4 + if (offset of (text theIndex of theKey) in theGuess) > 0 then + set cowCount to cowCount + 1 + end if + end repeat + + return cowCount +end cows + +to score of theGuess given key:theKey + set bullCount to bulls of theGuess given key:theKey + set cowCount to cows of theGuess given key:theKey, bulls:bullCount + return {bulls:bullCount, cows:cowCount} +end score + +on run + set theNumber to pickNumber() + set pastGuesses to {} + repeat + set theMessage to "" + repeat with aGuess in pastGuesses + set {theGuess, theResult} to aGuess + set theMessage to theMessage & theGuess & ":" & bulls of theResult & "B, " & cows of theResult & "C" & linefeed + end repeat + set theMessage to theMessage & linefeed & "Enter guess:" + set theGuess to text returned of (display dialog theMessage with title "Bulls and Cows" default answer "") + set theScore to score of theGuess given key:theNumber + if bulls of theScore is 4 then + display dialog "Correct! Found the secret in " & ((length of pastGuesses) + 1) & " guesses!" + exit repeat + else + set end of pastGuesses to {theGuess, theScore} + end if + end repeat +end run diff --git a/Task/Bulls-and-cows/Elixir/bulls-and-cows.elixir b/Task/Bulls-and-cows/Elixir/bulls-and-cows.elixir new file mode 100644 index 0000000000..4c98c87d2e --- /dev/null +++ b/Task/Bulls-and-cows/Elixir/bulls-and-cows.elixir @@ -0,0 +1,42 @@ +defmodule Bulls_and_cows do + def play(size \\ 4) do + secret = Enum.take_random(1..9, size) |> Enum.map(&to_string/1) + play(size, secret) + end + + defp play(size, secret) do + guess = input(size) + if guess == secret do + IO.puts "You win!" + else + {bulls, cows} = count(guess, secret) + IO.puts " Bulls: #{bulls}; Cows: #{cows}" + play(size, secret) + end + end + + defp input(size) do + guess = IO.gets("Enter your #{size}-digit guess: ") |> String.strip + cond do + guess == "" -> + IO.puts "Give up" + exit(:normal) + String.length(guess)==size and String.match?(guess, ~r/^[1-9]+$/) -> + String.codepoints(guess) + true -> input(size) + end + end + + defp count(guess, secret) do + Enum.zip(guess, secret) |> + Enum.reduce({0,0}, fn {g,s},{bulls,cows} -> + cond do + g == s -> {bulls + 1, cows} + g in secret -> {bulls, cows + 1} + true -> {bulls, cows} + end + end) + end +end + +Bulls_and_cows.play diff --git a/Task/Bulls-and-cows/Maple/bulls-and-cows.maple b/Task/Bulls-and-cows/Maple/bulls-and-cows.maple new file mode 100644 index 0000000000..03534db514 --- /dev/null +++ b/Task/Bulls-and-cows/Maple/bulls-and-cows.maple @@ -0,0 +1,55 @@ +BC := proc(n) #where n is the number of turns the user wishes to play before they quit + local target, win, numGuesses, guess, bulls, cows, i, err; + target := [0, 0, 0, 0]: + randomize(); #This is a command that makes sure that the numbers are truly randomized each time, otherwise your first time will always give the same result. + while member(0, target) or numelems({op(target)}) < 4 do #loop continues to generate random numbers until you get one with no repeating digits or 0s + target := [seq(parse(i), i in convert(rand(1234..9876)(), string))]: #a list of random numbers + end do: + + win := false: + numGuesses := 0: + while win = false and numGuesses < n do #loop allows the user to play until they win or until a set amount of turns have passed + err := true; + while err do #loop asks for values until user enters a valid number + printf("Please enter a 4 digit integer with no repeating digits\n"); + try#catches any errors in user input + guess := [seq(parse(i), i in readline())]; + if hastype(guess, 'Not(numeric)', 'exclude_container') then + printf("Postive integers only! Please guess again.\n\n"); + elif numelems(guess) <> 4 then + printf("4 digit numbers only! Please guess again.\n\n"); + elif numelems({op(guess)}) < 4 then + printf("No repeating digits! Please guess again.\n\n"); + elif member(0, guess) then + printf("No 0s! Please guess again.\n\n"); + else + err := false; + end if; + catch: + printf("Invalid input. Please guess again.\n\n"); + end try; + end do: + numGuesses := numGuesses + 1; + printf("Guess %a: %a\n", numGuesses, guess); + bulls := 0; + cows := 0; + for i to 4 do #loop checks for bulls and cows in the user's guess + if target[i] = guess[i] then + bulls := bulls + 1; + elif member(target[i], guess) then + cows := cows + 1; + end if; + end do; + if bulls = 4 then + win := true; + printf("The number was %a.\n", target); + printf(StringTools[FormatMessage]("You won with %1 %{1|guesses|guess|guesses}.", numGuesses)); + else + printf(StringTools[FormatMessage]("%1 %{1|Cows|Cow|Cows}, %2 %{2|Bulls|Bull|Bulls}.\n\n", cows, bulls)); + end if; + end do: + if win = false and numGuesses >= n then + printf("You lost! The number was %a.\n", target); + end if; + return NULL; +end proc: diff --git a/Task/Bulls-and-cows/PowerShell/bulls-and-cows.psh b/Task/Bulls-and-cows/PowerShell/bulls-and-cows.psh new file mode 100644 index 0000000000..a517bbe89c --- /dev/null +++ b/Task/Bulls-and-cows/PowerShell/bulls-and-cows.psh @@ -0,0 +1,47 @@ +[int]$guesses = $bulls = $cows = 0 +[string]$guess = "none" +[string]$digits = "" + +while ($digits.Length -lt 4) +{ + $character = [char](49..57 | Get-Random) + + if ($digits.IndexOf($character) -eq -1) {$digits += $character} +} + +Write-Host "`nGuess four digits (1-9) using no digit twice.`n" -ForegroundColor Cyan + +while ($bulls -lt 4) +{ + do + { + $prompt = "Guesses={0:0#}, Last='{1,4}', Bulls={2}, Cows={3}; Enter your guess" -f $guesses, $guess, $bulls, $cows + $guess = Read-Host $prompt + + if ($guess.Length -ne 4) {Write-Host "`nMust be a four-digit number`n" -ForegroundColor Red} + if ($guess -notmatch "[1-9][1-9][1-9][1-9]") {Write-Host "`nMust be numbers 1-9`n" -ForegroundColor Red} + } + until ($guess.Length -eq 4) + + $guesses += 1 + $bulls = $cows = 0 + + for ($i = 0; $i -lt 4; $i++) + { + $character = $digits.Substring($i,1) + + if ($guess.Substring($i,1) -eq $character) + { + $bulls += 1 + } + else + { + if ($guess.IndexOf($character) -ge 0) + { + $cows += 1 + } + } + } +} + +Write-Host "`nYou won after $($guesses - 1) guesses." -ForegroundColor Cyan diff --git a/Task/Bulls-and-cows/ZX-Spectrum-Basic/bulls-and-cows.zx b/Task/Bulls-and-cows/ZX-Spectrum-Basic/bulls-and-cows.zx new file mode 100644 index 0000000000..a434dbf6f4 --- /dev/null +++ b/Task/Bulls-and-cows/ZX-Spectrum-Basic/bulls-and-cows.zx @@ -0,0 +1,19 @@ +10 DIM n(10): LET c$="" +20 FOR i=1 TO 4 +30 LET d=INT (RND*9+1) +40 IF n(d)=1 THEN GO TO 30 +50 LET n(d)=1 +60 LET c$=c$+STR$ d +70 NEXT i +80 LET guesses=0 +90 INPUT "Guess a 4-digit number (1 to 9) with no duplicate digits: ";guess +100 IF guess=0 THEN STOP +110 IF guess>9999 OR guess<1000 THEN PRINT "Only 4 numeric digits, please": GO TO 90 +120 LET bulls=0: LET cows=0: LET guesses=guesses+1: LET g$=STR$ guess +130 FOR i=1 TO 4 +140 IF g$(i)=c$(i) THEN LET bulls=bulls+1: GO TO 160 +150 IF n(VAL g$(i))=1 THEN LET cows=cows+1 +160 NEXT i +170 PRINT bulls;" bulls, ";cows;" cows" +180 IF c$=g$ THEN PRINT "You won after ";guesses;" guesses!": GO TO 10 +190 GO TO 90 diff --git a/Task/CRC-32/00DESCRIPTION b/Task/CRC-32/00DESCRIPTION index 48d0bdd467..be0dcc5329 100644 --- a/Task/CRC-32/00DESCRIPTION +++ b/Task/CRC-32/00DESCRIPTION @@ -2,9 +2,16 @@ {{omit from|Lilypond}} {{omit from|TPP}} -Demonstrate a method of deriving the [[wp:Cyclic_Redundancy_Check|Cyclic Redundancy Check]] from within the language.
-The result should be in accordance with ISO 3309, [http://www.itu.int/rec/T-REC-V.42-200203-I/en ITU-T V.42], [http://tools.ietf.org/html/rfc1952 Gzip] and [http://www.w3.org/TR/2003/REC-PNG-20031110/ PNG].
-Algorithms are described on [[wp:Computation of CRC|Computation of CRC]] in Wikipedia. + +;Task: +Demonstrate a method of deriving the [[wp:Computation of cyclic redundancy checks|Cyclic Redundancy Check]] from within the language. + + +The result should be in accordance with ISO 3309, [http://www.itu.int/rec/T-REC-V.42-200203-I/en ITU-T V.42], [http://tools.ietf.org/html/rfc1952 Gzip] and [http://www.w3.org/TR/2003/REC-PNG-20031110/ PNG]. + +Algorithms are described on [[wp:Cyclic redundancy check|Computation of CRC]] in Wikipedia. This variant of CRC-32 uses LSB-first order, sets the initial CRC to FFFFFFFF16, and complements the final CRC. -For the purpose of this task, generate a CRC-32 checksum for the ASCII encoded string "The quick brown fox jumps over the lazy dog" (without quotes). +For the purpose of this task, generate a CRC-32 checksum for the ASCII encoded string: +:: The quick brown fox jumps over the lazy dog +

diff --git a/Task/CRC-32/AutoHotkey/crc-32-1.ahk b/Task/CRC-32/AutoHotkey/crc-32-1.ahk new file mode 100644 index 0000000000..453fa591d1 --- /dev/null +++ b/Task/CRC-32/AutoHotkey/crc-32-1.ahk @@ -0,0 +1,9 @@ +CRC32(str, enc = "UTF-8") +{ + l := (enc = "CP1200" || enc = "UTF-16") ? 2 : 1, s := (StrPut(str, enc) - 1) * l + VarSetCapacity(b, s, 0) && StrPut(str, &b, floor(s / l), enc) + CRC32 := DllCall("ntdll.dll\RtlComputeCrc32", "UInt", 0, "Ptr", &b, "UInt", s) + return Format("{:#x}", CRC32) +} + +MsgBox % CRC32("The quick brown fox jumps over the lazy dog") diff --git a/Task/CRC-32/AutoHotkey/crc-32-2.ahk b/Task/CRC-32/AutoHotkey/crc-32-2.ahk new file mode 100644 index 0000000000..d126f020f0 --- /dev/null +++ b/Task/CRC-32/AutoHotkey/crc-32-2.ahk @@ -0,0 +1,16 @@ +CRC32(str) +{ + static table := [] + loop 256 { + crc := A_Index - 1 + loop 8 + crc := (crc & 1) ? (crc >> 1) ^ 0xEDB88320 : (crc >> 1) + table[A_Index - 1] := crc + } + crc := ~0 + loop, parse, str + crc := table[(crc & 0xFF) ^ Asc(A_LoopField)] ^ (crc >> 8) + return Format("{:#x}", ~crc) +} + +MsgBox % CRC32("The quick brown fox jumps over the lazy dog") diff --git a/Task/CRC-32/AutoHotkey/crc-32.ahk b/Task/CRC-32/AutoHotkey/crc-32.ahk deleted file mode 100644 index 41bcf95d6a..0000000000 --- a/Task/CRC-32/AutoHotkey/crc-32.ahk +++ /dev/null @@ -1,19 +0,0 @@ -str := "The quick brown fox jumps over the lazy dog" -MsgBox, % "String:`n" (str) "`n`nCRC32:`n" CRC32(str) - - - -; CRC32 ============================================================================= -CRC32(string, encoding = "UTF-8") -{ - chrlength := (encoding = "CP1200" || encoding = "UTF-16") ? 2 : 1 - length := (StrPut(string, encoding) - 1) * chrlength - VarSetCapacity(data, length, 0) - StrPut(string, &data, floor(length / chrlength), encoding) - SetFormat, Integer, % SubStr((A_FI := A_FormatInteger) "H", 0) - CRC32 := DllCall("NTDLL\RtlComputeCrc32", "UInt", 0, "UInt", &data, "UInt", length, "UInt") - CRC := SubStr(CRC32 | 0x1000000000, -7) - DllCall("User32.dll\CharLower", "Str", CRC) - SetFormat, Integer, %A_FI% - return CRC -} diff --git a/Task/CRC-32/COBOL/crc-32.cobol b/Task/CRC-32/COBOL/crc-32.cobol new file mode 100644 index 0000000000..0b843fd7ad --- /dev/null +++ b/Task/CRC-32/COBOL/crc-32.cobol @@ -0,0 +1,37 @@ + *> tectonics: cobc -xj crc32-zlib.cob -lz + identification division. + program-id. rosetta-crc32. + + environment division. + configuration section. + repository. + function all intrinsic. + + data division. + working-storage section. + 01 crc32-initial usage binary-c-long. + 01 crc32-result usage binary-c-long unsigned. + 01 crc32-input. + 05 value "The quick brown fox jumps over the lazy dog". + 01 crc32-hex usage pointer. + + procedure division. + crc32-main. + + *> libz crc32 + call "crc32" using + by value crc32-initial + by reference crc32-input + by value length(crc32-input) + returning crc32-result + on exception + display "error: no crc32 zlib linkage" upon syserr + end-call + call "printf" using "checksum: %lx" & x"0a" by value crc32-result + + *> GnuCOBOL pointers are displayed in hex by default + set crc32-hex up by crc32-result + display 'crc32 of "' crc32-input '" is ' crc32-hex + + goback. + end program rosetta-crc32. diff --git a/Task/CRC-32/Forth/crc-32.fth b/Task/CRC-32/Forth/crc-32.fth new file mode 100644 index 0000000000..a7caecd8db --- /dev/null +++ b/Task/CRC-32/Forth/crc-32.fth @@ -0,0 +1,11 @@ +: crc/ ( n -- n ) 8 0 do dup 1 rshift swap 1 and if $edb88320 xor then loop ; + +: crcfill 256 0 do i crc/ , loop ; + +create crctbl crcfill + +: crc+ ( crc n -- crc' ) over xor $ff and cells crctbl + @ swap 8 rshift xor ; + +: crcbuf ( crc str len -- crc ) bounds ?do i c@ crc+ loop ; + +$ffffffff s" The quick brown fox jumps over the lazy dog" crcbuf $ffffffff xor hex. bye \ $414FA339 diff --git a/Task/CRC-32/Fortran/crc-32.f b/Task/CRC-32/Fortran/crc-32.f new file mode 100644 index 0000000000..cd5985c579 --- /dev/null +++ b/Task/CRC-32/Fortran/crc-32.f @@ -0,0 +1,45 @@ +module crc32_m + use iso_fortran_env + implicit none + integer(int32) :: crc_table(0:255) +contains + subroutine update_crc(a, crc) + integer :: n, i + character(*) :: a + integer(int32) :: crc + + crc = not(crc) + n = len(a) + do i = 1, n + crc = ieor(shiftr(crc, 8), crc_table(iand(ieor(crc, iachar(a(i:i))), 255))) + end do + crc = not(crc) + end subroutine + + subroutine init_table + integer :: i, j + integer(int32) :: k + + do i = 0, 255 + k = i + do j = 1, 8 + if (btest(k, 0)) then + k = ieor(shiftr(k, 1), -306674912) + else + k = shiftr(k, 1) + end if + end do + crc_table(i) = k + end do + end subroutine +end module + +program crc32 + use crc32_m + implicit none + integer(int32) :: crc = 0 + character(*), parameter :: s = "The quick brown fox jumps over the lazy dog" + call init_table + call update_crc(s, crc) + print "(Z8)", crc +end program diff --git a/Task/CRC-32/PARI-GP/crc-32.pari b/Task/CRC-32/PARI-GP/crc-32.pari new file mode 100644 index 0000000000..56f9f98229 --- /dev/null +++ b/Task/CRC-32/PARI-GP/crc-32.pari @@ -0,0 +1,3 @@ +install("crc32", "lLsL", "crc32", "libz.so"); +s = "The quick brown fox jumps over the lazy dog"; +printf("%0x\n", crc32(0, s, #s)) diff --git a/Task/CRC-32/Perl-6/crc-32-1.pl6 b/Task/CRC-32/Perl-6/crc-32-1.pl6 index 1bfc1e41fe..57b92b6927 100644 --- a/Task/CRC-32/Perl-6/crc-32-1.pl6 +++ b/Task/CRC-32/Perl-6/crc-32-1.pl6 @@ -1,6 +1,6 @@ use NativeCall; -sub crc32(int32 $crc, Str $buf, int32 $len --> int32) is native('/usr/lib/libz.dylib') { * } +sub crc32(int32 $crc, Buf $buf, int32 $len --> int32) is native('z') { * } -my $buf = 'The quick brown fox jumps over the lazy dog'; -say crc32(0, $buf, $buf.chars).fmt('%08x'); +my $buf = 'The quick brown fox jumps over the lazy dog'.encode; +say crc32(0, $buf, $buf.bytes).fmt('%08x'); diff --git a/Task/CRC-32/Perl-6/crc-32-2.pl6 b/Task/CRC-32/Perl-6/crc-32-2.pl6 index 745129e306..01c6ca7bb8 100644 --- a/Task/CRC-32/Perl-6/crc-32-2.pl6 +++ b/Task/CRC-32/Perl-6/crc-32-2.pl6 @@ -8,7 +8,7 @@ sub crc( :@bitorder = 0..7, # default: eat bytes LSB-first :@crcorder = 0..$n-1, # default: MSB of checksum is coefficient of x⁰ ) { - my @bit = ($buf.list X+& (1 X+< @bitorder))».so».Int, 0 xx $n; + my @bit = flat ($buf.list X+& (1 X+< @bitorder).list)».so».Int, 0 xx $n; @bit[0 .. $n-1] «+^=» @init; @bit[$_ ..$_+$n] «+^=» @poly if @bit[$_] for 0..@bit.end-$n; diff --git a/Task/CRC-32/PureBasic/crc-32.purebasic b/Task/CRC-32/PureBasic/crc-32.purebasic new file mode 100644 index 0000000000..924d6b8cf0 --- /dev/null +++ b/Task/CRC-32/PureBasic/crc-32.purebasic @@ -0,0 +1,10 @@ +a$="The quick brown fox jumps over the lazy dog" + +UseCRC32Fingerprint() : b$=StringFingerprint(a$, #PB_Cipher_CRC32) + +OpenConsole() +PrintN("CRC32 Cecksum [hex] = "+UCase(b$)) +PrintN("CRC32 Cecksum [dec] = "+Val("$"+b$)) +Input() + +End diff --git a/Task/CRC-32/Python/crc-32-1.py b/Task/CRC-32/Python/crc-32-1.py index 72b803c105..5cc64560d7 100644 --- a/Task/CRC-32/Python/crc-32-1.py +++ b/Task/CRC-32/Python/crc-32-1.py @@ -1,3 +1,8 @@ +>>> s = 'The quick brown fox jumps over the lazy dog' >>> import zlib ->>> hex(zlib.crc32('The quick brown fox jumps over the lazy dog')) +>>> hex(zlib.crc32(s)) +'0x414fa339' + +>>> import binascii +>>> hex(binascii.crc32(s)) '0x414fa339' diff --git a/Task/CRC-32/Python/crc-32-2.py b/Task/CRC-32/Python/crc-32-2.py index 2d62317765..4ad7274d56 100644 --- a/Task/CRC-32/Python/crc-32-2.py +++ b/Task/CRC-32/Python/crc-32-2.py @@ -1,3 +1,19 @@ ->>> import binascii ->>> hex(binascii.crc32('The quick brown fox jumps over the lazy dog')) -'0x414fa339' +def create_table(): + a = [] + for i in range(256): + k = i + for j in range(8): + if k & 1: + k ^= 0x1db710640 + k >>= 1 + a.append(k) + return a + +def crc_update(buf, crc): + crc ^= 0xffffffff + for k in buf: + crc = (crc >> 8) ^ crc_table[(crc & 0xff) ^ k] + return crc ^ 0xffffffff + +crc_table = create_table() +print(hex(crc_update(b"The quick brown fox jumps over the lazy dog", 0))) diff --git a/Task/CRC-32/REXX/crc-32.rexx b/Task/CRC-32/REXX/crc-32.rexx index 5cdc2c3122..dd4a7168a5 100644 --- a/Task/CRC-32/REXX/crc-32.rexx +++ b/Task/CRC-32/REXX/crc-32.rexx @@ -1,37 +1,34 @@ -/*REXX program computes the CRC─32 (32 bit Cyclic Redundancy Check) checksum*/ -/*─────────────────for a given string [as described in ISO 3309, ITU─T V.42].*/ +/*REXX program computes the CRC─32 (32 bit Cyclic Redundancy Check) checksum for a */ +/*─────────────────────────────────given string [as described in ISO 3309, ITU─T V.42].*/ +call show 'The quick brown fox jumps over the lazy dog' /*the 1st string.*/ +call show 'Generate CRC32 Checksum For Byte Array Example' /* " 2nd " */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +CRC_32: procedure; parse arg !,$; c='edb88320'x /*2nd arg used for repeated invocations*/ + f='ffFFffFF'x /* [↓] build an 8─bit indexed table,*/ + do i=0 for 256; z=d2c(i) /* one byte at a time.*/ + r=right(z, 4, '0'x) /*insure the "R" is thirty-two bits.*/ + /* [↓] handle each rightmost byte bit.*/ + do j=0 for 8; rb=x2b(c2x(r)) /*handle each bit of rightmost 8 bits. */ + r=x2c(b2x(0 || left(rb, 31))) /*shift it right (an unsigned) 1 bit.*/ + if right(rb,1) then r=bitxor(r,c) /*this is a bin bit for XOR grunt─work.*/ + end /*j*/ + !.z=r /*assign to an eight─bit index table. */ + end /*i*/ -call show 'The quick brown fox jumps over the lazy dog' /*1st string.*/ -call show 'Generate CRC32 Checksum For Byte Array Example' /*2nd " */ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -CRC_32: procedure; parse arg !,$ /*2nd arg: it has repeated─invocations.*/ - /* [↓] build an 8─bit indexed table,*/ - do i=0 for 256; z=d2c(i) /* one byte at a time.*/ - r=right(z, 4, '0'x) /*insure the "R" is thirty-two bits.*/ - - do j=0 for 8 /*handle each bit of rightmost 8 bits. */ - rb=x2b(c2x(r)) /*convert character ──► hex ──► binary.*/ - _=right(rb,1) /*remember the right─most bit for IF. */ - r=x2c(b2x(0 || left(rb, 31))) /*shift it right (an unsigned) 1 bit.*/ - if _\==0 then r=bitxor(r, 'edb88320'x) /*this is bit XOR grunt─work.*/ - end /*j*/ - !.z=r /*assign to an eight─bit index table. */ - end /*i*/ - -$=bitxor(word($ '0000000'x,1),'ffFFffFF'x) /*use the user's CRC or a default.*/ - do k=1 for length(!) /*start crunching the input data. */ - ?=bitxor(right($, 1), substr(!, k, 1)) - $=bitxor('0'x || left($, 3), !.?) - end /*k*/ -return $ /*return with da money to the invoker. */ -/*────────────────────────────────────────────────────────────────────────────*/ -show: procedure; parse arg Xstring; numeric digits 12; say; say -checksum=CRC_32(Xstring) /*invoke CRC_32 to create a CRC.*/ -checksum=bitxor(checksum,'ffFFffFF'x) /*final convolution for checksum.*/ -say center(' input string [length of' length(Xstring) "bytes] ", 79, '═') -say Xstring /*show the string on its own line*/ -say /*↓↓↓↓↓↓↓↓↓↓↓↓ is fifteen blanks*/ -say 'hex CRC-32 checksum =' c2x(checksum) left('', 15), - "dec CRC-32 checksum =" c2d(checksum) /*show the CRC-32 in hex and dec.*/ -return + $=bitxor(word($ '0000000'x, 1), f) /*utilize the user's CRC or a default. */ + do k=1 for length(!) /*start number crunching the input data*/ + ?=bitxor(right($,1), substr(!,k,1)) + $=bitxor('0'x || left($, 3), !.?) + end /*k*/ + return $ /*return with cyclic redundancy check. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +show: procedure; parse arg Xstring; numeric digits 12; say; say + checksum=CRC_32(Xstring) /*invoke CRC_32 to create a CRC.*/ + checksum=bitxor(checksum, 'ffFFffFF'x) /*final convolution for checksum.*/ + say center(' input string [length of' length(Xstring) "bytes] ", 79, '═') + say Xstring /*show the string on its own line*/ + say /*↓↓↓↓↓↓↓↓↓↓↓↓ is fifteen blanks*/ + say "hex CRC-32 checksum =" c2x(checksum) left('', 15), + "dec CRC-32 checksum =" c2d(checksum) /*show the CRC-32 in hex and dec.*/ + return diff --git a/Task/CRC-32/Rust/crc-32.rust b/Task/CRC-32/Rust/crc-32.rust new file mode 100644 index 0000000000..cc99b24d23 --- /dev/null +++ b/Task/CRC-32/Rust/crc-32.rust @@ -0,0 +1,26 @@ +fn crc32_compute_table() -> [u32; 256] { + let mut crc32_table = [0; 256]; + + for n in 0..256 { + crc32_table[n as usize] = (0..8).fold(n as u32, |acc, _| { + match acc & 1 { + 1 => 0xedb88320 ^ (acc >> 1), + _ => acc >> 1, + } + }); + } + + crc32_table +} + +fn crc32(buf: &str) -> u32 { + let crc_table = crc32_compute_table(); + + !buf.bytes().fold(!0, |acc, octet| { + (acc >> 8) ^ crc_table[((acc & 0xff) ^ octet as u32) as usize] + }) +} + +fn main() { + println!("{:x}", crc32("The quick brown fox jumps over the lazy dog")); +} diff --git a/Task/CSV-data-manipulation/00DESCRIPTION b/Task/CSV-data-manipulation/00DESCRIPTION index bd003b6bee..79181be65d 100644 --- a/Task/CSV-data-manipulation/00DESCRIPTION +++ b/Task/CSV-data-manipulation/00DESCRIPTION @@ -1,10 +1,14 @@ -[[wp:Comma-separated values|CSV spreadsheet files]] are suitable for -storing tabular data in a relatively portable way. The CSV format is -flexible but somewhat ill-defined. For present purposes, authors may -assume that the data fields contain no commas, backslashes, or -quotation marks. +[[wp:Comma-separated values|CSV spreadsheet files]] are suitable for storing tabular data in a relatively portable way. -The task here is to read a CSV file, change some values and save the changes back to a file. For this task we will use the following CSV file: +The CSV format is flexible but somewhat ill-defined. + +For present purposes, authors may assume that the data fields contain no commas, backslashes, or quotation marks. + + +;Task: +Read a CSV file, change some values and save the changes back to a file. + +For this task we will use the following CSV file: C1,C2,C3,C4,C5 1,5,9,13,17 @@ -17,3 +21,4 @@ The task here is to read a CSV file, change some values and save the changes bac
  • Show how to add a column, headed 'SUM', of the sums of the rows.
  • If possible, illustrate the use of built-in or standard functions, methods, or libraries, that handle generic CSV files. +

    diff --git a/Task/CSV-data-manipulation/C/csv-data-manipulation.c b/Task/CSV-data-manipulation/C/csv-data-manipulation.c new file mode 100644 index 0000000000..060dd21931 --- /dev/null +++ b/Task/CSV-data-manipulation/C/csv-data-manipulation.c @@ -0,0 +1,275 @@ +#define TITLE "CSV data manipulation" +#define URL "http://rosettacode.org/wiki/CSV_data_manipulation" + +#define _GNU_SOURCE +#define bool int +#include +#include /* malloc...*/ +#include /* strtok...*/ +#include +#include + + +/** + * How to read a CSV file ? + */ + + +typedef struct { + char * delim; + unsigned int rows; + unsigned int cols; + char ** table; +} CSV; + + +/** + * Utility function to trim whitespaces from left & right of a string + */ +int trim(char ** str) { + int trimmed; + int n; + int len; + + len = strlen(*str); + n = len - 1; + /* from right */ + while((n>=0) && isspace((*str)[n])) { + (*str)[n] = '\0'; + trimmed += 1; + n--; + } + + /* from left */ + n = 0; + while((n < len) && (isspace((*str)[0]))) { + (*str)[0] = '\0'; + *str = (*str)+1; + trimmed += 1; + n++; + } + return trimmed; +} + + +/** + * De-allocate csv structure + */ +int csv_destroy(CSV * csv) { + if (csv == NULL) { return 0; } + if (csv->table != NULL) { free(csv->table); } + if (csv->delim != NULL) { free(csv->delim); } + free(csv); + return 0; +} + + +/** + * Allocate memory for a CSV structure + */ +CSV * csv_create(unsigned int cols, unsigned int rows) { + CSV * csv; + + csv = malloc(sizeof(CSV)); + csv->rows = rows; + csv->cols = cols; + csv->delim = strdup(","); + + csv->table = malloc(sizeof(char *) * cols * rows); + if (csv->table == NULL) { goto error; } + + memset(csv->table, 0, sizeof(char *) * cols * rows); + + return csv; + +error: + csv_destroy(csv); + return NULL; +} + + +/** + * Get value in CSV table at COL, ROW + */ +char * csv_get(CSV * csv, unsigned int col, unsigned int row) { + unsigned int idx; + idx = col + (row * csv->cols); + return csv->table[idx]; +} + + +/** + * Set value in CSV table at COL, ROW + */ +int csv_set(CSV * csv, unsigned int col, unsigned int row, char * value) { + unsigned int idx; + idx = col + (row * csv->cols); + csv->table[idx] = value; + return 0; +} + +void csv_display(CSV * csv) { + int row, col; + char * content; + if ((csv->rows == 0) || (csv->cols==0)) { + printf("[Empty table]\n"); + return ; + } + + printf("\n[Table cols=%d rows=%d]\n", csv->cols, csv->rows); + for (row=0; rowrows; row++) { + printf("[|"); + for (col=0; colcols; col++) { + content = csv_get(csv, col, row); + printf("%s\t|", content); + } + printf("]\n"); + } + printf("\n"); +} + +/** + * Resize CSV table + */ +int csv_resize(CSV * old_csv, unsigned int new_cols, unsigned int new_rows) { + unsigned int cur_col, + cur_row, + max_cols, + max_rows; + CSV * new_csv; + char * content; + bool in_old, in_new; + + /* Build a new (fake) csv */ + new_csv = csv_create(new_cols, new_rows); + if (new_csv == NULL) { goto error; } + + new_csv->rows = new_rows; + new_csv->cols = new_cols; + + + max_cols = (new_cols > old_csv->cols)? new_cols : old_csv->cols; + max_rows = (new_rows > old_csv->rows)? new_rows : old_csv->rows; + + for (cur_col=0; cur_colcols) && (cur_row < old_csv->rows); + in_new = (cur_col < new_csv->cols) && (cur_row < new_csv->rows); + + if (in_old && in_new) { + /* re-link data */ + content = csv_get(old_csv, cur_col, cur_row); + csv_set(new_csv, cur_col, cur_row, content); + } else if (in_old) { + /* destroy data */ + content = csv_get(old_csv, cur_col, cur_row); + free(content); + } else { /* skip */ } + } + } + /* on rows */ + free(old_csv->table); + old_csv->rows = new_rows; + old_csv->cols = new_cols; + old_csv->table = new_csv->table; + new_csv->table = NULL; + csv_destroy(new_csv); + + return 0; + +error: + printf("Unable to resize CSV table: error %d - %s\n", errno, strerror(errno)); + return -1; +} + + +/** + * Open CSV file and load its content into provided CSV structure + **/ +int csv_open(CSV * csv, char * filename) { + FILE * fp; + unsigned int m_rows; + unsigned int m_cols, cols; + char line[2048]; + char * lineptr; + char * token; + + + fp = fopen(filename, "r"); + if (fp == NULL) { goto error; } + + m_rows = 0; + m_cols = 0; + while(fgets(line, sizeof(line), fp) != NULL) { + m_rows += 1; + cols = 0; + lineptr = line; + while ((token = strtok(lineptr, csv->delim)) != NULL) { + lineptr = NULL; + trim(&token); + cols += 1; + if (cols > m_cols) { m_cols = cols; } + csv_resize(csv, m_cols, m_rows); + csv_set(csv, cols-1, m_rows-1, strdup(token)); + } + } + + fclose(fp); + csv->rows = m_rows; + csv->cols = m_cols; + return 0; + +error: + fclose(fp); + printf("Unable to open %s for reading.", filename); + return -1; +} + + +/** + * Open CSV file and save CSV structure content into it + **/ +int csv_save(CSV * csv, char * filename) { + FILE * fp; + int row, col; + char * content; + + fp = fopen(filename, "w"); + for (row=0; rowrows; row++) { + for (col=0; colcols; col++) { + content = csv_get(csv, col, row); + fprintf(fp, "%s%s", content, + ((col == csv->cols-1) ? "" : csv->delim) ); + } + fprintf(fp, "\n"); + } + + fclose(fp); + return 0; +} + + +/** + * Test + */ +int main(int argc, char ** argv) { + CSV * csv; + + printf("%s\n%s\n\n",TITLE, URL); + + csv = csv_create(0, 0); + csv_open(csv, "fixtures/csv-data-manipulation.csv"); + csv_display(csv); + + csv_set(csv, 0, 0, "Column0"); + csv_set(csv, 1, 1, "100"); + csv_set(csv, 2, 2, "200"); + csv_set(csv, 3, 3, "300"); + csv_set(csv, 4, 4, "400"); + csv_display(csv); + + csv_save(csv, "tmp/csv-data-manipulation.result.csv"); + csv_destroy(csv); + + return 0; +} diff --git a/Task/CSV-data-manipulation/Common-Lisp/csv-data-manipulation.lisp b/Task/CSV-data-manipulation/Common-Lisp/csv-data-manipulation.lisp index e654cbc197..8c1ff4f92b 100644 --- a/Task/CSV-data-manipulation/Common-Lisp/csv-data-manipulation.lisp +++ b/Task/CSV-data-manipulation/Common-Lisp/csv-data-manipulation.lisp @@ -1,35 +1,39 @@ -(defun csv-to-nested-list (filename seperator) - "Reads the csv to a nested lisp list, where each sublist represents a line. -Each line is read in as a string, the commas are substituted by spaces and -parantheses are added to the beginning and the end. Then the string can be interpreted by the -reader as an actual lisp list. A nested lisp containing all sub-lists (lines) is returned. -First line is assumed to be a comment (as no comment syntax is specified)." - (let ((list nil)) - (with-open-file (input filename) - (setf list - (loop for line = (read-line input nil) - while line collect (read-from-string - (substitute #\Tab #\, (format nil "(~a)~%" line))))) - ;; throw away first line, which is assumed to be a comment - (cdr list)))) +(defun csvfile-to-nested-list (filename delim-char) + "Reads the csv to a nested list, where each sublist represents a line." + (with-open-file (input filename) + (loop :for line := (read-line input nil) :while line + :collect (read-from-string + (substitute #\SPACE delim-char + (format nil "(~a)~%" line)))))) -(defun calc-sums (nested-list) - "Return a list of sums of each sub-list in a nested list." - (loop for sublist in nested-list collect (apply #'+ sublist))) +(defun sublist-sum-list (nested-list) + "Return a list with the sum of each list of numbers in a nested list." + (mapcar (lambda (l) (if (every #'numberp l) + (reduce #'+ l) nil)) + nested-list)) -(defun list-to-csv (nested-list) +(defun append-each-sublist (nested-list1 nested-list2) + "Horizontally append the sublists in two nested lists. Used to add columns." + (mapcar #'append nested-list1 nested-list2)) + +(defun nested-list-to-csv (nested-list delim-string) "Converts the nested list back into a csv-formatted string." - (substitute #\, #\ - (substitute #\newline #\) - (remove #\((string-trim ")(" (format nil "~A" nested-list)))))) -;; main program -;; prints the results as lisp lists and as csv -(let ((nested-list (csv-to-nested-list "example_comma_csv.txt" #\,)) - (sum-list nil) - (comment "#C1,C2,C3,C4,C5,SUM")) - (setf sum-list (loop - for list in nested-list - for sum in (calc-sums nested-list) - collect (append list (list sum)))) - (format t "~A~%~%" sum-list) ;; print nested list in lisp representation - (format t "~A~%~A~%" comment (list-to-csv sum-list))) ;; print it again as csv + (format nil (concatenate 'string "~{~{~2,'0d" delim-string "~}~%~}") + nested-list)) + +(defun main () + (let* ((csvfile-path #p"projekte/common-lisp/example_comma_csv.txt") + (result-path #p"results.txt") + (data-list (csvfile-to-nested-list csvfile-path #\,)) + (list-of-sums (sublist-sum-list data-list)) + (result-header "C1,C2,C3,C4,C5,SUM")) + + (setf data-list ; add list of sums as additional column + (rest ; remove old header + (append-each-sublist data-list + (mapcar #'list list-of-sums)))) + ;; write to output-file + (with-open-file (output result-path :direction :output :if-exists :supersede) + (format output "~a~%~a" + result-header (nested-list-to-csv data-list ","))))) +(main) diff --git a/Task/CSV-data-manipulation/Elixir/csv-data-manipulation.elixir b/Task/CSV-data-manipulation/Elixir/csv-data-manipulation.elixir new file mode 100644 index 0000000000..9f24acda11 --- /dev/null +++ b/Task/CSV-data-manipulation/Elixir/csv-data-manipulation.elixir @@ -0,0 +1,51 @@ +defmodule Csv do + defstruct header: "", data: "", separator: "," + + def from_file(path) do + [header | data] = path + |> File.stream! + |> Enum.to_list + |> Enum.map(&String.trim/1) + + %Csv{ header: header, data: data } + end + + def sums_of_rows(csv) do + Enum.map(csv.data, fn (row) -> sum_of_row(row, csv.separator) end) + end + + def sum_of_row(row, separator) do + row + |> String.split(separator) + |> Enum.map(&String.to_integer/1) + |> Enum.sum + |> to_string + end + + def append_column(csv, column_header, column_data) do + header = append_to_row(csv.header, column_header, csv.separator) + + data = [csv.data, column_data] + |> List.zip + |> Enum.map(fn ({ row, value }) -> + append_to_row(row, value, csv.separator) + end) + + %Csv{ header: header, data: data } + end + + def append_to_row(row, value, separator) do + row <> separator <> value + end + + def to_file(csv, path) do + body = Enum.join([csv.header | csv.data], "\n") + + File.write(path, body) + end +end + +csv = Csv.from_file("in.csv") +csv +|> Csv.append_column("SUM", Csv.sums_of_rows(csv)) +|> Csv.to_file("out.csv") diff --git a/Task/CSV-data-manipulation/Fortran/csv-data-manipulation-1.f b/Task/CSV-data-manipulation/Fortran/csv-data-manipulation-1.f new file mode 100644 index 0000000000..61a339e357 --- /dev/null +++ b/Task/CSV-data-manipulation/Fortran/csv-data-manipulation-1.f @@ -0,0 +1,107 @@ +program rowsum + implicit none + character(:), allocatable :: line, name, a(:) + character(20) :: fmt + double precision, allocatable :: v(:) + integer :: n, nrow, ncol, i + + call get_command_argument(1, length=n) + allocate(character(n) :: name) + call get_command_argument(1, name) + open(unit=10, file=name, action="read", form="formatted", access="stream") + deallocate(name) + + call get_command_argument(2, length=n) + allocate(character(n) :: name) + call get_command_argument(2, name) + open(unit=11, file=name, action="write", form="formatted", access="stream") + deallocate(name) + + nrow = 0 + ncol = 0 + do while (readline(10, line)) + nrow = nrow + 1 + + call split(line, a) + + if (nrow == 1) then + ncol = size(a) + write(11, "(A)", advance="no") line + write(11, "(A)") ",Sum" + allocate(v(ncol + 1)) + write(fmt, "('(',G0,'(G0,:,''',A,'''))')") ncol + 1, "," + else + if (size(a) /= ncol) then + print "(A,' ',G0)", "Invalid number of values on row", nrow + stop + end if + + do i = 1, ncol + read(a(i), *) v(i) + end do + v(ncol + 1) = sum(v(1:ncol)) + write(11, fmt) v + end if + end do + close(10) + close(11) +contains + function readline(unit, line) + use iso_fortran_env + logical :: readline + integer :: unit, ios, n + character(:), allocatable :: line + character(10) :: buffer + + line = "" + readline = .false. + do + read(unit, "(A)", advance="no", size=n, iostat=ios) buffer + if (ios == iostat_end) return + readline = .true. + line = line // buffer(1:n) + if (ios == iostat_eor) return + end do + end function + + subroutine split(line, array, separator) + character(*) line + character(:), allocatable :: array(:) + character, optional :: separator + character :: sep + integer :: n, m, p, i, k + + if (present(separator)) then + sep = separator + else + sep = "," + end if + + n = len(line) + m = 0 + p = 1 + k = 1 + do i = 1, n + if (line(i:i) == sep) then + p = p + 1 + m = max(m, i - k) + k = i + 1 + end if + end do + m = max(m, n - k + 1) + + if (allocated(array)) deallocate(array) + allocate(character(m) :: array(p)) + + p = 1 + k = 1 + do i = 1, n + if (line(i:i) == sep) then + array(p) = line(k:i-1) + p = p + 1 + k = i + 1 + end if + end do + array(p) = line(k:n) + end subroutine +end program diff --git a/Task/CSV-data-manipulation/Fortran/csv-data-manipulation-2.f b/Task/CSV-data-manipulation/Fortran/csv-data-manipulation-2.f new file mode 100644 index 0000000000..ef63969cbc --- /dev/null +++ b/Task/CSV-data-manipulation/Fortran/csv-data-manipulation-2.f @@ -0,0 +1,20 @@ +Copies a file with 5 comma-separated values to a line, appending a column holding their sum. + INTEGER N !Instead of littering the source with "5" + PARAMETER (N = 5) !Provide some provenance. + CHARACTER*6 HEAD(N) !A perfect size? + INTEGER X(N) !Integers suffice. + INTEGER LINPR,IN !I/O unit numbers. + LINPR = 6 !Standard output via this unit number. + IN = 10 !Some unit number for the input file. + OPEN (IN,FILE="CSVtest.csv",STATUS="OLD",ACTION="READ") !For formatted input. + + READ (IN,*) HEAD !The first line has texts as column headings. + WRITE (LINPR,1) (TRIM(HEAD(I)), I = 1,N),"Sum" !Append a "Sum" column. + 1 FORMAT (666(A:",")) !The : sez "stop if no list element awaits". + 2 READ (IN,*,END = 10) X !Read a line's worth of numbers, separated by commas or spaces. + WRITE (LINPR,3) X,SUM(X) !Write, with a total appended. + 3 FORMAT (666(I0:",")) !I0 editing uses only as many columns as are needed. + GO TO 2 !Do it again. + + 10 CLOSE (IN) !All done. + END !That's all. diff --git a/Task/CSV-data-manipulation/Haskell/csv-data-manipulation.hs b/Task/CSV-data-manipulation/Haskell/csv-data-manipulation-1.hs similarity index 100% rename from Task/CSV-data-manipulation/Haskell/csv-data-manipulation.hs rename to Task/CSV-data-manipulation/Haskell/csv-data-manipulation-1.hs diff --git a/Task/CSV-data-manipulation/Haskell/csv-data-manipulation-2.hs b/Task/CSV-data-manipulation/Haskell/csv-data-manipulation-2.hs new file mode 100644 index 0000000000..6e4d7092da --- /dev/null +++ b/Task/CSV-data-manipulation/Haskell/csv-data-manipulation-2.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE FlexibleContexts, + TypeFamilies, + NoMonomorphismRestriction #-} +import Data.List (intercalate) +import Data.List.Split (splitOn) +import Lens.Micro + +(<$$>) :: (Functor f1, Functor f2) => + (a -> b) -> f1 (f2 a) -> f1 (f2 b) +(<$$>) = fmap . fmap + +------------------------------------------------------------ +-- reading and writing + +newtype CSV = CSV { values :: [[String]] } + +readCSV :: String -> CSV +readCSV = CSV . (splitOn "," <$$> lines) + +instance Show CSV where + show = unlines . map (intercalate ",") . values + +------------------------------------------------------------ +-- construction and combination + +mkColumn, mkRow :: [String] -> CSV +(<||>), (<==>) :: CSV -> CSV -> CSV + +mkColumn lst = CSV $ sequence [lst] +mkRow lst = CSV [lst] + +CSV t1 <||> CSV t2 = CSV $ zipWith (++) t1 t2 +CSV t1 <==> CSV t2 = CSV $ t1 ++ t2 + +------------------------------------------------------------ +-- access and modification via lenses + +table = lens values (\csv t -> csv {values = t}) +row i = table . ix i . traverse +col i = table . traverse . ix i +item i j = table . ix i . ix j + +------------------------------------------------------------ + +sample = readCSV "C1, C2, C3, C4, C5\n\ + \1, 5, 9, 13, 17\n\ + \2, 6, 10, 14, 18\n\ + \3, 7, 11, 15, 19\n\ + \4, 8, 12, 16, 20" diff --git a/Task/CSV-data-manipulation/Haskell/csv-data-manipulation-3.hs b/Task/CSV-data-manipulation/Haskell/csv-data-manipulation-3.hs new file mode 100644 index 0000000000..3bc965d1fa --- /dev/null +++ b/Task/CSV-data-manipulation/Haskell/csv-data-manipulation-3.hs @@ -0,0 +1,2 @@ +sampleSum = sample <||> (mkRow ["SUM"] <==> mkColumn sums) + where sums = map (show . sum) (read <$$> drop 1 (values sample)) diff --git a/Task/CSV-data-manipulation/JavaScript/csv-data-manipulation.js b/Task/CSV-data-manipulation/JavaScript/csv-data-manipulation.js new file mode 100644 index 0000000000..69739184ef --- /dev/null +++ b/Task/CSV-data-manipulation/JavaScript/csv-data-manipulation.js @@ -0,0 +1,76 @@ +(function () { + 'use strict'; + + // splitRegex :: Regex -> String -> [String] + function splitRegex(rgx, s) { + return s.split(rgx); + } + + // lines :: String -> [String] + function lines(s) { + return s.split(/[\r\n]/); + } + + // unlines :: [String] -> String + function unlines(xs) { + return xs.join('\n'); + } + + // macOS JavaScript for Automation version of readFile. + // Other JS contexts will need a different definition of this function, + // and some may have no access to the local file system at all. + + // readFile :: FilePath -> maybe String + function readFile(strPath) { + var error = $(), + str = ObjC.unwrap( + $.NSString.stringWithContentsOfFileEncodingError( + $(strPath) + .stringByStandardizingPath, + $.NSUTF8StringEncoding, + error + ) + ); + return error.code ? error.localizedDescription : str; + } + + // macOS JavaScript for Automation version of writeFile. + // Other JS contexts will need a different definition of this function, + // and some may have no access to the local file system at all. + + // writeFile :: FilePath -> String -> IO () + function writeFile(strPath, strText) { + $.NSString.alloc.initWithUTF8String(strText) + .writeToFileAtomicallyEncodingError( + $(strPath) + .stringByStandardizingPath, false, + $.NSUTF8StringEncoding, null + ); + } + + // EXAMPLE - appending a SUM column + + var delimCSV = /,\s*/g; + + var strSummed = unlines( + lines(readFile('~/csvSample.txt')) + .map(function (x, i) { + var xs = x ? splitRegex(delimCSV, x) : []; + + return (xs.length ? xs.concat( + // 'SUM' appended to first line, others summed. + i > 0 ? xs.reduce( + function (a, b) { + return a + parseInt(b, 10); + }, 0 + ).toString() : 'SUM' + ) : []).join(','); + }) + ); + + return ( + writeFile('~/csvSampleSummed.txt', strSummed), + strSummed + ); + +})(); diff --git a/Task/CSV-data-manipulation/PARI-GP/csv-data-manipulation.pari b/Task/CSV-data-manipulation/PARI-GP/csv-data-manipulation.pari new file mode 100644 index 0000000000..3ba4207dc0 --- /dev/null +++ b/Task/CSV-data-manipulation/PARI-GP/csv-data-manipulation.pari @@ -0,0 +1,18 @@ +\\ CSV data manipulation +\\ 10/24/16 aev +\\ processCsv(fn): Where fn is an input path and file name (but no actual extension). +processCsv(fn)= +{my(F, ifn=Str(fn,".csv"), ofn=Str(fn,"r.csv"), cn=",SUM",nf,nc,Vr,svr); +if(fn=="", return(-1)); +F=readstr(ifn); nf=#F; +F[1] = Str(F[1],cn); +for(i=2, nf, + Vr=stok(F[i],","); if(i==2,nc=#Vr); + svr=sum(k=1,nc,eval(Vr[k])); + F[i] = Str(F[i],",",svr); +);\\fend i +for(j=1, nf, write(ofn,F[j])) +} + +\\ Testing: +processCsv("c:\\pariData\\test"); diff --git a/Task/CSV-data-manipulation/PowerShell/csv-data-manipulation.psh b/Task/CSV-data-manipulation/PowerShell/csv-data-manipulation.psh new file mode 100644 index 0000000000..3623ef05e8 --- /dev/null +++ b/Task/CSV-data-manipulation/PowerShell/csv-data-manipulation.psh @@ -0,0 +1,33 @@ +## Create a CSV file +@" +C1,C2,C3,C4,C5 +1,5,9,13,17 +2,6,10,14,18 +3,7,11,15,19 +4,8,12,16,20 +"@ -split "`r`n" | Out-File -FilePath .\Temp.csv -Force + +## Import each line of the CSV file into an array of PowerShell objects +$records = Import-Csv -Path .\Temp.csv + +## Sum the values of the properties of each object +$sums = $records | ForEach-Object { + [int]$sum = 0 + foreach ($field in $_.PSObject.Properties.Name) + { + $sum += $_.$field + } + $sum +} + +## Add a column (Sum) and its value to each object in the array +$records = for ($i = 0; $i -lt $sums.Count; $i++) +{ + $records[$i] | Select-Object *,@{Name='Sum';Expression={$sums[$i]}} +} + +## Export the array of modified objects to the CSV file +$records | Export-Csv -Path .\Temp.csv -Force + +## Display the object in tabular form +$records | Format-Table -AutoSize diff --git a/Task/CSV-data-manipulation/PureBasic/csv-data-manipulation.purebasic b/Task/CSV-data-manipulation/PureBasic/csv-data-manipulation.purebasic new file mode 100644 index 0000000000..b83ff6b50a --- /dev/null +++ b/Task/CSV-data-manipulation/PureBasic/csv-data-manipulation.purebasic @@ -0,0 +1,51 @@ +EnableExplicit + +#Separator$ = "," + +Define fInput$ = "input.csv"; insert path to input file +Define fOutput$ = "output.csv"; insert path to output file +Define header$, row$, field$ +Define nbColumns, sum, i + +If OpenConsole() + If Not ReadFile(0, fInput$) + PrintN("Error opening input file") + Goto Finish + EndIf + + If Not CreateFile(1, fOutput$) + PrintN("Error creating output file") + CloseFile(0) + Goto Finish + EndIf + + ; Read header row + header$ = ReadString(0) + ; Determine number of columns + nbColumns = CountString(header$, ",") + 1 + ; Change header row + header$ + #Separator$ + "SUM" + ; Write to output file + WriteStringN(1, header$) + + ; Read remaining rows, process and write to output file + While Not Eof(0) + row$ = ReadString(0) + sum = 0 + For i = 1 To nbColumns + field$ = StringField(row$, i, #Separator$) + sum + Val(field$) + Next + row$ + #Separator$ + sum + WriteStringN(1, row$) + Wend + + CloseFile(0) + CloseFile(1) + + Finish: + PrintN("") + PrintN("Press any key to close the console") + Repeat: Delay(10) : Until Inkey() <> "" + CloseConsole() +EndIf diff --git a/Task/CSV-data-manipulation/SAS/csv-data-manipulation.sas b/Task/CSV-data-manipulation/SAS/csv-data-manipulation.sas new file mode 100644 index 0000000000..af1cbc7a0c --- /dev/null +++ b/Task/CSV-data-manipulation/SAS/csv-data-manipulation.sas @@ -0,0 +1,15 @@ +data _null_; +infile datalines dlm="," firstobs=2; +file "output.csv" dlm=","; +input c1-c5; +if _n_=1 then put "C1,C2,C3,C4,C5,Sum"; +s=sum(of c1-c5); +put c1-c5 s; +datalines; +C1,C2,C3,C4,C5 +1,5,9,13,17 +2,6,10,14,18 +3,7,11,15,19 +4,8,12,16,20 +; +run; diff --git a/Task/CSV-data-manipulation/Tcl/csv-data-manipulation.tcl b/Task/CSV-data-manipulation/Tcl/csv-data-manipulation-1.tcl similarity index 100% rename from Task/CSV-data-manipulation/Tcl/csv-data-manipulation.tcl rename to Task/CSV-data-manipulation/Tcl/csv-data-manipulation-1.tcl diff --git a/Task/CSV-data-manipulation/Tcl/csv-data-manipulation-2.tcl b/Task/CSV-data-manipulation/Tcl/csv-data-manipulation-2.tcl new file mode 100644 index 0000000000..e863925092 --- /dev/null +++ b/Task/CSV-data-manipulation/Tcl/csv-data-manipulation-2.tcl @@ -0,0 +1,6 @@ +set f [open example.csv r] +puts "[gets $f],SUM" +while { [gets $f row] > 0 } { + puts "$row,[expr [string map {, +} $row]]" +} +close $f diff --git a/Task/CSV-data-manipulation/VBA/csv-data-manipulation.vba b/Task/CSV-data-manipulation/VBA/csv-data-manipulation.vba new file mode 100644 index 0000000000..2785cc9855 --- /dev/null +++ b/Task/CSV-data-manipulation/VBA/csv-data-manipulation.vba @@ -0,0 +1,7 @@ +Sub ReadCSV() + Workbooks.Open Filename:="L:\a\input.csv" + Range("F1").Value = "Sum" + Range("F2:F5").Formula = "=SUM(A2:E2)" + ActiveWorkbook.SaveAs Filename:="L:\a\output.csv", FileFormat:=xlCSV + ActiveWindow.Close +End Sub diff --git a/Task/CSV-to-HTML-translation/00DESCRIPTION b/Task/CSV-to-HTML-translation/00DESCRIPTION index b8ec827980..485bef46b1 100644 --- a/Task/CSV-to-HTML-translation/00DESCRIPTION +++ b/Task/CSV-to-HTML-translation/00DESCRIPTION @@ -1,19 +1,25 @@ Consider a simplified CSV format where all rows are separated by a newline and all columns are separated by commas. + No commas are allowed as field data, but the data may contain other characters and character sequences that would -normally be escaped when converted to HTML +normally be   ''escaped''   when converted to HTML -The task is to create a function that takes a string representation of the CSV data + +;Task: +Create a function that takes a string representation of the CSV data and returns a text string of an HTML table representing the CSV data. -Use the following data as the CSV text to convert, and show your output. -:Character,Speech -:The multitude,The messiah! Show us the messiah! -:Brians mother,Now you listen here! He's not the messiah; he's a very naughty boy! Now go away! -:The multitude,Who are you? -:Brians mother,I'm his mother; that's who! -:The multitude,Behold his mother! Behold his mother! -For extra credit, ''optionally'' allow special formatting -for the first row of the table as if it is the tables header row +Use the following data as the CSV text to convert, and show your output. +: Character,Speech +: The multitude,The messiah! Show us the messiah! +: Brians mother,Now you listen here! He's not the messiah; he's a very naughty boy! Now go away! +: The multitude,Who are you? +: Brians mother,I'm his mother; that's who! +: The multitude,Behold his mother! Behold his mother! + + +;Extra credit: +''Optionally'' allow special formatting for the first row of the table as if it is the tables header row (via preferably; CSS if you must). +

    diff --git a/Task/CSV-to-HTML-translation/Batch-File/csv-to-html-translation-1.bat b/Task/CSV-to-HTML-translation/Batch-File/csv-to-html-translation-1.bat new file mode 100644 index 0000000000..070ea8844a --- /dev/null +++ b/Task/CSV-to-HTML-translation/Batch-File/csv-to-html-translation-1.bat @@ -0,0 +1,32 @@ +::Batch Files are terrifying when it comes to string processing. +::But well, a decent implementation! +@echo off + +REM Below is the CSV data to be converted. +REM Exactly three colons must be put before the actual line. + +:::Character,Speech +:::The multitude,The messiah! Show us the messiah! +:::Brians mother,Now you listen here! He's not the messiah; he's a very naughty boy! Now go away! +:::The multitude,Who are you? +:::Brians mother,I'm his mother; that's who! +:::The multitude,Behold his mother! Behold his mother! + +setlocal disabledelayedexpansion +echo ^ +for /f "delims=" %%A in ('findstr "^:::" "%~f0"') do ( + set "var=%%A" + setlocal enabledelayedexpansion + REM The next command removes the three colons... + set "var=!var:~3!" + + REM The following commands to the substitions per line... + set "var=!var:&=&!" + set "var=!var:<=<!" + set "var=!var:>=>!" + set "var=!var:,=!" + + echo ^^!var!^^ + endlocal +) +echo ^ diff --git a/Task/CSV-to-HTML-translation/Batch-File/csv-to-html-translation-2.bat b/Task/CSV-to-HTML-translation/Batch-File/csv-to-html-translation-2.bat new file mode 100644 index 0000000000..0964db10ff --- /dev/null +++ b/Task/CSV-to-HTML-translation/Batch-File/csv-to-html-translation-2.bat @@ -0,0 +1,8 @@ + + + + + + + +
    CharacterSpeech
    The multitudeThe messiah! Show us the messiah!
    Brians mother<angry>Now you listen here! He's not the messiah; he's a very naughty boy! Now go away!</angry>
    The multitudeWho are you?
    Brians motherI'm his mother; that's who!
    The multitudeBehold his mother! Behold his mother!
    diff --git a/Task/CSV-to-HTML-translation/Clojure/csv-to-html-translation-1.clj b/Task/CSV-to-HTML-translation/Clojure/csv-to-html-translation-1.clj new file mode 100644 index 0000000000..5b60324ab3 --- /dev/null +++ b/Task/CSV-to-HTML-translation/Clojure/csv-to-html-translation-1.clj @@ -0,0 +1,6 @@ +Character,Speech +The multitude,The messiah! Show us the messiah! +Brians mother,Now you listen here! He's not the messiah; he's a very naughty boy! Now go away! +The multitude,Who are you? +Brians mother,I'm his mother; that's who! +The multitude,Behold his mother! Behold his mother! diff --git a/Task/CSV-to-HTML-translation/Clojure/csv-to-html-translation-2.clj b/Task/CSV-to-HTML-translation/Clojure/csv-to-html-translation-2.clj new file mode 100644 index 0000000000..d86c11a501 --- /dev/null +++ b/Task/CSV-to-HTML-translation/Clojure/csv-to-html-translation-2.clj @@ -0,0 +1,31 @@ +(require 'clojure.string) + +(def escapes + {\< "<", \> ">", \& "&"}) + +(defn escape + [content] + (clojure.string/escape content escapes)) + +(defn tr + [cells] + (format "%s" + (apply str (map #(str "" (escape %) "") cells)))) + +;; turn a seq of seq of cells into a string. +(defn to-html + [tbl] + (format "%s" + (apply str (map tr tbl)))) + +;; Read from a string to a seq of seq of cells. +(defn from-csv + [text] + (map #(clojure.string/split % #",") + (clojure.string/split-lines text))) + +(defn -main + [] + (let [lines (line-seq (java.io.BufferedReader. *in*)) + tbl (map #(clojure.string/split % #",") lines)] + (println (to-html tbl))) diff --git a/Task/CSV-to-HTML-translation/Clojure/csv-to-html-translation-3.clj b/Task/CSV-to-HTML-translation/Clojure/csv-to-html-translation-3.clj new file mode 100644 index 0000000000..4dc622a9d2 --- /dev/null +++ b/Task/CSV-to-HTML-translation/Clojure/csv-to-html-translation-3.clj @@ -0,0 +1 @@ +
    diff --git a/Task/CSV-to-HTML-translation/Fortran/csv-to-html-translation.f b/Task/CSV-to-HTML-translation/Fortran/csv-to-html-translation.f new file mode 100644 index 0000000000..73683283d8 --- /dev/null +++ b/Task/CSV-to-HTML-translation/Fortran/csv-to-html-translation.f @@ -0,0 +1,71 @@ + SUBROUTINE CSVTEXT2HTML(FNAME,HEADED) !Does not recognise quoted strings. +Converts without checking field counts, or noting special characters. + CHARACTER*(*) FNAME !Names the input file. + LOGICAL HEADED !Perhaps its first line is to be a heading. + INTEGER MANY !How long is a piece of string? + PARAMETER (MANY=666) !This should suffice. + CHARACTER*(MANY) ALINE !A scratchpad for the input. + INTEGER MARK(0:MANY + 1) !Fingers the commas on a line. + INTEGER I,L,N !Assistants. + CHARACTER*2 WOT(2) !I don't see why a "table datum" could not be for either. + PARAMETER (WOT = (/"th","td"/)) !A table heding or a table datum + INTEGER IT !But, one must select appropriately. + INTEGER KBD,MSG,IN !A selection. + COMMON /IOUNITS/ KBD,MSG,IN !The caller thus avoids collisions. + OPEN(IN,FILE=FNAME,STATUS="OLD",ACTION="READ",ERR=661) !Go for the file. + WRITE (MSG,1) !Start the blather. + 1 FORMAT ("
    CharacterSpeech
    The multitudeThe messiah! Show us the messiah!
    Brians mother<angry>Now you listen here! He's not the messiah; he's a very naughty boy! Now go away!</angry>
    The multitudeWho are you?
    Brians motherI'm his mother; that's who!
    The multitudeBehold his mother! Behold his mother!
    ") !By stating that a table follows. + MARK(0) = 0 !Syncopation for the comma fingers. + N = 0 !No records read. + + 10 READ (IN,11,END = 20) L,ALINE(1:MIN(L,MANY)) !Carefully acquire some text. + 11 FORMAT (Q,A) !Q = number of characters yet to read, A = characters. + N = N + 1 !So, a record has been read. + IF (L.GT.MANY) THEN !Perhaps it is rather long? + WRITE (MSG,12) N,L,MANY !Alas! + 12 FORMAT ("Line ",I0," has length ",I0,"! My limit is ",I0) !Squawk/ + L = MANY !The limit actually read. + END IF !So much for paranoia. + IF (N.EQ.1 .AND. HEADED) THEN !Is the first line to be treated specially? + WRITE (MSG,*) "" !Yep. Nominate a heading. + IT = 1 !And select "th" rather than "td". + ELSE !But mostly, + IT = 2 !Just another row for the table. + END IF !So much for the first line. + NCOLS = 0 !No commas have been seen. + DO I = 1,L !So scan the text for them. + IF (ICHAR(ALINE(I:I)).EQ.ICHAR(",")) THEN !Here? + NCOLS = NCOLS + 1 !Yes! + MARK(NCOLS) = I !The texts are between commas. + END IF !So much for that character. + END DO !On to the next. + NCOLS = NCOLS + 1 !This is why the + 1 for the size of MARK. + MARK(NCOLS) = L + 1 !End-of-line is as if a comma was one further along. + WRITE (MSG,13) !Now roll all the texts. + 1 (WOT(IT), !This starting a cell, + 2 ALINE(MARK(I - 1) + 1:MARK(I) - 1), !This being the text between the commas, + 3 WOT(IT), !And this ending each cell. + 4 I = 1,NCOLS), !For this number of columns. + 5 "/tr" !And this ends the row. + 13 FORMAT (" ",666("<",A,">",A,"")) !How long is a piece of string? + IF (N.EQ.1 .AND. HEADED) WRITE (MSG,*) "" !Finish the possible header. + GO TO 10 !And try for another record. + + 20 CLOSE (IN) !Finished with input. + WRITE (MSG,21) !And finished with output. + 21 FORMAT ("
    ") !This writes starting at column one. + RETURN !Done! +Confusions. + 661 WRITE (MSG,*) "Can't open file ",FNAME !Alas. + END !So much for the conversion. + + INTEGER KBD,MSG,IN + COMMON /IOUNITS/ KBD,MSG,IN + KBD = 5 !Standard input. + MSG = 6 !Standard output. + IN = 10 !Some unspecial number. + + CALL CSVTEXT2HTML("Text.csv",.FALSE.) !The first line is not special. + WRITE (MSG,*) + CALL CSVTEXT2HTML("Text.csv",.TRUE.) !The first line is a heading. + END diff --git a/Task/CSV-to-HTML-translation/REXX/csv-to-html-translation.rexx b/Task/CSV-to-HTML-translation/REXX/csv-to-html-translation.rexx index 8c082edb34..5f85ccf6c9 100644 --- a/Task/CSV-to-HTML-translation/REXX/csv-to-html-translation.rexx +++ b/Task/CSV-to-HTML-translation/REXX/csv-to-html-translation.rexx @@ -1,28 +1,28 @@ -/*REXX program converts CSV ───► HTML table representing the CSV data. */ -arg header_ . /*determine if the user wants a header.*/ -wantsHdr= (header_=='HEADER') /*is the arg (low/upp/mix case)=HEADER?*/ +/*REXX program converts CSV ───► HTML table representing the CSV data. */ +arg header_ . /*obtain an uppercase version of args. */ +wantsHdr= (header_=='HEADER') /*is the arg (low/upp/mix case)=HEADER?*/ + /* [↑] determine if user wants a hdr. */ + iFID= 'CSV_HTML.TXT' /*the input fileID to be used. */ +if wantsHdr then oFID= 'OUTPUTH.HTML' /*the output fileID with header.*/ + else oFID= 'OUTPUT.HTML' /* " " " without " */ - iFID= 'CSV_HTML.TXT' /*the input fileID to be used. */ -if wantsHdr then oFID= 'OUTPUTH.HTML' /*the output fileID with header.*/ - else oFID= 'OUTPUT.HTML' /* " " " without " */ - - do rows=0 while lines(iFID)\==0 /*read the rows from a (text/txt) file.*/ - row.rows=strip(linein(iFID)) + do rows=0 while lines(iFID)\==0 /*read the rows from a (text/txt) file.*/ + row.rows= strip( linein(iFID) ) end /*rows*/ -convFrom= '& < > "' /*special characters to be converted. */ -convTo = '& < > "' /*display what they are converted into.*/ +convFrom= '& < > "' /*special characters to be converted. */ +convTo = '& < > "' /*display what they are converted into.*/ call write , '' call write , '' - do j=0 for rows; call write 5, '' - tx='td' - if wantsHdr & j==0 then tx='th' + do j=0 for rows; call write 5, '' + tx= 'td' + if wantsHdr & j==0 then tx= 'th' /*if user wants a header, then oblige. */ - do while row.j\==''; parse var row.j yyy ',' row.j + do while row.j\==''; parse var row.j yyy "," row.j do k=1 for words(convFrom) - yyy=changestr(word(convFrom, k), yyy, word(convTo, k)) + yyy=changestr( word( convFrom, k), yyy, word( convTo, k)) end /*k*/ call write 10, '<'tx">"yyy'" end /*forever*/ @@ -31,6 +31,6 @@ call write , '
    ' call write 5, '' call write , '
    ' call write , '' -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -write: call lineout oFID, left('', 0 || arg(1))arg(2); return +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +write: call lineout oFID, left('', 0 || arg(1) )arg(2); return diff --git a/Task/Caesar-cipher/00DESCRIPTION b/Task/Caesar-cipher/00DESCRIPTION index 56ad11ee6f..73d1a6d0b9 100644 --- a/Task/Caesar-cipher/00DESCRIPTION +++ b/Task/Caesar-cipher/00DESCRIPTION @@ -1,17 +1,20 @@ +;Task: Implement a [[wp:Caesar cipher|Caesar cipher]], both encoding and decoding.
    The key is an integer from 1 to 25. This cipher rotates (either towards left or right) the letters of the alphabet (A to Z). -The encoding replaces each letter with the 1st to 25th next letter in the alphabet (wrapping Z to A). So key 2 encrypts "HI" to "JK", but key 20 encrypts "HI" to "BC". +The encoding replaces each letter with the 1st to 25th next letter in the alphabet (wrapping Z to A). +
    So key 2 encrypts "HI" to "JK", but key 20 encrypts "HI" to "BC". -This simple "monoalphabetic substitution cipher" provides almost no security, because an attacker who has the encoded message can either use frequency analysis to guess the key, or just try all 25 keys. +This simple "mono-alphabetic substitution cipher" provides almost no security, because an attacker who has the encoded message can either use frequency analysis to guess the key, or just try all 25 keys. Caesar cipher is identical to [[Vigenère cipher]] with a key of length 1.
    Also, [[Rot-13]] is identical to Caesar cipher with key 13. -;See also: + +;Related tasks: * [[Rot-13]] * [[Substitution Cipher]] * [[Vigenère Cipher/Cryptanalysis]] -
    +

    diff --git a/Task/Caesar-cipher/APL/caesar-cipher.apl b/Task/Caesar-cipher/APL/caesar-cipher.apl new file mode 100644 index 0000000000..298e690c00 --- /dev/null +++ b/Task/Caesar-cipher/APL/caesar-cipher.apl @@ -0,0 +1,7 @@ + ∇CAESAR[⎕]∇ + ∇ +[0] A←K CAESAR V +[1] A←'AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz' +[2] ((,V∊A)/,V)←A[⎕IO+52|(2×K)+((A⍳,V)-⎕IO)~52] +[3] A←V + ∇ diff --git a/Task/Caesar-cipher/Common-Lisp/caesar-cipher.lisp b/Task/Caesar-cipher/Common-Lisp/caesar-cipher.lisp index 9327652e36..16d8a2cbeb 100644 --- a/Task/Caesar-cipher/Common-Lisp/caesar-cipher.lisp +++ b/Task/Caesar-cipher/Common-Lisp/caesar-cipher.lisp @@ -1,13 +1,9 @@ (defun encipher-char (ch key) - (let* - ((c (char-code ch)) - (la (char-code #\a)) (lz (char-code #\z)) - (ua (char-code #\A)) (uz (char-code #\Z)) - (base (cond - ((and (>= c la) (<= c lz)) la) - ((and (>= c ua) (<= c uz)) ua) - (t nil)))) - (if base (code-char (+ (mod (+ (- c base) key) 26) base)) ch))) + (let* ((c (char-code ch)) (la (char-code #\a)) (ua (char-code #\A)) + (base (cond ((<= la c (char-code #\z)) la) + ((<= ua c (char-code #\Z)) ua) + (nil)))) + (if base (code-char (+ (mod (+ (- c base) key) 26) base)) ch))) (defun caesar-cipher (str key) (map 'string #'(lambda (c) (encipher-char c key)) str)) diff --git a/Task/Caesar-cipher/Ela/caesar-cipher.ela b/Task/Caesar-cipher/Ela/caesar-cipher.ela new file mode 100644 index 0000000000..c2be98d2ac --- /dev/null +++ b/Task/Caesar-cipher/Ela/caesar-cipher.ela @@ -0,0 +1,28 @@ +open number char monad io string + +chars = "ABCDEFGHIJKLMOPQRSTUVWXYZ" + +caesar _ _ [] = "" +caesar op key (x::xs) = check shifted ++ caesar op key xs + where orig = indexOf (string.upper $ toString x) chars + shifted = orig `op` key + check val | orig == -1 = x + | val > 24 = trans $ val - 25 + | val < 0 = trans $ 25 + val + | else = trans shifted + trans idx = chars:idx + +cypher = caesar (+) +decypher = caesar (-) + +key = 2 + +do + putStrLn "A string to encode:" + str <- readStr + putStr "Encoded string: " + cstr <- return <| cypher key str + put cstr + putStrLn "" + putStr "Decoded string: " + put $ decypher key cstr diff --git a/Task/Caesar-cipher/Elixir/caesar-cipher.elixir b/Task/Caesar-cipher/Elixir/caesar-cipher.elixir index 7c6141999a..8eb7ecc4df 100644 --- a/Task/Caesar-cipher/Elixir/caesar-cipher.elixir +++ b/Task/Caesar-cipher/Elixir/caesar-cipher.elixir @@ -7,7 +7,7 @@ defmodule Caesar_cipher do def encode(text, key) do map = Map.new |> set_map(?a..?z, key) |> set_map(?A..?Z, key) - String.codepoints(text) |> Enum.map_join(fn c -> Dict.get(map, c, c) end) + String.graphemes(text) |> Enum.map_join(fn c -> Map.get(map, c, c) end) end end diff --git a/Task/Caesar-cipher/Haskell/caesar-cipher-1.hs b/Task/Caesar-cipher/Haskell/caesar-cipher-1.hs new file mode 100644 index 0000000000..47433cda7b --- /dev/null +++ b/Task/Caesar-cipher/Haskell/caesar-cipher-1.hs @@ -0,0 +1,16 @@ +module Caesar (caesar, uncaesar) where + +import Data.Char + +caesar, uncaesar :: (Integral a) => a -> String -> String +caesar k = map f + where f c = case generalCategory c of + LowercaseLetter -> addChar 'a' k c + UppercaseLetter -> addChar 'A' k c + _ -> c +uncaesar k = caesar (-k) + +addChar :: (Integral a) => Char -> a -> Char -> Char +addChar b o c = chr $ fromIntegral (b' + (c' - b' + o) `mod` 26) + where b' = fromIntegral $ ord b + c' = fromIntegral $ ord c diff --git a/Task/Caesar-cipher/Haskell/caesar-cipher-2.hs b/Task/Caesar-cipher/Haskell/caesar-cipher-2.hs new file mode 100644 index 0000000000..ea8e8e210f --- /dev/null +++ b/Task/Caesar-cipher/Haskell/caesar-cipher-2.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE LambdaCase #-} +module Main where + +import Control.Error (tryRead, tryAt) +import Control.Monad.Trans (liftIO) +import Control.Monad.Trans.Except (ExceptT, runExceptT) + +import Data.Char +import System.Exit (die) +import System.Environment (getArgs) + +main :: IO () +main = runExceptT parseKey >>= \case + Left err -> die err + Right k -> interact $ caesar k + +parseKey :: (Read a, Integral a) => ExceptT String IO a +parseKey = liftIO getArgs >>= + flip (tryAt "Not enough arguments") 0 >>= + tryRead "Key is not a valid integer" + +caesar :: (Integral a) => a -> String -> String +caesar k = map f + where f c = case generalCategory c of + LowercaseLetter -> addChar 'a' k c + UppercaseLetter -> addChar 'A' k c + _ -> c + +addChar :: (Integral a) => Char -> a -> Char -> Char +addChar b o c = chr $ fromIntegral (b' + (c' - b' + o) `mod` 26) + where b' = fromIntegral $ ord b + c' = fromIntegral $ ord c diff --git a/Task/Caesar-cipher/Haskell/caesar-cipher.hs b/Task/Caesar-cipher/Haskell/caesar-cipher.hs deleted file mode 100644 index 0cfb674c4c..0000000000 --- a/Task/Caesar-cipher/Haskell/caesar-cipher.hs +++ /dev/null @@ -1,17 +0,0 @@ -import Data.Char (ord, chr) -import Data.Ix (inRange) - -caesar :: Int -> String -> String -caesar k = map f - where - f c - | inRange ('a','z') c = tr 'a' k c - | inRange ('A','Z') c = tr 'A' k c - | otherwise = c - -unCaesar :: Int -> String -> String -unCaesar k = caesar (-k) - --- char addition -tr :: Char -> Int -> Char -> Char -tr base offset char = chr $ ord base + (ord char - ord base + offset) `mod` 26 diff --git a/Task/Caesar-cipher/JavaScript/caesar-cipher-1.js b/Task/Caesar-cipher/JavaScript/caesar-cipher-1.js new file mode 100644 index 0000000000..7aad4c2a83 --- /dev/null +++ b/Task/Caesar-cipher/JavaScript/caesar-cipher-1.js @@ -0,0 +1,11 @@ +function caesar (text, shift) { + return text.toUpperCase().replace(/[^A-Z]/g,'').replace(/[A-Z]/g, function(a) { + return String.fromCharCode(65+(a.charCodeAt(0)-65+shift)%26); + }); +} + +// Tests +var text = 'veni, vidi, vici'; +for (var i = 0; i<26; i++) { + console.log(i+': '+caesar(text,i)); +} diff --git a/Task/Caesar-cipher/JavaScript/caesar-cipher-2.js b/Task/Caesar-cipher/JavaScript/caesar-cipher-2.js new file mode 100644 index 0000000000..5333e06810 --- /dev/null +++ b/Task/Caesar-cipher/JavaScript/caesar-cipher-2.js @@ -0,0 +1,5 @@ +var caesar = (text, shift) => text + .toUpperCase() + .replace(/[^A-Z]/g, '') + .replace(/[A-Z]/g, a => + String.fromCharCode(65 + (a.charCodeAt(0) - 65 + shift) % 26)); diff --git a/Task/Caesar-cipher/JavaScript/caesar-cipher-3.js b/Task/Caesar-cipher/JavaScript/caesar-cipher-3.js new file mode 100644 index 0000000000..1157c7ce6b --- /dev/null +++ b/Task/Caesar-cipher/JavaScript/caesar-cipher-3.js @@ -0,0 +1,43 @@ +((key, strPlain) => { + + // Int -> String -> String + let caesar = (k, s) => s.split('') + .map(c => tr( + inRange(['a', 'z'], c) ? 'a' : + inRange(['A', 'Z'], c) ? 'A' : 0, + k, c + )) + .join(''); + + // Int -> String -> String + let unCaesar = (k, s) => caesar(26 - (k % 26), s); + + // Char -> Int -> Char -> Char + let tr = (base, offset, char) => + base ? ( + String.fromCharCode( + ord(base) + ( + ord(char) - ord(base) + offset + ) % 26 + ) + ) : char; + + // [a, a] -> a -> b + let inRange = ([min, max], v) => !(v < min || v > max); + + // Char -> Int + let ord = c => c.charCodeAt(0); + + // range :: Int -> Int -> [Int] + let range = (m, n) => + Array.from({ + length: Math.floor(n - m) + 1 + }, (_, i) => m + i); + + // TEST + let strCipher = caesar(key, strPlain), + strDecode = unCaesar(key, strCipher); + + return [strCipher, ' -> ', strDecode]; + +})(114, 'Curio, Cesare venne, e vide e vinse ? '); diff --git a/Task/Caesar-cipher/JavaScript/caesar-cipher.js b/Task/Caesar-cipher/JavaScript/caesar-cipher.js deleted file mode 100644 index f8a6a32ce4..0000000000 --- a/Task/Caesar-cipher/JavaScript/caesar-cipher.js +++ /dev/null @@ -1,24 +0,0 @@ -Caesar -
    
    -
    diff --git a/Task/Caesar-cipher/K/caesar-cipher.k b/Task/Caesar-cipher/K/caesar-cipher.k
    new file mode 100644
    index 0000000000..7cf5e3f2bb
    --- /dev/null
    +++ b/Task/Caesar-cipher/K/caesar-cipher.k
    @@ -0,0 +1,4 @@
    +  s:"there is a tide in the affairs of men"
    +  caesar:{ :[" "=x; x; {x!_ci 97+!26}[y]@_ic[x]-97]}'
    +  caesar[s;1]
    +"uifsf jt b ujef jo uif bggbjst pg nfo"
    diff --git a/Task/Caesar-cipher/Lua/caesar-cipher.lua b/Task/Caesar-cipher/Lua/caesar-cipher-1.lua
    similarity index 100%
    rename from Task/Caesar-cipher/Lua/caesar-cipher.lua
    rename to Task/Caesar-cipher/Lua/caesar-cipher-1.lua
    diff --git a/Task/Caesar-cipher/Lua/caesar-cipher-2.lua b/Task/Caesar-cipher/Lua/caesar-cipher-2.lua
    new file mode 100644
    index 0000000000..eceb909429
    --- /dev/null
    +++ b/Task/Caesar-cipher/Lua/caesar-cipher-2.lua
    @@ -0,0 +1,32 @@
    +local memo = {}
    +
    +local function make_table(k)
    +    local t = {}
    +    local a, A = ('a'):byte(), ('A'):byte()
    +
    +    for i = 0,25 do
    +        local  c = a + i
    +        local  C = A + i
    +        local rc = a + (i+k) % 26
    +        local RC = A + (i+k) % 26
    +        t[c], t[C] = rc, RC
    +    end
    +
    +    return t
    +end
    +
    +local function caesar(str, k, decode)
    +    k = (decode and -k or k) % 26
    +
    +    local t = memo[k]
    +    if not t then
    +        t = make_table(k)
    +        memo[k] = t
    +    end
    +
    +    local res_t = { str:byte(1,-1) }
    +    for i,c in ipairs(res_t) do
    +        res_t[i] = t[c] or c
    +    end
    +    return string.char(unpack(res_t))
    +end
    diff --git a/Task/Caesar-cipher/Python/caesar-cipher-3.py b/Task/Caesar-cipher/Python/caesar-cipher-3.py
    index 838af43dba..21ac5a64f8 100644
    --- a/Task/Caesar-cipher/Python/caesar-cipher-3.py
    +++ b/Task/Caesar-cipher/Python/caesar-cipher-3.py
    @@ -1,9 +1,11 @@
    -from string import ascii_uppercase as abc
    -
    -def caesar(s, k, decode = False):
    -    trans = dict(zip(abc, abc[(k,26-k)[decode]:] + abc[:(k,26-k)[decode]]))
    -    return ''.join(trans[L] for L in s.upper() if L in abc)
    -
    -msg = "The quick brown fox jumped over the lazy dogs"
    -print(caesar(msg, 11))
    -print(caesar(caesar(msg, 11), 11, True))
    +import string
    +def caesar(s, k = 13, decode = False, *, memo={}):
    +  if decode: k = 26 - k
    +  k = k % 26
    +  table = memo.get(k)
    +  if table is None:
    +    table = memo[k] = str.maketrans(
    +                        string.ascii_uppercase + string.ascii_lowercase,
    +                        string.ascii_uppercase[k:] + string.ascii_uppercase[:k] +
    +                        string.ascii_lowercase[k:] + string.ascii_lowercase[:k])
    +  return s.translate(table)
    diff --git a/Task/Caesar-cipher/Python/caesar-cipher-4.py b/Task/Caesar-cipher/Python/caesar-cipher-4.py
    new file mode 100644
    index 0000000000..838af43dba
    --- /dev/null
    +++ b/Task/Caesar-cipher/Python/caesar-cipher-4.py
    @@ -0,0 +1,9 @@
    +from string import ascii_uppercase as abc
    +
    +def caesar(s, k, decode = False):
    +    trans = dict(zip(abc, abc[(k,26-k)[decode]:] + abc[:(k,26-k)[decode]]))
    +    return ''.join(trans[L] for L in s.upper() if L in abc)
    +
    +msg = "The quick brown fox jumped over the lazy dogs"
    +print(caesar(msg, 11))
    +print(caesar(caesar(msg, 11), 11, True))
    diff --git a/Task/Caesar-cipher/REXX/caesar-cipher-1.rexx b/Task/Caesar-cipher/REXX/caesar-cipher-1.rexx
    index 77ba012c0e..4d0ce4b12f 100644
    --- a/Task/Caesar-cipher/REXX/caesar-cipher-1.rexx
    +++ b/Task/Caesar-cipher/REXX/caesar-cipher-1.rexx
    @@ -1,22 +1,22 @@
    -/*REXX pgm: Caesar cypher: Latin alphabet only, no punctuation or blanks*/
    -/*     allowed,  all lowercase Latin letters are treated as uppercase.  */
    -arg key p                              /*get key and text to be cyphered*/
    -p=space(p,0)                           /*remove all blanks from text.   */
    -                        say 'Caesar cypher key:' key
    -                        say '       plain text:' p
    -y=caesar(p, key)  ;     say '         cyphered:' y
    -z=caesar(y,-key)  ;     say '       uncyphered:' z
    -if z\==p  then say "plain text doesn't match uncyphered cyphered text."
    -exit                                   /*stick a fork in it, we're done.*/
    -/*──────────────────────────────────CAESAR subroutine───────────────────*/
    -caesar: procedure; arg s,k; @='ABCDEFGHIJKLMNOPQRSTUVWXYZ'; L=length(@)
    -ak=abs(k)
    -if ak>length(@)-1  |  k==0  |  k==''   then  call err k 'key is invalid'
    -_=verify(s,@)                          /*any illegal char specified ?   */
    -if _\==0  then call err 'unsupported character:' substr(s,_,1)
    -                                       /*now that error checks are done:*/
    -if k>0    then ky=k+1                  /*either cypher it, or ···       */
    -          else ky=27-ak                /*     decypher it.              */
    -return translate(s,substr(@||@,ky,L),@)
    -/*──────────────────────────────────ERR subroutine──────────────────────*/
    -err:   say;    say '***error!***';    say;    say arg(1);   say;   exit 13
    +/*REXX program supports the  Caesar cypher for the Latin alphabet only,  no punctuation */
    +/*──────────── or blanks allowed,  all lowercase Latin letters are treated as uppercase.*/
    +parse arg key .;  arg . p                        /*get key & uppercased text to be used.*/
    +p=space(p,0)                                     /*elide any and all spaces (blanks).   */
    +                    say 'Caesar cypher key:' key /*echo the Caesar cypher key to console*/
    +                    say '       plain text:' p   /*  "   "       plain text    "    "   */
    +y=Caesar(p, key);   say '         cyphered:' y   /*  "   "    cyphered text    "    "   */
    +z=Caesar(y,-key);   say '       uncyphered:' z   /*  "   "  uncyphered text    "    "   */
    +if z\==p  then say  "plain text doesn't match uncyphered cyphered text."
    +exit                                             /*stick a fork in it,  we're all done. */
    +/*──────────────────────────────────────────────────────────────────────────────────────*/
    +Caesar: procedure; arg s,k;  @='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
    +        ak=abs(k)                                /*obtain the absolute value of the key.*/
    +        L=length(@)                              /*obtain the length of the  @  string. */
    +        if ak>length(@)-1 | k==0  then  call err k  'key is invalid.'
    +        _=verify(s,@)                            /*any illegal characters specified ?   */
    +        if _\==0  then call err 'unsupported character:'   substr(s, _, 1)
    +        if k>0    then ky=k+1                    /*either cypher it,  or ···            */
    +                  else ky=L+1-ak                 /*     decypher it.                    */
    +        return translate(s, substr(@||@,ky,L),@) /*return the processed text.           */
    +/*──────────────────────────────────────────────────────────────────────────────────────*/
    +err:    say;      say '***error***';       say;          say arg(1);      say;     exit 13
    diff --git a/Task/Caesar-cipher/REXX/caesar-cipher-2.rexx b/Task/Caesar-cipher/REXX/caesar-cipher-2.rexx
    index 2e7b12a6d5..a908b9b4e2 100644
    --- a/Task/Caesar-cipher/REXX/caesar-cipher-2.rexx
    +++ b/Task/Caesar-cipher/REXX/caesar-cipher-2.rexx
    @@ -1,22 +1,22 @@
    -/*REXX pgm: Caesar cypher for almost all keyboard chars including blanks*/
    -parse arg key p                        /*get key and text to be cyphered*/
    -                        say 'Caesar cypher key:' key
    -                        say '       plain text:' p
    -y=caesar(p, key)  ;     say '         cyphered:' y
    -z=caesar(y,-key)  ;     say '       uncyphered:' z
    -if z\==p  then say "plain text doesn't match uncyphered cyphered text."
    -exit                                   /*stick a fork in it, we're done.*/
    -/*──────────────────────────────────CAESAR subroutine───────────────────*/
    -caesar:  procedure;     parse arg s,k;     @='abcdefghijklmnopqrstuvwxyz'
    -@=translate(@)@'0123456789(){}[]<>'    /*add uppercase, digs, group symb*/
    -@=@'~!@#$%^&*_+:";?,./`-= '''          /*add other characters here.     */
    -                       /*last char is doubled, REXX quoted syntax rules.*/
    -L=length(@)
    -ak=abs(k)
    -if ak>length(@)-1 | k==0  then  call err k 'key is invalid'
    -_=verify(s,@)                          /*any illegal char specified ?   */
    -if _\==0  then call err 'unsupported character:' substr(s,_,1)
    -if k>0    then ky=k+1
    -          else ky=L+1-ak
    -return translate(s,substr(@||@,ky,L),@)
    -/*──────────────────────────────────ERR subroutine──────────────────────*/
    +/*REXX program supports the Caesar cypher for most keyboard characters including blanks.*/
    +parse arg key p                                  /*get key and the text to be cyphered. */
    +                    say 'Caesar cypher key:' key /*echo the Caesar cypher key to console*/
    +                    say '       plain text:' p   /*  "   "       plain text    "    "   */
    +y=Caesar(p, key);   say '         cyphered:' y   /*  "   "    cyphered text    "    "   */
    +z=Caesar(y,-key);   say '       uncyphered:' z   /*  "   "  uncyphered text    "    "   */
    +if z\==p  then say  "plain text doesn't match uncyphered cyphered text."
    +exit                                             /*stick a fork in it,  we're all done. */
    +/*──────────────────────────────────────────────────────────────────────────────────────*/
    +Caesar: procedure;     parse arg s,k;     @= 'abcdefghijklmnopqrstuvwxyz'
    +        @=translate(@)@"0123456789(){}[]<>'"     /*add uppercase, digitss, group symbols*/
    +        @=@'~!@#$%^&*_+:";?,./`-= '              /*also add other characters to the list*/
    +        L=length(@)                              /*obtain the length of the  @  string. */
    +        ak=abs(k)                                /*obtain the absolute value of the key.*/
    +        if ak>length(@)-1 | k==0  then  call err k  'key is invalid.'
    +        _=verify(s,@)                            /*any illegal characters specified ?   */
    +        if _\==0  then call err 'unsupported character:'   substr(s, _, 1)
    +        if k>0    then ky=k+1                    /*either cypher it,  or ···            */
    +                  else ky=L+1-ak                 /*     decypher it.                    */
    +        return translate(s, substr(@ || @, ky, L),  @)
    +/*──────────────────────────────────────────────────────────────────────────────────────*/
    +err:    say;      say '***error***';       say;          say arg(1);      say;     exit 13
    diff --git a/Task/Caesar-cipher/Rust/caesar-cipher.rust b/Task/Caesar-cipher/Rust/caesar-cipher.rust
    new file mode 100644
    index 0000000000..8065eeba41
    --- /dev/null
    +++ b/Task/Caesar-cipher/Rust/caesar-cipher.rust
    @@ -0,0 +1,36 @@
    +use std::io::{self, Write};
    +use std::fmt::Display;
    +use std::{env, process};
    +
    +fn main() {
    +    let shift: u8 = env::args().nth(1)
    +        .unwrap_or_else(|| exit_err("No shift provided", 2))
    +        .parse()
    +        .unwrap_or_else(|e| exit_err(e, 3));
    +
    +    let plain = get_input()
    +        .unwrap_or_else(|e| exit_err(&e, e.raw_os_error().unwrap_or(-1)));
    +
    +    let cipher = plain.chars()
    +        .map(|c| {
    +            let case = if c.is_uppercase() {'A'} else {'a'} as u8;
    +            if c.is_alphabetic() { (((c as u8 - case + shift) % 26) + case) as char } else { c }
    +        }).collect::();
    +
    +    println!("Cipher text: {}", cipher.trim());
    +}
    +
    +
    +fn get_input() -> io::Result {
    +    print!("Plain text:  ");
    +    try!(io::stdout().flush());
    +
    +    let mut buf = String::new();
    +    try!(io::stdin().read_line(&mut buf));
    +    Ok(buf)
    +}
    +
    +fn exit_err(msg: T, code: i32) -> ! {
    +    let _ = writeln!(&mut io::stderr(), "ERROR: {}", msg);
    +    process::exit(code);
    +}
    diff --git a/Task/Caesar-cipher/ZX-Spectrum-Basic/caesar-cipher.zx b/Task/Caesar-cipher/ZX-Spectrum-Basic/caesar-cipher.zx
    new file mode 100644
    index 0000000000..6f0587bb66
    --- /dev/null
    +++ b/Task/Caesar-cipher/ZX-Spectrum-Basic/caesar-cipher.zx
    @@ -0,0 +1,13 @@
    +10 LET t$="PACK MY BOX WITH FIVE DOZEN LIQUOR JUGS"
    +20 PRINT t$''
    +30 LET key=RND*25+1
    +40 LET k=key: GO SUB 1000: PRINT t$''
    +50 LET k=26-key: GO SUB 1000: PRINT t$
    +60 STOP
    +1000 FOR i=1 TO LEN t$
    +1010 LET c= CODE t$(i)
    +1020 IF c<65 OR c>90 THEN GO TO 1050
    +1030 LET c=c+k: IF c>90 THEN LET c=c-90+64
    +1040 LET t$(i)=CHR$ c
    +1050 NEXT i
    +1060 RETURN
    diff --git a/Task/Calendar---for-REAL-programmers/00DESCRIPTION b/Task/Calendar---for-REAL-programmers/00DESCRIPTION
    index dc9837c656..5b118d6b70 100644
    --- a/Task/Calendar---for-REAL-programmers/00DESCRIPTION
    +++ b/Task/Calendar---for-REAL-programmers/00DESCRIPTION
    @@ -1,4 +1,6 @@
    -Provide an algorithm as per the [[Calendar]] task, except the entire code for the algorithm must be presented entirely without lowercase.
    +;Task:
    +Provide an algorithm as per the [[Calendar]] task, except the entire code for the algorithm must be presented   ''entirely without lowercase''.
    +
     Also - as per many 1969 era [[wp:line printer#Paper (forms) handling|line printer]]s - format the calendar to nicely fill a page that is 132 characters wide.
     
     (Hint: manually convert the code from the [[Calendar]] task to all UPPERCASE)
    @@ -24,3 +26,6 @@ For economy of size, do not actually include Snoopy generation
     in either the code or the output, instead just output a place-holder.
     
     FYI: a nice ASCII art file of Snoopy can be found at [http://www.textfiles.com/artscene/asciiart/cursepic.art textfiles.com].  Save with a .txt extension.
    +
    +'''Trivia:''' The terms uppercase and lowercase date back to the early days of the mechanical printing press.  Individual metal alloy casts of each needed letter, or punctuation symbol, were meticulously added to a press block, by hand, before rolling out copies of a page. These metal casts were stored and organized in wooden cases. The more often needed ''miniscule'' letters were placed closer to hand, in the lower cases of the work bench.  The less often needed, capitalized, ''majiscule'' letters, ended up in the harder to reach upper cases.
    +

    diff --git a/Task/Calendar---for-REAL-programmers/Elena/calendar---for-real-programmers.elena b/Task/Calendar---for-REAL-programmers/Elena/calendar---for-real-programmers.elena index 3981855392..1a8cf2cbd2 100644 --- a/Task/Calendar---for-REAL-programmers/Elena/calendar---for-real-programmers.elena +++ b/Task/Calendar---for-REAL-programmers/Elena/calendar---for-real-programmers.elena @@ -1,10 +1,10 @@ -#define system. -#define system'text. -#define system'routines. -#define system'calendar. -#define extensions. -#define extensions'math. -#define extensions'routines. +#import system. +#import system'text. +#import system'routines. +#import system'calendar. +#import extensions. +#import extensions'math. +#import extensions'routines. #symbol MonthNames = ("JANUARY","FEBRUARY","MARCH","APRIL","MAY","JUNE","JULY","AUGUST","SEPTEMBER","OCTOBER","NOVEMBER","DECEMBER"). #symbol DayNames = ("MO", "TU", "WE", "TH", "FR", "SA", "SU"). @@ -44,7 +44,6 @@ control do: [ theLine write:(theDate day literal) &paddingLeft:3 &with:#32. - theDate := theDate add &days:1. ] &until:[(theDate month != theMonth)or:[theDate dayOfWeek == 1]]. @@ -71,7 +70,6 @@ #loop (anIndex > theRow) ? [ self writeLine. ]. ] - get = self. }. @@ -114,7 +112,6 @@ aRow run &each: aMonth [ aMonth printTitleTo:anOutput. - anOutput write:" ". ]. @@ -125,10 +122,8 @@ aLine run &each: aPrinter [ aPrinter printTo:anOutput. - anOutput write:" ". ]. - anOutput writeLine. ]. ]. diff --git a/Task/Calendar---for-REAL-programmers/Lua/calendar---for-real-programmers-1.lua b/Task/Calendar---for-REAL-programmers/Lua/calendar---for-real-programmers-1.lua new file mode 100644 index 0000000000..ba10089513 --- /dev/null +++ b/Task/Calendar---for-REAL-programmers/Lua/calendar---for-real-programmers-1.lua @@ -0,0 +1,63 @@ +FUNCTION PRINT_CAL(YEAR) + LOCAL MONTHS={"JANUARY","FEBRUARY","MARCH","APRIL","MAY","JUNE", + "JULY","AUGUST","SEPTEMBER","OCTOBER","NOVEMBER","DECEMBER"} + LOCAL DAYSTITLE="MO TU WE TH FR SA SU" + LOCAL DAYSPERMONTH={31,28,31,30,31,30,31,31,30,31,30,31} + LOCAL STARTDAY=((YEAR-1)*365+MATH.FLOOR((YEAR-1)/4)-MATH.FLOOR((YEAR-1)/100)+MATH.FLOOR((YEAR-1)/400))%7 + IF YEAR%4==0 AND YEAR%100~=0 OR YEAR%400==0 THEN + DAYSPERMONTH[2]=29 + END + LOCAL SEP=5 + LOCAL MONTHWIDTH=DAYSTITLE:LEN() + LOCAL CALWIDTH=3*MONTHWIDTH+2*SEP + + FUNCTION CENTER(STR, WIDTH) + LOCAL FILL1=MATH.FLOOR((WIDTH-STR:LEN())/2) + LOCAL FILL2=WIDTH-STR:LEN()-FILL1 + RETURN STRING.REP(" ",FILL1)..STR..STRING.REP(" ",FILL2) + END + + FUNCTION MAKEMONTH(NAME, SKIP,DAYS) + LOCAL CAL={ + CENTER(NAME,MONTHWIDTH), + DAYSTITLE + } + LOCAL CURDAY=1-SKIP + WHILE #CAL<9 DO + LINE={} + FOR I=1,7 DO + IF CURDAY<1 OR CURDAY>DAYS THEN + LINE[I]=" " + ELSE + LINE[I]=STRING.FORMAT("%2D",CURDAY) + END + CURDAY=CURDAY+1 + END + CAL[#CAL+1]=TABLE.CONCAT(LINE," ") + END + RETURN CAL + END + + LOCAL CALENDAR={} + FOR I,MONTH IN IPAIRS(MONTHS) DO + LOCAL DPM=DAYSPERMONTH[I] + CALENDAR[I]=MAKEMONTH(MONTH, STARTDAY, DPM) + STARTDAY=(STARTDAY+DPM)%7 + END + + + PRINT(CENTER("[SNOOPY]",CALWIDTH):UPPER(),"\N") + PRINT(CENTER("--- "..YEAR.." ---",CALWIDTH):UPPER(),"\N") + + FOR Q=0,3 DO + FOR L=1,9 DO + LINE={} + FOR M=1,3 DO + LINE[M]=CALENDAR[Q*3+M][L] + END + PRINT(TABLE.CONCAT(LINE,STRING.REP(" ",SEP)):UPPER()) + END + END +END + +PRINT_CAL(1969) diff --git a/Task/Calendar---for-REAL-programmers/Lua/calendar---for-real-programmers-2.lua b/Task/Calendar---for-REAL-programmers/Lua/calendar---for-real-programmers-2.lua new file mode 100644 index 0000000000..a30b0996ad --- /dev/null +++ b/Task/Calendar---for-REAL-programmers/Lua/calendar---for-real-programmers-2.lua @@ -0,0 +1 @@ +do io.input( arg[ 1 ] ); local s = io.read( "*a" ):lower(); io.close(); assert( load( s ) )() end diff --git a/Task/Calendar---for-REAL-programmers/Perl-6/calendar---for-real-programmers.pl6 b/Task/Calendar---for-REAL-programmers/Perl-6/calendar---for-real-programmers.pl6 index e181e1f627..b113fb3896 100644 --- a/Task/Calendar---for-REAL-programmers/Perl-6/calendar---for-real-programmers.pl6 +++ b/Task/Calendar---for-REAL-programmers/Perl-6/calendar---for-real-programmers.pl6 @@ -1,4 +1,4 @@ -$_=["\0"..."~"];< -114 117 110 32 34 99 97 116 32 115 110 111 111 112 121 46 -116 120 116 59 99 97 108 32 64 42 65 82 71 83 91 48 93 34 ->."$_[99]$_[104]$_[114]$_[115]"()."$_[101]$_[118]$_[97]$_[108]"() +$_="\0".."~";< +115 97 121 32 34 91 73 78 83 69 82 84 32 83 78 79 79 80 89 32 72 69 82 69 93 34 +59 114 117 110 32 60 99 97 108 62 44 64 42 65 82 71 83 91 48 93 47 47 49 57 54 57 +>."$_[99]$_[104]$_[114]$_[115]"()."$_[69]$_[86]$_[65]$_[76]"() diff --git a/Task/Calendar---for-REAL-programmers/Python/calendar---for-real-programmers.py b/Task/Calendar---for-REAL-programmers/Python/calendar---for-real-programmers.py new file mode 100644 index 0000000000..7a153f50a7 --- /dev/null +++ b/Task/Calendar---for-REAL-programmers/Python/calendar---for-real-programmers.py @@ -0,0 +1,5 @@ +import subprocess +px = subprocess.Popen(['python', '-c', 'import calendar; calendar.prcal(1969)'], + stdout=subprocess.PIPE) +cal = px.communicate()[0] +print cal.upper() diff --git a/Task/Calendar/360-Assembly/calendar.360 b/Task/Calendar/360-Assembly/calendar.360 new file mode 100644 index 0000000000..9123a259a8 --- /dev/null +++ b/Task/Calendar/360-Assembly/calendar.360 @@ -0,0 +1,180 @@ +* calendar 08/06/2016 +CALENDAR CSECT + USING CALENDAR,R13 base register + B 72(R15) skip savearea + DC 17F'0' savearea + STM R14,R12,12(R13) prolog + ST R13,4(R15) " + ST R15,8(R13) " + LR R13,R15 " + L R4,YEAR year + SRDA R4,32 . + D R4,=F'4' year//4 + LTR R4,R4 if year//4=0 + BNZ LYNOT + L R4,YEAR year + SRDA R4,32 . + D R4,=F'100' year//100 + LTR R4,R4 if year//100=0 + BNZ LY + L R4,YEAR year + SRDA R4,32 . + D R4,=F'400' if year//400 + LTR R4,R4 if year//400=0 + BNZ LYNOT +LY MVC ML+2,=H'29' ml(2)=29 leapyear +LYNOT SR R10,R10 ltd1=0 + LA R6,1 i=1 +LOOPI1 C R6,=F'31' do i=1 to 31 + BH ELOOPI1 + XDECO R6,XDEC edit i + LA R14,TD1 td1 + AR R14,R10 td1+ltd1 + MVC 0(3,R14),XDEC+9 sub(td1,ltd1+1,3)=pic(i,3) + LA R10,3(R10) ltd1+3 + LA R6,1(R6) i=i+1 + B LOOPI1 +ELOOPI1 LA R6,1 i=1 +LOOPI2 C R6,=F'12' do i=1 to 12 + BH ELOOPI2 + ST R6,M m=i + MVC D,=F'1' d=1 + MVC YY,YEAR yy=year + L R4,M m + C R4,=F'3' if m<3 + BNL GE3 + L R2,M m + LA R2,12(R2) m+12 + ST R2,M m=m+12 + L R2,YY yy + BCTR R2,0 yy-1 + ST R2,YY yy=yy-1 +GE3 L R2,YY yy + LR R1,R2 yy + SRA R1,2 yy/4 + AR R2,R1 yy+(yy/4) + L R4,YY yy + SRDA R4,32 . + D R4,=F'100' yy/100 + SR R2,R5 yy+(yy/4)-(yy/100) + L R4,YY yy + SRDA R4,32 . + D R4,=F'400' yy/400 + AR R2,R5 yy+(yy/4)-(yy/100)+(yy/400) + A R2,D r2=yy+(yy/4)-(yy/100)+(yy/400)+d + LA R5,153 153 + M R4,M 153*m + LA R5,8(R5) 153*m+8 + D R4,=F'5' (153*m+8)/5 + AR R5,R2 ((153*m+8)/5+r2 + LA R4,0 . + D R4,=F'7' r4=mod(r5,7) 0=sun 1=mon ... 6=sat + LTR R4,R4 if j=0 + BNZ JNE0 + LA R4,7 j=7 +JNE0 BCTR R4,0 j-1 + MH R4,=H'3' j*3 + LR R10,R4 j1=j*3 + LR R1,R6 i + SLA R1,1 *2 + LH R11,ML-2(R1) ml(i) + MH R11,=H'3' j2=ml(i)*3 + MVC TD2,BLANK td2=' ' + LA R4,TD1 @td1 + LR R5,R11 j2 + LA R2,TD2 @td2 + AR R2,R10 @td2+j1 + LR R3,R5 j2 + MVCL R2,R4 sub(td2,j1+1,j2)=sub(td1,1,j2) + LR R1,R6 i + MH R1,=H'144' *144 + LA R14,DA-144(R1) @da(i) + MVC 0(144,R14),TD2 da(i)=td2 + LA R6,1(R6) i=i+1 + B LOOPI2 +ELOOPI2 L R1,YEAR year + XDECO R1,PG+23 edit year + XPRNT PG,35 print year + MVC WDLINE,BLANK wdline=' ' + LA R10,1 lwdline=1 + LA R8,1 k=1 +LOOPK3 C R8,=F'3' do k=1 to 3 + BH ELOOPK3 + LA R4,WDLINE @wdline + AR R4,R10 +lwdline + MVC 0(20,R4),WDNA sub(wdline,lwdline+1,20)=wdna + LA R10,20(R10) lwdline=lwdline+20 + C R8,=F'3' if k<3 + BNL ITERK3 + LA R10,2(R10) lwdline=lwdline+2 +ITERK3 LA R8,1(R8) k=k+1 + B LOOPK3 +ELOOPK3 LA R6,1 i=1 +LOOPI4 C R6,=F'12' do i=1 to 12 by 3 + BH ELOOPI4 + MVC MOLINE,BLANK moline=' ' + LA R10,6 lmoline=6 + LR R8,R6 k=i +LOOPK4 LA R2,2(R6) i+2 + CR R8,R2 do k=i to i+2 + BH ELOOPK4 + LR R1,R8 k + MH R1,=H'10' *10 + LA R3,MO-10(R1) mo(k) + LA R4,MOLINE @moline + AR R4,R10 +lmoline + MVC 0(10,R4),0(R3) sub(moline,lmoline+1,10)=mo(k) + LA R10,22(R10) lmoline=lmoline+22 + LA R8,1(R8) k=k+1 + B LOOPK4 +ELOOPK4 XPRNT MOLINE,L'MOLINE print months + XPRNT WDLINE,L'WDLINE print days of week + LA R7,1 j=1 +LOOPJ4 C R7,=F'106' do j=1 to 106 by 21 + BH ELOOPJ4 + MVC PG,BLANK clear buffer + LA R9,PG pgi=0 + LR R8,R6 k=i +LOOPK5 LA R2,2(R6) i+2 + CR R8,R2 do k=i to i+2 + BH ELOOPK5 + LR R1,R8 k + MH R1,=H'144' *144 + LA R4,DA-144(R1) da(k) + BCTR R4,0 -1 + AR R4,R7 +j + MVC 0(21,R9),0(R4) substr(da(k),j,21) + LA R9,22(R9) pgi=pgi+22 + LA R8,1(R8) k=k+1 + B LOOPK5 +ELOOPK5 XPRNT PG,L'PG print buffer + LA R7,21(R7) j=j+21 + B LOOPJ4 +ELOOPJ4 LA R6,3(R6) i=i+3 + B LOOPI4 +ELOOPI4 L R13,4(0,R13) epilog + LM R14,R12,12(R13) " + XR R15,R15 " + BR R14 exit + LTORG +YEAR DC F'1969' <== +MO DC CL10' January ',CL10' February ',CL10' March ' + DC CL10' April ',CL10' May ',CL10' June ' + DC CL10' July ',CL10' August ',CL10'September ' + DC CL10' October ',CL10' November ',CL10' December ' +ML DC H'31',H'28',H'31',H'30',H'31',H'30' + DC H'31',H'31',H'30',H'31',H'30',H'31' +WDNA DC CL20'Mo Tu We Th Fr Sa Su' +M DS F +D DS F +YY DS F +TD1 DS CL93 +TD2 DS CL144 +MOLINE DS CL66 +WDLINE DS CL66 +PG DC CL66' ' +XDEC DS CL12 +BLANK DC CL144' ' +DA DS 12CL144 + YREG + END CALENDAR diff --git a/Task/Calendar/F-Sharp/calendar.fs b/Task/Calendar/F-Sharp/calendar.fs new file mode 100644 index 0000000000..5ddaef5a96 --- /dev/null +++ b/Task/Calendar/F-Sharp/calendar.fs @@ -0,0 +1,71 @@ +let getCalendar year = + let day_of_week month year = + let t = [|0; 3; 2; 5; 0; 3; 5; 1; 4; 6; 2; 4|] + let y = if month < 3 then year - 1 else year + let m = month + let d = 1 + (y + y / 4 - y / 100 + y / 400 + t.[m - 1] + d) % 7 + //0 = Sunday, 1 = Monday, ... + + let last_day_of_month month year = + match month with + | 2 -> if (0 = year % 4 && (0 = year % 400 || 0 <> year % 100)) then 29 else 28 + | 4 | 6 | 9 | 11 -> 30 + | _ -> 31 + + let get_month_calendar year month = + let min (x: int, y: int) = if x < y then x else y + let ld = last_day_of_month month year + let dw = 7 - (day_of_week month year) + [|[|1..dw|]; + [|dw + 1..dw + 7|]; + [|dw + 8..dw + 14|]; + [|dw + 15..dw + 21|]; + [|dw + 22..min(ld, dw + 28)|]; + [|min(ld + 1, dw + 29)..ld|]|] + + let sb_fold (f:System.Text.StringBuilder -> 'a -> System.Text.StringBuilder) (sb:System.Text.StringBuilder) (xs:'a array) = + for x in xs do (f sb x) |> ignore + sb + + let sb_append (text:string) (sb:System.Text.StringBuilder) = sb.Append(text) + + let sb_appendln sb = sb |> sb_append "\n" |> ignore + + let sb_fold_in_range a b f sb = [|a..b|] |> sb_fold f sb |> ignore + + let mask_builder mask = Printf.StringFormat string>(mask) + let center n (s:string) = + let l = (n - s.Length) / 2 + s.Length + let f n s = sprintf (mask_builder ("%" + (n.ToString()) + "s")) s + (f l s) + (f (n - l) "") + let left n (s:string) = sprintf (mask_builder ("%-" + (n.ToString()) + "s")) s + let right n (s:string) = sprintf (mask_builder ("%" + (n.ToString()) + "s")) s + + let array2string xs = + let ys = xs |> Array.map (fun x -> sprintf "%2d " x) + let sb = ys |> sb_fold (fun sb y -> sb.Append(y)) (new System.Text.StringBuilder()) + sb.ToString() + + let xsss = + let m = get_month_calendar year + [|1..12|] |> Array.map (fun i -> m i) + + let months = [|"January"; "February"; "March"; "April"; "May"; "June"; "July"; "August"; "September"; "October"; "November"; "December"|] + + let sb = new System.Text.StringBuilder() + sb |> sb_append "\n" |> sb_append (center 74 (year.ToString())) |> sb_appendln + for i in 0..3..9 do + sb |> sb_appendln + sb |> sb_fold_in_range i (i + 2) (fun sb i -> sb |> sb_append (center 21 months.[i]) |> sb_append " ") + sb |> sb_appendln + sb |> sb_fold_in_range i (i + 2) (fun sb i -> sb |> sb_append "Su Mo Tu We Th Fr Sa " |> sb_append " ") + sb |> sb_appendln + sb |> sb_fold_in_range i (i + 2) (fun sb i -> sb |> sb_append (right 21 (array2string (xsss.[i].[0]))) |> sb_append " ") + sb |> sb_appendln + for j = 1 to 5 do + sb |> sb_fold_in_range i (i + 2) (fun sb i -> sb |> sb_append (left 21 (array2string (xsss.[i].[j]))) |> sb_append " ") + sb |> sb_appendln + sb.ToString() + +let printCalendar year = getCalendar year diff --git a/Task/Calendar/Haskell/calendar.hs b/Task/Calendar/Haskell/calendar.hs index 23d896bd93..1241c28bdb 100644 --- a/Task/Calendar/Haskell/calendar.hs +++ b/Task/Calendar/Haskell/calendar.hs @@ -71,10 +71,8 @@ center :: Int -> String -> String center i a = T.unpack . (T.center i ' ') $ T.pack a printCal :: [[[T.Text]]] -> IO () -printCal [] = return () -printCal (c:cx) = do - mapM_ (putStrLn . T.unpack) rows - printCal cx +printCal = mapM_ f where + f c = mapM_ (putStrLn . T.unpack) rows where rows = map (T.intercalate calMargin) $ transpose c printCalendar :: Integer -> Int -> IO () diff --git a/Task/Calendar/Kotlin/calendar.kotlin b/Task/Calendar/Kotlin/calendar.kotlin new file mode 100644 index 0000000000..40e4f67d61 --- /dev/null +++ b/Task/Calendar/Kotlin/calendar.kotlin @@ -0,0 +1,52 @@ +import java.text.* +import java.util.* +import java.io.PrintStream + +internal fun PrintStream.printCalendar(year: Int, nCols: Byte, locale: Locale?) { + if (nCols < 1 || nCols > 12) + throw IllegalArgumentException("Illegal column width.") + val w = nCols * 24 + val nRows = Math.ceil(12.0 / nCols).toInt() + + val date = GregorianCalendar(year, 0, 1) + var offs = date.get(Calendar.DAY_OF_WEEK) - 1 + + val days = DateFormatSymbols(locale).shortWeekdays.slice(1..7).map { it.slice(0..1) }.joinToString(" ", " ") + val mons = Array(12) { Array(8) { "" } } + DateFormatSymbols(locale).months.slice(0..11).forEachIndexed { m, name -> + val len = 11 + name.length / 2 + val format = MessageFormat.format("%{0}s%{1}s", len, 21 - len) + mons[m][0] = String.format(format, name, "") + mons[m][1] = days + val dim = date.getActualMaximum(Calendar.DAY_OF_MONTH) + for (d in 1..42) { + val isDay = d > offs && d <= offs + dim + val entry = if (isDay) String.format(" %2s", d - offs) else " " + if (d % 7 == 1) + mons[m][2 + (d - 1) / 7] = entry + else + mons[m][2 + (d - 1) / 7] += entry + } + offs = (offs + dim) % 7 + date.add(Calendar.MONTH, 1) + } + + printf("%" + (w / 2 + 10) + "s%n", "[Snoopy Picture]") + printf("%" + (w / 2 + 4) + "s%n%n", year) + + for (r in 0..nRows - 1) { + for (i in 0..7) { + var c = r * nCols + while (c < (r + 1) * nCols && c < 12) { + printf(" %s", mons[c][i]) + c++ + } + println() + } + println() + } +} + +fun main(args: Array) { + System.out.printCalendar(1969, 3, Locale.US) +} diff --git a/Task/Calendar/Lua/calendar.lua b/Task/Calendar/Lua/calendar.lua new file mode 100644 index 0000000000..1e7cbac4c0 --- /dev/null +++ b/Task/Calendar/Lua/calendar.lua @@ -0,0 +1,63 @@ +function print_cal(year) + local months={"JANUARY","FEBRUARY","MARCH","APRIL","MAY","JUNE", + "JULY","AUGUST","SEPTEMBER","OCTOBER","NOVEMBER","DECEMBER"} + local daysTitle="MO TU WE TH FR SA SU" + local daysPerMonth={31,28,31,30,31,30,31,31,30,31,30,31} + local startday=((year-1)*365+math.floor((year-1)/4)-math.floor((year-1)/100)+math.floor((year-1)/400))%7 + if year%4==0 and year%100~=0 or year%400==0 then + daysPerMonth[2]=29 + end + local sep=5 + local monthwidth=daysTitle:len() + local calwidth=3*monthwidth+2*sep + + function center(str, width) + local fill1=math.floor((width-str:len())/2) + local fill2=width-str:len()-fill1 + return string.rep(" ",fill1)..str..string.rep(" ",fill2) + end + + function makeMonth(name, skip,days) + local cal={ + center(name,monthwidth), + daysTitle + } + local curday=1-skip + while #cal<9 do + line={} + for i=1,7 do + if curday<1 or curday>days then + line[i]=" " + else + line[i]=string.format("%2d",curday) + end + curday=curday+1 + end + cal[#cal+1]=table.concat(line," ") + end + return cal + end + + local calendar={} + for i,month in ipairs(months) do + local dpm=daysPerMonth[i] + calendar[i]=makeMonth(month, startday, dpm) + startday=(startday+dpm)%7 + end + + + print(center("[SNOOPY]",calwidth),"\n") + print(center("--- "..year.." ---",calwidth),"\n") + + for q=0,3 do + for l=1,9 do + line={} + for m=1,3 do + line[m]=calendar[q*3+m][l] + end + print(table.concat(line,string.rep(" ",sep))) + end + end +end + +print_cal(1969) diff --git a/Task/Call-a-foreign-language-function/00DESCRIPTION b/Task/Call-a-foreign-language-function/00DESCRIPTION index ead05b9dda..7ecb0b8ee0 100644 --- a/Task/Call-a-foreign-language-function/00DESCRIPTION +++ b/Task/Call-a-foreign-language-function/00DESCRIPTION @@ -1,11 +1,16 @@ +;Task: Show how a [[Foreign function interface|foreign language function]] can be called from the language. + As an example, consider calling functions defined in the [[C]] language. Create a string containing "Hello World!" of the string type typical to the language. Pass the string content to [[C]]'s strdup. The content can be copied if necessary. Get the result from strdup and print it using language means. Do not forget to free the result of strdup (allocated in the heap). -Notes: + +;Notes: * It is not mandated if the [[C]] run-time library is to be loaded statically or dynamically. You are free to use either way. * [[C++]] and [[C]] solutions can take some other language to communicate with. * It is ''not'' mandatory to use strdup, especially if the foreign function interface being demonstrated makes that uninformative. -See also: -* [[Use another language to call a function]] + +;See also: +*   [[Use another language to call a function]] +

    diff --git a/Task/Call-a-foreign-language-function/COBOL/call-a-foreign-language-function.cobol b/Task/Call-a-foreign-language-function/COBOL/call-a-foreign-language-function.cobol new file mode 100644 index 0000000000..5993b75909 --- /dev/null +++ b/Task/Call-a-foreign-language-function/COBOL/call-a-foreign-language-function.cobol @@ -0,0 +1,27 @@ + identification division. + program-id. foreign. + + data division. + working-storage section. + 01 hello. + 05 value z"Hello, world". + 01 duplicate usage pointer. + 01 buffer pic x(16) based. + 01 storage pic x(16). + + procedure division. + call "strdup" using hello returning duplicate + on exception + display "error calling strdup" upon syserr + end-call + if duplicate equal null then + display "strdup returned null" upon syserr + else + set address of buffer to duplicate + string buffer delimited by low-value into storage + display function trim(storage) + call "free" using by value duplicate + on exception + display "error calling free" upon syserr + end-if + goback. diff --git a/Task/Call-a-foreign-language-function/Fortran/call-a-foreign-language-function.f b/Task/Call-a-foreign-language-function/Fortran/call-a-foreign-language-function.f new file mode 100644 index 0000000000..feed6cbaea --- /dev/null +++ b/Task/Call-a-foreign-language-function/Fortran/call-a-foreign-language-function.f @@ -0,0 +1,45 @@ +module c_api + use iso_c_binding + implicit none + + interface + function strdup(ptr) bind(C) + import c_ptr + type(c_ptr), value :: ptr + type(c_ptr) :: strdup + end function + end interface + + interface + subroutine free(ptr) bind(C) + import c_ptr + type(c_ptr), value :: ptr + end subroutine + end interface + + interface + function puts(ptr) bind(C) + import c_ptr, c_int + type(c_ptr), value :: ptr + integer(c_int) :: puts + end function + end interface +end module + +program c_example + use c_api + implicit none + + character(20), target :: str = "Hello, World!" // c_null_char + type(c_ptr) :: ptr + integer(c_int) :: res + + ptr = strdup(c_loc(str)) + + res = puts(c_loc(str)) + res = puts(ptr) + + print *, transfer(c_loc(str), 0_c_intptr_t), & + transfer(ptr, 0_c_intptr_t) + call free(ptr) +end program diff --git a/Task/Call-a-foreign-language-function/Perl-6/call-a-foreign-language-function.pl6 b/Task/Call-a-foreign-language-function/Perl-6/call-a-foreign-language-function.pl6 index 0081c0427e..8cbc4693dd 100644 --- a/Task/Call-a-foreign-language-function/Perl-6/call-a-foreign-language-function.pl6 +++ b/Task/Call-a-foreign-language-function/Perl-6/call-a-foreign-language-function.pl6 @@ -1,8 +1,8 @@ use NativeCall; sub strdup(Str $s --> OpaquePointer) is native {*} -sub puts(OpaquePointer $p --> int) is native {*} -sub free(OpaquePointer $p --> int) is native {*} +sub puts(OpaquePointer $p --> int32) is native {*} +sub free(OpaquePointer $p --> int32) is native {*} my $p = strdup("Success!"); say 'puts returns ', puts($p); diff --git a/Task/Call-a-foreign-language-function/Rust/call-a-foreign-language-function.rust b/Task/Call-a-foreign-language-function/Rust/call-a-foreign-language-function.rust new file mode 100644 index 0000000000..bd71df502a --- /dev/null +++ b/Task/Call-a-foreign-language-function/Rust/call-a-foreign-language-function.rust @@ -0,0 +1,13 @@ +extern crate libc; + +//c function that returns the sum of two integers +extern { + fn add_input(in1: libc::c_int, in2: libc::c_int) -> libc::c_int; +} + +fn main() { + let (in1, in2) = (5, 4); + let output = unsafe { + add_input(in1, in2) }; + assert!( (output == (in1 + in2) ),"Error in sum calculation") ; +} diff --git a/Task/Call-a-function-in-a-shared-library/COBOL/call-a-function-in-a-shared-library.cobol b/Task/Call-a-function-in-a-shared-library/COBOL/call-a-function-in-a-shared-library.cobol new file mode 100644 index 0000000000..da813822b4 --- /dev/null +++ b/Task/Call-a-function-in-a-shared-library/COBOL/call-a-function-in-a-shared-library.cobol @@ -0,0 +1,37 @@ + identification division. + program-id. callsym. + + data division. + working-storage section. + 01 handle usage pointer. + 01 addr usage program-pointer. + + procedure division. + call "dlopen" using + by reference null + by value 1 + returning handle + on exception + display function exception-statement upon syserr + goback + end-call + if handle equal null then + display function module-id ": error getting dlopen handle" + upon syserr + goback + end-if + + call "dlsym" using + by value handle + by content z"perror" + returning addr + end-call + if addr equal null then + display function module-id ": error getting perror symbol" + upon syserr + else + call addr returning omitted + end-if + + goback. + end program callsym. diff --git a/Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-4.f b/Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-4.f new file mode 100644 index 0000000000..b593a931cc --- /dev/null +++ b/Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-4.f @@ -0,0 +1,6 @@ +function ffun(x, y) + implicit none + !DEC$ ATTRIBUTES DLLEXPORT, STDCALL, REFERENCE :: FFUN + double precision :: x, y, ffun + ffun = x + y * y +end function diff --git a/Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-5.f b/Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-5.f new file mode 100644 index 0000000000..963c29ea9d --- /dev/null +++ b/Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-5.f @@ -0,0 +1,30 @@ +program dynload + use kernel32 + use iso_c_binding + implicit none + + abstract interface + function ffun_int(x, y) + !DEC$ ATTRIBUTES STDCALL, REFERENCE :: ffun_int + double precision :: ffun_int, x, y + end function + end interface + + procedure(ffun_int), pointer :: ffun_ptr + + integer(c_intptr_t) :: ptr + integer(handle) :: h + double precision :: x, y + + h = LoadLibrary("dllfun.dll" // c_null_char) + if (h == 0) error stop "Error: LoadLibrary" + + ptr = GetProcAddress(h, "ffun" // c_null_char) + if (ptr == 0) error stop "Error: GetProcAddress" + + call c_f_procpointer(transfer(ptr, c_null_funptr), ffun_ptr) + read *, x, y + print *, ffun_ptr(x, y) + + if (FreeLibrary(h) == 0) error stop "Error: FreeLibrary" +end program diff --git a/Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-6.f b/Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-6.f new file mode 100644 index 0000000000..fc0b0321d2 --- /dev/null +++ b/Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-6.f @@ -0,0 +1,6 @@ +function ffun(x, y) + implicit none + !GCC$ ATTRIBUTES DLLEXPORT, STDCALL :: FFUN + double precision :: x, y, ffun + ffun = x + y * y +end function diff --git a/Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-7.f b/Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-7.f new file mode 100644 index 0000000000..0a84cc64de --- /dev/null +++ b/Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-7.f @@ -0,0 +1,30 @@ +program dynload + use kernel32 + use iso_c_binding + implicit none + + abstract interface + function ffun_int(x, y) + !GCC$ ATTRIBUTES DLLEXPORT, STDCALL :: FFUN + double precision :: ffun_int, x, y + end function + end interface + + procedure(ffun_int), pointer :: ffun_ptr + + integer(c_intptr_t) :: ptr + integer(handle) :: h + double precision :: x, y + + h = LoadLibrary("dllfun.dll" // c_null_char) + if (h == 0) error stop "Error: LoadLibrary" + + ptr = GetProcAddress(h, "ffun_@8" // c_null_char) + if (ptr == 0) error stop "Error: GetProcAddress" + + call c_f_procpointer(transfer(ptr, c_null_funptr), ffun_ptr) + read *, x, y + print *, ffun_ptr(x, y) + + if (FreeLibrary(h) == 0) error stop "Error: FreeLibrary" +end program diff --git a/Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-8.f b/Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-8.f new file mode 100644 index 0000000000..d442752168 --- /dev/null +++ b/Task/Call-a-function-in-a-shared-library/Fortran/call-a-function-in-a-shared-library-8.f @@ -0,0 +1,35 @@ +module kernel32 + use iso_c_binding + implicit none + integer, parameter :: HANDLE = C_INTPTR_T + integer, parameter :: PVOID = C_INTPTR_T + integer, parameter :: BOOL = C_INT + + interface + function LoadLibrary(lpFileName) bind(C, name="LoadLibraryA") + import C_CHAR, HANDLE + !GCC$ ATTRIBUTES STDCALL :: LoadLibrary + integer(HANDLE) :: LoadLibrary + character(C_CHAR) :: lpFileName + end function + end interface + + interface + function FreeLibrary(hModule) bind(C, name="FreeLibrary") + import HANDLE, BOOL + !GCC$ ATTRIBUTES STDCALL :: FreeLibrary + integer(BOOL) :: FreeLibrary + integer(HANDLE), value :: hModule + end function + end interface + + interface + function GetProcAddress(hModule, lpProcName) bind(C, name="GetProcAddress") + import C_CHAR, PVOID, HANDLE + !GCC$ ATTRIBUTES STDCALL :: GetProcAddress + integer(PVOID) :: GetProcAddress + integer(HANDLE), value :: hModule + character(C_CHAR) :: lpProcName + end function + end interface +end module diff --git a/Task/Call-a-function-in-a-shared-library/VBA/call-a-function-in-a-shared-library-1.vba b/Task/Call-a-function-in-a-shared-library/VBA/call-a-function-in-a-shared-library-1.vba new file mode 100644 index 0000000000..ef00993b3a --- /dev/null +++ b/Task/Call-a-function-in-a-shared-library/VBA/call-a-function-in-a-shared-library-1.vba @@ -0,0 +1,6 @@ +function ffun(x, y) + implicit none + !DEC$ ATTRIBUTES DLLEXPORT, STDCALL, REFERENCE :: ffun + double precision :: x, y, ffun + ffun = x + y * y +end function diff --git a/Task/Call-a-function-in-a-shared-library/VBA/call-a-function-in-a-shared-library-2.vba b/Task/Call-a-function-in-a-shared-library/VBA/call-a-function-in-a-shared-library-2.vba new file mode 100644 index 0000000000..4fcb39c1d1 --- /dev/null +++ b/Task/Call-a-function-in-a-shared-library/VBA/call-a-function-in-a-shared-library-2.vba @@ -0,0 +1,8 @@ +Option Explicit +Declare Function ffun Lib "vbafun" (ByRef x As Double, ByRef y As Double) As Double +Sub Test() + Dim x As Double, y As Double + x = 2# + y = 10# + Debug.Print ffun(x, y) +End Sub diff --git a/Task/Call-a-function/00DESCRIPTION b/Task/Call-a-function/00DESCRIPTION index 30eb7d3ec6..6bf90ab912 100644 --- a/Task/Call-a-function/00DESCRIPTION +++ b/Task/Call-a-function/00DESCRIPTION @@ -1,15 +1,21 @@ -The task is to demonstrate the different syntax and semantics provided for calling a function. This may include: -* Calling a function that requires no arguments -* Calling a function with a fixed number of arguments -* Calling a function with [[Optional parameters|optional arguments]] -* Calling a function with a [[Variadic function|variable number of arguments]] -* Calling a function with [[Named parameters|named arguments]] -* Using a function in statement context -* Using a function in [[First-class functions|first-class context]] within an expression -* Obtaining the return value of a function -* Distinguishing built-in functions and user-defined functions -* Distinguishing subroutines and functions -* Stating whether arguments are [[:Category:Parameter passing|passed]] by value or by reference -* Is partial application possible and how +;Task: +Demonstrate the different syntax and semantics provided for calling a function. + +This may include: +:*   Calling a function that requires no arguments +:*   Calling a function with a fixed number of arguments +:*   Calling a function with [[Optional parameters|optional arguments]] +:*   Calling a function with a [[Variadic function|variable number of arguments]] +:*   Calling a function with [[Named parameters|named arguments]] +:*   Using a function in statement context +:*   Using a function in [[First-class functions|first-class context]] within an expression +:*   Obtaining the return value of a function +:*   Distinguishing built-in functions and user-defined functions +:*   Distinguishing subroutines and functions +;*   Stating whether arguments are [[:Category:Parameter passing|passed]] by value or by reference +;*   Is partial application possible and how + +
    This task is ''not'' about [[Function definition|defining functions]]. +

    diff --git a/Task/Call-a-function/BBC-BASIC/call-a-function-1.bbc b/Task/Call-a-function/BBC-BASIC/call-a-function-1.bbc new file mode 100644 index 0000000000..f865a793ed --- /dev/null +++ b/Task/Call-a-function/BBC-BASIC/call-a-function-1.bbc @@ -0,0 +1 @@ +PRINT SQR(2) diff --git a/Task/Call-a-function/BBC-BASIC/call-a-function-2.bbc b/Task/Call-a-function/BBC-BASIC/call-a-function-2.bbc new file mode 100644 index 0000000000..b6bb7a42af --- /dev/null +++ b/Task/Call-a-function/BBC-BASIC/call-a-function-2.bbc @@ -0,0 +1 @@ +PRINT SQR 2 diff --git a/Task/Call-a-function/BBC-BASIC/call-a-function-3.bbc b/Task/Call-a-function/BBC-BASIC/call-a-function-3.bbc new file mode 100644 index 0000000000..2807fa2d69 --- /dev/null +++ b/Task/Call-a-function/BBC-BASIC/call-a-function-3.bbc @@ -0,0 +1 @@ +PRINT FN_foo(bar$, baz%) diff --git a/Task/Call-a-function/BBC-BASIC/call-a-function-4.bbc b/Task/Call-a-function/BBC-BASIC/call-a-function-4.bbc new file mode 100644 index 0000000000..9622c7aea6 --- /dev/null +++ b/Task/Call-a-function/BBC-BASIC/call-a-function-4.bbc @@ -0,0 +1 @@ +PRINT FN_foo diff --git a/Task/Call-a-function/BBC-BASIC/call-a-function-5.bbc b/Task/Call-a-function/BBC-BASIC/call-a-function-5.bbc new file mode 100644 index 0000000000..fea80f7963 --- /dev/null +++ b/Task/Call-a-function/BBC-BASIC/call-a-function-5.bbc @@ -0,0 +1 @@ +PROC_foo diff --git a/Task/Call-a-function/BBC-BASIC/call-a-function-6.bbc b/Task/Call-a-function/BBC-BASIC/call-a-function-6.bbc new file mode 100644 index 0000000000..bb745c1593 --- /dev/null +++ b/Task/Call-a-function/BBC-BASIC/call-a-function-6.bbc @@ -0,0 +1 @@ +PROC_foo(bar$, baz%, quux) diff --git a/Task/Call-a-function/BBC-BASIC/call-a-function-7.bbc b/Task/Call-a-function/BBC-BASIC/call-a-function-7.bbc new file mode 100644 index 0000000000..47869cdd4a --- /dev/null +++ b/Task/Call-a-function/BBC-BASIC/call-a-function-7.bbc @@ -0,0 +1 @@ +DEF PROC_foo(a$, RETURN b%, RETURN c) diff --git a/Task/Call-a-function/BBC-BASIC/call-a-function-8.bbc b/Task/Call-a-function/BBC-BASIC/call-a-function-8.bbc new file mode 100644 index 0000000000..0ef0bbedc9 --- /dev/null +++ b/Task/Call-a-function/BBC-BASIC/call-a-function-8.bbc @@ -0,0 +1 @@ +200 GOSUB 30050 diff --git a/Task/Call-a-function/C/call-a-function.c b/Task/Call-a-function/C/call-a-function.c index 9bcdfa4817..6573a20595 100644 --- a/Task/Call-a-function/C/call-a-function.c +++ b/Task/Call-a-function/C/call-a-function.c @@ -30,8 +30,25 @@ void h(int a, ...) /* call it as: (if you feed it something it doesn't expect, don't count on it working) */ h(1, 2, 3, 4, "abcd", (void*)0); -/* named arguments: no such thing */ -/* statement context: is that a real phrase? */ +/* named arguments: this is only possible through some pre-processor abuse +*/ +struct v_args { + int arg1; + int arg2; + char _sentinel; +}; + +void _v(struct v_args args) +{ + printf("%d, %d\n", args.arg1, args.arg2); +} + +#define v(...) _v((struct v_args){__VA_ARGS__}) + +v(.arg2 = 5, .arg1 = 17); // prints "17,5" +/* NOTE the above implementation gives us optional typesafe optional arguments as well (unspecified arguments are initialized to zero)*/ +v(.arg2=1); // prints "0,1" +v(); // prints "0,0" /* as a first-class object (i.e. function pointer) */ printf("%p", f); /* that's the f() above */ diff --git a/Task/Call-a-function/Elixir/call-a-function.elixir b/Task/Call-a-function/Elixir/call-a-function.elixir new file mode 100644 index 0000000000..50dfd3b6ec --- /dev/null +++ b/Task/Call-a-function/Elixir/call-a-function.elixir @@ -0,0 +1,57 @@ +# Anonymous function + +foo = fn() -> + IO.puts("foo") +end + +foo() #=> undefined function foo/0 +foo.() #=> "foo" + +# Using `def` + +defmodule Foo do + def foo do + IO.puts("foo") + end +end + +Foo.foo #=> "foo" +Foo.foo() #=> "foo" + + +# Calling a function with a fixed number of arguments + +defmodule Foo do + def foo(x) do + IO.puts(x) + end +end + +Foo.foo("foo") #=> "foo" + +# Calling a function with a default argument + +defmodule Foo do + def foo(x \\ "foo") do + IO.puts(x) + end +end + +Foo.foo() #=> "foo" +Foo.foo("bar") #=> "bar" + +# There is no such thing as a function with a variable number of arguments. So in Elixir, you'd call the function with a list + +defmodule Foo do + def foo(args) when is_list(args) do + Enum.each(args, &(IO.puts(&1))) + end +end + +# Calling a function with named arguments + +defmodule Foo do + def foo([x: x]) do + IO.inspect(x) + end +end diff --git a/Task/Call-a-function/Fortran/call-a-function.f b/Task/Call-a-function/Fortran/call-a-function-1.f similarity index 96% rename from Task/Call-a-function/Fortran/call-a-function.f rename to Task/Call-a-function/Fortran/call-a-function-1.f index f114936f6c..cd1b247816 100644 --- a/Task/Call-a-function/Fortran/call-a-function.f +++ b/Task/Call-a-function/Fortran/call-a-function-1.f @@ -22,7 +22,7 @@ write(*,*) 'named arguments: ', h(c=4,b=8,a=5) write(*,*) '-----------------' write(*,*) 'function in statement context: Does not apply!' write(*,*) '-----------------' -write(*,*) 'Fortran passes memorty location of variables as arguments.' +write(*,*) 'Fortran passes memory location of variables as arguments.' write(*,*) 'So an argument can hold the return value.' write(*,*) 'function result: ', g(5,8,lresult) , ' function successful? ', lresult write(*,*) '-----------------' diff --git a/Task/Call-a-function/Fortran/call-a-function-2.f b/Task/Call-a-function/Fortran/call-a-function-2.f new file mode 100644 index 0000000000..64f9b3b889 --- /dev/null +++ b/Task/Call-a-function/Fortran/call-a-function-2.f @@ -0,0 +1,4 @@ + REAL this,that + DIST(X,Y,Z) = SQRT(X**2 + Y**2 + Z**2) + this/that !One arithmetic statement, possibly lengthy. + ... + D = 3 + DIST(X1 - X2,YDIFF,SQRT(ZD2)) !Invoke local function DIST. diff --git a/Task/Call-a-function/Fortran/call-a-function-3.f b/Task/Call-a-function/Fortran/call-a-function-3.f new file mode 100644 index 0000000000..b815dfbb33 --- /dev/null +++ b/Task/Call-a-function/Fortran/call-a-function-3.f @@ -0,0 +1,2 @@ + H = A + B + IF (blah) H = 3*H - 7 diff --git a/Task/Call-a-function/Fortran/call-a-function-4.f b/Task/Call-a-function/Fortran/call-a-function-4.f new file mode 100644 index 0000000000..dadd38ceff --- /dev/null +++ b/Task/Call-a-function/Fortran/call-a-function-4.f @@ -0,0 +1,25 @@ + REAL FUNCTION INTG8(F,A,B,DX) !Integrate function F. + EXTERNAL F !Some function of one parameter. + REAL A,B !Bounds. + REAL DX !Step. + INTEGER N !A counter. + INTG8 = F(A) + F(B) !Get the ends exactly. + N = (B - A)/DX !Truncates. Ignore A + N*DX = B chances. + DO I = 1,N !Step along the interior. + INTG8 = INTG8 + F(A + I*DX) !Evaluate the function. + END DO !On to the next. + INTG8 = INTG8/(N + 2)*(B - A) !Average value times interval width. + END FUNCTION INTG8 !This is not a good calculation! + + FUNCTION TRIAL(X) !Some user-written function. + REAL X + TRIAL = 1 + X !This will do. + END FUNCTION TRIAL !Not the name of a library function. + + PROGRAM POKE + INTRINSIC SIN !Thus, not an (undeclared) ordinary variable. + EXTERNAL TRIAL !Likewise, but also, not an intrinsic function. + REAL INTG8 !Don't look for the result in an integer place. + WRITE (6,*) "Result=",INTG8(SIN, 0.0,8*ATAN(1.0),0.01) + WRITE (6,*) "Linear=",INTG8(TRIAL,0.0,1.0, 0.01) + END diff --git a/Task/Call-a-function/Fortran/call-a-function-5.f b/Task/Call-a-function/Fortran/call-a-function-5.f new file mode 100644 index 0000000000..2e09390a6d --- /dev/null +++ b/Task/Call-a-function/Fortran/call-a-function-5.f @@ -0,0 +1,5 @@ + TYPE MIXED + CHARACTER*12 NAME + INTEGER STUFF + END TYPE MIXED + TYPE(MIXED) LOTS(12000) diff --git a/Task/Call-a-function/Rust/call-a-function.rust b/Task/Call-a-function/Rust/call-a-function.rust new file mode 100644 index 0000000000..c1c7d2ea37 --- /dev/null +++ b/Task/Call-a-function/Rust/call-a-function.rust @@ -0,0 +1,91 @@ +fn main() { + // Rust has a lot of neat things you can do with functions: let's go over the basics first + fn no_args() {} + // Run function with no arguments + no_args(); + + // Calling a function with fixed number of arguments. + // adds_one takes a 32-bit signed integer and returns a 32-bit signed integer + fn adds_one(num: i32) -> i32 { + // the final expression is used as the return value, though `return` may be used for early returns + num + 1 + } + adds_one(1); + + // Optional arguments + // The language itself does not support optional arguments, however, you can take advantage of + // Rust's algebraic types for this purpose + fn prints_argument(maybe: Option) { + match maybe { + Some(num) => println!("{}", num), + None => println!("No value given"), + }; + } + prints_argument(Some(3)); + prints_argument(None); + + // You could make this a bit more ergonomic by using Rust's Into trait + fn prints_argument_into(maybe: I) + where I: Into> + { + match maybe.into() { + Some(num) => println!("{}", num), + None => println!("No value given"), + }; + } + prints_argument_into(3); + prints_argument_into(None); + + // Rust does not support functions with variable numbers of arguments. Macros fill this niche + // (println! as used above is a macro for example) + + // Rust does not support named arguments + + // We used the no_args function above in a no-statement context + + // Using a function in an expression context + adds_one(1) + adds_one(5); // evaluates to eight + + // Obtain the return value of a function. + let two = adds_one(1); + + // In Rust there are no real built-in functions (save compiler intrinsics but these must be + // manually imported) + + // In rust there are no such thing as subroutines + + // In Rust, there are three ways to pass an object to a function each of which have very important + // distinctions when it comes to Rust's ownership model and move semantics. We may pass by + // value, by immutable reference, or mutable reference. + + let mut v = vec![1, 2, 3, 4, 5, 6]; + + // By mutable reference + fn add_one_to_first_element(vector: &mut Vec) { + vector[0] += 1; + } + add_one_to_first_element(&mut v); + // By immutable reference + fn print_first_element(vector: &Vec) { + println!("{}", vector[0]); + } + print_first_element(&v); + + // By value + fn consume_vector(vector: Vec) { + // We can do whatever we want to vector here + } + consume_vector(v); + // Due to Rust's move semantics, v is now inaccessible because it was moved into consume_vector + // and was then dropped when it went out of scope + + // Partial application is not possible in rust without wrapping the function in another + // function/closure e.g.: + fn average(x: f64, y: f64) -> f64 { + (x + y) / 2.0 + } + let average_with_four = |y| average(4.0, y); + average_with_four(2.0); + + +} diff --git a/Task/Call-an-object-method/Elena/call-an-object-method-1.elena b/Task/Call-an-object-method/Elena/call-an-object-method-1.elena new file mode 100644 index 0000000000..97444b7886 --- /dev/null +++ b/Task/Call-an-object-method/Elena/call-an-object-method-1.elena @@ -0,0 +1 @@ + instance message:param1:param2. diff --git a/Task/Call-an-object-method/Elena/call-an-object-method-2.elena b/Task/Call-an-object-method/Elena/call-an-object-method-2.elena new file mode 100644 index 0000000000..863f48823c --- /dev/null +++ b/Task/Call-an-object-method/Elena/call-an-object-method-2.elena @@ -0,0 +1 @@ + instance message &subj1:param1 &subj2:param2. diff --git a/Task/Call-an-object-method/Elixir/call-an-object-method.elixir b/Task/Call-an-object-method/Elixir/call-an-object-method.elixir new file mode 100644 index 0000000000..6b51692b5d --- /dev/null +++ b/Task/Call-an-object-method/Elixir/call-an-object-method.elixir @@ -0,0 +1,27 @@ +defmodule ObjectCall do + def new() do + spawn_link(fn -> loop end) + end + + defp loop do + receive do + {:concat, {caller, [str1, str2]}} -> + result = str1 <> str2 + send caller, {:ok, result} + loop + end + end + + def concat(obj, str1, str2) do + send obj, {:concat, {self(), [str1, str2]}} + + receive do + {:ok, result} -> + result + end + end +end + +obj = ObjectCall.new() + +IO.puts(obj |> ObjectCall.concat("Hello ", "World!")) diff --git a/Task/Call-an-object-method/Perl-6/call-an-object-method-1.pl6 b/Task/Call-an-object-method/Perl-6/call-an-object-method-1.pl6 new file mode 100644 index 0000000000..41ecdac215 --- /dev/null +++ b/Task/Call-an-object-method/Perl-6/call-an-object-method-1.pl6 @@ -0,0 +1,26 @@ +class Thing { + method regular-example() { say 'I haz a method' } + + multi method multi-example() { say 'No arguments given' } + multi method multi-example(Str $foo) { say 'String given' } + multi method multi-example(Int $foo) { say 'Integer given' } +}; + +# 'new' is actually a method, not a special keyword: +my $thing = Thing.new; + +# No arguments: parentheses are optional +$thing.regular-example; +$thing.regular-example(); +$thing.multi-example; +$thing.multi-example(); + +# Arguments: parentheses or colon required +$thing.multi-example("This is a string"); +$thing.multi-example: "This is a string"; +$thing.multi-example(42); +$thing.multi-example: 42; + +# Indirect (reverse order) method call syntax: colon required +my $foo = new Thing: ; +multi-example $thing: 42; diff --git a/Task/Call-an-object-method/Perl-6/call-an-object-method-2.pl6 b/Task/Call-an-object-method/Perl-6/call-an-object-method-2.pl6 new file mode 100644 index 0000000000..4372cc18bb --- /dev/null +++ b/Task/Call-an-object-method/Perl-6/call-an-object-method-2.pl6 @@ -0,0 +1,4 @@ +my @array = ; +@array .= sort; # short for @array = @array.sort; + +say @array».uc; # uppercase all the strings: A C D Y Z diff --git a/Task/Call-an-object-method/Perl-6/call-an-object-method-3.pl6 b/Task/Call-an-object-method/Perl-6/call-an-object-method-3.pl6 new file mode 100644 index 0000000000..532d695af4 --- /dev/null +++ b/Task/Call-an-object-method/Perl-6/call-an-object-method-3.pl6 @@ -0,0 +1,6 @@ +my $object = "a string"; # Everything is an object. +my method example-method { + return "This is { self }."; +} + +say $object.&example-method; # Outputs "This is a string." diff --git a/Task/Call-an-object-method/Perl-6/call-an-object-method.pl6 b/Task/Call-an-object-method/Perl-6/call-an-object-method.pl6 deleted file mode 100644 index 33bdc00927..0000000000 --- a/Task/Call-an-object-method/Perl-6/call-an-object-method.pl6 +++ /dev/null @@ -1,36 +0,0 @@ -class C { - method some-method(){ say 'I haz a method' } -}; -my C $a-c.=new; # we need an instance of C -$a-c.some-method; # so we can call a method - -sub not-a-method(Any:D $obj){ say $obj.WHAT }; # *.WHAT stringifies to the typename in parentheses -$a-c.¬-a-method; # output: '(C)' -my @many-cs = C.new xx 3; # a List of 3 Cs -@many-cs>>.¬-a-method; # let's call not-a-method on all 3 Cs at once - # the >>. hyperoperator is a candidate for autothreading so your order of execution may vary -my $runtime-method-name = 'some-method'; -$a-c."$runtime-method-name"(); # here some very late binding - -my multi method free-floating-method($self:){ # my is required or the compiler thinks we misplaced a method - say 'i haz a C' if $self ~~ C # we do the type check by hand -}; - -free-floating-method($a-c); # $self is bound to the first parameter -$a-c.&free-floating-method; # dito but automatically - -$a-c.?does-not-exist; # this method does not exist so it's not called thanks to .? - -use MONKEY-TYPING; -augment class Int { - method does-not-exists(){} # This is one way to add a method. As usual there are more then one. -} - -$a-c.?does-not-exists; # now it exists and we can call it - -my multi method free-floating-method(C:D $self:){} # we could let the compiler do the type check -my multi method free-floating-method(Int:D $self:){} # or let it pick the right candidate -my @a-good-mix = (Int.new((1..100).roll),C.new).roll xx 5; # let's have a mixture of Cs and Ints -@a-good-mix>>.&free-floating-method; # and let Perl 6 pick the right candidate for us - -C.some-method(); # actually we don't really need an instance of C. We can call class methods aswell. diff --git a/Task/Call-an-object-method/Processing/call-an-object-method b/Task/Call-an-object-method/Processing/call-an-object-method new file mode 100644 index 0000000000..3c4a50fd1b --- /dev/null +++ b/Task/Call-an-object-method/Processing/call-an-object-method @@ -0,0 +1,21 @@ +// define a rudimentary class +class HelloWorld +{ + public static void sayHello() + { + println("Hello, world!"); + } + public void sayGoodbye() + { + println("Goodbye, cruel world!"); + } +} + +// call the class method +HelloWorld.sayHello(); + +// create an instance of the class +HelloWorld hello = new HelloWorld(); + +// and call the instance method +hello.sayGoodbye(); diff --git a/Task/Call-an-object-method/Rust/call-an-object-method.rust b/Task/Call-an-object-method/Rust/call-an-object-method.rust index cce613c684..8bd4fc8cd7 100644 --- a/Task/Call-an-object-method/Rust/call-an-object-method.rust +++ b/Task/Call-an-object-method/Rust/call-an-object-method.rust @@ -23,4 +23,9 @@ fn main() { // get the answer to life // by calling the instance method of object foo println!("The answer to life is {}.", foo.get_the_answer_to_life()); + + // Note that in Rust, methods still work on references to the object. + // Rust will automatically do the appropriate dereferencing to get the method to work: + let lots_of_references = &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&foo; + println!("The answer to life is still {}." lots_of_references.get_the_answer_to_life()); } diff --git a/Task/Carmichael-3-strong-pseudoprimes/00DESCRIPTION b/Task/Carmichael-3-strong-pseudoprimes/00DESCRIPTION index d1da1f67b2..be265bd8b1 100644 --- a/Task/Carmichael-3-strong-pseudoprimes/00DESCRIPTION +++ b/Task/Carmichael-3-strong-pseudoprimes/00DESCRIPTION @@ -1,18 +1,29 @@ -A lot of composite numbers can be separated from primes by Fermat's Little Theorem, but there are some that completely confound it. The [[Miller-Rabin primality test|Miller Rabin Test]] uses a combination of Fermat's Little Theorem and Chinese Division Theorem to overcome this. +A lot of composite numbers can be separated from primes by Fermat's Little Theorem, but there are some that completely confound it. -The purpose of this task is to investigate such numbers using a method based on [[wp:Carmichael number|Carmichael numbers]], as suggested in [http://www.maths.lancs.ac.uk/~jameson/carfind.pdf Notes by G.J.O Jameson March 2010]. +The   [[Miller-Rabin primality test|Miller Rabin Test]]   uses a combination of Fermat's Little Theorem and Chinese Division Theorem to overcome this. -The objective is to find Carmichael numbers of the form Prime_1 \times Prime_2 \times Prime_3 (where Prime_1 < Prime_2 < Prime_3) for all Prime_1 up to 61 (see page 7 of [http://www.maths.lancs.ac.uk/~jameson/carfind.pdf Notes by G.J.O Jameson March 2010] for solutions). +The purpose of this task is to investigate such numbers using a method based on   [[wp:Carmichael number|Carmichael numbers]],   as suggested in   [http://www.maths.lancs.ac.uk/~jameson/carfind.pdf Notes by G.J.O Jameson March 2010]. -'''Pseudocode:'''
    For a given Prime_1 -for 1 < h3 < Prime1 -:for 0 < d < h3+Prime1 -::if (h3+Prime1)*(Prime1-1) mod d == 0 and -Prime1 squared mod h3 == d mod h3 -::then -:::Prime2 = 1 + ((Prime1-1) * (h3+Prime1)/d) -:::next d if Prime2 is not prime -:::Prime3 = 1 + (Prime1*Prime2/h3) -:::next d if Prime3 is not prime -:::next d if (Prime2*Prime3) mod (Prime1-1) not equal 1 -:::Prime1 * Prime2 * Prime3 is a Carmichael Number +;Task: +Find Carmichael numbers of the form: +:::: Prime1 × Prime2 × Prime3 + +where   (Prime1 < Prime2 < Prime3)   for all   Prime1   up to   '''61'''. +
    (See page 7 of   [http://www.maths.lancs.ac.uk/~jameson/carfind.pdf Notes by G.J.O Jameson March 2010]   for solutions.) + + +;Pseudocode: +For a given   Prime_1 + + for 1 < h3 < Prime1 + for 0 < d < h3+Prime1 + if (h3+Prime1)*(Prime1-1) mod d == 0 and -Prime1 squared mod h3 == d mod h3 + then + Prime2 = 1 + ((Prime1-1) * (h3+Prime1)/d) + next d if Prime2 is not prime + Prime3 = 1 + (Prime1*Prime2/h3) + next d if Prime3 is not prime + next d if (Prime2*Prime3) mod (Prime1-1) not equal 1 + Prime1 * Prime2 * Prime3 is a Carmichael Number +

    diff --git a/Task/Carmichael-3-strong-pseudoprimes/ALGOL-68/carmichael-3-strong-pseudoprimes.alg b/Task/Carmichael-3-strong-pseudoprimes/ALGOL-68/carmichael-3-strong-pseudoprimes.alg new file mode 100644 index 0000000000..a949478d3b --- /dev/null +++ b/Task/Carmichael-3-strong-pseudoprimes/ALGOL-68/carmichael-3-strong-pseudoprimes.alg @@ -0,0 +1,41 @@ +# sieve of Eratosthene: sets s[i] to TRUE if i is prime, FALSE otherwise # +PROC sieve = ( REF[]BOOL s )VOID: + BEGIN + # start with everything flagged as prime # + FOR i TO UPB s DO s[ i ] := TRUE OD; + # sieve out the non-primes # + s[ 1 ] := FALSE; + FOR i FROM 2 TO ENTIER sqrt( UPB s ) DO + IF s[ i ] THEN FOR p FROM i * i BY i TO UPB s DO s[ p ] := FALSE OD FI + OD + END # sieve # ; + +# construct a sieve of primes up to the maximum number required for the task # +# For Prime1, we need to check numbers up to around 120 000 # +INT max number = 200 000; +[ 1 : max number ]BOOL is prime; +sieve( is prime ); + +# Find the Carmichael 3 Stromg Pseudoprimes for Prime1 up to 61 # + +FOR prime1 FROM 2 TO 61 DO + IF is prime[ prime 1 ] THEN + FOR h3 TO prime1 - 1 DO + FOR d TO ( h3 + prime1 ) - 1 DO + IF ( h3 + prime1 ) * ( prime1 - 1 ) MOD d = 0 + AND ( - ( prime1 * prime1 ) ) MOD h3 = d MOD h3 + THEN + INT prime2 = 1 + ( ( prime1 - 1 ) * ( h3 + prime1 ) OVER d ); + IF is prime[ prime2 ] THEN + INT prime3 = 1 + ( prime1 * prime2 OVER h3 ); + IF is prime[ prime3 ] THEN + IF ( prime2 * prime3 ) MOD ( prime1 - 1 ) = 1 THEN + print( ( whole( prime1, 0 ), " ", whole( prime2, 0 ), " ", whole( prime3, 0 ), newline ) ) + FI + FI + FI + FI + OD + OD + FI +OD diff --git a/Task/Carmichael-3-strong-pseudoprimes/Fortran/carmichael-3-strong-pseudoprimes.f b/Task/Carmichael-3-strong-pseudoprimes/Fortran/carmichael-3-strong-pseudoprimes.f new file mode 100644 index 0000000000..50c1227e6b --- /dev/null +++ b/Task/Carmichael-3-strong-pseudoprimes/Fortran/carmichael-3-strong-pseudoprimes.f @@ -0,0 +1,40 @@ + LOGICAL FUNCTION ISPRIME(N) !Ad-hoc, since N is not going to be big... + INTEGER N !Despite this intimidating allowance of 32 bits... + INTEGER F !A possible factor. + ISPRIME = .FALSE. !Most numbers aren't prime. + DO F = 2,SQRT(DFLOAT(N)) !Wince... + IF (MOD(N,F).EQ.0) RETURN !Not even avoiding even numbers beyond two. + END DO !Nice and brief, though. + ISPRIME = .TRUE. !No factor found. + END FUNCTION ISPRIME !So, done. Hopefully, not often. + + PROGRAM CHASE + INTEGER P1,P2,P3 !The three primes to be tested. + INTEGER H3,D !Assistants. + INTEGER MSG !File unit number. + MSG = 6 !Standard output. + WRITE (MSG,1) !A heading would be good. + 1 FORMAT ("Carmichael numbers that are the product of three primes:" + & /" P1 x P2 x P3 =",9X,"C") + DO P1 = 2,61 !Step through the specified range. + IF (ISPRIME(P1)) THEN !Selecting only the primes. + DO H3 = 2,P1 - 1 !For 1 < H3 < P1. + DO D = 1,H3 + P1 - 1 !For 0 < D < H3 + P1. + IF (MOD((H3 + P1)*(P1 - 1),D).EQ.0 !Filter. + & .AND. (MOD(H3 + MOD(-P1**2,H3),H3) .EQ. MOD(D,H3))) THEN !Beware MOD for negative numbers! MOD(-P1**2, may surprise... + P2 = 1 + (P1 - 1)*(H3 + P1)/D !Candidate for the second prime. + IF (ISPRIME(P2)) THEN !Is it prime? + P3 = 1 + P1*P2/H3 !Yes. Candidate for the third prime. + IF (ISPRIME(P3)) THEN !Is it prime? + IF (MOD(P2*P3,P1 - 1).EQ.1) THEN !Yes! Final test. + WRITE (MSG,2) P1,P2,P3, INT8(P1)*P2*P3 !Result! + 2 FORMAT (3I6,I12) + END IF + END IF + END IF + END IF + END DO + END DO + END IF + END DO + END diff --git a/Task/Carmichael-3-strong-pseudoprimes/Java/carmichael-3-strong-pseudoprimes.java b/Task/Carmichael-3-strong-pseudoprimes/Java/carmichael-3-strong-pseudoprimes.java new file mode 100644 index 0000000000..9134509f93 --- /dev/null +++ b/Task/Carmichael-3-strong-pseudoprimes/Java/carmichael-3-strong-pseudoprimes.java @@ -0,0 +1,39 @@ +public class Test { + + static int mod(int n, int m) { + return ((n % m) + m) % m; + } + + static boolean isPrime(int n) { + if (n == 2 || n == 3) + return true; + else if (n < 2 || n % 2 == 0 || n % 3 == 0) + return false; + for (int div = 5, inc = 2; Math.pow(div, 2) <= n; + div += inc, inc = 6 - inc) + if (n % div == 0) + return false; + return true; + } + + public static void main(String[] args) { + for (int p = 2; p < 62; p++) { + if (!isPrime(p)) + continue; + for (int h3 = 2; h3 < p; h3++) { + int g = h3 + p; + for (int d = 1; d < g; d++) { + if ((g * (p - 1)) % d != 0 || mod(-p * p, h3) != d % h3) + continue; + int q = 1 + (p - 1) * g / d; + if (!isPrime(q)) + continue; + int r = 1 + (p * q / h3); + if (!isPrime(r) || (q * r) % (p - 1) != 1) + continue; + System.out.printf("%d x %d x %d%n", p, q, r); + } + } + } + } +} diff --git a/Task/Carmichael-3-strong-pseudoprimes/Kotlin/carmichael-3-strong-pseudoprimes.kotlin b/Task/Carmichael-3-strong-pseudoprimes/Kotlin/carmichael-3-strong-pseudoprimes.kotlin new file mode 100644 index 0000000000..be138b0952 --- /dev/null +++ b/Task/Carmichael-3-strong-pseudoprimes/Kotlin/carmichael-3-strong-pseudoprimes.kotlin @@ -0,0 +1,31 @@ +fun Int.isPrime(): Boolean { + when { + this == 2 -> return true + this <= 1 || this % 2 == 0 -> return false + else -> { + val max = Math.sqrt(toDouble()).toInt() + for (n in 3..max step 2) + if (this % n == 0) return false + return true + } + } +} + +fun mod(n: Int, m: Int) = ((n % m) + m) % m + +fun main(args: Array) { + for (p1 in 3..61) + if (p1.isPrime()) + for (h3 in 2..p1-1) { + val g = h3 + p1 + for (d in 1..g-1) + if ((g * (p1 - 1)) % d == 0 && mod(-p1 * p1, h3) == d % h3) { + val q = 1 + (p1 - 1) * g / d + if (q.isPrime()) { + val r = 1 + (p1 * q / h3) + if (r.isPrime() && (q * r) % (p1 - 1) == 1) + println("$p1 x $q x $r") + } + } + } +} diff --git a/Task/Carmichael-3-strong-pseudoprimes/REXX/carmichael-3-strong-pseudoprimes-1.rexx b/Task/Carmichael-3-strong-pseudoprimes/REXX/carmichael-3-strong-pseudoprimes-1.rexx index baddfac89a..10f1908ac0 100644 --- a/Task/Carmichael-3-strong-pseudoprimes/REXX/carmichael-3-strong-pseudoprimes-1.rexx +++ b/Task/Carmichael-3-strong-pseudoprimes/REXX/carmichael-3-strong-pseudoprimes-1.rexx @@ -1,37 +1,39 @@ -/*REXX program calculates Carmichael 3-strong pseudoprimes (up to N).*/ -numeric digits 30 /*in case user wants bigger nums.*/ -parse arg N .; if N=='' then N=61 /*allow user to specify the limit*/ -if 1=='f1'x then times='af'x /*if EBCDIC machine, use a bullet*/ - else times='f9'x /* " ASCII " " " " */ -carms=0 /*number of Carmichael #s so far.*/ -!.=0 /*a method of prime memoization. */ - do p=3 to N by 2; if \isPrime(p) then iterate /*Not prime? Skip.*/ - pm=p-1; nps=-p*p; @.=0; min=1e9; max=0 /*some handy-dandy variables.*/ - do h3=2 to pm; g=h3+p /*find Carmichael #s for this P. */ - do d=1 to g-1 - if g*pm//d\==0 then iterate - if ((nps//h3)+h3)//h3\==d//h3 then iterate - q=1+pm*g%d; if \isPrime(q) then iterate - r=1+p*q%h3; if q*r//pm\==1 then iterate - if \isPrime(r) then iterate - carms=carms+1 /*bump the Carmichael # counter. */ - min=min(min,q); max=max(max,q); @.q=r /*build a list.*/ - end /*d*/ - end /*h3*/ - /*display a list of some Carm #s.*/ - do j=min to max by 2; if @.j==0 then iterate /*one of the #s?*/ - say '──────── a Carmichael number: ' p times j times @.j - end /*j*/ - say /*show bueatification blank line.*/ - end /*p*/ -say; say carms ' Carmichael numbers found.' -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────ISPRIME subroutine──────────────────*/ -isPrime: procedure expose !.; parse arg x; if !.x then return 1 -if wordpos(x,'2 3 5 7 11 13')\==0 then do; !.x=1; return 1; end -if x<17 then return 0; if x//2==0 then return 0; if x//3==0 then return 0 -if right(x,1)==5 then return 0; if x//7==0 then return 0 - do i=11 by 6 until i*i>x; if x// i ==0 then return 0 - if x//(i+2) ==0 then return 0 - end /*i*/ -!.x=1; return 1 +/*REXX program calculates Carmichael 3─strong pseudoprimes (up to and including N). */ +numeric digits 18 /*handle big dig #s (9 is the default).*/ +parse arg N .; if N=='' then N=61 /*allow user to specify for the search.*/ +tell= N>0; N=abs(N) /*N>0? Then display Carmichael numbers*/ +#=0 /*number of Carmichael numbers so far. */ +@.=0; @.2=1; @.3=1; @.5=1; @.7=1; @.11=1; @.13=1; @.17=1; @.19=1; @.23=1; @.29=1; @.31=1 + /*[↑] prime number memoization array. */ + do p=3 to N by 2; pm=p-1; bot=0; top=0 /*step through some (odd) prime numbers*/ + if \isPrime(p) then iterate; nps=-p*p /*is P a prime? No, then skip it.*/ + !.=0 /*the list of Carmichael #'s (so far).*/ + do h3=2 to pm; g=h3+p /*find Carmichael #s for this prime. */ + gPM=g*pm; npsH3=((nps//h3)+h3)//h3 /*define a couple of shortcuts for pgm.*/ + /* [↓] perform some weeding of D values*/ + do d=1 for g-1; if gPM//d \== 0 then iterate + if npsH3 \== d//h3 then iterate + q=1+gPM%d; if \isPrime(q) then iterate + r=1+p*q%h3; if q*r//pm\==1 then iterate + if \isPrime(r) then iterate + #=#+1; !.q=r /*bump Carmichael counter; add to array*/ + if bot==0 then bot=q; bot=min(bot,q); top=max(top,q) + end /*d*/ + end /*h3*/ + $= /*display a list of some Carmichael #s.*/ + do j=bot to top by 2 while tell; if !.j\==0 then $=$ p"∙"j'∙'!.j + end /*j*/ + + if $\=='' then say 'Carmichael number: ' strip($) + end /*p*/ +say +say '──────── ' # " Carmichael numbers found." +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +isPrime: parse arg x; if @.x then return 1 /*X a known prime?*/ + if x<37 then return 0; if x//2==0 then return 0; if x// 3==0 then return 0 + parse var x '' -1 _; if _==5 then return 0; if x// 7==0 then return 0 + do k=11 by 6 until k*k>x; if x// k ==0 then return 0 + if x//(k+2)==0 then return 0 + end /*i*/ + @.x=1; return 1 diff --git a/Task/Carmichael-3-strong-pseudoprimes/REXX/carmichael-3-strong-pseudoprimes-2.rexx b/Task/Carmichael-3-strong-pseudoprimes/REXX/carmichael-3-strong-pseudoprimes-2.rexx index 72af76c507..3f72a7a5ad 100644 --- a/Task/Carmichael-3-strong-pseudoprimes/REXX/carmichael-3-strong-pseudoprimes-2.rexx +++ b/Task/Carmichael-3-strong-pseudoprimes/REXX/carmichael-3-strong-pseudoprimes-2.rexx @@ -1,40 +1,49 @@ -/*REXX program calculates Carmichael 3-strong pseudoprimes (up to N).*/ -numeric digits 30 /*in case user wants bigger nums.*/ -parse arg N .; if N=='' then N=61 /*allow user to specify the limit*/ -if 1=='f1'x then times='af'x /*if EBCDIC machine, use a bullet*/ - else times='f9'x /* " ASCII " " " " */ -carms=0 /*number of Carmichael #s so far.*/ -!.=0 /*a method of prime memoization. */ - /*Carmichael numbers aren't even.*/ - do p=3 to N by 2; if \isPrime(p) then iterate /*Not prime? Skip.*/ - pm=p-1; nps=-p*p; @.=0; min=1e9; max=0 /*some handy-dandy variables.*/ +/*REXX program calculates Carmichael 3─strong pseudoprimes (up to and including N). */ +numeric digits 18 /*handle big dig #s (9 is the default).*/ +parse arg N .; if N=='' then N=61 /*allow user to specify for the search.*/ +tell= N>0; N=abs(N) /*N>0? Then display Carmichael numbers*/ +#=0; @.=0 /*number of Carmichael numbers so far. */ +@.2=1; @.3=1; @.5=1; @.7=1; @.11=1; @.13=1; @.17=1; @.19=1; @.23=1; @.29=1; @.31=1; @.37=1 +HP=37; do i=HP+2 by 2 for N*20; if isPrime(i) then do; @.i=1; HP=i; end; end /*i*/ +HP=HP+2 + /*[↑] prime number memoization array. */ + do p=3 to N by 2; pm=p-1; bot=0; top=0 /*step through some (odd) prime numbers*/ + if \isPrime(p) then iterate; nps=-p*p /*is P a prime? No, then skip it.*/ + !.=0 /*the list of Carmichael #'s (so far).*/ + do h3=2 to pm; g=h3+p /*find Carmichael #s for this prime. */ + gPM=g*pm; npsH3=((nps//h3)+h3)//h3 /*define a couple of shortcuts for pgm.*/ + /* [↓] perform some weeding of D values*/ + do d=1 for g-1; if gPM//d \== 0 then iterate + if npsH3 \== d//h3 then iterate + q=1+gPM%d; if \isPrime(q) then iterate + r=1+p*q%h3; if q*r//pm\==1 then iterate + if \isPrime(r) then iterate + #=#+1; !.q=r /*bump Carmichael counter; add to array*/ + if bot==0 then bot=q; bot=min(bot,q); top=max(top,q) + end /*d*/ + end /*h3*/ + $= /*display a list of some Carmichael #s.*/ + do j=bot to top by 2 while tell; if !.j\==0 then $=$ p"∙"j'∙'!.j + end /*j*/ - do h3=2 to pm; g=h3+p /*find Carmichael #s for this P. */ - do d=1 to g-1 - if g*pm//d\==0 then iterate - if ((nps//h3)+h3)//h3\==d//h3 then iterate - q=1+pm*g%d; if \isPrime(q) then iterate - r=1+p*q%h3; if q*r//pm\==1 then iterate - if \isPrime(r) then iterate - carms=carms+1 /*bump the Carmichael # counter. */ - min=min(min,q); max=max(max,q); @.q=r /*build a list.*/ - end /*d*/ - end /*h3*/ - /*display a list of some Carm #s.*/ - do j=min to max by 2; if @.j==0 then iterate /*one of the #s?*/ - say '──────── a Carmichael number: ' p times j times @.j - end /*j*/ - say /*show bueatification blank line.*/ - end /*p*/ - -say; say carms ' Carmichael numbers found.' -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────ISPRIME subroutine──────────────────*/ -isPrime: procedure expose !.; parse arg x; if !.x then return 1 -if wordpos(x,'2 3 5 7 11 13')\==0 then do; !.x=1; return 1; end -if x<17 then return 0; if x//2==0 then return 0; if x//3==0 then return 0 -if right(x,1)==5 then return 0; if x//7==0 then return 0 - do i=11 by 6 until i*i>x; if x// i ==0 then return 0 - if x//(i+2) ==0 then return 0 - end /*i*/ -!.x=1; return 1 + if $\=='' then say 'Carmichael number: ' strip($) + end /*p*/ +say +say '──────── ' # " Carmichael numbers found." +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +isPrime: parse arg x; if @.x then return 1 /*X a known prime?*/ + if x1; b=b%4; _=c-s-b; s=s%2; if _>=0 then do; c=_; s=s+b; end; end + do k=41 by 6 to s; parse var k '' -1 _ + if _\==5 then if x// k ==0 then return 0 + if _\==3 then if x//(k+2)==0 then return 0 + end /*k*/ /*K will never be divisible by three.*/ + @.x=1; return 1 /*Define a new prime (X). Indicate so.*/ diff --git a/Task/Carmichael-3-strong-pseudoprimes/REXX/carmichael-3-strong-pseudoprimes.rexx b/Task/Carmichael-3-strong-pseudoprimes/REXX/carmichael-3-strong-pseudoprimes.rexx deleted file mode 100644 index d3d148464b..0000000000 --- a/Task/Carmichael-3-strong-pseudoprimes/REXX/carmichael-3-strong-pseudoprimes.rexx +++ /dev/null @@ -1,43 +0,0 @@ -/*REXX program calculates Carmichael 3-strong pseudoprimes (up to N).*/ -numeric digits 30 /*in case user wants bigger nums.*/ -parse arg N .; if N=='' then N=61 /*allow user to specify the limit*/ -if 7=='f7'x then times='af'x /*if EBCDIC machine, use a bullet*/ - else times='f9'x /* " ASCII " " " " */ -carms=0 /*number of Carmichael #s so far.*/ -!.=0; !.2=1; !.3=1; !.5=1; !.7=1; !.11=1; !.13=1; !.17=1; !.19=1; !.23=1 - /*[↓] prime # memoization array.*/ - do p=3 to N by 2; if \isPrime(p) then iterate /*Not prime? Skip*/ - pm=p-1; nps=-p*p; bot=0; top=0 /*some handy-dandy REXX variables*/ - @.=0 /*[↑] Carmichael numbers are odd*/ - do h3=2 to pm; g=h3+p /*find Carmichael #s for this P. */ - gPM=g*pm; npsH3=((nps//h3)+h3)//h3 /*shortcuts.*/ - - do d=1 for g-1 - if gPM//d \== 0 then iterate - if npsH3 \== d//h3 then iterate - q=1+gPM%d; if \isPrime(q) then iterate - r=1+p*q%h3; if q*r//pm\==1 then iterate - if \isPrime(r) then iterate - carms=carms+1; @.q=r /*bump Carmichael #; add to array*/ - if bot==0 then bot=q; bot=min(bot,q); top=max(top,q) - end /*d*/ /* [↑] find minimum and maximum.*/ - end /*h3*/ - $=0 /*display a list of some Carm #s.*/ - do j=bot to top by 2; if @.j==0 then iterate; $=1 - say '──────── a Carmichael number: ' p times j times @.j - end /*j*/ - if $ then say /*show beautification blank line.*/ - end /*p*/ - -say; say carms ' Carmichael numbers found.' -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────ISPRIME subroutine──────────────────*/ -isPrime: procedure expose !.; parse arg x; if !.x then return 1 -if x<23 then return 0; if x//2==0 then return 0; if x// 3==0 then return 0 -if right(x,1)==5 then return 0; if x// 7==0 then return 0 -if x//11==0 then return 0; if x//13==0 then return 0 -if x//17==0 then return 0; if x//19==0 then return 0 - do i=23 by 6 until i*i>x; if x// i ==0 then return 0 - if x//(i+2)==0 then return 0 - end /*i*/ -!.x=1; return 1 diff --git a/Task/Carmichael-3-strong-pseudoprimes/Rust/carmichael-3-strong-pseudoprimes.rust b/Task/Carmichael-3-strong-pseudoprimes/Rust/carmichael-3-strong-pseudoprimes.rust new file mode 100644 index 0000000000..d4ba78cc29 --- /dev/null +++ b/Task/Carmichael-3-strong-pseudoprimes/Rust/carmichael-3-strong-pseudoprimes.rust @@ -0,0 +1,51 @@ +fn is_prime(n: i64) -> bool { + if n > 1 { + (2..((n / 2) + 1)).all(|x| n % x != 0) + } else { + false + } +} + +// The modulo operator actually calculates the remainder. +fn modulo(n: i64, m: i64) -> i64 { + ((n % m) + m) % m +} + +fn carmichael(p1: i64) -> Vec<(i64, i64, i64)> { + let mut results = Vec::new(); + if !is_prime(p1) { + return results; + } + + for h3 in 2..p1 { + for d in 1..(h3 + p1) { + if (h3 + p1) * (p1 - 1) % d != 0 || modulo(-p1 * p1, h3) != d % h3 { + continue; + } + + let p2 = 1 + ((p1 - 1) * (h3 + p1) / d); + if !is_prime(p2) { + continue; + } + + let p3 = 1 + (p1 * p2 / h3); + if !is_prime(p3) || ((p2 * p3) % (p1 - 1) != 1) { + continue; + } + + results.push((p1, p2, p3)); + } + } + + results +} + +fn main() { + (1..62) + .filter(|&x| is_prime(x)) + .map(carmichael) + .filter(|x| !x.is_empty()) + .flat_map(|x| x) + .inspect(|x| println!("{:?}", x)) + .count(); // Evaluate entire iterator +} diff --git a/Task/Carmichael-3-strong-pseudoprimes/ZX-Spectrum-Basic/carmichael-3-strong-pseudoprimes.zx b/Task/Carmichael-3-strong-pseudoprimes/ZX-Spectrum-Basic/carmichael-3-strong-pseudoprimes.zx new file mode 100644 index 0000000000..ae810c191e --- /dev/null +++ b/Task/Carmichael-3-strong-pseudoprimes/ZX-Spectrum-Basic/carmichael-3-strong-pseudoprimes.zx @@ -0,0 +1,26 @@ +10 FOR p=2 TO 61 +20 LET n=p: GO SUB 1000 +30 IF NOT n THEN GO TO 200 +40 FOR h=1 TO p-1 +50 FOR d=1 TO h-1+p +60 IF NOT (FN m((h+p)*(p-1),d)=0 AND FN w(-p*p,h)=FN m(d,h)) THEN GO TO 180 +70 LET q=INT (1+((p-1)*(h+p)/d)) +80 LET n=q: GO SUB 1000 +90 IF NOT n THEN GO TO 180 +100 LET r=INT (1+(p*q/h)) +110 LET n=r: GO SUB 1000 +120 IF (NOT n) OR ((FN m((q*r),(p-1))<>1)) THEN GO TO 180 +130 PRINT p;" ";q;" ";r +180 NEXT d +190 NEXT h +200 NEXT p +210 STOP +1000 IF n<4 THEN LET n=(n>1): RETURN +1010 IF (NOT FN m(n,2)) OR (NOT FN m(n,3)) THEN LET n=0: RETURN +1020 LET i=5 +1030 IF NOT ((i*i)<=n) THEN LET n=1: RETURN +1040 IF (NOT FN m(n,i)) OR NOT FN m(n,(i+2)) THEN LET n=0: RETURN +1050 LET i=i+6 +1060 GO TO 1030 +2000 DEF FN m(a,b)=a-(INT (a/b)*b): REM Mod function +2010 DEF FN w(a,b)=FN m(FN m(a,b)+b,b): REM Mod function modified diff --git a/Task/Case-sensitivity-of-identifiers/00DESCRIPTION b/Task/Case-sensitivity-of-identifiers/00DESCRIPTION index 578a528f95..bd09c5a524 100644 --- a/Task/Case-sensitivity-of-identifiers/00DESCRIPTION +++ b/Task/Case-sensitivity-of-identifiers/00DESCRIPTION @@ -1,10 +1,12 @@ Three dogs (Are there three dogs or one dog?) is a code snippet used to illustrate the lettercase sensitivity of the programming language. For a case-sensitive language, the identifiers dog, Dog and DOG are all different and we should get the output: - +
     The three dogs are named Benjamin, Samba and Bernie.
    -
    +
    For a language that is lettercase insensitive, we get the following output: - +
     There is just one dog named Bernie.
    +
    ;Cf.: * [[Unicode variable names]] +

    diff --git a/Task/Case-sensitivity-of-identifiers/ALGOL-68/case-sensitivity-of-identifiers.alg b/Task/Case-sensitivity-of-identifiers/ALGOL-68/case-sensitivity-of-identifiers-1.alg similarity index 100% rename from Task/Case-sensitivity-of-identifiers/ALGOL-68/case-sensitivity-of-identifiers.alg rename to Task/Case-sensitivity-of-identifiers/ALGOL-68/case-sensitivity-of-identifiers-1.alg diff --git a/Task/Case-sensitivity-of-identifiers/ALGOL-68/case-sensitivity-of-identifiers-2.alg b/Task/Case-sensitivity-of-identifiers/ALGOL-68/case-sensitivity-of-identifiers-2.alg new file mode 100644 index 0000000000..818893f2e2 --- /dev/null +++ b/Task/Case-sensitivity-of-identifiers/ALGOL-68/case-sensitivity-of-identifiers-2.alg @@ -0,0 +1,13 @@ +'begin' + 'string' dog = "Benjamin"; + 'begin' + 'string' Dog = "Samba"; + 'begin' + 'string' DOG = "Bernie"; + 'if' DOG /= Dog 'or' DOG /= dog + 'then' print( ( "The three dogs are named: ", dog, ", ", Dog, " and ", DOG ) ) + 'else' print( ( "There is just one dog named: ", DOG ) ) + 'fi' + 'end' + 'end' +'end' diff --git a/Task/Case-sensitivity-of-identifiers/APL/case-sensitivity-of-identifiers.apl b/Task/Case-sensitivity-of-identifiers/APL/case-sensitivity-of-identifiers.apl new file mode 100644 index 0000000000..4d502b4ec2 --- /dev/null +++ b/Task/Case-sensitivity-of-identifiers/APL/case-sensitivity-of-identifiers.apl @@ -0,0 +1,5 @@ + DOG←'Benjamin' + Dog←'Samba' + dog←'Bernie' + 'The three dogs are named ',DOG,', ',Dog,', and ',dog +The three dogs are named Benjamin, Samba, and Bernie diff --git a/Task/Case-sensitivity-of-identifiers/Agena/case-sensitivity-of-identifiers.agena b/Task/Case-sensitivity-of-identifiers/Agena/case-sensitivity-of-identifiers.agena new file mode 100644 index 0000000000..6238e6f470 --- /dev/null +++ b/Task/Case-sensitivity-of-identifiers/Agena/case-sensitivity-of-identifiers.agena @@ -0,0 +1,13 @@ +scope + local dog := "Benjamin"; + scope + local Dog := "Samba"; + scope + local DOG := "Bernie"; + if DOG <> Dog or DOG <> dog + then print( "The three dogs are named: " & dog & ", " & Dog & " and " & DOG ) + else print( "There is just one dog named: " & DOG ) + fi + epocs + epocs +epocs diff --git a/Task/Case-sensitivity-of-identifiers/C++/case-sensitivity-of-identifiers.cpp b/Task/Case-sensitivity-of-identifiers/C++/case-sensitivity-of-identifiers.cpp new file mode 100644 index 0000000000..cb1e895b25 --- /dev/null +++ b/Task/Case-sensitivity-of-identifiers/C++/case-sensitivity-of-identifiers.cpp @@ -0,0 +1,9 @@ +#include +#include +using namespace std; + +int main() { + string dog = "Benjamin", Dog = "Samba", DOG = "Bernie"; + + cout << "The three dogs are named " << dog << ", " << Dog << ", and " << DOG << endl; +} diff --git a/Task/Case-sensitivity-of-identifiers/Forth/case-sensitivity-of-identifiers.fth b/Task/Case-sensitivity-of-identifiers/Forth/case-sensitivity-of-identifiers.fth new file mode 100644 index 0000000000..14a9785f70 --- /dev/null +++ b/Task/Case-sensitivity-of-identifiers/Forth/case-sensitivity-of-identifiers.fth @@ -0,0 +1,5 @@ +: DOG ." Benjamin" ; +: Dog ." Samba" ; +: dog ." Bernie" ; +: HOWMANYDOGS ." There is just one dog named " DOG ; +HOWMANYDOGS diff --git a/Task/Case-sensitivity-of-identifiers/PowerShell/case-sensitivity-of-identifiers.psh b/Task/Case-sensitivity-of-identifiers/PowerShell/case-sensitivity-of-identifiers.psh new file mode 100644 index 0000000000..1edfb33162 --- /dev/null +++ b/Task/Case-sensitivity-of-identifiers/PowerShell/case-sensitivity-of-identifiers.psh @@ -0,0 +1,5 @@ +$dog = "Benjamin" +$Dog = "Samba" +$DOG = "Bernie" + +"There is just one dog named {0}." -f $dOg diff --git a/Task/Case-sensitivity-of-identifiers/REXX/case-sensitivity-of-identifiers-1.rexx b/Task/Case-sensitivity-of-identifiers/REXX/case-sensitivity-of-identifiers-1.rexx new file mode 100644 index 0000000000..29634d3e39 --- /dev/null +++ b/Task/Case-sensitivity-of-identifiers/REXX/case-sensitivity-of-identifiers-1.rexx @@ -0,0 +1,16 @@ +/*REXX program demonstrate case insensitivity for simple REXX variable names. */ + + /* ┌──◄── all 3 left─hand side REXX variables are identical (as far as assignments). */ + /* │ */ + /* ↓ */ + dog= 'Benjamin' /*assign a lowercase variable (dog)*/ + Dog= 'Samba' /* " " capitalized " Dog */ + DOG= 'Bernie' /* " an uppercase " DOG */ + + say center('using simple variables', 35, "─") /*title.*/ + say + +if dog\==Dog | DOG\==dog then say 'The three dogs are named:' dog"," Dog 'and' DOG"." + else say 'There is just one dog named:' dog"." + + /*stick a fork in it, we're all done. */ diff --git a/Task/Case-sensitivity-of-identifiers/REXX/case-sensitivity-of-identifiers-2.rexx b/Task/Case-sensitivity-of-identifiers/REXX/case-sensitivity-of-identifiers-2.rexx new file mode 100644 index 0000000000..68d54b8d60 --- /dev/null +++ b/Task/Case-sensitivity-of-identifiers/REXX/case-sensitivity-of-identifiers-2.rexx @@ -0,0 +1,19 @@ +/*REXX program demonstrate case sensitive REXX index names (for compound variables). */ + + /* ┌──◄── all 3 indices (for an array variable) are unique (as far as array index). */ + /* │ */ + /* ↓ */ +x= 'dog'; dogname.x= "Gunner" /*assign an array index, lowercase dog*/ +x= 'Dog'; dogname.x= "Thor" /* " " " " capitalized Dog*/ +x= 'DOG'; dogname.x= "Jax" /* " " " " uppercase DOG*/ +x= 'doG'; dogname.x= "Rex" /* " " " " mixed doG*/ + + say center('using compound variables', 35, "═") /*title.*/ + say + +_= 'dog'; say "dogname.dog=" dogname._ /*display an array index, lowercase dog*/ +_= 'Dog'; say "dogname.Dog=" dogname._ /* " " " " capitalized Dog*/ +_= 'DOG'; say "dogname.DOG=" dogname._ /* " " " " uppercase DOG*/ +_= 'doG'; say "dogname.doG=" dogname._ /* " " " " mixed doG*/ + + /*stick a fork in it, we're all done. */ diff --git a/Task/Case-sensitivity-of-identifiers/REXX/case-sensitivity-of-identifiers.rexx b/Task/Case-sensitivity-of-identifiers/REXX/case-sensitivity-of-identifiers.rexx deleted file mode 100644 index 7834746e19..0000000000 --- a/Task/Case-sensitivity-of-identifiers/REXX/case-sensitivity-of-identifiers.rexx +++ /dev/null @@ -1,22 +0,0 @@ -/*demonstrate case insensitive REXX variable names. (for the most part).*/ -dog = 'Benjamin' -Dog = 'Samba' -DOG = 'Bernie' - -say copies('-',20) /*show a sep for visual clarity. */ -say 'dog=' dog -say 'Dog=' Dog -say 'DOG=' DOG -say copies('-',20) /*show a sep for visual clarity. */ -say - -x='dog'; dogname.x='Benjamin' -x='Dog'; dogname.x='Samba' -x='DOG'; dogname.x='Bernie' - -say copies('=',20) /*show a sep for visual clarity. */ -_='dog'; say 'dog=' dogname._ -_='Dog'; say 'Dog=' dogname._ -_='DOG'; say 'DOG=' dogname._ -say copies('=',20) /*show a sep for visual clarity. */ - /*stick a fork in it, we're done.*/ diff --git a/Task/Case-sensitivity-of-identifiers/Rust/case-sensitivity-of-identifiers-1.rust b/Task/Case-sensitivity-of-identifiers/Rust/case-sensitivity-of-identifiers-1.rust new file mode 100644 index 0000000000..4aacc1cc1c --- /dev/null +++ b/Task/Case-sensitivity-of-identifiers/Rust/case-sensitivity-of-identifiers-1.rust @@ -0,0 +1,6 @@ +fn main() { + let dog = "Benjamin"; + let Dog = "Samba"; + let DOG = "Bernie"; + println!("The three dogs are named {}, {} and {}.", dog, Dog, DOG); +} diff --git a/Task/Case-sensitivity-of-identifiers/Rust/case-sensitivity-of-identifiers-2.rust b/Task/Case-sensitivity-of-identifiers/Rust/case-sensitivity-of-identifiers-2.rust new file mode 100644 index 0000000000..6025e41152 --- /dev/null +++ b/Task/Case-sensitivity-of-identifiers/Rust/case-sensitivity-of-identifiers-2.rust @@ -0,0 +1,6 @@ +:3:9: 3:12 warning: variable `Dog` should have a snake case name such as `dog`, #[warn(non_snake_case)] on by default +:3 let Dog = "Samba"; + ^~~ +:4:9: 4:12 warning: variable `DOG` should have a snake case name such as `dog`, #[warn(non_snake_case)] on by default +:4 let DOG = "Bernie"; + ^~~ diff --git a/Task/Case-sensitivity-of-identifiers/Rust/case-sensitivity-of-identifiers-3.rust b/Task/Case-sensitivity-of-identifiers/Rust/case-sensitivity-of-identifiers-3.rust new file mode 100644 index 0000000000..6fd1158ba8 --- /dev/null +++ b/Task/Case-sensitivity-of-identifiers/Rust/case-sensitivity-of-identifiers-3.rust @@ -0,0 +1 @@ +The three dogs are named Benjamin, Samba and Bernie. diff --git a/Task/Case-sensitivity-of-identifiers/SETL/case-sensitivity-of-identifiers.setl b/Task/Case-sensitivity-of-identifiers/SETL/case-sensitivity-of-identifiers.setl new file mode 100644 index 0000000000..bdc2b008c7 --- /dev/null +++ b/Task/Case-sensitivity-of-identifiers/SETL/case-sensitivity-of-identifiers.setl @@ -0,0 +1,4 @@ +dog := 'Benjamin'; +Dog := 'Samba'; +DOG := 'Bernie'; +print( 'There is just one dog named', dOg ); diff --git a/Task/Case-sensitivity-of-identifiers/SNOBOL4/case-sensitivity-of-identifiers.sno b/Task/Case-sensitivity-of-identifiers/SNOBOL4/case-sensitivity-of-identifiers.sno new file mode 100644 index 0000000000..ba5ab8cb71 --- /dev/null +++ b/Task/Case-sensitivity-of-identifiers/SNOBOL4/case-sensitivity-of-identifiers.sno @@ -0,0 +1,5 @@ + DOG = 'Benjamin' + Dog = 'Samba' + dog = 'Bernie' + OUTPUT = 'The three dogs are named ' DOG ', ' Dog ', and ' dog +END diff --git a/Task/Case-sensitivity-of-identifiers/Simula/case-sensitivity-of-identifiers.simula b/Task/Case-sensitivity-of-identifiers/Simula/case-sensitivity-of-identifiers.simula new file mode 100644 index 0000000000..ee5258a528 --- /dev/null +++ b/Task/Case-sensitivity-of-identifiers/Simula/case-sensitivity-of-identifiers.simula @@ -0,0 +1,10 @@ +begin + text dog; + dog :- blanks( 8 ); + dog := "Benjamin"; + Dog := "Samba"; + DOG := "Bernie"; + outtext( "There is just one dog, named " ); + outtext( dog ); + outimage +end diff --git a/Task/Case-sensitivity-of-identifiers/Standard-ML/case-sensitivity-of-identifiers.ml b/Task/Case-sensitivity-of-identifiers/Standard-ML/case-sensitivity-of-identifiers.ml new file mode 100644 index 0000000000..c369ad9224 --- /dev/null +++ b/Task/Case-sensitivity-of-identifiers/Standard-ML/case-sensitivity-of-identifiers.ml @@ -0,0 +1,7 @@ +let + val dog = "Benjamin" + val Dog = "Samba" + val DOG = "Bernie" +in + print("The three dogs are named " ^ dog ^ ", " ^ Dog ^ ", and " ^ DOG ^ ".\n") +end; diff --git a/Task/Casting-out-nines/00DESCRIPTION b/Task/Casting-out-nines/00DESCRIPTION index d643a652b0..0ce9091ff4 100644 --- a/Task/Casting-out-nines/00DESCRIPTION +++ b/Task/Casting-out-nines/00DESCRIPTION @@ -1,20 +1,22 @@ -A task in three parts: +;Task   (in three parts): + ;Part 1 Write a procedure (say \mathit{co9}(x)) which implements [http://mathforum.org/library/drmath/view/55926.html Casting Out Nines] as described by returning the checksum for x. Demonstrate the procedure using the examples given there, or others you may consider lucky. ;Part 2 Notwithstanding past Intel microcode errors, checking computer calculations like this would not be sensible. To find a computer use for your procedure: -:Consider the statement "318682 is 101558 + 217124 and squared is 101558217124" (see: [[Kaprekar numbers#Casting Out Nines (fast)]]). -:note that 318682 has the same checksum as (101558 + 217124); -:note that 101558217124 has the same checksum as (101558 + 217124) because for a Kaprekar they are made up of the same digits (sometimes with extra zeroes); -:note that this implies that for Kaprekar numbers the checksum of k equals the checksum of k^2. +: Consider the statement "318682 is 101558 + 217124 and squared is 101558217124" (see: [[Kaprekar numbers#Casting Out Nines (fast)]]). +: note that 318682 has the same checksum as (101558 + 217124); +: note that 101558217124 has the same checksum as (101558 + 217124) because for a Kaprekar they are made up of the same digits (sometimes with extra zeroes); +: note that this implies that for Kaprekar numbers the checksum of k equals the checksum of k^2. Demonstrate that your procedure can be used to generate or filter a range of numbers with the property \mathit{co9}(k) = \mathit{co9}(k^2) and show that this subset is a small proportion of the range and contains all the Kaprekar in the range. ;Part 3 -Considering [http://mathworld.wolfram.com/CastingOutNines.html this Mathworld page], produce a efficient algorithmn based on the more mathmatical treatment of Casting Out Nines, and realizing: -:\mathit{co9}(x) is the residual of x mod 9; -:the procedure can be extended to bases other than 9. +Considering [http://mathworld.wolfram.com/CastingOutNines.html this MathWorld page], produce a efficient algorithm based on the more mathematical treatment of Casting Out Nines, and realizing: +: \mathit{co9}(x) is the residual of x mod 9; +: the procedure can be extended to bases other than 9. Demonstrate your algorithm by generating or filtering a range of numbers with the property k%(\mathit{Base}-1) == (k^2)%(\mathit{Base}-1) and show that this subset is a small proportion of the range and contains all the Kaprekar in the range. +

    diff --git a/Task/Casting-out-nines/Haskell/casting-out-nines.hs b/Task/Casting-out-nines/Haskell/casting-out-nines.hs new file mode 100644 index 0000000000..44d2a1855c --- /dev/null +++ b/Task/Casting-out-nines/Haskell/casting-out-nines.hs @@ -0,0 +1,10 @@ +digits base n + | n < m = [n] + | otherwise = r : digits base q where (q,r) = n `divMod` base + +co9 n + | n <= 8 = n + | otherwise = co9 $ sum $ filter (/= 9) $ digits 10 n + +task2 = filter (\n -> co9 n == co9 (n^2)) [1..100] +task3 k = filter (\n -> n `mod` k == n^2 `mod` k) [1..100] diff --git a/Task/Casting-out-nines/Java/casting-out-nines.java b/Task/Casting-out-nines/Java/casting-out-nines.java new file mode 100644 index 0000000000..8fd3af3292 --- /dev/null +++ b/Task/Casting-out-nines/Java/casting-out-nines.java @@ -0,0 +1,33 @@ +import java.util.*; +import java.util.stream.IntStream; + +public class CastingOutNines { + + public static void main(String[] args) { + System.out.println(castOut(16, 1, 255)); + System.out.println(castOut(10, 1, 99)); + System.out.println(castOut(17, 1, 288)); + } + + static List castOut(int base, int start, int end) { + int[] ran = IntStream + .range(0, base - 1) + .filter(x -> x % (base - 1) == (x * x) % (base - 1)) + .toArray(); + + int x = start / (base - 1); + + List result = new ArrayList<>(); + while (true) { + for (int n : ran) { + int k = (base - 1) * x + n; + if (k < start) + continue; + if (k > end) + return result; + result.add(k); + } + x++; + } + } +} diff --git a/Task/Casting-out-nines/JavaScript/casting-out-nines.js b/Task/Casting-out-nines/JavaScript/casting-out-nines.js new file mode 100644 index 0000000000..98237fd19b --- /dev/null +++ b/Task/Casting-out-nines/JavaScript/casting-out-nines.js @@ -0,0 +1,32 @@ +function main( s, e, bs, pbs ) { + bs = bs || 10; pbs = pbs || 10 + document.write('start:',toString(s), ' end:',toString(e), ' base:',bs, ' printBase:',pbs ) + document.write('
    castOutNine: '); castOutNine() + document.write('
    kaprekar: '); kaprekar() + document.write('

    ') + function castOutNine() { + for (var n=s, k=0, bsm1=bs-1; n<=e; n+=1) if (n%bsm1 == (n*n)%bsm1) k+=1, document.write(toString(n), ' ') + document.write('
    trying ', k, ' numbers instead of ', n=e-s+1, ' numbers saves ', (100-k/n*100).toFixed(3), '%') + } + function kaprekar() { + for (var n=s; n<=e; n+=1) if (isKaprekar(n)) document.write(toString(n), ' ') + function isKaprekar( n ) { + if ( n < 1 ) return false + if ( n == 1 ) return true + var s = (n * n).toString(bs) + for (var i=1, e=s.length; i=(Base^N)-1 THEN GO TO 150 +70 LET c1=c1+1 +80 IF FN m(k,Base-1)=FN m(k*k,Base-1) THEN LET c2=c2+1: PRINT k;" "; +90 LET k=k+1 +100 GO TO 60 +150 PRINT '"Trying ";c2;" numbers instead of ";c1;" numbers saves ";100-(c2/c1)*100;"%" +160 STOP +170 DEF FN m(a,b)=a-INT (a/b)*b diff --git a/Task/Catalan-numbers-Pascals-triangle/00DESCRIPTION b/Task/Catalan-numbers-Pascals-triangle/00DESCRIPTION index 0a0cc3e4a5..74024770df 100644 --- a/Task/Catalan-numbers-Pascals-triangle/00DESCRIPTION +++ b/Task/Catalan-numbers-Pascals-triangle/00DESCRIPTION @@ -1,4 +1,12 @@ -The task is to print out the first 15 Catalan numbers by extracting them from Pascal's triangle, see [http://milan.milanovic.org/math/english/fibo/fibo4.html Catalan Numbers and the Pascal Triangle]. This enables calculation of Catalan Numbers using only addition and subtraction. See [http://mathworld.wolfram.com/CatalansTriangle.html Catalan's Triangle] for a Number Triangle that generates Catalan Numbers using only addition. +;Task: +Print out the first   '''15'''   Catalan numbers by extracting them from Pascal's triangle. -Related Tasks: + +;See: +*   [http://milan.milanovic.org/math/english/fibo/fibo4.html Catalan Numbers and the Pascal Triangle].     This method enables calculation of Catalan Numbers using only addition and subtraction. +*   [http://mathworld.wolfram.com/CatalansTriangle.html Catalan's Triangle] for a Number Triangle that generates Catalan Numbers using only addition. + + +;Related Tasks: [[Pascal's triangle]] +

    diff --git a/Task/Catalan-numbers-Pascals-triangle/ALGOL-68/catalan-numbers-pascals-triangle.alg b/Task/Catalan-numbers-Pascals-triangle/ALGOL-68/catalan-numbers-pascals-triangle.alg new file mode 100644 index 0000000000..a92eef859c --- /dev/null +++ b/Task/Catalan-numbers-Pascals-triangle/ALGOL-68/catalan-numbers-pascals-triangle.alg @@ -0,0 +1,10 @@ +INT n = 15; +[ 0 : n + 1 ]INT t; +t[0] := 0; +t[1] := 1; +FOR i TO n DO + FOR j FROM i BY -1 TO 2 DO t[j] := t[j] + t[j-1] OD; + t[i+1] := t[i]; + FOR j FROM i+1 BY -1 TO 2 DO t[j] := t[j] + t[j-1] OD; + print( ( whole( t[i+1] - t[i], 0 ), " " ) ) +OD diff --git a/Task/Catalan-numbers-Pascals-triangle/APL/catalan-numbers-pascals-triangle.apl b/Task/Catalan-numbers-Pascals-triangle/APL/catalan-numbers-pascals-triangle.apl new file mode 100644 index 0000000000..c7cc77f275 --- /dev/null +++ b/Task/Catalan-numbers-Pascals-triangle/APL/catalan-numbers-pascals-triangle.apl @@ -0,0 +1,2 @@ + ⍝ Based heavily on the J solution + CATALAN←{¯1↓↑-/1 ¯1↓¨(⊂⎕IO+0 0)⍉¨0 2⌽¨⊂(⎕IO-⍨⍳N){+\⍣⍺⊢⍵}⍤0 1⊢1⍴⍨N←⍵+2} diff --git a/Task/Catalan-numbers-Pascals-triangle/C/catalan-numbers-pascals-triangle.c b/Task/Catalan-numbers-Pascals-triangle/C/catalan-numbers-pascals-triangle.c new file mode 100644 index 0000000000..148945e44b --- /dev/null +++ b/Task/Catalan-numbers-Pascals-triangle/C/catalan-numbers-pascals-triangle.c @@ -0,0 +1,45 @@ +//This code implements the print of 15 first Catalan's Numbers +//Formula used: +// __n__ +// | | (n + k) / k n>0 +// k=2 + +#include +#include + +//the number of Catalan's Numbers to be printed +const int N = 15; + +int main() +{ + //loop variables (in registers) + register int k, n; + + //necessarily ull for reach big values + unsigned long long int num, den; + + //the nmmber + int catalan; + + //the first is not calculated for the formula + printf("1 "); + + //iterating fro 2 to 15 + for (n=2; n<=N; ++n) { + //initializaing for products + num = den = 1; + //applying the formula + for (k=2; k<=n; ++k) { + num *= (n+k); + den *= k; + catalan = num /den; + } + + //output + printf("%d ", catalan); + } + + //the end + printf("\n"); + return 0; +} diff --git a/Task/Catalan-numbers-Pascals-triangle/Java/catalan-numbers-pascals-triangle.java b/Task/Catalan-numbers-Pascals-triangle/Java/catalan-numbers-pascals-triangle.java new file mode 100644 index 0000000000..6ebbc1726c --- /dev/null +++ b/Task/Catalan-numbers-Pascals-triangle/Java/catalan-numbers-pascals-triangle.java @@ -0,0 +1,20 @@ +public class Test { + public static void main(String[] args) { + int N = 15; + int[] t = new int[N + 2]; + t[1] = 1; + + for (int i = 1; i <= N; i++) { + + for (int j = i; j > 1; j--) + t[j] = t[j] + t[j - 1]; + + t[i + 1] = t[i]; + + for (int j = i + 1; j > 1; j--) + t[j] = t[j] + t[j - 1]; + + System.out.printf("%d ", t[i + 1] - t[i]); + } + } +} diff --git a/Task/Catalan-numbers-Pascals-triangle/JavaScript/catalan-numbers-pascals-triangle-1.js b/Task/Catalan-numbers-Pascals-triangle/JavaScript/catalan-numbers-pascals-triangle-1.js new file mode 100644 index 0000000000..6a1a271337 --- /dev/null +++ b/Task/Catalan-numbers-Pascals-triangle/JavaScript/catalan-numbers-pascals-triangle-1.js @@ -0,0 +1,7 @@ +var n = 15; +for (var t = [0, 1], i = 1; i <= n; i++) { + for (var j = i; j > 1; j--) t[j] += t[j - 1]; + t[i + 1] = t[i]; + for (var j = i + 1; j > 1; j--) t[j] += t[j - 1]; + document.write(i == 1 ? '' : ', ', t[i + 1] - t[i]); +} diff --git a/Task/Catalan-numbers-Pascals-triangle/JavaScript/catalan-numbers-pascals-triangle-2.js b/Task/Catalan-numbers-Pascals-triangle/JavaScript/catalan-numbers-pascals-triangle-2.js new file mode 100644 index 0000000000..e680691225 --- /dev/null +++ b/Task/Catalan-numbers-Pascals-triangle/JavaScript/catalan-numbers-pascals-triangle-2.js @@ -0,0 +1,64 @@ +(() => { + 'use strict'; + + // CATALAN + + // catalanSeries :: Int -> [Int] + let catalanSeries = n => { + let alternate = xs => xs.reduce( + (a, x, i) => i % 2 === 0 ? a.concat([x]) : a, [] + ), + diff = xs => xs.length > 1 ? xs[0] - xs[1] : xs[0]; + + return alternate(pascal(n * 2)) + .map((xs, i) => diff(drop(i, xs))); + } + + // PASCAL + + // pascal :: Int -> [[Int]] + let pascal = n => until( + m => m.level <= 1, + m => { + let nxt = zipWith( + (a, b) => a + b, [0].concat(m.row), m.row.concat(0) + ); + return { + row: nxt, + triangle: m.triangle.concat([nxt]), + level: m.level - 1 + } + }, { + level: n, + row: [1], + triangle: [ + [1] + ] + } + ) + .triangle; + + + // GENERIC FUNCTIONS + + // zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] + let zipWith = (f, xs, ys) => + xs.length === ys.length ? ( + xs.map((x, i) => f(x, ys[i])) + ) : undefined; + + // until :: (a -> Bool) -> (a -> a) -> a -> a + let until = (p, f, x) => { + let v = x; + while (!p(v)) v = f(v); + return v; + } + + // drop :: Int -> [a] -> [a] + let drop = (n, xs) => xs.slice(n); + + // tail :: [a] -> [a] + let tail = xs => xs.length ? xs.slice(1) : undefined; + + return tail(catalanSeries(16)); +})(); diff --git a/Task/Catalan-numbers-Pascals-triangle/JavaScript/catalan-numbers-pascals-triangle-3.js b/Task/Catalan-numbers-Pascals-triangle/JavaScript/catalan-numbers-pascals-triangle-3.js new file mode 100644 index 0000000000..99cd99f9fb --- /dev/null +++ b/Task/Catalan-numbers-Pascals-triangle/JavaScript/catalan-numbers-pascals-triangle-3.js @@ -0,0 +1 @@ +[1,2,5,14,42,132,429,1430,4862,16796,58786,208012,742900,2674440,9694845] diff --git a/Task/Catalan-numbers-Pascals-triangle/JavaScript/catalan-numbers-pascals-triangle.js b/Task/Catalan-numbers-Pascals-triangle/JavaScript/catalan-numbers-pascals-triangle.js deleted file mode 100644 index 7b569e9259..0000000000 --- a/Task/Catalan-numbers-Pascals-triangle/JavaScript/catalan-numbers-pascals-triangle.js +++ /dev/null @@ -1,7 +0,0 @@ -var n=15 -for (var t=[0,1], i=1; i<=n; i++) { - for (var j=i; j>1; j--) t[j] += t[j-1] - t[i+1] = t[i]; - for (var j=i+1; j>1; j--) t[j] += t[j-1] - document.write(i==1 ? '' : ', ', t[i+1] - t[i]) -} diff --git a/Task/Catalan-numbers-Pascals-triangle/Lua/catalan-numbers-pascals-triangle.lua b/Task/Catalan-numbers-Pascals-triangle/Lua/catalan-numbers-pascals-triangle.lua new file mode 100644 index 0000000000..91213713ff --- /dev/null +++ b/Task/Catalan-numbers-Pascals-triangle/Lua/catalan-numbers-pascals-triangle.lua @@ -0,0 +1,17 @@ +function nextrow (t) + local ret = {} + t[0], t[#t + 1] = 0, 0 + for i = 1, #t do ret[i] = t[i - 1] + t[i] end + return ret +end + +function catalans (n) + local t, middle = {1} + for i = 1, n do + middle = math.ceil(#t / 2) + io.write(t[middle] - (t[middle + 1] or 0) .. " ") + t = nextrow(nextrow(t)) + end +end + +catalans(15) diff --git a/Task/Catalan-numbers-Pascals-triangle/REXX/catalan-numbers-pascals-triangle-1.rexx b/Task/Catalan-numbers-Pascals-triangle/REXX/catalan-numbers-pascals-triangle-1.rexx index 2501989058..6a21491770 100644 --- a/Task/Catalan-numbers-Pascals-triangle/REXX/catalan-numbers-pascals-triangle-1.rexx +++ b/Task/Catalan-numbers-Pascals-triangle/REXX/catalan-numbers-pascals-triangle-1.rexx @@ -1,10 +1,12 @@ -/*REXX program obtains Catalan numbers from Pascal's triangle. */ -parse arg N .; if N=='' then N=15 /*Any args? No, then use default*/ -numeric digits max(9,N%2+N%8) /*can handle huge Catalan numbers*/ -@.=0; @.1=1 /*stem array default; 1st value.*/ +/*REXX program obtains and displays Catalan numbers from a Pascal's triangle. */ +parse arg N . /*Obtain the optional argument from CL.*/ +if N=='' | N=="." then N=15 /*Not specified? Then use the default.*/ +numeric digits max(9, N%2 + N%8) /*so we can handle huge Catalan numbers*/ +@.=0; @.1=1 /*stem array default; define 1st value.*/ - do i=1 for N; ip=i+1 - do j=i by -1 for N; jm=j-1; @.j=@.j+@.jm; end /*j*/ - @.ip=@.i; do k=ip by -1 for N; km=k-1; @.k=@.k+@.km; end /*k*/ - say @.ip-@.i /*display the Ith Catalan number.*/ - end /*i*/ /*stick a fork in it, we're done.*/ + do i=1 for N; ip=i+1 + do j=i by -1 for N; jm=j-1; @.j=@.j+@.jm; end /*j*/ + @.ip=@.i + do k=ip by -1 for N; km=k-1; @.k=@.k+@.km; end /*k*/ + say @.ip - @.i /*display the Ith Catalan number. */ + end /*i*/ /*stick a fork in it, we're all done. */ diff --git a/Task/Catalan-numbers-Pascals-triangle/REXX/catalan-numbers-pascals-triangle-2.rexx b/Task/Catalan-numbers-Pascals-triangle/REXX/catalan-numbers-pascals-triangle-2.rexx index 50a8f6eb43..c82dbacad4 100644 --- a/Task/Catalan-numbers-Pascals-triangle/REXX/catalan-numbers-pascals-triangle-2.rexx +++ b/Task/Catalan-numbers-Pascals-triangle/REXX/catalan-numbers-pascals-triangle-2.rexx @@ -1,14 +1,14 @@ -/*REXX program obtains/displays Catalan numbers from Pascal's triangle.*/ -parse arg N .; if N=='' then N=15 /*Any args? No, then use default*/ -numeric digits max(9,N%2+N%8) /*can handle huge Catalan numbers*/ -@.=0; @.1=1 /*stem array default; 1st value.*/ +/*REXX program obtains and displays Catalan numbers from a Pascal's triangle. */ +parse arg N . /*Obtain the optional argument from CL.*/ +if N=='' | N=="." then N=15 /*Not specified? Then use the default.*/ +numeric digits max(9, N%2 + N%8) /*so we can handle huge Catalan numbers*/ +@.=0; @.1=1 /*stem array default; define 1st value.*/ - do i=1 for N; ip=i+1 - do j=i by -1 for N; @.j=@.j+@(j-1); end /*j*/ - @.ip=@.i; do k=ip by -1 for N; @.k=@.k+@(k-1); end /*k*/ - say @.ip-@.i /*display the Ith Catalan number.*/ - end /*i*/ - -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────@ subroutine────────────────────────*/ -@: parse arg !; return @.! /*return the value of @.[arg(1)]*/ + do i=1 for N; ip=i+1 + do j=i by -1 for N; @.j=@.j+@(j-1); end /*j*/ + @.ip=@.i; do k=ip by -1 for N; @.k=@.k+@(k-1); end /*k*/ + say @.ip - @.i /*display the Ith Catalan number. */ + end /*i*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +@: parse arg !; return @.! /*return the value of @.[arg(1)] */ diff --git a/Task/Catalan-numbers-Pascals-triangle/REXX/catalan-numbers-pascals-triangle-3.rexx b/Task/Catalan-numbers-Pascals-triangle/REXX/catalan-numbers-pascals-triangle-3.rexx index 6029424bf7..bdf3f707a1 100644 --- a/Task/Catalan-numbers-Pascals-triangle/REXX/catalan-numbers-pascals-triangle-3.rexx +++ b/Task/Catalan-numbers-Pascals-triangle/REXX/catalan-numbers-pascals-triangle-3.rexx @@ -1,13 +1,14 @@ -/*REXX program obtains/displays Catalan numbers from Pascal's triangle.*/ -parse arg N .; if N=='' then N=15 /*Any args? No, then use default*/ -numeric digits max(9,N*4) /*can handle huge Catalan numbers*/ +/*REXX program obtains and displays Catalan numbers from a Pascal's triangle. */ +parse arg N . /*Obtain the optional argument from CL.*/ +if N=='' | N=="." then N=15 /*Not specified? Then use the default.*/ +numeric digits max(9, N%2 + N%8) /*so we can handle huge Catalan numbers*/ - do j=1 for N /* [↓] show N Catalan numbers*/ - say comb(j+j,j) % (j+1) /*display the Jth Catalan number.*/ - end /*j*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────! (factorial) function──────────────*/ -!: procedure; parse arg z; _=1; do j=1 for arg(1); _=_*j; end; return _ -/*──────────────────────────────────COMB (binomial coefficient) function*/ -comb: procedure; parse arg x,y; if x=y then return 1; if y>x then return 0 -if x-yx then return 0 + if x-yx then return 0 -if x-yx then return 0 + if x-y Catalan numbers are a sequence of numbers which can be defined directly: :C_n = \frac{1}{n+1}{2n\choose n} = \frac{(2n)!}{(n+1)!\,n!} \qquad\mbox{ for }n\ge 0. Or recursively: @@ -5,8 +6,14 @@ Or recursively: Or alternatively (also recursive): :C_0 = 1 \quad \mbox{and} \quad C_n=\frac{2(2n-1)}{n+1}C_{n-1}, -Implement at least one of these algorithms and print out the first 15 Catalan numbers with each. [[Memoization]] is not required, but may be worth the effort when using the second method above. -Related tasks: +;Task: +Implement at least one of these algorithms and print out the first 15 Catalan numbers with each. + +[[Memoization]]   is not required, but may be worth the effort when using the second method above. + + +;Related tasks: *[[Catalan numbers/Pascal's triangle]] *[[Evaluate binomial coefficients]] +

    diff --git a/Task/Catalan-numbers/ALGOL-68/catalan-numbers.alg b/Task/Catalan-numbers/ALGOL-68/catalan-numbers.alg new file mode 100644 index 0000000000..862e99ef68 --- /dev/null +++ b/Task/Catalan-numbers/ALGOL-68/catalan-numbers.alg @@ -0,0 +1,32 @@ +# calculate the first few catalan numbers, using LONG INT values # +# (64-bit quantities in Algol 68G which can handle up to C23) # + +# returns n!/k! # +PROC factorial over factorial = ( INT n, k )LONG INT: + IF k > n THEN 0 + ELIF k = n THEN 1 + ELSE # k < n # + LONG INT f := 1; + FOR i FROM k + 1 TO n DO f *:= i OD; + f + FI # factorial over factorial # ; + +# returns n! # +PROC factorial = ( INT n )LONG INT: + BEGIN + LONG INT f := 1; + FOR i FROM 2 TO n DO f *:= i OD; + f + END # factorial # ; + +# returnss the nth Catalan number using binomial coefficeients # +# uses the factorial over factorial procedure for a slight optimisation # +# note: Cn = 1/(n+1)(2n n) # +# = (2n)!/((n+1)!n!) # +# = factorial over factorial( 2n, n+1 )/n! # +PROC catalan = ( INT n )LONG INT: IF n < 2 THEN 1 ELSE factorial over factorial( n + n, n + 1 ) OVER factorial( n ) FI; + +# show the first few catalan numbers # +FOR i FROM 0 TO 15 DO + print( ( whole( i, -2 ), ": ", whole( catalan( i ), 0 ), newline ) ) +OD diff --git a/Task/Catalan-numbers/APL/catalan-numbers.apl b/Task/Catalan-numbers/APL/catalan-numbers.apl new file mode 100644 index 0000000000..e887f23181 --- /dev/null +++ b/Task/Catalan-numbers/APL/catalan-numbers.apl @@ -0,0 +1 @@ + {(!2×⍵)÷(!⍵+1)×!⍵}(⍳15)-1 diff --git a/Task/Catalan-numbers/Eiffel/catalan-numbers.e b/Task/Catalan-numbers/Eiffel/catalan-numbers.e index b1ded6700c..48e6ace4fe 100644 --- a/Task/Catalan-numbers/Eiffel/catalan-numbers.e +++ b/Task/Catalan-numbers/Eiffel/catalan-numbers.e @@ -11,7 +11,7 @@ feature {NONE} across 0 |..| 14 as c loop - io.put_double (catalan_numbers (c.item)) + io.put_double (nth_catalan_number (c.item)) io.new_line end end @@ -28,7 +28,7 @@ feature {NONE} else t := 4 * n.to_double - 2 s := n.to_double + 1 - Result := t / s * catalan_numbers (n - 1) + Result := t / s * nth_catalan_number (n - 1) end end diff --git a/Task/Catalan-numbers/Kotlin/catalan-numbers.kotlin b/Task/Catalan-numbers/Kotlin/catalan-numbers.kotlin new file mode 100644 index 0000000000..d02b6ad9f9 --- /dev/null +++ b/Task/Catalan-numbers/Kotlin/catalan-numbers.kotlin @@ -0,0 +1,55 @@ +import net.openhft.koloboke.collect.map.hash.HashIntDoubleMaps.* + +abstract class Catalan { + abstract operator fun invoke(n: Int) : Double + + protected val m = newUpdatableMapOf(0 , 1.0) +} + +object CatalanI : Catalan() { + override fun invoke(n: Int): Double { + if (n !in m) + m[n] = Math.round(fact(2 * n) / (fact(n + 1) * fact(n))).toDouble() + return m[n] + } + + private fun fact(n: Int): Double { + if (n in facts) + return facts[n] + var f = n * fact(n -1) + facts[n] = f + return f + } + + private val facts = newUpdatableMapOf(0 , 1.0, 1 , 1.0, 2 , 2.0) +} + +object CatalanR1 : Catalan() { + override fun invoke(n: Int): Double { + if (n in m) + return m[n] + + var sum = 0.0 + for (i in 0..n - 1) + sum += invoke(i) * invoke(n - 1 - i) + sum = Math.round(sum).toDouble() + m[n] = sum + return sum + } +} + +object CatalanR2 : Catalan() { + override fun invoke(n: Int): Double { + if (n !in m) + m[n] = Math.round(2.0 * (2 * (n - 1) + 1) / (n + 1) * invoke(n - 1)).toDouble() + return m[n] + } +} + +fun main(args: Array) { + val c = arrayOf(CatalanI, CatalanR1, CatalanR2) + for(i in 0..15) { + c.forEach { print("%9d".format(it(i).toLong())) } + println() + } +} diff --git a/Task/Catalan-numbers/PowerShell/catalan-numbers-1.psh b/Task/Catalan-numbers/PowerShell/catalan-numbers-1.psh new file mode 100644 index 0000000000..22a8095ac7 --- /dev/null +++ b/Task/Catalan-numbers/PowerShell/catalan-numbers-1.psh @@ -0,0 +1,10 @@ +function Catalan([uint64]$m) { + function fact([bigint]$n) { + if($n -lt 2) {[bigint]::one} + else{2..$n | foreach -Begin {$prod = [bigint]::one} -Process {$prod = [bigint]::Multiply($prod,$_)} -End {$prod}} + } + $fact = fact $m + $fact1 = [bigint]::Multiply($m+1,$fact) + [bigint]::divide((fact (2*$m)), [bigint]::Multiply($fact,$fact1)) +} +0..15 | foreach {"catalan($_): $(catalan $_)"} diff --git a/Task/Catalan-numbers/PowerShell/catalan-numbers-2.psh b/Task/Catalan-numbers/PowerShell/catalan-numbers-2.psh new file mode 100644 index 0000000000..f0bc38b0e7 --- /dev/null +++ b/Task/Catalan-numbers/PowerShell/catalan-numbers-2.psh @@ -0,0 +1,51 @@ +function Get-CatalanNumber +{ + [CmdletBinding()] + [OutputType([PSCustomObject])] + Param + ( + [Parameter(Mandatory=$true, + ValueFromPipeline=$true, + ValueFromPipelineByPropertyName=$true, + Position=0)] + [uint32[]] + $InputObject + ) + + Begin + { + function Get-Factorial ([int]$Number) + { + if ($Number -eq 0) + { + return 1 + } + + $factorial = 1 + + 1..$Number | ForEach-Object {$factorial *= $_} + + $factorial + } + + function Get-Catalan ([int]$Number) + { + if ($Number -eq 0) + { + return 1 + } + + (Get-Factorial (2 * $Number)) / ((Get-Factorial (1 + $Number)) * (Get-Factorial $Number)) + } + } + Process + { + foreach ($number in $InputObject) + { + [PSCustomObject]@{ + Number = $number + CatalanNumber = Get-Catalan $number + } + } + } +} diff --git a/Task/Catalan-numbers/PowerShell/catalan-numbers-3.psh b/Task/Catalan-numbers/PowerShell/catalan-numbers-3.psh new file mode 100644 index 0000000000..97a6ba77e4 --- /dev/null +++ b/Task/Catalan-numbers/PowerShell/catalan-numbers-3.psh @@ -0,0 +1 @@ +0..14 | Get-CatalanNumber diff --git a/Task/Catalan-numbers/PowerShell/catalan-numbers-4.psh b/Task/Catalan-numbers/PowerShell/catalan-numbers-4.psh new file mode 100644 index 0000000000..c7fca55fba --- /dev/null +++ b/Task/Catalan-numbers/PowerShell/catalan-numbers-4.psh @@ -0,0 +1 @@ +(0..14 | Get-CatalanNumber).CatalanNumber diff --git a/Task/Catalan-numbers/REXX/catalan-numbers-1.rexx b/Task/Catalan-numbers/REXX/catalan-numbers-1.rexx index 0e9e78bdb1..f46a7d7ba9 100644 --- a/Task/Catalan-numbers/REXX/catalan-numbers-1.rexx +++ b/Task/Catalan-numbers/REXX/catalan-numbers-1.rexx @@ -1,31 +1,23 @@ -/*REXX program calculates Catalan numbers using four different methods. */ -parse arg bot top . /*get optional arguments from the C.L. */ -if bot=='' then do; top=15; bot=0; end /*No args? Use a range of 0 ───► 15. */ -if top=='' then top=bot /*No top? Use the bottom for default. */ -numeric digits max(20, 5*top) /*this allows gihugic Catalan numbers. */ -@cat=' Catalan' /*a nice literal to have for the SAY. */ -w=length(top) /*width of the largest number for SAY. */ -call hdr 1A; do j=bot to top; say @cat right(j,w)": " Catalan1A(j); end -call hdr 1B; do j=bot to top; say @cat right(j,w)": " Catalan1B(j); end -call hdr 2 ; do j=bot to top; say @cat right(j,w)": " Catalan2(j); end -call hdr 3 ; do j=bot to top; say @cat right(j,w)": " Catalan3(j); end -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -Catalan1A: procedure expose !.; parse arg n; return comb(n+n, n) % (n+1) -Catalan1B: procedure expose !.; parse arg n; return !(n+n) % ((n+1) * !(n)**2) -comb: procedure; parse arg x,y; return pFact(x-y+1,x) % pFact(2,y) -pFact: procedure; !=1; do k=arg(1) to arg(2); !=!*k; end; return ! -/*────────────────────────────────────────────────────────────────────────────*/ -hdr: !.=.; c.=.; c.0=1; say -say center(' Catalan numbers, method' left(arg(1),3), 79, '─'); return -/*────────────────────────────────────────────────────────────────────────────*/ -!: procedure expose !.; parse arg x; !=1; if !.x\==. then return !.x - do k=1 for x; !=!*k; end /*k*/ - !.x=!; return ! -/*──────────────────────────────────Catalan method 2──────────────────────────*/ -Catalan2: procedure expose c.; parse arg n; $=0; if c.n\==. then return c.n - do k=0 to n-1; $=$+catalan2(k)*catalan2(n-k-1); end - c.n=$; return $ /*use a REXX memoization technique. */ -/*──────────────────────────────────Catalan method 3──────────────────────────*/ -Catalan3: procedure expose c.; parse arg n - if c.n==. then c.n=(4*n-2) * catalan3(n-1) % (n+1); return c.n +/*REXX program calculates and displays Catalan numbers using four different methods. */ +parse arg LO HI . /*obtain optional arguments from the CL*/ +if LO=='' | LO=="," then do; HI=15; LO=0; end /*No args? Then use a range of 0 ──► 15*/ +if HI=='' | HI=="," then HI=LO /*No HI? Then use LO for the default*/ +numeric digits max(20, 5*HI) /*this allows gihugic Catalan numbers. */ +w=length(HI) /*W: is used for aligning the output. */ +call hdr 1A; do j=LO to HI; say ' Catalan' right(j, w)": " Cat1A(j); end +call hdr 1B; do j=LO to HI; say ' Catalan' right(j, w)": " Cat1B(j); end +call hdr 2 ; do j=LO to HI; say ' Catalan' right(j, w)": " Cat2(j) ; end +call hdr 3 ; do j=LO to HI; say ' Catalan' right(j, w)": " Cat3(j) ; end +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +!: arg z; if !.z\==. then return !.z; !=1; do k=2 for z; !=!*k; end; !.z=!; return ! +Cat1A: procedure expose !.; parse arg n; return comb(n+n, n) % (n+1) +Cat1B: procedure expose !.; parse arg n; return !(n+n) % ((n+1) * !(n)**2) +Cat3: procedure expose c.; arg n; if c.n==. then c.n=(4*n-2)*cat3(n-1)%(n+1); return c.n +comb: procedure; parse arg x,y; return pFact(x-y+1, x) % pFact(2, y) +hdr: !.=.; c.=.; c.0=1; say; say center('Catalan numbers, method' arg(1),79,'─'); return +pFact: procedure; !=1; do k=arg(1) to arg(2); !=!*k; end; return ! +/*──────────────────────────────────────────────────────────────────────────────────────*/ +Cat2: procedure expose c.; parse arg n; $=0; if c.n\==. then return c.n + do k=0 to n-1; $=$ + cat2(k) * cat2(n-k-1); end + c.n=$; return $ /*use a memoization technique.*/ diff --git a/Task/Catalan-numbers/ZX-Spectrum-Basic/catalan-numbers.zx b/Task/Catalan-numbers/ZX-Spectrum-Basic/catalan-numbers.zx new file mode 100644 index 0000000000..fcee4b29f0 --- /dev/null +++ b/Task/Catalan-numbers/ZX-Spectrum-Basic/catalan-numbers.zx @@ -0,0 +1,12 @@ +10 FOR i=0 TO 15 +20 LET n=i: LET m=2*n +30 LET r=1: LET d=m-n +40 IF d>n THEN LET n=d: LET d=m-n +50 IF m<=n THEN GO TO 90 +60 LET r=r*m: LET m=m-1 +70 IF (d>1) AND NOT FN m(r,d) THEN LET r=r/d: LET d=d-1: GO TO 70 +80 GO TO 50 +90 PRINT i;TAB 4;r/(1+n) +100 NEXT i +110 STOP +120 DEF FN m(a,b)=a-INT (a/b)*b: REM Modulus function diff --git a/Task/Catamorphism/00DESCRIPTION b/Task/Catamorphism/00DESCRIPTION index 7733020350..0f07416896 100644 --- a/Task/Catamorphism/00DESCRIPTION +++ b/Task/Catamorphism/00DESCRIPTION @@ -1,7 +1,11 @@ ''Reduce'' is a function or method that is used to take the values in an array or a list and apply a function to successive members of the list to produce (or reduce them to), a single value. + +;Task: Show how ''reduce'' (or ''foldl'' or ''foldr'' etc), work (or would be implemented) in your language. + ;Cf. * [[wp:Fold (higher-order function)|Fold]] * [[wp:Catamorphism|Catamorphism]] +

    diff --git a/Task/Catamorphism/ALGOL-68/catamorphism.alg b/Task/Catamorphism/ALGOL-68/catamorphism.alg new file mode 100644 index 0000000000..4d7ffe2856 --- /dev/null +++ b/Task/Catamorphism/ALGOL-68/catamorphism.alg @@ -0,0 +1,20 @@ +# applies fn to successive elements of the array of values # +# the result is 0 if there are no values # +PROC reduce = ( []INT values, PROC( INT, INT )INT fn )INT: + IF UPB values < LWB values + THEN # no elements # + 0 + ELSE # there are some elements # + INT result := values[ LWB values ]; + FOR pos FROM LWB values + 1 TO UPB values + DO + result := fn( result, values[ pos ] ) + OD; + result + FI; # reduce # + +# test the reduce procedure # +BEGIN print( ( reduce( ( 1, 2, 3, 4, 5 ), ( INT a, b )INT: a + b ), newline ) ) # sum # + ; print( ( reduce( ( 1, 2, 3, 4, 5 ), ( INT a, b )INT: a * b ), newline ) ) # product # + ; print( ( reduce( ( 1, 2, 3, 4, 5 ), ( INT a, b )INT: a - b ), newline ) ) # difference # +END diff --git a/Task/Catamorphism/AppleScript/catamorphism.applescript b/Task/Catamorphism/AppleScript/catamorphism.applescript new file mode 100644 index 0000000000..76bda1abfd --- /dev/null +++ b/Task/Catamorphism/AppleScript/catamorphism.applescript @@ -0,0 +1,76 @@ +-- the arguments available to the called function f(a, x, i, l) are +-- a: current accumulator value +-- x: current item in list +-- i: [ 1-based index in list ] optional +-- l: [ a reference to the list itself ] optional + +-- reduce :: (a -> b -> a) -> a -> [b] -> a +on reduce(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 reduce + + +-- the arguments available to the called function f(a, x, i, l) are +-- a: current accumulator value +-- x: current item in list +-- i: [ 1-based index in list ] optional +-- l: [ a reference to the list itself ] optional + +-- reduceRight :: (a -> b -> a) -> a -> [b] -> a +on reduceRight(f, startValue, xs) + tell mReturn(f) + set v to startValue + set lng to length of xs + repeat with i from lng to 1 by -1 + set v to lambda(v, item i of xs, i, xs) + end repeat + return v + end tell +end reduceRight + + +-- TEST +on run + set lst to {1, 2, 3, 4, 5, 6, 7, 8, 9, 10} + + {reduce(sum_, 0, lst), ¬ + reduce(product_, 1, lst), ¬ + reduceRight(append_, "", lst)} + + --> {55, 3628800, "10987654321"} +end run + +on sum_(a, b) + a + b +end sum_ + +on product_(a, b) + a * b +end product_ + +on append_(a, b) + a & b +end append_ + + + +-- GENERIC + +-- 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 diff --git a/Task/Catamorphism/Elena/catamorphism.elena b/Task/Catamorphism/Elena/catamorphism.elena new file mode 100644 index 0000000000..eec0873a89 --- /dev/null +++ b/Task/Catamorphism/Elena/catamorphism.elena @@ -0,0 +1,18 @@ +#import system. +#import system'collections. +#import system'routines. +#import extensions. +#import extensions'text. + +#symbol program = +[ + #var numbers := 1 repeat &till:10 &each:n [ n ] summarize:(ArrayList new). + + #var summary := numbers accumulate:(Variable new:0) &with:(:a:b) [ a + b ]. + + #var product := numbers accumulate:(Variable new:1) &with:(:a:b) [ a * b ]. + + #var concatenation := numbers accumulate:(String new) &with:(:a:b) [ a literal + b literal ]. + + console writeLine:summary:" ":product:" ":concatenation. +]. diff --git a/Task/Catamorphism/Forth/catamorphism-1.fth b/Task/Catamorphism/Forth/catamorphism-1.fth new file mode 100644 index 0000000000..00cb18eef2 --- /dev/null +++ b/Task/Catamorphism/Forth/catamorphism-1.fth @@ -0,0 +1,5 @@ +: lowercase? ( c -- f ) + [char] a [ char z 1+ ] literal within ; + +: char-upcase ( c -- C ) + dup lowercase? if bl xor then ; diff --git a/Task/Catamorphism/Forth/catamorphism-2.fth b/Task/Catamorphism/Forth/catamorphism-2.fth new file mode 100644 index 0000000000..745e667d4e --- /dev/null +++ b/Task/Catamorphism/Forth/catamorphism-2.fth @@ -0,0 +1,19 @@ +: string-at ( c-addr u +n -- c ) + nip + c@ ; +: string-at! ( c-addr u +n c -- ) + rot drop -rot + c! ; + +: type-lowercase ( c-addr u -- ) + dup 0 ?do + 2dup i string-at dup lowercase? if emit else drop then + loop 2drop ; + +: upcase ( 'string' -- 'STRING' ) + dup 0 ?do + 2dup 2dup i string-at char-upcase i swap string-at! + loop ; + +: count-lowercase ( c-addr u -- n ) + 0 -rot dup 0 ?do + 2dup i string-at lowercase? if rot 1+ -rot then + loop 2drop ; diff --git a/Task/Catamorphism/Forth/catamorphism-3.fth b/Task/Catamorphism/Forth/catamorphism-3.fth new file mode 100644 index 0000000000..deea44f3ca --- /dev/null +++ b/Task/Catamorphism/Forth/catamorphism-3.fth @@ -0,0 +1,8 @@ +: next-char ( a +n -- a' n' c -1 ) ( a 0 -- 0 ) + dup if 2dup 1 /string 2swap drop c@ true + else 2drop 0 then ; + +: type-lowercase ( c-addr u -- ) + begin next-char while + dup lowercase? if emit else drop then + repeat ; diff --git a/Task/Catamorphism/Forth/catamorphism-4.fth b/Task/Catamorphism/Forth/catamorphism-4.fth new file mode 100644 index 0000000000..4e31c94d76 --- /dev/null +++ b/Task/Catamorphism/Forth/catamorphism-4.fth @@ -0,0 +1,17 @@ +: each-char[ ( c-addr u -- ) + postpone BOUNDS postpone ?DO + postpone I postpone C@ ; immediate + + \ interim code: ( c -- ) + +: ]each-char ( -- ) + postpone LOOP ; immediate + +: type-lowercase ( c-addr u -- ) + each-char[ dup lowercase? if emit else drop then ]each-char ; + +: upcase ( 'string' -- 'STRING' ) + 2dup each-char[ char-upcase i c! ]each-char ; + +: count-lowercase ( c-addr u -- n ) + 0 -rot each-char[ lowercase? if 1+ then ]each-char ; diff --git a/Task/Catamorphism/Forth/catamorphism-5.fth b/Task/Catamorphism/Forth/catamorphism-5.fth new file mode 100644 index 0000000000..6f90e406ec --- /dev/null +++ b/Task/Catamorphism/Forth/catamorphism-5.fth @@ -0,0 +1,17 @@ +: each-char ( c-addr u xt -- ) + {: xt :} bounds ?do + i c@ xt execute + loop ; + +: type-lowercase ( c-addr u -- ) + [: dup lowercase? if emit else drop then ;] + each-char ; + +\ producing a new string +: upcase ( 'string' -- 'STRING' ) + dup cell+ allocate throw -rot + [: ( new-string-addr c -- new-string-addr ) + upcase over c+! ;] each-char $@ ; + +: count-lowercase ( c-addr u -- n ) + 0 -rot [: lowercase? if 1+ then ;] each-char ; diff --git a/Task/Catamorphism/Groovy/catamorphism.groovy b/Task/Catamorphism/Groovy/catamorphism.groovy new file mode 100644 index 0000000000..9e3675ae32 --- /dev/null +++ b/Task/Catamorphism/Groovy/catamorphism.groovy @@ -0,0 +1,13 @@ +def vector1 = [1,2,3,4,5,6,7] +def vector2 = [7,6,5,4,3,2,1] +def map1 = [a:1, b:2, c:3, d:4] + +println vector1.inject { acc, val -> acc + val } // sum +println vector1.inject { acc, val -> acc + val*val } // sum of squares +println vector1.inject { acc, val -> acc * val } // product +println vector1.inject { acc, val -> acc acc + val[0]*val[1] }) //dot product (with seed 0) + +println (map1.inject { Map.Entry accEntry, Map.Entry entry -> // some sort of weird map-based reduction + [(accEntry.key + entry.key):accEntry.value + entry.value ].entrySet().toList().pop() +}) diff --git a/Task/Catamorphism/JavaScript/catamorphism.js b/Task/Catamorphism/JavaScript/catamorphism-1.js similarity index 100% rename from Task/Catamorphism/JavaScript/catamorphism.js rename to Task/Catamorphism/JavaScript/catamorphism-1.js diff --git a/Task/Catamorphism/JavaScript/catamorphism-2.js b/Task/Catamorphism/JavaScript/catamorphism-2.js new file mode 100644 index 0000000000..a244802404 --- /dev/null +++ b/Task/Catamorphism/JavaScript/catamorphism-2.js @@ -0,0 +1,21 @@ +(function (xs) { + 'use strict'; + + // foldl :: (b -> a -> b) -> b -> [a] -> b + function foldl(f, acc, xs) { + return xs.reduce(f, acc); + } + + // foldr :: (b -> a -> b) -> b -> [a] -> b + function foldr(f, acc, xs) { + return xs.reduceRight(f, acc); + } + + // Test folds in both directions + return [foldl, foldr].map(function (f) { + return f(function (acc, x) { + return acc + (x * 2).toString() + ' '; + }, [], xs); + }); + +})([0, 1, 2, 3, 4, 5, 6, 7, 8, 9]); diff --git a/Task/Catamorphism/JavaScript/catamorphism-3.js b/Task/Catamorphism/JavaScript/catamorphism-3.js new file mode 100644 index 0000000000..a37a1b842f --- /dev/null +++ b/Task/Catamorphism/JavaScript/catamorphism-3.js @@ -0,0 +1,5 @@ +var nums = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]; + +console.log(nums.reduce((a, b) => a + b, 0)); // sum of 1..10 +console.log(nums.reduce((a, b) => a * b, 1)); // product of 1..10 +console.log(nums.reduce((a, b) => a + b, '')); // concatenation of 1..10 diff --git a/Task/Catamorphism/Lua/catamorphism.lua b/Task/Catamorphism/Lua/catamorphism.lua new file mode 100644 index 0000000000..8c9dc5fbff --- /dev/null +++ b/Task/Catamorphism/Lua/catamorphism.lua @@ -0,0 +1,29 @@ +table.unpack = table.unpack or unpack -- 5.1 compatibility +local nums = {1,2,3,4,5,6,7,8,9} + +function add(a,b) + return a+b +end + +function mult(a,b) + return a*b +end + +function cat(a,b) + return tostring(a)..tostring(b) +end + +local function reduce(fun,a,b,...) + if ... then + return reduce(fun,fun(a,b),...) + else + return fun(a,b) + end +end + +local arithmetic_sum = function (...) return reduce(add,...) end +local factorial5 = reduce(mult,5,4,3,2,1) + +print("Σ(1..9) : ",arithmetic_sum(table.unpack(nums))) +print("5! : ",factorial5) +print("cat {1..9}: ",reduce(cat,table.unpack(nums))) diff --git a/Task/Catamorphism/Objeck/catamorphism.objeck b/Task/Catamorphism/Objeck/catamorphism.objeck new file mode 100644 index 0000000000..c33e7682ff --- /dev/null +++ b/Task/Catamorphism/Objeck/catamorphism.objeck @@ -0,0 +1,17 @@ +use Collection; + +class Reducer { + function : Main(args : String[]) ~ Nil { + values := IntVector->New([1, 2, 3, 4, 5]); + values->Reduce(Add(Int, Int) ~ Int)->PrintLine(); + values->Reduce(Mul(Int, Int) ~ Int)->PrintLine(); + } + + function : Add(a : Int, b : Int) ~ Int { + return a + b; + } + + function : Mul(a : Int, b : Int) ~ Int { + return a * b; + } +} diff --git a/Task/Catamorphism/PowerShell/catamorphism.psh b/Task/Catamorphism/PowerShell/catamorphism.psh new file mode 100644 index 0000000000..a35fbb9761 --- /dev/null +++ b/Task/Catamorphism/PowerShell/catamorphism.psh @@ -0,0 +1 @@ +1..5 | ForEach-Object -Begin {$result = 0} -Process {$result += $_} -End {$result} diff --git a/Task/Catamorphism/REXX/catamorphism.rexx b/Task/Catamorphism/REXX/catamorphism.rexx index b3480e41f4..16b1aead65 100644 --- a/Task/Catamorphism/REXX/catamorphism.rexx +++ b/Task/Catamorphism/REXX/catamorphism.rexx @@ -1,36 +1,36 @@ -/*REXX pgm shows a method for catamorphism for some simple functions. */ -@list = 1 2 3 4 5 6 7 8 9 10 - say 'show:' fold(@list, 'show') - say ' sum:' fold(@list, '+') - say 'prod:' fold(@list, '*') - say ' cat:' fold(@list, '||') - say ' min:' fold(@list, 'min') - say ' max:' fold(@list, 'max') - say ' avg:' fold(@list, 'avg') - say ' GCD:' fold(@list, 'GCD') - say ' LCM:' fold(@list, 'LCM') -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────FOLD subroutine─────────────────────*/ -fold: procedure; parse arg z; arg ,f; z=space(z) /*F is uppercased.*/ -za=translate(z, f, " "); zf=f'('translate(z,',' ," ")')' -if f=='+' | f=='*' then interpret 'return' za -if f=='||' then return space(z,0) -if f=='AVG' then interpret 'return' fold(z,'+') "/" words(z) -if wordpos(f,'MIN MAX LCM GCD')\==0 then interpret 'return' zf -if f=='SHOW' then return z -return 'illegal function:' arg(2) -/*──────────────────────────────────LCM subroutine──────────────────────*/ -lcm: procedure; $=; do j=1 for arg(); $=$ arg(j); end -x=abs(word($,1)) /* [↑] build a list of arguments.*/ - do k=2 to words($); !=abs(word($,k)); if !=0 then return 0 - x=x*! / gcd(x,!) /*have GCD do the heavy lifting.*/ - end /*k*/ -return x /*return with the money. */ -/*──────────────────────────────────GCD subroutine──────────────────────*/ -gcd: procedure; $=; do j=1 for arg(); $=$ arg(j); end -parse var $ x z .; if x=0 then x=z /* [↑] build a list of arguments.*/ -x=abs(x) - do k=2 to words($); y=abs(word($,k)); if y=0 then iterate - do until _==0; _=x//y; x=y; y=_; end /*until*/ - end /*k*/ -return x /*return with the money. */ +/*REXX program demonstrates a method for catamorphism for some simple functions. */ +@list= 1 2 3 4 5 6 7 8 9 10 + say 'show:' fold(@list, "show") + say ' sum:' fold(@list, "+" ) + say 'prod:' fold(@list, "*" ) + say ' cat:' fold(@list, "||" ) + say ' min:' fold(@list, "min" ) + say ' max:' fold(@list, "max" ) + say ' avg:' fold(@list, "avg" ) + say ' GCD:' fold(@list, "GCD" ) + say ' LCM:' fold(@list, "LCM" ) +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +fold: procedure; parse arg z; arg ,f; z=space(z); BIFs='MIN MAX LCM GCD' + za=translate(z, f, ' '); zf=f"("translate(z, ',' , " ")')' + if f=='+' | f=="*" then interpret "return" za + if f=='||' then return space(z, 0) + if f=='AVG' then interpret "return" fold(z, '+') "/" words(z) + if wordpos(f,BIFs)\==0 then interpret "return" zf + if f=='SHOW' then return z + return 'illegal function:' arg(2) +/*──────────────────────────────────────────────────────────────────────────────────────*/ +GCD: procedure; $=; do j=1 for arg(); $=$ arg(j); end /*j*/ + parse var $ x z .; if x=0 then x=z /* [↑] build a list of arguments.*/ + x=abs(x) + do k=2 to words($); y=abs(word($,k)); if y==0 then iterate + do until _==0; _=x//y; x=y; y=_; end /*until*/ + end /*k*/ + return x +/*──────────────────────────────────────────────────────────────────────────────────────*/ +LCM: procedure; $=; do j=1 for arg(); $=$ arg(j); end /*j*/ + x=abs(word($,1)) /* [↑] build a list of arguments.*/ + do k=2 to words($); !=abs(word($,k)); if !==0 then return 0 + x=x*! / GCD(x,!) /*have GCD do the heavy lifting.*/ + end /*k*/ + return x diff --git a/Task/Catamorphism/ZX-Spectrum-Basic/catamorphism.zx b/Task/Catamorphism/ZX-Spectrum-Basic/catamorphism.zx new file mode 100644 index 0000000000..c61a9cd5e7 --- /dev/null +++ b/Task/Catamorphism/ZX-Spectrum-Basic/catamorphism.zx @@ -0,0 +1,15 @@ +10 DIM a(5) +20 FOR i=1 TO 5 +30 READ a(i) +40 NEXT i +50 DATA 1,2,3,4,5 +60 LET o$="+": GO SUB 1000: PRINT tmp +70 LET o$="-": GO SUB 1000: PRINT tmp +80 LET o$="*": GO SUB 1000: PRINT tmp +90 STOP +1000 REM Reduce +1010 LET tmp=a(1) +1020 FOR i=2 TO 5 +1030 LET tmp=VAL ("tmp"+o$+"a(i)") +1040 NEXT i +1050 RETURN diff --git a/Task/Character-codes/00DESCRIPTION b/Task/Character-codes/00DESCRIPTION index a6c684424b..b1516d8d14 100644 --- a/Task/Character-codes/00DESCRIPTION +++ b/Task/Character-codes/00DESCRIPTION @@ -1,5 +1,9 @@ -Given a character value in your language, print its code (could be ASCII code, Unicode code, or whatever your language uses). +;Task: +Given a character value in your language, print its code   (could be ASCII code, Unicode code, or whatever your language uses). -For example, the character 'a' (lowercase letter A) has a code of 97 in ASCII (as well as Unicode, as ASCII forms the beginning of Unicode). + +;Example: +The character   'a'   (lowercase letter A)   has a code of 97 in ASCII   (as well as Unicode, as ASCII forms the beginning of Unicode). Conversely, given a code, print out the corresponding character. +

    diff --git a/Task/Character-codes/APL/character-codes-1.apl b/Task/Character-codes/APL/character-codes-1.apl new file mode 100644 index 0000000000..0488f4370e --- /dev/null +++ b/Task/Character-codes/APL/character-codes-1.apl @@ -0,0 +1,2 @@ + ⎕UCS 97 +a diff --git a/Task/Character-codes/APL/character-codes-2.apl b/Task/Character-codes/APL/character-codes-2.apl new file mode 100644 index 0000000000..2fe3e04c4b --- /dev/null +++ b/Task/Character-codes/APL/character-codes-2.apl @@ -0,0 +1,2 @@ + ⎕UCS 'a' +97 diff --git a/Task/Character-codes/APL/character-codes-3.apl b/Task/Character-codes/APL/character-codes-3.apl new file mode 100644 index 0000000000..c5990c80cc --- /dev/null +++ b/Task/Character-codes/APL/character-codes-3.apl @@ -0,0 +1,4 @@ + ⎕UCS 65 80 76 +APL + ⎕UCS 'Hello, world!' +72 101 108 108 111 44 32 119 111 114 108 100 33 diff --git a/Task/Character-codes/COBOL/character-codes.cobol b/Task/Character-codes/COBOL/character-codes.cobol new file mode 100644 index 0000000000..a935bb806c --- /dev/null +++ b/Task/Character-codes/COBOL/character-codes.cobol @@ -0,0 +1,9 @@ + identification division. + program-id. character-codes. + remarks. COBOL is an ordinal language, first is 1. + remarks. 42nd ASCII code is ")" not, "*". + procedure division. + display function char(42) + display function ord('*') + goback. + end program character-codes. diff --git a/Task/Character-codes/Io/character-codes.io b/Task/Character-codes/Io/character-codes.io new file mode 100644 index 0000000000..4e913c6af1 --- /dev/null +++ b/Task/Character-codes/Io/character-codes.io @@ -0,0 +1,5 @@ +"a" at(0) println // --> 97 +97 asCharacter println // --> a + +"π" at(0) println // --> 960 +960 asCharacter println // --> π diff --git a/Task/Character-codes/Python/character-codes-1.py b/Task/Character-codes/Python/character-codes-1.py index 2a83cb9de0..269b4731dd 100644 --- a/Task/Character-codes/Python/character-codes-1.py +++ b/Task/Character-codes/Python/character-codes-1.py @@ -1,2 +1,2 @@ print ord('a') # prints "97" -print chr(97) # prints "a" +print chr(97) # prints "a" diff --git a/Task/Character-codes/Python/character-codes-2.py b/Task/Character-codes/Python/character-codes-2.py index 6753119d31..a6eca4f4f2 100644 --- a/Task/Character-codes/Python/character-codes-2.py +++ b/Task/Character-codes/Python/character-codes-2.py @@ -1,2 +1,2 @@ -print ord(u'π') # prints "960" +print ord(u'π') # prints "960" print unichr(960) # prints "π" diff --git a/Task/Character-codes/Python/character-codes-3.py b/Task/Character-codes/Python/character-codes-3.py index e4346f4a45..426bc62377 100644 --- a/Task/Character-codes/Python/character-codes-3.py +++ b/Task/Character-codes/Python/character-codes-3.py @@ -1,4 +1,4 @@ -print(ord('a')) # prints "97" +print(ord('a')) # prints "97" (will also work in 2.x) print(ord('π')) # prints "960" -print(chr(97)) # prints "a" +print(chr(97)) # prints "a" (will also work in 2.x) print(chr(960)) # prints "π" diff --git a/Task/Character-codes/REXX/character-codes-1.rexx b/Task/Character-codes/REXX/character-codes-1.rexx index 20eab4e4a9..6487cae1c2 100644 --- a/Task/Character-codes/REXX/character-codes-1.rexx +++ b/Task/Character-codes/REXX/character-codes-1.rexx @@ -1,14 +1,26 @@ -yyy='c' /*assign a lowercase c to YYY.*/ -yyy='34'x /*assign hexadecimal 34 to YYY.*/ - /*the X can be upper/lowercase.*/ -yyy=x2c(34) /* (same as above) */ -yyy='00110100'b /* (same as above) */ -yyy='0011 0100'b /* (same as above) */ - /*the B can be upper/lowercase.*/ -yyy=d2c(97) /*assign decimal code 97 to YYY.*/ +/*REXX program displays a char's ASCII code/value (or EBCDIC if run on an EBCDIC system)*/ +yyy= 'c' /*assign a lowercase c to YYY. */ +yyy= "c" /* (same as above) */ +say 'from char, yyy code=' yyy -say yyy /*displays the value of YYY. */ -say c2x(yyy) /*displays the value of YYY in hexadecimal. */ -say c2d(yyy) /*displays the value of YYY in decimal. */ -say x2b(c2x(yyy)) /*displays the value of YYY in binary (bit string). */ - /*Note: some REXXes support the c2b bif */ +yyy= '63'x /*assign hexadecimal 63 to YYY. */ +yyy= '63'X /* (same as above) */ +say 'from hex, yyy code=' yyy + +yyy= x2c(63) /*assign hexadecimal 63 to YYY. */ +say 'from hex, yyy code=' yyy + +yyy= '01100011'b /*assign a binary 0011 0100 to YYY. */ +yyy= '0110 0011'b /* (same as above) */ +yyy= '0110 0011'B /* " " " */ +say 'from bin, yyy code=' yyy + +yyy= d2c(99) /*assign decimal code 99 to YYY. */ +say 'from dec, yyy code=' yyy + +say /* [↓] displays the value of YYY in ··· */ +say 'char code: ' yyy /* character code (as an 8-bit ASCII character).*/ +say ' hex code: ' c2x(yyy) /* hexadecimal */ +say ' dec code: ' c2d(yyy) /* decimal */ +say ' bin code: ' x2b( c2x(yyy) ) /* binary (as a bit string) */ + /*stick a fork in it, we're all done with display*/ diff --git a/Task/Character-codes/ZX-Spectrum-Basic/character-codes.zx b/Task/Character-codes/ZX-Spectrum-Basic/character-codes.zx new file mode 100644 index 0000000000..248a1f9b73 --- /dev/null +++ b/Task/Character-codes/ZX-Spectrum-Basic/character-codes.zx @@ -0,0 +1,2 @@ +10 PRINT CHR$ 97: REM prints a +20 PRINT CODE "a": REM prints 97 diff --git a/Task/Chat-server/00DESCRIPTION b/Task/Chat-server/00DESCRIPTION index 93b5cca8da..6a927fa866 100644 --- a/Task/Chat-server/00DESCRIPTION +++ b/Task/Chat-server/00DESCRIPTION @@ -1,3 +1,5 @@ -Write a server for a minimal text based chat. People should be able to connect via ‘telnet’, sign on with a nickname, and type messages which will then be seen by all other connected users. Arrivals and departures of chat members should generate appropriate notification messages. +;Task: +Write a server for a minimal text based chat. -Nov. 31st is an interesting deadline :-) --[[User:Walterpachl|Walterpachl]] ([[User talk:Walterpachl|talk]]) 10:46, 2 November 2013 (UTC) +People should be able to connect via ‘telnet’, sign on with a nickname, and type messages which will then be seen by all other connected users. Arrivals and departures of chat members should generate appropriate notification messages. +

    diff --git a/Task/Chat-server/D/chat-server.d b/Task/Chat-server/D/chat-server.d new file mode 100644 index 0000000000..cf4f30662a --- /dev/null +++ b/Task/Chat-server/D/chat-server.d @@ -0,0 +1,159 @@ +import std.getopt; +import std.socket; +import std.stdio; +import std.string; + +struct client { + int pos; + char[] name; + char[] buffer; + Socket socket; +} + +void broadcast(client[] connections, size_t self, const char[] message) { + writeln(message); + for (size_t i = 0; i < connections.length; i++) { + if (i == self) continue; + + connections[i].socket.send(message); + connections[i].socket.send("\r\n"); + } +} + +bool registerClient(client[] connections, size_t self) { + for (size_t i = 0; i < connections.length; i++) { + if (i == self) continue; + + if (icmp(connections[i].name, connections[self].name) == 0) { + return false; + } + } + + return true; +} + +void main(string[] args) { + ushort port = 4004; + + auto helpInformation = getopt + ( + args, + "port|p", "The port to listen to chat clients on [default is 4004]", &port + ); + + if (helpInformation.helpWanted) { + defaultGetoptPrinter("A simple chat server based on a task in rosettacode.", helpInformation.options); + return; + } + + auto listener = new TcpSocket(); + assert(listener.isAlive); + listener.blocking = false; + listener.bind(new InternetAddress(port)); + listener.listen(10); + writeln("Listening on port: ", port); + + enum MAX_CONNECTIONS = 60; + auto socketSet = new SocketSet(MAX_CONNECTIONS + 1); + client[] connections; + + while(true) { + socketSet.add(listener); + + foreach (con; connections) { + socketSet.add(con.socket); + } + + Socket.select(socketSet, null, null); + + for (size_t i = 0; i < connections.length; i++) { + if (socketSet.isSet(connections[i].socket)) { + char[1024] buf; + auto datLength = connections[i].socket.receive(buf[]); + + if (datLength == Socket.ERROR) { + writeln("Connection error."); + } else if (datLength != 0) { + if (buf[0] == '\n' || buf[0] == '\r') { + if (connections[i].buffer == "/quit") { + connections[i].socket.close(); + if (connections[i].name.length > 0) { + writeln("Connection from ", connections[i].name, " closed."); + } else { + writeln("Connection from ", connections[i].socket.remoteAddress(), " closed."); + } + + connections[i] = connections[$-1]; + connections.length--; + i--; + + writeln("\tTotal connections: ", connections.length); + continue; + } else if (connections[i].name.length == 0) { + connections[i].buffer = strip(connections[i].buffer); + if (connections[i].buffer.length > 0) { + connections[i].name = connections[i].buffer; + if (registerClient(connections, i)) { + connections.broadcast(i, "+++ " ~ connections[i].name ~ " arrived +++"); + } else { + connections[i].socket.send("Name already registered. Please enter your name: "); + connections[i].name.length = 0; + } + } else { + connections[i].socket.send("A name is required. Please enter your name: "); + } + } else { + connections.broadcast(i, connections[i].name ~ "> " ~ connections[i].buffer); + } + connections[i].buffer.length = 0; + } else { + connections[i].buffer ~= buf[0..datLength]; + } + } else { + try { + if (connections[i].name.length > 0) { + writeln("Connection from ", connections[i].name, " closed."); + } else { + writeln("Connection from ", connections[i].socket.remoteAddress(), " closed."); + } + } catch (SocketException) { + writeln("Connection closed."); + } + } + } + } + + if (socketSet.isSet(listener)) { + Socket sn = null; + scope(failure) { + writeln("Error accepting"); + + if (sn) { + sn.close(); + } + } + sn = listener.accept(); + assert(sn.isAlive); + assert(listener.isAlive); + + if (connections.length < MAX_CONNECTIONS) { + client newclient; + + writeln("Connection from ", sn.remoteAddress(), " established."); + sn.send("Enter name: "); + + newclient.socket = sn; + connections ~= newclient; + + writeln("\tTotal connections: ", connections.length); + } else { + writeln("Rejected connection from ", sn.remoteAddress(), "; too many connections."); + sn.close(); + assert(!sn.isAlive); + assert(listener.isAlive); + } + } + + socketSet.reset(); + } +} diff --git a/Task/Chat-server/Go/chat-server.go b/Task/Chat-server/Go/chat-server.go index 6031671c19..dfa6e5a1ec 100644 --- a/Task/Chat-server/Go/chat-server.go +++ b/Task/Chat-server/Go/chat-server.go @@ -34,7 +34,12 @@ func ListenAndServe(addr string) error { } log.Println("Listening for connections on", addr) defer ln.Close() - s := &Server{stop: make(chan bool)} + s := &Server{ + add: make(chan *conn), + rem: make(chan string), + msg: make(chan string), + stop: make(chan bool), + } go s.handleConns() for { // TODO use AcceptTCP() so that we can get a TCPConn on which @@ -54,10 +59,6 @@ func ListenAndServe(addr string) error { // handleConns is run as a go routine to handle adding and removal of // chat client connections as well as broadcasting messages to them. func (s *Server) handleConns() { - s.add = make(chan *conn) - s.rem = make(chan string) - s.msg = make(chan string) - // We define the `conns` map here rather than within Server, // and we use local function literals rather than methods to be // extra sure that the only place that touches this map is this @@ -167,7 +168,7 @@ func (c *conn) welcome() { // welcome phase has completed successfully. It reads single lines from // the client and passes them to the server for broadcast to all chat // clients (including us). -// Once done, we ask the server to remove our (and close) our connection. +// Once done, we ask the server to remove (and close) our connection. func (c *conn) readloop() { for { msg, err := c.ReadString('\n') diff --git a/Task/Chat-server/Perl-6/chat-server.pl6 b/Task/Chat-server/Perl-6/chat-server.pl6 new file mode 100644 index 0000000000..9829864687 --- /dev/null +++ b/Task/Chat-server/Perl-6/chat-server.pl6 @@ -0,0 +1,39 @@ +#!/usr/bin/env perl6 + +react { + my %connections; + + whenever IO::Socket::Async.listen('localhost', 4004) -> $conn { + my $name; + + $conn.print: "Please enter your name: "; + + whenever $conn.Supply.lines -> $message { + if !$name { + if %connections{$message} { + $conn.print: "Name already taken, choose another one: "; + } + else { + $name = $message; + %connections{$name} = $conn; + broadcast "+++ %s arrived +++", $name; + } + } + else { + broadcast "%s> %s", $name, $message; + } + LAST { + broadcast "--- %s left ---", $name; + %connections{$name}:delete; + } + } + } + + sub broadcast ($format, $from, *@message) { + my $text = sprintf $format, $from, |@message; + say $text; + for %connections.kv -> $name, $conn { + $conn.print: "$text\n" if $name ne $from; + } + } +} diff --git a/Task/Chat-server/Perl/chat-server.pl b/Task/Chat-server/Perl/chat-server.pl new file mode 100644 index 0000000000..2cf946671b --- /dev/null +++ b/Task/Chat-server/Perl/chat-server.pl @@ -0,0 +1,108 @@ +use 5.010; +use strict; +use warnings; + +use threads; +use threads::shared; + +use IO::Socket::INET; +use Time::HiRes qw(sleep ualarm); + +my $HOST = "localhost"; +my $PORT = 4004; + +my @open; +my %users : shared; + +sub broadcast { + my ($id, $message) = @_; + print "$message\n"; + foreach my $i (keys %users) { + if ($i != $id) { + $open[$i]->send("$message\n"); + } + } +} + +sub sign_in { + my ($conn) = @_; + + state $id = 0; + + threads->new( + sub { + while (1) { + $conn->send("Please enter your name: "); + $conn->recv(my $name, 1024, 0); + + if (defined $name) { + $name = unpack('A*', $name); + + if (exists $users{$name}) { + $conn->send("Name entered is already in use.\n"); + } + elsif ($name ne '') { + $users{$id} = $name; + broadcast($id, "+++ $name arrived +++"); + last; + } + } + } + } + ); + + ++$id; + push @open, $conn; +} + +my $server = IO::Socket::INET->new( + Timeout => 0, + LocalPort => $PORT, + Proto => "tcp", + LocalAddr => $HOST, + Blocking => 0, + Listen => 1, + Reuse => 1, + ); + +local $| = 1; +print "Listening on $HOST:$PORT\n"; + +while (1) { + my ($conn) = $server->accept; + + if (defined($conn)) { + sign_in($conn); + } + + foreach my $i (keys %users) { + + my $conn = $open[$i]; + my $message; + + eval { + local $SIG{ALRM} = sub { die "alarm\n" }; + ualarm(500); + $conn->recv($message, 1024, 0); + ualarm(0); + }; + + if ($@ eq "alarm\n") { + next; + } + + if (defined($message)) { + if ($message ne '') { + $message = unpack('A*', $message); + broadcast($i, "$users{$i}> $message"); + } + else { + broadcast($i, "--- $users{$i} leaves ---"); + delete $users{$i}; + undef $open[$i]; + } + } + } + + sleep(0.1); +} diff --git a/Task/Check-Machin-like-formulas/00DESCRIPTION b/Task/Check-Machin-like-formulas/00DESCRIPTION index 92f70a8543..101b74e6a7 100644 --- a/Task/Check-Machin-like-formulas/00DESCRIPTION +++ b/Task/Check-Machin-like-formulas/00DESCRIPTION @@ -1,5 +1,8 @@ -[[wp:Machin-like_formula|Machin-like formulas]] are useful for efficiently computing numerical approximations to Pi. -Verify the following Machin-like formulas are correct by calculating the value of '''tan'''(''right hand side)'' for each equation using exact arithmetic and showing they equal 1: +[[wp:Machin-like_formula|Machin-like formulas]]   are useful for efficiently computing numerical approximations for \pi + + +;Task: +Verify the following Machin-like formulas are correct by calculating the value of '''tan'''   (''right hand side)'' for each equation using exact arithmetic and showing they equal '''1''': : {\pi\over4} = \arctan{1\over2} + \arctan{1\over3} : {\pi\over4} = 2 \arctan{1\over3} + \arctan{1\over7} @@ -18,7 +21,7 @@ Verify the following Machin-like formulas are correct by calculating the value o : {\pi\over4} = 44 \arctan{1\over57} + 7 \arctan{1\over239} - 12 \arctan{1\over682} + 24 \arctan{1\over12943} : {\pi\over4} = 88 \arctan{1\over172} + 51 \arctan{1\over239} + 32 \arctan{1\over682} + 44 \arctan{1\over5357} + 68 \arctan{1\over12943} -and confirm that the following formula is incorrect by showing '''tan'''(''right hand side)'' is ''not'' 1: +and confirm that the following formula is incorrect by showing   '''tan'''   (''right hand side)''   is ''not''   '''1''': : {\pi\over4} = 88 \arctan{1\over172} + 51 \arctan{1\over239} + 32 \arctan{1\over682} + 44 \arctan{1\over5357} + 68 \arctan{1\over12944} @@ -29,6 +32,9 @@ These identities are useful in calculating the values: : \tan(-a) = -\tan(a) +
    You can store the equations in any convenient data structure, but for extra credit parse them from human-readable [[Check_Machin-like_formulas/text_equations|text input]]. -Note that to formally prove the formula correct you would also have to show that ''{-3 pi \over 4} < right hand side < {5 pi \over 4}'' due to ''\tan()'' periodicity. +Note: to formally prove the formula correct, it would have to be shown that ''{-3 pi \over 4} < right hand side < {5 pi \over 4}'' due to ''\tan()'' periodicity. + +

    diff --git a/Task/Check-Machin-like-formulas/Clojure/check-machin-like-formulas.clj b/Task/Check-Machin-like-formulas/Clojure/check-machin-like-formulas.clj new file mode 100644 index 0000000000..1000000f74 --- /dev/null +++ b/Task/Check-Machin-like-formulas/Clojure/check-machin-like-formulas.clj @@ -0,0 +1,52 @@ +(ns tanevaulator + (:gen-class)) + +;; Notation: [a b c] -> a x arctan(a/b) +(def test-cases [ + [[1, 1, 2], [1, 1, 3]], + [[2, 1, 3], [1, 1, 7]], + [[4, 1, 5], [-1, 1, 239]], + [[5, 1, 7], [2, 3, 79]], + [[1, 1, 2], [1, 1, 5], [1, 1, 8]], + [[4, 1, 5], [-1, 1, 70], [1, 1, 99]], + [[5, 1, 7], [4, 1, 53], [2, 1, 4443]], + [[6, 1, 8], [2, 1, 57], [1, 1, 239]], + [[8, 1, 10], [-1, 1, 239], [-4, 1, 515]], + [[12, 1, 18], [8, 1, 57], [-5, 1, 239]], + [[16, 1, 21], [3, 1, 239], [4, 3, 1042]], + [[22, 1, 28], [2, 1, 443], [-5, 1, 1393], [-10, 1, 11018]], + [[22, 1, 38], [17, 7, 601], [10, 7, 8149]], + [[44, 1, 57], [7, 1, 239], [-12, 1, 682], [24, 1, 12943]], + [[88, 1, 172], [51, 1, 239], [32, 1, 682], [44, 1, 5357], [68, 1, 12943]], + [[88, 1, 172], [51, 1, 239], [32, 1, 682], [44, 1, 5357], [68, 1, 12944]] + ]) + +(defn tan-sum [a b] + " tan (a + b) " + (/ (+ a b) (- 1 (* a b)))) + +(defn tan-eval [m] + " Evaluates tan of a triplet (e.g. [1, 1, 2])" + (let [coef (first m) + rat (/ (nth m 1) (nth m 2))] + (cond + (= 1 coef) rat + (neg? coef) (tan-eval [(- (nth m 0)) (- (nth m 1)) (nth m 2)]) + :else (let [ + ca (quot coef 2) + cb (- coef ca) + a (tan-eval [ca (nth m 1) (nth m 2)]) + b (tan-eval [cb (nth m 1) (nth m 2)])] + (tan-sum a b))))) + +(defn tans [m] + " Evaluates tan of set of triplets (e.g. [[1, 1, 2], [1, 1, 3]])" + (if (= 1 (count m)) + (tan-eval (nth m 0)) + (let [a (tan-eval (first m)) + b (tans (rest m))] + (tan-sum a b)))) + +(doseq [q test-cases] + " Display results " + (println "tan " q " = "(tans q))) diff --git a/Task/Check-Machin-like-formulas/GAP/check-machin-like-formulas.gap b/Task/Check-Machin-like-formulas/GAP/check-machin-like-formulas.gap new file mode 100644 index 0000000000..ec6df4afc7 --- /dev/null +++ b/Task/Check-Machin-like-formulas/GAP/check-machin-like-formulas.gap @@ -0,0 +1,44 @@ +TanPlus := function(a, b) + return (a + b) / (1 - a * b); +end; + +TanTimes := function(n, a) + local x; + x := 0; + while n > 0 do + if IsOddInt(n) then + x := TanPlus(x, a); + fi; + a := TanPlus(a, a); + n := QuoInt(n, 2); + od; + return x; +end; + +Check := function(a) + local x, p; + x := 0; + for p in a do + x := TanPlus(x, SignInt(p[1]) * TanTimes(AbsInt(p[1]), p[2])); + od; + return x = 1; +end; + +ForAll([ + [[1, 1/2], [1, 1/3]], + [[2, 1/3], [1, 1/7]], + [[4, 1/5], [-1, 1/239]], + [[5, 1/7], [2, 3/79]], + [[5, 29/278], [7, 3/79]], + [[1, 1/2], [1, 1/5], [1, 1/8]], + [[5, 1/7], [4, 1/53], [2, 1/4443]], + [[6, 1/8], [2, 1/57], [1, 1/239]], + [[8, 1/10], [-1, 1/239], [-4, 1/515]], + [[12, 1/18], [8, 1/57], [-5, 1/239]], + [[16, 1/21], [3, 1/239], [4, 3/1042]], + [[22, 1/28], [2, 1/443], [-5, 1/1393], [-10, 1/11018]], + [[22, 1/38], [17, 7/601], [10, 7/8149]], + [[44, 1/57], [7, 1/239], [-12, 1/682], [24, 1/12943]], + [[88, 1/172], [51, 1/239], [32, 1/682], [44, 1/5357], [68, 1/12943]]], Check); + +Check([[88, 1/172], [51, 1/239], [32, 1/682], [44, 1/5357], [68, 1/12944]]); diff --git a/Task/Check-Machin-like-formulas/REXX/check-machin-like-formulas.rexx b/Task/Check-Machin-like-formulas/REXX/check-machin-like-formulas.rexx index 5549a7b279..9ef56e6f57 100644 --- a/Task/Check-Machin-like-formulas/REXX/check-machin-like-formulas.rexx +++ b/Task/Check-Machin-like-formulas/REXX/check-machin-like-formulas.rexx @@ -1,52 +1,38 @@ -/*REXX program evaluates some Machin-like formulas and verifies their veracity*/ -parse arg digs .; if digs=='' then digs=100 /*use default for decimal digs?*/ -numeric digits digs+10; numeric fuzz 3; pi=pi(); @.= - @.1 = 'pi/4 = atan(1/2) + atan(1/3)' - @.2 = 'pi/4 = 2*atan(1/3) + atan(1/7)' - @.3 = 'pi/4 = 4*atan(1/5) - atan(1/239)' - @.4 = 'pi/4 = 5*atan(1/7) + 2*atan(3/79)' - @.5 = 'pi/4 = 5*atan(29/278) + 7*atan(3/79)' - @.6 = 'pi/4 = atan(1/2) + atan(1/5) + atan(1/8)' - @.7 = 'pi/4 = 4*atan(1/5) - atan(1/70) + atan(1/99)' - @.8 = 'pi/4 = 5*atan(1/7) + 4*atan(1/53) + 2*atan(1/4443)' - @.9 = 'pi/4 = 6*atan(1/8) + 2*atan(1/57) + atan(1/239)' -@.10 = 'pi/4 = 8*atan(1/10) - atan(1/239) - 4*atan(1/515)' -@.11 = 'pi/4 = 12*atan(1/18) + 8*atan(1/57) - 5*atan(1/239)' -@.12 = 'pi/4 = 16*atan(1/21) + 3*atan(1/239) + 4*atan(3/1042)' -@.13 = 'pi/4 = 22*atan(1/28) + 2*atan(1/443) - 5*atan(1/1393) - 10*atan(1/11018)' -@.14 = 'pi/4 = 22*atan(1/38) + 17*atan(7/601) + 10*atan(7/8149)' -@.15 = 'pi/4 = 44*atan(1/57) + 7*atan(1/239) - 12*atan(1/682) + 24*atan(1/12943)' -@.16 = 'pi/4 = 88*atan(1/172) + 51*atan(1/239) + 32*atan(1/682) + 44*atan(1/5357) + 68*atan(1/12943)' -@.17 = 'pi/4 = 88*atan(1/172) + 51*atan(1/239) + 32*atan(1/682) + 44*atan(1/5357) + 68*atan(1/12944)' +/*REXX program evaluates some Machin─like formulas and verifies their veracity. */ + numeric fuzz 3; pi=pi(); @.= + @.1= 'pi/4 = atan(1/2) + atan(1/3)' + @.2= 'pi/4 = 2*atan(1/3) + atan(1/7)' + @.3= 'pi/4 = 4*atan(1/5) - atan(1/239)' + @.4= 'pi/4 = 5*atan(1/7) + 2*atan(3/79)' + @.5= 'pi/4 = 5*atan(29/278) + 7*atan(3/79)' + @.6= 'pi/4 = atan(1/2) + atan(1/5) + atan(1/8)' + @.7= 'pi/4 = 4*atan(1/5) - atan(1/70) + atan(1/99)' + @.8= 'pi/4 = 5*atan(1/7) + 4*atan(1/53) + 2*atan(1/4443)' + @.9= 'pi/4 = 6*atan(1/8) + 2*atan(1/57) + atan(1/239)' +@.10= 'pi/4 = 8*atan(1/10) - atan(1/239) - 4*atan(1/515)' +@.11= 'pi/4 = 12*atan(1/18) + 8*atan(1/57) - 5*atan(1/239)' +@.12= 'pi/4 = 16*atan(1/21) + 3*atan(1/239) + 4*atan(3/1042)' +@.13= 'pi/4 = 22*atan(1/28) + 2*atan(1/443) - 5*atan(1/1393) - 10*atan(1/11018)' +@.14= 'pi/4 = 22*atan(1/38) + 17*atan(7/601) + 10*atan(7/8149)' +@.15= 'pi/4 = 44*atan(1/57) + 7*atan(1/239) - 12*atan(1/682) + 24*atan(1/12943)' +@.16= 'pi/4 = 88*atan(1/172) + 51*atan(1/239) + 32*atan(1/682) + 44*atan(1/5357) + 68*atan(1/12943)' +@.17= 'pi/4 = 88*atan(1/172) + 51*atan(1/239) + 32*atan(1/682) + 44*atan(1/5357) + 68*atan(1/12944)' - do j=1 while @.j\=='' /*evaluate each "Machin-like" formulas.*/ - interpret 'answer=' "(" @.j ")" /*this is the heavy lifting.*/ - say right(word('bad OK',answer+1),3)": " space(@.j,0) - end /*j*/ /* [↑] show OK or bad, and the formula*/ -exit /*stick a fork in it, we're all done. */ -/*────broutines───────────────────────────────────────────────────────────────*/ -pi: return 3.14159265358979323846264338327950288419716939937510582097494459 ||, - 230781640628620899862803482534211706798214808651 -AcosErr: call tellErr 'Acos(x), X must be in the range of -1 ──► +1, X='||x -AsinErr: call tellErr 'Asin(x), X must be in the range of -1 ──► +1, X='||x -tanErr: call tellErr 'tan(' || x") causes division by zero, X=" || x -tellErr: say; say '*** error! ***'; say; say arg(1); say; exit 13 - -Acos: procedure; parse arg x; if x<-1 | x>1 then call AcosErr - return .5*pi()-Asin(x) - -Asin: procedure expose $.; parse arg x 1 z 1 o 1 p; a=abs(x); aa=a*a - if a>1 then call AsinErr x /*X argument is out of valid range. */ - if a>=sqrt(2)*.5 then return sign(x)*acos(sqrt(1-aa), '-ASIN') - do j=2 by 2 until p=z; p=z; o=o*aa*(j-1)/j; z=z+o/(j+1); end - return z /* [↑] compute until no more noise. */ - -Atan: procedure; parse arg x; if abs(x)=1 then return pi()/4*sign(x) - return Asin(x/sqrt(1+x**2)) - -sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); i=; m.=9 - numeric digits 9; numeric form; h=d+6; if x<0 then do; x=-x; i='i'; end - parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_%2 - do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ - do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ - numeric digits d; return (g/1)i /*make complex if X < 0.*/ + do j=1 while @.j\=='' /*evaluate each "Machin─like" formulas.*/ + interpret 'answer=' "(" @.j ')' /*where REXX does the heavy lifting. */ + say right( word( 'bad OK', answer+1), 3)": " @.j + end /*j*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +pi: return 3.141592653589793238462643383279502884197169399375105820974944592307816406186 +Acos: procedure; parse arg x; return pi()*.5-Asin(x) +Atan: procedure; arg x; if abs(x)=1 then return pi()/4*sign(x); return Asin(x/sqrt(1+x*x)) +/*──────────────────────────────────────────────────────────────────────────────────────*/ +Asin: procedure; parse arg x 1 z 1 o 1 p; a=abs(x); aa=a*a + if a>=sqrt(2)*.5 then return sign(x) * Acos( sqrt(1 - aa) ) + do j=2 by 2 until p=z; p=z; o=o*aa*(j-1)/j; z=z+o/(j+1); end /*j*/; return z +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); m.=9; h=d+6; numeric form + numeric digits; parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g *.5'e'_ % 2 + do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ + do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/; return g diff --git a/Task/Check-that-file-exists/00DESCRIPTION b/Task/Check-that-file-exists/00DESCRIPTION index 432587f942..089c2e3fc1 100644 --- a/Task/Check-that-file-exists/00DESCRIPTION +++ b/Task/Check-that-file-exists/00DESCRIPTION @@ -1,4 +1,13 @@ -In this task, the job is to verify that a file called "input.txt" and the directory called "docs" exist. -This should be done twice: once for the current working directory and once for a file and a directory in the filesystem root. +;Task: +Verify that a file called     '''input.txt'''     and   a directory called     '''docs'''     exist. -Optional criteria (May 2015): verify it works with 0-length files; and with an unusual filename: `Abdu'l-Bahá.txt + +This should be done twice:   +:::*   once for the current working directory,   and +:::*   once for a file and a directory in the filesystem root. + +
    +Optional criteria (May 2015):   verify it works with: +:::*   zero-length files +:::*   an unusual filename:   ''' `Abdu'l-Bahá.txt ''' +

    diff --git a/Task/Check-that-file-exists/ALGOL-68/check-that-file-exists.alg b/Task/Check-that-file-exists/ALGOL-68/check-that-file-exists.alg new file mode 100644 index 0000000000..a8892b0632 --- /dev/null +++ b/Task/Check-that-file-exists/ALGOL-68/check-that-file-exists.alg @@ -0,0 +1,40 @@ +# Check files and directories exist # + +# check a file exists by attempting to open it for input # +# returns TRUE if the file exists, FALSE otherwise # +PROC file exists = ( STRING file name )BOOL: + IF FILE f; + open( f, file name, stand in channel ) = 0 + THEN + # file opened OK so must exist # + close( f ); + TRUE + ELSE + # file cannot be opened - assume it does not exist # + FALSE + FI # file exists # ; + +# print a suitable messages if the specified file exists # +PROC test file exists = ( STRING name )VOID: + print( ( "file: " + , name + , IF file exists( name ) THEN " does" ELSE " does not" FI + , " exist" + , newline + ) + ); +# print a suitable messages if the specified directory exists # +PROC test directory exists = ( STRING name )VOID: + print( ( "dir: " + , name + , IF file is directory( name ) THEN " does" ELSE " does not" FI + , " exist" + , newline + ) + ); + +# test the flies and directories mentioned in the task exist or not # +test file exists( "input.txt" ); +test file exists( "\input.txt"); +test directory exists( "docs" ); +test directory exists( "\docs" ) diff --git a/Task/Check-that-file-exists/AWK/check-that-file-exists-2.awk b/Task/Check-that-file-exists/AWK/check-that-file-exists-2.awk index 063ec96802..7eab16fe1b 100644 --- a/Task/Check-that-file-exists/AWK/check-that-file-exists-2.awk +++ b/Task/Check-that-file-exists/AWK/check-that-file-exists-2.awk @@ -15,7 +15,7 @@ function exists(file ,line, msg) if ( (getline line < file) == -1 ) { # "Permission denied" is for MS-Windows - msg = (ERRNO ~ /Permission denied/ || ERRNO ~ /a directory/) ? "1" : "0" + msg = (ERRNO ~ /Permission denied/ || ERRNO ~ /a directory/) ? 1 : 0 close(file) return msg } diff --git a/Task/Check-that-file-exists/COBOL/check-that-file-exists.cobol b/Task/Check-that-file-exists/COBOL/check-that-file-exists.cobol new file mode 100644 index 0000000000..7337ccb5f1 --- /dev/null +++ b/Task/Check-that-file-exists/COBOL/check-that-file-exists.cobol @@ -0,0 +1,70 @@ + identification division. + program-id. check-file-exist. + + environment division. + configuration section. + repository. + function all intrinsic. + + data division. + working-storage section. + 01 skip pic 9 value 2. + 01 file-name. + 05 value "/output.txt". + 01 dir-name. + 05 value "/docs/". + 01 unusual-name. + 05 value "Abdu'l-Bahá.txt". + + 01 test-name pic x(256). + + 01 file-handle usage binary-long. + 01 file-info. + 05 file-size pic x(8) comp-x. + 05 file-date. + 10 file-day pic x comp-x. + 10 file-month pic x comp-x. + 10 file-year pic xx comp-x. + 05 file-time. + 10 file-hours pic x comp-x. + 10 file-minutes pic x comp-x. + 10 file-seconds pic x comp-x. + 10 file-hundredths pic x comp-x. + + procedure division. + files-main. + + *> check in current working dir + move file-name(skip:) to test-name + perform check-file + + move dir-name(skip:) to test-name + perform check-file + + move unusual-name to test-name + perform check-file + + *> check in root dir + move 1 to skip + move file-name(skip:) to test-name + perform check-file + + move dir-name(skip:) to test-name + perform check-file + + goback. + + check-file. + call "CBL_CHECK_FILE_EXIST" using test-name file-info + if return-code equal zero then + display test-name(1:32) ": size " file-size ", " + file-year "-" file-month "-" file-day space + file-hours ":" file-minutes ":" file-seconds "." + file-hundredths + else + display "error: CBL_CHECK_FILE_EXIST " return-code space + trim(test-name) + end-if + . + + end program check-file-exist. diff --git a/Task/Check-that-file-exists/Elena/check-that-file-exists.elena b/Task/Check-that-file-exists/Elena/check-that-file-exists.elena new file mode 100644 index 0000000000..0000d0376d --- /dev/null +++ b/Task/Check-that-file-exists/Elena/check-that-file-exists.elena @@ -0,0 +1,14 @@ +#import system. +#import system'io. +#import extensions. + +#symbol program = +[ + console writeLine:"input.txt file ":("input.txt" file_path is &available iif:"exists":"not found"). + + console writeLine:"\input.txt file ":("\input.txt" file_path is &available iif:"exists":"not found"). + + console writeLine:"docs directory ":("docs" directory_path is &available iif:"exists":"not found"). + + console writeLine:"\docs directory ":("\docs" directory_path is &available iif:"exists":"not found"). +]. diff --git a/Task/Check-that-file-exists/Java/check-that-file-exists-3.java b/Task/Check-that-file-exists/Java/check-that-file-exists-3.java new file mode 100644 index 0000000000..4407e85b3b --- /dev/null +++ b/Task/Check-that-file-exists/Java/check-that-file-exists-3.java @@ -0,0 +1,5 @@ +import java.nio.file.Files; +public class FileExistsTest{ + public static void main(String args[]){ + System.out.printf("input.txt - %s", new File("input.txt").exists()); + } diff --git a/Task/Check-that-file-exists/Perl-6/check-that-file-exists-1.pl6 b/Task/Check-that-file-exists/Perl-6/check-that-file-exists-1.pl6 new file mode 100644 index 0000000000..be65886c8d --- /dev/null +++ b/Task/Check-that-file-exists/Perl-6/check-that-file-exists-1.pl6 @@ -0,0 +1,9 @@ +my $path = "/etc/passwd"; +say $path.IO.e ?? "Exists" !! "Does not exist"; + +given $path.IO { + when :d { say "$path is a directory"; } + when :f { say "$path is a regular file"; } + when :e { say "$path is neither a directory nor a file, but it does exist"; } + default { say "$path does not exist" } +} diff --git a/Task/Check-that-file-exists/Perl-6/check-that-file-exists-2.pl6 b/Task/Check-that-file-exists/Perl-6/check-that-file-exists-2.pl6 new file mode 100644 index 0000000000..3b06943678 --- /dev/null +++ b/Task/Check-that-file-exists/Perl-6/check-that-file-exists-2.pl6 @@ -0,0 +1,4 @@ +run ('touch', "♥ Unicode.txt"); + +say "♥ Unicode.txt".IO.e; # "True" +say "♥ Unicode.txt".IO ~~ :e; # same diff --git a/Task/Check-that-file-exists/Perl-6/check-that-file-exists.pl6 b/Task/Check-that-file-exists/Perl-6/check-that-file-exists.pl6 deleted file mode 100644 index f791c2d5bf..0000000000 --- a/Task/Check-that-file-exists/Perl-6/check-that-file-exists.pl6 +++ /dev/null @@ -1,4 +0,0 @@ -'input.txt'.IO ~~ :e; -'docs'.IO ~~ :d; -'/input.txt'.IO ~~ :e; -'/docs'.IO ~~ :d diff --git a/Task/Check-that-file-exists/Python/check-that-file-exists.py b/Task/Check-that-file-exists/Python/check-that-file-exists.py index c8923a4f77..9a76f6863f 100644 --- a/Task/Check-that-file-exists/Python/check-that-file-exists.py +++ b/Task/Check-that-file-exists/Python/check-that-file-exists.py @@ -1,6 +1,6 @@ import os -os.path.exists("input.txt") -os.path.exists("/input.txt") -os.path.exists("docs") -os.path.exists("/docs") +os.path.isfile("input.txt") +os.path.isfile("/input.txt") +os.path.isdir("docs") +os.path.isdir("/docs") diff --git a/Task/Check-that-file-exists/Run-BASIC/check-that-file-exists.run b/Task/Check-that-file-exists/Run-BASIC/check-that-file-exists.run index 8e570277bd..312f94b62c 100644 --- a/Task/Check-that-file-exists/Run-BASIC/check-that-file-exists.run +++ b/Task/Check-that-file-exists/Run-BASIC/check-that-file-exists.run @@ -1,6 +1,5 @@ files #f,"input.txt" if #f hasanswer() = 1 then print "File does not exist" - files #f,"docs" if #f hasanswer() = 1 then print "File does not exist" -if #f isDir() = 0 then print "This is a directory" +if #f isDir() = 0 then print "This is a directory" diff --git a/Task/Check-that-file-exists/Rust/check-that-file-exists.rust b/Task/Check-that-file-exists/Rust/check-that-file-exists.rust new file mode 100644 index 0000000000..f2caaf31ad --- /dev/null +++ b/Task/Check-that-file-exists/Rust/check-that-file-exists.rust @@ -0,0 +1,18 @@ +use std::fs; + +fn main() { + for file in ["input.txt", "docs", "/input.txt", "/docs"].iter() { + match fs::metadata(file) { + Ok(attr) => { + if attr.is_dir() { + println!("{} is a directory", file); + }else { + println!("{} is a file", file); + } + }, + Err(_) => { + println!("{} does not exist", file); + } + }; + } +} diff --git a/Task/Check-that-file-exists/Vala/check-that-file-exists-1.vala b/Task/Check-that-file-exists/Vala/check-that-file-exists-1.vala new file mode 100644 index 0000000000..3a1f1d046f --- /dev/null +++ b/Task/Check-that-file-exists/Vala/check-that-file-exists-1.vala @@ -0,0 +1,8 @@ +int main (string[] args) { + string[] files = {"input.txt", "docs", Path.DIR_SEPARATOR_S + "input.txt", Path.DIR_SEPARATOR_S + "docs"}; + foreach (string f in files) { + var file = File.new_for_path (f); + print ("%s exists: %s\n", f, file.query_exists ().to_string ()); + } + return 0; +} diff --git a/Task/Check-that-file-exists/Vala/check-that-file-exists-2.vala b/Task/Check-that-file-exists/Vala/check-that-file-exists-2.vala new file mode 100644 index 0000000000..625b946f4b --- /dev/null +++ b/Task/Check-that-file-exists/Vala/check-that-file-exists-2.vala @@ -0,0 +1,20 @@ +int main (string[] args) { + string[] files = {"input.txt", "docs", Path.DIR_SEPARATOR_S + "input.txt", Path.DIR_SEPARATOR_S + "docs"}; + foreach (var f in files) { + var file = File.new_for_path (f); + var exists = file.query_exists (); + var name = ""; + if (!exists) { + print ("%s does not exist\n", f); + } else { + var type = file.query_file_type (FileQueryInfoFlags.NOFOLLOW_SYMLINKS); + if (type == 1) { + name = "file"; + } else if (type == 2) { + name = "directory"; + } + print ("%s %s exists\n", name, f); + } + } + return 0; +} diff --git a/Task/Chinese-remainder-theorem/00DESCRIPTION b/Task/Chinese-remainder-theorem/00DESCRIPTION index 63b863f244..d016edb5b3 100644 --- a/Task/Chinese-remainder-theorem/00DESCRIPTION +++ b/Task/Chinese-remainder-theorem/00DESCRIPTION @@ -1,30 +1,49 @@ -Suppose n_1, n_2, \ldots, n_k are positive [[integer]]s that are pairwise coprime. Then, for any given sequence of integers a_1, a_2, \dots, a_k, there exists an integer x solving the following system of simultaneous congruences. +Suppose   n_1,   n_2,   \ldots,   n_k   are positive [[integer]]s that are pairwise co-prime.   -:\begin{align} +Then, for any given sequence of integers   a_1,   a_2,   \dots,   a_k,   there exists an integer   x   solving the following system of simultaneous congruences: + +::: \begin{align} x &\equiv a_1 \pmod{n_1} \\ x &\equiv a_2 \pmod{n_2} \\ &{}\ \ \vdots \\ x &\equiv a_k \pmod{n_k} \end{align} -Furthermore, all solutions x of this system are congruent modulo the product, N=n_1n_2\ldots n_k. +Furthermore, all solutions   x   of this system are congruent modulo the product,   N=n_1n_2\ldots n_k. -'''Your task''' is to write a program to solve a system of linear congruences by applying the [[wp:Chinese Remainder Theorem|Chinese Remainder Theorem]]. If the system of equations cannot be solved, your program must somehow indicate this. (It may throw an exception or return a special false value.) Since there are infinitely many solutions, the program should return the unique solution s where 0 \leq s \leq n_1n_2\ldots n_k. -''Show the functionality of this program'' by printing the result such that the n's are [3,5,7] and the a's are [2,3,2]. +;Task: +Write a program to solve a system of linear congruences by applying the   [[wp:Chinese Remainder Theorem|Chinese Remainder Theorem]]. -'''Algorithm''': The following algorithm only applies if the n_i's are pairwise coprime. +If the system of equations cannot be solved, your program must somehow indicate this. + +(It may throw an exception or return a special false value.) + +Since there are infinitely many solutions, the program should return the unique solution   s   where   0 \leq s \leq n_1n_2\ldots n_k. + + +''Show the functionality of this program'' by printing the result such that the   n's   are   [3,5,7]   and the   a's   are   [2,3,2]. + + +'''Algorithm''':   The following algorithm only applies if the   n_i's   are pairwise co-prime. Suppose, as above, that a solution is required for the system of congruences: -:x \equiv a_i \pmod{n_i} \quad\mathrm{for}\; i = 1, \ldots, k +::: x \equiv a_i \pmod{n_i} \quad\mathrm{for}\; i = 1, \ldots, k -Again, to begin, the product N = n_1n_2 \ldots n_k is defined. Then a solution x can be found as follows. +Again, to begin, the product   N = n_1n_2 \ldots n_k   is defined. -For each i, the integers n_i and N/n_i are coprime. Using the [[wp:Extended Euclidean algorithm|Extended Euclidean algorithm]] we can find integers r_i and s_i such that r_i n_i + s_i N/n_i = 1. Then, one solution to the system of simultaneous congruences is: +Then a solution   x   can be found as follows: -:x = \sum_{i=1}^k a_i s_i N/n_i +For each   i,   the integers   n_i   and   N/n_i   are co-prime. + +Using the   [[wp:Extended Euclidean algorithm|Extended Euclidean algorithm]],   we can find integers   r_i   and   s_i   such that   r_i n_i + s_i N/n_i = 1. + +Then, one solution to the system of simultaneous congruences is: + +::: x = \sum_{i=1}^k a_i s_i N/n_i and the minimal solution, -:x \pmod{N}. +::: x \pmod{N}. +

    diff --git a/Task/Chinese-remainder-theorem/Clojure/chinese-remainder-theorem.clj b/Task/Chinese-remainder-theorem/Clojure/chinese-remainder-theorem.clj new file mode 100644 index 0000000000..698d1e7fb1 --- /dev/null +++ b/Task/Chinese-remainder-theorem/Clojure/chinese-remainder-theorem.clj @@ -0,0 +1,41 @@ +(ns test-p.core + (:require [clojure.math.numeric-tower :as math])) + +(defn extended-gcd + "The extended Euclidean algorithm + Returns a list containing the GCD and the Bézout coefficients + corresponding to the inputs. " + [a b] + (cond (zero? a) [(math/abs b) 0 1] + (zero? b) [(math/abs a) 1 0] + :else (loop [s 0 + s0 1 + t 1 + t0 0 + r (math/abs b) + r0 (math/abs a)] + (if (zero? r) + [r0 s0 t0] + (let [q (quot r0 r)] + (recur (- s0 (* q s)) s + (- t0 (* q t)) t + (- r0 (* q r)) r)))))) + +(defn chinese_remainder + " Main routine to return the chinese remainder " + [n a] + (let [prod (apply * n) + reducer (fn [sum [n_i a_i]] + (let [p (quot prod n_i) ; p = prod / n_i + egcd (extended-gcd p n_i) ; Extended gcd + inv_p (second egcd)] ; Second item is the inverse + (+ sum (* a_i inv_p p)))) + sum-prod (reduce reducer 0 (map vector n a))] ; Replaces the Python for loop to sum + ; (map vector n a) is same as + ; ; Python's version Zip (n, a) + (mod sum-prod prod))) ; Result line + +(def n [3 5 7]) +(def a [2 3 2]) + +(println (chinese_remainder n a)) diff --git a/Task/Chinese-remainder-theorem/Elixir/chinese-remainder-theorem.elixir b/Task/Chinese-remainder-theorem/Elixir/chinese-remainder-theorem.elixir index f6c0c60193..a144f633ad 100644 --- a/Task/Chinese-remainder-theorem/Elixir/chinese-remainder-theorem.elixir +++ b/Task/Chinese-remainder-theorem/Elixir/chinese-remainder-theorem.elixir @@ -2,9 +2,9 @@ defmodule Chinese do def remainder(mods, remainders) do max = Enum.reduce(mods, fn x,acc -> x*acc end) Enum.zip(mods, remainders) - |> Enum.map(fn {m,r} -> Enum.take_every(r..max, m) |> Enum.into(HashSet.new) end) - |> Enum.reduce(fn set,acc -> Set.intersection(set, acc) end) - |> Set.to_list + |> Enum.map(fn {m,r} -> Enum.take_every(r..max, m) |> MapSet.new end) + |> Enum.reduce(fn set,acc -> MapSet.intersection(set, acc) end) + |> MapSet.to_list end end diff --git a/Task/Chinese-remainder-theorem/Java/chinese-remainder-theorem.java b/Task/Chinese-remainder-theorem/Java/chinese-remainder-theorem.java new file mode 100644 index 0000000000..304a587c7e --- /dev/null +++ b/Task/Chinese-remainder-theorem/Java/chinese-remainder-theorem.java @@ -0,0 +1,46 @@ +import static java.util.Arrays.stream; + +public class ChineseRemainderTheorem { + + public static int chineseRemainder(int[] n, int[] a) { + + int prod = stream(n).reduce(1, (i, j) -> i * j); + + int p, sm = 0; + for (int i = 0; i < n.length; i++) { + p = prod / n[i]; + sm += a[i] * mulInv(p, n[i]) * p; + } + return sm % prod; + } + + private static int mulInv(int a, int b) { + int b0 = b; + int x0 = 0; + int x1 = 1; + + if (b == 1) + return 1; + + while (a > 1) { + int q = a / b; + int amb = a % b; + a = b; + b = amb; + int xqx = x1 - q * x0; + x1 = x0; + x0 = xqx; + } + + if (x1 < 0) + x1 += b0; + + return x1; + } + + public static void main(String[] args) { + int[] n = {3, 5, 7}; + int[] a = {2, 3, 2}; + System.out.println(chineseRemainder(n, a)); + } +} diff --git a/Task/Chinese-remainder-theorem/REXX/chinese-remainder-theorem-1.rexx b/Task/Chinese-remainder-theorem/REXX/chinese-remainder-theorem-1.rexx index 888e6be2c4..fa7c4e1700 100644 --- a/Task/Chinese-remainder-theorem/REXX/chinese-remainder-theorem-1.rexx +++ b/Task/Chinese-remainder-theorem/REXX/chinese-remainder-theorem-1.rexx @@ -1,26 +1,26 @@ -/*REXX program demonstrates Sun Tzu's (or Sunzi's) Chinese Remainder Theorem.*/ -parse arg Ns As . /*get optional arguments from the C.L. */ -if Ns=='' then Ns = '3,5,7' /*Ns not specified? Then use default.*/ -if As=='' then As = '2,3,2' /*As " " " " " */ - say 'Ns: ' Ns - say 'As: ' As; say -Ns=space(translate(Ns,,',')); #=words(Ns) /*elide any superfluous blanks.*/ -As=space(translate(As,,',')); _=words(As) /* " " " " */ +/*REXX program demonstrates Sun Tzu's (or Sunzi's) Chinese Remainder Theorem. */ +parse arg Ns As . /*get optional arguments from the C.L. */ +if Ns=='' | Ns=="," then Ns = '3,5,7' /*Ns not specified? Then use default.*/ +if As=='' | As=="," then As = '2,3,2' /*As " " " " " */ + say 'Ns: ' Ns + say 'As: ' As; say +Ns=space(translate(Ns, , ',')); #=words(Ns) /*elide any superfluous blanks from N's*/ +As=space(translate(As, , ',')); _=words(As) /* " " " " " A's*/ if #\==_ then do; say "size of number sets don't match."; exit 131; end if #==0 then do; say "size of the N set isn't valid."; exit 132; end if _==0 then do; say "size of the A set isn't valid."; exit 133; end -N=1 /*the product─to─be for prod(n.j). */ - do j=1 for # /*process each number for As and Ns. */ - n.j=word(Ns,j); N=N*n.j /*get an N.j and calculate product. */ - a.j=word(As,j) /* " " A.j from the As list. */ +N=1 /*the product─to─be for prod(n.j). */ + do j=1 for # /*process each number for As and Ns. */ + n.j=word(Ns,j); N=N*n.j /*get an N.j and calculate product. */ + a.j=word(As,j) /* " " A.j from the As list. */ end /*j*/ - do x=1 for N /*use a simple algebraic method. */ - do i=1 for # /*process each N.i and A.i number.*/ - if x//n.i\==a.i then iterate x /*is modulus correct for the number X ?*/ - end /*i*/ /* [↑] limit solution to the product. */ - say 'found a solution with X=' x /*display one possible solution. */ - exit /*stick a fork in it, we're all done. */ - end /*x*/ + do x=1 for N /*use a simple algebraic method. */ + do i=1 for # /*process each N.i and A.i number.*/ + if x//n.i\==a.i then iterate x /*is modulus correct for the number X ?*/ + end /*i*/ /* [↑] limit solution to the product. */ + say 'found a solution with X=' x /*display one possible solution. */ + exit /*stick a fork in it, we're all done. */ + end /*x*/ -say 'no solution found.' /*oops, announce that solution ¬ found.*/ +say 'no solution found.' /*oops, announce that solution ¬ found.*/ diff --git a/Task/Chinese-remainder-theorem/REXX/chinese-remainder-theorem-2.rexx b/Task/Chinese-remainder-theorem/REXX/chinese-remainder-theorem-2.rexx index b90b5973f2..60be2d0f91 100644 --- a/Task/Chinese-remainder-theorem/REXX/chinese-remainder-theorem-2.rexx +++ b/Task/Chinese-remainder-theorem/REXX/chinese-remainder-theorem-2.rexx @@ -1,28 +1,28 @@ -/*REXX program demonstrates Sun Tzu's (or Sunzi's) Chinese Remainder Theorem.*/ -parse arg Ns As . /*get optional arguments from the C.L. */ -if Ns=='' then Ns = '3,5,7' /*Ns not specified? Then use default.*/ -if As=='' then As = '2,3,2' /*As " " " " " */ - say 'Ns: ' Ns - say 'As: ' As; say -Ns=space(translate(Ns,,',')); #=words(Ns) /*elide any superfluous blanks.*/ -As=space(translate(As,,',')); _=words(As) /* " " " " */ +/*REXX program demonstrates Sun Tzu's (or Sunzi's) Chinese Remainder Theorem. */ +parse arg Ns As . /*get optional arguments from the C.L. */ +if Ns=='' | Ns=="," then Ns = '3,5,7' /*Ns not specified? Then use default.*/ +if As=='' | As=="," then As = '2,3,2' /*As " " " " " */ + say 'Ns: ' Ns + say 'As: ' As; say +Ns=space(translate(Ns, , ',')); #=words(Ns) /*elide any superfluous blanks from N's*/ +As=space(translate(As, , ',')); _=words(As) /* " " " " " A's*/ if #\==_ then do; say "size of number sets don't match."; exit 131; end if #==0 then do; say "size of the N set isn't valid."; exit 132; end if _==0 then do; say "size of the A set isn't valid."; exit 133; end -N=1 /*the product─to─be for prod(n.j). */ - do j=1 for # /*process each number for As and Ns. */ - n.j=word(Ns,j); N=N*n.j /*get an N.j and calculate product. */ - a.j=word(As,j) /* " " A.j from the As list. */ +N=1 /*the product─to─be for prod(n.j). */ + do j=1 for # /*process each number for As and Ns. */ + n.j=word(Ns,j); N=N*n.j /*get an N.j and calculate product. */ + a.j=word(As,j) /* " " A.j from the As list. */ end /*j*/ -@.= /* [↓] converts congruences ───► sets.*/ +@.= /* [↓] converts congruences ───► sets.*/ do i=1 for #; _=a.i; @.i._=a.i; p=a.i - do N; p=p+n.i; @.i.p=p; end /*build a (array) list of modulo values*/ + do N; p=p+n.i; @.i.p=p; end /*build a (array) list of modulo values*/ end /*i*/ - /* [↓] find common number in the sets.*/ - do x=1 for N; if @.1.x=='' then iterate /*locate a number. */ - do v=2 to #; if @.v.x=='' then iterate x; end /*Is in all sets ? */ - say 'found a solution with X=' x /*display one possible solution. */ - exit /*stick a fork in it, we're all done. */ + /* [↓] find common number in the sets.*/ + do x=1 for N; if @.1.x=='' then iterate /*locate a number. */ + do v=2 to #; if @.v.x=='' then iterate x; end /*Is in all sets ? */ + say 'found a solution with X=' x /*display one possible solution. */ + exit /*stick a fork in it, we're all done. */ end /*x*/ -say 'no solution found.' /*oops, announce that solution ¬ found.*/ +say 'no solution found.' /*oops, announce that solution ¬ found.*/ diff --git a/Task/Chinese-remainder-theorem/Ruby/chinese-remainder-theorem.rb b/Task/Chinese-remainder-theorem/Ruby/chinese-remainder-theorem-1.rb similarity index 100% rename from Task/Chinese-remainder-theorem/Ruby/chinese-remainder-theorem.rb rename to Task/Chinese-remainder-theorem/Ruby/chinese-remainder-theorem-1.rb diff --git a/Task/Chinese-remainder-theorem/Ruby/chinese-remainder-theorem-2.rb b/Task/Chinese-remainder-theorem/Ruby/chinese-remainder-theorem-2.rb new file mode 100644 index 0000000000..e565456634 --- /dev/null +++ b/Task/Chinese-remainder-theorem/Ruby/chinese-remainder-theorem-2.rb @@ -0,0 +1,28 @@ +def extended_gcd(a, b) + last_remainder, remainder = a.abs, b.abs + x, last_x, y, last_y = 0, 1, 1, 0 + while remainder != 0 + last_remainder, (quotient, remainder) = remainder, last_remainder.divmod(remainder) + x, last_x = last_x - quotient*x, x + y, last_y = last_y - quotient*y, y + end + return last_remainder, last_x * (a < 0 ? -1 : 1) +end + +def invmod(e, et) + g, x = extended_gcd(e, et) + if g != 1 + raise 'Multiplicative inverse modulo does not exist!' + end + x % et +end + +def chinese_remainder(mods, remainders) + max = mods.inject( :* ) # product of all moduli + series = remainders.zip(mods).map{ |r,m| (r * max * invmod(max/m, m) / m) } + series.inject( :+ ) % max +end + +p chinese_remainder([3,5,7], [2,3,2]) #=> 23 +p chinese_remainder([17353461355013928499, 3882485124428619605195281, 13563122655762143587], [7631415079307304117, 1248561880341424820456626, 2756437267211517231]) #=> 937307771161836294247413550632295202816 +p chinese_remainder([10,4,9], [11,22,19]) #=> nil diff --git a/Task/Chinese-remainder-theorem/ZX-Spectrum-Basic/chinese-remainder-theorem.zx b/Task/Chinese-remainder-theorem/ZX-Spectrum-Basic/chinese-remainder-theorem.zx new file mode 100644 index 0000000000..7352e57e57 --- /dev/null +++ b/Task/Chinese-remainder-theorem/ZX-Spectrum-Basic/chinese-remainder-theorem.zx @@ -0,0 +1,24 @@ +10 DIM n(3): DIM a(3) +20 FOR i=1 TO 3 +30 READ n(i),a(i) +40 NEXT i +50 DATA 3,2,5,3,7,2 +100 LET prod=1: LET sum=0 +110 FOR i=1 TO 3: LET prod=prod*n(i): NEXT i +120 FOR i=1 TO 3 +130 LET p=INT (prod/n(i)): LET a=p: LET b=n(i) +140 GO SUB 1000 +150 LET sum=sum+a(i)*x1*p +160 NEXT i +170 PRINT FN m(sum,prod) +180 STOP +200 DEF FN m(a,b)=a-INT (a/b)*b: REM Modulus function +1000 LET b0=b: LET x0=0: LET x1=1 +1010 IF b=1 THEN RETURN +1020 IF a<=1 THEN GO TO 1100 +1030 LET q=INT (a/b) +1040 LET t=b: LET b=FN m(a,b): LET a=t +1050 LET t=x0: LET x0=x1-q*x0: LET x1=t +1060 GO TO 1020 +1100 IF x1<0 THEN LET x1=x1+b0 +1110 RETURN diff --git a/Task/Cholesky-decomposition/Haskell/cholesky-decomposition-2.hs b/Task/Cholesky-decomposition/Haskell/cholesky-decomposition-2.hs index 9dd8dee396..948d4d1b5d 100644 --- a/Task/Cholesky-decomposition/Haskell/cholesky-decomposition-2.hs +++ b/Task/Cholesky-decomposition/Haskell/cholesky-decomposition-2.hs @@ -2,21 +2,17 @@ import Data.Array.IArray import Data.List import Cholesky -takeDrop 0 xs = ([],xs) -takeDrop _ [] = ([],[]) -takeDrop n (x:xs) = (x:a,b) where (a,b) = takeDrop (n-1) xs - fm _ [] = "" fm _ [x] = fst x fm width ((a,b):xs) = a ++ (take (width - b) $ cycle " ") ++ (fm width xs) fmt width row (xs,[]) = fm width xs -fmt width row (xs,ys) = fm width xs ++ "\n" ++ fmt width row (takeDrop row ys) +fmt width row (xs,ys) = fm width xs ++ "\n" ++ fmt width row (splitAt row ys) showMatrice row xs = ys where vs = map (\s -> let sh = show s in (sh,length sh)) xs - width = (maximum $ snd $ unzip vs) + 2 - ys = fmt width row (takeDrop row vs) + width = (maximum $ snd $ unzip vs) + 1 + ys = fmt width row (splitAt row vs) ex1, ex2 :: Arr ex1 = listArray ((0,0),(2,2)) [25, 15, -5, diff --git a/Task/Cholesky-decomposition/PARI-GP/cholesky-decomposition.pari b/Task/Cholesky-decomposition/PARI-GP/cholesky-decomposition.pari new file mode 100644 index 0000000000..fafaed9f35 --- /dev/null +++ b/Task/Cholesky-decomposition/PARI-GP/cholesky-decomposition.pari @@ -0,0 +1,12 @@ +cholesky(M) = +{ + my (L = matrix(#M,#M)); + + for (i = 1, #M, + for (j = 1, i, + s = sum (k = 1, j-1, L[i,k] * L[j,k]); + L[i,j] = if (i == j, sqrt(M[i,i] - s), (M[i,j] - s) / L[j,j]) + ) + ); + L +} diff --git a/Task/Cholesky-decomposition/PowerShell/cholesky-decomposition.psh b/Task/Cholesky-decomposition/PowerShell/cholesky-decomposition.psh new file mode 100644 index 0000000000..453a2cb825 --- /dev/null +++ b/Task/Cholesky-decomposition/PowerShell/cholesky-decomposition.psh @@ -0,0 +1,56 @@ +function cholesky ($a) { + $l = @() + if ($a) { + $n = $a.count + $end = $n - 1 + $l = @(0) * $n + foreach ($i in 0..$end) {$l[$i] = @(0) * $n} + foreach ($k in 0..$end) { + $m = $k - 1 + $sum = 0 + if(0 -lt $k) { + foreach ($j in 0..$m) {$sum += $l[$k][$j]*$l[$k][$j]} + } + $l[$k][$k] = [Math]::Sqrt($a[$k][$k] - $sum) + if ($k -lt $end) { + foreach ($i in ($k+1)..$end) { + $sum = 0 + if (0 -lt $k) { + foreach ($j in 0..$m) {$sum += $l[$i][$j]*$l[$k][$j]} + } + $l[$i][$k] = ($a[$i][$k] - $sum)/$l[$k][$k] + } + } + } + } + $l +} + +function show($a) { + if($a) { + 0..($a.Count - 1) | foreach{ if($a[$_]){"$($a[$_])"}else{""} } + } +} + +$a1 = @( +@(25, 15, -5), +@(15, 18, 0), +@(-5, 0, 11) +) +"a1 =" +show $a1 +"" +"l1 =" +show (cholesky $a1) +"" +$a2 = @( +@(18, 22, 54, 42), +@(22, 70, 86, 62), +@(54, 86, 174, 134), +@(42, 62, 134, 106) +) +"a2 =" +show $a2 +"" +"l2 =" +show (cholesky $a2) diff --git a/Task/Cholesky-decomposition/REXX/cholesky-decomposition.rexx b/Task/Cholesky-decomposition/REXX/cholesky-decomposition.rexx index 811309f286..da49f72c59 100644 --- a/Task/Cholesky-decomposition/REXX/cholesky-decomposition.rexx +++ b/Task/Cholesky-decomposition/REXX/cholesky-decomposition.rexx @@ -10,7 +10,7 @@ hexer = 18 22 54 42, /*define a 4x4 matrix. */ call Cholesky hexer exit /*stick a fork in it, we're all done. */ /*────────────────────────────────────────────────────────────────────────────*/ -Cholesky: procedure; parse arg mat; say; say; call tell 'input array',mat +Cholesky: procedure; parse arg mat; say; say; call tell 'input matrix',mat do r=1 for ord do c=1 for r; $=0; do i=1 for c-1; $=$+!.r.i*!.c.i; end /*i*/ if r=c then !.r.r=sqrt(!.r.r-$) diff --git a/Task/Cholesky-decomposition/ZX-Spectrum-Basic/cholesky-decomposition.zx b/Task/Cholesky-decomposition/ZX-Spectrum-Basic/cholesky-decomposition.zx new file mode 100644 index 0000000000..b26ccef767 --- /dev/null +++ b/Task/Cholesky-decomposition/ZX-Spectrum-Basic/cholesky-decomposition.zx @@ -0,0 +1,35 @@ +10 LET d=2000: GO SUB 1000: GO SUB 4000: GO SUB 5000 +20 LET d=3000: GO SUB 1000: GO SUB 4000: GO SUB 5000 +30 STOP +1000 RESTORE d +1010 READ a,b +1020 DIM m(a,b) +1040 FOR i=1 TO a +1050 FOR j=1 TO b +1060 READ m(i,j) +1070 NEXT j +1080 NEXT i +1090 RETURN +2000 DATA 3,3,25,15,-5,15,18,0,-5,0,11 +3000 DATA 4,4,18,22,54,42,22,70,86,62,54,86,174,134,42,62,134,106 +4000 REM Cholesky decomposition +4005 DIM l(a,b) +4010 FOR i=1 TO a +4020 FOR j=1 TO i +4030 LET s=0 +4050 FOR k=1 TO j-1 +4060 LET s=s+l(i,k)*l(j,k) +4070 NEXT k +4080 IF i=j THEN LET l(i,j)=SQR (m(i,i)-s): GO TO 4100 +4090 LET l(i,j)=(m(i,j)-s)/l(j,j) +4100 NEXT j +4110 NEXT i +4120 RETURN +5000 REM Print +5010 FOR r=1 TO a +5020 FOR c=1 TO b +5030 PRINT l(r,c);" "; +5040 NEXT c +5050 PRINT +5060 NEXT r +5070 RETURN diff --git a/Task/Circles-of-given-radius-through-two-points/00DESCRIPTION b/Task/Circles-of-given-radius-through-two-points/00DESCRIPTION index c1d726bfb5..ced8cafbf4 100644 --- a/Task/Circles-of-given-radius-through-two-points/00DESCRIPTION +++ b/Task/Circles-of-given-radius-through-two-points/00DESCRIPTION @@ -1,3 +1,5 @@ +[[File:2 circles through 2 points.jpg|500px||right|2 circles with a given radius through 2 points in 2D space.]] + Given two points on a plane and a radius, usually two circles of given radius can be drawn through the points. ;Exceptions: # r==0.0 should be treated as never describing circles (except in the case where the points are coincident). @@ -5,15 +7,19 @@ Given two points on a plane and a radius, usually two circles of given radius ca # If the points form a diameter then return two identical circles ''or'' return a single circle, according to which is the most natural mechanism for the implementation language. # If the points are too far apart then no circles can be drawn. + ;Task detail: * Write a function/subroutine/method/... that takes two points and a radius and returns the two circles through those points, ''or some indication of special cases where two, possibly equal, circles cannot be returned''. * Show here the output for the following inputs: -
          p1                p2           r
    +
    +      p1                p2           r
     0.1234, 0.9876    0.8765, 0.2345    2.0
     0.0000, 2.0000    0.0000, 0.0000    1.0
     0.1234, 0.9876    0.1234, 0.9876    2.0
     0.1234, 0.9876    0.8765, 0.2345    0.5
    -0.1234, 0.9876    0.1234, 0.9876    0.0
    +0.1234, 0.9876 0.1234, 0.9876 0.0 +
    ;Ref: * [http://mathforum.org/library/drmath/view/53027.html Finding the Center of a Circle from 2 Points and Radius] from Math forum @ Drexel +

    diff --git a/Task/Circles-of-given-radius-through-two-points/ALGOL-68/circles-of-given-radius-through-two-points.alg b/Task/Circles-of-given-radius-through-two-points/ALGOL-68/circles-of-given-radius-through-two-points.alg new file mode 100644 index 0000000000..da0f226159 --- /dev/null +++ b/Task/Circles-of-given-radius-through-two-points/ALGOL-68/circles-of-given-radius-through-two-points.alg @@ -0,0 +1,107 @@ +# represents a point # +MODE POINT = STRUCT( REAL x, REAL y ); +# returns TRUE if p1 is the same point as p2, FALSE otherwise # +OP = = ( POINT p1, POINT p2 )BOOL: x OF p1 = x OF p2 AND y OF p1 = y OF p2; + +# represents a circle with centre c and radius r # +MODE CIRCLE = STRUCT( POINT c, REAL r ); +# returns the difference in x-coordinate of two points # +PRIO XDIFF = 5; +OP XDIFF = ( POINT p1, POINT p2 )REAL: x OF p1 - x OF p2; +# returns the difference in y-coordinate of two points # +PRIO YDIFF = 5; +OP YDIFF = ( POINT p1, POINT p2 )REAL: y OF p1 - y OF p2; +# returns the distance between two points # +OP - = ( POINT p1, POINT p2 )REAL: + BEGIN + REAL x diff = p1 XDIFF p2; + REAL y diff = p1 YDIFF p2; + sqrt( ( x diff * xdiff ) + ( y diff * y diff ) ) + END; # - # +# generate a human-readable version of the circle c # +OP TOSTRING = ( CIRCLE c )STRING: + ( "radius:" + + fixed( r OF c, -8, 4 ) + + " @(" + + fixed( x OF c OF c, -8, 4 ) + + ", " + + fixed( y OF c OF c, -8, 4 ) + + ")" + ); + +# modes to represent the results of the circles procedure ... # +# infinite number of circles # +MODE INFINITECIRCLES = STRUCT( STRING t, REAL r ); +# two possible circles # +MODE TWOCIRCLES = STRUCT( CIRCLE a, CIRCLE b ); +# one possible circle results in a CIRCLE # +# no possible circles # +MODE NOCIRCLES = STRUCT( STRING reason, POINT p1, POINT p2, REAL r ); +# mode returned by the circles procedure # +MODE POSSIBLECIRCLES = UNION( INFINITECIRCLES, TWOCIRCLES, CIRCLE, NOCIRCLES ); + +# returns the circles of radius r that can be drawn through # +# points p1 and p2 # +PROC circles = ( POINT p1, POINT p2, REAL r )POSSIBLECIRCLES: + IF r < 0 THEN # negative radius - there are no circles # + NOCIRCLES( "negative radius", p1, p2, r ) + ELIF p1 = p2 THEN # coincident points # + IF r = 0.0 THEN + # only one circle of radius 0 is possible # + CIRCLE( p1, 0.0 ) + ELSE + # an infinite number of circles can be drawn through # + # the point # + INFINITECIRCLES( "infinite", r ) + FI + ELSE # two possible circles # + REAL distance = p1 - p2; + IF distance > 2 * r THEN + # the points are too far apart # + NOCIRCLES( "points too far apart", p1, p2, r ) + ELIF distance = 2 * r THEN + # the points are on the diameter of the circle # + CIRCLE( POINT( x OF p1 + ( ( p2 XDIFF p1 ) / 2 ) + , y OF p1 + ( ( p2 YDIFF p1 ) / 2 ) + ) + , r + ) + ELSE + # it is possible to draw two circles through the points # + REAL half x sum = ( x OF p1 + x OF p2 ) / 2; + REAL half y sum = ( y OF p1 + y OF p2 ) / 2; + REAL mirror distance = sqrt( ( r * r ) - ( ( distance * distance ) / 4 ) ); + REAL x mirror = ( mirror distance * ( y OF p1 - y OF p2 ) ) / distance; + REAL y mirror = ( mirror distance * ( x OF p2 - x OF p1 ) ) / distance; + TWOCIRCLES( CIRCLE( POINT( half x sum + y mirror, half y sum + x mirror ), r ) + , CIRCLE( POINT( half x sum - y mirror, half y sum - x mirror ), r ) + ) + FI + FI; # circles # + +# test the circles procedure with the examples from the task # + +PROC print circles = ( REAL x1, y1, x2, y2, r )VOID: + BEGIN + CASE circles( POINT( x1, y1 ), POINT( x2, y2 ), r ) + IN ( NOCIRCLES n ): print( ( "No circles : ", reason OF n ) ) + , ( TWOCIRCLES t ): print( ( "Two circles: " + , TOSTRING a OF t + , ", " + , TOSTRING b OF t + ) + ) + , ( CIRCLE c ): print( ( "One circle : ", TOSTRING c ) ) + , ( INFINITECIRCLES i ): print( ( "Infinite circles" ) ) + OUT BEGIN + print( ( "Unexpected circles result", newline ) ); + stop + END + ESAC; + print( ( newline ) ) + END; # print circles # +print circles( 0.1234, 0.9876, 0.8765, 0.2345, 2.0 ); +print circles( 0.0000, 2.0000, 0.0000, 0.0000, 1.0 ); +print circles( 0.1234, 0.9876, 0.1234, 0.9876, 2.0 ); +print circles( 0.1234, 0.9876, 0.8765, 0.2345, 0.5 ); +print circles( 0.1234, 0.9876, 0.1234, 0.9876, 0.0 ) diff --git a/Task/Circles-of-given-radius-through-two-points/C-sharp/circles-of-given-radius-through-two-points.cs b/Task/Circles-of-given-radius-through-two-points/C-sharp/circles-of-given-radius-through-two-points.cs new file mode 100644 index 0000000000..ba375a9ddb --- /dev/null +++ b/Task/Circles-of-given-radius-through-two-points/C-sharp/circles-of-given-radius-through-two-points.cs @@ -0,0 +1,72 @@ +using System; +public class CirclesOfGivenRadiusThroughTwoPoints +{ + public static void Main() + { + double[][] values = new double[][] { + new [] { 0.1234, 0.9876, 0.8765, 0.2345, 2 }, + new [] { 0.0, 2.0, 0.0, 0.0, 1 }, + new [] { 0.1234, 0.9876, 0.1234, 0.9876, 2 }, + new [] { 0.1234, 0.9876, 0.8765, 0.2345, 0.5 }, + new [] { 0.1234, 0.9876, 0.1234, 0.9876, 0 } + }; + + foreach (var a in values) { + var p = new Point(a[0], a[1]); + var q = new Point(a[2], a[3]); + Console.WriteLine($"Points {p} and {q} with radius {a[4]}:"); + try { + var centers = FindCircles(p, q, a[4]); + Console.WriteLine("\t" + string.Join(" and ", centers)); + } catch (Exception ex) { + Console.WriteLine("\t" + ex.Message); + } + } + } + + static Point[] FindCircles(Point p, Point q, double radius) { + if(radius < 0) throw new ArgumentException("Negative radius."); + if(radius == 0) { + if(p == q) return new [] { p }; + else throw new InvalidOperationException("No circles."); + } + if (p == q) throw new InvalidOperationException("Infinite number of circles."); + + double sqDistance = Point.SquaredDistance(p, q); + double sqDiameter = 4 * radius * radius; + if (sqDistance > sqDiameter) throw new InvalidOperationException("Points are too far apart."); + + Point midPoint = new Point((p.X + q.X) / 2, (p.Y + q.Y) / 2); + if (sqDistance == sqDiameter) return new [] { midPoint }; + + double d = Math.Sqrt(radius * radius - sqDistance / 4); + double distance = Math.Sqrt(sqDistance); + double ox = d * (q.X - p.X) / distance, oy = d * (q.Y - p.Y) / distance; + return new [] { + new Point(midPoint.X - oy, midPoint.Y + ox), + new Point(midPoint.X + oy, midPoint.Y - ox) + }; + } + + public struct Point + { + public Point(double x, double y) : this() { + X = x; + Y = y; + } + + public double X { get; } + public double Y { get; } + + public static bool operator ==(Point p, Point q) => p.X == q.X && p.Y == q.Y; + public static bool operator !=(Point p, Point q) => p.X != q.X || p.Y != q.Y; + + public static double SquaredDistance(Point p, Point q) { + double dx = q.X - p.X, dy = q.Y - p.Y; + return dx * dx + dy * dy; + } + + public override string ToString() => $"({X}, {Y})"; + + } +} diff --git a/Task/Circles-of-given-radius-through-two-points/Maple/circles-of-given-radius-through-two-points.maple b/Task/Circles-of-given-radius-through-two-points/Maple/circles-of-given-radius-through-two-points.maple new file mode 100644 index 0000000000..03be20c45f --- /dev/null +++ b/Task/Circles-of-given-radius-through-two-points/Maple/circles-of-given-radius-through-two-points.maple @@ -0,0 +1,28 @@ +drawCircles := proc(x1, y1, x2, y2, r, $) + local c1, c2, p1, p2; + use geometry in + if x1 = x2 and y1 = y2 then + if r = 0 then + printf("The circle is a point at [%a, %a].\n", x1, y1); + else + printf("The two points are the same. Infinite circles can be drawn.\n"); + end if; + elif evalf(distance(point(A, x1, y1), point(B, x2, y2))) >r*2 then + printf("The two points are too far apart. No circles can be drawn.\n"); + else + circle(P1Cir, [A, r]);#make a circle around the first point + circle(P2Cir, [B, r]);#make a circle around the second point + intersection('i', P1Cir, P2Cir); + #the intersection of the above 2 circles should give you the centers of the two circles you need to draw + c1 := plottools[circle](coordinates(`if`(type(i, list), i[1], i)), r);#make the first circle + c2 := plottools[circle](coordinates(`if`(type(i, list), i[2], i)), r);#make the second circle + plots[display](c1, c2, scaling = constrained);#draw + end if; + end use; +end proc: + +drawCircles(0.1234, 0.9876, 0.8765, 0.2345, 2.0); +drawCircles(0.0000, 2.0000, 0.0000, 0.0000, 1.0); +drawCircles(0.1234, 0.9876, 0.1234, 0.9876, 2.0); +drawCircles(0.1234, 0.9876, 0.8765, 0.2345, 0.5); +drawCircles(0.1234, 0.9876, 0.1234, 0.9876, 0.0); diff --git a/Task/Circles-of-given-radius-through-two-points/Perl-6/circles-of-given-radius-through-two-points-1.pl6 b/Task/Circles-of-given-radius-through-two-points/Perl-6/circles-of-given-radius-through-two-points-1.pl6 index eb49b56577..a93a7446b3 100644 --- a/Task/Circles-of-given-radius-through-two-points/Perl-6/circles-of-given-radius-through-two-points-1.pl6 +++ b/Task/Circles-of-given-radius-through-two-points/Perl-6/circles-of-given-radius-through-two-points-1.pl6 @@ -1,21 +1,23 @@ -sub circles(@A, @B where (not [and] @A Z== @B), $radius where * > 0) { - my @middle = .5 X* (@A Z+ @B); +multi sub circles (@A, @B where ([and] @A Z== @B), 0.0) { 'Degenerate point' } +multi sub circles (@A, @B where ([and] @A Z== @B), $) { 'Infinitely many share a point' } +multi sub circles (@A, @B, $radius) { + my @middle = (@A Z+ @B) X/ 2; my @diff = @A Z- @B; - my @orth = -@diff[1], @diff[0] X/ - 2 * tan asin 2*$radius R/ sqrt [+] @diff X**2; + my $q = sqrt [+] @diff X** 2; + return 'Too far apart' if $q > $radius * 2; - return (@middle Z+ @orth).item, (@middle Z- @orth).item; + my @orth = -@diff[0], @diff[1] X* sqrt($radius ** 2 - ($q / 2) ** 2) / $q; + return (@middle Z+ @orth), (@middle Z- @orth); } my @input = -\([0.1234, 0.9876], [0.8765, 0.2345], 2.0), -\([0.0000, 2.0000], [0.0000, 0.0000], 1.0), -\([0.1234, 0.9876], [0.1234, 0.9876], 2.0), -\([0.1234, 0.9876], [0.8765, 0.2345], 0.5), -\([0.1234, 0.9876], [0.1234, 0.9876], 0.0), -; + ([0.1234, 0.9876], [0.8765, 0.2345], 2.0), + ([0.0000, 2.0000], [0.0000, 0.0000], 1.0), + ([0.1234, 0.9876], [0.1234, 0.9876], 2.0), + ([0.1234, 0.9876], [0.8765, 0.2345], 0.5), + ([0.1234, 0.9876], [0.1234, 0.9876], 0.0), + ; -for @input -> $input { - say $input.perl, ": ", - try { say join " and ", circles(|$input) } +for @input { + say .list.perl, ': ', circles(|$_).join(' and '); } diff --git a/Task/Circles-of-given-radius-through-two-points/Perl-6/circles-of-given-radius-through-two-points-2.pl6 b/Task/Circles-of-given-radius-through-two-points/Perl-6/circles-of-given-radius-through-two-points-2.pl6 index 89c3f6264d..04c0326f61 100644 --- a/Task/Circles-of-given-radius-through-two-points/Perl-6/circles-of-given-radius-through-two-points-2.pl6 +++ b/Task/Circles-of-given-radius-through-two-points/Perl-6/circles-of-given-radius-through-two-points-2.pl6 @@ -1,14 +1,20 @@ -sub circles($a, $b where $b != $a, $r) { - my $h = ($b - $a)/2; +multi sub circles ($a, $b where $a == $b, 0.0) { 'Degenerate point' } +multi sub circles ($a, $b where $a == $b, $) { 'Infinitely many share a point' } +multi sub circles ($a, $b, $r) { + my $h = ($b - $a) / 2; my $l = sqrt($r**2 - $h.abs**2); - return map { $a + $h + $l * $_ * $h/$h.abs }, - i, -i; + return 'Too far apart' if $l.isNaN; + return map { $a + $h + $l * $_ * $h / $h.abs }, i, -i; } my @input = -\(0.1234 + 0.9876i, 0.8765 + 0.2345i, 2.0), -\(0.0000 + 2.0000i, 0.0000 + 0.0000i, 1.0), -\(0.1234 + 0.9876i, 0.1234 + 0.9876i, 2.0), -\(0.1234 + 0.9876i, 0.8765 + 0.2345i, 0.5), -\(0.1234 + 0.9876i, 0.1234 + 0.9876i, 0.0), -; + (0.1234 + 0.9876i, 0.8765 + 0.2345i, 2.0), + (0.0000 + 2.0000i, 0.0000 + 0.0000i, 1.0), + (0.1234 + 0.9876i, 0.1234 + 0.9876i, 2.0), + (0.1234 + 0.9876i, 0.8765 + 0.2345i, 0.5), + (0.1234 + 0.9876i, 0.1234 + 0.9876i, 0.0), + ; + +for @input { + say .join(', '), ': ', circles(|$_).join(' and '); +} diff --git a/Task/Circles-of-given-radius-through-two-points/REXX/circles-of-given-radius-through-two-points.rexx b/Task/Circles-of-given-radius-through-two-points/REXX/circles-of-given-radius-through-two-points.rexx index 52012c9554..3b43925b81 100644 --- a/Task/Circles-of-given-radius-through-two-points/REXX/circles-of-given-radius-through-two-points.rexx +++ b/Task/Circles-of-given-radius-through-two-points/REXX/circles-of-given-radius-through-two-points.rexx @@ -1,33 +1,30 @@ -/*REXX program finds two circles with a specific radius given two (X,Y) points*/ -@.=; @.1=0.1234 0.9876 0.8765 0.2345 2 - @.2=0 2 0 0 1 - @.3=0.1234 0.9876 0.1234 0.9876 2 - @.4=0.1234 0.9876 0.8765 0.2345 0.5 - @.5=0.1234 0.9876 0.1234 0.9876 0 +/*REXX program finds two circles with a specific radius given two (X,Y) points. */ +@.=; @.1= 0.1234 0.9876 0.8765 0.2345 2 + @.2= 0 2 0 0 1 + @.3= 0.1234 0.9876 0.1234 0.9876 2 + @.4= 0.1234 0.9876 0.8765 0.2345 0.5 + @.5= 0.1234 0.9876 0.1234 0.9876 0 say ' x1 y1 x2 y2 radius circle1x circle1y circle2x circle2y' say ' ════════ ════════ ════════ ════════ ══════ ════════ ════════ ════════ ════════' - do j=1 while @.j\=='' /*process the points and radii. */ - do k=1 for 4; w.k=f(word(@.j,k)) /*format # with 4 decimal digits.*/ - end /*k*/ - say w.1 w.2 w.3 w.4 center(word(@.j,5)/1,9) "───► " 2circ(@.j) - end /*j*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -2circ: procedure; parse arg px py qx qy r .; x=(qx-px)/2; y=(qy-py)/2 - bx=px+x; by=py+y; pb=sqrt(x**2+y**2) - if r=0 then return 'radius of zero yields no circles.' - if pb=0 then return 'coincident points give infinite circles.' - if pb>r then return 'points are too far apart for the specified radius.' - cb=sqrt(r**2-pb**2); x1=y*cb/pb; y1=x*cb/pb - return f(bx-x1) f(by+y1) f(bx+x1) f(by-y1) -/*────────────────────────────────────────────────────────────────────────────*/ -f: f=right(format(arg(1),,4),9); _=f /*format # with four decimal digits.*/ - if pos(.,f)\==0 then f=strip(f,'T',0) /*strip trailing 0s if decimal point*/ - return left(strip(f,'T',.),length(_)) /*maybe strip trailing decimal point*/ -/*────────────────────────────────────────────────────────────────────────────*/ -sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); i=; m.=9 - numeric digits 9; numeric form; h=d+6; if x<0 then do; x=-x; i='i'; end - parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_%2 - do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ - do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ - numeric digits d; return (g/1)i /*make complex if X < 0.*/ + do j=1 while @.j\==''; parse var @.j p1 p2 p3 p4 r /*points, radii*/ + say f(p1) f(p2) f(p3) f(p4) center(r/1,9) "───► " 2circ(@.j) + end /*j*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +2circ: procedure; parse arg px py qx qy r .; x=(qx-px)/2; y=(qy-py)/2 + bx=px+x; by=py+y; pb=sqrt(x**2+y**2) + if r = 0 then return 'radius of zero yields no circles.' + if pb==0 then return 'coincident points give infinite circles.' + if pb >r then return 'points are too far apart for the specified radius.' + cb=sqrt(r**2-pb**2); x1=y*cb/pb; y1=x*cb/pb + return f(bx-x1) f(by+y1) f(bx+x1) f(by-y1) +/*──────────────────────────────────────────────────────────────────────────────────────*/ +f: f=right(format(arg(1), , 4), 9); _=f /*format the # with four decimal digits*/ + if pos(.,f)\==0 then f=strip(f,'T',0) /*strip trailing 0s if decimal point.*/ + return left(strip(f,'T',.), length(_)) /*maybe strip trailing decimal point.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sqrt: procedure; arg x; if x=0 then return 0; d=digits(); numeric digits; h=d+6; m.=9 + numeric form; parse value format(x,2,1,,0) 'E0' with g "E" _ .; g=g *.5'e'_ % 2 + do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ + do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ + return g diff --git a/Task/Circles-of-given-radius-through-two-points/ZX-Spectrum-Basic/circles-of-given-radius-through-two-points.zx b/Task/Circles-of-given-radius-through-two-points/ZX-Spectrum-Basic/circles-of-given-radius-through-two-points.zx new file mode 100644 index 0000000000..55f546d5c2 --- /dev/null +++ b/Task/Circles-of-given-radius-through-two-points/ZX-Spectrum-Basic/circles-of-given-radius-through-two-points.zx @@ -0,0 +1,27 @@ +10 FOR i=1 TO 5 +20 READ x1,y1,x2,y2,r +30 PRINT i;") ";x1;" ";y1;" ";x2;" ";y2;" ";r +40 GO SUB 1000 +50 NEXT i +60 STOP +70 DATA 0.1234,0.9876,0.8765,0.2345,2.0 +80 DATA 0.0000,2.0000,0.0000,0.0000,1.0 +90 DATA 0.1234,0.9876,0.1234,0.9876,2.0 +100 DATA 0.1234,0.9876,0.8765,0.2345,0.5 +110 DATA 0.1234,0.9876,0.1234,0.9876,0.0 +1000 IF NOT (x1=x2 AND y1=y2) THEN GO TO 1090 +1010 IF r=0 THEN PRINT "It will be a single point (";x1;",";y1;") of radius 0": RETURN +1020 PRINT "There are any number of circles via single point (";x1;",";y1;") of radius ";r: RETURN +1090 LET p1=(x1-x2): LET p2=(y1-y2) +1100 LET r2=SQR (p1*p1+p2*p2)/2 +1110 IF r A polymorphic value has a type tag indicating its specific type from the class and the corresponding specific value of that type. This type is sometimes called '''the most specific type''' of a [polymorphic] value. The type tag of the value is used in order to resolve the dispatch. @@ -24,5 +27,7 @@ In some languages they are distinct (like in [[Ada]]). When class T and T are equivalent, there is no way to distinguish polymorphic and specific values. -The purpose of this task is to create a basic class with a method, -a constructor, an instance variable and how to instantiate it. + +;Task: +Create a basic class with a method, a constructor, an instance variable and how to instantiate it. +

    diff --git a/Task/Classes/Elena/classes.elena b/Task/Classes/Elena/classes.elena new file mode 100644 index 0000000000..7bc0015ae5 --- /dev/null +++ b/Task/Classes/Elena/classes.elena @@ -0,0 +1,30 @@ +#import system. +#import extensions. + +#class MyClass +{ + #field _variable. + + #method Variable = _variable. + + #method someMethod + [ + _variable := 1. + ] + + #constructor new + [ + ] +} + +#symbol program = +[ + // instantiate the class + #var instance := MyClass new. + + // invoke the method + instance someMethod. + + // get the variable + console writeLine:"Variable=":(instance Variable). +]. diff --git a/Task/Classes/PowerShell/classes-1.psh b/Task/Classes/PowerShell/classes-1.psh new file mode 100644 index 0000000000..230aa874c2 --- /dev/null +++ b/Task/Classes/PowerShell/classes-1.psh @@ -0,0 +1,28 @@ +Add-Type -Language CSharp -TypeDefinition @' +public class MyClass +{ + public MyClass() + { + } + public void SomeMethod() + { + } + private int _variable; + public int Variable + { + get { return _variable; } + set { _variable = value; } + } + public static void Main() + { + // instantiate it + MyClass instance = new MyClass(); + // invoke the method + instance.SomeMethod(); + // set the variable + instance.Variable = 99; + // get the variable + System.Console.WriteLine( "Variable=" + instance.Variable.ToString() ); + } +} +'@ diff --git a/Task/Classes/PowerShell/classes-2.psh b/Task/Classes/PowerShell/classes-2.psh new file mode 100644 index 0000000000..9c46f92862 --- /dev/null +++ b/Task/Classes/PowerShell/classes-2.psh @@ -0,0 +1,17 @@ +class MyClass +{ +[type]$MyProperty1 +[type]$MyProperty2 = "Default value" + + # Constructor + MyClass( [type]$MyParameter1, [type]$MyParameter2 ) + { + # Code + } + + # Method ( [returntype] defaults to [void] ) + [returntype] MyMethod( [type]$MyParameter3, [type]$MyParameter4 ) + { + # Code + } +} diff --git a/Task/Classes/PowerShell/classes-3.psh b/Task/Classes/PowerShell/classes-3.psh new file mode 100644 index 0000000000..c87f17b3a8 --- /dev/null +++ b/Task/Classes/PowerShell/classes-3.psh @@ -0,0 +1,33 @@ +class Banana +{ +# Properties +[string]$Color +[boolean]$Peeled + +# Default constructor +Banana() + { + $This.Color = "Green" + } + +# Constructor +Banana( [boolean]$Peeled ) + { + $This.Color = "Green" + $This.Peeled = $Peeled + } + +# Method +Ripen() + { + If ( $This.Color -eq "Green" ) { $This.Color = "Yellow" } + Else { $This.Color = "Brown" } + } + +# Method +[boolean] IsReadyToEat() + { + If ( $This.Color -eq "Yellow" -and $This.Peeled ) { return $True } + Else { return $False } + } +} diff --git a/Task/Classes/PowerShell/classes-4.psh b/Task/Classes/PowerShell/classes-4.psh new file mode 100644 index 0000000000..1e021efa64 --- /dev/null +++ b/Task/Classes/PowerShell/classes-4.psh @@ -0,0 +1,5 @@ +$MyBanana = [banana]::New() +$YourBanana = [banana]::New( $True ) +$YourBanana.Ripen() +If ( -not $MyBanana.IsReadyToEat() -and $YourBanana.IsReadyToEat() ) + { $MySecondBanana = $YourBanana } diff --git a/Task/Classes/Simula/classes.simula b/Task/Classes/Simula/classes.simula new file mode 100644 index 0000000000..151d0f2ebc --- /dev/null +++ b/Task/Classes/Simula/classes.simula @@ -0,0 +1,19 @@ +BEGIN + CLASS MyClass(instanceVariable); + INTEGER instanceVariable; + BEGIN + PROCEDURE doMyMethod(n); + INTEGER n; + BEGIN + Outint(instanceVariable, 5); + Outtext(" + "); + Outint(n, 5); + Outtext(" = "); + Outint(instanceVariable + n, 5); + Outimage + END; + END; + REF(MyClass) myObject; + myObject :- NEW MyClass(5); + myObject.doMyMethod(2) +END diff --git a/Task/Classes/SuperCollider/classes-1.supercollider b/Task/Classes/SuperCollider/classes-1.supercollider new file mode 100644 index 0000000000..3ed20c8240 --- /dev/null +++ b/Task/Classes/SuperCollider/classes-1.supercollider @@ -0,0 +1,29 @@ +SpecialObject { + + classvar a = 42, c; // Class variables. 42 and 0 are default values. + var <>x, <>y; // Instance variables. + // Note: variables are private by default. In the above, "<" creates a getter, ">" creates a setter + + *new { |value| + ^super.new.init(value) // constructor is a class method. typically calls some instance method to set up, here "init" + } + + init { |value| + x = value; + y = sqrt(squared(a) + squared(b)) + } + + // a class method + *randomizeAll { + a = 42.rand; + b = 42.rand; + c = 42.rannd; + } + + // an instance method + coordinates { + ^Point(x, y) // The "^" means to return the result. If not specified, then the object itself will be returned ("^this") + } + + +} diff --git a/Task/Classes/SuperCollider/classes-2.supercollider b/Task/Classes/SuperCollider/classes-2.supercollider new file mode 100644 index 0000000000..18fcafbfbf --- /dev/null +++ b/Task/Classes/SuperCollider/classes-2.supercollider @@ -0,0 +1,3 @@ +SpecialObject.randomizeAll; +a = SpecialObject(8); +a.coordinates; diff --git a/Task/Classes/SuperCollider/classes.supercollider b/Task/Classes/SuperCollider/classes.supercollider deleted file mode 100644 index 39b9cc917e..0000000000 --- a/Task/Classes/SuperCollider/classes.supercollider +++ /dev/null @@ -1,22 +0,0 @@ -MyClass { - classvar someVar, thirdVar; // Class variables. - var <>something, <>somethingElse; // Instance variables. - // Note: variables are private by default. In the above, "<" enables getting, ">" enables setting - - *new { - ^super.new.init // constructor is a class method. typically calls some instance method to set up, here "init" - } - - init { - something = thirdVar.squared; - somethingElse = this.class.name; - } - - *aClassMethod { - ^ someVar + thirdVar // The "^" means to return the result. If not specified, then the object itself will be returned ("^this") - } - - anInstanceMethod { - something = something + 1; - } -} diff --git a/Task/Closest-pair-problem/00DESCRIPTION b/Task/Closest-pair-problem/00DESCRIPTION index 162b19eaf2..85d3dcd072 100644 --- a/Task/Closest-pair-problem/00DESCRIPTION +++ b/Task/Closest-pair-problem/00DESCRIPTION @@ -1,9 +1,10 @@ {{Wikipedia|Closest pair of points problem}} -The aim of this task is to provide a function to find the closest two points among a set of given points in two dimensions, i.e. to solve the [[wp:Closest pair of points problem|Closest pair of points problem]] in the ''planar'' case. -The straightforward solution is a O(n2) algorithm -(which we can call ''brute-force algorithm''); -the pseudocode (using indexes) could be simply: + +;Task: +Provide a function to find the closest two points among a set of given points in two dimensions,   i.e. to solve the   [[wp:Closest pair of points problem|Closest pair of points problem]]   in the   ''planar''   case. + +The straightforward solution is a   O(n2)   algorithm   (which we can call ''brute-force algorithm'');   the pseudo-code (using indexes) could be simply: '''bruteForceClosestPair''' of P(1), P(2), ... P(N) '''if''' N < 2 '''then''' @@ -22,9 +23,7 @@ the pseudocode (using indexes) could be simply: '''return''' minDistance, minPoints '''endif''' -A better algorithm is based on the recursive divide&conquer approach, -as explained also at [[wp:Closest pair of points problem#Planar_case|Wikipedia]], -which is O(''n'' log ''n''); a pseudocode could be: +A better algorithm is based on the recursive divide&conquer approach,   as explained also at   [[wp:Closest pair of points problem#Planar_case|Wikipedia's Closest pair of points problem]],   which is   O(''n'' log ''n'');   a pseudo-code could be: '''closestPair''' of (xP, yP) where xP is P(1) .. P(N) sorted by x coordinate, and @@ -59,9 +58,10 @@ which is O(''n'' log ''n''); a pseudocode could be: '''endif''' -'''References and further readings''' -* [[wp:Closest pair of points problem|Closest pair of points problem]] -* [http://www.cs.mcgill.ca/~cs251/ClosestPair/ClosestPairDQ.html Closest Pair (McGill)] -* [http://www.cs.ucsb.edu/~suri/cs235/ClosestPair.pdf Closest Pair (UCSB)] -* [http://classes.cec.wustl.edu/~cse241/handouts/closestpair.pdf Closest pair (WUStL)] -* [http://www.cs.iupui.edu/~xkzou/teaching/CS580/Divide-and-conquer-closestPair.ppt Closest pair (IUPUI)] +;References and further readings: +*   [[wp:Closest pair of points problem|Closest pair of points problem]] +*   [http://www.cs.mcgill.ca/~cs251/ClosestPair/ClosestPairDQ.html Closest Pair (McGill)] +*   [http://www.cs.ucsb.edu/~suri/cs235/ClosestPair.pdf Closest Pair (UCSB)] +*   [http://classes.cec.wustl.edu/~cse241/handouts/closestpair.pdf Closest pair (WUStL)] +*   [http://www.cs.iupui.edu/~xkzou/teaching/CS580/Divide-and-conquer-closestPair.ppt Closest pair (IUPUI)] +

    diff --git a/Task/Closest-pair-problem/Elixir/closest-pair-problem.elixir b/Task/Closest-pair-problem/Elixir/closest-pair-problem.elixir index c55ab39a89..5f4fb1c840 100644 --- a/Task/Closest-pair-problem/Elixir/closest-pair-problem.elixir +++ b/Task/Closest-pair-problem/Elixir/closest-pair-problem.elixir @@ -1,19 +1,47 @@ defmodule Closest_pair do - def bruteForce([p0,p1|_] = points) do - pnts = List.to_tuple(points) - minDist = distance(p0, p1) - n = tuple_size(pnts) - {minDistance, minPoints} = Enum.reduce(0..n-2, {minDist, [0,1]}, fn i,{mD,mP} -> - Enum.reduce(i+1..n-1, {mD,mP}, fn j,{md,mp} -> - dist = distance(elem(pnts,i), elem(pnts,j)) - if dist < md, do: {dist, [i,j]}, else: {md,mp} - end) - end) - {:math.sqrt(minDistance), minPoints} + # brute-force algorithm: + def bruteForce([p0,p1|_] = points), do: bf_loop(points, {distance(p0, p1), {p0, p1}}) + + defp bf_loop([_], acc), do: acc + defp bf_loop([h|t], acc), do: bf_loop(t, bf_loop(h, t, acc)) + + defp bf_loop(_, [], acc), do: acc + defp bf_loop(p0, [p1|t], {minD, minP}) do + dist = distance(p0, p1) + if dist < minD, do: bf_loop(p0, t, {dist, {p0, p1}}), + else: bf_loop(p0, t, {minD, minP}) end defp distance({p0x,p0y}, {p1x,p1y}) do - (p1x - p0x) * (p1x - p0x) + (p1y - p0y) * (p1y - p0y) + :math.sqrt( (p1x - p0x) * (p1x - p0x) + (p1y - p0y) * (p1y - p0y) ) + end + + # recursive divide&conquer approach: + def recursive(points) do + recursive(Enum.sort(points), Enum.sort_by(points, fn {_x,y} -> y end)) + end + + def recursive(xP, _yP) when length(xP) <= 3, do: bruteForce(xP) + def recursive(xP, yP) do + {xL, xR} = Enum.split(xP, div(length(xP), 2)) + {xm, _} = hd(xR) + {yL, yR} = Enum.partition(yP, fn {x,_} -> x < xm end) + {dL, pairL} = recursive(xL, yL) + {dR, pairR} = recursive(xR, yR) + {dmin, pairMin} = if dL abs(xm - x) < dmin end) + merge(yS, {dmin, pairMin}) + end + + defp merge([_], acc), do: acc + defp merge([h|t], acc), do: merge(t, merge_loop(h, t, acc)) + + defp merge_loop(_, [], acc), do: acc + defp merge_loop(p0, [p1|_], {dmin,_}=acc) when dmin <= elem(p1,1) - elem(p0,1), do: acc + defp merge_loop(p0, [p1|t], {dmin, pair}) do + dist = distance(p0, p1) + if dist < dmin, do: merge_loop(p0, t, {dist, {p0, p1}}), + else: merge_loop(p0, t, {dmin, pair}) end end @@ -22,3 +50,10 @@ data = [{0.654682, 0.925557}, {0.409382, 0.619391}, {0.891663, 0.888594}, {0.716 {0.293786, 0.691701}, {0.839186, 0.728260}] IO.inspect Closest_pair.bruteForce(data) +IO.inspect Closest_pair.recursive(data) + +data2 = for _ <- 1..5000, do: {:rand.uniform, :rand.uniform} +IO.puts "\nBrute-force:" +IO.inspect :timer.tc(fn -> Closest_pair.bruteForce(data2) end) +IO.puts "Recursive divide&conquer:" +IO.inspect :timer.tc(fn -> Closest_pair.recursive(data2) end) diff --git a/Task/Closest-pair-problem/Go/closest-pair-problem-1.go b/Task/Closest-pair-problem/Go/closest-pair-problem-1.go index 14cfe73db3..dac6e64917 100644 --- a/Task/Closest-pair-problem/Go/closest-pair-problem-1.go +++ b/Task/Closest-pair-problem/Go/closest-pair-problem-1.go @@ -4,6 +4,7 @@ import ( "fmt" "math" "math/rand" + "time" ) type xy struct { @@ -11,18 +12,17 @@ type xy struct { } const n = 1000 -const scale = 1. +const scale = 100. func d(p1, p2 xy) float64 { - dx := p2.x - p1.x - dy := p2.y - p1.y - return math.Sqrt(dx*dx + dy*dy) + return math.Hypot(p2.x-p1.x, p2.y-p1.y) } func main() { + rand.Seed(time.Now().Unix()) points := make([]xy, n) for i := range points { - points[i] = xy{rand.Float64(), rand.Float64() * scale} + points[i] = xy{rand.Float64() * scale, rand.Float64() * scale} } p1, p2 := closestPair(points) fmt.Println(p1, p2) diff --git a/Task/Closest-pair-problem/Go/closest-pair-problem-2.go b/Task/Closest-pair-problem/Go/closest-pair-problem-2.go index 3ff526a213..e2adea4c21 100644 --- a/Task/Closest-pair-problem/Go/closest-pair-problem-2.go +++ b/Task/Closest-pair-problem/Go/closest-pair-problem-2.go @@ -6,6 +6,7 @@ import ( "fmt" "math" "math/rand" + "time" ) // number of points to search for closest pair @@ -13,7 +14,7 @@ const n = 1e6 // size of bounding box for points. // x and y will be random with uniform distribution in the range [0,scale). -const scale = 1. +const scale = 100. // point struct type xy struct { @@ -21,17 +22,15 @@ type xy struct { key int64 // an annotation used in the algorithm } -// Euclidian distance func d(p1, p2 xy) float64 { - dx := p2.x - p1.x - dy := p2.y - p1.y - return math.Sqrt(dx*dx + dy*dy) + return math.Hypot(p2.x-p1.x, p2.y-p1.y) } func main() { + rand.Seed(time.Now().Unix()) points := make([]xy, n) for i := range points { - points[i] = xy{rand.Float64(), rand.Float64() * scale, 0} + points[i] = xy{rand.Float64() * scale, rand.Float64() * scale, 0} } p1, p2 := closestPair(points) fmt.Println(p1, p2) @@ -64,14 +63,14 @@ func closestPair(s []xy) (p1, p2 xy) { mx := int64(scale*invB) + 1 // mx is number of cells along a side // construct map as a histogram: // key is index into mesh. value is count of points in cell - hm := make(map[int64]int) + hm := map[int64]int{} for ip, p := range s1 { key := int64(p.x*invB)*mx + int64(p.y*invB) s1[ip].key = key hm[key]++ } // construct s2 = s1 less the points without neighbors - var s2 []xy + s2 := make([]xy, 0, len(s1)) nx := []int64{-mx - 1, -mx, -mx + 1, -1, 0, 1, mx - 1, mx, mx + 1} for i, p := range s1 { nn := 0 @@ -93,7 +92,7 @@ func closestPair(s []xy) (p1, p2 xy) { // step 4: compute answer from approximation invB := 1 / dxi mx := int64(scale*invB) + 1 - hm := make(map[int64][]int) + hm := map[int64][]int{} for i, p := range s { key := int64(p.x*invB)*mx + int64(p.y*invB) s[i].key = key diff --git a/Task/Closest-pair-problem/J/closest-pair-problem-1.j b/Task/Closest-pair-problem/J/closest-pair-problem-1.j index cf1d000445..b053e2d22b 100644 --- a/Task/Closest-pair-problem/J/closest-pair-problem-1.j +++ b/Task/Closest-pair-problem/J/closest-pair-problem-1.j @@ -1,4 +1,4 @@ -vecl =: +/"1&.:*: NB. length of each of vectors +vecl =: +/"1&.:*: NB. length of each vector dist =: <@:vecl@:({: -"1 }:)\ NB. calculate all distances among vectors minpair=: ({~ > {.@($ #: I.@,)@:= <./@;)dist NB. find one pair of the closest points closestpairbf =: (; vecl@:-/)@minpair NB. the pair and their distance diff --git a/Task/Closest-pair-problem/Pascal/closest-pair-problem.pascal b/Task/Closest-pair-problem/Pascal/closest-pair-problem.pascal new file mode 100644 index 0000000000..7883199e5b --- /dev/null +++ b/Task/Closest-pair-problem/Pascal/closest-pair-problem.pascal @@ -0,0 +1,67 @@ +program closestPoints; +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} +const + PointCnt = 10000;//31623; +type + TdblPoint = Record + ptX, + ptY : double; + end; + tPtLst = array of TdblPoint; + + tMinDIstIdx = record + md1, + md2 : NativeInt; + end; + +function ClosPointBruteForce(var ptl :tPtLst):tMinDIstIdx; +Var + i,j,k : NativeInt; + mindst2,dst2: double; //square of distance, no need to sqrt + p0,p1 : ^TdblPoint; //using pointer, since calc of ptl[?] takes much time +Begin + i := Low(ptl); + j := High(ptl); + result.md1 := i;result.md2 := j; + mindst2 := sqr(ptl[i].ptX-ptl[j].ptX)+sqr(ptl[i].ptY-ptl[j].ptY); + repeat + p0 := @ptl[i]; + p1 := p0; inc(p1); + For k := i+1 to j do + Begin + dst2:= sqr(p0^.ptX-p1^.ptX)+sqr(p0^.ptY-p1^.ptY); + IF mindst2 > dst2 then + Begin + mindst2 := dst2; + result.md1 := i; + result.md2 := k; + end; + inc(p1); + end; + inc(i); + until i = j; +end; + +var + PointLst :tPtLst; + cloPt : tMinDIstIdx; + i : NativeInt; +Begin + randomize; + setlength(PointLst,PointCnt); + For i := 0 to PointCnt-1 do + with PointLst[i] do + Begin + ptX := random; + ptY := random; + end; + cloPt:= ClosPointBruteForce(PointLst) ; + i := cloPt.md1; + Writeln('P[',i:4,']= x: ',PointLst[i].ptX:0:8, + ' y: ',PointLst[i].ptY:0:8); + i := cloPt.md2; + Writeln('P[',i:4,']= x: ',PointLst[i].ptX:0:8, + ' y: ',PointLst[i].ptY:0:8); +end. diff --git a/Task/Closest-pair-problem/REXX/closest-pair-problem.rexx b/Task/Closest-pair-problem/REXX/closest-pair-problem.rexx index 913f69f8e1..2436e35517 100644 --- a/Task/Closest-pair-problem/REXX/closest-pair-problem.rexx +++ b/Task/Closest-pair-problem/REXX/closest-pair-problem.rexx @@ -1,33 +1,32 @@ -/*REXX program solves the closest pair of points problem in two dimensions.*/ -parse arg N low high seed . /*obtain optional arguments from the CL*/ -if N=='' | N==',' then N=100 /*Not specified? Then use the default.*/ -if low=='' | low==',' then low=0 /* " " " " " " */ -if high=='' |high==',' then high=20000 /* " " " " " " */ -if datatype(seed,'W') then call random ,,seed /*seed for RANDOM repeatable.*/ +/*REXX program solves the closest pair of points problem (in two dimensions). */ +parse arg N low high seed . /*obtain optional arguments from the CL*/ +if N=='' | N=="," then N= 100 /*Not specified? Then use the default.*/ +if low=='' | low=="," then low= 0 /* " " " " " " */ +if high=='' | high=="," then high=20000 /* " " " " " " */ +if datatype(seed,'W') then call random ,,seed /*seed for RANDOM (BIF) repeatability.*/ w=length(high); w=w + (w//2==0) - /*╔══════════════════════╗*/ do j=1 for N /*generate N random points. */ - /*║ generate N points. ║*/ @x.j=random(low,high) /*a random X. */ - /*╚══════════════════════╝*/ @y.j=random(low,high) /*" " Y. */ - end /*j*/ - A=1; B=2 -minDD=(@x.A-@x.B)**2 + (@y.A-@y.B)**2 /*distance between first two points. */ + /*╔══════════════════════╗*/ do j=1 for N /*generate N random points.*/ + /*║ generate N points. ║*/ @x.j=random(low,high) /* " a random X. */ + /*╚══════════════════════╝*/ @y.j=random(low,high) /* " " " Y. */ + end /*j*/ /*X and Y make the point*/ + A=1; B=2 /* [↓] MINDD is actually the unsquared*/ +minDD=(@x.A-@x.B)**2 + (@y.A-@y.B)**2 /*distance between the first two points*/ + /* [↓] use of XJ & YJ speed things up.*/ + do j=1 for N-1; xj=@x.j; yj=@y.j /*find minimum distance between a ··· */ + do k=j+1 to N /* ··· point and all the other points.*/ + dd=(xj - @x.k)**2 + (yj - @y.k)**2 /*compute squared distance from points.*/ + if dd9; m.j=h; h=h%2+1; end /*j*/ - do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ - numeric digits d; return (g/1)i /*make complex if X < 0.*/ + _= 'For ' N " points, the minimum distance between the two points: " +say _ center("x", w, '═')" " center('y', w, "═") ' is: ' sqrt(abs(minDD))/1 +say left('', length(_)-1) "["right(@x.A, w)',' right(@y.A, w)"]" +say left('', length(_)-1) "["right(@x.B, w)',' right(@y.B, w)"]" +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); m.=9; numeric form; h=d+6 + numeric digits; parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g *.5'e'_ % 2 + do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ + do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ + return g diff --git a/Task/Closest-pair-problem/ZX-Spectrum-Basic/closest-pair-problem.zx b/Task/Closest-pair-problem/ZX-Spectrum-Basic/closest-pair-problem.zx new file mode 100644 index 0000000000..6701cbbea2 --- /dev/null +++ b/Task/Closest-pair-problem/ZX-Spectrum-Basic/closest-pair-problem.zx @@ -0,0 +1,23 @@ +10 DIM x(10): DIM y(10) +20 FOR i=1 TO 10 +30 READ x(i),y(i) +40 NEXT i +50 LET min=1e30 +60 FOR i=1 TO 9 +70 FOR j=i+1 TO 10 +80 LET p1=x(i)-x(j): LET p2=y(i)-y(j): LET dsq=p1*p1+p2*p2 +90 IF dsqi -(you may choose to start i from either 0 or 1), when run, -should return the square of the index, that is, i^2. -Display the result of running any but the last function, -to demonstrate that the function indeed remembers its value. +;Task: +Create a list of ten functions, in the simplest manner possible   (anonymous functions are encouraged),   such that the function at index   '' i ''   (you may choose to start   '' i ''   from either   '''0'''   or   '''1'''),   when run, should return the square of the index,   that is,   '' i '' 2. + +Display the result of running any but the last function, to demonstrate that the function indeed remembers its value. + + +;Goal: +Demonstrate how to create a series of independent closures based on the same template but maintain separate copies of the variable closed over. -'''Goal:''' To demonstrate how to create a series of independent closures based on the same template but maintain separate copies of the variable closed over. In imperative languages, one would generally use a loop with a mutable counter variable. -For each function to maintain the correct number, it has to capture the ''value'' -of the variable at the time it was created, rather than just a reference to the variable, which would have a different value by the time the function was run. + +For each function to maintain the correct number, it has to capture the ''value'' of the variable at the time it was created, rather than just a reference to the variable, which would have a different value by the time the function was run. + +See also: [[Multiple distinct objects]] diff --git a/Task/Closures-Value-capture/AppleScript/closures-value-capture-1.applescript b/Task/Closures-Value-capture/AppleScript/closures-value-capture-1.applescript new file mode 100644 index 0000000000..31a69ece1a --- /dev/null +++ b/Task/Closures-Value-capture/AppleScript/closures-value-capture-1.applescript @@ -0,0 +1,19 @@ +on run + set fns to {} + + repeat with i from 1 to 10 + set end of fns to closure(i) + end repeat + + lambda() of item 3 of fns + +end run + + +on closure(x) + script + on lambda() + return x * x + end lambda + end script +end closure diff --git a/Task/Closures-Value-capture/AppleScript/closures-value-capture-2.applescript b/Task/Closures-Value-capture/AppleScript/closures-value-capture-2.applescript new file mode 100644 index 0000000000..4e30264da9 --- /dev/null +++ b/Task/Closures-Value-capture/AppleScript/closures-value-capture-2.applescript @@ -0,0 +1,42 @@ +on run + + lambda() of (item 3 of (map(closure, range(1, 10)))) + +end run + +on closure(x) + script + on lambda() + return x * x + end lambda + end script +end closure + + + +-- GENERIC FUNCTIONS + +-- map :: (a -> b) -> [a] -> [b] +on map(f, xs) + script mf + property lambda : f + end script + set lng to length of xs + set lst to {} + repeat with i from 1 to lng + set end of lst to mf's lambda(item i of xs, i, xs) + end repeat + return lst +end map + + +-- range :: Int -> Int -> Int +on range(m, n) + set lng to (n - m) + 1 + set base to m - 1 + set lst to {} + repeat with i from 1 to lng + set end of lst to i + base + end repeat + return lst +end range diff --git a/Task/Closures-Value-capture/Clojure/closures-value-capture.clj b/Task/Closures-Value-capture/Clojure/closures-value-capture.clj new file mode 100644 index 0000000000..8fc13097d0 --- /dev/null +++ b/Task/Closures-Value-capture/Clojure/closures-value-capture.clj @@ -0,0 +1,2 @@ +(def funcs (map #(fn [] (* % %)) (range 11))) +(printf "%d\n%d\n" ((nth funcs 3)) ((nth funcs 4))) diff --git a/Task/Closures-Value-capture/Elena/closures-value-capture.elena b/Task/Closures-Value-capture/Elena/closures-value-capture.elena new file mode 100644 index 0000000000..8a5f0ec9b1 --- /dev/null +++ b/Task/Closures-Value-capture/Elena/closures-value-capture.elena @@ -0,0 +1,3 @@ +#var list := Array new &length:10 set &every: (&index:i) [ [ ^ i * i. ] ]. + +console writeLine:(list@3 eval). diff --git a/Task/Closures-Value-capture/Elixir/closures-value-capture.elixir b/Task/Closures-Value-capture/Elixir/closures-value-capture.elixir new file mode 100644 index 0000000000..b75c702c0c --- /dev/null +++ b/Task/Closures-Value-capture/Elixir/closures-value-capture.elixir @@ -0,0 +1,2 @@ +funs = for i <- 0..9, do: (fn -> i*i end) +Enum.each(funs, &IO.puts &1.()) diff --git a/Task/Closures-Value-capture/Forth/closures-value-capture-1.fth b/Task/Closures-Value-capture/Forth/closures-value-capture-1.fth new file mode 100644 index 0000000000..ed273e230f --- /dev/null +++ b/Task/Closures-Value-capture/Forth/closures-value-capture-1.fth @@ -0,0 +1,6 @@ +: xt-array here { a } + 10 cells allot 10 0 do + :noname i ]] literal dup * ; [[ a i cells + ! + loop a ; + +xt-array 5 cells + @ execute . diff --git a/Task/Closures-Value-capture/Forth/closures-value-capture-2.fth b/Task/Closures-Value-capture/Forth/closures-value-capture-2.fth new file mode 100644 index 0000000000..7273c0fa8c --- /dev/null +++ b/Task/Closures-Value-capture/Forth/closures-value-capture-2.fth @@ -0,0 +1 @@ +25 diff --git a/Task/Closures-Value-capture/Io/closures-value-capture.io b/Task/Closures-Value-capture/Io/closures-value-capture.io new file mode 100644 index 0000000000..354075641b --- /dev/null +++ b/Task/Closures-Value-capture/Io/closures-value-capture.io @@ -0,0 +1,2 @@ +blist := list(0,1,2,3,4,5,6,7,8,9) map(i,block(i,block(i*i)) call(i)) +writeln(blist at(3) call) // prints 9 diff --git a/Task/Closures-Value-capture/JavaScript/closures-value-capture-3.js b/Task/Closures-Value-capture/JavaScript/closures-value-capture-3.js new file mode 100644 index 0000000000..804defee18 --- /dev/null +++ b/Task/Closures-Value-capture/JavaScript/closures-value-capture-3.js @@ -0,0 +1,6 @@ +"use strict"; +let funcs = []; +for (let i = 0; i < 10; ++i) { + funcs.push((i => () => i*i)(i)); +} +console.log(funcs[3]()); diff --git a/Task/Closures-Value-capture/JavaScript/closures-value-capture-4.js b/Task/Closures-Value-capture/JavaScript/closures-value-capture-4.js new file mode 100644 index 0000000000..b48c68abe3 --- /dev/null +++ b/Task/Closures-Value-capture/JavaScript/closures-value-capture-4.js @@ -0,0 +1,21 @@ +(function () { + 'use strict'; + + // Int -> Int -> [Int] + function range(m, n) { + return Array.apply(null, Array(n - m + 1)) + .map(function (x, i) { + return m + i; + }); + } + + var lstFns = range(0, 10) + .map(function (i) { + return function () { + return i * i; + }; + }) + + return lstFns[3](); + +})(); diff --git a/Task/Closures-Value-capture/JavaScript/closures-value-capture-5.js b/Task/Closures-Value-capture/JavaScript/closures-value-capture-5.js new file mode 100644 index 0000000000..787b0b56a1 --- /dev/null +++ b/Task/Closures-Value-capture/JavaScript/closures-value-capture-5.js @@ -0,0 +1 @@ +let funcs = [...Array(10).keys()].map(i => () => i*i); diff --git a/Task/Closures-Value-capture/PowerShell/closures-value-capture-1.psh b/Task/Closures-Value-capture/PowerShell/closures-value-capture-1.psh new file mode 100644 index 0000000000..095ed0f14e --- /dev/null +++ b/Task/Closures-Value-capture/PowerShell/closures-value-capture-1.psh @@ -0,0 +1,4 @@ +function Get-Closure ([double]$Number) +{ + {param([double]$Sum) return $script:Number *= $Sum}.GetNewClosure() +} diff --git a/Task/Closures-Value-capture/PowerShell/closures-value-capture-2.psh b/Task/Closures-Value-capture/PowerShell/closures-value-capture-2.psh new file mode 100644 index 0000000000..fff8176f9f --- /dev/null +++ b/Task/Closures-Value-capture/PowerShell/closures-value-capture-2.psh @@ -0,0 +1,9 @@ +for ($i = 1; $i -lt 11; $i++) +{ + $total = Get-Closure -Number $i + + [PSCustomObject]@{ + Function = $i + Sum = & $total -Sum $i + } +} diff --git a/Task/Closures-Value-capture/PowerShell/closures-value-capture-3.psh b/Task/Closures-Value-capture/PowerShell/closures-value-capture-3.psh new file mode 100644 index 0000000000..c2bc3b0d02 --- /dev/null +++ b/Task/Closures-Value-capture/PowerShell/closures-value-capture-3.psh @@ -0,0 +1,11 @@ +$numbers = 1..20 | Get-Random -Count 10 + +foreach ($number in $numbers) +{ + $total = Get-Closure -Number $number + + [PSCustomObject]@{ + Function = $number + Sum = & $total -Sum $number + } +} diff --git a/Task/Closures-Value-capture/REXX/closures-value-capture.rexx b/Task/Closures-Value-capture/REXX/closures-value-capture.rexx index 1c3162e3be..cbcb915db9 100644 --- a/Task/Closures-Value-capture/REXX/closures-value-capture.rexx +++ b/Task/Closures-Value-capture/REXX/closures-value-capture.rexx @@ -1,14 +1,13 @@ -/*REXX pgm has a list of 10 functions, each returns its invocation(idx)²*/ +/*REXX program has a list of ten functions, each returns its invocation (index) squared.*/ - do j=1 for 9 /*invoke random functions 9 times.*/ - interpret 'CALL .'random(0,9) /*invoke a randomly selected func.*/ - end /*j*/ /* [↑] the random func has no args*/ + do j=1 for 9; ?=random(0, 9) /*invoke random functions nine times.*/ + interpret 'CALL .'? /*invoke a randomly selected function. */ + end /*j*/ /* [↑] the called function has no args*/ -say 'The tenth invocation of .0 ───► ' .0() -exit /*stick a fork in it, we're done.*/ -/*─────────────────────────────────list of 10 functions─────────────────*/ -/*[Below is the closest thing to anonymous functions in the REXX lang.] */ - .0:return .(); .1:return .(); .2:return .(); .3:return .(); .4:return .() - .5:return .(); .6:return .(); .7:return .(); .8:return .(); .9:return .() -/*─────────────────────────────────. function───────────────────────────*/ -.: if symbol('@')=='LIT' then @=0 /*handle 1st invoke*/; @=@+1; return @*@ +say 'The tenth invocation of .0 ───► ' .0() +exit /*stick a fork in it, we're all done. */ +/*───────────────────────────[Below is the closest thing to anonymous functions in REXX]*/ +.0: return .(); .1: return .(); .2: return .(); .3: return .(); .4: return .() +.5: return .(); .6: return .(); .7: return .(); .8: return .(); .9: return .() +/*──────────────────────────────────────────────────────────────────────────────────────*/ +.: if symbol('@')=="LIT" then @=0 /* ◄───handle very 1st invoke*/; @=@+1; return @*@ diff --git a/Task/Closures-Value-capture/Ruby/closures-value-capture.rb b/Task/Closures-Value-capture/Ruby/closures-value-capture.rb new file mode 100644 index 0000000000..93df231cea --- /dev/null +++ b/Task/Closures-Value-capture/Ruby/closures-value-capture.rb @@ -0,0 +1,2 @@ +procs = Array.new(10){|i| ->{i*i} } # -> creates a lambda +p procs[7].call # => 49 diff --git a/Task/Collections/00DESCRIPTION b/Task/Collections/00DESCRIPTION index e7b4598947..eebef7bff5 100644 --- a/Task/Collections/00DESCRIPTION +++ b/Task/Collections/00DESCRIPTION @@ -1,7 +1,13 @@ {{clarified-review}} + Collections are abstractions to represent sets of values. + In statically-typed languages, the values are typically of a common data type. + +;Task: Create a collection, and add a few values to it. + {{Template:See also lists}} +

    diff --git a/Task/Collections/ALGOL-68/collections.alg b/Task/Collections/ALGOL-68/collections.alg new file mode 100644 index 0000000000..0aa3dc0529 --- /dev/null +++ b/Task/Collections/ALGOL-68/collections.alg @@ -0,0 +1,21 @@ +# create a constant array of integers and set its values # +[]INT constant array = ( 1, 2, 3, 4 ); +# create an array of integers that can be changed, note the size mst be specified # +# this array has the default lower bound of 1 # +[ 5 ]INT mutable array := ( 9, 8, 7, 6, 5 ); +# modify the second element of the mutable array # +mutable array[ 2 ] := -1; +# array sizes are normally fixed when the array is created, however arrays can be # +# declared to be FLEXible, allowing their sizes to change by assigning a new array to them # +# The standard built-in STRING is notionally defined as FLEX[ 1 : 0 ]CHAR in the standard prelude # +# Create a string variable: # +STRING str := "abc"; +# assign a longer value to it # +str := "bbc/itv"; +# add a few characters to str, +=: adds the text to the beginning, +:= adds it to the end # +"[" +=: str; str +:= "]"; # str now contains "[bbc/itv]" # +# Arrays of any type can be FLEXible: # +# create an array of two integers # +FLEX[ 1 : 2 ]INT fa := ( 0, 0 ); +# replace it with a new array of 5 elements # +fa := LOC[ -2 : 2 ]INT; diff --git a/Task/Collections/COBOL/collections.cobol b/Task/Collections/COBOL/collections.cobol new file mode 100644 index 0000000000..615f28cf73 --- /dev/null +++ b/Task/Collections/COBOL/collections.cobol @@ -0,0 +1,37 @@ + identification division. + program-id. collections. + + data division. + working-storage section. + 01 sample-table. + 05 sample-record occurs 1 to 3 times depending on the-index. + 10 sample-alpha pic x(4). + 10 filler pic x value ":". + 10 sample-number pic 9(4). + 10 filler pic x value space. + 77 the-index usage index. + + procedure division. + collections-main. + + set the-index to 3 + move 1234 to sample-number(1) + move "abcd" to sample-alpha(1) + + move "test" to sample-alpha(2) + + move 6789 to sample-number(3) + move "wxyz" to sample-alpha(3) + + display "sample-table : " sample-table + display "sample-number(1): " sample-number(1) + display "sample-record(2): " sample-record(2) + display "sample-number(3): " sample-number(3) + + *> abend: out of bounds subscript, -debug turns on bounds check + set the-index down by 1 + display "sample-table : " sample-table + display "sample-number(3): " sample-number(3) + + goback. + end program collections. diff --git a/Task/Collections/Elena/collections-1.elena b/Task/Collections/Elena/collections-1.elena new file mode 100644 index 0000000000..5fc0e307a6 --- /dev/null +++ b/Task/Collections/Elena/collections-1.elena @@ -0,0 +1,5 @@ +// Creates and initializes a new Array +#var intArray := (1, 2, 3, 4, 5). + +#var stringArr := Array new:5. +stringArr@0 := "string". diff --git a/Task/Collections/Elena/collections-2.elena b/Task/Collections/Elena/collections-2.elena new file mode 100644 index 0000000000..a661e7e3e2 --- /dev/null +++ b/Task/Collections/Elena/collections-2.elena @@ -0,0 +1,5 @@ +//Create and initialize ArrayList +#var myAl := ArrayList new += "Hello" += "World" += "!". + +//Create and initialize List +#var myList := List new += "Hello" += "World" += "!". diff --git a/Task/Collections/Elena/collections-3.elena b/Task/Collections/Elena/collections-3.elena new file mode 100644 index 0000000000..26e226b7c8 --- /dev/null +++ b/Task/Collections/Elena/collections-3.elena @@ -0,0 +1,4 @@ +//Create a dictionary +#var dict := Dictionary new. +dict@"Hello" := "World". +dict@"Key" := "Value". diff --git a/Task/Collections/Elixir/collections-4.elixir b/Task/Collections/Elixir/collections-4.elixir index ff044d52eb..a8329ad110 100644 --- a/Task/Collections/Elixir/collections-4.elixir +++ b/Task/Collections/Elixir/collections-4.elixir @@ -1,7 +1,15 @@ -empty_map = Map.new #=> %{} -map = %{:a => 1, 2 => :b} #=> %{2 => :b, :a => 1} -map[:a] #=> 1 -map[2] #=> :b +empty_map = Map.new #=> %{} +kwlist = [x: 1, y: 2] # Key Word List +Map.new(kwlist) #=> %{x: 1, y: 2} +Map.new([{1,"A"}, {2,"B"}]) #=> %{1 => "A", 2 => "B"} +map = %{:a => 1, 2 => :b} #=> %{2 => :b, :a => 1} +map[:a] #=> 1 +map[2] #=> :b # If you pass duplicate keys when creating a map, the last one wins: -%{1 => 1, 1 => 2} #=> %{1 => 2} +%{1 => 1, 1 => 2} #=> %{1 => 2} + +# When all the keys in a map are atoms, you can use the keyword syntax for convenience: +map = %{:a => 1, :b => 2} #=> %{a: 1, b: 2} +map.a #=> 1 +%{map | :a => 2} #=> %{a: 2, b: 2} update only diff --git a/Task/Collections/Elixir/collections-5.elixir b/Task/Collections/Elixir/collections-5.elixir index 896698a49f..37609e5670 100644 --- a/Task/Collections/Elixir/collections-5.elixir +++ b/Task/Collections/Elixir/collections-5.elixir @@ -1,3 +1,10 @@ -map = %{:a => 1, :b => 2} #=> %{a: 1, b: 2} -map.a #=> 1 -%{map | :a => 2} #=> %{a: 2, b: 2} +empty_set = MapSet.new #=> #MapSet<[]> +set1 = MapSet.new(1..4) #=> #MapSet<[1, 2, 3, 4]> +MapSet.size(set1) #=> 4 +MapSet.member?(set1,3) #=> true +MapSet.put(set1,9) #=> #MapSet<[1, 2, 3, 4, 9]> +set2 = MapSet.new([6,4,2,0]) #=> #MapSet<[0, 2, 4, 6]> +MapSet.union(set1,set2) #=> #MapSet<[0, 1, 2, 3, 4, 6]> +MapSet.intersection(set1,set2) #=> #MapSet<[2, 4]> +MapSet.difference(set1,set2) #=> #MapSet<[1, 3]> +MapSet.subset?(set1,set2) #=> false diff --git a/Task/Collections/Elixir/collections-6.elixir b/Task/Collections/Elixir/collections-6.elixir index 9ec5765d87..2a1fb129ab 100644 --- a/Task/Collections/Elixir/collections-6.elixir +++ b/Task/Collections/Elixir/collections-6.elixir @@ -1,10 +1,9 @@ -empty_set = HashSet.new #=> #HashSet<[]> -set1 = Enum.into(1..4,HashSet.new) #=> #HashSet<[2, 3, 4, 1]> -Set.size(set1) #=> 4 -Set.member?(set1,3) #=> true -Set.put(set1,9) #=> #HashSet<[2, 3, 4, 1, 9]> -set2 = Enum.into([0,2,4,6],HashSet.new) #=> #HashSet<[0, 2, 6, 4]> -Set.union(set1,set2) #=> #HashSet<[0, 2, 6, 4, 3, 1]> -Set.intersection(set1,set2) #=> #HashSet<[2, 4]> -Set.difference(set1,set2) #=> #HashSet<[3, 1]> -Set.subset?(set1,set2) #=> false +defmodule User do + defstruct name: "john", age: 27 +end +john = %User{} #=> %User{age: 27, name: "john"} +john.name #=> "john" +%User{age: age} = john # pattern matching +age #=> 27 +meg = %User{name: "meg"} #=> %User{age: 27, name: "meg"} +is_map(meg) #=> true diff --git a/Task/Collections/Rust/collections-1.rust b/Task/Collections/Rust/collections-1.rust new file mode 100644 index 0000000000..5cef276908 --- /dev/null +++ b/Task/Collections/Rust/collections-1.rust @@ -0,0 +1,2 @@ +let a = [1u8,2,3,4,5]; // a is of type [u8; 5]; +let b = [0;256] // Equivalent to `let b = [0,0,0,0,0,0... repeat 256 times]` diff --git a/Task/Collections/Rust/collections-2.rust b/Task/Collections/Rust/collections-2.rust new file mode 100644 index 0000000000..a777380c7b --- /dev/null +++ b/Task/Collections/Rust/collections-2.rust @@ -0,0 +1,3 @@ +let array = [1,2,3,4,5]; +let slice = &array[0..2] +println!("{:?}", slice); diff --git a/Task/Collections/Rust/collections-3.rust b/Task/Collections/Rust/collections-3.rust new file mode 100644 index 0000000000..77844a5f1a --- /dev/null +++ b/Task/Collections/Rust/collections-3.rust @@ -0,0 +1,6 @@ +let mut v = Vec::new(); +v.push(1); +v.push(2); +v.push(3); +// Or (mostly) equivalently via a convenient macro in the standard library +let v = vec![1,2,3]; diff --git a/Task/Collections/Rust/collections-4.rust b/Task/Collections/Rust/collections-4.rust new file mode 100644 index 0000000000..33de818351 --- /dev/null +++ b/Task/Collections/Rust/collections-4.rust @@ -0,0 +1,4 @@ +let x = "abc"; // x is of type &str (a borrowed string slice) +let s = String::from(x); +// or alternatively +let s = x.to_owned(); diff --git a/Task/Color-of-a-screen-pixel/AutoIt/color-of-a-screen-pixel.autoit b/Task/Color-of-a-screen-pixel/AutoIt/color-of-a-screen-pixel.autoit index 3f1b1556ff..d28797d7f8 100644 --- a/Task/Color-of-a-screen-pixel/AutoIt/color-of-a-screen-pixel.autoit +++ b/Task/Color-of-a-screen-pixel/AutoIt/color-of-a-screen-pixel.autoit @@ -1,2 +1,5 @@ -$a = Mousegetpos() -PixelGetColor($a[0], $a[1]) +Opt('MouseCoordMode',1) ; 1 = (default) absolute screen coordinates +$pos = MouseGetPos() +$c = PixelGetColor($pos[0], $pos[1]) +ConsoleWrite("Color at x=" & $pos[0] & ",y=" & $pos[1] & _ + " ==> " & $c & " = 0x" & Hex($c) & @CRLF) diff --git a/Task/Color-quantization/Go/color-quantization.go b/Task/Color-quantization/Go/color-quantization.go index 3bae71c1b8..ffdf647cb0 100644 --- a/Task/Color-quantization/Go/color-quantization.go +++ b/Task/Color-quantization/Go/color-quantization.go @@ -17,16 +17,16 @@ func main() { log.Fatal(err) } img, err := png.Decode(f) - f.Close() + if ec := f.Close(); err != nil { + log.Fatal(err) + } else if ec != nil { + log.Fatal(ec) + } + fq, err := os.Create("frog16.png") if err != nil { log.Fatal(err) } - fq, err := os.Create("frog256.png") - if err != nil { - log.Fatal(err) - } - err = png.Encode(fq, quant(img, 256)) - if err != nil { + if err = png.Encode(fq, quant(img, 16)); err != nil { log.Fatal(err) } } diff --git a/Task/Colour-bars-Display/00DESCRIPTION b/Task/Colour-bars-Display/00DESCRIPTION index 55cd61d5ab..977ceeea34 100644 --- a/Task/Colour-bars-Display/00DESCRIPTION +++ b/Task/Colour-bars-Display/00DESCRIPTION @@ -1 +1,14 @@ -The task is to display a series of vertical color bars across the width of the display. The color bars should either use the system palette, or the sequence of colors: Black, Red, Green, Blue, Magenta, Cyan, Yellow, White. +;Task: +Display a series of vertical color bars across the width of the display. + +The color bars should either use: +:::*   the system palette,   or +:::*   the sequence of colors: +::::::*   black +::::::*   red +::::::*   green +::::::*   magenta +::::::*   cyan +::::::*   yellow +::::::*   white +
    diff --git a/Task/Colour-bars-Display/Haskell/colour-bars-display-1.hs b/Task/Colour-bars-Display/Haskell/colour-bars-display-1.hs new file mode 100644 index 0000000000..3e60d07ce1 --- /dev/null +++ b/Task/Colour-bars-Display/Haskell/colour-bars-display-1.hs @@ -0,0 +1,38 @@ +#!/usr/bin/env stack +-- stack --resolver lts-7.0 --install-ghc runghc --package vty -- -threaded + +import Graphics.Vty + +colorBars :: Int -> [(Int, Attr)] -> Image +colorBars h bars = horizCat $ map colorBar bars + where colorBar (w, attr) = charFill attr ' ' w h + +barWidths :: Int -> Int -> [Int] +barWidths nBars totalWidth = map barWidth [0..nBars-1] + where fracWidth = fromIntegral totalWidth / fromIntegral nBars + barWidth n = + let n' = fromIntegral n :: Double + in floor ((n' + 1) * fracWidth) - floor (n' * fracWidth) + +barImage :: Int -> Int -> Image +barImage w h = colorBars h $ zip (barWidths nBars w) attrs + where attrs = map color2attr colors + nBars = length colors + colors = [black, brightRed, brightGreen, brightMagenta, brightCyan, brightYellow, brightWhite] + color2attr c = Attr Default Default (SetTo c) + +main = do + cfg <- standardIOConfig + vty <- mkVty cfg + let output = outputIface vty + bounds <- displayBounds output + let showBars (w,h) = do + let img = barImage w h + pic = picForImage img + update vty pic + e <- nextEvent vty + case e of + EvResize w' h' -> showBars (w',h') + _ -> return () + showBars bounds + shutdown vty diff --git a/Task/Colour-bars-Display/Haskell/colour-bars-display-2.hs b/Task/Colour-bars-Display/Haskell/colour-bars-display-2.hs new file mode 100644 index 0000000000..8430630f72 --- /dev/null +++ b/Task/Colour-bars-Display/Haskell/colour-bars-display-2.hs @@ -0,0 +1,51 @@ +-- Before you can install the SFML Haskell library, you need to install +-- the CSFML C library. (For example, "brew install csfml" on OS X.) + +-- This program runs in fullscreen mode. +-- Press any key or mouse button to exit. + +import Control.Exception +import SFML.Graphics +import SFML.SFResource +import SFML.Window hiding (width, height) + +withResource :: SFResource a => IO a -> (a -> IO b) -> IO b +withResource acquire = bracket acquire destroy + +withResources :: SFResource a => IO [a] -> ([a] -> IO b) -> IO b +withResources acquire = bracket acquire (mapM_ destroy) + +colors :: [Color] +colors = [black, red, green, magenta, cyan, yellow, white] + +makeBar :: (Float, Float) -> (Color, Int) -> IO RectangleShape +makeBar (barWidth, height) (c, i) = do + bar <- err $ createRectangleShape + setPosition bar $ Vec2f (fromIntegral i * barWidth) 0 + setSize bar $ Vec2f barWidth height + setFillColor bar c + return bar + +barSize :: VideoMode -> (Float, Float) +barSize (VideoMode w h _ ) = ( fromIntegral w / fromIntegral (length colors) + , fromIntegral h ) + +loop :: RenderWindow -> [RectangleShape] -> IO () +loop wnd bars = do + mapM_ (\x -> drawRectangle wnd x Nothing) bars + display wnd + evt <- waitEvent wnd + case evt of + Nothing -> return () + Just SFEvtClosed -> return () + Just (SFEvtKeyPressed {}) -> return () + Just (SFEvtMouseButtonPressed {}) -> return () + _ -> loop wnd bars + +main :: IO () +main = do + vMode <- getDesktopMode + let wStyle = [SFFullscreen] + withResource (createRenderWindow vMode "color bars" wStyle Nothing) $ + \wnd -> withResources (mapM (makeBar $ barSize vMode) $ zip colors [0..]) $ + \bars -> loop wnd bars diff --git a/Task/Colour-bars-Display/PowerShell/colour-bars-display.psh b/Task/Colour-bars-Display/PowerShell/colour-bars-display.psh new file mode 100644 index 0000000000..31d46ef570 --- /dev/null +++ b/Task/Colour-bars-Display/PowerShell/colour-bars-display.psh @@ -0,0 +1,14 @@ +[string[]]$colors = "Black" , "DarkBlue" , "DarkGreen" , "DarkCyan", + "DarkRed" , "DarkMagenta", "DarkYellow", "Gray", + "DarkGray", "Blue" , "Green" , "Cyan", + "Red" , "Magenta" , "Yellow" , "White" + +for ($i = 0; $i -lt 64; $i++) +{ + for ($j = 0; $j -lt $colors.Count; $j++) + { + Write-Host (" " * 12) -BackgroundColor $colors[$j] -NoNewline + } + + Write-Host +} diff --git a/Task/Colour-bars-Display/REXX/colour-bars-display.rexx b/Task/Colour-bars-Display/REXX/colour-bars-display.rexx index 270ccbb31c..d07a327994 100644 --- a/Task/Colour-bars-Display/REXX/colour-bars-display.rexx +++ b/Task/Colour-bars-Display/REXX/colour-bars-display.rexx @@ -1,26 +1,26 @@ -/*REXX program displays eight colored vertical bars on the full screen. */ -parse value scrsize() with sd sw . /*screen depth,width.*/ -barWidth=sw%8 /*calculate bar width*/ -_.=copies('db'x,barWidth) /*the bar, full width*/ -_.8=left(_.,barWidth-1) /*last bar width. */ - $ = x2c('1b5b73') || x2c('1b5b313b33376d') /* preamble, header. */ -hdr.1 = x2c('1b5b303b33306d') /* the color black. */ -hdr.2 = x2c('1b5b313b33316d') /* the color red. */ -hdr.3 = x2c('1b5b313b33326d') /* the color green. */ -hdr.4 = x2c('1b5b313b33346d') /* the color blue. */ -hdr.5 = x2c('1b5b313b33356d') /* the color magenta.*/ -hdr.6 = x2c('1b5b313b33366d') /* the color cyan. */ -hdr.7 = x2c('1b5b313b33336d') /* the color yellow. */ -hdr.8 = x2c('1b5b313b33376d') /* the color white. */ - tail = x2c('1b5b751b5b303b313b33363b34303b306d') /* epilogue, trailer.*/ - /* [↓] last bar width is shrunk.*/ - do j=1 for 8 /*build the line, color by color.*/ - $=$ || hdr.j || _.j /*append the color header + bar. */ - end /*j*/ /* [↑] color order is the list. */ - /* [↓] the tail is overkill. */ -$=$ || tail /*append the epilogue (trailer). */ - /* [↓] show full screen of bars.*/ - do k=1 for sd /*SD = screen depth (from above).*/ - say $ /*have REXX display line of bars.*/ - end /*k*/ /* [↑] Note: SD could be zero.*/ - /*stick a fork in it, we're done.*/ +/*REXX program displays eight colored vertical bars on a full screen. */ +parse value scrsize() with sd sw . /*the screen depth and width. */ +barWidth=sw%8 /*calculate the bar width. */ +_.=copies('db'x, barWidth) /*the bar, full width. */ +_.8=left(_.,barWidth-1) /*the last bar width, less one. */ + $ = x2c('1b5b73') || x2c("1b5b313b33376d") /* the preamble, and the header. */ +hdr.1 = x2c('1b5b303b33306d') /* " color black. */ +hdr.2 = x2c('1b5b313b33316d') /* " color red. */ +hdr.3 = x2c('1b5b313b33326d') /* " color green. */ +hdr.4 = x2c('1b5b313b33346d') /* " color blue. */ +hdr.5 = x2c('1b5b313b33356d') /* " color magenta. */ +hdr.6 = x2c('1b5b313b33366d') /* " color cyan. */ +hdr.7 = x2c('1b5b313b33336d') /* " color yellow. */ +hdr.8 = x2c('1b5b313b33376d') /* " color white. */ + tail = x2c('1b5b751b5b303b313b33363b34303b306d') /* " epilogue, and the trailer.*/ + /* [↓] last bar width is shrunk. */ + do j=1 for 8 /*build the line, color by color. */ + $=$ || hdr.j || _.j /*append the color header + bar. */ + end /*j*/ /* [↑] color order is the list. */ + /* [↓] the tail is overkill. */ +$=$ || tail /*append the epilogue (trailer). */ + /* [↓] show full screen of bars. */ + do k=1 for sd /*SD = screen depth (from above). */ + say $ /*have REXX display line of bars. */ + end /*k*/ /* [↑] Note: SD could be zero. */ + /*stick a fork in it, we're done. */ diff --git a/Task/Colour-pinstripe-Display/Perl-6/colour-pinstripe-display.pl6 b/Task/Colour-pinstripe-Display/Perl-6/colour-pinstripe-display.pl6 index 9fbbdeee14..c0977ccada 100644 --- a/Task/Colour-pinstripe-Display/Perl-6/colour-pinstripe-display.pl6 +++ b/Task/Colour-pinstripe-Display/Perl-6/colour-pinstripe-display.pl6 @@ -14,7 +14,7 @@ my @colors = map -> $r, $g, $b { [$r, $g, $b] }, my $PPM = open "pinstripes.ppm", :w, :bin or die "Can't create pinstripes.ppm: $!"; $PPM.print: qq:to/EOH/; - P6 + P3 # pinstripes.ppm $HOR $VERT 255 @@ -23,8 +23,8 @@ $PPM.print: qq:to/EOH/; my $vzones = $VERT div 4; for 1..4 -> $w { my $hzones = ceiling $HOR / $w / +@colors; - my $line = Buf.new: ((@colors Xxx $w) xx $hzones).splice(0,$HOR).map: *.values; - $PPM.write: $line for ^$vzones; + my $line = [((@colors Xxx $w) xx $hzones).flatmap: *.values].splice(0,$HOR); + $PPM.put: $line for ^$vzones; } $PPM.close; diff --git a/Task/Combinations-and-permutations/00DESCRIPTION b/Task/Combinations-and-permutations/00DESCRIPTION index 52c100beb5..259e9de9b6 100644 --- a/Task/Combinations-and-permutations/00DESCRIPTION +++ b/Task/Combinations-and-permutations/00DESCRIPTION @@ -1,15 +1,25 @@ -{{wikipedia|Combination}} {{wikipedia|Permutation}} +{{wikipedia|Combination}} + +{{wikipedia|Permutation}} + ;Task: -Implement the [[wp:Combination|combination]] (nCk) and [[wp:Permutation|permutation]] (nPk) operators in the target language: -* ^n\operatorname C_k =\binom nk = \frac{n(n-1)\ldots(n-k+1)}{k(k-1)\dots1} -* ^n\operatorname P_k = n\cdot(n-1)\cdot(n-2)\cdots(n-k+1) -See the wikipedia articles for a more detailed description. +Implement the [[wp:Combination|combination]]   (nCk)   and [[wp:Permutation|permutation]]   (nPk)   operators in the target language: + +:::* ^n\operatorname C_k =\binom nk = \frac{n(n-1)\ldots(n-k+1)}{k(k-1)\dots1} + +:::* ^n\operatorname P_k = n\cdot(n-1)\cdot(n-2)\cdots(n-k+1) + +
    +See the Wikipedia articles for a more detailed description. '''To test''', generate and print examples of: -* A sample of permutations from 1 to 12 and Combinations from 10 to 60 using exact Integer arithmetic. -* A sample of permutations from 5 to 15000 and Combinations from 100 to 1000 using approximate Floating point arithmetic.
    This 'floating point' code could be implemented using an approximation, e.g., by calling the [[Gamma function]]. +*   A sample of permutations from 1 to 12 and Combinations from 10 to 60 using exact Integer arithmetic. +*   A sample of permutations from 5 to 15000 and Combinations from 100 to 1000 using approximate Floating point arithmetic.
    This 'floating point' code could be implemented using an approximation, e.g., by calling the [[Gamma function]]. + + +;Related task: +*   [[Evaluate binomial coefficients]] -'''See Also:''' -* [[Evaluate binomial coefficients]] {{Template:Combinations and permutations}} +

    diff --git a/Task/Combinations-and-permutations/Common-Lisp/combinations-and-permutations.lisp b/Task/Combinations-and-permutations/Common-Lisp/combinations-and-permutations.lisp new file mode 100644 index 0000000000..acbc81c7af --- /dev/null +++ b/Task/Combinations-and-permutations/Common-Lisp/combinations-and-permutations.lisp @@ -0,0 +1,11 @@ +(defun combinations (n k) + (let ((num 1) + (den 1) ) + (dotimes (i k (/ num den)) + (setq num (* num (- n i)) den (* den (- k i))) ))) + + +(defun permutations (n k) + (let ((p 1)) + (dotimes (i k p) + (setq p (* p (- n i))) ))) diff --git a/Task/Combinations-and-permutations/Elixir/combinations-and-permutations.elixir b/Task/Combinations-and-permutations/Elixir/combinations-and-permutations.elixir new file mode 100644 index 0000000000..2f94958399 --- /dev/null +++ b/Task/Combinations-and-permutations/Elixir/combinations-and-permutations.elixir @@ -0,0 +1,38 @@ +defmodule Combinations_permutations do + def perm(n, k), do: product(n - k + 1 .. n) + + def comb(n, k), do: div( perm(n, k), product(1 .. k) ) + + defp product(a..b) when a>b, do: 1 + defp product(list), do: Enum.reduce(list, 1, fn n, acc -> n * acc end) + + def test do + IO.puts "\nA sample of permutations from 1 to 12:" + Enum.each(1..12, &show_perm(&1, div(&1, 3))) + IO.puts "\nA sample of combinations from 10 to 60:" + Enum.take_every(10..60, 10) |> Enum.each(&show_comb(&1, div(&1, 3))) + IO.puts "\nA sample of permutations from 5 to 15000:" + Enum.each([5,50,500,1000,5000,15000], &show_perm(&1, div(&1, 3))) + IO.puts "\nA sample of combinations from 100 to 1000:" + Enum.take_every(100..1000, 100) |> Enum.each(&show_comb(&1, div(&1, 3))) + end + + defp show_perm(n, k), do: show_gen(n, k, "perm", &perm/2) + + defp show_comb(n, k), do: show_gen(n, k, "comb", &comb/2) + + defp show_gen(n, k, strfun, fun), do: + IO.puts "#{strfun}(#{n}, #{k}) = #{show_big(fun.(n, k), 40)}" + + defp show_big(n, limit) do + strn = to_string(n) + if String.length(strn) < limit do + strn + else + {shown, hidden} = String.split_at(strn, limit) + "#{shown}... (#{String.length(hidden)} more digits)" + end + end +end + +Combinations_permutations.test diff --git a/Task/Combinations-and-permutations/PARI-GP/combinations-and-permutations.pari b/Task/Combinations-and-permutations/PARI-GP/combinations-and-permutations.pari new file mode 100644 index 0000000000..f1ecf6c776 --- /dev/null +++ b/Task/Combinations-and-permutations/PARI-GP/combinations-and-permutations.pari @@ -0,0 +1,10 @@ +sample(f,a,b)=for(i=1,4, my(n1=random(b-a)+a,n2=random(b-a)+a); [n1,n2]=[max(n1,n2),min(n1,n2)]; print(n1", "n2": "f(n1,n2))) +permExact(m,n)=factorback([m-n+1..m]); +combExact=binomial; +permApprox(m,n)=exp(lngamma(m+1)-lngamma(m-n+1)); +combApprox(m,n)=exp(lngamma(m+1)-lngamma(n+1)-lngamma(m-n+1)); + +sample(permExact, 1, 12); +sample(combExact, 10, 60); +sample(permApprox, 5, 15000); +sample(combApprox, 100, 1000); diff --git a/Task/Combinations-and-permutations/REXX/combinations-and-permutations.rexx b/Task/Combinations-and-permutations/REXX/combinations-and-permutations.rexx index 6a76dc4bcd..5653f435de 100644 --- a/Task/Combinations-and-permutations/REXX/combinations-and-permutations.rexx +++ b/Task/Combinations-and-permutations/REXX/combinations-and-permutations.rexx @@ -1,44 +1,44 @@ -/*REXX program to compute and show a sampling of combinations and permutations*/ -numeric digits 100 /*use 100 decimal digits of precision. */ +/*REXX program compute and displays a sampling of combinations and permutations. */ +numeric digits 100 /*use 100 decimal digits of precision. */ - do j=1 for 12 /*show all permutations from 1 ──► 12.*/ - _=; do k=1 for j /*step through all J permutations. */ - _=_ 'P('j","k')='perm(j,k)" " /*add an extra blank between numbers. */ - end /*k*/ - say strip(_) /*show the permutations horizontally. */ - end /*j*/ -say - do j=10 to 60 by 10 /*show some combinations 10 ──► 60. */ - _=; do k= 1 to j by j%5 /*step through some combinations. */ - _=_ 'C('j","k')='comb(j,k)" " /*add an extra blank between numbers. */ - end /*k*/ - say strip(_) /*show the combinations horizontally. */ - end /*j*/ -say -numeric digits 20 /*force floating point for big numbers.*/ + do j=1 for 12; _= /*show all permutations from 1 ──► 12.*/ + do k=1 for j /*step through all J permutations. */ + _=_ 'P('j","k')='perm(j,k)" " /*add an extra blank between numbers. */ + end /*k*/ + say strip(_) /*show the permutations horizontally. */ + end /*j*/ +say /*display a blank line for readability.*/ + do j=10 to 60 by 10; _= /*show some combinations 10 ──► 60. */ + do k= 1 to j by j%5 /*step through some combinations. */ + _=_ 'C('j","k')='comb(j,k)" " /*add an extra blank between numbers. */ + end /*k*/ + say strip(_) /*show the combinations horizontally. */ + end /*j*/ +say /*display a blank line for readability.*/ +numeric digits 20 /*force floating point for big numbers.*/ - do j=5 to 15000 by 1000 /*show a few permutations, big numbers.*/ - _=; do k=1 to j for 5 by j%10 /*step through some J permutations. */ - _=_ 'P('j","k')='perm(j,k)" " /*add an extra blank between numbers. */ - end /*k*/ - say strip(_) /*show the permutations horizontally. */ - end /*j*/ -say - do j=100 to 1000 by 100 /*show a few combinations, big numbers.*/ - _=; do k= 1 to j by j%5 /*step through some combinations. */ - _=_ 'C('j","k')='comb(j,k)" " /*add an extra blank between numbers. */ - end /*k*/ - say strip(_) /*show the combinations horizontally. */ - end /*j*/ -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────one─liner subroutines─────────────────────*/ -perm: procedure; parse arg x,y; call .combPerm; return _ -.combPerm: _=1; do j=x-y+1 to x; _=_*j; end; return _ -!: procedure; parse arg x; !=1; do j=2 to x; !=!*j; end; return ! -/*────────────────────────────────────────────────────────────────────────────*/ -comb: procedure; parse arg x,y /*arguments: X things, Y at-a-time.*/ -if y>x then return 0 /*oops-say, too big a chunk. */ -if x=y then return 1 /*X things are the same as chunk size.*/ -if x-yx then return 0 /*oops-say, an error, too big a chunk.*/ + if x =y then return 1 /*X things are the same as chunk size.*/ + if x-y 7.602322407770517e+58 p 15000.big_permutation(73) #=> 6.004137561717704e+304 #That's about the maximum of Float: p 15000.big_permutation(74) #=> Infinity -# Integer has no maximum: +#Fixnum has no maximum: p 15000.permutation(74) #=> 896237613852967826239917238565433149353074416025197784301593335243699358040738127950872384197159884905490054194835376498534786047382445592358843238688903318467070575184552953997615178973027752714539513893159815472948987921587671399790410958903188816684444202526779550201576117111844818124800000000000000000000 diff --git a/Task/Combinations-and-permutations/Ruby/combinations-and-permutations-2.rb b/Task/Combinations-and-permutations/Ruby/combinations-and-permutations-2.rb new file mode 100644 index 0000000000..2c6eeffb1f --- /dev/null +++ b/Task/Combinations-and-permutations/Ruby/combinations-and-permutations-2.rb @@ -0,0 +1 @@ +(1..60).to_a.combination(53).size #=> 386206920 diff --git a/Task/Combinations-with-repetitions/00DESCRIPTION b/Task/Combinations-with-repetitions/00DESCRIPTION index a8c9e97660..50b5d76f55 100644 --- a/Task/Combinations-with-repetitions/00DESCRIPTION +++ b/Task/Combinations-with-repetitions/00DESCRIPTION @@ -8,12 +8,16 @@ For example: Note that both the order of items within a pair, and the order of the pairs given in the answer is not significant; the pairs represent multisets.
    Also note that ''doughnut'' can also be spelled ''donut''. -'''Task description''' + +;Task: * Write a function/program/routine/.. to generate all the combinations with repetitions of n types of things taken k at a time and use it to ''show'' an answer to the doughnut example above. * For extra credit, use the function to compute and show ''just the number of ways'' of choosing three doughnuts from a choice of ten types of doughnut. Do not show the individual choices for this part. -'''References:''' + +;References: * [[wp:Combination|k-combination with repetitions]] -'''See Also:''' + +;See also: {{Template:Combinations and permutations}} +

    diff --git a/Task/Combinations-with-repetitions/J/combinations-with-repetitions-2.j b/Task/Combinations-with-repetitions/J/combinations-with-repetitions-2.j index 09a41720f0..2693284afd 100644 --- a/Task/Combinations-with-repetitions/J/combinations-with-repetitions-2.j +++ b/Task/Combinations-with-repetitions/J/combinations-with-repetitions-2.j @@ -12,5 +12,5 @@ ├─────┼─────┤ │plain│plain│ └─────┴─────┘ - #3 rcomb i.10 NB. ways to choose 3 items from 10 with repetitions + #3 rcomb i.10 NB. # ways to choose 3 items from 10 with repetitions 220 diff --git a/Task/Combinations-with-repetitions/JavaScript/combinations-with-repetitions-2.js b/Task/Combinations-with-repetitions/JavaScript/combinations-with-repetitions-2.js index 2d19ae9378..8f433aac9c 100644 --- a/Task/Combinations-with-repetitions/JavaScript/combinations-with-repetitions-2.js +++ b/Task/Combinations-with-repetitions/JavaScript/combinations-with-repetitions-2.js @@ -1,8 +1,45 @@ -iced iced -iced jam -iced plain -jam jam -jam plain -plain plain -6 combos -pick 3 out of 10: 220 combos +(function () { + + // n -> [a] -> [[a]] + function combsWithRep(n, lst) { + return n ? ( + lst.length ? combsWithRep(n - 1, lst).map(function (t) { + return [lst[0]].concat(t); + }).concat(combsWithRep(n, lst.slice(1))) : [] + ) : [[]]; + }; + + // If needed, we can derive a significantly faster version of + // the simple recursive function above by memoizing it + + // f -> f + function memoized(fn) { + m = {}; + return function (x) { + var args = [].slice.call(arguments), + strKey = args.join('-'); + + v = m[strKey]; + if ('u' === (typeof v)[0]) + m[strKey] = v = fn.apply(null, args); + return v; + } + } + + // [m..n] + function range(m, n) { + return Array.apply(null, Array(n - m + 1)).map(function (x, i) { + return m + i; + }); + } + + + return [ + + combsWithRep(2, ["iced", "jam", "plain"]), + + // obtaining and applying a memoized version of the function + memoized(combsWithRep)(3, range(1, 10)).length + ]; + +})(); diff --git a/Task/Combinations-with-repetitions/JavaScript/combinations-with-repetitions-3.js b/Task/Combinations-with-repetitions/JavaScript/combinations-with-repetitions-3.js new file mode 100644 index 0000000000..0f4a2f16c3 --- /dev/null +++ b/Task/Combinations-with-repetitions/JavaScript/combinations-with-repetitions-3.js @@ -0,0 +1,5 @@ +[ + [["iced", "iced"], ["iced", "jam"], ["iced", "plain"], + ["jam", "jam"], ["jam", "plain"], ["plain", "plain"]], + 220 +] diff --git a/Task/Combinations-with-repetitions/JavaScript/combinations-with-repetitions.js b/Task/Combinations-with-repetitions/JavaScript/combinations-with-repetitions.js deleted file mode 100644 index 97d6e9602a..0000000000 --- a/Task/Combinations-with-repetitions/JavaScript/combinations-with-repetitions.js +++ /dev/null @@ -1,24 +0,0 @@ -Donuts -
    
    diff --git a/Task/Combinations-with-repetitions/Perl-6/combinations-with-repetitions-1.pl6 b/Task/Combinations-with-repetitions/Perl-6/combinations-with-repetitions-1.pl6
    new file mode 100644
    index 0000000000..77ff7f90f4
    --- /dev/null
    +++ b/Task/Combinations-with-repetitions/Perl-6/combinations-with-repetitions-1.pl6
    @@ -0,0 +1,4 @@
    +my @S = ;
    +my $k = 2;
    +
    +.put for [X](@S xx $k).unique(as => *.sort, with => &[eqv])
    diff --git a/Task/Combinations-with-repetitions/Perl-6/combinations-with-repetitions-2.pl6 b/Task/Combinations-with-repetitions/Perl-6/combinations-with-repetitions-2.pl6
    new file mode 100644
    index 0000000000..5815f852f3
    --- /dev/null
    +++ b/Task/Combinations-with-repetitions/Perl-6/combinations-with-repetitions-2.pl6
    @@ -0,0 +1,17 @@
    +proto combs_with_rep (UInt, @) {*}
    +
    +multi combs_with_rep (0,  @)  { () }
    +multi combs_with_rep (1,  @a)  { map { $_, }, @a }
    +multi combs_with_rep ($,  []) { () }
    +multi combs_with_rep ($n, [$head, *@tail]) {
    +    |combs_with_rep($n - 1, ($head, |@tail)).map({ $head, |@_ }),
    +    |combs_with_rep($n, @tail);
    +}
    +
    +.say for combs_with_rep( 2, [< iced jam plain >] );
    +
    +# Extra credit:
    +sub postfix: { [*] 1..$^n }
    +sub combs_with_rep_count ($k, $n) { ($n + $k - 1)! / $k! / ($n - 1)! }
    +
    +say combs_with_rep_count( 3, 10 );
    diff --git a/Task/Combinations-with-repetitions/Perl-6/combinations-with-repetitions.pl6 b/Task/Combinations-with-repetitions/Perl-6/combinations-with-repetitions.pl6
    deleted file mode 100644
    index 7ac9bd306a..0000000000
    --- a/Task/Combinations-with-repetitions/Perl-6/combinations-with-repetitions.pl6
    +++ /dev/null
    @@ -1,17 +0,0 @@
    -proto combs_with_rep (Int, @) {*}
    -
    -multi combs_with_rep (0,  @)  { [] }
    -multi combs_with_rep ($,  []) { () }
    -multi combs_with_rep ($n, [$head, *@tail]) {
    -    map( { [$head, @^others] },
    -            combs_with_rep($n - 1, [$head, @tail]) ),
    -    combs_with_rep($n, @tail);
    -}
    -
    -.perl.say for combs_with_rep( 2, [< iced jam plain >] );
    -
    -# Extra credit:
    -sub postfix: { [*] 1..$^n }
    -sub combs_with_rep_count ($k, $n) { ($n + $k - 1)! / $k! / ($n - 1)! }
    -
    -say combs_with_rep_count( 3, 10 );
    diff --git a/Task/Combinations-with-repetitions/REXX/combinations-with-repetitions.rexx b/Task/Combinations-with-repetitions/REXX/combinations-with-repetitions-1.rexx
    similarity index 100%
    rename from Task/Combinations-with-repetitions/REXX/combinations-with-repetitions.rexx
    rename to Task/Combinations-with-repetitions/REXX/combinations-with-repetitions-1.rexx
    diff --git a/Task/Combinations-with-repetitions/REXX/combinations-with-repetitions-2.rexx b/Task/Combinations-with-repetitions/REXX/combinations-with-repetitions-2.rexx
    new file mode 100644
    index 0000000000..b2397dfb9d
    --- /dev/null
    +++ b/Task/Combinations-with-repetitions/REXX/combinations-with-repetitions-2.rexx
    @@ -0,0 +1,66 @@
    +/*REXX compute (and show) combination sets for nt things in ns places*/
    +  debug=0
    +  Call time 'R'
    +  Call RcombN 3,2,'iced,jam,plain'  /* The 1st part of the task      */
    +  Call RcombN -10,3,'iced,jam,plain,d,e,f,g,h,i,j' /* 2nd part       */
    +  Call RcombN -10,9,'iced,jam,plain,d,e,f,g,h,i,j' /* extra part     */
    +  Say time('E') 'seconds'
    +  Exit
    +/*-------------------------------------------------------------------*/
    +Rcombn: Procedure Expose thing. debug
    +  Parse Arg nt,ns,thinglist
    +  tell=nt>0
    +  nt=abs(nt)
    +  Say '------------' nt 'doughnut selection taken' ns 'at a time:'
    +  If tell=0 Then
    +    Say ' list output suppressed'
    +  Do i=1 By 1 While thinglist>''
    +    Parse Var thinglist thing.i ',' thinglist /* assign things.      */
    +    End
    +  index.=1
    +  Do cmb=1 By 1
    +    If tell Then                    /* display combinations          */
    +      Call show                     /* show this one                 */
    +    index.ns=index.ns+1
    +    Call show_index 'A'
    +    If index.ns==nt+1 Then
    +      If proc(ns-1) Then
    +        Leave
    +    End
    +  Say '------------' cmb 'combinations.'
    +  Say
    +  Return
    +/*-------------------------------------------------------------------*/
    +proc: Procedure Expose nt ns thing. index. debug
    +  Parse Arg recnt
    +  If recnt>0 Then Do
    +    p=index.recnt+1
    +    If p=nt+1 Then
    +      Return proc(recnt-1)
    +    Do i=recnt To ns
    +      index.i=p
    +      End
    +    Call show_index 'C'
    +    End
    +  Return recnt=0
    +/*-------------------------------------------------------------------*/
    +show: Procedure Expose index. thing. ns debug
    +  l=''
    +  Call show_index 'B----------------------->'
    +  Do i=1 To ns
    +    j=index.i
    +    l=l thing.j
    +    End
    +  Say l
    +  Return
    +
    +show_index: Procedure Expose index. ns debug
    +  If debug Then Do
    +    Parse Arg tag
    +      l=tag
    +      Do i=1 To ns
    +        l=l index.i
    +        End
    +      Say l
    +    End
    +  Return
    diff --git a/Task/Combinations-with-repetitions/REXX/combinations-with-repetitions-3.rexx b/Task/Combinations-with-repetitions/REXX/combinations-with-repetitions-3.rexx
    new file mode 100644
    index 0000000000..2357e8e7b9
    --- /dev/null
    +++ b/Task/Combinations-with-repetitions/REXX/combinations-with-repetitions-3.rexx
    @@ -0,0 +1,55 @@
    +/*REXX compute (and show) combination sets for nt things in ns places*/
    +  Numeric Digits 20
    +  debug=0
    +  Call time 'R'
    +  Call IcombN 3,2,'iced,jam,plain'  /* The 1st part of the task      */
    +  Call IcombN -10,3,'iced,jam,plain,d,e,f,g,h,i,j' /* 2nd part       */
    +  Call IcombN -10,9,'iced,jam,plain,d,e,f,g,h,i,j' /* extra part     */
    +  Say time('E') 'seconds'
    +  Exit
    +
    +IcombN: Procedure Expose thing. debug
    +  Parse Arg nt,ns,thinglist
    +  tell=nt>0
    +  nt=abs(nt)
    +  Say '------------' nt 'doughnut selection taken' ns 'at a time:'
    +  If tell=0 Then
    +    Say ' list output suppressed'
    +  Do i=1 By 1 While thinglist>''
    +    Parse Var thinglist thing.i ',' thinglist /* assign things.      */
    +    End
    +  index.=1
    +  cmb=0
    +  Call show
    +  i=ns+1
    +  Do While i>1
    +    i=i-1
    +    Do j=1 By 1 While index.im and n, generate all size m [http://mathworld.wolfram.com/Combination.html combinations] of the integers from 0 to n-1 in sorted order (each combination is sorted and the entire table is sorted).
    +;Task:
    +Given non-negative integers    '''m'''    and    '''n''',   generate all size    '''m'''    [http://mathworld.wolfram.com/Combination.html combinations]   of the integers from    '''0'''   (zero)   to    '''n-1'''    in sorted order   (each combination is sorted and the entire table is sorted).
     
    -For example, 3 comb 5 is
    +
    +;Example:
    +'''3'''   comb    '''5'''      is:
      0 1 2
      0 1 3
      0 1 4
    @@ -12,7 +15,10 @@ For example, 3 comb 5 is
      1 3 4
      2 3 4
     
    -If it is more "natural" in your language to start counting from 1 instead of 0 the combinations can be of the integers from 1 to n.
    +If it is more "natural" in your language to start counting from    '''1'''   (unity) instead of    '''0'''   (zero),
    +
    the combinations can be of the integers from   '''1'''   to   '''n'''. -'''See Also:''' + +;See also: {{Template:Combinations and permutations}} +

    diff --git a/Task/Combinations/360-Assembly/combinations.360 b/Task/Combinations/360-Assembly/combinations.360 new file mode 100644 index 0000000000..fc770b8d70 --- /dev/null +++ b/Task/Combinations/360-Assembly/combinations.360 @@ -0,0 +1,64 @@ +* Combinations 26/05/2016 +COMBINE CSECT + USING COMBINE,R13 base register + B 72(R15) skip savearea + DC 17F'0' savearea + STM R14,R12,12(R13) prolog + ST R13,4(R15) " + ST R15,8(R13) " + LR R13,R15 " + SR R3,R3 clear + LA R7,C @c(1) + LH R8,N v=n +LOOPI1 STC R8,0(R7) do i=1 to n; c(i)=n-i+1 + LA R7,1(R7) @c(i)++ + BCT R8,LOOPI1 next i +LOOPBIG LA R10,PG big loop {------------------ + LH R1,N n + LA R7,C-1(R1) @c(i) + LH R6,N i=n +LOOPI2 IC R3,0(R7) do i=n to 1 by -1; r2=c(i) + XDECO R3,PG+80 edit c(i) + MVC 0(2,R10),PG+90 output c(i) + LA R10,3(R10) @pgi=@pgi+3 + BCTR R7,0 @c(i)-- + BCT R6,LOOPI2 next i + XPRNT PG,80 print buffer + LA R7,C @c(1) + LH R8,M v=m + LA R6,1 i=1 +LOOPI3 LR R1,R6 do i=1 by 1; r1=i + IC R3,0(R7) c(i) + CR R3,R8 while c(i)>=m-i+1 + BL ELOOPI3 leave i + CH R6,N if i>=n + BNL ELOOPBIG exit loop + BCTR R8,0 v=v-1 + LA R7,1(R7) @c(i)++ + LA R6,1(R6) i=i+1 + B LOOPI3 next i +ELOOPI3 LR R1,R6 i + LA R4,C-1(R1) @c(i) + IC R3,0(R4) c(i) + LA R3,1(R3) c(i)+1 + STC R3,0(R4) c(i)=c(i)+1 + BCTR R7,0 @c(i)-- +LOOPI4 CH R6,=H'2' do i=i to 2 by -1 + BL ELOOPI4 leave i + IC R3,1(R7) c(i) + LA R3,1(R3) c(i)+1 + STC R3,0(R7) c(i-1)=c(i)+1 + BCTR R7,0 @c(i)-- + BCTR R6,0 i=i-1 + B LOOPI4 next i +ELOOPI4 B LOOPBIG big loop }------------------ +ELOOPBIG L R13,4(0,R13) epilog + LM R14,R12,12(R13) " + XR R15,R15 " + BR R14 exit +M DC H'5' <=input +N DC H'3' <=input +C DS 64X array of 8 bit integers +PG DC CL92' ' buffer + YREGS + END COMBINE diff --git a/Task/Combinations/AppleScript/combinations-1.applescript b/Task/Combinations/AppleScript/combinations-1.applescript index 2b69cea1bc..61dd66010b 100644 --- a/Task/Combinations/AppleScript/combinations-1.applescript +++ b/Task/Combinations/AppleScript/combinations-1.applescript @@ -1,27 +1,27 @@ on comb(n, k) - set c to {} - repeat with i from 1 to k - set end of c to i's contents - end repeat - set r to {c's contents} - repeat while my next_comb(c, k, n) - set end of r to c's contents - end repeat - return r + set c to {} + repeat with i from 1 to k + set end of c to i's contents + end repeat + set r to {c's contents} + repeat while my next_comb(c, k, n) + set end of r to c's contents + end repeat + return r end comb on next_comb(c, k, n) - set i to k - set c's item i to (c's item i) + 1 - repeat while (i > 1 and c's item i ≥ n - k + 1 + i) - set i to i - 1 - set c's item i to (c's item i) + 1 - end repeat - if (c's item 1 > n - k + 1) then return false - repeat with i from i + 1 to k - set c's item i to (c's item (i - 1)) + 1 - end repeat - return true + set i to k + set c's item i to (c's item i) + 1 + repeat while (i > 1 and c's item i ≥ n - k + 1 + i) + set i to i - 1 + set c's item i to (c's item i) + 1 + end repeat + if (c's item 1 > n - k + 1) then return false + repeat with i from i + 1 to k + set c's item i to (c's item (i - 1)) + 1 + end repeat + return true end next_comb return comb(5, 3) diff --git a/Task/Combinations/AppleScript/combinations-3.applescript b/Task/Combinations/AppleScript/combinations-3.applescript new file mode 100644 index 0000000000..0092d7b010 --- /dev/null +++ b/Task/Combinations/AppleScript/combinations-3.applescript @@ -0,0 +1,104 @@ +-- comb :: Int -> [a] -> [[a]] +on comb(n, lst) + set h to head(lst) + + script headPrepended + on lambda(t) + h & t + end lambda + end script + + if n < 1 then + [[]] + else if length of lst = 0 then + [] + else + set xs to tail(lst) + + map(headPrepended, ¬ + comb(n - 1, xs)) & comb(n, xs) + end if +end comb + + +-- TEST + +-- spaced :: [a] -> String +on spaced(lst) + intercalate(space, lst) +end spaced + +on run + + intercalate(linefeed, ¬ + map(spaced, comb(3, range(0, 4)))) + +end run + + + +-- GENERIC FUNCTIONS + +-- 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 + +-- 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 + +-- intercalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate + +-- range :: Int -> Int -> [Int] +on range(m, n) + if n < m then + set d to -1 + else + set d to 1 + end if + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range + +-- head :: [a] -> a +on head(xs) + if length of xs > 0 then + item 1 of xs + else + missing value + end if +end head + +-- tail :: [a] -> [a] +on tail(xs) + if length of xs > 1 then + items 2 thru -1 of xs + else + {} + end if +end tail diff --git a/Task/Combinations/AppleScript/combinations.applescript b/Task/Combinations/AppleScript/combinations.applescript deleted file mode 100644 index 2b69cea1bc..0000000000 --- a/Task/Combinations/AppleScript/combinations.applescript +++ /dev/null @@ -1,27 +0,0 @@ -on comb(n, k) - set c to {} - repeat with i from 1 to k - set end of c to i's contents - end repeat - set r to {c's contents} - repeat while my next_comb(c, k, n) - set end of r to c's contents - end repeat - return r -end comb - -on next_comb(c, k, n) - set i to k - set c's item i to (c's item i) + 1 - repeat while (i > 1 and c's item i ≥ n - k + 1 + i) - set i to i - 1 - set c's item i to (c's item i) + 1 - end repeat - if (c's item 1 > n - k + 1) then return false - repeat with i from i + 1 to k - set c's item i to (c's item (i - 1)) + 1 - end repeat - return true -end next_comb - -return comb(5, 3) diff --git a/Task/Combinations/Elena/combinations.elena b/Task/Combinations/Elena/combinations.elena index dfca1f05dd..035574691d 100644 --- a/Task/Combinations/Elena/combinations.elena +++ b/Task/Combinations/Elena/combinations.elena @@ -17,7 +17,7 @@ #symbol program = [ - #var aNumbers := numbers:N. + #var aNumbers := numbers eval:N. Combinator new:M &of:aNumbers run &each: aRow [ console writeLine:aRow. diff --git a/Task/Combinations/Emacs-Lisp/combinations.l b/Task/Combinations/Emacs-Lisp/combinations.l new file mode 100644 index 0000000000..4d6237b086 --- /dev/null +++ b/Task/Combinations/Emacs-Lisp/combinations.l @@ -0,0 +1,11 @@ +(defun comb-recurse (m n n-max) + (cond ((zerop m) '(())) + ((= n-max n) '()) + (t (append (mapcar #'(lambda (rest) (cons n rest)) + (comb-recurse (1- m) (1+ n) n-max)) + (comb-recurse m (1+ n) n-max))))) + +(defun comb (m n) + (comb-recurse m 0 n)) + +(comb 3 5) diff --git a/Task/Combinations/JavaScript/combinations-3.js b/Task/Combinations/JavaScript/combinations-3.js new file mode 100644 index 0000000000..80c97ace68 --- /dev/null +++ b/Task/Combinations/JavaScript/combinations-3.js @@ -0,0 +1,29 @@ +(function () { + + function comb(n, lst) { + if (!n) return [[]]; + if (!lst.length) return []; + + var x = lst[0], + xs = lst.slice(1); + + return comb(n - 1, xs).map(function (t) { + return [x].concat(t); + }).concat(comb(n, xs)); + } + + + // [m..n] + function range(m, n) { + return Array.apply(null, Array(n - m + 1)).map(function (x, i) { + return m + i; + }); + } + + return comb(3, range(0, 4)) + + .map(function (x) { + return x.join(' '); + }).join('\n'); + +})(); diff --git a/Task/Combinations/JavaScript/combinations-4.js b/Task/Combinations/JavaScript/combinations-4.js new file mode 100644 index 0000000000..46b6decac0 --- /dev/null +++ b/Task/Combinations/JavaScript/combinations-4.js @@ -0,0 +1,46 @@ +(function (n) { + + // n -> [a] -> [[a]] + function comb(n, lst) { + if (!n) return [[]]; + if (!lst.length) return []; + + var x = lst[0], + xs = lst.slice(1); + + return comb(n - 1, xs).map(function (t) { + return [x].concat(t); + }).concat(comb(n, xs)); + } + + // f -> f + function memoized(fn) { + m = {}; + return function (x) { + var args = [].slice.call(arguments), + strKey = args.join('-'); + + v = m[strKey]; + if ('u' === (typeof v)[0]) + m[strKey] = v = fn.apply(null, args); + return v; + } + } + + // [m..n] + function range(m, n) { + return Array.apply(null, Array(n - m + 1)).map(function (x, i) { + return m + i; + }); + } + + var fnMemoized = memoized(comb), + lstRange = range(0, 4); + + return fnMemoized(n, lstRange) + + .map(function (x) { + return x.join(' '); + }).join('\n'); + +})(3); diff --git a/Task/Combinations/JavaScript/combinations-5.js b/Task/Combinations/JavaScript/combinations-5.js new file mode 100644 index 0000000000..e0af6657f6 --- /dev/null +++ b/Task/Combinations/JavaScript/combinations-5.js @@ -0,0 +1,10 @@ +0 1 2 +0 1 3 +0 1 4 +0 2 3 +0 2 4 +0 3 4 +1 2 3 +1 2 4 +1 3 4 +2 3 4 diff --git a/Task/Combinations/JavaScript/combinations-6.js b/Task/Combinations/JavaScript/combinations-6.js new file mode 100644 index 0000000000..99cce48212 --- /dev/null +++ b/Task/Combinations/JavaScript/combinations-6.js @@ -0,0 +1,47 @@ +(function (n) { + 'use strict'; + + + // n -> [a] -> [[a]] + let comb = (n, xs) => { + if (n < 1) return [[]]; + if (xs.length === 0) return []; + + let h = xs[0], + tail = xs.slice(1); + + return comb(n - 1, tail) + .map((t) => [h].concat(t)) + .concat(comb(n, tail)); + }, + + + + // Derive a memoized version of a function + // Function -> Function + memoized = (f) => { + let m = {}; + + return function (x) { + let args = [].slice.call(arguments), + strKey = args.join('-'), + v = m[strKey]; + + return ( + (v === undefined) && + (m[strKey] = v = f.apply(null, args)), + v + ); + } + }, + + range = (m, n) => + Array.from({ + length: (n - m) + 1 + }, (_, i) => m + i); + + + return memoized(comb)(n, range(0, 4)) + + +})(3); diff --git a/Task/Combinations/Julia/combinations.julia b/Task/Combinations/Julia/combinations.julia index 3d7433b639..69daa9fd3b 100644 --- a/Task/Combinations/Julia/combinations.julia +++ b/Task/Combinations/Julia/combinations.julia @@ -1,3 +1,5 @@ -for i in combinations(1:5,3) - print(i') +n = 4 +m = 3 +for i in combinations(0:n,m) + println(i') end diff --git a/Task/Combinations/K/combinations.k b/Task/Combinations/K/combinations.k new file mode 100644 index 0000000000..e1714036bb --- /dev/null +++ b/Task/Combinations/K/combinations.k @@ -0,0 +1,4 @@ +comb:{[n;k] + f:{:[k=#x; :,x; :,/_f' x,'(1+*|x) _ !n]} + :,/f' !n +} diff --git a/Task/Combinations/PHP/combinations.php b/Task/Combinations/PHP/combinations.php new file mode 100644 index 0000000000..1f152bea08 --- /dev/null +++ b/Task/Combinations/PHP/combinations.php @@ -0,0 +1,48 @@ + Combinations(int m, int n) + { + int[] result = new int[m]; + Stack stack = new Stack(); + stack.Push(0); + + while (stack.Count > 0) { + int index = stack.Count - 1; + int value = stack.Pop(); + + while (value < n) { + result[index++] = value++; + stack.Push(value); + if (index == m) { + yield return result; + break; + } + } + } + } + } + } +'@ + +Add-Type -TypeDefinition $source -Language CSharp + +[Powershell.CSharp]::Combinations(3,5) | Format-Wide {$_} -Column 3 -Force diff --git a/Task/Combinations/REXX/combinations.rexx b/Task/Combinations/REXX/combinations.rexx index 0e25e9288e..bb1a5e8d8b 100644 --- a/Task/Combinations/REXX/combinations.rexx +++ b/Task/Combinations/REXX/combinations.rexx @@ -1,28 +1,21 @@ -/*REXX program shows combination sets for X things taken Y at a time*/ -parse arg x y $ . /*get optional args from the C.L.*/ -if x=='' | x==',' then x=5 /*X specified? No, use default.*/ -if y=='' | y==',' then y=3 /*Y specified? No, use default.*/ -@abc='abcdefghijklmnopqrstuvwxyz'; @abcU=@abc; upper @abcU -if $=='' then $=123456789||@abc||@abcU /*chars for symbol table string. */ -say "────────────" x ' things taken ' y " at a time:" -say "────────────" combN(x,y) ' combinations.' -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────COMBN subroutine────────────────────*/ -combN: procedure expose $; parse arg x,y; base=x+1; bbase=base-y -!.=0; do i=1 for y; !.i=i - end /*i*/ - - do j=1; L=; do d=1 for y - L=L word(substr($,!.d,1) !.d,1) - end /*d*/ - say L - !.y=!.y+1; if !.y==base then if .combUp(y-1) then leave - end /*j*/ -return j - -.combUp: procedure expose !. y bbase; parse arg d; if d==0 then return 1 -p=!.d; do u=d to y; !.u=p+1 - if !.u==bbase+u then return .combUp(u-1) - p=!.u - end /*u*/ -return 0 +/*REXX program displays combination sets for X things taken Y at a time. */ +parse arg x y $ . /*get optional arguments from the C.L. */ +if x=='' | x=="," then x=5 /*No X specified? Then use default.*/ +if y=='' | y=="," then y=3 /* " Y " " " " */ +if $=='' | $=="," then $= '123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ' + /* [↑] No $ specified? Use default.*/ +say "────────────" x ' things taken ' y " at a time:" +say "────────────" combN(x,y) ' combinations.' +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +combN: procedure expose $; parse arg x,y; xp=x+1; xm=xp-y; !.=0 + do i=1 for y; !.i=i; end /*i*/ + do j=1; L=; do d=1 for y; L=L word(substr($,!.d,1) !.d, 1); end /*d*/ + say L; !.y=!.y+1 + if !.y==xp then if .combN(y-1) then leave + end /*j*/ + return j +.combN: procedure expose !. y xm; parse arg d; if d==0 then return 1; p=!.d + do u=d to y; !.u=p+1; if !.u==xm+u then return .combN(u-1); p=!.u + end /*u*/ + return 0 diff --git a/Task/Comma-quibbling/00DESCRIPTION b/Task/Comma-quibbling/00DESCRIPTION index 8745fef3c3..cd278a15f4 100644 --- a/Task/Comma-quibbling/00DESCRIPTION +++ b/Task/Comma-quibbling/00DESCRIPTION @@ -1,15 +1,21 @@ Comma quibbling is a task originally set by Eric Lippert in his [http://blogs.msdn.com/b/ericlippert/archive/2009/04/15/comma-quibbling.aspx blog]. -'''The task''' is to write a function to generate a string output which is the concatenation of input words from a list/sequence where: + +;Task: + +Write a function to generate a string output which is the concatenation of input words from a list/sequence where: # An input of no words produces the output string of just the two brace characters "{}". # An input of just one word, e.g. ["ABC"], produces the output string of the word inside the two braces, e.g. "{ABC}". # An input of two words, e.g. ["ABC", "DEF"], produces the output string of the two words inside the two braces with the words separated by the string " and ", e.g. "{ABC and DEF}". # An input of three or more words, e.g. ["ABC", "DEF", "G", "H"], produces the output string of all but the last word separated by ", " with the last word separated by " and " and all within braces; e.g. "{ABC, DEF, G and H}". +
    Test your function with the following series of inputs showing your output here on this page: * [] # (No input words). * ["ABC"] * ["ABC", "DEF"] * ["ABC", "DEF", "G", "H"] +
    Note: Assume words are non-empty strings of uppercase characters for this task. +

    diff --git a/Task/Comma-quibbling/Forth/comma-quibbling-1.fth b/Task/Comma-quibbling/Forth/comma-quibbling-1.fth new file mode 100644 index 0000000000..890a337404 --- /dev/null +++ b/Task/Comma-quibbling/Forth/comma-quibbling-1.fth @@ -0,0 +1,93 @@ +\ string primitives operate on addresses passed on the stack +: C+! ( n addr -- ) dup >R C@ + R> C! ; \ increment a byte at addr by n +: APPEND ( addr1 n addr2 -- ) 2DUP 2>R COUNT + SWAP MOVE 2R> C+! ; \ append u bytes at addr1 to addr2 +: PLACE ( addr1 n addr2 -- ) 2DUP 2>R 1+ SWAP MOVE 2R> C! ; \ copy n bytes at addr to addr2 +: ,' ( -- ) [CHAR] ' WORD c@ 1+ ALLOT ALIGN ; \ Parse input stream until ' and write into next + \ available memory + +\ use ,' to create some counted string literals with mnemonic names +create '"{}"' ( -- addr) ,' "{}"' \ counted strings return the address of the 1st byte +create '"{' ( -- addr) ,' "{' +create '}"' ( -- addr) ,' }"' +create ',' ( -- addr) ,' , ' +create 'and' ( -- addr) ,' and ' +create "] ( -- addr) ,' "]' + +create null$ ( -- addr) 0 , + +HEX +\ build a string stack/array to hold input strings +100 constant ss-width \ string stack width +variable $DEPTH \ the string stack pointer + +create $stack ( -- addr) 20 ss-width * allot + +DECIMAL +: new: ( -- ) 1 $DEPTH +! ; \ incr. string stack pointer +: ]stk$ ( ndx -- addr) ss-width * $stack + ; \ calc string stack element address from ndx +: TOP$ ( -- addr) $DEPTH @ ]stk$ ; \ returns address of the top string on string stack +: collapse ( -- ) $DEPTH off ; \ reset string stack pointer + +\ used primitives to build counted string functions +: move$ ( $1 $2 -- ) >r COUNT R> PLACE ; \ copy $1 to $2 +: push$ ( $ -- ) new: top$ move$ ; \ push $ onto string stack +: +$ ( $1 $2 -- top$ ) swap push$ count TOP$ APPEND top$ ; \ concatentate $2 to $1, Return result in TOP$ +: LEN ( $1 -- length) c@ ; \ char fetch the first byte returns the string length +: compare$ ( $1 $2 -- -n:0:n ) count rot count compare ; \ compare is an ANS Forth word. returns 0 if $1=$2 +: =$ ( $1 $2 -- flag ) compare$ 0= ; +: [""] ( -- ) null$ push$ ; \ put a null string on the string stack + +: [" \ collects input strings onto string stack + COLLAPSE + begin + bl word dup "] =$ not \ parse input stream and terminate at "] + while + push$ + repeat + drop + $DEPTH @ 0= if [""] then ; \ minimally leave a null string on the string stack + + +: ]stk$+ ( dest$ n -- top$) ]stk$ +$ ; \ concatenate n ]stk$ to DEST$ + +: writeln ( $ -- ) cr count type collapse ; \ print string on new line and collapse string stack + +\ write the solution with the new words +: 1-input ( -- ) + 1 ]stk$ LEN 0= \ check for empty string length + if + '"{}"' writeln \ return the null string output + else + '"{' push$ \ create a new string beginning with '{' + TOP$ 1 ]stk$+ '}"' +$ writeln \ concatenate the pieces for 1 input + + then ; + +: 2-inputs ( -- ) + '"{' push$ + TOP$ 1 ]stk$+ 'and' +$ 2 ]stk$+ '}"' +$ writeln ; + +: 3+inputs ( -- ) + $DEPTH @ dup >R \ save copy of the number of inputs on the return stack + '"{' push$ + ( n) 1- 1 \ loop indices for 1 to 2nd last string + DO TOP$ I ]stk$+ ',' +$ LOOP \ create all but the last 2 strings in a loop with comma + ( -- top$) R@ 1- ]stk$+ 'and' +$ \ concatenate the 2nd last string to Top$ + 'and' + R> ]stk$+ '}"' +$ writeln \ use the copy of $DEPTH to get the final string index + 2drop ; \ clean the parameter stack + +: quibble ( -- ) + $DEPTH @ + case + 1 of 1-input endof + 2 of 2-inputs endof + 3+inputs \ default case + endcase ; + + +\ interpret this test code after including the above code +[""] QUIBBLE +[" "] QUIBBLE +[" ABC "] QUIBBLE +[" ABC DEF "] QUIBBLE +[" ABC DEF GHI BROWN FOX "] QUIBBLE diff --git a/Task/Comma-quibbling/Forth/comma-quibbling-2.fth b/Task/Comma-quibbling/Forth/comma-quibbling-2.fth new file mode 100644 index 0000000000..ca5b853002 --- /dev/null +++ b/Task/Comma-quibbling/Forth/comma-quibbling-2.fth @@ -0,0 +1,27 @@ + include FMS-SI.f +include FMS-SILib.f + +: foo { l | s -- } + cr ." {" + l size: dup 1- to s + 0 ?do + i l at: p: + s i - 1 > + if ." , " + else s i <> if ." and " then + then + loop + ." }" l ");Out.String(str);Out.Ln +END CommaQuibbling. diff --git a/Task/Comma-quibbling/PowerShell/comma-quibbling-1.psh b/Task/Comma-quibbling/PowerShell/comma-quibbling-1.psh new file mode 100644 index 0000000000..951ae85cf7 --- /dev/null +++ b/Task/Comma-quibbling/PowerShell/comma-quibbling-1.psh @@ -0,0 +1,41 @@ +function Out-Quibble +{ + [OutputType([string])] + Param + ( + # Zero or more strings. + [Parameter(Mandatory=$false, Position=0)] + [AllowEmptyString()] + [string[]] + $Text = "" + ) + + # If not null or empty... + if ($Text) + { + # Remove empty strings from the array. + $text = "$Text".Split(" ", [StringSplitOptions]::RemoveEmptyEntries) + } + else + { + return "{}" + } + + # Build a format string. + $outStr = "" + for ($i = 0; $i -lt $text.Count; $i++) + { + $outStr += "{$i}, " + } + $outStr = $outStr.TrimEnd(", ") + + # If more than one word, insert " and" at last comma position. + if ($text.Count -gt 1) + { + $cIndex = $outStr.LastIndexOf(",") + $outStr = $outStr.Remove($cIndex,1).Insert($cIndex," and") + } + + # Output the formatted string. + "{" + $outStr -f $text + "}" +} diff --git a/Task/Comma-quibbling/PowerShell/comma-quibbling-2.psh b/Task/Comma-quibbling/PowerShell/comma-quibbling-2.psh new file mode 100644 index 0000000000..9b60aa3cb5 --- /dev/null +++ b/Task/Comma-quibbling/PowerShell/comma-quibbling-2.psh @@ -0,0 +1,4 @@ +Out-Quibble +Out-Quibble "ABC" +Out-Quibble "ABC", "DEF" +Out-Quibble "ABC", "DEF", "G", "H" diff --git a/Task/Comma-quibbling/PowerShell/comma-quibbling-3.psh b/Task/Comma-quibbling/PowerShell/comma-quibbling-3.psh new file mode 100644 index 0000000000..41d8b6c793 --- /dev/null +++ b/Task/Comma-quibbling/PowerShell/comma-quibbling-3.psh @@ -0,0 +1,11 @@ +$file = @' + +ABC +ABC, DEF +ABC, DEF, G, H +'@ -split [Environment]::NewLine + +foreach ($line in $file) +{ + Out-Quibble -Text ($line -split ", ") +} diff --git a/Task/Comma-quibbling/PureBasic/comma-quibbling.purebasic b/Task/Comma-quibbling/PureBasic/comma-quibbling.purebasic new file mode 100644 index 0000000000..4c86bc6e38 --- /dev/null +++ b/Task/Comma-quibbling/PureBasic/comma-quibbling.purebasic @@ -0,0 +1,34 @@ +EnableExplicit + +Procedure.s CommaQuibble(Input$) + Protected i, count + Protected result$, word$ + Input$ = RemoveString(Input$, "[") + Input$ = RemoveString(Input$, "]") + Input$ = RemoveString(Input$, #DQUOTE$) + count = CountString(Input$, ",") + 1 + result$ = "{" + For i = 1 To count + word$ = StringField(Input$, i, ",") + If i = 1 + result$ + word$ + ElseIf Count = i + result$ + " and " + word$ + Else + result$ + ", " + word$ + EndIf + Next + ProcedureReturn result$ + "}" +EndProcedure + +If OpenConsole() + ; As 3 of the strings contain embedded quotes these need to be escaped with '\' and the whole string preceded by '~' + PrintN(CommaQuibble("[]")) + PrintN(CommaQuibble(~"[\"ABC\"]")) + PrintN(CommaQuibble(~"[\"ABC\",\"DEF\"]")) + PrintN(CommaQuibble(~"[\"ABC\",\"DEF\",\"G\",\"H\"]")) + PrintN("") + PrintN("Press any key to close the console") + Repeat: Delay(10) : Until Inkey() <> "" + CloseConsole() +EndIf diff --git a/Task/Comma-quibbling/REXX/comma-quibbling-3.rexx b/Task/Comma-quibbling/REXX/comma-quibbling-3.rexx index 13c8ae06cc..e6f1b74cf8 100644 --- a/Task/Comma-quibbling/REXX/comma-quibbling-3.rexx +++ b/Task/Comma-quibbling/REXX/comma-quibbling-3.rexx @@ -16,7 +16,7 @@ exit quibbling03: procedure parse arg '[' lst ']' - lst = changestr('"', changestr("'", lst, ''), '') -- remove double & single quotes + lst = changestr('"', changestr("'", lst, ''), '') /* remove double & single quotes */ lc = lastpos(',', lst) if lc > 0 then lst = overlay(' ', insert('and', lst, lc), lc) diff --git a/Task/Comma-quibbling/Rust/comma-quibbling.rust b/Task/Comma-quibbling/Rust/comma-quibbling.rust index 659705da7d..f1c44738a5 100644 --- a/Task/Comma-quibbling/Rust/comma-quibbling.rust +++ b/Task/Comma-quibbling/Rust/comma-quibbling.rust @@ -1,16 +1,18 @@ -// rust 0.9-pre - -fn quibble(seq: &[&str]) -> ~str { - match seq { - [] => ~"{}", - [ref word] => "{" + *word + "}", - [..words, ref word] => "{" + words.connect(", ") + " and " + *word + "}", +fn quibble(seq: &[&str]) -> String { + match seq.len() { + 0 => "{}".to_string(), + 1 => format!("{{{}}}", seq[0]), + _ => { + format!("{{{} and {}}}", + seq[..seq.len() - 1].join(", "), + seq.last().unwrap()) + } } } fn main() { - println(quibble([])); - println(quibble(["ABC"])); - println(quibble(["ABC", "DEF"])); - println(quibble(["ABC", "DEF", "G", "H"])); + println!("{}", quibble(&[])); + println!("{}", quibble(&["ABC"])); + println!("{}", quibble(&["ABC", "DEF"])); + println!("{}", quibble(&["ABC", "DEF", "G", "H"])); } diff --git a/Task/Comma-quibbling/ZX-Spectrum-Basic/comma-quibbling.zx b/Task/Comma-quibbling/ZX-Spectrum-Basic/comma-quibbling.zx new file mode 100644 index 0000000000..02594b0fe5 --- /dev/null +++ b/Task/Comma-quibbling/ZX-Spectrum-Basic/comma-quibbling.zx @@ -0,0 +1,20 @@ +10 DATA 0 +20 DATA 1,"ABC" +30 DATA 2,"ABC","DEF" +40 DATA 4,"ABC","DEF","G","H" +50 FOR n=10 TO 40 STEP 10 +60 RESTORE n: GO SUB 1000 +70 NEXT n +80 STOP +1000 REM quibble +1010 LET s$="" +1020 READ j +1030 IF j=0 THEN GO TO 1100 +1040 FOR i=1 TO j +1050 READ a$ +1060 LET s$=s$+a$ +1070 IF (i+1)=j THEN LET s$=s$+" and ": GO TO 1090 +1080 IF (i+1)) { + println("There are " + args.size + " arguments given.") + args.forEachIndexed { i, a -> println("The argument #${i+1} is $a and is at index $i") } +} diff --git a/Task/Command-line-arguments/TXR/command-line-arguments-2.txr b/Task/Command-line-arguments/TXR/command-line-arguments-2.txr index d7865d6dd1..e0fbc068f1 100644 --- a/Task/Command-line-arguments/TXR/command-line-arguments-2.txr +++ b/Task/Command-line-arguments/TXR/command-line-arguments-2.txr @@ -1,4 +1,3 @@ -@(do - (tree-case *args* - ((a b c) (put-line "got three args, thanks!")) - (else (put-line `usage: @(ldiff *full-args* *args*) `)))) +(tree-case *args* + ((a b c) (put-line "got three args, thanks!")) + (else (put-line `usage: @(ldiff *full-args* *args*) `))) diff --git a/Task/Comments/00DESCRIPTION b/Task/Comments/00DESCRIPTION index 17a2680322..55b952c7b3 100644 --- a/Task/Comments/00DESCRIPTION +++ b/Task/Comments/00DESCRIPTION @@ -1,7 +1,14 @@ -All ways to include text in a language source file +;Task: +Show all ways to include text in a language source file that's completely ignored by the compiler or interpreter. -'''See Also:'''
    -* Related Task: [[Documentation]] -* [https://en.wikipedia.org/wiki/Comment_(computer_programming) Wikipedia] -* [http://xkcd.com/156 xkcd] (Humor: hand gesture denoting // for "commenting out" people.) + +;Related tasks: +*   [[Documentation]] +*   [[Here_document]] + + +;See also: +*   [https://en.wikipedia.org/wiki/Comment_(computer_programming) Wikipedia] +*   [http://xkcd.com/156 xkcd] (Humor: hand gesture denoting // for "commenting out" people.) +

    diff --git a/Task/Comments/APL/comments.apl b/Task/Comments/APL/comments.apl new file mode 100644 index 0000000000..f9d49138fe --- /dev/null +++ b/Task/Comments/APL/comments.apl @@ -0,0 +1 @@ +⍝ This is a comment diff --git a/Task/Comments/Agena/comments.agena b/Task/Comments/Agena/comments.agena new file mode 100644 index 0000000000..f36e7d9a93 --- /dev/null +++ b/Task/Comments/Agena/comments.agena @@ -0,0 +1,9 @@ +# single line comment + +#/ multi-line comment + - ends with the "/ followed by #" terminator on the next line +/# + +/* multi-line comment - C-style + - ends with the "* followed by /" terminator on the next line +*/ diff --git a/Task/Comments/AppleScript/comments-1.applescript b/Task/Comments/AppleScript/comments-1.applescript new file mode 100644 index 0000000000..2c034ba02f --- /dev/null +++ b/Task/Comments/AppleScript/comments-1.applescript @@ -0,0 +1,12 @@ +--This is a single line comment + +display dialog "ok" --it can go at the end of a line + +# Hash style comments are also supported + +(* This is a multi +line comment*) + +(* This is a comment. --comments can be nested + (* Nested block comment *) +*) diff --git a/Task/Comments/AppleScript/comments-2.applescript b/Task/Comments/AppleScript/comments-2.applescript new file mode 100644 index 0000000000..e12016be28 --- /dev/null +++ b/Task/Comments/AppleScript/comments-2.applescript @@ -0,0 +1 @@ +display dialog "ok" #Starting in version 2.0, end-line comments can begin with a hash diff --git a/Task/Comments/COBOL/comments-6.cobol b/Task/Comments/COBOL/comments-6.cobol new file mode 100644 index 0000000000..0971be427f --- /dev/null +++ b/Task/Comments/COBOL/comments-6.cobol @@ -0,0 +1,11 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. program. + + AUTHOR. Rest of line ignored. + REMARKS. Rest of line ignored. + REMARKS. More remarks. + SECURITY. line ignored. + INSTALLATION. line ignored. + DATE-WRITTEN. same, human readable dates are allowed for instance + DATE-COMPILED. same. + DATE-MODIFIED. this one is handy when auto-stamped by an editor. diff --git a/Task/Comments/Elena/comments.elena b/Task/Comments/Elena/comments.elena new file mode 100644 index 0000000000..32cd4a06e6 --- /dev/null +++ b/Task/Comments/Elena/comments.elena @@ -0,0 +1,4 @@ +//single line comment + +/*multiple line +comment*/ diff --git a/Task/Comments/Frink/comments.frink b/Task/Comments/Frink/comments.frink index 0471859017..cb1f6579cf 100644 --- a/Task/Comments/Frink/comments.frink +++ b/Task/Comments/Frink/comments.frink @@ -1,5 +1,4 @@ // This is a single-line comment - /* This is a comment that spans multiple lines and so on. diff --git a/Task/Comments/Processing/comments b/Task/Comments/Processing/comments new file mode 100644 index 0000000000..01c400c636 --- /dev/null +++ b/Task/Comments/Processing/comments @@ -0,0 +1,10 @@ +// a single-line comment + +/* a multi-line + comment +*/ + +/* + * a multi-line comment + * with some decorative stars + */ diff --git a/Task/Comments/REXX/comments-1.rexx b/Task/Comments/REXX/comments-1.rexx index 53d5fc0f44..e0d19a17a8 100644 --- a/Task/Comments/REXX/comments-1.rexx +++ b/Task/Comments/REXX/comments-1.rexx @@ -1,42 +1,3 @@ -/*REXX program to demonstrate various uses and types of comments. */ - -/* everything between a "climbstar" and a "starclimb" (exclusive of literals) is - a comment. - climbstar = /* [slash-asterisk] - starclimb = */ [asterisk-slash] - - /* this is a nested comment, by gum! */ - /*so is this*/ - -Also, REXX comments can span multiple records. - -There can be no intervening character between the slash and asterisk (or -the asterisk and slash). These two joined characters cannot be separated -via a continued line, as in the manner of: - - say 'If I were two─faced,' , - 'would I be wearing this one?' , - ' --- Abraham Lincoln' - - Here comes the thingy that ends this REXX comment. ───┐ - │ - │ - ↓ - - */ - - hour = 12 /*high noon */ -midnight = 00 /*first hour of the day */ - suits = 1234 /*card suits: ♥ ♦ ♣ ♠ */ - -hutchHdr = '/*' -hutchEnd = "*/" - - /* the previous two "hutch" assignments aren't - the start nor the end of a REXX comment. */ - - x=1000000 ** /*¡big power!*/ 1000 - -/*not a real good place for a comment (above), - but essentially, a REXX comment can be - anywhere whitespace is allowed. */ +/*REXX program that demonstrates what happens when dividing by zero. */ +y=7 +say 44 / (7-y) /* divide by some strange thingy.*/ diff --git a/Task/Comments/REXX/comments-2.rexx b/Task/Comments/REXX/comments-2.rexx index 2d869f5121..53d5fc0f44 100644 --- a/Task/Comments/REXX/comments-2.rexx +++ b/Task/Comments/REXX/comments-2.rexx @@ -1,2 +1,42 @@ --- A REXX line comment -say "something" -- another line comment +/*REXX program to demonstrate various uses and types of comments. */ + +/* everything between a "climbstar" and a "starclimb" (exclusive of literals) is + a comment. + climbstar = /* [slash-asterisk] + starclimb = */ [asterisk-slash] + + /* this is a nested comment, by gum! */ + /*so is this*/ + +Also, REXX comments can span multiple records. + +There can be no intervening character between the slash and asterisk (or +the asterisk and slash). These two joined characters cannot be separated +via a continued line, as in the manner of: + + say 'If I were two─faced,' , + 'would I be wearing this one?' , + ' --- Abraham Lincoln' + + Here comes the thingy that ends this REXX comment. ───┐ + │ + │ + ↓ + + */ + + hour = 12 /*high noon */ +midnight = 00 /*first hour of the day */ + suits = 1234 /*card suits: ♥ ♦ ♣ ♠ */ + +hutchHdr = '/*' +hutchEnd = "*/" + + /* the previous two "hutch" assignments aren't + the start nor the end of a REXX comment. */ + + x=1000000 ** /*¡big power!*/ 1000 + +/*not a real good place for a comment (above), + but essentially, a REXX comment can be + anywhere whitespace is allowed. */ diff --git a/Task/Comments/REXX/comments-3.rexx b/Task/Comments/REXX/comments-3.rexx new file mode 100644 index 0000000000..f2b812c838 --- /dev/null +++ b/Task/Comments/REXX/comments-3.rexx @@ -0,0 +1,2 @@ +-- A REXX line comment (maybe) +say "something" -- another line comment (maybe) diff --git a/Task/Compare-sorting-algorithms-performance/Go/compare-sorting-algorithms-performance.go b/Task/Compare-sorting-algorithms-performance/Go/compare-sorting-algorithms-performance.go new file mode 100644 index 0000000000..91fa21825f --- /dev/null +++ b/Task/Compare-sorting-algorithms-performance/Go/compare-sorting-algorithms-performance.go @@ -0,0 +1,222 @@ +package main + +import ( + "log" + "math/rand" + "testing" + "time" + + "github.com/gonum/plot" + "github.com/gonum/plot/plotter" + "github.com/gonum/plot/plotutil" + "github.com/gonum/plot/vg" +) + +// Step 1, sort routines. +// These functions are copied without changes from the RC tasks Bubble Sort, +// Insertion sort, and Quicksort. + +func bubblesort(a []int) { + for itemCount := len(a) - 1; ; itemCount-- { + hasChanged := false + for index := 0; index < itemCount; index++ { + if a[index] > a[index+1] { + a[index], a[index+1] = a[index+1], a[index] + hasChanged = true + } + } + if hasChanged == false { + break + } + } +} + +func insertionsort(a []int) { + for i := 1; i < len(a); i++ { + value := a[i] + j := i - 1 + for j >= 0 && a[j] > value { + a[j+1] = a[j] + j = j - 1 + } + a[j+1] = value + } +} + +func quicksort(a []int) { + var pex func(int, int) + pex = func(lower, upper int) { + for { + switch upper - lower { + case -1, 0: + return + case 1: + if a[upper] < a[lower] { + a[upper], a[lower] = a[lower], a[upper] + } + return + } + bx := (upper + lower) / 2 + b := a[bx] + lp := lower + up := upper + outer: + for { + for lp < upper && !(b < a[lp]) { + lp++ + } + for { + if lp > up { + break outer + } + if a[up] < b { + break + } + up-- + } + a[lp], a[up] = a[up], a[lp] + lp++ + up-- + } + if bx < lp { + if bx < lp-1 { + a[bx], a[lp-1] = a[lp-1], b + } + up = lp - 2 + } else { + if bx > lp { + a[bx], a[lp] = a[lp], b + } + up = lp - 1 + lp++ + } + if up-lower < upper-lp { + pex(lower, up) + lower = lp + } else { + pex(lp, upper) + upper = up + } + } + } + pex(0, len(a)-1) +} + +// Step 2.0 sequence routines. 2.0 is the easy part. 2.5, timings, follows. + +func ones(n int) []int { + s := make([]int, n) + for i := range s { + s[i] = 1 + } + return s +} + +func ascending(n int) []int { + s := make([]int, n) + v := 1 + for i := 0; i < n; { + if rand.Intn(3) == 0 { + s[i] = v + i++ + } + v++ + } + return s +} + +func shuffled(n int) []int { + return rand.Perm(n) +} + +// Steps 2.5 write timings, and 3 plot timings are coded together. +// If write means format and output human readable numbers, step 2.5 +// is satisfied with the log output as the program runs. The timings +// are plotted immediately however for step 3, not read and parsed from +// any formated output. +const ( + nPts = 7 // number of points per test + inc = 1000 // data set size increment per point +) + +var ( + p *plot.Plot + sortName = []string{"Bubble sort", "Insertion sort", "Quicksort"} + sortFunc = []func([]int){bubblesort, insertionsort, quicksort} + dataName = []string{"Ones", "Ascending", "Shuffled"} + dataFunc = []func(int) []int{ones, ascending, shuffled} +) + +func main() { + rand.Seed(time.Now().Unix()) + var err error + p, err = plot.New() + if err != nil { + log.Fatal(err) + } + p.X.Label.Text = "Data size" + p.Y.Label.Text = "microseconds" + p.Y.Scale = plot.LogScale{} + p.Y.Tick.Marker = plot.LogTicks{} + p.Y.Min = .5 // hard coded to make enough room for legend + + for dx, name := range dataName { + s, err := plotter.NewScatter(plotter.XYs{}) + if err != nil { + log.Fatal(err) + } + s.Shape = plotutil.DefaultGlyphShapes[dx] + p.Legend.Add(name, s) + } + for sx, name := range sortName { + l, err := plotter.NewLine(plotter.XYs{}) + if err != nil { + log.Fatal(err) + } + l.Color = plotutil.DarkColors[sx] + p.Legend.Add(name, l) + } + for sx := range sortFunc { + bench(sx, 0, 1) // for ones, a single timing is sufficient. + bench(sx, 1, 5) // ascending and shuffled have some randomness though, + bench(sx, 2, 5) // so average timings on 5 different random sets. + } + + if err := p.Save(5*vg.Inch, 5*vg.Inch, "comp.png"); err != nil { + log.Fatal(err) + } +} + +func bench(sx, dx, rep int) { + log.Println("bench", sortName[sx], dataName[dx], "x", rep) + pts := make(plotter.XYs, nPts) + sf := sortFunc[sx] + for i := range pts { + x := (i + 1) * inc + // to avoid timing sequence creation, create sequence before timing + // then just copy the data inside the timing loop. copy time should + // be the same regardless of sequence data. + s0 := dataFunc[dx](x) // reference sequence + s := make([]int, x) // working copy + var tSort int64 + for j := 0; j < rep; j++ { + tSort += testing.Benchmark(func(b *testing.B) { + for i := 0; i < b.N; i++ { + copy(s, s0) + sf(s) + } + }).NsPerOp() + } + tSort /= int64(rep) + log.Println(x, "items", tSort, "ns") // step 2.5, write timings + pts[i] = struct{ X, Y float64 }{float64(x), float64(tSort) * .001} + } + pl, ps, err := plotter.NewLinePoints(pts) // step 3, plot timings + if err != nil { + log.Fatal(err) + } + pl.Color = plotutil.DarkColors[sx] + ps.Color = plotutil.DarkColors[sx] + ps.Shape = plotutil.DefaultGlyphShapes[dx] + p.Add(pl, ps) +} diff --git a/Task/Compile-time-calculation/00DESCRIPTION b/Task/Compile-time-calculation/00DESCRIPTION index d3a6b46585..8517cb0353 100644 --- a/Task/Compile-time-calculation/00DESCRIPTION +++ b/Task/Compile-time-calculation/00DESCRIPTION @@ -1,3 +1,10 @@ -Some programming languages allow calculation of values at compile time. For this task, calculate 10! at compile time. Print the result when the program is run. +Some programming languages allow calculation of values at compile time. + + +;Task: +Calculate   10!   (ten factorial)   at compile time. + +Print the result when the program is run. Discuss what limitations apply to compile-time calculations in your language. +

    diff --git a/Task/Compile-time-calculation/C/compile-time-calculation.c b/Task/Compile-time-calculation/C/compile-time-calculation-1.c similarity index 100% rename from Task/Compile-time-calculation/C/compile-time-calculation.c rename to Task/Compile-time-calculation/C/compile-time-calculation-1.c diff --git a/Task/Compile-time-calculation/C/compile-time-calculation-2.c b/Task/Compile-time-calculation/C/compile-time-calculation-2.c new file mode 100644 index 0000000000..578cb5ec46 --- /dev/null +++ b/Task/Compile-time-calculation/C/compile-time-calculation-2.c @@ -0,0 +1,6 @@ +#include +const int val = 2*3*4*5*6*7*8*9*10; +int main(void) { + printf("10! = %d\n", val ); + return 0; +} diff --git a/Task/Compile-time-calculation/REXX/compile-time-calculation.rexx b/Task/Compile-time-calculation/REXX/compile-time-calculation.rexx index 3056ded832..a50e4bf03d 100644 --- a/Task/Compile-time-calculation/REXX/compile-time-calculation.rexx +++ b/Task/Compile-time-calculation/REXX/compile-time-calculation.rexx @@ -1,3 +1,6 @@ -/*REXX program to compute 10!*/ say '10! =' !(10); exit +/*REXX program computes 10! (ten factorial) during REXX's equivalent of "compile─time". */ -!: procedure; !=1; do j=2 to arg(1); !=!*j; end; return ! +say '10! =' !(10) +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +!: procedure; !=1; do j=2 to arg(1); !=!*j; end /*j*/; return ! diff --git a/Task/Compound-data-type/00DESCRIPTION b/Task/Compound-data-type/00DESCRIPTION index f8a1b48e0a..f023d98ae2 100644 --- a/Task/Compound-data-type/00DESCRIPTION +++ b/Task/Compound-data-type/00DESCRIPTION @@ -1,7 +1,16 @@ {{Data structure}} -Create a compound data type Point(x,y). + +;Task: +Create a compound data type: + Point(x,y) + A compound data type is one that holds multiple independent values. -See also [[Enumeration]]. + + +;Related task: +*   [[Enumeration]] + {{Template:See also lists}} +

    diff --git a/Task/Compound-data-type/Elixir/compound-data-type.elixir b/Task/Compound-data-type/Elixir/compound-data-type.elixir new file mode 100644 index 0000000000..73d2cef88b --- /dev/null +++ b/Task/Compound-data-type/Elixir/compound-data-type.elixir @@ -0,0 +1,18 @@ +iex(1)> defmodule Point do +...(1)> defstruct x: 0, y: 0 +...(1)> end +{:module, Point, <<70, 79, 82, ...>>, %Point{x: 0, y: 0}} +iex(2)> origin = %Point{} +%Point{x: 0, y: 0} +iex(3)> pa = %Point{x: 10, y: 20} +%Point{x: 10, y: 20} +iex(4)> pa.x +10 +iex(5)> %Point{pa | y: 30} +%Point{x: 10, y: 30} +iex(6)> %Point{x: px, y: py} = pa # pattern matching +%Point{x: 10, y: 20} +iex(7)> px +10 +iex(8)> py +20 diff --git a/Task/Compound-data-type/PowerShell/compound-data-type.psh b/Task/Compound-data-type/PowerShell/compound-data-type.psh new file mode 100644 index 0000000000..a56b5d9815 --- /dev/null +++ b/Task/Compound-data-type/PowerShell/compound-data-type.psh @@ -0,0 +1,18 @@ +class Point { + [Int]$a + [Int]$b + Point() { + $this.a = 0 + $this.b = 0 + } + Point([Int]$a, [Int]$b) { + $this.a = $a + $this.b = $b + } + [Int]add() {return $this.a + $this.b} + [Int]mul() {return $this.a * $this.b} +} +$p1 = [Point]::new() +$p2 = [Point]::new(3,2) +$p1.add() +$p2.mul() diff --git a/Task/Compound-data-type/PureBasic/compound-data-type.purebasic b/Task/Compound-data-type/PureBasic/compound-data-type.purebasic new file mode 100644 index 0000000000..c4b19c5db8 --- /dev/null +++ b/Task/Compound-data-type/PureBasic/compound-data-type.purebasic @@ -0,0 +1,4 @@ +Structure MyPoint + x.i + y.i +EndStructure diff --git a/Task/Compound-data-type/Rust/compound-data-type-1.rust b/Task/Compound-data-type/Rust/compound-data-type-1.rust new file mode 100644 index 0000000000..90c390ca0c --- /dev/null +++ b/Task/Compound-data-type/Rust/compound-data-type-1.rust @@ -0,0 +1,9 @@ + // Defines a generic struct where x and y can be of any type T +struct Point { + x: T, + y: T, +} +fn main() { + let p = Point { x: 1.0, y: 2.5 }; // p is of type Point + println!("{}, {}", p.x, p.y); +} diff --git a/Task/Compound-data-type/Rust/compound-data-type-2.rust b/Task/Compound-data-type/Rust/compound-data-type-2.rust new file mode 100644 index 0000000000..cd04a1628b --- /dev/null +++ b/Task/Compound-data-type/Rust/compound-data-type-2.rust @@ -0,0 +1,5 @@ +struct Point(T, T); +fn main() { + let p = Point(1.0, 2.5); + println!("{},{}", p.0, p.1); +} diff --git a/Task/Compound-data-type/Rust/compound-data-type-3.rust b/Task/Compound-data-type/Rust/compound-data-type-3.rust new file mode 100644 index 0000000000..1a78a5488c --- /dev/null +++ b/Task/Compound-data-type/Rust/compound-data-type-3.rust @@ -0,0 +1,4 @@ + fn main() { + let p = (0.0, 2.4); + println!("{},{}", p.0, p.1); +} diff --git a/Task/Concurrent-computing/00DESCRIPTION b/Task/Concurrent-computing/00DESCRIPTION index fe26cd2fcf..84b150c1b4 100644 --- a/Task/Concurrent-computing/00DESCRIPTION +++ b/Task/Concurrent-computing/00DESCRIPTION @@ -1 +1,5 @@ -Using either native language concurrency syntax or freely available libraries write a program to display the strings "Enjoy" "Rosetta" "Code", one string per line, in random order. Concurrency syntax must use [[thread|threads]], tasks, co-routines, or whatever concurrency is called in your language. +;Task: +Using either native language concurrency syntax or freely available libraries, write a program to display the strings "Enjoy" "Rosetta" "Code", one string per line, in random order. + +Concurrency syntax must use [[thread|threads]], tasks, co-routines, or whatever concurrency is called in your language. +

    diff --git a/Task/Concurrent-computing/Elixir/concurrent-computing.elixir b/Task/Concurrent-computing/Elixir/concurrent-computing.elixir new file mode 100644 index 0000000000..8d6a40e75b --- /dev/null +++ b/Task/Concurrent-computing/Elixir/concurrent-computing.elixir @@ -0,0 +1,9 @@ +defmodule ConcurrentComputing do + def print(xs) do + Enum.map(xs, fn x -> + spawn(fn -> IO.puts x end) + end) + end +end + +ConcurrentComputing.print ["Enjoy", "Rosetta", "Code"] diff --git a/Task/Conditional-structures/00DESCRIPTION b/Task/Conditional-structures/00DESCRIPTION index a24865feb3..b1fb35049f 100644 --- a/Task/Conditional-structures/00DESCRIPTION +++ b/Task/Conditional-structures/00DESCRIPTION @@ -1,3 +1,8 @@ -{{Control Structures}} [[Category:Simple]] -This page lists the conditional structures offered by different programming languages. -Common conditional structures are '''if-then-else''' and '''switch'''. +{{Control Structures}} +[[Category:Simple]] + +;Task: +List the   ''conditional structures''   offered by a programming language. + +Common conditional structures are     '''if-then-else'''     and     '''switch'''. +

    diff --git a/Task/Conditional-structures/360-Assembly/conditional-structures.360 b/Task/Conditional-structures/360-Assembly/conditional-structures-1.360 similarity index 100% rename from Task/Conditional-structures/360-Assembly/conditional-structures.360 rename to Task/Conditional-structures/360-Assembly/conditional-structures-1.360 diff --git a/Task/Conditional-structures/360-Assembly/conditional-structures-2.360 b/Task/Conditional-structures/360-Assembly/conditional-structures-2.360 new file mode 100644 index 0000000000..d3caaff5a6 --- /dev/null +++ b/Task/Conditional-structures/360-Assembly/conditional-structures-2.360 @@ -0,0 +1,73 @@ + expression: + opcode,op1,rel,op2 + opcode,op1,rel,op2,OR,opcode,op1,rel,op2 + opcode,op1,rel,op2,AND,opcode,op1,rel,op2 + opcode::=C,CH,CR,CLC,CLI,CLCL, LTR, CP,CE,CD,... + rel::=EQ,NE,LT,LE,GT,GE, (fortran style) + E,L,H,NE,NL,NH (assembler style) + P (plus), M (minus) ,Z (zero) ,O (overflow) + opcode::=CLM,TM + rel::=O (ones),M (mixed) ,Z (zeros) + +* IF + IF expression [THEN] + ... + ELSEIF expression [THEN] + ... + ELSE + ... + ENDIF + + IF C,R4,EQ,=F'10' THEN if r4=10 then + MVI PG,C'A' pg='A' + ELSEIF C,R4,EQ,=F'11' THEN elseif r4=11 then + MVI PG,C'B' pg='B' + ELSEIF C,R4,EQ,=F'12' THEN elseif r4=12 then + MVI PG,C'C' pg='C' + ELSE else + MV PG,C'?' pg='?' + ENDIF end if + +* SELECT + SELECT expressionpart1 + WHEN expressionpart2a + ... + WHEN expressionpart2b + ... + OTHRWISE + ... + ENDSEL + +* example SELECT type 1 + SELECT CLI,HEXAFLAG,EQ select hexaflag= + WHEN X'20' when x'20' + MVI PG,C'<' pg='<' + WHEN X'21' when x'21' + MVI PG,C'!' pg='!' + WHEN X'22' when x'21' + MVI PG,C'>' pg='>' + OTHRWISE otherwise + MVI PG,C'?' pg='?' + ENDSEL end select + +* example SELECT type 2 + SELECT select + WHEN C,DELTA,LT,0 when delta<0 + MVC PG,=C'0 SOL' pg='0 SOL' + WHEN C,DELTA,EQ,0 when delta=0 + MVC PG,=C'1 SOL'' pg='0 SOL' + WHEN C,DELTA,GT,0 when delta>0 + MVC PG,=C'2 SOL'' pg='0 SOL' + ENDSEL end select + +* CASE + CASENTRY R4 select case r4 + CASE 1 case 1 + LA R5,1 r5=1 + CASE 3 case 3 + LA R5,2 r5=2 + CASE 5 case 5 + LA R5,3 r5=1 + CASE 7 case 7 + LA R5,4 r5=4 + ENDCASE end select diff --git a/Task/Conditional-structures/Perl/conditional-structures-1.pl b/Task/Conditional-structures/Perl/conditional-structures-1.pl new file mode 100644 index 0000000000..998e75e753 --- /dev/null +++ b/Task/Conditional-structures/Perl/conditional-structures-1.pl @@ -0,0 +1,3 @@ +if ($expression) { + do_something; +} diff --git a/Task/Conditional-structures/Perl/conditional-structures-2.pl b/Task/Conditional-structures/Perl/conditional-structures-2.pl new file mode 100644 index 0000000000..a833aac47e --- /dev/null +++ b/Task/Conditional-structures/Perl/conditional-structures-2.pl @@ -0,0 +1,2 @@ +# postfix conditional +do_something if $expression; diff --git a/Task/Conditional-structures/Perl/conditional-structures-3.pl b/Task/Conditional-structures/Perl/conditional-structures-3.pl new file mode 100644 index 0000000000..a9fd8a9e6f --- /dev/null +++ b/Task/Conditional-structures/Perl/conditional-structures-3.pl @@ -0,0 +1,6 @@ +if ($expression) { + do_something; +} +else { + do_fallback; +} diff --git a/Task/Conditional-structures/Perl/conditional-structures-4.pl b/Task/Conditional-structures/Perl/conditional-structures-4.pl new file mode 100644 index 0000000000..74b41ee69e --- /dev/null +++ b/Task/Conditional-structures/Perl/conditional-structures-4.pl @@ -0,0 +1,9 @@ +if ($expression1) { + do_something; +} +elsif ($expression2) { + do_something_different; +} +else { + do_fallback; +} diff --git a/Task/Conditional-structures/Perl/conditional-structures-5.pl b/Task/Conditional-structures/Perl/conditional-structures-5.pl new file mode 100644 index 0000000000..d33f5fab08 --- /dev/null +++ b/Task/Conditional-structures/Perl/conditional-structures-5.pl @@ -0,0 +1 @@ +$variable = $expression ? $value_for_true : $value_for_false; diff --git a/Task/Conditional-structures/Perl/conditional-structures-6.pl b/Task/Conditional-structures/Perl/conditional-structures-6.pl new file mode 100644 index 0000000000..637e7ac1f2 --- /dev/null +++ b/Task/Conditional-structures/Perl/conditional-structures-6.pl @@ -0,0 +1 @@ +$condition and do_something; # equivalent to $condition ? do_something : $condition diff --git a/Task/Conditional-structures/Perl/conditional-structures-7.pl b/Task/Conditional-structures/Perl/conditional-structures-7.pl new file mode 100644 index 0000000000..3f3a382f44 --- /dev/null +++ b/Task/Conditional-structures/Perl/conditional-structures-7.pl @@ -0,0 +1 @@ +$condition or do_something; # equivalent to $condition ? $condition : do_something diff --git a/Task/Conditional-structures/Perl/conditional-structures.pl b/Task/Conditional-structures/Perl/conditional-structures-8.pl similarity index 100% rename from Task/Conditional-structures/Perl/conditional-structures.pl rename to Task/Conditional-structures/Perl/conditional-structures-8.pl diff --git a/Task/Conjugate-transpose/00DESCRIPTION b/Task/Conjugate-transpose/00DESCRIPTION index 96d9423e8f..04cafbc89b 100644 --- a/Task/Conjugate-transpose/00DESCRIPTION +++ b/Task/Conjugate-transpose/00DESCRIPTION @@ -1,15 +1,32 @@ -Suppose that a [[matrix]] M contains [[Arithmetic/Complex|complex numbers]]. Then the [[wp:conjugate transpose|conjugate transpose]] of M is a matrix M^H containing the [[complex conjugate]]s of the [[matrix transposition]] of M. +Suppose that a [[matrix]] M contains [[Arithmetic/Complex|complex numbers]]. Then the [[wp:conjugate transpose|conjugate transpose]] of M is a matrix M^H containing the [[complex conjugate]]s of the [[matrix transposition]] of M. -: (M^H)_{ji} = \overline{M_{ij}} +::: (M^H)_{ji} = \overline{M_{ij}} -This means that row j, column i of the conjugate transpose equals the complex conjugate of row i, column j of the original matrix. -In the next list, M must also be a square matrix. +This means that row j, column i of the conjugate transpose equals the +
    complex conjugate of row i, column j of the original matrix. + + +In the next list, M must also be a square matrix. * A [[wp:Hermitian matrix|Hermitian matrix]] equals its own conjugate transpose: M^H = M. * A [[wp:normal matrix|normal matrix]] is commutative in [[matrix multiplication|multiplication]] with its conjugate transpose: M^HM = MM^H. -* A [[wp:unitary matrix|unitary matrix]] has its [[inverse matrix|inverse]] equal to its conjugate transpose: M^H = M^{-1}. This is true [[wikt:iff|iff]] M^HM = I_n and iff MM^H = I_n, where I_n is the identity matrix. +* A [[wp:unitary matrix|unitary matrix]] has its [[inverse matrix|inverse]] equal to its conjugate transpose: M^H = M^{-1}.
    This is true [[wikt:iff|iff]] M^HM = I_n and iff MM^H = I_n, where I_n is the identity matrix. -Given some matrix of complex numbers, find its conjugate transpose. Also determine if it is a Hermitian matrix, normal matrix, or a unitary matrix. -* MathWorld: [http://mathworld.wolfram.com/ConjugateTranspose.html conjugate transpose], [http://mathworld.wolfram.com/HermitianMatrix.html Hermitian matrix], [http://mathworld.wolfram.com/NormalMatrix.html normal matrix], [http://mathworld.wolfram.com/UnitaryMatrix.html unitary matrix] +
    +;Task: +Given some matrix of complex numbers, find its conjugate transpose. + +Also determine if the matrix is a: +::* Hermitian matrix, +::* normal matrix, or +::* unitary matrix. + + +;See also: +* MathWorld entry: [http://mathworld.wolfram.com/ConjugateTranspose.html conjugate transpose] +* MathWorld entry: [http://mathworld.wolfram.com/HermitianMatrix.html Hermitian matrix] +* MathWorld entry: [http://mathworld.wolfram.com/NormalMatrix.html normal matrix] +* MathWorld entry: [http://mathworld.wolfram.com/UnitaryMatrix.html unitary matrix] +

    diff --git a/Task/Conjugate-transpose/Common-Lisp/conjugate-transpose.lisp b/Task/Conjugate-transpose/Common-Lisp/conjugate-transpose.lisp new file mode 100644 index 0000000000..8987ebece9 --- /dev/null +++ b/Task/Conjugate-transpose/Common-Lisp/conjugate-transpose.lisp @@ -0,0 +1,30 @@ +(defun matrix-multiply (m1 m2) + (mapcar + (lambda (row) + (apply #'mapcar + (lambda (&rest column) + (apply #'+ (mapcar #'* row column))) m2)) m1)) + +(defun identity-p (m &optional (tolerance 1e-6)) + "Is m an identity matrix?" + (loop for row in m + for r = 1 then (1+ r) do + (loop for col in row + for c = 1 then (1+ c) do + (if (eql r c) + (unless (< (abs (- col 1)) tolerance) (return-from identity-p nil)) + (unless (< (abs col) tolerance) (return-from identity-p nil)) ))) + T ) + +(defun conjugate-transpose (m) + (apply #'mapcar #'list (mapcar #'(lambda (r) (mapcar #'conjugate r)) m)) ) + +(defun hermitian-p (m) + (equalp m (conjugate-transpose m))) + +(defun normal-p (m) + (let ((m* (conjugate-transpose m))) + (equalp (matrix-multiply m m*) (matrix-multiply m* m)) )) + +(defun unitary-p (m) + (identity-p (matrix-multiply m (conjugate-transpose m))) ) diff --git a/Task/Conjugate-transpose/Haskell/conjugate-transpose.hs b/Task/Conjugate-transpose/Haskell/conjugate-transpose.hs new file mode 100644 index 0000000000..bd213d5290 --- /dev/null +++ b/Task/Conjugate-transpose/Haskell/conjugate-transpose.hs @@ -0,0 +1,45 @@ +import Data.List (transpose) +import Data.Complex + +type Matrix a = [[a]] + +main :: IO () +main = + mapM_ (\a -> do + putStrLn "\nMatrix:" + mapM_ print a + putStrLn "Conjugate Transpose:" + mapM_ print (conjTranspose a) + putStrLn $ "Hermitian? " ++ show (isHermitianMatrix a) + putStrLn $ "Normal? " ++ show (isNormalMatrix a) + putStrLn $ "Unitary? " ++ show (isUnitaryMatrix a)) + ([[[3, 2:+1], + [2:+(-1), 1 ]], + + [[1, 1, 0], + [0, 1, 1], + [1, 0, 1]], + + [[sqrt 2/2:+0, sqrt 2/2:+0, 0 ], + [0:+sqrt 2/2, 0:+ (-sqrt 2/2), 0 ], + [0, 0, 0:+1]]] :: [Matrix (Complex Double)]) + +isHermitianMatrix, isNormalMatrix, isUnitaryMatrix :: RealFloat a => Matrix (Complex a) -> Bool +isHermitianMatrix a = a `approxEqualMatrix` conjTranspose a +isNormalMatrix a = (a `mmul` conjTranspose a) `approxEqualMatrix` (conjTranspose a `mmul` a) +isUnitaryMatrix a = (a `mmul` conjTranspose a) `approxEqualMatrix` ident (length a) + +approxEqualMatrix :: (Fractional a, Ord a) => Matrix (Complex a) -> Matrix (Complex a) -> Bool +approxEqualMatrix a b = length a == length b && length (head a) == length (head b) && + and (zipWith approxEqualComplex (concat a) (concat b)) + where approxEqualComplex (rx :+ ix) (ry :+ iy) = abs (rx - ry) < eps && abs (ix - iy) < eps + eps = 1e-14 + +mmul :: Num a => Matrix a -> Matrix a -> Matrix a +mmul a b = [[sum (zipWith (*) row column) | column <- transpose b] | row <- a] + +ident :: Num a => Int -> Matrix a +ident size = [[fromIntegral $ div a b * div b a | a <- [1..size]] | b <- [1..size]] + +conjTranspose :: Num a => Matrix (Complex a) -> Matrix (Complex a) +conjTranspose = map (map conjugate) . transpose diff --git a/Task/Conjugate-transpose/Perl-6/conjugate-transpose.pl6 b/Task/Conjugate-transpose/Perl-6/conjugate-transpose.pl6 new file mode 100644 index 0000000000..9953d5b786 --- /dev/null +++ b/Task/Conjugate-transpose/Perl-6/conjugate-transpose.pl6 @@ -0,0 +1,52 @@ +for [ # Test Matrices + [ 1, 1+i, 2i], + [ 1-i, 5, -3], + [0-2i, -3, 0] + ], + [ + [1, 1, 0], + [0, 1, 1], + [1, 0, 1] + ], + [ + [0.707 , 0.707, 0], + [0.707i, 0-0.707i, 0], + [0 , 0, i] + ] + -> @m { + say "\nMatrix:"; + @m.&say-it; + my @t = @m».conj.&mat-trans; + say "\nTranspose:"; + @t.&say-it; + say "Is Hermitian?\t{is-Hermitian(@m, @t)}"; + say "Is Normal?\t{is-Normal(@m, @t)}"; + say "Is Unitary?\t{is-Unitary(@m, @t)}"; + } + +sub is-Hermitian (@m, @t, --> Bool) { + so @m».Complex eqv @t».Complex + } + +sub is-Normal (@m, @t, --> Bool) { + so mat-mult(@m, @t)».Complex eqv mat-mult(@t, @m)».Complex +} + +sub is-Unitary (@m, @t, --> Bool) { + so mat-mult(@m, @t, 1e-3)».Complex eqv mat-ident(+@m)».Complex; +} + +sub mat-trans (@m) { map { [ @m[*;$_] ] }, ^@m[0] } + +sub mat-ident ($n) { [ map { [ flat 0 xx $_, 1, 0 xx $n - 1 - $_ ] }, ^$n ] } + +sub mat-mult (@a, @b, \ε = 1e-15) { + my @p; + for ^@a X ^@b[0] -> ($r, $c) { + @p[$r][$c] += @a[$r][$_] * @b[$_][$c] for ^@b; + @p[$r][$c].=round(ε); # avoid floating point math errors + } + @p +} + +sub say-it (@array) { $_».fmt("%9s").say for @array } diff --git a/Task/Conjugate-transpose/Perl/conjugate-transpose.pl b/Task/Conjugate-transpose/Perl/conjugate-transpose.pl new file mode 100644 index 0000000000..4d94a1f072 --- /dev/null +++ b/Task/Conjugate-transpose/Perl/conjugate-transpose.pl @@ -0,0 +1,84 @@ +use strict; +use English; +use Math::Complex; +use Math::MatrixReal; + +my @examples = (example1(), example2(), example3()); +foreach my $m (@examples) { + print "Starting matrix:\n", cmat_as_string($m), "\n"; + my $m_ct = conjugate_transpose($m); + print "Its conjugate transpose:\n", cmat_as_string($m_ct), "\n"; + print "Is Hermitian? ", (cmats_are_equal($m, $m_ct) ? 'TRUE' : 'FALSE'), "\n"; + my $product = $m_ct * $m; + print "Is normal? ", (cmats_are_equal($product, $m * $m_ct) ? 'TRUE' : 'FALSE'), "\n"; + my $I = identity(($m->dim())[0]); + print "Is unitary? ", (cmats_are_equal($product, $I) ? 'TRUE' : 'FALSE'), "\n"; + print "\n"; +} +exit 0; + +sub cmats_are_equal { + my ($m1, $m2) = @ARG; + my $max_norm = 1.0e-7; + return abs($m1 - $m2) < $max_norm; # Math::MatrixReal overloads abs(). +} + +# Note that Math::Complex and Math::MatrixReal both overload '~', for +# complex conjugates and matrix transpositions respectively. +sub conjugate_transpose { + my $m_T = ~ shift; + my $result = $m_T->each(sub {~ $ARG[0]}); + return $result; +} + +sub cmat_as_string { + my $m = shift; + my $n_rows = ($m->dim())[0]; + my @row_strings = map { q{[} . join(q{, }, $m->row($ARG)->as_list) . q{]} } + (1 .. $n_rows); + return join("\n", @row_strings); +} + +sub identity { + my $N = shift; + my $m = new Math::MatrixReal($N, $N); + $m->one(); + return $m; +} + +sub example1 { + my $m = new Math::MatrixReal(2, 2); + $m->assign(1, 1, cplx(3, 0)); + $m->assign(1, 2, cplx(2, 1)); + $m->assign(2, 1, cplx(2, -1)); + $m->assign(2, 2, cplx(1, 0)); + return $m; +} + +sub example2 { + my $m = new Math::MatrixReal(3, 3); + $m->assign(1, 1, cplx(1, 0)); + $m->assign(1, 2, cplx(1, 0)); + $m->assign(1, 3, cplx(0, 0)); + $m->assign(2, 1, cplx(0, 0)); + $m->assign(2, 2, cplx(1, 0)); + $m->assign(2, 3, cplx(1, 0)); + $m->assign(3, 1, cplx(1, 0)); + $m->assign(3, 2, cplx(0, 0)); + $m->assign(3, 3, cplx(1, 0)); + return $m; +} + +sub example3 { + my $m = new Math::MatrixReal(3, 3); + $m->assign(1, 1, cplx(0.70710677, 0)); + $m->assign(1, 2, cplx(0.70710677, 0)); + $m->assign(1, 3, cplx(0, 0)); + $m->assign(2, 1, cplx(0, -0.70710677)); + $m->assign(2, 2, cplx(0, 0.70710677)); + $m->assign(2, 3, cplx(0, 0)); + $m->assign(3, 1, cplx(0, 0)); + $m->assign(3, 2, cplx(0, 0)); + $m->assign(3, 3, cplx(0, 1)); + return $m; +} diff --git a/Task/Conjugate-transpose/PowerShell/conjugate-transpose.psh b/Task/Conjugate-transpose/PowerShell/conjugate-transpose.psh new file mode 100644 index 0000000000..d13367615e --- /dev/null +++ b/Task/Conjugate-transpose/PowerShell/conjugate-transpose.psh @@ -0,0 +1,76 @@ +function conjugate-transpose($a) { + $arr = @() + if($a) { + $n = $a.count - 1 + if(0 -lt $n) { + $m = ($a | foreach {$_.count} | measure-object -Minimum).Minimum - 1 + if( 0 -le $m) { + if (0 -lt $m) { + $arr =@(0)*($m+1) + foreach($i in 0..$m) { + $arr[$i] = foreach($j in 0..$n) {@([System.Numerics.complex]::Conjugate($a[$j][$i]))} + } + } else {$arr = foreach($row in $a) {[System.Numerics.complex]::Conjugate($row[0])}} + } + } else {$arr = foreach($row in $a) {[System.Numerics.complex]::Conjugate($row[0])}} + } + $arr +} + +function multarrays-complex($a, $b) { + $c = @() + if($a -and $b) { + $n = $a.count - 1 + $m = $b[0].count - 1 + $c = @([System.Numerics.complex]::new(0,0))*($n+1) + foreach ($i in 0..$n) { + $c[$i] = foreach ($j in 0..$m) { + [System.Numerics.complex]$sum = [System.Numerics.complex]::new(0,0) + foreach ($k in 0..$n){$sum = [System.Numerics.complex]::Add($sum, ([System.Numerics.complex]::Multiply($a[$i][$k],$b[$k][$j])))} + $sum + } + } + } + $c +} + +function identity-complex($n) { + if(0 -lt $n) { + $array = @(0) * $n + foreach ($i in 0..($n-1)) { + $array[$i] = @([System.Numerics.complex]::new(0,0)) * $n + $array[$i][$i] = [System.Numerics.complex]::new(1,0) + } + $array + } else { @() } +} + +function are-eq ($a,$b) { -not (Compare-Object $a $b -SyncWindow 0)} + +function show($a) { + if($a) { + 0..($a.Count - 1) | foreach{ if($a[$_]){"$($a[$_])"}else{""} } + } +} +function complex($a,$b) {[System.Numerics.complex]::new($a,$b)} + +$id2 = identity-complex 2 +$m = @(@((complex 2 7), (complex 9 -5)),@((complex 3 4), (complex 8 -6))) +$hm = conjugate-transpose $m +$mhm = multarrays-complex $m $hm +$hmm = multarrays-complex $hm $m +"`$m =" +show $m +"" +"`$hm = conjugate-transpose `$m =" +show $hm +"" +"`$m * `$hm =" +show $mhm +"" +"`$hm * `$m =" +show $hmm +"" +"Hermitian? `$m = $(are-eq $m $hm)" +"Normal? `$m = $(are-eq $mhm $hmm)" +"Unitary? `$m = $((are-eq $id2 $hmm) -and (are-eq $id2 $mhm))" diff --git a/Task/Conjugate-transpose/REXX/conjugate-transpose.rexx b/Task/Conjugate-transpose/REXX/conjugate-transpose.rexx index 4c73c5bd66..7533b06e9c 100644 --- a/Task/Conjugate-transpose/REXX/conjugate-transpose.rexx +++ b/Task/Conjugate-transpose/REXX/conjugate-transpose.rexx @@ -1,87 +1,83 @@ -/*REXX pgm performs a conjugate transpose on a complex square matrix. */ -parse arg N elements; if N=='' then N=3 -M.=0 /*Matrix has all elements equal to zero*/ -k=0; do r=1 for N - do c=1 for N; k=k+1; M.r.c=word(word(elements,k) 1,1); end /*c*/ - end /*r*/ - -call showCmat 'M' ,N /*display a nicely formatted matrix. */ -identity.=0; do d=1 for N; identity.d.d=1; end /*d*/ -call conjCmat 'MH', "M" ,N /*conjugate the M matrix ───► MH */ -call showCmat 'MH' ,N /*display a nicely formatted matrix. */ +/*REXX program performs a conjugate transpose on a complex square matrix. */ +parse arg N elements; if N==''|N=="," then N=3 /*Not specified? Then use the default.*/ +k=0; do r=1 for N + do c=1 for N; k=k+1; M.r.c=word(word(elements,k) 1,1); end /*c*/ + end /*r*/ +call showCmat 'M' ,N /*display a nicely formatted matrix. */ +identity.=0; do d=1 for N; identity.d.d=1; end /*d*/ +call conjCmat 'MH', "M" ,N /*conjugate the M matrix ───► MH */ +call showCmat 'MH' ,N /*display a nicely formatted matrix. */ say 'M is Hermitian: ' word('no yes',isHermitian('M',"MH",N)+1) -call multCmat 'M', 'MH', 'MMH', N /*multiple the two matrices together. */ -call multCmat 'MH', 'M', 'MHM', N /* " " " " " */ -say ' M is Normal: ' word('no yes',isHermitian('MMH',"MHM",N)+1) -say ' M is Unary: ' word('no yes',isUnary('M',N)+1) -say 'MMH is Unary: ' word('no yes',isUnary('MMH',N)+1) -say 'MHM is Unary: ' word('no yes',isUnary('MHM',N)+1) -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────one─liner subroutines─────────────────────*/ -cP: procedure; arg ',' p; return word(strip(translate(p,,'IJ')) 0,1) -rP: procedure; parse arg r ','; return word(r 0,1) -/*────────────────────────────────────────────────────────────────────────────*/ -conjCmat: parse arg matX,matY,rows 1 cols; call normCmat matY,rows - do r=1 for rows; _= - do c=1 for cols; v=value(matY'.'r"."c) - rP=rP(v); cP=-cP(v); call value matX'.'c"."r, rP','cP - end /*c*/ - end /*r*/ +call multCmat 'M', 'MH', 'MMH', N /*multiple the two matrices together. */ +call multCmat 'MH', 'M', 'MHM', N /* " " " " " */ +say ' M is Normal: ' word('no yes', isHermitian('MMH', "MHM", N) + 1) +say ' M is Unary: ' word('no yes', isUnary('M', N) + 1) +say 'MMH is Unary: ' word('no yes', isUnary('MMH', N) + 1) +say 'MHM is Unary: ' word('no yes', isUnary('MHM', N) + 1) +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +cP: procedure; arg ',' c; return word( strip( translate(c, , 'IJ') ) 0, 1) +rP: procedure; parse arg r ','; return word( r 0, 1) /*◄──maybe return a 0 ↑ */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +conjCmat: parse arg matX,matY,rows 1 cols; call normCmat matY, rows + do r=1 for rows; _= + do c=1 for cols; v=value(matY'.'r"."c) + rP=rP(v); cP=-cP(v); call value matX'.'c"."r, rP','cP + end /*c*/ + end /*r*/ return -/*────────────────────────────────────────────────────────────────────────────*/ -isHermitian: parse arg matX,matY,rows 1 cols; call normCmat matX,rows - call normCmat matY,rows - do r=1 for rows; _= - do c=1 for cols - if value(matX'.'r"."c)\=value(matY'.'r"."c) then return 0 - end /*c*/ - end /*r*/ - return 1 -/*────────────────────────────────────────────────────────────────────────────*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +isHermitian: parse arg matX,matY,rows 1 cols; call normCmat matX, rows + call normCmat matY, rows + do r=1 for rows; _= + do c=1 for cols + if value(matX'.'r"."c) \= value(matY'.'r"."c) then return 0 + end /*c*/ + end /*r*/ + return 1 +/*──────────────────────────────────────────────────────────────────────────────────────*/ isUnary: parse arg matX,rows 1 cols - do r=1 for rows; _= - do c=1 for cols; z=value(matX'.'r"."c); rP=rP(z); cP=cP(z) - if abs(sqrt(rP(z)**2+cP(z)**2)-(r==c))>=.0001 then return 0 - end /*c*/ - end /*r*/ - return 1 -/*────────────────────────────────────────────────────────────────────────────*/ -multCmat: parse arg matA,matB,matT,rows 1 cols; call value matT'.',0 - do r=1 for rows; _= - do c=1 for cols - do k=1 for cols; T=value(matT'.'r"."c); Tr=rP(T); Tc=cP(T) - A=value(matA'.'r"."k); Ar=rP(A); Ac=cP(A) - B=value(matB'.'k"."c); Br=rP(B); Bc=cP(B) - Pr=Ar*Br-Ac*Bc; Pc=Ac*Br+Ar*Bc; Tr=Tr+Pr; Tc=Tc+Pc - call value matT'.'r"."c,Tr','Tc - end /*k*/ - end /*c*/ - end /*r*/ + do r=1 for rows; _= + do c=1 for cols; z=value(matX'.'r"."c); rP=rP(z); cP=cP(z) + if abs(sqrt(rP(z)**2 + cP(z)**2) - (r==c)) >= .0001 then return 0 + end /*c*/ + end /*r*/ + return 1 +/*──────────────────────────────────────────────────────────────────────────────────────*/ +multCmat: parse arg matA,matB,matT,rows 1 cols; call value matT'.', 0 + do r=1 for rows; _= + do c=1 for cols + do k=1 for cols; T=value(matT'.'r"."c); Tr=rP(T); Tc=cP(T) + A=value(matA'.'r"."k); Ar=rP(A); Ac=cP(A) + B=value(matB'.'k"."c); Br=rP(B); Bc=cP(B) + Pr=Ar*Br - Ac*Bc; Pc=Ac*Br + Ar*Bc; Tr=Tr+Pr; Tc=Tc+Pc + call value matT'.'r"."c,Tr','Tc + end /*k*/ + end /*c*/ + end /*r*/ return -/*────────────────────────────────────────────────────────────────────────────*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ normCmat: parse arg matN,rows 1 cols - do r=1 to rows; _= - do c=1 to cols; v=translate(value(matN'.'r"."c),,"IiJj") - parse upper var v real ',' cplx - if real\=='' then real=real/1 - if cplx\=='' then cplx=cplx/1; if cplx=0 then cplx= - if cplx\=='' then cplx=cplx"j" - call value matN'.'r"."c,strip(real','cplx,"T",',') - end /*c*/ - end /*r*/ + do r=1 to rows; _= + do c=1 to cols; v=translate(value(matN'.'r"."c), , "IiJj") + parse upper var v real ',' cplx + if real\=='' then real=real/1 + if cplx\=='' then cplx=cplx/1; if cplx=0 then cplx= + if cplx\=='' then cplx=cplx"j" + call value matN'.'r"."c, strip(real','cplx, "T", ',') + end /*c*/ + end /*r*/ return -/*────────────────────────────────────────────────────────────────────────────*/ -showCmat: parse arg matX,rows,cols; if cols=='' then cols=rows; @@=left('',6) - say; say center('matrix' matX,79,'─'); call normCmat matX,rows,cols - do r=1 to rows; _= - do c=1 to cols; _=_ @@ left(value(matX'.'r"."c),9); end +/*──────────────────────────────────────────────────────────────────────────────────────*/ +showCmat: parse arg matX,rows,cols; if cols=='' then cols=rows; @@=left('',6) + say; say center('matrix' matX, 79, '─'); call normCmat matX, rows, cols + do r=1 to rows; _= + do c=1 to cols; _=_ @@ left(value(matX'.'r"."c), 9); end /*c*/ say _ end /*r*/ say; return -/*────────────────────────────────────────────────────────────────────────────*/ -sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); i=; m.=9 - numeric digits 9; numeric form; h=d+6; if x<0 then do; x=-x; i='i'; end - parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_%2 - do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ - do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ - numeric digits d; return (g/1)i /*make complex if X < 0.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); numeric form; h=d+6 + numeric digits; parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g *.5'e'_ % 2 + m.=9; do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ + do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/; return g diff --git a/Task/Conjugate-transpose/Rust/conjugate-transpose.rust b/Task/Conjugate-transpose/Rust/conjugate-transpose.rust new file mode 100644 index 0000000000..45ec7f4a95 --- /dev/null +++ b/Task/Conjugate-transpose/Rust/conjugate-transpose.rust @@ -0,0 +1,80 @@ +extern crate num; // crate for complex numbers + +use num::complex::Complex; +use std::ops::Mul; +use std::fmt; + + +#[derive(Debug, PartialEq)] +struct Matrix { + grid: [[Complex; 2]; 2], // used to represent matrix +} + + +impl Matrix { // implements a method call for calculating the conjugate transpose + fn conjugate_transpose(&self) -> Matrix { + Matrix {grid: [[self.grid[0][0].conj(), self.grid[1][0].conj()], + [self.grid[0][1].conj(), self.grid[1][1].conj()]]} + } +} + +impl Mul for Matrix { // implements '*' (multiplication) for the matrix + type Output = Matrix; + + fn mul(self, other: Matrix) -> Matrix { + Matrix {grid: [[self.grid[0][0]*other.grid[0][0] + self.grid[0][1]*other.grid[1][0], + self.grid[0][0]*other.grid[0][1] + self.grid[0][1]*other.grid[1][1]], + [self.grid[1][0]*other.grid[0][0] + self.grid[1][1]*other.grid[1][0], + self.grid[1][0]*other.grid[1][0] + self.grid[1][1]*other.grid[1][1]]]} + } +} + +impl Copy for Matrix {} // implemented to prevent 'moved value' errors in if statements below +impl Clone for Matrix { + fn clone(&self) -> Matrix { + *self + } +} + +impl fmt::Display for Matrix { // implemented to make output nicer + fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { + write!(f, "({}, {})\n({}, {})", self.grid[0][0], self.grid[0][1], self.grid[1][0], self.grid[1][1]) + } +} + +fn main() { + let a = Matrix {grid: [[Complex::new(3.0, 0.0), Complex::new(2.0, 1.0)], + [Complex::new(2.0, -1.0), Complex::new(1.0, 0.0)]]}; + + let b = Matrix {grid: [[Complex::new(0.5, 0.5), Complex::new(0.5, -0.5)], + [Complex::new(0.5, -0.5), Complex::new(0.5, 0.5)]]}; + + test_type(a); + test_type(b); +} + +fn test_type(mat: Matrix) { + let identity = Matrix {grid: [[Complex::new(1.0, 0.0), Complex::new(0.0, 0.0)], + [Complex::new(0.0, 0.0), Complex::new(1.0, 0.0)]]}; + let mat_conj = mat.conjugate_transpose(); + + println!("Matrix: \n{}\nConjugate transpose: \n{}", mat, mat_conj); + + if mat == mat_conj { + println!("Hermitian?: TRUE"); + } else { + println!("Hermitian?: FALSE"); + } + + if mat*mat_conj == mat_conj*mat { + println!("Normal?: TRUE"); + } else { + println!("Normal?: FALSE"); + } + + if mat*mat_conj == identity { + println!("Unitary?: TRUE"); + } else { + println!("Unitary?: FALSE"); + } +} diff --git a/Task/Conjugate-transpose/Scala/conjugate-transpose.scala b/Task/Conjugate-transpose/Scala/conjugate-transpose.scala new file mode 100644 index 0000000000..1dc298bd27 --- /dev/null +++ b/Task/Conjugate-transpose/Scala/conjugate-transpose.scala @@ -0,0 +1,77 @@ +object ConjugateTranspose { + + case class Complex(re: Double, im: Double) { + def conjugate(): Complex = Complex(re, -im) + def +(other: Complex) = Complex(re + other.re, im + other.im) + def *(other: Complex) = Complex(re * other.re - im * other.im, re * other.im + im * other.re) + override def toString(): String = { + if (im < 0) { + s"${re}${im}i" + } else { + s"${re}+${im}i" + } + } + } + + case class Matrix(val entries: Vector[Vector[Complex]]) { + + def *(other: Matrix): Matrix = { + new Matrix( + Vector.tabulate(entries.size, other.entries(0).size)((r, c) => { + val rightRow = entries(r) + val leftCol = other.entries.map(_(c)) + rightRow.zip(leftCol) + .map{ case (x, y) => x * y } // multiply pair-wise + .foldLeft(new Complex(0,0)){ case (x, y) => x + y } // sum over all + }) + ) + } + + def conjugateTranspose(): Matrix = { + new Matrix( + Vector.tabulate(entries(0).size, entries.size)((r, c) => entries(c)(r).conjugate) + ) + } + + def isHermitian(): Boolean = { + this == conjugateTranspose() + } + + def isNormal(): Boolean = { + val ct = conjugateTranspose() + this * ct == ct * this + } + + def isIdentity(): Boolean = { + val entriesWithIndexes = for (r <- 0 until entries.size; c <- 0 until entries(r).size) yield (r, c, entries(r)(c)) + entriesWithIndexes.forall { case (r, c, x) => + if (r == c) { + x == Complex(1.0, 0.0) + } else { + x == Complex(0.0, 0.0) + } + } + } + + def isUnitary(): Boolean = { + (this * conjugateTranspose()).isIdentity() + } + + override def toString(): String = { + entries.map(" " + _.mkString("[", ",", "]")).mkString("[\n", "\n", "\n]") + } + + } + + def main(args: Array[String]): Unit = { + val m = new Matrix( + Vector.fill(3, 3)(new Complex(Math.random() * 2 - 1.0, Math.random() * 2 - 1.0)) + ) + println("Matrix: " + m) + println("Conjugate Transpose: " + m.conjugateTranspose()) + println("Hermitian: " + m.isHermitian()) + println("Normal: " + m.isNormal()) + println("Unitary: " + m.isUnitary()) + } + +} diff --git a/Task/Constrained-genericity/Fortran/constrained-genericity.f b/Task/Constrained-genericity/Fortran/constrained-genericity.f new file mode 100644 index 0000000000..2bb63ab2ec --- /dev/null +++ b/Task/Constrained-genericity/Fortran/constrained-genericity.f @@ -0,0 +1,42 @@ +module cg + implicit none + + type, abstract :: eatable + end type eatable + + type, extends(eatable) :: carrot_t + end type carrot_t + + type :: brick_t; end type brick_t + + type :: foodbox + class(eatable), allocatable :: food + contains + procedure, public :: add_item => add_item_fb + end type foodbox + +contains + + subroutine add_item_fb(this, f) + class(foodbox), intent(inout) :: this + class(eatable), intent(in) :: f + allocate(this%food, source=f) + end subroutine add_item_fb +end module cg + + +program con_gen + use cg + implicit none + + type(carrot_t) :: carrot + type(brick_t) :: brick + type(foodbox) :: fbox + + ! Put a carrot into the foodbox + call fbox%add_item(carrot) + + ! Try to put a brick in - results in a compiler error + call fbox%add_item(brick) + +end program con_gen diff --git a/Task/Constrained-genericity/J/constrained-genericity-1.j b/Task/Constrained-genericity/J/constrained-genericity-1.j index f9dd1babe2..a4c65b78eb 100644 --- a/Task/Constrained-genericity/J/constrained-genericity-1.j +++ b/Task/Constrained-genericity/J/constrained-genericity-1.j @@ -5,10 +5,10 @@ isEdible=:3 :0 coclass'FoodBox' create=:3 :0 - assert isEdible_Connoisseur_ type=:y collection=: 0#y ) add=:3 :0"0 - 'inedible' assert type e. copath y + 'inedible' assert isEdible_Connoisseur_ y collection=: collection, y + EMPTY ) diff --git a/Task/Constrained-genericity/J/constrained-genericity-3.j b/Task/Constrained-genericity/J/constrained-genericity-3.j index bb467bc8a1..f55f5a02a3 100644 --- a/Task/Constrained-genericity/J/constrained-genericity-3.j +++ b/Task/Constrained-genericity/J/constrained-genericity-3.j @@ -1,4 +1,4 @@ - lunch=:(<'Apple') conew 'FoodBox' + lunch=:'' conew 'FoodBox' a1=: conew 'Apple' a2=: conew 'Apple' add__lunch a1 diff --git a/Task/Constrained-genericity/Perl-6/constrained-genericity-1.pl6 b/Task/Constrained-genericity/Perl-6/constrained-genericity-1.pl6 index 5f8318c8c2..fdff7ae150 100644 --- a/Task/Constrained-genericity/Perl-6/constrained-genericity-1.pl6 +++ b/Task/Constrained-genericity/Perl-6/constrained-genericity-1.pl6 @@ -2,8 +2,8 @@ subset Eatable of Any where { .^can('eat') }; class Cake { method eat() {...} } -role FoodBox[Eatable ::T] { - has T %.foodbox; +role FoodBox[Eatable] { + has %.foodbox; } class Yummy does FoodBox[Cake] { } # composes correctly diff --git a/Task/Constrained-genericity/Ruby/constrained-genericity.rb b/Task/Constrained-genericity/Ruby/constrained-genericity.rb new file mode 100644 index 0000000000..1aace0b03b --- /dev/null +++ b/Task/Constrained-genericity/Ruby/constrained-genericity.rb @@ -0,0 +1,18 @@ +class Foodbox + def initialize (*food) + raise ArgumentError, "food must be eadible" unless food.all?{|f| f.respond_to?(:eat)} + @box = food + end +end + +class Fruit + def eat; end +end + +class Apple < Fruit; end + +p Foodbox.new(Fruit.new, Apple.new) +# => #, #]> + +p Foodbox.new(Apple.new, "string can't eat") +# => test1.rb:3:in `initialize': food must be eadible (ArgumentError) diff --git a/Task/Constrained-random-points-on-a-circle/00DESCRIPTION b/Task/Constrained-random-points-on-a-circle/00DESCRIPTION index 7ab39b9e3c..ac35be0ba7 100644 --- a/Task/Constrained-random-points-on-a-circle/00DESCRIPTION +++ b/Task/Constrained-random-points-on-a-circle/00DESCRIPTION @@ -1,4 +1,5 @@ -Generate 100 coordinate pairs such that x and y are integers sampled from the uniform distribution with the condition that 10 \leq \sqrt{ x^2 + y^2 } \leq 15 . Then display/plot them. The outcome should be a "fuzzy" circle. The actual number of points plotted may be less than 100, given that some pairs may be generated more than once. +;Task: +Generate 100 coordinate pairs such that x and y are integers sampled from the uniform distribution with the condition that
    10 \leq \sqrt{ x^2 + y^2 } \leq 15 .
    Then display/plot them. The outcome should be a "fuzzy" circle. The actual number of points plotted may be less than 100, given that some pairs may be generated more than once. There are several possible approaches to accomplish this. Here are two possible algorithms. @@ -6,3 +7,4 @@ There are several possible approaches to accomplish this. Here are two possible :10 \leq \sqrt{ x^2 + y^2 } \leq 15 . 2) Precalculate the set of all possible points (there are 404 of them) and select randomly from this set. +

    diff --git a/Task/Constrained-random-points-on-a-circle/Elixir/constrained-random-points-on-a-circle-1.elixir b/Task/Constrained-random-points-on-a-circle/Elixir/constrained-random-points-on-a-circle-1.elixir index 3bf7c039eb..93175d7eb8 100644 --- a/Task/Constrained-random-points-on-a-circle/Elixir/constrained-random-points-on-a-circle-1.elixir +++ b/Task/Constrained-random-points-on-a-circle/Elixir/constrained-random-points-on-a-circle-1.elixir @@ -1,17 +1,19 @@ defmodule Random do defp generate_point(0, _, _, set), do: set - defp generate_point(n, f, range, set) do + defp generate_point(n, f, condition, set) do point = {x,y} = {f.(), f.()} - if x*x + y*y in range and not Set.member?(set, point), - do: generate_point(n-1, f, range, Set.put(set, point)), - else: generate_point(n, f, range, set) + if x*x + y*y in condition and not point in set, + do: generate_point(n-1, f, condition, MapSet.put(set, point)), + else: generate_point(n, f, condition, set) end + def circle do f = fn -> :rand.uniform(31) - 16 end - points = generate_point(100, f, 10*10..15*15, HashSet.new) - for x <- -15..15 do - for y <- -15..15 do - IO.write if Set.member?(points, {x,y}), do: "x", else: " " + points = generate_point(100, f, 10*10..15*15, MapSet.new) + range = -15..15 + for x <- range do + for y <- range do + IO.write if {x,y} in points, do: "x", else: " " end IO.puts "" end diff --git a/Task/Constrained-random-points-on-a-circle/Elixir/constrained-random-points-on-a-circle-2.elixir b/Task/Constrained-random-points-on-a-circle/Elixir/constrained-random-points-on-a-circle-2.elixir index 93c17e2ec1..a950996d23 100644 --- a/Task/Constrained-random-points-on-a-circle/Elixir/constrained-random-points-on-a-circle-2.elixir +++ b/Task/Constrained-random-points-on-a-circle/Elixir/constrained-random-points-on-a-circle-2.elixir @@ -1,15 +1,12 @@ defmodule Constrain do - defp precalculate(range, condition) do - for x <- range, y <- range, x*x + y*y in condition, do: {x,y} - end - def circle do range = -15..15 - all_points = precalculate(range, 10*10..15*15) - IO.puts length(all_points) - points = Enum.shuffle(all_points) |> Enum.take(100) - Enum.each(-15..15, fn x -> - IO.puts Enum.map(range, fn y -> if Enum.member?(points, {x,y}), do: "o ", else: " " end) + r2 = 10*10..15*15 + all_points = for x <- range, y <- range, x*x+y*y in r2, do: {x,y} + IO.puts "Precalculate: #{length(all_points)}" + points = Enum.take_random(all_points, 100) + Enum.each(range, fn x -> + IO.puts Enum.map(range, fn y -> if {x,y} in points, do: "o ", else: " " end) end) end end diff --git a/Task/Constrained-random-points-on-a-circle/Go/constrained-random-points-on-a-circle-1.go b/Task/Constrained-random-points-on-a-circle/Go/constrained-random-points-on-a-circle-1.go index 594a401fae..ec6e7e29ee 100644 --- a/Task/Constrained-random-points-on-a-circle/Go/constrained-random-points-on-a-circle-1.go +++ b/Task/Constrained-random-points-on-a-circle/Go/constrained-random-points-on-a-circle-1.go @@ -7,28 +7,40 @@ import ( "time" ) -type pt struct { - x, y int -} +const ( + nPts = 100 + rMin = 10 + rMax = 15 +) func main() { - rand.Seed(time.Now().UnixNano()) - // generate random points, accumulate 100 distinct points meeting condition - m := make(map[int]pt) // key is buffer index - for len(m) < 100 { - p := pt{rand.Intn(31) - 15, rand.Intn(31) - 15} - rs := p.x*p.x + p.y*p.y - if 100 <= rs && rs <= 225 { - m[(p.x+15)*2+(p.y+15)*31*2] = p + rand.Seed(time.Now().Unix()) + span := rMax + 1 + rMax + rows := make([][]byte, span) + for r := range rows { + rows[r] = bytes.Repeat([]byte{' '}, span*2) + } + u := 0 // count unique points + min2 := rMin * rMin + max2 := rMax * rMax + for n := 0; n < nPts; { + x := rand.Intn(span) - rMax + y := rand.Intn(span) - rMax + // x, y is the generated coordinate pair + rs := x*x + y*y + if rs < min2 || rs > max2 { + continue + } + n++ // count pair as meeting condition + r := y + rMax + c := (x + rMax) * 2 + if rows[r][c] == ' ' { + rows[r][c] = '*' + u++ } } - // plot to buffer - b := bytes.Repeat([]byte{' '}, 31*31*2) - for i := range m { - b[i] = '*' - } - // print buffer to screen - for i := 0; i < 31; i++ { - fmt.Println(string(b[i*31*2 : (i+1)*31*2])) + for _, row := range rows { + fmt.Println(string(row)) } + fmt.Println(u, "unique points") } diff --git a/Task/Constrained-random-points-on-a-circle/Go/constrained-random-points-on-a-circle-2.go b/Task/Constrained-random-points-on-a-circle/Go/constrained-random-points-on-a-circle-2.go index cb7d7fd66d..c8d791f032 100644 --- a/Task/Constrained-random-points-on-a-circle/Go/constrained-random-points-on-a-circle-2.go +++ b/Task/Constrained-random-points-on-a-circle/Go/constrained-random-points-on-a-circle-2.go @@ -4,36 +4,45 @@ import ( "bytes" "fmt" "math/rand" + "time" ) -type pt struct { - x, y int -} +const ( + nPts = 100 + rMin = 10 + rMax = 15 +) func main() { - // generate possible points - all := make([]pt, 0, 404) - for x := -15; x <= 15; x++ { - for y := -15; y <= 15; y++ { - rs := x*x + y*y - if 100 <= rs && rs <= 225 { - all = append(all, pt{x, y}) + rand.Seed(time.Now().Unix()) + var poss []struct{ x, y int } + min2 := rMin * rMin + max2 := rMax * rMax + for y := -rMax; y <= rMax; y++ { + for x := -rMax; x <= rMax; x++ { + if r2 := x*x + y*y; r2 >= min2 && r2 <= max2 { + poss = append(poss, struct{ x, y int }{x, y}) } } } - if len(all) != 404 { - panic(len(all)) + fmt.Println(len(poss), "possible points") + span := rMax + 1 + rMax + rows := make([][]byte, span) + for r := range rows { + rows[r] = bytes.Repeat([]byte{' '}, span*2) } - // randomly order - rp := rand.Perm(404) - // plot 100 of them to a buffer - b := bytes.Repeat([]byte{' '}, 31*31*2) - for i := 0; i < 100; i++ { - p := all[rp[i]] - b[(p.x+15)*2+(p.y+15)*31*2] = '*' + u := 0 + for n := 0; n < nPts; n++ { + i := rand.Intn(len(poss)) + r := poss[i].y + rMax + c := (poss[i].x + rMax) * 2 + if rows[r][c] == ' ' { + rows[r][c] = '*' + u++ + } } - // print buffer to screen - for i := 0; i < 31; i++ { - fmt.Println(string(b[i*31*2 : (i+1)*31*2])) + for _, row := range rows { + fmt.Println(string(row)) } + fmt.Println(u, "unique points") } diff --git a/Task/Constrained-random-points-on-a-circle/PowerShell/constrained-random-points-on-a-circle.psh b/Task/Constrained-random-points-on-a-circle/PowerShell/constrained-random-points-on-a-circle.psh new file mode 100644 index 0000000000..7e6df3594c --- /dev/null +++ b/Task/Constrained-random-points-on-a-circle/PowerShell/constrained-random-points-on-a-circle.psh @@ -0,0 +1,18 @@ +$MinR2 = 10 * 10 +$MaxR2 = 15 * 15 + +$Points = @{} + +While ( $Points.Count -lt 100 ) + { + $X = Get-Random -Minimum -16 -Maximum 17 + $Y = Get-Random -Minimum -16 -Maximum 17 + $R2 = $X * $X + $Y * $Y + + If ( $R2 -ge $MinR2 -and $R2 -le $MaxR2 -and "$X,$Y" -notin $Points.Keys ) + { + $Points += @{ "$X,$Y" = 1 } + } + } + +ForEach ( $Y in -16..16 ) { ( -16..16 | ForEach { ( " ", "*" )[[int]$Points["$_,$Y"]] } ) -join '' } diff --git a/Task/Constrained-random-points-on-a-circle/REXX/constrained-random-points-on-a-circle-1.rexx b/Task/Constrained-random-points-on-a-circle/REXX/constrained-random-points-on-a-circle-1.rexx index d2d7c5098d..f1f58e290e 100644 --- a/Task/Constrained-random-points-on-a-circle/REXX/constrained-random-points-on-a-circle-1.rexx +++ b/Task/Constrained-random-points-on-a-circle/REXX/constrained-random-points-on-a-circle-1.rexx @@ -1,26 +1,26 @@ -/*REXX program generates 100 random points in an annulus: 10 ≤ √(x²≤y²) ≤ 15 */ -parse arg points low high . /*obtain optional args from the C.L. */ +/*REXX program generates 100 random points in an annulus: 10 ≤ √(x²≤y²) ≤ 15 */ +parse arg points low high . /*obtain optional args from the C.L. */ if points=='' then points=100 -if low=='' then low=10; low2= low**2 /*define a shortcut for square.*/ -if high=='' then high=15; high2=high**2 /* " " " " " */ +if low=='' then low=10; low2= low**2 /*define a shortcut for squaring LOW. */ +if high=='' then high=15; high2=high**2 /* " " " " " HIGH.*/ $= - do x=-high; x2=x*x /*generate all possible annulus points.*/ + do x=-high; x2=x*x /*generate all possible annulus points.*/ if x<0 & x2>high2 then iterate if x>0 & x2>high2 then leave do y=-high; s=x2+y*y if (y<0 & s>high2) | s0 & s>high2 then leave - $=$ x','y /*add a point─set to the $ list. */ + $=$ x','y /*add a point─set to the $ list. */ end /*y*/ end /*x*/ plotChar='Θ'; minY=high2; maxY=-minY; ap=words($); @.= - do j=1 for points /*define the x,y points [character O].*/ - parse value word($,random(1,ap)) with x ',' y /*pick a random point.*/ - @.y=overlay(plotChar, @.y, x+high+1) /*define: the point. */ - minY=min(minY,y); maxY=max(maxY,y) /*plot restricting. */ + do j=1 for points /*define the x,y points [character O].*/ + parse value word($,random(1,ap)) with x ',' y /*pick a random point in the annulus.*/ + @.y=overlay(plotChar, @.y, x+high+1) /*define: the data point. */ + minY=min(minY,y); maxY=max(maxY,y) /*perform the plot point restricting. */ end /*j*/ - /* [↓] only show displayable section. */ - do y=minY to maxY; say @.y; end /*display the annulus to the terminal. */ - /*stick a fork in it, we're all done. */ + /* [↓] only show displayable section. */ + do y=minY to maxY; say @.y; end /*display the annulus to the terminal. */ + /*stick a fork in it, we're all done. */ diff --git a/Task/Constrained-random-points-on-a-circle/REXX/constrained-random-points-on-a-circle-2.rexx b/Task/Constrained-random-points-on-a-circle/REXX/constrained-random-points-on-a-circle-2.rexx index aee38fc1cf..e4ccb95ac8 100644 --- a/Task/Constrained-random-points-on-a-circle/REXX/constrained-random-points-on-a-circle-2.rexx +++ b/Task/Constrained-random-points-on-a-circle/REXX/constrained-random-points-on-a-circle-2.rexx @@ -1,26 +1,26 @@ -/*REXX program generates 100 random points in an annulus: 10 ≤ √(x²≤y²) ≤ 15 */ -parse arg points low high . /*obtain optional args from the C.L. */ +/*REXX program generates 100 random points in an annulus: 10 ≤ √(x²≤y²) ≤ 15 */ +parse arg points low high . /*obtain optional args from the C.L. */ if points=='' then points=100 -if low=='' then low=10; low2= low**2 /*define a square shortcut.*/ -if high=='' then high=15; high2=high**2 /* " " " " */ +if low=='' then low=10; low2= low**2 /*define a shortcut for squaring LOW. */ +if high=='' then high=15; high2=high**2 /* " " " " " HIGH.*/ $= - do x=-high; x2=x*x /*generate all possible annulus points.*/ + do x=-high; x2=x*x /*generate all possible annulus points.*/ if x<0 & x2>high2 then iterate if x>0 & x2>high2 then leave do y=-high; s=x2+y*y if (y<0 & s>high2) | s0 & s>high2 then leave - $=$ x','y /*add a point─set to the $ list. */ + $=$ x','y /*add a point─set to the $ list. */ end /*y*/ end /*x*/ plotChar='Θ'; minY=high2; maxY=-minY; ap=words($); @.= - do j=1 for points /*define the x,y points [character Θ].*/ - parse value word($,random(1,ap)) with x ',' y /*pick a random point.*/ - @.y=overlay(plotChar, @.y, 2*x+2*high+1) /*define: the point. */ - minY=min(minY,y); maxY=max(maxY,y) /*plot restricting. */ + do j=1 for points /*define the x,y points [character O].*/ + parse value word($,random(1,ap)) with x ',' y /*pick a random point in the annulus.*/ + @.y=overlay(plotChar, @.y, 2*x+2*high+1) /*define: the data point. */ + minY=min(minY,y); maxY=max(maxY,y) /*perform the plot point restricting. */ end /*j*/ - /* [↓] only show displayable section. */ - do y=minY to maxY; say @.y; end /*display the annulus to the terminal. */ - /*stick a fork in it, we're all done. */ + /* [↓] only show displayable section. */ + do y=minY to maxY; say @.y; end /*display the annulus to the terminal. */ + /*stick a fork in it, we're all done. */ diff --git a/Task/Constrained-random-points-on-a-circle/ZX-Spectrum-Basic/constrained-random-points-on-a-circle.zx b/Task/Constrained-random-points-on-a-circle/ZX-Spectrum-Basic/constrained-random-points-on-a-circle.zx new file mode 100644 index 0000000000..8df1e7ba6f --- /dev/null +++ b/Task/Constrained-random-points-on-a-circle/ZX-Spectrum-Basic/constrained-random-points-on-a-circle.zx @@ -0,0 +1,6 @@ +10 FOR i=1 TO 1000 +20 LET x=RND*31-16 +30 LET y=RND*31-16 +40 LET r=SQR (x*x+y*y) +50 IF (r>=10) AND (r<=15) THEN PLOT 127+x*2,88+y*2 +60 NEXT i diff --git a/Task/Continued-fraction-Arithmetic-Construct-from-rational-number/REXX/continued-fraction-arithmetic-construct-from-rational-number.rexx b/Task/Continued-fraction-Arithmetic-Construct-from-rational-number/REXX/continued-fraction-arithmetic-construct-from-rational-number.rexx index 466bb30fce..2ba9a0f02c 100644 --- a/Task/Continued-fraction-Arithmetic-Construct-from-rational-number/REXX/continued-fraction-arithmetic-construct-from-rational-number.rexx +++ b/Task/Continued-fraction-Arithmetic-Construct-from-rational-number/REXX/continued-fraction-arithmetic-construct-from-rational-number.rexx @@ -1,13 +1,12 @@ -/*REXX pgm converts decimal or rational fraction to a continued fraction*/ -numeric digits 230 /*this determines how many terms */ - /*can be generated for dec fracts*/ +/*REXX program converts a decimal or rational fraction to a continued fraction. */ +numeric digits 230 /*determines how many terms to be gened*/ say ' 1/2 ──► CF: ' r2cf( '1/2' ) say ' 3 ──► CF: ' r2cf( 3 ) say ' 23/8 ──► CF: ' r2cf( '23/8' ) say ' 13/11 ──► CF: ' r2cf( '13/11' ) say ' 22/7 ──► CF: ' r2cf( '22/7 ' ) -say -say '───────── attempts at √2.' +say ' ___' +say '───────── attempts at √ 2.' say '14142/1e4 ──► CF: ' r2cf( '14142/1e4 ' ) say '141421/1e5 ──► CF: ' r2cf( '141421/1e5 ' ) say '1414214/1e6 ──► CF: ' r2cf( '1414214/1e6 ' ) @@ -19,44 +18,45 @@ say '141421356237/1e11 ──► CF: ' r2cf( '141421356237/1e11 ' ) say '1414213562373/1e12 ──► CF: ' r2cf( '1414213562373/1e12 ' ) say '√2 ──► CF: ' r2cf( sqrt(2) ) say -say '───────── an attempt at π' -say 'π ──► CF: ' r2cf( pi() ) -exit /*stick a fork in it, we're done.*/ -/*────────────────────────────────R2CF subroutine───────────────────────*/ +say '───────── an attempt at pi' +say 'pi ──► CF: ' r2cf( pi() ) +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ r2cf: procedure; parse arg g 1 s 2; $=; if s=='-' then g = substr(g,2) else s = -if pos('.',g)\==0 then do - if \datatype(g,'N') then call serr 'not numeric:' g - g = $maxfact(g) - end -if pos('/',g)==0 then g = g"/"1 -parse var g n '/' d -if \datatype(n,'W') then call serr "a numerator isn't an integer:" n -if \datatype(d,'W') then call serr "a denominator isn't an integer:" d -n = abs(n) /*ensure numerator is positive. */ -if d=0 then call serr 'a denominator is zero' + if pos('.',g)\==0 then do + if \datatype(g,'N') then call serr 'not numeric:' g + g = $maxfact(g) + end + if pos('/',g)==0 then g = g"/"1 + parse var g n '/' d + if \datatype(n,'W') then call serr "a numerator isn't an integer:" n + if \datatype(d,'W') then call serr "a denominator isn't an integer:" d + n = abs(n) /*ensure numerator is positive. */ + if d=0 then call serr 'a denominator is zero' - do while d\==0 /*where the rubber meets the road*/ - $ = $ s || (n%d) /*append another number to list. */ - _ = d - d = n // d /* % is int div, // is modulus.*/ - n = _ - end /*while*/ -return strip($) -/*─────────────────────────────PI subroutine────────────────────────────*/ -pi: return, /*a bit of overkill, but hey !! */ /* ··· should ≥ NUMERIC DIGITS */ -3.141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701938521105559644622948954930381964428810975665933446128475648233786783165271 -/*─────────────────────────────SERR subroutine──────────────────────────*/ -serr: say; say '***error!***'; say; say arg(1); say; exit -/*─────────────────────────────SQRT subroutine──────────────────────────*/ -sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); i=; m.=9 - numeric digits 9; numeric form; h=d+6; if x<0 then do; x=-x; i='i'; end - parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_%2 - do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ - do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ - numeric digits d; return (g/1)i /*make complex if X < 0.*/ -/*─────────────────────────────MAXFACT subroutine───────────────────────*/ -$maxFact: procedure; parse arg x 1 _x,y; y=10**(digits()-1); b=0; h=1 -a=1; g=0; do while a<=y & g<=y; n=trunc(_x); _=a; a=n*a+b; b=_; _=g -g=n*g+h; h=_; if n=_x | a/g=x then do; if a>y | g>y then iterate; b=a -h=g; leave; end; _x=1/(_x-n); end; return b'/'h + do while d\==0 /*where the rubber meets the road*/ + $ = $ s || (n%d) /*append another number to list. */ + _ = d + d = n // d /* % is int div, // is modulus.*/ + n = _ + end /*while*/ + return strip($) +/*──────────────────────────────────────────────────────────────────────────────────────*/ +pi: return 3.1415926535897932384626433832795028841971693993751058209749445923078164062862, + || 089986280348253421170679821480865132823066470938446095505822317253594081284, + || 811174502841027019385211055596446229489549303819644288109756659334461284756, + || 48233786783165271 /* ··· should ≥ NUMERIC DIGITS */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +serr: say; say '***error!***'; say; say arg(1); say; exit 13 +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); h=d+6; numeric form + m.=9; numeric digits; parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_%2 + do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ + do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ + numeric digits d; return g/1 +/*──────────────────────────────────────────────────────────────────────────────────────*/ +$maxFact: procedure; parse arg x 1 _x,y; y=10**(digits()-1); b=0; h=1; a=1; g=0 + do while a<=y & g<=y; n=trunc(_x); _=a; a=n*a+b; b=_; _=g; g=n*g+h; h=_ + if n=_x | a/g=x then do; if a>y|g>y then iterate; b=a; h=g; leave; end + _x=1/(_x-n); end; return b'/'h diff --git a/Task/Continued-fraction-Arithmetic-Construct-from-rational-number/Rust/continued-fraction-arithmetic-construct-from-rational-number.rust b/Task/Continued-fraction-Arithmetic-Construct-from-rational-number/Rust/continued-fraction-arithmetic-construct-from-rational-number.rust new file mode 100644 index 0000000000..a0e28160c4 --- /dev/null +++ b/Task/Continued-fraction-Arithmetic-Construct-from-rational-number/Rust/continued-fraction-arithmetic-construct-from-rational-number.rust @@ -0,0 +1,54 @@ +struct R2cf { + n1: i64, + n2: i64 +} + +// This iterator generates the continued fraction representation from the +// specified rational number. +impl Iterator for R2cf { + type Item = i64; + + fn next(&mut self) -> Option { + if self.n2 == 0 { + None + } + else { + let t1 = self.n1 / self.n2; + let t2 = self.n2; + self.n2 = self.n1 - t1 * t2; + self.n1 = t2; + Some(t1) + } + } +} + +fn r2cf(n1: i64, n2: i64) -> R2cf { + R2cf { n1: n1, n2: n2 } +} + +macro_rules! printcf { + ($x:expr, $y:expr) => (println!("{:?}", r2cf($x, $y).collect::>())); +} + +fn main() { + printcf!(1, 2); + printcf!(3, 1); + printcf!(23, 8); + printcf!(13, 11); + printcf!(22, 7); + printcf!(-152, 77); + + printcf!(14_142, 10_000); + printcf!(141_421, 100_000); + printcf!(1_414_214, 1_000_000); + printcf!(14_142_136, 10_000_000); + + printcf!(31, 10); + printcf!(314, 100); + printcf!(3142, 1000); + printcf!(31_428, 10_000); + printcf!(314_285, 100_000); + printcf!(3_142_857, 1_000_000); + printcf!(31_428_571, 10_000_000); + printcf!(314_285_714, 100_000_000); +} diff --git a/Task/Continued-fraction-Arithmetic-G-matrix-NG,-Contined-Fraction-N1,-Contined-Fraction-N2-/Perl-6/continued-fraction-arithmetic-g-matrix-ng,-contined-fraction-n1,-contined-fraction-n2--1.pl6 b/Task/Continued-fraction-Arithmetic-G-matrix-NG,-Contined-Fraction-N1,-Contined-Fraction-N2-/Perl-6/continued-fraction-arithmetic-g-matrix-ng,-contined-fraction-n1,-contined-fraction-n2--1.pl6 index f6f2f176be..24eaad01a2 100644 --- a/Task/Continued-fraction-Arithmetic-G-matrix-NG,-Contined-Fraction-N1,-Contined-Fraction-N2-/Perl-6/continued-fraction-arithmetic-g-matrix-ng,-contined-fraction-n1,-contined-fraction-n2--1.pl6 +++ b/Task/Continued-fraction-Arithmetic-G-matrix-NG,-Contined-Fraction-N1,-Contined-Fraction-N2-/Perl-6/continued-fraction-arithmetic-g-matrix-ng,-contined-fraction-n1,-contined-fraction-n2--1.pl6 @@ -7,15 +7,15 @@ class NG2 { method apply(@cf1, @cf2, :$limit = 30) { my @cfs = [@cf1], [@cf2]; gather { - while @cfs[0].elems or @cfs[1].elems { + while @cfs[0] or @cfs[1] { my $term; (take $term if $term = self!extract) unless self!needterm; my $from = self!from; - $from = @cfs[$from].elems ?? $from !! $from +^ 1; + $from = @cfs[$from] ?? $from !! $from +^ 1; self!inject($from, @cfs[$from].shift); } take self!drain while $!b; - }[ ^ $limit ]; + }[ ^$limit ].grep: *.defined; } # Private methods diff --git a/Task/Continued-fraction-Arithmetic-G-matrix-NG,-Contined-Fraction-N1,-Contined-Fraction-N2-/Perl-6/continued-fraction-arithmetic-g-matrix-ng,-contined-fraction-n1,-contined-fraction-n2--2.pl6 b/Task/Continued-fraction-Arithmetic-G-matrix-NG,-Contined-Fraction-N1,-Contined-Fraction-N2-/Perl-6/continued-fraction-arithmetic-g-matrix-ng,-contined-fraction-n1,-contined-fraction-n2--2.pl6 index 12ded80a9d..57d4164ae6 100644 --- a/Task/Continued-fraction-Arithmetic-G-matrix-NG,-Contined-Fraction-N1,-Contined-Fraction-N2-/Perl-6/continued-fraction-arithmetic-g-matrix-ng,-contined-fraction-n1,-contined-fraction-n2--2.pl6 +++ b/Task/Continued-fraction-Arithmetic-G-matrix-NG,-Contined-Fraction-N1,-Contined-Fraction-N2-/Perl-6/continued-fraction-arithmetic-g-matrix-ng,-contined-fraction-n1,-contined-fraction-n2--2.pl6 @@ -1,5 +1,5 @@ say "√2 expressed as a continued fraction: "; -my @root2 = 1, 2 xx *; +my @root2 = lazy flat 1, 2 xx *; my @result = NG2.new.operator(|%ops{'*'}).apply( @root2, @root2, limit => 6 ); say @root2.&ppcf, "² = \n"; say @result.&ppcf; diff --git a/Task/Continued-fraction/COBOL/continued-fraction.cobol b/Task/Continued-fraction/COBOL/continued-fraction.cobol new file mode 100644 index 0000000000..d0fe6e486e --- /dev/null +++ b/Task/Continued-fraction/COBOL/continued-fraction.cobol @@ -0,0 +1,185 @@ + identification division. + program-id. show-continued-fractions. + + environment division. + configuration section. + repository. + function continued-fractions + function all intrinsic. + + procedure division. + fractions-main. + + display "Square root 2 approximately : " + continued-fractions("sqrt-2-alpha", "sqrt-2-beta", 100) + display "Napier constant approximately : " + continued-fractions("napier-alpha", "napier-beta", 40) + display "Pi approximately : " + continued-fractions("pi-alpha", "pi-beta", 10000) + + goback. + end program show-continued-fractions. + + *> ************************************************************** + identification division. + function-id. continued-fractions. + + data division. + working-storage section. + 01 alpha-function usage program-pointer. + 01 beta-function usage program-pointer. + 01 alpha usage float-long. + 01 beta usage float-long. + 01 running usage float-long. + 01 i usage binary-long. + + linkage section. + 01 alpha-name pic x any length. + 01 beta-name pic x any length. + 01 iterations pic 9 any length. + 01 approximation usage float-long. + + procedure division using + alpha-name beta-name iterations + returning approximation. + + set alpha-function to entry alpha-name + if alpha-function = null then + display "error: no " alpha-name " function" upon syserr + goback + end-if + set beta-function to entry beta-name + if beta-function = null then + display "error: no " beta-name " function" upon syserr + goback + end-if + + move 0 to alpha beta running + perform varying i from iterations by -1 until i = 0 + call alpha-function using i returning alpha + call beta-function using i returning beta + compute running = beta / (alpha + running) + end-perform + call alpha-function using 0 returning alpha + compute approximation = alpha + running + + goback. + end function continued-fractions. + + *> ****************************** + identification division. + program-id. sqrt-2-alpha. + + data division. + working-storage section. + 01 result usage float-long. + + linkage section. + 01 iteration usage binary-long unsigned. + + procedure division using iteration returning result. + if iteration equal 0 then + move 1.0 to result + else + move 2.0 to result + end-if + + goback. + end program sqrt-2-alpha. + + *> ****************************** + identification division. + program-id. sqrt-2-beta. + + data division. + working-storage section. + 01 result usage float-long. + + linkage section. + 01 iteration usage binary-long unsigned. + + procedure division using iteration returning result. + move 1.0 to result + + goback. + end program sqrt-2-beta. + + *> ****************************** + identification division. + program-id. napier-alpha. + + data division. + working-storage section. + 01 result usage float-long. + + linkage section. + 01 iteration usage binary-long unsigned. + + procedure division using iteration returning result. + if iteration equal 0 then + move 2.0 to result + else + move iteration to result + end-if + + goback. + end program napier-alpha. + + *> ****************************** + identification division. + program-id. napier-beta. + + data division. + working-storage section. + 01 result usage float-long. + + linkage section. + 01 iteration usage binary-long unsigned. + + procedure division using iteration returning result. + if iteration = 1 then + move 1.0 to result + else + compute result = iteration - 1.0 + end-if + + goback. + end program napier-beta. + + *> ****************************** + identification division. + program-id. pi-alpha. + + data division. + working-storage section. + 01 result usage float-long. + + linkage section. + 01 iteration usage binary-long unsigned. + + procedure division using iteration returning result. + if iteration equal 0 then + move 3.0 to result + else + move 6.0 to result + end-if + + goback. + end program pi-alpha. + + *> ****************************** + identification division. + program-id. pi-beta. + + data division. + working-storage section. + 01 result usage float-long. + + linkage section. + 01 iteration usage binary-long unsigned. + + procedure division using iteration returning result. + compute result = (2 * iteration - 1) ** 2 + + goback. + end program pi-beta. diff --git a/Task/Continued-fraction/Clojure/continued-fraction.clj b/Task/Continued-fraction/Clojure/continued-fraction.clj new file mode 100644 index 0000000000..23cdd94aaa --- /dev/null +++ b/Task/Continued-fraction/Clojure/continued-fraction.clj @@ -0,0 +1,8 @@ +(defn cfrac + [a b n] + (letfn [(cfrac-iter [[x k]] [(+ (a k) (/ (b (inc k)) x)) (dec k)])] + (ffirst (take 1 (drop (inc n) (iterate cfrac-iter [1 n])))))) + +(def sq2 (cfrac #(if (zero? %) 1.0 2.0) (constantly 1.0) 100)) +(def e (cfrac #(if (zero? %) 2.0 %) #(if (= 1 %) 1.0 (double (dec %))) 100)) +(def pi (cfrac #(if (zero? %) 3.0 6.0) #(let [x (- (* 2.0 %) 1.0)] (* x x)) 900000)) diff --git a/Task/Continued-fraction/Java/continued-fraction.java b/Task/Continued-fraction/Java/continued-fraction.java new file mode 100644 index 0000000000..48a447a421 --- /dev/null +++ b/Task/Continued-fraction/Java/continued-fraction.java @@ -0,0 +1,25 @@ +import static java.lang.Math.pow; +import java.util.*; +import java.util.function.Function; + +public class Test { + static double calc(Function f, int n) { + double temp = 0; + + for (int ni = n; ni >= 1; ni--) { + Integer[] p = f.apply(ni); + temp = p[1] / (double) (p[0] + temp); + } + return f.apply(0)[0] + temp; + } + + public static void main(String[] args) { + List> fList = new ArrayList<>(); + fList.add(n -> new Integer[]{n > 0 ? 2 : 1, 1}); + fList.add(n -> new Integer[]{n > 0 ? n : 2, n > 1 ? (n - 1) : 1}); + fList.add(n -> new Integer[]{n > 0 ? 6 : 3, (int) pow(2 * n - 1, 2)}); + + for (Function f : fList) + System.out.println(calc(f, 200)); + } +} diff --git a/Task/Continued-fraction/REXX/continued-fraction-1.rexx b/Task/Continued-fraction/REXX/continued-fraction-1.rexx index 688b4ef34f..2f67a48e9a 100644 --- a/Task/Continued-fraction/REXX/continued-fraction-1.rexx +++ b/Task/Continued-fraction/REXX/continued-fraction-1.rexx @@ -1,80 +1,43 @@ -/*REXX program calculates and displays values of some specific continued*/ -/*───────────── fractions (along with their α and ß terms). */ -/*───────────── Continued fractions: also known as anthyphairetic ratio.*/ -T=500 /*use 500 terms for calculations.*/ -showDig=100; numeric digits 2*showDig /*use 100 digits for the display.*/ -a=; @=; b= /*omitted ß terms are assumed = 1*/ -/*══════════════════════════════════════════════════════════════════════*/ -a=1 rep(2); call tell '√2' -/*══════════════════════════════════════════════════════════════════════*/ -a=1 rep(1 2); call tell '√3' /*also: 2∙sin(π/3) */ -/*══════════════════════════════════════ ___ ════════════════════════*/ - /*generalized √ N */ - do N=2 to 11; a=1 rep(2); b=rep(N-1); call tell 'gen √'N; end -N=1/2; a=1 rep(2); b=rep(N-1); call tell 'gen √½' -/*══════════════════════════════════════════════════════════════════════*/ - do j=1 for T; a=a j; end; b=1 a; a=2 a; call tell 'e' -/*══════════════════════════════════════════════════════════════════════*/ - do j=1 for T by 2; a=a j; b=b j+1; end; call tell '1÷[√e-1]' -/*══════════════════════════════════════════════════════════════════════*/ - do j=1 for T; a=a j; end; b=a; a=0 a; call tell '1÷[e-1]' -/*══════════════════════════════════════════════════════════════════════*/ -a=1 rep(1); call tell 'φ, phi' -/*══════════════════════════════════════════════════════════════════════*/ -a=1; do j=1 for T by 2; a=a j 1; end; call tell 'tan(1)' -/*══════════════════════════════════════════════════════════════════════*/ -a=1; do j=1 for T; a=a 2*j+1; end; call tell 'coth(1)' -/*══════════════════════════════════════════════════════════════════════*/ -a=2; do j=1 for T; a=a 4*j+2; end; call tell 'coth(½)' /*also: [e+1] ÷ [e-1] */ -/*══════════════════════════════════════════════════════════════════════*/ -T=10000 -a=1 rep(2) - do j=1 for T by 2; b=b j**2; end; call tell '4÷π' -/*══════════════════════════════════════════════════════════════════════*/ -T=10000 -a=1; do j=1 for T; a=a 1/j; @=@ '1/'j; end; call tell '½π, ½pi' -/*══════════════════════════════════════════════════════════════════════*/ -T=10000 -a=0 1 rep(2) - do j=1 for T by 2; b=b j**2; end; b=4 b; call tell 'π, pi' -/*══════════════════════════════════════════════════════════════════════*/ -T=10000 -a=0; do j=1 for T; a=a j*2-1; b=b j**2; end; b=4 b; call tell 'π, pi' -/*══════════════════════════════════════════════════════════════════════*/ -T=100000 -a=3 rep(6) - do j=1 for T by 2; b=b j**2; end; call tell 'π, pi' -exit /*stick a fork in it, we're done.*/ - -/*────────────────────────────────CF subroutine─────────────────────────*/ -cf: procedure; parse arg C x,y; !=0; numeric digits digits()+5 - do k=words(x) to 1 by -1; a=word(x,k); b=word(word(y,k) 1,1) - d=a+!; if d=0 then call divZero /*in case divisor is bogus.*/ - !=b/d /*here's a binary mosh pit.*/ - end /*k*/ -return !+C -/*────────────────────────────────DIVZERO subroutine────────────────────*/ -divZero: say; say '***error!***'; say 'division by zero.'; say; exit 13 -/*────────────────────────────────GETT subroutine───────────────────────*/ -getT: parse arg stuff,width,ma,mb,_ - do m=1; mm=m+ma; mn=max(1,m-mb); w=word(stuff,m) - w=right(w,max(length(word(As,mm)),length(word(Bs,mn)),length(w))) - if length(_ w)>width then leave /*stop getting terms?*/ - _=_ w /*whole, don't chop. */ - end /*m*/ /*done building terms*/ -return strip(_) /*strip leading blank*/ -/*────────────────────────────────REP subroutine────────────────────────*/ -rep: parse arg rep; return space(copies(' 'rep, T%words(rep))) -/*────────────────────────────────RF subroutine─────────────────────────*/ -rf: parse arg xxx,z - do m=1 for T; w=word(xxx,m) ; if w=='1/1' | w=1 then w=1 - if w=='1/2' | w=1/2 then w='½'; if w=-.5 then w='-½' - if w=='1/4' | w=1/4 then w='¼'; if w=-.25 then w='-¼' - z=z w - end -return z /*done re-formatting.*/ -/*────────────────────────────────TELL subroutine───────────────────────*/ -tell: parse arg ?; v=cf(a,b); numeric digits showdig; As=rf(@ a); Bs=rf(b) - say right(?,8) '=' left(v/1,showdig) ' α terms= ' getT(As,72 ,0,1) - if b\=='' then say right('',8+2+showdig+1) ' ß terms= ' getT(Bs,72-2,1,0) - a=; @=; b=; return +/*REXX program calculates and displays values of various continued fractions. */ +parse arg terms digs . +if terms=='' | terms=="," then terms=500 +if digs=='' | digs=="," then digs=100 +numeric digits digs /*use 100 decimal digits for display.*/ +b.=1 /*omitted ß terms are assumed to be 1.*/ +/*══════════════════════════════════════════════════════════════════════════════════════*/ +a.=2; call tell '√2', cf(1) +/*══════════════════════════════════════════════════════════════════════════════════════*/ +a.=1; do N=2 by 2 to terms; a.N=2; end; call tell '√3', cf(1) /*also: 2∙sin(π/3) */ +/*══════════════════════════════════════════════════════════════════════════════════════*/ +a.=2 /* ___ */ + do N=2 to 17 /*generalized √ N */ + b.=N-1; NN=right(N, 2); call tell 'gen √'NN, cf(1) + end /*N*/ +/*══════════════════════════════════════════════════════════════════════════════════════*/ +a.=2; b.=-1/2; call tell 'gen √ ½', cf(1) +/*══════════════════════════════════════════════════════════════════════════════════════*/ + do j=1 for terms; a.j=j; if j>1 then b.j=a.p; p=j; end; call tell 'e', cf(2) +/*══════════════════════════════════════════════════════════════════════════════════════*/ +a.=1; call tell 'φ, phi', cf(1) +/*══════════════════════════════════════════════════════════════════════════════════════*/ +a.=1; do j=1 for terms; if j//2 then a.j=j; end; call tell 'tan(1)', cf(1) +/*══════════════════════════════════════════════════════════════════════════════════════*/ + do j=1 for terms; a.j=2*j+1; end; call tell 'coth(1)', cf(1) +/*══════════════════════════════════════════════════════════════════════════════════════*/ + do j=1 for terms; a.j=4*j+2; end; call tell 'coth(½)', cf(2) /*also: [e+1]÷[e-1] */ +/*══════════════════════════════════════════════════════════════════════════════════════*/ + terms=100000 +a.=6; do j=1 for terms; b.j=(2*j-1)**2; end; call tell 'π, pi', cf(3) +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +cf: procedure expose a. b. terms; parse arg C; !=0; numeric digits 9+digits() + do k=terms by -1 for terms; d=a.k+!; !=b.k/d + end /*k*/ + return !+C +/*──────────────────────────────────────────────────────────────────────────────────────*/ +tell: parse arg ?,v; $=left(format(v)/1,1+digits()); w=50 /*50 bytes of terms*/ + aT=; do k=1; _=space(aT a.k); if length(_)>w then leave; aT=_; end /*k*/ + bT=; do k=1; _=space(bT b.k); if length(_)>w then leave; bT=_; end /*k*/ + say right(?,8) "=" $ ' α terms='aT ... + if b.1\==1 then say right("",12+digits()) ' ß terms='bT ... + a=; b.=1; return /*only 50 bytes of α & ß terms ↑ are displayed. */ diff --git a/Task/Continued-fraction/Rust/continued-fraction.rust b/Task/Continued-fraction/Rust/continued-fraction.rust new file mode 100644 index 0000000000..d09fd79bb6 --- /dev/null +++ b/Task/Continued-fraction/Rust/continued-fraction.rust @@ -0,0 +1,45 @@ +use std::iter; + +// Calculating a continued fraction is quite easy with iterators, however +// writing a proper iterator adapter is less so. We settle for a macro which +// for most purposes works well enough. +// +// One limitation with this iterator based approach is that we cannot reverse +// input iterators since they are not usually DoubleEnded. To circumvent this +// we can collect the elements and then reverse them, however this isn't ideal +// as we now have to store elements equal to the number of iterations. +// +// Another is that iterators cannot be resused once consumed, so it is often +// required to make many clones of iterators. +macro_rules! continued_fraction { + ($a:expr, $b:expr ; $iterations:expr) => ( + ($a).zip($b) + .take($iterations) + .collect::>().iter() + .rev() + .fold(0 as f64, |acc: f64, &(x, y)| { + x as f64 + (y as f64 / acc) + }) + ); + + ($a:expr, $b:expr) => (continued_fraction!($a, $b ; 1000)); +} + +fn main() { + // Sqrt(2) + let sqrt2a = (1..2).chain(iter::repeat(2)); + let sqrt2b = iter::repeat(1); + println!("{}", continued_fraction!(sqrt2a, sqrt2b)); + + + // Napier's Constant + let napiera = (2..3).chain(1..); + let napierb = (1..2).chain(1..); + println!("{}", continued_fraction!(napiera, napierb)); + + + // Pi + let pia = (3..4).chain(iter::repeat(6)); + let pib = (1i64..).map(|x| (2 * x - 1).pow(2)); + println!("{}", continued_fraction!(pia, pib)); +} diff --git a/Task/Continued-fraction/ZX-Spectrum-Basic/continued-fraction.zx b/Task/Continued-fraction/ZX-Spectrum-Basic/continued-fraction.zx new file mode 100644 index 0000000000..ee00c1adc6 --- /dev/null +++ b/Task/Continued-fraction/ZX-Spectrum-Basic/continued-fraction.zx @@ -0,0 +1,11 @@ +10 LET a0=1: LET b1=1: LET a$="2": LET b$="1": PRINT "SQR(2) = ";: GO SUB 1000 +20 LET a0=2: LET b1=1: LET a$="N": LET b$="N": PRINT "e = ";: GO SUB 1000 +30 LET a0=3: LET b1=1: LET a$="6": LET b$="(2*N+1)^2": PRINT "PI = ";: GO SUB 1000 +100 STOP +1000 LET n=0: LET e$="": LET p$="" +1010 LET n=n+1 +1020 LET e$=e$+STR$ VAL a$+"+"+STR$ VAL b$+"/(" +1030 IF LEN e$<(4000-n) THEN GO TO 1010 +1035 FOR i=1 TO n: LET p$=p$+")": NEXT i +1040 PRINT a0+b1/VAL (e$+"1"+p$) +1050 RETURN diff --git a/Task/Convert-decimal-number-to-rational/00DESCRIPTION b/Task/Convert-decimal-number-to-rational/00DESCRIPTION index 6e67542421..b918264f4a 100644 --- a/Task/Convert-decimal-number-to-rational/00DESCRIPTION +++ b/Task/Convert-decimal-number-to-rational/00DESCRIPTION @@ -1,3 +1,5 @@ +{{clarify task}} + The task is to write a program to transform a decimal number into a fraction in lowest terms. It is not always possible to do this exactly. For instance, while rational numbers can be converted to decimal representation, some of them need an infinite number of digits to be represented exactly in decimal form. Namely, [[wp:Repeating decimal|repeating decimals]] such as 1/3 = 0.333... @@ -6,11 +8,12 @@ Because of this, the following fractions cannot be obtained (reliably) unless th * 67 / 74 = 0.9(054) = 0.9054054... * 14 / 27 = 0.(518) = 0.518518... -Acceptable output: +
    Acceptable output: * 0.9054054 → 4527027 / 5000000 * 0.518518 → 259259 / 500000 -Finite decimals are of course no problem: +
    Finite decimals are of course no problem: * 0.75 → 3 / 4 +

    diff --git a/Task/Convert-decimal-number-to-rational/Forth/convert-decimal-number-to-rational.fth b/Task/Convert-decimal-number-to-rational/Forth/convert-decimal-number-to-rational.fth new file mode 100644 index 0000000000..9b6aee4aa9 --- /dev/null +++ b/Task/Convert-decimal-number-to-rational/Forth/convert-decimal-number-to-rational.fth @@ -0,0 +1,35 @@ +\ Brute force search, optimized to search only within integer bounds surrounding target +\ Forth 200x compliant + +: RealToRational ( float_target int_denominator_limit -- numerator denominator ) + {: f: thereal denlimit | realscale numtor denom neg? f: besterror f: temperror :} + 0 to numtor + 0 to denom + 9999999e to besterror \ very large error that will surely be improved upon + thereal F0< to neg? \ save sign for later + thereal FABS to thereal + + thereal FTRUNC f>s 1+ to realscale \ realscale helps set integer bounds around target + + denlimit 1+ 1 ?DO \ search through possible denominators ( 1 to denlimit) + + I realscale * I realscale 1- * ?DO \ search within integer limits bounding the real + I s>f J s>f F/ \ e.g. for 3.1419e search only between 3 and 4 + thereal F- FABS to temperror + + temperror besterror F< IF + temperror to besterror I to numtor J to denom + THEN + LOOP + + LOOP + + neg? IF numtor NEGATE to numtor THEN + + numtor denom +; +(run) +1.618033988e 100 RealToRational swap . . 144 89 +3.14159e 1000 RealToRational swap . . 355 113 +2.71828e 1000 RealToRational swap . . 1264 465 +0.9054054e 100 RealToRational swap . . 67 74 diff --git a/Task/Convert-decimal-number-to-rational/Fortran/convert-decimal-number-to-rational.f b/Task/Convert-decimal-number-to-rational/Fortran/convert-decimal-number-to-rational.f new file mode 100644 index 0000000000..1e1af206dc --- /dev/null +++ b/Task/Convert-decimal-number-to-rational/Fortran/convert-decimal-number-to-rational.f @@ -0,0 +1,97 @@ + MODULE PQ !Plays with some integer arithmetic. + INTEGER MSG !Output unit number. + CONTAINS !One good routine. + INTEGER FUNCTION GCD(I,J) !Greatest common divisor. + INTEGER I,J !Of these two integers. + INTEGER N,M,R !Workers. + N = MAX(I,J) !Since I don't want to damage I or J, + M = MIN(I,J) !These copies might as well be the right way around. + 1 R = MOD(N,M) !Divide N by M to get the remainder R. + IF (R.GT.0) THEN !Remainder zero? + N = M !No. Descend a level. + M = R !M-multiplicity has been removed from N. + IF (R .GT. 1) GO TO 1 !No point dividing by one. + END IF !If R = 0, M divides N. + GCD = M !There we are. + END FUNCTION GCD !Euclid lives on! + + SUBROUTINE RATIONAL10(X)!By contrast, this is rather crude. + DOUBLE PRECISION X !The number. + DOUBLE PRECISION R !Its latest rational approach. + INTEGER P,Q !For R = P/Q. + INTEGER F,WHACK !Assistants. + PARAMETER (WHACK = 10**8) !The rescale... + P = X*WHACK + 0.5 !Multiply by WHACK/WHACK = 1 and round to integer. + Q = WHACK !Thus compute X/1, sortof. + F = GCD(P,Q) !Perhaps there is a common factor. + P = P/F !Divide it out. + Q = Q/F !For a proper rational number. + R = DBLE(P)/DBLE(Q) !So, where did we end up? + WRITE (MSG,1) P,Q,X - R,WHACK !Details. + 1 FORMAT ("x - ",I0,"/",I0,T28," = ",F18.14, + 1 " via multiplication by ",I0) + END SUBROUTINE RATIONAL10 !Enough of this. + + SUBROUTINE RATIONAL(X) !Use brute force in a different way. + DOUBLE PRECISION X !The number. + DOUBLE PRECISION R,E,BEST !Assistants. + INTEGER P,Q !For R = P/Q. + INTEGER TRY,F !Floundering. + P = 1 + X !Prevent P = 0. + Q = 1 !So, X/1, sortof. + BEST = X*6 !A largeish value for the first try. + DO TRY = 1,10000000 !Pound away. + R = DBLE(P)/DBLE(Q) !The current approximation. + E = X - R !Deviation. + IF (ABS(E) .LE. BEST) THEN !Significantly better than before? + BEST = ABS(E)*0.125 !Yes. Demand eightfold improvement to notice. + F = GCD(P,Q) !We may land on a multiple. + IF (BEST.LT.0.1D0) WRITE (MSG,1) P/F,Q/F,E !Skip early floundering. + 1 FORMAT ("x - ",I0,"/",I0,T28," = ",F18.14) !Try to align columns. + IF (F.NE.1) WRITE (MSG,*) "Common factor!",F !A surprise! + IF (E.EQ.0) EXIT !Perhaps we landed a direct hit? + END IF !So much for possible announcements. + IF (E.GT.0) THEN !Is R too small? + P = P + CEILING(E*Q) !Yes. Make P bigger by the shortfall. + ELSE IF (E .LT. 0) THEN !But perhaps R is too big? + Q = Q + 1 !If so, use a smaller interval. + END IF !So much for adjustments. + END DO !Try again. + END SUBROUTINE RATIONAL !Limited integers, limited sense. + + SUBROUTINE RATIONALISE(X,WOT) !Run the tests. + DOUBLE PRECISION X !The value. + CHARACTER*(*) WOT !Some blather. + WRITE (MSG,*) X,WOT !Explanations can help. + CALL RATIONAL10(X) !Try a crude method. + CALL RATIONAL(X) !Try a laborious method. + WRITE (MSG,*) !Space off. + END SUBROUTINE RATIONALISE !That wasn't much fun. + END MODULE PQ !But computer time is cheap. + + PROGRAM APPROX + USE PQ + DOUBLE PRECISION PI,E + MSG = 6 + WRITE (MSG,*) "Rational numbers near to decimal values." + WRITE (MSG,*) + PI = 1 !Thus get a double precision conatant. + PI = 4*ATAN(PI) !That will determine the precision of ATAN. + E = DEXP(1.0D0) !Rather than blabber on about 1 in double precision. + CALL RATIONALISE(0.1D0,"1/10 Repeating in binary..") + CALL RATIONALISE(3.14159D0,"Pi approx.") + CALL RATIONALISE(PI,"Pi approximated better.") + CALL RATIONALISE(E,"e: rational approximations aren't much use.") + CALL RATIONALISE(10.15D0,"Exact in decimal, recurring in binary.") + WRITE (MSG,*) + WRITE (MSG,*) "Variations on 67/74" + CALL RATIONALISE(0.9054D0,"67/74 = 0·9(054) repeating in base 10") + CALL RATIONALISE(0.9054054D0,"Two repeats.") + CALL RATIONALISE(0.9054054054D0,"Three repeats.") + WRITE (MSG,*) + WRITE (MSG,*) "Variations on 14/27" + CALL RATIONALISE(0.518D0,"14/27 = 0·(518) repeating in decimal.") + CALL RATIONALISE(0.519D0,"Rounded.") + CALL RATIONALISE(0.518518D0,"Two repeats, truncated.") + CALL RATIONALISE(0.518519D0,"Two repeats, rounded.") + END diff --git a/Task/Convert-decimal-number-to-rational/Java/convert-decimal-number-to-rational.java b/Task/Convert-decimal-number-to-rational/Java/convert-decimal-number-to-rational.java new file mode 100644 index 0000000000..7d31dad680 --- /dev/null +++ b/Task/Convert-decimal-number-to-rational/Java/convert-decimal-number-to-rational.java @@ -0,0 +1,12 @@ +import org.apache.commons.math3.fraction.BigFraction; + +public class Test { + + public static void main(String[] args) { + double[] n = {0.750000000, 0.518518000, 0.905405400, 0.142857143, + 3.141592654, 2.718281828, -0.423310825, 31.415926536}; + + for (double d : n) + System.out.printf("%-12s : %s%n", d, new BigFraction(d, 0.00000002D, 10000)); + } +} diff --git a/Task/Convert-decimal-number-to-rational/Perl-6/convert-decimal-number-to-rational-2.pl6 b/Task/Convert-decimal-number-to-rational/Perl-6/convert-decimal-number-to-rational-2.pl6 index 00c60cc2fe..9b99bd99c9 100644 --- a/Task/Convert-decimal-number-to-rational/Perl-6/convert-decimal-number-to-rational-2.pl6 +++ b/Task/Convert-decimal-number-to-rational/Perl-6/convert-decimal-number-to-rational-2.pl6 @@ -1,18 +1,18 @@ sub decimal_to_fraction ( Str $n, Int $rep_digits = 0 ) returns Str { my ( $int, $dec ) = ( $n ~~ /^ (\d+) \. (\d+) $/ )».Str or die; - my ( $numer, $denom ) = ( $dec, 10 ** $dec.bytes ); + my ( $numer, $denom ) = ( $dec, 10 ** $dec.chars ); if $rep_digits { - my $to_move = $dec.bytes - $rep_digits; + my $to_move = $dec.chars - $rep_digits; $numer -= $dec.substr(0, $to_move); $denom -= 10 ** $to_move; } - my $rat = Rat.new( $numer.Int, $denom.Int ).perl; - return $int ?? "$int $rat" !! $rat; + my $rat = Rat.new( $numer.Int, $denom.Int ).nude.join('/'); + return $int > 0 ?? "$int $rat" !! $rat; } -my @a = ['0.9054', 3], ['0.518', 3], ['0.75', 0], (^4).map({['12.34567', $_]}); +my @a = ['0.9054', 3], ['0.518', 3], ['0.75', 0], | (^4).map({['12.34567', $_]}); for @a -> [ $n, $d ] { say "$n with $d repeating digits = ", decimal_to_fraction( $n, $d ); } diff --git a/Task/Convert-decimal-number-to-rational/REXX/convert-decimal-number-to-rational-1.rexx b/Task/Convert-decimal-number-to-rational/REXX/convert-decimal-number-to-rational-1.rexx index f30d48bc50..7243e64f68 100644 --- a/Task/Convert-decimal-number-to-rational/REXX/convert-decimal-number-to-rational-1.rexx +++ b/Task/Convert-decimal-number-to-rational/REXX/convert-decimal-number-to-rational-1.rexx @@ -1,27 +1,27 @@ -/*REXX pgm converts a rational fraction [n/m] or nnn.ddd to it's lowest terms*/ -numeric digits 10 /*use ten decimal digits of precision. */ -parse arg orig 1 n.1 '/' n.2; if n.2='' then n.2=1 /*get fraction. */ -if n.1='' then call er 'no argument specified.' /*tell error msg*/ +/*REXX program converts a rational fraction [n/m] (or nnn.ddd) to it's lowest terms.*/ +numeric digits 10 /*use ten decimal digits of precision. */ +parse arg orig 1 n.1 "/" n.2; if n.2='' then n.2=1 /*get the fraction.*/ +if n.1='' then call er 'no argument specified.' - do j=1 to 2; if \datatype(n.j,'N') then call er "argument isn't numeric:" n.j - end /*j*/ /* [↑} validate arguments: n.1 n.2 */ + do j=1 for 2; if \datatype(n.j, 'N') then call er "argument isn't numeric:" n.j + end /*j*/ /* [↑] validate arguments: n.1 n.2 */ -if n.2=0 then call er "divisor can't be zero." /*Whoa! Dividing by zero! */ -say 'old =' space(orig) /*display original fraction*/ -say 'new =' rat(n.1/n.2) /*display the result──►term*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -er: say; say '***error!***'; say; say arg(1); say; exit 13 -/*────────────────────────────────────────────────────────────────────────────*/ -rat: procedure; parse arg x 1 _x,y; if y=='' then y = 10**(digits()-1) - b=0; g=0; a=1; h=1 /* [↑] Y is the tolerance*/ - do while a<=y & g<=y; n=trunc(_x) +if n.2=0 then call er "divisor can't be zero." /*Whoa! We're dividing by zero ! */ +say 'old =' space(orig) /*display the original fraction. */ +say 'new =' rat(n.1/n.2) /*display the result ──► terminal. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +er: say; say '***error***'; say; say arg(1); say; exit 13 +/*──────────────────────────────────────────────────────────────────────────────────────*/ +rat: procedure; parse arg x 1 _x,y; if y=='' then y = 10**(digits()-1) + b=0; g=0; a=1; h=1 /* [↑] Y is the tolerance.*/ + do while a<=y & g<=y; n=trunc(_x) _=a; a=n*a+b; b=_ _=g; g=n*g+h; h=_ if n=_x | a/g=x then do; if a>y | g>y then iterate b=a; h=g; leave end _x=1/(_x-n) - end /*while a≤y & g≤y*/ - if h==1 then return b /*don't display the number divided by 1*/ - return b'/'h /*display proper (or improper) fraction*/ + end /*while*/ + if h==1 then return b /*don't return number ÷ by 1.*/ + return b'/'h /*proper or improper fraction. */ diff --git a/Task/Conways-Game-of-Life/00DESCRIPTION b/Task/Conways-Game-of-Life/00DESCRIPTION index d1e79ede50..bb6995ecf4 100644 --- a/Task/Conways-Game-of-Life/00DESCRIPTION +++ b/Task/Conways-Game-of-Life/00DESCRIPTION @@ -1,9 +1,10 @@ -The '''Game of Life''' is a [[wp:cellular automaton|cellular automaton]] devised by the British mathematician [[wp:John Horton Conway|John Horton Conway]] in 1970. -It is the best-known example of a cellular automaton. +The '''Game of Life''' is a   [[wp:cellular automaton|cellular automaton]]   devised by the British mathematician   [[wp:John Horton Conway|John Horton Conway]]   in 1970.   It is the best-known example of a cellular automaton. -Conway's game of life is described [[wp:Conway%27s_Game_of_Life|here]]: +Conway's game of life is described   [[wp:Conway%27s_Game_of_Life|here]]: -A cell '''C''' is represented by a 1 when alive or 0 when dead, in an m-by-m square array of cells. We calculate '''N''' - the sum of live cells in C's [[wp:Moore neighborhood|eight-location neighbourhood]], then cell C is alive or dead in the next generation based on the following table: +A cell   '''C'''   is represented by a   '''1'''   when alive,   or   '''0'''   when dead,   in an   m-by-m   (or m×m)   square array of cells. + +We calculate   '''N'''   - the sum of live cells in C's   [[wp:Moore neighborhood|eight-location neighbourhood]],   then cell   C   is alive or dead in the next generation based on the following table: '''C N new C''' 1 0,1 -> 0 # Lonely 1 4,5,6,7,8 -> 0 # Overcrowded @@ -13,13 +14,18 @@ A cell '''C''' is represented by a 1 when alive or 0 when dead, in an m-by-m squ Assume cells beyond the boundary are always dead. -The "game" is actually a zero-player game, meaning that its evolution is determined by its initial state, needing no input from human players. One interacts with the Game of Life by creating an initial configuration and observing how it evolves. +The "game" is actually a zero-player game, meaning that its evolution is determined by its initial state, needing no input from human players.   One interacts with the Game of Life by creating an initial configuration and observing how it evolves. + + +;Task: +Although you should test your implementation on more complex examples such as the   [[wp:Conway%27s_Game_of_Life#Examples_of_patterns|glider]]   in a larger universe,   show the action of the blinker   (three adjoining cells in a row all alive),   over three generations, in a 3 by 3 grid. -Although you should test your implementation on more complex examples such as the [[wp:Conway%27s_Game_of_Life#Examples_of_patterns|glider]] in a larger universe, show the action of the blinker (three adjoining cells in a row all alive), over three generations, in a 3 by 3 grid. ;References: -* Its creator John Conway, explains [http://www.youtube.com/watch?v=E8kUJL04ELA the game of life]. Video from numberphile on youtube. -* John Conway [http://www.youtube.com/watch?v=R9Plq-D1gEk Inventing Game of Life]- Numberphile video. +*   Its creator John Conway, explains   [http://www.youtube.com/watch?v=E8kUJL04ELA the game of life].   Video from numberphile on youtube. +*   John Conway   [http://www.youtube.com/watch?v=R9Plq-D1gEk Inventing Game of Life]   - Numberphile video. + ;See also: -* [[Langton's ant]] - another well known cellular automaton. +*   [[Langton's ant]]   - another well known cellular automaton. +

    diff --git a/Task/Conways-Game-of-Life/BASIC/conways-game-of-life-10.basic b/Task/Conways-Game-of-Life/BASIC/conways-game-of-life-10.basic new file mode 100644 index 0000000000..3e6839ffc6 --- /dev/null +++ b/Task/Conways-Game-of-Life/BASIC/conways-game-of-life-10.basic @@ -0,0 +1,76 @@ +Define life(pattern) = Prgm + Local x,y,nt,count,save,xl,yl,xh,yh + Define nt(y,x) = when(pxlTest(y,x), 1, 0) + + {}→save + setGraph("Axes", "Off")→save[1] + setGraph("Grid", "Off")→save[2] + setGraph("Labels", "Off")→save[3] + FnOff + PlotOff + ClrDraw + + If pattern = "blinker" Then + 36→yl + 40→yh + 78→xl + 82→xh + PxlOn 36,80 + PxlOn 38,80 + PxlOn 40,80 + ElseIf pattern = "glider" Then + 30→yl + 40→yh + 76→xl + 88→xh + PxlOn 38,76 + PxlOn 36,78 + PxlOn 36,80 + PxlOn 38,80 + PxlOn 40,80 + ElseIf pattern = "r" Then + 38-5*2→yl + 38+5*2→yh + 80-5*2→xl + 80+5*2→xh + PxlOn 38,78 + PxlOn 36,82 + PxlOn 36,80 + PxlOn 38,80 + PxlOn 40,80 + EndIf + + While getKey() = 0 + © Expand upper-left corner to whole cell + For y,yl,yh,2 + For x,xl,xh,2 + If pxlTest(y,x) Then + PxlOn y+1,x + PxlOn y+1,x+1 + PxlOn y, x+1 + Else + PxlOff y+1,x + PxlOff y+1,x+1 + PxlOff y, x+1 + EndIf + EndFor + EndFor + + © Compute next generation + For y,yl,yh,2 + For x,xl,xh,2 + nt(y-1,x-1) + nt(y-1,x) + nt(y-1,x+2) + nt(y,x-1) + nt(y+1,x+2) + nt(y+2,x-1) + nt(y+2,x+1) + nt(y+2,x+2) → count + If count = 3 Then + PxlOn y,x + ElseIf count ≠ 2 Then + PxlOff y,x + EndIf + EndFor + EndFor + EndWhile + + © Restore changed options + setGraph("Axes", save[1]) + setGraph("Grid", save[2]) + setGraph("Labels", save[3]) +EndPrgm diff --git a/Task/Conways-Game-of-Life/BASIC/conways-game-of-life-4.basic b/Task/Conways-Game-of-Life/BASIC/conways-game-of-life-4.basic index d810d2e1d9..4e003a2083 100644 --- a/Task/Conways-Game-of-Life/BASIC/conways-game-of-life-4.basic +++ b/Task/Conways-Game-of-Life/BASIC/conways-game-of-life-4.basic @@ -1,41 +1,45 @@ -'FreeBASIC Conway's Game of Life -'May 2015 -' - grid = 300 '480 by 480 - gridy = grid - gridx = grid - pointsize = 5 'pixels - steps = 10 +' FreeBASIC Conway's Game of Life +' May 2015 +' 07-10-2016 cleanup/little changes +' moved test inkey outside the ScreenLock - ScreenUnLock block +' compile: fbc -s gui -press$ = "" +Const As UInteger grid = 300 '480 by 480 +Const As UInteger gridy = grid +Const As UInteger gridx = grid +Const As UInteger pointsize = 5 'pixels +Const As UInteger steps = 10 +Dim As UInteger gen, n, neighbours, x, y, was - red = 4 'red is color 6 - white = 15 'color - black = 0 'color +Dim As String press - 'color 0 normaly is black - 'color 1 normaly is dark blue - 'color 2 normaly is green - bot = 35 'this is 35 lines from the top of the page - dim old( grid + 10, grid +10), new( grid +10, grid +10) +Const As UByte red = 4 'red is color 6 +Const As UByte white = 15 'color +Const As UByte black = 0 'color + +'color 0 normaly is black +'color 1 normaly is dark blue +'color 2 normaly is green +Const As UInteger bot = 35 'this is 35 lines from the top of the page +Dim As UByte old( grid + 10, grid +10), new_( grid +10, grid +10) 'Set blinker: - ' old( 160, 160) =1: old( 160, 170) =1 : old( 160, 180) =1 +' old( 160, 160) =1: old( 160, 170) =1 : old( 160, 180) =1 'Set blinker: - ' old( 160, 20) =1: old( 160, 30) =1 : old( 160, 40) =1 +' old( 160, 20) =1: old( 160, 30) =1 : old( 160, 40) =1 'Set blinker: - ' old( 20, 20) =1: old( 20, 30) =1 : old( 20, 40) =1 +' old( 20, 20) =1: old( 20, 30) =1 : old( 20, 40) =1 'Set glider: - ' old( 50, 70) =1: old( 60, 70) =1: old( 70, 70) =1 - ' old( 70, 60) =1: old( 60, 50) =1 +' old( 50, 70) =1: old( 60, 70) =1: old( 70, 70) =1 +' old( 70, 60) =1: old( 60, 50) =1 ' http://en.wikipedia.org/wiki/Conway%27s_Game_of_Life ' Thunderbird methuselah 'X = 59 : Y = 35 : H = 4 -'c[X/2-1,Y/3+1] = 1 : c[X/2,Y/3+1] = 1 : c[X/2+1,Y/3+1] = 1 +'c[X/2-1,Y/3+1] = 1 : c[X/2,Y/3+1] = 1 : c[X/2+1,Y/3+1] = 1 'c[X/2,Y/3+3] = 1 : c[X/2,Y/3+4] = 1 : c[X/2,Y/3+5] = 1 'xb = 59 : yb = 35 @@ -55,110 +59,113 @@ press$ = "" ' 0X ' 000X ' XX00XXX - old( 180,200) =1 - old( 200,210) =1 - old( 170,220) =1 :old( 180,220) =1 : old( 210,220) =1 : old( 220,220) =1 : old( - -230,220) =1 +old( 180,200) =1 +old( 200,210) =1 +old( 170,220) =1 : old( 180,220) =1 : old( 210,220) =1 : old( 220,220) =1 : old( 230,220) =1 Screen 20 'Resolution 800x600 with at least 256 colors -color white -line (10,10)-(gridx,gridy),,B 'box from top left to bottom right +Color white +Line (10, 10) - (gridx + 10, gridy + 10),,B 'box from top left to bottom right Locate bot, 1 'Use a standard place on the bottom of the page -color white -print " Welcome to Conway's Game of Life" -Print " Using a consrained playing field (300x300), the Acorn seed runs" -print " for about 450 generations before it becomes stable (or stale)." -print " Enter any key to start" -beep -sleep +Color white +Print " Welcome to Conway's Game of Life" +Print " Using a constrained playing field (300x300), the Acorn seed runs" +Print " for about 450 generations before it becomes stable (or stale)." +Print " Enter any key to start" +Beep +Sleep Do ' flush the key input buffer - press$ = Inkey -Loop Until press$ = "" -print " " + press = Inkey +Loop Until press = "" +'Print " " 'Draw initial grid - for x = 10 to gridX step steps - for y = 10 to gridY step steps - color white 'old(x,y) - if old(x,y) = 1 then circle (x, y), pointsize,,,,, F - next y - next x +For x = 10 To gridX Step steps + For y = 10 To gridY Step steps + Color white 'old(x,y) + If old(x,y) = 1 Then Circle (x + pointsize, y + pointsize), pointsize,,,,, F + Next y +Next x ' Locate bot, 1 -color white -print " Welcome to Conway's Game of Life" -Print " Using a consrained playing field, the Acorn seed runs for " -print " about 450 generations before it becomes stable (or stale)." -color red -print " Enter spacebar to continue or pause, ESC to stop" -sleep +Color white +Print " Welcome to Conway's Game of Life" +Print " Using a constrained playing field, the Acorn seed runs for " +Print " about 450 generations before it becomes stable (or stale). " +Color red +Print " Enter spacebar to continue or pause, ESC to stop" +Sleep ' Do ' flush the key input buffer - press$ = Inkey -Loop Until press$ = "" + press = Inkey +Loop Until press = "" - do - press$ = INKEY - gen = gen + 1 - locate bot+5,1 - color white - print " Gen = "; gen - for x = 10 to gridX step steps - for y = 10 to gridY step steps - 'find number of live Moore neighbours - neighbours = old( x - steps, y - steps) +old( x , y - steps) - neighbours = neighbours + old( x + steps, y -steps) - neighbours = neighbours + old( x - steps, y) + old( x + steps, y) - neighbours = neighbours + old( x - steps, y + steps) - neighbours = neighbours + old( x, y + steps) +old( x + steps, y + steps) - was =old( x, y) - if was =0 then - if neighbours =3 then N =1 else N =0 - else - if neighbours =3 or neighbours =2 then N =1 else N =0 - end if - new( x, y) = N - if n = 2 then color white - if n = 1 then color red - if n = 0 then color black - circle (x, y), pointsize,,,,, F - if press$ = CHR$(27) goto 10 - if press$ = " " then - sleep - Do ' flush the key input buffer - press$ = Inkey - Loop Until press$ = "" - press$ = INKEY - endif - next y - next x -color white -line (10,10)-(gridx,gridy),,B 'box from top left to bottom right -locate bot,1 -' -'t = timer -'do -'loop until timer > t + .2 +Do + gen = gen + 1 + Locate bot+5,1 + Color white + Print " Gen = "; gen + ScreenLock + For x = 10 To gridX Step steps + For y = 10 To gridY Step steps + 'find number of live neighbours + neighbours = old( x - steps, y - steps) +old( x , y - steps) + neighbours = neighbours + old( x + steps, y -steps) + neighbours = neighbours + old( x - steps, y) + old( x + steps, y) + neighbours = neighbours + old( x - steps, y + steps) + neighbours = neighbours + old( x, y + steps) +old( x + steps, y + steps) + was =old( x, y) + If was =0 Then + If neighbours =3 Then N =1 Else N =0 + Else + If neighbours =3 Or neighbours =2 Then N =1 Else N =0 + End If + new_( x, y) = N + If n = 2 Then Color white + If n = 1 Then Color red + If n = 0 Then Color black + Circle (x + pointsize, y + pointsize), pointsize,,,,, F + Next y + Next x + Color white + Line (10, 10) - (gridx + 10, gridy + 10),,B 'box from top left to bottom right + ' Locate bot,1 + ' + 't = timer + 'do + 'loop until timer > t + .2 + ScreenUnlock + ' might not be slow enough + Sleep 70, 1 ' ignore key press -sleep 70 ' might not be slow enough -' - for x =10 to gridX step steps - for y =10 to gridY step steps - old( x, y) =new( x, y) - next y - next x + press = Inkey + If press = " " Then + Do ' flush the key input buffer + press = Inkey + Loop Until press = "" + Do ' wait until a key is pressed + press = Inkey + Loop Until press <> "" + End If + If press = Chr(27) Then Exit Do + ' mouse click on close window "X" + If press = Chr(255)+"k" Then End ' stop and close window -LOOP ' UNTIL press$ = CHR$(27) 'return to do loop up top until "esc" key is pressed. + For x =10 To gridX Step steps + For y =10 To gridY Step steps + old( x, y) =new_( x, y) + Next y + Next x -10 -color white -locate bot+3,1 -print " " 'clear instructions -locate bot+6,1 +Loop ' UNTIL press = CHR(27) 'return to do loop up top until "esc" key is pressed. + +Color white +Locate bot+3,1 +Print Space(55) 'clear instructions +Locate bot+6,1 Print " Press any key to exit " -sleep +Sleep End diff --git a/Task/Conways-Game-of-Life/BASIC/conways-game-of-life-5.basic b/Task/Conways-Game-of-Life/BASIC/conways-game-of-life-5.basic index e1f236d310..a6fa0ea8d8 100644 --- a/Task/Conways-Game-of-Life/BASIC/conways-game-of-life-5.basic +++ b/Task/Conways-Game-of-Life/BASIC/conways-game-of-life-5.basic @@ -1,68 +1,143 @@ - nomainwin - - gridX = 20 - gridY = gridX - - mult =500 /gridX - pointSize =360 /gridX - - dim old( gridX +1, gridY +1), new( gridX +1, gridY +1) - -'Set blinker: - old( 16, 16) =1: old( 16, 17) =1 : old( 16, 18) =1 - -'Set glider: - old( 5, 7) =1: old( 6, 7) =1: old( 7, 7) =1 - old( 7, 6) =1: old( 6, 5) =1 - - WindowWidth =570 - WindowHeight =600 - - open "Conway's 'Game of Life'." for graphics_nsb_nf as #w - - #w "trapclose [quit]" - #w "down ; size "; pointSize - #w "fill black" - -'Draw initial grid - for x = 1 to gridX - for y = 1 to gridY - '#w "color "; int( old( x, y) *256); " 0 255" - if old( x, y) <>0 then #w "color red" else #w "color darkgray" - #w "set "; x *mult +20; " "; y *mult +20 - next y - next x -' ______________________________________________________________________________ -'Run - do - for x =1 to gridX - for y =1 to gridY - 'find number of live Moore neighbours - neighbours =old( x -1, y -1) +old( x, y -1) +old( x +1, y -1)+_ - old( x -1, y) +old( x +1, y )+_ - old( x -1, y +1) +old( x, y +1) +old( x +1, y +1) - was =old( x, y) - if was =0 then - if neighbours =3 then N =1 else N =0 - else - if neighbours =3 or neighbours =2 then N =1 else N =0 - end if - new( x, y) = N - '#w "color "; int( N /8 *256); " 0 255" - if N <>0 then #w "color red" else #w "color darkgray" - #w "set "; x *mult +20; " "; y *mult +20 - next y - next x - scan -'swap - for x =1 to gridX - for y =1 to gridY - old( x, y) =new( x, y) - next y - next x -'Re-run until interrupted... - loop until FALSE -'User shutdown received - [quit] - close #w - end +' +' Conway's Game of Life +' +' 30x30 world held in an array size 32x32 +' world is in indices 1->30, 0 and 31 are always false, for neighbourhoods +' +DIM world!(32,32) +DIM ns%(31,31) ! used to hold the neighbour counts +clock%=1 +' +' run the world +' +@setup_world +@open_window +DO + @display_world + t$=INKEY$ + EXIT IF t$="q" ! need to hold key down to exit + @update_world + DELAY 0.5 ! delay of 0.5s needed in compiled version +LOOP +@close_window +' +' Setup the world, with a blinker in one corner and a glider in the other +' +PROCEDURE setup_world + ARRAYFILL world!(),FALSE + ' blinker in lower-right + world!(25,25)=TRUE + world!(26,25)=TRUE + world!(27,25)=TRUE + ' glider in top-left + world!(2,2)=TRUE + world!(3,3)=TRUE + world!(3,4)=TRUE + world!(2,4)=TRUE + world!(1,4)=TRUE +RETURN +' +' Count the number of neighbours of the point i,j +' (Assume i/j +/- 1 will not fall out of world) +' +FUNCTION count_neighbours(i%,j%) + LOCAL count%,l% + count%=0 + FOR l%=-1 TO 1 + IF world!(i%+l%,j%-1) + count%=count%+1 + ENDIF + IF world!(i%+l%,j%+1) + count%=count%+1 + ENDIF + NEXT l% + IF world!(i%-1,j%) + count%=count%+1 + ENDIF + IF world!(i%+1,j%) + count%=count%+1 + ENDIF + RETURN count% +ENDFUNC +' +' Update the world one step +' +PROCEDURE update_world + LOCAL i%,j% + ' compute neighbour counts and store + FOR i%=1 TO 30 + FOR j%=1 TO 30 + ns%(i%,j%)=@count_neighbours(i%,j%) + NEXT j% + NEXT i% + ' update the world cells + FOR i%=1 TO 30 + FOR j%=1 TO 30 + IF world!(i%,j%) + SELECT ns%(i%,j%) + CASE 0,1 + world!(i%,j%)=FALSE ! LONELY + CASE 2,3 + world!(i%,j%)=TRUE ! LIVES + CASE 4,5,6,7,8 + world!(i%,j%)=FALSE ! OVERCROWDED + ENDSELECT + ELSE + IF ns%(i%,j%)=3 + world!(i%,j%)=TRUE ! BIRTH + ELSE + world!(i%,j%)=FALSE ! BARREN + ENDIF + ENDIF + NEXT j% + NEXT i% + ' update the clock + clock%=clock%+1 +RETURN +' +' Display the world in window +' +PROCEDURE display_world + LOCAL offsetx%,offsety%,i%,j%,x%,y%,scale% + @clear_window + ' show clock + VSETCOLOR 2,0,0,0 + DEFTEXT 2 + PRINT AT(5,1);"Clock: ";clock% + ' offset from top-left of display + offsetx%=10 + offsety%=10 + ' colour to display active cell + VSETCOLOR 1,15,0,0 + DEFFILL 1 + ' scale of display + scale%=9 + ' display each cell in world + FOR i%=1 TO 30 + FOR j%=1 TO 30 + IF world!(i%,j%) + ' display active cell + x%=offsetx%+scale%*i% + y%=offsety%+scale%*j% + PBOX x%,y%,x%+scale%,y%+scale% + ENDIF + NEXT j% + NEXT i% +RETURN +' +' Manage window for display +' +PROCEDURE open_window + OPENW 1 + CLEARW 1 +RETURN +' +PROCEDURE clear_window + VSETCOLOR 0,15,15,15 + DEFFILL 0 + PBOX 0,0,300,300 +RETURN +' +PROCEDURE close_window + CLOSEW 1 +RETURN diff --git a/Task/Conways-Game-of-Life/BASIC/conways-game-of-life-6.basic b/Task/Conways-Game-of-Life/BASIC/conways-game-of-life-6.basic index 3cbea8d8cb..ae1d5b19b5 100644 --- a/Task/Conways-Game-of-Life/BASIC/conways-game-of-life-6.basic +++ b/Task/Conways-Game-of-Life/BASIC/conways-game-of-life-6.basic @@ -1,56 +1,68 @@ -EnableExplicit -Define.i x, y ,Xmax ,Ymax ,N -Xmax = 13 : Ymax = 20 -Dim world.i(Xmax+1,Ymax+1) -Dim Nextworld.i(Xmax+1,Ymax+1) + nomainwin -; Glider test -;------------------------------------------ - world(1,1)=1 : world(1,2)=0 : world(1,3)=0 - world(2,1)=0 : world(2,2)=1 : world(2,3)=1 - world(3,1)=1 : world(3,2)=1 : world(3,3)=0 -;------------------------------------------ + gridX = 20 + gridY = gridX -OpenConsole() -EnableGraphicalConsole(1) -ClearConsole() -Print("Press any key to interrupt") -Repeat - ConsoleLocate(0,2) - PrintN(LSet("", Xmax+2, "-")) - ;---------- endless world --------- - For y = 1 To Ymax - world(0,y)=world(Xmax,y) - world(Xmax+1,y)=world(1,y) - Next - For x = 1 To Xmax - world(x,0)=world(x,Ymax) - world(x,Ymax+1)=world(x,1) - Next - world(0 ,0 )=world(Xmax,Ymax) - world(Xmax+1,Ymax+1)=world(1 ,1 ) - world(Xmax+1,0 )=world(1 ,Ymax) - world( 0,Ymax+1)=world(Xmax,1 ) - ;---------- endless world --------- - For y = 1 To Ymax - Print("|") - For x = 1 To Xmax - Print(Chr(32+world(x,y)*3)) - N = world(x-1,y-1)+world(x-1,y)+world(x-1,y+1)+world(x,y-1) - N + world(x,y+1)+world(x+1,y-1)+world(x+1,y)+world(x+1,y+1) - If (world(x,y) And (N = 2 Or N = 3))Or (world(x,y)=0 And N = 3) - Nextworld(x,y)=1 - Else - Nextworld(x,y)=0 - EndIf - Next - PrintN("|") - Next - PrintN(LSet("", Xmax+2, "-")) - Delay(100) - ;Swap world() , Nextworld() ;PB <4.50 - CopyArray(Nextworld(), world());PB =>4.50 - Dim Nextworld.i(Xmax+1,Ymax+1) -Until Inkey() <> "" + mult =500 /gridX + pointSize =360 /gridX -PrintN("Press any key to exit"): Repeat: Until Inkey() <> "" + dim old( gridX +1, gridY +1), new( gridX +1, gridY +1) + +'Set blinker: + old( 16, 16) =1: old( 16, 17) =1 : old( 16, 18) =1 + +'Set glider: + old( 5, 7) =1: old( 6, 7) =1: old( 7, 7) =1 + old( 7, 6) =1: old( 6, 5) =1 + + WindowWidth =570 + WindowHeight =600 + + open "Conway's 'Game of Life'." for graphics_nsb_nf as #w + + #w "trapclose [quit]" + #w "down ; size "; pointSize + #w "fill black" + +'Draw initial grid + for x = 1 to gridX + for y = 1 to gridY + '#w "color "; int( old( x, y) *256); " 0 255" + if old( x, y) <>0 then #w "color red" else #w "color darkgray" + #w "set "; x *mult +20; " "; y *mult +20 + next y + next x +' ______________________________________________________________________________ +'Run + do + for x =1 to gridX + for y =1 to gridY + 'find number of live Moore neighbours + neighbours =old( x -1, y -1) +old( x, y -1) +old( x +1, y -1)+_ + old( x -1, y) +old( x +1, y )+_ + old( x -1, y +1) +old( x, y +1) +old( x +1, y +1) + was =old( x, y) + if was =0 then + if neighbours =3 then N =1 else N =0 + else + if neighbours =3 or neighbours =2 then N =1 else N =0Tail Recursive + end if + new( x, y) = N + '#w "color "; int( N /8 *256); " 0 255" + if N <>0 then #w "color red" else #w "color darkgray" + #w "set "; x *mult +20; " "; y *mult +20 + next y + next x + scan +'swap + for x =1 to gridX + for y =1 to gridY + old( x, y) =new( x, y) + next y + next x +'Re-run until interrupted... + loop until FALSE +'User shutdown received + [quit] + close #w + end diff --git a/Task/Conways-Game-of-Life/BASIC/conways-game-of-life-7.basic b/Task/Conways-Game-of-Life/BASIC/conways-game-of-life-7.basic index 00c941336f..3cbea8d8cb 100644 --- a/Task/Conways-Game-of-Life/BASIC/conways-game-of-life-7.basic +++ b/Task/Conways-Game-of-Life/BASIC/conways-game-of-life-7.basic @@ -1,21 +1,56 @@ - PROGRAM:CONWAY -:While 1 -:For(X,2,9,1) -:For(Y,2,17,1) -:If [A](Y,X) -:Then -:Output(X-1,Y-1,"X") -:Else -:Output(X-1,Y-1," ") -:End -:[A](Y-1,X-1)+[A](Y,X-1)+[A](Y+1,X-1)+[A](Y-1,X)+[A](Y+1,X)+[A](Y-1,X+1)+[A](Y,X+1)+[A](Y+1,X+1)→N -:If ([A](Y,X) and (N=2 or N=3)) or (not([A](Y,X)) and N=3) -:Then -:1→[B](Y,X) -:Else -:0→[B](Y,X) -:End -:End -:End -:[B]→[A] -:End +EnableExplicit +Define.i x, y ,Xmax ,Ymax ,N +Xmax = 13 : Ymax = 20 +Dim world.i(Xmax+1,Ymax+1) +Dim Nextworld.i(Xmax+1,Ymax+1) + +; Glider test +;------------------------------------------ + world(1,1)=1 : world(1,2)=0 : world(1,3)=0 + world(2,1)=0 : world(2,2)=1 : world(2,3)=1 + world(3,1)=1 : world(3,2)=1 : world(3,3)=0 +;------------------------------------------ + +OpenConsole() +EnableGraphicalConsole(1) +ClearConsole() +Print("Press any key to interrupt") +Repeat + ConsoleLocate(0,2) + PrintN(LSet("", Xmax+2, "-")) + ;---------- endless world --------- + For y = 1 To Ymax + world(0,y)=world(Xmax,y) + world(Xmax+1,y)=world(1,y) + Next + For x = 1 To Xmax + world(x,0)=world(x,Ymax) + world(x,Ymax+1)=world(x,1) + Next + world(0 ,0 )=world(Xmax,Ymax) + world(Xmax+1,Ymax+1)=world(1 ,1 ) + world(Xmax+1,0 )=world(1 ,Ymax) + world( 0,Ymax+1)=world(Xmax,1 ) + ;---------- endless world --------- + For y = 1 To Ymax + Print("|") + For x = 1 To Xmax + Print(Chr(32+world(x,y)*3)) + N = world(x-1,y-1)+world(x-1,y)+world(x-1,y+1)+world(x,y-1) + N + world(x,y+1)+world(x+1,y-1)+world(x+1,y)+world(x+1,y+1) + If (world(x,y) And (N = 2 Or N = 3))Or (world(x,y)=0 And N = 3) + Nextworld(x,y)=1 + Else + Nextworld(x,y)=0 + EndIf + Next + PrintN("|") + Next + PrintN(LSet("", Xmax+2, "-")) + Delay(100) + ;Swap world() , Nextworld() ;PB <4.50 + CopyArray(Nextworld(), world());PB =>4.50 + Dim Nextworld.i(Xmax+1,Ymax+1) +Until Inkey() <> "" + +PrintN("Press any key to exit"): Repeat: Until Inkey() <> "" diff --git a/Task/Conways-Game-of-Life/BASIC/conways-game-of-life-8.basic b/Task/Conways-Game-of-Life/BASIC/conways-game-of-life-8.basic index b6f27a46b2..00c941336f 100644 --- a/Task/Conways-Game-of-Life/BASIC/conways-game-of-life-8.basic +++ b/Task/Conways-Game-of-Life/BASIC/conways-game-of-life-8.basic @@ -1,6 +1,21 @@ -PROGRAM:PIC2LIFE -:For(I,0,17,1) -:For(J,0,9,1) -:pxl-Test(J,I)→[A](I+1,J+1) + PROGRAM:CONWAY +:While 1 +:For(X,2,9,1) +:For(Y,2,17,1) +:If [A](Y,X) +:Then +:Output(X-1,Y-1,"X") +:Else +:Output(X-1,Y-1," ") +:End +:[A](Y-1,X-1)+[A](Y,X-1)+[A](Y+1,X-1)+[A](Y-1,X)+[A](Y+1,X)+[A](Y-1,X+1)+[A](Y,X+1)+[A](Y+1,X+1)→N +:If ([A](Y,X) and (N=2 or N=3)) or (not([A](Y,X)) and N=3) +:Then +:1→[B](Y,X) +:Else +:0→[B](Y,X) :End :End +:End +:[B]→[A] +:End diff --git a/Task/Conways-Game-of-Life/BASIC/conways-game-of-life-9.basic b/Task/Conways-Game-of-Life/BASIC/conways-game-of-life-9.basic index 3e6839ffc6..b6f27a46b2 100644 --- a/Task/Conways-Game-of-Life/BASIC/conways-game-of-life-9.basic +++ b/Task/Conways-Game-of-Life/BASIC/conways-game-of-life-9.basic @@ -1,76 +1,6 @@ -Define life(pattern) = Prgm - Local x,y,nt,count,save,xl,yl,xh,yh - Define nt(y,x) = when(pxlTest(y,x), 1, 0) - - {}→save - setGraph("Axes", "Off")→save[1] - setGraph("Grid", "Off")→save[2] - setGraph("Labels", "Off")→save[3] - FnOff - PlotOff - ClrDraw - - If pattern = "blinker" Then - 36→yl - 40→yh - 78→xl - 82→xh - PxlOn 36,80 - PxlOn 38,80 - PxlOn 40,80 - ElseIf pattern = "glider" Then - 30→yl - 40→yh - 76→xl - 88→xh - PxlOn 38,76 - PxlOn 36,78 - PxlOn 36,80 - PxlOn 38,80 - PxlOn 40,80 - ElseIf pattern = "r" Then - 38-5*2→yl - 38+5*2→yh - 80-5*2→xl - 80+5*2→xh - PxlOn 38,78 - PxlOn 36,82 - PxlOn 36,80 - PxlOn 38,80 - PxlOn 40,80 - EndIf - - While getKey() = 0 - © Expand upper-left corner to whole cell - For y,yl,yh,2 - For x,xl,xh,2 - If pxlTest(y,x) Then - PxlOn y+1,x - PxlOn y+1,x+1 - PxlOn y, x+1 - Else - PxlOff y+1,x - PxlOff y+1,x+1 - PxlOff y, x+1 - EndIf - EndFor - EndFor - - © Compute next generation - For y,yl,yh,2 - For x,xl,xh,2 - nt(y-1,x-1) + nt(y-1,x) + nt(y-1,x+2) + nt(y,x-1) + nt(y+1,x+2) + nt(y+2,x-1) + nt(y+2,x+1) + nt(y+2,x+2) → count - If count = 3 Then - PxlOn y,x - ElseIf count ≠ 2 Then - PxlOff y,x - EndIf - EndFor - EndFor - EndWhile - - © Restore changed options - setGraph("Axes", save[1]) - setGraph("Grid", save[2]) - setGraph("Labels", save[3]) -EndPrgm +PROGRAM:PIC2LIFE +:For(I,0,17,1) +:For(J,0,9,1) +:pxl-Test(J,I)→[A](I+1,J+1) +:End +:End diff --git a/Task/Conways-Game-of-Life/C++/conways-game-of-life-1.cpp b/Task/Conways-Game-of-Life/C++/conways-game-of-life-1.cpp new file mode 100644 index 0000000000..f57130d334 --- /dev/null +++ b/Task/Conways-Game-of-Life/C++/conways-game-of-life-1.cpp @@ -0,0 +1,204 @@ +#include +#define HEIGHT 4 +#define WIDTH 4 + +struct Shape { +public: + char xCoord; + char yCoord; + char height; + char width; + char **figure; +}; + +struct Glider : public Shape { + static const char GLIDER_SIZE = 3; + Glider( char x , char y ); + ~Glider(); +}; + +struct Blinker : public Shape { + static const char BLINKER_HEIGHT = 3; + static const char BLINKER_WIDTH = 1; + Blinker( char x , char y ); + ~Blinker(); +}; + +class GameOfLife { +public: + GameOfLife( Shape sh ); + void print(); + void update(); + char getState( char state , char xCoord , char yCoord , bool toggle); + void iterate(unsigned int iterations); +private: + char world[HEIGHT][WIDTH]; + char otherWorld[HEIGHT][WIDTH]; + bool toggle; + Shape shape; +}; + +GameOfLife::GameOfLife( Shape sh ) : + shape(sh) , + toggle(true) +{ + for ( char i = 0; i < HEIGHT; i++ ) { + for ( char j = 0; j < WIDTH; j++ ) { + world[i][j] = '.'; + } + } + for ( char i = shape.yCoord; i - shape.yCoord < shape.height; i++ ) { + for ( char j = shape.xCoord; j - shape.xCoord < shape.width; j++ ) { + if ( i < HEIGHT && j < WIDTH ) { + world[i][j] = + shape.figure[ i - shape.yCoord ][j - shape.xCoord ]; + } + } + } +} + +void GameOfLife::print() { + if ( toggle ) { + for ( char i = 0; i < HEIGHT; i++ ) { + for ( char j = 0; j < WIDTH; j++ ) { + std::cout << world[i][j]; + } + std::cout << std::endl; + } + } else { + for ( char i = 0; i < HEIGHT; i++ ) { + for ( char j = 0; j < WIDTH; j++ ) { + std::cout << otherWorld[i][j]; + } + std::cout << std::endl; + } + } + for ( char i = 0; i < WIDTH; i++ ) { + std::cout << '='; + } + std::cout << std::endl; +} + +void GameOfLife::update() { + if (toggle) { + for ( char i = 0; i < HEIGHT; i++ ) { + for ( char j = 0; j < WIDTH; j++ ) { + otherWorld[i][j] = + GameOfLife::getState(world[i][j] , i , j , toggle); + } + } + toggle = !toggle; + } else { + for ( char i = 0; i < HEIGHT; i++ ) { + for ( char j = 0; j < WIDTH; j++ ) { + world[i][j] = + GameOfLife::getState(otherWorld[i][j] , i , j , toggle); + } + } + toggle = !toggle; + } +} + +char GameOfLife::getState( char state, char yCoord, char xCoord, bool toggle ) { + char neighbors = 0; + if ( toggle ) { + for ( char i = yCoord - 1; i <= yCoord + 1; i++ ) { + for ( char j = xCoord - 1; j <= xCoord + 1; j++ ) { + if ( i == yCoord && j == xCoord ) { + continue; + } + if ( i > -1 && i < HEIGHT && j > -1 && j < WIDTH ) { + if ( world[i][j] == 'X' ) { + neighbors++; + } + } + } + } + } else { + for ( char i = yCoord - 1; i <= yCoord + 1; i++ ) { + for ( char j = xCoord - 1; j <= xCoord + 1; j++ ) { + if ( i == yCoord && j == xCoord ) { + continue; + } + if ( i > -1 && i < HEIGHT && j > -1 && j < WIDTH ) { + if ( otherWorld[i][j] == 'X' ) { + neighbors++; + } + } + } + } + } + if (state == 'X') { + return ( neighbors > 1 && neighbors < 4 ) ? 'X' : '.'; + } + else { + return ( neighbors == 3 ) ? 'X' : '.'; + } +} + +void GameOfLife::iterate( unsigned int iterations ) { + for ( int i = 0; i < iterations; i++ ) { + print(); + update(); + } +} + +Glider::Glider( char x , char y ) { + xCoord = x; + yCoord = y; + height = GLIDER_SIZE; + width = GLIDER_SIZE; + figure = new char*[GLIDER_SIZE]; + for ( char i = 0; i < GLIDER_SIZE; i++ ) { + figure[i] = new char[GLIDER_SIZE]; + } + for ( char i = 0; i < GLIDER_SIZE; i++ ) { + for ( char j = 0; j < GLIDER_SIZE; j++ ) { + figure[i][j] = '.'; + } + } + figure[0][1] = 'X'; + figure[1][2] = 'X'; + figure[2][0] = 'X'; + figure[2][1] = 'X'; + figure[2][2] = 'X'; +} + +Glider::~Glider() { + for ( char i = 0; i < GLIDER_SIZE; i++ ) { + delete[] figure[i]; + } + delete[] figure; +} + +Blinker::Blinker( char x , char y ) { + xCoord = x; + yCoord = y; + height = BLINKER_HEIGHT; + width = BLINKER_WIDTH; + figure = new char*[BLINKER_HEIGHT]; + for ( char i = 0; i < BLINKER_HEIGHT; i++ ) { + figure[i] = new char[BLINKER_WIDTH]; + } + for ( char i = 0; i < BLINKER_HEIGHT; i++ ) { + for ( char j = 0; j < BLINKER_WIDTH; j++ ) { + figure[i][j] = 'X'; + } + } +} + +Blinker::~Blinker() { + for ( char i = 0; i < BLINKER_HEIGHT; i++ ) { + delete[] figure[i]; + } + delete[] figure; +} + +int main() { + Glider glider(0,0); + GameOfLife gol(glider); + gol.iterate(5); + Blinker blinker(1,0); + GameOfLife gol2(blinker); + gol2.iterate(4); +} diff --git a/Task/Conways-Game-of-Life/C++/conways-game-of-life.cpp b/Task/Conways-Game-of-Life/C++/conways-game-of-life-2.cpp similarity index 100% rename from Task/Conways-Game-of-Life/C++/conways-game-of-life.cpp rename to Task/Conways-Game-of-Life/C++/conways-game-of-life-2.cpp diff --git a/Task/Conways-Game-of-Life/COBOL/conways-game-of-life.cobol b/Task/Conways-Game-of-Life/COBOL/conways-game-of-life.cobol new file mode 100644 index 0000000000..d0db0f1e86 --- /dev/null +++ b/Task/Conways-Game-of-Life/COBOL/conways-game-of-life.cobol @@ -0,0 +1,69 @@ +identification division. +program-id. game-of-life-program. +data division. +working-storage section. +01 grid. + 05 cell-table. + 10 row occurs 5 times. + 15 cell pic x value space occurs 5 times. + 05 next-gen-cell-table. + 10 next-gen-row occurs 5 times. + 15 next-gen-cell pic x occurs 5 times. +01 counters. + 05 generation pic 9. + 05 current-row pic 9. + 05 current-cell pic 9. + 05 living-neighbours pic 9. + 05 neighbour-row pic 9. + 05 neighbour-cell pic 9. + 05 check-row pic s9. + 05 check-cell pic s9. +procedure division. +control-paragraph. + perform blinker-paragraph varying current-cell from 2 by 1 + until current-cell is greater than 4. + perform show-grid-paragraph through life-paragraph + varying generation from 0 by 1 + until generation is greater than 2. + stop run. +blinker-paragraph. + move '#' to cell(3,current-cell). +show-grid-paragraph. + display 'GENERATION ' generation ':'. + display ' +---+'. + perform show-row-paragraph varying current-row from 2 by 1 + until current-row is greater than 4. + display ' +---+'. + display ''. +life-paragraph. + perform update-row-paragraph varying current-row from 2 by 1 + until current-row is greater than 4. + move next-gen-cell-table to cell-table. +show-row-paragraph. + display ' |' with no advancing. + perform show-cell-paragraph varying current-cell from 2 by 1 + until current-cell is greater than 4. + display '|'. +show-cell-paragraph. + display cell(current-row,current-cell) with no advancing. +update-row-paragraph. + perform update-cell-paragraph varying current-cell from 2 by 1 + until current-cell is greater than 4. +update-cell-paragraph. + move 0 to living-neighbours. + perform check-row-paragraph varying check-row from -1 by 1 + until check-row is greater than 1. + evaluate living-neighbours, + when 2 move cell(current-row,current-cell) to next-gen-cell(current-row,current-cell), + when 3 move '#' to next-gen-cell(current-row,current-cell), + when other move space to next-gen-cell(current-row,current-cell), + end-evaluate. +check-row-paragraph. + add check-row to current-row giving neighbour-row. + perform check-cell-paragraph varying check-cell from -1 by 1 + until check-cell is greater than 1. +check-cell-paragraph. + add check-cell to current-cell giving neighbour-cell. + if cell(neighbour-row,neighbour-cell) is equal to '#', + and check-cell is not equal to zero or check-row is not equal to zero, + then add 1 to living-neighbours. diff --git a/Task/Conways-Game-of-Life/Elixir/conways-game-of-life.elixir b/Task/Conways-Game-of-Life/Elixir/conways-game-of-life.elixir new file mode 100644 index 0000000000..52a782fc4f --- /dev/null +++ b/Task/Conways-Game-of-Life/Elixir/conways-game-of-life.elixir @@ -0,0 +1,69 @@ +defmodule Conway do + def game_of_life(name, size, generations, initial_life\\nil) do + board = seed(size, initial_life) + print_board(board, name, size, 0) + reason = generate(name, size, generations, board, 1) + case reason do + :all_dead -> "no more life." + :static -> "no movement" + _ -> "specified lifetime ended" + end + |> IO.puts + IO.puts "" + end + + defp new_board(n) do + for x <- 1..n, y <- 1..n, into: %{}, do: {{x,y}, 0} + end + + defp seed(n, points) do + if points do + points + else # randomly seed board + (for x <- 1..n, y <- 1..n, do: {x,y}) |> Enum.take_random(10) + end + |> Enum.reduce(new_board(n), fn pos,acc -> %{acc | pos => 1} end) + end + + defp generate(_, _, generations, _, gen) when generations < gen, do: :ok + defp generate(name, size, generations, board, gen) do + new = evolve(board, size) + print_board(new, name, size, gen) + cond do + barren?(new) -> :all_dead + board == new -> :static + true -> generate(name, size, generations, new, gen+1) + end + end + + defp evolve(board, n) do + for x <- 1..n, y <- 1..n, into: %{}, do: {{x,y}, fate(board, x, y, n)} + end + + defp fate(board, x, y, n) do + irange = max(1, x-1) .. min(x+1, n) + jrange = max(1, y-1) .. min(y+1, n) + sum = ((for i <- irange, j <- jrange, do: board[{i,j}]) |> Enum.sum) - board[{x,y}] + cond do + sum == 3 -> 1 + sum == 2 and board[{x,y}] == 1 -> 1 + true -> 0 + end + end + + defp barren?(board) do + Enum.all?(board, fn {_,v} -> v == 0 end) + end + + defp print_board(board, name, n, generation) do + IO.puts "#{name}: generation #{generation}" + Enum.each(1..n, fn y -> + Enum.map(1..n, fn x -> if board[{x,y}]==1, do: "#", else: "." end) + |> IO.puts + end) + end +end + +Conway.game_of_life("blinker", 3, 2, [{2,1},{2,2},{2,3}]) +Conway.game_of_life("glider", 4, 4, [{2,1},{3,2},{1,3},{2,3},{3,3}]) +Conway.game_of_life("random", 5, 10) diff --git a/Task/Conways-Game-of-Life/Emacs-Lisp/conways-game-of-life-1.l b/Task/Conways-Game-of-Life/Emacs-Lisp/conways-game-of-life-1.l new file mode 100644 index 0000000000..eda9e0b89b --- /dev/null +++ b/Task/Conways-Game-of-Life/Emacs-Lisp/conways-game-of-life-1.l @@ -0,0 +1,94 @@ +#!/usr/bin/env emacs -script +;; -*- lexical-binding: t -*- +;; run: ./conways-life conways-life.config +(require 'cl-lib) + +(defconst blinker '("***")) +(defconst toad '(".***" "***.")) +(defconst pentomino-p '(".**" ".**" ".*.")) +(defconst pi-heptomino '("***" "*.*" "*.*")) +(defconst glider '(".*." "..*" "***")) +(defconst pre-pulsar '("***...***" "*.*...*.*" "***...***")) +(defconst ship '("**." "*.*" ".**")) +(defconst pentadecathalon '("**********")) +(defconst clock '("..*." "*.*." ".*.*" ".*..")) + +(defmacro swap (a b) + `(setq ,b (prog1 ,a (setq ,a ,b)))) + +(cl-defstruct world rows cols data) + +(defun new-world (rows cols) + (make-world :rows rows :cols cols :data (make-vector (* rows cols) nil))) + +(defmacro world-pt (w r c) + `(+ (* (mod ,r (world-rows ,w)) (world-cols ,w)) + (mod ,c (world-cols ,w)))) + +(defmacro world-ref (w r c) + `(aref (world-data ,w) (world-pt ,w ,r ,c))) + +(defun print-world (world) + (dotimes (r (world-rows world)) + (dotimes (c (world-cols world)) + (princ (format "%c" (if (world-ref world r c) ?* ?.)))) + (terpri))) + +(defun insert-pattern (world row col shape) + (let ((r row) + (c col)) + (unless (listp shape) + (setq shape (symbol-value shape))) + (dolist (row-data shape) + (dolist (col-data (mapcar 'identity row-data)) + (setf (world-ref world r c) (not (or (eq col-data ?.)))) + (setq c (1+ c))) + (setq r (1+ r)) + (setq c col)))) + +(defun neighbors (world row col) + (let ((n 0)) + (dolist (offset '((1 . 1) (1 . 0) (1 . -1) (0 . 1) (0 . -1) (-1 . 1) (-1 . 0) (-1 . -1))) + (when (world-ref world (+ row (car offset)) (+ col (cdr offset))) + (setq n (1+ n)))) + n)) + +(defun advance-generation (old new) + (dotimes (r (world-rows old)) + (dotimes (c (world-cols old)) + (let ((n (neighbors old r c))) + (setf (world-ref new r c) + (if (world-ref old r c) + (or (= n 2) (= n 3)) + (= n 3))))))) + +(defun read-config (file-name) + (with-temp-buffer + (insert-file-contents-literally file-name) + (read (current-buffer)))) + +(defun get-config (key config) + (let ((val (assoc key config))) + (if (null val) + (error (format "missing value for %s" key)) + (cdr val)))) + +(defun insert-patterns (world patterns) + (dolist (p patterns) + (apply 'insert-pattern (cons world p)))) + +(defun simulate-life (file-name) + (let* ((config (read-config file-name)) + (rows (get-config 'rows config)) + (cols (get-config 'cols config)) + (generations (get-config 'generations config)) + (a (new-world rows cols)) + (b (new-world rows cols))) + (insert-patterns a (get-config 'patterns config)) + (dotimes (g generations) + (princ (format "generation %d\n" g)) + (print-world a) + (advance-generation a b) + (swap a b)))) + +(simulate-life (elt command-line-args-left 0)) diff --git a/Task/Conways-Game-of-Life/Emacs-Lisp/conways-game-of-life-2.l b/Task/Conways-Game-of-Life/Emacs-Lisp/conways-game-of-life-2.l new file mode 100644 index 0000000000..228513993e --- /dev/null +++ b/Task/Conways-Game-of-Life/Emacs-Lisp/conways-game-of-life-2.l @@ -0,0 +1,9 @@ +((rows . 8) + (cols . 10) + (generations . 3) + (patterns + ;; Blinker is defined in the script. + (1 1 blinker) + ;; This is a custom pattern. + (4 4 (".***" + "***.")))) diff --git a/Task/Conways-Game-of-Life/Perl-6/conways-game-of-life.pl6 b/Task/Conways-Game-of-Life/Perl-6/conways-game-of-life.pl6 index 68039f5305..9f78de82b1 100644 --- a/Task/Conways-Game-of-Life/Perl-6/conways-game-of-life.pl6 +++ b/Task/Conways-Game-of-Life/Perl-6/conways-game-of-life.pl6 @@ -1,53 +1,55 @@ class Automaton { subset World of Str where { - .lines>>.chars.uniq == 1 and m/^^<[.#\n]>+$$/ + .lines>>.chars.unique == 1 and m/^^<[.#\n]>+$$/ } has Int ($.width, $.height); has @.a; multi method new (World $s) { - self.new: - :width(.pick.chars), :height(.elems), - :a( .map: { [ .comb ] } ) - given $s.lines; + self.new: + :width(.pick.chars), :height(.elems), + :a( .map: { [ .comb ] } ) + given $s.lines.cache; } - method gist { join "\n", map { [~] @$_ }, @!a } + method gist { join "\n", map { .join }, @!a } method C (Int $r, Int $c --> Bool) { - @!a[$r % $!height][$c % $!width] eq '#'; + @!a[$r % $!height][$c % $!width] eq '#'; } method N (Int $r, Int $c --> Int) { - +grep ?*, map { self.C: |@$_ }, - [ $r - 1, $c - 1], [ $r - 1, $c ], [ $r - 1, $c + 1], - [ $r , $c - 1], [ $r , $c + 1], - [ $r + 1, $c - 1], [ $r + 1, $c ], [ $r + 1, $c + 1]; + +grep ?*, map { self.C: |@$_ }, + [ $r - 1, $c - 1], [ $r - 1, $c ], [ $r - 1, $c + 1], + [ $r , $c - 1], [ $r , $c + 1], + [ $r + 1, $c - 1], [ $r + 1, $c ], [ $r + 1, $c + 1]; } method succ { - self.new: :$!width, :$!height, - :a( - gather for ^$.height -> $r { - take [ - gather for ^$.width -> $c { - take - (self.C($r, $c) == 1 && self.N($r, $c) == 2|3 ) - || (self.C($r, $c) == 0 && self.N($r, $c) == 3) - ?? '#' !! '.' - } - ] - } - ) + self.new: :$!width, :$!height, + :a( + gather for ^$.height -> $r { + take [ + gather for ^$.width -> $c { + take + (self.C($r, $c) == 1 && self.N($r, $c) == 2|3) + || (self.C($r, $c) == 0 && self.N($r, $c) == 3) + ?? '#' !! '.' + } + ] + } + ) } } -my Automaton $glider .= new: '............ -............ -............ -.......###.. -.......#.... -........#... -............'; +my Automaton $glider .= new: q:to/EOF/; + ............ + ............ + ............ + .......###.. + .###...#.... + ........#... + ............ + EOF for ^10 { diff --git a/Task/Conways-Game-of-Life/REXX/conways-game-of-life-1.rexx b/Task/Conways-Game-of-Life/REXX/conways-game-of-life-1.rexx index d912bc3d5f..29445fd5e2 100644 --- a/Task/Conways-Game-of-Life/REXX/conways-game-of-life-1.rexx +++ b/Task/Conways-Game-of-Life/REXX/conways-game-of-life-1.rexx @@ -1,48 +1,46 @@ -/*REXX program displays Conway's game of life, it stops after N repeats.*/ -signal on halt /*handle cell growth interruptus.*/ -parse arg peeps '(' rows cols empty life! clearScreen repeats generations - rows = p(rows 3) /*the maximum number of cell rows*/ - cols = p(cols 3) /* " " " " " cols*/ - emp = pickChar(empty 'blank') /*an empty cell character (glyph)*/ - clearScr = p(clearScreen 0) /*1 indicates to clear the screen*/ -clearscr=1 -clearscr=0 - life! = pickChar(life! '☼') /*the gylph looks like an ameba. */ - reps = p(repeats 2) /*stop if there are 2 repeats.*/ -generations = p(generations 100) /*number of generations allowed. */ -usw=max(linesize()-1,cols) /*usable screen width for display*/ -#reps=0; $.=emp /*the universe is new, and barren*/ -gens=abs(generations) /*use this for convenience. */ -x=space(peeps); upper x /*elide superfluous spaces; upper*/ -if x=='' then x='BLINKER' /*if none specified, use BLINKER.*/ -if x=='BLINKER' then x='2,1 2,2 2,3' -if x=='GLIDER' then x='48,11 48,12 48,13 49,13 50,12' -if x=='OCTAGON' then x='1,5 1,6 2,4 2,7 3,3 3,8 4,2 4,9 5,2 5,9 6,3 6,8 7,4 7,7 8,5 8,6' -call assign. /*assign the initial state cells.*/ -call showCells /*show initial state of the cells*/ - /* [↓] cell colony grow/live/die*/ - do life=1 for gens; call assign@ /*construct the next generation. */ - if generations>0 | life==gens then call showCells /*display it?*/ +/*REXX program runs and displays the Conway's game of life, it stops after N repeats. */ +signal on halt /*handle a cell growth interruptus. */ +parse arg peeps '(' rows cols empty life! clearScreen repeats generations . + rows = p(rows 3) /*the maximum number of cell rows. */ + cols = p(cols 3) /* " " " " " columns. */ + emp = pickChar(empty 'blank') /*an empty cell character (glyph). */ + clearScr = p(clearScreen 0) /* "1" indicates to clear the screen.*/ + life! = pickChar(life! '☼') /*the gylph kinda looks like an amoeba.*/ + reps = p(repeats 2) /*stop pgm if there are two repeats.*/ +generations = p(generations 100) /*the number of generations allowed. */ +sw=max(linesize()-1,cols) /*usable screen width for the display. */ +#reps=0; $.=emp /*the universe is new, ··· and barren.*/ +gens=abs(generations) /*used for a programming convenience.*/ +x=space(peeps); upper x /*elide superfluous spaces; uppercase. */ +if x=='' then x="BLINKER" /*if nothing specified, use BLINKER. */ +if x=='BLINKER' then x= "2,1 2,2 2,3" +if x=='OCTAGON' then x= "1,5 1,6 2,4 2,7 3,3 3,8 4,2 4,9 5,2 5,9 6,3 6,8 7,4 7,7 8,5 8,6" +call assign. /*assign the initial state of all cells*/ +call showCells /*show the initial state of the cells.*/ + /* [↓] cell colony grows, lives, dies.*/ + do life=1 for gens; call assign@ /*construct next generation of cells.*/ + if generations>0 | life==gens then call showCells /*should cells be displayed? */ end /*life*/ -fin: exit /*stick a fork in it, we're done.*/ -/*───────────────────────────────SHOWCELLS subroutine───────────────────*/ -showCells: if clearScr then 'CLS' /* ◄─── change this for your OS.*/ -call showRows /*show the rows in proper order. */ -say right(copies('▒',usw) life,usw) /*show fence between generations.*/ -if _=='' then call fin /*if no life, then stop the run.*/ -if !._ then #reps=#reps+1 /*we detected a repeated pattern.*/ -!._=1 /*existence state & compare later*/ -if reps\==0 & #reps<=reps then return /*so far, so good regarding reps.*/ -say; say ' "Life" repeated itself' reps "times, simulation has ended." -call fin /*stick a fork in it, we're done.*/ -/*───────────────────────────────1─liner subroutines───────────────────────────────────────────────────────────────────────*/ -$: parse arg _row,_col; return $._row._col==life! -assign$: do r=1 for rows; do c=1 for cols; $.r.c=@.r.c; end; end; return -assign.: do while x\==''; parse var x r ',' c x; $.r.c=life!; rows=max(rows,r); cols=max(cols,c); end; life=0; !.=0; return +fin: exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +showCells: if clearScr then 'CLS' /* ◄─── change 'command' for your OS.*/ + call showRows /*show the rows in the proper order. */ + say right(copies('▒', sw) life, sw) /*show a fence between the generations.*/ + if _=='' then call fin /*if there's no life, then stop the run*/ + if !._ then #reps=#reps+1 /*we detected a repeated cell pattern. */ + !._=1 /*existence state and compare later. */ + if reps\==0 & #reps<=reps then return /*so far, so good, regarding repeats.*/ + say + say center('"Life" repeated itself' reps "times, simulation has ended.",sw,'▒') + call fin /*stick a fork in it, we're all done. */ +/*───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/ +$: parse arg _row,_col; return $._row._col==life! +assign$: do r=1 for rows; do c=1 for cols; $.r.c=@.r.c; end; end; return +assign.: do while x\==''; parse var x r "," c x; $.r.c=life!; rows=max(rows,r); cols=max(cols,c); end; life=0; !.=0; return assign?: ?=$.r.c; n=neighbors(); if ?==emp then do;if n==3 then ?=life!; end; else if n<2 | n>3 then ?=emp; @.r.c=?; return -assign@: @.=emp; do r=1 for rows; do c=1 for cols; call assign?; end; end; call assign$; return -halt: say; say 'REXX program halted.'; say; exit 0 -neighbors: rm=r-1; rp=r+1; cm=c-1; cp=c+1; return $(rm,cm)+$(rm,c)+$(rm,cp)+$(r,cm)+$(r,cp)+$(rp,cm)+$(rp,c)+$(rp,cp) -p: return word(arg(1),1) -pickChar: _=p(arg(1)); arg u .; if u=='BLANK' then _=' '; L=length(_); if L==3 then _=d2c(_);if L==2 then _=x2c(_); return _ +assign@: @.=emp; do r=1 for rows; do c=1 for cols; call assign?; end; end; call assign$; return +halt: say; say "REXX program (Conway's Life) halted."; say; exit 0 +neighbors: return $(r-1,c-1) + $(r-1,c) + $(r-1,c+1) + $(r,c-1) + $(r,c+1) + $(r+1,c-1) + $(r+1,c) + $(r+1,c+1) +p: return word(arg(1), 1) +pickChar: _=p(arg(1)); arg u .; if u=='BLANK' then _=" "; L=length(_); if L==3 then _=d2c(_); if L==2 then _=x2c(_); return _ showRows: _=; do r=rows by -1 for rows; z=; do c=1 for cols; z=z||$.r.c; end; z=strip(z,'T',emp); say z; _=_||z; end; return diff --git a/Task/Conways-Game-of-Life/ZX-Spectrum-Basic/conways-game-of-life.zx b/Task/Conways-Game-of-Life/ZX-Spectrum-Basic/conways-game-of-life.zx new file mode 100644 index 0000000000..9269ea9fe4 --- /dev/null +++ b/Task/Conways-Game-of-Life/ZX-Spectrum-Basic/conways-game-of-life.zx @@ -0,0 +1,21 @@ +10 REM Initialize +20 LET w=32*22 +30 DIM w$(w): DIM n$(w) +40 FOR n=1 TO 100 +50 LET w$(RND*w+1)="O" +60 NEXT n +70 REM Loop +80 FOR i=34 TO w-34 +90 LET p$="": LET d=0 +100 LET p$=p$+w$(i-1)+w$(i+1)+w$(i-33)+w$(i-32)+w$(i-31)+w$(i+31)+w$(i+32)+w$(i+33) +110 LET n$(i)=w$(i) +120 FOR n=1 TO LEN p$ +130 IF p$(n)="O" THEN LET d=d+1 +140 NEXT n +150 IF (w$(i)=" ") AND (d=3) THEN LET n$(i)="O": GO TO 180 +160 IF (w$(i)="O") AND (d<2) THEN LET n$(i)=" ": GO TO 180 +170 IF (w$(i)="O") AND (d>3) THEN LET n$(i)=" " +180 NEXT i +190 PRINT AT 0,0;w$ +200 LET w$=n$ +210 GO TO 80 diff --git a/Task/Copy-a-string/00DESCRIPTION b/Task/Copy-a-string/00DESCRIPTION index 094ec6d895..e31e1af2f1 100644 --- a/Task/Copy-a-string/00DESCRIPTION +++ b/Task/Copy-a-string/00DESCRIPTION @@ -1,4 +1,9 @@ {{omit from|bc}} + This task is about copying a string. + + +;Task: Where it is relevant, distinguish between copying the contents of a string versus making an additional reference to an existing string. +

    diff --git a/Task/Copy-a-string/Babel/copy-a-string.pb b/Task/Copy-a-string/Babel/copy-a-string.pb index 852e410cac..851f787277 100644 --- a/Task/Copy-a-string/Babel/copy-a-string.pb +++ b/Task/Copy-a-string/Babel/copy-a-string.pb @@ -1,4 +1,4 @@ -"Hello, world\n" dup cp -str2ar dup 'Y' str2ar 0 paste ar2str -<< -<< +babel> "Hello, world\n" dup cp dup 0 "Y" 0 1 move8 +babel> << << +Yello, world +Hello, world diff --git a/Task/Copy-a-string/Elena/copy-a-string.elena b/Task/Copy-a-string/Elena/copy-a-string.elena new file mode 100644 index 0000000000..1a09b83bd2 --- /dev/null +++ b/Task/Copy-a-string/Elena/copy-a-string.elena @@ -0,0 +1,3 @@ +#var src := "Hello". +#var dst := src. // copying the reference +#var copy := src clone. // copying the content diff --git a/Task/Copy-a-string/Kotlin/copy-a-string.kotlin b/Task/Copy-a-string/Kotlin/copy-a-string.kotlin new file mode 100644 index 0000000000..2c0c22ec89 --- /dev/null +++ b/Task/Copy-a-string/Kotlin/copy-a-string.kotlin @@ -0,0 +1,2 @@ +val h = "Hello" +val c = "" + h diff --git a/Task/Copy-a-string/MIPS-Assembly/copy-a-string.mips b/Task/Copy-a-string/MIPS-Assembly/copy-a-string.mips new file mode 100644 index 0000000000..bd7d6cae05 --- /dev/null +++ b/Task/Copy-a-string/MIPS-Assembly/copy-a-string.mips @@ -0,0 +1,53 @@ +.data + ex_msg_og: .asciiz "Original string:\n" + ex_msg_cpy: .asciiz "\nCopied string:\n" + string: .asciiz "Nice string you got there!\n" + +.text + main: + la $v1,string #load addr of string into $v0 + la $t1,($v1) #copy addr into $t0 for later access + lb $a1,($v1) #load byte from string addr + strlen_loop: + beqz $a1,alloc_mem + addi $a0,$a0,1 #increment strlen_counter + addi $v1,$v1,1 #increment ptr + lb $a1,($v1) #load the byte + j strlen_loop + + alloc_mem: + li $v0,9 #alloc memory, $a0 is arg for how many bytes to allocate + #result is stored in $v0 + syscall + la $t0,($v0) #$v0 is static, $t0 is the moving ptr + la $v1,($t1) #get a copy we can increment + copy_str: + lb $a1,($t1) #copy first byte from source + + strcopy_loop: + beqz $a1,exit_procedure #check if current byte is NULL + sb $a1,($t0) #store the byte at the target pointer + addi $t0,$t0,1 #increment source ptr + addi $t1,$t1,1 #decrement source ptr + lb $a1,($t1) #load next byte from source ptr + j strcopy_loop + + + exit_procedure: + la $a1,($v0) #store our string at $v0 so it doesn't get overwritten + li $v0,4 #set syscall to PRINT + + la $a0,ex_msg_og #PRINT("original string:") + syscall + + la $a0,($v1) #PRINT(original string) + syscall + + la $a0,ex_msg_cpy #PRINT("copied string:") + syscall + + la $a0,($a1) #PRINT(strcopy) + syscall + + li $v0,10 #EXIT(0) + syscall diff --git a/Task/Copy-a-string/Rust/copy-a-string-1.rust b/Task/Copy-a-string/Rust/copy-a-string-1.rust new file mode 100644 index 0000000000..58f6bfba31 --- /dev/null +++ b/Task/Copy-a-string/Rust/copy-a-string-1.rust @@ -0,0 +1,8 @@ +fn main() { + let s1 = "A String"; + let mut s2 = s1; + + s2 = "Another String"; + + println!("s1 = {}, s2 = {}", s1, s2); +} diff --git a/Task/Copy-a-string/Rust/copy-a-string-2.rust b/Task/Copy-a-string/Rust/copy-a-string-2.rust new file mode 100644 index 0000000000..8178ad40c9 --- /dev/null +++ b/Task/Copy-a-string/Rust/copy-a-string-2.rust @@ -0,0 +1 @@ +s1 = A String, s2 = Another String diff --git a/Task/Count-in-factors/00DESCRIPTION b/Task/Count-in-factors/00DESCRIPTION index e716b205be..27a030a740 100644 --- a/Task/Count-in-factors/00DESCRIPTION +++ b/Task/Count-in-factors/00DESCRIPTION @@ -1,5 +1,15 @@ -Write a program which counts up from 1, displaying each number as the multiplication of its prime factors. For the purpose of this task, 1 may be shown as itself. +;Task: +Write a program which counts up from   '''1''',   displaying each number as the multiplication of its prime factors. -For example, 2 is prime, so it would be shown as itself. 6 is not prime; it would be shown as 2\times3. Likewise, 2144 is not prime; it would be shown as 2\times2\times2\times2\times2\times67. +For the purpose of this task,   '''1'''   (unity)   may be shown as itself. -c.f. [[Prime decomposition]] + +;Example: +      '''2'''   is prime,   so it would be shown as itself. +
          '''6'''   is not prime;   it would be shown as   '''2\times3.''' +
    '''2144'''   is not prime;   it would be shown as   '''2\times2\times2\times2\times2\times67.''' + + +;Related task: +*   [[Prime decomposition]] +

    diff --git a/Task/Count-in-factors/Clojure/count-in-factors.clj b/Task/Count-in-factors/Clojure/count-in-factors.clj new file mode 100644 index 0000000000..96ca2c5726 --- /dev/null +++ b/Task/Count-in-factors/Clojure/count-in-factors.clj @@ -0,0 +1,20 @@ +(ns listfactors + (:gen-class)) + +(defn factors + "Return a list of factors of N." + ([n] + (factors n 2 ())) + ([n k acc] + (cond + (= n 1) (if (empty? acc) + [n] + (sort acc)) + (>= k n) (if (empty? acc) + [n] + (sort (cons n acc))) + (= 0 (rem n k)) (recur (quot n k) k (cons k acc)) + :else (recur n (inc k) acc)))) + +(doseq [q (range 1 26)] + (println q " = " (clojure.string/join " x "(factors q)))) diff --git a/Task/Count-in-factors/Haskell/count-in-factors-1.hs b/Task/Count-in-factors/Haskell/count-in-factors-1.hs index d6a19296ef..a55335c0d1 100644 --- a/Task/Count-in-factors/Haskell/count-in-factors-1.hs +++ b/Task/Count-in-factors/Haskell/count-in-factors-1.hs @@ -1,3 +1,5 @@ import Data.List (intercalate) showFactors n = show n ++ " = " ++ (intercalate " * " . map show . factorize) n +-- Pointfree form +showFactors = ((++) . show) <*> ((" = " ++) . intercalate " * " . map show . factorize) diff --git a/Task/Count-in-factors/Maple/count-in-factors.maple b/Task/Count-in-factors/Maple/count-in-factors.maple new file mode 100644 index 0000000000..4546ac53f9 --- /dev/null +++ b/Task/Count-in-factors/Maple/count-in-factors.maple @@ -0,0 +1,24 @@ +factorNum := proc(n) + local i, j, firstNum; + if n = 1 then + printf("%a", 1); + end if; + firstNum := true: + for i in ifactors(n)[2] do + for j to i[2] do + if firstNum then + printf ("%a", i[1]); + firstNum := false: + else + printf(" x %a", i[1]); + end if; + end do; + end do; + printf("\n"); + return NULL; +end proc: + +for i from 1 to 10 do + printf("%2a: ", i); + factorNum(i); +end do; diff --git a/Task/Count-in-factors/R/count-in-factors.r b/Task/Count-in-factors/R/count-in-factors.r new file mode 100644 index 0000000000..2d98715422 --- /dev/null +++ b/Task/Count-in-factors/R/count-in-factors.r @@ -0,0 +1,26 @@ +#initially I created a function which returns prime factors then I have created another function counts in the factors and #prints the values. + +findfactors <- function(num) { + x <- c() + p1<- 2 + p2 <- 3 + everyprime <- num + while( everyprime != 1 ) { + while( everyprime%%p1 == 0 ) { + x <- c(x, p1) + everyprime <- floor(everyprime/ p1) + } + p1 <- p2 + p2 <- p2 + 2 + } + x +} +count_in_factors=function(x){ + primes=findfactors(x) + x=c(1) + for (i in 1:length(primes)) { + x=paste(primes[i],"x",x) + } + return(x) +} +count_in_factors(72) diff --git a/Task/Count-in-factors/REXX/count-in-factors-1.rexx b/Task/Count-in-factors/REXX/count-in-factors-1.rexx index 1fc76f5e73..141f07006a 100644 --- a/Task/Count-in-factors/REXX/count-in-factors-1.rexx +++ b/Task/Count-in-factors/REXX/count-in-factors-1.rexx @@ -1,34 +1,34 @@ -/*REXX program lists the prime factors of a specified integer (or a range).*/ -@.=left('',8); @.0='{unity} '; @.1='[prime] '; X='x' /*some tags and literals.*/ -parse arg low high . /*get optional arguments from the C.L. */ -if low=='' then do;low=1;high=40; end /*No LOW & HIGH? Then use the default.*/ -if high=='' then high=low; tell=high>0 /*No HIGH? " " " " */ -w=length(high); high=abs(high) /*get maximum width for pretty output. */ -numeric digits max(9,w+1) /*maybe bump the precision of numbers. */ -#=0 /*the number of primes found (so far). */ - do n=low to high; f=factr(n) /*process a single number or a range.*/ - p=words(translate(f,,'x')) -(n==1) /*P: is the number of prime factors. */ - if p==1 then #=#+1 /*bump the primes counter (exclude N=1)*/ - if tell then say right(n,w) '=' @.p space(f,0) /*show if prime, factors*/ +/*REXX program lists the prime factors of a specified integer (or a range of integers).*/ +@.=left('', 8); @.0="{unity} "; @.1='[prime] ' /*some tags and handy-dandy literals.*/ +parse arg low high . /*get optional arguments from the C.L. */ +if low=='' then do; low=1; high=40; end /*No LOW & HIGH? Then use the default.*/ +if high=='' then high=low; tell= (high>0) /*No HIGH? " " " " */ +w=length(high); high=abs(high) /*get maximum width for pretty output. */ +numeric digits max(9, w+1) /*maybe bump the precision of numbers. */ +#=0 /*the number of primes found (so far). */ + do n=low to high; f=factr(n) /*process a single number or a range.*/ + p=words(translate(f,,'x')) - (n==1) /*P: is the number of prime factors. */ + if p==1 then #=#+1 /*bump the primes counter (exclude N=1)*/ + if tell then say right(n, w) '=' @.p space(f, 0) /*show if prime and factors.*/ end /*n*/ say -say right(#,w) ' primes found.' /*display the number of primes found. */ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -factr: procedure; parse arg z 1 n,$; if z<2 then return z - do while z// 2==0; $=$ 'x 2' ; z=z% 2; end /*maybe add factor of 2 */ - do while z// 3==0; $=$ 'x 3' ; z=z% 3; end /* " " " " 3 */ - do while z// 5==0; $=$ 'x 5' ; z=z% 5; end /* " " " " 5 */ - do while z// 7==0; $=$ 'x 7' ; z=z% 7; end /* " " " " 7 */ +say right(#, w) ' primes found.' /*display the number of primes found. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +factr: procedure; parse arg z 1 n,$; if z<2 then return z /*if Z too small, return Z*/ + do while z// 2==0; $=$ 'x 2' ; z=z% 2; end /*maybe add factor of 2 */ + do while z// 3==0; $=$ 'x 3' ; z=z% 3; end /* " " " " 3 */ + do while z// 5==0; $=$ 'x 5' ; z=z% 5; end /* " " " " 5 */ + do while z// 7==0; $=$ 'x 7' ; z=z% 7; end /* " " " " 7 */ - do j=11 by 6 while j<=z /*insure that J isn't divisible by 3.*/ - parse var j '' -1 _ /*get the last decimal digit of J. */ - if _\==5 then do while z//j==0; $=$ 'x' j; z=z%j; end /*maybe reduce.*/ - if _ ==3 then iterate /*if next number will be ÷ by 3, skip.*/ - if j*j>n then leave /*are we higher than the √ N ? */ - y=j+2 - do while z//y==0; $=$ 'x' y; z=z%y; end - end /*j*/ + do j=11 by 6 while j<=z /*insure that J isn't divisible by 3.*/ + parse var j '' -1 _ /*get the last decimal digit of J. */ + if _\==5 then do while z//j==0; $=$ 'x' j; z=z%j; end /*maybe reduce Z.*/ + if _ ==3 then iterate /*if next number will be ÷ by 5, skip.*/ + if j*j>n then leave /*are we higher than the √ N ? */ + y=j+2 + do while z//y==0; $=$ 'x' y; z=z%y; end /*maybe reduce Z.*/ + end /*j*/ -if z==1 then z= /*if residual is unity, then nullify it*/ -return strip( strip( $ 'x' z), , 'x') /*elide a possible leading (extra) "x".*/ +if z==1 then z= /*if residual is unity, then nullify it*/ +return strip( strip($ 'x' z), , "x") /*elide a possible leading (extra) "x".*/ diff --git a/Task/Count-in-factors/REXX/count-in-factors-2.rexx b/Task/Count-in-factors/REXX/count-in-factors-2.rexx index 9a088c14a5..18b4004d73 100644 --- a/Task/Count-in-factors/REXX/count-in-factors-2.rexx +++ b/Task/Count-in-factors/REXX/count-in-factors-2.rexx @@ -1,37 +1,47 @@ -/*REXX program lists the prime factors of a specified integer (or a range).*/ -@.=left('',8); @.0='{unity} '; @.1='[prime] '; X='x' /*some tags and literals.*/ -parse arg low high . /*get optional arguments from the C.L. */ -if low=='' then do;low=1;high=40; end /*No LOW & HIGH? Then use the default.*/ -if high=='' then high=low; tell=high>0 /*No HIGH? " " " " */ -w=length(high); high=abs(high) /*get maximum width for pretty output. */ -numeric digits max(9,w+1) /*maybe bump the precision of numbers. */ -#=0 /*the number of primes found (so far). */ - do n=low to high; f=factr(n) /*process a single number or a range.*/ - p=words(translate(f,,'x')) -(n==1) /*P: is the number of prime factors. */ - if p==1 then #=#+1 /*bump the primes counter (exclude N=1)*/ - if tell then say right(n,w) '=' @.p space(f,0) /*show if prime, factors*/ +/*REXX program lists the prime factors of a specified integer (or a range of integers).*/ +@.=left('', 8); @.0="{unity} "; @.1='[prime] ' /*some tags and handy-dandy literals.*/ +parse arg low high . /*get optional arguments from the C.L. */ +if low=='' then do; low=1; high=40; end /*No LOW & HIGH? Then use the default.*/ +if high=='' then high=low; tell= (high>0) /*No HIGH? " " " " */ +w=length(high); high=abs(high) /*get maximum width for pretty output. */ +numeric digits max(9, w+1) /*maybe bump the precision of numbers. */ +#=0 /*the number of primes found (so far). */ + do n=low to high; f=factr(n) /*process a single number or a range.*/ + p=words(translate(f,,'x')) - (n==1) /*P: is the number of prime factors. */ + if p==1 then #=#+1 /*bump the primes counter (exclude N=1)*/ + if tell then say right(n, w) '=' @.p space(f, 0) /*show if prime & the factors.*/ end /*n*/ say -say right(#,w) ' primes found.' /*display the number of primes found. */ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -factr: procedure; parse arg z 1 n,$; if z<2 then return z - do while z// 2==0; $=$ 'x 2' ; z=z% 2; end /*maybe add factor of 2 */ - do while z// 3==0; $=$ 'x 3' ; z=z% 3; end /* " " " " 3 */ - do while z// 5==0; $=$ 'x 5' ; z=z% 5; end /* " " " " 5 */ - do while z// 7==0; $=$ 'x 7' ; z=z% 7; end /* " " " " 7 */ - t=z; r=0; q=1; do while q<=t; q=q*4; end /*R will be iSqrt of Z*/ +say right(#, w) ' primes found.' /*display the number of primes found. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +factr: procedure; parse arg z 1 n,$; if z<2 then return z /*if Z too small, return Z*/ + do while z// 2==0; $=$ 'x 2' ; z=z% 2; end /*maybe add factor of 2 */ + do while z// 3==0; $=$ 'x 3' ; z=z% 3; end /* " " " " 3 */ + do while z// 5==0; $=$ 'x 5' ; z=z% 5; end /* " " " " 5 */ + do while z// 7==0; $=$ 'x 7' ; z=z% 7; end /* " " " " 7 */ + do while z//11==0; $=$ 'x 11' ; z=z%11; end /* " " " " 11 */ + do while z//13==0; $=$ 'x 13' ; z=z%13; end /* " " " " 13 */ + do while z//17==0; $=$ 'x 17' ; z=z%17; end /* " " " " 17 */ + do while z//19==0; $=$ 'x 19' ; z=z%19; end /* " " " " 19 */ + do while z//23==0; $=$ 'x 23' ; z=z%23; end /* " " " " 23 */ + do while z//29==0; $=$ 'x 29' ; z=z%29; end /* " " " " 29 */ + do while z//31==0; $=$ 'x 31' ; z=z%31; end /* " " " " 31 */ + do while z//37==0; $=$ 'x 37' ; z=z%37; end /* " " " " 37 */ +if z>40 then do + t=z; q=1; r=0; do while q<=t; q=q*4; end /*R: will be integer SQRT of Z.*/ - do while q>1; q=q%4; _=t-r-q; r=r%2; if _>=0 then do; t=_; r=r+q; end - end /*while ···*/ /* [↑] compute the integer SQRT of Z. */ + do while q>1; q=q%4; _=t-r-q; r=r%2; if _>=0 then do; t=_; r=r+q; end + end /*while*/ /* [↑] find integer SQRT(z). */ - do j=11 by 6 to r while j<=z /*insure that J isn't divisible by 3.*/ - parse var j '' -1 _ /*get the last decimal digit of J. */ - if _\==5 then do while z//j==0; $=$ 'x' j; z=z%j; end /*maybe reduce*/ - if _ ==3 then iterate /*if next number will be ÷ by 3, skip.*/ - y=j+2 - do while z//y==0; $=$ 'x' y; z=z%y; end /*maybe reduce*/ - end /*j*/ + do j=41 by 6 to r while j<=z /*insure J isn't divisible by 3*/ + parse var j '' -1 _ /*get last decimal digit of J.*/ + if _\==5 then do while z//j==0; $=$ 'x' j; z=z%j; end /*reduce Z?*/ + if _ ==3 then iterate /*Next number ÷ by 5 ? Skip.*/ + y=j+2 + do while z//y==0; $=$ 'x' y; z=z%y; end /*reduce Z?*/ + end /*j*/ + end /*if z>40*/ -if z==1 then z= /*if residual is unity, then nullify it*/ -return strip( strip( $ 'x' z), , 'x') /*elide a possible leading (extra) "x".*/ +if z==1 then z= /*if residual is unity, then nullify it*/ +return strip(strip( $ 'x' z), , "x") /*elide a possible leading (extra) "x".*/ diff --git a/Task/Count-in-factors/Racket/count-in-factors.rkt b/Task/Count-in-factors/Racket/count-in-factors.rkt index 79e90b19d0..d775d7f0f6 100644 --- a/Task/Count-in-factors/Racket/count-in-factors.rkt +++ b/Task/Count-in-factors/Racket/count-in-factors.rkt @@ -1,12 +1,22 @@ -#lang racket -(require math) +#lang typed/racket -(define (~ f) - (match f - [(list p 1) (~a p)] - [(list p n) (~a p "^" n)])) +(require math/number-theory) -(for ([x (in-range 2 20)]) - (display (~a x " = ")) - (for-each display (add-between (map ~ (factorize x)) " * ")) - (newline)) +(define (factorise-as-primes [n : Natural]) + (if + (= n 1) + '(1) + (let ((F (factorize n))) + (append* + (for/list : (Listof (Listof Natural)) + ((f (in-list F))) + (make-list (second f) (first f))))))) + +(define (factor-count [start-inc : Natural] [end-inc : Natural]) + (for ((i : Natural (in-range start-inc (add1 end-inc)))) + (define f (string-join (map number->string (factorise-as-primes i)) " × ")) + (printf "~a:\t~a~%" i f))) + +(factor-count 1 22) +(factor-count 2140 2150) +; tb diff --git a/Task/Count-in-factors/ZX-Spectrum-Basic/count-in-factors.zx b/Task/Count-in-factors/ZX-Spectrum-Basic/count-in-factors.zx new file mode 100644 index 0000000000..49e7092b95 --- /dev/null +++ b/Task/Count-in-factors/ZX-Spectrum-Basic/count-in-factors.zx @@ -0,0 +1,11 @@ +10 FOR i=1 TO 20 +20 PRINT i;" = "; +30 IF i=1 THEN PRINT 1: GO TO 90 +40 LET p=2: LET n=i: LET f$="" +50 IF p>n THEN GO TO 80 +60 IF NOT FN m(n,p) THEN LET f$=f$+STR$ p+" x ": LET n=INT (n/p): GO TO 50 +70 LET p=p+1: GO TO 50 +80 PRINT f$( TO LEN f$-3) +90 NEXT i +100 STOP +110 DEF FN m(a,b)=a-INT (a/b)*b diff --git a/Task/Count-in-octal/00DESCRIPTION b/Task/Count-in-octal/00DESCRIPTION index c1e8dd8654..0b4d892a3d 100644 --- a/Task/Count-in-octal/00DESCRIPTION +++ b/Task/Count-in-octal/00DESCRIPTION @@ -1,3 +1,9 @@ -The task is to produce a sequential count in octal, starting at zero, and using an increment of a one for each consecutive number. Each number should appear on a single line, and the program should count until terminated, or until the maximum value of the numeric type in use is reached. +;Task: +Produce a sequential count in octal,   starting at zero,   and using an increment of a one for each consecutive number. -* [[Integer sequence]] is a similar task without the use of octal numbers. +Each number should appear on a single line,   and the program should count until terminated,   or until the maximum value of the numeric type in use is reached. + + +;Related task: +*   [[Integer sequence]]   is a similar task without the use of octal numbers. +

    diff --git a/Task/Count-in-octal/360-Assembly/count-in-octal.360 b/Task/Count-in-octal/360-Assembly/count-in-octal.360 new file mode 100644 index 0000000000..f4bd50a432 --- /dev/null +++ b/Task/Count-in-octal/360-Assembly/count-in-octal.360 @@ -0,0 +1,46 @@ +* Octal 04/07/2016 +OCTAL CSECT + USING OCTAL,R13 base register + B 72(R15) skip savearea + DC 17F'0' savearea + STM R14,R12,12(R13) prolog + ST R13,4(R15) " + ST R15,8(R13) " + LR R13,R15 " + LA R6,0 i=0 +LOOPI LR R2,R6 x=i + LA R9,10 j=10 + LA R4,PG+23 @pg +LOOP LR R3,R2 save x + SLL R2,29 shift left 32-3 + SRL R2,29 shift right 32-3 + CVD R2,DW convert octal(j) to pack decimal + OI DW+7,X'0F' prepare unpack + UNPK 0(1,R4),DW packed decimal to zoned printable + LR R2,R3 restore x + SRL R2,3 shift right 3 + BCTR R4,0 @pg=@pg-1 + BCT R9,LOOP j=j-1 + CVD R2,DW binary to pack decimal + OI DW+7,X'0F' prepare unpack + UNPK 0(1,R4),DW packed decimal to zoned printable + CVD R6,DW convert i to pack decimal + MVC ZN12,EM12 load mask + ED ZN12,DW+2 packed decimal (PL6) to char (CL12) + MVC PG(12),ZN12 output i + XPRNT PG,80 print buffer + C R6,=F'2147483647' if i>2**31-1 (integer max) + BE ELOOPI then exit loop on i + LA R6,1(R6) i=i+1 + B LOOPI loop on i +ELOOPI L R13,4(0,R13) epilog + LM R14,R12,12(R13) " + XR R15,R15 " + BR R14 exit + LTORG +PG DC CL80' ' buffer +DW DS 0D,PL8 15num +ZN12 DS CL12 +EM12 DC X'40',9X'20',X'2120' mask CL12 11num + YREGS + END OCTAL diff --git a/Task/Count-in-octal/Oberon-2/count-in-octal.oberon-2 b/Task/Count-in-octal/Oberon-2/count-in-octal.oberon-2 new file mode 100644 index 0000000000..2c44a553e1 --- /dev/null +++ b/Task/Count-in-octal/Oberon-2/count-in-octal.oberon-2 @@ -0,0 +1,12 @@ +MODULE CountInOctal; +IMPORT + NPCT:Tools, + Out := NPCT:Console; +VAR + i: INTEGER; + +BEGIN + FOR i := 0 TO MAX(INTEGER) DO; + Out.String(Tools.IntToOct(i));Out.Ln + END +END CountInOctal. diff --git a/Task/Count-in-octal/ZX-Spectrum-Basic/count-in-octal.zx b/Task/Count-in-octal/ZX-Spectrum-Basic/count-in-octal.zx new file mode 100644 index 0000000000..fa341c7e62 --- /dev/null +++ b/Task/Count-in-octal/ZX-Spectrum-Basic/count-in-octal.zx @@ -0,0 +1,10 @@ +10 PRINT "DEC. OCT." +20 FOR i=0 TO 20 +30 LET o$="": LET n=i +40 LET o$=STR$ FN m(n,8)+o$ +50 LET n=INT (n/8) +60 IF n>0 THEN GO TO 40 +70 PRINT i;TAB 3;" = ";o$ +80 NEXT i +90 STOP +100 DEF FN m(a,b)=a-INT (a/b)*b diff --git a/Task/Count-occurrences-of-a-substring/00DESCRIPTION b/Task/Count-occurrences-of-a-substring/00DESCRIPTION index 13396aedbb..0a6461c3f6 100644 --- a/Task/Count-occurrences-of-a-substring/00DESCRIPTION +++ b/Task/Count-occurrences-of-a-substring/00DESCRIPTION @@ -1,7 +1,12 @@ -The task is to either create a function, or show a built-in function, to count the number of non-overlapping occurrences of a substring inside a string.
    -The function should take two arguments: the first argument being the string to search and the second a substring to be searched for.
    -It should return an integer count. +;Task: +Create a function,   or show a built-in function,   to count the number of non-overlapping occurrences of a substring inside a string. +The function should take two arguments: +:::*   the first argument being the string to search,   and +:::*   the second a substring to be searched for. + + +It should return an integer count. print countSubstring("the three truths","th") 3 @@ -10,4 +15,9 @@ print countSubstring("ababababab","abab") 2 The matching should yield the highest number of non-overlapping matches. -In general, this essentially means matching from left-to-right or right-to-left (see proof on talk page). + +In general, this essentially means matching from left-to-right or right-to-left   (see proof on talk page). + + +{{Template:Strings}} +

    diff --git a/Task/Count-occurrences-of-a-substring/360-Assembly/count-occurrences-of-a-substring.360 b/Task/Count-occurrences-of-a-substring/360-Assembly/count-occurrences-of-a-substring.360 new file mode 100644 index 0000000000..07276d1a7a --- /dev/null +++ b/Task/Count-occurrences-of-a-substring/360-Assembly/count-occurrences-of-a-substring.360 @@ -0,0 +1,66 @@ +* Count occurrences of a substring 05/07/2016 +COUNTSTR CSECT + USING COUNTSTR,R13 base register + B 72(R15) skip savearea + DC 17F'0' savearea + STM R14,R12,12(R13) prolog + ST R13,4(R15) " + ST R15,8(R13) " + LR R13,R15 " + MVC HAYSTACK,=CL32'the three truths' + MVC LENH,=F'17' lh=17 + MVC NEEDLE,=CL8'th' needle='th' + MVC LENN,=F'2' ln=2 + BAL R14,SHOW call show + MVC HAYSTACK,=CL32'ababababab' + MVC LENH,=F'11' lh=11 + MVC NEEDLE,=CL8'abab' needle='abab' + MVC LENN,=F'4' ln=4 + BAL R14,SHOW call show + L R13,4(0,R13) epilog + LM R14,R12,12(R13) " + XR R15,R15 " + BR R14 exit +HAYSTACK DS CL32 haystack +NEEDLE DS CL8 needle +LENH DS F length(haystack) +LENN DS F length(needle) +*------- ---- show--------------------------------------------------- +SHOW ST R14,SAVESHOW save return address + BAL R14,COUNT count(haystack,needle) + LR R11,R0 ic=count(haystack,needle) + MVC PG(20),HAYSTACK output haystack + MVC PG+20(5),NEEDLE output needle + XDECO R11,PG+25 output ic + XPRNT PG,80 print buffer + L R14,SAVESHOW restore return address + BR R14 return to caller +SAVESHOW DS A return address of caller +PG DC CL80' ' buffer +*------- ---- count-------------------------------------------------- +COUNT ST R14,SAVECOUN save return address + SR R7,R7 n=0 + LA R6,1 istart=1 + L R10,LENH lh + S R10,LENN ln + LA R10,1(R10) lh-ln+1 +LOOPI CR R6,R10 do istart=1 to lh-ln+1 + BH ELOOPI + LA R8,NEEDLE @needle + L R9,LENN ln + LA R4,HAYSTACK-1 @haystack[0] + AR R4,R6 +istart + LR R5,R9 ln + CLCL R4,R8 if substr(haystack,istart,ln)=needle + BNE NOTEQ + LA R7,1(R7) n=n+1 + A R6,LENN istart=istart+ln +NOTEQ LA R6,1(R6) istart=istart+1 + B LOOPI +ELOOPI LR R0,R7 return(n) + L R14,SAVECOUN restore return address + BR R14 return to caller +SAVECOUN DS A return address of caller +* ---- ------------------------------------------------------- + YREGS + END COUNTSTR diff --git a/Task/Count-occurrences-of-a-substring/AWK/count-occurrences-of-a-substring.awk b/Task/Count-occurrences-of-a-substring/AWK/count-occurrences-of-a-substring.awk index b3b766e08e..ac55135dff 100644 --- a/Task/Count-occurrences-of-a-substring/AWK/count-occurrences-of-a-substring.awk +++ b/Task/Count-occurrences-of-a-substring/AWK/count-occurrences-of-a-substring.awk @@ -1,16 +1,30 @@ -#!/usr/local/bin/awk -f - function countsubstring (str,pat) - { - n=0; - while (match(str,pat)) { - n++; - str = substr(str,RSTART+RLENGTH); - } - return n; - } - - BEGIN { - print countsubstring("the three truths","th"); - print countsubstring("ababababab","abab"); - print countsubstring(ARGV[1],ARGV[2]); +# +# countsubstring(string, pattern) +# Returns number of occurrences of pattern in string +# Pattern treated as a literal string (regex characters not expanded) +# +function countsubstring(str, pat, len, i, c) { + c = 0 + if( ! (len = length(pat) ) ) + return 0 + while(i = index(str, pat)) { + str = substr(str, i + len) + c++ } + return c +} +# +# countsubstring_regex(string, regex_pattern) +# Returns number of occurrences of pattern in string +# Pattern treated as regex +# +function countsubstring_regex(str, pat, c) { + c = 0 + c += gsub(pat, "", str) + return c +} +BEGIN { + print countsubstring("[do&d~run?d!run&>run&]", "run&") + print countsubstring_regex("[do&d~run?d!run&>run&]", "run[&]") + print countsubstring("the three truths","th") +} diff --git a/Task/Count-occurrences-of-a-substring/Ada/count-occurrences-of-a-substring.ada b/Task/Count-occurrences-of-a-substring/Ada/count-occurrences-of-a-substring.ada index 66bbbb29a1..1b89563491 100644 --- a/Task/Count-occurrences-of-a-substring/Ada/count-occurrences-of-a-substring.ada +++ b/Task/Count-occurrences-of-a-substring/Ada/count-occurrences-of-a-substring.ada @@ -1,18 +1,9 @@ -with Ada.Strings.Fixed, Ada.Text_IO; - -procedure Count_Substrings is - - function Substrings(Main: String; Sub: String) return Natural is - Idx: Natural := Ada.Strings.Fixed.Index(Source => Main, Pattern => Sub); - begin - if Idx = 0 then - return 0; - else - return 1 + Substrings(Main(Idx+Sub'Length .. Main'Last), Sub); - end if; - end Substrings; +with Ada.Strings.Fixed, Ada.Integer_Text_IO; +procedure Substrings is begin - Ada.Text_IO.Put(Integer'Image(Substrings("the three truths", "th"))); - Ada.Text_IO.Put(Integer'Image(Substrings("ababababab", "abab"))); -end Count_Substrings; + Ada.Integer_Text_IO.Put (Ada.Strings.Fixed.Count (Source => "the three truths", + Pattern => "th")); + Ada.Integer_Text_IO.Put (Ada.Strings.Fixed.Count (Source => "ababababab", + Pattern => "abab")); +end Substrings; diff --git a/Task/Count-occurrences-of-a-substring/AppleScript/count-occurrences-of-a-substring.applescript b/Task/Count-occurrences-of-a-substring/AppleScript/count-occurrences-of-a-substring.applescript new file mode 100644 index 0000000000..b00f65fc4b --- /dev/null +++ b/Task/Count-occurrences-of-a-substring/AppleScript/count-occurrences-of-a-substring.applescript @@ -0,0 +1,29 @@ +use framework "OSAKit" + +on run + {countSubstring("the three truths", "th"), ¬ + countSubstring("ababababab", "abab")} +end run + +on countSubstring(str, subStr) + return evalOSA("JavaScript", "var matches = '" & str & "'" & ¬ + ".match(new RegExp('" & subStr & "', 'g'));" & ¬ + "matches ? matches.length : 0") as integer +end countSubstring + +-- evalOSA :: ("JavaScript" | "AppleScript") -> String -> String +on evalOSA(strLang, strCode) + + set ca to current application + set oScript to ca's OSAScript's alloc's initWithSource:strCode ¬ + |language|:(ca's OSALanguage's languageForName:(strLang)) + + set {blnCompiled, oError} to oScript's compileAndReturnError:(reference) + + if blnCompiled then + set {oDesc, oError} to oScript's executeAndReturnError:(reference) + if (oError is missing value) then return oDesc's stringValue as text + end if + + return oError's NSLocalizedDescription as text +end evalOSA diff --git a/Task/Count-occurrences-of-a-substring/Haskell/count-occurrences-of-a-substring.hs b/Task/Count-occurrences-of-a-substring/Haskell/count-occurrences-of-a-substring-1.hs similarity index 100% rename from Task/Count-occurrences-of-a-substring/Haskell/count-occurrences-of-a-substring.hs rename to Task/Count-occurrences-of-a-substring/Haskell/count-occurrences-of-a-substring-1.hs diff --git a/Task/Count-occurrences-of-a-substring/Haskell/count-occurrences-of-a-substring-2.hs b/Task/Count-occurrences-of-a-substring/Haskell/count-occurrences-of-a-substring-2.hs new file mode 100644 index 0000000000..20ac2f87b9 --- /dev/null +++ b/Task/Count-occurrences-of-a-substring/Haskell/count-occurrences-of-a-substring-2.hs @@ -0,0 +1,9 @@ +count :: Eq a => [a] -> [a] -> Int +count [] = error "empty substring" +count sub = go + where + go = scan sub . dropWhile (/= head sub) + scan _ [] = 0 + scan [] xs = 1 + go xs + scan (x:xs) (y:ys) | x == y = scan xs ys + | otherwise = go ys diff --git a/Task/Count-occurrences-of-a-substring/Haskell/count-occurrences-of-a-substring-3.hs b/Task/Count-occurrences-of-a-substring/Haskell/count-occurrences-of-a-substring-3.hs new file mode 100644 index 0000000000..df6624ba34 --- /dev/null +++ b/Task/Count-occurrences-of-a-substring/Haskell/count-occurrences-of-a-substring-3.hs @@ -0,0 +1,5 @@ +import Data.List (tails, stripPrefix) +import Data.Maybe (catMaybes) + +count :: Eq a => [a] -> [a] -> Int +count sub = length . catMaybes . map (stripPrefix sub) . tails diff --git a/Task/Count-occurrences-of-a-substring/JavaScript/count-occurrences-of-a-substring.js b/Task/Count-occurrences-of-a-substring/JavaScript/count-occurrences-of-a-substring.js index 12bfd99303..8bf3672d18 100644 --- a/Task/Count-occurrences-of-a-substring/JavaScript/count-occurrences-of-a-substring.js +++ b/Task/Count-occurrences-of-a-substring/JavaScript/count-occurrences-of-a-substring.js @@ -1,4 +1,4 @@ -function countSubstring(str, subStr){ - var matches=str.match(new RegExp(subStr, "g")); - return matches?matches.length:0; +function countSubstring(str, subStr) { + var matches = str.match(new RegExp(subStr, "g")); + return matches ? matches.length : 0; } diff --git a/Task/Count-occurrences-of-a-substring/Lua/count-occurrences-of-a-substring.lua b/Task/Count-occurrences-of-a-substring/Lua/count-occurrences-of-a-substring.lua index 96b8e6849a..3717ed98cc 100644 --- a/Task/Count-occurrences-of-a-substring/Lua/count-occurrences-of-a-substring.lua +++ b/Task/Count-occurrences-of-a-substring/Lua/count-occurrences-of-a-substring.lua @@ -1,8 +1,8 @@ -function Count_Substring( s1, s2 ) - local magic = "[%^%$%(%)%%%.%[%]%*%+%-%?]" - local percent = function(s)return "%"..s end - return select( 2, s1:gsub( s2:gsub(magic,percent), "" ) ) +function countSubstring (s1, s2) + local count = 0 + for eachMatch in s1:gmatch(s2) do count = count + 1 end + return count end -print( Count_Substring( "the three truths", "th" ) ) -print( Count_Substring( "ababababab","abab" ) ) +print(countSubstring("the three truths", "th")) +print(countSubstring("ababababab","abab")) diff --git a/Task/Count-occurrences-of-a-substring/REXX/count-occurrences-of-a-substring.rexx b/Task/Count-occurrences-of-a-substring/REXX/count-occurrences-of-a-substring.rexx index e5e753b90a..6ff61b9963 100644 --- a/Task/Count-occurrences-of-a-substring/REXX/count-occurrences-of-a-substring.rexx +++ b/Task/Count-occurrences-of-a-substring/REXX/count-occurrences-of-a-substring.rexx @@ -1,30 +1,29 @@ -/*REXX pgm counts the occurrences of a (non─overlapping) substring in a string*/ -w=. /*max. width so far.*/ -bag='the three truths' ; x='th' ; call showResult -bag='ababababab' ; x='abab' ; call showResult -bag='aaaabacad' ; x='aa' ; call showResult -bag='abaabba*bbaba*bbab' ; x='a*b' ; call showResult -bag='abaabba*bbaba*bbab' ; x=' ' ; call showResult -bag= ; x='a' ; call showResult -bag= ; x= ; call showResult -bag='catapultcatalog' ; x='cat' ; call showResult -bag='aaaaaaaaaaaaaa' ; x='aa' ; call showResult -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -countstr: procedure; parse arg haystack,needle,start /*get the arguments.*/ -if start=='' then start=1; width=length(needle) - do $=0 until p==0; p=pos(needle,haystack,start) - start=p+width /*prevent overlaps. */ - end /*$*/ -return $ /*return the count. */ -/*────────────────────────────────────────────────────────────────────────────*/ -showResult: _= '═' /*the char (double bar) used in title. */ -if w==. then do; w=30; n=w%2 /*W: width of largest haystack; N=½W */ - say center('haystack',w ) center('needle',n ) center('count',5 ) - say center('' ,w,_) center('' ,n,_) center('' ,5,_) - end - /* [↓] handle showing of null strings.*/ -if bag=='' then bag=' (null)' -if x=='' then x=' (null)' -say left(bag,w) left(x,n) center(countstr(bag,x),5) /*display the result.*/ -return +/*REXX program counts the occurrences of a (non─overlapping) substring in a string. */ +w=. /*max. width so far.*/ +bag= 'the three truths' ; x= "th" ; call showResult +bag= 'ababababab' ; x= "abab" ; call showResult +bag= 'aaaabacad' ; x= "aa" ; call showResult +bag= 'abaabba*bbaba*bbab' ; x= "a*b" ; call showResult +bag= 'abaabba*bbaba*bbab' ; x= " " ; call showResult +bag= ; x= "a" ; call showResult +bag= ; x= ; call showResult +bag= 'catapultcatalog' ; x= "cat" ; call showResult +bag= 'aaaaaaaaaaaaaa' ; x= "aa" ; call showResult +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +countstr: procedure; parse arg haystack,needle,start; if start=='' then start=1 + width=length(needle) + do $=0 until p==0; p=pos(needle,haystack,start) + start=width + p /*prevent overlaps.*/ + end /*$*/ + return $ /*return the count.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +showResult: if w==. then do; w=30 /*W: largest haystack width.*/ + say center('haystack',w) center('needle',w%2) center('count',5) + say left('', w, "═") left('', w%2, "═") left('', 5, "═") + end + + if bag=='' then bag= " (null)" /*handle displaying of nulls.*/ + if x=='' then x= " (null)" /* " " " " */ + say left(bag, w) left(x, w%2) center(countstr(bag, x), 5) + return diff --git a/Task/Count-occurrences-of-a-substring/Rust/count-occurrences-of-a-substring.rust b/Task/Count-occurrences-of-a-substring/Rust/count-occurrences-of-a-substring.rust new file mode 100644 index 0000000000..fd841d13af --- /dev/null +++ b/Task/Count-occurrences-of-a-substring/Rust/count-occurrences-of-a-substring.rust @@ -0,0 +1,4 @@ +fn main() { + println!("{}","the three truths".matches("th").count()); + println!("{}","ababababab".matches("abab").count()); +} diff --git a/Task/Count-occurrences-of-a-substring/ZX-Spectrum-Basic/count-occurrences-of-a-substring.zx b/Task/Count-occurrences-of-a-substring/ZX-Spectrum-Basic/count-occurrences-of-a-substring.zx new file mode 100644 index 0000000000..20707a88b1 --- /dev/null +++ b/Task/Count-occurrences-of-a-substring/ZX-Spectrum-Basic/count-occurrences-of-a-substring.zx @@ -0,0 +1,10 @@ +10 LET t$="ABABABABAB": LET p$="ABAB": GO SUB 1000 +20 LET t$="THE THREE TRUTHS": LET p$="TH": GO SUB 1000 +30 STOP +1000 PRINT t$: LET c=0 +1010 LET lp=LEN p$ +1020 FOR i=1 TO LEN t$-lp+1 +1030 IF (t$(i TO i+lp-1)=p$) THEN LET c=c+1: LET i=i+lp-1 +1040 NEXT i +1050 PRINT p$;"=";c'' +1060 RETURN diff --git a/Task/Count-the-coins/00DESCRIPTION b/Task/Count-the-coins/00DESCRIPTION index c02c287227..275d7ee06e 100644 --- a/Task/Count-the-coins/00DESCRIPTION +++ b/Task/Count-the-coins/00DESCRIPTION @@ -1,16 +1,29 @@ -There are four types of common coins in US currency: quarters (25 cents), dimes (10), nickels (5) and pennies (1). There are 6 ways to make change for 15 cents: -* A dime and a nickel; -* A dime and 5 pennies; -* 3 nickels; -* 2 nickels and 5 pennies; -* A nickel and 10 pennies; -* 15 pennies. +There are four types of common coins in   [https://en.wikipedia.org/wiki/United_States US]   currency: +:::#   quarters   (25 cents) +:::#   dimes   (10 cents) +:::#   nickels   (5 cents),   and +:::#   pennies   (1 cent) -How many ways are there to make change for a dollar using these common coins? (1 dollar = 100 cents). -'''Optional:''' +There are six ways to make change for 15 cents: +:::#   A dime and a nickel +:::#   A dime and 5 pennies +:::#   3 nickels +:::#   2 nickels and 5 pennies +:::#   A nickel and 10 pennies +:::#   15 pennies +
    -Less common are dollar coins (100 cents); very rare are half dollars (50 cents). With the addition of these two coins, how many ways are there to make change for $1000? (note: the answer is larger than 232). +;Task: +How many ways are there to make change for a dollar using these common coins?     (1 dollar = 100 cents). -'''Algorithm''': -See [http://mitpress.mit.edu/sicp/full-text/book/book-Z-H-11.html#%_sec_Temp_52 here]. + +;Optional: +Less common are dollar coins (100 cents);   and very rare are half dollars (50 cents).   With the addition of these two coins, how many ways are there to make change for $1000? + +(Note:   the answer is larger than   232). + + +;Reference: +*   [http://mitpress.mit.edu/sicp/full-text/book/book-Z-H-11.html#%_sec_Temp_52 an algorithm from MIT Press]. +

    diff --git a/Task/Count-the-coins/Elixir/count-the-coins.elixir b/Task/Count-the-coins/Elixir/count-the-coins.elixir index eb1c528bea..a32ea6a84f 100644 --- a/Task/Count-the-coins/Elixir/count-the-coins.elixir +++ b/Task/Count-the-coins/Elixir/count-the-coins.elixir @@ -1,8 +1,8 @@ defmodule Coins do def find(coins,lim) do - vals = Enum.into(0..lim,Map.new,&{&1,0}) |> Dict.put(0,1) + vals = Enum.into(0..lim,Map.new,&{&1,0}) |> Map.put(0,1) count(coins,lim,vals) - |> Dict.values + |> Map.values |> Enum.max |> IO.inspect end @@ -17,7 +17,7 @@ defmodule Coins do ways(num+1,coin,lim,ad(coin,num,vals)) end - defp ad(a,b,c), do: Dict.put(c,b,c[b]+c[b-a]) + defp ad(a,b,c), do: Map.put(c,b,c[b]+c[b-a]) end Coins.find([1,5,10,25],100) diff --git a/Task/Count-the-coins/Icon/count-the-coins-3.icon b/Task/Count-the-coins/Icon/count-the-coins-3.icon new file mode 100644 index 0000000000..f7208f5db7 --- /dev/null +++ b/Task/Count-the-coins/Icon/count-the-coins-3.icon @@ -0,0 +1,18 @@ +# coin.icn +# usage: coin value +procedure count(coinlist, value) + if value = 0 then return 1 + if value < 0 then return 0 + if (*coinlist <= 0) & (value >= 1) then return 0 + return count(coinlist[1:*coinlist], value) + count(coinlist, value - coinlist[*coinlist]) +end + + +procedure main(params) + money := params[1] + coins := [1,5,10,25] + + writes("Value of ", money, " can be changed by using a set of ") + every writes(coins[1 to *coins], " ") + write(" coins in ", count(coins, money), " different ways.") +end diff --git a/Task/Count-the-coins/Lua/count-the-coins.lua b/Task/Count-the-coins/Lua/count-the-coins.lua new file mode 100644 index 0000000000..9d489add67 --- /dev/null +++ b/Task/Count-the-coins/Lua/count-the-coins.lua @@ -0,0 +1,12 @@ +function countSums (amount, values) + local t = {} + for i = 1, amount do t[i] = 0 end + t[0] = 1 + for k, val in pairs(values) do + for i = val, amount do t[i] = t[i] + t[i - val] end + end + return t[amount] +end + +print(countSums(100, {1, 5, 10, 25})) +print(countSums(100000, {1, 5, 10, 25, 50, 100})) diff --git a/Task/Count-the-coins/REXX/count-the-coins-1.rexx b/Task/Count-the-coins/REXX/count-the-coins-1.rexx index 0e1bbbfe15..0ff90ae68d 100644 --- a/Task/Count-the-coins/REXX/count-the-coins-1.rexx +++ b/Task/Count-the-coins/REXX/count-the-coins-1.rexx @@ -1,31 +1,31 @@ -/*REXX program counts the ways to make change with coins from an given amount.*/ -numeric digits 20 /*be able to handle large amounts of $.*/ -parse arg N $ /*obtain optional arguments from the CL*/ -if N='' | N=',' then N=100 /*Not specified? Then Use $1 (≡100¢).*/ -if $='' | $=',' then $=1 5 10 25 /*Use penny/nickel/dime/quarter default*/ -if left(N,1)=='$' then N=100*substr(N,2) /*amount was specified in dollars.*/ -coins=words($) /*the number of coins specified. */ -NN=N; do j=1 for coins /*create a fast way of accessing specie*/ - _=word($,j) /*define an array element for the coin.*/ - if _=='1/2' then _=.5 /*an alternate spelling of a half-cent.*/ - if _=='1/4' then _=.25 /* " " " " " quarter-¢.*/ - $.j=_ /*assign the value to a particular coin*/ - end /*j*/ -_=n//100; cnt=' cents' /* [↓] Is amount in whole $'s*/ -if _=0 then do; NN='$'||(NN%100); cnt=; end /*show amount in dollars, ¬ ¢.*/ -say 'with an amount of ' commas(NN)cnt", there are " commas(kaChing(N,coins)) +/*REXX program counts the number of ways to make change with coins from an given amount.*/ +numeric digits 20 /*be able to handle large amounts of $.*/ +parse arg N $ /*obtain optional arguments from the CL*/ +if N='' | N="," then N=100 /*Not specified? Then Use $1 (≡100¢).*/ +if $='' | $="," then $=1 5 10 25 /*Use penny/nickel/dime/quarter default*/ +if left(N,1)=='$' then N=100*substr(N,2) /*the amount was specified in dollars.*/ +coins=words($) /*the number of coins specified. */ +NN=N; do j=1 for coins /*create a fast way of accessing specie*/ + _=word($,j) /*define an array element for the coin.*/ + if _=='1/2' then _=.5 /*an alternate spelling of a half-cent.*/ + if _=='1/4' then _=.25 /* " " " " " quarter-¢.*/ + $.j=_ /*assign the value to a particular coin*/ + end /*j*/ +_=n//100; cnt=' cents' /* [↓] is the amount in whole dollars?*/ +if _=0 then do; NN='$' || (NN%100); cnt=; end /*show the amount in dollars, not cents*/ +say 'with an amount of ' commas(NN)cnt", there are " commas( MKchg(N, coins) ) say 'ways to make change with coins of the following denominations: ' $ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -commas: procedure; parse arg _; n=_'.9'; #=123456789; b=verify(n,#,"M") +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +commas: procedure; parse arg _; n=_'.9'; #=123456789; b=verify(n,#,"M") e=verify(n,#'0',,verify(n,#"0.",'M'))-4 - do j=e to b by -3; _=insert(',',_,j); end /*j*/; return _ -/*────────────────────────────────────────────────────────────────────────────*/ -kaChing: procedure expose $.; parse arg a,k /*this function is recursive.*/ -if a==0 then return 1 /*unroll for a special case. */ -if k==1 then return 1 /* " " " " " */ -if k==2 then f=1 /*handle this special case. */ - else f=kaChing(a, k-1) /*count, recurse the amount. */ -if a==$.k then return f + 1 /*handle this special case. */ -if a <$.k then return f /* " " " " */ - return f + kaChing(a-$.k, k) /*use a diminished amount ($)*/ + do j=e to b by -3; _=insert(',',_,j); end /*j*/; return _ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +MKchg: procedure expose $.; parse arg a,k /*this function is invoked recursively.*/ + if a==0 then return 1 /*unroll for a special case of zero. */ + if k==1 then return 1 /* " " " " " " unity. */ + if k==2 then f=1 /*handle this special case of two. */ + else f=MKchg(a, k-1) /*count, and then recurse the amount. */ + if a==$.k then return f+1 /*handle this special case of A=a coin.*/ + if a <$.k then return f /* " " " " " A
    max$ then call ser X " amount can't be greater than " max$'.' -coins=words($); !.=.; NN=N; p=0 /*#coins specified; coins; amount; prev*/ -@.=0 /*verify a coin was only specified once*/ - do j=1 for coins /*create a fast way of accessing specie*/ - _=word($,j); ?=_ ' coin' /*define an array element for the coin.*/ - if _=='1/2' then _=.5 /*an alternate spelling of a half-cent.*/ - if _=='1/4' then _=.25 /* " " " " " quarter-¢.*/ +coins=words($); !.=.; NN=N; p=0 /*#coins specified; coins; amount; prev*/ +@.=0 /*verify a coin was only specified once*/ + do j=1 for coins /*create a fast way of accessing specie*/ + _=word($,j); ?=_ ' coin' /*define an array element for the coin.*/ + if _=='1/2' then _=.5 /*an alternate spelling of a half-cent.*/ + if _=='1/4' then _=.25 /* " " " " " quarter-¢.*/ if \isNum(_) then call ser ? "coin value isn't numeric." if _<0 then call ser ? "coin value can't be negative." if _<=0 then call ser ? "coin value can't be zero." if @._ then call ser ? "coin was already specified." - if _

    N then call ser ? "coin must be less or equal to amount:" X - @._=1; p=_ /*signify coin was specified; set prev.*/ - $.j=_ /*assign the value to a particular coin*/ + if _

    N then call ser ? "coin must be less or equal to amount:" X + @._=1; p=_ /*signify coin was specified; set prev.*/ + $.j=_ /*assign the value to a particular coin*/ end /*j*/ -_=n//100; cnt=' cents' /* [↓] Is amount in whole $'s*/ -if _=0 then do; NN='$'||(NN%100); cnt=; end /*show amount in dollars, ¬ ¢.*/ -say 'with an amount of ' commas(NN)cnt", there are " commas(kaChing(N,coins)) +_=n//100; cnt=' cents' /* [↓] is the amount in whole dollars?*/ +if _=0 then do; NN='$' || (NN%100); cnt=; end /*show the amount in dollars, not cents*/ +say 'with an amount of ' commas(NN)cnt", there are " commas( MKchg(N, coins) ) say 'ways to make change with coins of the following denominations: ' $ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -isNum: return datatype(arg(1), 'N') /*return 1 if arg is numeric, 0 if not.*/ -ser: say; say '***error!***'; say; say arg(1); say; exit 13 /*error msg.*/ -/*────────────────────────────────────────────────────────────────────────────*/ -commas: procedure; parse arg _; n=_'.9'; #=123456789; b=verify(n,#,"M") +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +isNum: return datatype(arg(1), 'N') /*return 1 if arg is numeric, 0 if not.*/ +ser: say; say '***error***'; say; say arg(1); say; exit 13 /*error msg.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +commas: procedure; parse arg _; n=_'.9'; #=123456789; b=verify(n,#,"M") e=verify(n,#'0',,verify(n,#"0.",'M'))-4 - do j=e to b by -3; _=insert(',',_,j); end /*j*/; return _ -/*────────────────────────────────────────────────────────────────────────────*/ -kaChing: procedure expose $. !.; parse arg a,k /*function is recursive. */ -if !.a.k\==. then return !.a.k /*found this A & K before? */ -if a==0 then return 1 /*unroll for a special case*/ -if k==1 then return 1 /* " " " " " */ -if k==2 then f=1 /*handle this special case.*/ - else f=kaChing(a, k-1) /*count, recurse the amount*/ -if a==$.k then do; !.a.k=f+1; return !.a.k; end /*handle this special case.*/ -if a <$.k then do; !.a.k=f ; return f ; end /* " " " " */ -!.a.k=f + kaChing(a-$.k, k) ; return !.a.k /*compute, define, return. */ + do j=e to b by -3; _=insert(',',_,j); end /*j*/; return _ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +MKchg: procedure expose $. !.; parse arg a,k /*function is recursive. */ + if !.a.k\==. then return !.a.k /*found this A & K before? */ + if a==0 then return 1 /*unroll for a special case*/ + if k==1 then return 1 /* " " " " " */ + if k==2 then f=1 /*handle this special case.*/ + else f=MKchg(a, k-1) /*count, recurse the amount*/ + if a==$.k then do; !.a.k=f+1; return !.a.k; end /*handle this special case.*/ + if a <$.k then do; !.a.k=f ; return f ; end /* " " " " */ + !.a.k=f + MKchg(a-$.k, k); return !.a.k /*compute, define, return. */ diff --git a/Task/Count-the-coins/SAS/count-the-coins.sas b/Task/Count-the-coins/SAS/count-the-coins.sas new file mode 100644 index 0000000000..74e0958fc3 --- /dev/null +++ b/Task/Count-the-coins/SAS/count-the-coins.sas @@ -0,0 +1,21 @@ +/* call OPTMODEL procedure in SAS/OR */ +proc optmodel; + /* declare set and names of coins */ + set COINS = {1,5,10,25}; + str name {COINS} = ['penny','nickel','dime','quarter']; + + /* declare variables and constraint */ + var NumCoins {COINS} >= 0 integer; + con Dollar: + sum {i in COINS} i * NumCoins[i] = 100; + + /* call CLP solver */ + solve with CLP / findallsolns; + + /* write solutions to SAS data set */ + create data sols(drop=s) from [s]=(1.._NSOL_) {i in COINS} ; +quit; + +/* print all solutions */ +proc print data=sols; +run; diff --git a/Task/Count-the-coins/ZX-Spectrum-Basic/count-the-coins.zx b/Task/Count-the-coins/ZX-Spectrum-Basic/count-the-coins.zx new file mode 100644 index 0000000000..0d4c0dc592 --- /dev/null +++ b/Task/Count-the-coins/ZX-Spectrum-Basic/count-the-coins.zx @@ -0,0 +1,20 @@ +10 LET amount=100 +20 GO SUB 1000 +30 STOP +1000 LET nPennies=amount +1010 LET nNickles=INT (amount/5) +1020 LET nDimes=INT (amount/10) +1030 LET nQuarters=INT (amount/25) +1040 LET count=0 +1050 FOR p=0 TO nPennies +1060 FOR n=0 TO nNickles +1070 FOR d=0 TO nDimes +1080 FOR q=0 TO nQuarters +1090 LET s=p+n*5+d*10+q*25 +1100 IF s=100 THEN LET count=count+1 +1110 NEXT q +1120 NEXT d +1130 NEXT n +1140 NEXT p +1150 PRINT count +1160 RETURN diff --git a/Task/Create-a-file/COBOL/create-a-file.cobol b/Task/Create-a-file/COBOL/create-a-file.cobol new file mode 100644 index 0000000000..b8da29eeea --- /dev/null +++ b/Task/Create-a-file/COBOL/create-a-file.cobol @@ -0,0 +1,41 @@ + identification division. + program-id. create-a-file. + + data division. + working-storage section. + 01 skip pic 9 value 2. + 01 file-name. + 05 value "/output.txt". + 01 dir-name. + 05 value "/docs". + 01 file-handle usage binary-long. + + procedure division. + files-main. + + *> create in current working directory + perform create-file-and-dir + + *> create in root of file system, will fail without privilege + move 1 to skip + perform create-file-and-dir + + goback. + + create-file-and-dir. + *> create file in current working dir, for read/write + call "CBL_CREATE_FILE" using file-name(skip:) 3 0 0 file-handle + if return-code not equal 0 then + display "error: CBL_CREATE_FILE " file-name(skip:) ": " + file-handle ", " return-code upon syserr + end-if + + *> create dir below current working dir, owner/group read/write + call "CBL_CREATE_DIR" using dir-name(skip:) + if return-code not equal 0 then + display "error: CBL_CREATE_DIR " dir-name(skip:) ": " + return-code upon syserr + end-if + . + + end program create-a-file. diff --git a/Task/Create-a-file/Elena/create-a-file.elena b/Task/Create-a-file/Elena/create-a-file.elena new file mode 100644 index 0000000000..aee912b68f --- /dev/null +++ b/Task/Create-a-file/Elena/create-a-file.elena @@ -0,0 +1,13 @@ +#import system. +#import system'io. + +#symbol program = +[ + "output.txt" file_path textwriter close. + + "\output.txt" file_path textwriter close. + + "docs" directory_path create. + + "\docs" directory_path create. +]. diff --git a/Task/Create-a-file/Go/create-a-file.go b/Task/Create-a-file/Go/create-a-file.go index c3f8acdbab..40a0288a0a 100644 --- a/Task/Create-a-file/Go/create-a-file.go +++ b/Task/Create-a-file/Go/create-a-file.go @@ -6,7 +6,6 @@ import ( ) func createFile(fn string) { - // create new; don't overwrite an existing file. f, err := os.Create(fn) if err != nil { fmt.Println(err) diff --git a/Task/Create-a-file/PARI-GP/create-a-file-1.pari b/Task/Create-a-file/PARI-GP/create-a-file-1.pari new file mode 100644 index 0000000000..fca71eacf4 --- /dev/null +++ b/Task/Create-a-file/PARI-GP/create-a-file-1.pari @@ -0,0 +1,2 @@ +write1("0.txt","") +write1("/0.txt","") diff --git a/Task/Create-a-file/PARI-GP/create-a-file-2.pari b/Task/Create-a-file/PARI-GP/create-a-file-2.pari new file mode 100644 index 0000000000..179d44f9f9 --- /dev/null +++ b/Task/Create-a-file/PARI-GP/create-a-file-2.pari @@ -0,0 +1 @@ +system("mkdir newdir") diff --git a/Task/Create-a-two-dimensional-array-at-runtime/C++/create-a-two-dimensional-array-at-runtime-1.cpp b/Task/Create-a-two-dimensional-array-at-runtime/C++/create-a-two-dimensional-array-at-runtime-1.cpp index 11c0c14a03..12133cc5d6 100644 --- a/Task/Create-a-two-dimensional-array-at-runtime/C++/create-a-two-dimensional-array-at-runtime-1.cpp +++ b/Task/Create-a-two-dimensional-array-at-runtime/C++/create-a-two-dimensional-array-at-runtime-1.cpp @@ -23,4 +23,6 @@ int main() // get rid of array delete[] array; delete[] array_data; + + return 0; } diff --git a/Task/Create-a-two-dimensional-array-at-runtime/C++/create-a-two-dimensional-array-at-runtime-2.cpp b/Task/Create-a-two-dimensional-array-at-runtime/C++/create-a-two-dimensional-array-at-runtime-2.cpp index ae34df02f4..864e748373 100644 --- a/Task/Create-a-two-dimensional-array-at-runtime/C++/create-a-two-dimensional-array-at-runtime-2.cpp +++ b/Task/Create-a-two-dimensional-array-at-runtime/C++/create-a-two-dimensional-array-at-runtime-2.cpp @@ -19,4 +19,5 @@ int main() std::cout << array[0][0] << std::endl; // the array is automatically freed at the end of main() + return 0; } diff --git a/Task/Create-a-two-dimensional-array-at-runtime/C++/create-a-two-dimensional-array-at-runtime-3.cpp b/Task/Create-a-two-dimensional-array-at-runtime/C++/create-a-two-dimensional-array-at-runtime-3.cpp index 39e849ae35..5fc8a564e6 100644 --- a/Task/Create-a-two-dimensional-array-at-runtime/C++/create-a-two-dimensional-array-at-runtime-3.cpp +++ b/Task/Create-a-two-dimensional-array-at-runtime/C++/create-a-two-dimensional-array-at-runtime-3.cpp @@ -12,9 +12,11 @@ int main() // create array two_d_array_type A(boost::extents[dim1][dim2]); - // write elements + // write element A[0][0] = 3.1415; - // read elements + // read element std::cout << A[0][0] << std::endl; + + return 0; } diff --git a/Task/Create-a-two-dimensional-array-at-runtime/C++/create-a-two-dimensional-array-at-runtime-4.cpp b/Task/Create-a-two-dimensional-array-at-runtime/C++/create-a-two-dimensional-array-at-runtime-4.cpp new file mode 100644 index 0000000000..22013d4f5b --- /dev/null +++ b/Task/Create-a-two-dimensional-array-at-runtime/C++/create-a-two-dimensional-array-at-runtime-4.cpp @@ -0,0 +1,18 @@ +#include +#include +#include + +int main (const int argc, const char** argv) { + if (argc > 2) { + using namespace boost::numeric::ublas; + + matrix m(atoi(argv[1]), atoi(argv[2])); // build + for (unsigned i = 0; i < m.size1(); i++) + for (unsigned j = 0; j < m.size2(); j++) + m(i, j) = 1.0 + i + j; // fill + std::cout << m << std::endl; // print + return EXIT_SUCCESS; + } + + return EXIT_FAILURE; +} diff --git a/Task/Create-a-two-dimensional-array-at-runtime/Elena/create-a-two-dimensional-array-at-runtime-1.elena b/Task/Create-a-two-dimensional-array-at-runtime/Elena/create-a-two-dimensional-array-at-runtime-1.elena new file mode 100644 index 0000000000..a8c7bbaca4 --- /dev/null +++ b/Task/Create-a-two-dimensional-array-at-runtime/Elena/create-a-two-dimensional-array-at-runtime-1.elena @@ -0,0 +1,17 @@ +#import system. +#import extensions. + +#symbol program = +[ + #var n := Integer new. + #var m := Integer new. + + console write:"Enter two space delimited integers:". + console readLine:n:m. + + #var myArray := RealMatrix new:n:m. + + myArray@0@0 := 2. + + console writeLine:(myArray@0@0). +]. diff --git a/Task/Create-a-two-dimensional-array-at-runtime/Elena/create-a-two-dimensional-array-at-runtime-2.elena b/Task/Create-a-two-dimensional-array-at-runtime/Elena/create-a-two-dimensional-array-at-runtime-2.elena new file mode 100644 index 0000000000..be7f190528 --- /dev/null +++ b/Task/Create-a-two-dimensional-array-at-runtime/Elena/create-a-two-dimensional-array-at-runtime-2.elena @@ -0,0 +1,19 @@ +#import system. +#import system'routines. +#import extensions. + +#symbol program = +[ + #var n := Integer new. + #var m := Integer new. + + console write:"Enter two space delimited integers:". + console readLine:n:m. + + #var myArray2 := Array new:n set &every:(&index:i) [ Array new:m ]. + myArray2@0@0 := 2. + myArray2@1@0 := "Hello". + + console writeLine:(myArray2@0@0). + console writeLine:(myArray2@1@0). +]. diff --git a/Task/Create-a-two-dimensional-array-at-runtime/Elixir/create-a-two-dimensional-array-at-runtime.elixir b/Task/Create-a-two-dimensional-array-at-runtime/Elixir/create-a-two-dimensional-array-at-runtime.elixir new file mode 100644 index 0000000000..d3bc8c3238 --- /dev/null +++ b/Task/Create-a-two-dimensional-array-at-runtime/Elixir/create-a-two-dimensional-array-at-runtime.elixir @@ -0,0 +1,29 @@ +defmodule TwoDimArray do + + def create(w, h) do + List.duplicate(0, w) + |> List.duplicate(h) + end + + def set(arr, x, y, value) do + List.replace_at(arr, x, + List.replace_at(Enum.at(arr, x), y, value) + ) + end + + def get(arr, x, y) do + arr |> Enum.at(x) |> Enum.at(y) + end +end + + +width = IO.gets "Enter Array Width: " +w = width |> String.trim() |> String.to_integer() + +height = IO.gets "Enter Array Height: " +h = height |> String.trim() |> String.to_integer() + +arr = TwoDimArray.create(w, h) +arr = TwoDimArray.set(arr,2,0,42) + +IO.puts(TwoDimArray.get(arr,2,0)) diff --git a/Task/Create-a-two-dimensional-array-at-runtime/Kotlin/create-a-two-dimensional-array-at-runtime.kotlin b/Task/Create-a-two-dimensional-array-at-runtime/Kotlin/create-a-two-dimensional-array-at-runtime.kotlin new file mode 100644 index 0000000000..0e6aa2f87d --- /dev/null +++ b/Task/Create-a-two-dimensional-array-at-runtime/Kotlin/create-a-two-dimensional-array-at-runtime.kotlin @@ -0,0 +1,7 @@ +fun main(args: Array) { + val dim = args.map { it.toInt() } // interpret + val array = Array(dim[0], { IntArray(dim[1]) } ) // build + + array.forEachIndexed { i, it -> for (j in it.indices) it[j] = 1 + i + j } // fill + array.forEach { println(it.asList()) } // print +} diff --git a/Task/Create-a-two-dimensional-array-at-runtime/Perl-6/create-a-two-dimensional-array-at-runtime-2.pl6 b/Task/Create-a-two-dimensional-array-at-runtime/Perl-6/create-a-two-dimensional-array-at-runtime-2.pl6 index 90f2bcf9a6..0957ef63b0 100644 --- a/Task/Create-a-two-dimensional-array-at-runtime/Perl-6/create-a-two-dimensional-array-at-runtime-2.pl6 +++ b/Task/Create-a-two-dimensional-array-at-runtime/Perl-6/create-a-two-dimensional-array-at-runtime-2.pl6 @@ -1,4 +1,3 @@ -$ ./two-dee Dimensions? 5x35 [@ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @] [@ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @] diff --git a/Task/Create-a-two-dimensional-array-at-runtime/Perl-6/create-a-two-dimensional-array-at-runtime-3.pl6 b/Task/Create-a-two-dimensional-array-at-runtime/Perl-6/create-a-two-dimensional-array-at-runtime-3.pl6 new file mode 100644 index 0000000000..1908b30ac6 --- /dev/null +++ b/Task/Create-a-two-dimensional-array-at-runtime/Perl-6/create-a-two-dimensional-array-at-runtime-3.pl6 @@ -0,0 +1,4 @@ +my ($major,$minor) = +«prompt("Dimensions? ").comb(/\d+/); +my Int @array[$major;$minor] = (7 xx $minor ) xx $major; +@array[$major div 2;$minor div 2] = 42; +say @array; diff --git a/Task/Create-a-two-dimensional-array-at-runtime/Perl-6/create-a-two-dimensional-array-at-runtime-4.pl6 b/Task/Create-a-two-dimensional-array-at-runtime/Perl-6/create-a-two-dimensional-array-at-runtime-4.pl6 new file mode 100644 index 0000000000..9e7550c17e --- /dev/null +++ b/Task/Create-a-two-dimensional-array-at-runtime/Perl-6/create-a-two-dimensional-array-at-runtime-4.pl6 @@ -0,0 +1,2 @@ +Dimensions? 3 x 10 +[[7 7 7 7 7 7 7 7 7 7] [7 7 7 7 7 42 7 7 7 7] [7 7 7 7 7 7 7 7 7 7]] diff --git a/Task/Create-a-two-dimensional-array-at-runtime/PowerShell/create-a-two-dimensional-array-at-runtime-1.psh b/Task/Create-a-two-dimensional-array-at-runtime/PowerShell/create-a-two-dimensional-array-at-runtime-1.psh new file mode 100644 index 0000000000..533ef37692 --- /dev/null +++ b/Task/Create-a-two-dimensional-array-at-runtime/PowerShell/create-a-two-dimensional-array-at-runtime-1.psh @@ -0,0 +1,22 @@ +function Read-ArrayIndex ([string]$Prompt = "Enter an integer greater than zero") +{ + [int]$inputAsInteger = 0 + + while (-not [Int]::TryParse(([string]$inputString = Read-Host $Prompt), [ref]$inputAsInteger)) + { + $inputString = Read-Host "Enter an integer greater than zero" + } + + if ($inputAsInteger -gt 0) {return $inputAsInteger} else {return 1} +} + +$x = $y = $null + +do +{ + if ($x -eq $null) {$x = Read-ArrayIndex -Prompt "Enter two dimensional array index X"} + if ($y -eq $null) {$y = Read-ArrayIndex -Prompt "Enter two dimensional array index Y"} +} +until (($x -ne $null) -and ($y -ne $null)) + +$array2d = New-Object -TypeName 'System.Object[,]' -ArgumentList $x, $y diff --git a/Task/Create-a-two-dimensional-array-at-runtime/PowerShell/create-a-two-dimensional-array-at-runtime-2.psh b/Task/Create-a-two-dimensional-array-at-runtime/PowerShell/create-a-two-dimensional-array-at-runtime-2.psh new file mode 100644 index 0000000000..62a06feb59 --- /dev/null +++ b/Task/Create-a-two-dimensional-array-at-runtime/PowerShell/create-a-two-dimensional-array-at-runtime-2.psh @@ -0,0 +1,6 @@ +[int]$k = 1 + +for ($i = 0; $i -lt 6; $i++) +{ + 0..5 | ForEach-Object -Begin {$k += 10} -Process {$array2d[$i,$_] = $k + $_} +} diff --git a/Task/Create-a-two-dimensional-array-at-runtime/PowerShell/create-a-two-dimensional-array-at-runtime-3.psh b/Task/Create-a-two-dimensional-array-at-runtime/PowerShell/create-a-two-dimensional-array-at-runtime-3.psh new file mode 100644 index 0000000000..3ac520bb6b --- /dev/null +++ b/Task/Create-a-two-dimensional-array-at-runtime/PowerShell/create-a-two-dimensional-array-at-runtime-3.psh @@ -0,0 +1,4 @@ +for ($i = 0; $i -lt 6; $i++) +{ + "{0}`t{1}`t{2}`t{3}`t{4}`t{5}" -f (0..5 | ForEach-Object {$array2d[$i,$_]}) +} diff --git a/Task/Create-a-two-dimensional-array-at-runtime/PowerShell/create-a-two-dimensional-array-at-runtime-4.psh b/Task/Create-a-two-dimensional-array-at-runtime/PowerShell/create-a-two-dimensional-array-at-runtime-4.psh new file mode 100644 index 0000000000..592b870ff1 --- /dev/null +++ b/Task/Create-a-two-dimensional-array-at-runtime/PowerShell/create-a-two-dimensional-array-at-runtime-4.psh @@ -0,0 +1 @@ +$array2d[2,2] diff --git a/Task/Create-an-HTML-table/00DESCRIPTION b/Task/Create-an-HTML-table/00DESCRIPTION index 9d4e1386e2..f5a8d300ed 100644 --- a/Task/Create-an-HTML-table/00DESCRIPTION +++ b/Task/Create-an-HTML-table/00DESCRIPTION @@ -4,3 +4,4 @@ Create an HTML table. * An extra column should be added at either the extreme left or the extreme right of the table that has no heading, but is filled with sequential row numbers. * The rows of the "X", "Y", and "Z" columns should be filled with random or sequential integers having 4 digits or less. * The numbers should be aligned in the same fashion for all columns. +

    diff --git a/Task/Create-an-HTML-table/ALGOL-68/create-an-html-table.alg b/Task/Create-an-HTML-table/ALGOL-68/create-an-html-table.alg new file mode 100644 index 0000000000..5ec7be798a --- /dev/null +++ b/Task/Create-an-HTML-table/ALGOL-68/create-an-html-table.alg @@ -0,0 +1,78 @@ +INT not numbered = 0; # possible values for HTMLTABLE row numbering # +INT numbered left = 1; # " " " " " " # +INT numbered right = 2; # " " " " " " # + +INT align centre = 0; # possible values for HTMLTABLE column alignment # +INT align left = 1; # " " " " " " # +INT align right = 2; # " " " " " " # + +# allowable content for the HTML table - extend the UNION and TOSTRING # +# operator to add additional modes # +MODE HTMLTABLEDATA = UNION( INT, REAL, STRING ); +OP TOSTRING = ( HTMLTABLEDATA content )STRING: + CASE content + IN ( INT i ): whole( i, 0 ) + , ( REAL r ): fixed( r, 0, 0 ) + , ( STRING s ): s + OUT "Unsupported HTMLTABLEDATA content" + ESAC; +# MODE to hold an html table # +MODE HTMLTABLE = STRUCT( FLEX[ 0 ]STRING headings + , FLEX[ 0, 0 ]HTMLTABLEDATA data + , INT row numbering + , INT column alignment + , INT cell spacing + , INT col spacing + , INT border + ); +# write an html table to a file # +PROC write html table = ( REF FILE f, HTMLTABLE t )VOID: +BEGIN + STRING align = "align=""" + + CASE column alignment OF t IN "left", "right" OUT "center" ESAC + + """"; + PROC th element = ( REF FILE f, HTMLTABLE t, STRING content )VOID: + put( f, ( "" + content + "", newline ) ); + PROC td element = ( REF FILE f, HTMLTABLE t, HTMLTABLEDATA content )VOID: + put( f, ( "" + TOSTRING content + "", newline ) ); + + # table element # + put( f, ( "" + , newline + ) + ); + # table headings # + put( f, ( "", newline ) ); + IF row numbering OF t = numbered left THEN th element( f, t, "" ) FI; + FOR col FROM LWB headings OF t TO UPB headings OF t DO + th element( f, t, ( headings OF t )[ col ] ) + OD; + IF row numbering OF t = numbered right THEN th element( f, t, "" ) FI; + put( f, ( "", newline ) ); + # table rows # + FOR row FROM 1 LWB data OF t TO 1 UPB data OF t DO + put( f, ( "", newline ) ); + IF row numbering OF t = numbered left THEN th element( f, t, whole( row, 0 ) ) FI; + FOR col FROM 2 LWB data OF t TO 2 UPB data OF t DO + td element( f, t, ( data OF t )[ row, col ] ) + OD; + IF row numbering OF t = numbered right THEN th element( f, t, whole( row, 0 ) ) FI; + put( f, ( "", newline ) ) + OD; + # end of table # + put( f, ( "", newline ) ) +END # write html table # ; + +# create an HTMLTABLE and print it to standard output # +HTMLTABLE t; +cell spacing OF t := col spacing OF t := 0; +border OF t := 1; +column alignment OF t := align right; +row numbering OF t := numbered left; +headings OF t := ( "A", "B", "C" ); +data OF t := ( ( 1001, 1002, 1003 ), ( 21, 22, 23 ), ( 201, 202, 203 ) ); +write html table( stand out, t ) diff --git a/Task/Create-an-HTML-table/AWK/create-an-html-table.awk b/Task/Create-an-HTML-table/AWK/create-an-html-table.awk new file mode 100644 index 0000000000..6cb7bdde87 --- /dev/null +++ b/Task/Create-an-HTML-table/AWK/create-an-html-table.awk @@ -0,0 +1,9 @@ +#!/usr/bin/awk -f +BEGIN { + print "\n " + printf " \n \n \n" + for (i=1; i<=10; i++) { + printf " \n",i, 10*i, 100*i, 1000*i-1 + } + print " \n
    XYZ
    %2i%5i%5i%5i
    \n" +} diff --git a/Task/Create-an-HTML-table/Agena/create-an-html-table.agena b/Task/Create-an-HTML-table/Agena/create-an-html-table.agena new file mode 100644 index 0000000000..c2a10b2e2b --- /dev/null +++ b/Task/Create-an-HTML-table/Agena/create-an-html-table.agena @@ -0,0 +1,55 @@ +notNumbered := 0; # possible values for html table row numbering +numberedLeft := 1; # " " " " " " " +numberedRight := 2; # " " " " " " " + +alignCentre := 0; # possible values for html table column alignment +alignLeft := 1; # " " " " " " " +alignRight := 2; # " " " " " " " + +# write an html table to a file +writeHtmlTable := proc( fh, t :: table ) is + local align := "align='"; + case t.columnAlignment + of alignLeft then align := align & "left'" + of alignRight then align := align & "right'" + else align := align & "center'" + esac; + local put := proc( text :: string ) is io.write( fh, text & "\n" ) end; + local thElement := proc( content :: string ) is put( "" & content & "" ) end; + local tdElement := proc( content ) is put( "" & content & "" ) end; + # table element + put( "" + ); + # table headings + put( "" ); + if t.rowNumbering = numberedLeft then thElement( "" ) fi; + for col to size t.headings do thElement( t.headings[ col ] ) od; + if t.rowNumbering = numberedRight then thElement( "" ) fi; + put( "" ); + # table rows + for row to size t.data do + put( "" ); + if t.rowNumbering = numberedLeft then thElement( row & "" ) fi; + for col to size t.data[ row ] do tdElement( t.data[ row, col ] ) od; + if t.rowNumbering = numberedRight then thElement( row & "" ) fi; + put( "" ) + od; + # end of table + put( "" ) +end ; + +# create an html table and print it to standard output +scope + local t := []; + t.cellSpacing, t.colSpacing := 0, 0; + t.border := 1; + t.columnAlignment := alignRight; + t.rowNumbering := numberedLeft; + t.headings := [ "A", "B", "C" ]; + t.data := [ [ 1001, 1002, 1003 ], [ 21, 22, 23 ], [ 201, 202, 203 ] ]; + writeHtmlTable( io.stdout, t ) +epocs diff --git a/Task/Create-an-HTML-table/Forth/create-an-html-table.fth b/Task/Create-an-HTML-table/Forth/create-an-html-table.fth new file mode 100644 index 0000000000..c999e012ee --- /dev/null +++ b/Task/Create-an-HTML-table/Forth/create-an-html-table.fth @@ -0,0 +1,65 @@ +include random.hsf + +\ parser routines +: totag + [char] < PARSE pad place \ parse input up to '<' char + -1 >in +! \ move the interpreter pointer back 1 char + pad count type ; + +: '"' [char] " emit ; +: '"..' '"' space ; \ output a quote char with trailing space + +: toquote \ parse input to " then print as quoted text + '"' [char] " PARSE pad place + pad count type '"..' ; + +: > [char] > emit space ; \ output the '>' with trailing space + +\ Create some HTML extensions to the Forth interpreter +: ."
    " cr ; :
    ." " cr ; +: " cr ; : ." " cr ; +: ." " cr ; +: " ; : ." " ; +: ." " cr ; +: " ; +: ." " cr ; + +\ Write the source code that generates HTML in our EXTENDED FORTH +cr +
    ." " totag ; : ."
    ." " ; : ."
    cr ." " totag ; :
    + + + + + + + + + + + + + + + + + + + + + + + + + +
    This table was created with FORTH HTML tags
    ." A" ." B" ." C"
    1 . 1000 RND . 1000 RND . 1000 RND .
    2 . 1000 RND . 1000 RND . 1000 RND .
    3 . 1000 RND . 1000 RND . 1000 RND .
    diff --git a/Task/Create-an-HTML-table/Fortran/create-an-html-table.f b/Task/Create-an-HTML-table/Fortran/create-an-html-table.f new file mode 100644 index 0000000000..2cbedd59da --- /dev/null +++ b/Task/Create-an-HTML-table/Fortran/create-an-html-table.f @@ -0,0 +1,490 @@ + MODULE PARAMETERS !Assorted oddities that assorted routines pick and choose from. + CHARACTER*5 I AM !Assuage finicky compilers. + PARAMETER (IAM = "Gnash") !I AM! + INTEGER LUSERCODE !One day, I'll get around to devising some string protocol. + CHARACTER*28 USERCODE !I'm not too sure how long this can be. + DATA USERCODE,LUSERCODE/"",0/!Especially before I have a text. + END MODULE PARAMETERS + + MODULE ASSISTANCE + CONTAINS !Assorted routines that seem to be of general use but don't seem worth isolating.. + Subroutine Croak(Gasp) !A dying message, when horror is suddenly encountered. +Casts out some final words and STOP, relying on the SubInOut stuff to have been used. +Cut down from the full version of April MMI, that employed the SubIN and SubOUT protocol.. + Character*(*) Gasp !The last gasp. + COMMON KBD,MSG + WRITE (MSG,1) GASP + 1 FORMAT ("Oh dear! ",A) + STOP "I STOP now. Farewell..." !Whatever pit I was in, I'm gone. + End Subroutine Croak !That's it. + + INTEGER FUNCTION LSTNB(TEXT) !Sigh. Last Not Blank. +Concocted yet again by R.N.McLean (whom God preserve) December MM. +Code checking reveals that the Compaq compiler generates a copy of the string and then finds the length of that when using the latter-day intrinsic LEN_TRIM. Madness! +Can't DO WHILE (L.GT.0 .AND. TEXT(L:L).LE.' ') !Control chars. regarded as spaces. +Curse the morons who think it good that the compiler MIGHT evaluate logical expressions fully. +Crude GO TO rather than a DO-loop, because compilers use a loop counter as well as updating the index variable. +Comparison runs of GNASH showed a saving of ~3% in its mass-data reading through the avoidance of DO in LSTNB alone. +Crappy code for character comparison of varying lengths is avoided by using ICHAR which is for single characters only. +Checking the indexing of CHARACTER variables for bounds evoked astounding stupidities, such as calculating the length of TEXT(L:L) by subtracting L from L! +Comparison runs of GNASH showed a saving of ~25-30% in its mass data scanning for this, involving all its two-dozen or so single-character comparisons, not just in LSTNB. + CHARACTER*(*),INTENT(IN):: TEXT !The bumf. If there must be copy-in, at least there need not be copy back. + INTEGER L !The length of the bumf. + L = LEN(TEXT) !So, what is it? + 1 IF (L.LE.0) GO TO 2 !Are we there yet? + IF (ICHAR(TEXT(L:L)).GT.ICHAR(" ")) GO TO 2 !Control chars are regarded as spaces also. + L = L - 1 !Step back one. + GO TO 1 !And try again. + 2 LSTNB = L !The last non-blank, possibly zero. + RETURN !Unsafe to use LSTNB as a variable. + END FUNCTION LSTNB !Compilers can bungle it. + CHARACTER*2 FUNCTION I2FMT(N) !These are all the same. + INTEGER*4 N !But, the compiler doesn't offer generalisations. + IF (N.LT.0) THEN !Negative numbers cop a sign. + IF (N.LT.-9) THEN !But there's not much room left. + I2FMT = "-!" !So this means 'overflow'. + ELSE !Otherwise, room for one negative digit. + I2FMT = "-"//CHAR(ICHAR("0") - N) !Thus. Presume adjacent character codes, etc. + END IF !So much for negative numbers. + ELSE IF (N.LT.10) THEN !Single digit positive? + I2FMT = " " //CHAR(ICHAR("0") + N) !Yes. This. + ELSE IF (N.LT.100) THEN !Two digit positive? + I2FMT = CHAR(N/10 + ICHAR("0")) !Yes. + 1 //CHAR(MOD(N,10) + ICHAR("0")) !These. + ELSE !Otherwise, + I2FMT = "+!" !Positive overflow. + END IF !So much for that. + END FUNCTION I2FMT !No WRITE and FORMAT unlimbering. + CHARACTER*8 FUNCTION I8FMT(N) !Oh for proper strings. + INTEGER*4 N + CHARACTER*8 HIC + WRITE (HIC,1) N + 1 FORMAT (I8) + I8FMT = HIC + END FUNCTION I8FMT + CHARACTER*42 FUNCTION ERRORWORDS(IT) !Look for an explanation. One day, the system may offer coherent messages. +Curious collection of encountered codes. Will they differ on other systems? +Compaq's compiler was taken over by unintel; http://software.intel.com/sites/products/documentation/hpc/compilerpro/en-us/fortran/lin/compiler_f/bldaps_for/common/bldaps_rterrs.htm +contains a schedule of error numbers that matched those I'd found for Compaq, and so some assumptions are added. +Copying all (hundreds!) is excessive; these seem possible for the usage so far made of error diversion. +Compaq's compiler interface ("visual" blah) has a help offering, which can provide error code information. +Compaq messages also appear in http://cens.ioc.ee/local/man/CompaqCompilers/cf/dfuum028.htm#tab_runtime_errors +Combines IOSTAT codes (file open, read etc) with STAT codes (allocate/deallocate) as their numbers are distinct. +Completeness and context remains a problem. Excess brevity means cause and effect can be confused. + INTEGER IT !The error code in question. + INTEGER LASTKNOWN !Some codes I know about. + PARAMETER (LASTKNOWN = 26) !But only a few, discovered by experiment and mishap. + TYPE HINT !For them, I can supply a table. + INTEGER CODE !The code number. (But, different systems..??) + CHARACTER*42 EXPLICATION !An explanation. Will it be the answer? + END TYPE HINT !Simple enough. + TYPE(HINT) ERROR(LASTKNOWN) !So, let's have a collection. + PARAMETER (ERROR = (/ !With these values. + 1 HINT(-1,"End-of-file at the start of reading!"), !From examples supplied with the Compaq compiler involving IOSTAT. + 2 HINT( 0,"No worries."), !Apparently the only standard value. + 3 HINT( 9,"Permissions - read only?"), + 4 HINT(10,"File already exists!"), + 5 HINT(17,"Syntax error in NameList input."), + 6 HINT(18,"Too many values for the recipient."), + 7 HINT(19,"Invalid naming of a variable."), + 8 HINT(24,"Surprise end-of-file during read!"), !From example source. + 9 HINT(25,"Invalid record number!"), + o HINT(29,"File name not found."), + 1 HINT(30,"Unavailable - exclusive use?"), + 2 HINT(32,"Invalid fileunit number!"), + 3 HINT(35,"'Binary' form usage is rejected."), !From example source. + 4 HINT(36,"Record number for a non-existing record!"), + 5 HINT(37,"No record length has been specified."), + 6 HINT(38,"I/O error during a write!"), + 7 HINT(39,"I/O error during a read!"), + 8 HINT(41,"Insufficient memory available!"), + 9 HINT(43,"Malformed file name."), + o HINT(47,"Attempting a write, but read-only is set."), + 1 HINT(66,"Output overflows single record size."), !This one from experience. + 2 HINT(67,"Input demand exceeds single record size."), !These two are for unformatted I/O. + 3 HINT(151,"Can't allocate: already allocated!"), !These different numbers are for memory allocation failures. + 4 HINT(153,"Can't deallocate: not allocated!"), + 5 HINT(173,"The fingered item was not allocated!"), !Such as an ordinary array that was not allocated. + 6 HINT(179,"Size exceeds addressable memory!")/)) + INTEGER I !A stepper. + DO I = LASTKNOWN,1,-1 !So, step through the known codes. + IF (IT .EQ. ERROR(I).CODE) GO TO 1 !This one? + END DO !On to the next. + 1 IF (I.LE.0) THEN !Fail with I = 0. + ERRORWORDS = I8FMT(IT)//" is a novel code!" !Reveal the mysterious number. + ELSE !But otherwise, it is found. + ERRORWORDS = ERROR(I).EXPLICATION !And these words might even apply. + END IF !But on all systems? + END FUNCTION ERRORWORDS !Hopefully, helpful. + END MODULE ASSISTANCE + + MODULE LOGORRHOEA + CONTAINS + SUBROUTINE ECART(TEXT) !Produces trace output with many auxiliary details. + CHARACTER*(*) TEXT !The text to be annotated. + COMMON KBD,MSG !I/O units. + WRITE (MSG,1) TEXT !Just roll the text. + 1 FORMAT ("Trace: ",A) !Lacks the names of the invoking routine, and that which invoked it. + END SUBROUTINE ECART + SUBROUTINE WRITE(OUT,TEXT,ON) !We get here in the end. Cast forth some pearls. +C Once upon a time, there was just confusion between ASCII and EBCDIC character codes and glyphs, +c after many variant collections caused annoyance. Now I see that modern computing has introduced +c many new variations, so that one text editor may display glyphs differing from those displayed +c by another editor and also different from those displayed when a programme writes to the screen +c in "teletype" mode, which is to say, employing the character/glyph combination of the moment. +c And in particular, decimal points and degree symbols differ and annoyance has grown. +c So, on re-arranging SAY to not send output to multiple distinations depending on the value of OUT, +c except for the special output to MSG that is echoed to TRAIL, it became less messy to make an assault +c on the text that goes to MSG, but after it was sent to TRAIL. I would have preferred to fiddle the +c "code page" for text output that determines what glyph to show for which code, but not only +c is it unclear how to do this, even if facilities were available, I suspect that the screen display +c software only loads the mysterious code page during startup. +c This fiddling means that any write to MSG should be done last, and writes of text literals +c should not include characters that will be fiddled, as text literals may be protected against change. +C Somewhere along the way, the cent character (¢) has disappeared. Perhaps it will return in "unicode". + USE ASSISTANCE !But might still have difficulty. + INTEGER OUT !The destination. + CHARACTER*(*) TEXT !The message. Possibly damaged. Any trailing spaces will be sent forth. + LOGICAL ON !Whether to terminate the line... TRUE sez that someone will be carrying on. + INTEGER IOSTAT !Furrytran gibberish. +c INCLUDE "cIOUnits.for" !I/O unit numbers. + COMMON KBD,MSG +c INTEGER*2,SAVE:: I Be !Self-identification. +c CALL SUBIN("Write",I Be) !Hullo! + IF (OUT.LE.0) GO TO 999 !Goodbye? +c IF (IOGOOD(OUT)) THEN !Is this one in good heart? +c IF (IOCOUNT(OUT).LE.0 .AND. OUT.NE.MSG) THEN !Is it attached to a file? +c IF (IONAME(OUT).EQ."") IONAME(OUT) = "Anome" !"No name". +c 1 //I2FMT(OUT)//".txt" !Clutch at straws. +c IF (.NOT.OPEN(OUT,IONAME(OUT),"REPLACE","WRITE")) THEN !Just in time? +c IOGOOD(OUT) = .FALSE. !No! Strangle further usage. +c GO TO 999 !Can't write, so give up! +c END IF !It might be better to hit the WRITE and fail. +c END IF !We should be ready now. +c IF (OUT.EQ.MSG .AND. SCRAGTEXTOUT) CALL SCRAG(TEXT) !Output to the screen is recoded for the screen. + IF (ON) THEN !Now for the actual output at last. This is annoying. + WRITE (OUT,1,ERR = 666,IOSTAT = IOSTAT) TEXT !Splurt. + 1 FORMAT (A,$) !Don't move on to a new line. (The "$"! Is it not obvious?) +c IOPART(OUT) = IOPART(OUT) + 1 !Thus count a part-line in case someone fusses. + ELSE !But mostly, write and advance. + WRITE (OUT,2,ERR = 666,IOSTAT = IOSTAT) TEXT !Splurt. + 2 FORMAT (A) !*-style "free" format chops at 80 or some such. + END IF !So much for last-moment dithering. +c IOCOUNT(OUT) = IOCOUNT(OUT) + 1 !Count another write (whole or part) so as to be not zero.. +c END IF !So much for active passages. +c 999 CALL SUBOUT("Write") !I am closing. + 999 RETURN !Done. +Confusions. + 666 IF (OUT.NE.MSG) CALL CROAK("Can't write to unit "//I2FMT(OUT) !Why not? +c 1 //" (file "//IONAME(OUT)(1:LSTNB(IONAME(OUT))) !Possibly, no more disc space! In which case, this may fail also! + 2 //") message "//ERRORWORDS(IOSTAT) !Hopefully, helpful. + 3 //" length "//I8FMT(LEN(TEXT))//", this: "//TEXT) !The instigation. + STOP "Constipation!" !Just so. + END SUBROUTINE WRITE !The moving hand having writ, moves on. + + SUBROUTINE SAY(OUT,TEXT) !And maybe a copy to the trail file as well. + USE PARAMETERS !Odds and ends. + USE ASSISTANCE !Just a little. + INTEGER OUT !The orifice. + CHARACTER*(*) TEXT !The blather. Can be modified if to MSG and certain characters are found. + CHARACTER*120 IS !For a snatched question. + INTEGER L !A finger. +c INCLUDE "cIOUnits.for" !I/O unit numbers. + COMMON KBD,MSG +c INTEGER*2,SAVE:: I Be !Self-identification. +c CALL SUBIN("Say",I Be) !Me do be Me, I say! +Chop off trailing spaces. + L = LEN(TEXT) !What I say may be rather brief. + 1 IF (L.GT.0) THEN !So, is there a last character to look at? + IF (ICHAR(TEXT(L:L)).LE.ICHAR(" ")) THEN !Yes. Is it boring? + L = L - 1 !Yes! Trim it! + GO TO 1 !And check afresh. + END IF !A DO-loop has overhead with its iteration count as well. + END IF !Function LEN_TRIM copies the text first!! +Contemplate the disposition of TEXT(1:L) +c IF (OUT.NE.MSG) THEN !Normal stuff? + CALL WRITE(OUT,TEXT(1:L),.FALSE.) !Roll. +c ELSE !Echo what goes to MSG to the TRAIL file. +c CALL WRITE(TRAIL,TEXT(1:L),.FALSE.) !Thus. +c CALL WRITE( MSG,TEXT(1:L),.FALSE.) !Splot to the screen. +c IF (.NOT.BLABBERMOUTH) THEN !Do we know restraint? +c IF (IOCOUNT(MSG).GT.BURP) THEN !Yes. Consider it. +c WRITE (MSG,100) IOCOUNT(MSG) !Alas, triggered. So remark on quantity, +c 100 FORMAT (//I9," lines! Your spirit might flag." !Hint. (Not copied to the TRAIL file) +c 1 /," Type quit to set GIVEOVER to TRUE, with hope for " +c 2 ,"a speedy palliation,", +c 3 /," or QUIT to abandon everything, here, now", +c 4 /," or blabber to abandon further restraint,", +c 5 /," or anything else to carry on:") +c IS = REPLY("QUIT, quit, blabber or continue") !And ask. +c IF (IS.EQ."QUIT") CALL CROAK("Enough of this!") !No UPDATE, nothing. +c CALL UPCASE(IS) !Now we're past the nice distinction, simplify. +c IF (IS.EQ."QUIT") GIVEOVER = .TRUE. !Signal to those who listen. +c IF (IS.EQ."BLABBER") BLABBERMOUTH = .TRUE. !Well? +c IF (GIVEOVER) WRITE (MSG,101) !Announce hope. +c 101 FORMAT ("Let's hope that the babbler notices...") !Like, IF (GIVEOVER) GO TO ... +c IF (.NOT.GIVEOVER) WRITE (MSG,102) !Alternatively, firm resolve. +c 102 FORMAT("Onwards with renewed vigour!") !Fight the good fight. +c BURP = IOCOUNT(MSG) + ENOUGH !The next pause to come. +c END IF !So much for last-moment restraint. +c END IF !So much for restraint. +c END IF !So much for selection. +c CALL SUBOUT("Say") !I am merely the messenger. + END SUBROUTINE SAY !Enough said. + SUBROUTINE SAYON(OUT,TEXT) !Roll to the screen and to the trail file as well. +C This differs by not ending the line so that further output can be appended to it. + USE ASSISTANCE + INTEGER OUT !The orifice. + CHARACTER*(*) TEXT !The blather. + INTEGER L !A finger. +c INCLUDE "cIOUnits.for" !I/O unit numbers. + COMMON KBD,MSG +c INTEGER*2,SAVE:: I Be !Self-identification. +c CALL SUBIN("SayOn",I Be) !Me do be another. Me, I say on! + L = LEN(TEXT) !How much say I on? + 1 IF (L.GT.0) THEN !I say on anything? + IF (ICHAR(TEXT(L:L)).LE.ICHAR(" ")) THEN !I end it spaceish? + L = L - 1 !Yes. Trim such. + GO TO 1 !And look afresh. + END IF !So much for trailing off. + END IF !Continue with L fingering the last non-blank. +c IF (OUT.EQ.MSG) CALL WRITE(TRAIL,TEXT(1:L),.TRUE.) !Writes to the screen go also to the TRAIL. + CALL WRITE( OUT,TEXT(1:L),.TRUE.) !It is said, and more is expected. +c CALL SUBOUT("SayOn") !I am merely the messenger. + END SUBROUTINE SAYON !And further messages impend. + + END MODULE LOGORRHOEA + + MODULE HTMLSTUFF !Assists with the production of decorated output. +Can't say I think much of the scheme. How about <+blah> ... <-blah> rather than the assymetric ... ? +Cack-handed comment format as well... + USE PARAMETERS !To ascertain who I AM. + USE ASSISTANCE !To get at LSTNB. + USE LOGORRHOEA !To get at SAYON and SAY. + INTEGER INDEEP,HOLE !I keep track of some details. + PRIVATE INDEEP,HOLE !Amongst myselves. + DATA INDEEP,HOLE/0,0/ !Initially, I'm not doing anything. +Choose amongst output formats. + INTEGER LASTFILETYPENAME !Certain file types are recognised. + PARAMETER (LASTFILETYPENAME = 2) !Thus, three options. + INTEGER OUTTYPE,OUTTXT,OUTCSV,OUTHTML !The recognition. + CHARACTER*5 OUTSTYLE,FILETYPENAME(0:LASTFILETYPENAME) !Via the tail end of a file name. + PARAMETER (FILETYPENAME = (/".txt",".CSV",".HTML"/)) !Thusly. Note that WHATFILETYPE will not recognise ".txt" directly. + PARAMETER (OUTTXT = 0,OUTCSV = 1,OUTHTML = 2) !Mnemonics. + DATA OUTSTYLE/""/ !So OUTTYPE = OUTTXT. But if an output file is specified, its file type will be inspected. + TYPE HTMLMNEMONIC !I might as well get systematic, as these are global names. + CHARACTER* 9 COMMAH !This looks like a comma + CHARACTER* 9 COMMAD !And in another context, so does this. + CHARACTER* 6 SPACE !Some spaces are to be atomic. + CHARACTER*18 RED !Decoration and + CHARACTER* 7 DER !noitaroceD. + END TYPE HTMLMNEMONIC !That's enough for now. + TYPE(HTMLMNEMONIC) HTMLA !I'll have one set, please. + PARAMETER (HTMLA = HTMLMNEMONIC( !With these values. + 1 "", !But .html has its variants. For a heading. + 2 "", !For a table datum. + 3 " ", !A space that is not to be split. + 4 '', !Dabble in decoration. + 5 '')) !Grrrr. A font is for baptismal water. + CONTAINS !Mysterious assistants. + SUBROUTINE HTML(TEXT) !Rolls some text, with suitable indentation. + CHARACTER*(*) TEXT !The text. +c INCLUDE "cIOUnits.for" !I/O unit numbers. + IF (LEN(TEXT).LE.0) RETURN !Possibly boring. + IF (INDEEP.GT.0) THEN !Some indenting desired? + CALL WRITE(HOLE,REPEAT(" ",INDEEP),.TRUE.) !Yep. SAYON trims trailing spaces. +c IF (HOLE.EQ.MSG) CALL WRITE(TRAIL,REPEAT(" ",INDEEP),.TRUE.) !So I must copy. + END IF !Enough indenting. + CALL SAY(HOLE,TEXT) !Say the piece and end the line. + END SUBROUTINE HTML !Maintain stacks? Check entry/exit matching? + + SUBROUTINE HTML3(HEAD,BUMF,TAIL) !Rolls some text, with suitable indentation. +Checks the BUMF for decimal points only. HTMLALINE handles text to HTML for troublesome characters, replacing them with special names for the desired glyph. +Confusion might arise, if & is in BUMF and is not to be converted. "&" vs "&so on"; similar worries with < and >. + CHARACTER*(*) HEAD !If not "", the start of the line, with indentation supplied. + CHARACTER*(*) BUMF !The main body of the text. + CHARACTER*(*) TAIL !If not "", this is for the end of the line. + INTEGER LB,L1,L2 !A length and some fingers for scanning. + CHARACTER*1 MUMBLE !These symbols may not be presented properly. + CHARACTER*8 MUTTER !But these encodements may be interpreted as desired. + PARAMETER (MUMBLE = "·") !I want certain glyphs, but encodement varies. + PARAMETER (MUTTER = "·") !As does recognition. +c INCLUDE "cIOUnits.for" !I/O unit numbers. + COMMON KBD,MSG +Commence with a new line? + IF (HEAD.NE."") THEN !Is a line to be started? (Spaces are equivalent to "" as well) + IF (INDEEP.GT.0) THEN !Some indentation is good. + CALL WRITE(HOLE,REPEAT(" ",INDEEP),.TRUE.) !Yep. SAYON trims trailing spaces. +c IF (HOLE.EQ.MSG) CALL WRITE(TRAIL, !So I must copy for the log. +c 1 REPEAT(" ",INDEEP),.TRUE.) !Hopefully, not generated a second time. + ELSE !The accountancy may be bungled. + CALL ECART("HTML huh? InDeep="//I8FMT(INDEEP)) !So, complain. + END IF !Also, REPEAT has misbehaved. + CALL SAYON(HOLE,HEAD) !Thus a suitable indentation. + END IF !So much for a starter. +Cast forth the bumf. Any trailing spaces will be dropped by SAYON. + LB = LEN(BUMF) !How much bumf? Trailing spaces will be rolled. + L1 = 1 !Waiting to be sent. + L2 = 0 !Syncopation. + 1 L2 = L2 + 1 !Advance to the next character to be inspected.. + IF (L2.GT.LB) GO TO 2 !Is there another? + IF (ICHAR(BUMF(L2:L2)).NE.ICHAR(MUMBLE)) GO TO 1 !Yes. Advance through the untroublesome. + IF (L1.LT.L2) THEN !A hit. Have any untroubled ones been passed? + CALL WRITE(HOLE,BUMF(L1:L2 - 1),.TRUE.) !Yes. Send them forth. +c IF (HOLE.EQ.MSG) CALL WRITE(TRAIL,BUMF(L1:L2 - 1),.TRUE.) !With any trailing spaces included. + END IF !Now to do something in place of BUMF(L2) + L1 = L2 + 1 !Moving the marker past it, like. + CALL SAYON(HOLE,MUTTER) !The replacement for BUMF(L2 as was). + GO TO 1 !Continue scanning. + 2 IF (L2.GT.L1) THEN !Any tail end, but not ending the output line. + CALL WRITE(HOLE,BUMF(L1:L2 - 1),.TRUE.) !Yes. Away it goes. +c IF (HOLE.EQ.MSG) CALL WRITE(TRAIL,BUMF(L1:L2 - 1),.TRUE.) !And logged. + END IF !So much for the bumf. +Consider ending the line. + 3 IF (TAIL.NE."") CALL SAY(HOLE,TAIL) !Enough! + END SUBROUTINE HTML3 !Maintain stacks? Check entry/exit matching? + + SUBROUTINE HTMLSTART(OUT,TITLE,DESC) !Roll forth some gibberish. + INTEGER OUT !The mouthpiece, mentioned once only at the start, and remembered for future use. + CHARACTER*(*) TITLE !This should be brief. + CHARACTER*(*) DESC !This a little less brief. + CHARACTER*(*) METAH !Some repetition. + PARAMETER (METAH = '') !Endless blather. + CALL HTML('') ! H E R E W E G O ! + INDEEP = 1 !Its content. + CALL HTML("") !And the first decoration begins. + INDEEP = 2 !Its content. + CALL HTML(""//I AM//" " !This appears in the web page tag. + 1 // TITLE(1:LSTNB(TITLE)) //"")!So it should be short. + CALL HTML('') !But said to be worthy. + CALL HTML(METAH//'Description" Content="'//DESC//'">') !Hopefully, helpful. + CALL HTML(METAH//'Generator" Content="'//I AM//'">') !I said. + CALL DATE_AND_TIME(DATE = D,TIME = T) !Not assignments, but attachments. + CALL HTML(METAH//'Created" Content="' !Convert the timestamp + 1 //D(1:4)//"-"//D(5:6)//"-"//D(7:8) !Into an international standard. + 2 //" "//T(1:2)//":"//T(3:4)//":"//T(5:10)//'">') !For date and time. + IF (LUSERCODE.GT.0) CALL HTML(METAH !Possibly, the user's code is known. + 1 //'Author" Content="'//USERCODE(1:LUSERCODE) !If so, reveal. + 2 //'"> ') !Disclaiming responsibility... + INDEEP = 1 !Finishing the content of the header. + CALL HTML("") !Enough of that. + CALL HTML("") !A fresh line seems polite. + INDEEP = 2 !Its content follows.. + END SUBROUTINE HTMLSTART !Others will follow on. Hopefully, correctly. + SUBROUTINE HTMLSTOP !And hopefully, this will be a good closure. +Could be more sophisticated and track the stack via INDEEP+- and names, to enable a desperate close-off if INDEEP is not 2. + IF (INDEEP.NE.2) CALL ECART("Misclosure! InDeep not 2 but" !But, + 1 //I8FMT(INDEEP)) !It may not be. + INDEEP = 1 !Retreat to the first level. + CALL HTML("") !End the "body". + INDEEP = 0 !Retreat to the start level. + CALL HTML("") !End the whole thing. + END SUBROUTINE HTMLSTOP !Ah... + + SUBROUTINE HTMLTSTART(B,SUMMARY) !Start a table. + INTEGER B !Border thickness. + CHARACTER*(*) SUMMARY !Some well-chosen words. + CALL HTML("') !Not displayed, but potentially used by non-display agencies... + INDEEP = INDEEP + 1 !Another level dug. + END SUBROUTINE HTMLTSTART!That part was easy. + SUBROUTINE HTMLTSTOP !And the ending is easy too. + INDEEP = INDEEP - 1 !Withdraw a level. + CALL HTML("
    ") !Hopefully, aligning. + END SUBROUTINE HTMLTSTOP !The bounds are easy. + + SUBROUTINE HTMLTHEADSTART !Start a table's heading. + CALL HTML("") !Thus. + INDEEP = INDEEP + 1 !Dig deeper. + END SUBROUTINE HTMLTHEADSTART !Content should follow. + SUBROUTINE HTMLTHEADSTOP !And now, enough. + INDEEP = INDEEP - 1 !Retreat a level. + CALL HTML("") !And end the head. + END SUBROUTINE HTMLTHEADSTOP !At the neck of the body? + + SUBROUTINE HTMLTHEAD(N,TEXT) !Cast forth a whole-span table heading. + INTEGER N !The count of columns to be spanned. + CHARACTER*(*) TEXT !A brief description to place there. + CALL HTML3("',"") !Start the specification. + CALL HTML3("",TEXT(1:LSTNB(TEXT)),"") !This text, possibly verbose. + END SUBROUTINE HTMLTHEAD !Thus, all contained on one line. + + SUBROUTINE HTMLTBODYSTART !Start on the table body. + CALL HTML(' ') !And I don't think much of the "comment" formalism, either. + INDEEP = INDEEP + 1 !Anyway, we're ready with the alignment. + END SUBROUTINE HTMLTBODYSTART !Others will provide the body. + SUBROUTINE HTMLTBODYSTOP !And, they've had enough. + INDEEP = INDEEP - 1 !So, up out of the hole. + CALL HTML("") !Take a breath. + END SUBROUTINE HTMLTBODYSTOP !And wander off. + SUBROUTINE HTMLTROWTEXT(TEXT,N) !Roll a row of column headings. + CHARACTER*(*) TEXT(:) !The headings. + INTEGER N !Their number. + INTEGER I,L !Assistants. + CALL HTML3("","","") !Start a row of headings-to-come, and don't end the line. + DO I = 1,N !Step through the headings. + L = LSTNB(TEXT(I)) !Trailing spaces are to be ignored. + IF (L.LE.0) THEN !Thus discovering blank texts. + CALL HTML3(""," ","") !This prevents the cell being collapsed. + ELSE !But for those with text, + CALL HTML3("",""//TEXT(I)(1:L)//"","") !Roll it. + END IF !So much for that text. + END DO !On to the next. + CALL HTML3("","","") !Finish the row, and thus the line. + END SUBROUTINE HTMLTROWTEXT !So much for texts. + SUBROUTINE HTMLTROWINTEGER(V,N) !Now for all integers. + INTEGER V(:) !The integers. + INTEGER N !Their number. + INTEGER I !A stepper. + CALL HTML3('',"","") !Start a row of entries. + DO I = 1,N !Work through the row's values. + CALL HTML3("",""//I8FMT(V(I))//"","") !One by one. + END DO !On to the next. + CALL HTML3("","","") !Finish the row, and thus the line. + END SUBROUTINE HTMLTROWINTEGER !All the same type is not troublesome. + END MODULE HTMLSTUFF !Enough already. + + PROGRAM MAKETABLE + USE PARAMETERS + USE ASSISTANCE + USE HTMLSTUFF + INTEGER KBD,MSG + INTEGER NCOLS !The usage of V must conform to this! + PARAMETER (NCOLS = 4) !Specified number of columns. + CHARACTER*3 COLNAME(NCOLS) !And they have names. + PARAMETER (COLNAME = (/"","X","Y","Z"/)) !As specified. + INTEGER V(NCOLS) !A scratchpad for a line's worth. + COMMON KBD,MSG !I/O units. + KBD = 5 !Keyboard. + MSG = 6 !Screen. + CALL GETLOG(USERCODE) !Who has poked me into life? + LUSERCODE = LSTNB(USERCODE) !Ah, text gnashing. + + CALL HTMLSTART(MSG,"Powers","Table of integer powers") !Output to the screen will do. + CALL HTMLTSTART(1,"Successive powers of successive integers") !Start the table. + CALL HTMLTHEADSTART !The table heading. + CALL HTMLTHEAD(NCOLS,"Successive powers") !A full-width heading. + CALL HTMLTROWTEXT(COLNAME,NCOLS) !Headings for each column. + CALL HTMLTHEADSTOP !So much for the heading. + CALL HTMLTBODYSTART !Now for the content. + DO I = 1,10 !This should be enough. + V(1) = I !The unheaded row number. + V(2) = I**2 !Its square. + V(3) = I**3 !Cube. + V(4) = I**4 !Fourth power. + CALL HTMLTROWINTEGER(V,NCOLS) !Show a row's worth.. + END DO !On to the next line. + CALL HTMLTBODYSTOP !No more content. + CALL HTMLTSTOP !End the table. + CALL HTMLSTOP + END diff --git a/Task/Create-an-HTML-table/Lua/create-an-html-table.lua b/Task/Create-an-HTML-table/Lua/create-an-html-table.lua new file mode 100644 index 0000000000..f5b39dad03 --- /dev/null +++ b/Task/Create-an-HTML-table/Lua/create-an-html-table.lua @@ -0,0 +1,24 @@ +function htmlTable (data) + local html = "\n\n\n" + for _, heading in pairs(data[1]) do + html = html .. "" .. "\n" + end + html = html .. "\n" + for row = 2, #data do + html = html .. "\n\n" + for _, field in pairs(data[row]) do + html = html .. "\n" + end + html = html .. "\n" + end + return html .. "
    " .. heading .. "
    " .. row - 1 .. "" .. field .. "
    " +end + +local tableData = { + {"X", "Y", "Z"}, + {"1", "2", "3"}, + {"4", "5", "6"}, + {"7", "8", "9"} +} + +print(htmlTable(tableData)) diff --git a/Task/Create-an-HTML-table/REXX/create-an-html-table.rexx b/Task/Create-an-HTML-table/REXX/create-an-html-table.rexx index a24d204293..d0127223e3 100644 --- a/Task/Create-an-HTML-table/REXX/create-an-html-table.rexx +++ b/Task/Create-an-HTML-table/REXX/create-an-html-table.rexx @@ -1,21 +1,22 @@ -/*REXX program creates an HTML table of five rows and three columns. */ -arg rows .; if rows=='' then rows=5 /*no ROWS specified? Then use default.*/ - cols = 3 /*specify three columns for the table. */ - maxRand = 9999 /*4-digit numbers, allows negative nums*/ -headerInfo = 'X Y Z' /*specifify column header information. */ - oFID = 'a_table.html' /*name of the output file. */ - w = 0 /*number of writes to the output file. */ +/*REXX program creates (and displays) an HTML table of five rows and three columns.*/ +parse arg rows . /*obtain optional argument from the CL.*/ +if rows=='' | rows=="," then rows=5 /*no ROWS specified? Then use default.*/ + cols = 3 /*specify three columns for the table. */ + maxRand = 9999 /*4-digit numbers, allows negative nums*/ +headerInfo = 'X Y Z' /*specifify column header information. */ + oFID = 'a_table.html' /*name of the output file. */ + w = 0 /*number of writes to the output file. */ call wrt "" call wrt "" call wrt "" call wrt "" - do r=0 to rows /* [↓] handle row 0 as being special.*/ - if r==0 then call wrt "" - else call wrt "" + do r=0 to rows /* [↓] handle row 0 as being special.*/ + if r==0 then call wrt "" /*when it's the zeroth row. */ + else call wrt "" /* " " not " " " */ - do c=1 for cols /* [↓] for row 0, add the header info*/ + do c=1 for cols /* [↓] for row 0, add the header info*/ if r==0 then call wrt "" else call wrt "" end /*c*/ @@ -25,7 +26,7 @@ call wrt "
    " r "
    " r "" word(headerInfo,c) "" rnd() "
    " call wrt "" call wrt "" say; say w ' records were written to the output file: ' oFID -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -rnd: return right(random(0,maxRand*2)-maxRand,5) /*REXX doesn't gen neg RANDs.*/ -wrt: call lineout oFID,arg(1); say '══►' arg(1); w=w+1; return /*write.*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +rnd: return right(random(0,maxRand*2)-maxRand,5) /*RANDOM doesn't generate negative ints*/ +wrt: call lineout oFID,arg(1); say '══►' arg(1); w=w+1; return /*write.*/ diff --git a/Task/Create-an-HTML-table/Standard-ML/create-an-html-table.ml b/Task/Create-an-HTML-table/Standard-ML/create-an-html-table.ml new file mode 100644 index 0000000000..9ffc1b1e25 --- /dev/null +++ b/Task/Create-an-HTML-table/Standard-ML/create-an-html-table.ml @@ -0,0 +1,34 @@ +(* + * val mkHtmlTable : ('a list * 'b list) -> ('a -> string * 'b -> string) + * -> (('a * 'b) -> string) -> string + * The int list is list of colums, the function returns the values + * at a given colum and row. + * returns the HTML code of the generated table. + *) +fun mkHtmlTable (columns, rows) (rowToStr, colToStr) values = + let + val text = ref "\n" + in + (* Add headers *) + map (fn colum => text := !text ^ "") columns; + + text := !text ^ "\n"; + (* Add data rows *) + map (fn row => + (* row name *) + (text := !text ^ ""; + (* data *) + map (fn col => text := !text ^ "") columns; + text := !text ^ "\n") + ) rows; + !text ^ "
    " ^ (colToStr colum) ^ "
    " ^ (rowToStr row) ^ "" ^ (values (row, col)) ^ "
    " + end + +fun mkHtmlWithBody (title, body) = "\n\n" ^ title ^ "\n\n\n" ^ body ^ "\n\n\n" + +fun samplePage () = mkHtmlWithBody ("Sample Page", + mkHtmlTable ([1.0,2.0,3.0,4.0,5.0], [1.0,2.0,3.0,4.0]) + (Real.toString, Real.toString) + (fn (a, b) => Real.toString (Math.pow (a, b)))) + +val _ = print (samplePage ()) diff --git a/Task/Create-an-object-at-a-given-address/Pascal/create-an-object-at-a-given-address.pascal b/Task/Create-an-object-at-a-given-address/Pascal/create-an-object-at-a-given-address.pascal new file mode 100644 index 0000000000..deb4a95893 --- /dev/null +++ b/Task/Create-an-object-at-a-given-address/Pascal/create-an-object-at-a-given-address.pascal @@ -0,0 +1,21 @@ +program test; +type + t8Byte = array[0..7] of byte; +var + I : integer; + A : integer absolute I; + K : t8Byte; + L : Int64 absolute K; +begin + I := 0; + A := 255; writeln(I); + I := 4711;writeln(A); + + For i in t8Byte do + Begin + K[i]:=i; + write(i:3,' '); + end; + writeln(#8#32); + writeln(L); +end. diff --git a/Task/Currying/00DESCRIPTION b/Task/Currying/00DESCRIPTION index ce722c3741..77c39cb16d 100644 --- a/Task/Currying/00DESCRIPTION +++ b/Task/Currying/00DESCRIPTION @@ -3,3 +3,4 @@ Create a simple demonstrative example of [[wp:Currying|Currying]] in the specifi Add any historic details as to how the feature made its way into the language. +[[Category:Functions and subroutines]] diff --git a/Task/Currying/AppleScript/currying.applescript b/Task/Currying/AppleScript/currying.applescript new file mode 100644 index 0000000000..35d4f75e61 --- /dev/null +++ b/Task/Currying/AppleScript/currying.applescript @@ -0,0 +1,99 @@ +-- curry :: (Script|Handler) -> Script +on curry(f) + script + on lambda(a) + script + on lambda(b) + lambda(a, b) of mReturn(f) + end lambda + end script + end lambda + end script +end curry + + +-- TESTS + +-- add :: Num -> Num -> Num +on add(a, b) + a + b +end add + +-- product :: Num -> Num -> Num +on product(a, b) + a * b +end product + +-- Test 1. +curry(add) + +--> «script» + + +-- Test 2. +curry(add)'s lambda(2) + +--> «script» + + +-- Test 3. +curry(add)'s lambda(2)'s lambda(3) + +--> 5 + + +-- Test 4. +map(curry(product)'s lambda(7), range(1, 10)) + +--> {7, 14, 21, 28, 35, 42, 49, 56, 63, 70} + + +-- Combined: +{curry(add), ¬ + curry(add)'s lambda(2), ¬ + curry(add)'s lambda(2)'s lambda(3), ¬ + map(curry(product)'s lambda(7), range(1, 10))} + +--> {«script», «script», 5, {7, 14, 21, 28, 35, 42, 49, 56, 63, 70}} + + + +-- GENERIC FUNCTIONS + +-- 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 + +-- 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 + +-- range :: Int -> Int -> [Int] +on range(m, n) + if n < m then + set d to -1 + else + set d to 1 + end if + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range diff --git a/Task/Currying/JavaScript/currying-10.js b/Task/Currying/JavaScript/currying-10.js new file mode 100644 index 0000000000..099c61f85d --- /dev/null +++ b/Task/Currying/JavaScript/currying-10.js @@ -0,0 +1 @@ +[7, 14, 21, 28, 35, 42, 49, 56, 63, 70] diff --git a/Task/Currying/JavaScript/currying-11.js b/Task/Currying/JavaScript/currying-11.js new file mode 100644 index 0000000000..d33849ed1f --- /dev/null +++ b/Task/Currying/JavaScript/currying-11.js @@ -0,0 +1,29 @@ +(() => { + + // (arbitrary arity to fully curried) + // extraCurry :: Function -> Function + let extraCurry = (f, ...args) => { + let intArgs = f.length; + + // Recursive currying + let _curry = (xs, ...arguments) => + xs.length >= intArgs ? ( + f.apply(null, xs) + ) : function () { + return _curry(xs.concat([].slice.apply(arguments))); + }; + + return _curry([].slice.call(args, 1)); + }; + + // TEST + + // product3:: Num -> Num -> Num -> Num + let product3 = (a, b, c) => a * b * c; + + return [1, 2, 3, 4, 5, 6, 7, 8, 9, 10] + .map(extraCurry(product3)(7)(2)) + + // [14, 28, 42, 56, 70, 84, 98, 112, 126, 140] + +})(); diff --git a/Task/Currying/JavaScript/currying-12.js b/Task/Currying/JavaScript/currying-12.js new file mode 100644 index 0000000000..81e953bd3b --- /dev/null +++ b/Task/Currying/JavaScript/currying-12.js @@ -0,0 +1 @@ +[14, 28, 42, 56, 70, 84, 98, 112, 126, 140] diff --git a/Task/Currying/JavaScript/currying-2.js b/Task/Currying/JavaScript/currying-2.js index ad04ebfba7..67641bc875 100644 --- a/Task/Currying/JavaScript/currying-2.js +++ b/Task/Currying/JavaScript/currying-2.js @@ -1 +1,34 @@ -(a,b) => expr_using_a_and_b +(function () { + + // curry :: ((a, b) -> c) -> a -> b -> c + function curry(f) { + return function (a) { + return function (b) { + return f(a, b); + }; + }; + } + + + // TESTS + + // product :: Num -> Num -> Num + function product(a, b) { + return a * b; + } + + // return typeof curry(product); + // --> function + + // return typeof curry(product)(7) + // --> function + + //return typeof curry(product)(7)(9) + // --> number + + return [1, 2, 3, 4, 5, 6, 7, 8, 9, 10] + .map(curry(product)(7)) + + // [7, 14, 21, 28, 35, 42, 49, 56, 63, 70] + +})(); diff --git a/Task/Currying/JavaScript/currying-3.js b/Task/Currying/JavaScript/currying-3.js index 9fc60dfb57..099c61f85d 100644 --- a/Task/Currying/JavaScript/currying-3.js +++ b/Task/Currying/JavaScript/currying-3.js @@ -1 +1 @@ -a => b => expr_using_a_and_b +[7, 14, 21, 28, 35, 42, 49, 56, 63, 70] diff --git a/Task/Currying/JavaScript/currying-4.js b/Task/Currying/JavaScript/currying-4.js index c1058a8a69..a9b4b36886 100644 --- a/Task/Currying/JavaScript/currying-4.js +++ b/Task/Currying/JavaScript/currying-4.js @@ -1,23 +1,34 @@ -let - fix = // This is a variant of the Applicative order Y combinator - f => (f => f(f))(g => f((...a) => g(g)(...a))), - curry = - f => ( - fix( - z => (n,...a) => ( - n>0 - ?b => z(n-1,...a,b) - :f(...a))) - (f.length)), - curryrest = - f => ( - fix( - z => (n,...a) => ( - n>0 - ?b => z(n-1,...a,b) - :(...b) => f(...a,...b))) - (f.length)), - curriedmax=curry(Math.max), - curryrestedmax=curryrest(Math.max); -print(curriedmax(8)(4),curryrestedmax(8)(4)(),curryrestedmax(8)(4)(9,7,2)); -// 8,8,9 +(function () { + + // (arbitrary arity to fully curried) + // extraCurry :: Function -> Function + function extraCurry(f) { + + // Recursive currying + function _curry(xs) { + return xs.length >= intArgs ? ( + f.apply(null, xs) + ) : function () { + return _curry(xs.concat([].slice.apply(arguments))); + }; + } + + var intArgs = f.length; + + return _curry([].slice.call(arguments, 1)); + } + + + // TEST + + // product3:: Num -> Num -> Num -> Num + function product3(a, b, c) { + return a * b * c; + } + + return [1, 2, 3, 4, 5, 6, 7, 8, 9, 10] + .map(extraCurry(product3)(7)(2)) + + // [14, 28, 42, 56, 70, 84, 98, 112, 126, 140] + +})(); diff --git a/Task/Currying/JavaScript/currying-5.js b/Task/Currying/JavaScript/currying-5.js new file mode 100644 index 0000000000..81e953bd3b --- /dev/null +++ b/Task/Currying/JavaScript/currying-5.js @@ -0,0 +1 @@ +[14, 28, 42, 56, 70, 84, 98, 112, 126, 140] diff --git a/Task/Currying/JavaScript/currying-6.js b/Task/Currying/JavaScript/currying-6.js new file mode 100644 index 0000000000..ad04ebfba7 --- /dev/null +++ b/Task/Currying/JavaScript/currying-6.js @@ -0,0 +1 @@ +(a,b) => expr_using_a_and_b diff --git a/Task/Currying/JavaScript/currying-7.js b/Task/Currying/JavaScript/currying-7.js new file mode 100644 index 0000000000..9fc60dfb57 --- /dev/null +++ b/Task/Currying/JavaScript/currying-7.js @@ -0,0 +1 @@ +a => b => expr_using_a_and_b diff --git a/Task/Currying/JavaScript/currying-8.js b/Task/Currying/JavaScript/currying-8.js new file mode 100644 index 0000000000..c1058a8a69 --- /dev/null +++ b/Task/Currying/JavaScript/currying-8.js @@ -0,0 +1,23 @@ +let + fix = // This is a variant of the Applicative order Y combinator + f => (f => f(f))(g => f((...a) => g(g)(...a))), + curry = + f => ( + fix( + z => (n,...a) => ( + n>0 + ?b => z(n-1,...a,b) + :f(...a))) + (f.length)), + curryrest = + f => ( + fix( + z => (n,...a) => ( + n>0 + ?b => z(n-1,...a,b) + :(...b) => f(...a,...b))) + (f.length)), + curriedmax=curry(Math.max), + curryrestedmax=curryrest(Math.max); +print(curriedmax(8)(4),curryrestedmax(8)(4)(),curryrestedmax(8)(4)(9,7,2)); +// 8,8,9 diff --git a/Task/Currying/JavaScript/currying-9.js b/Task/Currying/JavaScript/currying-9.js new file mode 100644 index 0000000000..3b76575862 --- /dev/null +++ b/Task/Currying/JavaScript/currying-9.js @@ -0,0 +1,27 @@ +(() => { + + // curry :: ((a, b) -> c) -> a -> b -> c + let curry = f => a => b => f(a, b); + + + // TEST + + // product :: Num -> Num -> Num + let product = (a, b) => a * b, + + // Int -> Int -> Maybe Int -> [Int] + range = (m, n, step) => { + let d = (step || 1) * (n >= m ? 1 : -1); + + return Array.from({ + length: Math.floor((n - m) / d) + 1 + }, (_, i) => m + (i * d)); + } + + + return range(1, 10) + .map(curry(product)(7)) + + // [7, 14, 21, 28, 35, 42, 49, 56, 63, 70] + +})(); diff --git a/Task/Currying/Lua/currying.lua b/Task/Currying/Lua/currying.lua new file mode 100644 index 0000000000..99ffcf7497 --- /dev/null +++ b/Task/Currying/Lua/currying.lua @@ -0,0 +1,17 @@ +function curry2(f) + return function(x) + return function(y) + return f(x,y) + end + end +end + +function add(x,y) + return x+y +end + +local adder = curry2(add) +assert(adder(3)(4) == 3+4) +local add2 = adder(2) +assert(add2(3) == 2+3) +assert(add2(5) == 2+5) diff --git a/Task/Currying/PowerShell/currying-1.psh b/Task/Currying/PowerShell/currying-1.psh new file mode 100644 index 0000000000..4c9d645de5 --- /dev/null +++ b/Task/Currying/PowerShell/currying-1.psh @@ -0,0 +1 @@ +function Add($x) { return { param($y) return $y + $x }.GetNewClosure() } diff --git a/Task/Currying/PowerShell/currying-2.psh b/Task/Currying/PowerShell/currying-2.psh new file mode 100644 index 0000000000..dbe310f289 --- /dev/null +++ b/Task/Currying/PowerShell/currying-2.psh @@ -0,0 +1 @@ +& (Add 1) 2 diff --git a/Task/Currying/PowerShell/currying-3.psh b/Task/Currying/PowerShell/currying-3.psh new file mode 100644 index 0000000000..1768c3d21d --- /dev/null +++ b/Task/Currying/PowerShell/currying-3.psh @@ -0,0 +1 @@ +(4,9,16,25 | ForEach-Object { & (add $_) ([Math]::Sqrt($_)) }) -join ", " diff --git a/Task/Currying/TXR/currying.txr b/Task/Currying/TXR/currying.txr new file mode 100644 index 0000000000..ec447a92a8 --- /dev/null +++ b/Task/Currying/TXR/currying.txr @@ -0,0 +1 @@ +(op - 10 @1 @2 5) diff --git a/Task/Cut-a-rectangle/Elixir/cut-a-rectangle-1.elixir b/Task/Cut-a-rectangle/Elixir/cut-a-rectangle-1.elixir new file mode 100644 index 0000000000..14b2182b09 --- /dev/null +++ b/Task/Cut-a-rectangle/Elixir/cut-a-rectangle-1.elixir @@ -0,0 +1,41 @@ +import Integer + +defmodule Rectangle do + def cut_it(h, w) when is_odd(h) and is_odd(w), do: 0 + def cut_it(h, w) when is_odd(h), do: cut_it(w, h) + def cut_it(_, 1), do: 1 + def cut_it(h, 2), do: h + def cut_it(2, w), do: w + def cut_it(h, w) do + grid = List.duplicate(false, (h + 1) * (w + 1)) + t = div(h, 2) * (w + 1) + div(w, 2) + if is_odd(w) do + grid = grid |> List.replace_at(t, true) |> List.replace_at(t+1, true) + walk(h, w, div(h, 2), div(w, 2) - 1, grid) + walk(h, w, div(h, 2) - 1, div(w, 2), grid) * 2 + else + grid = grid |> List.replace_at(t, true) + count = walk(h, w, div(h, 2), div(w, 2) - 1, grid) + if h == w, do: count * 2, + else: count + walk(h, w, div(h, 2) - 1, div(w, 2), grid) + end + end + + defp walk(h, w, y, x, grid, count\\0) + defp walk(h, w, y, x,_grid, count) when y in [0,h] or x in [0,w], do: count+1 + defp walk(h, w, y, x, grid, count) do + blen = (h + 1) * (w + 1) - 1 + t = y * (w + 1) + x + grid = grid |> List.replace_at(t, true) |> List.replace_at(blen-t, true) + Enum.reduce(next(w), count, fn {nt, dy, dx}, cnt -> + if Enum.at(grid, t+nt), do: cnt, else: cnt + walk(h, w, y+dy, x+dx, grid) + end) + end + + defp next(w), do: [{w+1, 1, 0}, {-w-1, -1, 0}, {-1, 0, -1}, {1, 0, 1}] # {next,dy,dx} +end + +Enum.each(1..9, fn w -> + Enum.each(1..w, fn h -> + if is_even(w * h), do: IO.puts "#{w} x #{h}: #{Rectangle.cut_it(w, h)}" + end) +end) diff --git a/Task/Cut-a-rectangle/Elixir/cut-a-rectangle-2.elixir b/Task/Cut-a-rectangle/Elixir/cut-a-rectangle-2.elixir new file mode 100644 index 0000000000..af3248d8c3 --- /dev/null +++ b/Task/Cut-a-rectangle/Elixir/cut-a-rectangle-2.elixir @@ -0,0 +1,77 @@ +defmodule Rectangle do + def cut(h, w, disp\\true) when rem(h,2)==0 or rem(w,2)==0 do + limit = div(h * w, 2) + start_link + grid = make_grid(h, w) + walk(h, w, grid, 0, 0, limit, %{}, []) + if disp, do: display(h, w) + result = Agent.get(__MODULE__, &(&1)) + Agent.stop(__MODULE__) + MapSet.to_list(result) + end + + defp start_link do + Agent.start_link(fn -> MapSet.new end, name: __MODULE__) + end + + defp make_grid(h, w) do + for i <- 0..h-1, j <- 0..w-1, into: %{}, do: {{i,j}, true} + end + + defp walk(h, w, grid, x, y, limit, cut, select) do + grid2 = grid |> Map.put({x,y}, false) |> Map.put({h-x-1,w-y-1}, false) + select2 = [{x,y} | select] |> Enum.sort + unless cut[select2] do + if length(select2) == limit do + Agent.update(__MODULE__, fn set -> MapSet.put(set, select2) end) + else + cut2 = Map.put(cut, select2, true) + search_next(grid2, select2) + |> Enum.each(fn {i,j} -> walk(h, w, grid2, i, j, limit, cut2, select2) end) + end + end + end + + defp dirs(x, y), do: [{x+1, y}, {x-1, y}, {x, y-1}, {x, y+1}] + + defp search_next(grid, select) do + (for {x,y} <- select, {i,j} <- dirs(x,y), grid[{i,j}], do: {i,j}) + |> Enum.uniq + end + + defp display(h, w) do + Agent.get(__MODULE__, &(&1)) + |> Enum.each(fn select -> + grid = Enum.reduce(select, make_grid(h,w), fn {x,y},grid -> + %{grid | {x,y} => false} + end) + IO.puts to_string(h, w, grid) + end) + end + + defp to_string(h, w, grid) do + text = for x <- 0..h*2, into: %{}, do: {x, String.duplicate(" ", w*4+1)} + text = Enum.reduce(0..h, text, fn i,acc -> + Enum.reduce(0..w, acc, fn j,txt -> + to_s(txt, i, j, grid) + end) + end) + Enum.map_join(0..h*2, "\n", fn i -> text[i] end) + end + + defp to_s(text, i, j, grid) do + text = if grid[{i,j}] != grid[{i-1,j}], do: replace(text, i*2, j*4+1, "---"), else: text + text = if grid[{i,j}] != grid[{i,j-1}], do: replace(text, i*2+1, j*4, "|"), else: text + replace(text, i*2, j*4, "+") + end + + defp replace(text, x, y, replacement) do + len = String.length(replacement) + Map.update!(text, x, fn str -> + String.slice(str, 0, y) <> replacement <> String.slice(str, y+len..-1) + end) + end +end + +Rectangle.cut(2, 2) |> length |> IO.puts +Rectangle.cut(3, 4) |> length |> IO.puts diff --git a/Task/Cut-a-rectangle/Java/cut-a-rectangle.java b/Task/Cut-a-rectangle/Java/cut-a-rectangle.java new file mode 100644 index 0000000000..fd6725dff9 --- /dev/null +++ b/Task/Cut-a-rectangle/Java/cut-a-rectangle.java @@ -0,0 +1,66 @@ +import java.util.*; + +public class CutRectangle { + + private static int[][] dirs = {{0, -1}, {-1, 0}, {0, 1}, {1, 0}}; + + public static void main(String[] args) { + cutRectangle(2, 2); + cutRectangle(4, 3); + } + + static void cutRectangle(int w, int h) { + if (w % 2 == 1 && h % 2 == 1) + return; + + int[][] grid = new int[h][w]; + Stack stack = new Stack<>(); + + int half = (w * h) / 2; + long bits = (long) Math.pow(2, half) - 1; + + for (; bits > 0; bits -= 2) { + + for (int i = 0; i < half; i++) { + int r = i / w; + int c = i % w; + grid[r][c] = (bits & (1 << i)) != 0 ? 1 : 0; + grid[h - r - 1][w - c - 1] = 1 - grid[r][c]; + } + + stack.push(0); + grid[0][0] = 2; + int count = 1; + while (!stack.empty()) { + + int pos = stack.pop(); + int r = pos / w; + int c = pos % w; + + for (int[] dir : dirs) { + + int nextR = r + dir[0]; + int nextC = c + dir[1]; + + if (nextR >= 0 && nextR < h && nextC >= 0 && nextC < w) { + + if (grid[nextR][nextC] == 1) { + stack.push(nextR * w + nextC); + grid[nextR][nextC] = 2; + count++; + } + } + } + } + if (count == half) { + printResult(grid); + } + } + } + + static void printResult(int[][] arr) { + for (int[] a : arr) + System.out.println(Arrays.toString(a)); + System.out.println(); + } +} diff --git a/Task/Cut-a-rectangle/Perl-6/cut-a-rectangle.pl6 b/Task/Cut-a-rectangle/Perl-6/cut-a-rectangle.pl6 index a36bf2e977..db7d849a72 100644 --- a/Task/Cut-a-rectangle/Perl-6/cut-a-rectangle.pl6 +++ b/Task/Cut-a-rectangle/Perl-6/cut-a-rectangle.pl6 @@ -63,13 +63,11 @@ sub solve(Int $hh, Int $ww, Int $recur) returns Int { return $cnt; } -sub MAIN { - my ($y, $x); - loop ($y = 1; $y <= 10; $y++) { - loop ($x = 1; $x <= $y; $x++) { - if (!($x +& 1) || !($y +& 1)) { - printf("%d x %d: %d\n", $y, $x, solve($y, $x, 1)); - } +my ($y, $x); +loop ($y = 1; $y <= 10; $y++) { + loop ($x = 1; $x <= $y; $x++) { + if (!($x +& 1) || !($y +& 1)) { + printf("%d x %d: %d\n", $y, $x, solve($y, $x, 1)); } } } diff --git a/Task/Cut-a-rectangle/REXX/cut-a-rectangle-1.rexx b/Task/Cut-a-rectangle/REXX/cut-a-rectangle-1.rexx index 8fe0805a50..f658423938 100644 --- a/Task/Cut-a-rectangle/REXX/cut-a-rectangle-1.rexx +++ b/Task/Cut-a-rectangle/REXX/cut-a-rectangle-1.rexx @@ -2,7 +2,7 @@ /*────────────────────────────── cut along unit dimensions and may be rotated.*/ numeric digits 20 /*be able to handle some big integers. */ parse arg N .; if N=='' then N=10 /*N not specified? Then use default.*/ -dir.=0; dir.0.1=-1; dir.1.0=-1; dir.2.1=1; dir.3.0=1 /*four directions*/ +dir.=0; dir.0.1=-1; dir.1.0=-1; dir.2.1=1; dir.3.0=1 /*4 directions.*/ do y=2 to N; say /*calculate rectangles up to size NxN.*/ do x=1 for y; if x//2 & y//2 then iterate /*not if both X&Y odd.*/ @@ -11,35 +11,35 @@ dir.=0; dir.0.1=-1; dir.1.0=-1; dir.2.1=1; dir.3.0=1 /*four directions*/ end /*x*/ end /*y*/ exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────S subroutine──────────────────────────────*/ -s: if arg(1)=1 then return arg(3); return word(arg(2) 's',1) /*pluralizer.*/ -/*──────────────────────────────────SOLVE subroutine──────────────────────────*/ -solve: procedure expose # dir. @. h len next. w -parse arg hh 1 h,ww 1 w,recur; @.=0 /*get args; zero rectangle coördinates.*/ -if h//2 then do; t=w; w=h; h=t; if h//2 then return 0 - end -if w==1 then return 1 -if w==2 then return h -if h==2 then return w /* % is REXX's integer division. */ -cy = h%2; cx=w%2 /*cut the [XY] rectangle in half. */ -len = (h+1) * (w+1) - 1 /*extend the area of the rectangle. */ -next.0=-1; next.1=-w-1; next.2=1; next.3=w+1 /*direction and distance.*/ -if recur then #=0 - do x=cx+1 to w-1; t=x+cy*(w+1) - @.t=1; _=len-t; @._=1; call walk cy-1,x - end /*x*/ -#=#+1 -if h==w then #=#+# /*double the count of rectangle cuts. */ - else if w//2==0 & recur then call solve w,h,0 -return # -/*──────────────────────────────────WALK subroutine───────────────────────────*/ -walk: procedure expose # dir. @. h len next. w; parse arg y,x -if y==h | x==0 | x==w | y==0 then do; #=#=2; return; end -t=x + y*(w+1); @.t=@.t+1; _=len-t -@._=@._+1 - do j=0 for 4; _ = t+next.j /*try four directions.*/ - if @._==0 then call walk y+dir.j.0, x+dir.j.1 - end /*j*/ -@.t=@.t-1 -_=len-t; @._=@._-1 -return +/*────────────────────────────────────────────────────────────────────────────*/ +s: if arg(1)=1 then return arg(3); return word(arg(2) 's',1) /*pluralizer*/ +/*────────────────────────────────────────────────────────────────────────────*/ +solve: procedure expose # dir. @. h len next. w; @.=0 /*zero rect. coördinates*/ + parse arg hh 1 h,ww 1 w,recur /*obtain the values for some arguments.*/ + if h//2 then do; t=w; w=h; h=t; if h//2 then return 0 + end + if w==1 then return 1 + if w==2 then return h + if h==2 then return w /* % is REXX's integer division. */ + cy = h%2; cx=w%2 /*cut the [XY] rectangle in half. */ + len = (h+1) * (w+1) - 1 /*extend the area of the rectangle. */ + next.0=-1; next.1=-w-1; next.2=1; next.3=w+1 /*direction & distance*/ + if recur then #=0 + do x=cx+1 to w-1; t=x+cy*(w+1) + @.t=1; _=len-t; @._=1; call walk cy-1,x + end /*x*/ + #=#+1 + if h==w then #=#+# /*double the count of rectangle cuts. */ + else if w//2==0 & recur then call solve w,h,0 + return # +/*────────────────────────────────────────────────────────────────────────────*/ +walk: procedure expose # dir. @. h len next. w; parse arg y,x + if y==h | x==0 | x==w | y==0 then do; #=#=2; return; end + t=x + y*(w+1); @.t=@.t+1; _=len-t + @._=@._+1 + do j=0 for 4; _ = t+next.j /*try four directions.*/ + if @._==0 then call walk y+dir.j.0, x+dir.j.1 + end /*j*/ + @.t=@.t-1 + _=len-t; @._=@._-1 + return diff --git a/Task/Cut-a-rectangle/REXX/cut-a-rectangle-2.rexx b/Task/Cut-a-rectangle/REXX/cut-a-rectangle-2.rexx index ae1d4f557b..368793e7bf 100644 --- a/Task/Cut-a-rectangle/REXX/cut-a-rectangle-2.rexx +++ b/Task/Cut-a-rectangle/REXX/cut-a-rectangle-2.rexx @@ -2,7 +2,7 @@ /*────────────────────────────── cut along unit dimensions and may be rotated.*/ numeric digits 20 /*be able to handle some big integers. */ parse arg N .; if N=='' then N=10 /*N not specified? Then use default.*/ -dir.=0; dir.0.1=-1; dir.1.0=-1; dir.2.1=1; dir.3.0=1 /*four directions*/ +dir.=0; dir.0.1=-1; dir.1.0=-1; dir.2.1=1; dir.3.0=1 /*4 directions.*/ do y=2 to N; say /*calculate rectangles up to size NxN.*/ do x=1 for y; if x//2 & y//2 then iterate /*not if both X&Y odd.*/ @@ -11,45 +11,45 @@ dir.=0; dir.0.1=-1; dir.1.0=-1; dir.2.1=1; dir.3.0=1 /*four directions*/ end /*x*/ end /*y*/ exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────S subroutine──────────────────────────────*/ -s: if arg(1)=1 then return arg(3); return word(arg(2) 's',1) /*pluralizer.*/ -/*──────────────────────────────────SOLVE subroutine──────────────────────────*/ -solve: procedure expose # dir. @. h len next. w -parse arg hh 1 h,ww 1 w,recur; @.=0 /*get args; zero rectangle coördinates.*/ -if h//2 then do; parse value w h w with t w h; if h//2 then return 0 - end -if w==1 then return 1 -if w==2 then return h -if h==2 then return w /* % is REXX's integer division. */ -cy = h%2; cx=w%2 /*cut the [XY] rectangle in half. */ -len = (h+1) * (w+1) - 1 /*extend the area of the rectangle. */ -next.0=-1; next.1=-w-1; next.2=1; next.3=w+1 /*direction and distance.*/ -if recur then #=0 - do x=cx+1 to w-1; t=x+cy*(w+1) - @.t=1; _=len-t; @._=1; call walk cy-1,x - end /*x*/ -#=#+1 -if h==w then #=#+# /*double the count of rectangle cuts. */ - else if w//2==0 & recur then call solve w,h,0 -return # -/*──────────────────────────────────WALK subroutine───────────────────────────*/ -walk: procedure expose # dir. @. h len next. w; parse arg y,x -if y==h then do; #=#+2; return; end /* ◄──┐ REXX short circuit. */ -if x==0 then do; #=#+2; return; end /* ◄──┤ " " " */ -if x==w then do; #=#+2; return; end /* ◄──┤ " " " */ -if y==0 then do; #=#+2; return; end /* ◄──┤ " " " */ -t=x + y*(w+1); @.t=@.t+1; _=len-t /* │ ordered by most likely ►───┐ */ -@._=@._+1 /* └─────────────────────────────┘ */ - do j=0 for 4; _ = t+next.j /*try four directions.*/ - if @._==0 then do - yn=y+dir.j.0; xn=x+dir.j.1 - if yn==h then do; #=#+2; iterate; end - if xn==0 then do; #=#+2; iterate; end - if xn==w then do; #=#+2; iterate; end - if yn==0 then do; #=#+2; iterate; end - call walk yn, xn - end - end /*j*/ -@.t=@.t-1 -_=len-t; @._=@._-1 -return +/*────────────────────────────────────────────────────────────────────────────*/ +s: if arg(1)=1 then return arg(3); return word(arg(2) 's',1) /*pluralizer*/ +/*────────────────────────────────────────────────────────────────────────────*/ +solve: procedure expose # dir. @. h len next. w; @.=0 /*zero rect. coördinates*/ + parse arg hh 1 h,ww 1 w,recur /*obtain the values for some arguments.*/ + if h//2 then do; parse value w h w with t w h; if h//2 then return 0 + end + if w==1 then return 1 + if w==2 then return h + if h==2 then return w /* % is REXX's integer division. */ + cy = h%2; cx=w%2 /*cut the [XY] rectangle in half. */ + len = (h+1) * (w+1) - 1 /*extend the area of the rectangle. */ + next.0=-1; next.1=-w-1; next.2=1; next.3=w+1 /*direction & distance*/ + if recur then #=0 + do x=cx+1 to w-1; t=x+cy*(w+1) + @.t=1; _=len-t; @._=1; call walk cy-1,x + end /*x*/ + #=#+1 + if h==w then #=#+# /*double the count of rectangle cuts. */ + else if w//2==0 & recur then call solve w,h,0 + return # +/*────────────────────────────────────────────────────────────────────────────*/ +walk: procedure expose # dir. @. h len next. w; parse arg y,x + if y==h then do; #=#+2; return; end /*◄──┐ REXX short circuit. */ + if x==0 then do; #=#+2; return; end /*◄──┤ " " " */ + if x==w then do; #=#+2; return; end /*◄──┤ " " " */ + if y==0 then do; #=#+2; return; end /*◄──┤ " " " */ + t=x + y*(w+1); @.t=@.t+1; _=len-t /* │ordered by most likely ►──┐*/ + @._=@._+1 /* └──────────────────────────┘*/ + do j=0 for 4; _ = t+next.j /*try 4 directions.*/ + if @._==0 then do + yn=y+dir.j.0; xn=x+dir.j.1 + if yn==h then do; #=#+2; iterate; end + if xn==0 then do; #=#+2; iterate; end + if xn==w then do; #=#+2; iterate; end + if yn==0 then do; #=#+2; iterate; end + call walk yn, xn + end + end /*j*/ + @.t=@.t-1 + _=len-t; @._=@._-1 + return diff --git a/Task/DNS-query/00DESCRIPTION b/Task/DNS-query/00DESCRIPTION index 2c0694cf80..cf27692ddd 100644 --- a/Task/DNS-query/00DESCRIPTION +++ b/Task/DNS-query/00DESCRIPTION @@ -1,3 +1,4 @@ DNS is an internet service that maps domain names, like rosettacode.org, to IP addresses, like 66.220.0.231. Use DNS to resolve www.kame.net to both IPv4 and IPv6 addresses. Print these addresses. +

    diff --git a/Task/DNS-query/Batch-File/dns-query.bat b/Task/DNS-query/Batch-File/dns-query.bat index 222f30a51b..088a81b64e 100644 --- a/Task/DNS-query/Batch-File/dns-query.bat +++ b/Task/DNS-query/Batch-File/dns-query.bat @@ -1,21 +1,38 @@ +:: DNS Query Task from Rosetta Code Wiki +:: Batch File Implementation + @echo off -setlocal enabledelayedexpansion -set "Temp_File=%TMP%\NSLOOKUP_%RANDOM%.TMP" -set "Domain=www.kame.net" - -echo.Domain: %Domain% +set "domain=www.kame.net" +echo DOMAIN: "%domain%" echo. -echo.IP Addresses: - - ::The Main Processor -nslookup %Domain% >"%Temp_File%" 2>nul -for /f "tokens=*" %%A in ( -'findstr /B /C:"Address" "%Temp_File%" ^& findstr /B /C:" " "%Temp_File%"' -) do ( - set data=%%A - echo.!data:*s: =!|findstr /VBC:"192.168." /VBC:"127.0.0.1" -) -del /Q "%Temp_File%" +call :DNS_Lookup "%domain%" echo. pause +exit /b + +::Main Procedure +::Uses NSLOOKUP Command and a Temporary File +::Also uses a dirty "parsing" to detect IP addresses. + +:DNS_Lookup [domain] +setlocal enabledelayedexpansion +for /f "delims=" %%T in ('forfiles /p "%~dp0." /m "%~nx0" /c "cmd /c echo(0x09"') do set "TAB=%%T" +set "temp_file=%TMP%\NSLOOKUP_%RANDOM%.TMP" + +set "record=" +for /f "tokens=1* delims=:" %%x in ('nslookup "%~1" 2^>nul') do ( + set "line=%%x" + if "!line:~0,4!"=="Name" set "record=yes" + if "!line:~0,5!"=="Alias" set "record=" + if "!record!"=="yes" ( + if "%%y"=="" (echo %%x>>"%temp_file%") else (echo %%x:%%y>>"%temp_file%") + ) +) +if exist "%temp_file%" ( + for /f "tokens=*" %%a in ( + 'findstr /BC:"Address" "%temp_file%" ^& findstr /BC:"%TAB%" "%temp_file%"' + ) do (set "data=%%a"&echo !data:*s: =!) + del /q "%temp_file%" +) else (echo Connection to domain failed.) +goto :EOF diff --git a/Task/DNS-query/C++/dns-query.cpp b/Task/DNS-query/C++/dns-query.cpp new file mode 100644 index 0000000000..ee5ec892e4 --- /dev/null +++ b/Task/DNS-query/C++/dns-query.cpp @@ -0,0 +1,20 @@ +#include +#include + +int main() { + int rc {EXIT_SUCCESS}; + try { + boost::asio::io_service io_service; + boost::asio::ip::tcp::resolver resolver {io_service}; + auto entries = resolver.resolve({"www.kame.net", ""}); + boost::asio::ip::tcp::resolver::iterator entries_end; + for (; entries != entries_end; ++entries) { + std::cout << entries->endpoint().address() << std::endl; + } + } + catch (std::exception& e) { + std::cerr << e.what() << std::endl; + rc = EXIT_FAILURE; + } + return rc; +} diff --git a/Task/DNS-query/Oberon-2/dns-query.oberon-2 b/Task/DNS-query/Oberon-2/dns-query.oberon-2 new file mode 100644 index 0000000000..4167ddebf9 --- /dev/null +++ b/Task/DNS-query/Oberon-2/dns-query.oberon-2 @@ -0,0 +1,16 @@ +MODULE DNSQuery; +IMPORT + IO:Address, + Out := NPCT:Console; + +PROCEDURE Do() RAISES Address.UnknownHostException; +VAR + ip: Address.Inet; +BEGIN + ip := Address.GetByName("www.kame.net"); + Out.String(ip.ToString());Out.Ln +END Do; + +BEGIN + Do; +END DNSQuery. diff --git a/Task/DNS-query/REXX/dns-query-1.rexx b/Task/DNS-query/REXX/dns-query-1.rexx index 23eac7b49b..efd95cd7c9 100644 --- a/Task/DNS-query/REXX/dns-query-1.rexx +++ b/Task/DNS-query/REXX/dns-query-1.rexx @@ -1,17 +1,16 @@ -/*REXX program displays IPv4 and IPv6 addresses for a supplied domain name.*/ -trace off /*don't show PING none─zero return code*/ +/*REXX program displays IPV4 and IPV6 addresses for a supplied domain name.*/ parse arg tar . /*obtain optional domain name from C.L.*/ -if tar=='' then tar='www.kame.net' /*Not specified? Then use the default.*/ -tempFID='\TEMP\DNSQUERY.$$$.' /*define temp file to store the IPv4. */ -pingOpts='-l 0 -n 1 -w 1' tar /*define options for the PING command. */ - - do j=4 to 6 by 2 /*handle IPv4 and IPv6 addresses. */ - 'PING' (-j) pingOpts ">" tempFID /*restrict PING's output to a minimum. */ - q=charin(tempFID,1,999) /*read the output file from PING cmd.*/ - parse var q '[' IPA ']' /*parse IP address from the output. */ - say 'IPv'j 'for domain name ' tar " is " IPA /*IPv4 or IPv6 address.*/ - call lineout tempFID /* ◄──┬─◄ needed by some REXXes to */ - end /*j*/ /* └─◄ force file integrity.*/ - -'ERASE' tempFID /*clean up (delete) the temporary file.*/ +if tar=='' then tar= 'www.kame.net' /*Not specified? Then use the default.*/ +tFID = '\TEMP\DNSQUERY.$$$' /*define temp file to store IPV4 output*/ +pingOpts= '-l 0 -n 1 -w 0' tar /*define options for the PING command. */ +trace off /*don't show PING none─zero return code*/ + /* [↓] perform 2 versions of PING cmd.*/ + do j=4 to 6 by 2 /*handle IPV4 and IPV6 addresses. */ + 'PING' (-j) pingOpts ">" tFID /*restrict PING's output to a minimum. */ + q=charin(tFID, 1, 999) /*read the output file from PING cmd.*/ + parse var q '[' ipaddr "]" /*parse IP address from the output. */ + say 'IPV'j "for domain name " tar ' is ' ipaddr /*IPVx address.*/ + call lineout tFID /* ◄──┬─◄ needed by some REXXes to */ + end /*j*/ /* └─◄ force (TEMP) file integrity.*/ /*stick a fork in it, we're all done. */ +'ERASE' tFID /*clean up (delete) the temporary file.*/ diff --git a/Task/Date-format/00DESCRIPTION b/Task/Date-format/00DESCRIPTION index cb7e517319..49c58d6c80 100644 --- a/Task/Date-format/00DESCRIPTION +++ b/Task/Date-format/00DESCRIPTION @@ -1,2 +1,7 @@ - {{Clarified-review}} -Display the current date in the formats of "2007-11-10" and "Sunday, November 10, 2007". +{{Clarified-review}} + +;Task: +Display the   current date   in the formats of: +:::*   '''2007-11-23'''     and +:::*   '''Sunday, November 23, 2007''' +

    diff --git a/Task/Date-format/Emacs-Lisp/date-format.l b/Task/Date-format/Emacs-Lisp/date-format.l new file mode 100644 index 0000000000..3d7e1eb5c6 --- /dev/null +++ b/Task/Date-format/Emacs-Lisp/date-format.l @@ -0,0 +1,6 @@ +(format-time-string "%Y-%m-%d") +(format-time-string "%F") ;; new in Emacs 24 +=> "2015-11-08" + +(format-time-string "%A, %B %e, %Y") +=> "Sunday, November 8, 2015" diff --git a/Task/Date-format/Perl-6/date-format.pl6 b/Task/Date-format/Perl-6/date-format-1.pl6 similarity index 80% rename from Task/Date-format/Perl-6/date-format.pl6 rename to Task/Date-format/Perl-6/date-format-1.pl6 index 9bc573c13b..4a53ccccdf 100644 --- a/Task/Date-format/Perl-6/date-format.pl6 +++ b/Task/Date-format/Perl-6/date-format-1.pl6 @@ -1,4 +1,4 @@ -use DateTime::Utils; +use DateTime::Format; my $dt = DateTime.now; diff --git a/Task/Date-format/Perl-6/date-format-2.pl6 b/Task/Date-format/Perl-6/date-format-2.pl6 new file mode 100644 index 0000000000..e3ee6d4c02 --- /dev/null +++ b/Task/Date-format/Perl-6/date-format-2.pl6 @@ -0,0 +1,6 @@ +use DateTime::Format; + +my $dt = DateTime.now; + +say $dt.yyyy-mm-dd; +say strftime('%A, %B %d, %Y', $dt); diff --git a/Task/Date-format/PowerShell/date-format.psh b/Task/Date-format/PowerShell/date-format.psh index 3397271179..ac0f1483db 100644 --- a/Task/Date-format/PowerShell/date-format.psh +++ b/Task/Date-format/PowerShell/date-format.psh @@ -1,2 +1,5 @@ "{0:yyyy-MM-dd}" -f (Get-Date) "{0:dddd, MMMM d, yyyy}" -f (Get-Date) +# or +(Get-Date).ToString("yyyy-MM-dd") +(Get-Date).ToString("dddd, MMMM d, yyyy") diff --git a/Task/Date-format/Rust/date-format.rust b/Task/Date-format/Rust/date-format.rust new file mode 100644 index 0000000000..b20357f327 --- /dev/null +++ b/Task/Date-format/Rust/date-format.rust @@ -0,0 +1,7 @@ +extern crate chrono; +use chrono::*; +fn main(){ + let now : DateTime = UTC::now(); + println!("{}", now.format("%Y-%m-%d").to_string()); + println!("{}", now.format("%A, %B %d, %Y").to_string()); +} diff --git a/Task/Date-format/UNIX-Shell/date-format.sh b/Task/Date-format/UNIX-Shell/date-format-1.sh similarity index 100% rename from Task/Date-format/UNIX-Shell/date-format.sh rename to Task/Date-format/UNIX-Shell/date-format-1.sh diff --git a/Task/Date-format/UNIX-Shell/date-format-2.sh b/Task/Date-format/UNIX-Shell/date-format-2.sh new file mode 100644 index 0000000000..d95db2f1d3 --- /dev/null +++ b/Task/Date-format/UNIX-Shell/date-format-2.sh @@ -0,0 +1 @@ +date +"%F" diff --git a/Task/Date-manipulation/00DESCRIPTION b/Task/Date-manipulation/00DESCRIPTION index 29c00aa465..1836aff705 100644 --- a/Task/Date-manipulation/00DESCRIPTION +++ b/Task/Date-manipulation/00DESCRIPTION @@ -1,7 +1,9 @@ {{omit from|ML/I}} {{omit from|PARI/GP|No real capacity for string manipulation}} +;Task: Given the date string "March 7 2009 7:30pm EST",
    output the time 12 hours later in any human-readable format. As extra credit, display the resulting time in a time zone different from your own. +

    diff --git a/Task/Date-manipulation/COBOL/date-manipulation.cobol b/Task/Date-manipulation/COBOL/date-manipulation.cobol new file mode 100644 index 0000000000..372e4c8594 --- /dev/null +++ b/Task/Date-manipulation/COBOL/date-manipulation.cobol @@ -0,0 +1,121 @@ + identification division. + program-id. date-manipulation. + + environment division. + configuration section. + repository. + function all intrinsic. + + data division. + working-storage section. + 01 given-date. + 05 filler value z"March 7 2009 7:30pm EST". + 01 date-spec. + 05 filler value z"%B %d %Y %I:%M%p %Z". + + 01 time-struct. + 05 tm-sec usage binary-long. + 05 tm-min usage binary-long. + 05 tm-hour usage binary-long. + 05 tm-mday usage binary-long. + 05 tm-mon usage binary-long. + 05 tm-year usage binary-long. + 05 tm-wday usage binary-long. + 05 tm-yday usage binary-long. + 05 tm-isdst usage binary-long. + 05 tm-gmtoff usage binary-c-long. + 05 tm-zone usage pointer. + 01 scan-index usage pointer. + + 01 time-t usage binary-c-long. + 01 time-tm usage pointer. + + 01 reform-buffer pic x(64). + 01 reform-length usage binary-long. + + 01 current-locale usage pointer. + + 01 iso-spec constant as "YYYY-MM-DDThh:mm:ss+hh:mm". + 01 iso-date constant as "2009-03-07T19:30:00-05:00". + 01 date-integer pic 9(9). + 01 time-integer pic 9(9). + + procedure division. + + call "strptime" using + by reference given-date + by reference date-spec + by reference time-struct + returning scan-index + on exception + display "error calling strptime" upon syserr + end-call + display "Given: " given-date + + if scan-index not equal null then + *> add 12 hours, and reform as local + call "mktime" using time-struct returning time-t + add 43200 to time-t + perform form-datetime + + *> reformat as Pacific time + set environment "TZ" to "PST8PDT" + call "tzset" returning omitted + perform form-datetime + + *> reformat as Greenwich mean + set environment "TZ" to "GMT" + call "tzset" returning omitted + perform form-datetime + + + *> reformat for Tokyo time, as seen in Hong Kong + set environment "TZ" to "Japan" + call "tzset" returning omitted + call "setlocale" using by value 6 by content z"en_HK.utf8" + returning current-locale + on exception + display "error with setlocale" upon syserr + end-call + move z"%c" to date-spec + perform form-datetime + else + display "date parse error" upon syserr + end-if + + *> A more standard COBOL approach, based on ISO8601 + display "Given: " iso-date + move integer-of-formatted-date(iso-spec, iso-date) + to date-integer + + move seconds-from-formatted-time(iso-spec, iso-date) + to time-integer + + add 43200 to time-integer + if time-integer greater than 86400 then + subtract 86400 from time-integer + add 1 to date-integer + end-if + display " " substitute(formatted-datetime(iso-spec + date-integer, time-integer, -300), "T", "/") + + goback. + + form-datetime. + call "localtime" using time-t returning time-tm + call "strftime" using + by reference reform-buffer + by value length(reform-buffer) + by reference date-spec + by value time-tm + returning reform-length + on exception + display "error calling strftime" upon syserr + end-call + if reform-length > 0 and <= length(reform-buffer) then + display " " reform-buffer(1 : reform-length) + else + display "date format error" upon syserr + end-if + . + end program date-manipulation. diff --git a/Task/Date-manipulation/Perl-6/date-manipulation.pl6 b/Task/Date-manipulation/Perl-6/date-manipulation.pl6 index a5b1ec18f3..f8312a6152 100644 --- a/Task/Date-manipulation/Perl-6/date-manipulation.pl6 +++ b/Task/Date-manipulation/Perl-6/date-manipulation.pl6 @@ -1,5 +1,5 @@ my @month = ; -my %month = (@month Z=> ^12).flat, (@month».substr(0,3) Z=> ^12).flat, 'Sept' => 8; +my %month = flat (@month Z=> ^12), (@month».substr(0,3) Z=> ^12), 'Sept' => 8; grammar US-DateTime { rule TOP { ','? ','?

    MDR: [n0..n4]
    +
    +MDR: [n0..n4]
     ===  ========
       0: [0, 10, 20, 25, 30]
       1: [1, 11, 111, 1111, 11111]
    @@ -19,9 +21,12 @@ The [[wp:Multiplicative digital root|multiplicative digital root]] (MDR) and mul
       6: [6, 16, 23, 28, 32]
       7: [7, 17, 71, 117, 171]
       8: [8, 18, 24, 29, 36]
    -  9: [9, 19, 33, 91, 119]
    + 9: [9, 19, 33, 91, 119] +
    Show all output on this page. + ;References: * [http://mathworld.wolfram.com/MultiplicativeDigitalRoot.html Multiplicative Digital Root] on Wolfram Mathworld. * [http://oeis.org/A031347 Multiplicative digital root] on The On-Line Encyclopedia of Integer Sequences. +

    diff --git a/Task/Digital-root-Multiplicative-digital-root/Elixir/digital-root-multiplicative-digital-root.elixir b/Task/Digital-root-Multiplicative-digital-root/Elixir/digital-root-multiplicative-digital-root.elixir index 8e459c0f19..c2b34a9382 100644 --- a/Task/Digital-root-Multiplicative-digital-root/Elixir/digital-root-multiplicative-digital-root.elixir +++ b/Task/Digital-root-Multiplicative-digital-root/Elixir/digital-root-multiplicative-digital-root.elixir @@ -26,12 +26,12 @@ defmodule Digital do defp add_map(n, m, map) do {mdr, _persist} = mdroot(n) - new_map = Dict.update(map, mdr, [n], fn vals -> [n | vals] end) - min_len = Dict.values(new_map) |> Enum.map(&length(&1)) |> Enum.min + new_map = Map.update(map, mdr, [n], fn vals -> [n | vals] end) + min_len = Map.values(new_map) |> Enum.map(&length(&1)) |> Enum.min if min_len < m, do: add_map(n+1, m, new_map), else: new_map end end Digital.task1([123321, 7739, 893, 899998]) -Digital.task2(5) +Digital.task2 diff --git a/Task/Digital-root-Multiplicative-digital-root/PARI-GP/digital-root-multiplicative-digital-root.pari b/Task/Digital-root-Multiplicative-digital-root/PARI-GP/digital-root-multiplicative-digital-root.pari new file mode 100644 index 0000000000..af5d784904 --- /dev/null +++ b/Task/Digital-root-Multiplicative-digital-root/PARI-GP/digital-root-multiplicative-digital-root.pari @@ -0,0 +1,3 @@ +a(n)=my(i);while(n>9,n=factorback(digits(n));i++);[i,n]; +apply(a, [123321, 7739, 893, 899998]) +v=vector(10,i,[]); forstep(n=0,oo,1, t=a(n)[2]+1; if(#v[t]<5,v[t]=concat(v[t],n); if(vecmin(apply(length,v))>4, return(v)))) diff --git a/Task/Digital-root-Multiplicative-digital-root/Perl-6/digital-root-multiplicative-digital-root.pl6 b/Task/Digital-root-Multiplicative-digital-root/Perl-6/digital-root-multiplicative-digital-root.pl6 index c9780113db..0b879c607d 100644 --- a/Task/Digital-root-Multiplicative-digital-root/Perl-6/digital-root-multiplicative-digital-root.pl6 +++ b/Task/Digital-root-Multiplicative-digital-root/Perl-6/digital-root-multiplicative-digital-root.pl6 @@ -1,6 +1,6 @@ sub multiplicative-digital-root(Int $n) { return .elems - 1, .[.end] - given $n, {[*] .comb} ... *.chars == 1 + given cache($n, {[*] .comb} ... *.chars == 1) } for 123321, 7739, 893, 899998 { diff --git a/Task/Digital-root/00DESCRIPTION b/Task/Digital-root/00DESCRIPTION index 384c1bdea9..f4c4644557 100644 --- a/Task/Digital-root/00DESCRIPTION +++ b/Task/Digital-root/00DESCRIPTION @@ -12,10 +12,12 @@ The task is to calculate the additive persistence and the digital root of a numb The digital root may be calculated in bases other than 10. -See: -*[[Casting out nines]] for this wiki's use of this procedure. -*[[Digital root/Multiplicative digital root]] -*[[Sum digits of an integer]] -*[[oeis:A010888|Digital root sequence on OEIS]] -*[[oeis:A031286|Additive persistence sequence on OEIS]] -*[[Iterated digits squaring]] + +;See: +* [[Casting out nines]] for this wiki's use of this procedure. +* [[Digital root/Multiplicative digital root]] +* [[Sum digits of an integer]] +* [[oeis:A010888|Digital root sequence on OEIS]] +* [[oeis:A031286|Additive persistence sequence on OEIS]] +* [[Iterated digits squaring]] +

    diff --git a/Task/Digital-root/ALGOL-68/digital-root.alg b/Task/Digital-root/ALGOL-68/digital-root.alg new file mode 100644 index 0000000000..21ee998a3b --- /dev/null +++ b/Task/Digital-root/ALGOL-68/digital-root.alg @@ -0,0 +1,34 @@ +# calculates the digital root and persistance of n # +PROC digital root = ( LONG LONG INT n, REF INT root, persistance )VOID: + BEGIN + LONG LONG INT number := ABS n; + persistance := 0; + WHILE persistance PLUSAB 1; + LONG LONG INT digit sum := 0; + WHILE number > 0 + DO + digit sum PLUSAB number MOD 10; + number OVERAB 10 + OD; + number := digit sum; + number > 9 + DO + SKIP + OD; + root := SHORTEN SHORTEN number + END; # digital root # + +# calculates and prints the digital root and persistace of number # +PROC print digital root and persistance = ( LONG LONG INT number )VOID: + BEGIN + INT root, persistance; + digital root( number, root, persistance ); + print( ( whole( number, -15 ), " root: ", whole( root, 0 ), " persistance: ", whole( persistance, -3 ), newline ) ) + END; # print digital root and persistance # + +# test the digital root proc # +BEGIN print digital root and persistance( 627615 ) + ; print digital root and persistance( 39390 ) + ; print digital root and persistance( 588225 ) + ; print digital root and persistance( 393900588225 ) +END diff --git a/Task/Digital-root/Elixir/digital-root.elixir b/Task/Digital-root/Elixir/digital-root.elixir index 5937d61023..5241e1fe06 100644 --- a/Task/Digital-root/Elixir/digital-root.elixir +++ b/Task/Digital-root/Elixir/digital-root.elixir @@ -1,12 +1,9 @@ defmodule Digital do - def root(n, base \\ 10), do: root(n, base, 0) + def root(n, base\\10), do: root(n, base, 0) - def root(n, base, ap) when n < base, do: {n, ap} - def root(n, base, ap) do - Integer.to_string(n, base) - |> String.codepoints - |> Enum.reduce(0, fn x,acc -> acc + String.to_integer(x, base) end) - |> root(base, ap+1) + defp root(n, base, ap) when n < base, do: {n, ap} + defp root(n, base, ap) do + Integer.digits(n, base) |> Enum.sum |> root(base, ap+1) end end diff --git a/Task/Digital-root/R/digital-root.r b/Task/Digital-root/R/digital-root.r new file mode 100644 index 0000000000..38b6e75531 --- /dev/null +++ b/Task/Digital-root/R/digital-root.r @@ -0,0 +1,13 @@ +y=1 +digital_root=function(n){ + x=sum(as.numeric(unlist(strsplit(as.character(n),"")))) + if(x<10){ + k=x + }else{ + y=y+1 + assign("y",y,envir = globalenv()) + k=digital_root(x) + } + return(k) +} +print("Given number has additive persistence",y) diff --git a/Task/Digital-root/REXX/digital-root-2.rexx b/Task/Digital-root/REXX/digital-root-2.rexx index 4f1c4c1281..14eeb6d6f2 100644 --- a/Task/Digital-root/REXX/digital-root-2.rexx +++ b/Task/Digital-root/REXX/digital-root-2.rexx @@ -1,21 +1,20 @@ -/*REXX program calculates the digital root and additive persisteance. */ -numeric digits 1000 /*lets handle biguns.*/ -say 'digital' /*part of the header.*/ -say ' root persistence' center('number',81) /* " " " " */ -say '═══════ ═══════════' center('' ,81,'═') /* " " " " */ +/*REXX program calculates and displays the digital root and additive persistence. */ +say 'digital' /*display the 1st line of the header.*/ +say " root persistence" center('number',77) /* " " 2nd " " " " */ +say "═══════ ═══════════" left('', 77, "═") /* " " 3rd " " " " */ call digRoot 627615 call digRoot 39390 call digRoot 588225 call digRoot 393900588225 -call digRoot 899999999999999999999999999999999999999999999999999999999999999999999999999999999 -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────DIGROOT subroutine──────────────────*/ -digRoot: procedure; parse arg x 1 ox /*get the num, save as original. */ - do pers=0 while length(x)\==1; r=0 /*keep summing until digRoot=1dig*/ - do j=1 for length(x) /*add each digit in the number. */ - r=r+substr(x,j,1) /*add a digit to the digital root*/ - end /*j*/ - x=r /*'new' num, it may be multi-dig.*/ - end /*pers*/ -say center(x,7) center(pers,11) ox /*show a nicely formatted line. */ -return +call digRoot 89999999999999999999999999999999999999999999999999999999999999999999999999999 +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +digRoot: procedure; parse arg x 1 ox /*get the number, also get another copy*/ + do pers=0 while length(x)\==1; $=0 /*keep summing until digRoot ≡ 1 digit.*/ + do j=1 for length(x) /*add each digit in the decimal number.*/ + $=$+substr(x,j,1) /*add a decimal digit to digital root. */ + end /*j*/ + x=$ /*a 'new' num, it may be multi-digit.*/ + end /*pers*/ + say center(x,7) center(pers,11) ox /*display a nicely formatted line. */ + return diff --git a/Task/Digital-root/REXX/digital-root-3.rexx b/Task/Digital-root/REXX/digital-root-3.rexx index c60533449c..feadcb08b9 100644 --- a/Task/Digital-root/REXX/digital-root-3.rexx +++ b/Task/Digital-root/REXX/digital-root-3.rexx @@ -1,14 +1,14 @@ ∙ ∙ ∙ -/*──────────────────────────────────DIGROOT subroutine──────────────────*/ -digRoot: procedure; parse arg x 1 ox /*get the num, save as original. */ - do pers=0 while length(x)\==1; r=0 /*keep summing until digRoot=1dig*/ - do j=1 for length(x) /*add each digit in the number. */ - ?=substr(x,j,1) /*pick off a char, maybe a dig ? */ - if datatype(?,'W') then r=r+? /*add a digit to the digital root*/ - end /*j*/ - x=r /*'new' num, it may be multi-dig.*/ - end /*pers*/ -say center(x,7) center(pers,11) ox /*show a nicely formatted line. */ -return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +digRoot: procedure; parse arg x 1 ox /*get the number, also get another copy*/ + do pers=0 while length(x)\==1; $=0 /*keep summing until digRoot ≡ 1 digit.*/ + do j=1 for length(x) /*add each digit in the decimal number.*/ + ?=substr(x, j, 1) /*pick off a character, maybe a digit ?*/ + if datatype(?, 'W') then $=$+? /*add a decimal digit to digital root. */ + end /*j*/ + x=$ /*a 'new' num, it may be multi-digit.*/ + end /*pers*/ + say center(x,7) center(pers,11) ox /*display a nicely formatted line. */ + return diff --git a/Task/Digital-root/Rust/digital-root.rust b/Task/Digital-root/Rust/digital-root.rust new file mode 100644 index 0000000000..d153085627 --- /dev/null +++ b/Task/Digital-root/Rust/digital-root.rust @@ -0,0 +1,43 @@ +fn sum_digits(mut n: u64, base: u64) -> u64 { + let mut sum = 0u64; + while n > 0 { + sum = sum + (n % base); + n = n / base; + } + sum +} + +// Returns tuple of (additive-persistence, digital-root) +fn digital_root(mut num: u64, base: u64) -> (u64, u64) { + let mut pers = 0; + while num >= base { + pers = pers + 1; + num = sum_digits(num, base); + } + (pers, num) +} + +fn main() { + + // Test base 10 + let values = [627615u64, 39390u64, 588225u64, 393900588225u64]; + for &value in values.iter() { + let (pers, root) = digital_root(value, 10); + println!("{} has digital root {} and additive persistance {}", + value, + root, + pers); + } + + println!(""); + + // Test base 16 + let values_base16 = [0x7e0, 0x14e344, 0xd60141, 0x12343210]; + for &value in values_base16.iter() { + let (pers, root) = digital_root(value, 16); + println!("0x{:x} has digital root 0x{:x} and additive persistance 0x{:x}", + value, + root, + pers); + } +} diff --git a/Task/Digital-root/ZX-Spectrum-Basic/digital-root.zx b/Task/Digital-root/ZX-Spectrum-Basic/digital-root.zx new file mode 100644 index 0000000000..51840485c2 --- /dev/null +++ b/Task/Digital-root/ZX-Spectrum-Basic/digital-root.zx @@ -0,0 +1,18 @@ +10 DATA 4,627615,39390,588225,9992 +20 READ j: LET b=10 +30 FOR i=1 TO j +40 READ n +50 PRINT "Digital root of ";n;" is" +60 GO SUB 1000 +70 NEXT i +80 STOP +1000 REM Digital Root +1010 LET c=0 +1020 IF n>=b THEN LET c=c+1: GO SUB 2000: GO TO 1020 +1030 PRINT n;" persistance is ";c'' +1040 RETURN +2000 REM Digit sum +2010 LET s=0 +2020 IF n<>0 THEN LET q=INT (n/b): LET s=s+n-q*b: LET n=q: GO TO 2020 +2030 LET n=s +2040 RETURN diff --git a/Task/Dinesmans-multiple-dwelling-problem/00DESCRIPTION b/Task/Dinesmans-multiple-dwelling-problem/00DESCRIPTION index 27764ac02c..4b6169ad3b 100644 --- a/Task/Dinesmans-multiple-dwelling-problem/00DESCRIPTION +++ b/Task/Dinesmans-multiple-dwelling-problem/00DESCRIPTION @@ -1,5 +1,7 @@ {{omit from|GUISS}} -The task is to '''solve Dinesman's multiple dwelling [http://mitpress.mit.edu/sicp/full-text/book/book-Z-H-28.html#%_sec_4.3.2 problem] but in a way that most naturally follows the problem statement given below'''. + +;Task +Solve Dinesman's multiple dwelling [http://mitpress.mit.edu/sicp/full-text/book/book-Z-H-28.html#%_sec_4.3.2 problem] but in a way that most naturally follows the problem statement given below. Solutions are allowed (but not required) to parse and interpret the problem text, but should remain flexible and should state what changes to the problem text are allowed. Flexibility and ease of expression are valued. @@ -7,12 +9,14 @@ Examples may be be split into "setup", "problem statement", and "output" section Example output should be shown here, as well as any comments on the examples flexibility. -;The problem: -:Baker, Cooper, Fletcher, Miller, and Smith live on different floors of an apartment house that contains only five floors. -:Baker does not live on the top floor. -:Cooper does not live on the bottom floor. -:Fletcher does not live on either the top or the bottom floor. -:Miller lives on a higher floor than does Cooper. -:Smith does not live on a floor adjacent to Fletcher's. -:Fletcher does not live on a floor adjacent to Cooper's. -:''Where does everyone live?'' + +;The problem +Baker, Cooper, Fletcher, Miller, and Smith live on different floors of an apartment house that contains only five floors.
    +* Baker does not live on the top floor. +* Cooper does not live on the bottom floor. +* Fletcher does not live on either the top or the bottom floor. +* Miller lives on a higher floor than does Cooper. +* Smith does not live on a floor adjacent to Fletcher's. +* Fletcher does not live on a floor adjacent to Cooper's.

    +''Where does everyone live?''
    +

    diff --git a/Task/Dinesmans-multiple-dwelling-problem/ALGOL-68/dinesmans-multiple-dwelling-problem.alg b/Task/Dinesmans-multiple-dwelling-problem/ALGOL-68/dinesmans-multiple-dwelling-problem.alg new file mode 100644 index 0000000000..ee9ee4f59f --- /dev/null +++ b/Task/Dinesmans-multiple-dwelling-problem/ALGOL-68/dinesmans-multiple-dwelling-problem.alg @@ -0,0 +1,70 @@ +# attempt to solve the dinesman Multiple Dwelling problem # + +# SETUP # + +# special floor values # +INT top floor = 4; +INT bottom floor = 0; + +# mode to specify the persons floor constraint # +MODE PERSON = STRUCT( STRING name, REF INT floor, PROC( INT )BOOL ok ); + +# yields TRUE if the floor of the specified person is OK, FALSE otherwise # +OP OK = ( PERSON p )BOOL: ( ok OF p )( floor OF p ); + +# yields TRUE if floor is adjacent to other persons floor, FALSE otherwise # +PROC adjacent = ( INT floor, other persons floor )BOOL: floor >= ( other persons floor - 1 ) AND floor <= ( other persons floor + 1 ); + +# displays the floor of an occupant # +PROC print floor = ( PERSON occupant )VOID: print( ( whole( floor OF occupant, -1 ), " ", name OF occupant, newline ) ); + +# PROBLEM STATEMENT # + +# the inhabitants with their floor and constraints # +PERSON baker = ( "Baker", LOC INT := 0, ( INT floor )BOOL: floor /= top floor ); +PERSON cooper = ( "Cooper", LOC INT := 0, ( INT floor )BOOL: floor /= bottom floor ); +PERSON fletcher = ( "Fletcher", LOC INT := 0, ( INT floor )BOOL: floor /= top floor AND floor /= bottom floor + AND NOT adjacent( floor, floor OF cooper ) ); +PERSON miller = ( "Miller", LOC INT := 0, ( INT floor )BOOL: floor > floor OF cooper ); +PERSON smith = ( "Smith", LOC INT := 0, ( INT floor )BOOL: NOT adjacent( floor, floor OF fletcher ) ); + +# SOLUTION # + +# "brute force" solution - we run through the possible 5^5 configurations # +# we cold optimise this by e.g. restricting f to bottom floor + 1 TO top floor - 1 # +# at the cost of reducing the flexibility of the constraints # +# alternatively, we could add minimum and maximum allowed floors to the PERSON # +# STRUCT and loop through these instead of bottom floor TO top floor # + +FOR b FROM bottom floor TO top floor DO + floor OF baker := b; + FOR c FROM bottom floor TO top floor DO + IF b /= c THEN + floor OF cooper := c; + FOR f FROM bottom floor TO top floor DO + IF b /= f AND c /= f THEN + floor OF fletcher := f; + FOR m FROM bottom floor TO top floor DO + IF b /= m AND c /= m AND f /= m THEN + floor OF miller := m; + FOR s FROM bottom floor TO top floor DO + IF b /= s AND c /= s AND f /= s AND m /= s THEN + floor OF smith := s; + IF OK baker AND OK cooper AND OK fletcher AND OK miller AND OK smith + THEN + # found a solution # + print floor( baker ); + print floor( cooper ); + print floor( fletcher ); + print floor( miller ); + print floor( smith ) + FI + FI + OD + FI + OD + FI + OD + FI + OD +OD diff --git a/Task/Dinesmans-multiple-dwelling-problem/C-sharp/dinesmans-multiple-dwelling-problem.cs b/Task/Dinesmans-multiple-dwelling-problem/C-sharp/dinesmans-multiple-dwelling-problem.cs new file mode 100644 index 0000000000..cc2c74c973 --- /dev/null +++ b/Task/Dinesmans-multiple-dwelling-problem/C-sharp/dinesmans-multiple-dwelling-problem.cs @@ -0,0 +1,68 @@ +public class Program +{ + public static void Main() + { + const int count = 5; + const int Baker = 0, Cooper = 1, Fletcher = 2, Miller = 3, Smith = 4; + string[] names = { nameof(Baker), nameof(Cooper), nameof(Fletcher), nameof(Miller), nameof(Smith) }; + + Func[] constraints = { + floorOf => floorOf[Baker] != count-1, + floorOf => floorOf[Cooper] != 0, + floorOf => floorOf[Fletcher] != count-1 && floorOf[Fletcher] != 0, + floorOf => floorOf[Miller] > floorOf[Cooper], + floorOf => Math.Abs(floorOf[Smith] - floorOf[Fletcher]) > 1, + floorOf => Math.Abs(floorOf[Fletcher] - floorOf[Cooper]) > 1, + }; + + var solver = new DinesmanSolver(); + foreach (var tenants in solver.Solve(count, constraints)) { + Console.WriteLine(string.Join(" ", tenants.Select(t => names[t]))); + } + } +} + +public class DinesmanSolver +{ + public IEnumerable Solve(int count, params Func[] constraints) { + foreach (int[] floorOf in Permutations(count)) { + if (constraints.All(c => c(floorOf))) { + yield return Enumerable.Range(0, count).OrderBy(i => floorOf[i]).ToArray(); + } + } + } + + static IEnumerable Permutations(int length) { + if (length == 0) { + yield return new int[0]; + yield break; + } + bool forwards = false; + foreach (var permutation in Permutations(length - 1)) { + for (int i = 0; i < length; i++) { + yield return permutation.InsertAt(forwards ? i : length - i - 1, length - 1).ToArray(); + } + forwards = !forwards; + } + } +} + +static class Extensions +{ + public static IEnumerable InsertAt(this IEnumerable source, int position, T newElement) { + if (source == null) throw new ArgumentNullException(nameof(source)); + if (position < 0) throw new ArgumentOutOfRangeException(nameof(position)); + return InsertAtIterator(source, position, newElement); + } + + private static IEnumerable InsertAtIterator(IEnumerable source, int position, T newElement) { + int index = 0; + foreach (T element in source) { + if (index == position) yield return newElement; + yield return element; + index++; + } + if (index < position) throw new ArgumentOutOfRangeException(nameof(position)); + if (index == position) yield return newElement; + } +} diff --git a/Task/Dinesmans-multiple-dwelling-problem/Go/dinesmans-multiple-dwelling-problem.go b/Task/Dinesmans-multiple-dwelling-problem/Go/dinesmans-multiple-dwelling-problem.go new file mode 100644 index 0000000000..fae066a834 --- /dev/null +++ b/Task/Dinesmans-multiple-dwelling-problem/Go/dinesmans-multiple-dwelling-problem.go @@ -0,0 +1,122 @@ +package main + +import "fmt" + +// The program here is restricted to finding assignments of tenants (or more +// generally variables with distinct names) to floors (or more generally +// integer values.) It finds a solution assigning all tenants and assigning +// them to different floors. + +// Change number and names of tenants here. Adding or removing names is +// allowed but the names should be distinct; the code is not written to handle +// duplicate names. +var tenants = []string{"Baker", "Cooper", "Fletcher", "Miller", "Smith"} + +// Change the range of floors here. The bottom floor does not have to be 1. +// These should remain non-negative integers though. +const bottom = 1 +const top = 5 + +// A type definition for readability. Do not change. +type assignments map[string]int + +// Change rules defining the problem here. Change, add, or remove rules as +// desired. Each rule should first be commented as human readable text, then +// coded as a function. The function takes a tentative partial list of +// assignments of tenants to floors and is free to compute anything it wants +// with this information. Other information available to the function are +// package level defintions, such as top and bottom. A function returns false +// to say the assignments are invalid. +var rules = []func(assignments) bool{ + // Baker does not live on the top floor + func(a assignments) bool { + floor, assigned := a["Baker"] + return !assigned || floor != top + }, + // Cooper does not live on the bottom floor + func(a assignments) bool { + floor, assigned := a["Cooper"] + return !assigned || floor != bottom + }, + // Fletcher does not live on either the top or the bottom floor + func(a assignments) bool { + floor, assigned := a["Fletcher"] + return !assigned || (floor != top && floor != bottom) + }, + // Miller lives on a higher floor than does Cooper + func(a assignments) bool { + if m, assigned := a["Miller"]; assigned { + c, assigned := a["Cooper"] + return !assigned || m > c + } + return true + }, + // Smith does not live on a floor adjacent to Fletcher's + func(a assignments) bool { + if s, assigned := a["Smith"]; assigned { + if f, assigned := a["Fletcher"]; assigned { + d := s - f + return d*d > 1 + } + } + return true + }, + // Fletcher does not live on a floor adjacent to Cooper's + func(a assignments) bool { + if f, assigned := a["Fletcher"]; assigned { + if c, assigned := a["Cooper"]; assigned { + d := f - c + return d*d > 1 + } + } + return true + }, +} + +// Assignment program, do not change. The algorithm is a depth first search, +// tentatively assigning each tenant in order, and for each tenant trying each +// unassigned floor in order. For each tentative assignment, it evaluates all +// rules in the rules list and backtracks as soon as any one of them fails. +// +// This algorithm ensures that the tenative assignments have only names in the +// tenants list, only floor numbers from bottom to top, and that tentants are +// assigned to different floors. These rules are hard coded here and do not +// need to be coded in the the rules list above. +func main() { + a := assignments{} + var occ [top + 1]bool + var df func([]string) bool + df = func(u []string) bool { + if len(u) == 0 { + return true + } + tn := u[0] + u = u[1:] + f: + for f := bottom; f <= top; f++ { + if !occ[f] { + a[tn] = f + for _, r := range rules { + if !r(a) { + delete(a, tn) + continue f + } + } + occ[f] = true + if df(u) { + return true + } + occ[f] = false + delete(a, tn) + } + } + return false + } + if !df(tenants) { + fmt.Println("no solution") + return + } + for t, f := range a { + fmt.Println(t, f) + } +} diff --git a/Task/Dinesmans-multiple-dwelling-problem/Haskell/dinesmans-multiple-dwelling-problem-2.hs b/Task/Dinesmans-multiple-dwelling-problem/Haskell/dinesmans-multiple-dwelling-problem-2.hs index 5658a86993..62a6cd664d 100644 --- a/Task/Dinesmans-multiple-dwelling-problem/Haskell/dinesmans-multiple-dwelling-problem-2.hs +++ b/Task/Dinesmans-multiple-dwelling-problem/Haskell/dinesmans-multiple-dwelling-problem-2.hs @@ -1,2 +1,6 @@ import Data.List (permutations) -main = print [ (b,c,f,m,s) | [b,c,f,m,s] <- permutations [1..5], b/=5,c/=1,f/=1,f/=5,m>c,abs(s-f)>1,abs(c-f)>1] +print [ ("Baker lives on " ++ show b + , "Cooper lives on " ++ show c + , "Fletcher lives on " ++ show f + , "Miller lives on " ++ show m + , "Smith lives on " ++ show s) | [b,c,f,m,s] <- permutations [1..5], b/=5,c/=1,f/=1,f/=5,m>c,abs(s-f)>1,abs(c-f)>1] diff --git a/Task/Dinesmans-multiple-dwelling-problem/JavaScript/dinesmans-multiple-dwelling-problem-1.js b/Task/Dinesmans-multiple-dwelling-problem/JavaScript/dinesmans-multiple-dwelling-problem-1.js new file mode 100644 index 0000000000..05a242e6da --- /dev/null +++ b/Task/Dinesmans-multiple-dwelling-problem/JavaScript/dinesmans-multiple-dwelling-problem-1.js @@ -0,0 +1,54 @@ +(() => { + 'use strict'; + + // concatMap :: (a -> [b]) -> [a] -> [b] + const concatMap = (f, xs) => [].concat.apply([], xs.map(f)); + + // range :: Int -> Int -> [Int] + const range = (m, n) => + Array.from({ + length: Math.floor(n - m) + 1 + }, (_, i) => m + i); + + // and :: [Bool] -> Bool + const and = xs => { + let i = xs.length; + while (i--) + if (!xs[i]) return false; + return true; + } + + // nubBy :: (a -> a -> Bool) -> [a] -> [a] + const nubBy = (p, xs) => { + const x = xs.length ? xs[0] : undefined; + return x !== undefined ? [x].concat( + nubBy(p, xs.slice(1) + .filter(y => !p(x, y))) + ) : []; + } + + // PROBLEM DECLARATION + + const floors = range(1, 5); + + return concatMap(b => + concatMap(c => + concatMap(f => + concatMap(m => + concatMap(s => + and([ // CONDITIONS + nubBy((a, b) => a === b, [b, c, f, m, s]) // all floors singly occupied + .length === 5, + b !== 5, c !== 1, f !== 1, f !== 5, + m > c, Math.abs(s - f) > 1, Math.abs(c - f) > 1 + ]) ? [{ + Baker: b, + Cooper: c, + Fletcher: f, + Miller: m, + Smith: s + }] : [], + floors), floors), floors), floors), floors); + + // --> [{"Baker":3, "Cooper":2, "Fletcher":4, "Miller":5, "Smith":1}] +})(); diff --git a/Task/Dinesmans-multiple-dwelling-problem/JavaScript/dinesmans-multiple-dwelling-problem-2.js b/Task/Dinesmans-multiple-dwelling-problem/JavaScript/dinesmans-multiple-dwelling-problem-2.js new file mode 100644 index 0000000000..7810889b63 --- /dev/null +++ b/Task/Dinesmans-multiple-dwelling-problem/JavaScript/dinesmans-multiple-dwelling-problem-2.js @@ -0,0 +1 @@ +[{"Baker":3, "Cooper":2, "Fletcher":4, "Miller":5, "Smith":1}] diff --git a/Task/Dinesmans-multiple-dwelling-problem/JavaScript/dinesmans-multiple-dwelling-problem-3.js b/Task/Dinesmans-multiple-dwelling-problem/JavaScript/dinesmans-multiple-dwelling-problem-3.js new file mode 100644 index 0000000000..3e06b65155 --- /dev/null +++ b/Task/Dinesmans-multiple-dwelling-problem/JavaScript/dinesmans-multiple-dwelling-problem-3.js @@ -0,0 +1,55 @@ +(() => { + 'use strict'; + + // concatMap :: (a -> [b]) -> [a] -> [b] + const concatMap = (f, xs) => [].concat.apply([], xs.map(f)); + + // range :: Int -> Int -> [Int] + const range = (m, n) => + Array.from({ + length: Math.floor(n - m) + 1 + }, (_, i) => m + i); + + // and :: [Bool] -> Bool + const and = xs => { + let i = xs.length; + while (i--) + if (!xs[i]) return false; + return true; + } + + // permutations :: [a] -> [[a]] + const permutations = xs => + xs.length ? concatMap(x => concatMap(ys => [ + [x].concat(ys) + ], + permutations(delete_(x, xs))), xs) : [ + [] + ]; + + // delete :: a -> [a] -> [a] + const delete_ = (x, xs) => + deleteBy((a, b) => a === b, x, xs); + + // deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a] + const deleteBy = (f, x, xs) => + xs.reduce((a, y) => f(x, y) ? a : a.concat(y), []); + + // PROBLEM DECLARATION + + const floors = range(1, 5); + + return concatMap(([c, b, f, m, s]) => + and([ // CONDITIONS (assuming full occupancy, no cohabitation) + b !== 5, c !== 1, f !== 1, f !== 5, + m > c, Math.abs(s - f) > 1, Math.abs(c - f) > 1 + ]) ? [{ + Baker: b, + Cooper: c, + Fletcher: f, + Miller: m, + Smith: s + }] : [], permutations(floors)); + + // --> [{"Baker":3, "Cooper":2, "Fletcher":4, "Miller":5, "Smith":1}] +})(); diff --git a/Task/Dinesmans-multiple-dwelling-problem/JavaScript/dinesmans-multiple-dwelling-problem-4.js b/Task/Dinesmans-multiple-dwelling-problem/JavaScript/dinesmans-multiple-dwelling-problem-4.js new file mode 100644 index 0000000000..7810889b63 --- /dev/null +++ b/Task/Dinesmans-multiple-dwelling-problem/JavaScript/dinesmans-multiple-dwelling-problem-4.js @@ -0,0 +1 @@ +[{"Baker":3, "Cooper":2, "Fletcher":4, "Miller":5, "Smith":1}] diff --git a/Task/Dinesmans-multiple-dwelling-problem/Perl-6/dinesmans-multiple-dwelling-problem-1.pl6 b/Task/Dinesmans-multiple-dwelling-problem/Perl-6/dinesmans-multiple-dwelling-problem-1.pl6 index 09ac46be23..de9f8137c5 100644 --- a/Task/Dinesmans-multiple-dwelling-problem/Perl-6/dinesmans-multiple-dwelling-problem-1.pl6 +++ b/Task/Dinesmans-multiple-dwelling-problem/Perl-6/dinesmans-multiple-dwelling-problem-1.pl6 @@ -1,6 +1,9 @@ +use MONKEY-SEE-NO-EVAL; + sub parse_and_solve ($text) { my %ids; my $expr = (grammar { + state $c = 0; rule TOP { + { make join ' && ', $>>.made } } rule fact { (not)? @@ -19,7 +22,7 @@ sub parse_and_solve ($text) { || { note "Failed to parse line " ~ +$/.prematch.comb(/^^/); exit 1; } } - token name { :i <[a..z]>+ { make %ids{~$/} //= (state $)++ } } + token name { :i <[a..z]>+ { make %ids{~$/} //= $c++ } } token ordinal { [1st | 2nd | 3rd | \d+th] { make +$/.match(/(\d+)/)[0] } } }).parse($text).made; diff --git a/Task/Dinesmans-multiple-dwelling-problem/PowerShell/dinesmans-multiple-dwelling-problem-1.psh b/Task/Dinesmans-multiple-dwelling-problem/PowerShell/dinesmans-multiple-dwelling-problem-1.psh new file mode 100644 index 0000000000..404f73d996 --- /dev/null +++ b/Task/Dinesmans-multiple-dwelling-problem/PowerShell/dinesmans-multiple-dwelling-problem-1.psh @@ -0,0 +1,68 @@ +# Floors are numbered 1 (ground) to 5 (top) + +# Baker, Cooper, Fletcher, Miller, and Smith live on different floors: +$statement1 = '$baker -ne $cooper -and $baker -ne $fletcher -and $baker -ne $miller -and + $baker -ne $smith -and $cooper -ne $fletcher -and $cooper -ne $miller -and + $cooper -ne $smith -and $fletcher -ne $miller -and $fletcher -ne $smith -and + $miller -ne $smith' + +# Baker does not live on the top floor: +$statement2 = '$baker -ne 5' + +# Cooper does not live on the bottom floor: +$statement3 = '$cooper -ne 1' + +# Fletcher does not live on either the top or the bottom floor: +$statement4 = '$fletcher -ne 1 -and $fletcher -ne 5' + +# Miller lives on a higher floor than does Cooper: +$statement5 = '$miller -gt $cooper' + +# Smith does not live on a floor adjacent to Fletcher's: +$statement6 = '[Math]::Abs($smith - $fletcher) -ne 1' + +# Fletcher does not live on a floor adjacent to Cooper's: +$statement7 = '[Math]::Abs($fletcher - $cooper) -ne 1' + +for ($baker = 1; $baker -lt 6; $baker++) +{ + for ($cooper = 1; $cooper -lt 6; $cooper++) + { + for ($fletcher = 1; $fletcher -lt 6; $fletcher++) + { + for ($miller = 1; $miller -lt 6; $miller++) + { + for ($smith = 1; $smith -lt 6; $smith++) + { + if (Invoke-Expression $statement2) + { + if (Invoke-Expression $statement3) + { + if (Invoke-Expression $statement5) + { + if (Invoke-Expression $statement4) + { + if (Invoke-Expression $statement6) + { + if (Invoke-Expression $statement7) + { + if (Invoke-Expression $statement1) + { + $multipleDwellings = @() + $multipleDwellings+= [PSCustomObject]@{Name = "Baker" ; Floor = $baker} + $multipleDwellings+= [PSCustomObject]@{Name = "Cooper" ; Floor = $cooper} + $multipleDwellings+= [PSCustomObject]@{Name = "Fletcher"; Floor = $fletcher} + $multipleDwellings+= [PSCustomObject]@{Name = "Miller" ; Floor = $miller} + $multipleDwellings+= [PSCustomObject]@{Name = "Smith" ; Floor = $smith} + } + } + } + } + } + } + } + } + } + } + } +} diff --git a/Task/Dinesmans-multiple-dwelling-problem/PowerShell/dinesmans-multiple-dwelling-problem-2.psh b/Task/Dinesmans-multiple-dwelling-problem/PowerShell/dinesmans-multiple-dwelling-problem-2.psh new file mode 100644 index 0000000000..fb59feb26b --- /dev/null +++ b/Task/Dinesmans-multiple-dwelling-problem/PowerShell/dinesmans-multiple-dwelling-problem-2.psh @@ -0,0 +1 @@ +$multipleDwellings diff --git a/Task/Dinesmans-multiple-dwelling-problem/PowerShell/dinesmans-multiple-dwelling-problem-3.psh b/Task/Dinesmans-multiple-dwelling-problem/PowerShell/dinesmans-multiple-dwelling-problem-3.psh new file mode 100644 index 0000000000..a7f6ce4a2e --- /dev/null +++ b/Task/Dinesmans-multiple-dwelling-problem/PowerShell/dinesmans-multiple-dwelling-problem-3.psh @@ -0,0 +1 @@ +$multipleDwellings | Sort-Object -Property Floor -Descending diff --git a/Task/Dinesmans-multiple-dwelling-problem/REXX/dinesmans-multiple-dwelling-problem.rexx b/Task/Dinesmans-multiple-dwelling-problem/REXX/dinesmans-multiple-dwelling-problem.rexx index 204888b50c..4c963b4204 100644 --- a/Task/Dinesmans-multiple-dwelling-problem/REXX/dinesmans-multiple-dwelling-problem.rexx +++ b/Task/Dinesmans-multiple-dwelling-problem/REXX/dinesmans-multiple-dwelling-problem.rexx @@ -1,32 +1,32 @@ -/*REXX pgm: Dinesman's multiple-dwelling problem with "natural" wording.*/ -names= 'Baker Cooper Fletcher Miller Smith' /*names of the tenants.*/ -floors=5; top=floors; bottom=1; #=floors; sols=0 - /*floor 1 is the ground floor. */ - do !.1=1 for #;do !.2=1 for #;do !.3=1 for #;do !.4=1 for #;do !.5=1 for # - do p=1 for words(names); _=word(names,p); upper _; call value _,!.p - end /*p*/ - /* [↓] don't live on same floor.*/ - do j=1 for #-1; do k=j+1 to #; if !.j==!.k then iterate !.5; end;end +/*REXX program solves the Dinesman's multiple─dwelling problem with "natural" wording.*/ +names= 'Baker Cooper Fletcher Miller Smith' /*names of multiple─dwelling tenants. */ +tenants=words(names) /*the number of tenants in the building*/ +floors=5; top=floors; bottom=1; #=floors; /*floor 1 is the ground (bottom) floor.*/ +sols=0 + do !.1=1 for #; do !.2=1 for #; do !.3=1 for #; do !.4=1 for #; do !.5=1 for # + do p=1 for tenants; _=word(names,p); upper _; call value _, !.p + end /*p*/ + do j=1 for #-1 /* [↓] people don't live on same floor*/ + do k=j+1 to #; if !.j==!.k then iterate !.5 /*cohab?*/ + end /*k*/ + end /*j*/ + call Waldo /* ◄══ where the rubber meets the road.*/ + end; end; end; end; end /*!.5 & !.4 & !.3 & !.2 & !.1*/ - call Waldo /* ◄───────────────────where the rubber meets the road.*/ - end /*!.5*/; end /*!.4*/; end /*!.3*/; end /*!.2*/; end /*!.1*/ - -say; say 'found' sols "solution"s(sols)'.' -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────Waldo subroutine────────────────────*/ -Waldo: - if Baker == top then return - if Cooper == bottom then return - if Fletcher == bottom | Fletcher == top then return - if Miller \> Cooper then return - if Smith == Fletcher-1 | Smith == Fletcher+1 then return - if Fletcher == Cooper-1 | Fletcher == Cooper+1 then return - -say; sols=sols+1 /*list tenants in order in list. */ - do p=1 for words(names); _=word(names,p) - say right(_,20) 'lives on the' !.p||th(!.p) "floor." - end /*p*/ -return -/*──────────────────────────────────one-liner subroutines───────────────*/ -s: if arg(1)=1 then return ''; return 's' /*a simple pluralizer funct.*/ -th:procedure;parse arg x;x=abs(x);return word('th st nd rd',1+x//10*(x//100%10\==1)*(x//10<4)) +say 'found' sols "solution"s(sols). /*display the number of solutions found*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +Waldo: if Baker == top then return + if Cooper == bottom then return + if Fletcher == bottom | Fletcher == top then return + if Miller \> Cooper then return + if Smith == Fletcher-1 | Smith == Fletcher+1 then return + if Fletcher == Cooper -1 | Fletcher == Cooper +1 then return + sols=sols+1 + say; do p=1 for tenants; tenant=right( word(names, p), 30) + say tenant 'lives on the' !.p || th(!.p) "floor." + end /*p*/ + return /* [↑] show tenants in order in NAMES.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +s: if arg(1)=1 then return ''; return "s" /*a simple pluralizer function.*/ +th: arg x; x=abs(x); return word('th st nd rd', 1 +x// 10* (x//100%10\==1)*(x//10<4)) diff --git a/Task/Dinesmans-multiple-dwelling-problem/Run-BASIC/dinesmans-multiple-dwelling-problem.run b/Task/Dinesmans-multiple-dwelling-problem/Run-BASIC/dinesmans-multiple-dwelling-problem.run index 093624997f..6370ea3285 100644 --- a/Task/Dinesmans-multiple-dwelling-problem/Run-BASIC/dinesmans-multiple-dwelling-problem.run +++ b/Task/Dinesmans-multiple-dwelling-problem/Run-BASIC/dinesmans-multiple-dwelling-problem.run @@ -1,21 +1,13 @@ -people$ = "Baler,Cooper,Fletcher,Miller,Smith" - for baler = 1 to 4 ' can not be in room 5 for cooper = 2 to 5 ' can not be in room 1 for fletcher = 2 to 4 ' can not be in room 1 or 5 for miller = 1 to 5 ' can be in any room for smith = 1 to 5 ' can be in any room - if miller > cooper and abs(smith - fletcher) > 1 and abs(fletcher - cooper) > 1 then + if baler <> cooper and fletcher <> miller and miller > cooper and abs(smith - fletcher) > 1 and abs(fletcher - cooper) > 1 then if baler + cooper + fletcher + miller + smith = 15 then ' that is 1 + 2 + 3 + 4 + 5 rooms$ = baler;cooper;fletcher;miller;smith - bad = 0 - for i = 1 to 5 ' make sure each room is unique - rm$ = chr$(i + 48) - r1 = instr(rooms$,rm$) - r2 = instr(rooms$,rm$,r1+1) - if r2 <> 0 then bad = 1 - next i - if bad = 0 then goto [roomAssgn] ' if it is not bad it is a good assignment + print "baler: ";baler;" copper: ";cooper;" fletcher: ";fletcher;" miller: ";miller;" smith: ";smith + end end if end if next smith @@ -23,11 +15,4 @@ for baler = 1 to 4 ' can not be in r next fletcher next cooper next baler -print "Cam't assign rooms" ' print this if it can not find a solution -wait - -[roomAssgn] -Print "Room Assignment" -for i = 1 to 5 -print mid$(rooms$,i,1);" ";word$(people$,i,",");" "; ' print the room assignments -next i +print "Can't assign rooms" ' print this if it can not find a solution diff --git a/Task/Dinesmans-multiple-dwelling-problem/ZX-Spectrum-Basic/dinesmans-multiple-dwelling-problem.zx b/Task/Dinesmans-multiple-dwelling-problem/ZX-Spectrum-Basic/dinesmans-multiple-dwelling-problem.zx new file mode 100644 index 0000000000..16e3b83a87 --- /dev/null +++ b/Task/Dinesmans-multiple-dwelling-problem/ZX-Spectrum-Basic/dinesmans-multiple-dwelling-problem.zx @@ -0,0 +1,11 @@ +10 REM Floors are numbered 0 (ground) to 4 (top) +20 REM "Baker, Cooper, Fletcher, Miller, and Smith live on different floors": +30 REM "Baker does not live on the top floor" +40 REM "Cooper does not live on the bottom floor" +50 REM "Fletcher does not live on either the top or the bottom floor" +60 REM "Miller lives on a higher floor than does Cooper" +70 REM "Smith does not live on a floor adjacent to Fletcher's" +80 REM "Fletcher does not live on a floor adjacent to Cooper's" +90 FOR b=0 TO 4: FOR c=0 TO 4: FOR f=0 TO 4: FOR m=0 TO 4: FOR s=0 TO 4 +100 IF B<>C AND B<>F AND B<>M AND B<>S AND C<>F AND C<>M AND C<>S AND F<>M AND F<>S AND M<>S AND B<>4 AND C<>0 AND F<>0 AND F<>4 AND M>C AND ABS (S-F)<>1 AND ABS (F-C)<>1 THEN PRINT "Baker lives on floor ";b: PRINT "Cooper lives on floor ";c: PRINT "Fletcher lives on floor ";f: PRINT "Miller lives on floor ";m: PRINT "Smith lives on floor ";s: STOP +110 NEXT s: NEXT m: NEXT f: NEXT c: NEXT b diff --git a/Task/Dining-philosophers/C/dining-philosophers-3.c b/Task/Dining-philosophers/C/dining-philosophers-3.c new file mode 100644 index 0000000000..cb681ba1a0 --- /dev/null +++ b/Task/Dining-philosophers/C/dining-philosophers-3.c @@ -0,0 +1,60 @@ +#include +#include +#include + +#define NUM_THREADS 5 + +struct timespec time1; +mtx_t forks[NUM_THREADS]; + +typedef struct { + char *name; + int left; + int right; +} Philosopher; + +Philosopher *create(char *nam, int lef, int righ) { + Philosopher *x = malloc(sizeof(Philosopher)); + x->name = nam; + x->left = lef; + x->right = righ; + return x; +} + +int eat(void *data) { + time1.tv_sec = 1; + Philosopher *foo = (Philosopher *) data; + mtx_lock(&forks[foo->left]); + mtx_lock(&forks[foo->right]); + printf("%s is eating\n", foo->name); + thrd_sleep(&time1, NULL); + printf("%s is done eating\n", foo->name); + mtx_unlock(&forks[foo->left]); + mtx_unlock(&forks[foo->right]); + return 0; +} + +int main(void) { + thrd_t threadId[NUM_THREADS]; + Philosopher *all[NUM_THREADS] = {create("Teral", 0 ,1), + create("Billy", 1, 2), + create("Daniel", 2,3), + create("Philip", 3, 4), + create("Bennet", 0, 4)}; + for (int i = 0; i < NUM_THREADS; i++){ + if (mtx_init(&forks[i], mtx_plain) != thrd_success){ + puts("FAILED IN MUTEX INIT!"); + return 0; + } + } + for (int i=0; i < NUM_THREADS; ++i) { + if (thrd_create(threadId+i, eat, all[i]) != thrd_success) { + printf("%d-th thread create error\n", i); + return 0; + } + } + + for (int i=0; i < NUM_THREADS; ++i) + thrd_join(threadId[i], NULL); + return 0; +} diff --git a/Task/Dining-philosophers/Go/dining-philosophers.go b/Task/Dining-philosophers/Go/dining-philosophers-1.go similarity index 72% rename from Task/Dining-philosophers/Go/dining-philosophers.go rename to Task/Dining-philosophers/Go/dining-philosophers-1.go index 02949e7bb8..ce26d7fcbd 100644 --- a/Task/Dining-philosophers/Go/dining-philosophers.go +++ b/Task/Dining-philosophers/Go/dining-philosophers-1.go @@ -1,6 +1,7 @@ package main import ( + "hash/fnv" "log" "math/rand" "os" @@ -11,17 +12,19 @@ import ( // It is not otherwise fixed in the program. var ph = []string{"Aristotle", "Kant", "Spinoza", "Marx", "Russell"} -const nBites = 3 // number of times each philosopher eats +const hunger = 3 // number of times each philosopher eats +const think = time.Second / 100 // mean think time +const eat = time.Second / 100 // mean eat time var fmt = log.New(os.Stdout, "", 0) // for thread-safe output +var done = make(chan bool) + // This solution uses channels to implement synchronization. // Sent over channels are "forks." type fork byte -// A fork object in the program obviously models a physical fork in the -// philosopher simulation. In the more general context of resource -// sharing, the object would represent exclusive control of a resource. +// A fork object in the program models a physical fork in the simulation. // A separate channel represents each fork place. Two philosophers // have access to each fork. The channels are buffered with capacity = 1, // representing a place for a single fork. @@ -31,17 +34,25 @@ type fork byte func philosopher(phName string, dominantHand, otherHand chan fork, done chan bool) { fmt.Println(phName, "seated") - rg := rand.New(rand.NewSource(time.Now().UnixNano())) - for i := 0; i < nBites; i++ { + // each philosopher goroutine has a random number generator, + // seeded with a hash of the philosopher's name. + h := fnv.New64a() + h.Write([]byte(phName)) + rg := rand.New(rand.NewSource(int64(h.Sum64()))) + // utility function to sleep for a randomized nominal time + rSleep := func(t time.Duration) { + time.Sleep(t/2 + time.Duration(rg.Int63n(int64(t)))) + } + for h := hunger; h > 0; h-- { fmt.Println(phName, "hungry") <-dominantHand // pick up forks <-otherHand fmt.Println(phName, "eating") - time.Sleep(time.Duration(rg.Int63n(1e8))) + rSleep(eat) dominantHand <- 'f' // put down forks otherHand <- 'f' fmt.Println(phName, "thinking") - time.Sleep(time.Duration(rg.Int63n(1e8))) + rSleep(think) } fmt.Println(phName, "satisfied") done <- true @@ -52,7 +63,6 @@ func main() { fmt.Println("table empty") // Create fork channels and start philosopher goroutines, // supplying each goroutine with the appropriate channels - done := make(chan bool) place0 := make(chan fork, 1) place0 <- 'f' // byte in channel represents a fork on the table. placeLeft := place0 @@ -67,7 +77,7 @@ func main() { // This makes precedence acyclic, preventing deadlock. go philosopher(ph[0], place0, placeLeft, done) // they are all now busy eating - for _ = range ph { + for range ph { <-done // wait for philosphers to finish } fmt.Println("table empty") diff --git a/Task/Dining-philosophers/Go/dining-philosophers-2.go b/Task/Dining-philosophers/Go/dining-philosophers-2.go new file mode 100644 index 0000000000..6ede6e6b29 --- /dev/null +++ b/Task/Dining-philosophers/Go/dining-philosophers-2.go @@ -0,0 +1,59 @@ +package main + +import ( + "hash/fnv" + "log" + "math/rand" + "os" + "sync" + "time" +) + +var ph = []string{"Aristotle", "Kant", "Spinoza", "Marx", "Russell"} + +const hunger = 3 +const think = time.Second / 100 +const eat = time.Second / 100 + +var fmt = log.New(os.Stdout, "", 0) + +var dining sync.WaitGroup + +func philosopher(phName string, dominantHand, otherHand *sync.Mutex) { + fmt.Println(phName, "seated") + h := fnv.New64a() + h.Write([]byte(phName)) + rg := rand.New(rand.NewSource(int64(h.Sum64()))) + rSleep := func(t time.Duration) { + time.Sleep(t/2 + time.Duration(rg.Int63n(int64(t)))) + } + for h := hunger; h > 0; h-- { + fmt.Println(phName, "hungry") + dominantHand.Lock() // pick up forks + otherHand.Lock() + fmt.Println(phName, "eating") + rSleep(eat) + dominantHand.Unlock() // put down forks + otherHand.Unlock() + fmt.Println(phName, "thinking") + rSleep(think) + } + fmt.Println(phName, "satisfied") + dining.Done() + fmt.Println(phName, "left the table") +} + +func main() { + fmt.Println("table empty") + dining.Add(5) + fork0 := &sync.Mutex{} + forkLeft := fork0 + for i := 1; i < len(ph); i++ { + forkRight := &sync.Mutex{} + go philosopher(ph[i], forkLeft, forkRight) + forkLeft = forkRight + } + go philosopher(ph[0], fork0, forkLeft) + dining.Wait() // wait for philosphers to finish + fmt.Println("table empty") +} diff --git a/Task/Discordian-date/00DESCRIPTION b/Task/Discordian-date/00DESCRIPTION index a88b322033..972119c4bb 100644 --- a/Task/Discordian-date/00DESCRIPTION +++ b/Task/Discordian-date/00DESCRIPTION @@ -1 +1,3 @@ -Convert a given date from the [[wp:Gregorian calendar|Gregorian calendar]] to the [[wp:Discordian calendar|Discordian calendar]]. +;Task: +Convert a given date from the   [[wp:Gregorian calendar|Gregorian calendar]]   to the   [[wp:Discordian calendar|Discordian calendar]]. +

    diff --git a/Task/Discordian-date/AWK/discordian-date.awk b/Task/Discordian-date/AWK/discordian-date.awk index b227b8f3a7..628157f853 100644 --- a/Task/Discordian-date/AWK/discordian-date.awk +++ b/Task/Discordian-date/AWK/discordian-date.awk @@ -83,11 +83,14 @@ function yearly_calendar(y, d,m) { } } } -function dos_date( cmd,x) { # under Microsoft Windows XP +function dos_date( arr,cmd,d,x) { # under Microsoft Windows +# XP - The current date is: MM/DD/YYYY +# 8 - The current date is: DOW MM/DD/YYYY cmd = "DATE s := To_Unbounded_String("Sweetmorn"); + when Boomtime => s := To_Unbounded_String("Boomtime"); + when Pungenday => s := To_Unbounded_String("Pungenday"); + when Prickle_Prickle => s := To_Unbounded_String("Prickle-Prickle"); + when Setting_Orange => s := To_Unbounded_String("Setting Orange"); + end case; + return s; + end Week_Day_To_Str; + + function Holiday(Season: Seasons) return Unbounded_String is + s : Unbounded_String; + begin + case Season is + when Chaos => s := To_Unbounded_String("Chaoflux"); + when Discord => s := To_Unbounded_String("Discoflux"); + when Confusion => s := To_Unbounded_String("Confuflux"); + when Bureaucracy => s := To_Unbounded_String("Bureflux"); + when The_Aftermath => s := To_Unbounded_String("Afflux"); + end case; + return s; + end Holiday; + + function Apostle(Season: Seasons) return Unbounded_String is + s : Unbounded_String; + begin + case Season is + when Chaos => s := To_Unbounded_String("Mungday"); + when Discord => s := To_Unbounded_String("Mojoday"); + when Confusion => s := To_Unbounded_String("Syaday"); + when Bureaucracy => s := To_Unbounded_String("Zaraday"); + when The_Aftermath => s := To_Unbounded_String("Maladay"); + end case; + return s; + end Apostle; + + function Season_To_Str(Season: Seasons) return Unbounded_String is + s : Unbounded_String; + begin + case Season is + when Chaos => s := To_Unbounded_String("Chaos"); + when Discord => s := To_Unbounded_String("Discord"); + when Confusion => s := To_Unbounded_String("Confusion"); + when Bureaucracy => s := To_Unbounded_String("Bureaucracy"); + when The_Aftermath => s := To_Unbounded_String("The Aftermath"); + end case; + return s; + end Season_To_Str; + procedure Convert (From : Time; To : out Discordian_Date) is use Ada.Calendar.Arithmetic; First_Day : Time; Number_Days : Day_Count; + Leap_Year : boolean; begin First_Day := Time_Of (Year => Year (From), Month => 1, Day => 1); Number_Days := From - First_Day; To.Year := Year (Date => From) + 1166; To.Is_Tibs_Day := False; - if (To.Year - 2) mod 4 = 0 then + Leap_Year := False; + if Year (Date => From) mod 4 = 0 then + if Year (Date => From) mod 100 = 0 then + if Year (Date => From) mod 400 = 0 then + Leap_Year := True; + end if; + else + Leap_Year := True; + end if; + end if; + if Leap_Year then if Number_Days > 59 then Number_Days := Number_Days - 1; elsif Number_Days = 59 then @@ -39,42 +114,90 @@ procedure Discordian is when 4 => To.Season := The_Aftermath; when others => raise Constraint_Error; end case; + case Number_Days mod 5 is + when 0 => To.Week_Day := Sweetmorn; + when 1 => To.Week_Day := Boomtime; + when 2 => To.Week_Day := Pungenday; + when 3 => To.Week_Day := Prickle_Prickle; + when 4 => To.Week_Day := Setting_Orange; + when others => raise Constraint_Error; + end case; end Convert; procedure Put (Item : Discordian_Date) is begin - Ada.Text_IO.Put ("YOLD" & Integer'Image (Item.Year)); if Item.Is_Tibs_Day then - Ada.Text_IO.Put (", St. Tib's Day"); + Ada.Text_IO.Put ("St. Tib's Day"); else - Ada.Text_IO.Put (", " & Seasons'Image (Item.Season)); - Ada.Text_IO.Put (" " & Integer'Image (Item.Day)); + UStr_IO.Put (Week_Day_To_Str(Item.Week_Day)); + Ada.Text_IO.Put (", day" & Integer'Image (Item.Day)); + Ada.Text_IO.Put (" of "); + UStr_IO.Put (Season_To_Str (Item.Season)); + if Item.Day = 5 then + Ada.Text_IO.Put (", "); + UStr_IO.Put (Apostle(Item.Season)); + elsif Item.Day = 50 then + Ada.Text_IO.Put (", "); + UStr_IO.Put (Holiday(Item.Season)); + end if; end if; + Ada.Text_IO.Put (" in the YOLD" & Integer'Image (Item.Year)); Ada.Text_IO.New_Line; end Put; Test_Day : Time; Test_DDay : Discordian_Date; + Year : Integer; + Month : Integer; + Day : Integer; + YYYYMMDD : Integer; begin - Test_Day := Clock; - Convert (From => Test_Day, To => Test_DDay); - Put (Test_DDay); - Test_Day := Time_Of (Year => 2012, Month => 2, Day => 28); - Convert (From => Test_Day, To => Test_DDay); - Put (Test_DDay); - Test_Day := Time_Of (Year => 2012, Month => 2, Day => 29); - Convert (From => Test_Day, To => Test_DDay); - Put (Test_DDay); - Test_Day := Time_Of (Year => 2012, Month => 3, Day => 1); - Convert (From => Test_Day, To => Test_DDay); - Put (Test_DDay); - Test_Day := Time_Of (Year => 2010, Month => 7, Day => 22); - Convert (From => Test_Day, To => Test_DDay); - Put (Test_DDay); - Test_Day := Time_Of (Year => 2012, Month => 9, Day => 2); - Convert (From => Test_Day, To => Test_DDay); - Put (Test_DDay); - Test_Day := Time_Of (Year => 2012, Month => 12, Day => 31); - Convert (From => Test_Day, To => Test_DDay); - Put (Test_DDay); + + if Argument_Count = 0 then + Test_Day := Clock; + Convert (From => Test_Day, To => Test_DDay); + Put (Test_DDay); + end if; + + for Arg in 1..Argument_Count loop + + if Argument(Arg)'Length < 8 then + Ada.Text_IO.Put("ERROR: Invalid Argument : '" & Argument(Arg) & "'"); + Ada.Text_IO.Put("Input format YYYYMMDD"); + raise Constraint_Error; + end if; + + begin + YYYYMMDD := Integer'Value(Argument(Arg)); + exception + when Constraint_Error => + Ada.Text_IO.Put("ERROR: Invalid Argument : '" & Argument(Arg) & "'"); + raise; + end; + + Day := YYYYMMDD mod 100; + if Day < Day_Number'First or Day > Day_Number'Last then + Ada.Text_IO.Put("ERROR: Invalid Day:" & Integer'Image(Day)); + raise Constraint_Error; + end if; + + Month := ((YYYYMMDD - Day) / 100) mod 100; + if Month < Month_Number'First or Month > Month_Number'Last then + Ada.Text_IO.Put("ERROR: Invalid Month:" & Integer'Image(Month)); + raise Constraint_Error; + end if; + + Year := ((YYYYMMDD - Day - Month * 100) / 10000); + if Year < 1901 or Year > 2399 then + Ada.Text_IO.Put("ERROR: Invalid Year:" & Integer'Image(Year)); + raise Constraint_Error; + end if; + + Test_Day := Time_Of (Year => Year, Month => Month, Day => Day); + + Convert (From => Test_Day, To => Test_DDay); + Put (Test_DDay); + + end loop; + end Discordian; diff --git a/Task/Discordian-date/Batch-File/discordian-date.bat b/Task/Discordian-date/Batch-File/discordian-date.bat new file mode 100644 index 0000000000..70e00bf6a3 --- /dev/null +++ b/Task/Discordian-date/Batch-File/discordian-date.bat @@ -0,0 +1,177 @@ +@echo off +goto Parse + + Discordian Date Converter: + + Usage: + ddate + ddate /v + ddate /d isoDate + ddate /v /d isoDate + +:Parse + shift + if "%0"=="" goto Prologue + if "%0"=="/v" set Verbose=1 + if "%0"=="/d" set dateToTest=%1 + if "%0"=="/d" shift +goto Parse + +:Prologue + if "%dateToTest%"=="" set dateToTest=%date% + for %%a in (GYear GMonth GDay GMonthName GWeekday GDayThisYear) do set %%a=fnord + for %%a in (DYear DMonth DDay DMonthName DWeekday) do set %%a=MUNG +goto Start + +:Start + for /f "tokens=1,2,3 delims=/:;-. " %%a in ('echo %dateToTest%') do ( + set GYear=%%a + set GMonth=%%b + set GDay=%%c + ) +goto GMonthName + +:GMonthName + if %GMonth% EQU 1 set GMonthName=January + if %GMonth% EQU 2 set GMonthName=February + if %GMonth% EQU 3 set GMonthName=March + if %GMonth% EQU 4 set GMonthName=April + if %GMonth% EQU 5 set GMonthName=May + if %GMonth% EQU 6 set GMonthName=June + if %GMonth% EQU 7 set GMonthName=July + if %GMonth% EQU 8 set GMonthName=August + if %GMonth% EQU 9 set GMonthName=September + if %GMonth% EQU 10 set GMonthName=October + if %GMonth% EQU 11 set GMonthName=November + if %GMonth% EQU 12 set GMonthName=December +goto GLeap + +:GLeap + set /a CommonYear=GYear %% 4 + set /a CommonCent=GYear %% 100 + set /a CommonQuad=GYear %% 400 + set GLeap=0 + if %CommonYear% EQU 0 set GLeap=1 + if %CommonCent% EQU 0 set GLeap=0 + if %CommonQuad% EQU 0 set GLeap=1 +goto GDayThisYear + +:GDayThisYear + set GDayThisYear=%GDay% + if %GMonth% GTR 11 set /a GDayThisYear=%GDayThisYear%+30 + if %GMonth% GTR 10 set /a GDayThisYear=%GDayThisYear%+31 + if %GMonth% GTR 9 set /a GDayThisYear=%GDayThisYear%+30 + if %GMonth% GTR 8 set /a GDayThisYear=%GDayThisYear%+31 + if %GMonth% GTR 7 set /a GDayThisYear=%GDayThisYear%+31 + if %GMonth% GTR 6 set /a GDayThisYear=%GDayThisYear%+30 + if %GMonth% GTR 5 set /a GDayThisYear=%GDayThisYear%+31 + if %GMonth% GTR 4 set /a GDayThisYear=%GDayThisYear%+30 + if %GMonth% GTR 3 set /a GDayThisYear=%GDayThisYear%+31 + if %GMonth% GTR 2 if %GLeap% EQU 1 set /a GDayThisYear=%GDayThisYear%+29 + if %GMonth% GTR 2 if %GLeap% EQU 0 set /a GDayThisYear=%GDayThisYear%+28 + if %GMonth% GTR 1 set /a GDayThisYear=%GDayThisYear%+31 +goto DYear + +:DYear + set /a DYear=GYear+1166 +goto DMonth + +:DMonth + set DMonth=1 + set DDay=%GDayThisYear% + if %DDay% GTR 73 ( + set /a DDay=%DDay%-73 + set /a DMonth=%DMonth%+1 + ) + if %DDay% GTR 73 ( + set /a DDay=%DDay%-73 + set /a DMonth=%DMonth%+1 + ) + if %DDay% GTR 73 ( + set /a DDay=%DDay%-73 + set /a DMonth=%DMonth%+1 + ) + if %DDay% GTR 73 ( + set /a DDay=%DDay%-73 + set /a DMonth=%DMonth%+1 + ) +goto DDay + +:DDay + if %GLeap% EQU 1 ( + if %GDayThisYear% GEQ 61 ( + set /a DDay=%DDay%-1 + ) + ) + if %DDay% EQU 0 ( + set /a DDay=73 + set /a DMonth=%DMonth%-1 + ) +goto DMonthName + +:DMonthName + if %DMonth% EQU 1 set DMonthName=Chaos + if %DMonth% EQU 2 set DMonthName=Discord + if %DMonth% EQU 3 set DMonthName=Confusion + if %DMonth% EQU 4 set DMonthName=Bureaucracy + if %DMonth% EQU 5 set DMonthName=Aftermath +goto DTib + +:DTib + set DTib=0 + if %GDayThisYear% EQU 60 if %GLeap% EQU 1 set DTib=1 + if %GLeap% EQU 1 if %GDayThisYear% GTR 60 set /a GDayThisYear=%GDayThisYear%-1 + set DWeekday=%GDayThisYear% +goto DWeekday + +:DWeekday + if %DWeekday% LEQ 5 goto _DWeekday + set /a DWeekday=%DWeekday%-5 + goto DWeekday +:_DWeekday + if %DWeekday% EQU 1 set DWeekday=Sweetmorn + if %DWeekday% EQU 2 set DWeekday=Boomtime + if %DWeekday% EQU 3 set DWeekday=Pungenday + if %DWeekday% EQU 4 set DWeekday=Prickle-Prickle + if %DWeekday% EQU 5 set DWeekday=Setting Orange +goto GWeekday + +:GWeekday +goto GEnding + +:GEnding + set GEnding=th + for %%a in (1 21 31) do if %GDay% EQU %%a set GEnding=st + for %%a in (2 22) do if %GDay% EQU %%a set GEnding=nd + for %%a in (3 23) do if %GDay% EQU %%a set GEnding=rd +goto DEnding + +:DEnding + set DEnding=th + for %%a in (1 21 31 41 51 61 71) do if %Dday% EQU %%a set DEnding=st + for %%a in (2 22 32 42 52 62 72) do if %Dday% EQU %%a set DEnding=nd + for %%a in (3 23 33 43 53 63 73) do if %Dday% EQU %%a set DEnding=rd +goto Display + +:Display + if "%Verbose%"=="1" goto Display2 + echo. + if %DTib% EQU 1 ( + echo St. Tib's Day, %DYear% + ) else echo %DWeekday%, %DMonthName% %DDay%%DEnding%, %DYear% +goto Epilogue + +:Display2 + echo. + echo Gregorian: %GMonthName% %GDay%%GEnding%, %GYear% + if %DTib% EQU 1 ( + echo Discordian: St. Tib's Day, %DYear% + ) else echo Discordian: %DWeekday%, %DMonthName% %DDay%%DEnding%, %DYear% +goto Epilogue + +:Epilogue +set Verbose= +set dateToTest= +echo. + +:End diff --git a/Task/Discordian-date/C/discordian-date.c b/Task/Discordian-date/C/discordian-date.c index 3b7d51c958..4286b910b5 100644 --- a/Task/Discordian-date/C/discordian-date.c +++ b/Task/Discordian-date/C/discordian-date.c @@ -2,6 +2,12 @@ #include #include +#define day_of_week( x ) ((x) == 1 ? "Sweetmorn" :\ + (x) == 2 ? "Boomtime" :\ + (x) == 3 ? "Pungenday" :\ + (x) == 4 ? "Prickle-Prickle" :\ + "Setting Orange") + #define season( x ) ((x) == 0 ? "Chaos" :\ (x) == 1 ? "Discord" :\ (x) == 2 ? "Confusion" :\ @@ -25,7 +31,8 @@ char * ddate( int y, int d ){ } } - sprintf( result, "%s %d, YOLD %d", season( d/73 ), date( d ), dyear ); + sprintf( result, "%s, %s %d, YOLD %d", + day_of_week(d%5), season(((d%73)==0?d-1:d)/73 ), date( d ), dyear ); return result; } diff --git a/Task/Discordian-date/D/discordian-date.d b/Task/Discordian-date/D/discordian-date.d index df54c37d88..15ae85f7a6 100644 --- a/Task/Discordian-date/D/discordian-date.d +++ b/Task/Discordian-date/D/discordian-date.d @@ -20,13 +20,13 @@ string discordianDate(in Date date) pure { date.dayOfYear - 1 : date.dayOfYear; - immutable dsDay = doy % 73; // Season day. + immutable dsDay = (doy % 73)==0? 73:(doy % 73); // Season day. if (dsDay == 5) return apostle[doy / 73] ~ ", in the YOLD " ~ dYear; if (dsDay == 50) return holiday[doy / 73] ~ ", in the YOLD " ~ dYear; - immutable dSeas = seasons[doy / 73]; + immutable dSeas = seasons[(((doy%73)==0)?doy-1:doy) / 73]; immutable dWday = weekday[(doy - 1) % 5]; return format("%s, day %s of %s in the YOLD %s", @@ -48,6 +48,33 @@ unittest { "Discoflux, in the YOLD 3177"); } -void main() { - (cast(Date)Clock.currTime).discordianDate.writeln; +void main(string args[]) { + int yyyymmdd, day, mon, year, sign; + if (args.length == 1) { + (cast(Date)Clock.currTime).discordianDate.writeln; + return; + } + foreach (i, arg; args) { + if (i > 0) { + //writef("%d: %s: ", i, arg); + yyyymmdd = to!int(arg); + if (yyyymmdd < 0) { + sign = -1; + yyyymmdd = -yyyymmdd; + } + else { + sign = 1; + } + day = yyyymmdd % 100; + if (day == 0) { + day = 1; + } + mon = ((yyyymmdd - day) / 100) % 100; + if (mon == 0) { + mon = 1; + } + year = sign * ((yyyymmdd - day - 100*mon) / 10000); + writefln("%s", Date(year, mon, day).discordianDate); + } + } } diff --git a/Task/Discordian-date/Haskell/discordian-date-1.hs b/Task/Discordian-date/Haskell/discordian-date-1.hs new file mode 100644 index 0000000000..aa8f57d144 --- /dev/null +++ b/Task/Discordian-date/Haskell/discordian-date-1.hs @@ -0,0 +1,44 @@ +import Data.Time (isLeapYear) +import Data.Time.Calendar.MonthDay (monthAndDayToDayOfYear) +import Text.Printf (printf) + +type Year = Integer +type Day = Int +type Month = Int + +data DDate = DDate Weekday Season Day Year + | StTibsDay Year deriving (Eq, Ord) + +data Season = Chaos + | Discord + | Confusion + | Bureaucracy + | TheAftermath + deriving (Show, Enum, Eq, Ord, Bounded) + +data Weekday = Sweetmorn + | Boomtime + | Pungenday + | PricklePrickle + | SettingOrange + deriving (Show, Enum, Eq, Ord, Bounded) + +instance Show DDate where + show (StTibsDay y) = printf "St. Tib's Day, %d YOLD" y + show (DDate w s d y) = printf "%s, %s %d, %d YOLD" (show w) (show s) d y + +fromYMD :: (Year, Month, Day) -> DDate +fromYMD (y, m, d) + | leap && dayOfYear == 59 = StTibsDay yold + | leap && dayOfYear >= 60 = mkDDate $ dayOfYear - 1 + | otherwise = mkDDate dayOfYear + where + yold = y + 1166 + dayOfYear = monthAndDayToDayOfYear leap m d - 1 + leap = isLeapYear y + + mkDDate dayOfYear = DDate weekday season dayOfSeason yold + where + weekday = toEnum $ dayOfYear `mod` 5 + season = toEnum $ dayOfYear `div` 73 + dayOfSeason = 1 + dayOfYear `mod` 73 diff --git a/Task/Discordian-date/Haskell/discordian-date-2.hs b/Task/Discordian-date/Haskell/discordian-date-2.hs new file mode 100644 index 0000000000..028c957fdb --- /dev/null +++ b/Task/Discordian-date/Haskell/discordian-date-2.hs @@ -0,0 +1,11 @@ +test = mapM_ display dates + where + display d = putStr (show d ++ " -> ") >> print (fromYMD d) + dates = [(2012,2,28) + ,(2012,2,29) + ,(2012,3,1) + ,(2012,3,14) + ,(2012,3,15) + ,(2010,9,2) + ,(2010,12,31) + ,(2011,1,1)] diff --git a/Task/Discordian-date/Haskell/discordian-date.hs b/Task/Discordian-date/Haskell/discordian-date.hs deleted file mode 100644 index c74545f458..0000000000 --- a/Task/Discordian-date/Haskell/discordian-date.hs +++ /dev/null @@ -1,14 +0,0 @@ -import Data.List -import Data.Time -import Data.Time.Calendar.MonthDay - -seasons = words "Chaos Discord Confusion Bureaucracy The_Aftermath" - -discordianDate (y,m,d) = do - let doy = monthAndDayToDayOfYear (isLeapYear y) m d - (season, dday) = divMod doy 73 - dos = dday - fromEnum (isLeapYear y && m >2) - dDate - | isLeapYear y && m==2 && d==29 = "St. Tib's Day, " ++ show (y+1166) ++ " YOLD" - | otherwise = seasons!!season ++ " " ++ show dos ++ ", " ++ show (y+1166) ++ " YOLD" - putStrLn dDate diff --git a/Task/Discordian-date/Java/discordian-date.java b/Task/Discordian-date/Java/discordian-date.java index 3deb9ebf86..0bc927e196 100644 --- a/Task/Discordian-date/Java/discordian-date.java +++ b/Task/Discordian-date/Java/discordian-date.java @@ -2,7 +2,6 @@ import java.util.Calendar; import java.util.GregorianCalendar; public class DiscordianDate { - final static String[] seasons = {"Chaos", "Discord", "Confusion", "Bureaucracy", "The Aftermath"}; diff --git a/Task/Discordian-date/JavaScript/discordian-date-1.js b/Task/Discordian-date/JavaScript/discordian-date-1.js index 953d91ea84..606c75e319 100644 --- a/Task/Discordian-date/JavaScript/discordian-date-1.js +++ b/Task/Discordian-date/JavaScript/discordian-date-1.js @@ -1,49 +1,72 @@ /** * All Hail Discordia! - this script prints Discordian date using system date. - * author: s1w_, lang: JavaScript + * author: jklu, lang: JavaScript */ -function print_ddate(mod) { - var p; - switch(mod || 0) {// <--choose display pattern or pass option by parameter - default: - case 0:/* Sweetmorn, Day 57 of the Season of Confusion, Anno Mung 3177 */ p="{0}, [Day {1} of the Season of {2}], Anno Mung {3}"; break; - case 1:/* Sweetmorn, The 57th Day of Confusion, 3177 YOLD */ p="{0}, [The {1}th Day of {2}], {3} YOLD"; break; - case 2:/* Sweetmorn, the 57th day of Confusion, AM 3177 */ p="{0}, [the {1}th day of {2}], AM {3}"; break; - case 3:/* Sweetmorn / Confusion 57th / AM 3177 */ p="{0} / [{2} {1}th] / AM {3}"; break; - } - var ddateStr, curr, sum, extra, today, day, month, year, dSeason, dDay, season, ddate, dyear; +var seasons = ["Chaos", "Discord", "Confusion", + "Bureaucracy", "The Aftermath"]; +var weekday = ["Sweetmorn", "Boomtime", "Pungenday", + "Prickle-Prickle", "Setting Orange"]; - format = function(s, $1, $2, $3, $4) { - if ($2 != undefined) { - var postfix; - switch(parseInt($2.charAt($2.length-1))) { - case 1: postfix = '}st'; break; - case 2: postfix = '}nd'; break; - case 3: postfix = '}rd'; break; - default:postfix = '}th'; - } - return p.replace(/\}th/, postfix).replace(/(\[|\])/g, '').format($1, $2, $3, $4); - } - else return p.replace(/\[.*?\]/,"{2}").format($1, $2, $3, $4); - } +var apostle = ["Mungday", "Mojoday", "Syaday", + "Zaraday", "Maladay"]; - String.prototype.format = function() { - var pattern = /\{\d+\}/g; - var args = arguments; - return this.replace(pattern, function(capture){ return args[capture.match(/\d+/)]; }); - } +var holiday = ["Chaoflux", "Discoflux", "Confuflux", + "Bureflux", "Afflux"]; - dDay = new Array("Sweetmorn", "Boomtime", "Pungenday", "Prickle-Prickle", "Setting Orange"); - dSeason = new Array("Chaos", "Discord", "Confusion", "Bureaucracy", "Aftermath"); - curr = new Date(); extra = new Array(0,3,0,3,2,3,2,3,3,2,3,2); - today = curr.getDate(); month = curr.getMonth(); year = curr.getFullYear(); - sum = month * 28; - for(var i=0; i<=month; i++) - sum += extra[i]; - sum += today; - day = (sum - 1) % 5; ddate = sum % 73; - season = (month==1)&&(today==29) ? "St. Tib\'s Day" : dSeason[Math.floor(sum/73)]; - dyear = year+1166; - ddateStr = ""+dDay[day]+ddate+season+dyear; - document.write(ddateStr.replace(/(\D+)(?:(\d+)(?!St)|(?:\d+))(\D+)(\d+)/i, format)); + +Date.prototype.isLeapYear = function() { + var year = this.getFullYear(); + if ((year & 3) !== 0) return false; + return ((year % 100) !== 0 || (year % 400) === 0); +}; + +// Get Day of Year +Date.prototype.getDOY = function() { + var dayCount = [0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334]; + var mn = this.getMonth(); + var dn = this.getDate(); + var dayOfYear = dayCount[mn] + dn; + if (mn > 1 && this.isLeapYear()) dayOfYear++; + return dayOfYear; +}; + +function discordianDate(date) { + var y = date.getFullYear(); + var yold = y + 1166; + var dayOfYear = date.getDOY(); + + if (date.isLeapYear()) { + if (dayOfYear == 60) + return "St. Tib's Day, in the YOLD " + yold; + else if (dayOfYear > 60) + dayOfYear--; + } + dayOfYear--; + + var divDay= Math.floor(dayOfYear/73); + + var seasonDay = (dayOfYear % 73) + 1; + if (seasonDay == 5) + return apostle[divDay] + ", in the YOLD " + yold; + if (seasonDay == 50) + return holiday[divDay] + ", in the YOLD " + yold; + + var season = seasons[divDay]; + var dayOfWeek = weekday[dayOfYear % 5]; + + return dayOfWeek + ", day " + seasonDay + " of " + + season + " in the YOLD " + yold; } + +function test(y, m, d, result) { + console.assert((discordianDate(new Date(y, m, d)) == result), result); +} + +console.log(discordianDate(new Date(Date.now()))); +test(2010, 6, 22, "Pungenday, day 57 of Confusion in the YOLD 3176"); +test(2012, 1, 28, "Prickle-Prickle, day 59 of Chaos in the YOLD 3178"); +test(2012, 1, 29, "St. Tib's Day, in the YOLD 3178"); +test(2012, 2, 1, "Setting Orange, day 60 of Chaos in the YOLD 3178"); +test(2010, 0, 5, "Mungday, in the YOLD 3176"); +test(2011, 4, 3, "Discoflux, in the YOLD 3177"); +test(2015, 9, 19, "Boomtime, day 73 of Bureaucracy in the YOLD 3181"); diff --git a/Task/Discordian-date/JavaScript/discordian-date-2.js b/Task/Discordian-date/JavaScript/discordian-date-2.js index 3c654e9faf..d49e0f9154 100644 --- a/Task/Discordian-date/JavaScript/discordian-date-2.js +++ b/Task/Discordian-date/JavaScript/discordian-date-2.js @@ -1,8 +1,2 @@ -print_ddate() -"Sweetmorn, Day 57 of the Season of Confusion, Anno Mung 3177" -print_ddate(1) -"Sweetmorn, The 57th Day of Confusion, 3177 YOLD" -print_ddate(2) -"Sweetmorn, the 57th day of Confusion, AM 3177" -print_ddate(3) -"Sweetmorn / Confusion 57th / AM 3177" +console.log(discordianDate(new Date(Date.now()))); +"Prickle-Prickle, day 47 of The Aftermath in the YOLD 3181" diff --git a/Task/Discordian-date/Kotlin/discordian-date.kotlin b/Task/Discordian-date/Kotlin/discordian-date.kotlin new file mode 100644 index 0000000000..14e3a57ca7 --- /dev/null +++ b/Task/Discordian-date/Kotlin/discordian-date.kotlin @@ -0,0 +1,55 @@ +import java.util.Calendar +import java.util.GregorianCalendar + +enum class Season { + Chaos, Discord, Confusion, Bureaucracy, Aftermath; + companion object { fun from(i: Int) = values()[i / 73] } +} +enum class Weekday { + Sweetmorn, Boomtime, Pungenday, Prickle_Prickle, Setting_Orange; + companion object { fun from(i: Int) = values()[i % 5] } +} +enum class Apostle { + Mungday, Mojoday, Syaday, Zaraday, Maladay; + companion object { fun from(i: Int) = values()[i / 73] } +} +enum class Holiday { + Chaoflux, Discoflux, Confuflux, Bureflux, Afflux; + companion object { fun from(i: Int) = values()[i / 73] } +} + +fun GregorianCalendar.discordianDate(): String { + val y = get(Calendar.YEAR) + val yold = y + 1166 + + var dayOfYear = get(Calendar.DAY_OF_YEAR) + if (isLeapYear(y)) { + if (dayOfYear == 60) + return "St. Tib's Day, in the YOLD " + yold + else if (dayOfYear > 60) + dayOfYear-- + } + + val seasonDay = --dayOfYear % 73 + 1 + return when (seasonDay) { + 5 -> "" + Apostle.from(dayOfYear) + ", in the YOLD " + yold + 50 -> "" + Holiday.from(dayOfYear) + ", in the YOLD " + yold + else -> "" + Weekday.from(dayOfYear) + ", day " + seasonDay + " of " + Season.from(dayOfYear) + " in the YOLD " + yold + } +} + +internal fun test(y: Int, m: Int, d: Int, result: String) { + assert(GregorianCalendar(y, m, d).discordianDate() == result) +} + +fun main(args: Array) { + println(GregorianCalendar().discordianDate()) + + test(2010, 6, 22, "Pungenday, day 57 of Confusion in the YOLD 3176") + test(2012, 1, 28, "Prickle-Prickle, day 59 of Chaos in the YOLD 3178") + test(2012, 1, 29, "St. Tib's Day, in the YOLD 3178") + test(2012, 2, 1, "Setting Orange, day 60 of Chaos in the YOLD 3178") + test(2010, 0, 5, "Mungday, in the YOLD 3176") + test(2011, 4, 3, "Discoflux, in the YOLD 3177") + test(2015, 9, 19, "Boomtime, day 73 of Bureaucracy in the YOLD 3181") +} diff --git a/Task/Discordian-date/Maple/discordian-date.maple b/Task/Discordian-date/Maple/discordian-date.maple new file mode 100644 index 0000000000..5d75cf015b --- /dev/null +++ b/Task/Discordian-date/Maple/discordian-date.maple @@ -0,0 +1,37 @@ +convertDiscordian := proc(year, month, day) + local days31, days30, daysThisYear, i, dYear, dMonth, dDay, seasons, week, dayOfWeek; + days31 := [1, 3, 5, 7, 8, 10, 12]; + days30 := [4, 6, 9, 11]; + if month < 1 or month >12 then + error "Invalid month: %1", month; + end if; + if (member(month, days31) and day > 31) or (member(month, days30) and day > 30) or (month = 2 and day > 29) or day < 1 then + error "Invalid date: %1", day; + end if; + dYear := year + 1166; + if month = 2 and day = 29 then + printf("The date is St. Tib's Day, YOLD %a.\n", dYear); + else + seasons := ["Chaos", "Discord", "Confusion", "Bureaucracy", "The Aftermath"]; + week := ["Sweetmorn", "Boomtime", "Pungenday", "Prickle-Prickle", "Setting Orange"]; + daysThisYear := 0; + for i to month-1 do + if member(i, days31) then + daysThisYear := daysThisYear + 31; + elif member(i, days30) then + daysThisYear := daysThisYear + 30; + else + daysThisYear := daysThisYear + 28; + end if; + end do; + daysThisYear := daysThisYear + day -1; + dMonth := seasons[trunc((daysThisYear) / 73)+1]; + dDay := daysThisYear mod 73 +1; + dayOfWeek := week[daysThisYear mod 5 +1]; + printf("The date is %s %s %s, YOLD %a.\n", dayOfWeek, dMonth, convert(dDay, ordinal), dYear); + end if; +end proc: + +convertDiscordian (2016, 1, 1); +convertDiscordian (2016, 2, 29); +convertDiscordian (2016, 12, 31); diff --git a/Task/Discordian-date/Perl-6/discordian-date.pl6 b/Task/Discordian-date/Perl-6/discordian-date.pl6 index 76f831b553..a1fdf7e25c 100644 --- a/Task/Discordian-date/Perl-6/discordian-date.pl6 +++ b/Task/Discordian-date/Perl-6/discordian-date.pl6 @@ -1,5 +1,5 @@ -my @seasons = ['Chaos', 'Discord', 'Confusion', 'Bureaucracy', 'The Aftermath']; -my @days = ['Sweetmorn', 'Boomtime', 'Pungenday', 'Prickle-Prickle', 'Setting Orange']; +my @seasons = << Chaos Discord Confusion Bureaucracy 'The Aftermath' >>; +my @days = << Sweetmorn Boomtime Pungenday Prickle-Prickle 'Setting Orange' >>; sub ordinal ( Int $n ) { $n ~ ( $n % 100 == 11|12|13 ?? 'th' !! < th st nd rd th th th th th th >[$n % 10] ) } diff --git a/Task/Discordian-date/PowerShell/discordian-date.psh b/Task/Discordian-date/PowerShell/discordian-date.psh new file mode 100644 index 0000000000..63a8f8df77 --- /dev/null +++ b/Task/Discordian-date/PowerShell/discordian-date.psh @@ -0,0 +1,22 @@ +function ConvertTo-Discordian ( [datetime]$GregorianDate ) +{ +$DayOfYear = $GregorianDate.DayOfYear +$Year = $GregorianDate.Year + 1166 +If ( [datetime]::IsLeapYear( $GregorianDate.Year ) -and $DayOfYear -eq 60 ) + { $Day = "St. Tib's Day" } +Else + { + If ( [datetime]::IsLeapYear( $GregorianDate.Year ) -and $DayOfYear -gt 60 ) + { $DayOfYear-- } + $Weekday = @( 'Sweetmorn', 'Boomtime', 'Pungenday', 'Prickle-Prickle', 'Setting Orange' )[(($DayOfYear - 1 ) % 5 )] + $Season = @( 'Chaos', 'Discord', 'Confusion', 'Bureaucracy', 'The Aftermath' )[( [math]::Truncate( ( $DayOfYear - 1 ) / 73 ) )] + $DayOfSeason = ( $DayOfYear - 1 ) % 73 + 1 + $Day = "$Weekday, $Season $DayOfSeason" + } +$DiscordianDate = "$Day, $Year YOLD" +return $DiscordianDate +} + +ConvertTo-Discordian ([datetime]'1/5/2016') +ConvertTo-Discordian ([datetime]'2/29/2016') +ConvertTo-Discordian ([datetime]'12/8/2016') diff --git a/Task/Discordian-date/REXX/discordian-date.rexx b/Task/Discordian-date/REXX/discordian-date.rexx index 3c152048da..147450a17a 100644 --- a/Task/Discordian-date/REXX/discordian-date.rexx +++ b/Task/Discordian-date/REXX/discordian-date.rexx @@ -1,35 +1,34 @@ -/*REXX program converts a mm/dd/yyyy Gregorian date ───► Discordian date. */ -@day.1= 'Sweetness' /*define the 1st day─of─Discordian─week*/ -@day.2= 'Boomtime' /* " " 2nd " " " " */ -@day.3= 'Pungenday' /* " " 3rd " " " " */ -@day.4= 'Prickle-Prickle' /* " " 4th " " " " */ -@day.5= 'Setting Orange' /* " " 5th " " " " */ +/*REXX program converts a mm/dd/yyyy Gregorian date ───► a Discordian date. */ + @day.1= 'Sweetness' /*define the 1st day─of─Discordian─week*/ + @day.2= 'Boomtime' /* " " 2nd " " " " */ + @day.3= 'Pungenday' /* " " 3rd " " " " */ + @day.4= 'Prickle-Prickle' /* " " 4th " " " " */ + @day.5= 'Setting Orange' /* " " 5th " " " " */ -@seas.0= "St. Tib's day," /*define the leap─day of Discordian yr.*/ -@seas.1= 'Chaos' /* " 1st season─of─Discordian─year.*/ -@seas.2= 'Discord' /* " 2nd " " " " */ -@seas.3= 'Confusion' /* " 3rd " " " " */ -@seas.4= 'Bureaucracy' /* " 4th " " " " */ -@seas.5= 'The Aftermath' /* " 5th " " " " */ +@seas.0= "St. Tib's day," /*define the leap─day of Discordian yr.*/ +@seas.1= 'Chaos' /* " 1st season─of─Discordian─year.*/ +@seas.2= 'Discord' /* " 2nd " " " " */ +@seas.3= 'Confusion' /* " 3rd " " " " */ +@seas.4= 'Bureaucracy' /* " 4th " " " " */ +@seas.5= 'The Aftermath' /* " 5th " " " " */ -parse arg gM '/' gD "/" gY . /*get the specified Gregorian date*/ -if gM=='' | gM=='*' then parse value date('U') with gM '/' gD "/" gY . +parse arg gM '/' gD "/" gY . /*obtain the specified Gregorian date. */ +if gM=='' | gM=='*' then parse value date('U') with gM '/' gD "/" gY . -gY=left(right(date(),4),4-length(Gy))gY /*adjust for 2─digit year or none.*/ +gY=left( right( date(), 4), 4 - length(Gy) )gY /*adjust for two─digit year or none. */ - /* [↓] day─of─year, leapyear adj.*/ -doy=date('d',gY || right(gM,2,0)right(gD,2,0), "s") - (leapyear(gY) & gM>2) + /* [↓] day─of─year, leapyear adjust. */ +doy=date('d', gY || right(gM, 2, 0)right(gD ,2, 0), "s") - (leapyear(gY) & gM>2) -dW=doy//5; if dW==0 then dW=5 /*compute the Discordian weekday. */ -dS=(doy-1)%73+1 /* " " " season. */ -dD=doy//73; if dD==0 then dD=73 /*compute Discordian day─of─month.*/ -dD=dD',' /*append a comma to Discordian day*/ -if leapyear(gY) & gM=2 & gD=29 then ds=0 /*is this St. Tib's day (leapday)?*/ -if ds==0 then dD= /*adjust for Discordian leap day. */ +dW=doy//5; if dW==0 then dW=5 /*compute the Discordian weekday. */ +dS=(doy-1)%73+1 /* " " " season. */ +dD=doy//73; if dD==0 then dD=73 /* " " " day─of─month. */ +if leapyear(gY) & gM=2 & gD=29 then ds=0 /*is this St. Tib's day (leapday) ? */ +if ds==0 then dD= /*adjust for the Discordian leap day. */ -say space(@day.dW',' @seas.dS dD gY+1166) /*display the Discordian date. */ -exit /*stick a fork in it, we're done.*/ -/*────────────────────────────────────────────────────────────────────────────*/ -leapyear: procedure; parse arg y /*obtain four-digit Gregorian year*/ - if y//4\==0 then return 0 /*Not ÷ by 4? Not a leapyear.*/ - return y//100\==0 | y//400==0 /*apply the 100 and 400 year rule.*/ +say space(@day.dW',' @seas.dS dD"," gY +1166) /*display Discordian date to terminal. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +leapyear: procedure; parse arg y /*obtain a four─digit Gregorian year. */ + if y//4\==0 then return 0 /*Not ÷ by 4? Then not a leapyear. */ + return y//100\==0 | y//400==0 /*apply the 100 and 400 year rules.*/ diff --git a/Task/Discordian-date/Ruby/discordian-date-1.rb b/Task/Discordian-date/Ruby/discordian-date-1.rb index 3a9c77b8e6..4aba463f37 100644 --- a/Task/Discordian-date/Ruby/discordian-date-1.rb +++ b/Task/Discordian-date/Ruby/discordian-date-1.rb @@ -21,7 +21,8 @@ class DiscordianDate end end - @season, @day = @day_of_year.divmod(DAYS_PER_SEASON) + @season, @day = (@day_of_year-1).divmod(DAYS_PER_SEASON) + @day += 1 #← ↑ fixes of-by-one error (only visible at season changes) @year = gregorian_date.year + YEAR_OFFSET end attr_reader :year, :day diff --git a/Task/Discordian-date/Ruby/discordian-date-2.rb b/Task/Discordian-date/Ruby/discordian-date-2.rb index d00dfb4cb1..0dfc94ce40 100644 --- a/Task/Discordian-date/Ruby/discordian-date-2.rb +++ b/Task/Discordian-date/Ruby/discordian-date-2.rb @@ -1,4 +1,4 @@ -[[2012, 2, 28], [2012, 2, 29], [2012, 3, 1], [2011, 10, 5]].each do |date| +[[2012, 2, 28], [2012, 2, 29], [2012, 3, 1], [2011, 10, 5], [2015, 10, 19]].each do |date| dd = DiscordianDate.new(*date) puts "#{"%4d-%02d-%02d" % date} => #{dd}" end diff --git a/Task/Discordian-date/Scala/discordian-date-1.scala b/Task/Discordian-date/Scala/discordian-date-1.scala index 27093e6b97..3d4897b279 100644 --- a/Task/Discordian-date/Scala/discordian-date-1.scala +++ b/Task/Discordian-date/Scala/discordian-date-1.scala @@ -1,4 +1,11 @@ - val DISCORDIAN_SEASONS = Array("Chaos", "Discord", "Confusion", "Bureaucracy", "The Aftermath") +package rosetta + +import java.util.GregorianCalendar +import java.util.Calendar + +object DDate extends App { + private val DISCORDIAN_SEASONS = Array("Chaos", "Discord", "Confusion", "Bureaucracy", "The Aftermath") + // month from 1-12; day from 1-31 def ddate(year: Int, month: Int, day: Int): String = { val date = new GregorianCalendar(year, month - 1, day) @@ -8,12 +15,20 @@ if (isLeapYear && month == 2 && day == 29) // 2 means February "St. Tib's Day " + dyear + " YOLD" else { - var dayOfYear = date.get(Calendar.DAY_OF_YEAR) + var dayOfYear = date.get(Calendar.DAY_OF_YEAR) - 1 if (isLeapYear && dayOfYear >= 60) dayOfYear -= 1 // compensate for St. Tib's Day val dday = dayOfYear % 73 val season = dayOfYear / 73 - "%s %d, %d YOLD".format(DISCORDIAN_SEASONS(season), dday, dyear) + "%s %d, %d YOLD".format(DISCORDIAN_SEASONS(season), dday + 1, dyear) } } + if (args.length == 3) + println(ddate(args(2).toInt, args(1).toInt, args(0).toInt)) + else if (args.length == 0) { + val today = Calendar.getInstance + println(ddate(today.get(Calendar.YEAR), today.get(Calendar.MONTH)+1, today.get(Calendar.DAY_OF_MONTH))) + } else + println("usage: DDate [day month year]") +} diff --git a/Task/Discordian-date/Scala/discordian-date-2.scala b/Task/Discordian-date/Scala/discordian-date-2.scala index bb64fabd51..c5169456cf 100644 --- a/Task/Discordian-date/Scala/discordian-date-2.scala +++ b/Task/Discordian-date/Scala/discordian-date-2.scala @@ -1,4 +1,10 @@ -ddate(2010, 7, 22) // Confusion 57, 3176 YOLD -ddate(2012, 2, 28) // Chaos 59, 3178 YOLD -ddate(2012, 2, 29) // St. Tib's Day 3178 YOLD -ddate(2012, 3, 1) // Chaos 60, 3178 YOLD +scala rosetta.DDate 2010 7 22 +Confusion 57, 3176 YOLD +scala rosetta.DDate 28 2 2012 +Chaos 59, 3178 YOLD +scala rosetta.DDate 29 2 2012 +St. Tib's Day 3178 YOLD +scala rosetta.DDate 1 3 2012 +Chaos 60, 3178 YOLD +scala rosetta.DDate 19 10 2015 +Bureaucracy 73, 3181 YOLD diff --git a/Task/Documentation/00DESCRIPTION b/Task/Documentation/00DESCRIPTION index 56b2fc280b..34c321b7a8 100644 --- a/Task/Documentation/00DESCRIPTION +++ b/Task/Documentation/00DESCRIPTION @@ -1,4 +1,7 @@ Show how to insert documentation for classes, functions, and/or variables in your language. If this documentation is built-in to the language, note it. If this documentation requires external tools, note them. -'''See Also:'''
    -* Related Task: [[Comments]] + +;See also: +* Related task: [[Comments]] +* Related task: [[Here_document]] +

    diff --git a/Task/Documentation/COBOL/documentation-1.cobol b/Task/Documentation/COBOL/documentation-1.cobol new file mode 100644 index 0000000000..251a23b04e --- /dev/null +++ b/Task/Documentation/COBOL/documentation-1.cobol @@ -0,0 +1,57 @@ + *>****L* cobweb/cobweb-gtk [0.2] + *> Author: + *> Author details + *> Colophon: + *> Part of the GnuCobol free software project + *> Copyright (C) 2014 person + *> Date 20130308 + *> Modified 20141003 + *> License GNU General Public License, GPL, 3.0 or greater + *> Documentation licensed GNU FDL, version 2.1 or greater + *> HTML Documentation thanks to ROBODoc --cobol + *> Purpose: + *> GnuCobol functional bindings to GTK+ + *> Main module includes paperwork output and self test + *> Synopsis: + *> |dotfile cobweb-gtk.dot + *> |html
    + *> Functions include + *> |exec cobcrun cobweb-gtk >cobweb-gtk.repository + *> |html
    +      *> |copy cobweb-gtk.repository
    +      *> |html 
    + *> |exec rm cobweb-gtk.repository + *> Tectonics: + *> cobc -v -b -g -debug cobweb-gtk.cob voidcall_gtk.c + *> `pkg-config --libs gtk+-3.0` -lvte2_90 -lyelp + *> robodoc --cobol --src ./ --doc cobwebgtk --multidoc --rc robocob.rc --css cobodoc.css + *> cobc -E -Ddocpass cobweb-gtk.cob + *> make singlehtml # once Sphinx set up to read cobweb-gtk.i + *> Example: + *> COPY cobweb-gtk-preamble. + *> procedure division. + *> move TOP-LEVEL to window-type + *> move 640 to width-hint + *> move 480 to height-hint + *> move new-window("window title", window-type, + *> width-hint, height-hint) + *> to gtk-window-data + *> move gtk-go(gtk-window) to extraneous + *> goback. + *> Notes: + *> The interface signatures changed between 0.1 and 0.2 + *> Screenshot: + *> image:cobweb-gtk1.png + *> Source: + REPLACE ==FIELDSIZE== BY ==80== + ==AREASIZE== BY ==32768== + ==FILESIZE== BY ==65536==. + +id identification division. + program-id. cobweb-gtk. + + ... + +done goback. + end program cobweb-gtk. + *>**** diff --git a/Task/Documentation/COBOL/documentation-2.cobol b/Task/Documentation/COBOL/documentation-2.cobol new file mode 100644 index 0000000000..50d89342f9 --- /dev/null +++ b/Task/Documentation/COBOL/documentation-2.cobol @@ -0,0 +1,16 @@ +>>IF docpass NOT DEFINED + +... code ... + +>>ELSE +!doc-marker! +======== +:SAMPLE: +======== + +.. contents:: + +Introduction +------------ +ReStructuredText or other markup source ... +>>END-IF diff --git a/Task/Documentation/Fortran/documentation.f b/Task/Documentation/Fortran/documentation.f new file mode 100644 index 0000000000..35b0f8e3a9 --- /dev/null +++ b/Task/Documentation/Fortran/documentation.f @@ -0,0 +1,3 @@ + SUBROUTINE SHOW(A,N) !Prints details to I/O unit LINPR. + REAL*8 A !Distance to the next node. + INTEGER N !Number of the current node. diff --git a/Task/Documentation/MATLAB/documentation.m b/Task/Documentation/MATLAB/documentation.m new file mode 100644 index 0000000000..c28f38a444 --- /dev/null +++ b/Task/Documentation/MATLAB/documentation.m @@ -0,0 +1,3 @@ +function Gnash(GnashFile); %Convert to a "function". Data is placed in the "global" area. +% My first MatLab attempt, to swallow data as produced by Gnash's DUMP +%command in a comma-separated format. Such files start with a line diff --git a/Task/Documentation/PowerShell/documentation.psh b/Task/Documentation/PowerShell/documentation.psh new file mode 100644 index 0000000000..5cc141cc71 --- /dev/null +++ b/Task/Documentation/PowerShell/documentation.psh @@ -0,0 +1 @@ +help about_comment_based_help diff --git a/Task/Documentation/REXX/documentation-1.rexx b/Task/Documentation/REXX/documentation-1.rexx index 289d39e386..9fa01e1da9 100644 --- a/Task/Documentation/REXX/documentation-1.rexx +++ b/Task/Documentation/REXX/documentation-1.rexx @@ -1,36 +1,29 @@ -/*REXX program to show how to display embedded documention in REXX code.*/ -parse arg doc -doc=space(doc) -if doc=='?' then call help /*show doc if arg is a single ? */ -/*════════════════════════regular═══════════════════════════════════════*/ -/*════════════════════════════════mainline══════════════════════════════*/ -/*═════════════════════════════════════════code═════════════════════════*/ -/*══════════════════════════════════════════════here.═══════════════════*/ -exit - -/*──────────────────────────────────HELP subroutine─────────────────────*/ -help: help=0; do j=1 for sourceline() - _=sourceline(j) - if _=='' then do; help=1; iterate; end - if _=='' then exit - if help then say _ - end /*j*/ -exit /*stick a fork in it, we're done.*/ - -/*──────────────────────────────────start of the in─line documentation. +/*REXX program illustrates how to display embedded documentation (help) within REXX code*/ +parse arg doc /*obtain (all) the arguments from C.L. */ +if doc='?' then call help /*show documentation if arg=a single ? */ +/*■■■■■■■■■regular■■■■■■■■■■■■■■■■■■■■■■■■■*/ +/*■■■■■■■■■■■■■■■■■mainline■■■■■■■■■■■■■■■■*/ +/*■■■■■■■■■■■■■■■■■■■■■■■■■■code■■■■■■■■■■■*/ +/*■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■here.■■■■■*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +help: ?=0; do j=1 for sourceline(); _=sourceline(j) /*get a line of source.*/ + if _='' then do; ?=1; iterate; end /*search for */ + if _='' then leave /* " " */ + if ? then say _ + end /*j*/ + exit /*stick a fork in it, we're all done. */ +/*══════════════════════════════════start of the in═line documentation AFTER the -To use the YYYY program, enter: + To use the YYYY program, enter one of: + + YYYY numberOfItems + YYYY (no arguments uses the default) + YYYY ? (to see this documentation) - YYYY numberOfItems - YYYY (with no args for the default) - YYYY ? (to see this documentation) + ─── where: numberOfItems is the number of items to be used. - -─── where: - -numberOfItems is the number of items to be processed. - -If no "numberOfItems" are entered, the default of 100 is used. + If no "numberOfItems" are entered, the default of 100 is used. -────────────────────────────────────end of the in─line documentation. */ +════════════════════════════════════end of the in═line documentation BEFORE the */ diff --git a/Task/Dot-product/00DESCRIPTION b/Task/Dot-product/00DESCRIPTION index 1699af2558..3a833b4eac 100644 --- a/Task/Dot-product/00DESCRIPTION +++ b/Task/Dot-product/00DESCRIPTION @@ -1,8 +1,20 @@ -Create a function/use an in-built function, to compute the '''[[wp:Dot product|dot product]]''', also known as the '''scalar product''' of two vectors. If possible, make the vectors of arbitrary length. +;Task: +Create a function/use an in-built function, to compute the   '''[[wp:Dot product|dot product]]''',   also known as the   '''scalar product'''   of two vectors. -As an example, compute the dot product of the vectors [1, 3, -5] and [4, -2, -1]. +If possible, make the vectors of arbitrary length. -If implementing the dot product of two vectors directly, each vector must be the same length; multiply corresponding terms from each vector then sum the results to produce the answer. -;Reference: -* [[Vector products]] here on RC. +As an example, compute the dot product of the vectors: +::::   [1,  3, -5]     and +::::   [4, -2, -1] + +
    +If implementing the dot product of two vectors directly: +:::*   each vector must be the same length +:::*   multiply corresponding terms from each vector +:::*   sum the products   (to produce the answer) + + +;Related task: +*   [[Vector products]] +

    diff --git a/Task/Dot-product/360-Assembly/dot-product.360 b/Task/Dot-product/360-Assembly/dot-product.360 new file mode 100644 index 0000000000..084f6faf76 --- /dev/null +++ b/Task/Dot-product/360-Assembly/dot-product.360 @@ -0,0 +1,24 @@ +* Dot product 03/05/2016 +DOTPROD CSECT + USING DOTPROD,R15 + SR R7,R7 p=0 + LA R6,1 i=1 +LOOPI CH R6,=AL2((B-A)/4) do i=1 to hbound(a) + BH ELOOPI + LR R1,R6 i + SLA R1,2 *4 + L R3,A-4(R1) a(i) + L R4,B-4(R1) b(i) + MR R2,R4 a(i)*b(i) + AR R7,R3 p=p+a(i)*b(i) + LA R6,1(R6) i=i+1 + B LOOPI +ELOOPI XDECO R7,PG edit p + XPRNT PG,80 print buffer + XR R15,R15 rc=0 + BR R14 return +A DC F'1',F'3',F'-5' +B DC F'4',F'-2',F'-1' +PG DC CL80' ' buffer + YREGS + END DOTPROD diff --git a/Task/Dot-product/AppleScript/dot-product-1.applescript b/Task/Dot-product/AppleScript/dot-product-1.applescript new file mode 100644 index 0000000000..e67fe3eb0f --- /dev/null +++ b/Task/Dot-product/AppleScript/dot-product-1.applescript @@ -0,0 +1,99 @@ +-- dotProduct :: [Number] -> [Number] -> Number +on dotProduct(xs, ys) + script product + on lambda(a, b) + a * b + end lambda + end script + + if length of xs = length of ys then + sum(zipWith(product, xs, ys)) + else + missing value -- arrays of differing dimension + end if +end dotProduct + +-- sum :: [Number] -> Number +on sum(xs) + script add + on lambda(a, b) + a + b + end lambda + end script + + foldl(add, 0, xs) +end sum + + +-- TEST +on run + + dotProduct([1, 3, -5], [4, -2, -1]) + + --> 3 +end run + + +-- GENERIC FUNCTIONS + +-- all :: (a -> Bool) -> [a] -> Bool +on all(f, xs) + tell mReturn(f) + set lng to length of xs + repeat with i from 1 to lng + if not lambda(item i of xs) then return false + end repeat + true + end tell +end all + +-- 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 + +-- 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 + +-- 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 + +-- cond :: Bool -> (a -> b) -> (a -> b) -> (a -> b) +on cond(bool, f, g) + if bool then + f + else + g + end if +end cond diff --git a/Task/Dot-product/AppleScript/dot-product-2.applescript b/Task/Dot-product/AppleScript/dot-product-2.applescript new file mode 100644 index 0000000000..00750edc07 --- /dev/null +++ b/Task/Dot-product/AppleScript/dot-product-2.applescript @@ -0,0 +1 @@ +3 diff --git a/Task/Dot-product/C++/dot-product.cpp b/Task/Dot-product/C++/dot-product-1.cpp similarity index 100% rename from Task/Dot-product/C++/dot-product.cpp rename to Task/Dot-product/C++/dot-product-1.cpp diff --git a/Task/Dot-product/C++/dot-product-2.cpp b/Task/Dot-product/C++/dot-product-2.cpp new file mode 100644 index 0000000000..476a7f64a5 --- /dev/null +++ b/Task/Dot-product/C++/dot-product-2.cpp @@ -0,0 +1,14 @@ +#include +#include + +int main() +{ + std::valarray xs = {1,3,-5}; + std::valarray ys = {4,-2,-1}; + + double result = (xs * ys).sum(); + + std::cout << result << '\n'; + + return 0; +} diff --git a/Task/Dot-product/JavaScript/dot-product-3.js b/Task/Dot-product/JavaScript/dot-product-3.js new file mode 100644 index 0000000000..567f586098 --- /dev/null +++ b/Task/Dot-product/JavaScript/dot-product-3.js @@ -0,0 +1,21 @@ +(() => { + 'use strict'; + + // dotProduct :: [Int] -> [Int] -> Int + const dotProduct = (xs, ys) => { + const sum = xs => xs ? xs.reduce((a, b) => a + b, 0) : undefined; + + return xs.length === ys.length ? ( + sum(zipWith((a, b) => a * b, xs, ys)) + ) : undefined; + } + + // 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])); + } + + return dotProduct([1, 3, -5], [4, -2, -1]); +})(); diff --git a/Task/Dot-product/JavaScript/dot-product-4.js b/Task/Dot-product/JavaScript/dot-product-4.js new file mode 100644 index 0000000000..00750edc07 --- /dev/null +++ b/Task/Dot-product/JavaScript/dot-product-4.js @@ -0,0 +1 @@ +3 diff --git a/Task/Dot-product/Kotlin/dot-product.kotlin b/Task/Dot-product/Kotlin/dot-product.kotlin new file mode 100644 index 0000000000..44205d4d02 --- /dev/null +++ b/Task/Dot-product/Kotlin/dot-product.kotlin @@ -0,0 +1,4 @@ +fun dot(v1: Array, v2: Array) = + v1.zip(v2).map { it.first * it.second }.reduce { a, b -> a + b } + +dot(arrayOf(1.0, 3.0, -5.0), arrayOf(4.0, -2.0, -1.0)).let { println(it) } diff --git a/Task/Dot-product/Oberon-2/dot-product.oberon-2 b/Task/Dot-product/Oberon-2/dot-product.oberon-2 new file mode 100644 index 0000000000..372c8dd9f3 --- /dev/null +++ b/Task/Dot-product/Oberon-2/dot-product.oberon-2 @@ -0,0 +1,25 @@ +MODULE DotProduct; +IMPORT + Out := NPCT:Console; + +VAR + x,y: ARRAY 3 OF LONGINT; + +PROCEDURE DotProduct(a,b: ARRAY OF LONGINT): LONGINT; +VAR + resp, i: LONGINT; +BEGIN + ASSERT(LEN(a) = LEN(b)); + resp := 0; + FOR i := 0 TO LEN(x) - 1 DO + INC(resp,x[i]*y[i]) + END; + RETURN resp +END DotProduct; + +BEGIN + x[0] := 1;y[0] := 4; + x[1] := 3;y[1] := -2; + x[2] := -5;y[2] := -1; + Out.Int(DotProduct(x,y),0);Out.Ln +END DotProduct. diff --git a/Task/Dot-product/PowerShell/dot-product.psh b/Task/Dot-product/PowerShell/dot-product.psh index 1ef773d778..e922c9384d 100644 --- a/Task/Dot-product/PowerShell/dot-product.psh +++ b/Task/Dot-product/PowerShell/dot-product.psh @@ -1,7 +1,5 @@ function dotproduct( $a, $b) { - $i = $res = 0 - $a | foreach{ $($_)*$b[$i++] } | foreach{ $res += $_ } - $res + $a | foreach -Begin {$i = $res = 0} -Process { $res += $_*$b[$i++] } -End{$res} } dotproduct (1..2) (1..2) dotproduct (1..10) (11..20) diff --git a/Task/Dot-product/REXX/dot-product-1.rexx b/Task/Dot-product/REXX/dot-product-1.rexx index 35fbdb90d5..44b77c8225 100644 --- a/Task/Dot-product/REXX/dot-product-1.rexx +++ b/Task/Dot-product/REXX/dot-product-1.rexx @@ -1,15 +1,17 @@ -/*REXX program computes the dot product of two equal size vectors. */ -vectorA = ' 1 3 -5 ' /*populate vector A with some numbers*/ -vectorB = ' 4 -2 -1 ' /* " " B " " " */ -say; say 'vector A = ' vectorA /*display the elements in the vector A.*/ - say 'vector B = ' vectorB /* " " " " " " B.*/ -p=dotProd(vectorA, vectorB) /*invoke function & compute dot product*/ -say; say 'dot product = ' p /*blank line; display the dot product.*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -dotProd: procedure; parse arg A,B /*this function compute the dot product*/ -$=0 /*initialize the sum to 0 (zero). */ - do j=1 for words(A) /*multiply each number in the vectors. */ - $=$+word(A,j) * word(B,j) /* ··· and add the product to the sum.*/ - end /*j*/ -return $ /*return the sum to invoker of function*/ +/*REXX program computes the dot product of two equal size vectors (of any size).*/ +vectorA = ' 1 3 -5 ' /*populate vector A with some numbers*/ +vectorB = ' 4 -2 -1 ' /* " " B " " " */ +say /*display a blank line for readability.*/ +say 'vector A = ' vectorA /*display the elements in the vector A.*/ +say 'vector B = ' vectorB /* " " " " " " B.*/ +p=dotProd(vectorA, vectorB) /*invoke function & compute dot product*/ +say /*display a blank line for readability.*/ +say 'dot product = ' p /*display the dot product to terminal. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +dotProd: procedure; parse arg A,B /*this function compute the dot product*/ + $=0 /*initialize the sum to 0 (zero). */ + do j=1 for words(A) /*multiply each number in the vectors. */ + $=$+word(A,j) * word(B,j) /* ··· and add the product to the sum.*/ + end /*j*/ + return $ /*return the sum to invoker of function*/ diff --git a/Task/Dot-product/REXX/dot-product-2.rexx b/Task/Dot-product/REXX/dot-product-2.rexx index 1b68f31849..c7ed386a08 100644 --- a/Task/Dot-product/REXX/dot-product-2.rexx +++ b/Task/Dot-product/REXX/dot-product-2.rexx @@ -1,34 +1,31 @@ -/*REXX program computes the dot product of two equal size vectors. */ -vectorA = ' 1 3 -5 ' /*populate vector A with some numbers*/ -vectorB = ' 4 -2 -1 ' /* " " B " " " */ -say; say 'vector A = ' vectorA /*display the elements in the vector A.*/ - say 'vector B = ' vectorB /* " " " " " " B.*/ -p=dotProd(vectorA, vectorB) /*invoke function & compute dot product*/ -say; say 'dot product = ' p /*blank line; display the dot product.*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -dotProd: procedure; parse arg A,B /*this function compute the dot product*/ -lenA = words(A) /*the number of numbers in vector A. */ -lenB = words(B) /* " " " " " " B. */ -e='***error!*** '; @.='A'; @.2='B' /*define some literals for error msgs. */ - -if lenA\==lenB then do /*oops─ay.*/ - say e "vectors aren't the same size:" - say ' vector A length = ' lenA - say ' vector B length = ' lenB - exit 13 /*exit with bad─boy return code 13. */ - end -$=0 /*initialize the sum to 0 (zero). */ - do j=1 for lenA /*multiply each number in the vectors. */ - n.1=word(A,j); n.2=word(B,j) - - do k=1 for 2; notNum=\datatype(n.k,'Number') /*verify numbers.*/ - if notNum then do /*oops─ay, ¬ num.*/ - say e "vector" @.k 'element' j "isn't numeric:" n.k - exit 13 /*exit with return code 13.*/ - end - end /*k*/ - - $=$+n.1 * n.2 /* ··· and add the product to the sum.*/ - end /*j*/ -return $ /*return the sum to invoker of function*/ +/*REXX program computes the dot product of two equal size vectors (of any size).*/ +vectorA = ' 1 3 -5 ' /*populate vector A with some numbers*/ +vectorB = ' 4 -2 -1 ' /* " " B " " " */ +say /*display a blank line for readability.*/ +say 'vector A = ' vectorA /*display the elements in the vector A.*/ +say 'vector B = ' vectorB /* " " " " " " B.*/ +p=.prod(vectorA, vectorB) /*invoke function & compute dot product*/ +say /*display a blank line for readability.*/ +say 'dot product = ' p /*display the dot product to terminal. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +ser: say "***error*** vector " @.k ' element' j " isn't numeric: " n.k; exit 13 +/*──────────────────────────────────────────────────────────────────────────────────────*/ +.prod: procedure; parse arg A,B /*this function compute the dot product*/ + lenA = words(A); @.1= 'A' /*the number of numbers in vector A. */ + lenB = words(B); @.2= 'B' /* " " " " " " B. */ + /*Also, define 2 literals to hold names*/ + if lenA\==lenB then do; say "***error*** vectors aren't the same size:" /*oops*/ + say ' vector A length = ' lenA + say ' vector B length = ' lenB + exit 13 /*exit pgm with bad─boy return code 13.*/ + end + $=0 /*initialize the sum to 0 (zero). */ + do j=1 for lenA /*multiply each number in the vectors. */ + #.1=word(A,j) /*use array to hold 2 numbers at a time*/ + #.2=word(B,j) + do k=1 for 2; if \datatype(#.k,'N') then call ser + end /*k*/ + $=$ + #.1 * #.2 /* ··· and add the product to the sum.*/ + end /*j*/ + return $ /*return the sum to invoker of function*/ diff --git a/Task/Dot-product/S-lang/dot-product.slang b/Task/Dot-product/S-lang/dot-product.slang new file mode 100644 index 0000000000..dd3c687d6d --- /dev/null +++ b/Task/Dot-product/S-lang/dot-product.slang @@ -0,0 +1 @@ +print(sum([1, 3, -5] * [4, -2, -1])); diff --git a/Task/Dot-product/TI-83-BASIC/dot-product.ti-83 b/Task/Dot-product/TI-83-BASIC/dot-product.ti-83 new file mode 100644 index 0000000000..34e96ed456 --- /dev/null +++ b/Task/Dot-product/TI-83-BASIC/dot-product.ti-83 @@ -0,0 +1 @@ +sum({1,3,–5}*{4,–2,–1}) diff --git a/Task/Dot-product/X86-Assembly/dot-product-1.x86 b/Task/Dot-product/X86-Assembly/dot-product-1.x86 new file mode 100644 index 0000000000..7ef9d86317 --- /dev/null +++ b/Task/Dot-product/X86-Assembly/dot-product-1.x86 @@ -0,0 +1,70 @@ +format PE64 console +entry start + + include 'win64a.inc' + +section '.text' code readable executable + + start: + stdcall dotProduct, vA, vB + invoke printf, msg_num, rax + + stdcall dotProduct, vA, vC + invoke printf, msg_num, rax + + invoke ExitProcess, 0 + + proc dotProduct vectorA, vectorB + mov rax, [rcx] + cmp rax, [rdx] + je .calculate + + invoke printf, msg_sizeMismatch + mov rax, 0 + ret + + .calculate: + mov r8, rcx + add r8, 8 + mov r9, rdx + add r9, 8 + mov rcx, rax + mov rax, 0 + mov rdx, 0 + + .next: + mov rbx, [r9] + imul rbx, [r8] + add rax, rbx + add r8, 8 + add r9, 8 + loop .next + + ret + endp + +section '.data' data readable + + msg_num db "%d", 0x0D, 0x0A, 0 + msg_sizeMismatch db "Size mismatch; can't calculate.", 0x0D, 0x0A, 0 + + struc Vector [symbols] { + common + .length dq (.end - .symbols) / 8 + .symbols dq symbols + .end: + } + + vA Vector 1, 3, -5 + vB Vector 4, -2, -1 + vC Vector 7, 2, 9, 0 + +section '.idata' import data readable writeable + + library kernel32, 'KERNEL32.DLL',\ + msvcrt, 'MSVCRT.DLL' + + include 'api/kernel32.inc' + + import msvcrt,\ + printf, 'printf' diff --git a/Task/Dot-product/X86-Assembly/dot-product-2.x86 b/Task/Dot-product/X86-Assembly/dot-product-2.x86 new file mode 100644 index 0000000000..b3fa7af902 --- /dev/null +++ b/Task/Dot-product/X86-Assembly/dot-product-2.x86 @@ -0,0 +1,3 @@ +3 +Size mismatch; can't calculate. +0 diff --git a/Task/Dot-product/ZX-Spectrum-Basic/dot-product.zx b/Task/Dot-product/ZX-Spectrum-Basic/dot-product.zx new file mode 100644 index 0000000000..5bcaea3b51 --- /dev/null +++ b/Task/Dot-product/ZX-Spectrum-Basic/dot-product.zx @@ -0,0 +1,5 @@ +10 DIM a(3): LET a(1)=1: LET a(2)=3: LET a(3)=-5 +20 DIM b(3): LET b(1)=4: LET b(2)=-2: LET b(3)=-1 +30 LET sum=0 +40 FOR i=1 TO 3: LET sum=sum+a(i)*b(i): NEXT i +50 PRINT sum diff --git a/Task/Doubly-linked-list-Definition/00DESCRIPTION b/Task/Doubly-linked-list-Definition/00DESCRIPTION index 1e7dadf315..1acbe79d65 100644 --- a/Task/Doubly-linked-list-Definition/00DESCRIPTION +++ b/Task/Doubly-linked-list-Definition/00DESCRIPTION @@ -3,4 +3,6 @@ Define the data structure for a complete Doubly Linked List. * The structure should support adding elements to the head, tail and middle of the list. * The structure should not allow circular loops + {{Template:See also lists}} +

    diff --git a/Task/Doubly-linked-list-Definition/PowerShell/doubly-linked-list-definition-1.psh b/Task/Doubly-linked-list-Definition/PowerShell/doubly-linked-list-definition-1.psh new file mode 100644 index 0000000000..b264e0a087 --- /dev/null +++ b/Task/Doubly-linked-list-Definition/PowerShell/doubly-linked-list-definition-1.psh @@ -0,0 +1,8 @@ +$list = New-Object -TypeName 'Collections.Generic.LinkedList[PSCustomObject]' + +for($i=1; $i -lt 10; $i++) +{ + $list.AddLast([PSCustomObject]@{ID=$i; X=100+$i;Y=200+$i}) | Out-Null +} + +$list diff --git a/Task/Doubly-linked-list-Definition/PowerShell/doubly-linked-list-definition-2.psh b/Task/Doubly-linked-list-Definition/PowerShell/doubly-linked-list-definition-2.psh new file mode 100644 index 0000000000..ea768006b9 --- /dev/null +++ b/Task/Doubly-linked-list-Definition/PowerShell/doubly-linked-list-definition-2.psh @@ -0,0 +1,3 @@ +$list.AddFirst([PSCustomObject]@{ID=123; X=123;Y=123}) | Out-Null + +$list diff --git a/Task/Doubly-linked-list-Definition/PowerShell/doubly-linked-list-definition-3.psh b/Task/Doubly-linked-list-Definition/PowerShell/doubly-linked-list-definition-3.psh new file mode 100644 index 0000000000..6bb1980abc --- /dev/null +++ b/Task/Doubly-linked-list-Definition/PowerShell/doubly-linked-list-definition-3.psh @@ -0,0 +1,14 @@ +$current = $list.First + +while(-not ($current -eq $null)) +{ + If($current.Value.X -eq 105) + { + $list.AddAfter($current, [PSCustomObject]@{ID=345;X=345;Y=345}) | Out-Null + break + } + + $current = $current.Next +} + +$list diff --git a/Task/Doubly-linked-list-Definition/PowerShell/doubly-linked-list-definition-4.psh b/Task/Doubly-linked-list-Definition/PowerShell/doubly-linked-list-definition-4.psh new file mode 100644 index 0000000000..983daeb256 --- /dev/null +++ b/Task/Doubly-linked-list-Definition/PowerShell/doubly-linked-list-definition-4.psh @@ -0,0 +1,3 @@ +$list.AddLast([PSCustomObject]@{ID=789; X=789;Y=789}) | Out-Null + +$list diff --git a/Task/Doubly-linked-list-Definition/REXX/doubly-linked-list-definition.rexx b/Task/Doubly-linked-list-Definition/REXX/doubly-linked-list-definition.rexx index 1706eb0c62..116a844f57 100644 --- a/Task/Doubly-linked-list-Definition/REXX/doubly-linked-list-definition.rexx +++ b/Task/Doubly-linked-list-Definition/REXX/doubly-linked-list-definition.rexx @@ -1,70 +1,44 @@ -/*REXX program that implements various List Manager functions. */ -/*┌────────────────────────────────────────────────────────────────────┐ -┌─┘ ☼☼☼☼☼☼☼☼☼☼☼ Functions of the List Manager ☼☼☼☼☼☼☼☼☼☼☼ └─┐ -│ @init ─── initializes the List. │ -│ │ -│ @size ─── returns the size of the List [could be 0 (zero)]. │ -│ │ -│ @show ─── shows (displays) the complete List. │ -│ @show k,1 ─── shows (displays) the Kth item. │ -│ @show k,m ─── shows (displays) M items, starting with Kth item.│ -│ @show ,,─1 ─── shows (displays) the complete List backwards. │ -│ │ -│ @get k ─── returns the Kth item. │ -│ @get k,m ─── returns the M items starting with the Kth item. │ -│ │ -│ @put x ─── adds the X items to the end (tail) of the List. │ -│ @put x,0 ─── adds the X items to the start (head) of the List. │ -│ @put x,k ─── adds the X items to before of the Kth item. │ -│ │ -│ @del k ─── deletes the item K. │ -└─┐ @del k,m ─── deletes the M items starting with item K. ┌─┘ - └────────────────────────────────────────────────────────────────────┘*/ -call sy 'initializing the list.' ; call @init -call sy 'building list: Was it a cat I saw'; call @put 'Was it a cat I saw' -call sy 'displaying list size.' ; say 'list size='@size() -call sy 'forward list' ; call @show -call sy 'backward list' ; call @show ,,-1 -call sy 'showing 4th item' ; call @show 4,1 -call sy 'showing 5th & 6th items' ; call @show 5,2 -call sy 'adding item before item 4: black' ; call @put 'black',4 -call sy 'showing list' ; call @show -call sy 'adding to tail: there, in the ...'; call @put 'there, in the shadows, stalking its prey (and next meal).' -call sy 'showing list' ; call @show -call sy 'adding to head: Oy!' ; call @put 'Oy!',0 -call sy 'showing list' ; call @show -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────subroutines─────────────────────────*/ -p: return word(arg(1), 1) /*pick the first word of many. */ -sy: say; say left('', 30) "───" arg(1) '───'; return -@init: $.@=; @adjust: $.@=space($.@); $.#=words($.@); return -@hasopt: arg o; return pos(o, opt)\==0 +/*REXX program implements various List Manager functions (see the documentation above).*/ +call sy 'initializing the list.' ; call @init +call sy 'building list: Was it a cat I saw' ; call @put "Was it a cat I saw" +call sy 'displaying list size.' ; say "list size="@size() +call sy 'forward list' ; call @show +call sy 'backward list' ; call @show ,,-1 +call sy 'showing 4th item' ; call @show 4,1 +call sy 'showing 5th & 6th items' ; call @show 5,2 +call sy 'adding item before item 4: black' ; call @put "black",4 +call sy 'showing list' ; call @show +call sy 'adding to tail: there, in the ...' ; call @put "there, in the shadows, stalking its prey (and next meal)." +call sy 'showing list' ; call @show +call sy 'adding to head: Oy!' ; call @put "Oy!",0 +call sy 'showing list' ; call @show +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +p: return word(arg(1), 1) /*pick the first word out of many items*/ +sy: say; say left('', 30) "───" arg(1) '───'; return +@init: $.@=; @adjust: $.@=space($.@); $.#=words($.@); return +@hasopt: arg o; return pos(o, opt)\==0 @size: return $.# - +/*──────────────────────────────────────────────────────────────────────────────────────*/ @del: procedure expose $.; arg k,m; call @parms 'km' _=subword($.@, k, k-1) subword($.@, k+m) - $.@=_; call @adjust - return - + $.@=_; call @adjust; return +/*──────────────────────────────────────────────────────────────────────────────────────*/ @get: procedure expose $.; arg k,m,dir,_ call @parms 'kmd' - do j=k for m by dir while j>0 & j<=$.# + do j=k for m by dir while j>0 & j<=$.# _=_ subword($.@, j, 1) end /*j*/ return strip(_) - -@parms: arg opt /*define a variable based on OPT.*/ - if @hasopt('k') then k=min($.#+1, max(1,p(k 1))) - if @hasopt('m') then m=p(m 1) - if @hasopt('d') then dir=p(dir 1) +/*──────────────────────────────────────────────────────────────────────────────────────*/ +@parms: arg opt /*define a variable based on an option.*/ + if @hasopt('k') then k=min($.#+1, max(1, p(k 1))) + if @hasopt('m') then m=p(m 1) + if @hasopt('d') then dir=p(dir 1); return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +@put: procedure expose $.; parse arg x,k; k=p(k $.#+1); call @parms 'k' + $.@=subword($.@, 1, max(0, k-1)) x subword($.@, k); call @adjust return - -@put: procedure expose $.; parse arg x,k ; k=p(k $.#+1) - call @parms 'k' - $.@=subword($.@, 1, max(0, k-1)) x subword($.@, k) - call @adjust - return - -@show: procedure expose $.; parse arg k,m,dir - if dir==-1 & k=='' then k=$.#; m=p(m $.#) - call @parms 'kmd'; say @get(k,m, dir); return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +@show: procedure expose $.; parse arg k,m,dir; if dir==-1 & k=='' then k=$.# + m=p(m $.#); call @parms 'kmd'; say @get(k,m, dir); return diff --git a/Task/Doubly-linked-list-Element-definition/00DESCRIPTION b/Task/Doubly-linked-list-Element-definition/00DESCRIPTION index 74bd51f4f8..70a1150999 100644 --- a/Task/Doubly-linked-list-Element-definition/00DESCRIPTION +++ b/Task/Doubly-linked-list-Element-definition/00DESCRIPTION @@ -1,3 +1,10 @@ -Define the data structure for a [[Linked_List#Doubly-Linked_List|doubly-linked list]] element. The element should include a data member to hold its value and pointers to both the next element in the list and the previous element in the list. The pointers should be mutable. +;Task: +Define the data structure for a [[Linked_List#Doubly-Linked_List|doubly-linked list]] element. + +The element should include a data member to hold its value and pointers to both the next element in the list and the previous element in the list. + +The pointers should be mutable. + {{Template:See also lists}} +

    diff --git a/Task/Doubly-linked-list-Element-definition/C/doubly-linked-list-element-definition.c b/Task/Doubly-linked-list-Element-definition/C/doubly-linked-list-element-definition.c index e57c406cad..d08b1ea300 100644 --- a/Task/Doubly-linked-list-Element-definition/C/doubly-linked-list-element-definition.c +++ b/Task/Doubly-linked-list-Element-definition/C/doubly-linked-list-element-definition.c @@ -1,5 +1,7 @@ -struct link { +struct link +{ struct link *next; struct link *prev; - int data; + void *data; + size_t type; }; diff --git a/Task/Doubly-linked-list-Element-definition/REXX/doubly-linked-list-element-definition.rexx b/Task/Doubly-linked-list-Element-definition/REXX/doubly-linked-list-element-definition.rexx index 816a1b99dc..116a844f57 100644 --- a/Task/Doubly-linked-list-Element-definition/REXX/doubly-linked-list-element-definition.rexx +++ b/Task/Doubly-linked-list-Element-definition/REXX/doubly-linked-list-element-definition.rexx @@ -1,79 +1,44 @@ -/*REXX program that implements various List Manager functions. */ -/*┌────────────────────────────────────────────────────────────────────┐ -┌─┘ Functions of the List Manager └─┐ -│ │ -│ @init ─── initializes the List. │ -│ │ -│ @size ─── returns the size of the List [could be 0 (zero)]. │ -│ │ -│ @show ─── shows (displays) the complete List. │ -│ @show k,1 ─── shows (displays) the Kth item. │ -│ @show k,m ─── shows (displays) M items, starting with Kth item. │ -│ @show ,,─1 ─── shows (displays) the complete List backwards. │ -│ │ -│ @get k ─── returns the Kth item. │ -│ @get k,m ─── returns the M items starting with the Kth item. │ -│ │ -│ @put x ─── adds the X items to the end (tail) of the List. │ -│ @put x,0 ─── adds the X items to the start (head) of the List. │ -│ @put x,k ─── adds the X items to before of the Kth item. │ -│ │ -│ @del k ─── deletes the item K. │ -│ @del k,m ─── deletes the M items starting with item K. │ -└─┐ ┌─┘ - └────────────────────────────────────────────────────────────────────┘*/ -call sy 'initializing the list.' ; call @init -call sy 'building list: Was it a cat I saw'; call @put 'Was it a cat I saw' -call sy 'displaying list size.' ; say 'list size='@size() -call sy 'forward list' ; call @show -call sy 'backward list' ; call @show ,,-1 -call sy 'showing 4th item' ; call @show 4,1 -call sy 'showing 5th & 6th items' ; call @show 5,2 -call sy 'adding item before item 4: black' ; call @put 'black',4 -call sy 'showing list' ; call @show -call sy 'adding to tail: there, in the ...'; call @put 'there, in the shadows, stalking its prey (and next meal).' -call sy 'showing list' ; call @show -call sy 'adding to head: Oy!' ; call @put 'Oy!',0 -call sy 'showing list' ; call @show -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────subroutines─────────────────────────*/ -p: return word(arg(1),1) -sy: say; say left('',30) "───" arg(1) '───'; return -@hasopt: arg o; return pos(o,opt)\==0 +/*REXX program implements various List Manager functions (see the documentation above).*/ +call sy 'initializing the list.' ; call @init +call sy 'building list: Was it a cat I saw' ; call @put "Was it a cat I saw" +call sy 'displaying list size.' ; say "list size="@size() +call sy 'forward list' ; call @show +call sy 'backward list' ; call @show ,,-1 +call sy 'showing 4th item' ; call @show 4,1 +call sy 'showing 5th & 6th items' ; call @show 5,2 +call sy 'adding item before item 4: black' ; call @put "black",4 +call sy 'showing list' ; call @show +call sy 'adding to tail: there, in the ...' ; call @put "there, in the shadows, stalking its prey (and next meal)." +call sy 'showing list' ; call @show +call sy 'adding to head: Oy!' ; call @put "Oy!",0 +call sy 'showing list' ; call @show +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +p: return word(arg(1), 1) /*pick the first word out of many items*/ +sy: say; say left('', 30) "───" arg(1) '───'; return +@init: $.@=; @adjust: $.@=space($.@); $.#=words($.@); return +@hasopt: arg o; return pos(o, opt)\==0 @size: return $.# -@init: $.@=''; $.#=0; return 0 -@adjust: $.@=space($.@); $.#=words($.@); return 0 - -@parms: arg opt - if @hasopt('k') then k=min($.#+1,max(1,p(k 1))) - if @hasopt('m') then m=p(m 1) - if @hasopt('d') then dir=p(dir 1) - return - -@show: procedure expose $.; parse arg k,m,dir - if dir==-1 & k=='' then k=$.# - m=p(m $.#); +/*──────────────────────────────────────────────────────────────────────────────────────*/ +@del: procedure expose $.; arg k,m; call @parms 'km' + _=subword($.@, k, k-1) subword($.@, k+m) + $.@=_; call @adjust; return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +@get: procedure expose $.; arg k,m,dir,_ call @parms 'kmd' - say @get(k,m,dir); - return 0 - -@get: procedure expose $.; arg k,m,dir,_ - call @parms 'kmd' - do j=k for m by dir while j>0 & j<=$.# - _=_ subword($.@,j,1) - end /*j*/ + do j=k for m by dir while j>0 & j<=$.# + _=_ subword($.@, j, 1) + end /*j*/ return strip(_) - -@put: procedure expose $.; parse arg x,k - k=p(k $.#+1) - call @parms 'k' - $.@=subword($.@,1,max(0,k-1)) x subword($.@,k) - call @adjust - return 0 - -@del: procedure expose $.; arg k,m - call @parms 'km' - _=subword($.@,k,k-1) subword($.@,k+m) - $.@=_ - call @adjust +/*──────────────────────────────────────────────────────────────────────────────────────*/ +@parms: arg opt /*define a variable based on an option.*/ + if @hasopt('k') then k=min($.#+1, max(1, p(k 1))) + if @hasopt('m') then m=p(m 1) + if @hasopt('d') then dir=p(dir 1); return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +@put: procedure expose $.; parse arg x,k; k=p(k $.#+1); call @parms 'k' + $.@=subword($.@, 1, max(0, k-1)) x subword($.@, k); call @adjust return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +@show: procedure expose $.; parse arg k,m,dir; if dir==-1 & k=='' then k=$.# + m=p(m $.#); call @parms 'kmd'; say @get(k,m, dir); return diff --git a/Task/Doubly-linked-list-Element-definition/Rust/doubly-linked-list-element-definition-1.rust b/Task/Doubly-linked-list-Element-definition/Rust/doubly-linked-list-element-definition-1.rust new file mode 100644 index 0000000000..14f822a8eb --- /dev/null +++ b/Task/Doubly-linked-list-Element-definition/Rust/doubly-linked-list-element-definition-1.rust @@ -0,0 +1,5 @@ +use std::collections::LinkedList; +fn main() { + // Doubly linked list containing 32-bit integers + let list = LinkedList::::new(); +} diff --git a/Task/Doubly-linked-list-Element-definition/Rust/doubly-linked-list-element-definition-2.rust b/Task/Doubly-linked-list-Element-definition/Rust/doubly-linked-list-element-definition-2.rust new file mode 100644 index 0000000000..86b2840c1a --- /dev/null +++ b/Task/Doubly-linked-list-Element-definition/Rust/doubly-linked-list-element-definition-2.rust @@ -0,0 +1,17 @@ +pub struct LinkedList { // User-facing implementation + length: usize, + list_head: Link, + list_tail: Rawlink>, +} + +type Link = Option>>; // Type definition + +struct Rawlink { // Pointer is wrapped in struct so that Option-like methods can be added to it later (wrappers around NULL checks) + p: *mut T, // Raw mutable pointer +} + +struct Node { + next: Link, + prev: Rawlink>, + value: T, +} diff --git a/Task/Doubly-linked-list-Element-insertion/Rust/doubly-linked-list-element-insertion-1.rust b/Task/Doubly-linked-list-Element-insertion/Rust/doubly-linked-list-element-insertion-1.rust new file mode 100644 index 0000000000..6846a0b845 --- /dev/null +++ b/Task/Doubly-linked-list-Element-insertion/Rust/doubly-linked-list-element-insertion-1.rust @@ -0,0 +1,5 @@ +use std::collections::LinkedList; +fn main() { + let mut list = LinkedList::new(); + list.push_front(8); +} diff --git a/Task/Doubly-linked-list-Element-insertion/Rust/doubly-linked-list-element-insertion-2.rust b/Task/Doubly-linked-list-Element-insertion/Rust/doubly-linked-list-element-insertion-2.rust new file mode 100644 index 0000000000..3b478b7869 --- /dev/null +++ b/Task/Doubly-linked-list-Element-insertion/Rust/doubly-linked-list-element-insertion-2.rust @@ -0,0 +1,52 @@ +impl Node { + fn new(v: T) -> Node { + Node {value: v, next: None, prev: Rawlink::none()} + } +} + +impl Rawlink { + fn none() -> Self { + Rawlink {p: ptr::null_mut()} + } + + fn some(n: &mut T) -> Rawlink { + Rawlink{p: n} + } +} + +impl<'a, T> From<&'a mut Link> for Rawlink> { + fn from(node: &'a mut Link) -> Self { + match node.as_mut() { + None => Rawlink::none(), + Some(ptr) => Rawlink::some(ptr) + } + } +} + + +fn link_no_prev(mut next: Box>) -> Link { + next.prev = Rawlink::none(); + Some(next) +} + +impl LinkedList { + #[inline] + fn push_front_node(&mut self, mut new_head: Box>) { + match self.list_head { + None => { + self.list_head = link_no_prev(new_head); + self.list_tail = Rawlink::from(&mut self.list_head); + } + Some(ref mut head) => { + new_head.prev = Rawlink::none(); + head.prev = Rawlink::some(&mut *new_head); + mem::swap(head, &mut new_head); + head.next = Some(new_head); + } + } + self.length += 1; + } + pub fn push_front(&mut self, elt: T) { + self.push_front_node(Box::new(Node::new(elt))); + } +} diff --git a/Task/Dragon-curve/00DESCRIPTION b/Task/Dragon-curve/00DESCRIPTION index b785d7aa99..2f9a7323b5 100644 --- a/Task/Dragon-curve/00DESCRIPTION +++ b/Task/Dragon-curve/00DESCRIPTION @@ -1,6 +1,13 @@ -Create and display a [[wp:dragon curve|dragon curve]] fractal. (You may either display the curve directly or write it to an image file.) +[[File:dragon_curve_steps.png|400px||right]] -==Algorithms== +[[File:dragon_curve.png|400px||right]] + +Create and display a [[wp:dragon curve|dragon curve]] fractal. + +(You may either display the curve directly or write it to an image file.) + + +;Algorithms Here are some brief notes the algorithms used and how they might suit various languages. @@ -92,4 +99,4 @@ This always has F at even positions and S at odd. Eg. after 3 levels F_S_ Variations are possible if you have only a single symbol for line draw, for example the [[#Icon and Unicon|Icon and Unicon]] and [[#Xfractint|Xfractint]] code. The angles can also be broken into 45-degree parts to keep the expansion in a single direction rather than the endpoint rotating around. -The string rewrites can be done recursively without building the whole string, just follow its instructions at the target level. See for example [[#C by IFS Drawing|C by IFS Drawing]] code. The effect is the same as "recursive with parameter" above but can draw other curves defined by L-systems. +The string rewrites can be done recursively without building the whole string, just follow its instructions at the target level. See for example [[#C by IFS Drawing|C by IFS Drawing]] code. The effect is the same as "recursive with parameter" above but can draw other curves defined by L-systems.

    diff --git a/Task/Dragon-curve/COBOL/dragon-curve.cobol b/Task/Dragon-curve/COBOL/dragon-curve.cobol new file mode 100644 index 0000000000..5ad0e7a7a7 --- /dev/null +++ b/Task/Dragon-curve/COBOL/dragon-curve.cobol @@ -0,0 +1,173 @@ + >>SOURCE FORMAT FREE +*> This code is dedicated to the public domain +identification division. +program-id. dragon. +environment division. +configuration section. +repository. function all intrinsic. +data division. +working-storage section. +01 segment-length pic 9 value 2. +01 mark pic x value '.'. +01 segment-count pic 9999 value 513. + +01 segment pic 9999. +01 point pic 9999 value 1. +01 point-max pic 9999. +01 point-lim pic 9999 value 8192. +01 dragon-curve. + 03 filler occurs 8192. + 05 ydragon pic s9999. + 05 xdragon pic s9999. + +01 x pic s9999 value 1. +01 y pic S9999 value 1. + +01 xdelta pic s9 value 1. *> start pointing east +01 ydelta pic s9 value 0. + +01 x-max pic s9999 value -9999. +01 x-min pic s9999 value 9999. +01 y-max pic s9999 value -9999. +01 y-min pic s9999 value 9999. + +01 n pic 9999. +01 r pic 9. + +01 xupper pic s9999. +01 yupper pic s9999. + +01 window-line-number pic 99. +01 window-width pic 99 value 64. +01 window-height pic 99 value 22. +01 window. + 03 window-line occurs 22. + 05 window-point occurs 64 pic x. + +01 direction pic x. + +procedure division. +start-dragon. + + if segment-count * segment-length > point-lim + *> too many segments for the point-table + compute segment-count = point-lim / segment-length + end-if + + perform varying segment from 1 by 1 + until segment > segment-count + + *>=========================================== + *> segment = n * 2 ** b + *> if mod(n,4) = 3, turn left else turn right + *>=========================================== + + *> calculate the turn + divide 2 into segment giving n remainder r + perform until r <> 0 + divide 2 into n giving n remainder r + end-perform + divide 2 into n giving n remainder r + + *> perform the turn + evaluate r also xdelta also ydelta + when 0 also 1 also 0 *> turn right from east + when 1 also -1 also 0 *> turn left from west + *> turn to south + move 0 to xdelta + move 1 to ydelta + when 1 also 1 also 0 *> turn left from east + when 0 also -1 also 0 *> turn right from west + *> turn to north + move 0 to xdelta + move -1 to ydelta + when 0 also 0 also 1 *> turn right from south + when 1 also 0 also -1 *> turn left from north + *> turn to west + move 0 to ydelta + move -1 to xdelta + when 1 also 0 also 1 *> turn left from south + when 0 also 0 also -1 *> turn right from north + *> turn to east + move 0 to ydelta + move 1 to xdelta + end-evaluate + + *> plot the segment points + perform segment-length times + add xdelta to x + add ydelta to y + + move x to xdragon(point) + move y to ydragon(point) + + add 1 to point + end-perform + + *> update the limits for the display + compute x-max = max(x, x-max) + compute x-min = min(x, x-min) + compute y-max = max(y, y-max) + compute y-min = min(y, y-min) + move point to point-max + + end-perform + + *>========================================== + *> display the curve + *> hjkl corresponds to left, up, down, right + *> anything else ends the program + *>========================================== + + move 1 to yupper xupper + + perform with test after + until direction <> 'h' and 'j' and 'k' and 'l' + + *>========================================== + *> (yupper,xupper) maps to window-point(1,1) + *>========================================== + + *> move the window + evaluate true + when direction = 'h' *> move window left + and xupper > x-min + window-width + subtract 1 from xupper + when direction = 'j' *> move window up + and yupper < y-max - window-height + add 1 to yupper + when direction = 'k' *> move window down + and yupper > y-min + window-height + subtract 1 from yupper + when direction = 'l' *> move window right + and xupper < x-max - window-width + add 1 to xupper + end-evaluate + + *> plot the dragon points in the window + move spaces to window + perform varying point from 1 by 1 + until point > point-max + if ydragon(point) >= yupper and < yupper + window-height + and xdragon(point) >= xupper and < xupper + window-width + *> we're in the window + compute y = ydragon(point) - yupper + 1 + compute x = xdragon(point) - xupper + 1 + move mark to window-point(y, x) + end-if + end-perform + + *> display the window + perform varying window-line-number from 1 by 1 + until window-line-number > window-height + display window-line(window-line-number) + end-perform + + *> get the next window move or terminate + display 'hjkl?' with no advancing + accept direction + end-perform + + stop run + . +end program dragon. diff --git a/Task/Dragon-curve/Openscad/dragon-curve.scad b/Task/Dragon-curve/Openscad/dragon-curve.scad new file mode 100644 index 0000000000..7d533625f3 --- /dev/null +++ b/Task/Dragon-curve/Openscad/dragon-curve.scad @@ -0,0 +1,18 @@ +level = 8; +linewidth = .1; // fraction of segment length +sqrt2 = pow(2, .5); + +// Draw a dragon curve "level" going from [0,0] to [1,0] +module dragon(level) { + if (level <= 0) { + translate([.5,0]) cube([1+linewidth,linewidth,linewidth],center=true); + } else { + rotate(-45) scale(1/sqrt2) dragon(level-1); + translate([1,0]) rotate(-135) scale(1/sqrt2) dragon(level-1); + } +} + +scale(40) { // scale to nicely visible in the default GUI + sphere(1.5*linewidth / pow(2,level/2)); // mark the start of the curve + dragon(level); +} diff --git a/Task/Dragon-curve/PARI-GP/dragon-curve-3.pari b/Task/Dragon-curve/PARI-GP/dragon-curve-3.pari new file mode 100644 index 0000000000..306ce5cd65 --- /dev/null +++ b/Task/Dragon-curve/PARI-GP/dragon-curve-3.pari @@ -0,0 +1,19 @@ +\\ Dragon curve +\\ 4/8/16 aev +Dragon(level)={my(p=[0,1],end); +print(" *** Dragon curve, level ",level); +for(i=1,level, end=(1+I)*p[#p]; + p=concat(p,apply(z->(end-I*z),Vecrev(p[^-1]))) ); +plothraw(apply(real,p),apply(imag,p), 1); +} + +{\\ Executing/Testing: + +Dragon(13); \\ Dragon13.png + +Dragon(17); \\ Dragon17.png + +Dragon(21); \\ Dragon21.png + +Dragon(23); \\ No result +} diff --git a/Task/Dragon-curve/PL-I/dragon-curve.pli b/Task/Dragon-curve/PL-I/dragon-curve.pli new file mode 100644 index 0000000000..c620b46b95 --- /dev/null +++ b/Task/Dragon-curve/PL-I/dragon-curve.pli @@ -0,0 +1,237 @@ +* PROCESS GONUMBER, MARGINS(1,72), NOINTERRUPT, MACRO; +TEST:PROCEDURE OPTIONS(MAIN); + DECLARE + SYSIN FILE STREAM INPUT, + DRAGON FILE STREAM OUTPUT PRINT, + SYSPRINT FILE STREAM OUTPUT PRINT; + DECLARE (MIN,MAX,MOD,INDEX,LENGTH,SUBSTR,VERIFY,TRANSLATE) BUILTIN; + DECLARE (COMPLEX,SQRT,REAL,IMAG,ATAN,SIN,EXP,COS,ABS) BUILTIN; + %INCLUDE PLILIB(GOODIES); + %INCLUDE PLILIB(SCAN); + %INCLUDE PLILIB(GRAMMAR); + %INCLUDE PLILIB(CARDINAL); + %INCLUDE PLILIB(ORDINAL); + %INCLUDE PLILIB(ANSWAROD); + %INCLUDE PLILIB(RUNFILE); + %INCLUDE PLILIB(PSTUFF); + + DECLARE (TWOPI,TORAD) REAL; + DECLARE RANGE(4) REAL; + DECLARE TRACERANGE BOOLEAN INITIAL(FALSE); + DECLARE FRESHRANGE BOOLEAN INITIAL(TRUE); + + BOUND:PROCEDURE(Z); + DECLARE Z COMPLEX; + DECLARE (ZX,ZY) REAL; + ZX = REAL(Z); ZY = IMAG(Z); + IF FRESHRANGE THEN + DO; + RANGE(1),RANGE(2) = ZX; + RANGE(3),RANGE(4) = ZY; + END; + ELSE + DO; + RANGE(1) = MIN(RANGE(1),ZX); + RANGE(2) = MAX(RANGE(2),ZX); + RANGE(3) = MIN(RANGE(3),ZY); + RANGE(4) = MAX(RANGE(4),ZY); + END; + FRESHRANGE = FALSE; + END BOUND; + + PLOTZ:PROCEDURE(Z,PEN); + DECLARE Z COMPLEX; + DECLARE PEN INTEGER; + IF TRACERANGE THEN CALL BOUND(Z); + CALL PLOT(REAL(Z),IMAG(Z),PEN); + END PLOTZ; + + %PAGE; + DRAGONCURVE:PROCEDURE(ORDER,HOP); /*Folding paper in two...*/ +/*Some statistics on runs with x = 56.25", y = 32.6" +&(the calcomp plotter).*/ +/*The actual size of the picture determines the number of steps +&to each quarter-turn.*/ +/* n turns x y secs dx dy +&*/ +/* 20 1,048,575 -2389:681 -682:1364 180+ 3070 2046 +&*/ +/* 19 524,287 -1365:681 -340:1364 119 2046 1704 +&*/ +/* 18 262,143 -341:681 -340:1194 71 1022 1554 +&*/ +/* 17 131,071 -171:681 -340:682 35 852 1022 +&*/ + DECLARE ORDER BIGINT; /*So how many folds.*/ + DECLARE HOP BOOLEAN; + DECLARE FOLD(0:31,0:32767) BOOLEAN; /*Oh for (0:1000000) or so..*/ + DECLARE (TURN,N,IT,I,I1,I2,J1,J2,L,LL) BIGINT; + DECLARE (XMIN,XMAX,YMIN,YMAX,XMID,YMID) REAL; + DECLARE (IXMIN,IXMAX,IYMIN,IYMAX) BIGINT; + DECLARE (S,H,TORAD) REAL; + DECLARE (ZMID,Z,Z2,DZ,ZL) COMPLEX; + DECLARE (FULLTURN,ABOUTTURN,QUARTERTURN) INTEGER; + DECLARE (WAY,DIRECTION,ND,LD,LD1,LD2) INTEGER; + DECLARE LEAF(0:3,0:360) COMPLEX; /*Corner turning.*/ + DECLARE SWAPXY BOOLEAN; /*Try to align rectangles.*/ + DECLARE (T1,T2) CHARACTER(200) VARYING; + IF ¬PLOTCHOICE('') THEN RETURN; /*Ascertain the plot device.*/ + N = 0; + FOR TURN = 1 TO ORDER; + IT = N + 1; + I1 = IT/32768; I2 = MOD(IT,32768); + FOLD(I1,I2) = TRUE; + FOR I = 1 TO N; + I1 = (IT + I)/32768; I2 = MOD(IT + I,32768); + J1 = (IT - I)/32768; J2 = MOD(IT - I,32768); + FOLD(I1,I2) = ¬FOLD(J1,J2); + END; + N = N*2 + 1; + IF HOP & TURN < ORDER THEN GO TO XX; + XMIN,XMAX,YMIN,YMAX = 0; + Z = 0; /*Start at the origin.*/ + DZ = 1; /*Step out unilaterally.*/ + FOR I = 1 TO N; + Z = Z + DZ; /*Take the step before the kink.*/ + I1 = I/32768; I2 = MOD(I,32768); + IF FOLD(I1,I2) THEN DZ = DZ*(0 + 1I); ELSE DZ = DZ*(0 - 1I); + Z = Z + DZ; /*The step after the kink.*/ + XMIN = MIN(XMIN,REAL(Z)); XMAX = MAX(XMAX,REAL(Z)); + YMIN = MIN(YMIN,IMAG(Z)); YMAX = MAX(YMAX,IMAG(Z)); + END; + SWAPXY = ((XMAX - XMIN) >= (YMAX - YMIN)) /*Contemplate */ + ¬= (PLOTSTUFF.XSIZE >= PLOTSTUFF.YSIZE); /* rectangularities.*/ + IF SWAPXY THEN + DO; + H = XMIN; + XMIN = YMIN; + YMIN = -XMAX; + XMAX = YMAX; + YMAX = -H; + END; + IXMAX = XMAX; IYMAX = YMAX; IXMIN = XMIN; IYMIN = YMIN; + XMID = (XMAX + XMIN)/2; YMID = (YMAX + YMIN)/2; + ZMID = COMPLEX(XMID,YMID); + XMAX = XMAX - XMID; YMAX = YMAX - YMID; + XMIN = XMIN - XMID; YMIN = YMIN - YMID; + T1 = 'Order ' || IFMT(TURN) || ' Dragoncurve, ' + || SAYNUM(0,N,'turn') || '.'; + IF SWAPXY THEN T2 = 'y range ' || IFMT(IYMIN) || ':' || IFMT(IYMAX) + || ', x range ' || IFMT(IXMIN) || ':' || IFMT(IXMAX); + ELSE T2 = 'x range ' || IFMT(IXMIN) || ':' || IFMT(IXMAX) + || ', y range ' || IFMT(IYMIN) || ':' || IFMT(IYMAX); + S = MIN(PLOTSTUFF.XSIZE/(XMAX - XMIN), /*Rectangularity */ + (PLOTSTUFF.YSIZE - 4*H)/(YMAX - YMIN)); /* matching?*/ + H = MIN(PLOTSTUFF.XSIZE,S*(XMAX - XMIN)); /*X-width for text.*/ + H = MIN(PLOTCHAR,H/(MAX(LENGTH(T1),LENGTH(T2)) + 6)); + IF ¬NEWRANGE(XMIN*S,XMAX*S,YMIN*S-2*H,YMAX*S+2*H) THEN STOP('Urp!'); + CALL PLOTTEXT(-LENGTH(T1)*H/2,YMAX*S + 2*PLOTTICK,H,T1,0); + CALL PLOTTEXT(-LENGTH(T2)*H/2,YMIN*S - 2*H + 2*PLOTTICK,H,T2,0); + QUARTERTURN = MIN(MAX(3,12*SQRT(S)),90); /*Angle refinement.*/ + ABOUTTURN = QUARTERTURN*2; + FULLTURN = QUARTERTURN*4; /*Ensures divisibility.*/ + TORAD = TWOPI/FULLTURN; /*Imagine if FULLTURN was 360.*/ + ZL = 1; /*Start with 0 degrees.*/ + FOR L = 0 TO 3; /*The four directions.*/ + FOR I = 0 TO FULLTURN; /*Fill out the petals in the corner.*/ + LEAF(L,I) = ZL + EXP((0 + 1I)*I*TORAD); /*Poke!*/ + END; /*Fill out the full circle for each for simplicity.*/ + ZL = ZL*(0 + 1I); /*Rotate to the next axis.*/ + END; /*Four circles, centred one unit along each axial direction.*/ + Z = -ZMID; /*The start point. Was 0, before shift by ZMID.*/ + CALL PLOTZ(S*Z,3); /*Position the pen.*/ + DIRECTION = 0; /*The way ahead is along the x-axis.*/ + DZ = 1; /*The step before the kink.*/ + IF SWAPXY THEN DIRECTION = -QUARTERTURN; /*Or maybe y.*/ + IF SWAPXY THEN DZ = (0 - 1I); /*An x-y swap.*/ + FRESHRANGE = TRUE; /*A sniffing.*/ + FOR I = 1 TO N; /*The deviationism begins.*/ + I1 = I/32768; I2 = MOD(I,32768); + IF FOLD(I1,I2) THEN WAY = +1; ELSE WAY = -1; + ND = DIRECTION + QUARTERTURN*WAY; + IF ND >= FULLTURN THEN ND = ND - FULLTURN; + IF ND < 0 THEN ND = ND + FULLTURN; + LD = ND/QUARTERTURN; /*Select a leaf.*/ + LD1 = MOD(ND + ABOUTTURN,FULLTURN); + LD2 = LD1 + WAY*QUARTERTURN; /*No mod, see the FOR loop below.*/ + FOR L = LD1 TO LD2 BY WAY; /*Round the kink.*/ + LL = L; /*A copy to wrap into range.*/ + IF LL < 0 THEN LL = LL + FULLTURN; + IF LL >= FULLTURN THEN LL = LL - FULLTURN; + ZL = Z + LEAF(LD,LL); /*Work along the curve.*/ + CALL PLOTZ(S*ZL,2); /*Move a bit.*/ + END; /*On to the next step.*/ + DIRECTION = ND; /*The new direction.*/ + Z = Z + DZ; /*The first half of the step that has been rounded.*/ + DZ = DZ*(0 + 1I)*WAY; /*A right-angle, one way or the other.*/ + Z = Z + DZ; /*Avoid the roundoff of hordes of fractional moves.*/ + END; /*On to the next fold.*/ + CALL PLOT(0,0,998); + IF TRACERANGE THEN PUT SKIP(3) FILE(DRAGON) LIST('Dragoncurve: '); + IF TRACERANGE THEN PUT FILE(DRAGON) DATA(RANGE,ORDER,S,ZMID); +XX:END; + END DRAGONCURVE; + %PAGE; + %PAGE; + %PAGE; + RANDOM:PROCEDURE(SEED) RETURNS(REAL); + DECLARE SEED INTEGER; + SEED = SEED*497 + 4032; + IF SEED <= 0 THEN SEED = SEED + 32767; + IF SEED > 32767 THEN SEED = MOD(SEED,32767); + RETURN(SEED/32767.0); + END RANDOM; + + %PAGE; + TRACE:PROCEDURE(O,R,A,N,G); + DECLARE (I,N,G) INTEGER; + DECLARE (O,R,A(*),X0,X1,X2) COMPLEX; + X1 = O + R*A(1); + X0 = X1; + CALL PLOT(REAL(X1),IMAG(X1),3); + FOR I = 2 TO N; + X2 = O + R*A(I); + CALL PLOT(REAL(X2),IMAG(X2),2); + X1 = X2; + END; + CALL PLOT(REAL(X0),IMAG(X0),2); + END TRACE; + + CENTREZ:PROCEDURE(A,N); + DECLARE (A(*),T) COMPLEX; + DECLARE (I,N) INTEGER; + T = 0; + FOR I = 1 TO N; + T = T + A(I); + END; + T = T/N; + FOR I = 1 TO N; + A(I) = A(I) - T; + END; + END CENTREZ; + %PAGE; + %PAGE; + DECLARE (BELCH,ORDER,CHASE,TWIRL) INTEGER; + DECLARE HOP BOOLEAN; + + TWOPI = 8*ATAN(1); + TORAD = TWOPI/360; + BELCH = REPLYN('How many dragoncurves (max 20)'); + IF BELCH < 12 THEN HOP = FALSE; + ELSE HOP = YEA('Go directly to order ' || IFMT(BELCH)); +/*ORDER = REPLYN('The depth of recursion (eg 4)'); + CHASE = REPLYN('How many pursuits'); + TWIRL = REPLYN('How many twirls'); + TRACERANGE = YEA('Trace the ranges');*/ + CALL DRAGONCURVE(BELCH,HOP); +/*CALL TRIANGLEPLEX(ORDER); + CALL SQUAREBASH(ORDER,+1); + CALL SQUAREBASH(ORDER,-1); + CALL SNOWFLAKE(ORDER); + CALL SNOWFLAKE3(ORDER); + CALL PURSUE(CHASE); + CALL LISSAJOU(TWIRL); + CALL CARDIOD; + CALL HEART;*/ + CALL PLOT(0,0,-3); CALL PLOT(0,0,999); +END TEST; diff --git a/Task/Dragon-curve/REXX/dragon-curve.rexx b/Task/Dragon-curve/REXX/dragon-curve.rexx index f97f9f1f1c..4b06347c6e 100644 --- a/Task/Dragon-curve/REXX/dragon-curve.rexx +++ b/Task/Dragon-curve/REXX/dragon-curve.rexx @@ -1,36 +1,35 @@ -/*REXX program draws an ASCII Dragon Curve (or Harter-Heighway dragon curve)*/ -z=1; d.=1; d.L=-d.; @.=' '; x=0; x2=x; y=0; y2=y; @.x.y='∙' -plot_pts = '123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZΘ' -minX=0; maxX=0; minY=0; maxY=0 /*assign various constants & variables.*/ -parse arg # p c . /*#: number of iterations; P=init dir.*/ -if #=='' | #==',' then #=11 /*Not specified? Then use the default.*/ -if p=='' | p==',' then p=0 /* " " " " " " */ -if c=='' then c=plot_pts /* " " " " " " */ -if length(c)==2 then c=x2c(c) /*was a hexadecimal code specified? */ -if length(c)==3 then c=d2c(c) /* " " decimal " " ? */ -$= /*assign a null to dragon curve string.*/ - do # /* [↓] create dragon curve.*/ - $=$'R'reverse(translate($, "RL", 'LR')) /*append, flip, and reverse.*/ - end /*#*/ /* [↑] TRANSLATE flips chrs*/ - /* [↓] create dragon curve.*/ - do j=1 for length($); _=substr($, j, 1) /*obtain the next direction.*/ - p=(p+d._)//4; if p<0 then p=p+4 /*move curve in a direction.*/ - if p==0 then do; y=y+1; y2=y+1; end /*going east cartologically*/ - if p==1 then do; x=x+1; x2=x+1; end /* " south " */ - if p==2 then do; y=y-1; y2=y-1; end /* " west " */ - if p==3 then do; x=x-1; x2=x-1; end /* " north " */ - if j>2**z then z=z+1 /*identify curve being built*/ - !=substr(c,z,1); if !==' ' then !=right(c,1) /*choose the plot point char*/ - @.x.y=!; @.x2.y2=! /*draw part of dragon curve.*/ - minX=min(minX,x,x2); maxX=max(maxX,x,x2); x=x2 /*define the X graph limits.*/ - minY=min(minY,y,y2); maxY=max(maxY,y,y2); y=y2 /* " " Y " " */ - end /*j*/ /* [↑] process all of $ str*/ - /* [↓] display the dragon curve. */ - do r=minX to maxX; a= /*nullify the line that will bee drawn.*/ - do c=minY to maxY /*create a line (row) of curve points. */ - a=a || @.r.c /*add a single column of row at a time.*/ - end /*c*/ - a=strip(a, 'T') /*be nice and strip any trailing blanks*/ - if a\=='' then say a /*display a line (row) of curve points.*/ - end /*r*/ - /*stick a fork in it, we're all done. */ +/*REXX program creates & draws an ASCII Dragon Curve (or Harter-Heighway dragon curve).*/ +z=1; d.=1; d.L=-d.; @.=' '; x=0; x2=x; y=0; y2=y; @.x.y="∙" +plot_pts = '123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZΘ' /*plot chrs*/ +minX=0; maxX=0; minY=0; maxY=0 /*assign various constants & variables.*/ +parse arg # p c . /*#: number of iterations; P=init dir.*/ +if #=='' | #=="," then #=11 /*Not specified? Then use the default.*/ +if p=='' | p=="," then p=0 /* " " " " " " */ +if c=='' then c=plot_pts /* " " " " " " */ +if length(c)==2 then c=x2c(c) /*was a hexadecimal code specified? */ +if length(c)==3 then c=d2c(c) /* " " decimal " " */ +$= /*assign a null to dragon curve string.*/ + do # /* [↓] create (part of) a dragon curve*/ + $=$'R'reverse( translate($, "RL", 'LR') ) /*append char, flip, and then reverse.*/ + end /*#*/ /* [↑] TRANSLATE (flip) the characters*/ + /* [↓] create the dragon curve. */ + do j=1 for length($); _=substr($, j, 1) /*obtain the next direction for curve. */ + p= (p+d._)//4; if p<0 then p=p+4 /*move dragon curve in a new direction.*/ + if p==0 then do; y=y+1; y2=y+1; end /*curve is going east cartologically.*/ + if p==1 then do; x=x+1; x2=x+1; end /* " " south " */ + if p==2 then do; y=y-1; y2=y-1; end /* " " west " */ + if p==3 then do; x=x-1; x2=x-1; end /* " " north " */ + if j>2**z then z=z+1 /*identify the dragon curve being built*/ + !=substr(c,z,1); if !==' ' then !=right(c,1) /*choose plot point character (glyph). */ + @.x.y=!; @.x2.y2=! /*draw part of the dragon curve. */ + minX=min(minX,x,x2); maxX=max(maxX,x,x2); x=x2 /*define the min & max X graph limits*/ + minY=min(minY,y,y2); maxY=max(maxY,y,y2); y=y2 /* " " " " " Y " " */ + end /*j*/ /* [↑] process all of $ char string.*/ + /* [↓] display the dragon curve. */ + do r=minX to maxX; a= /*nullify the line that will bee drawn.*/ + do c=minY to maxY /*create a line (row) of curve points. */ + a=a || @.r.c /*append single column of row at a time*/ + end /*c*/ + a=strip(a, 'T') /*be nice and strip any trailing blanks*/ + if a\=='' then say a /*display a line (row) of curve points.*/ + end /*r*/ /*stick a fork in it, we're all done. */ diff --git a/Task/Dragon-curve/ZX-Spectrum-Basic/dragon-curve.zx b/Task/Dragon-curve/ZX-Spectrum-Basic/dragon-curve.zx new file mode 100644 index 0000000000..14faa74d2c --- /dev/null +++ b/Task/Dragon-curve/ZX-Spectrum-Basic/dragon-curve.zx @@ -0,0 +1,29 @@ +10 LET level=15: LET insize=120 +20 LET x=80: LET y=70 +30 LET iters=2^level +40 LET qiter=256/iters +50 LET sq=SQR (2): LET qpi=PI/4 +60 LET rotation=0: LET iter=0: LET rq=1 +70 DIM r(level) +75 GO SUB 80: STOP +80 REM Dragon +90 IF level>1 THEN GO TO 200 +100 LET yn=SIN (rotation)*insize+y +110 LET xn=COS (rotation)*insize+x +120 PLOT x,y: DRAW xn-x,yn-y +130 LET iter=iter+1 +140 LET x=xn: LET y=yn +150 RETURN +200 LET insize=insize/sq +210 LET rotation=rotation+rq*qpi +220 LET level=level-1 +230 LET r(level)=rq: LET rq=1 +240 GO SUB 80 +250 LET rotation=rotation-r(level)*qpi*2 +260 LET rq=-1 +270 GO SUB 80 +280 LET rq=r(level) +290 LET rotation=rotation+rq*qpi +300 LET level=level+1 +310 LET insize=insize*sq +320 RETURN diff --git a/Task/Draw-a-clock/00DESCRIPTION b/Task/Draw-a-clock/00DESCRIPTION index fbd6668161..fb42ba2695 100644 --- a/Task/Draw-a-clock/00DESCRIPTION +++ b/Task/Draw-a-clock/00DESCRIPTION @@ -1,7 +1,17 @@ -'''Task''': draw a clock. More specific: -:# Draw a time keeping device. It can be a stopwatch, hourglass, sundial, a mouth counting "one thousand and one", anything. Only showing the seconds is required, e.g. a watch with just a second hand will suffice. However, it must clearly change every second, and the change must cycle every so often (one minute, 30 seconds, etc.) It must be ''drawn''; printing a string of numbers to your terminal doesn't qualify. Both text-based and graphical drawing are OK. -:# The clock is unlikely to be used to control space flights, so it needs not be hyper-accurate, but it should be usable, meaning if one can read the seconds off the clock, it must agree with the system clock. -:# A clock is rarely (never?) a major application: don't be a CPU hog and poll the system timer every microsecond, use a proper timer/signal/event from your system or language instead. For a bad example, many OpenGL programs update the framebuffer in a busy loop even if no redraw is needed, which is very undesirable for this task. -:# A clock is rarely (never?) a major application: try to keep your code simple and to the point. Don't write something too elaborate or convoluted, instead do whatever is natural, concise and clear in your language. +;Task: +Draw a clock. -Key points: animate simple object; timed event; polling system resources; code clarity. + +More specific: +# Draw a time keeping device. It can be a stopwatch, hourglass, sundial, a mouth counting "one thousand and one", anything. Only showing the seconds is required, e.g.: a watch with just a second hand will suffice. However, it must clearly change every second, and the change must cycle every so often (one minute, 30 seconds, etc.) It must be ''drawn''; printing a string of numbers to your terminal doesn't qualify. Both text-based and graphical drawing are OK. +# The clock is unlikely to be used to control space flights, so it needs not be hyper-accurate, but it should be usable, meaning if one can read the seconds off the clock, it must agree with the system clock. +# A clock is rarely (never?) a major application: don't be a CPU hog and poll the system timer every microsecond, use a proper timer/signal/event from your system or language instead. For a bad example, many OpenGL programs update the frame-buffer in a busy loop even if no redraw is needed, which is very undesirable for this task. +# A clock is rarely (never?) a major application: try to keep your code simple and to the point. Don't write something too elaborate or convoluted, instead do whatever is natural, concise and clear in your language. + +
    +;Key points +* animate simple object +* timed event +* polling system resources +* code clarity +

    diff --git a/Task/Draw-a-clock/Icon/draw-a-clock-1.icon b/Task/Draw-a-clock/Icon/draw-a-clock-1.icon new file mode 100644 index 0000000000..4d4005b3b6 --- /dev/null +++ b/Task/Draw-a-clock/Icon/draw-a-clock-1.icon @@ -0,0 +1,112 @@ +link graphics + +global xsize, + ysize, + fontsize + +procedure main(args) + if *args > 0 then xsize := ysize := numeric(args[1]) + + /xsize := /ysize := 200 + WIN := WOpen("size=" || xsize || "," || ysize, "label=Clock", "resize=on") | stop("Fenster geht nicht auf!", image(xsize), " - ", image(ysize)) + ziffernblatt() + + repeat + { write(&time) + + if *Pending(WIN) > 1 then while *Pending() > 0 do + { e := Event() + ziffernblatt() + } + + Fg("#CFB53B") + FillCircle(xsize/2, ysize/2, xsize/2 * 0.81) + Fg("black") + + clock := &clock + sec := clock[7:0] + min := clock[4:6] + hour := clock[1:3] + + if fontsize > 7 then + { #Fg("yellow") + EraseArea(10,0, TextWidth(clock),WAttrib("fheight")) + DrawString(10,fontsize, clock) + } + + draw_zeiger(hour, min, sec) + + WFlush() + delay(100) + } +end + +procedure ziffernblatt() + xsize := WAttrib("width") + ysize := WAttrib("height") + if xsize < ysize then ysize := xsize + if ysize < xsize then xsize := ysize + + EraseArea(0,0,WAttrib("width"),WAttrib("height")) + + Fg("#CFB53B") + FillCircle(xsize/2, ysize/2, xsize/2) + Fg("black") + fontsize := fontsize := 30 * xsize / 800.0 + + every i := 1 to 60 do + { winkel := 6 * i / 180.0 * &pi + if i % 5 = 0 then + { laenge := 0.95 + if fontsize > 15 then + { Font("mono," || integer(fontsize) || ",bold") + WAttrib("linewidth=3") + } + if fontsize > 8 then + { Font("sans," || integer(fontsize)) + WAttrib("linewidth=2") + } + + if fontsize > 8 then DrawString(xsize/2 + 0.90 * xsize/2 * sin(winkel) - fontsize / 2, ysize/2 - 0.90 * ysize/2 * cos(winkel) + fontsize/2, (i/5)("I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX", "X", "XI", "XII")) + } + else laenge := 0.98 + if fontsize >= 5 then DrawLine(xsize/2 + laenge * xsize/2 * sin(winkel), ysize/2 - laenge * ysize/2 * cos(winkel), xsize/2 + 0.99 * xsize/2 * sin(winkel), ysize/2 - 0.99 * ysize/2 * cos(winkel)) + if fontsize < 5 then if i % 5 = 0 then + { WAttrib("linewidth=1") + DrawLine(xsize/2 + laenge * xsize/2 * sin(winkel), ysize/2 - laenge * ysize/2 * cos(winkel), xsize/2 + 0.99 * xsize/2 * sin(winkel), ysize/2 - 0.99 * ysize/2 * cos(winkel)) + } + } + clock := &clock + sec := clock[7:0] + min := clock[4:6] + hour := clock[1:3] + + if fontsize > 7 then + { EraseArea(10,0, TextWidth(clock),WAttrib("fheight")) + DrawString(10,fontsize, clock) + } + draw_zeiger(hour, min, sec) + + Fg("#D4AF37") + FillCircle(xsize/2, ysize/2, 5) + Fg("black") + WAttrib("linewidth=2") + + DrawCircle(xsize/2, ysize/2,5) + +end + +procedure draw(laenge, breite, winkel) + WAttrib("linewidth=" || breite) + DrawLine(xsize/2,ysize/2,xsize/2 + laenge * sin(winkel), ysize/2 - laenge * cos(winkel)) +end + +procedure draw_zeiger(h, m, s) + wh := 30 * ((h % 12) + m / 60.0 + s / 3600.0) / 180 * &pi + wm := 6 * (m + s / 60.0) / 180.0 * &pi + ws := 6 * s / 180.0 * &pi + + draw(xsize/2 * 0.5, 5, wh) # Stundenzeiger + draw(xsize/2 * 0.65, 3, wm) # Minutenzeiger + draw(xsize/2 * 0.80, 1, ws) # Sekundenzeiger +end diff --git a/Task/Draw-a-clock/Icon/draw-a-clock-2.icon b/Task/Draw-a-clock/Icon/draw-a-clock-2.icon new file mode 100644 index 0000000000..5529c7ff40 --- /dev/null +++ b/Task/Draw-a-clock/Icon/draw-a-clock-2.icon @@ -0,0 +1,181 @@ +link graphics, turtle + +global xsize, + ysize, + fontsize + +procedure main(args) + if *args > 0 then xsize := ysize := numeric(args[1]) + + /xsize := /ysize := 200 + WIN := WOpen("size=" || xsize || "," || ysize, "label=Clock", "resize=on") | stop("Fenster geht nicht auf!", image(xsize), " - ", image(ysize)) + ziffernblatt() + + TInit() + +# clocker := create((right("0" || (0 to 23), 2) || ":" || right("0" || (0 to 59), 2) || ":" || right("0" || (0 to 59), 2))) # simul_clock() + + repeat + { write(&time) + + if *Pending(WIN) > 1 then + { while *Pending() > 0 do e := Event() + ziffernblatt() + } + + Fg("#CFB53B") + FillCircle(xsize/2, ysize/2, xsize/2 * 0.81) + Fg("black") + + clock := &clock #clock := @clocker + sec := clock[7:0] + min := clock[4:6] + hour := clock[1:3] + + if fontsize > 7 then + { altfg := Fg() + Fg("blue") + altbg := Bg() + Bg("black") + + if fh := open("/etc/timezone", "r") then + { timezone := read(fh) + close(fh) + } + + erase := TextWidth(clock) + erase <:= TextWidth(&date) + erase <:= TextWidth(timezone) + + EraseArea(xsize/2 - erase / 2, ysize * 7 / 8, erase, WAttrib("fheight")) + DrawString(xsize/2 - TextWidth(clock) / 2,ysize * 7 / 8 + WAttrib("fheight") - WAttrib("descent"), clock) + + EraseArea(xsize/2 - erase / 2, ysize * 7 / 8 - WAttrib("fheight"), erase,WAttrib("fheight")) + DrawString(xsize/2 - TextWidth(&date) / 2,ysize * 7 / 8 - WAttrib("fheight") + WAttrib("fheight") - WAttrib("descent"), &date) + + + EraseArea(xsize/2 - erase / 2, ysize * 7 / 8 - 2 * WAttrib("fheight"), erase,WAttrib("fheight")) + DrawString(xsize/2 - TextWidth(timezone) / 2,ysize * 7 / 8 - 2 * WAttrib("fheight") + WAttrib("fheight") - WAttrib("descent"), timezone) + + Bg(altbg) + Fg(altfg) + } + + draw_zeiger(hour, min, sec) + + Fg("#D4AF37") + FillCircle(xsize/2, ysize/2, 5 * xsize / 400.0) + Fg("black") + WAttrib("linewidth=" || 2 * xsize / 400) + + DrawCircle(xsize/2, ysize/2, 5 * xsize / 400.0) + + WAttrib("linewidth=1") + + WFlush() + delay(50) + } +end + +procedure ziffernblatt() + xsize := WAttrib("width") + ysize := WAttrib("height") + if xsize < ysize then ysize := xsize + if ysize < xsize then xsize := ysize + + EraseArea(0,0,WAttrib("width"),WAttrib("height")) + + Fg("#CFB53B") + FillCircle(xsize/2, ysize/2, xsize/2) + Fg("black") + fontsize := fontsize := 30 * xsize / 800.0 + WAttrib("linewidth=1") + + every i := 1 to 60 do + { winkel := 6 * i / 180.0 * &pi + TX(xsize/2) + TY(ysize/2) + THeading(i * 6) + + if i % 5 = 0 then + { laenge := 0.95 + if fontsize > 15 then + { Font("mono," || integer(fontsize) || ",bold") + WAttrib("linewidth=3") + } + if fontsize > 8 then + { Font("sans," || integer(fontsize)) + WAttrib("linewidth=2") + } + + if fontsize > 8 then DrawString(xsize/2 + 0.90 * xsize/2 * sin(winkel) - fontsize / 2, ysize/2 - 0.90 * ysize/2 * cos(winkel) + fontsize/2, (i/5)("I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX", "X", "XI", "XII")) + } + else + { laenge := 0.98 + if fontsize > 15 then WAttrib("linewidth=3") + if fontsize > 8 then WAttrib("linewidth=2") + if fontsize < 5 then WAttrib("linewidth=1") + + } + if fontsize >= 5 then {TSkip(laenge * xsize/2); TDraw((0.99-laenge) * xsize / 2)} #DrawLine(xsize/2 + laenge * xsize/2 * sin(winkel), ysize/2 - laenge * ysize/2 * cos(winkel), xsize/2 + 0.99 * xsize/2 * sin(winkel), ysize/2 - 0.99 * ysize/2 * cos(winkel)) + if fontsize < 5 then if i % 5 = 0 then + { WAttrib("linewidth=1") + TSkip(laenge * xsize/2); TDraw((0.99-laenge) * xsize / 2) #DrawLine(xsize/2 + laenge * xsize/2 * sin(winkel), ysize/2 - laenge * ysize/2 * cos(winkel), xsize/2 + 0.99 * xsize/2 * sin(winkel), ysize/2 - 0.99 * ysize/2 * cos(winkel)) + } + } + clock := &clock + sec := clock[7:0] + min := clock[4:6] + hour := clock[1:3] + + #if fontsize > 7 then + #{ EraseArea(10,0, TextWidth(clock),WAttrib("fheight")) + # DrawString(10,fontsize, clock) + #} + draw_zeiger(hour, min, sec) +end + +procedure draw(zeiger, laenge, breite, winkel) + TX(xsize/2); TY(ysize/2); THeading(winkel - 90) + WAttrib("linewidth=" || breite) + TDraw(laenge) + if zeiger == ("h" | "m" | "s") then + { + TSkip((0.05 + breite / 250.0) * xsize / 5) + WAttrib("linewidth=1") + TFPoly((0.05 + breite / 250.0) * xsize,3) + } + if zeiger == ("h" | "m" | "s") then + { Fg("green yellow") + TFPoly(0.04 * xsize, 3) + Fg("black") + } + WAttrib("linewidth=" || breite) + + if zeiger == "r" then + { TSkip(0.025 * xsize) + TCircle(0.05 * xsize) + } + if breite > 7 then + { Fg("green yellow") + TX(xsize/2); TY(ysize/2); THeading(winkel -90) + TSkip(laenge / 2) + TFRect(laenge / 2, breite -5) + Fg("black") + } +end + +procedure draw_zeiger(h, m, s) + wh := 30 * ((h % 12) + m / 60.0 + s / 3600.0) #/ 180 * &pi + wm := 6 * (m + s / 60.0) #/ 180.0 * &pi + ws := 6 * s #/ 180.0 * &pi + + draw("h", xsize/2 * 0.45,20 * xsize / 800, wh) # Stundenzeiger + draw("r", xsize/2 * 0.15,20 * xsize / 800, wh - 180) + + draw("m", xsize/2 * 0.60,12 * xsize / 800, wm) # Minutenzeiger + draw("r", xsize/2 * 0.20,12 * xsize / 800, wm - 180) + + draw("s", xsize/2 * 0.70, 4 * xsize / 800, ws) # Sekundenzeiger + draw("r", xsize/2 * 0.25, 8 * xsize / 800, ws - 180) +end diff --git a/Task/Draw-a-cuboid/00DESCRIPTION b/Task/Draw-a-cuboid/00DESCRIPTION index 5adc1a0d72..2c969be978 100644 --- a/Task/Draw-a-cuboid/00DESCRIPTION +++ b/Task/Draw-a-cuboid/00DESCRIPTION @@ -1,8 +1,9 @@ -The task is to draw a [http://en.wikipedia.org/wiki/Cuboid cuboid] -with relative dimensions of 2x3x4. +;Task: +Draw a [http://en.wikipedia.org/wiki/Cuboid cuboid] with relative dimensions of 2x3x4. The cuboid can be represented graphically, or in ASCII art, depending on the language capabilities. To fulfill the criteria of being a cuboid, three faces must be visible. -The cuboid can be represented graphically, or in ascii art, -depending on the language capabilities. - -To fulfil the criteria of being a cuboid, three faces must be visible.
    Either static or rotational projection is acceptable for this task. +

    + +;Related tasks +* [[Draw_a_rotating_cube|Draw a rotating cube]] +

    diff --git a/Task/Draw-a-cuboid/Elixir/draw-a-cuboid.elixir b/Task/Draw-a-cuboid/Elixir/draw-a-cuboid.elixir index 336d2d74e4..5450515446 100644 --- a/Task/Draw-a-cuboid/Elixir/draw-a-cuboid.elixir +++ b/Task/Draw-a-cuboid/Elixir/draw-a-cuboid.elixir @@ -15,19 +15,19 @@ defmodule Cuboid do area = Enum.reduce(0..nz-1, area, fn i,acc -> draw_line(acc, y, x, @z*i, :/) end) area = Enum.reduce(0..nx, area, fn i,acc -> draw_line(acc, y, @x*i, z, :/) end) Enum.each(y+z..0, fn j -> - IO.puts Enum.map(0..x+y, fn i -> Dict.get(area, {i,j}, " ") end) |> Enum.join + IO.puts Enum.map_join(0..x+y, fn i -> Map.get(area, {i,j}, " ") end) end) end defp draw_line(area, n, sx, sy, c) do - {dx, dy} = Dict.get(@dir, c) + {dx, dy} = Map.get(@dir, c) draw_line(area, n, sx, sy, c, dx, dy) end defp draw_line(area, n, _, _, _, _, _) when n<0, do: area defp draw_line(area, n, i, j, c, dx, dy) do - area2 = Dict.update(area, {i,j}, c, fn _ -> :+ end) - draw_line(area2, n-1, i+dx, j+dy, c, dx, dy) + Map.update(area, {i,j}, c, fn _ -> :+ end) + |> draw_line(n-1, i+dx, j+dy, c, dx, dy) end end diff --git a/Task/Draw-a-cuboid/Openscad/draw-a-cuboid.scad b/Task/Draw-a-cuboid/Openscad/draw-a-cuboid.scad index 35dbee5228..7661d6f883 100644 --- a/Task/Draw-a-cuboid/Openscad/draw-a-cuboid.scad +++ b/Task/Draw-a-cuboid/Openscad/draw-a-cuboid.scad @@ -1,2 +1,2 @@ // This will produce a simple cuboid -cube([2,3,4]) +cube([2,3,4]); diff --git a/Task/Draw-a-cuboid/PARI-GP/draw-a-cuboid.pari b/Task/Draw-a-cuboid/PARI-GP/draw-a-cuboid.pari new file mode 100644 index 0000000000..7950587bac --- /dev/null +++ b/Task/Draw-a-cuboid/PARI-GP/draw-a-cuboid.pari @@ -0,0 +1,25 @@ +\\ Simple "cuboid". Try different parameters of this Cuboid() function. +\\ 4/11/16 aev +Cuboid(a,b,c,u=10)={ +my(dx,dy,ttl="Cuboid AxBxC: ",size=200,da=a*u,db=b*u,dc=c*u); +print(" *** ",ttl,a,"x",b,"x",c,"; u=",u); +plotinit(0); +plotscale(0, 0,size, 0,size); +plotcolor(0,7); \\grey +plotmove(0, 0,0); +plotrline(0,dc,da\2); plotrline(0,db,0); plotrline(0,-db,0); +plotrline(0,0,da); +plotcolor(0,2); \\black +plotmove(0, db,da); +plotrline(0,0,-da); plotrline(0,-db,0); +plotrline(0,0,da); plotrline(0,db,0); +plotrline(0,dc,da\2); plotrline(0,-db,0); plotrline(0,-dc,-da\2); +plotmove(0, db,0); +plotrline(0,dc,da\2); plotrline(0,0,da); +plotdraw([0,size,size]); +} + +{\\ Executing: +Cuboid(2,3,4,20); \\Cuboid1.png +Cuboid(5,3,1,20); \\Cuboid2.png +} diff --git a/Task/Draw-a-cuboid/Perl-6/draw-a-cuboid.pl6 b/Task/Draw-a-cuboid/Perl-6/draw-a-cuboid.pl6 index bdc53af666..8c82858fe2 100644 --- a/Task/Draw-a-cuboid/Perl-6/draw-a-cuboid.pl6 +++ b/Task/Draw-a-cuboid/Perl-6/draw-a-cuboid.pl6 @@ -28,7 +28,7 @@ sub cuboid ( [$x, $y, $z] ) { my \x = $x * 4; my \y = $y * 4; my \z = $z * 2; - my Bool %t; + my %t; sub horz ($X, $Y) { %t{$Y }{$X + $_} = True for 0 .. x } sub vert ($X, $Y) { %t{$Y + $_}{$X } = True for 0 .. y } sub diag ($X, $Y) { %t{$Y - $_}{$X + $_} = True for 0 .. z } diff --git a/Task/Draw-a-cuboid/REXX/draw-a-cuboid.rexx b/Task/Draw-a-cuboid/REXX/draw-a-cuboid.rexx index 5f7614a0ed..50cf946889 100644 --- a/Task/Draw-a-cuboid/REXX/draw-a-cuboid.rexx +++ b/Task/Draw-a-cuboid/REXX/draw-a-cuboid.rexx @@ -1,17 +1,17 @@ -/*REXX program displays a cuboid (dimensions must be positive integers). */ -parse arg x y z indent . /*x,y,z: dimensions and indentation. */ -x=p(x 2); y=p(y 3); z=p(z 4) /*use the defaults if not specified. */ -in=p(indent 0) - call show y+2 , , "+-" - do j=1 for y; call show y-j+2, j-1, "/ |" ; end - call show , y , "+-|" - do z-1; call show , y , "| |" ; end - call show , y , "| +" - do j=1 for y; call show , y-j, "| /" ; end - call show , , "+-" -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -p: return word(arg(1), 1) /*pick the first number or word in list*/ -/*────────────────────────────────────────────────────────────────────────────*/ -show: parse arg #,$,a 2 b 3 c 4 /*get the arguments (or parts thereof).*/ - say left('',in)right(a,p(# 1))copies(b,4*x)a || right(c,p($ 0)+1); return +/*REXX program displays a cuboid (dimensions, if specified, must be positive integers).*/ +parse arg x y z indent . /*x, y, z: dimensions and indentation.*/ +x=p(x 2); y=p(y 3); z=p(z 4); in=p(indent 0) /*use the defaults if not specified. */ +pad=left('', in) /*indentation must be non-negative. */ + call show y+2 , , "+-" + do j=1 for y; call show y-j+2, j-1, "/ |" ; end /*j*/ + call show , y , "+-|" + do z-1; call show , y , "| |" ; end /*z-1*/ + call show , y , "| +" + do j=1 for y; call show , y-j, "| /" ; end /*j*/ + call show , , "+-" +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +p: return word( arg(1), 1) /*pick the first number or word in list*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +show: parse arg #,$,a 2 b 3 c 4 /*get the arguments (or parts thereof).*/ + say pad || right(a, p(# 1) )copies(b, 4*x)a || right(c, p($ 0) + 1); return diff --git a/Task/Draw-a-cuboid/ZX-Spectrum-Basic/draw-a-cuboid.zx b/Task/Draw-a-cuboid/ZX-Spectrum-Basic/draw-a-cuboid.zx new file mode 100644 index 0000000000..a254868389 --- /dev/null +++ b/Task/Draw-a-cuboid/ZX-Spectrum-Basic/draw-a-cuboid.zx @@ -0,0 +1,6 @@ +10 LET width=50: LET height=width*1.5: LET depth=width*2 +20 LET x=80: LET y=10 +30 PLOT x,y +40 DRAW 0,height: DRAW width,0: DRAW 0,-height: DRAW -width,0: REM Front +50 PLOT x,y+height: DRAW depth/2,height: DRAW width,0: DRAW 0,-height: DRAW -width,-height +60 PLOT x+width,y+height: DRAW depth/2,height diff --git a/Task/Draw-a-sphere/00DESCRIPTION b/Task/Draw-a-sphere/00DESCRIPTION index d685926366..f728b86f74 100644 --- a/Task/Draw-a-sphere/00DESCRIPTION +++ b/Task/Draw-a-sphere/00DESCRIPTION @@ -1,6 +1,7 @@ -The task is to draw a sphere. +;Task: +Draw a sphere. -The sphere can be represented graphically, or in ascii art, -depending on the language capabilities. +The sphere can be represented graphically, or in ASCII art, depending on the language capabilities. Either static or rotational projection is acceptable for this task. +

    diff --git a/Task/Draw-a-sphere/ATS/draw-a-sphere.ats b/Task/Draw-a-sphere/ATS/draw-a-sphere.ats new file mode 100644 index 0000000000..13719a57a0 --- /dev/null +++ b/Task/Draw-a-sphere/ATS/draw-a-sphere.ats @@ -0,0 +1,101 @@ +(* +** Solution to Draw_a_sphere.dats +*) + +(* ****** ****** *) +// +#include +"share/atspre_define.hats" // defines some names +#include +"share/atspre_staload.hats" // for targeting C +#include +"share/HATS/atspre_staload_libats_ML.hats" // for ... +#include +"share/HATS/atslib_staload_libats_libc.hats" // for libc +// +(* ****** ****** *) + +extern +fun +Draw_a_sphere +( + R: double, k: double, ambient: double +) : void // end of [Draw_a_sphere] + +(* ****** ****** *) + +implement +Draw_a_sphere +( + R: double, k: double, ambient: double +) = let + fun normalize(v0: double, v1: double, v2: double): (double, double, double) = let + val len = sqrt(v0*v0+v1*v1+v2*v2) + in + (v0/len, v1/len, v2/len) + end // end of [normalize] + + fun dot(v0: double, v1: double, v2: double, x0: double, x1: double, x2: double): double = let + val d = v0*x0+v1*x1+v2*x2 + val sgn = gcompare_val_val (d, 0.0) + in + if sgn < 0 then ~d else 0.0 + end // end of [dot] + + fun print_char(i: int): void = + if i = 0 then print!(".") else + if i = 1 then print!(":") else + if i = 2 then print!("!") else + if i = 3 then print!("*") else + if i = 4 then print!("o") else + if i = 5 then print!("e") else + if i = 6 then print!("&") else + if i = 7 then print!("#") else + if i = 8 then print!("%") else + if i = 9 then print!("@") else print!(" ") + + val i_start = floor(~R) + val i_end = ceil(R) + val j_start = floor(~2 * R) + val j_end = ceil(2 * R) + val (l0, l1, l2) = normalize(30.0, 30.0, ~50.0) + + fun loopj(j: int, j_end: int, x: double): void = let + val y = j / 2.0 + 0.5; + val sgn = gcompare_val_val (x*x + y*y, R*R) + val (v0, v1, v2) = normalize(x, y, sqrt(R*R - x*x - y*y)) + val b = pow(dot(l0, l1, l2, v0, v1, v2), k) + ambient + val intensity = 9.0 - 9.0*b + val sgn2 = gcompare_val_val (intensity, 0.0) + val sgn3 = gcompare_val_val (intensity, 9.0) + in + ( if sgn > 0 then print_char(10) else + if sgn2 < 0 then print_char(0) else + if sgn3 >= 0 then print_char(8) else + print_char(g0float2int(intensity)); + if j < j_end then loopj(j+1, j_end, x) + ) + end // end of [loopj] + + fun loopi(i: int, i_end: int, j: int, j_end: int): void = let + val x = i + 0.5 + val () = loopj(j, j_end, x) + val () = println!() + in + if i < i_end then loopi(i+1, i_end, j, j_end) + end // end of [loopi] + +in + loopi(g0float2int(i_start), g0float2int(i_end), g0float2int(j_start), g0float2int(j_end)) +end + +(* ****** ****** *) + +implement +main0() = () where +{ + val () = DrawSphere(20.0, 4.0, .1) + val () = DrawSphere(10.0, 2.0, .4) +} (* end of [main0] *) + +(* ****** ****** *) diff --git a/Task/Draw-a-sphere/BASIC/draw-a-sphere-4.basic b/Task/Draw-a-sphere/BASIC/draw-a-sphere-4.basic index 220de6134d..f4edd507d1 100644 --- a/Task/Draw-a-sphere/BASIC/draw-a-sphere-4.basic +++ b/Task/Draw-a-sphere/BASIC/draw-a-sphere-4.basic @@ -42,7 +42,7 @@ Next Locate 50,2 Color(RGB(255,255,255),RGB(0,0,0)) ' foreground color is changed ' empty keyboard buffer -While InKey <> "" : Var _key_ = InKey : Wend +While InKey <> "" : Wend Print : Print "hit any key to end program" Sleep End diff --git a/Task/Draw-a-sphere/Batch-File/draw-a-sphere.bat b/Task/Draw-a-sphere/Batch-File/draw-a-sphere.bat new file mode 100644 index 0000000000..11a202dd2c --- /dev/null +++ b/Task/Draw-a-sphere/Batch-File/draw-a-sphere.bat @@ -0,0 +1,40 @@ +@echo off +setlocal enabledelayedexpansion +mode con cols=80 + +set /a r=220,cent=340,r2=r/2 +set "spaces= " +set "block1=MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM" +set "block2=#########" +set "block3=XXXXXXXXX" +set "block4=ooooooooo" +set "block5=?????????" +set "block6=*********" +set "block7=~~~~~~~~~" +set "block8=---------" + +set wy=0 +set linea= +echo Batch-File ASCII Ball +echo. +for /L %%y in (-%r%,10,%r%) do ( + set /a "w1=r*r-%%y*%%y" + call:sqrt2 w1 w1 + set /a "w1=14*w1/10,wy=(cent-w1),cnt=0,sp=wy/10,centre=cent/10-sp" + call set "linea=%%spaces:~0,!sp!%%%%block1:~0,!centre!%% + set /a wy=0,sum=0 + for %%i in (30 80 120 150 170 185 195 200) do ( + set /a "cnt+=1,wy2=(%%i+r2)*w1/r,ww=(wy2+5)/10-sum,wy=wy2,sum+=ww" + call set miblock=%%block!cnt!%% + call set "Linea=%%linea%%%%miblock:~0,!ww!%%" + ) + call echo(!linea! +) +echo. +exit /b + +:sqrt2 [num] calculates integer square root . By AAcini +set "s=!%~1!" +set /A "x=s/(11*1024)+40,x=(s/x+x)>>1,x=(s/x+x)>>1,x=(s/x+x)>>1,x=(s/x+x)>>1,x=(s/x+x)>>1,x+=(s-x*x)>>31 +set %~2=%x% +exit /b diff --git a/Task/Draw-a-sphere/Maple/draw-a-sphere.maple b/Task/Draw-a-sphere/Maple/draw-a-sphere.maple new file mode 100644 index 0000000000..c844fcd571 --- /dev/null +++ b/Task/Draw-a-sphere/Maple/draw-a-sphere.maple @@ -0,0 +1 @@ +plots[display](plottools[sphere](), axes = none, style = surface); diff --git a/Task/Draw-a-sphere/REXX/draw-a-sphere.rexx b/Task/Draw-a-sphere/REXX/draw-a-sphere.rexx index af1ded11a5..a743b61228 100644 --- a/Task/Draw-a-sphere/REXX/draw-a-sphere.rexx +++ b/Task/Draw-a-sphere/REXX/draw-a-sphere.rexx @@ -1,39 +1,38 @@ -/*REXX program expresses a lighted sphere with simple characters for shading.*/ -call drawSphere 19, 4, 2/10 /*draw a sphere with a radius of 19. */ -call drawSphere 10, 2, 4/10 /* " " " " " " " ten. */ -exit /*stick a fork in it, we're all done. */ -/*─────────────────────────────────────one─liner subroutines──────────────────*/ -ceil: procedure; parse arg x; _=trunc(x); return _ + (x>0) *(x\=_) -floor: procedure; parse arg x; _=trunc(x); return _ - (x<0) *(x\=_) -norm: parse arg _1 _2 _3; _=sqrt(_1**2+_2**2+_3**2); return _1/_ _2/_ _3/_ -/*──────────────────────────────────DRAWSPHERE subroutine─────────────────────*/ -drawSphere: procedure; parse arg r, k, ambient /*get the arguments from CL*/ -if 1=='f1'x then shading= ".:!*oe&#%@" /* EBCDIC dithering chars. */ - else shading= "·:!°oe@░▒▓" /* ASCII " " */ -lightSource = '30 30 -50' /*position of light source.*/ -parse value norm(lightSource) with s1 s2 s3 /*normalize light source. */ -sLen=length(shading)-1; rr=r*r /*handy─dandy variables. */ +/*REXX program expresses a lighted sphere with simple characters used for shading. */ +call drawSphere 19, 4, 2/10 /*draw a sphere with a radius of 19. */ +call drawSphere 10, 2, 4/10 /* " " " " " " " ten. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +ceil: procedure; parse arg x; _=trunc(x); return _ + (x>0) *(x\=_) +floor: procedure; parse arg x; _=trunc(x); return _ - (x<0) *(x\=_) +norm: parse arg $a $b $c; _=sqrt($a**2 + $b**2 + $c**2); return $a/_ $b/_ $c/_ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +drawSphere: procedure; parse arg r, k, ambient /*get the arguments from CL*/ + if 5=='f5'x then shading= ".:!*oe&#%@" /* EBCDIC dithering chars. */ + else shading= "·:!°oe@░▒▓" /* ASCII " " */ + lightSource= '30 30 -50' /*position of light source.*/ + parse value norm(lightSource) with s1 s2 s3 /*normalize light source. */ + sLen=length(shading)-1; rr=r*r /*handy─dandy variables. */ - do i=floor(-r) to ceil(r) ; x= i+.5; xx=x**2; $= - do j=floor(-2*r) to ceil(r+r); y=j/2+.5; yy=y**2 - if xx+yy<=rr then do /*is point within sphere ? */ - parse value norm(x y sqrt(rr-xx-yy)) with v1 v2 v3 - dot=s1*v1 + s2*v2 + s3*v3 /*the dot product of the Vs*/ - if dot>0 then dot=0 /*if positive, make it zero*/ - b=abs(dot)**k + ambient /*calculate the brightness.*/ - if b<=0 then brite=sLen - else brite=trunc( max( (1-b) * sLen, 0) ) - $=($)substr(shading,brite+1,1) /*build a display line.*/ - end - else $=$' ' /*append a blank to line. */ - end /*j*/ - say strip($,'trailing') /*show a line of the sphere*/ - end /*i*/ /* [↑] display the sphere.*/ -return -/*──────────────────────────────────SQRT subroutine───────────────────────────*/ -sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); i=; m.=9 - numeric digits 9; numeric form; h=d+6; if x<0 then do; x=-x; i='i'; end - parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_%2 - do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ - do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ - numeric digits d; return (g/1)i /*make complex if X < 0.*/ + do i=floor(-r) to ceil(r) ; x= i+.5; xx=x**2; $= + do j=floor(-2*r) to ceil(r+r); y=j/2+.5; yy=y**2 + if xx+yy<=rr then do /*is point within sphere ? */ + parse value norm(x y sqrt(rr-xx-yy)) with v1 v2 v3 + dot=s1*v1 + s2*v2 + s3*v3 /*the dot product of the Vs*/ + if dot>0 then dot=0 /*if positive, make it zero*/ + b=abs(dot)**k + ambient /*calculate the brightness.*/ + if b<=0 then brite=sLen + else brite=trunc( max( (1-b) * sLen, 0) ) + $=($)substr(shading,brite+1,1) /*construct a display line.*/ + end + else $=$' ' /*append a blank to line. */ + end /*j*/ + say strip($, 'T') /*show a line of the sphere*/ + end /*i*/ /* [↑] display the sphere.*/ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); m.=9; numeric form + numeric digits; parse value format(x,2,1,,0) 'E0' with g "E" _ .; g=g*.5'e'_%2 + h=d+6; do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ + do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ + numeric digits d; return g/1 diff --git a/Task/Draw-a-sphere/ZX-Spectrum-Basic/draw-a-sphere.zx b/Task/Draw-a-sphere/ZX-Spectrum-Basic/draw-a-sphere.zx new file mode 100644 index 0000000000..c182cbf4cb --- /dev/null +++ b/Task/Draw-a-sphere/ZX-Spectrum-Basic/draw-a-sphere.zx @@ -0,0 +1,52 @@ +1 REM fast +50 REM spheer with hidden lines and rotation +100 CLS +110 PRINT "sphere with lenght&wide-circles" +120 PRINT "_______________________________"'' +200 INPUT "rotate x-as:";a +210 INPUT "rotate y-as:";b +220 INPUT "rotate z-as:";c +225 INPUT "distance lines(10-45):";d +230 LET u=128: LET v=87: LET r=87: LET bm=PI/180: LET h=.5 +240 LET s1=SIN (a*bm): LET s2=SIN (b*bm): LET s3=SIN (c*bm) +250 LET c1=COS (a*bm): LET c2=COS (b*bm): LET c3=COS (c*bm) +260 REM calc rotate matrix +270 LET ax=c2*c3: LET ay=-c2*s3: LET az=s2 +280 LET bx=c1*s3+s1*s2*c3 +290 LET by=c1*c3-s1*s2*s3: LET bz=-s1*c2 +300 LET cx=s1*s3-c1*s2*c3 +310 LET cy=s1*c3+c1*s2*s3: LET cz=c1*c2 +400 REM draw outer +410 CLS : CIRCLE u,v,r +500 REM draw lenght-circle +510 FOR l=0 TO 180-d STEP d +515 LET f1=0 +520 FOR p=0 TO 360 STEP 5 +530 GO SUB 1000: REM xx,yy,zz calc +540 IF yy>0 THEN LET f2=0: LET f1=0: GO TO 580 +550 LET xb=INT (u+xx+h): LET yb=INT (v+zz+h): LET f2=1 +560 IF f1=0 THEN LET x1=xb: LET y1=yb: LET f1=1: GO TO 580 +570 PLOT x1,y1: DRAW xb-x1,yb-y1: LET x1=xb: LET y1=yb: LET f1=f2 +580 NEXT p +590 NEXT l +600 REM draw wide-circle +610 FOR p=-90+d TO 90-d STEP d +615 LET f1=0 +620 FOR l=0 TO 360 STEP 5 +630 GO SUB 1000: REM xx,yy,zz +640 IF yy>0 THEN LET f2=0: LET f1=0: GO TO 680 +650 LET xb=INT (u+xx+h): LET yb=INT (v+zz+h): LET f2=1 +660 IF f1=0 THEN LET x1=xb: LET y1=yb: LET f1=1: GO TO 680 +670 PLOT x1,y1: DRAW xb-x1,yb-y1: LET x1=xb: LET y1=yb: LET f1=f2 +680 NEXT l +690 NEXT p +700 PRINT #0;"...press any key...": PAUSE 0: RUN +999 REM sfere-coordinates>>>Cartesis Coordinate +1000 LET x=r*COS (p*bm)*COS (l*bm) +1010 LET y=r*COS (p*bm)*SIN (l*bm) +1020 LET z=r*SIN (p*bm) +1030 REM p(x,y,z) rotate to p(xx,yy,zz) +1040 LET xx=ax*x+ay*y+az*z +1050 LET yy=bx*x+by*y+bz*z +1060 LET zz=cx*x+cy*y+cz*z +1070 RETURN diff --git a/Task/Dutch-national-flag-problem/00DESCRIPTION b/Task/Dutch-national-flag-problem/00DESCRIPTION index d8f60db15e..13d06b235e 100644 --- a/Task/Dutch-national-flag-problem/00DESCRIPTION +++ b/Task/Dutch-national-flag-problem/00DESCRIPTION @@ -1,22 +1,16 @@ +[[File:Dutch_flag_3.jpg|200px||right]] + The Dutch national flag is composed of three coloured bands in the order red then white and lastly blue. The problem posed by [[wp:Edsger Dijkstra|Edsger Dijkstra]] is: :Given a number of red, blue and white balls in random order, arrange them in the order of the colours Dutch national flag. When the problem was first posed, Dijkstra then went on to successively refine a solution, minimising the number of swaps and the number of times the colour of a ball needed to determined and restricting the balls to end in an array, ... -;This task is to: +;Task # Generate a randomized order of balls ''ensuring that they are not in the order of the Dutch national flag''. # Sort the balls in a way idiomatic to your language. # Check the sorted balls ''are'' in the order of the Dutch national flag. -
    -; A rendition of the Dutch flag: - 
    -████████████
    -████████████
    -████████████
    -████████████
    -████████████
    -████████████

    -;Cf. +;C.f.: * [[wp:Dutch national flag problem|Dutch national flag problem]] * [https://www.google.co.uk/search?rlz=1C1DSGK_enGB472GB472&sugexp=chrome,mod=8&sourceid=chrome&ie=UTF-8&q=Dutch+national+flag+problem#hl=en&rlz=1C1DSGK_enGB472GB472&sclient=psy-ab&q=Probabilistic+analysis+of+algorithms+for+the+Dutch+national+flag+problem&oq=Probabilistic+analysis+of+algorithms+for+the+Dutch+national+flag+problem&gs_l=serp.3...60754.61818.1.62736.1.1.0.0.0.0.72.72.1.1.0...0.0.Pw3RGungndU&psj=1&bav=on.2,or.r_gc.r_pw.r_cp.r_qf.,cf.osb&fp=c33d18147f5082cc&biw=1395&bih=951 Probabilistic analysis of algorithms for the Dutch national flag problem] by Wei-Mei Chen. (pdf) +

    diff --git a/Task/Dutch-national-flag-problem/Perl-6/dutch-national-flag-problem.pl6 b/Task/Dutch-national-flag-problem/Perl-6/dutch-national-flag-problem.pl6 index 2ef861b1d3..1ec958e5a4 100644 --- a/Task/Dutch-national-flag-problem/Perl-6/dutch-national-flag-problem.pl6 +++ b/Task/Dutch-national-flag-problem/Perl-6/dutch-national-flag-problem.pl6 @@ -21,10 +21,10 @@ say "Using in-place sort"; how'bout { @colors .= sort: *.value } say "Using a Bag"; -how'bout { @colors = red, white, blue Zxx bag(@colors».key) } +how'bout { @colors = flat red, white, blue Zxx bag(@colors».key) } say "Using the classify method"; -how'bout { @colors = (.list for %(@colors.classify: *.value){0,1,2}) } +how'bout { @colors = flat (.list for %(@colors.classify: *.value){0,1,2}) } say "Using multiple greps"; -how'bout { @colors = (.grep(red), .grep(white), .grep(blue) given @colors) } +how'bout { @colors = flat (.grep(red), .grep(white), .grep(blue) given @colors) } diff --git a/Task/Dutch-national-flag-problem/Perl/dutch-national-flag-problem.pl b/Task/Dutch-national-flag-problem/Perl/dutch-national-flag-problem.pl index 5e0c7e282e..15f21b8143 100644 --- a/Task/Dutch-national-flag-problem/Perl/dutch-national-flag-problem.pl +++ b/Task/Dutch-national-flag-problem/Perl/dutch-national-flag-problem.pl @@ -1,17 +1,4 @@ -#!/usr/bin/perl -{{task}} -The Dutch national flag is composed of three coloured bands in the order red then white and lastly blue. The problem posed by [[wp:Edsger Dijkstra|Edsger Dijkstra]] is: -:Given a number of red, blue and white balls in random order, arrange them in the order of the colours Dutch national flag. -When the problem was first posed, Dijkstra then went on to successively refine a solution, minimising the number of swaps and the number of times the colour of a ball needed to determined and restricting the balls to end in an array, ... - -;This task is to: -# Generate a randomized order of balls ''ensuring that they are not in the order of the Dutch national flag''. -# Sort the balls in a way idiomatic to your language. -# Check the sorted balls ''are'' in the order of the Dutch national flag. - -;Cf. -* [[wp:Dutch national flag problem|Dutch national flag problem]] -* [https://www.google.co.uk/search?rlz=1C1DSGK_enGB472GB472use warnings; +use warnings; use strict; use 5.010; # // diff --git a/Task/Dutch-national-flag-problem/PowerShell/dutch-national-flag-problem.psh b/Task/Dutch-national-flag-problem/PowerShell/dutch-national-flag-problem.psh new file mode 100644 index 0000000000..a73f6823fa --- /dev/null +++ b/Task/Dutch-national-flag-problem/PowerShell/dutch-national-flag-problem.psh @@ -0,0 +1,16 @@ +$Colors = 'red', 'white','blue' + +# Select 10 random colors +$RandomBalls = 1..10 | ForEach { $Colors | Get-Random } + +# Ensure we aren't finished before we start. For some reason. It's in the task requirements. +While ( $RandomBalls -eq $RandomBalls | Sort { $Colors.IndexOf( $_ ) } ) + { $RandomBalls = 1..10 | ForEach { $Colors | Get-Random } } + +# Sort the colors +$SortedBalls = $RandomBalls | Sort { $Colors.IndexOf( $_ ) } + +# Display the results +$RandomBalls +'' +$SortedBalls diff --git a/Task/Dutch-national-flag-problem/REXX/dutch-national-flag-problem-1.rexx b/Task/Dutch-national-flag-problem/REXX/dutch-national-flag-problem-1.rexx index 6e9782d0f0..5ce9288047 100644 --- a/Task/Dutch-national-flag-problem/REXX/dutch-national-flag-problem-1.rexx +++ b/Task/Dutch-national-flag-problem/REXX/dutch-national-flag-problem-1.rexx @@ -1,32 +1,32 @@ -/*REXX program reorders a set of random colored balls into a correct order, */ -/*────────────which is the order of colors on the Dutch flag: red white blue.*/ -parse arg N colors /*get optional parameters from the CL. */ -if N=',' | N='' then N=15 /*Not specified? Then use the default.*/ -if colors='' then colors=space('red white blue') /*use the default colors? */ -#=words(colors) /*count the number of colors specified.*/ -@=word(colors,#) word(colors,1) /*ensure balls aren't already in order.*/ +/*REXX program reorders a set of random colored balls into a correct order, which is the*/ +/*────────────────────────────────── order of colors on the Dutch flag: red white blue.*/ +parse arg N colors /*obtain optional arguments from the CL*/ +if N='' | N="," then N=15 /*Not specified? Then use the default.*/ +if colors='' then colors= 'red white blue' /* " " " " " " */ +#=words(colors) /*count the number of colors specified.*/ +@=word(colors, #) word(colors, 1) /*ensure balls aren't already in order.*/ - do g=3 to N /*generate a random # of colored balls.*/ - @=@ word(colors, random(1, #)) /*append a random color to the @ list.*/ + do g=3 to N /*generate a random # of colored balls.*/ + @=@ word( colors, random(1, #) ) /*append a random color to the @ list.*/ end /*g*/ say 'number of colored balls generated = ' N ; say -say center(' original ball order ', length(@), '─') +say center(' original ball order ', length(@), "─") say @ ; say -$=; do j=1 for #; ; _=word(colors, j) - $=$ copies(_' ', countWords(_, @)) +$=; do j=1 for #; + _=word(colors, j); $=$ copies(_' ', countWords(_, @)) end /*j*/ say -say center(' sorted ball order ', length(@), '─') +say center(' sorted ball order ', length(@), "─") say space($) say - do k=2 to N /*verify the balls are in correct order*/ + do k=2 to N /*verify the balls are in correct order*/ if wordpos(word($,k), colors) >= wordpos(word($,k-1), colors) then iterate say "The list of sorted balls isn't in proper order!"; exit 13 end /*k*/ say say 'The sorted colored ball list has been confirmed as being sorted correctly.' -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────COUNTWORDS subroutine─────────────────────*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ countWords: procedure; parse arg ?,hay; s=1 - do r=0 until _==0; _=wordpos(?,hay,s); s=_+1; end; return r + do r=0 until _==0; _=wordpos(?, hay, s); s=_+1; end /*r*/; return r diff --git a/Task/Dutch-national-flag-problem/REXX/dutch-national-flag-problem-2.rexx b/Task/Dutch-national-flag-problem/REXX/dutch-national-flag-problem-2.rexx index b8bd04c2b6..b656ee1841 100644 --- a/Task/Dutch-national-flag-problem/REXX/dutch-national-flag-problem-2.rexx +++ b/Task/Dutch-national-flag-problem/REXX/dutch-national-flag-problem-2.rexx @@ -1,29 +1,29 @@ -/*REXX program reorders a set of random colored balls into a correct order, */ -/*────────────which is the order of colors on the Dutch flag: red white blue.*/ -parse arg N colors /*get optional parameters from the CL. */ -if N=',' | N='' then N=15 /*Not specified? Then use the default.*/ -if colors='' then colors='RWB' /*use default: R=red, W=white, B=blue */ -#=length(colors) /*count the number of colors specified.*/ -@=right(colors,1)left(colors,1) /*ensure balls aren't already in order.*/ +/*REXX program reorders a set of random colored balls into a correct order, which is the*/ +/*────────────────────────────────── order of colors on the Dutch flag: red white blue.*/ +parse arg N colors /*obtain optional arguments from the CL*/ +if N='' | N="," then N=15 /*Not specified? Then use the default.*/ +if colors='' then colors= "RWB" /*use default: R=red, W=white, B=blue */ +#=length(colors) /*count the number of colors specified.*/ +@=right(colors, 1)left(colors, 1) /*ensure balls aren't already in order.*/ - do g=3 to N /*generate a random # of colored balls.*/ - @=@ ||substr(colors,random(1,#),1) /*append a color (1char) to the @ list.*/ + do g=3 to N /*generate a random # of colored balls.*/ + @=@ ||substr( colors, random(1, #), 1) /*append a color (1char) to the @ list.*/ end /*g*/ -say 'number of colored balls generated = ' N ; say -say center(' original ball order ', max(30,2*#), '─') -say @ ; say +say 'number of colored balls generated = ' N ; say +say center(' original ball order ', max(30,2*#), "─") +say @ ; say $=; do j=1 for #; _=substr(colors, j, 1) - #=length(@) - length(space(translate(@, , _), 0)) + #=length(@) - length( space( translate(@, , _), 0) ) $=$ || copies(_, #) end /*j*/ -say center(' sorted ball order ', max(30,2*#), '─') +say center(' sorted ball order ', max(30, 2*#), "─") say $ say - do k=2 to N /*verify the balls are in correct order*/ + do k=2 to N /*verify the balls are in correct order*/ if pos(substr($,k,1), colors) >= pos(substr($,k-1,1), colors) then iterate say "The list of sorted balls isn't in proper order!"; exit 13 end /*k*/ say say 'The sorted colored ball list has been confirmed as being sorted correctly.' - /*stick a fork in it, we're all done. */ +exit /*stick a fork in it, we're all done. */ diff --git a/Task/Dutch-national-flag-problem/ZX-Spectrum-Basic/dutch-national-flag-problem.zx b/Task/Dutch-national-flag-problem/ZX-Spectrum-Basic/dutch-national-flag-problem.zx new file mode 100644 index 0000000000..a9af0fdf3d --- /dev/null +++ b/Task/Dutch-national-flag-problem/ZX-Spectrum-Basic/dutch-national-flag-problem.zx @@ -0,0 +1,14 @@ +10 LET r$="Red": LET w$="White": LET b$="Blue" +20 LET c$="RWB" +30 DIM b(10) +40 PRINT "Random:" +50 FOR n=1 TO 10 +60 LET b(n)=INT (RND*3)+1 +70 PRINT VAL$ (c$(b(n))+"$");" "; +80 NEXT n +90 PRINT ''"Sorted:" +100 FOR i=1 TO 3 +110 FOR j=1 TO 10 +120 IF b(j)=i THEN PRINT VAL$ (c$(i)+"$");" "; +130 NEXT j +140 NEXT i diff --git a/Task/Dynamic-variable-names/00DESCRIPTION b/Task/Dynamic-variable-names/00DESCRIPTION index 582654a620..98e9fa4a08 100644 --- a/Task/Dynamic-variable-names/00DESCRIPTION +++ b/Task/Dynamic-variable-names/00DESCRIPTION @@ -1,5 +1,11 @@ {{omit from|Lily}} -Create a variable with a user-defined name. The variable name should ''not'' be written in the program text, but should be taken from the user dynamically. + +;Task: +Create a variable with a user-defined name. + +The variable name should ''not'' be written in the program text, but should be taken from the user dynamically. + ;See also -* [[Eval in environment]] is a similar task. +*   [[Eval in environment]] is a similar task. +

    diff --git a/Task/Dynamic-variable-names/Common-Lisp/dynamic-variable-names-1.lisp b/Task/Dynamic-variable-names/Common-Lisp/dynamic-variable-names-1.lisp index a425deaa40..89991a85a6 100644 --- a/Task/Dynamic-variable-names/Common-Lisp/dynamic-variable-names-1.lisp +++ b/Task/Dynamic-variable-names/Common-Lisp/dynamic-variable-names-1.lisp @@ -1,6 +1,2 @@ -(defun rc-create-variable (name initial-value) - "Create a global variable whose name is NAME in the current package and which is bound to INITIAL-VALUE." - (let ((symbol (intern name))) - (proclaim `(special ,symbol)) - (setf (symbol-value symbol) initial-value) - symbol)) +(setq var-name (read)) ; reads a name into var-name +(set var-name 1) ; assigns the value 1 to a variable named as entered by the user diff --git a/Task/Dynamic-variable-names/Common-Lisp/dynamic-variable-names-2.lisp b/Task/Dynamic-variable-names/Common-Lisp/dynamic-variable-names-2.lisp index 4def18d4bb..a425deaa40 100644 --- a/Task/Dynamic-variable-names/Common-Lisp/dynamic-variable-names-2.lisp +++ b/Task/Dynamic-variable-names/Common-Lisp/dynamic-variable-names-2.lisp @@ -1,5 +1,6 @@ -CL-USER> (rc-create-variable "GREETING" "hello") -GREETING - -CL-USER> (print greeting) -"hello" +(defun rc-create-variable (name initial-value) + "Create a global variable whose name is NAME in the current package and which is bound to INITIAL-VALUE." + (let ((symbol (intern name))) + (proclaim `(special ,symbol)) + (setf (symbol-value symbol) initial-value) + symbol)) diff --git a/Task/Dynamic-variable-names/Common-Lisp/dynamic-variable-names-3.lisp b/Task/Dynamic-variable-names/Common-Lisp/dynamic-variable-names-3.lisp new file mode 100644 index 0000000000..4def18d4bb --- /dev/null +++ b/Task/Dynamic-variable-names/Common-Lisp/dynamic-variable-names-3.lisp @@ -0,0 +1,5 @@ +CL-USER> (rc-create-variable "GREETING" "hello") +GREETING + +CL-USER> (print greeting) +"hello" diff --git a/Task/Dynamic-variable-names/Elena/dynamic-variable-names.elena b/Task/Dynamic-variable-names/Elena/dynamic-variable-names.elena new file mode 100644 index 0000000000..00ce33028a --- /dev/null +++ b/Task/Dynamic-variable-names/Elena/dynamic-variable-names.elena @@ -0,0 +1,25 @@ +#import system. +#import system'dynamic. +#import extensions. + +#class TestClass +{ + #field theVariables. + + #constructor new + [ + theVariables := DynamicStruct new. + ] + + #method eval + [ + #var(type:subject) varRef := Signature new &literal:(console write:"Enter the variable name:" readLine). + theVariables::varRef set:42. + + #var v := theVariables::varRef get. + + console writeLine:(varRef name):"=":(theVariables::varRef get). + ] +} + +#symbol program = TestClass new. diff --git a/Task/Dynamic-variable-names/J/dynamic-variable-names-3.j b/Task/Dynamic-variable-names/J/dynamic-variable-names-3.j index a2700077af..6d92281c98 100644 --- a/Task/Dynamic-variable-names/J/dynamic-variable-names-3.j +++ b/Task/Dynamic-variable-names/J/dynamic-variable-names-3.j @@ -1 +1,4 @@ -(userDefined)=: 0 + userDefined=: 'BAR' + (userDefined)=: 1 + BAR +1 diff --git a/Task/Echo-server/Ada/echo-server.ada b/Task/Echo-server/Ada/echo-server-1.ada similarity index 100% rename from Task/Echo-server/Ada/echo-server.ada rename to Task/Echo-server/Ada/echo-server-1.ada diff --git a/Task/Echo-server/Ada/echo-server-2.ada b/Task/Echo-server/Ada/echo-server-2.ada new file mode 100644 index 0000000000..70fb1b6240 --- /dev/null +++ b/Task/Echo-server/Ada/echo-server-2.ada @@ -0,0 +1,143 @@ +with Ada.Text_IO; +with Ada.IO_Exceptions; +with GNAT.Sockets; +procedure echo_server_multi is +-- Multiple socket connections example based on Rosetta Code echo server. + + Tasks_To_Create : constant := 3; -- simultaneous socket connections. + +------------------------------------------------------------------------------- +-- Use stack to pop the next free task index. When a task finishes its +-- asynchronous (no rendezvous) phase, it pushes the index back on the stack. + type Integer_List is array (1..Tasks_To_Create) of integer; + subtype Counter is integer range 0 .. Tasks_To_Create; + subtype Index is integer range 1 .. Tasks_To_Create; + protected type Info is + procedure Push_Stack (Return_Task_Index : in Index); + procedure Initialize_Stack; + entry Pop_Stack (Get_Task_Index : out Index); + private + Task_Stack : Integer_List; -- Stack of free-to-use tasks. + Stack_Pointer: Counter := 0; + end Info; + + protected body Info is + procedure Push_Stack (Return_Task_Index : in Index) is + begin -- Performed by tasks that were popped, so won't overflow. + Stack_Pointer := Stack_Pointer + 1; + Task_Stack(Stack_Pointer) := Return_Task_Index; + end; + + entry Pop_Stack (Get_Task_Index : out Index) when Stack_Pointer /= 0 is + begin -- guarded against underflow. + Get_Task_Index := Task_Stack(Stack_Pointer); + Stack_Pointer := Stack_Pointer - 1; + end; + + procedure Initialize_Stack is + begin + for I in Task_Stack'range loop + Push_Stack (I); + end loop; + end; + end Info; + + Task_Info : Info; + +------------------------------------------------------------------------------- + task type SocketTask is + -- Rendezvous the setup, which sets the parameters for entry Echo. + entry Setup (Connection : GNAT.Sockets.Socket_Type; + Client : GNAT.Sockets.Sock_Addr_Type; + Channel : GNAT.Sockets.Stream_Access; + Task_Index : Index); + -- Echo accepts the asynchronous phase, i.e. no rendezvous. When the + -- communication is over, push the task number back on the stack. + entry Echo; + end SocketTask; + + task body SocketTask is + my_Connection : GNAT.Sockets.Socket_Type; + my_Client : GNAT.Sockets.Sock_Addr_Type; + my_Channel : GNAT.Sockets.Stream_Access; + my_Index : Index; + begin + loop -- Infinitely reusable + accept Setup (Connection : GNAT.Sockets.Socket_Type; + Client : GNAT.Sockets.Sock_Addr_Type; + Channel : GNAT.Sockets.Stream_Access; + Task_Index : Index) do + -- Store parameters and mark task busy. + my_Connection := Connection; + my_Client := Client; + my_Channel := Channel; + my_Index := Task_Index; + end; + + accept Echo; -- Do the echo communications. + begin + Ada.Text_IO.Put_Line ("Task " & integer'image(my_Index)); + loop + Character'Output (my_Channel, Character'Input(my_Channel)); + end loop; + exception + when Ada.IO_Exceptions.End_Error => + Ada.Text_IO.Put_Line ("Echo " & integer'image(my_Index) & " end"); + when others => + Ada.Text_IO.Put_Line ("Echo " & integer'image(my_Index) & " err"); + end; + GNAT.Sockets.Close_Socket (my_Connection); + Task_Info.Push_Stack (my_Index); -- Return to stack of unused tasks. + end loop; + end SocketTask; + +------------------------------------------------------------------------------- +-- Setup the socket receiver, initialize the task stack, and then loop, +-- blocking on Accept_Socket, using Pop_Stack for the next free task from the +-- stack, waiting if necessary. + task type SocketServer (my_Port : GNAT.Sockets.Port_Type) is + entry Listen; + end SocketServer; + + task body SocketServer is + Receiver : GNAT.Sockets.Socket_Type; + Connection : GNAT.Sockets.Socket_Type; + Client : GNAT.Sockets.Sock_Addr_Type; + Channel : GNAT.Sockets.Stream_Access; + Worker : array (1..Tasks_To_Create) of SocketTask; + Use_Task : Index; + + begin + accept Listen; + GNAT.Sockets.Create_Socket (Socket => Receiver); + GNAT.Sockets.Set_Socket_Option + (Socket => Receiver, + Option => (Name => GNAT.Sockets.Reuse_Address, Enabled => True)); + GNAT.Sockets.Bind_Socket + (Socket => Receiver, + Address => (Family => GNAT.Sockets.Family_Inet, + Addr => GNAT.Sockets.Inet_Addr ("127.0.0.1"), + Port => my_Port)); + GNAT.Sockets.Listen_Socket (Socket => Receiver); + Task_Info.Initialize_Stack; +Find: loop -- Block for connection and take next free task. + GNAT.Sockets.Accept_Socket + (Server => Receiver, + Socket => Connection, + Address => Client); + Ada.Text_IO.Put_Line ("Connect " & GNAT.Sockets.Image(Client)); + Channel := GNAT.Sockets.Stream (Connection); + Task_Info.Pop_Stack(Use_Task); -- Protected guard waits if full house. + -- Setup the socket in this task in rendezvous. + Worker(Use_Task).Setup(Connection,Client, Channel,Use_Task); + -- Run the asynchronous task for the socket communications. + Worker(Use_Task).Echo; -- Start echo loop. + end loop Find; + end SocketServer; + + Echo_Server : SocketServer(my_Port => 12321); + +------------------------------------------------------------------------------- +begin + Echo_Server.Listen; +end echo_server_multi; diff --git a/Task/Echo-server/Common-Lisp/echo-server-1.lisp b/Task/Echo-server/Common-Lisp/echo-server-1.lisp index fd38d0534e..ea0f921736 100644 --- a/Task/Echo-server/Common-Lisp/echo-server-1.lisp +++ b/Task/Echo-server/Common-Lisp/echo-server-1.lisp @@ -4,7 +4,7 @@ (defun read-all (stream) (loop for char = (read-char-no-hang stream nil :eof) - until (or (null char) (eq char :eof)) collect char into msg + until (or (null char) (eql char :eof)) collect char into msg finally (return (values msg char)))) (defun echo-server (port &optional (log-stream *standard-output*)) diff --git a/Task/Echo-server/Factor/echo-server.factor b/Task/Echo-server/Factor/echo-server.factor index a154c9b263..8a6d2aa264 100644 --- a/Task/Echo-server/Factor/echo-server.factor +++ b/Task/Echo-server/Factor/echo-server.factor @@ -1,17 +1,16 @@ -USING: accessors io io.encodings.utf8 io.servers.connection -threads ; +USING: accessors io io.encodings.utf8 io.servers io.sockets threads ; IN: rosetta.echo CONSTANT: echo-port 12321 : handle-client ( -- ) - [ write "\r\n" write flush ] each-line ; + [ print flush ] each-line ; : ( -- threaded-server ) utf8 - "echo-server" >>name + "echo server" >>name echo-port >>insecure [ handle-client ] >>handler ; -: start-echo-server ( -- threaded-server ) - [ start-server ] in-thread ; +: start-echo-server ( -- ) + [ start-server ] in-thread start-server drop ; diff --git a/Task/Echo-server/Lua/echo-server.lua b/Task/Echo-server/Lua/echo-server.lua new file mode 100644 index 0000000000..6cd85cc12a --- /dev/null +++ b/Task/Echo-server/Lua/echo-server.lua @@ -0,0 +1,31 @@ +require("socket") + +function checkOn (client) + local line, err = client:receive() + if line then + print(tostring(client) .. " said " .. line) + client:send(line .. "\n") + end + if err and err ~= "timeout" then + print(tostring(client) .. " " .. err) + client:close() + return err + end + return nil +end + +local delay, clients, newClient = 10^-6, {} +local server = assert(socket.bind("*", 12321)) +server:settimeout(delay) +print("Server started") +while 1 do + repeat + newClient = server:accept() + for k, v in pairs(clients) do + if checkOn(v) then table.remove(clients, k) end + end + until newClient + newClient:settimeout(delay) + print(tostring(newClient) .. " connected") + table.insert(clients, newClient) +end diff --git a/Task/Echo-server/Perl-6/echo-server.pl6 b/Task/Echo-server/Perl-6/echo-server.pl6 index 23d6205b56..90b8ea9acc 100644 --- a/Task/Echo-server/Perl-6/echo-server.pl6 +++ b/Task/Echo-server/Perl-6/echo-server.pl6 @@ -8,7 +8,7 @@ while $socket.accept -> $conn { start { while $conn.recv -> $stuff { say "Echoing $stuff"; - $conn.send($stuff); + $conn.print($stuff); } $conn.close; } diff --git a/Task/Echo-server/Racket/echo-server.rkt b/Task/Echo-server/Racket/echo-server.rkt index 238fe0f7c3..2e99bbb7e2 100644 --- a/Task/Echo-server/Racket/echo-server.rkt +++ b/Task/Echo-server/Racket/echo-server.rkt @@ -1,5 +1,4 @@ #lang racket - (define listener (tcp-listen 12321)) (let echo-server () (define-values [I O] (tcp-accept listener)) diff --git a/Task/Element-wise-operations/00DESCRIPTION b/Task/Element-wise-operations/00DESCRIPTION index 6bd891c04e..fdf0522abb 100644 --- a/Task/Element-wise-operations/00DESCRIPTION +++ b/Task/Element-wise-operations/00DESCRIPTION @@ -1,3 +1,18 @@ -Similar to [[Matrix multiplication]] and [[Matrix transposition]], the task is to implement basic element-wise matrix-matrix and scalar-matrix operations, which can be referred to in other, higher-order tasks. Implement addition, subtraction, multiplication, division and exponentiation. +This task is similar to: +::*   [[Matrix multiplication]] +::*   [[Matrix transposition]] + +;Task: +Implement basic element-wise matrix-matrix and scalar-matrix operations, which can be referred to in other, higher-order tasks. + +Implement: +:::*   addition +:::*   subtraction +:::*   multiplication +:::*   division +:::*   exponentiation + +
    Extend the task if necessary to include additional basic operations, which should not require their own specialised task. +

    diff --git a/Task/Element-wise-operations/Java/element-wise-operations.java b/Task/Element-wise-operations/Java/element-wise-operations.java new file mode 100644 index 0000000000..4aa8b4a180 --- /dev/null +++ b/Task/Element-wise-operations/Java/element-wise-operations.java @@ -0,0 +1,59 @@ +import java.util.Arrays; +import java.util.HashMap; +import java.util.Map; +import java.util.function.BiFunction; +import java.util.stream.Stream; + +@SuppressWarnings("serial") +public class ElementWiseOp { + static final Map> OPERATIONS = new HashMap>() { + { + put("add", (a, b) -> a + b); + put("sub", (a, b) -> a - b); + put("mul", (a, b) -> a * b); + put("div", (a, b) -> a / b); + put("pow", (a, b) -> Math.pow(a, b)); + put("mod", (a, b) -> a % b); + } + }; + public static Double[][] scalarOp(String op, Double[][] matr, Double scalar) { + BiFunction operation = OPERATIONS.getOrDefault(op, (a, b) -> a); + Double[][] result = new Double[matr.length][matr[0].length]; + for (int i = 0; i < matr.length; i++) { + for (int j = 0; j < matr[i].length; j++) { + result[i][j] = operation.apply(matr[i][j], scalar); + } + } + return result; + } + public static Double[][] matrOp(String op, Double[][] matr, Double[][] scalar) { + BiFunction operation = OPERATIONS.getOrDefault(op, (a, b) -> a); + Double[][] result = new Double[matr.length][Stream.of(matr).mapToInt(a -> a.length).max().getAsInt()]; + for (int i = 0; i < matr.length; i++) { + for (int j = 0; j < matr[i].length; j++) { + result[i][j] = operation.apply(matr[i][j], scalar[i % scalar.length][j + % scalar[i % scalar.length].length]); + } + } + return result; + } + public static void printMatrix(Double[][] matr) { + Stream.of(matr).map(Arrays::toString).forEach(System.out::println); + } + public static void main(String[] args) { + printMatrix(scalarOp("mul", new Double[][] { + { 1.0, 2.0, 3.0 }, + { 4.0, 5.0, 6.0 }, + { 7.0, 8.0, 9.0 } + }, 3.0)); + + printMatrix(matrOp("div", new Double[][] { + { 1.0, 2.0, 3.0 }, + { 4.0, 5.0, 6.0 }, + { 7.0, 8.0, 9.0 } + }, new Double[][] { + { 1.0, 2.0}, + { 3.0, 4.0} + })); + } +} diff --git a/Task/Element-wise-operations/Perl-6/element-wise-operations.pl6 b/Task/Element-wise-operations/Perl-6/element-wise-operations-1.pl6 similarity index 74% rename from Task/Element-wise-operations/Perl-6/element-wise-operations.pl6 rename to Task/Element-wise-operations/Perl-6/element-wise-operations-1.pl6 index 4300da9473..46e8507b2e 100644 --- a/Task/Element-wise-operations/Perl-6/element-wise-operations.pl6 +++ b/Task/Element-wise-operations/Perl-6/element-wise-operations-1.pl6 @@ -4,7 +4,10 @@ my @a = [7,8,9]; sub msay(@x) { - .perl.say for @x; + for @x -> @row { + print ' ', $_%1 ?? $_.nude.join('/') !! $_ for @row; + say ''; + } say ''; } diff --git a/Task/Element-wise-operations/Perl-6/element-wise-operations-2.pl6 b/Task/Element-wise-operations/Perl-6/element-wise-operations-2.pl6 new file mode 100644 index 0000000000..fd56b46e5c --- /dev/null +++ b/Task/Element-wise-operations/Perl-6/element-wise-operations-2.pl6 @@ -0,0 +1,5 @@ +sub infix: (\l,\r) { l <<+>> r } + +msay @a M+ @a; +msay @a M+ [1,2,3]; +msay @a M+ 2; diff --git a/Task/Element-wise-operations/REXX/element-wise-operations-1.rexx b/Task/Element-wise-operations/REXX/element-wise-operations-1.rexx index 863b311151..4089a8af15 100644 --- a/Task/Element-wise-operations/REXX/element-wise-operations-1.rexx +++ b/Task/Element-wise-operations/REXX/element-wise-operations-1.rexx @@ -1,32 +1,31 @@ -/*REXX program multiplies two matrixes together, shows matrixes & result*/ +/*REXX program multiplies two matrixes together, displays the matrixes and the result.*/ m=(1 2 3) (4 5 6) (7 8 9) -w=words(m); do k=1; if k*k>=w then leave; end /*k*/; rows=k; cols=k - +w=words(m); do k=1; if k*k>=w then leave; end /*k*/; rows=k; cols=k call showMat M, 'M matrix' -answer=matAdd(m, 2 ); call showMat answer, 'M matrix, added 2' -answer=matSub(m, 7 ); call showMat answer, 'M matrix, subtracted 7' -answer=matMul(m, 2.5); call showMat answer, 'M matrix, multiplied by 2½' -answer=matPow(m, 3 ); call showMat answer, 'M matrix, cubed' -answer=matDiv(m, 4 ); call showMat answer, 'M matrix, divided by 4' -answer=matIdv(m, 2 ); call showMat answer, 'M matrix, integer halved' -answer=matMod(m, 3 ); call showMat answer, 'M matrix, modulus 3' -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────SHOWMAT subroutine──────────────────*/ -showMat: parse arg @, hdr; say -L=0; do j=1 for w; L=max(L,length(word(@,j))); end -say center(hdr, max(length(hdr)+4, cols*(L+1)+4), "─") -n=0 - do r =1 for rows; _= - do c=1 for cols; n=n+1; _=_ right(word(@,n),L); end; say _ - end -return -/*──────────────────────────────────one-liner subroutines───────────────*/ -matAdd: arg @,#; call mat#; do j=1 for w; !.j=!.j+#; end; return mat@() -matSub: arg @,#; call mat#; do j=1 for w; !.j=!.j-#; end; return mat@() -matMul: arg @,#; call mat#; do j=1 for w; !.j=!.j*#; end; return mat@() -matDiv: arg @,#; call mat#; do j=1 for w; !.j=!.j/#; end; return mat@() -matIdv: arg @,#; call mat#; do j=1 for w; !.j=!.j%#; end; return mat@() -matPow: arg @,#; call mat#; do j=1 for w; !.j=!.j**#; end; return mat@() -matMod: arg @,#; call mat#; do j=1 for w; !.j=!.j//#; end; return mat@() -mat#: w=words(@); do j=1 for w; !.j=word(@,j); end; return -mat@: @=!.1; do j=2 to w; @=@ !.j; end; return @ +answer=matAdd(m, 2 ); call showMat answer, 'M matrix, added 2' +answer=matSub(m, 7 ); call showMat answer, 'M matrix, subtracted 7' +answer=matMul(m, 2.5); call showMat answer, 'M matrix, multiplied by 2½' +answer=matPow(m, 3 ); call showMat answer, 'M matrix, cubed' +answer=matDiv(m, 4 ); call showMat answer, 'M matrix, divided by 4' +answer=matIdv(m, 2 ); call showMat answer, 'M matrix, integer halved' +answer=matMod(m, 3 ); call showMat answer, 'M matrix, modulus 3' +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +matAdd: parse arg @,#; call mat#; do j=1 for w; !.j=!.j+#; end; return mat@() +matSub: parse arg @,#; call mat#; do j=1 for w; !.j=!.j-#; end; return mat@() +matMul: parse arg @,#; call mat#; do j=1 for w; !.j=!.j*#; end; return mat@() +matDiv: parse arg @,#; call mat#; do j=1 for w; !.j=!.j/#; end; return mat@() +matIdv: parse arg @,#; call mat#; do j=1 for w; !.j=!.j%#; end; return mat@() +matPow: parse arg @,#; call mat#; do j=1 for w; !.j=!.j**#; end; return mat@() +matMod: parse arg @,#; call mat#; do j=1 for w; !.j=!.j//#; end; return mat@() +mat#: w=words(@); do j=1 for w; !.j=word(@,j); end; return +mat@: @=!.1; do j=2 to w; @=@ !.j; end; return @ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +showMat: parse arg @, hdr; L=0; say + do j=1 for w; L=max(L,length(word(@,j))); end + say center(hdr, max(length(hdr)+4, cols*(L+1)+4), "─") + n=0 + do r =1 for rows; _= + do c=1 for cols; n=n+1; _=_ right(word(@,n),L); end; say _ + end + return diff --git a/Task/Element-wise-operations/REXX/element-wise-operations-2.rexx b/Task/Element-wise-operations/REXX/element-wise-operations-2.rexx index a74deb01fc..a9e78d8bd0 100644 --- a/Task/Element-wise-operations/REXX/element-wise-operations-2.rexx +++ b/Task/Element-wise-operations/REXX/element-wise-operations-2.rexx @@ -1,27 +1,26 @@ -/*REXX program multiplies two matrixes together, shows matrixes & result*/ +/*REXX program multiplies two matrixes together, displays the matrixes and the result. */ m=(1 2 3) (4 5 6) (7 8 9) -w=words(m); do k=1; if k*k>=w then leave; end /*k*/; rows=k; cols=k - +w=words(m); do k=1; if k*k>=w then leave; end /*k*/; rows=k; cols=k call showMat M, 'M matrix' -ans=matOp(m, '+2' ); call showMat ans, 'M matrix, added 2' -ans=matOp(m, '-7' ); call showMat ans, 'M matrix, subtracted 7' -ans=matOp(m, '*2.5' ); call showMat ans, 'M matrix, multiplied by 2½' -ans=matOp(m, '**3' ); call showMat ans, 'M matrix, cubed' -ans=matOp(m, '/4' ); call showMat ans, 'M matrix, divided by 4' -ans=matOp(m, '%2' ); call showMat ans, 'M matrix, integer halved' -ans=matOp(m, '//3' ); call showMat ans, 'M matrix, modulus 3' -ans=matOp(m, '*3-1' ); call showMat ans, 'M matrix, tripled, less one' -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────SHOWMAT subroutine──────────────────*/ -showMat: parse arg @, hdr; say -L=0; do j=1 for w; L=max(L,length(word(@,j))); end -say; say center(hdr,max(length(hdr)+4,cols*(L+1)+4),"─") -n=0 - do r =1 for rows; _= - do c=1 for cols; n=n+1; _=_ right(word(@,n),L); end; say _ - end -return -/*──────────────────────────────────one-liner subroutines───────────────*/ -matOp: arg @,#;call mat#; do j=1 for w; interpret '!.'j"=!."j #;end; return mat@() -mat#: w=words(@); do j=1 for w; !.j=word(@,j); end; return -mat@: @=!.1; do j=2 to w; @=@ !.j; end; return @ +ans=matOp(m, '+2' ); call showMat ans, "M matrix, added 2" +ans=matOp(m, '-7' ); call showMat ans, "M matrix, subtracted 7" +ans=matOp(m, '*2.5' ); call showMat ans, "M matrix, multiplied by 2½" +ans=matOp(m, '**3' ); call showMat ans, "M matrix, cubed" +ans=matOp(m, '/4' ); call showMat ans, "M matrix, divided by 4" +ans=matOp(m, '%2' ); call showMat ans, "M matrix, integer halved" +ans=matOp(m, '//3' ); call showMat ans, "M matrix, modulus 3" +ans=matOp(m, '*3-1' ); call showMat ans, "M matrix, tripled, less one" +exit /*stick a fork in it, we"re all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +matOp: parse arg @,#; call mat#; do j=1 for w; interpret '!.'j"=!."j #;end; return mat@() +mat#: w=words(@); do j=1 for w; !.j=word(@,j); end; return +mat@: @=!.1; do j=2 to w; @=@ !.j; end; return @ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +showMat: parse arg @, hdr; say + L=0; do j=1 for w; L=max(L,length(word(@,j))); end + say; say center(hdr,max(length(hdr)+4,cols*(L+1)+4),"─") + n=0 + do r =1 for rows; _= + do c=1 for cols; n=n+1; _=_ right(word(@,n),L); end; say _ + end + return diff --git a/Task/Empty-directory/ALGOL-68/empty-directory.alg b/Task/Empty-directory/ALGOL-68/empty-directory.alg new file mode 100644 index 0000000000..e0f03d417d --- /dev/null +++ b/Task/Empty-directory/ALGOL-68/empty-directory.alg @@ -0,0 +1,32 @@ +# returns TRUE if the specified directory is empty, FALSE if it doesn't exist or is non-empty # +PROC is empty directory = ( STRING directory )BOOL: + IF NOT file is directory( directory ) + THEN + # directory doesn't exist # + FALSE + ELSE + # directory is empty if it contains no files or just "." and possibly ".." # + []STRING files = get directory( directory ); + BOOL result := FALSE; + FOR f FROM LWB files TO UPB files + WHILE result := files[ f ] = "." OR files[ f ] = ".." + DO + SKIP + OD; + result + FI # is empty directory # ; + +# test the is empty directory procedure # +# show whether the directories specified on the command line ( following "-" ) are empty or not # +BOOL directory name parameter := FALSE; +FOR i TO argc DO + IF argv( i ) = "-" + THEN + # marker to indicate directory names follow # + directory name parameter := TRUE + ELIF directory name parameter + THEN + # have a directory name - report whether it is emty or not # + print( ( argv( i ), " is ", IF is empty directory( argv( i ) ) THEN "empty" ELSE "not empty" FI, newline ) ) + FI +OD diff --git a/Task/Empty-directory/Lua/empty-directory-1.lua b/Task/Empty-directory/Lua/empty-directory-1.lua new file mode 100644 index 0000000000..09b06ac655 --- /dev/null +++ b/Task/Empty-directory/Lua/empty-directory-1.lua @@ -0,0 +1,16 @@ +function scandir(directory) + local i, t, popen = 0, {}, io.popen + local pfile = popen('ls -a "'..directory..'"') + for filename in pfile:lines() do + if filename ~= '.' and filename ~= '..' then + i = i + 1 + t[i] = filename + end + end + pfile:close() + return t +end + +function isemptydir(directory) + return #scandir(directory) == 0 +end diff --git a/Task/Empty-directory/Lua/empty-directory-2.lua b/Task/Empty-directory/Lua/empty-directory-2.lua new file mode 100644 index 0000000000..e06578fe08 --- /dev/null +++ b/Task/Empty-directory/Lua/empty-directory-2.lua @@ -0,0 +1,8 @@ +function isemptydir(directory,nospecial) + for filename in require('lfs').dir(directory) do + if filename ~= '.' and filename ~= '..' then + return false + end + end + return true +end diff --git a/Task/Empty-directory/Objeck/empty-directory.objeck b/Task/Empty-directory/Objeck/empty-directory.objeck new file mode 100644 index 0000000000..e29350ee3e --- /dev/null +++ b/Task/Empty-directory/Objeck/empty-directory.objeck @@ -0,0 +1,3 @@ +function : IsEmptyDirectory(dir : String) ~ Bool { + return Directory->List(dir)->Size() = 0; +} diff --git a/Task/Empty-directory/PARI-GP/empty-directory-1.pari b/Task/Empty-directory/PARI-GP/empty-directory-1.pari new file mode 100644 index 0000000000..402dc79aac --- /dev/null +++ b/Task/Empty-directory/PARI-GP/empty-directory-1.pari @@ -0,0 +1 @@ +chkdir(d)=extern(concat(["[ -d '",d,"' ]&&ls -A '",d,"'|wc -l||echo -1"])) diff --git a/Task/Empty-directory/PARI-GP/empty-directory-2.pari b/Task/Empty-directory/PARI-GP/empty-directory-2.pari new file mode 100644 index 0000000000..5daa756e7f --- /dev/null +++ b/Task/Empty-directory/PARI-GP/empty-directory-2.pari @@ -0,0 +1 @@ +dir_is_empty(d)=!chkdir(d) diff --git a/Task/Empty-directory/Standard-ML/empty-directory.ml b/Task/Empty-directory/Standard-ML/empty-directory.ml new file mode 100644 index 0000000000..adecf06e06 --- /dev/null +++ b/Task/Empty-directory/Standard-ML/empty-directory.ml @@ -0,0 +1,12 @@ +fun isDirEmpty(path: string) = + let + val dir = OS.FileSys.openDir path + val dirEntryOpt = OS.FileSys.readDir dir + in + ( + OS.FileSys.closeDir(dir); + case dirEntryOpt of + NONE => true + | _ => false + ) + end; diff --git a/Task/Empty-program/00DESCRIPTION b/Task/Empty-program/00DESCRIPTION index 7190f46e90..d14592b98c 100644 --- a/Task/Empty-program/00DESCRIPTION +++ b/Task/Empty-program/00DESCRIPTION @@ -1,3 +1,5 @@ -In this task, the goal is to create the simplest possible program that is still considered "correct." +;Task: +Create the simplest possible program that is still considered "correct." +

    =Programming Languages= diff --git a/Task/Empty-program/8086-Assembly/empty-program-1.8086 b/Task/Empty-program/8086-Assembly/empty-program-1.8086 new file mode 100644 index 0000000000..a6a9baf65e --- /dev/null +++ b/Task/Empty-program/8086-Assembly/empty-program-1.8086 @@ -0,0 +1 @@ +end diff --git a/Task/Empty-program/8086-Assembly/empty-program-2.8086 b/Task/Empty-program/8086-Assembly/empty-program-2.8086 new file mode 100644 index 0000000000..e2308802b9 --- /dev/null +++ b/Task/Empty-program/8086-Assembly/empty-program-2.8086 @@ -0,0 +1,8 @@ + segment .text + global _start + +_start: + mov eax, 60 + xor edi, edi + syscall + end diff --git a/Task/Empty-program/C/empty-program-3.c b/Task/Empty-program/C/empty-program-3.c index f73ad9f4fb..43047e7e05 100644 --- a/Task/Empty-program/C/empty-program-3.c +++ b/Task/Empty-program/C/empty-program-3.c @@ -1,3 +1 @@ -main () { - return 0; -} +const main = 195; diff --git a/Task/Empty-program/Elena/empty-program.elena b/Task/Empty-program/Elena/empty-program.elena new file mode 100644 index 0000000000..a497f4ae57 --- /dev/null +++ b/Task/Empty-program/Elena/empty-program.elena @@ -0,0 +1,3 @@ +#symbol program = +[ +]. diff --git a/Task/Empty-program/J/empty-program-1.j b/Task/Empty-program/J/empty-program-1.j index e69de29bb2..a614936fa4 100644 --- a/Task/Empty-program/J/empty-program-1.j +++ b/Task/Empty-program/J/empty-program-1.j @@ -0,0 +1 @@ +'' diff --git a/Task/Empty-program/Joy/empty-program.joy b/Task/Empty-program/Joy/empty-program.joy index e69de29bb2..9c558e357c 100644 --- a/Task/Empty-program/Joy/empty-program.joy +++ b/Task/Empty-program/Joy/empty-program.joy @@ -0,0 +1 @@ +. diff --git a/Task/Empty-program/Kotlin/empty-program.kotlin b/Task/Empty-program/Kotlin/empty-program.kotlin new file mode 100644 index 0000000000..c718b65ae9 --- /dev/null +++ b/Task/Empty-program/Kotlin/empty-program.kotlin @@ -0,0 +1 @@ +fun main(a: Array) {} diff --git a/Task/Empty-program/MIPS-Assembly/empty-program.mips b/Task/Empty-program/MIPS-Assembly/empty-program.mips new file mode 100644 index 0000000000..5dc95892f5 --- /dev/null +++ b/Task/Empty-program/MIPS-Assembly/empty-program.mips @@ -0,0 +1,3 @@ + .text +main: li $v0, 10 + syscall diff --git a/Task/Empty-program/Perl-6/empty-program-1.pl6 b/Task/Empty-program/Perl-6/empty-program-1.pl6 index 96a23abc8a..e69de29bb2 100644 --- a/Task/Empty-program/Perl-6/empty-program-1.pl6 +++ b/Task/Empty-program/Perl-6/empty-program-1.pl6 @@ -1 +0,0 @@ -use v6; diff --git a/Task/Empty-program/Perl-6/empty-program-2.pl6 b/Task/Empty-program/Perl-6/empty-program-2.pl6 index f24da357ac..96a23abc8a 100644 --- a/Task/Empty-program/Perl-6/empty-program-2.pl6 +++ b/Task/Empty-program/Perl-6/empty-program-2.pl6 @@ -1 +1 @@ -v6; +use v6; diff --git a/Task/Empty-program/Perl-6/empty-program-3.pl6 b/Task/Empty-program/Perl-6/empty-program-3.pl6 index f75e10d7ce..f24da357ac 100644 --- a/Task/Empty-program/Perl-6/empty-program-3.pl6 +++ b/Task/Empty-program/Perl-6/empty-program-3.pl6 @@ -1 +1 @@ -6; +v6; diff --git a/Task/Empty-program/Perl/empty-program-1.pl b/Task/Empty-program/Perl/empty-program-1.pl index 0dcc959fd8..e69de29bb2 100644 --- a/Task/Empty-program/Perl/empty-program-1.pl +++ b/Task/Empty-program/Perl/empty-program-1.pl @@ -1,2 +0,0 @@ -#!/usr/bin/perl -1; diff --git a/Task/Empty-program/Perl/empty-program-2.pl b/Task/Empty-program/Perl/empty-program-2.pl index cecf79c076..1f1c293970 100644 --- a/Task/Empty-program/Perl/empty-program-2.pl +++ b/Task/Empty-program/Perl/empty-program-2.pl @@ -1,2 +1 @@ #!/usr/bin/perl -exit; diff --git a/Task/Empty-program/PowerShell/empty-program.psh b/Task/Empty-program/PowerShell/empty-program.psh new file mode 100644 index 0000000000..f30451d8e5 --- /dev/null +++ b/Task/Empty-program/PowerShell/empty-program.psh @@ -0,0 +1 @@ +&{} diff --git a/Task/Empty-program/REXX/empty-program-2.rexx b/Task/Empty-program/REXX/empty-program-2.rexx index a23f9fdc47..76138cf7f3 100644 --- a/Task/Empty-program/REXX/empty-program-2.rexx +++ b/Task/Empty-program/REXX/empty-program-2.rexx @@ -1 +1 @@ -/*comment*/ +/*REXX*/ diff --git a/Task/Empty-program/Run-BASIC/empty-program.run b/Task/Empty-program/Run-BASIC/empty-program.run new file mode 100644 index 0000000000..c8ea698124 --- /dev/null +++ b/Task/Empty-program/Run-BASIC/empty-program.run @@ -0,0 +1 @@ +end ' actually a blank is ok diff --git a/Task/Empty-string/00DESCRIPTION b/Task/Empty-string/00DESCRIPTION index d373144b4d..a0e31c3ee0 100644 --- a/Task/Empty-string/00DESCRIPTION +++ b/Task/Empty-string/00DESCRIPTION @@ -1,11 +1,11 @@ Languages may have features for dealing specifically with empty strings (those containing no characters). -The task is to: -* Demonstrate how to assign an empty string to a variable. - -* Demonstrate how to check that a string is empty. -* Demonstrate how to check that a string is not empty. +;Task: +::*   Demonstrate how to assign an empty string to a variable. +::*   Demonstrate how to check that a string is empty. +::*   Demonstrate how to check that a string is not empty. +

    [[Category:String manipulation]] [[Category:Simple]] diff --git a/Task/Empty-string/BASIC/empty-string.basic b/Task/Empty-string/BASIC/empty-string-1.basic similarity index 100% rename from Task/Empty-string/BASIC/empty-string.basic rename to Task/Empty-string/BASIC/empty-string-1.basic diff --git a/Task/Empty-string/BASIC/empty-string-2.basic b/Task/Empty-string/BASIC/empty-string-2.basic new file mode 100644 index 0000000000..9fafcf6ef0 --- /dev/null +++ b/Task/Empty-string/BASIC/empty-string-2.basic @@ -0,0 +1,3 @@ + 10 LET A$ = " + 40 IF LEN (A$) = 0 THEN PRINT "THE STRING IS EMPTY" + 50 IF LEN (A$) THEN PRINT "THE STRING IS NOT EMPTY" diff --git a/Task/Empty-string/Elena/empty-string.elena b/Task/Empty-string/Elena/empty-string.elena new file mode 100644 index 0000000000..d192193e3b --- /dev/null +++ b/Task/Empty-string/Elena/empty-string.elena @@ -0,0 +1,12 @@ +#import system. +#import extensions. + +#symbol program = [ + #var s := emptyLiteralValue. + + (s is &empty) + ? [ console writeLine:"'":s:"' is empty". ]. + + (s is &nonempty) + ? [ console writeLine:"'":s:"' is not empty". ]. +]. diff --git a/Task/Empty-string/JavaScript/empty-string-3.js b/Task/Empty-string/JavaScript/empty-string-3.js index 8f5743c550..418ac61c32 100644 --- a/Task/Empty-string/JavaScript/empty-string-3.js +++ b/Task/Empty-string/JavaScript/empty-string-3.js @@ -1,3 +1,4 @@ +!!s s != "" s.length != 0 s.length > 0 diff --git a/Task/Empty-string/Kotlin/empty-string.kotlin b/Task/Empty-string/Kotlin/empty-string.kotlin new file mode 100644 index 0000000000..90dc415ac5 --- /dev/null +++ b/Task/Empty-string/Kotlin/empty-string.kotlin @@ -0,0 +1,6 @@ +val s = "" +println(s.isEmpty()) // true +println(s.isNotEmpty()) // false +println(s.length) // 0 +println(s.none()) // true +println(s.any()) // false diff --git a/Task/Empty-string/PowerShell/empty-string-1.psh b/Task/Empty-string/PowerShell/empty-string-1.psh new file mode 100644 index 0000000000..825d6dcd77 --- /dev/null +++ b/Task/Empty-string/PowerShell/empty-string-1.psh @@ -0,0 +1,4 @@ +[string]$alpha = "abcdefghijklmnopqrstuvwxyz" +[string]$empty = "" +# or... +[string]$empty = [String]::Empty diff --git a/Task/Empty-string/PowerShell/empty-string-2.psh b/Task/Empty-string/PowerShell/empty-string-2.psh new file mode 100644 index 0000000000..793f861714 --- /dev/null +++ b/Task/Empty-string/PowerShell/empty-string-2.psh @@ -0,0 +1,2 @@ +[String]::IsNullOrEmpty($alpha) +[String]::IsNullOrEmpty($empty) diff --git a/Task/Empty-string/PowerShell/empty-string.psh b/Task/Empty-string/PowerShell/empty-string.psh deleted file mode 100644 index 1ed4f3c593..0000000000 --- a/Task/Empty-string/PowerShell/empty-string.psh +++ /dev/null @@ -1,2 +0,0 @@ -[string]::IsNullOrEmpty("") -[string]::IsNullOrEmpty("a") diff --git a/Task/Empty-string/REXX/empty-string.rexx b/Task/Empty-string/REXX/empty-string.rexx index 69cbc1a417..58175314a9 100644 --- a/Task/Empty-string/REXX/empty-string.rexx +++ b/Task/Empty-string/REXX/empty-string.rexx @@ -1,40 +1,39 @@ -/*REXX: how to assign an empty string & then check for empty/not-empty.*/ +/*REXX program shows how to assign an empty string, & then check for empty/not-empty str*/ -/*─────────────── 3 simple wats to assign an empty string to a variable.*/ -auk='' /*uses two single quotes or apostrophies. */ -ide="" /*uses two quotes, sometimes called a double quote.*/ -doe= /*... nothing at all. */ + /*─────────────── 3 simple ways to assign an empty string to a variable.*/ +auk='' /*uses two single quotes (also called apostrophes); easier to peruse. */ +ide="" /*uses two quotes, sometimes called a double quote. */ +doe= /*··· nothing at all (which in this case, a null value is assigned. */ -/*─────────────── assigning multiple null values to vars, 2 methods are:*/ -ram=0 -parse var ram . emu pug yak nit moa owl pas jay koi ern ewe fae gar hob - /*where the value of zero is skipped, the rest set to null,*/ - /*which is the next value AFTER the value of RAM (nothing).*/ + /*─────────────── assigning multiple null values to vars, 2 methods are:*/ +parse var doe emu pug yak nit moa owl pas jay koi ern ewe fae gar hob - /*───or─── (with less clutter ─── or more, ... perception).*/ + /*where emu, pug, yak, ··· (and the rest) are all set to a null value.*/ + + /*───or─── (with less clutter ─── or more, depending on your perception)*/ parse value 0 with . ant ape ant imp fly tui paa elo dab cub bat ayu - /*where the value of zero is skipped, the rest set to null,*/ - /*which is the next value AFTER the 0 (zero): nothing. */ + /*where the value of zero is skipped, and the rest are set to null,*/ + /*which is the next value AFTER the 0 (zero): nothing (or a null).*/ -/*─────────────── how to check that a string is empty, several methods: */ -if cat=='' then say "the feline is not here." -if pig=="" then say 'no ham today' -if length(gnu)==0 then say "the wildebeast is empty & hungry." -if length(ips)=0 then say "checking with == instead of = is faster" -if length(hub)<1 then method = "obtuse, don't do as I do ..." + /*─────────────── how to check that a string is empty, several methods: */ +if cat=='' then say "the feline is not here." +if pig=="" then say 'no ham today.' +if length(gnu)==0 then say "the wildebeest's stomach is empty and hungry." +if length(ips)=0 then say "checking with == instead of = is faster" +if length(hub)<1 then method = "this is rather obtuse, don't do as I do ···" -nit='' /*assign an empty string to a lice egg.*/ -if cow==nit then say 'the cow has no milk today.' +nit='' /*assign an empty string to a lice egg.*/ +if cow==nit then say 'the cow has no milk today.' -/*─────────────── how to check that a string isn't empty, several ways: */ + /*─────────────── how to check that a string isn't empty, several ways: */ if dog\=='' then say "the dogs are out!" - /*most REXXes support the "not" character. */ + /*most REXXes support the ¬ character. */ if fox¬=='' then say "and the fox is in the henhouse." -if length(rat)>0 then say "the rat is singing" /*ugly way to test.*/ +if length(rat)>0 then say "the rat is singing" /*an obscure-ish (or ugly) way to test.*/ -if elk=='' then nop; else say "long way for an elk to be tested." +if elk=='' then nop; else say "long way obtuse for an elk to be tested." -if length(eel)\==0 then fish=eel /*fast compare, quick.*/ -if length(cod)\=0 then fish=cod /*not-so-fast compare.*/ +if length(eel)\==0 then fish=eel /*a fast compare (than below), & quick.*/ +if length(cod)\=0 then fish=cod /*a not-as-fast compare. */ -/*────────────────────────── anyway, as they say: "choose your poison." */ + /*────────────────────────── anyway, as they say: "choose your poison." */ diff --git a/Task/Empty-string/Rust/empty-string.rust b/Task/Empty-string/Rust/empty-string.rust new file mode 100644 index 0000000000..1e194861cd --- /dev/null +++ b/Task/Empty-string/Rust/empty-string.rust @@ -0,0 +1,9 @@ +let s = ""; +println!("is empty: {}", s.is_empty()); +let t = "x"; +println!("is empty: {}", t.is_empty()); +let a = String::new(); +println!("is empty: {}", a.is_empty()); +let b = "x".to_string(); +println!("is empty: {}", b.is_empty()); +println!("is not empty: {}", !b.is_empty()); diff --git a/Task/Empty-string/SNOBOL4/empty-string.sno b/Task/Empty-string/SNOBOL4/empty-string.sno new file mode 100644 index 0000000000..8be16e158b --- /dev/null +++ b/Task/Empty-string/SNOBOL4/empty-string.sno @@ -0,0 +1,7 @@ +* ASSIGN THE NULL STRING TO X + X = +* CHECK THAT X IS INDEED NULL + EQ(X, NULL) :S(YES) + OUTPUT = 'NOT NULL' :(END) +YES OUTPUT = 'NULL' +END diff --git a/Task/Enforced-immutability/Ada/enforced-immutability.ada b/Task/Enforced-immutability/Ada/enforced-immutability-1.ada similarity index 100% rename from Task/Enforced-immutability/Ada/enforced-immutability.ada rename to Task/Enforced-immutability/Ada/enforced-immutability-1.ada diff --git a/Task/Enforced-immutability/Ada/enforced-immutability-2.ada b/Task/Enforced-immutability/Ada/enforced-immutability-2.ada new file mode 100644 index 0000000000..89b9b4c96c --- /dev/null +++ b/Task/Enforced-immutability/Ada/enforced-immutability-2.ada @@ -0,0 +1,6 @@ +type T is limited private; -- inner structure is hidden +X, Y: T; +B: Boolean; +-- The following operations do not exist: +X := Y; -- illegal (cannot be compiled +B := X = Y; -- illegal diff --git a/Task/Enforced-immutability/Perl-6/enforced-immutability-3.pl6 b/Task/Enforced-immutability/Perl-6/enforced-immutability-3.pl6 index 6c00a1e465..e4b36d18d9 100644 --- a/Task/Enforced-immutability/Perl-6/enforced-immutability-3.pl6 +++ b/Task/Enforced-immutability/Perl-6/enforced-immutability-3.pl6 @@ -1 +1 @@ -my $pi ::= 3 + rand; +my $pi := 3 + rand; diff --git a/Task/Enforced-immutability/REXX/enforced-immutability.rexx b/Task/Enforced-immutability/REXX/enforced-immutability.rexx index 8c389d8b3c..1202fa777b 100644 --- a/Task/Enforced-immutability/REXX/enforced-immutability.rexx +++ b/Task/Enforced-immutability/REXX/enforced-immutability.rexx @@ -1,37 +1,37 @@ -/*REXX pgm emulates immutable variables (as a post-computational check).*/ -call immutable '$=1' /* ◄─── assigns an immutable var.*/ -call immutable ' pi = 3.14159' /* ◄─── " " " " */ -call immutable 'radius= 2*pi/4 ' /* ◄─── " " " " */ -call immutable ' r=13/2 ' /* ◄─── " " " " */ -call immutable ' d=0002 * r' /* ◄─── " " " " */ -call immutable ' f.1 = 12**2 ' /* ◄─── " " " " */ +/*REXX program emulates immutable variables (as a post-computational check). */ +call immutable '$=1' /* ◄─── assigns an immutable variable. */ +call immutable ' pi = 3.14159' /* ◄─── " " " " */ +call immutable 'radius= 2*pi/4 ' /* ◄─── " " " " */ +call immutable ' r=13/2 ' /* ◄─── " " " " */ +call immutable ' d=0002 * r' /* ◄─── " " " " */ +call immutable ' f.1 = 12**2 ' /* ◄─── " " " " */ -say ' $ =' $ /*show variable, just to be sure.*/ -say ' pi =' pi /* " " " " " " */ -say ' radius =' radius /* " " " " " " */ -say ' r =' r /* " " " " " " */ -say ' d =' d /* " " " " " " */ +say ' $ =' $ /*show the variable, just to be sure. */ +say ' pi =' pi /* " " " " " " " */ +say ' radius =' radius /* " " " " " " " */ +say ' r =' r /* " " " " " " " */ +say ' d =' d /* " " " " " " " */ - do radius=10 to -10 by -1 /*perform some stuff*/ - circum=$*pi*2*radius /*some kind of calc.*/ - end /*k*/ /*that should do it.*/ -call immutable /* ◄═══ check if immutables OK. */ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────IMMUTABLE subroutine────────────────*/ -immutable: if symbol('immutable.0')=='LIT' then immutable.0= /*1st time*/ -if arg()==0 then do /* [↓] check all immutable vars.*/ - do __=1 for words(immutable.0); _=word(immutable.0,__) - if value(_)==value('IMMUTABLE.!'_) then iterate /*same?*/ - call ser -12, 'immutable variable ' _ " compromised." - end /*__*/ /* [↑] if an error, ERRmsg, exit*/ - return 0 /*return to invoker, indicate OK.*/ - end /* [↓] immutable var must have =*/ -if pos('=',arg(1))==0 then call ser -4, 'no equal sign in assignment:' arg(1) -parse arg _ '=' __; upper _; _=space(_) /*purify var name.*/ -if symbol('_')=='BAD' then call ser -8,_ "isn't a valid variable symbol." -immutable.0=immutable.0 _ /*add immutable var to the list. */ -interpret '__='__; call value _,__ /*assign a value to a variable. */ -call value 'IMMUTABLE.!'_,__ /*also, assign value to bkup. var*/ -return words(immutable.0) /*return the # of immutable vars.*/ -/*──────────────────────────────────SER subroutine──────────────────────*/ -ser: say; say '***error!***' arg(2); say; exit arg(1) /*ERRmsg.*/ + do radius=10 to -10 by -1 /*perform some faux important stuff. */ + circum=$*pi*2*radius /*some kind of impressive calculation. */ + end /*k*/ /* [↑] that should do it, by gum. */ +call immutable /* ◄═══ see if immutable variables OK. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +immutable: if symbol('immutable.0')=='LIT' then immutable.0= /*1st time see immutable? */ + if arg()==0 then do /* [↓] chk all immutables*/ + do __=1 for words(immutable.0); _=word(immutable.0,__) + if value(_)==value('IMMUTABLE.!'_) then iterate /*same?*/ + call ser -12, 'immutable variable ' _ " compromised." + end /*__*/ /* [↑] Error? ERRmsg, exit*/ + return 0 /*return and indicate A-OK.*/ + end /* [↓] immutable must have =*/ + if pos('=',arg(1))==0 then call ser -4, "no equal sign in assignment:" arg(1) + parse arg _ '=' __; upper _; _=space(_) /*purify variable name.*/ + if symbol("_")=='BAD' then call ser -8,_ "isn't a valid variable symbol." + immutable.0=immutable.0 _ /*add immutable var to list.*/ + interpret '__='__; call value _,__ /*assign value to a variable*/ + call value 'IMMUTABLE.!'_,__ /*assign value to bkup var. */ + return words(immutable.0) /*return number immutables. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +ser: say; say '***error***' arg(2); say; exit arg(1) /*error msg.*/ diff --git a/Task/Enforced-immutability/Rust/enforced-immutability-3.rust b/Task/Enforced-immutability/Rust/enforced-immutability-3.rust new file mode 100644 index 0000000000..7fb381bd1b --- /dev/null +++ b/Task/Enforced-immutability/Rust/enforced-immutability-3.rust @@ -0,0 +1,8 @@ +let mut x = 4; +let y = &x; +*y += 2 // Raises compiler error. Even though x is mutable, y is an immutable reference. +let y = &mut x; +*y += 2// Works +// Note that though y is now a mutable reference, y itself is still immutable e.g. +let mut z = 5; +let y = &mut z; // Raises compiler error because y is already assigned to '&mut x' diff --git a/Task/Entropy/00DESCRIPTION b/Task/Entropy/00DESCRIPTION index 8a3bed63d4..f254b81d88 100644 --- a/Task/Entropy/00DESCRIPTION +++ b/Task/Entropy/00DESCRIPTION @@ -1,16 +1,36 @@ -Calculate the [[wp:Entropy (information theory)|information entropy]] (Shannon entropy) of a given input string. +;Task: +Calculate the Shannon entropy   H   of a given input string. -Entropy is the [[wp:Expected value|expected value]] of the measure of [[wp:Self-information|information]] content in a system. -In general, the Shannon entropy of a variable X is defined as: -:H(X) = \sum_{x\in\Omega} P(x) I(x) -where the information content I(x) = -\log_{b} P(x). -If the base of the logarithm b = 2, the result is expressed in ''bits'', a [[wp:Units of information|unit of information]]. -Therefore, given a string S of length n where P(s_i) is the relative frequency of each character, the entropy of a string in bits is: -:H(S) = -\sum_{i=0}^n P(s_i) \log_2 (P(s_i)) -For this task, use "1223334444" as an example. -The result should be around 1.84644 bits. +Given the discreet random variable X that is a string of N "symbols" (total characters) consisting of n different characters (n=2 for binary), the Shannon entropy of X in '''bits/symbol''' is : +:H_2(X) = -\sum_{i=1}^n \frac{count_i}{N} \log_2 \left(\frac{count_i}{N}\right) -Related Tasks: +where count_i is the count of character n_i. -:::* [[Fibonacci_word]] -:::* [[Entropy/Narcissist]] +For this task, use X="1223334444" as an example. The result should be 1.84644... bits/symbol. This assumes X was a random variable, which may not be the case, or it may depend on the observer. + +This coding problem calculates the "specific" or "[[wp:Intensive_and_extensive_properties|intensive]]" entropy that finds its parallel in physics with "specific entropy" S0 which is entropy per kg or per mole, not like physical entropy S and therefore not the "information" content of a file. It comes from Boltzmann's H-theorem where S=k_B N H where N=number of molecules. Boltzmann's H is the same equation as Shannon's H, and it gives the specific entropy H on a "per molecule" basis. + +The "total", "absolute", or "[[wp:Intensive_and_extensive_properties|extensive]]" information entropy is +:S=H_2 N bits +This is not the entropy being coded here, but it is the closest to physical entropy and a measure of the information content of a string. But it does not look for any patterns that might be available for compression, so it is a very restricted, basic, and certain measure of "information". Every binary file with an equal number of 1's and 0's will have S=N bits. All hex files with equal symbol frequencies will have S=N \log_2(16) bits of entropy. The total entropy in bits of the example above is S= 10*18.4644 = 18.4644 bits. + +The H function does not look for any patterns in data or check if X was a random variable. For example, X=000000111111 gives the same calculated entropy in all senses as Y=010011100101. For most purposes it is usually more relevant to divide the gzip length by the length of the original data to get an informal measure of how much "order" was in the data. + +Two other "entropies" are useful: + +Normalized specific entropy: +:H_n=\frac{H_2 * \log(2)}{\log(n)} +which varies from 0 to 1 and it has units of "entropy/symbol" or just 1/symbol. For this example, Hn<\sub>= 0.923. + +Normalized total (extensive) entropy: +:S_n = \frac{H_2 N * \log(2)}{\log(n)} +which varies from 0 to N and does not have units. It is simply the "entropy", but it needs to be called "total normalized extensive entropy" so that it is not confused with Shannon's (specific) entropy or physical entropy. For this example, Sn<\sub>= 9.23. + +Shannon himself is the reason his "entropy/symbol" H function is very confusingly called "entropy". That's like calling a function that returns a speed a "meter". See section 1.7 of his classic [http://worrydream.com/refs/Shannon%20-%20A%20Mathematical%20Theory%20of%20Communication.pdf A Mathematical Theory of Communication] and search on "per symbol" and "units" to see he always stated his entropy H has units of "bits/symbol" or "entropy/symbol" or "information/symbol". So it is legitimate to say entropy NH is "information". + +In keeping with Landauer's limit, the physics entropy generated from erasing N bits is S = H_2 N k_B \ln(2) if the bit storage device is perfectly efficient. This can be solved for H2*N to (arguably) get the number of bits of information that a physical entropy represents. + +;Related tasks: +:* [[Fibonacci_word]] +:* [[Entropy/Narcissist]] +

    diff --git a/Task/Entropy/APL/entropy.apl b/Task/Entropy/APL/entropy.apl new file mode 100644 index 0000000000..dbfd9ea7a0 --- /dev/null +++ b/Task/Entropy/APL/entropy.apl @@ -0,0 +1,24 @@ + ENTROPY←{-+/R×2⍟R←(+⌿⍵∘.=∪⍵)÷⍴⍵} + + ⍝ How it works: + ⎕←UNIQUE←∪X←'1223334444' +1234 + ⎕←TABLE_OF_OCCURENCES←X∘.=UNIQUE +1 0 0 0 +0 1 0 0 +0 1 0 0 +0 0 1 0 +0 0 1 0 +0 0 1 0 +0 0 0 1 +0 0 0 1 +0 0 0 1 +0 0 0 1 + ⎕←COUNT←+⌿TABLE_OF_OCCURENCES +1 2 3 4 + ⎕←N←⍴X +10 + ⎕←RATIO←COUNT÷N +0.1 0.2 0.3 0.4 + -+/RATIO×2⍟RATIO +1.846439345 diff --git a/Task/Entropy/Elixir/entropy.elixir b/Task/Entropy/Elixir/entropy.elixir index 340e1a0d79..ee768ea871 100644 --- a/Task/Entropy/Elixir/entropy.elixir +++ b/Task/Entropy/Elixir/entropy.elixir @@ -1,7 +1,7 @@ defmodule RC do def entropy(str) do leng = String.length(str) - String.split(str, "", trim: true) + String.graphemes(str) |> Enum.group_by(&(&1)) |> Enum.map(fn{_,value} -> length(value) end) |> Enum.reduce(0, fn count, entropy -> diff --git a/Task/Entropy/Haskell/entropy.hs b/Task/Entropy/Haskell/entropy.hs index e022cfbf10..4f81720498 100644 --- a/Task/Entropy/Haskell/entropy.hs +++ b/Task/Entropy/Haskell/entropy.hs @@ -2,7 +2,7 @@ import Data.List main = print $ entropy "1223334444" -entropy s = - sum . map lg' . fq' . map (fromIntegral.length) . group . sort $ s - where lg' c = (c * ) . logBase 2 $ 1.0 / c - fq' c = let sc = sum c in map (/ sc) c +entropy :: (Ord a, Floating c) => [a] -> c +entropy = sum . map lg . fq . map genericLength . group . sort + where lg c = -c * logBase 2 c + fq c = let sc = sum c in map (/ sc) c diff --git a/Task/Entropy/Lua/entropy.lua b/Task/Entropy/Lua/entropy.lua new file mode 100644 index 0000000000..4877fd17bd --- /dev/null +++ b/Task/Entropy/Lua/entropy.lua @@ -0,0 +1,19 @@ +function log2 (x) return math.log(x) / math.log(2) end + +function entropy (X) + local N, count, sum, i = X:len(), {}, 0 + for char = 1, N do + i = X:sub(char, char) + if count[i] then + count[i] = count[i] + 1 + else + count[i] = 1 + end + end + for n_i, count_i in pairs(count) do + sum = sum + count_i / N * log2(count_i / N) + end + return -sum +end + +print(entropy("1223334444")) diff --git a/Task/Entropy/REXX/entropy-3.rexx b/Task/Entropy/REXX/entropy-3.rexx index 1f522bf8ff..05a43a5517 100644 --- a/Task/Entropy/REXX/entropy-3.rexx +++ b/Task/Entropy/REXX/entropy-3.rexx @@ -1,30 +1,30 @@ -/*REXX program calculates the information entropy for a given character string*/ -numeric digits 50 /*use 50 decimal digits for precision. */ -parse arg $; if $='' then $=1223334444 /*obtain the optional input from the CL*/ -#=0; @.=0; L=length($); $$= /*define handy-dandy REXX variables. */ +/*REXX program calculates the information entropy for a given character string. */ +numeric digits 50 /*use 50 decimal digits for precision. */ +parse arg $; if $='' then $=1223334444 /*obtain the optional input from the CL*/ +#=0; @.=0; L=length($); $$= /*define handy-dandy REXX variables. */ - do j=1 for L; _=substr($,j,1) /*process each character in $ string.*/ - if @._==0 then do; #=#+1 /*Unique? Yes, bump character counter.*/ - $$=$$ || _ /*add this character to the $$ list. */ + do j=1 for L; _=substr($,j,1) /*process each character in $ string.*/ + if @._==0 then do; #=#+1 /*Unique? Yes, bump character counter.*/ + $$=$$ || _ /*add this character to the $$ list. */ end - @._=@._+1 /*keep track of this character's count.*/ + @._=@._+1 /*keep track of this character's count.*/ end /*j*/ -sum=0 /*calculate info entropy for each char.*/ - do i=1 for #; _=substr($$,i,1) /*obtain a character from unique list. */ - sum=sum - @._/L * log2(@._/L) /*add (negatively) the char entropies. */ +sum=0 /*calculate info entropy for each char.*/ + do i=1 for #; _=substr($$,i,1) /*obtain a character from unique list. */ + sum=sum - @._/L * log2(@._/L) /*add (negatively) the char entropies. */ end /*i*/ say ' input string: ' $ say 'string length: ' L say ' unique chars: ' # ; say -say 'the information entropy of the string ──► ' format(sum,,12) " bits." -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────LOG2 subroutine───────────────────────────*/ -log2: procedure; parse arg x 1 ox; ig= x>1.5; is=1-2*(ig\==1); ii=0 -numeric digits digits()+5 /* [↓] precision of E must be ≥ digits().*/ -e=2.7182818284590452353602874713526624977572470936999595749669676277240766303535 - do while ig & ox>1.5 | \ig&ox<.5; _=e; do k=-1; iz=ox* _**-is - if k>=0 & (ig & iz<1 | \ig&iz>.5) then leave; _=_*_; izz=iz; end - ox=izz; ii=ii+is*2**k; end; x=x* e** -ii-1; z=0; _=-1; p=z - do k=1; _=-_*x; z=z+_/k; if z=p then leave; p=z; end /*k*/ - r=z+ii; if arg()==2 then return r; return r/log2(2,0) +say 'the information entropy of the string ──► ' format(sum,,12) " bits." +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +log2: procedure; parse arg x 1 ox; ig= x>1.5; ii=0; is=1 - 2 * (ig\==1) + numeric digits digits()+5 /* [↓] precision of E must be≥digits()*/ + e=2.71828182845904523536028747135266249775724709369995957496696762772407663035354759 + do while ig & ox>1.5 | \ig&ox<.5; _=e; do j=-1; iz=ox* _**-is + if j>=0 & (ig & iz<1 | \ig&iz>.5) then leave; _=_*_; izz=iz; end /*j*/ + ox=izz; ii=ii+is*2**j; end; x=x* e**-ii-1; z=0; _=-1; p=z + do k=1; _=-_*x; z=z+_/k; if z=p then leave; p=z; end /*k*/ + r=z+ii; if arg()==2 then return r; return r/log2(2,.) diff --git a/Task/Entropy/Run-BASIC/entropy.run b/Task/Entropy/Run-BASIC/entropy.run new file mode 100644 index 0000000000..b88424efa4 --- /dev/null +++ b/Task/Entropy/Run-BASIC/entropy.run @@ -0,0 +1,26 @@ +dim chrCnt( 255) ' possible ASCII chars + +source$ = "1223334444" +numChar = len(source$) + +for i = 1 to len(source$) ' count which chars are used in source + ch$ = mid$(source$,i,1) + if not( instr(chrUsed$, ch$)) then chrUsed$ = chrUsed$ + ch$ + j = instr(chrUsed$, ch$) + chrCnt(j) =chrCnt(j) +1 +next i + +lc = len(chrUsed$) +for i = 1 to lc + odds = chrCnt(i) /numChar + entropy = entropy - (odds * (log(odds) / log(2))) +next i + +print " Characters used and times used of each " +for i = 1 to lc + print " '"; mid$(chrUsed$,i,1); "'";chr$(9);chrCnt(i) +next i + +print " Entropy of '"; source$; "' is "; entropy; " bits." + +end diff --git a/Task/Entropy/ZX-Spectrum-Basic/entropy.zx b/Task/Entropy/ZX-Spectrum-Basic/entropy.zx new file mode 100644 index 0000000000..c4e287bcfc --- /dev/null +++ b/Task/Entropy/ZX-Spectrum-Basic/entropy.zx @@ -0,0 +1,12 @@ +10 LET s$="1223334444": LET base=2: LET entropy=0 +20 LET sourcelen=LEN s$ +30 DIM t(255) +40 FOR i=1 TO sourcelen +50 LET number= CODE s$(i) +60 LET t(number)=t(number)+1 +70 NEXT i +80 PRINT "Char";TAB (6);"Count" +90 FOR i=1 TO 255 +100 IF t(i)<>0 THEN PRINT CHR$ i;TAB (6);t(i): LET prop=t(i)/sourcelen: LET entropy=entropy-(prop*(LN prop)/(LN base)) +110 NEXT i +120 PRINT '"The Entropy of """;s$;""" is ";entropy diff --git a/Task/Enumerations/00DESCRIPTION b/Task/Enumerations/00DESCRIPTION index 061c6929e9..afd8b074c2 100644 --- a/Task/Enumerations/00DESCRIPTION +++ b/Task/Enumerations/00DESCRIPTION @@ -1 +1,3 @@ +;Task: Create an enumeration of constants with and without explicit values. +

    diff --git a/Task/Enumerations/Elixir/enumerations-1.elixir b/Task/Enumerations/Elixir/enumerations-1.elixir index 8c58d79bad..4a6b0ff005 100644 --- a/Task/Enumerations/Elixir/enumerations-1.elixir +++ b/Task/Enumerations/Elixir/enumerations-1.elixir @@ -1,4 +1,5 @@ fruits = [:apple, :banana, :cherry] -# fruits = ~w(apple banana cherry)a +fruits = ~w(apple banana cherry)a # Above-mentioned different notation val = :banana -Enum.member?(fruits, val) #=> true +Enum.member?(fruits, val) #=> true +val in fruits #=> true diff --git a/Task/Enumerations/Elixir/enumerations-2.elixir b/Task/Enumerations/Elixir/enumerations-2.elixir index 787158f8c4..c127508d05 100644 --- a/Task/Enumerations/Elixir/enumerations-2.elixir +++ b/Task/Enumerations/Elixir/enumerations-2.elixir @@ -1,10 +1,10 @@ -fruits = [{:apple, 1}, {:banana, 2}, {:cherry, 3}] # Keyword list -fruits = [apple: 1, banana: 2, cherry: 3] # Above-mentioned different notation -fruits[:apple] #=> 1 -Dict.has_key?(fruits, :banana) #=> true +fruits = [{:apple, 1}, {:banana, 2}, {:cherry, 3}] # Keyword list +fruits = [apple: 1, banana: 2, cherry: 3] # Above-mentioned different notation +fruits[:apple] #=> 1 +Keyword.has_key?(fruits, :banana) #=> true -fruits = %{:apple=>1, :banana=>2, :cherry=>3} # Map -fruits = %{apple: 1, banana: 2, cherry: 3} # Above-mentioned different notation -fruits[:apple] #=> 1 -fruits.apple #=> 1 (Only When the key is Atom) -Dict.has_key?(fruits, :banana) #=> true +fruits = %{:apple=>1, :banana=>2, :cherry=>3} # Map +fruits = %{apple: 1, banana: 2, cherry: 3} # Above-mentioned different notation +fruits[:apple] #=> 1 +fruits.apple #=> 1 (Only When the key is Atom) +Map.has_key?(fruits, :banana) #=> true diff --git a/Task/Enumerations/Elixir/enumerations-3.elixir b/Task/Enumerations/Elixir/enumerations-3.elixir index 10bdc44744..24a070a68d 100644 --- a/Task/Enumerations/Elixir/enumerations-3.elixir +++ b/Task/Enumerations/Elixir/enumerations-3.elixir @@ -1,2 +1,7 @@ +# Keyword list fruits = ~w(apple banana cherry)a |> Enum.with_index #=> [apple: 0, banana: 1, cherry: 2] + +# Map +fruits = ~w(apple banana cherry)a |> Enum.with_index |> Map.new +#=> %{apple: 0, banana: 1, cherry: 2} diff --git a/Task/Enumerations/Perl-6/enumerations.pl6 b/Task/Enumerations/Perl-6/enumerations.pl6 index 22b3678c70..73e7b262a8 100644 --- a/Task/Enumerations/Perl-6/enumerations.pl6 +++ b/Task/Enumerations/Perl-6/enumerations.pl6 @@ -2,7 +2,7 @@ enum Fruit ; # Numbered 0 through 2. enum ClassicalElement ( Earth => 5, - 'Air', # Gets the value 6. - Fire => 'hot', - Water => 'wet' + 'Air', # gets the value 6 + 'Fire', # gets the value 7 + Water => 10, ); diff --git a/Task/Enumerations/PowerShell/enumerations-1.psh b/Task/Enumerations/PowerShell/enumerations-1.psh new file mode 100644 index 0000000000..2e2a1cbc1d --- /dev/null +++ b/Task/Enumerations/PowerShell/enumerations-1.psh @@ -0,0 +1,8 @@ +Enum fruits { + Apple + Banana + Cherry +} +[fruits]::Apple +[fruits]::Apple + 1 +[fruits]::Banana + 1 diff --git a/Task/Enumerations/PowerShell/enumerations-2.psh b/Task/Enumerations/PowerShell/enumerations-2.psh new file mode 100644 index 0000000000..5c9e0dc1ad --- /dev/null +++ b/Task/Enumerations/PowerShell/enumerations-2.psh @@ -0,0 +1,8 @@ +Enum fruits { + Apple = 10 + Banana = 15 + Cherry = 30 +} +[fruits]::Apple +[fruits]::Apple + 1 +[fruits]::Banana + 1 diff --git a/Task/Enumerations/REXX/enumerations.rexx b/Task/Enumerations/REXX/enumerations.rexx index a874a4be47..36df6d1e7b 100644 --- a/Task/Enumerations/REXX/enumerations.rexx +++ b/Task/Enumerations/REXX/enumerations.rexx @@ -1,50 +1,55 @@ -/*REXX program to illustrate enumeration of constants via stemmed arrays*/ -fruit.=0 /*the default for all "FRUITS." */ -fruit.apple = 65 -fruit.cherry = 4 -fruit.kiwi = 12 -fruit.peach = 48 -fruit.plum = 50 -fruit.raspberry = 17 -fruit.tomato = 8000 -fruit.ugli = 2 -fruit.watermelon = 0.5 /*could also specify: 1/2 */ +/*REXX program illustrates a method of enumeration of constants via stemmed arrays. */ +fruit.=0 /*the default for all possible "FRUITS." (zero). */ + fruit.apple = 65 + fruit.cherry = 4 + fruit.kiwi = 12 + fruit.peach = 48 + fruit.plum = 50 + fruit.raspberry = 17 + fruit.tomato = 8000 + fruit.ugli = 2 + fruit.watermelon = 0.5 /*◄─────────── could also be specified as: 1/2 */ - /*A partial list of some fruits (below). */ - /* [↓] This is one method of using a list. */ -FruitList='apple apricot avocado banana bilberry blackberry blackcurrent blueberry baobab boysenberry breadfruit cantalope cherry chilli chokecherry citront', - 'coconut cranberry cucumber current date dragonfruit durian eggplant elderberry fig feijoa gac gooseberry grape grapefruit guava honeydew huckleberry jackfruit', - 'jambul juneberry kiwi kumquat lemon lime lingenberry loquat lychee mandarine mango mangosteen netarine orange papaya passionfruit peach pear persimmon', - 'physalis pineapple pitaya pomegranate pomelo plum pumpkin rambutan raspberry redcurrent satsuma squash strawberry tangerine tomato ugli watermelon zucchini' -/*┌────────────────────────────────────────────────────────────────────┐ - │ Spoiler alert: sex is discussed below: PG-13. Most berries don't │ - │ have "berry" in their name. A berry is a simple fruit produced │ - │ from a single ovary. Some true berries are: pomegranate, guava, │ - │ eggplant, tomato, chilli, pumpkin, cucumber, melon, and citruses. │ - │ Blueberry is a false berry, blackberry is an aggregate fruit, │ - │ and strawberry is an accessory fruit. Most nuts are fruits. │ - │ The following aren't true nuts: almond, cashew, coconut, │ - │ macadamia, peanut, pecan, pistachio, and walnut. │ - └────────────────────────────────────────────────────────────────────┘*/ - /* [↓] due to a Central America blight in 1922.*/ -if fruit.banana=0 then say "Yes! We have no bananas today." /*(sic)*/ -if fruit.kiwi \=0 then say "We gots" fruit.kiwi "hairy fruit." /*(sic)*/ -if fruit.peach\=0 then say "We gots" fruit.peach "fuzzy fruit." /*(sic)*/ -maxL = length(' fruit ') -maxQ = length(' quantity ') + /*A method of using a list (of some fruits).*/ +@fruits= 'apple apricot avocado banana bilberry blackberry blackcurrant blueberry baobab', + 'boysenberry breadfruit cantaloupe cherry chilli chokecherry citron coconut', + 'cranberry cucumber currant date dragonfruit durian eggplant elderberry fig', + 'feijoa gac gooseberry grape grapefruit guava honeydew huckleberry jackfruit', + 'jambul juneberry kiwi kumquat lemon lime lingenberry loquat lychee mandarin', + 'mango mangosteen nectarine orange papaya passionfruit peach pear persimmon', + 'physalis pineapple pitaya pomegranate pomelo plum pumpkin rambutan raspberry', + 'redcurrant satsuma squash strawberry tangerine tomato ugli watermelon zucchini' + +/*╔════════════════════════════════════════════════════════════════════════════════════╗ + ║Parental warning: sex is discussed below: PG─13. Most berries don't have "berry" in║ + ║their name. A berry is a simple fruit produced from a single ovary. Some true ║ + ║berries are: pomegranate, guava, eggplant, tomato, chilli, pumpkin, cucumber, melon,║ + ║and citruses. Blueberry is a false berry; blackberry is an aggregate fruit; ║ + ║and strawberry is an accessory fruit. Most nuts are fruits. The following aren't║ + ║true nuts: almond, cashew, coconut, macadamia, peanut, pecan, pistachio, and walnut.║ + ╚════════════════════════════════════════════════════════════════════════════════════╝*/ + + /* ┌─◄── due to a Central America blight in 1922; it was*/ + /* ↓ called the Panama disease (a soil─borne fungus)*/ +if fruit.banana=0 then say "Yes! We have no bananas today." /* (sic) */ +if fruit.kiwi \=0 then say "We gots " fruit.kiwi ' hairy fruit.' /* " */ +if fruit.peach\=0 then say "We gots " fruit.peach ' fuzzy fruit.' /* " */ + +maxL=length(' fruit ') /*ensure this header title can be shown*/ +maxQ=length(' quantity ') /* " " " " " " " */ say - do pass=1 for 2 /*first pass finds the maximums. */ - do j=1 for words(FruitList) - f=word(FruitList,j) /*get a fruit name from the list.*/ - q=value('FRUIT.'f) - if pass==1 then do /*widest fruit name and quantity.*/ - maxL=max(maxL,length(f)) /*longest fruit name*/ - maxQ=max(maxQ,length(q)) /*widest fruit quant*/ - iterate /*j*/ - end - if j==1 then say center('fruit',maxL) center('quantity',maxQ) - if j==1 then say copies('─',maxL) copies('─',maxQ) - if q\=0 then say right(f,maxL) right(q,maxQ) - end /*j*/ - end /*pass*/ - /*stick a fork in it, we're done.*/ + do p =0 for 2 /*the first pass finds the maximums. */ + do j=1 for words(@fruits) /*process each of the names of fruits. */ + @=word(@fruits, j) /*obtain a fruit name from the list. */ + #=value('FRUIT.'@) /* " the quantity of a fruit. */ + if \p then do /*is this the first pass through ? */ + maxL=max(maxL, length(@)) /*the longest (widest) name of a fruit.*/ + maxQ=max(maxQ, length(#)) /*the widest width quantity of fruit. */ + iterate /*j*/ /*now, go get another name of a fruit. */ + end + if j==1 then say center('fruit', maxL) center("quantity", maxQ) + if j==1 then say copies('─' , maxL) copies("─" , maxQ) + if #\=0 then say right( @ , maxL) right( # , maxQ) + end /*j*/ + end /*p*/ + /*stick a fork in it, we're all done. */ diff --git a/Task/Environment-variables/00DESCRIPTION b/Task/Environment-variables/00DESCRIPTION index 15885f2de6..2fce28e035 100644 --- a/Task/Environment-variables/00DESCRIPTION +++ b/Task/Environment-variables/00DESCRIPTION @@ -2,5 +2,11 @@ {{omit from|TI-83 BASIC}} {{omit from|TI-89 BASIC}} {{omit from|Unlambda|Does not provide access to environment variables.}} +;Task: Show how to get one of your process's [[wp:Environment variable|environment variables]]. -The available variables vary by system; some of the common ones available on Unix include PATH, HOME, USER. + +The available variables vary by system;   some of the common ones available on Unix include: +:::*   PATH +:::*   HOME +:::*   USER +

    diff --git a/Task/Environment-variables/AutoHotkey/environment-variables.ahk b/Task/Environment-variables/AutoHotkey/environment-variables-1.ahk similarity index 100% rename from Task/Environment-variables/AutoHotkey/environment-variables.ahk rename to Task/Environment-variables/AutoHotkey/environment-variables-1.ahk diff --git a/Task/Environment-variables/AutoHotkey/environment-variables-2.ahk b/Task/Environment-variables/AutoHotkey/environment-variables-2.ahk new file mode 100644 index 0000000000..9959a91c23 --- /dev/null +++ b/Task/Environment-variables/AutoHotkey/environment-variables-2.ahk @@ -0,0 +1,11 @@ +ConsoleWrite("# Environment:" & @CRLF) + +Local $sEnvVar = EnvGet("LANG") +ConsoleWrite("LANG : " & $sEnvVar & @CRLF) + +ShowEnv("SystemDrive") +ShowEnv("USERNAME") + +Func ShowEnv($N) + ConsoleWrite( StringFormat("%-12s : %s\n", $N, EnvGet($N)) ) +EndFunc ;==>ShowEnv diff --git a/Task/Equilibrium-index/00DESCRIPTION b/Task/Equilibrium-index/00DESCRIPTION index fb6a8b8778..fde54b2fc1 100644 --- a/Task/Equilibrium-index/00DESCRIPTION +++ b/Task/Equilibrium-index/00DESCRIPTION @@ -1,24 +1,31 @@ -An equilibrium index of a sequence is an index into the sequence such that the sum of elements at lower indices is equal to the sum of elements at higher indices. For example, in a sequence A: +An equilibrium index of a sequence is an index into the sequence such that the sum of elements at lower indices is equal to the sum of elements at higher indices. -: A_0 = -7 -: A_1 = 1 -: A_2 = 5 -: A_3 = 2 -: A_4 = -4 -: A_5 = 3 -: A_6 = 0 -3 is an equilibrium index, because: +For example, in a sequence   A: -: A_0 + A_1 + A_2 = A_4 + A_5 + A_6 +:::::   A_0 = -7 +:::::   A_1 = 1 +:::::   A_2 = 5 +:::::   A_3 = 2 +:::::   A_4 = -4 +:::::   A_5 = 3 +:::::   A_6 = 0 -6 is also an equilibrium index, because: +3   is an equilibrium index, because: -: A_0 + A_1 + A_2 + A_3 + A_4 + A_5 = 0 +:::::   A_0 + A_1 + A_2 = A_4 + A_5 + A_6 + +6   is also an equilibrium index, because: + +:::::   A_0 + A_1 + A_2 + A_3 + A_4 + A_5 = 0 (sum of zero elements is zero) -7 is not an equilibrium index, because it is not a valid index of sequence A. +7   is not an equilibrium index, because it is not a valid index of sequence A. + +;Task; Write a function that, given a sequence, returns its equilibrium indices (if any). + Assume that the sequence may be very long. +

    diff --git a/Task/Equilibrium-index/JavaScript/equilibrium-index.js b/Task/Equilibrium-index/JavaScript/equilibrium-index.js index 0e69b2f815..e206ba577d 100644 --- a/Task/Equilibrium-index/JavaScript/equilibrium-index.js +++ b/Task/Equilibrium-index/JavaScript/equilibrium-index.js @@ -1,21 +1,19 @@ -function equilibrium (array) { - var equilibriums = []; - - array.forEach(function(_, idx, arr) { - var left = 0, right = 0; - - for (var i = 0; i < arr.length; i++) { - if (i < idx) { - left += array[i]; - } else if (i > idx) { - right += array[i]; - } - } - - if (left === right) equilibriums.push(idx); - }); - - return equilibriums; +function equilibrium(a) { + var N = a.length, i, l = [], r = [], e = [] + for (l[0] = a[0], r[N - 1] = a[N - 1], i = 1; i high(indices) then + setlength(indices, idx+10); + end; + inc(i); + leftSum := leftsum+pC^; + inc(pC); + until i>=0; + leftSum := leftsum+pC^; + IF LeftSum = RightSum then + Begin + indices[idx] := Hilist+i; + inc(idx); + end; + setlength(indices,idx); +end; + +procedure TestRun(const numbers:tnumList); +var + indices : tresList; + i: integer; +Begin + write('List of numbers: '); + for i := low(numbers) to high(numbers) do + write(numbers[i]:3); + writeln; + EquilibriumIndex(numbers,indices); + write('Equilibirum indices: '); + EquilibriumIndex(numbers,indices); + for i := low(indices) to high(indices) do + write(indices[i]:3); + writeln; + writeln; +end; + +var + numbers: tnumList; + I: integer; +begin + setlength(numbers,High(cNumbers)-Low(cNumbers)+1); + move(cNumbers[Low(cNumbers)],numbers[0],sizeof(cnumbers)); + TestRun(numbers); + for i := low(numbers) to high(numbers) do + numbers[i]:= 0; + TestRun(numbers); +end. diff --git a/Task/Equilibrium-index/Perl-6/equilibrium-index-1.pl6 b/Task/Equilibrium-index/Perl-6/equilibrium-index-1.pl6 index 4c9dd1ac42..98f35b4f14 100644 --- a/Task/Equilibrium-index/Perl-6/equilibrium-index-1.pl6 +++ b/Task/Equilibrium-index/Perl-6/equilibrium-index-1.pl6 @@ -9,4 +9,4 @@ sub equilibrium_index(@list) { } my @list = -7, 1, 5, 2, -4, 3, 0; -.say for equilibrium_index(@list); +.say for equilibrium_index(@list).grep(/\d/); diff --git a/Task/Equilibrium-index/Perl-6/equilibrium-index-2.pl6 b/Task/Equilibrium-index/Perl-6/equilibrium-index-2.pl6 index 3cd70e14c1..a461c80ca8 100644 --- a/Task/Equilibrium-index/Perl-6/equilibrium-index-2.pl6 +++ b/Task/Equilibrium-index/Perl-6/equilibrium-index-2.pl6 @@ -1,5 +1,5 @@ sub equilibrium_index(@list) { - my @a := [\+] @list; + my @a = [\+] @list; my @b := reverse [\+] reverse @list; ^@list Zxx (@a »==« @b); } diff --git a/Task/Equilibrium-index/PowerShell/equilibrium-index-1.psh b/Task/Equilibrium-index/PowerShell/equilibrium-index-1.psh new file mode 100644 index 0000000000..23c5eb0316 --- /dev/null +++ b/Task/Equilibrium-index/PowerShell/equilibrium-index-1.psh @@ -0,0 +1,22 @@ +function Get-EquilibriumIndex ( $Sequence ) + { + $Indexes = 0..($Sequence.Count - 1) + $EqulibriumIndex = @() + + ForEach ( $TestIndex in $Indexes ) + { + $Left = 0 + $Right = 0 + ForEach ( $Index in $Indexes ) + { + If ( $Index -lt $TestIndex ) { $Left += $Sequence[$Index] } + ElseIf ( $Index -gt $TestIndex ) { $Right += $Sequence[$Index] } + } + + If ( $Left -eq $Right ) + { + $EqulibriumIndex += $TestIndex + } + } + return $EqulibriumIndex + } diff --git a/Task/Equilibrium-index/PowerShell/equilibrium-index-2.psh b/Task/Equilibrium-index/PowerShell/equilibrium-index-2.psh new file mode 100644 index 0000000000..7327e83ab7 --- /dev/null +++ b/Task/Equilibrium-index/PowerShell/equilibrium-index-2.psh @@ -0,0 +1 @@ +Get-EquilibriumIndex -7, 1, 5, 2, -4, 3, 0 diff --git a/Task/Equilibrium-index/PowerShell/equilibrium-index.psh b/Task/Equilibrium-index/PowerShell/equilibrium-index.psh deleted file mode 100644 index 5a447df6f0..0000000000 --- a/Task/Equilibrium-index/PowerShell/equilibrium-index.psh +++ /dev/null @@ -1,15 +0,0 @@ -function equil($arr){ - $res=@() - for($i=0;$i -lt $arr.length;$i++){ - $left=0;$right=0 - - for($j=0;$j -lt $arr.length;$j++){ - if ($j -lt $i){$left+=$arr[$j]} - if ($j -gt $i){$right+=$arr[$j]} - } - if($left -eq $right){$res+=$i} - } - [String]$res -} - -equil -7,1,5,2,-4,3,0 diff --git a/Task/Equilibrium-index/REXX/equilibrium-index-1.rexx b/Task/Equilibrium-index/REXX/equilibrium-index-1.rexx index 4b262509f2..e445c8b045 100644 --- a/Task/Equilibrium-index/REXX/equilibrium-index-1.rexx +++ b/Task/Equilibrium-index/REXX/equilibrium-index-1.rexx @@ -1,22 +1,21 @@ -/*REXX program finds the equilibrium index for a numeric array (list). */ -parse arg x /*get array's numbers from the CL.*/ -if x='' then x=copies(' 7 -7',50) 7 /*Nothing given? Generate a list.*/ -say ' array list: ' space(x) /*echo the array list to screen. */ -n=words(x) /*the number of words in the list.*/ - do j=0 for n /*0─start is for zero─based array.*/ - A.j=word(x, j+1) /*define the array element. */ - end /*j*/ /* [↑] assign A.0 A.1 A.3 ··· */ -say /*··· and also show a blank line. */ -ans=equilibrium_index(n) /*calculate the equilibrium index.*/ -say 'equilibrium' word('indices index', 1 + (words(ans==1)))": " ans -exit /*stick a fork in it, we're done. */ -/*──────────────────────────────────EQUILIBRIUM_INDEX subroutine─────────*/ -equilibrium_index: procedure expose A. /*have the array A. be exposed.*/ -parse arg # /*stemmed array A. starts at 0*/ -$= /*equilibrium indices (so far). */ - do i=0 for #; sum=0 - do k=0 for #; sum=sum + A.k*sign(k-i); end /*k*/ - if sum=0 then $=$ i - end /*i*/ -if $=='' then $="(none)" /*adjust if no indices are found. */ -return strip($) /*return the equilibrium list. */ +/*REXX program calculates and displays the equilibrium index for a numeric array (list).*/ +parse arg x /*obtain the optional arguments from CL*/ +if x='' then x=copies(" 7 -7", 50) 7 /*Not specified? Then use the default.*/ +say ' array list: ' space(x) /*echo the array list to the terminal. */ +n=words(x) /*the number of numbers in the X list.*/ + do j=0 for n /*zero─start is for zero─based array. */ + A.j=word(x, j+1) /*define the array element ───► A.j */ + end /*j*/ /* [↑] assign A.0 A.1 A.3 ··· */ +say /* ··· and also display a blank line. */ +ans=equilibriumIDX(n) /*calculate the equilibrium index. */ +say 'equilibrium' word("indices index", 1 + (words(ans==1)))': ' ans +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +equilibriumIDX: procedure expose A.; parse arg # /*expose the array A. (make global).*/ +$= /*equilibrium indices (so far). */ + do i=0 for #; sum=0 + do k=0 for #; sum=sum + A.k*sign(k-i); end /*k*/ + if sum=0 then $=$ i + end /*i*/ +if $=='' then $="(none)" /*adjust if no indices were found. */ +return strip($) /*return the equilibrium list. */ diff --git a/Task/Equilibrium-index/Scala/equilibrium-index.scala b/Task/Equilibrium-index/Scala/equilibrium-index.scala new file mode 100644 index 0000000000..b895cddd11 --- /dev/null +++ b/Task/Equilibrium-index/Scala/equilibrium-index.scala @@ -0,0 +1,8 @@ + def getEquilibriumIndex(A: Array[Int]): Int = { + val bigA: Array[BigInt] = A.map(BigInt(_)) + val partialSums: Array[BigInt] = bigA.scanLeft(BigInt(0))(_+_).tail + def lSum(i: Int): BigInt = if (i == 0) 0 else partialSums(i - 1) + def rSum(i: Int): BigInt = partialSums.last - partialSums(i) + def isRandLSumEqual(i: Int): Boolean = lSum(i) == rSum(i) + (0 until partialSums.length).find(isRandLSumEqual).getOrElse(-1) + } diff --git a/Task/Equilibrium-index/ZX-Spectrum-Basic/equilibrium-index.zx b/Task/Equilibrium-index/ZX-Spectrum-Basic/equilibrium-index.zx new file mode 100644 index 0000000000..a7a07a87c5 --- /dev/null +++ b/Task/Equilibrium-index/ZX-Spectrum-Basic/equilibrium-index.zx @@ -0,0 +1,12 @@ +10 DATA 7,-7,1,5,2,-4,3,0 +20 READ n +30 DIM a(n): LET sum=0: LET leftsum=0: LET s$="" +40 FOR i=1 TO n: READ a(i): LET sum=sum+a(i): NEXT i +50 FOR i=1 TO n +60 LET sum=sum-a(i) +70 IF leftsum=sum THEN LET s$=s$+STR$ i+" " +80 LET leftsum=leftsum+a(i) +90 NEXT i +100 PRINT "Numbers: "; +110 FOR i=1 TO n: PRINT a(i);" ";: NEXT i +120 PRINT '"Indices: ";s$ diff --git a/Task/Ethiopian-multiplication/00DESCRIPTION b/Task/Ethiopian-multiplication/00DESCRIPTION index 02d4279ee7..c0b166f665 100644 --- a/Task/Ethiopian-multiplication/00DESCRIPTION +++ b/Task/Ethiopian-multiplication/00DESCRIPTION @@ -1,13 +1,15 @@ -A method of multiplying integers using only addition, doubling, and halving. +Ethiopian multiplication is a method of multiplying integers using only addition, doubling, and halving. -'''Method:'''
    + +'''Method:'''
    # Take two numbers to be multiplied and write them down at the top of two columns. # In the left-hand column repeatedly halve the last number, discarding any remainders, and write the result below the last in the same column, until you write a value of 1. # In the right-hand column repeatedly double the last number and write the result below. stop when you add a result in the same row as where the left hand column shows 1. # Examine the table produced and discard any row where the value in the left column is even. # Sum the values in the right-hand column that remain to produce the result of multiplying the original two numbers together -'''For example:''' 17 × 34 +
    +'''For example:'''   17 × 34 17 34 Halving the first column: 17 34 @@ -37,15 +39,21 @@ Sum the remaining numbers in the right-hand column: 578 So 17 multiplied by 34, by the Ethiopian method is 578. + +;Task: The task is to '''define three named functions'''/methods/procedures/subroutines: # one to '''halve an integer''', # one to '''double an integer''', and # one to '''state if an integer is even'''. + +
    Use these functions to '''create a function that does Ethiopian multiplication'''. -'''References''' + +;References: *[http://www.bbc.co.uk/learningzone/clips/ethiopian-multiplication-explained/11232.html Ethiopian multiplication explained] (Video) *[http://www.youtube.com/watch?v=Nc4yrFXw20Q A Night Of Numbers - Go Forth And Multiply] (Video) *[http://www.ncetm.org.uk/blogs/3064 Ethiopian multiplication] *[http://www.bbc.co.uk/dna/h2g2/A22808126 Russian Peasant Multiplication] *[http://thedailywtf.com/Articles/Programming-Praxis-Russian-Peasant-Multiplication.aspx Programming Praxis: Russian Peasant Multiplication] +

    diff --git a/Task/Ethiopian-multiplication/AppleScript/ethiopian-multiplication.applescript b/Task/Ethiopian-multiplication/AppleScript/ethiopian-multiplication.applescript new file mode 100644 index 0000000000..223419b9a5 --- /dev/null +++ b/Task/Ethiopian-multiplication/AppleScript/ethiopian-multiplication.applescript @@ -0,0 +1,63 @@ +on run + {ethMult(17, 34), ethMult("Rhind", 9)} + + --> {578, "RhindRhindRhindRhindRhindRhindRhindRhind"} +end run + + +-- Int -> Int -> Int +-- or +-- Int -> String -> String +on ethMult(m, n) + script fns + property identity : missing value + property plus : missing value + + on half(n) -- 1. half an integer (div 2) + n div 2 + end half + + on double(n) -- 2. double (add to self) + plus(n, n) + end double + + on isEven(n) -- 3. is n even ? (mod 2 > 0) + (n mod 2) > 0 + end isEven + + on chooseFns(c) + if c is string then + set identity of fns to "" + set plus of fns to plusString of fns + else + set identity of fns to 0 + set plus of fns to plusInteger of fns + end if + end chooseFns + + on plusInteger(a, b) + a + b + end plusInteger + + on plusString(a, b) + a & b + end plusString + end script + + chooseFns(class of m) of fns + + + -- MAIN PROCESS OF CALCULATION + + set o to identity of fns + if n < 1 then return o + + repeat while (n > 1) + if isEven(n) of fns then -- 3. is n even ? (mod 2 > 0) + set o to plus(o, m) of fns + end if + set n to half(n) of fns -- 1. half an integer (div 2) + set m to double(m) of fns -- 2. double (add to self) + end repeat + return plus(o, m) of fns +end ethMult diff --git a/Task/Ethiopian-multiplication/Java/ethiopian-multiplication-4.java b/Task/Ethiopian-multiplication/Java/ethiopian-multiplication-4.java index 1ea4761dee..11c4e0bb0a 100644 --- a/Task/Ethiopian-multiplication/Java/ethiopian-multiplication-4.java +++ b/Task/Ethiopian-multiplication/Java/ethiopian-multiplication-4.java @@ -1 +1,12 @@ -def pairs: while( .[0] > 0; [ (.[0] | halve), (.[1] | double) ]); +function ethMult(m, n) { + var o = !isNaN(m) ? 0 : ''; // same technique works with strings + if (n < 1) return o; + while (n > 1) { + if (n & 1) o += m; // 3. integer odd/even? (bit-wise and 1) + n >>= 1; // 1. integer halved (by right-shift) + m += m; // 2. integer doubled (addition to self) + } + return o + m; +} + +ethMult(17, 34) diff --git a/Task/Ethiopian-multiplication/Java/ethiopian-multiplication-5.java b/Task/Ethiopian-multiplication/Java/ethiopian-multiplication-5.java index 8cef496ce6..14015fd602 100644 --- a/Task/Ethiopian-multiplication/Java/ethiopian-multiplication-5.java +++ b/Task/Ethiopian-multiplication/Java/ethiopian-multiplication-5.java @@ -1,15 +1 @@ -def halve: (./2) | floor; - -def double: 2 * .; - -def isEven: . % 2 == 0; - -def ethiopian_multiply(a;b): - def pairs: recurse( if .[0] > 0 - then [ (.[0] | halve), (.[1] | double) ] - else empty - end ); - reduce ([a,b] | pairs - | select( .[0] | isEven | not) - | .[1] ) as $i - (0; . + $i) ; +ethMult('Ethiopian', 34) diff --git a/Task/Ethiopian-multiplication/Java/ethiopian-multiplication-6.java b/Task/Ethiopian-multiplication/Java/ethiopian-multiplication-6.java index e89ad806a5..1ea4761dee 100644 --- a/Task/Ethiopian-multiplication/Java/ethiopian-multiplication-6.java +++ b/Task/Ethiopian-multiplication/Java/ethiopian-multiplication-6.java @@ -1 +1 @@ -ethiopian_multiply(17;34) # => 578 +def pairs: while( .[0] > 0; [ (.[0] | halve), (.[1] | double) ]); diff --git a/Task/Ethiopian-multiplication/Java/ethiopian-multiplication-7.java b/Task/Ethiopian-multiplication/Java/ethiopian-multiplication-7.java new file mode 100644 index 0000000000..8cef496ce6 --- /dev/null +++ b/Task/Ethiopian-multiplication/Java/ethiopian-multiplication-7.java @@ -0,0 +1,15 @@ +def halve: (./2) | floor; + +def double: 2 * .; + +def isEven: . % 2 == 0; + +def ethiopian_multiply(a;b): + def pairs: recurse( if .[0] > 0 + then [ (.[0] | halve), (.[1] | double) ] + else empty + end ); + reduce ([a,b] | pairs + | select( .[0] | isEven | not) + | .[1] ) as $i + (0; . + $i) ; diff --git a/Task/Ethiopian-multiplication/Java/ethiopian-multiplication-8.java b/Task/Ethiopian-multiplication/Java/ethiopian-multiplication-8.java new file mode 100644 index 0000000000..e89ad806a5 --- /dev/null +++ b/Task/Ethiopian-multiplication/Java/ethiopian-multiplication-8.java @@ -0,0 +1 @@ +ethiopian_multiply(17;34) # => 578 diff --git a/Task/Ethiopian-multiplication/REXX/ethiopian-multiplication-1.rexx b/Task/Ethiopian-multiplication/REXX/ethiopian-multiplication-1.rexx index f8b4a6184c..d7ee0a1a4b 100644 --- a/Task/Ethiopian-multiplication/REXX/ethiopian-multiplication-1.rexx +++ b/Task/Ethiopian-multiplication/REXX/ethiopian-multiplication-1.rexx @@ -1,20 +1,20 @@ -/*REXX program multiplies two integers by the Ethiopian/Russian peasant method*/ -numeric digits 3000 /*handle some gihugeic integers. */ -parse arg a b . /*get two numbers from the command line*/ -say 'a=' a -say 'b=' b -say 'product=' eMult(a,b) -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -eMult: procedure; parse arg x 1 ox,y /*X and OX are set to the 1st argument.*/ -$=0 /*product of the two integers (so far).*/ - do while x\==0 /*keep processing while X not 0.*/ - if \isEven(x) then $=$+y /*if odd, then add Y to product.*/ - x= halve(x) /*invoke the HALVE function. */ - y=double(y) /* " " DOUBLE " */ - end /*while*/ /* [↑] Ethiopian multiplication*/ -return $*sign(ox) /*maintain correct sign for prod*/ -/*──────────────────────────────────one─liner subroutines─────────────────────*/ -double: return arg(1) * 2 /* * is REXX multiplication. */ -halve: return arg(1) % 2 /* % " " integer division. */ -isEven: return arg(1) // 2 == 0 /* // " " " remainder. */ +/*REXX program multiplies two integers by the Ethiopian (or Russian peasant) method. */ +numeric digits 3000 /*handle some gihugeic integers. */ +parse arg a b . /*get two numbers from the command line*/ +say 'a=' a /*display a formatted value of A. */ +say 'b=' b /* " " " " " B. */ +say 'product=' eMult(a, b) /*invoke eMult & multiple two integers.*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +eMult: procedure; parse arg x,y; s=sign(x) /*obtain the two arguments; sign for X.*/ + $=0 /*product of the two integers (so far).*/ + do while x\==0 /*keep processing while X not zero.*/ + if \isEven(x) then $=$+y /*if odd, then add Y to product. */ + x= halve(x) /*invoke the HALVE function. */ + y=double(y) /* " " DOUBLE " */ + end /*while*/ /* [↑] Ethiopian multiplication method*/ + return $*s/1 /*maintain the correct sign for product*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +double: return arg(1) * 2 /* * is REXX's multiplication. */ +halve: return arg(1) % 2 /* % " " integer division. */ +isEven: return arg(1) // 2 == 0 /* // " " division remainder.*/ diff --git a/Task/Ethiopian-multiplication/REXX/ethiopian-multiplication-2.rexx b/Task/Ethiopian-multiplication/REXX/ethiopian-multiplication-2.rexx index 3defa11ba8..c7a50b7685 100644 --- a/Task/Ethiopian-multiplication/REXX/ethiopian-multiplication-2.rexx +++ b/Task/Ethiopian-multiplication/REXX/ethiopian-multiplication-2.rexx @@ -1,26 +1,28 @@ -/*REXX program multiplies two integers by the Ethiopian/Russian peasant method*/ -numeric digits 3000 /*handle some ginormous integers. */ -parse arg a b _ . /*get two numbers from the command line*/ -if \datatype(a,'W') then call error "1st argument isn't an integer." -if \datatype(b,'N') then call error "2nd argument isn't a valid number." -if b=='' | _\=='' then call error "two arguments weren't specified." -p=eMult(a,b) /*Ethiopian or Russian peasant method. */ -w=max(length(a), length(b), length(p)) /*find the maximum width of 3 numbers. */ -say ' a=' right(a,w) /*use right justification to display A.*/ -say ' b=' right(b,w) /* " " " " " B.*/ -say 'product=' right(p,w) /* " " " " " P.*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -eMult: procedure; parse arg x 1 ox,y /*X and OX are set to the 1st argument.*/ -$=0 /*product of the two integers (so far).*/ - do while x\==0 /*keep processing while X not 0.*/ - if \isEven(x) then $=$+y /*if odd, then add Y to product.*/ - x= halve(x) /*invoke the HALVE function. */ - y=double(y) /* " " DOUBLE " */ - end /*while*/ /* [↑] Ethiopian multiplication*/ -return $*sign(ox)/1 /*maintain correct sign for prod*/ -/*──────────────────────────────────one─liner subroutines─────────────────────*/ -double: return arg(1) * 2 /* * is REXX multiplication. */ -halve: return arg(1) % 2 /* % " " integer division. */ -isEven: return arg(1) // 2 == 0 /* // " " " remainder. */ -error: say '***error!***' arg(1); exit 13 /*display an error message.*/ +/*REXX program multiplies two integers by the Ethiopian (or Russian peasant) method. */ +numeric digits 3000 /*handle some gihugeic integers. */ +parse arg a b _ . /*get two numbers from the command line*/ +if a=='' then call error "1st argument wasn't specified." +if b=='' then call error "2nd argument wasn't specified." +if _\=='' then call error "too many arguments were specified: " _ +if \datatype(a, 'W') then call error "1st argument isn't an integer: " a +if \datatype(b, 'N') then call error "2nd argument isn't a valid number: " b +p=eMult(a, b) /*Ethiopian or Russian peasant method. */ +w=max(length(a), length(b), length(p)) /*find the maximum width of 3 numbers. */ +say ' a=' right(a, w) /*use right justification to display A.*/ +say ' b=' right(b, w) /* " " " " " B.*/ +say 'product=' right(p, w) /* " " " " " P.*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +eMult: procedure; parse arg x,y; s=sign(x) /*obtain the two arguments; sign for X.*/ + $=0 /*product of the two integers (so far).*/ + do while x\==0 /*keep processing while X not zero.*/ + if \isEven(x) then $=$+y /*if odd, then add Y to product. */ + x= halve(x) /*invoke the HALVE function. */ + y=double(y) /* " " DOUBLE " */ + end /*while*/ /* [↑] Ethiopian multiplication method*/ + return $*s/1 /*maintain the correct sign for product*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +double: return arg(1) * 2 /* * is REXX's multiplication. */ +halve: return arg(1) % 2 /* % " " integer division. */ +isEven: return arg(1) // 2 == 0 /* // " " division remainder.*/ +error: say '***error!***' arg(1); exit 13 /*display an error message to terminal.*/ diff --git a/Task/Ethiopian-multiplication/ZX-Spectrum-Basic/ethiopian-multiplication.zx b/Task/Ethiopian-multiplication/ZX-Spectrum-Basic/ethiopian-multiplication.zx new file mode 100644 index 0000000000..d1233b7a87 --- /dev/null +++ b/Task/Ethiopian-multiplication/ZX-Spectrum-Basic/ethiopian-multiplication.zx @@ -0,0 +1,10 @@ +10 DEF FN e(a)=a-INT (a/2)*2-1 +20 DEF FN h(a)=INT (a/2) +30 DEF FN d(a)=2*a +40 LET x=17: LET y=34: LET tot=0 +50 IF x<1 THEN GO TO 100 +60 PRINT x;TAB (4); +70 IF FN e(x)=0 THEN LET tot=tot+y: PRINT y: GO TO 90 +80 PRINT "---" +90 LET x=FN h(x): LET y=FN d(y): GO TO 50 +100 PRINT TAB (4);"===",TAB (4);tot diff --git a/Task/Euler-method/00DESCRIPTION b/Task/Euler-method/00DESCRIPTION index f9a88d9255..7e27773c4f 100644 --- a/Task/Euler-method/00DESCRIPTION +++ b/Task/Euler-method/00DESCRIPTION @@ -1,50 +1,61 @@ -Euler's method numerically approximates solutions of first-order ordinary differential equations (ODEs) with a given initial value. It is an explicit method for solving initial value problems (IVPs), as described in [[wp:Euler method|the wikipedia page]]. +Euler's method numerically approximates solutions of first-order ordinary differential equations (ODEs) with a given initial value.   It is an explicit method for solving initial value problems (IVPs), as described in [[wp:Euler method|the wikipedia page]]. + The ODE has to be provided in the following form: -:\frac{dy(t)}{dt} = f(t,y(t)) +::: \frac{dy(t)}{dt} = f(t,y(t)) with an initial value -:y(t_0) = y_0 +::: y(t_0) = y_0 -To get a numeric solution, we replace the derivative on the LHS with a finite difference approximation: +To get a numeric solution, we replace the derivative on the   LHS   with a finite difference approximation: -:\frac{dy(t)}{dt} \approx \frac{y(t+h)-y(t)}{h} +::: \frac{dy(t)}{dt} \approx \frac{y(t+h)-y(t)}{h} then solve for y(t+h): -:y(t+h) \approx y(t) + h \, \frac{dy(t)}{dt} +::: y(t+h) \approx y(t) + h \, \frac{dy(t)}{dt} which is the same as -:y(t+h) \approx y(t) + h \, f(t,y(t)) +::: y(t+h) \approx y(t) + h \, f(t,y(t)) The iterative solution rule is then: -:y_{n+1} = y_n + h \, f(t_n, y_n) +::: y_{n+1} = y_n + h \, f(t_n, y_n) + +where   h   is the step size, the most relevant parameter for accuracy of the solution.   A smaller step size increases accuracy but also the computation cost, so it has always has to be hand-picked according to the problem at hand. -h is the step size, the most relevant parameter for accuracy of the solution. A smaller step size increases accuracy but also the computation cost, so it has always has to be hand-picked according to the problem at hand. '''Example: Newton's Cooling Law''' -Newton's cooling law describes how an object of initial temperature T(t_0) = T_0 cools down in an environment of temperature T_R : - -:\frac{dT(t)}{dt} = -k \, \Delta T +Newton's cooling law describes how an object of initial temperature   T(t_0) = T_0   cools down in an environment of temperature   T_R: +::: \frac{dT(t)}{dt} = -k \, \Delta T or +::: \frac{dT(t)}{dt} = -k \, (T(t) - T_R) -:\frac{dT(t)}{dt} = -k \, (T(t) - T_R) - -It says that the cooling rate \frac{dT(t)}{dt} of the object is proportional to the current temperature difference \Delta T = (T(t) - T_R) to the surrounding environment. +
    +It says that the cooling rate   \frac{dT(t)}{dt}   of the object is proportional to the current temperature difference   \Delta T = (T(t) - T_R)   to the surrounding environment. The analytical solution, which we will compare to the numerical approximation, is +::: T(t) = T_R + (T_0 - T_R) \; e^{-k t} -:T(t) = T_R + (T_0 - T_R) \; e^{-k t} -'''Task''' +;Task: +Implement a routine of Euler's method and then to use it to solve the given example of Newton's cooling law with it for three different step sizes of: +:::*   2 s +:::*   5 s       and +:::*   10 s +and to compare with the analytical solution. -The task is to implement a routine of Euler's method and then to use it to solve the given example of Newton's cooling law with it for three different step sizes of 2 s, 5 s and 10 s and to compare with the analytical solution. -The initial temperature T_0 shall be 100 °C, the room temperature T_R 20 °C, and the cooling constant k 0.07. The time interval to calculate shall be from 0 s to 100 s. -A reference solution ([[#Common Lisp|Common Lisp]]) can be seen below. We see that bigger step sizes lead to reduced approximation accuracy. +;Initial values: +:::*   initial temperature   T_0   shall be   100 °C +:::*   room temperature   T_R   shall be   20 °C +:::*   cooling constant     k     shall be   0.07 +:::*   time interval to calculate shall be from   0 s   ──►   100 s + +
    +A reference solution ([[#Common Lisp|Common Lisp]]) can be seen below.   We see that bigger step sizes lead to reduced approximation accuracy. [[Image:Euler_Method_Newton_Cooling.png|center|750px]] diff --git a/Task/Euler-method/Clojure/euler-method.clj b/Task/Euler-method/Clojure/euler-method.clj new file mode 100644 index 0000000000..ab2fc27077 --- /dev/null +++ b/Task/Euler-method/Clojure/euler-method.clj @@ -0,0 +1,21 @@ +(ns newton-cooling + (:gen-class)) + +(defn euler [f y0 a b h] + "Euler's Method. + Approximates y(time) in y'(time)=f(time,y) with y(a)=y0 and t=a..b and the step size h." + (loop [t a + y y0 + result []] + (if (<= t b) + (recur (+ t h) (+ y (* (f (+ t h) y) h)) (conj result [(double t) (double y)])) + result))) + +(defn newton-coolling [t temp] + "Newton's cooling law, f(t,T) = -0.07*(T-20)" + (* -0.07 (- temp 20))) + +; Run for case h = 10 +(println "Example output") +(doseq [q (euler newton-coolling 100 0 100 10)] + (println (apply format "%.3f %.3f" q))) diff --git a/Task/Euler-method/Common-Lisp/euler-method.lisp b/Task/Euler-method/Common-Lisp/euler-method-1.lisp similarity index 91% rename from Task/Euler-method/Common-Lisp/euler-method.lisp rename to Task/Euler-method/Common-Lisp/euler-method-1.lisp index 1c4fcd1101..45ca426b7a 100644 --- a/Task/Euler-method/Common-Lisp/euler-method.lisp +++ b/Task/Euler-method/Common-Lisp/euler-method-1.lisp @@ -7,8 +7,8 @@ (defun euler (f y0 a b h) ;; Set the initial values and increments of the iteration variables. - (do ((t a (incf t h)) - (y y0 (incf y (* h (funcall f t y))))) + (do ((t a (+ t h)) + (y y0 (+ y (* h (funcall f t y))))) ;; End the iteration when t reaches the end b of the time interval. ((>= t b) 'DONE) diff --git a/Task/Euler-method/Common-Lisp/euler-method-2.lisp b/Task/Euler-method/Common-Lisp/euler-method-2.lisp new file mode 100644 index 0000000000..2abfddaddf --- /dev/null +++ b/Task/Euler-method/Common-Lisp/euler-method-2.lisp @@ -0,0 +1,13 @@ +;; slightly more idiomatic Common Lisp version + +(defun newton-cooling (time temperature) + "Newton's cooling law, f(t,T) = -0.07*(T-20)" + (declare (ignore time)) + (* -0.07 (- temperature 20))) + +(defun euler (f y0 a b h) + "Euler's Method. +Approximates y(time) in y'(time)=f(time,y) with y(a)=y0 and t=a..b and the step size h." + (loop for time from a below b by h + for y = y0 then (+ y (* h (funcall f time y))) + do (format t "~6,3F ~6,3F~%" time y))) diff --git a/Task/Euler-method/Erlang/euler-method.erl b/Task/Euler-method/Erlang/euler-method.erl new file mode 100644 index 0000000000..4f1549d0c4 --- /dev/null +++ b/Task/Euler-method/Erlang/euler-method.erl @@ -0,0 +1,38 @@ +-module(euler). +-export([main/0, euler/5]). + +cooling(_Time, Temperature) -> + (-0.07)*(Temperature-20). + +euler(_, Y, T, _, End) when End == T -> + io:fwrite("\n"), + Y; + +euler(Func, Y, T, Step, End) -> + if + T rem 10 == 0 -> + io:fwrite("~.3f ",[float(Y)]); + true -> + ok + end, + euler(Func, Y + Step * Func(T, Y), T + Step, Step, End). + +analytic(T, End) when T == End -> + io:fwrite("\n"), + T; + +analytic(T, End) -> + Y = (20 + 80 * math:exp(-0.07 * T)), + io:fwrite("~.3f ", [Y]), + analytic(T+10, End). + +main() -> + io:fwrite("Analytic:\n"), + analytic(0, 100), + io:fwrite("Step 2:\n"), + euler(fun cooling/2, 100, 0, 2, 100), + io:fwrite("Step 5:\n"), + euler(fun cooling/2, 100, 0, 5, 100), + io:fwrite("Step 10:\n"), + euler(fun cooling/2, 100, 0, 10, 100), + ok. diff --git a/Task/Euler-method/Haskell/euler-method-1.hs b/Task/Euler-method/Haskell/euler-method-1.hs new file mode 100644 index 0000000000..b5cd6decb6 --- /dev/null +++ b/Task/Euler-method/Haskell/euler-method-1.hs @@ -0,0 +1,5 @@ +-- the solver +dsolveBy _ _ [] _ = error "empty solution interval" +dsolveBy method f mesh x0 = zip mesh results + where results = scanl (method f) x0 intervals + intervals = zip mesh (tail mesh) diff --git a/Task/Euler-method/Haskell/euler-method-2.hs b/Task/Euler-method/Haskell/euler-method-2.hs new file mode 100644 index 0000000000..cfe4105da3 --- /dev/null +++ b/Task/Euler-method/Haskell/euler-method-2.hs @@ -0,0 +1,14 @@ +-- 1-st order Euler +euler f x (t1,t2) = x + (t2 - t1) * f t1 x + +-- 2-nd order Runge-Kutta +rk2 f x (t1,t2) = x + h * f (t1 + h/2) (x + h/2*f t1 x) + where h = t2 - t1 + +-- 4-th order Runge-Kutta +rk4 f x (t1,t2) = x + h/6 * (k1 + 2*k2 + 2*k3 + k4) + where k1 = f t1 x + k2 = f (t1 + h/2) (x + h/2*k1) + k3 = f (t1 + h/2) (x + h/2*k2) + k4 = f (t1 + h) (x + h*k3) + h = t2 - t1 diff --git a/Task/Euler-method/Haskell/euler-method-3.hs b/Task/Euler-method/Haskell/euler-method-3.hs new file mode 100644 index 0000000000..806e695eb1 --- /dev/null +++ b/Task/Euler-method/Haskell/euler-method-3.hs @@ -0,0 +1,23 @@ +import Graphics.EasyPlot + +newton t temp = -0.07 * (temp - 20) + +exactSolution t = 80*exp(-0.07*t)+20 + +test1 = plot (PNG "euler1.png") + [ Data2D [Title "Step 10", Style Lines] [] sol1 + , Data2D [Title "Step 5", Style Lines] [] sol2 + , Data2D [Title "Step 1", Style Lines] [] sol3 + , Function2D [Title "exact solution"] [Range 0 100] exactSolution ] + where sol1 = dsolveBy euler newton [0,10..100] 100 + sol2 = dsolveBy euler newton [0,5..100] 100 + sol3 = dsolveBy euler newton [0,1..100] 100 + +test2 = plot (PNG "euler2.png") + [ Data2D [Title "Euler"] [] sol1 + , Data2D [Title "RK2"] [] sol2 + , Data2D [Title "RK4"] [] sol3 + , Function2D [Title "exact solution"] [Range 0 100] exactSolution ] + where sol1 = dsolveBy euler newton [0,10..100] 100 + sol2 = dsolveBy rk2 newton [0,10..100] 100 + sol3 = dsolveBy rk4 newton [0,10..100] 100 diff --git a/Task/Euler-method/Haskell/euler-method.hs b/Task/Euler-method/Haskell/euler-method.hs deleted file mode 100644 index bf0cf7f6a7..0000000000 --- a/Task/Euler-method/Haskell/euler-method.hs +++ /dev/null @@ -1,15 +0,0 @@ -import Text.Printf - -euler :: (Num a, Ord a) => (a -> a -> a) -> a -> a -> a -> a -> [(a,a)] -euler f y0 a b h = - (a, y0) : - if a < b - then euler f (y0 + (f a y0) * h) (a + h) b h - else [] - -newtonCooling :: Double -> Double -> Double -newtonCooling _ t = -0.07 * (t - 20) - -main = do - mapM_ (uncurry $ printf "%6.3f %6.3f\n") $ euler newtonCooling 100 0 100 10 - putStrLn "DONE" diff --git a/Task/Euler-method/REXX/euler-method.rexx b/Task/Euler-method/REXX/euler-method-1.rexx similarity index 100% rename from Task/Euler-method/REXX/euler-method.rexx rename to Task/Euler-method/REXX/euler-method-1.rexx diff --git a/Task/Euler-method/REXX/euler-method-2.rexx b/Task/Euler-method/REXX/euler-method-2.rexx new file mode 100644 index 0000000000..be55f2b113 --- /dev/null +++ b/Task/Euler-method/REXX/euler-method-2.rexx @@ -0,0 +1,26 @@ +/*REXX pgm solves example of Newton's cooling law via Euler's method (diff. step sizes).*/ +numeric digits length( e() - 1) /*use the number of decimal digits in E*/ +parse arg Ti Tr cc tt ss /*obtain optional arguments from the CL*/ +if Ti=='' | Ti=="," then Ti=100 /*given? Default: initial temp in ºC.*/ +if Tr=='' | Tr=="," then Tr= 20 /* " " room " " " */ +if cc=='' | cc=="," then cc= 0.07 /* " " cooling constant. */ +if tt=='' | tt=="," then tt=100 /* " " total time seconds. */ +if ss ='' | ss ="," then ss=2 5 10 /* " " the step sizes. */ +@= '═' /*the character used in title separator*/ + do sSize=1 for words(ss); say; say; say center('time in' , 11) + say center('seconds' , 11, @) center('Euler method', 16, @) , + center('analytic', 18, @) center('difference' , 14, @) + $=Ti; inc=word(ss,Ssize) /*the 1st value; obtain the increment.*/ + do t=0 to Ti by inc /*step through calculations by the inc.*/ + a=format(Tr + (Ti-Tr)/exp(cc*t),6,9) /*calculate the analytic (exact) value.*/ + say center(t,11) format($,6,3) 'ºC ' a "ºC" format(abs(a-$)/a*100,6,2) '%' + $=$ + inc * cc * (Tr-$) /*calc. next value via Euler's method. */ + end /*t*/ + end /*stepSize*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +e: return 2.718281828459045235360287471352662497757247093699959574966967627724076630353548 +/*──────────────────────────────────────────────────────────────────────────────────────*/ +exp: procedure; parse arg x; ix=x%1; if abs(x-ix)>.5 then ix=ix+sign(x); x=x-ix; z=1 + _=1; w=1; do j=1; _=_*x/j; z=(z+_)/1; if z==w then leave; w=z; end /*j*/ + if z\==0 then z=e()**ix * z; return z diff --git a/Task/Euler-method/ZX-Spectrum-Basic/euler-method.zx b/Task/Euler-method/ZX-Spectrum-Basic/euler-method.zx new file mode 100644 index 0000000000..cbe7ed3b1c --- /dev/null +++ b/Task/Euler-method/ZX-Spectrum-Basic/euler-method.zx @@ -0,0 +1,3 @@ +10 LET d$="-0.07*(y-20)": LET y=100: LET a=0: LET b=100: LET s=10 +20 LET t=a +30 IF t<=b THEN PRINT t;TAB 10;y: LET y=y+s*VAL d$: LET t=t+s: GO TO 30 diff --git a/Task/Evaluate-binomial-coefficients/00DESCRIPTION b/Task/Evaluate-binomial-coefficients/00DESCRIPTION index 15de09e134..08819910e2 100644 --- a/Task/Evaluate-binomial-coefficients/00DESCRIPTION +++ b/Task/Evaluate-binomial-coefficients/00DESCRIPTION @@ -1,11 +1,15 @@ This programming task, is to calculate ANY binomial coefficient. -However, it has to be able to output \binom{5}{3}, which is 10. +However, it has to be able to output   \binom{5}{3},   which is   '''10'''. This formula is recommended: -: \binom{n}{k} = \frac{n!}{(n-k)!k!} = \frac{n(n-1)(n-2)\ldots(n-k+1)}{k(k-1)(k-2)\ldots 1} + +:: \binom{n}{k} = \frac{n!}{(n-k)!k!} = \frac{n(n-1)(n-2)\ldots(n-k+1)}{k(k-1)(k-2)\ldots 1} + + '''See Also:''' * [[Combinations and permutations]] * [[Pascal's triangle]] {{Template:Combinations and permutations}} +
    diff --git a/Task/Evaluate-binomial-coefficients/Factor/evaluate-binomial-coefficients.factor b/Task/Evaluate-binomial-coefficients/Factor/evaluate-binomial-coefficients.factor new file mode 100644 index 0000000000..bf179022b4 --- /dev/null +++ b/Task/Evaluate-binomial-coefficients/Factor/evaluate-binomial-coefficients.factor @@ -0,0 +1,15 @@ +: fact ( n -- n-factorial ) + dup 0 = [ drop 1 ] [ dup 1 - fact * ] if ; + +: choose ( n k -- n-choose-k ) + 2dup - fact swap fact * swap fact swap / ; + +! outputs 10 +5 3 choose . + +! alternative using folds +USE: math.ranges + +! (product [n..k+1] / product [n-k..1]) +: choose-fold ( n k -- n-choose-k ) + 2dup 1 + [a,b] product -rot - 1 [a,b] product / ; diff --git a/Task/Evaluate-binomial-coefficients/Julia/evaluate-binomial-coefficients.julia b/Task/Evaluate-binomial-coefficients/Julia/evaluate-binomial-coefficients.julia index 676fbd4e33..fb0248ac28 100644 --- a/Task/Evaluate-binomial-coefficients/Julia/evaluate-binomial-coefficients.julia +++ b/Task/Evaluate-binomial-coefficients/Julia/evaluate-binomial-coefficients.julia @@ -3,7 +3,7 @@ function binom(n,k) n == 1 && return 1 k == 0 && return 1 - binom(n-1,k-1) + binom (n-1,k) #recursive call + (n * binom(n - 1, k - 1)) ÷ k #recursive call end julia> binom(5,2) diff --git a/Task/Evaluate-binomial-coefficients/Perl-6/evaluate-binomial-coefficients-1.pl6 b/Task/Evaluate-binomial-coefficients/Perl-6/evaluate-binomial-coefficients-1.pl6 index 6d6b1b7797..a58f7fed0f 100644 --- a/Task/Evaluate-binomial-coefficients/Perl-6/evaluate-binomial-coefficients-1.pl6 +++ b/Task/Evaluate-binomial-coefficients/Perl-6/evaluate-binomial-coefficients-1.pl6 @@ -1,2 +1 @@ -sub infix: { [*] ($^n ... 0) Z/ 1 .. $^p } -say 5 choose 3; +say combinations(5, 3).elems; diff --git a/Task/Evaluate-binomial-coefficients/Perl-6/evaluate-binomial-coefficients-2.pl6 b/Task/Evaluate-binomial-coefficients/Perl-6/evaluate-binomial-coefficients-2.pl6 index 019115371d..6d6b1b7797 100644 --- a/Task/Evaluate-binomial-coefficients/Perl-6/evaluate-binomial-coefficients-2.pl6 +++ b/Task/Evaluate-binomial-coefficients/Perl-6/evaluate-binomial-coefficients-2.pl6 @@ -1 +1,2 @@ -sub infix: { ([*] ($^n ... 0) Z/ 1 .. $^p).Int } +sub infix: { [*] ($^n ... 0) Z/ 1 .. $^p } +say 5 choose 3; diff --git a/Task/Evaluate-binomial-coefficients/Perl-6/evaluate-binomial-coefficients-3.pl6 b/Task/Evaluate-binomial-coefficients/Perl-6/evaluate-binomial-coefficients-3.pl6 new file mode 100644 index 0000000000..53a27533b5 --- /dev/null +++ b/Task/Evaluate-binomial-coefficients/Perl-6/evaluate-binomial-coefficients-3.pl6 @@ -0,0 +1 @@ +sub infix: { [*] ($^n ... 0) Z/ 1 .. min($n - $^p, $p) } diff --git a/Task/Evaluate-binomial-coefficients/Perl-6/evaluate-binomial-coefficients-4.pl6 b/Task/Evaluate-binomial-coefficients/Perl-6/evaluate-binomial-coefficients-4.pl6 new file mode 100644 index 0000000000..2c95bbc240 --- /dev/null +++ b/Task/Evaluate-binomial-coefficients/Perl-6/evaluate-binomial-coefficients-4.pl6 @@ -0,0 +1 @@ +sub infix: { ([*] ($^n ... 0) Z/ 1 .. min($n - $^p, $p)).Int } diff --git a/Task/Evaluate-binomial-coefficients/REXX/evaluate-binomial-coefficients-1.rexx b/Task/Evaluate-binomial-coefficients/REXX/evaluate-binomial-coefficients-1.rexx index 9fcde676fd..832146d79e 100644 --- a/Task/Evaluate-binomial-coefficients/REXX/evaluate-binomial-coefficients-1.rexx +++ b/Task/Evaluate-binomial-coefficients/REXX/evaluate-binomial-coefficients-1.rexx @@ -1,9 +1,8 @@ -/*REXX program calculates binomial coefficients (aka, combinations). */ -numeric digits 100000 /*be able to handle gihugeic numbers. */ -parse arg n k . /*obtain N and K from the C.L. */ -say 'combinations('n","k')=' comb(n,k) /*display the number of combinations. */ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ +/*REXX program calculates binomial coefficients (also known as combinations). */ +numeric digits 100000 /*be able to handle gihugeic numbers. */ +parse arg n k . /*obtain N and K from the C.L. */ +say 'combinations('n","k')=' comb(n,k) /*display the number of combinations. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ comb: procedure; parse arg x,y; return !(x) % (!(x-y) * !(y)) -/*────────────────────────────────────────────────────────────────────────────*/ -!: procedure; !=1; do j=2 to arg(1); !=!*j; end; return ! +!: procedure; !=1; do j=2 to arg(1); !=!*j; end /*j*/; return ! diff --git a/Task/Evaluate-binomial-coefficients/REXX/evaluate-binomial-coefficients-2.rexx b/Task/Evaluate-binomial-coefficients/REXX/evaluate-binomial-coefficients-2.rexx index 630ea3a018..5431178926 100644 --- a/Task/Evaluate-binomial-coefficients/REXX/evaluate-binomial-coefficients-2.rexx +++ b/Task/Evaluate-binomial-coefficients/REXX/evaluate-binomial-coefficients-2.rexx @@ -1,9 +1,9 @@ -/*REXX program calculates binomial coefficients (aka, combinations). */ -numeric digits 100000 /*be able to handle gihugeic numbers. */ -parse arg n k . /*obtain N and K from the C.L. */ -say 'combinations('n","k')=' comb(n,k) /*display the number of combinations. */ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -comb: procedure; parse arg x,y; return pfact(x-y+1,x) % pfact(2,y) -/*────────────────────────────────────────────────────────────────────────────*/ -pfact: procedure; !=1; do j=arg(1) to arg(2); !=!*j; end; return ! +/*REXX program calculates binomial coefficients (also known as combinations). */ +numeric digits 100000 /*be able to handle gihugeic numbers. */ +parse arg n k . /*obtain N and K from the C.L. */ +say 'combinations('n","k')=' comb(n,k) /*display the number of combinations. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +comb: procedure; parse arg x,y; return pfact(x-y+1, x) % pfact(2, y) +/*──────────────────────────────────────────────────────────────────────────────────────*/ +pfact: procedure; !=1; do j=arg(1) to arg(2); !=!*j; end /*j*/; return ! diff --git a/Task/Evaluate-binomial-coefficients/Ruby/evaluate-binomial-coefficients-3.rb b/Task/Evaluate-binomial-coefficients/Ruby/evaluate-binomial-coefficients-3.rb new file mode 100644 index 0000000000..2c8332d205 --- /dev/null +++ b/Task/Evaluate-binomial-coefficients/Ruby/evaluate-binomial-coefficients-3.rb @@ -0,0 +1 @@ +(1..60).to_a.combination(30).size #=> 118264581564861424 diff --git a/Task/Evaluate-binomial-coefficients/Rust/evaluate-binomial-coefficients.rust b/Task/Evaluate-binomial-coefficients/Rust/evaluate-binomial-coefficients.rust new file mode 100644 index 0000000000..9bb576b77d --- /dev/null +++ b/Task/Evaluate-binomial-coefficients/Rust/evaluate-binomial-coefficients.rust @@ -0,0 +1,19 @@ +fn fact(n:u32) -> u64 { + let mut f:u64 = n as u64; + for i in 2..n { + f *= i as u64; + } + return f; +} + +fn choose(n: u32, k: u32) -> u64 { + let mut num:u64 = n as u64; + for i in 1..k { + num *= (n-i) as u64; + } + return num / fact(k); +} + +fn main() { + println!("{}", choose(5,3)); +} diff --git a/Task/Evaluate-binomial-coefficients/ZX-Spectrum-Basic/evaluate-binomial-coefficients.zx b/Task/Evaluate-binomial-coefficients/ZX-Spectrum-Basic/evaluate-binomial-coefficients.zx new file mode 100644 index 0000000000..3cb85bd267 --- /dev/null +++ b/Task/Evaluate-binomial-coefficients/ZX-Spectrum-Basic/evaluate-binomial-coefficients.zx @@ -0,0 +1,10 @@ +10 LET n=33: LET k=17: PRINT "Binomial ";n;",";k;" = "; +20 LET r=1: LET d=n-k +30 IF d>k THEN LET k=d: LET d=n-k +40 IF n<=k THEN GO TO 90 +50 LET r=r*n +60 LET n=n-1 +70 IF (d>1) AND (FN m(r,d)=0) THEN LET r=r/d: LET d=d-1: GO TO 70 +80 GO TO 40 +90 PRINT r +100 DEF FN m(a,b)=a-INT (a/b)*b diff --git a/Task/Even-or-odd/00DESCRIPTION b/Task/Even-or-odd/00DESCRIPTION index f5dc4f4be0..0a4689e499 100644 --- a/Task/Even-or-odd/00DESCRIPTION +++ b/Task/Even-or-odd/00DESCRIPTION @@ -1,3 +1,4 @@ +;Task: Test whether an integer is even or odd. There is more than one way to solve this task: @@ -8,3 +9,4 @@ There is more than one way to solve this task: * Use modular congruences: ** ''i'' ≡ 0 (mod 2) iff ''i'' is even. ** ''i'' ≡ 1 (mod 2) iff ''i'' is odd. +

    diff --git a/Task/Even-or-odd/APL/even-or-odd.apl b/Task/Even-or-odd/APL/even-or-odd.apl new file mode 100644 index 0000000000..cbe6f0258a --- /dev/null +++ b/Task/Even-or-odd/APL/even-or-odd.apl @@ -0,0 +1,4 @@ + 2|28 +0 + 2|37 +1 diff --git a/Task/Even-or-odd/CoffeeScript/even-or-odd.coffee b/Task/Even-or-odd/CoffeeScript/even-or-odd.coffee new file mode 100644 index 0000000000..58b568eeea --- /dev/null +++ b/Task/Even-or-odd/CoffeeScript/even-or-odd.coffee @@ -0,0 +1 @@ +isEven = (x) -> !(x%2) diff --git a/Task/Even-or-odd/Excel/even-or-odd-1.excel b/Task/Even-or-odd/Excel/even-or-odd-1.excel new file mode 100644 index 0000000000..8b3617fc8b --- /dev/null +++ b/Task/Even-or-odd/Excel/even-or-odd-1.excel @@ -0,0 +1,2 @@ +=MOD(33;2) +=MOD(18;2) diff --git a/Task/Even-or-odd/Excel/even-or-odd-2.excel b/Task/Even-or-odd/Excel/even-or-odd-2.excel new file mode 100644 index 0000000000..1aab216047 --- /dev/null +++ b/Task/Even-or-odd/Excel/even-or-odd-2.excel @@ -0,0 +1,2 @@ +=ISEVEN(33) +=ISEVEN(18) diff --git a/Task/Even-or-odd/Excel/even-or-odd-3.excel b/Task/Even-or-odd/Excel/even-or-odd-3.excel new file mode 100644 index 0000000000..6406954f3f --- /dev/null +++ b/Task/Even-or-odd/Excel/even-or-odd-3.excel @@ -0,0 +1,2 @@ +=ISODD(33) +=ISODD(18) diff --git a/Task/Even-or-odd/JavaScript/even-or-odd-2.js b/Task/Even-or-odd/JavaScript/even-or-odd-2.js index 0c4efc81d1..3d63bb9a0b 100644 --- a/Task/Even-or-odd/JavaScript/even-or-odd-2.js +++ b/Task/Even-or-odd/JavaScript/even-or-odd-2.js @@ -1,3 +1,8 @@ function isEven( i ) { return i % 2 === 0; } + +// Alternative +function isEven( i ) { + return !(i % 2); +} diff --git a/Task/Even-or-odd/JavaScript/even-or-odd-3.js b/Task/Even-or-odd/JavaScript/even-or-odd-3.js new file mode 100644 index 0000000000..d56169e1d9 --- /dev/null +++ b/Task/Even-or-odd/JavaScript/even-or-odd-3.js @@ -0,0 +1,2 @@ +// EMCAScript 6 +const isEven=x=>!(x%2) diff --git a/Task/Even-or-odd/MIPS-Assembly/even-or-odd.mips b/Task/Even-or-odd/MIPS-Assembly/even-or-odd.mips new file mode 100644 index 0000000000..89449ad2c0 --- /dev/null +++ b/Task/Even-or-odd/MIPS-Assembly/even-or-odd.mips @@ -0,0 +1,34 @@ +.data + even_str: .asciiz "Even" + odd_str: .asciiz "Odd" + +.text + #set syscall to get integer from user + li $v0,5 + syscall + + #perform bitwise AND and store in $a0 + and $a0,$v0,1 + + #set syscall to print dytomh + li $v0,4 + + #jump to odd if the result of the AND operation + beq $a0,1,odd +even: + #load even_str message, and print + la $a0,even_str + syscall + + #exit program + li $v0,10 + syscall + +odd: + #load odd_str message, and print + la $a0,odd_str + syscall + + #exit program + li $v0,10 + syscall diff --git a/Task/Even-or-odd/Neko/even-or-odd.neko b/Task/Even-or-odd/Neko/even-or-odd.neko new file mode 100644 index 0000000000..ec650567d8 --- /dev/null +++ b/Task/Even-or-odd/Neko/even-or-odd.neko @@ -0,0 +1,7 @@ +var number = 6; + +if(number % 2 == 0) { + $print("Even"); +} else { + $print("Odd"); +} diff --git a/Task/Even-or-odd/Oberon-2/even-or-odd.oberon-2 b/Task/Even-or-odd/Oberon-2/even-or-odd.oberon-2 new file mode 100644 index 0000000000..e010e2ed06 --- /dev/null +++ b/Task/Even-or-odd/Oberon-2/even-or-odd.oberon-2 @@ -0,0 +1,21 @@ +MODULE EvenOrOdd; +IMPORT + S := SYSTEM, + Out; +VAR + x: INTEGER; + s: SET; + +BEGIN + x := 10;Out.Int(x,0); + IF ODD(x) THEN Out.String(" odd") ELSE Out.String(" even") END; + Out.Ln; + + x := 11;s := S.VAL(SET,LONG(x));Out.Int(x,0); + IF 0 IN s THEN Out.String(" odd") ELSE Out.String(" even") END; + Out.Ln; + + x := 12;Out.Int(x,0); + IF x MOD 2 # 0 THEN Out.String(" odd") ELSE Out.String(" even") END; + Out.Ln +END EvenOrOdd. diff --git a/Task/Even-or-odd/PowerShell/even-or-odd-1.psh b/Task/Even-or-odd/PowerShell/even-or-odd-1.psh new file mode 100644 index 0000000000..769cafd779 --- /dev/null +++ b/Task/Even-or-odd/PowerShell/even-or-odd-1.psh @@ -0,0 +1,2 @@ +$IsOdd = -not ( [bigint]$N ).IsEven +$IsEven = ( [bigint]$N ).IsEven diff --git a/Task/Even-or-odd/PowerShell/even-or-odd-2.psh b/Task/Even-or-odd/PowerShell/even-or-odd-2.psh new file mode 100644 index 0000000000..dc75ed2dbc --- /dev/null +++ b/Task/Even-or-odd/PowerShell/even-or-odd-2.psh @@ -0,0 +1,2 @@ +$IsOdd = [boolean]( $N -band 1 ) +$IsEven = [boolean]( $N -band 0 ) diff --git a/Task/Even-or-odd/PowerShell/even-or-odd-3.psh b/Task/Even-or-odd/PowerShell/even-or-odd-3.psh new file mode 100644 index 0000000000..3330252f4e --- /dev/null +++ b/Task/Even-or-odd/PowerShell/even-or-odd-3.psh @@ -0,0 +1,2 @@ +$IsOdd = $N % 2 -ne 0 +$IsEven = $N % 2 -eq 0 diff --git a/Task/Even-or-odd/PowerShell/even-or-odd.psh b/Task/Even-or-odd/PowerShell/even-or-odd.psh deleted file mode 100644 index 1787352638..0000000000 --- a/Task/Even-or-odd/PowerShell/even-or-odd.psh +++ /dev/null @@ -1,9 +0,0 @@ -function parity($n) { - if($n%2 -eq 0) { - "$n is even" - } else { - "$n is odd" - } -} -parity 0 -parity 1 diff --git a/Task/Even-or-odd/REXX/even-or-odd.rexx b/Task/Even-or-odd/REXX/even-or-odd.rexx index 2eb512cb30..4c50130c68 100644 --- a/Task/Even-or-odd/REXX/even-or-odd.rexx +++ b/Task/Even-or-odd/REXX/even-or-odd.rexx @@ -1,85 +1,76 @@ -/*REXX program tests and displays if an integer is even or odd.*/ -!.=0; do j=0 by 2 to 8; !.j=1; end /*assign 0,2,4,6,8 to a "true" value.*/ - /* [↑] assigns even digits to "true".*/ -numeric digits 1000 /*handle most huge numbers from the CL.*/ -parse arg x _ . /*get an argument from the command line*/ -if x=='' then call terr "no input integer." /*error.*/ -if _\=='' | arg()\==1 then call terr "too many arguments: " _ arg(2) /*error.*/ -if \datatype(x,'N') then call terr x " isn't numeric." /*error.*/ -if \datatype(x,'W') then call terr x " isn't an integer." /*error.*/ -y=abs(x)/1 /*in case X is negative or malformed,*/ - /* [↑] remainder of neg # might be -1.*/ - /*malformed #s: 007 9.0 4.8e1 .21e2 */ - /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/ -call sayr 'remainder method (oddness)' +/*REXX program tests and displays if an integer is even or odd using different styles.*/ +!.=0; do j=0 by 2 to 8; !.j=1; end /*assign 0,2,4,6,8 to a "true" value.*/ + /* [↑] assigns even digits to "true".*/ +numeric digits 1000 /*handle most huge numbers from the CL.*/ +parse arg x _ . /*get an argument from the command line*/ +if x=='' then call terr "no integer input (argument)." +if _\=='' | arg()\==1 then call terr "too many arguments: " _ arg(2) +if \datatype(x, 'N') then call terr "argument isn't numeric: " x +if \datatype(x, 'W') then call terr "argument isn't an integer: " x +y=abs(x)/1 /*in case X is negative or malformed,*/ + /* [↑] remainder of neg # might be -1.*/ + /*malformed #s: 007 9.0 4.8e1 .21e2 */ +call tell 'remainder method (oddness)' if y//2 then say x 'is odd' else say x 'is even' - /* [↑] uses division to get remainder.*/ + /* [↑] uses division to get remainder.*/ - /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/ -call sayr 'rightmost digit using BIF (not evenness)' -_=right(y,1) -if pos(_,86420)==0 then say x 'is odd' - else say x 'is even' - /* [↑] uses 2 BIF (built─in functions)*/ +call tell 'rightmost digit using BIF (not evenness)' +_=right(y, 1) +if pos(_, 86420)==0 then say x 'is odd' + else say x 'is even' + /* [↑] uses 2 BIF (built─in functions)*/ - /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/ -call sayr 'rightmost digit using BIF (evenness)' -_=right(y,1) -if pos(_,86420)\==0 then say x 'is even' - else say x 'is odd' - /* [↑] uses 2 BIF (built─in functions)*/ +call tell 'rightmost digit using BIF (evenness)' +_=right(y, 1) +if pos(_, 86420)\==0 then say x 'is even' + else say x 'is odd' + /* [↑] uses 2 BIF (built─in functions)*/ - /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/ -call sayr 'even rightmost digit using array (evenness)' -_=right(y,1) +call tell 'even rightmost digit using array (evenness)' +_=right(y, 1) if !._ then say x 'is even' else say x 'is odd' - /* [↑] uses a BIF (built─in function).*/ + /* [↑] uses a BIF (built─in function).*/ - /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/ -call sayr 'remainder of division via function invoke (evenness)' +call tell 'remainder of division via function invoke (evenness)' if even(y) then say x 'is even' else say x 'is odd' - /* [↑] uses (even) function invocation*/ + /* [↑] uses (even) function invocation*/ - /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/ -call sayr 'remainder of division via function invoke (oddness)' +call tell 'remainder of division via function invoke (oddness)' if odd(y) then say x 'is odd' else say x 'is even' - /* [↑] uses (odd) function invocation*/ + /* [↑] uses (odd) function invocation*/ - /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/ -call sayr 'rightmost digit using BIF (not oddness)' -_=right(y,1) -if pos(_,13579)==0 then say x 'is even' - else say x 'is odd' - /* [↑] uses 2 BIF (built─in functions)*/ +call tell 'rightmost digit using BIF (not oddness)' +_=right(y, 1) +if pos(_, 13579)==0 then say x 'is even' + else say x 'is odd' + /* [↑] uses 2 BIF (built─in functions)*/ - /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/ -call sayr 'rightmost (binary) bit (oddness)' -if right(x2b(d2x(y)),1) then say x 'is odd' - else say x 'is even' - /* [↑] requires extra numeric digits. */ +call tell 'rightmost (binary) bit (oddness)' +if right(x2b(d2x(y)), 1) then say x 'is odd' + else say x 'is even' + /* [↑] requires extra numeric digits. */ - /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/ -call sayr 'parse statement using BIF (not oddness)' -parse var y '' -1 _ /*obtain last decimal digit of the Y #.*/ -if pos(_,02468)==0 then say x 'is odd' - else say x 'is even' - /* [↑] uses a BIF (built─in function).*/ +call tell 'parse statement using BIF (not oddness)' +parse var y '' -1 _ /*obtain last decimal digit of the Y #.*/ +if pos(_, 02468)==0 then say x 'is odd' + else say x 'is even' + /* [↑] uses a BIF (built─in function).*/ - /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/ -call sayr 'parse statement using array (evenness)' -parse var y '' -1 _ /*obtain last decimal digit of the Y #.*/ +call tell 'parse statement using array (evenness)' +parse var y '' -1 _ /*obtain last decimal digit of the Y #.*/ if !._ then say x 'is even' else say x 'is odd' - /* [↑] this is the fastest algorithm. */ -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────one─liner subroutines─────────────────────*/ -even: return \ ( arg(1)//2 ) /*actual algorithm used can be varied. */ -even: return arg(1)//2 == 0 /* " " " " " " */ -even: parse arg '' -1 _; return !._ /* " " " " " " */ -odd: return arg(1)//2 /* " " " " " " */ -sayr: say; say center('using the' arg(1), 79, '═'); return -terr: say; say '***error!***'; say; say arg(1); say; exit 13 + /* [↑] this is the fastest algorithm. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +even: return \( arg(1)//2 ) /*returns "evenness" of arg, version 1.*/ +even: return arg(1)//2==0 /* " " " " " 2.*/ +even: parse arg '' -1 _; return !._ /* " " " " " 3.*/ + /*last version shown is the fastest. */ +odd: return arg(1)//2 /*returns "oddness" of the argument. */ +tell: say; say center('using the' arg(1), 79, "═"); return +terr: say; say '***error***'; say; say arg(1); say; exit 13 diff --git a/Task/Even-or-odd/SETL/even-or-odd.setl b/Task/Even-or-odd/SETL/even-or-odd.setl new file mode 100644 index 0000000000..a2428f4188 --- /dev/null +++ b/Task/Even-or-odd/SETL/even-or-odd.setl @@ -0,0 +1,5 @@ +xs := {1..10}; +evens := {x in xs | even( x )}; +odds := {x in xs | odd( x )}; +print( evens ); +print( odds ); diff --git a/Task/Even-or-odd/SNOBOL4/even-or-odd.sno b/Task/Even-or-odd/SNOBOL4/even-or-odd.sno new file mode 100644 index 0000000000..a8ff8b8538 --- /dev/null +++ b/Task/Even-or-odd/SNOBOL4/even-or-odd.sno @@ -0,0 +1,10 @@ + DEFINE('even(n)') :(even_end) +even even = (EQ(REMDR(n, 2), 0) 'even', 'odd') :(RETURN) +even_end + + OUTPUT = "-2 is " even(-2) + OUTPUT = "-1 is " even(-1) + OUTPUT = "0 is " even(0) + OUTPUT = "1 is " even(1) + OUTPUT = "2 is " even(2) +END diff --git a/Task/Even-or-odd/SQL/even-or-odd.sql b/Task/Even-or-odd/SQL/even-or-odd.sql new file mode 100644 index 0000000000..5a5d1a6764 --- /dev/null +++ b/Task/Even-or-odd/SQL/even-or-odd.sql @@ -0,0 +1,13 @@ +-- Setup a table with some integers +create table ints(int integer); +insert into ints values (-1); +insert into ints values (0); +insert into ints values (1); +insert into ints values (2); + +-- Are they even or odd? +select + int, + case mod(int, 2) when 0 then 'Even' else 'Odd' end +from + ints; diff --git a/Task/Even-or-odd/Standard-ML/even-or-odd.ml b/Task/Even-or-odd/Standard-ML/even-or-odd.ml new file mode 100644 index 0000000000..f385b6cf61 --- /dev/null +++ b/Task/Even-or-odd/Standard-ML/even-or-odd.ml @@ -0,0 +1,15 @@ +fun even n = + n mod 2 = 0; + +fun odd n = + n mod 2 <> 0; + +(* bitwise and *) + +type werd = Word.word; + +fun evenbitw(w: werd) = + Word.andb(w, 0w2) = 0w0; + +fun oddbitw(w: werd) = + Word.andb(w, 0w2) <> 0w0; diff --git a/Task/Even-or-odd/ZX-Spectrum-Basic/even-or-odd.zx b/Task/Even-or-odd/ZX-Spectrum-Basic/even-or-odd.zx new file mode 100644 index 0000000000..04c4c04b9f --- /dev/null +++ b/Task/Even-or-odd/ZX-Spectrum-Basic/even-or-odd.zx @@ -0,0 +1,6 @@ +10 FOR n=-3 TO 4: GO SUB 30: NEXT n +20 STOP +30 LET odd=FN m(n,2) +40 PRINT n;" is ";("Even" AND odd=0)+("Odd" AND odd=1) +50 RETURN +60 DEF FN m(a,b)=a-INT (a/b)*b diff --git a/Task/Events/Clojure/events.clj b/Task/Events/Clojure/events.clj new file mode 100644 index 0000000000..8a36c74855 --- /dev/null +++ b/Task/Events/Clojure/events.clj @@ -0,0 +1,37 @@ +(ns async-example.core + (:require [clojure.core.async :refer [>! !! ! c "reset") ; Send message to task + )))) + +; Invoke -main function +(-main) diff --git a/Task/Events/REXX/events.rexx b/Task/Events/REXX/events.rexx index beb0a9d19e..e50dcec343 100644 --- a/Task/Events/REXX/events.rexx +++ b/Task/Events/REXX/events.rexx @@ -1,16 +1,18 @@ -/*REXX program shows a method of handling events (this is time-driven). */ -signal on halt /*allow the user to HALT the pgm.*/ -parse arg timeEvent /*allow "event" to be specified. */ -if timeEvent='' then timeEvent=5 /*if not specified, use default. */ +/*REXX program demonstrates a method of handling events (this is a time─driven pgm).*/ +signal on halt /*allow the user to HALT the program.*/ +parse arg timeEvent /*allow the "event" to be specified. */ +if timeEvent='' then timeEvent=5 /*Not specified? Then use the default.*/ -event?: do forever /*determine if an event occurred.*/ - theEvent=right(time(),1) /*maybe it's an event, maybe not.*/ +event?: do forever /*determine if an event has occurred. */ + theEvent=right(time(),1) /*maybe it's an event, ─or─ maybe not.*/ if pos(theEvent,timeEvent)\==0 then signal happening end /*forever*/ -say 'Control should never get here!' /*This is a logic no-no occurance*/ -halt: say 'program halted.'; exit /*stick a fork in it, we're done.*/ -/*───────────────────────────────────HAPPENING processing───────────────*/ -happening: say 'an event occurred at' time()", the event is:" theEvent - do while theEvent==right(time(),1); /*process the event here.*/ nop;end -signal event? /*see if another event happened. */ +say 'Control should never get here!' /*This is a logic can─never─happen ! */ +halt: say '════════════ program halted.'; exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +happening: say 'an event occurred at' time()", the event is:" theEvent + do while theEvent==right(time(),1) + nop /*replace NOP with the "process" code.*/ + end /*while*/ /*NOP is a special REXX statement. */ +signal event? /*see if another event has happened. */ diff --git a/Task/Evolutionary-algorithm/00DESCRIPTION b/Task/Evolutionary-algorithm/00DESCRIPTION index 42bb6475c8..4bfc47362f 100644 --- a/Task/Evolutionary-algorithm/00DESCRIPTION +++ b/Task/Evolutionary-algorithm/00DESCRIPTION @@ -8,11 +8,15 @@ Starting with: :* Assess the fitness of the parent and all the copies to the target and make the most fit string the new parent, discarding the others. :* repeat until the parent converges, (hopefully), to the target. -Cf: [[wp:Weasel_program#Weasel_algorithm|Weasel algorithm]] and [[wp:Evolutionary algorithm|Evolutionary algorithm]] +;Related tasks: +*   [[wp:Weasel_program#Weasel_algorithm|Weasel algorithm]]. +*   [[wp:Evolutionary algorithm|Evolutionary algorithm]]. + +
    Note: to aid comparison, try and ensure the variables and functions mentioned in the task description appear in solutions -=========== +
    A cursory examination of a few of the solutions reveals that the instructions have not been followed rigorously in some solutions. Specifically, * While the parent is not yet the target: :* copy the parent C times, each time allowing some random probability that another character might be substituted using mutate. @@ -33,3 +37,4 @@ As illustration of this error, the code for 8th has the following remark. Clearly, this algo will be applying the mutation function only to the parent characters that don't match to the target characters! To ensure that the new parent is never less fit than the prior parent, both the parent and all of the latest mutations are subjected to the fitness test to select the next parent. +

    diff --git a/Task/Evolutionary-algorithm/COBOL/evolutionary-algorithm.cobol b/Task/Evolutionary-algorithm/COBOL/evolutionary-algorithm.cobol new file mode 100644 index 0000000000..9076389384 --- /dev/null +++ b/Task/Evolutionary-algorithm/COBOL/evolutionary-algorithm.cobol @@ -0,0 +1,88 @@ +identification division. +program-id. evolutionary-program. +data division. +working-storage section. +01 evolving-strings. + 05 target pic a(28) + value 'METHINKS IT IS LIKE A WEASEL'. + 05 parent pic a(28). + 05 offspring-table. + 10 offspring pic a(28) + occurs 50 times. +01 fitness-calculations. + 05 fitness pic 99. + 05 highest-fitness pic 99. + 05 fittest pic 99. +01 parameters. + 05 character-set pic a(27) + value 'ABCDEFGHIJKLMNOPQRSTUVWXYZ '. + 05 size-of-generation pic 99 + value 50. + 05 mutation-rate pic 99 + value 5. +01 counters-and-working-variables. + 05 character-position pic 99. + 05 randomization. + 10 random-seed pic 9(8). + 10 random-number pic 99. + 10 random-letter pic 99. + 05 generation pic 999. + 05 child pic 99. + 05 temporary-string pic a(28). +procedure division. +control-paragraph. + accept random-seed from time. + move function random(random-seed) to random-number. + perform random-letter-paragraph, + varying character-position from 1 by 1 + until character-position is greater than 28. + move temporary-string to parent. + move zero to generation. + perform output-paragraph. + perform evolution-paragraph, + varying generation from 1 by 1 + until parent is equal to target. + stop run. +evolution-paragraph. + perform mutation-paragraph varying child from 1 by 1 + until child is greater than size-of-generation. + move zero to highest-fitness. + move 1 to fittest. + perform check-fitness-paragraph varying child from 1 by 1 + until child is greater than size-of-generation. + move offspring(fittest) to parent. + perform output-paragraph. +output-paragraph. + display generation ': ' parent. +random-letter-paragraph. + move function random to random-number. + divide random-number by 3.80769 giving random-letter. + add 1 to random-letter. + move character-set(random-letter:1) + to temporary-string(character-position:1). +mutation-paragraph. + move parent to temporary-string. + perform character-mutation-paragraph, + varying character-position from 1 by 1 + until character-position is greater than 28. + move temporary-string to offspring(child). +character-mutation-paragraph. + move function random to random-number. + if random-number is less than mutation-rate + then perform random-letter-paragraph. +check-fitness-paragraph. + move offspring(child) to temporary-string. + perform fitness-paragraph. +fitness-paragraph. + move zero to fitness. + perform character-fitness-paragraph, + varying character-position from 1 by 1 + until character-position is greater than 28. + if fitness is greater than highest-fitness + then perform fittest-paragraph. +character-fitness-paragraph. + if temporary-string(character-position:1) is equal to + target(character-position:1) then add 1 to fitness. +fittest-paragraph. + move fitness to highest-fitness. + move child to fittest. diff --git a/Task/Evolutionary-algorithm/Elena/evolutionary-algorithm.elena b/Task/Evolutionary-algorithm/Elena/evolutionary-algorithm.elena new file mode 100644 index 0000000000..f3160aafd3 --- /dev/null +++ b/Task/Evolutionary-algorithm/Elena/evolutionary-algorithm.elena @@ -0,0 +1,65 @@ +#import system. +#import system'routines. +#import extensions. + +#symbol Target = "METHINKS IT IS LIKE A WEASEL". +#symbol AllowedCharacters = " ABCDEFGHIJKLMNOPQRSTUVWXYZ". +#symbol C = 100. +#symbol P = 0.05r. +#symbol rnd = randomGenerator. + +#symbol randomChar + = AllowedCharacters @ (rnd nextInt:(AllowedCharacters length)). + +#class(extension) evoHelper +{ + #method randomString + = 0 repeat &till:self &each:x [ randomChar ] summarize:(String new) literal. + + #method fitness &of:s + = self zip:s &into:(:a:b)[ (a == b)iif:1:0 ] summarize:(Integer new) int. + + #method mutate : p + = self select &each: ch [ (rnd nextReal <= p) iif:randomChar:ch ] summarize:(String new) literal. +} + +#class EvoAlgorithm :: Enumerator +{ + #field theTarget. + #field theCurrent. + #field theVariantCount. + + #constructor new : s &of:count + [ + theTarget := s. + theVariantCount := count int. + ] + + #method get = theCurrent. + + #method next + [ + ($nil == theCurrent) + ? [ theCurrent := theTarget length randomString. ^ true. ]. + + (theTarget == theCurrent) + ? [ ^ false. ]. + + #var variants := Array new:theVariantCount set &every:(&index:x) [ theCurrent mutate:P ]. + + theCurrent := variants array sort:(:a:b) [ a fitness &of:Target > b fitness &of:Target ] getAt:0. + + ^ true. + ] +} + +#symbol program = +[ + #var attempt := Integer new. + EvoAlgorithm new:Target &of:C run &each:current + [ + console + writeLiteral:"#":(attempt += 1) &paddingLeft:10 + writeLine:" ":current:" fitness: ":(current fitness &of:Target). + ]. +]. diff --git a/Task/Evolutionary-algorithm/Elixir/evolutionary-algorithm.elixir b/Task/Evolutionary-algorithm/Elixir/evolutionary-algorithm.elixir new file mode 100644 index 0000000000..eb18c07e54 --- /dev/null +++ b/Task/Evolutionary-algorithm/Elixir/evolutionary-algorithm.elixir @@ -0,0 +1,63 @@ +defmodule Log do + def show(offspring,i) do + IO.puts "Generation: #{i}, Offspring: #{offspring}" + end + + def found({target,i}) do + IO.puts "#{target} found in #{i} iterations" + end +end + +defmodule Evolution do + # char list from A to Z; 32 is the ord value for space. + @chars [32 | Enum.to_list(?A..?Z)] + + def select(target) do + (1..String.length(target)) # Creates parent for generation 0. + |> Enum.map(fn _-> Enum.random(@chars) end) + |> mutate(to_char_list(target),0) + |> Log.found + end + + # w is used to denote fitness in population genetics. + + defp mutate(parent,target,i) when target == parent, do: {parent,i} + defp mutate(parent,target,i) do + w = fitness(parent,target) + prev = reproduce(target,parent,mu_rate(w)) + + # Check if the most fit member of the new gen has a greater fitness than the parent. + if w < fitness(prev,target) do + parent = prev + Log.show(parent,i) + end + mutate(parent,target,i+1) + end + + # Generate 100 offspring and select the one with the greatest fitness. + + defp reproduce(target,parent,rate) do + [parent | Enum.map(1..100, fn _-> mutation(parent,rate) end)] + |> Enum.max_by(fn n -> fitness(n,target) end) + end + + # Calculate fitness by checking difference between parent and offspring chars. + + defp fitness(t,r) do + Enum.zip(t,r) + |> Enum.reduce(0, fn {tn,rn},sum -> abs(tn - rn) + sum end) + |> calc + end + + # Generate offspring based on parent. + + defp mutation(p,r) do + # Copy the parent chars, then check each val against the random mutation rate + Enum.map(p, fn n -> if :rand.uniform <= r, do: Enum.random(@chars), else: n end) + end + + defp calc(sum), do: 100 * :math.exp(sum/-10) + defp mu_rate(n), do: 1 - :math.exp(-(100-n)/400) +end + +Evolution.select("METHINKS IT IS LIKE A WEASEL") diff --git a/Task/Evolutionary-algorithm/PARI-GP/evolutionary-algorithm.pari b/Task/Evolutionary-algorithm/PARI-GP/evolutionary-algorithm.pari new file mode 100644 index 0000000000..e33c81e794 --- /dev/null +++ b/Task/Evolutionary-algorithm/PARI-GP/evolutionary-algorithm.pari @@ -0,0 +1,46 @@ +target="METHINKS IT IS LIKE A WEASEL"; +fitness(s)=-dist(Vec(s),Vec(target)); +dist(u,v)=sum(i=1,min(#u,#v),u[i]!=v[i])+abs(#u-#v); +letter()=my(r=random(27)); if(r==26, " ", Strchr(r+65)); +insert(v,x=letter())= +{ + my(r=random(#v+1)); + if(r==0, return(concat([x],v))); + if(r==#v, return(concat(v,[x]))); + concat(concat(v[1..r],[x]),v[r+1..#v]); +} +delete(v)= +{ + if(#v<2, return([])); + my(r=random(#v)+1); + if(r==1, return(v[2..#v])); + if(r==#v, return(v[1..#v-1])); + concat(v[1..r-1],v[r+1..#v]); +} +mutate(s,rateM,rateI,rateD)= +{ + my(v=Vec(s)); + if(random(1.)best, best=t; parent=v[i]) + ); + ct++ + ); + print(parent" "fitness(parent)); + ct; +} +evolve(35,.05) diff --git a/Task/Evolutionary-algorithm/PureBasic/evolutionary-algorithm.purebasic b/Task/Evolutionary-algorithm/PureBasic/evolutionary-algorithm.purebasic index 05b2d6a589..2a7ba10c3f 100644 --- a/Task/Evolutionary-algorithm/PureBasic/evolutionary-algorithm.purebasic +++ b/Task/Evolutionary-algorithm/PureBasic/evolutionary-algorithm.purebasic @@ -1,69 +1,71 @@ -Define.i Pop = 100 ,Mrate = 6 -Define.s targetS = "METHINKS IT IS LIKE A WEASEL" -Define.s CsetS = "ABCDEFGHIJKLMNOPQRSTUVWXYZ " +Define population = 100, mutationRate = 6 +Define.s target$ = "METHINKS IT IS LIKE A WEASEL" +Define.s charSet$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ " -Procedure.i fitness (Array aspirant.c(1),Array target.c(1)) - Protected.i i ,len, fit +Procedure.i fitness(Array aspirant.c(1), Array target.c(1)) + Protected i, len, fit len = ArraySize(aspirant()) - For i=0 To len - If aspirant(i)=target(i): fit +1: EndIf + For i = 0 To len + If aspirant(i) = target(i): fit +1: EndIf Next ProcedureReturn fit EndProcedure -Procedure mutatae(Array parent.c(1),Array child.c(1),Array CsetA.c(1),rate.i) - Protected i.i ,L.i,maxC +Procedure mutatae(Array parent.c(1), Array child.c(1), Array charSetA.c(1), rate.i) + Protected i, L, maxC L = ArraySize(child()) - maxC = ArraySize(CsetA()) + maxC = ArraySize(charSetA()) For i = 0 To L If Random(100) < rate - child(i)= CsetA(Random(maxC)) + child(i) = charSetA(Random(maxC)) Else - child(i)=parent(i) + child(i) = parent(i) EndIf Next EndProcedure -Procedure.s Carray2String(Array A.c(1)) - Protected S.s ,len.i - len = ArraySize(A())+1 : S = LSet("",len," ") - CopyMemory(@A(0),@S, len *SizeOf(Character)) +Procedure.s cArray2string(Array A.c(1)) + Protected S.s, len + len = ArraySize(A())+1 : S = Space(len) + CopyMemory(@A(0), @S, len * SizeOf(Character)) ProcedureReturn S EndProcedure -Define.i Mrate , maxC ,Tlen ,i ,maxfit ,gen ,fit,bestfit -Dim targetA.c(Len(targetS)-1) - CopyMemory(@targetS, @targetA(0), StringByteLength(targetS)) +Define mutationRate, maxChar, target_len, i, maxfit, gen, fit, bestfit +Dim targetA.c(Len(target$) - 1) +CopyMemory(@target$, @targetA(0), StringByteLength(target$)) -Dim CsetA.c(Len(CsetS)-1) - CopyMemory(@CsetS, @CsetA(0), StringByteLength(CsetS)) +Dim charSetA.c(Len(charSet$) - 1) +CopyMemory(@charSet$, @charSetA(0), StringByteLength(charSet$)) -maxC = Len(CsetS)-1 -maxfit = Len(targetS) -Tlen = Len(targetS)-1 -Dim parent.c(Tlen) -Dim child.c(Tlen) -Dim Bestchild.c(Tlen) +maxChar = Len(charSet$) - 1 +maxfit = Len(target$) +target_len = Len(target$) - 1 +Dim parent.c(target_len) +Dim child.c(target_len) +Dim Bestchild.c(target_len) -For i = 0 To Tlen - parent(i)= CsetA(Random(maxC)) + +For i = 0 To target_len + parent(i) = charSetA(Random(maxChar)) Next -fit = fitness (parent(),targetA()) +fit = fitness (parent(), targetA()) OpenConsole() -PrintN(Str(gen)+": "+Carray2String(parent())+" Fitness= "+Str(fit)+"/"+Str(maxfit)) +PrintN(Str(gen) + ": " + cArray2string(parent()) + ": Fitness= " + Str(fit) + "/" + Str(maxfit)) While bestfit <> maxfit - gen +1 : - For i = 1 To Pop - mutatae(parent(),child(),CsetA(),Mrate) - fit = fitness (child(),targetA()) + gen + 1 + For i = 1 To population + mutatae(parent(),child(),charSetA(), mutationRate) + fit = fitness (child(), targetA()) If fit > bestfit - bestfit = fit : Swap Bestchild() , child() + bestfit = fit: CopyArray(child(), Bestchild()) EndIf Next - Swap parent() , Bestchild() - PrintN(Str(gen)+": "+Carray2String(parent())+" Fitness= "+Str(bestfit)+"/"+Str(maxfit)) + CopyArray(Bestchild(), parent()) + PrintN(Str(gen) + ": " + cArray2string(parent()) + ": Fitness= " + Str(bestfit) + "/" + Str(maxfit)) Wend + PrintN("Press any key to exit"): Repeat: Until Inkey() <> "" diff --git a/Task/Evolutionary-algorithm/REXX/evolutionary-algorithm-1.rexx b/Task/Evolutionary-algorithm/REXX/evolutionary-algorithm-1.rexx index d5d3e7a1d7..bdf6762c2f 100644 --- a/Task/Evolutionary-algorithm/REXX/evolutionary-algorithm-1.rexx +++ b/Task/Evolutionary-algorithm/REXX/evolutionary-algorithm-1.rexx @@ -1,34 +1,33 @@ -/*REXX program demonstrates an evolutionary algorithm (by using mutation). */ -parse arg children MR seed . /*get optional arguments from the C.L. */ -if children=='' then children = 10 /*# children produced each generation. */ -if MR =='' then MR = '4%' /*the character Mutation Rate each gen.*/ -if right(MR,1)=='%' then MR=strip(MR,,'%')/100 /*expressed as %? Then adjust*/ -if seed\=='' then call random ,,seed /*SEED allow the runs to be repeatable.*/ +/*REXX program demonstrates an evolutionary algorithm (by using mutation). */ +parse arg children MR seed . /*get optional arguments from the C.L. */ +if children=='' then children = 10 /*# children produced each generation. */ +if MR =='' then MR = "4%" /*the character Mutation Rate each gen.*/ +if right(MR,1)=='%' then MR=strip(MR,,"%")/100 /*expressed as a percent? Then adjust.*/ +if seed\=='' then call random ,,seed /*SEED allow the runs to be repeatable.*/ abc = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ ' ; Labc=length(abc) target= 'METHINKS IT IS LIKE A WEASEL' ; Ltar=length(target) -parent= mutate( left('',Ltar), 1) /*gen rand string,same length as target*/ -say center('target string',Ltar,'─') "children" 'mutationRate' -say target center(children,8) center((MR*100/1)'%',12); say -say center('new string',Ltar,'─') "closeness" 'generation' +parent= mutate( left('',Ltar), 1) /*gen rand string,same length as target*/ +say center('target string', Ltar, "─") 'children' "mutationRate" +say target center(children,8) center((MR*100/1)'%', 12); say +say center('new string' ,Ltar, "─") "closeness" 'generation' - do gen=0 until parent==target; close=fitness(parent) + do gen=0 until parent==target; close=fitness(parent) almost=parent - do children; child=mutate(parent,MR) - _=fitness(child); if _<=close then iterate - close=_; almost=child - say almost right(close,9) right(gen,10) - end /*children*/ + do children; child=mutate(parent,MR) + _=fitness(child); if _<=close then iterate + close=_; almost=child + say almost right(close, 9) right(gen,10) + end /*children*/ parent=almost end /*gen*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -fitness: parse arg x; $=0 - do k=1 for Ltar; $=$+(substr(x,k,1)==substr(target,k,1)); end /*k*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +fitness: parse arg x; $=0; do k=1 for Ltar; $=$+(substr(x,k,1)==substr(target,k,1)); end return $ -/*────────────────────────────────────────────────────────────────────────────*/ -mutate: parse arg x,rate $ /*set X to 1st argument, RATE to 2nd.*/ - $=; do j=1 for Ltar; r=random(1,100000) /*REXX's max.*/ - if .00001*r<=rate then $=$ || substr(abc,r//Labc+1,1) - else $=$ || substr(x,j,1) +/*──────────────────────────────────────────────────────────────────────────────────────*/ +mutate: parse arg x,rate; $= /*set X to 1st argument, RATE to 2nd.*/ + do j=1 for Ltar; r=random(1,100000) /*REXX's max for RANSOM*/ + if .00001*r<=rate then $=$ || substr(abc,r//Labc+1, 1) + else $=$ || substr(x ,j , 1) end /*j*/ return $ diff --git a/Task/Evolutionary-algorithm/REXX/evolutionary-algorithm-2.rexx b/Task/Evolutionary-algorithm/REXX/evolutionary-algorithm-2.rexx index 5a3280db32..57caf4941b 100644 --- a/Task/Evolutionary-algorithm/REXX/evolutionary-algorithm-2.rexx +++ b/Task/Evolutionary-algorithm/REXX/evolutionary-algorithm-2.rexx @@ -1,43 +1,42 @@ -/*REXX program demonstrates an evolutionary algorithm (by using mutation). */ -parse arg children MR seed . /*get optional arguments from the C.L. */ -if children=='' then children = 10 /*# children produced each generation. */ -if MR =='' then MR = '4%' /*the character Mutation Rate each gen.*/ -if right(MR,1)=='%' then MR=strip(MR,,'%')/100 /*expressed as %? Then adjust*/ -if seed\=='' then call random ,,seed /*SEED allow the runs to be repeatable.*/ +/*REXX program demonstrates an evolutionary algorithm (by using mutation). */ +parse arg children MR seed . /*get optional arguments from the C.L. */ +if children=='' then children = 10 /*# children produced each generation. */ +if MR =='' then MR = "4%" /*the character Mutation Rate each gen.*/ +if right(MR,1)=='%' then MR=strip(MR,,"%")/100 /*expressed as a percent? Then adjust.*/ +if seed\=='' then call random ,,seed /*SEED allow the runs to be repeatable.*/ abc = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ '; Labc=length(abc) - do i=0 for Labc /*define array (for faster compare), */ - @.i=substr(abc,i+1,1) /* it's better than picking out a */ - end /*i*/ /* byte from a character string. */ + do i=0 for Labc /*define array (for faster compare), */ + @.i=substr(abc, i+1, 1) /* it's better than picking out a */ + end /*i*/ /* byte from a character string. */ target= 'METHINKS IT IS LIKE A WEASEL' ; Ltar=length(target) - do i=1 for Ltar /*define an array (for faster compare),*/ - T.i=substr(target,i,1) /* it's better than a byte-by-byte */ - end /*i*/ /* compare using character strings.*/ + do i=1 for Ltar /*define an array (for faster compare),*/ + T.i=substr(target, i, 1) /* it's better than a byte-by-byte */ + end /*i*/ /* compare using character strings.*/ -parent= mutate( left('',Ltar), 1) /*gen rand string, same length as tar. */ -say center('target string',Ltar,'─') "children" 'mutationRate' -say target center(children,8) center((MR*100/1)'%',12); say -say center('new string',Ltar,'─') "closeness" 'generation' +parent= mutate( left('', Ltar), 1) /*gen rand string, same length as tar. */ +say center('target string', Ltar, "─") 'children' "mutationRate" +say target center(children, 8) center((MR*100/1)'%',12); say +say center('new string' , Ltar, "─") 'closeness' "generation" - do gen=0 until parent==target; close=fitness(parent) + do gen=0 until parent==target; close=fitness(parent) almost=parent - do children; child=mutate(parent,MR) - _=fitness(child); if _<=close then iterate - close=_; almost=child - say almost right(close,9) right(gen,10) + do children; child=mutate(parent,MR) + _=fitness(child); if _<=close then iterate + close=_; almost=child + say almost right(close, 9) right(gen, 10) end /*children*/ parent=almost end /*gen*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -fitness: parse arg x; $=0; do k=1 for Ltar; $=$+(substr(x,k,1)==T.k); end - return $ -/*────────────────────────────────────────────────────────────────────────────*/ -mutate: parse arg x,rate /*set X to 1st argument, RATE to 2nd.*/ - $=; do j=1 for Ltar; r=random(1,100000) /*REXX's max.*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +fitness: parse arg x; $=0; do k=1 for Ltar; $=$+(substr(x,k,1)==T.k); end; return $ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +mutate: parse arg x,rate /*set X to 1st argument, RATE to 2nd.*/ + $=; do j=1 for Ltar; r=random(1, 100000) /*REXX's max for RANDOM*/ if .00001*r<=rate then do; _=r//Labc; $=$ || @._; end - else $=$ || substr(x,j,1) + else $=$ || substr(x, j, 1) end /*j*/ return $ diff --git a/Task/Exceptions-Catch-an-exception-thrown-in-a-nested-call/00DESCRIPTION b/Task/Exceptions-Catch-an-exception-thrown-in-a-nested-call/00DESCRIPTION index 8aaed74d82..17a61bb208 100644 --- a/Task/Exceptions-Catch-an-exception-thrown-in-a-nested-call/00DESCRIPTION +++ b/Task/Exceptions-Catch-an-exception-thrown-in-a-nested-call/00DESCRIPTION @@ -4,13 +4,14 @@ {{omit from|Retro}} {{omit from|Swift}} -Show how to create a user-defined exception and -show how to catch an exception raised from several nested calls away. +Show how to create a user-defined exception   and   show how to catch an exception raised from several nested calls away. -# Create two user-defined exceptions, U0 and U1. -# Have function foo call function bar twice. -# Have function bar call function baz. -# Arrange for function baz to raise, or throw exception U0 on its first call, then exception U1 on its second. -# Function foo should catch only exception U0, not U1. +:#   Create two user-defined exceptions,   '''U0'''   and   '''U1'''. +:#   Have function   '''foo'''   call function   '''bar'''   twice. +:#   Have function   '''bar'''   call function   '''baz'''. +:#   Arrange for function   '''baz'''   to raise, or throw exception   '''U0'''   on its first call, then exception   '''U1'''   on its second. +:#   Function   '''foo'''   should catch only exception   '''U0''',   not   '''U1'''. +
    Show/describe what happens when the program is run. +

    diff --git a/Task/Exceptions-Catch-an-exception-thrown-in-a-nested-call/Io/exceptions-catch-an-exception-thrown-in-a-nested-call.io b/Task/Exceptions-Catch-an-exception-thrown-in-a-nested-call/Io/exceptions-catch-an-exception-thrown-in-a-nested-call.io new file mode 100644 index 0000000000..c61a25518e --- /dev/null +++ b/Task/Exceptions-Catch-an-exception-thrown-in-a-nested-call/Io/exceptions-catch-an-exception-thrown-in-a-nested-call.io @@ -0,0 +1,20 @@ +U0 := Exception clone +U1 := Exception clone + +foo := method( + for(i,1,2, + try( + bar(i) + )catch( U0, + "foo caught U0" print + )pass + ) +) +bar := method(n, + baz(n) +) +baz := method(n, + if(n == 1,U0,U1) raise("baz with n = #{n}" interpolate) +) + +foo diff --git a/Task/Exceptions-Catch-an-exception-thrown-in-a-nested-call/PARI-GP/exceptions-catch-an-exception-thrown-in-a-nested-call.pari b/Task/Exceptions-Catch-an-exception-thrown-in-a-nested-call/PARI-GP/exceptions-catch-an-exception-thrown-in-a-nested-call.pari new file mode 100644 index 0000000000..11ac0d2989 --- /dev/null +++ b/Task/Exceptions-Catch-an-exception-thrown-in-a-nested-call/PARI-GP/exceptions-catch-an-exception-thrown-in-a-nested-call.pari @@ -0,0 +1,7 @@ +call = 0; + +U0() = error("x = ", 1, " should not happen!"); +U1() = error("x = ", 2, " should not happen!"); +baz(x) = if(x==1, U0(), x==2, U1());x; +bar() = baz(call++); +foo() = if(!call, iferr(bar(), E, printf("Caught exception, call=%d",call)), bar()) diff --git a/Task/Exceptions-Catch-an-exception-thrown-in-a-nested-call/REXX/exceptions-catch-an-exception-thrown-in-a-nested-call.rexx b/Task/Exceptions-Catch-an-exception-thrown-in-a-nested-call/REXX/exceptions-catch-an-exception-thrown-in-a-nested-call.rexx index 7b7d9da2db..1288edb26f 100644 --- a/Task/Exceptions-Catch-an-exception-thrown-in-a-nested-call/REXX/exceptions-catch-an-exception-thrown-in-a-nested-call.rexx +++ b/Task/Exceptions-Catch-an-exception-thrown-in-a-nested-call/REXX/exceptions-catch-an-exception-thrown-in-a-nested-call.rexx @@ -1,21 +1,22 @@ -/*REXX program to create two exceptions & demonstrate how to handle them*/ -call foo /*invoke the FOO function. */ -say 'mainline program is done.' /*indicate that Elroy was here. */ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────FOO function────────────────────────*/ -foo: call bar; call bar /*invoke BAR function twice. */ - return 0 /*return a zero to invoker. */ -U0: say 'exception U0 caught in FOO' /*handle the U0 exception. */ -return -2 /*return to the invoker. */ -/*──────────────────────────────────BAR function────────────────────────*/ -bar: call baz /*have BAR invoke BAZ function. */ - return 0 /*return a zero to invoker. */ -/*──────────────────────────────────BAZ function────────────────────────*/ -baz: if symbol('BAZ#')=='LIT' then baz#=0 /*initialize BAZ invocation#*/ - baz# = baz#+1 /*bump the BAZ invocation # by 1.*/ - if baz#==1 then signal U0 /*if first invocation, raise U0 */ - if baz#==2 then signal U1 /* " second " " U1 */ - return 0 /*return a 0 (zero) to invoker.*/ - /* [↓] this U0 sub is ignored.*/ -U0: return -1 /*handle exception if not caught.*/ -U1: return -1 /* " " " " " */ +/*REXX program creates two exceptions and demonstrates how to handle (catch) them. */ +call foo /*invoke the FOO function (below). */ +say 'The REXX mainline program has completed.' /*indicate that Elroy was here. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +foo: call bar; call bar /*invoke BAR function twice. */ + return 0 /*return a zero to the invoker. */ + /*the 1st U0 in REXX program is used.*/ +U0: say 'exception U0 caught in FOO' /*handle the U0 exception. */ + return -2 /*return to the invoker. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +bar: call baz /*have BAR function invoke BAZ function*/ + return 0 /*return a zero to the invoker. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +baz: if symbol('BAZ#')=='LIT' then baz#=0 /*initialize the first BAZ invocation #*/ + baz# = baz#+1 /*bump the BAZ invocation number by 1. */ + if baz#==1 then signal U0 /*if first invocation, then raise U0 */ + if baz#==2 then signal U1 /* " second " " " U1 */ + return 0 /*return a 0 (zero) to the invoker.*/ + /* [↓] this U0 subroutine is ignored.*/ +U0: return -1 /*handle exception if not caught. */ +U1: return -1 /* " " " " " */ diff --git a/Task/Exceptions-Catch-an-exception-thrown-in-a-nested-call/TXR/exceptions-catch-an-exception-thrown-in-a-nested-call.txr b/Task/Exceptions-Catch-an-exception-thrown-in-a-nested-call/TXR/exceptions-catch-an-exception-thrown-in-a-nested-call.txr index 8abc807ef2..6bdd78942a 100644 --- a/Task/Exceptions-Catch-an-exception-thrown-in-a-nested-call/TXR/exceptions-catch-an-exception-thrown-in-a-nested-call.txr +++ b/Task/Exceptions-Catch-an-exception-thrown-in-a-nested-call/TXR/exceptions-catch-an-exception-thrown-in-a-nested-call.txr @@ -13,7 +13,7 @@ @ (baz x) @(end) @(define foo ()) -@ (next `!echo "0\n1\n"`) +@ (next :list @'("0" "1")) @ (collect) @num @ (try) diff --git a/Task/Executable-library/Io/executable-library-1.io b/Task/Executable-library/Io/executable-library-1.io new file mode 100644 index 0000000000..0bd1686d0e --- /dev/null +++ b/Task/Executable-library/Io/executable-library-1.io @@ -0,0 +1,30 @@ +HailStone := Object clone +HailStone sequence := method(n, + if(n < 1, Exception raise("hailstone: expect n >= 1 not #{n}" interpolate)) + n = n floor // make sure integer value + stones := list(n) + while (n != 1, + n = if(n isEven, n/2, 3*n + 1) + stones append(n) + ) + stones +) + +if( isLaunchScript, + out := HailStone sequence(27) + writeln("hailstone(27) has length ",out size,": ", + out slice(0,4) join(" ")," ... ",out slice(-4) join(" ")) + + maxSize := 0 + maxN := 0 + for(n, 1, 100000-1, + out = HailStone sequence(n) + if(out size > maxSize, + maxSize = out size + maxN = n + ) + ) + + writeln("For numbers < 100,000, ", maxN, + " has the longest sequence of ", maxSize, " elements.") +) diff --git a/Task/Executable-library/Io/executable-library-2.io b/Task/Executable-library/Io/executable-library-2.io new file mode 100644 index 0000000000..26f11975e6 --- /dev/null +++ b/Task/Executable-library/Io/executable-library-2.io @@ -0,0 +1,20 @@ +counts := Map clone +for(n, 1, 100000-1, + out := HailStone sequence(n) + key := out size asCharacter + counts atPut(key, counts atIfAbsentPut(key, 0) + 1) +) + +maxCount := counts values max +lengths := list() +counts foreach(k,v, + if(v == maxCount, lengths append(k at(0))) +) + +if(lengths size == 1, + writeln("The most frequent sequence length for n < 100,000 is ",lengths at(0), + " occurring ",maxCount," times.") +, + writeln("The most frequent sequence lengths for n < 100,000 are:\n", + lengths join(",")," occurring ",maxCount," times each.") +) diff --git a/Task/Executable-library/PARI-GP/executable-library-1.pari b/Task/Executable-library/PARI-GP/executable-library-1.pari new file mode 100644 index 0000000000..e22c98400d --- /dev/null +++ b/Task/Executable-library/PARI-GP/executable-library-1.pari @@ -0,0 +1,44 @@ +#include + +#define HAILSTONE1 "n=1;print1(%d,\": \");apply(x->while(x!=1,if(x/2==x\\2,x/=2,x=x*3+1);n++;print1(x,\", \")),%d);print(\"(\",n,\")\n\")" +#define HAILSTONE2 "m=n=0;for(i=2,%d,h=1;apply(x->while(x!=1,if(x/2==x\\2,x/=2,x=x*3+1);h++),i);if(m +{{implementation|Brainf***}} +RCBF is a set of [[Brainf***]] compilers and interpreters written for Rosetta Code in a variety of languages. + Below are links to each of the versions of RCBF. An implementation need only properly implement the following instructions: @@ -22,5 +24,5 @@ An implementation need only properly implement the following instructions: |- | style="text-align:center"| ] || Jump back to the matching [ if the cell under the pointer is nonzero |} -Any cell size is allowed, EOF support is optional, as is whether you have bounded or unbounded memory. -
    +Any cell size is allowed,   EOF   (End-O-File)   support is optional, as is whether you have bounded or unbounded memory. +

    diff --git a/Task/Execute-Brain----/Fortran/execute-brain-----1.f b/Task/Execute-Brain----/Fortran/execute-brain-----1.f new file mode 100644 index 0000000000..70a29f07bc --- /dev/null +++ b/Task/Execute-Brain----/Fortran/execute-brain-----1.f @@ -0,0 +1,76 @@ + MODULE BRAIN !It will suffer. + INTEGER MSG,KBD + CONTAINS !A twisted interpreter. + SUBROUTINE RUN(PROG,STORE) !Code and data are separate! + CHARACTER*(*) PROG !So, this is the code. + CHARACTER*(1) STORE(:) !And this a work area. + CHARACTER*1 C !The code of the moment. + INTEGER I,D !Fingers to an instruction, and to data. + D = 1 !First element of the store. + I = 1 !First element of the prog. + + DO WHILE(I.LE.LEN(PROG)) !Off the end yet? + C = PROG(I:I) !Load the opcode fingered by I. + I = I + 1 !Advance one. The classic. + SELECT CASE(C) !Now decode the instruction. + CASE(">") !Move the data finger one place right. + D = D + 1 + CASE("<") !Move the data finger one place left. + D = D - 1 + CASE("+") !Add one to the fingered datum. + STORE(D) = CHAR(ICHAR(STORE(D)) + 1) + CASE("-") !Subtract one. + STORE(D) = CHAR(ICHAR(STORE(D)) - 1) + CASE(".") !Write a character. + WRITE (MSG,1) STORE(D) + CASE(",") !Read a character. + READ (KBD,1) STORE(D) + CASE("[") !Conditionally, surge forward. + IF (ICHAR(STORE(D)).EQ.0) CALL SEEK(+1) + CASE("]") !Conditionally, retreat. + IF (ICHAR(STORE(D)).NE.0) CALL SEEK(-1) + CASE DEFAULT !For all others, + !Do nothing. + END SELECT !That was simple. + END DO !See what comes next. + + 1 FORMAT (A1,$) !One character, no advance to the next line. + CONTAINS !Now for an assistant. + SUBROUTINE SEEK(WAY) !Look for the BA that matches the AB. + INTEGER WAY !Which direction: ±1. + CHARACTER*1 AB,BA !The dancers. + INTEGER INDEEP !Nested brackets are allowed. + INDEEP = 0 !None have been counted. + I = I - 1 !Back to where C came from PROG. + AB = PROG(I:I) !The starter. + BA = "[ ]"(WAY + 2:WAY + 2) !The stopper. + 1 IF (I.GT.LEN(PROG)) STOP "Out of code!" !Perhaps not! + IF (PROG(I:I).EQ.AB) THEN !A starter? (Even if backwards) + INDEEP = INDEEP + 1 !Yep. + ELSE IF (PROG(I:I).EQ.BA) THEN !A stopper? + INDEEP = INDEEP - 1 !Yep. + END IF !A case statement requires constants. + IF (INDEEP.GT.0) THEN !Are we out of it yet? + I = I + WAY !No. Move. + IF (I.GT.0) GO TO 1 !And try again. + STOP "Back to 0!" !Perhaps not. + END IF !But if we are out of the nest, + I = I + 1 !Advance to the following instruction, either WAY. + END SUBROUTINE SEEK !Seek, and one shall surely find. + END SUBROUTINE RUN !So much for that. + END MODULE BRAIN !Simple in itself. + + PROGRAM POKE !A tester. + USE BRAIN !In a rather bad way. + CHARACTER*1 STORE(30000) !Probably rather more than is needed. + CHARACTER*(*) HELLOWORLD !Believe it or not... + PARAMETER (HELLOWORLD = "++++++++[>++++[>++>+++>+++>+<<<<-]" + 1 //" >+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------" + 2 //".--------.>>+.>++.") + KBD = 5 !Standard input. + MSG = 6 !Standard output. + STORE = CHAR(0) !Scrub. + + CALL RUN(HELLOWORLD,STORE) !Have a go. + + END !Enough. diff --git a/Task/Execute-Brain----/Fortran/execute-brain-----2.f b/Task/Execute-Brain----/Fortran/execute-brain-----2.f new file mode 100644 index 0000000000..aff35b0fb3 --- /dev/null +++ b/Task/Execute-Brain----/Fortran/execute-brain-----2.f @@ -0,0 +1,103 @@ + SUBROUTINE BRAINFORT(PROG,N,INF,OUF,F) !Stand strong! +Converts the Brain*uck in PROG into the equivalent furrytran source... + CHARACTER*(*) PROG !The Brain*uck source. + INTEGER N !A size for the STORE. + INTEGER INF,OUF,F !I/O unit numbers. + INTEGER L !A stepper. + INTEGER LABEL,NLABEL,INDEEP,STACK(66) !Labels cause difficulty. + CHARACTER*1 C !The operation of the moment. + CHARACTER*36 SOURCE !A scratchpad. + WRITE (F,1) PROG,N !The programme heading. + 1 FORMAT (6X,"PROGRAM BRAINFORT",/, !Name it. + 1 "Code: ",A,/ !Show the provenance. + 2 6X,"CHARACTER*1 STORE(",I0,")",/ !Declare the working memory. + 3 6X,"INTEGER D",/ !The finger to the cell of the moment. + 4 6X,"STORE = CHAR(0)",/ !Clear to nulls, not spaces. + 5 6X,"D = 1",/) !Start the data finger at the first cell. + NLABEL = 0 !No labels seen. + INDEEP = 0 !So, the stack is empty. + LABEL = 0 !And the current label is absent. + L = 1 !Start at the start. +Chug through the PROG. + DO WHILE(L.LE.LEN(PROG)) !And step through to the end. + C = PROG(L:L) !The code of the moment. + SELECT CASE(C) !What to do? + CASE(">") !Move the data finger forwards one. + WRITE (SOURCE,2) "D = D + ",RATTLE(">") !But, catch multiple steps. + CASE("<") !Move the data finger back one. + WRITE (SOURCE,2) "D = D - ",RATTLE("<") !Rather than a sequence of one steps. + CASE("+") !Increment the fingered datum by one. + WRITE (SOURCE,2) "STORE(D) = CHAR(ICHAR(STORE(D)) + ", !Catching multiple increments. + 1 RATTLE("+"),")" !And being careful over the placement of brackets. + CASE("-") !Decrement the fingered datum by one. + WRITE (SOURCE,2) "STORE(D) = CHAR(ICHAR(STORE(D)) - ", !Catching multiple decrements. + 1 RATTLE("-"),")" !And closing brackets. + CASE(".") !Write a character. + WRITE (SOURCE,2) "WRITE (",OUF,",'(A1,$)') STORE(D)" !Using the given output unit. + CASE(",") !Read a charactger. + WRITE (SOURCE,2) "READ (",INF,",'(A1)') STORE(D)" !And the input unit. + CASE("[") !A label! + NLABEL = NLABEL + 1 !Labels come in pairs due to [...] + LABEL = 2*NLABEL - 1 !So this belongs to the [. + INDEEP = INDEEP + 1 !I need to remember when later the ] is encountered. + STACK(INDEEP) = LABEL + 1 !This will be the other label. + WRITE (SOURCE,2) "IF (ICHAR(STORE(D)).EQ.0) GO TO ", !So, go thee, therefore. + 1 STACK(INDEEP) !Its placement will come, all going well. + CASE("]") !The end of a [...] pair. + LABEL = STACK(INDEEP) !This was the value of the label to be, now to be placed. + WRITE (SOURCE,2) "IF (ICHAR(STORE(D)).NE.0) GO TO ", !The conditional part + 1 LABEL - 1 !The branch back destination is known by construction. + INDEEP = INDEEP - 1 !And we're out of the [...] sequence's consequences. + CASE DEFAULT !All others are ignored. + SOURCE = "CONTINUE" !So, just carry on. + END SELECT !Enough of all that. + 2 FORMAT (A,I0,A) !Text, an integer, text. +Cast forth the statement. + IF (LABEL.LE.0) THEN !Is a label waiting? + WRITE (F,3) SOURCE !No. Just roll the source. + 3 FORMAT (<6 + 2*MIN(12,INDEEP)>X,A)!With indentation. + ELSE !But if there is a label, + WRITE (F,4) LABEL,SOURCE !Slightly more complicated. + 4 FORMAT (I5,<1 + 2*MIN(12,INDEEP)>X,A) !I align my labels rightwards... + LABEL = 0 !It is used. + END IF !So much for that statement. + L = L + 1 !Advance to the next command. + END DO !And perhaps we're finished. + +Closedown. + WRITE (F,100) !No more source. + 100 FORMAT (6X,"END") !So, this is the end. + CONTAINS !A function with odd effects. + INTEGER FUNCTION RATTLE(C) !Advances thrugh multiple C, counting them. + CHARACTER*1 C !The symbol. + RATTLE = 1 !We have one to start with. + 1 IF (L.LT.LEN(PROG)) THEN !Further text to look at? + IF (PROG(L + 1:L + 1).EQ.C) THEN !Yes. The same again? + L = L + 1 !Yes. Advance the finger to it. + RATTLE = RATTLE + 1 !Count another. + GO TO 1 !And try again. + END IF !Rather than just one at a time. + END IF !Curse the double evaluation of WHILE(L < LEN(PROG) & ...) + END FUNCTION RATTLE !Computers excel at counting. + END SUBROUTINE BRAINFORT!They only need be direction as to what to count... + END MODULE BRAIN !Simple in itself. + + PROGRAM POKE !A tester. + USE BRAIN !In a rather bad way. + CHARACTER*1 STORE(30000) !Probably rather more than is needed. + CHARACTER*(*) HELLOWORLD !Believe it or not... + PARAMETER (HELLOWORLD = "++++++++[>++++[>++>+++>+++>+<<<<-]" + 1 //" >+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------" + 2 //".--------.>>+.>++.") + INTEGER F + KBD = 5 !Standard input. + MSG = 6 !Standard output. + F = 10 + + STORE = CHAR(0) !Scrub. + +c CALL RUN(HELLOWORLD,STORE) !Have a go. + + OPEN (F,FILE="BrainFort.for",STATUS="REPLACE",ACTION="WRITE") + CALL BRAINFORT(HELLOWORLD,30000,KBD,MSG,F) + END !Enough. diff --git a/Task/Execute-Brain----/Fortran/execute-brain-----3.f b/Task/Execute-Brain----/Fortran/execute-brain-----3.f new file mode 100644 index 0000000000..f6823bb4a8 --- /dev/null +++ b/Task/Execute-Brain----/Fortran/execute-brain-----3.f @@ -0,0 +1,68 @@ + PROGRAM BRAINFORT +Code: ++++++++[>++++[>++>+++>+++>+<<<<-] >+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++. + CHARACTER*1 STORE(30000) + INTEGER D + STORE = CHAR(0) + D = 1 + + STORE(D) = CHAR(ICHAR(STORE(D)) + 8) + 1 IF (ICHAR(STORE(D)).EQ.0) GO TO 2 + D = D + 1 + STORE(D) = CHAR(ICHAR(STORE(D)) + 4) + 3 IF (ICHAR(STORE(D)).EQ.0) GO TO 4 + D = D + 1 + STORE(D) = CHAR(ICHAR(STORE(D)) + 2) + D = D + 1 + STORE(D) = CHAR(ICHAR(STORE(D)) + 3) + D = D + 1 + STORE(D) = CHAR(ICHAR(STORE(D)) + 3) + D = D + 1 + STORE(D) = CHAR(ICHAR(STORE(D)) + 1) + D = D - 4 + STORE(D) = CHAR(ICHAR(STORE(D)) - 1) + 4 IF (ICHAR(STORE(D)).NE.0) GO TO 3 + CONTINUE + D = D + 1 + STORE(D) = CHAR(ICHAR(STORE(D)) + 1) + D = D + 1 + STORE(D) = CHAR(ICHAR(STORE(D)) + 1) + D = D + 1 + STORE(D) = CHAR(ICHAR(STORE(D)) - 1) + D = D + 2 + STORE(D) = CHAR(ICHAR(STORE(D)) + 1) + 5 IF (ICHAR(STORE(D)).EQ.0) GO TO 6 + D = D - 1 + 6 IF (ICHAR(STORE(D)).NE.0) GO TO 5 + D = D - 1 + STORE(D) = CHAR(ICHAR(STORE(D)) - 1) + 2 IF (ICHAR(STORE(D)).NE.0) GO TO 1 + D = D + 2 + WRITE (6,'(A1,$)') STORE(D) + D = D + 1 + STORE(D) = CHAR(ICHAR(STORE(D)) - 3) + WRITE (6,'(A1,$)') STORE(D) + STORE(D) = CHAR(ICHAR(STORE(D)) + 7) + WRITE (6,'(A1,$)') STORE(D) + WRITE (6,'(A1,$)') STORE(D) + STORE(D) = CHAR(ICHAR(STORE(D)) + 3) + WRITE (6,'(A1,$)') STORE(D) + D = D + 2 + WRITE (6,'(A1,$)') STORE(D) + D = D - 1 + STORE(D) = CHAR(ICHAR(STORE(D)) - 1) + WRITE (6,'(A1,$)') STORE(D) + D = D - 1 + WRITE (6,'(A1,$)') STORE(D) + STORE(D) = CHAR(ICHAR(STORE(D)) + 3) + WRITE (6,'(A1,$)') STORE(D) + STORE(D) = CHAR(ICHAR(STORE(D)) - 6) + WRITE (6,'(A1,$)') STORE(D) + STORE(D) = CHAR(ICHAR(STORE(D)) - 8) + WRITE (6,'(A1,$)') STORE(D) + D = D + 2 + STORE(D) = CHAR(ICHAR(STORE(D)) + 1) + WRITE (6,'(A1,$)') STORE(D) + D = D + 1 + STORE(D) = CHAR(ICHAR(STORE(D)) + 2) + WRITE (6,'(A1,$)') STORE(D) + END diff --git a/Task/Execute-Brain----/Fortran/execute-brain-----4.f b/Task/Execute-Brain----/Fortran/execute-brain-----4.f new file mode 100644 index 0000000000..bb4544fd55 --- /dev/null +++ b/Task/Execute-Brain----/Fortran/execute-brain-----4.f @@ -0,0 +1,2 @@ + 4 IF (ICHAR(STORE(D)).NE.0) GO TO 3 + IF (ICHAR(STORE(D)).NE.0) GO TO 3 diff --git a/Task/Execute-Brain----/REXX/execute-brain----.rexx b/Task/Execute-Brain----/REXX/execute-brain----.rexx index 430291cc36..6c3bf3459f 100644 --- a/Task/Execute-Brain----/REXX/execute-brain----.rexx +++ b/Task/Execute-Brain----/REXX/execute-brain----.rexx @@ -1,52 +1,55 @@ -/*REXX program to implement the Brainf*ck (self-censored) language. */ -#.=0 /*initialize the infinite "tape".*/ -p=0 /*the "tape" cell pointer. */ -!=0 /* ! is the instruction pointer.*/ -parse arg $ /*allow CBLF to specify a BF pgm.*/ - /* │ No pgm? Then use default.*/ -if $='' then $=, /* ↓ displays: Hello, World! */ - "++++++++++ initialize cell #0 to 10; then loop: ", - "[ > +++++++ add 7 to cell #1; final result: 70 ", - " > ++++++++++ add 10 to cell #2; final result: 100 ", - " > +++ add 3 to cell #3; final result 30 ", - " > + add 1 to cell #4; final result 10 ", - " <<<< - ] decrement cell #0 ", - "> ++ . display 'H' which is ASCII 72 (decimal) ", - "> + . display 'e' which is ASCII 101 (decimal) ", - "+++++++ .. display 'll' which is ASCII 108 (decimal) {2}", - "+++ . display 'o' which is ASCII 111 (decimal) ", - "> ++ . display ' ' which is ASCII 32 (decimal) ", - "<< +++++++++++++++ . display 'W' which is ASCII 87 (decimal) ", - "> . display 'o' which is ASCII 111 (decimal) ", - "+++ . display 'r' which is ASCII 114 (decimal) ", - "------ . display 'l' which is ASCII 108 (decimal) ", - "-------- . display 'd' which is ASCII 100 (decimal) ", - "> + . display '!' which is ASCII 33 (decimal) " - /*(above) note Brainf*ck comments*/ - do forever; !=!+1; if !==0 | !>length($) then leave; x=substr($,!,1) - select /*examine the current instruction*/ - when x=='+' then #.p=#.p + 1 /*increment the "tape" cell by 1.*/ - when x=='-' then #.p=#.p - 1 /*decrement the "tape" cell by 1.*/ - when x=='>' then p=p + 1 /*increment the pointer by 1.*/ - when x=='<' then p=p - 1 /*decrement the pointer by 1.*/ - when x=='[' then != forward() /*go forward to ]+1 if #.P =0.*/ - when x==']' then !=backward() /*go backward to [+1 if #.P ¬0.*/ - when x=='.' then call charout ,d2c(#.p) /*display a "tape" cell.*/ - when x==',' then do; say 'input a value:'; parse pull #.p; end +/*REXX program implements the Brainf*ck (self─censored) language. */ +@.=0 /*initialize the infinite "tape". */ +p =0 /*the "tape" cell pointer. */ +! =0 /* ! is the instruction pointer (IP).*/ +parse arg $ /*allow user to specify a BrainF*ck pgm*/ + /* ┌──◄── No program? Then use default;*/ +if $='' then $=, /* ↓ it displays: Hello, World! */ + "++++++++++ initialize cell #0 to 10; then loop: ", + "[ > +++++++ add 7 to cell #1; final result: 70 ", + " > ++++++++++ add 10 to cell #2; final result: 100 ", + " > +++ add 3 to cell #3; final result 30 ", + " > + add 1 to cell #4; final result 10 ", + " <<<< - ] decrement cell #0 ", + "> ++ . display 'H' which is ASCII 72 (decimal) ", + "> + . display 'e' which is ASCII 101 (decimal) ", + "+++++++ .. display 'll' which is ASCII 108 (decimal) {2}", + "+++ . display 'o' which is ASCII 111 (decimal) ", + "> ++ . display ' ' which is ASCII 32 (decimal) ", + "<< +++++++++++++++ . display 'W' which is ASCII 87 (decimal) ", + "> . display 'o' which is ASCII 111 (decimal) ", + "+++ . display 'r' which is ASCII 114 (decimal) ", + "------ . display 'l' which is ASCII 108 (decimal) ", + "-------- . display 'd' which is ASCII 100 (decimal) ", + "> + . display '!' which is ASCII 33 (decimal) " + /* [↑] note the Brainf*ck comments.*/ + do !=1 while !\==0 & !<=length($) /*keep executing BF as long as IP ¬ 0*/ + parse var $ =(!) x +1 /*obtain a Brainf*ck instruction (x),*/ + /*···it's the same as x=substr($,!,1) */ + select /*examine the current instruction. */ + when x=='+' then @.p=@.p + 1 /*increment the "tape" cell by 1 */ + when x=='-' then @.p=@.p - 1 /*decrement " " " " " */ + when x=='>' then p= p + 1 /*increment " instruction ptr " " */ + when x=='<' then p= p - 1 /*decrement " " " " " */ + when x=='[' then != forward() /*go forward to ]+1 if @.P = 0. */ + when x==']' then !=backward() /* " backward " [+1 " " ¬ " */ + when x== . then call charout , d2c(@.p) /*display a "tape" cell to terminal. */ + when x==',' then do; say 'input a value:'; parse pull @.p; end otherwise iterate end /*select*/ end /*forever*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────FORWARD subroutine──────────────────*/ -forward: if #.p\==0 then return !; c=1 /* C is the [ nested counter.*/ - do k=!+1 to length($); z=substr($,k,1) - if z=='[' then do; c=c+1; iterate; end - if z==']' then do; c=c-1; if c==0 then leave; end - end /*k*/ -return k -/*──────────────────────────────────BACKWARD subroutine─────────────────*/ -backward: if #.p==0 then return !; c=1 /* C is the ] nested counter.*/ - do k=!-1 to 1 by -1; z=substr($,k,1) - if z==']' then do; c=c+1; iterate; end - if z=='[' then do; c=c-1; if c==0 then return k+1; end - end /*k*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +forward: if @.p\==0 then return !; c=1 /*C: ◄─── is the [ nested counter.*/ + do k=!+1 to length($); ?=substr($, k, 1) + if ?=='[' then do; c=c+1; iterate; end + if ?==']' then do; c=c-1; if c==0 then leave; end + end /*k*/ + return k +/*──────────────────────────────────────────────────────────────────────────────────────*/ +backward: if @.p==0 then return !; c=1 /*C: ◄─── is the ] nested counter.*/ + do k=!-1 to 1 by -1; ?=substr($, k, 1) + if ?==']' then do; c=c+1; iterate; end + if ?=='[' then do; c=c-1; if c==0 then return k+1; end + end /*k*/ + return k diff --git a/Task/Execute-HQ9+/00DESCRIPTION b/Task/Execute-HQ9+/00DESCRIPTION index 880884e0fc..e255ae93db 100644 --- a/Task/Execute-HQ9+/00DESCRIPTION +++ b/Task/Execute-HQ9+/00DESCRIPTION @@ -1 +1,3 @@ -Implement a [[HQ9+]] interpreter or compiler for Rosetta Code. +;Task: +Implement a   ''' [[HQ9+]] '''   interpreter or compiler. +

    diff --git a/Task/Execute-HQ9+/ALGOL-68/execute-hq9+.alg b/Task/Execute-HQ9+/ALGOL-68/execute-hq9+.alg new file mode 100644 index 0000000000..4d42bbcb06 --- /dev/null +++ b/Task/Execute-HQ9+/ALGOL-68/execute-hq9+.alg @@ -0,0 +1,47 @@ +# the increment-only accumulator # +INT hq9accumulator := 0; + +# interpret a HQ9+ code string # +PROC hq9 = ( STRING code )VOID: + FOR i TO UPB code + DO + CHAR op = code[ i ]; + IF op = "Q" OR op = "q" + THEN + # display the program # + print( ( code, newline ) ) + ELIF op = "H" OR op = "h" + THEN + print( ( "Hello, world!", newline ) ) + ELIF op = "9" + THEN + # 99 bottles of beer # + FOR bottles FROM 99 BY -1 TO 1 DO + STRING bottle count = whole( bottles, 0 ) + IF bottles > 1 THEN " bottles" ELSE " bottle" FI; + print( ( bottle count, " of beer on the wall", newline ) ); + print( ( bottle count, " bottles of beer.", newline ) ); + print( ( "Take one down, pass it around,", newline ) ); + IF bottles > 1 + THEN + print( ( whole( bottles - 1, 0 ), " bottles of beer on the wall.", newline, newline ) ) + FI + OD; + print( ( "No more bottles of beer on the wall.", newline ) ) + ELIF op = "+" + THEN + # increment the accumulator # + hq9accumulator +:= 1 + ELSE + # unimplemented operation # + print( ( """", op, """ not implemented", newline ) ) + FI + OD; + + +# test the interpreter # +BEGIN + STRING code; + print( ( "HQ9+> " ) ); + read( ( code, newline ) ); + hq9( code ) +END diff --git a/Task/Execute-HQ9+/ALGOL-W/execute-hq9+.alg b/Task/Execute-HQ9+/ALGOL-W/execute-hq9+.alg new file mode 100644 index 0000000000..86725d45ed --- /dev/null +++ b/Task/Execute-HQ9+/ALGOL-W/execute-hq9+.alg @@ -0,0 +1,52 @@ +begin + + procedure writeBottles( integer value bottleCount ) ; + begin + write( bottleCount, " bottle" ); + if bottleCount not = 1 then writeon( "s " ) else writeon( " " ); + end writeBottles ; + + procedure hq9 ( string(32) value code % code to execute % + ; integer value length % length of code % + ) ; + for i := 0 until length - 1 do begin + string(1) op; + + % the increment-only accumulator % + integer hq9accumulator; + + hq9accumulator := 0; + op := code(i//1); + + if op = "Q" or op = "q" then write( code ) + else if op = "H" OR op = "h" then write( "Hello, World!" ) + else if op = "9" then begin + % 99 bottles of beer % + i_w := 1; s_w := 0; + for bottles := 99 step -1 until 1 do begin + writeBottles( bottles ); writeon( "of beer on the wall" ); + writeBottles( bottles ); writeon( "of beer" );; + write( "Take one down, pass it around," ); + if bottles > 1 then begin + writeBottles( bottles - 1 ); writeon( "of beer on the wall." ) + end; + write() + end; + write( "No more bottles of beer on the wall." ) + end + else if op = "+" then hq9accumulator := hq9accumulator + 1 + else write( """", op, """ not implemented" ) + end hq9 ; + + + % test the interpreter % + begin + string(32) code; + integer codeLength; + write( "HQ9+> " ); + read( code ); + codeLength := 31; + while codeLength >= 0 and code(codeLength//1) = " " do codeLength := codeLength - 1; + hq9( code, codeLength + 1 ) + end +end. diff --git a/Task/Execute-HQ9+/Agena/execute-hq9+.agena b/Task/Execute-HQ9+/Agena/execute-hq9+.agena new file mode 100644 index 0000000000..25f3f47f3a --- /dev/null +++ b/Task/Execute-HQ9+/Agena/execute-hq9+.agena @@ -0,0 +1,48 @@ +# HQ9+ interpreter + +# execute an HQ9+ program in the code string - code is not case sensitive +hq9 := proc( code :: string ) is + local hq9Accumulator := 0; # the HQ9+ accumulator + local hq9Operations := # table of HQ9+ operations and their implemntations + [ "q" ~ proc() is print( code ) end + , "h" ~ proc() is print( "Hello, world!" ) end + , "9" ~ proc() is + local writeBottles := proc( bottleCount :: number, message :: string ) is + print( bottleCount + & " bottle" + & if bottleCount <> 1 then "s " else " " fi + & message + ) + end; + + for bottles from 99 to 1 by -1 do + writeBottles( bottles, "of beer on the wall" ); + writeBottles( bottles, "of beer" ); + print( "Take one down, pass it around," ); + if bottles > 1 then + writeBottles( bottles - 1, "of beer on the wall." ) + fi; + print() + od; + print( "No more bottles of beer on the wall." ) + end + , "+" ~ proc() is inc hq9Accumulator, 1 end + ]; + for op in lower( code ) do + if hq9Operations[ op ] <> null then + hq9Operations[ op ]() + else + print( '"' & op & '" not implemented' ) + fi + od +end; + +# prompt for HQ9+ code and execute it, repeating until an empty code string is entered +scope + local code; + do + write( "HQ9+> " ); + code := io.read(); + hq9( code ) + until code = "" +epocs; diff --git a/Task/Execute-HQ9+/Applesoft-BASIC/execute-hq9+.applesoft b/Task/Execute-HQ9+/Applesoft-BASIC/execute-hq9+.applesoft new file mode 100644 index 0000000000..4588150771 --- /dev/null +++ b/Task/Execute-HQ9+/Applesoft-BASIC/execute-hq9+.applesoft @@ -0,0 +1,19 @@ +100 INPUT "HQ9+ : "; I$ +110 LET J$ = I$ + CHR$(13) +120 LET H$ = "HELLO, WORLD!" +130 LET B$ = "BOTTLES OF BEER" +140 LET W$ = " ON THE WALL" +150 LET W$ = W$ + CHR$(13) +160 FOR I = 1 TO LEN(I$) +170 LET C$ = MID$(J$, I, 1) +180 IF C$ = "H" THEN PRINT H$ +190 IF C$ = "Q" THEN PRINT I$ +200 LET A = A + (C$ = "+") +210 IF C$ <> "9" THEN 280 +220 FOR B = 99 TO 1 STEP -1 +230 PRINT B " " B$ W$ B " " B$ +240 PRINT "TAKE ONE DOWN, "; +250 PRINT "PASS IT AROUND" +260 PRINT B - 1 " " B$ W$ +270 NEXT B +280 NEXT I diff --git a/Task/Execute-HQ9+/C++/execute-hq9+.cpp b/Task/Execute-HQ9+/C++/execute-hq9+.cpp index 750742d3d9..2679a199a2 100644 --- a/Task/Execute-HQ9+/C++/execute-hq9+.cpp +++ b/Task/Execute-HQ9+/C++/execute-hq9+.cpp @@ -1,7 +1,7 @@ void runCode(string code) { int c_len = code.length(); - int accumulator, bottles; + int accumulator=0, bottles; for(int i=0;i println!("{}", code), + 'H' => println!("Hello, World!"), + '9' => { + for n in (1..100).rev() { + println!("{} bottles of beer on the wall", n); + println!("{} bottles of beer", n); + println!("Take one down, pass it around"); + if (n - 1) > 1 { + println!("{} bottles of beer on the wall\n", n - 1); + } else { + println!("1 bottle of beer on the wall\n"); + } + } + } + '+' => accumulator += 1, + _ => panic!("Invalid character '{}' found in source.", c), + } + } +} + +fn main() { + execute(&env::args().nth(1).unwrap()); +} diff --git a/Task/Execute-a-Markov-algorithm/00DESCRIPTION b/Task/Execute-a-Markov-algorithm/00DESCRIPTION index 9c2da90b4b..5e6292f958 100644 --- a/Task/Execute-a-Markov-algorithm/00DESCRIPTION +++ b/Task/Execute-a-Markov-algorithm/00DESCRIPTION @@ -1,15 +1,24 @@ -Create an interpreter for a [[wp:Markov algorithm|Markov Algorithm]]. Rules have the syntax: +;Task: +Create an interpreter for a [[wp:Markov algorithm|Markov Algorithm]]. + +Rules have the syntax: ::= (( | ) +)* ::= # {} ::= -> [.] ::= ( | ) [] -There is one rule per line. If there is a . present before the , then this is a terminating rule in which case the interpreter must halt execution. A ruleset consists of a sequence of rules, with optional comments. +There is one rule per line. -=Rulesets= +If there is a   .   (period)   present before the   '''''',   then this is a terminating rule in which case the interpreter must halt execution. + +A ruleset consists of a sequence of rules, with optional comments. + + + Rulesets Use the following tests on entries: -==Ruleset 1== + +;Ruleset 1:
     # This rules file is extracted from Wikipedia:
     # http://en.wikipedia.org/wiki/Markov_Algorithm
    @@ -21,11 +30,12 @@ the shop -> my brother
     a never used -> .terminating rule
     
    Sample text of: -: I bought a B of As from T S. +: I bought a B of As from T S. Should generate the output: -: I bought a bag of apples from my brother. +: I bought a bag of apples from my brother. -==Ruleset 2== + +;Ruleset 2: A test of the terminating rule
     # Slightly modified from the rules on Wikipedia
    @@ -40,9 +50,11 @@ Sample text of:
     Should generate:
     : I bought a bag of apples from T shop.
     
    -==Ruleset 3==
    +
    +;Ruleset 3:
     This tests for correct substitution order and may trap simple regexp based replacement routines if special regexp characters are not escaped.
    -
    # BNF Syntax testing rules
    +
    +# BNF Syntax testing rules
     A -> apple
     WWWW -> with
     Bgage -> ->.*
    @@ -52,14 +64,16 @@ W -> WW
     S -> .shop
     T -> the
     the shop -> my brother
    -a never used -> .terminating rule
    +a never used -> .terminating rule +
    Sample text of: : I bought a B of As W my Bgage from T S. Should generate: : I bought a bag of apples with my money from T shop. -==Ruleset 4== -This tests for correct order of scanning of rules, and may trap replacement routines that scan in the wrong order. It implements a general unary multiplication engine. (Note that the input expression must be placed within underscores in this implementation.) + +;Ruleset 4: +This tests for correct order of scanning of rules, and may trap replacement routines that scan in the wrong order.   It implements a general unary multiplication engine.   (Note that the input expression must be placed within underscores in this implementation.)
     ### Unary Multiplication Engine, for testing Markov Algorithm implementations
     ### By Donal Fellows.
    @@ -91,15 +105,16 @@ _1 -> 1
     _+_ ->
     
    Sample text of: -: _1111*11111_ +: _1111*11111_ should generate the output: -: 11111111111111111111 +: 11111111111111111111 -==Ruleset 5== + +;Ruleset 5: A simple [http://en.wikipedia.org/wiki/Turing_machine Turing machine], implementing a three-state [http://en.wikipedia.org/wiki/Busy_beaver busy beaver]. -The tape consists of 0s and 1s, the states are A, B, C and H (for Halt), and the head position is indicated by writing the state letter before the character where the head is. +The tape consists of '''0'''s and '''1'''s,   the states are '''A''', '''B''', '''C''' and '''H''' (for '''H'''alt), and the head position is indicated by writing the state letter before the character where the head is. All parts of the initial tape the machine operates on have to be given in the input. Besides demonstrating that the Markov algorithm is Turing-complete, it also made me catch a bug in the C++ implementation which wasn't caught by the first four rulesets. @@ -124,8 +139,7 @@ B1 -> 1B 1C1 -> H11
    This ruleset should turn -: 000000A000000 +: 000000A000000 into -: 00011H1111000 - -=Examples= +: 00011H1111000 +

    diff --git a/Task/Execute-a-Markov-algorithm/Go/execute-a-markov-algorithm.go b/Task/Execute-a-Markov-algorithm/Go/execute-a-markov-algorithm.go new file mode 100644 index 0000000000..2a32d33137 --- /dev/null +++ b/Task/Execute-a-Markov-algorithm/Go/execute-a-markov-algorithm.go @@ -0,0 +1,176 @@ +package main + +import ( + "fmt" + "regexp" + "strings" +) + +type testCase struct { + ruleSet, sample, output string +} + +func main() { + fmt.Println("validating", len(testSet), "test cases") + var failures bool + for i, tc := range testSet { + if r, ok := interpret(tc.ruleSet, tc.sample); !ok { + fmt.Println("test", i+1, "invalid ruleset") + failures = true + } else if r != tc.output { + fmt.Printf("test %d: got %q, want %q\n", i+1, r, tc.output) + failures = true + } + } + if !failures { + fmt.Println("no failures") + } +} + +func interpret(ruleset, input string) (string, bool) { + if rules, ok := parse(ruleset); ok { + return run(rules, input), true + } + return "", false +} + +type rule struct { + pat string + rep string + term bool +} + +var ( + rxSet = regexp.MustCompile(ruleSet) + rxEle = regexp.MustCompile(ruleEle) + ruleSet = `(?m:^(?:` + ruleEle + `)*$)` + ruleEle = `(?:` + comment + `|` + ruleRe + `)\n+` + comment = `#.*` + ruleRe = `(.*)` + ws + `->` + ws + `([.])?(.*)` + ws = `[\t ]+` +) + +func parse(rs string) ([]rule, bool) { + if !rxSet.MatchString(rs) { + return nil, false + } + x := rxEle.FindAllStringSubmatchIndex(rs, -1) + var rules []rule + for _, x := range x { + if x[2] > 0 { + rules = append(rules, + rule{pat: rs[x[2]:x[3]], term: x[4] > 0, rep: rs[x[6]:x[7]]}) + } + } + return rules, true +} + +func run(rules []rule, s string) string { +step1: + for _, r := range rules { + if f := strings.Index(s, r.pat); f >= 0 { + s = s[:f] + r.rep + s[f+len(r.pat):] + if r.term { + return s + } + goto step1 + } + } + return s +} + +// text all cut and paste from RC task page +var testSet = []testCase{ + {`# This rules file is extracted from Wikipedia: +# http://en.wikipedia.org/wiki/Markov_Algorithm +A -> apple +B -> bag +S -> shop +T -> the +the shop -> my brother +a never used -> .terminating rule +`, + `I bought a B of As from T S.`, + `I bought a bag of apples from my brother.`, + }, + {`# Slightly modified from the rules on Wikipedia +A -> apple +B -> bag +S -> .shop +T -> the +the shop -> my brother +a never used -> .terminating rule +`, + `I bought a B of As from T S.`, + `I bought a bag of apples from T shop.`, + }, + {`# BNF Syntax testing rules +A -> apple +WWWW -> with +Bgage -> ->.* +B -> bag +->.* -> money +W -> WW +S -> .shop +T -> the +the shop -> my brother +a never used -> .terminating rule +`, + `I bought a B of As W my Bgage from T S.`, + `I bought a bag of apples with my money from T shop.`, + }, + {`### Unary Multiplication Engine, for testing Markov Algorithm implementations +### By Donal Fellows. +# Unary addition engine +_+1 -> _1+ +1+1 -> 11+ +# Pass for converting from the splitting of multiplication into ordinary +# addition +1! -> !1 +,! -> !+ +_! -> _ +# Unary multiplication by duplicating left side, right side times +1*1 -> x,@y +1x -> xX +X, -> 1,1 +X1 -> 1X +_x -> _X +,x -> ,X +y1 -> 1y +y_ -> _ +# Next phase of applying +1@1 -> x,@y +1@_ -> @_ +,@_ -> !_ +++ -> + +# Termination cleanup for addition +_1 -> 1 +1+_ -> 1 +_+_ -> +`, + `_1111*11111_`, + `11111111111111111111`, + }, + {`# Turing machine: three-state busy beaver +# +# state A, symbol 0 => write 1, move right, new state B +A0 -> 1B +# state A, symbol 1 => write 1, move left, new state C +0A1 -> C01 +1A1 -> C11 +# state B, symbol 0 => write 1, move left, new state A +0B0 -> A01 +1B0 -> A11 +# state B, symbol 1 => write 1, move right, new state B +B1 -> 1B +# state C, symbol 0 => write 1, move left, new state B +0C0 -> B01 +1C0 -> B11 +# state C, symbol 1 => write 1, move left, halt +0C1 -> H01 +1C1 -> H11 +`, + `000000A000000`, + `00011H1111000`, + }, +} diff --git a/Task/Execute-a-system-command/00DESCRIPTION b/Task/Execute-a-system-command/00DESCRIPTION index 151abce152..815097698d 100644 --- a/Task/Execute-a-system-command/00DESCRIPTION +++ b/Task/Execute-a-system-command/00DESCRIPTION @@ -1 +1,6 @@ -In this task, the goal is to run either the ls (dir on Windows) system command, or the pause system command. +;Task: +Run either the   '''ls'''   system command   ('''dir'''   on Windows),   or the   '''pause'''   system command. +

    +;Related tasks +* [[Get_system_command_output | Get system command output]] +

    diff --git a/Task/Execute-a-system-command/ABAP/execute-a-system-command.abap b/Task/Execute-a-system-command/ABAP/execute-a-system-command.abap new file mode 100644 index 0000000000..8c5ac4fafd --- /dev/null +++ b/Task/Execute-a-system-command/ABAP/execute-a-system-command.abap @@ -0,0 +1,134 @@ +*&---------------------------------------------------------------------* +*& Report ZEXEC_SYS_CMD +*& +*&---------------------------------------------------------------------* +*& +*& +*&---------------------------------------------------------------------* + +REPORT zexec_sys_cmd. + +DATA: lv_opsys TYPE syst-opsys, + lt_sxpgcotabe TYPE TABLE OF sxpgcotabe, + ls_sxpgcotabe LIKE LINE OF lt_sxpgcotabe, + ls_sxpgcolist TYPE sxpgcolist, + lv_name TYPE sxpgcotabe-name, + lv_opcommand TYPE sxpgcotabe-opcommand, + lv_index TYPE c, + lt_btcxpm TYPE TABLE OF btcxpm, + ls_btcxpm LIKE LINE OF lt_btcxpm + . + +* Initialize +lv_opsys = sy-opsys. +CLEAR lt_sxpgcotabe[]. + +IF lv_opsys EQ 'Windows NT'. + lv_opcommand = 'dir'. +ELSE. + lv_opcommand = 'ls'. +ENDIF. + +* Check commands +SELECT * FROM sxpgcotabe INTO TABLE lt_sxpgcotabe + WHERE opsystem EQ lv_opsys + AND opcommand EQ lv_opcommand. + +IF lt_sxpgcotabe IS INITIAL. + CLEAR ls_sxpgcolist. + CLEAR lv_name. + WHILE lv_name IS INITIAL. +* Don't mess with other users' commands + lv_index = sy-index. + CONCATENATE 'ZLS' lv_index INTO lv_name. + SELECT * FROM sxpgcostab INTO ls_sxpgcotabe + WHERE name EQ lv_name. + ENDSELECT. + IF sy-subrc = 0. + CLEAR lv_name. + ENDIF. + ENDWHILE. + ls_sxpgcolist-name = lv_name. + ls_sxpgcolist-opsystem = lv_opsys. + ls_sxpgcolist-opcommand = lv_opcommand. +* Create own ls command when nothing is declared + CALL FUNCTION 'SXPG_COMMAND_INSERT' + EXPORTING + command = ls_sxpgcolist + public = 'X' + EXCEPTIONS + command_already_exists = 1 + no_permission = 2 + parameters_wrong = 3 + foreign_lock = 4 + system_failure = 5 + OTHERS = 6. + IF sy-subrc <> 0. +* Implement suitable error handling here + ELSE. +* Hooray it worked! Let's try to call it + CALL FUNCTION 'SXPG_COMMAND_EXECUTE_LONG' + EXPORTING + commandname = lv_name + TABLES + exec_protocol = lt_btcxpm + EXCEPTIONS + no_permission = 1 + command_not_found = 2 + parameters_too_long = 3 + security_risk = 4 + wrong_check_call_interface = 5 + program_start_error = 6 + program_termination_error = 7 + x_error = 8 + parameter_expected = 9 + too_many_parameters = 10 + illegal_command = 11 + wrong_asynchronous_parameters = 12 + cant_enq_tbtco_entry = 13 + jobcount_generation_error = 14 + OTHERS = 15. + IF sy-subrc <> 0. +* Implement suitable error handling here + WRITE: 'Cant execute ls - '. + CASE sy-subrc. + WHEN 1. + WRITE: / ' no permission!'. + WHEN 2. + WRITE: / ' command could not be created!'. + WHEN 3. + WRITE: / ' parameter list too long!'. + WHEN 4. + WRITE: / ' security risk!'. + WHEN 5. + WRITE: / ' wrong call of SXPG_COMMAND_EXECUTE_LONG!'. + WHEN 6. + WRITE: / ' command cant be started!'. + WHEN 7. + WRITE: / ' program terminated!'. + WHEN 8. + WRITE: / ' x_error!'. + WHEN 9. + WRITE: / ' parameter missing!'. + WHEN 10. + WRITE: / ' too many parameters!'. + WHEN 11. + WRITE: / ' illegal command!'. + WHEN 12. + WRITE: / ' wrong asynchronous parameters!'. + WHEN 13. + WRITE: / ' cant enqueue job!'. + WHEN 14. + WRITE: / ' cant create job!'. + WHEN 15. + WRITE: / ' unknown error!'. + WHEN OTHERS. + WRITE: / ' unknown error!'. + ENDCASE. + ELSE. + LOOP AT lt_btcxpm INTO ls_btcxpm. + WRITE: / ls_btcxpm. + ENDLOOP. + ENDIF. + ENDIF. +ENDIF. diff --git a/Task/Execute-a-system-command/Fortran/execute-a-system-command-1.f b/Task/Execute-a-system-command/Fortran/execute-a-system-command-1.f new file mode 100644 index 0000000000..43b606599f --- /dev/null +++ b/Task/Execute-a-system-command/Fortran/execute-a-system-command-1.f @@ -0,0 +1,4 @@ +program SystemTest +integer :: i + call execute_command_line ("ls", exitstat=i) +end program SystemTest diff --git a/Task/Execute-a-system-command/Fortran/execute-a-system-command.f b/Task/Execute-a-system-command/Fortran/execute-a-system-command-2.f similarity index 100% rename from Task/Execute-a-system-command/Fortran/execute-a-system-command.f rename to Task/Execute-a-system-command/Fortran/execute-a-system-command-2.f diff --git a/Task/Execute-a-system-command/Frink/execute-a-system-command.frink b/Task/Execute-a-system-command/Frink/execute-a-system-command.frink new file mode 100644 index 0000000000..706018903a --- /dev/null +++ b/Task/Execute-a-system-command/Frink/execute-a-system-command.frink @@ -0,0 +1,2 @@ +r = callJava["java.lang.Runtime", "getRuntime"] +println[read[r.exec["dir"].getInputStream[]]] diff --git a/Task/Exponentiation-operator/00DESCRIPTION b/Task/Exponentiation-operator/00DESCRIPTION index 4f1a76c2bb..3772e1f80a 100644 --- a/Task/Exponentiation-operator/00DESCRIPTION +++ b/Task/Exponentiation-operator/00DESCRIPTION @@ -1,4 +1,8 @@ Most programming languages have a built-in implementation of exponentiation. -Re-implement integer exponentiation for both intint and floatint as both a procedure, and an operator (if your language supports operator definition). -If the language supports operator (or procedure) overloading, then an overloaded form should be provided for both intint and floatint variants. + +;Task: +Re-implement integer exponentiation for both   intint   and   floatint   as both a procedure,   and an operator (if your language supports operator definition). + +If the language supports operator (or procedure) overloading, then an overloaded form should be provided for both   intint   and   floatint   variants. +

    diff --git a/Task/Exponentiation-operator/AWK/exponentiation-operator.awk b/Task/Exponentiation-operator/AWK/exponentiation-operator-1.awk similarity index 72% rename from Task/Exponentiation-operator/AWK/exponentiation-operator.awk rename to Task/Exponentiation-operator/AWK/exponentiation-operator-1.awk index accef0333c..f315c12745 100644 --- a/Task/Exponentiation-operator/AWK/exponentiation-operator.awk +++ b/Task/Exponentiation-operator/AWK/exponentiation-operator-1.awk @@ -1,7 +1 @@ $ awk 'function pow(x,n){r=1;for(i=0;i 0 = f x (n - 1) x + |else = fail "Negative exponent" + where f _ 0 y = y + f a d y = g a d + where g b i | even i = g (b * b) (i `quot` 2) + | else = f b (i - 1) (b * y) + +(12 ^ 4, 12 ** 4) diff --git a/Task/Exponentiation-operator/Ela/exponentiation-operator-2.ela b/Task/Exponentiation-operator/Ela/exponentiation-operator-2.ela new file mode 100644 index 0000000000..e76728f90b --- /dev/null +++ b/Task/Exponentiation-operator/Ela/exponentiation-operator-2.ela @@ -0,0 +1,20 @@ +open number + +//Function quot from number module is defined only for +//integral numbers. We can use this as an universal quot. +uquot x y | x is Integral = x `quot` y + | else = x / y + +//Changing implementation by using generic numeric literals +//(e.g. 2u) and elimitating all comparisons with 0. +!x ^ n | n ~= 0u = 1u + | n > 0u = f x (n - 1u) x + | else = fail "Negative exponent" + where f a d y + | d ~= 0u = y + | else = g a d + where g b i | even i = g (b * b) (i `uquot` 2u) + | else = f b (i - 1u) (b * y) + + +(12 ^ 4, 12.34 ^ 4.04) diff --git a/Task/Exponentiation-operator/Ela/exponentiation-operator-3.ela b/Task/Exponentiation-operator/Ela/exponentiation-operator-3.ela new file mode 100644 index 0000000000..c6d29d6110 --- /dev/null +++ b/Task/Exponentiation-operator/Ela/exponentiation-operator-3.ela @@ -0,0 +1,28 @@ +open number + +//A class that defines our overloadable function +class Exponent a where + (^) a->a->_ + +//Implementation for integers +instance Exponent Int where + _ ^ 0 = 1 + x ^ n | n > 0 = f x (n - 1) x + |else = fail "Negative exponent" + where f _ 0 y = y + f a d y = g a d + where g b i | even i = g (b * b) (i `quot` 2) + | else = f b (i - 1) (b * y) + +//Implementation for floats +instance Exponent Single where + x ^ n | n < 0.001 = 1 + | n > 0 = f x (n - 1) x + | else = fail "Negative exponent" + where f a d y + | d < 0.001 = y + | else = g a d + where g b i | even i = g (b * b) (i / 2) + | else = f b (i - 1) (b * y) + +(12 ^ 4, 12.34 ^ 4.04) diff --git a/Task/Exponentiation-operator/REXX/exponentiation-operator.rexx b/Task/Exponentiation-operator/REXX/exponentiation-operator.rexx index 2be61bd331..86eb0da6b6 100644 --- a/Task/Exponentiation-operator/REXX/exponentiation-operator.rexx +++ b/Task/Exponentiation-operator/REXX/exponentiation-operator.rexx @@ -1,38 +1,42 @@ -/*REXX program to show various (integer) exponentiations. */ - say center('digits='digits(),79,'─') +/*REXX program computes and displays various (integer) exponentiations. */ + say center('digits='digits(), 79, "─") say '17**65 is:' say 17**65 +say -numeric digits 100; say; say center('digits='digits(),79,'─') +numeric digits 100; say center('digits='digits(), 79, "─") say '17**65 is:' say 17**65 +say -numeric digits 10; say; say center('digits='digits(),79,'─') +numeric digits 10; say center('digits='digits(), 79, "─") say '2 ** -10 is:' say 2 ** -10 +say -numeric digits 30; say; say center('digits='digits(),79,'─') +numeric digits 30; say center('digits='digits(), 79, "─") say '-3.1415926535897932384626433 ** 3 is:' say -3.1415926535897932384626433 ** 3 +say -numeric digits 1000; say; say center('digits='digits(),79,'─') +numeric digits 1000; say center('digits='digits(), 79, "─") say '2 ** 1000 is:' say 2 ** 1000 +say -numeric digits 60; say; say center('digits='digits(),79,'─') -say 'ipow(5,70) is:' -say ipow(5,70) -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────ERRIPOW subroutine──────────────────*/ -errIpow: say; say '***error!***'; say; say arg(1); say; say; exit 13 -/*──────────────────────────────────IPOW subroutine─────────────────────*/ -ipow: procedure; parse arg x 1 _,p -if arg()<2 then call erripow 'not enough arguments specified' -if arg()>2 then call erripow 'too many arguments specified' -if \datatype(_,'N') then call erripow "1st arg isn't numeric:" _ -if \datatype(p,'W') then call erripow "2nd arg isn't an integer:" p -if p=0 then return 1 -pa=abs(p) - do pa-1; _=_*x; end -if p<0 then _=1/_ -return _ +numeric digits 60; say center('digits='digits(), 79, "─") +say 'iPow(5, 70) is:' +say iPow(5, 70) +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +errMsg: say; say '***error***'; say; say arg(1); say; say; exit 13 +/*──────────────────────────────────────────────────────────────────────────────────────*/ +iPow: procedure; parse arg x 1 _,p + if arg()<2 then call errMsg "not enough arguments specified" + if arg()>2 then call errMsg "too many arguments specified" + if \datatype(x,'N') then call errMsg "1st arg isn't numeric:" x + if \datatype(p,'W') then call errMsg "2nd arg isn't an integer:" p + if p=0 then return 1 + do abs(p) - 1; _=_*x; end /*abs(p)-1*/ + if p<0 then _=1/_ + return _ diff --git a/Task/Extend-your-language/ALGOL-68/extend-your-language.alg b/Task/Extend-your-language/ALGOL-68/extend-your-language.alg new file mode 100644 index 0000000000..8e3cfc7f15 --- /dev/null +++ b/Task/Extend-your-language/ALGOL-68/extend-your-language.alg @@ -0,0 +1,13 @@ +# operator to turn two boolean values into an integer - name inspired by the COBOL sample # +PRIO ALSO = 1; +OP ALSO = ( BOOL a, b )INT: IF a AND b THEN 1 ELIF a THEN 2 ELIF b THEN 3 ELSE 4 FI; + +# using the above operator, we can use the standard CASE construct to provide the # +# required construct, e.g.: # +BOOL a := TRUE, b := FALSE; +CASE a ALSO b + IN print( ( "both: a and b are TRUE", newline ) ) + , print( ( "first: only a is TRUE", newline ) ) + , print( ( "second: only b is TRUE", newline ) ) + , print( ( "neither: a and b are FALSE", newline ) ) +ESAC diff --git a/Task/Extend-your-language/PowerShell/extend-your-language-1.psh b/Task/Extend-your-language/PowerShell/extend-your-language-1.psh new file mode 100644 index 0000000000..ff33c2c9ce --- /dev/null +++ b/Task/Extend-your-language/PowerShell/extend-your-language-1.psh @@ -0,0 +1,47 @@ +function When-Condition +{ + [CmdletBinding()] + Param + ( + [Parameter(Mandatory=$true, Position=0)] + [bool] + $Test1, + + [Parameter(Mandatory=$true, Position=1)] + [bool] + $Test2, + + [Parameter(Mandatory=$true, Position=2)] + [scriptblock] + $Both, + + [Parameter(Mandatory=$true, Position=3)] + [scriptblock] + $First, + + [Parameter(Mandatory=$true, Position=4)] + [scriptblock] + $Second, + + [Parameter(Mandatory=$true, Position=5)] + [scriptblock] + $Neither + ) + + if ($Test1 -and $Test2) + { + return (&$Both) + } + elseif ($Test1 -and -not $Test2) + { + return (&$First) + } + elseif (-not $Test1 -and $Test2) + { + return (&$Second) + } + else + { + return (&$Neither) + } +} diff --git a/Task/Extend-your-language/PowerShell/extend-your-language-2.psh b/Task/Extend-your-language/PowerShell/extend-your-language-2.psh new file mode 100644 index 0000000000..93db635bd1 --- /dev/null +++ b/Task/Extend-your-language/PowerShell/extend-your-language-2.psh @@ -0,0 +1,6 @@ +When-Condition -Test1 (Test-Path .\temp.txt) -Test2 (Test-Path .\tmp.txt) ` + -Both { "both true" +} -First { "first true" +} -Second { "second true" +} -Neither { "neither true" +} diff --git a/Task/Extend-your-language/PowerShell/extend-your-language-3.psh b/Task/Extend-your-language/PowerShell/extend-your-language-3.psh new file mode 100644 index 0000000000..2a5e6d491f --- /dev/null +++ b/Task/Extend-your-language/PowerShell/extend-your-language-3.psh @@ -0,0 +1,8 @@ +Set-Alias -Name if2 -Value When-Condition + +if2 $true $false { + "both true" +} { "first true" +} { "second true" +} { "neither true" +} diff --git a/Task/Extend-your-language/REXX/extend-your-language-2.rexx b/Task/Extend-your-language/REXX/extend-your-language-2.rexx index 208f352e7c..2bd71c8798 100644 --- a/Task/Extend-your-language/REXX/extend-your-language-2.rexx +++ b/Task/Extend-your-language/REXX/extend-your-language-2.rexx @@ -1,23 +1,23 @@ -/*REXX program introduces IF2, a type of a four-way compound IF: */ -parse arg bot top . /*obtain optional arguments from the CL*/ -if bot=='' | bot==',' then bot=10 /*Not specified? Then use the default.*/ -if top=='' | top==',' then top=25 /* " " " " " " */ -w=max(length(bot), length(top)) + 10 /*W: max width, used for displaying #. */ +/*REXX program introduces the IF2 "statement", a type of a four-way compound IF: */ +parse arg bot top . /*obtain optional arguments from the CL*/ +if bot=='' | bot=="," then bot=10 /*Not specified? Then use the default.*/ +if top=='' | top=="," then top=25 /* " " " " " " */ +w=max(length(bot), length(top)) + 10 /*W: max width, used for displaying #.*/ - do #=bot to top /*put a DO loop through its paces. */ - /* [↓] divisible by two and/or three? */ - if2( #//2==0, #//3==0) /*use a new four-way IF statement. */ - select /*now, test the four possible cases. */ - when if.11 then say right(#,w) " is divisible by both two and three." - when if.10 then say right(#,w) " is divisible by two, but not by three." - when if.01 then say right(#,w) " is divisible by three, but not by two." - when if.00 then say right(#,w) " isn't divisible by two, nor by three." - otherwise nop /*◄──┬◄ this statement is optional and */ - end /*select*/ /* ├◄ only exists in case one or more*/ - end /*#*/ /* └◄ WHENs (above) are omitted. */ -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────IF2 routine───────────────────────────────*/ -if2: parse arg if.10, if.01 /*assign the cases 10 and 01 */ - if.11= if.10 & if.01 /* " " case 11 */ - if.00= \(if.10 | if.01) /* " " " 00 */ -return '' + do #=bot to top /*put a DO loop through its paces. */ + /* [↓] divisible by two and/or three? */ + if2( #//2==0, #//3==0) /*use a new four-way IF statement. */ + select /*now, test the four possible cases. */ + when if.11 then say right(#,w) " is divisible by both two and three." + when if.10 then say right(#,w) " is divisible by two, but not by three." + when if.01 then say right(#,w) " is divisible by three, but not by two." + when if.00 then say right(#,w) " isn't divisible by two, nor by three." + otherwise nop /*◄──┬◄ this statement is optional and */ + end /*select*/ /* ├◄ only exists in case one or more*/ + end /*#*/ /* └◄ WHENs (above) are omitted. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +if2: parse arg if.10, if.01 /*assign the cases of 10 and 01 */ + if.11= if.10 & if.01 /* " " case " 11 */ + if.00= \(if.10 | if.01) /* " " " " 00 */ + return '' diff --git a/Task/Extensible-prime-generator/00DESCRIPTION b/Task/Extensible-prime-generator/00DESCRIPTION index 591c5dff6e..44e851e553 100644 --- a/Task/Extensible-prime-generator/00DESCRIPTION +++ b/Task/Extensible-prime-generator/00DESCRIPTION @@ -1,16 +1,19 @@ -The task is to write a generator of prime numbers, in order, that will automatically adjust to accommodate the generation of any reasonably high prime. +;Task: +Write a generator of prime numbers, in order, that will automatically adjust to accommodate the generation of any reasonably high prime. The routine should demonstrably rely on either: # Being based on an open-ended counter set to count without upper limit other than system or programming language limits. In this case, explain where this counter is in the code. # Being based on a limit that is extended automatically. In this case, choose a small limit that ensures the limit will be passed when generating some of the values to be asked for below. # If other methods of creating an extensible prime generator are used, the algorithm's means of extensibility/lack of limits should be stated. + The routine should be used to: * Show the first twenty primes. * Show the primes between 100 and 150. * Show the ''number'' of primes between 7,700 and 8,000. * Show the 10,000th prime. +
    Show output on this page. '''Note:''' You may reference code already on this site if it is written to be imported/included, then only the code necessary for import and the performance of this task need be shown. (It is also important to leave a forward link on the referenced tasks entry so that later editors know that the code is used for multiple tasks). @@ -19,3 +22,4 @@ Show output on this page. ;See also: * The task is written so it may be useful in solving task [[Emirp primes]] as well as others (depending on its efficiency). +

    diff --git a/Task/Extensible-prime-generator/Clojure/extensible-prime-generator.clj b/Task/Extensible-prime-generator/Clojure/extensible-prime-generator.clj new file mode 100644 index 0000000000..7ac8ced2c6 --- /dev/null +++ b/Task/Extensible-prime-generator/Clojure/extensible-prime-generator.clj @@ -0,0 +1,50 @@ +ns test-project-intellij.core + (:gen-class) + (:require [clojure.string :as string])) + +(def primes +" The following routine produces a infinite sequence of primes + (i.e. can be infinite since the evaluation is lazy in that it + only produces values as needed). The method is from clojure primes.clj library + which produces primes based upon O'Neill's paper: + 'The Genuine Sieve of Eratosthenes'. + + Produces primes based upon trial division on previously found primes up to + (sqrt number), and uses 'wheel' to avoid + testing numbers which are divisors of 2, 3, 5, or 7. + A full explanation of the method is available at: + [https://github.com/stuarthalloway/programming-clojure/pull/12] " + + (concat + [2 3 5 7] + (lazy-seq + (let [primes-from ; generates primes by only checking if primes + ; numbers which are not divisible by 2, 3, 5, or 7 + (fn primes-from [n [f & r]] + (if (some #(zero? (rem n %)) + (take-while #(<= (* % %) n) primes)) + (recur (+ n f) r) + (lazy-seq (cons n (primes-from (+ n f) r))))) + + ; wheel provides offsets from previous number to insure we are not landing on a divisor of 2, 3, 5, 7 + wheel (cycle [2 4 2 4 6 2 6 4 2 4 6 6 2 6 4 2 + 6 4 6 8 4 2 4 2 4 8 6 4 6 2 4 6 + 2 6 6 4 2 4 6 2 6 4 2 4 2 10 2 10])] + (primes-from 11 wheel))))) + +(defn between [lo hi] + "Primes between lo and hi value " + (->> (take-while #(<= % hi) primes) + (filter #(>= % lo)) + )) + +(println "First twenty:" (take 20 primes)) + +(println "Between 100 and 150:" (between 100 150)) + +(println "Number between 7,7700 and 8,000:" (count (between 7700 8000))) + +(println "10,000th prime:" (nth primes (dec 10000))) ; decrement by one since nth starts counting from 0 + + +} diff --git a/Task/Extensible-prime-generator/Fortran/extensible-prime-generator-1.f b/Task/Extensible-prime-generator/Fortran/extensible-prime-generator-1.f new file mode 100644 index 0000000000..c7ee940b09 --- /dev/null +++ b/Task/Extensible-prime-generator/Fortran/extensible-prime-generator-1.f @@ -0,0 +1,4 @@ + DO WHILE(F*F <= LST) !But, F*F might overflow the integer limit so instead, + DO WHILE(F <= LST/F) !Except, LST might also overflow the integer limit, so + DO WHILE(F <= (IST + 2*(SBITS - 1))/F) !Which becomes... + DO WHILE(F <= IST/F + (MOD(IST,F) + 2*(SBITS - 1))/F) !Preserving the remainder from IST/F. diff --git a/Task/Extensible-prime-generator/Fortran/extensible-prime-generator-2.f b/Task/Extensible-prime-generator/Fortran/extensible-prime-generator-2.f new file mode 100644 index 0000000000..d69dee03c8 --- /dev/null +++ b/Task/Extensible-prime-generator/Fortran/extensible-prime-generator-2.f @@ -0,0 +1,382 @@ + MODULE PRIMEBAG !Need prime numbers? Plenty are available. +C Creates and expands a disc file for a sieve of Eratoshenes, representing odd numbers only and starting with three. +C Storage requirements: an array of N prime numbers in 16/32/64 bits vs. a bit array up to the 16/32/64 bit limit. +C Word size N Prime N words in bits Bit array in bits. +C 8 bit P(31) = 127 248 128 +C P(54) = 251 432 256 +C 16 bit P(3,512) = 32,749 56,192 32,768 +C P(6,542) = 65,521 104,672 65,536 +C 32 bit P(105,097,565) = 2,147,483,647 3,363,122,080 2,147,483,648 +C P(203,280,221) = 4,294,967,291 6,504,967,072 4,294,967,296 +C 64 bit 2.112E17 ? 1.352E19 9,223,372,036,854,775,808 ~ 9.22E18 +C from n/Ln(n) 4.158E17 ? 2.661E19 18,446,744,073,709,551,616 ~ 1.84E19 + INTEGER MSG !I/O unit number. + INTEGER SSTASH !For attachment to my stash file. + INTEGER SRECLEN,SCHARS,SBITS !Sizes. + INTEGER SORG !Where the sieve starts. This must be three. + INTEGER SLAST !Last record in my stash file. + DATA SSTASH,SREC,SLAST/0,0,0/ !Prepared by PRIMEBAG. + PARAMETER (SRECLEN = 1024) !4K disc bloc size, but RECL (in OPEN) is in terms of four-byte integers. + PARAMETER (SCHARS = (SRECLEN - 1)*4) !Reserving space for one number at the start. + PARAMETER (SBITS = SCHARS*8) !Known size of a character. + PARAMETER (SORG = 3) !First odd number past two, which is not odd. + CHARACTER*(*) SFILE !A name is needed. + PARAMETER (SFILE = "C:/Nicky/RosettaCode/Primes/PrimeSieve.bit") !I don't have to count the characters. +Components of a buffered record for the stash. + INTEGER SREC !The record number. + CHARACTER*1 C4(4) !The start of the record - a counter. + CHARACTER*1 SCHAR(0:SCHARS - 1) !The majority of the record - a bit array, packed in 8-bit blobs... +Collect some bit twiddling assistants for AND and OR, rather than bit shifting. + CHARACTER*1 BITON(0:7),BITOFF(0:7) !Functions IBSET and IBCLR may not be available, and are little-endian anyway. + PARAMETER (BITON =(/CHAR(2#10000000),CHAR(2#01000000), !128, 64, Reading strictly left-to-right. + 1 CHAR(2#00100000),CHAR(2#00010000), ! 32, 16, Uncompromising bigendery. + 1 CHAR(2#00001000),CHAR(2#00000100), ! 8, 4, Not just for bytes in words, + 3 CHAR(2#00000010),CHAR(2#00000001)/)) ! 2, 1. But also bits in bytes. + PARAMETER (BITOFF=(/CHAR(2#01111111),CHAR(2#10111111), !127, 191, BITON + BITOFF = 255. + 2 CHAR(2#11011111),CHAR(2#11101111), !223, 239, + 1 CHAR(2#11110111),CHAR(2#11111011), !247, 251, + 3 CHAR(2#11111101),CHAR(2#11111110)/)) !253, 254. + CONTAINS + INTEGER FUNCTION I4UNPACK(C4) !Convert four successive characters into an integer. + CHARACTER*1 C4(4) !The characters. + I4UNPACK = ((ICHAR(C4(1))*256 + ICHAR(C4(2)))*256 !Convert the first four bytes + 1 + ICHAR(C4(3)))*256 + ICHAR(C4(4)) !To a four-byte integer. + END FUNCTION I4UNPACK !Big-endian style, irrespective of cpu endianness. + SUBROUTINE C4PACK(I4) !Convert an integer into successive bytes. +Could return the result via a fancy function, but for now a global variable will do. + INTEGER I4,N !The integer, and a copy to damage. + INTEGER I !A stepper. + N = I4 !Keep the original safe. + DO I = 4,1,-1 !Know that four characters will do. Fixed format makes this easy. + C4(I) = CHAR(MOD(N,256)) !Grab the low-order eight bits. + N = N/256 !And shift right eight. + END DO !Do it again. + END SUBROUTINE C4PACK !Stored big-endianly, irrespective of cpu endianness. + + LOGICAL FUNCTION GRASPPRIMEBAG(F) + INTEGER F !The I/O unit number to use. + LOGICAL EXIST !Use the keyword as a name + INTEGER IOSTAT !And don't worry over assignment direction. + CHARACTER*3 STYLE !One way or another. + SSTASH = F !I shall use it. + INQUIRE (FILE = SFILE,EXIST = EXIST) !Trouble with a missing "path" may arise. + IF (EXIST) THEN !If the file exists, + STYLE = "OLD" !I shall read it. + ELSE !But if it doesn't, + STYLE = "NEW" !I shall create it. + END IF !Enough prevarication. + OPEN(SSTASH,FILE = SFILE, STATUS = STYLE, !Go for the file. + & ACCESS = "DIRECT", RECL = SRECLEN, FORM = "UNFORMATTED", !I have plans. + & ERR = 666, IOSTAT = IOSTAT) !Which may be thwarted. + IF (EXIST) THEN !If there is one... + CALL READSCHAR(1) !The first record is also a header. + SLAST = I4UNPACK(C4) !The number of records stored. + ELSE !Otherwise, start from scratch. + SLAST = 0 !No saved records. + CALL PSURGE(SCHAR) !During preparation of the first batch of bits. + END IF !All should now be in readiness. + GRASPPRIMEBAG = .TRUE.!So, feel confidence. + RETURN !And escape. + 666 WRITE (*,667) IOSTAT,SFILE !But, something may have gone wrong. + 667 FORMAT ("Pox! Error code ",I0, !A "hole" in the directory path? + 1 " when attempting to open file ",A) !Read-only access allowed when I want "update"? + GRASPPRIMEBAG = .FALSE. !Whatever, it didn't work. + END FUNCTION GRASPPRIMEBAG !So much for that. + + SUBROUTINE READSCHAR(R) !Get record R into SCHAR, which may already hold it. + INTEGER R !The record number desired. + IF (R.EQ.SREC) RETURN !Perhaps it is already to hand. + SREC = R !If not, move attention to it. + READ (SSTASH,REC = SREC) C4,SCHAR !And read the record. + END SUBROUTINE READSCHAR!Thus, I have a buffer too. + + LOGICAL FUNCTION PSURGE(BIT8) !Add another record to the stash. +C Surges forward into the next batch of primes, to be stored via a bit array in the file. +C Each record starts with a count of the number of primes that have gone before. +C Except that for the first record, this is the record counter for the stash file. +C Except that when starting the second record, one is also the number of primes before SORG. + CHARACTER*1 BIT8(0:SCHARS - 1) !Watch out! This may be SCHAR itself! + INTEGER IST,LST !The numbers spanned by the surge. + INTEGER F !A factor. + INTEGER I !Another factor and a stepper. + INTEGER C !Index for array BIT8. + INTEGER NP !Number of primes. +Carry forward the count of previous primes to start the following record.. + 10 IF (SLAST.GT.0) THEN !Is there a previous record? + CALL READSCHAR(SLAST) !Yes. Grab it. A good chance this is already in C4,SCHAR. + NP = I4UNPACK(C4) !Its count of the primes accumulated before it. + DO I = 0,SCHARS - 1 !Find out how namy primes it fingered by scanning its bits. + NP = NP + COUNT(IAND(ICHAR(SCHAR(I)),ICHAR(BITON)).NE.0) !Whee! Eight at a go! + END DO !On to the next byte. + END IF !When creating a new record, its follower may not be sought in this run. +Concoct the next batch of bits. Contorted calculations avoid integer overflow. + 20 BIT8 = CHAR(255) !All bits are aligned with numbers that might prove to be prime. + IST = SORG + SLAST*(2*SBITS) !Bit(0) of BIT8(0) corresponds to IST. + LST = IST + 2*(SBITS - 1) !Bit(last) to this number. Remember, only odd numbers have bits. + IF (IST.LE.0) THEN !Humm. I'd better check. + WRITE (MSG,21) SLAST,IST,LST !This works only with two's complement integers. + 21 FORMAT (/,"Integer overflow in the sieve of Eratosthenes!", !Oh dear. + 1 /,"Advancing from surge ",I0," to span ",I0," to ",I0) !These numbers will look odd. + PSURGE = .FALSE. !But it is better than no indication of what went wrong. + RETURN !Give in. + END IF !Enough worrying. + F = 3 !The first possible factor. Zapping will start at F² +c DO WHILE(F.LE.LST/F) !If F² is past the end, so will be still larger F: enough. + DO WHILE(F.LE.IST/F + (MOD(IST,F) + 2*(SBITS - 1))/F) !"Synthetic division" avoiding overflow. + I = (IST - 1)/F + 1 !I want the first multiple of F in IST:LST. F may be a factor of IST. + IF (MOD(I,2).EQ.0) I = I + 1!If even, advance to the next odd multiple. Even numbers are omitted by design. + IF (I.LT.F) I = F !Less than F is superfluous: the position was zapped by earlier action. +c I = (I*F - IST)/2 !Current bit positions are for IST, IST+2, IST+4, etc. + I = ((I - IST/F)*F - MOD(IST,F))/2 !Avoids overflow when calculating the start value, I*F. + DO I = I,SBITS - 1,F !Zap every F'th bit along. This is the sieve of Eratosthenes. + C = I/8 !Eight bits per character. + BIT8(C) = CHAR(IAND(ICHAR(BIT8(C)), !For F = 3 and 5, characters will be hit more than once. + 1 ICHAR(BITOFF(MOD(I,8))))) !Whack a bit. All the above just for this! + END DO !On to the next bit. + 22 F = NEXTPRIME(F) !So much for F. Next, please. + END DO !Are we there yet? +Correct the count in the header, if this is an added record. + 30 IF (SLAST.GT.0) THEN !So, was there a pre-existing header record? + CALL READSCHAR(1) !Yes. Get the header record into C4,SCHAR. + CALL C4PACK(SLAST + 1) !This is the new record count. + WRITE (SSTASH,REC = 1) C4,SCHAR !Write it all back. + SCHAR = BIT8 !Ensure that SCHAR and SREC will be agreed. + END IF !So much for the header's count. +Cast the bits into the stash by writing record SLAST + 1.. + 40 IF (SLAST.EQ.0) THEN !If we're writing the first record, + CALL C4PACK(1) !Then this is the record count. + ELSE !Otherwise, + CALL C4PACK(NP) !Place the previous primes count. + END IF !All this to help PRIME(i). + SLAST = SLAST + 1 !This is now the last stashed record. + WRITE (SSTASH,REC = SLAST) C4,BIT8 !I/O directly from the work area? + SREC = SLAST !This is where BIT8 was written. + PSURGE = .TRUE. !That assumes BIT8 is not SCHAR for SLAST > 1. + END FUNCTION PSURGE !That was fun! + + RECURSIVE SUBROUTINE GETSREC(R) !Make present the bit array belonging to record R. + INTEGER R !The record number.. + CHARACTER*1 BIT8(0:SCHARS - 1) !A scratchpad. Others may be relying on SCHAR. + IF (SLAST.LE.0) RETURN!DANGER! The first record is being initialised! + DO WHILE(SLAST.LT.R) !If we haven't reached so far, + IF (.NOT.PSURGE(BIT8)) THEN !Slog forwards one record's worth. + WRITE (MSG,1) R !Or maybe not. + 1 FORMAT ("Cannot prepare surge ",I0) !Explain. + STOP "No bits, no go." !And quit. + END IF !And having prepared the next block of bits, + END DO !Check afresh. + CALL READSCHAR(R) !Read the desired record's bits. + END SUBROUTINE GETSREC !Done. + + INTEGER FUNCTION PRIME(N) !P(1) = 2, P(2) = 3, etc. +C Calculate P(n) ~ n.ln(n) +C ~ n{ln(n) + ln(ln(n)) - 1 + (ln(ln(n)) - 2)/ln(n) - [ln(ln(n))**2 - 6*log(log(n)) + 11]/[2*(ln(n))**2] + ....} +C J.B.Rosser's 1938 Theorem: n[ln(n) + ln(ln(n)) - 1] < P(n) < n[ln(n) + ln(ln(n))] +C or, with E = ln(n) + ln(ln(n)), n[E - 1] < P(n) < n[E] +C Experimentation shows that the undershoot of the first two terms involves many records worth of bits. +C Including additional terms does much better, but can overshoot. + INTEGER N !The desired one. + INTEGER R,NP !Counts. + INTEGER B,C !Bit and character indices. + DOUBLE PRECISION EST,LN,LLN !Hope, if not actuality. + IF (N.LE.0) STOP "Primes are counted positively!" !Something must be wrong! + IF (N.LE.1) THEN !The start of the bit array being preempted. + PRIME = 2 !So, no array access. + ELSE !Otherwise, the fun begins. + LN = LOG(DFLOAT(N)) !Here we go. + LLN = LOG(LN) !A popular term. + EST = N*(LN !Estimate the value of the N'th prime. + 1 + LLN - 1 !Second term + 2 + (LLN - 2)/LN !Third term. + 3 - (LLN**2 - 6*LLN + 11)/(2*LN**2)) !Fourth term. + R = (EST - SORG)/(2*SBITS) + 1 !Thereby selecting a record to scan. + IF (R.LE.0) R = 1 !And not making a mess with N < 6 or so. + 9 CALL GETSREC(R) !Go for the record. + IF (R.LE.1) THEN !The first record starts with the record count. + NP = 1 !And I know how many primes precede its start point + ELSE !While for all subsequent records, + NP = I4UNPACK(C4) !This counts the number of primes that precede record R's start number. + END IF !So now I'm ready to count onwards. + IF (N.LE.NP) THEN !Maybe not. + R = R - 1 !The estimate took me too far ahead. + GO TO 9 !Try again. + END IF !Could escalate to a binary search or even an interpolating search. +Commence scanning the bits. + C = 0 !Start with the first character of SREC.. + B = -1 !Syncopation. The formula is known to always under-estimate. + 10 IF (NP.LT.N) THEN !Are we there yet? + 11 B = B + 1 !No. Advance to the next bit. + IF (B.GE.8) THEN !Overflowed a character yet? + B = 0 !Yes. Start afresh at the first bit. + C = C + 1 !And advance one character. + IF (C.GE.SCHARS) THEN !Overflowed the record yet? + C = 0 !Yes. Start afresh at its first character. + R = R + 1 !And advance to the next record. + CALL GETSREC(R) !Possibly, create it. + END IF !So much for records. + END IF !We're now ready to test bit B of character C of record R. + IF (IAND(ICHAR(SCHAR(C)),ICHAR(BITON(B))).EQ.0) GO TO 11 !Not a prime. Search on. + NP = NP + 1 !Count another prime. + GO TO 10 !Pehaps this will be the one. + END IF !So much for the search. + PRIME = SORG + (R - 1)*(2*SBITS) + (C*8 + B)*2 !The corresponding number. + IF (PRIME.LE.0) WRITE (MSG,666) N,PRIME !Or, possibly not. + 666 FORMAT ("Integer overflow! Prime(",I0,") gives ",I0,"!") !Let us hope the caller notices. + END IF !So, all going well, + END FUNCTION PRIME !It is found. + + RECURSIVE INTEGER FUNCTION NEXTPRIME(N) !Keep right on to the end of the road. +Can invoke GETSREC, which can invoke PSURGE, which ... invokes NEXTPRIME. Oh dear. + INTEGER N !Not necessarily itself a prime number. + INTEGER NN !A value to work with. + INTEGER R !A record number into the stash. + INTEGER I,IST !Number offsets. + INTEGER C,B !Character and bit index. + IF (N.LE.1) THEN !Suspicion prevails. + NN = 2 !This is not represented in my bit array. + ELSE !Otherwise, the fun begins. + NN = N + 1 !Advance, with a copy I can mess with. + IF (MOD(NN,2).EQ.0) NN = NN + 1 !Thus, NN is now odd. + IF (NN.LE.0) GO TO 666 !But perhaps not proper, due to overflow. + R = (NN - SORG)/(2*SBITS) !SORG is odd, so (NN - SORG) is even. + CALL GETSREC(R + 1) !The first record is numbered one, not zero. + IST = SORG + R*(2*SBITS) !The number for its first bit: even numbers are omitted.. + I = (NN - IST)/2 !Offset into the record. NN - IST is even. + C = I/8 !Which character in SCHAR(0:SCHARS - 1)? + B = MOD(I,8) !Which bit in SCHAR(C)? + 10 IF (IAND(ICHAR(SCHAR(C)),ICHAR(BITON(B))).EQ.0) THEN !On for a prime. + NN = NN + 2 !Alas, it is off, so NN is not a prime. Perhaps this will be. + B = B + 1 !Advance one bit. Each bit steps two. + IF (B.GE.8) THEN !Past the end of the character? + B = 0 !Yes. Back to bit zero. + C = C + 1 !And advance one chracter. + IF (C.GE.SCHARS) THEN !Past the end of the record? + IF (NN.LE.0) GO TO 666!Yes. If NN has overflowed, the end of the rope is reached. + C = 0 !Back to the start of a record. + R = R + 1 !Advance one record. + CALL GETSREC(R + 1) !And read it. (Count is from 1, not 0). + END IF !So much for overflowing a record. + END IF !So much for overflowing a character. + GO TO 10 !Try again. + END IF !So much for the bit array. + END IF !If there had been a scan. + NEXTPRIME = NN !The number for which the scan stopped. + IF (NN.GT.0) RETURN !All is well. + 666 WRITE (MSG,667) N,NN !Or, maybe not. Careful: this won't appear if NEXTPRIME is invoked in a WRITE list. + 667 FORMAT ("Integer overflow! NextPrime(",I0,") gives ",I0,"!") !The recipient could do a two's complement. + NEXTPRIME = NN !Prefer to return the bad value rather than fail to return anything. + END FUNCTION NEXTPRIME !No divisions, no sieving. Here, anyway + + INTEGER FUNCTION PREVIOUSPRIME(N) !If N is good, this can't overflow. + INTEGER N !The number, not necessarily a prime. + INTEGER NN !A value to mess with. + INTEGER R !A record number. + INTEGER I !Offset. + INTEGER C,B !Character and bit fingers. + IF (N.LE.3) THEN !Suppress annoyances. + NN = 2 !This is now called the first prime, not one. + ELSE !Otherwise, some work is to be done. + NN = N - 1 !Step back one to ensure previousness. + IF (MOD(NN,2).EQ.0) NN = NN - 1 !And here, oddness is a minimal requirement. + R = (NN - SORG)/(2*SBITS) !Finger the record containing the bit for NN. + CALL GETSREC(R + 1) !Record counting starts with one. + I = (NN - (SORG + R*(2*SBITS)))/2 !Offset into that record. + C = I/8 !Finger the character in SCHAR. + B = MOD(I,8) !And the bit within the character. + 10 IF (IAND(ICHAR(SCHAR(C)),ICHAR(BITON(B))).EQ.0) THEN !On for a prime. + NN = NN - 2 !Alas, it is off, so NN is not a prime. Perhaps this will be. + B = B - 1 !Retreat one bit. Each bit steps two. + IF (B.LT.0) THEN !Past the start of the character? + B = 7 !Yes. Back to the last bit. + C = C - 1 !And retreat one chracter. + IF (C.LT.0) THEN !Past the start of the record? + C = SCHARS - 1 !Yes. Back to the end of a record. + R = R - 1 !Retreat one record. + CALL GETSREC(R + 1) !And read it. (Count is from 1, not 0). + END IF !So much for overflowing a record. + END IF !So much for overflowing a character. + GO TO 10 !Try again. + END IF !So much for the bit array. + END IF !Possibly, it was not needed. + PREVIOUSPRIME = NN !There. + END FUNCTION PREVIOUSPRIME !Doesn't overflow, either. + + LOGICAL FUNCTION ISPRIME(N) !Could fool around explicity testing 2 and 3 and say 5, + INTEGER N !But that means also checking that N > 2, N > 3, and N > 5. + ISPRIME = N .EQ. NEXTPRIME(N - 1) !This is so much easier. + END FUNCTION ISPRIME !No divisions up to SQRT(N) or the like either. + END MODULE PRIMEBAG !Functions updating a disc file as a side effect... + + PROGRAM POKE + USE PRIMEBAG + INTEGER I,P,N,N1,N2 !Assorted assistants. + INTEGER ORDER !A collection of special values. + PARAMETER (ORDER = 6) !For one, two, and four byte integers. + INTEGER EDGE(ORDER) !Considered as two's complement and unsigned. + PARAMETER (EDGE = (/31,54,3512,6542,105097565,203280221/)) !These primes are of interest. + MSG = 6 !Standard output. + + IF (.NOT.GRASPPRIMEBAG(66)) STOP "Gan't grab my file!" !Attempt in hope. + +Case 1. +C FORALL(I = 1:20) LIST(I) = PRIME(I) is rejected because function Prime(i) is rather impure. + 10 WRITE (MSG,11) + 11 FORMAT (19X,"First twenty primes: ", $) + DO I = 1,20 + P = PRIME(I) + WRITE (MSG,12) P + 12 FORMAT (I0,",",$) + END DO + +Case 2. + 20 WRITE (MSG,21) + 21 FORMAT (/,12X,"Primes between 100 and 150: ",$) + P = 100 + 22 P = NEXTPRIME(P) !While (P:=NextPrime(P)) <= 150 do Print P; + IF (P.LE.150) THEN !But alas, no assignment within an expression. + WRITE (MSG,23) P + 23 FORMAT (I0,",",$) + GO TO 22 + END IF + +Case 3. + 30 N1 = 7700 !Might as well parameterise this. + N2 = 8000 !Rather than litter the source with explicit integers. + N = 0 + P = N1 + 31 P = NEXTPRIME(P) + IF (P.LE.N2) THEN + N = N + 1 + GO TO 31 + END IF + WRITE (MSG,32) N1,N2,N + 32 FORMAT (/"Number of primes between ",I0," and ",I0,": ",I0) + +Case 4. + 40 WRITE (MSG,41) + 41 FORMAT (/,"Tenfold steps...") + N = 1 + DO I = 1,9 !This goes about as far as it can go. + P = PRIME(N) + WRITE (MSG,42) N,P + 42 FORMAT ("Prime(",I0,") = ",I0) + N = N*10 + END DO + +Cast forth some interesting values. + 100 WRITE (MSG,101) + 101 FORMAT (/,"Primes close to number sizes") + DO N = 1,ORDER !Step through the list. + N1 = EDGE(N) - 1 !Syncopation for the special value. + DO I = 1,2 !I want the prime on either side. + N1 = N1 + 1 !So, there are two successive primes to finger. + WRITE (MSG,102) N1 !Identify the index. + 102 FORMAT ("Prime(",I0,") = ",$) !Piecemeal writing to the output, + P = PRIME(N1) !As this may fling forth a complaint. + WRITE (MSG,103) P !Show the value returned. + 103 FORMAT (I0,", ",$) !Which may be unexpected. + END DO !On to the second. + WRITE (MSG,*) !End the line after the second result. + END DO !On to the next in the list. + + END !Whee! diff --git a/Task/Extensible-prime-generator/Fortran/extensible-prime-generator-3.f b/Task/Extensible-prime-generator/Fortran/extensible-prime-generator-3.f new file mode 100644 index 0000000000..d375279da5 --- /dev/null +++ b/Task/Extensible-prime-generator/Fortran/extensible-prime-generator-3.f @@ -0,0 +1,5 @@ + P = NEXTPRIME(100) + DO WHILE (P.LE.150) + ...stuff... + P = NEXTPRIME(P) + END DO diff --git a/Task/Extensible-prime-generator/Fortran/extensible-prime-generator-4.f b/Task/Extensible-prime-generator/Fortran/extensible-prime-generator-4.f new file mode 100644 index 0000000000..068c744ddf --- /dev/null +++ b/Task/Extensible-prime-generator/Fortran/extensible-prime-generator-4.f @@ -0,0 +1 @@ + P:=100; WHILE (P:=NextPrime(P)) <= 150 DO stuff; diff --git a/Task/Extensible-prime-generator/JavaScript/extensible-prime-generator-1.js b/Task/Extensible-prime-generator/JavaScript/extensible-prime-generator-1.js new file mode 100644 index 0000000000..94da5fd8b0 --- /dev/null +++ b/Task/Extensible-prime-generator/JavaScript/extensible-prime-generator-1.js @@ -0,0 +1,41 @@ +function primeGenerator(num, showPrimes) { + var i, + arr = []; + + function isPrime(num) { + // try primes <= 16 + if (num <= 16) return ( + num == 2 || num == 3 || num == 5 || num == 7 || num == 11 || num == 13 + ); + // cull multiples of 2, 3, 5 or 7 + if (num % 2 == 0 || num % 3 == 0 || num % 5 == 0 || num % 7 == 0) + return false; + // cull square numbers ending in 1, 3, 7 or 9 + for (var i = 10; i * i <= num; i += 10) { + if (num % (i + 1) == 0) return false; + if (num % (i + 3) == 0) return false; + if (num % (i + 7) == 0) return false; + if (num % (i + 9) == 0) return false; + } + return true; + } + + if (typeof num == "number") { + for (i = 0; arr.length < num; i++) if (isPrime(i)) arr.push(i); + // first x primes + if (showPrimes) return arr; + // xth prime + else return arr.pop(); + } + + if (Array.isArray(num)) { + for (i = num[0]; i <= num[1]; i++) if (isPrime(i)) arr.push(i); + // primes between x .. y + if (showPrimes) return arr; + // number of primes between x .. y + else return arr.length; + } + // throw a default error if nothing returned yet + // (surrogate for a quite long and detailed try-catch-block anywhere before) + throw("Invalid arguments for primeGenerator()"); +} diff --git a/Task/Extensible-prime-generator/JavaScript/extensible-prime-generator-2.js b/Task/Extensible-prime-generator/JavaScript/extensible-prime-generator-2.js new file mode 100644 index 0000000000..d5f4b257ba --- /dev/null +++ b/Task/Extensible-prime-generator/JavaScript/extensible-prime-generator-2.js @@ -0,0 +1,11 @@ +// first 20 primes +console.log(primeGenerator(20, true)); + +// primes between 100 and 150 +console.log(primeGenerator([100, 150], true)); + +// numbers of primes between 7700 and 8000 +console.log(primeGenerator([7700, 8000], false)); + +// the 10,000th prime +console.log(primeGenerator(10000, false)); diff --git a/Task/Extensible-prime-generator/JavaScript/extensible-prime-generator-3.js b/Task/Extensible-prime-generator/JavaScript/extensible-prime-generator-3.js new file mode 100644 index 0000000000..5dad837d91 --- /dev/null +++ b/Task/Extensible-prime-generator/JavaScript/extensible-prime-generator-3.js @@ -0,0 +1,7 @@ +Array [ 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 51, 59, 61, 67, 71 ] + +Array [ 101, 103, 107, 109, 113, 127, 131, 137, 139, 149 ] + +30 + +104729 diff --git a/Task/Extensible-prime-generator/REXX/extensible-prime-generator.rexx b/Task/Extensible-prime-generator/REXX/extensible-prime-generator.rexx index ee0e07d56e..53762370f8 100644 --- a/Task/Extensible-prime-generator/REXX/extensible-prime-generator.rexx +++ b/Task/Extensible-prime-generator/REXX/extensible-prime-generator.rexx @@ -1,46 +1,46 @@ -/*REXX program finds primes using an extendible prime number generator.*/ -parse arg f .; if f=='' then f=20 /*allow specifying # for 1 ──► F.*/ -call primes f; do j=1 for f; $=$ @.j; end -say 'first' f 'primes are:' $ +/*REXX program calculates and displays primes using an extendible prime number generator*/ +parse arg f .; if f=='' then f=20 /*allow specifying number for 1 ──► F.*/ +call primes f; do j=1 for f; $=$ @.j; end /*j*/ +say 'first' f 'primes are:' $ say -call primes -150; do j=100 to 150; if !.j==0 then iterate; $=$ j; end -say 'the primes between 100 to 150 (inclusive) are:' $ +call primes -150; do j=100 to 150; if !.j==0 then iterate; $=$ j; end /*j*/ +say 'the primes between 100 to 150 (inclusive) are:' $ say -call primes -8000; do j=7700 to 8000; if !.j==0 then iterate; $=$ j; end +call primes -8000; do j=7700 to 8000; if !.j==0 then iterate; $=$ j; end /*j*/ say 'the number of primes between 7700 and 8000 (inclusive) is:' words($) say call primes 10000 say 'the 10000th prime is:' @.10000 -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────PRIMES subroutine───────────────────*/ -primes: procedure expose !. s. @. $ #; parse arg H . 1 m .,,$; H=abs(H) -if symbol('!.0')=='LIT' then /*1st time here? Initialize stuff*/ - do; !.=0; @.=0; s.=0 /*!.x=some prime; @.n=Nth prime.*/ - _=2 3 5 7 11 13 17 19 23 /*generate a bunch of low primes.*/ - do #=1 for words(_); p=word(_,#); @.#=p; !.p=1; end - #=#-1; !.0=#; s.#=@.#**2 /*set # to be number of primes.*/ - end /* [↑] done with building low Ps*/ -neg= m<0 /*Neg? Request is for a P value.*/ -if neg then if H<=@.# then return /*Have a high enough P already?*/ - else nop /*used to match the above THEN. */ - else if H<=# then return /*Have a enough primes already ? */ -/*─────────────────────────────────────── [↓] gen more P's within range*/ - do j=@.#+2 by 2 /*find primes until have H Primes*/ - if j//3 ==0 then iterate /*is J divisible by three? */ - if right(j,1)==5 then iterate /*is the right-most digit a "5" ?*/ - if j//7 ==0 then iterate /*is J divisible by seven? */ - if j//11 ==0 then iterate /*is J divisible by eleven? */ - if j//13 ==0 then iterate /*is J divisible by thirteen? */ - if j//17 ==0 then iterate /*is J divisible by seventeen? */ - if j//19 ==0 then iterate /*is J divisible by nineteen? */ - /*[↑] above seven lines saves time*/ - do k=!.0 while s.k<=j /*divide by the known odd primes.*/ - if j//@.k==0 then iterate j /*Is J divisible by P? Not prime.*/ - end /*k*/ /* [↑] divide by odd primes √j.*/ - #=#+1 /*bump number of primes found. */ - @.#=j; s.#=j*j; !.j=1 /*assign to sparse array; prime².*/ - if neg then if H<=@.# then leave /*do we have a high enough prime?*/ - else nop /*used to match the above THEN. */ - else if H<=# then leave /*do we have enough primes yet? */ - end /*j*/ /* [↑] keep generating 'til nuff*/ -return /*return to invoker with more Ps.*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +primes: procedure expose !. s. @. $ #; parse arg H . 1 m .,,$; H=abs(H) + if symbol('!.0')=='LIT' then /*1st time here? Then initialize stuff*/ + do; !.=0; @.=0; s.=0 /*!.x = some prime; @.n = Nth prime. */ + _=2 3 5 7 11 13 17 19 23 /*generate a bunch of low primes. */ + do #=1 for words(_); p=word(_,#); @.#=p; !.p=1; end + #=#-1; !.0=#; s.#=@.#**2 /*set # to be the number of primes. */ + end /* [↑] done with building low primes? */ + neg= m<0 /*Negative? Request is for a P value.*/ + if neg then if H<=@.# then return /*do we have a high enough P already?*/ + else nop /*this is used to match the above THEN.*/ + else if H<=# then return /*do we have a enough primes already ? */ + /* [↓] gen more primes within range. */ + do j=@.#+2 by 2 /*find primes until have H Primes. */ + if j//3 ==0 then iterate /*is J divisible by three? */ + parse var j '' -1 _; if _==5 then iterate /*is the right-most digit a 5?*/ + if j//7 ==0 then iterate /*is J divisible by seven? */ + if j//11==0 then iterate /*is J divisible by eleven? */ + if j//13==0 then iterate /*is J divisible by thirteen? */ + if j//17==0 then iterate /*is J divisible by seventeen? */ + if j//19==0 then iterate /*is J divisible by nineteen? */ + /*[↑] above five lines saves time. */ + do k=!.0 while s.k<=j /*divide by the known odd primes. */ + if j//@.k==0 then iterate j /*Is J ÷ by a prime? ¬prime. ___*/ + end /*k*/ /* [↑] divide by odd primes up to √ j */ + #=#+1 /*bump the number of primes found. */ + @.#=j; s.#=j*j; !.j=1 /*assign to sparse array; prime²; P#.*/ + if neg then if H<=@.# then leave /*do we have a high enough prime? */ + else nop /*used to match the above THEN. */ + else if H<=# then leave /*do we have enough primes yet? */ + end /*j*/ /* [↑] keep generating until enough. */ + return /*return to invoker with more primes. */ diff --git a/Task/Extensible-prime-generator/Seed7/extensible-prime-generator.seed7 b/Task/Extensible-prime-generator/Seed7/extensible-prime-generator.seed7 index 84f1ede0e8..0eea0922e8 100644 --- a/Task/Extensible-prime-generator/Seed7/extensible-prime-generator.seed7 +++ b/Task/Extensible-prime-generator/Seed7/extensible-prime-generator.seed7 @@ -2,17 +2,17 @@ $ include "seed7_05.s7i"; const func boolean: isPrime (in integer: number) is func result - var boolean: result is FALSE; + var boolean: prime is FALSE; local var integer: count is 2; begin if number = 2 then - result := TRUE; + prime := TRUE; elsif number > 2 then while number rem count <> 0 and count * count <= number do incr(count); end while; - result := number rem count <> 0; + prime := number rem count <> 0; end if; end func; @@ -21,12 +21,12 @@ var integer: primeNum is 0; const func integer: getPrime is func result - var integer: prime is 0; + var integer: nextPrime is 0; begin repeat incr(currentPrime); until isPrime(currentPrime); - prime := currentPrime; + nextPrime := currentPrime; incr(primeNum); end func; diff --git a/Task/Extreme-floating-point-values/00DESCRIPTION b/Task/Extreme-floating-point-values/00DESCRIPTION index e920843f9a..02a3f808a3 100644 --- a/Task/Extreme-floating-point-values/00DESCRIPTION +++ b/Task/Extreme-floating-point-values/00DESCRIPTION @@ -5,10 +5,18 @@ The IEEE floating point specification defines certain 'extreme' floating point values such as minus zero, -0.0, a value distinct from plus zero; not a number, NaN; and plus and minus infinity. The task is to use expressions involving other 'normal' floating point values in your language to calculate these, (and maybe other), extreme floating point values in your language and assign them to variables. -Print the values of these variables if possible; and show some arithmetic with these values and variables. If your language can directly enter these extreme floating point values then show it. -
    C.f: -* [http://www.cl.cam.ac.uk/teaching/1011/FPComp/floatingmath.pdf What Every Computer Scientist Should Know About Floating-Point Arithmetic] -* [[Infinity]] -* [[Detect division by zero]] -* [[Literals/Floating point]] +Print the values of these variables if possible; and show some arithmetic with these values and variables. + +If your language can directly enter these extreme floating point values then show it. + + +;See also: +*   [http://www.cl.cam.ac.uk/teaching/1011/FPComp/floatingmath.pdf What Every Computer Scientist Should Know About Floating-Point Arithmetic] + + +;Related tasks: +*   [[Infinity]] +*   [[Detect division by zero]] +*   [[Literals/Floating point]] +

    diff --git a/Task/Extreme-floating-point-values/Fortran/extreme-floating-point-values-1.f b/Task/Extreme-floating-point-values/Fortran/extreme-floating-point-values-1.f new file mode 100644 index 0000000000..9bc9c71a8f --- /dev/null +++ b/Task/Extreme-floating-point-values/Fortran/extreme-floating-point-values-1.f @@ -0,0 +1,8 @@ + REAL*8 BAD,NaN !Sometimes a number is not what is appropriate. + PARAMETER (NaN = Z'FFFFFFFFFFFFFFFF') !This value is recognised in floating-point arithmetic. + PARAMETER (BAD = Z'FFFFFFFFFFFFFFFF') !I pay special attention to BAD values. + CHARACTER*3 BADASTEXT !Speakable form. + DATA BADASTEXT/" ? "/ !Room for "NaN", short for "Not a Number", if desired. + REAL*8 PINF,NINF !Special values. No sign of an "overflow" state, damnit. + PARAMETER (PINF = Z'7FF0000000000000') !May well cause confusion + PARAMETER (NINF = Z'FFF0000000000000') !On a cpu not using this scheme. diff --git a/Task/Extreme-floating-point-values/Fortran/extreme-floating-point-values-2.f b/Task/Extreme-floating-point-values/Fortran/extreme-floating-point-values-2.f new file mode 100644 index 0000000000..c53330ea22 --- /dev/null +++ b/Task/Extreme-floating-point-values/Fortran/extreme-floating-point-values-2.f @@ -0,0 +1,78 @@ +Cause various arithmetic errors to see what sort of hissy fit is thrown. + REAL X2,X3,X4,Y4,XX,ZERO + INTEGER IX4,IY4 + EQUIVALENCE (X4,IX4),(Y4,IY4) !To view bits without provoking special fp handling. + REAL*4 NaN4 + PARAMETER (NaN4 = Z'FFC00000') !FFFFFFFF +c PARAMETER (NaN4 = Z'FFFFFFFF') !FFFFFFFF + REAL*8 NaN8,X8(5),Y8,INF8 + PARAMETER (NaN8 = Z'FFF8000000000000') !FFFFFFFF +c PARAMETER (NaN8 = Z'FFFFFFFFFFFFFFFF') + LOGICAL LX(5) + INTEGER I + X4 = NaN4 + WRITE (6,1) X4,IX4 + 1 FORMAT ("X4 =",F12.4,' Hex ',Z8) + WRITE (6,*) "Test X4 .EQ. Bad? ",X4.EQ.NaN4 + WRITE (6,*) "Test X4 .NE. Bad? ",X4.NE.NaN4 + WRITE (6,*) "Test IsNaN(X4) ",ISNAN(X4) + WRITE (6,*) "Test Abs(bad) ",ABS(X4) +c WRITE (6,*) "Test Exp(bad)",EXP(X4) + Y8 = HUGE(Y8) + WRITE(6,*) "Huge",Y8,LOG(Y8) + Y8 = LOG(Y8) + WRITE (6,*) "Hic",EXP(Y8) + + X2 = 0 + X3 = 0 + ZERO = 0 + XX = 666.66 + X2 = XX + X4 + WRITE (6,*) "Test x + BAD ",X2 + WRITE (6,*) "Test 0/0 ",X3/ZERO + WRITE (6,*) "Test 1/0 ",1/ZERO + WRITE (6,*) "Test-1/0 ",-1/ZERO + X2 = MIN(XX,X4) + WRITE (6,*) "Test min(x,Bad) ",X2 + WRITE (6,*) "Test min(x,NaN4)",MIN(XX,NaN4) +c WRITE (6,*) "Test mod(x,Bad) ",MOD(XX,X4) +c WRITE (6,*) "Test mod(Bad,x) ",MOD(X4,XX) +c WRITE (6,*) "Test mod(x,0) ",MOD(XX,Z) +c WRITE (6,*) "Sqrt(Bad)",SQRT(X4) + + DO I = 1,0,-1 !for sqrt(-1), a snarl. + X4 = I + X4 = X4/FLOAT(I) + Y4 = SQRT(FLOAT(I)) + WRITE (6,10) I,I,X4,IX4,I,Y4,IY4 + 10 FORMAT (I3,"/",I3," gives",F9.5," Hex ",Z8, + 1 ", Sqrt(",I3,") gives",F9.5," Hex ",Z8) + END DO + +Contemplate double precision. + WRITE (6,*) + WRITE (6,*) "Problems with IsNaN and arrays..." + DO I = 1,5 + X8(I) = I + END DO + X8(3:4) = NaN8 + WRITE (6,*) "X=",X8 + WRITE (6,*) "X(2:4)=",X8(2:4) + WRITE (6,*) "isnan(x(2:4))",ISNAN(X8(2:4)) + WRITE (6,*) "isnan(x(2))..(4))",ISNAN(X8(2)),ISNAN(X8(3)), + 1 ISNAN(X8(4)) + WRITE (6,*) "abs(x(2:4))",ABS(X8(2:4)) + WRITE (6,*) "isnan(abs(x(2:4)))",ISNAN(ABS(X8(2:4))) + LX = ISNAN(X8) + WRITE (6,*) "LX = isnan(X)",LX + + XX = HUGE(XX) + WRITE(6,*) "Huge(x)=",XX,-XX + XX = 1/ZERO + WRITE(6,11) XX,-XX + 11 FORMAT("1/Zero=",Z8,", neg ",Z8) + INF8 = XX + WRITE (6,12) INF8,-INF8 + 12 FORMAT("1/Zero=",Z16,", neg ",Z16) + WRITE (6,*) "Burp!" + END diff --git a/Task/Extreme-floating-point-values/Perl-6/extreme-floating-point-values.pl6 b/Task/Extreme-floating-point-values/Perl-6/extreme-floating-point-values.pl6 index 73c4eee921..6249ed2b4e 100644 --- a/Task/Extreme-floating-point-values/Perl-6/extreme-floating-point-values.pl6 +++ b/Task/Extreme-floating-point-values/Perl-6/extreme-floating-point-values.pl6 @@ -1,8 +1,8 @@ print qq:to 'END' -positive infinity: {Inf} -negative infinity: {-Inf} -negative zero: {-0e0} -not a number: {NaN} +positive infinity: {1e309} +negative infinity: {-1e309} +negative zero: {0e0 * -1} +not a number: {0 * 1e309} +Inf + 2.0 = {Inf + 2} +Inf - 10.1 = {Inf - 10.1} +Inf + -Inf = {Inf + -Inf} diff --git a/Task/Extreme-floating-point-values/PureBasic/extreme-floating-point-values.purebasic b/Task/Extreme-floating-point-values/PureBasic/extreme-floating-point-values.purebasic index bd5f1982d0..2b3da04235 100644 --- a/Task/Extreme-floating-point-values/PureBasic/extreme-floating-point-values.purebasic +++ b/Task/Extreme-floating-point-values/PureBasic/extreme-floating-point-values.purebasic @@ -1,9 +1,9 @@ Define.f If OpenConsole() - inf = 1/None - minus_inf = -1/None + inf = Infinity() ; or 1/None ;None represents a variable of value = 0 + minus_inf = -Infinity() ; or -1/None minus_zero = -1/inf - nan = None/None + nan = NaN() ; or None/None PrintN("positive infinity: "+StrF(inf)) PrintN("negative infinity: "+StrF(minus_inf)) @@ -19,7 +19,7 @@ If OpenConsole() PrintN("NaN + 1.0 = "+StrF(nan + 1.0)) PrintN("NaN + NaN = "+StrF(nan + nan)) PrintN("Logics") - If IsInfinity(inf): PrintN("Variabel 'Infinity' is infinite"): EndIf + If IsInfinity(inf): PrintN("Variable 'Infinity' is infinite"): EndIf If IsNAN(nan): PrintN("Variable 'nan' is not a number"): EndIf Print(#CRLF$+"Press ENTER to EXIT"): Input() diff --git a/Task/Factorial/00DESCRIPTION b/Task/Factorial/00DESCRIPTION index 3827a02adf..b708d7953f 100644 --- a/Task/Factorial/00DESCRIPTION +++ b/Task/Factorial/00DESCRIPTION @@ -1,5 +1,13 @@ -The '''Factorial Function''' of a positive integer, ''n'', is defined as the product of the sequence ''n'', ''n''-1, ''n''-2, ...1 and the factorial of zero, 0, is [[wp:Factorial#Definition|defined]] as being 1. +;Definitions: +:*   The   '''Factorial Function'''   of a positive integer,   ''n'',   is defined as the product of the sequence: + ''n'',   ''n''-1,   ''n''-2,   ...   1 +:*   The factorial of   '''0'''   (zero)   is [[wp:Factorial#Definition|defined]] as being   1   (unity). + +;Task: Write a function to return the factorial of a number. + Solutions can be iterative or recursive. -Support for trapping negative n errors is optional. + +Support for trapping negative   ''n''   errors is optional. +

    diff --git a/Task/Factorial/APL/factorial-1.apl b/Task/Factorial/APL/factorial-1.apl new file mode 100644 index 0000000000..c60be82833 --- /dev/null +++ b/Task/Factorial/APL/factorial-1.apl @@ -0,0 +1,2 @@ + !6 +720 diff --git a/Task/Factorial/APL/factorial-2.apl b/Task/Factorial/APL/factorial-2.apl new file mode 100644 index 0000000000..93121cc039 --- /dev/null +++ b/Task/Factorial/APL/factorial-2.apl @@ -0,0 +1 @@ + FACTORIAL←{×/⍳⍵} diff --git a/Task/Factorial/APL/factorial-3.apl b/Task/Factorial/APL/factorial-3.apl new file mode 100644 index 0000000000..eb7bf8ead8 --- /dev/null +++ b/Task/Factorial/APL/factorial-3.apl @@ -0,0 +1,2 @@ + FACTORIAL 6 +720 diff --git a/Task/Factorial/AppleScript/factorial-1.applescript b/Task/Factorial/AppleScript/factorial-1.applescript index 29a1d8971a..8c193870ae 100644 --- a/Task/Factorial/AppleScript/factorial-1.applescript +++ b/Task/Factorial/AppleScript/factorial-1.applescript @@ -1,8 +1,8 @@ on factorial(x) - if x < 0 then return 0 - set R to 1 - repeat while x > 1 - set {R, x} to {R * x, x - 1} - end repeat - return R + if x < 0 then return 0 + set R to 1 + repeat while x > 1 + set {R, x} to {R * x, x - 1} + end repeat + return R end factorial diff --git a/Task/Factorial/AppleScript/factorial-2.applescript b/Task/Factorial/AppleScript/factorial-2.applescript index 18f0a0568c..61d1ee35b0 100644 --- a/Task/Factorial/AppleScript/factorial-2.applescript +++ b/Task/Factorial/AppleScript/factorial-2.applescript @@ -1,5 +1,10 @@ +-- factorial :: Int -> Int on factorial(x) - if x < 0 then return 0 - if x > 1 then return x * (my factorial(x - 1)) - return 1 + if x > 1 then + x * (factorial(x - 1)) + else if x = 1 then + 1 + else + 0 + end if end factorial diff --git a/Task/Factorial/AppleScript/factorial-3.applescript b/Task/Factorial/AppleScript/factorial-3.applescript new file mode 100644 index 0000000000..a283ee3f8d --- /dev/null +++ b/Task/Factorial/AppleScript/factorial-3.applescript @@ -0,0 +1,63 @@ +-- factorial :: Int -> Int +on factorial(x) + script product + on lambda(a, b) + a * b + end lambda + end script + + foldl(product, 1, range(1, x)) +end factorial + + + +-- TEST +on run + + factorial(11) + + --> 39916800 + +end run + + +-- GENERIC LIBRARY PRIMITIVES + +-- 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 + +-- range :: Int -> Int -> [Int] +on range(m, n) + if n < m then + set d to -1 + else + set d to 1 + end if + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range + + +-- 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 diff --git a/Task/Factorial/Groovy/factorial-1.groovy b/Task/Factorial/Groovy/factorial-1.groovy index eb55b8752e..82c48a6a9a 100644 --- a/Task/Factorial/Groovy/factorial-1.groovy +++ b/Task/Factorial/Groovy/factorial-1.groovy @@ -1,2 +1,2 @@ def rFact -rFact = { (it > 1) ? it * rFact(it - 1) : 1 } +rFact = { (it > 1) ? it * rFact(it - 1) : 1 as BigInteger } diff --git a/Task/Factorial/Groovy/factorial-2.groovy b/Task/Factorial/Groovy/factorial-2.groovy index 237d76fb80..8e18424c8d 100644 --- a/Task/Factorial/Groovy/factorial-2.groovy +++ b/Task/Factorial/Groovy/factorial-2.groovy @@ -1 +1 @@ -(0..6).each { println "${it}: ${rFact(it)}" } +def iFact = { (it > 1) ? (2..it).inject(1 as BigInteger) { i, j -> i*j } : 1 } diff --git a/Task/Factorial/Groovy/factorial-3.groovy b/Task/Factorial/Groovy/factorial-3.groovy index 16d91aa814..6710348dfb 100644 --- a/Task/Factorial/Groovy/factorial-3.groovy +++ b/Task/Factorial/Groovy/factorial-3.groovy @@ -1 +1,17 @@ -def iFact = { (it > 1) ? (2..it).inject(1) { i, j -> i*j } : 1 } +def time = { Closure c -> + def start = System.currentTimeMillis() + def result = c() + def elapsedMS = (System.currentTimeMillis() - start)/1000 + printf '(%6.4fs elapsed)', elapsedMS + result +} + +def dashes = '---------------------' +print " n! elapsed time "; (0..15).each { def length = Math.max(it - 3, 3); printf " %${length}d", it }; println() +print "--------- -----------------"; (0..15).each { def length = Math.max(it - 3, 3); print " ${dashes[0.. + printf "%9s ", name + def factList = time { (0..15).collect {fact(it)} } + factList.each { printf ' %3d', it } + println() +} diff --git a/Task/Factorial/JavaScript/factorial-4.js b/Task/Factorial/JavaScript/factorial-4.js index a44b4b5f42..98f8abe570 100644 --- a/Task/Factorial/JavaScript/factorial-4.js +++ b/Task/Factorial/JavaScript/factorial-4.js @@ -1 +1,27 @@ -var factorial = n => (n < 2) ? 1 : n * factorial(n - 1); +(function () { + 'use strict'; + + // factorial :: Int -> Int + function factorial(x) { + + return range(1, x) + .reduce(function (a, b) { + return a * b; + }, 1); + } + + + + // range :: Int -> Int -> [Int] + function range(m, n) { + var a = Array(n - m + 1), + i = n + 1; + + while (i-- > m) a[i - m] = i; + return a; + } + + + return factorial(18); + +})(); diff --git a/Task/Factorial/JavaScript/factorial-5.js b/Task/Factorial/JavaScript/factorial-5.js new file mode 100644 index 0000000000..1a350e8e6e --- /dev/null +++ b/Task/Factorial/JavaScript/factorial-5.js @@ -0,0 +1 @@ +6402373705728000 diff --git a/Task/Factorial/JavaScript/factorial-6.js b/Task/Factorial/JavaScript/factorial-6.js new file mode 100644 index 0000000000..a44b4b5f42 --- /dev/null +++ b/Task/Factorial/JavaScript/factorial-6.js @@ -0,0 +1 @@ +var factorial = n => (n < 2) ? 1 : n * factorial(n - 1); diff --git a/Task/Factorial/JavaScript/factorial-7.js b/Task/Factorial/JavaScript/factorial-7.js new file mode 100644 index 0000000000..1909b7d333 --- /dev/null +++ b/Task/Factorial/JavaScript/factorial-7.js @@ -0,0 +1,20 @@ +(function (n) { + 'use strict'; + + // factorial :: Int -> Int + let factorial = (n) => range(1, n).reduce(product, 1); + + + // product :: Num -> Num -> Num + let product = (a, b) => a * b, + + // range :: Int -> Int -> [Int] + range = (m, n) => + Array.from({ + length: (n - m) + 1 + }, (_, i) => m + i) + + + return factorial(n); + +})(18); diff --git a/Task/Factorial/Kotlin/factorial.kotlin b/Task/Factorial/Kotlin/factorial.kotlin new file mode 100644 index 0000000000..b259f35c70 --- /dev/null +++ b/Task/Factorial/Kotlin/factorial.kotlin @@ -0,0 +1,20 @@ +fun facti(n: Int) = when { + n < 0 -> throw IllegalArgumentException("negative numbers not allowed") + else -> { + var ans = 1L + for (i in 2..n) ans *= i + ans + } +} + +fun factr(n: Int): Long = when { + n < 0 -> throw IllegalArgumentException("negative numbers not allowed") + n < 2 -> 1L + else -> n * factr(n - 1) +} + +fun main(args: Array) { + val n = 20 + println("$n! = " + facti(n)) + println("$n! = " + factr(n)) +} diff --git a/Task/Factorial/LOLCODE/factorial.lol b/Task/Factorial/LOLCODE/factorial.lol new file mode 100644 index 0000000000..6a9174f46e --- /dev/null +++ b/Task/Factorial/LOLCODE/factorial.lol @@ -0,0 +1,16 @@ +HAI 1.3 + +HOW IZ I Faktorial YR Number + BOTH SAEM 1 AN BIGGR OF Number AN 1 + O RLY? + YA RLY + FOUND YR 1 + NO WAI + FOUND YR PRODUKT OF Number AN I IZ Faktorial YR DIFFRENCE OF Number AN 1 MKAY + OIC +IF U SAY SO + +IM IN YR Loop UPPIN YR Index WILE DIFFRINT Index AN 13 + VISIBLE Index "! = " I IZ Faktorial YR Index MKAY +IM OUTTA YR Loop +KTHXBYE diff --git a/Task/Factorial/Lua/factorial-3.lua b/Task/Factorial/Lua/factorial-3.lua new file mode 100644 index 0000000000..adc76d41b6 --- /dev/null +++ b/Task/Factorial/Lua/factorial-3.lua @@ -0,0 +1,7 @@ +fact = setmetatable({[0] = 1}, { + __call = function(t,n) + if n < 0 then return 0 end + if not t[n] then t[n] = n * t(n-1) end + return t[n] + end +}) diff --git a/Task/Factorial/MIPS-Assembly/factorial.mips b/Task/Factorial/MIPS-Assembly/factorial.mips new file mode 100644 index 0000000000..e114ab8aa4 --- /dev/null +++ b/Task/Factorial/MIPS-Assembly/factorial.mips @@ -0,0 +1,48 @@ +################################## +# Factorial; iterative # +# By Keith Stellyes :) # +# Targets Mars implementation # +# August 24, 2016 # +################################## + +# This example reads an integer from user, stores in register a1 +# Then, it uses a0 as a multiplier and target, it is set to 1 + +# Pseudocode: +# a0 = 1 +# a1 = read_int_from_user() +# while(a1 > 1) +# { +# a0 = a0*a1 +# DECREMENT a1 +# } +# print(a0) + +.text ### PROGRAM BEGIN ### + ### GET INTEGER FROM USER ### + li $v0, 5 #set syscall arg to READ_INTEGER + syscall #make the syscall + move $a1, $v0 #int from READ_INTEGER is returned in $v0, but we need $v0 + #this will be used as a counter + + ### SET $a1 TO INITAL VALUE OF 1 AS MULTIPLIER ### + li $a0,1 + + ### Multiply our multiplier, $a1 by our counter, $a0 then store in $a1 ### +loop: ble $a1,1,exit # If the counter is greater than 1, go back to start + mul $a0,$a0,$a1 #a1 = a1*a0 + + subi $a1,$a1,1 # Decrement counter + + j loop # Go back to start + +exit: + ### PRINT RESULT ### + li $v0,1 #set syscall arg to PRINT_INTEGER + #NOTE: syscall 1 (PRINT_INTEGER) takes a0 as its argument. Conveniently, that + # is our result. + syscall #make the syscall + + #exit + li $v0, 10 #set syscall arg to EXIT + syscall #make the syscall diff --git a/Task/Factorial/Neko/factorial.neko b/Task/Factorial/Neko/factorial.neko new file mode 100644 index 0000000000..1e835fb505 --- /dev/null +++ b/Task/Factorial/Neko/factorial.neko @@ -0,0 +1,13 @@ +var factorial = function(number) { + var i = 1; + var result = 1; + + while(i <= number) { + result *= i; + i += 1; + } + + return result; +}; + +$print(factorial(10)); diff --git a/Task/Factorial/Perl-6/factorial-1.pl6 b/Task/Factorial/Perl-6/factorial-1.pl6 index b529869a7a..95abfb4d27 100644 --- a/Task/Factorial/Perl-6/factorial-1.pl6 +++ b/Task/Factorial/Perl-6/factorial-1.pl6 @@ -1,2 +1,2 @@ -sub postfix: ( UInt:D $n ) is looser(&prefix:<->) { [*] 2..$n } +sub postfix: (Int $n) { [*] 2..$n } say 5!; diff --git a/Task/Factorial/Prolog/factorial-2.pro b/Task/Factorial/Prolog/factorial-2.pro index 71c8127db5..f50a59b02e 100644 --- a/Task/Factorial/Prolog/factorial-2.pro +++ b/Task/Factorial/Prolog/factorial-2.pro @@ -3,6 +3,6 @@ fact(N, NF) :- fact(X, X, F, F) :- !. fact(X, N, FX, F) :- - FX1 is FX * X, X1 is X + 1, + FX1 is FX * X1, fact(X1, N, FX1, F). diff --git a/Task/Factorial/Python/factorial-4.py b/Task/Factorial/Python/factorial-4.py index 2e8331bac3..5bf8836512 100644 --- a/Task/Factorial/Python/factorial-4.py +++ b/Task/Factorial/Python/factorial-4.py @@ -1,27 +1,5 @@ -from cmath import * - -# Coefficients used by the GNU Scientific Library -g = 7 -p = [0.99999999999980993, 676.5203681218851, -1259.1392167224028, - 771.32342877765313, -176.61502916214059, 12.507343278686905, - -0.13857109526572012, 9.9843695780195716e-6, 1.5056327351493116e-7] - -def gamma(z): - z = complex(z) - # Reflection formula - if z.real < 0.5: - return pi / (sin(pi*z)*gamma(1-z)) - else: - z -= 1 - x = p[0] - for i in range(1, g+2): - x += p[i]/(z+i) - t = z + g + 0.5 - return sqrt(2*pi) * t**(z+0.5) * exp(-t) * x - def factorial(n): - return gamma(n+1) - -print "factorial(-0.5)**2=",factorial(-0.5)**2 -for i in range(10): - print "factorial(%d)=%s"%(i,factorial(i)) + z=1 + if n>1: + z=n*factorial(n-1) + return z diff --git a/Task/Factorial/Python/factorial-5.py b/Task/Factorial/Python/factorial-5.py index 5bf8836512..2e8331bac3 100644 --- a/Task/Factorial/Python/factorial-5.py +++ b/Task/Factorial/Python/factorial-5.py @@ -1,5 +1,27 @@ +from cmath import * + +# Coefficients used by the GNU Scientific Library +g = 7 +p = [0.99999999999980993, 676.5203681218851, -1259.1392167224028, + 771.32342877765313, -176.61502916214059, 12.507343278686905, + -0.13857109526572012, 9.9843695780195716e-6, 1.5056327351493116e-7] + +def gamma(z): + z = complex(z) + # Reflection formula + if z.real < 0.5: + return pi / (sin(pi*z)*gamma(1-z)) + else: + z -= 1 + x = p[0] + for i in range(1, g+2): + x += p[i]/(z+i) + t = z + g + 0.5 + return sqrt(2*pi) * t**(z+0.5) * exp(-t) * x + def factorial(n): - z=1 - if n>1: - z=n*factorial(n-1) - return z + return gamma(n+1) + +print "factorial(-0.5)**2=",factorial(-0.5)**2 +for i in range(10): + print "factorial(%d)=%s"%(i,factorial(i)) diff --git a/Task/Factorial/REXX/factorial-1.rexx b/Task/Factorial/REXX/factorial-1.rexx index 9d45e4c027..f721bc38e7 100644 --- a/Task/Factorial/REXX/factorial-1.rexx +++ b/Task/Factorial/REXX/factorial-1.rexx @@ -1,21 +1,18 @@ -/*REXX program computes the factorial of a non-negative integer. */ -numeric digits 100000 /*100k digs: handles N up to 25k.*/ -parse arg n /*get argument from command line. */ -if n='' then call er 'no argument specified' -if arg()>1 | words(n)>1 then call er 'too many arguments specified.' -if \datatype(n,'N') then call er "argument isn't numeric: " n -if \datatype(n,'W') then call er "argument isn't a whole number: " n -if n<0 then call er "argument can't be negative: " n -!=1 /*define factorial product so far.*/ +/*REXX program computes the factorial of a non-negative integer. */ +numeric digits 100000 /*100k digits: handles N up to 25k.*/ +parse arg n /*obtain optional argument from the CL.*/ +if n='' then call er 'no argument specified.' +if arg()>1 | words(n)>1 then call er 'too many arguments specified.' +if \datatype(n,'N') then call er "argument isn't numeric: " n +if \datatype(n,'W') then call er "argument isn't a whole number: " n +if n<0 then call er "argument can't be negative: " n +!=1 /*define the factorial product (so far)*/ + do j=2 to n; !=!*j /*compute the factorial the hard way. */ + end /*j*/ /* [↑] where da rubber meets da road. */ -/*══════════════════════════════════════where da rubber meets da road──┐*/ - do j=2 to n; !=!*j /*compute the ! the hard way◄───┘*/ - end /*j*/ -/*══════════════════════════════════════════════════════════════════════*/ - -say n'! is ['length(!) "digits]:" /*display # of digits in factorial*/ -say /*add some whitespace to output. */ -say !/1 /*normalize the factorial product.*/ -exit /*stick a fork in it, we're done. */ -/*─────────────────────────────────ER subroutine────────────────────────*/ -er: say; say '***error!***'; say; say arg(1); say; say; exit 13 +say n'! is ['length(!) "digits]:" /*display number of digits in factorial*/ +say /*add some whitespace to the output. */ +say ! /*display the factorial product. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +er: say; say '***error***'; say; say arg(1); say; exit 13 diff --git a/Task/Factorial/REXX/factorial-2.rexx b/Task/Factorial/REXX/factorial-2.rexx index 1e2a3c0beb..cf0d79b940 100644 --- a/Task/Factorial/REXX/factorial-2.rexx +++ b/Task/Factorial/REXX/factorial-2.rexx @@ -1,53 +1,22 @@ -/*REXX program computes the factorial of a non-negative integer, and */ -/* automatically adjusts the number of digits to accommodate the answer.*/ -/* ┌────────────────────────────────────────────────────────────────┐ - │ ───── Some factorial lengths ───── │ - │ │ - │ 10 ! = 7 digits │ - │ 20 ! = 19 digits │ - │ 52 ! = 68 digits │ - │ 104 ! = 167 digits │ - │ 208 ! = 394 digits │ - │ 416 ! = 394 digits (8 deck shoe) │ - │ │ - │ 1k ! = 2,568 digits │ - │ 10k ! = 35,660 digits │ - │ 100k ! = 456,574 digits │ - │ │ - │ 1m ! = 5,565,709 digits │ - │ 10m ! = 65,657,060 digits │ - │ 100m ! = 756,570,556 digits │ - │ │ - │ Only one result is shown below for pratical reasons. │ - │ │ - │ This version of the REXX interpreter is essentially limited │ - │ to around 8 million digits, but with some programming │ - │ tricks, it could yield a result up to ≈ 16 million digits. │ - │ │ - │ Also, the Regina REXX interpreter is limited to an exponent │ - │ 9 digits, i.e.: 9.999...999e+999999999 │ - └────────────────────────────────────────────────────────────────┘ */ -numeric digits 99 /*99 digs initially, then expanded*/ -numeric form /*exponentiated #s =scientric form*/ -parse arg n /*get argument from command line. */ -if n='' then call er 'no argument specified' -if arg()>1 | words(n)>1 then call er 'too many arguments specified.' -if \datatype(n,'N') then call er "argument isn't numeric: " n -if \datatype(n,'W') then call er "argument isn't a whole number: " n -if n<0 then call er "argument can't be negative: " n -!=1 /*define factorial product so far.*/ +/*REXX program computes the factorial of a non-negative integer, and it automatically */ +/*────────────────────── adjusts the number of decimal digits to accommodate the answer.*/ +numeric digits 99 /*99 digits initially, then expanded. */ +parse arg n /*obtain optional argument from the CL.*/ +if n='' then call er 'no argument specified' +if arg()>1 | words(n)>1 then call er 'too many arguments specified.' +if \datatype(n,'N') then call er "argument isn't numeric: " n +if \datatype(n,'W') then call er "argument isn't a whole number: " n +if n<0 then call er "argument can't be negative: " n +!=1 /*define the factorial product (so far)*/ + do j=2 to n; !=!*j /*compute the factorial the hard way. */ + if pos(.,!)==0 then iterate /*is the ! in exponential notation? */ + parse var ! 'E' digs /*extract exponent of the factorial, */ + numeric digits digs+digs%10 /* ··· and increase it by ten percent.*/ + end /*j*/ /* [↑] where da rubber meets da road. */ -/*══════════════════════════════════════where da rubber meets da road──┐*/ - do j=2 to n; !=!*j /*compute the ! the hard way◄───┘*/ - if pos('E',!)==0 then iterate /*is ! in exponential notation? */ - parse var ! 'E' digs /*pick off the factorial exponent.*/ - numeric digits digs+digs%10 /* and incease it by ten percent.*/ - end /*j*/ -/*══════════════════════════════════════════════════════════════════════*/ - -say n'! is ['length(!) "digits]:" /*display # of digits in factorial*/ -say /*add some whitespace to output. */ -say !/1 /*normalize the factorial product.*/ -exit /*stick a fork in it, we're done. */ -/*─────────────────────────────────ER subroutine────────────────────────*/ -er: say; say '***error!***'; say; say arg(1); say; say; exit 13 +say n'! is ['length(!) "digits]:" /*display number of digits in factorial*/ +say /*add some whitespace to the output. */ +say !/1 /*normalize the factorial product. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +er: say; say '***error!***'; say; say arg(1); say; exit 13 diff --git a/Task/Factorial/REXX/factorial-3.rexx b/Task/Factorial/REXX/factorial-3.rexx index 33103af367..8f8ca3340a 100644 --- a/Task/Factorial/REXX/factorial-3.rexx +++ b/Task/Factorial/REXX/factorial-3.rexx @@ -1,27 +1,28 @@ -/*REXX program computes the factorial of a number, striping trailing 0's*/ -numeric digits 200 /*start with two hundred digits. */ -parse arg N .; if N=='' then N=0 /*get argument from command line.*/ -!=1 /*define factorial produce so far*/ -/*═══════════════════════════════════════where the rubber meets the road*/ - do j=2 to N /*compute factorial the hard way.*/ - old!=! /*save old ! in case of overflow.*/ - !=!*j /*multiple old factorial with J.*/ - if pos('E',!)\==0 then do /*is ! in exponential notation?*/ - d=digits() /*D temporarly stores # digits.*/ - numeric digits d+d%10 /*add 10% do digits.*/ - !=old!*j /*recalculate for the lost digits*/ - end /*IFF ≡ if and only if. [↓] */ - if right(!,1)==0 then !=strip(!,,0) /*strip trailing zeroes IFF the*/ - end /*j*/ /* [↑] right-most digit is zero.*/ -z=0 /*the number of trailing zeroes. */ - do v=5 by 0 while v<=N /*calculate # of trailing zeroes.*/ - z=z+N%v /*bump Z if multiple power of 5. */ - v=v*5 /*calculate the next power of 5. */ - end /*while v≤N*/ /* [↑] advance V by ourselves.*/ -/*══════════════════════════════════════════════════════════════════════*/ -!=! || copies(0,z) /*add water to rehydrate the !. */ -if z==0 then z='no' /*use gooder English for message.*/ -say N'! is ['length(!) " digits with " z ' trailing zeroes]:' -say /*display blank line (whitespace)*/ -say ! /* ··· and display the ! product.*/ - /*stick a fork in it, we're done.*/ +/*REXX program computes the factorial of an integer, striping trailing zeroes. */ +numeric digits 200 /*start with two hundred digits. */ +parse arg N .; if N=='' then N=0 /*obtain the optional argument from CL.*/ + +!=1 /*define the factorial product so far. */ + do j=2 to N /*compute factorial the hard way. */ + old!=! /*save old product in case of overflow.*/ + !=!*j /*multiple the old factorial with J. */ + if pos(.,!) \==0 then do /*is the ! in exponential notation?*/ + d=digits() /*D temporarily stores number digits.*/ + numeric digits d+d%10 /*add 10% to the decimal digits. */ + !=old! * j /*re─calculate for the "lost" digits.*/ + end /*IFF ≡ if and only if. [↓] */ + parse var ! '' -1 _ /*obtain the right-most digit of ! */ + if _==0 then !=strip(!,,0) /*strip trailing zeroes IFF the ... */ + end /*j*/ /* [↑] ... right-most digit is zero. */ +z=0 /*the number of trailing zeroes in ! */ + do v=5 by 0 while v<=N /*calculate number of trailing zeroes. */ + z=z + N%v /*bump Z if multiple power of five.*/ + v=v*5 /*calculate the next power of five. */ + end /*v*/ /* [↑] we only advance V by ourself.*/ + +!=! || copies(0, z) /*add water to rehydrate the product. */ +if z==0 then z='no' /*use gooder English for the message. */ +say N'! is ['length(!) " digits with " z ' trailing zeroes]:' +say /*display blank line (for whitespace).*/ +say ! /*display the factorial product. */ + /*stick a fork in it, we're all done. */ diff --git a/Task/Factorial/Ruby/factorial.rb b/Task/Factorial/Ruby/factorial.rb index b23e8d242a..33da8847d5 100644 --- a/Task/Factorial/Ruby/factorial.rb +++ b/Task/Factorial/Ruby/factorial.rb @@ -16,8 +16,7 @@ end # Iterative with Range#inject def factorial_inject(n) - return 1 if n.zero? - (1..n).inject { |prod, i| prod * i } + (1..n).inject(1){ |prod, i| prod * i } end # Iterative with Range#reduce, requires Ruby 1.8.7 diff --git a/Task/Factorial/Seed7/factorial-1.seed7 b/Task/Factorial/Seed7/factorial-1.seed7 index 7f4db853d3..8ecdbe8225 100644 --- a/Task/Factorial/Seed7/factorial-1.seed7 +++ b/Task/Factorial/Seed7/factorial-1.seed7 @@ -1,10 +1,10 @@ const func bigInteger: factorial (in bigInteger: n) is func result - var bigInteger: result is 1_; + var bigInteger: fact is 1_; local var bigInteger: i is 0_; begin for i range 1_ to n do - result *:= i; + fact *:= i; end for; end func; diff --git a/Task/Factorial/Seed7/factorial-2.seed7 b/Task/Factorial/Seed7/factorial-2.seed7 index 8e0c44ff70..859b2b05c5 100644 --- a/Task/Factorial/Seed7/factorial-2.seed7 +++ b/Task/Factorial/Seed7/factorial-2.seed7 @@ -1,8 +1,8 @@ const func bigInteger: factorial (in bigInteger: n) is func result - var bigInteger: result is 1_; + var bigInteger: fact is 1_; begin if n > 1_ then - result := n * factorial(pred(n)); + fact := n * factorial(pred(n)); end if; end func; diff --git a/Task/Factorial/Simula/factorial.simula b/Task/Factorial/Simula/factorial.simula new file mode 100644 index 0000000000..e221db265c --- /dev/null +++ b/Task/Factorial/Simula/factorial.simula @@ -0,0 +1,14 @@ +begin + integer procedure factorial( n ); + integer n; + begin + integer fact, i; + fact := 1; + if n > 1 then + for i := 2 step 1 until n do + fact := fact * i; + factorial := fact + end; + outint( factorial( 6 ), 5); + outimage +end diff --git a/Task/Factorial/Vim-Script/factorial.vim b/Task/Factorial/Vim-Script/factorial.vim new file mode 100644 index 0000000000..257a912caa --- /dev/null +++ b/Task/Factorial/Vim-Script/factorial.vim @@ -0,0 +1,7 @@ +function! Factorial(n) + if a:n < 2 + return 1 + else + return a:n * Factorial(a:n-1) + endif +endfunction diff --git a/Task/Factors-of-a-Mersenne-number/00DESCRIPTION b/Task/Factors-of-a-Mersenne-number/00DESCRIPTION index 07672ca7e3..0de4dde3f3 100644 --- a/Task/Factors-of-a-Mersenne-number/00DESCRIPTION +++ b/Task/Factors-of-a-Mersenne-number/00DESCRIPTION @@ -36,8 +36,11 @@ As in other trial division algorithms, the algorithm stops when 2kP+1 > sqrt(N). These primality tests only work on Mersenne numbers where P is prime. For example, M4=15 yields no factors using these techniques, but factors into 3 and 5, neither of which fit 2kP+1. + ;Task: Using the above method find a factor of 2929-1 (aka M929) -;See also: + +;Related task: * [https://www.youtube.com/watch?v=SNwvJ7psoow Computers in 1948: 2¹²⁷-1]
    +

    diff --git a/Task/Factors-of-a-Mersenne-number/Clojure/factors-of-a-mersenne-number.clj b/Task/Factors-of-a-Mersenne-number/Clojure/factors-of-a-mersenne-number.clj new file mode 100644 index 0000000000..617bfc0984 --- /dev/null +++ b/Task/Factors-of-a-Mersenne-number/Clojure/factors-of-a-mersenne-number.clj @@ -0,0 +1,58 @@ +(ns mersennenumber + (:gen-class)) + +(defn m* [p q m] + " Computes (p*q) mod m " + (mod (*' p q) m)) + +(defn power + "modular exponentiation (i.e. b^e mod m" + [b e m] + (loop [b b, e e, x 1] + (if (zero? e) + x + (if (even? e) (recur (m* b b m) (quot e 2) x) + (recur (m* b b m) (quot e 2) (m* b x m)))))) + +(defn divides? [k n] + " checks if k divides n " + (= (rem n k) 0)) + +(defn is-prime? [n] + " checks if n is prime " + (cond + (< n 2) false ; 0, 1 not prime (i.e. primes are greater than one) + (= n 2) true ; 2 is prime + (= 0 (mod n 2)) false ; all other evens are not prime + :else ; check for divisors up to sqrt(n) + (empty? (filter #(divides? % n) (take-while #(<= (* % %) n) (range 2 n)))))) + +;; Max k to check +(def MAX-K 16384) + +(defn trial-factor [p k] + " check if k satisfies 2*k*P + 1 divides 2^p - 1 " + (let [q (+ (* 2 p k) 1) + mq (mod q 8)] + (cond + (not (is-prime? q)) nil + (and (not= 1 mq) + (not= 7 mq)) nil + (= 1 (power 2 p q)) q + :else nil))) + +(defn m-factor [p] + " searches for k-factor " + (some #(trial-factor p %) (range 16384))) + +(defn -main [p] + (if-not (is-prime? p) + (format "M%d = 2^%d - 1 exponent is not prime" p p) + (if-let [factor (m-factor p)] + (format "M%d = 2^%d - 1 is composite with factor %d" p p factor) + (format "M%d = 2^%d - 1 is prime" p p)))) + +;; Tests different p values +(doseq [p [2,3,4,5,7,11,13,17,19,23,29,31,37,41,43,47,53,929] + :let [s (-main p)]] + (println s)) diff --git a/Task/Factors-of-a-Mersenne-number/Haskell/factors-of-a-mersenne-number-1.hs b/Task/Factors-of-a-Mersenne-number/Haskell/factors-of-a-mersenne-number-1.hs index 4799b5e1c1..1cab859c71 100644 --- a/Task/Factors-of-a-Mersenne-number/Haskell/factors-of-a-mersenne-number-1.hs +++ b/Task/Factors-of-a-Mersenne-number/Haskell/factors-of-a-mersenne-number-1.hs @@ -1,5 +1,5 @@ import Data.List -import HFM.Primes(isPrime) +import HFM.Primes (isPrime) import Control.Monad import Control.Arrow diff --git a/Task/Factors-of-a-Mersenne-number/Perl-6/factors-of-a-mersenne-number.pl6 b/Task/Factors-of-a-Mersenne-number/Perl-6/factors-of-a-mersenne-number.pl6 index c2aa371888..c99f1e92bd 100644 --- a/Task/Factors-of-a-Mersenne-number/Perl-6/factors-of-a-mersenne-number.pl6 +++ b/Task/Factors-of-a-Mersenne-number/Perl-6/factors-of-a-mersenne-number.pl6 @@ -26,7 +26,7 @@ sub mtest($bits, $p) { my @bits = $bits.base(2).comb; loop (my $sq = 1; @bits; $sq %= $p) { $sq *= $sq; - $sq += $sq if @bits.shift; + $sq += $sq if 1 == @bits.shift; } $sq == 1; } diff --git a/Task/Factors-of-an-integer/00DESCRIPTION b/Task/Factors-of-an-integer/00DESCRIPTION index aa3f2090df..c9104f9e64 100644 --- a/Task/Factors-of-an-integer/00DESCRIPTION +++ b/Task/Factors-of-an-integer/00DESCRIPTION @@ -1,10 +1,17 @@ - {{basic data operation}} +{{basic data operation}} [[Category:Arithmetic operations]] [[Category:Mathematical_operations]] -Compute the [[wp:Divisor|factors]] of a positive integer. -These factors are the positive integers by which the number being factored can be divided to yield a positive integer result. -(Though the concepts function correctly for zero and negative integers, the set of factors of zero has countably infinite members, and the factors of negative integers can be obtained from the factors of related positive numbers without difficulty; this task does not require handling of either of these cases). -Note that every prime number has two factors; ‘1’ and itself. -See also: -* [[Prime decomposition]] +;Task: +Compute the   [[wp:Divisor|factors]]   of a positive integer. + +These factors are the positive integers by which the number being factored can be divided to yield a positive integer result. + +(Though the concepts function correctly for zero and negative integers, the set of factors of zero has countably infinite members, and the factors of negative integers can be obtained from the factors of related positive numbers without difficulty;   this task does not require handling of either of these cases). + +Note that every prime number has two factors:   '''1'''   and itself. + + +;Related task: +*   [[Prime decomposition]] +

    diff --git a/Task/Factors-of-an-integer/ALGOL-W/factors-of-an-integer.alg b/Task/Factors-of-an-integer/ALGOL-W/factors-of-an-integer.alg new file mode 100644 index 0000000000..f09a33cdf5 --- /dev/null +++ b/Task/Factors-of-an-integer/ALGOL-W/factors-of-an-integer.alg @@ -0,0 +1,52 @@ +begin + % return the factors of n ( n should be >= 1 ) in the array factor % + % the bounds of factor should be 0 :: len (len must be at least 1) % + % the number of factors will be returned in factor( 0 ) % + procedure getFactorsOf ( integer value n + ; integer array factor( * ) + ; integer value len + ) ; + begin + for i := 0 until len do factor( i ) := 0; + if n >= 1 and len >= 1 then begin + integer pos, lastFactor; + factor( 0 ) := factor( 1 ) := pos := 1; + % find the factors up to sqrt( n ) % + for f := 2 until truncate( sqrt( n ) ) + 1 do begin + if ( n rem f ) = 0 and pos <= len then begin + % found another factor and there's room to store it % + pos := pos + 1; + factor( 0 ) := pos; + factor( pos ) := f + end if_found_factor + end for_f; + % find the factors above sqrt( n ) % + lastFactor := factor( factor( 0 ) ); + for f := factor( 0 ) step -1 until 1 do begin + integer newFactor; + newFactor := n div factor( f ); + if newFactor > lastFactor and pos <= len then begin + % found another factor and there's room to store it % + pos := pos + 1; + factor( 0 ) := pos; + factor( pos ) := newFactor + end if_found_factor + end for_f; + end if_params_ok + end getFactorsOf ; + + + % prpocedure to test getFactorsOf % + procedure testFactorsOf( integer value n ) ; + begin + integer array factor( 0 :: 100 ); + getFactorsOf( n, factor, 100 ); + i_w := 1; s_w := 0; % set output format % + write( n, " has ", factor( 0 ), " factors:" ); + for f := 1 until factor( 0 ) do writeon( " ", factor( f ) ) + end testFactorsOf ; + + % test the factorising % + for i := 1 until 100 do testFactorsOf( i ) + +end. diff --git a/Task/Factors-of-an-integer/AppleScript/factors-of-an-integer-1.applescript b/Task/Factors-of-an-integer/AppleScript/factors-of-an-integer-1.applescript new file mode 100644 index 0000000000..6db19874d2 --- /dev/null +++ b/Task/Factors-of-an-integer/AppleScript/factors-of-an-integer-1.applescript @@ -0,0 +1,95 @@ +-- integerFactors :: Int -> [Int] +on integerFactors(n) + if n = 1 then + {1} + else + set realRoot to n ^ (1 / 2) + set intRoot to realRoot as integer + set blnPerfectSquare to intRoot = realRoot + + -- isFactor :: Int -> Bool + script isFactor + on lambda(x) + (n mod x) = 0 + end lambda + end script + + -- Factors up to square root of n, + set lows to filter(isFactor, range(1, intRoot)) + + -- integerQuotient :: Int -> Int + script integerQuotient + on lambda(x) + (n / x) as integer + end lambda + end script + + -- and quotients of these factors beyond the square root. + lows & map(integerQuotient, ¬ + items (1 + (blnPerfectSquare as integer)) thru -1 of reverse of lows) + end if +end integerFactors + + +-- TEST +on run + + integerFactors(120) + + --> {1, 2, 3, 4, 5, 6, 8, 10, 12, 15, 20, 24, 30, 40, 60, 120} +end run + + + +-- GENERIC LIBRARY FUNCTIONS + +-- 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 + +-- 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 + +-- range :: Int -> Int -> [Int] +on range(m, n) + if n < m then + set d to -1 + else + set d to 1 + end if + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range + +-- 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 diff --git a/Task/Factors-of-an-integer/AppleScript/factors-of-an-integer-2.applescript b/Task/Factors-of-an-integer/AppleScript/factors-of-an-integer-2.applescript new file mode 100644 index 0000000000..e11a37f27f --- /dev/null +++ b/Task/Factors-of-an-integer/AppleScript/factors-of-an-integer-2.applescript @@ -0,0 +1 @@ +{1, 2, 3, 4, 5, 6, 8, 10, 12, 15, 20, 24, 30, 40, 60, 120} diff --git a/Task/Factors-of-an-integer/COBOL/factors-of-an-integer.cobol b/Task/Factors-of-an-integer/COBOL/factors-of-an-integer.cobol new file mode 100644 index 0000000000..107623e3fa --- /dev/null +++ b/Task/Factors-of-an-integer/COBOL/factors-of-an-integer.cobol @@ -0,0 +1,40 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. FACTORS. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 CALCULATING. + 03 NUM USAGE BINARY-LONG VALUE ZERO. + 03 LIM USAGE BINARY-LONG VALUE ZERO. + 03 CNT USAGE BINARY-LONG VALUE ZERO. + 03 DIV USAGE BINARY-LONG VALUE ZERO. + 03 REM USAGE BINARY-LONG VALUE ZERO. + 03 ZRS USAGE BINARY-SHORT VALUE ZERO. + + 01 DISPLAYING. + 03 DIS PIC 9(10) USAGE DISPLAY. + + PROCEDURE DIVISION. + MAIN-PROCEDURE. + DISPLAY "Factors of? " WITH NO ADVANCING + ACCEPT NUM + DIVIDE NUM BY 2 GIVING LIM. + + PERFORM VARYING CNT FROM 1 BY 1 UNTIL CNT > LIM + DIVIDE NUM BY CNT GIVING DIV REMAINDER REM + IF REM = 0 + MOVE CNT TO DIS + PERFORM SHODIS + END-IF + END-PERFORM. + + MOVE NUM TO DIS. + PERFORM SHODIS. + STOP RUN. + + SHODIS. + MOVE ZERO TO ZRS. + INSPECT DIS TALLYING ZRS FOR LEADING ZERO. + DISPLAY DIS(ZRS + 1:) + EXIT PARAGRAPH. + + END PROGRAM FACTORS. diff --git a/Task/Factors-of-an-integer/Elixir/factors-of-an-integer.elixir b/Task/Factors-of-an-integer/Elixir/factors-of-an-integer.elixir index 517619497c..4433547d5e 100644 --- a/Task/Factors-of-an-integer/Elixir/factors-of-an-integer.elixir +++ b/Task/Factors-of-an-integer/Elixir/factors-of-an-integer.elixir @@ -3,8 +3,24 @@ defmodule RC do def factor(n) do (for i <- 1..div(n,2), rem(n,i)==0, do: i) ++ [n] end + + # Recursive (faster version); + def divisor(n), do: divisor(n, 1, []) |> Enum.sort + + defp divisor(n, i, factors) when n < i*i , do: factors + defp divisor(n, i, factors) when n == i*i , do: [i | factors] + defp divisor(n, i, factors) when rem(n,i)==0, do: divisor(n, i+1, [i, div(n,i) | factors]) + defp divisor(n, i, factors) , do: divisor(n, i+1, factors) end -Enum.each([45, 53, 64], fn n -> +Enum.each([45, 53, 60, 64], fn n -> IO.puts "#{n}: #{inspect RC.factor(n)}" end) + +IO.puts "\nRange: #{inspect range = 1..10000}" +funs = [ factor: &RC.factor/1, + divisor: &RC.divisor/1 ] +Enum.each(funs, fn {name, fun} -> + {time, value} = :timer.tc(fn -> Enum.count(range, &length(fun.(&1))==2) end) + IO.puts "#{name}\t prime count : #{value},\t#{time/1000000} sec" +end) diff --git a/Task/Factors-of-an-integer/Fish/factors-of-an-integer.fish b/Task/Factors-of-an-integer/Fish/factors-of-an-integer.fish new file mode 100644 index 0000000000..bab02ed253 --- /dev/null +++ b/Task/Factors-of-an-integer/Fish/factors-of-an-integer.fish @@ -0,0 +1,4 @@ +0v + >i:0(?v'0'%+a* + >~a,:1:>r{% ?vr:nr','ov + ^:&:;?(&:+1r:< < diff --git a/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-1.hs b/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-1.hs index e30a3bf116..c8a10c2bf0 100644 --- a/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-1.hs +++ b/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-1.hs @@ -1,5 +1,8 @@ -import HFM.Primes(primePowerFactors) -import Data.List +import HFM.Primes (primePowerFactors) +import Control.Monad (mapM) +import Data.List (product) -factors = map product. - mapM (uncurry((. enumFromTo 0) . map .(^) )) . primePowerFactors +-- primePowerFactors :: Integer -> [(Integer,Int)] + +factors = map product . + mapM (\(p,m)-> [p^i | i<-[0..m]]) . primePowerFactors diff --git a/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-2.hs b/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-2.hs index 9c8b0dc7ea..89c2860290 100644 --- a/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-2.hs +++ b/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-2.hs @@ -1 +1,2 @@ -factors_naive n = [i | i <-[1..n], (mod n i) == 0] +~> factors 42 +[1,7,3,21,2,14,6,42] diff --git a/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-3.hs b/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-3.hs index 4865b7dedb..09f641e0c1 100644 --- a/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-3.hs +++ b/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-3.hs @@ -1,2 +1,2 @@ -factors_naive 6 -[1,2,3,6] +import Data.List (group) +primePowerFactors = map (\x-> (head x, length x)) . group . factorize diff --git a/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-4.hs b/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-4.hs index 6d8edc4c4b..9c7d2f29a7 100644 --- a/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-4.hs +++ b/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-4.hs @@ -1,7 +1 @@ -import Data.List -tuple_to_list lt = (fst lt) ++ (snd lt) -factors_co n = sort (tuple_to_list(unzip - [ (j, (div n j)) | j <- - [i | i <- - [1..truncate (sqrt (fromIntegral n))] - , (mod n i) == 0]] )) +factors_naive n = [i | i <-[1..n], mod n i == 0] diff --git a/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-5.hs b/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-5.hs index b89b91f1fd..0d8bf0cf0e 100644 --- a/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-5.hs +++ b/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-5.hs @@ -1,2 +1,2 @@ -factors_co 6 -[1,2,3,6] +~> factors_naive 25 +[1,5,25] diff --git a/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-6.hs b/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-6.hs index 767d88c834..f5db03ec62 100644 --- a/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-6.hs +++ b/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-6.hs @@ -1,3 +1,7 @@ import Data.List -factors n = lows ++ (reverse $ map (div n) lows) - where lows = filter ((== 0) . mod n) [1..truncate . sqrt $ fromIntegral n] +tuple_to_list xs = fst xs ++ snd xs +factors_co n = sort (tuple_to_list (unzip + [ (i, (div n i)) | i <- [1..floor (sqrt (fromIntegral n))-1] + , mod n i == 0]) ++ + [ i | i <- [floor (sqrt (fromIntegral n))] + , mod n i == 0]) diff --git a/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-7.hs b/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-7.hs index 25781a43b2..4e11691fa2 100644 --- a/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-7.hs +++ b/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-7.hs @@ -1,4 +1,5 @@ -*Main> :set +s -*Main> factors 120 -[1,2,3,4,5,6,8,10,12,15,20,24,30,40,60,120] -(0.01 secs, 7578656 bytes) +import Data.List +factors_o n = ds ++ [r | mod n r == 0] ++ reverse (map (n `div`) ds) + where + r = floor (sqrt (fromIntegral n)) + ds = [i | i <- [1..r-1], mod n i == 0] diff --git a/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-8.hs b/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-8.hs new file mode 100644 index 0000000000..958619c426 --- /dev/null +++ b/Task/Factors-of-an-integer/Haskell/factors-of-an-integer-8.hs @@ -0,0 +1,9 @@ +*Main> :set +s +~> factors_o 120 +[1,2,3,4,5,6,8,10,12,15,20,24,30,40,60,120] +(0.01 secs, 7578656 bytes) + +~> factors_o 12041111117 +[1,7,41,287,541,3787,22181,77551,155267,542857,3179591,22257137,41955091,2936856 +37,1720158731,12041111117] +(0.31 secs, 51583744 bytes) diff --git a/Task/Factors-of-an-integer/JavaScript/factors-of-an-integer-6.js b/Task/Factors-of-an-integer/JavaScript/factors-of-an-integer-6.js new file mode 100644 index 0000000000..9842ff9d0b --- /dev/null +++ b/Task/Factors-of-an-integer/JavaScript/factors-of-an-integer-6.js @@ -0,0 +1,73 @@ +(function (lstTest) { + 'use strict'; + + // INTEGER FACTORS + + // integerFactors :: Int -> [Int] + let integerFactors = (n) => { + let rRoot = Math.sqrt(n), + intRoot = Math.floor(rRoot), + + lows = range(1, intRoot) + .filter(x => (n % x) === 0); + + // for perfect squares, we can drop + // the head of the 'highs' list + return lows.concat(lows + .map(x => n / x) + .reverse() + .slice((rRoot === intRoot) | 0) + ); + }, + + // range :: Int -> Int -> [Int] + range = (m, n) => Array.from({ + length: (n - m) + 1 + }, (_, i) => m + i); + + + + + + /*************************** TESTING *****************************/ + + // TABULATION OF RESULTS IN SPACED AND ALIGNED COLUMNS + let alignedTable = (lstRows, lngPad, fnAligned) => { + var lstColWidths = range( + 0, lstRows + .reduce( + (a, x) => (x.length > a ? x.length : a), + 0 + ) - 1 + ) + .map((iCol) => lstRows + .reduce((a, lst) => { + let w = lst[iCol] ? lst[iCol].toString() + .length : 0; + return (w > a) ? w : a; + }, 0)); + + return lstRows.map((lstRow) => + lstRow.map((v, i) => fnAligned( + v, lstColWidths[i] + lngPad + )) + .join('') + ) + .join('\n'); + }, + + alignRight = (n, lngWidth) => { + let s = n.toString(); + return Array(lngWidth - s.length + 1) + .join(' ') + s; + }; + + // TEST + return '\nintegerFactors(n)\n\n' + alignedTable(lstTest + .map(integerFactors) + .map( + (x, i) => [lstTest[i], '-->'].concat(x) + ), 2, alignRight + ) + '\n'; + +})([25, 45, 53, 64, 100, 102, 120, 12345, 32766, 32767]); diff --git a/Task/Factors-of-an-integer/K/factors-of-an-integer.k b/Task/Factors-of-an-integer/K/factors-of-an-integer.k index 62f8cfb163..cbb5415ff8 100644 --- a/Task/Factors-of-an-integer/K/factors-of-an-integer.k +++ b/Task/Factors-of-an-integer/K/factors-of-an-integer.k @@ -1,10 +1,6 @@ - f:{d:&~x!'!1+_sqrt x;?d,_ x%|d} - - f 1 -1 - - f 3 -1 3 + f:{i:{y[&x=y*x div y]}[x;1+!_sqrt x];?i,x div|i} +equivalent to: +q)f:{i:{y where x=y*x div y}[x ; 1+ til floor sqrt x]; distinct i,x div reverse i} f 120 1 2 3 4 5 6 8 10 12 15 20 24 30 40 60 120 diff --git a/Task/Factors-of-an-integer/Liberty-BASIC/factors-of-an-integer-3.liberty b/Task/Factors-of-an-integer/Liberty-BASIC/factors-of-an-integer-3.liberty new file mode 100644 index 0000000000..17825594ba --- /dev/null +++ b/Task/Factors-of-an-integer/Liberty-BASIC/factors-of-an-integer-3.liberty @@ -0,0 +1,36 @@ +print "ROSETTA CODE - Factors of an integer" +'A simpler approach for smaller numbers +[Start] +print +input "Enter an integer (< 1,000,000): "; n +n=abs(int(n)): if n=0 then goto [Quit] +if n>999999 then goto [Start] +FactorCount=FactorCount(n) +select case FactorCount + case 1: print "The factor of 1 is: 1" + case else + print "The "; FactorCount; " factors of "; n; " are: "; + for x=1 to FactorCount + print " "; Factor(x); + next x + if FactorCount=2 then print " (Prime)" else print +end select +goto [Start] + +[Quit] +print "Program complete." +end + +function FactorCount(n) + dim Factor(100) + for y=1 to n + if y>sqr(n) and FactorCount=1 then +'If no second factor is found by the square root of n, then n is prime. + FactorCount=2: Factor(FactorCount)=n: exit function + end if + if (n mod y)=0 then + FactorCount=FactorCount+1 + Factor(FactorCount)=y + end if + next y +end function diff --git a/Task/Factors-of-an-integer/REXX/factors-of-an-integer-1.rexx b/Task/Factors-of-an-integer/REXX/factors-of-an-integer-1.rexx index a105698e2c..e89a005a8c 100644 --- a/Task/Factors-of-an-integer/REXX/factors-of-an-integer-1.rexx +++ b/Task/Factors-of-an-integer/REXX/factors-of-an-integer-1.rexx @@ -1,24 +1,26 @@ -/*REXX program displays divisors of any [negative/zero/positive] integer(s).*/ -parse arg bot top inc . /*optional args.*/ -top=word(top bot 20,1); bot=word(bot 1,1); inc=word(inc 1,1) /*range options.*/ -w=length(high)+1; numeric digits max(9,w); $='∞' /*digits for // */ -@.=left('',7); @.1='{unity}'; @.2='[prime]'; @.$=' {'$"} " /*some literals.*/ -say center('n',1+w) '#divisors' center('divisors',60) /*show a header.*/ -say copies('═',1+w) '═════════' copies('═' ,60) /* " " sep. */ - - do n=bot to top by inc; divs=divisors(n); #=words(divs) - if divs==$ then do; #=$; divs=' (infinite)'; end /*handle infinity*/ - p=@.#; if n<0 then p=@.. /*handle negative*/ - say center(n,w+1) center('['#"]",9) "──► " p ' ' divs - end /*n*/ /* [↑] process a range of integers. */ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -divisors: procedure; parse arg x; x=abs(x); if x==1 then return 1 -odd=x//2; b=x; if x==0 then return '∞' -a=1 /* [↓] process only EVEN│ODD integers.*/ - do j=2+odd by 1+odd while j*j Vec { + let mut factors: Vec = Vec::new(); // creates a new vector for the factors of the number + + for i in 1..((num as f32).sqrt() as i32 + 1) { + if num % i == 0 { + factors.push(i); // pushes smallest factor to factors + factors.push(num/i); // pushes largest factor to factors + } + } + factors.sort(); // sorts the factors into numerical order for viewing purposes + factors // returns the factors +} diff --git a/Task/Factors-of-an-integer/Scala/factors-of-an-integer.scala b/Task/Factors-of-an-integer/Scala/factors-of-an-integer.scala index 74c7833119..138a1f9fe2 100644 --- a/Task/Factors-of-an-integer/Scala/factors-of-an-integer.scala +++ b/Task/Factors-of-an-integer/Scala/factors-of-an-integer.scala @@ -1,5 +1,12 @@ +Brute force approach: + def factors(num: Int) = { (1 to num).filter { divisor => num % divisor == 0 } - } + +Since factors can't be higher than sqrt(num), the code above can be edited as follows + def factors(num: Int) = { + (1 to sqrt(num)).filter { divisor => + num % divisor == 0 + } diff --git a/Task/Factors-of-an-integer/ZX-Spectrum-Basic/factors-of-an-integer.zx b/Task/Factors-of-an-integer/ZX-Spectrum-Basic/factors-of-an-integer.zx new file mode 100644 index 0000000000..41fbf626fb --- /dev/null +++ b/Task/Factors-of-an-integer/ZX-Spectrum-Basic/factors-of-an-integer.zx @@ -0,0 +1,7 @@ +10 INPUT "Enter a number or 0 to exit: ";n +20 IF n=0 THEN STOP +30 PRINT "Factors of ";n;": "; +40 FOR i=1 TO n +50 IF FN m(n,i)=0 THEN PRINT i;" "; +60 NEXT i +70 DEF FN m(a,b)=a-INT (a/b)*b diff --git a/Task/Fast-Fourier-transform/00DESCRIPTION b/Task/Fast-Fourier-transform/00DESCRIPTION index 1626ad3386..1b45c2971b 100644 --- a/Task/Fast-Fourier-transform/00DESCRIPTION +++ b/Task/Fast-Fourier-transform/00DESCRIPTION @@ -1,10 +1,13 @@ {{omit from|GUISS}} -The purpose of this task is to calculate the FFT (Fast Fourier Transform) -of an input sequence.
    + +;Task: +Calculate the   FFT   (Fast Fourier Transform)   of an input sequence. + The most general case allows for complex numbers at the input and results in a sequence of equal length, again of complex numbers. If you need to restrict yourself to real numbers, the output should be the magnitude (i.e. sqrt(re²+im²)) of the complex result. -The classic version is the recursive Cooley–Tukey FFT. [http://en.wikipedia.org/wiki/Cooley–Tukey_FFT_algorithm Wikipedia] has pseudocode for that. +The classic version is the recursive Cooley–Tukey FFT. [http://en.wikipedia.org/wiki/Cooley–Tukey_FFT_algorithm Wikipedia] has pseudo-code for that. Further optimizations are possible but not required. +

    diff --git a/Task/Fast-Fourier-transform/C/fast-fourier-transform-1.c b/Task/Fast-Fourier-transform/C/fast-fourier-transform-1.c index 21c5b24912..72d8ca2a80 100644 --- a/Task/Fast-Fourier-transform/C/fast-fourier-transform-1.c +++ b/Task/Fast-Fourier-transform/C/fast-fourier-transform-1.c @@ -27,23 +27,24 @@ void fft(cplx buf[], int n) _fft(buf, out, n, 1); } + +void show(const char * s, cplx buf[]) { + printf("%s", s); + for (int i = 0; i < 8; i++) + if (!cimag(buf[i])) + printf("%g ", creal(buf[i])); + else + printf("(%g, %g) ", creal(buf[i]), cimag(buf[i])); +} + int main() { PI = atan2(1, 1) * 4; cplx buf[] = {1, 1, 1, 1, 0, 0, 0, 0}; - void show(const char * s) { - printf("%s", s); - for (int i = 0; i < 8; i++) - if (!cimag(buf[i])) - printf("%g ", creal(buf[i])); - else - printf("(%g, %g) ", creal(buf[i]), cimag(buf[i])); - } - - show("Data: "); + show("Data: ", buf); fft(buf, 8); - show("\nFFT : "); + show("\nFFT : ", buf); return 0; } diff --git a/Task/Fast-Fourier-transform/C/fast-fourier-transform-2.c b/Task/Fast-Fourier-transform/C/fast-fourier-transform-2.c index 427fd572bc..ebfbff324b 100644 --- a/Task/Fast-Fourier-transform/C/fast-fourier-transform-2.c +++ b/Task/Fast-Fourier-transform/C/fast-fourier-transform-2.c @@ -1,2 +1,41 @@ -Data: 1 1 1 1 0 0 0 0 -FFT : 4 (1, -2.41421) 0 (1, -0.414214) 0 (1, 0.414214) 0 (1, 2.41421) +#include +#include + +void fft(DSPComplex buf[], int n) { + float inputMemory[2*n]; + float outputMemory[2*n]; + // half for real and half for complex + DSPSplitComplex inputSplit = {inputMemory, inputMemory + n}; + DSPSplitComplex outputSplit = {outputMemory, outputMemory + n}; + + vDSP_ctoz(buf, 2, &inputSplit, 1, n); + + vDSP_DFT_Setup setup = vDSP_DFT_zop_CreateSetup(NULL, n, vDSP_DFT_FORWARD); + + vDSP_DFT_Execute(setup, + inputSplit.realp, inputSplit.imagp, + outputSplit.realp, outputSplit.imagp); + + vDSP_ztoc(&outputSplit, 1, buf, 2, n); +} + + +void show(const char *s, DSPComplex buf[], int n) { + printf("%s", s); + for (int i = 0; i < n; i++) + if (!buf[i].imag) + printf("%g ", buf[i].real); + else + printf("(%g, %g) ", buf[i].real, buf[i].imag); + printf("\n"); +} + +int main() { + DSPComplex buf[] = {{1,0}, {1,0}, {1,0}, {1,0}, {0,0}, {0,0}, {0,0}, {0,0}}; + + show("Data: ", buf, 8); + fft(buf, 8); + show("FFT : ", buf, 8); + + return 0; +} diff --git a/Task/Fast-Fourier-transform/C/fast-fourier-transform.c b/Task/Fast-Fourier-transform/C/fast-fourier-transform.c deleted file mode 100644 index 72d8ca2a80..0000000000 --- a/Task/Fast-Fourier-transform/C/fast-fourier-transform.c +++ /dev/null @@ -1,50 +0,0 @@ -#include -#include -#include - -double PI; -typedef double complex cplx; - -void _fft(cplx buf[], cplx out[], int n, int step) -{ - if (step < n) { - _fft(out, buf, n, step * 2); - _fft(out + step, buf + step, n, step * 2); - - for (int i = 0; i < n; i += 2 * step) { - cplx t = cexp(-I * PI * i / n) * out[i + step]; - buf[i / 2] = out[i] + t; - buf[(i + n)/2] = out[i] - t; - } - } -} - -void fft(cplx buf[], int n) -{ - cplx out[n]; - for (int i = 0; i < n; i++) out[i] = buf[i]; - - _fft(buf, out, n, 1); -} - - -void show(const char * s, cplx buf[]) { - printf("%s", s); - for (int i = 0; i < 8; i++) - if (!cimag(buf[i])) - printf("%g ", creal(buf[i])); - else - printf("(%g, %g) ", creal(buf[i]), cimag(buf[i])); -} - -int main() -{ - PI = atan2(1, 1) * 4; - cplx buf[] = {1, 1, 1, 1, 0, 0, 0, 0}; - - show("Data: ", buf); - fft(buf, 8); - show("\nFFT : ", buf); - - return 0; -} diff --git a/Task/Fast-Fourier-transform/Java/fast-fourier-transform.java b/Task/Fast-Fourier-transform/Java/fast-fourier-transform.java new file mode 100644 index 0000000000..b1e66292b9 --- /dev/null +++ b/Task/Fast-Fourier-transform/Java/fast-fourier-transform.java @@ -0,0 +1,95 @@ +import static java.lang.Math.*; + +public class FastFourierTransform { + + public static int bitReverse(int n, int bits) { + int reversedN = n; + int count = bits - 1; + + n >>= 1; + while (n > 0) { + reversedN = (reversedN << 1) | (n & 1); + count--; + n >>= 1; + } + + return ((reversedN << count) & ((1 << bits) - 1)); + } + + static void fft(Complex[] buffer) { + + int bits = (int) (log(buffer.length) / log(2)); + for (int j = 1; j < buffer.length / 2; j++) { + + int swapPos = bitReverse(j, bits); + Complex temp = buffer[j]; + buffer[j] = buffer[swapPos]; + buffer[swapPos] = temp; + } + + for (int N = 2; N <= buffer.length; N <<= 1) { + for (int i = 0; i < buffer.length; i += N) { + for (int k = 0; k < N / 2; k++) { + + int evenIndex = i + k; + int oddIndex = i + k + (N / 2); + Complex even = buffer[evenIndex]; + Complex odd = buffer[oddIndex]; + + double term = (-2 * PI * k) / (double) N; + Complex exp = (new Complex(cos(term), sin(term)).mult(odd)); + + buffer[evenIndex] = even.add(exp); + buffer[oddIndex] = even.sub(exp); + } + } + } + } + + public static void main(String[] args) { + double[] input = {1.0, 1.0, 1.0, 1.0, 0.0, 0.0, 0.0, 0.0}; + + Complex[] cinput = new Complex[input.length]; + for (int i = 0; i < input.length; i++) + cinput[i] = new Complex(input[i], 0.0); + + fft(cinput); + + System.out.println("Results:"); + for (Complex c : cinput) { + System.out.println(c); + } + } +} + +class Complex { + public final double re; + public final double im; + + public Complex() { + this(0, 0); + } + + public Complex(double r, double i) { + re = r; + im = i; + } + + public Complex add(Complex b) { + return new Complex(this.re + b.re, this.im + b.im); + } + + public Complex sub(Complex b) { + return new Complex(this.re - b.re, this.im - b.im); + } + + public Complex mult(Complex b) { + return new Complex(this.re * b.re - this.im * b.im, + this.re * b.im + this.im * b.re); + } + + @Override + public String toString() { + return String.format("(%f,%f)", re, im); + } +} diff --git a/Task/Fast-Fourier-transform/Lua/fast-fourier-transform.lua b/Task/Fast-Fourier-transform/Lua/fast-fourier-transform.lua new file mode 100644 index 0000000000..d4c10f17be --- /dev/null +++ b/Task/Fast-Fourier-transform/Lua/fast-fourier-transform.lua @@ -0,0 +1,67 @@ +-- operations on complex number +complex = {__mt={} } + +function complex.new (r, i) + local new={r=r, i=i or 0} + setmetatable(new,complex.__mt) + return new +end + +function complex.__mt.__add (c1, c2) + return complex.new(c1.r + c2.r, c1.i + c2.i) +end + +function complex.__mt.__sub (c1, c2) + return complex.new(c1.r - c2.r, c1.i - c2.i) +end + +function complex.__mt.__mul (c1, c2) + return complex.new(c1.r*c2.r - c1.i*c2.i, + c1.r*c2.i + c1.i*c2.r) +end + +function complex.expi (i) + return complex.new(math.cos(i),math.sin(i)) +end + +function complex.__mt.__tostring(c) + return "("..c.r..","..c.i..")" +end + + +-- Cooley–Tukey FFT (in-place, divide-and-conquer) +-- Higher memory requirements and redundancy although more intuitive +function fft(vect) + local n=#vect + if n<=1 then return vect end +-- divide + local odd,even={},{} + for i=1,n,2 do + odd[#odd+1]=vect[i] + even[#even+1]=vect[i+1] + end +-- conquer + fft(even); + fft(odd); +-- combine + for k=1,n/2 do + local t=even[k] * complex.expi(-2*math.pi*(k-1)/n) + vect[k] = odd[k] + t; + vect[k+n/2] = odd[k] - t; + end + return vect +end + +function toComplex(vectr) + vect={} + for i,r in ipairs(vectr) do + vect[i]=complex.new(r) + end + return vect +end + +-- test +data = toComplex{1, 1, 1, 1, 0, 0, 0, 0}; + +print("orig:", unpack(data)) +print("fft:", unpack(fft(data))) diff --git a/Task/Fast-Fourier-transform/Perl-6/fast-fourier-transform.pl6 b/Task/Fast-Fourier-transform/Perl-6/fast-fourier-transform.pl6 index 6d27e33a74..130b2db033 100644 --- a/Task/Fast-Fourier-transform/Perl-6/fast-fourier-transform.pl6 +++ b/Task/Fast-Fourier-transform/Perl-6/fast-fourier-transform.pl6 @@ -2,13 +2,13 @@ sub fft { return @_ if @_ == 1; my @evn = fft( @_[0, 2 ... *] ); my @odd = fft( @_[1, 3 ... *] ) Z* - map &cis, (0, 2 * pi / @_ ... *); + map &cis, (0, tau / @_ ... *); return flat @evn »+« @odd, @evn »-« @odd; } my @seq = ^16; my $cycles = 3; -my @wave = map { sin( 2*pi * $_ / @seq * $cycles ) }, @seq; +my @wave = map { sin( tau * $_ / @seq * $cycles ) }, @seq; say "wave: ", @wave.fmt("%7.3f"); say "fft: ", fft(@wave)».abs.fmt("%7.3f"); diff --git a/Task/Fast-Fourier-transform/REXX/fast-fourier-transform.rexx b/Task/Fast-Fourier-transform/REXX/fast-fourier-transform.rexx index eaccc5f366..f4e1dc2358 100644 --- a/Task/Fast-Fourier-transform/REXX/fast-fourier-transform.rexx +++ b/Task/Fast-Fourier-transform/REXX/fast-fourier-transform.rexx @@ -1,70 +1,69 @@ -/*REXX pgm performs a fast Fourier transform (FFT) on a set of complex numbers*/ -numeric digits length( pi() ) - 1 /*limited by the PI function result. */ -arg data /*ARG verb uppercases the DATA from CL.*/ -if data='' then data=1 1 1 1 0 /*Not specified? Then use the default.*/ -size=words(data); pad=left('',6) /*PAD: for indenting and padding SAYs.*/ - do p=0 until 2**p>=size ; end /*number of args exactly a power of 2? */ - do j=size+1 to 2**p;data=data 0; end /*add zeroes to DATA 'til a power of 2.*/ -size=words(data); ph=p%2; call hdr /*╔═════════════════════════════╗*/ - /* [↓] TRANSLATE allows I&J*/ /*║ Numbers in data can be in ║*/ - do j=0 for size /*║ seven formats: real ║*/ - _=translate(word(data,j+1), 'J', "I") /*║ real,imag ║*/ - parse var _ #.1.j '' $ 1 ',' #.2.j /*║ ,imag ║*/ - if $=='J' then parse var #.1.j #2.j , /*║ nnnJ ║*/ - "J" #.1.j /*║ nnnj ║*/ - do m=1 for 2; #.m.j=word(#.m.j 0,1) /*║ nnnI ║*/ - end /*m*/ /* [↑] ommited part?*/ /*║ nnni ║*/ - /*╚═════════════════════════════╝*/ - say pad " FFT in " center(j+1,7) pad fmt(#.1.j) fmt(#.2.j,'i') - end /*j*/ +/*REXX program performs a fast Fourier transform (FFT) on a set of complex numbers. */ +numeric digits length( pi() ) - 1 /*limited by the PI function result. */ +arg data /*ARG verb uppercases the DATA from CL.*/ +if data='' then data=1 1 1 1 0 /*Not specified? Then use the default.*/ +size=words(data); pad=left('',6) /*PAD: for indenting and padding SAYs.*/ + do p=0 until 2**p>=size ; end /*number of args exactly a power of 2? */ + do j=size+1 to 2**p;data=data 0; end /*add zeroes to DATA 'til a power of 2.*/ +size=words(data); ph=p%2; call hdr /*╔═══════════════════════════╗*/ + /* [↓] TRANSLATE allows I & J*/ /*║ Numbers in data can be in ║*/ + do j=0 for size /*║ seven formats: real ║*/ + _=translate( word(data,j+1), 'J', "I") /*║ real,imag ║*/ + parse var _ #.1.j '' $ 1 "," #.2.j /*║ ,imag ║*/ + if $=='J' then parse var #.1.j #2.j "J" #.1.j /*║ nnnJ ║*/ + /*║ nnnj ║*/ + do m=1 for 2; #.m.j= word(#.m.j 0, 1) /*║ nnnI ║*/ + end /*m*/ /*omitted part? [↑] */ /*║ nnni ║*/ + /*╚═══════════════════════════╝*/ + say pad ' FFT in ' center(j+1, 7) pad fmt(#.1.j) fmt(#.2.j, "i") + end /*j*/ say -tran=pi()*2/2**p; !.=0; hp=2**p%2; A=2**(p-ph); ptr=A; dbl=1 +tran=pi()*2 / 2**p; !.=0; hp=2**p %2; A=2**(p-ph); ptr=A; dbl=1 say - do p-ph; halfPtr=ptr%2 - do i=halfPtr by ptr to A-halfPtr; _=i-halfPtr; !.i=!._+dbl - end /*i*/ - dbl=dbl*2; ptr=halfPtr - end /*p-ph*/ + do p-ph; halfPtr=ptr%2 + do i=halfPtr by ptr to A-halfPtr; _=i-halfPtr; !.i=!._+dbl + end /*i*/ + dbl=dbl*2; ptr=halfPtr + end /*p-ph*/ - do j=0 to 2**p%4; cmp.j=cos(j*tran); _=hp - j; cmp._= -cmp.j - _=hp + j; cmp._= -cmp.j - end /*j*/ + do j=0 to 2**p%4; cmp.j=cos(j*tran); _=hp - j; cmp._= -cmp.j + _=hp + j; cmp._= -cmp.j + end /*j*/ B=2**ph - - do i=0 for A; q=i * B - do j=0 for B; h=q+j; _=!.j*B+!.i; if _<=h then iterate - parse value #.1._ #.1.h #.2._ #.2.h with #.1.h #.1._ #.2.h #.2._ - end /*j*/ /* [↑] swap two sets of values.*/ - end /*i*/ - -dbl=1; do p ; w=hp % dbl - do k=0 for dbl ; Lb=w * k ; Lh=Lb + 2**p % 4 - do j=0 for w ; a=j * dbl * 2 + k ; b= a + dbl - r=#.1.a; i=#.2.a ; c1=cmp.Lb * #.1.b ; c4=cmp.Lb * #.2.b - c2=cmp.Lh * #.2.b ; c3=cmp.Lh * #.1.b - #.1.a=r + c1 - c2 ; #.2.a=i + c3 + c4 - #.1.b=r - c1 + c2 ; #.2.b=i - c3 - c4 - end /*j*/ - end /*k*/ - dbl=dbl+dbl - end /*p*/ + do i=0 for A; q=i * B + do j=0 for B; h=q+j; _=!.j*B+!.i; if _<=h then iterate + parse value #.1._ #.1.h #.2._ #.2.h with #.1.h #.1._ #.2.h #.2._ + end /*j*/ /* [↑] swap two sets of values. */ + end /*i*/ +dbl=1 + do p ; w=hp % dbl + do k=0 for dbl ; Lb=w * k ; Lh=Lb + 2**p % 4 + do j=0 for w ; a=j * dbl * 2 + k ; b= a + dbl + r=#.1.a; i=#.2.a ; c1=cmp.Lb * #.1.b ; c4=cmp.Lb * #.2.b + c2=cmp.Lh * #.2.b ; c3=cmp.Lh * #.1.b + #.1.a=r + c1 - c2 ; #.2.a=i + c3 + c4 + #.1.b=r - c1 + c2 ; #.2.b=i - c3 - c4 + end /*j*/ + end /*k*/ + dbl=dbl+dbl + end /*p*/ call hdr do i=0 for size say pad " FFT out " center(i+1,7) pad fmt(#.1.i) fmt(#.2.i,'j') - end /*i*/ /*numbers are shown with 10 digs [↑] */ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -cos: procedure; parse arg x; q=r2r(x)**2; z=1; _=1; p=1 - do k=2 by 2; _=-_*q/(k*(k-1)); z=z+_; if z=p then leave; p=z; end; return z -/*────────────────────────────────────────────────────────────────────────────*/ -fmt: procedure; parse arg y,j; y=y/1 /*transforms complex numbers for looks.*/ - if abs(y)<'1e-'digits()%4 then y=0; if y=0 & j\=='' then return '' - y=format(y,,10); if pos(.,y)\==0 then y=strip(y,'T',0) - y=strip(y,,.); if y>=0 then y=' 'y; return left(y||j, 12) -/*────────────────────────────────────────────────────────────────────────────*/ -hdr: _='───data─── num real─part imaginary─part'; say pad _ - say pad translate(_, " "copies('═',256), " "xrange()); return -/*────────────────────────────────────────────────────────────────────────────*/ -pi: return 3.141592653589793238462643383279502884197169399375105820974944592308 -/*────────────────────────────────────────────────────────────────────────────*/ -r2r: return arg(1) // (pi()*2) /*reduce the radians to a unit circle. */ + end /*i*/ /*[↑] #s are shown with 10 decimal digs*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +cos: procedure; parse arg x; q=r2r(x)**2; z=1; _=1; p=1 /*bare bones COS. */ + do k=2 by 2; _=-_*q/(k*(k-1)); z=z+_; if z=p then leave; p=z; end; return z +/*──────────────────────────────────────────────────────────────────────────────────────*/ +fmt: procedure; parse arg y,j; y=y/1 /*prettifies complex numbers for show. */ + if abs(y) < '1e-'digits()%4 then y=0; if y=0 & j\=='' then return '' + y=format(y, , 10); if pos(.,y)\==0 then y=strip(y, 'T', 0) + y=strip(y, , .); if y>=0 then y=' 'y; return left(y || j, 12) +/*──────────────────────────────────────────────────────────────────────────────────────*/ +hdr: _='───data─── num real─part imaginary─part'; say pad _ + say pad translate(_, " "copies('═',256), " "xrange()); return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +pi: return 3.1415926535897932384626433832795028841971693993751058209749445923078164062862 +/*──────────────────────────────────────────────────────────────────────────────────────*/ +r2r: return arg(1) // ( pi()*2 ) /*reduce the radians to a unit circle. */ diff --git a/Task/Fibonacci-n-step-number-sequences/00DESCRIPTION b/Task/Fibonacci-n-step-number-sequences/00DESCRIPTION index 89ffb256ba..beec7e67fa 100644 --- a/Task/Fibonacci-n-step-number-sequences/00DESCRIPTION +++ b/Task/Fibonacci-n-step-number-sequences/00DESCRIPTION @@ -31,14 +31,17 @@ For small values of n, [[wp:Number prefix#Greek_series|Greek numeri |} Allied sequences can be generated where the initial values are changed: -: '''The [[wp:Lucas number|Lucas series]]''' sums the two preceeding values like the fibonacci series for n=2 but uses [2, 1] as its initial values. +: '''The [[wp:Lucas number|Lucas series]]''' sums the two preceding values like the fibonacci series for n=2 but uses [2, 1] as its initial values. -;The task is to: +
    +;Task: # Write a function to generate Fibonacci n-step number sequences given its initial values and assuming the number of initial values determines how many previous values are summed to make the next number of the series. # Use this to print and show here at least the first ten members of the Fibo/tribo/tetra-nacci and Lucas sequences. -;Cf.: -* [[Fibonacci sequence]] -* [http://mathworld.wolfram.com/Fibonaccin-StepNumber.html Wolfram Mathworld] -* [[Hofstadter Q sequence‎]] -* [https://www.youtube.com/watch?v=PeUbRXnbmms Lucas Numbers - Numberphile] (Video). + +;Related tasks: +*   [[Fibonacci sequence]] +*   [http://mathworld.wolfram.com/Fibonaccin-StepNumber.html Wolfram Mathworld] +*   [[Hofstadter Q sequence‎]] +*   [https://www.youtube.com/watch?v=PeUbRXnbmms Lucas Numbers - Numberphile] (Video) +

    diff --git a/Task/Fibonacci-n-step-number-sequences/ALGOL-68/fibonacci-n-step-number-sequences.alg b/Task/Fibonacci-n-step-number-sequences/ALGOL-68/fibonacci-n-step-number-sequences.alg new file mode 100644 index 0000000000..b27cf192af --- /dev/null +++ b/Task/Fibonacci-n-step-number-sequences/ALGOL-68/fibonacci-n-step-number-sequences.alg @@ -0,0 +1,30 @@ +# returns an array of the first required count elements of an a n-step fibonacci sequence # +# the initial values are taken from the init array # +PROC n step fibonacci sequence = ( []INT init, INT required count )[]INT: + BEGIN + [ 1 : required count ]INT result; + []INT initial values = init[ AT 1 ]; + INT step = UPB initial values; + # install the initial values # + FOR n TO step DO result[ n ] := initial values[ n ] OD; + # calculate the rest of the sequence # + FOR n FROM step + 1 TO required count DO + result[ n ] := 0; + FOR p FROM n - step TO n - 1 DO result[ n ] +:= result[ p ] OD + OD; + result + END; # required count # + +# prints the elements of a sequence # +PROC print sequence = ( STRING legend, []INT sequence )VOID: + BEGIN + print( ( legend, ":" ) ); + FOR e FROM LWB sequence TO UPB sequence DO print( ( " ", whole( sequence[ e ], 0 ) ) ) OD; + print( ( newline ) ) + END; # print sequence # + +# print some sequences # +print sequence( "fibonacci ", n step fibonacci sequence( ( 1, 1 ), 10 ) ); +print sequence( "tribonacci ", n step fibonacci sequence( ( 1, 1, 2 ), 10 ) ); +print sequence( "tetrabonacci", n step fibonacci sequence( ( 1, 1, 2, 4 ), 10 ) ); +print sequence( "lucus ", n step fibonacci sequence( ( 2, 1 ), 10 ) ) diff --git a/Task/Fibonacci-n-step-number-sequences/Groovy/fibonacci-n-step-number-sequences-1.groovy b/Task/Fibonacci-n-step-number-sequences/Groovy/fibonacci-n-step-number-sequences-1.groovy new file mode 100644 index 0000000000..32cd86b0d6 --- /dev/null +++ b/Task/Fibonacci-n-step-number-sequences/Groovy/fibonacci-n-step-number-sequences-1.groovy @@ -0,0 +1,14 @@ +def fib = { List seed, int k=10 -> + assert seed : "The seed list must be non-null and non-empty" + assert seed.every { it instanceof Number } : "Every member of the seed must be a number" + def n = seed.size() + assert n > 1 : "The seed must contain at least two elements" + List result = [] + seed + if (k < n) { + result[0..k] + } else { + (n..k).inject(result) { res, kk -> + res << res[-n..-1].sum() + } + } +} diff --git a/Task/Fibonacci-n-step-number-sequences/Groovy/fibonacci-n-step-number-sequences-2.groovy b/Task/Fibonacci-n-step-number-sequences/Groovy/fibonacci-n-step-number-sequences-2.groovy new file mode 100644 index 0000000000..f047910874 --- /dev/null +++ b/Task/Fibonacci-n-step-number-sequences/Groovy/fibonacci-n-step-number-sequences-2.groovy @@ -0,0 +1,17 @@ +[ + ' fibonacci':[1,1], + 'tribonacci':[1,1,2], + 'tetranacci':[1,1,2,4], + 'pentanacci':[1,1,2,4,8], + ' hexanacci':[1,1,2,4,8,16], + 'heptanacci':[1,1,2,4,8,16,32], + ' octonacci':[1,1,2,4,8,16,32,64], + ' nonanacci':[1,1,2,4,8,16,32,64,128], + ' decanacci':[1,1,2,4,8,16,32,64,128,256], + ' lucas':[2,1], +].each { name, seed -> + println "${name}: ${fib(seed,10)}" +} + +println " lucas[0]: ${fib([2,1],0)}" +println " tetra[3]: ${fib([1,1,2,4],3)}" diff --git a/Task/Fibonacci-n-step-number-sequences/Lua/fibonacci-n-step-number-sequences.lua b/Task/Fibonacci-n-step-number-sequences/Lua/fibonacci-n-step-number-sequences.lua new file mode 100644 index 0000000000..4cdb622bc1 --- /dev/null +++ b/Task/Fibonacci-n-step-number-sequences/Lua/fibonacci-n-step-number-sequences.lua @@ -0,0 +1,37 @@ +function n_Nacci (n, seqLength, lucas) + local seq, nextNum = {1} + if lucas then + seq = {2, 1} + else + for power = 1, n - 1 do + table.insert(seq, 2 ^ power) + end + end + while #seq < seqLength do + nextNum = 0 + for i = #seq - (n-1), #seq do + nextNum = nextNum + seq[i] + end + table.insert(seq, nextNum) + end + return seq +end + +function display (t) + print(" n\t|\t\t\tValues") + print(string.rep("-", 75)) + for k, v in pairs(t) do + io.write(" " .. k, "\t| ") + for _, val in pairs(v) do + io.write(val .. " ") + end + print("...") + end +end + +local nacciTab = {} +for n = 2, 10 do + nacciTab[n] = n_Nacci(n, 16) -- 16 of each fits in one cmd line +end +nacciTab.lucas = n_Nacci(2, 16, "lucas") +display(nacciTab) diff --git a/Task/Fibonacci-n-step-number-sequences/Maple/fibonacci-n-step-number-sequences.maple b/Task/Fibonacci-n-step-number-sequences/Maple/fibonacci-n-step-number-sequences.maple new file mode 100644 index 0000000000..94e84849fa --- /dev/null +++ b/Task/Fibonacci-n-step-number-sequences/Maple/fibonacci-n-step-number-sequences.maple @@ -0,0 +1,16 @@ +numSequence := proc(initValues :: Array) + local n, i, values; + n := numelems(initValues); + values := copy(initValues); + for i from (n+1) to 15 do + values(i) := add(values[i-n..i-1]); + end do; + return values; +end proc: + +initValues := Array([1]): +for i from 2 to 10 do + initValues(i) := add(initValues): + printf ("nacci(%d): %a\n", i, convert(numSequence(initValues), list)); +end do: +printf ("lucas: %a\n", convert(numSequence(Array([2, 1])), list)); diff --git a/Task/Fibonacci-n-step-number-sequences/Perl-6/fibonacci-n-step-number-sequences-2.pl6 b/Task/Fibonacci-n-step-number-sequences/Perl-6/fibonacci-n-step-number-sequences-2.pl6 index 38d4bd0d22..3e3a6a994b 100644 --- a/Task/Fibonacci-n-step-number-sequences/Perl-6/fibonacci-n-step-number-sequences-2.pl6 +++ b/Task/Fibonacci-n-step-number-sequences/Perl-6/fibonacci-n-step-number-sequences-2.pl6 @@ -1,5 +1,5 @@ sub fib ($n, @xs is copy = [1]) { - gather { + flat gather { take @xs[*]; loop { take my $x = [+] @xs; diff --git a/Task/Fibonacci-sequence/00DESCRIPTION b/Task/Fibonacci-sequence/00DESCRIPTION index 9600144067..fa5f010f92 100644 --- a/Task/Fibonacci-sequence/00DESCRIPTION +++ b/Task/Fibonacci-sequence/00DESCRIPTION @@ -1,24 +1,31 @@ -The '''Fibonacci sequence''' is a sequence Fn of natural numbers defined recursively: - F0 = 0 - F1 = 1 - Fn = Fn-1 + Fn-2, if n>1 +The '''Fibonacci sequence''' is a sequence   Fn   of natural numbers defined recursively: + + F0 = 0 + F1 = 1 + Fn = Fn-1 + Fn-2, if n>1 + + +;Task: +Write a function to generate the   nth   Fibonacci number. -Write a function to generate the nth Fibonacci number. Solutions can be iterative or recursive (though recursive solutions are generally considered too slow and are mostly used as an exercise in recursion). The sequence is sometimes extended into negative numbers by using a straightforward inverse of the positive definition: - Fn = Fn+2 - Fn+1, if n<0 + Fn = Fn+2 - Fn+1, if n<0 -Support for negative n in the solution is optional. +support for negative     n     in the solution is optional. + + +;Related task: +*   [[Fibonacci n-step number sequences‎]] -;Cf.: -* [[Fibonacci n-step number sequences‎]] ;References: -* [[wp:Fibonacci number|Wikipedia, Fibonacci number]] -* [[wp:Lucas number|Wikipedia, Lucas number]] -* [http://mathworld.wolfram.com/FibonacciNumber.html MathWorld, Fibonacci Number] -* [http://www.math-cs.ucmo.edu/~curtisc/articles/howardcooper/genfib4.pdf Some identities for r-Fibonacci numbers] -*[[oeis:A000045|OEIS Fibonacci numbers]] -*[[oeis:A000032|OEIS Lucas numbers]] +*   [[wp:Fibonacci number|Wikipedia, Fibonacci number]] +*   [[wp:Lucas number|Wikipedia, Lucas number]] +*   [http://mathworld.wolfram.com/FibonacciNumber.html MathWorld, Fibonacci Number] +*   [http://www.math-cs.ucmo.edu/~curtisc/articles/howardcooper/genfib4.pdf Some identities for r-Fibonacci numbers] +*   [[oeis:A000045|OEIS Fibonacci numbers]] +*   [[oeis:A000032|OEIS Lucas numbers]] +

    diff --git a/Task/Fibonacci-sequence/6502-Assembly/fibonacci-sequence.6502 b/Task/Fibonacci-sequence/6502-Assembly/fibonacci-sequence.6502 new file mode 100644 index 0000000000..10abb4c5a5 --- /dev/null +++ b/Task/Fibonacci-sequence/6502-Assembly/fibonacci-sequence.6502 @@ -0,0 +1,16 @@ + LDA #0 + STA $F0 ; LOWER NUMBER + LDA #1 + STA $F1 ; HIGHER NUMBER + LDX #0 +LOOP: LDA $F1 + STA $0F1B,X + STA $F2 ; OLD HIGHER NUMBER + ADC $F0 + STA $F1 ; NEW HIGHER NUMBER + LDA $F2 + STA $F0 ; NEW LOWER NUMBER + INX + CPX #$0A ; STOP AT FIB(10) + BMI LOOP + RTS ; RETURN FROM SUBROUTINE diff --git a/Task/Fibonacci-sequence/8080-Assembly/fibonacci-sequence.8080 b/Task/Fibonacci-sequence/8080-Assembly/fibonacci-sequence.8080 new file mode 100644 index 0000000000..23a0281c8b --- /dev/null +++ b/Task/Fibonacci-sequence/8080-Assembly/fibonacci-sequence.8080 @@ -0,0 +1,10 @@ +FIBNCI: MOV C, A ; C will store the counter + DCR C ; decrement, because we know f(1) already + MVI A, 1 + MVI B, 0 +LOOP: MOV D, A + ADD B ; A := A + B + MOV B, D + DCR C + JNZ LOOP ; jump if not zero + RET ; return from subroutine diff --git a/Task/Fibonacci-sequence/ALGOL-W/fibonacci-sequence.alg b/Task/Fibonacci-sequence/ALGOL-W/fibonacci-sequence.alg new file mode 100644 index 0000000000..c1fb741f44 --- /dev/null +++ b/Task/Fibonacci-sequence/ALGOL-W/fibonacci-sequence.alg @@ -0,0 +1,19 @@ +begin + % return the nth Fibonacci number % + integer procedure Fibonacci( integer value n ) ; + begin + integer fn, fn1, fn2; + fn2 := 1; + fn1 := 0; + fn := 0; + for i := 1 until n do begin + fn := fn1 + fn2; + fn2 := fn1; + fn1 := fn + end ; + fn + end Fibonacci ; + + for i := 0 until 10 do writeon( i_w := 3, s_w := 0, Fibonacci( i ) ) + +end. diff --git a/Task/Fibonacci-sequence/APL/fibonacci-sequence-3.apl b/Task/Fibonacci-sequence/APL/fibonacci-sequence-3.apl new file mode 100644 index 0000000000..3eff61d5ef --- /dev/null +++ b/Task/Fibonacci-sequence/APL/fibonacci-sequence-3.apl @@ -0,0 +1 @@ +⌊.5+(((1+PHI)÷2)*⍳N)÷PHI←5*.5 diff --git a/Task/Fibonacci-sequence/ARM-Assembly/fibonacci-sequence.arm b/Task/Fibonacci-sequence/ARM-Assembly/fibonacci-sequence.arm new file mode 100644 index 0000000000..a0fd212459 --- /dev/null +++ b/Task/Fibonacci-sequence/ARM-Assembly/fibonacci-sequence.arm @@ -0,0 +1,16 @@ +fibonacci: + push {r1-r3} + mov r1, #0 + mov r2, #1 + +fibloop: + mov r3, r2 + add r2, r1, r2 + mov r1, r3 + sub r0, r0, #1 + cmp r0, #1 + bne fibloop + + mov r0, r2 + pop {r1-r3} + mov pc, lr diff --git a/Task/Fibonacci-sequence/AppleScript/fibonacci-sequence.applescript b/Task/Fibonacci-sequence/AppleScript/fibonacci-sequence-1.applescript similarity index 100% rename from Task/Fibonacci-sequence/AppleScript/fibonacci-sequence.applescript rename to Task/Fibonacci-sequence/AppleScript/fibonacci-sequence-1.applescript diff --git a/Task/Fibonacci-sequence/AppleScript/fibonacci-sequence-2.applescript b/Task/Fibonacci-sequence/AppleScript/fibonacci-sequence-2.applescript new file mode 100644 index 0000000000..73da54b23f --- /dev/null +++ b/Task/Fibonacci-sequence/AppleScript/fibonacci-sequence-2.applescript @@ -0,0 +1,9 @@ +on fib(n) + if n < 1 then + 0 + else if n < 3 then + 1 + else + fib(n - 2) + fib(n - 1) + end if +end fib diff --git a/Task/Fibonacci-sequence/AppleScript/fibonacci-sequence-3.applescript b/Task/Fibonacci-sequence/AppleScript/fibonacci-sequence-3.applescript new file mode 100644 index 0000000000..2a9087d2a4 --- /dev/null +++ b/Task/Fibonacci-sequence/AppleScript/fibonacci-sequence-3.applescript @@ -0,0 +1,64 @@ +-- fib :: Int -> Int +on fib(n) + + -- (Int, Int) -> (Int, Int) + script lastTwo + on lambda([a, b]) + [b, a + b] + end lambda + end script + + item 1 of foldl(lastTwo, {0, 1}, range(1, n)) +end fib + + + +-- TEST +on run + + fib(32) + + --> 2178309 +end run + + + +-- GENERIC FUNCTIONS + +-- 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 + +-- range :: Int -> Int -> [Int] +on range(m, n) + if n < m then + set d to -1 + else + set d to 1 + end if + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range diff --git a/Task/Fibonacci-sequence/Babel/fibonacci-sequence-1.pb b/Task/Fibonacci-sequence/Babel/fibonacci-sequence-1.pb new file mode 100644 index 0000000000..e56527bc64 --- /dev/null +++ b/Task/Fibonacci-sequence/Babel/fibonacci-sequence-1.pb @@ -0,0 +1 @@ +fib { <- 0 1 { dup <- + -> swap } -> times zap } < diff --git a/Task/Fibonacci-sequence/Babel/fibonacci-sequence-2.pb b/Task/Fibonacci-sequence/Babel/fibonacci-sequence-2.pb new file mode 100644 index 0000000000..0956f6cd07 --- /dev/null +++ b/Task/Fibonacci-sequence/Babel/fibonacci-sequence-2.pb @@ -0,0 +1 @@ +{19 iter - fib !} 20 times collect ! lsnum ! diff --git a/Task/Fibonacci-sequence/Babel/fibonacci-sequence.pb b/Task/Fibonacci-sequence/Babel/fibonacci-sequence.pb deleted file mode 100644 index 670a093465..0000000000 --- a/Task/Fibonacci-sequence/Babel/fibonacci-sequence.pb +++ /dev/null @@ -1,20 +0,0 @@ -((main - {{iter fib !} - 20 times - - collect ! - rev - - {%d " " . <<} - each}) - -(collect { -1 take }) - -(fib - {{dup 2 <} - {fnord} - {dup - <- 2 - fib ! -> - 1 - fib ! - + } - ifte})) diff --git a/Task/Fibonacci-sequence/C/fibonacci-sequence-1.c b/Task/Fibonacci-sequence/C/fibonacci-sequence-1.c index 97cf199c39..ff8174c61b 100644 --- a/Task/Fibonacci-sequence/C/fibonacci-sequence-1.c +++ b/Task/Fibonacci-sequence/C/fibonacci-sequence-1.c @@ -1,3 +1,3 @@ -long long int fibb(long long int a, long long int b, int n) { -return (--n>0)?(fibb(b, a+b, n)):(a); +long long fibb(long long a, long long b, int n) { + return (--n>0)?(fibb(b, a+b, n)):(a); } diff --git a/Task/Fibonacci-sequence/Clojure/fibonacci-sequence-9.clj b/Task/Fibonacci-sequence/Clojure/fibonacci-sequence-9.clj new file mode 100644 index 0000000000..b8ec357a0d --- /dev/null +++ b/Task/Fibonacci-sequence/Clojure/fibonacci-sequence-9.clj @@ -0,0 +1,16 @@ +(ns fib.core) +(require '[clojure.core.async + :refer [! >!! !! c a) + (recur b (+ a b)))) + + +(defn -main [] + (let [c (chan)] + (go (fib c)) + (dorun + (for [i (range 10)] + (println ( 1 ? rFib(it-1) + rFib(it-2) + /*it < 0*/: rFib(it+2) - rFib(it+1) + +} diff --git a/Task/Fibonacci-sequence/Groovy/fibonacci-sequence-2.groovy b/Task/Fibonacci-sequence/Groovy/fibonacci-sequence-2.groovy index 55d41b1913..a7fc9ff36a 100644 --- a/Task/Fibonacci-sequence/Groovy/fibonacci-sequence-2.groovy +++ b/Task/Fibonacci-sequence/Groovy/fibonacci-sequence-2.groovy @@ -1 +1,6 @@ -def iFib = { it < 1 ? 0 : it == 1 ? 1 : (2..it).inject([0,1]){i, j -> [i[1], i[0]+i[1]]}[1] } +def iFib = { + it == 0 ? 0 + : it == 1 ? 1 + : it > 1 ? (2..it).inject([0,1]){i, j -> [i[1], i[0]+i[1]]}[1] + /*it < 0*/: (-1..it).inject([0,1]){i, j -> [i[1]-i[0], i[0]]}[0] +} diff --git a/Task/Fibonacci-sequence/Groovy/fibonacci-sequence-3.groovy b/Task/Fibonacci-sequence/Groovy/fibonacci-sequence-3.groovy index 3ad18dc77a..55a870b054 100644 --- a/Task/Fibonacci-sequence/Groovy/fibonacci-sequence-3.groovy +++ b/Task/Fibonacci-sequence/Groovy/fibonacci-sequence-3.groovy @@ -1 +1,2 @@ -(0..20).each { println "${it}: ${rFib(it)} ${iFib(it)}" } +final φ = (1 + 5**(1/2))/2 +def aFib = { (φ**it - (-φ)**(-it))/(5**(1/2)) as BigInteger } diff --git a/Task/Fibonacci-sequence/Groovy/fibonacci-sequence-4.groovy b/Task/Fibonacci-sequence/Groovy/fibonacci-sequence-4.groovy new file mode 100644 index 0000000000..0a00104450 --- /dev/null +++ b/Task/Fibonacci-sequence/Groovy/fibonacci-sequence-4.groovy @@ -0,0 +1,16 @@ +def time = { Closure c -> + def start = System.currentTimeMillis() + def result = c() + def elapsedMS = (System.currentTimeMillis() - start)/1000 + printf '(%6.4fs elapsed)', elapsedMS + result +} + +print " F(n) elapsed time "; (-10..10).each { printf ' %3d', it }; println() +print "--------- -----------------"; (-10..10).each { print ' ---' }; println() +[recursive:rFib, iterative:iFib, analytic:aFib].each { name, fib -> + printf "%9s ", name + def fibList = time { (-10..10).collect {fib(it)} } + fibList.each { printf ' %3d', it } + println() +} diff --git a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-1.hs b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-1.hs index eb85845a7f..b0ad32a369 100644 --- a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-1.hs +++ b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-1.hs @@ -1 +1 @@ -fib = 0 : 1 : zipWith (+) fib (tail fib) +[floor(0.01+(1/p**n+p**n)/sqrt 5)|let p=(1+sqrt 5)/2, n<-[0..42]] diff --git a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-10.hs b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-10.hs new file mode 100644 index 0000000000..834fc5fc26 --- /dev/null +++ b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-10.hs @@ -0,0 +1,15 @@ +import Data.List + +xs <+> ys = zipWith (+) xs ys +xs <*> ys = sum $ zipWith (*) xs ys + +newtype Mat a = Mat {unMat :: [[a]]} deriving Eq + +instance Show a => Show (Mat a) where + show xm = "Mat " ++ show (unMat xm) + +instance Num a => Num (Mat a) where + negate xm = Mat $ map (map negate) $ unMat xm + xm + ym = Mat $ zipWith (<+>) (unMat xm) (unMat ym) + xm * ym = Mat [[xs <*> ys | ys <- transpose $ unMat ym] | xs <- unMat xm] + fromInteger n = Mat [[fromInteger n]] diff --git a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-11.hs b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-11.hs new file mode 100644 index 0000000000..1f3ba1d2e4 --- /dev/null +++ b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-11.hs @@ -0,0 +1,3 @@ +fib 0 = 0 -- this line is necessary because "something ^ 0" returns "fromInteger 1", which unfortunately + -- in our case is not our multiplicative identity (the identity matrix) but just a 1x1 matrix of 1 +fib n = last $ head $ unMat $ (Mat [[1,1],[1,0]]) ^ n diff --git a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-12.hs b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-12.hs new file mode 100644 index 0000000000..2589d7e629 --- /dev/null +++ b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-12.hs @@ -0,0 +1,20 @@ +fibsteps (a,b) n + | n <= 0 = (a,b) + | otherwise = fibsteps (b, a+b) (n-1) + +fibnums :: [Integer] +fibnums = map fst $ iterate (`fibsteps` 1) (0,1) + +fibN2 :: Integer -> (Integer, Integer) +fibN2 m | m < 10 = fibsteps (0,1) m +fibN2 m = fibN2_next (n,r) (fibN2 n) + where (n,r) = quotRem m 3 + +fibN2_next (n,r) (f,g) | r==0 = (a,b) -- 3n ,3n+1 + | r==1 = (b,c) -- 3n+1,3n+2 + | r==2 = (c,d) -- 3n+2,3n+3 (*) + where + a = ( 5*f^3 + if even n then 3*f else (- 3*f) ) -- 3n + b = ( g^3 + 3 * g * f^2 - f^3 ) -- 3n+1 + c = ( g^3 + 3 * g^2 * f + f^3 ) -- 3n+2 + d = ( 5*g^3 + if even n then (- 3*g) else 3*g ) -- 3(n+1) (*) diff --git a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-13.hs b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-13.hs new file mode 100644 index 0000000000..3a908740e5 --- /dev/null +++ b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-13.hs @@ -0,0 +1,2 @@ + *Main> take 10 $ show $ fst $ fibN2 (10^6) + "1953282128" diff --git a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-2.hs b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-2.hs index bac976bc03..a7a77004a4 100644 --- a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-2.hs +++ b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-2.hs @@ -1 +1 @@ -fib = 0 : 1 : next fib where next (a: t@(b:_)) = (a+b) : next t +fib x = if x < 1 then 0 else if x < 2 then 1 else fib(x - 1) + fib(x - 2) diff --git a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-3.hs b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-3.hs index 093c22af12..4c75d11644 100644 --- a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-3.hs +++ b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-3.hs @@ -1 +1,5 @@ -fib = 0 : scanl (+) 1 fib +fib x = if x < 1 then 0 + else if x==1 then 1 + else fibs!!(x - 1) + fibs!!(x - 2) + where + fibs = map fib [0..] diff --git a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-4.hs b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-4.hs index 834fc5fc26..b3558a3788 100644 --- a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-4.hs +++ b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-4.hs @@ -1,15 +1,2 @@ -import Data.List - -xs <+> ys = zipWith (+) xs ys -xs <*> ys = sum $ zipWith (*) xs ys - -newtype Mat a = Mat {unMat :: [[a]]} deriving Eq - -instance Show a => Show (Mat a) where - show xm = "Mat " ++ show (unMat xm) - -instance Num a => Num (Mat a) where - negate xm = Mat $ map (map negate) $ unMat xm - xm + ym = Mat $ zipWith (<+>) (unMat xm) (unMat ym) - xm * ym = Mat [[xs <*> ys | ys <- transpose $ unMat ym] | xs <- unMat xm] - fromInteger n = Mat [[fromInteger n]] +fib :: Integer -> Integer +fib n = fst $ foldl (\(a, b) _ -> (b, a + b)) (0, 1) [1 .. n] diff --git a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-5.hs b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-5.hs index 1f3ba1d2e4..b8a0c82ac7 100644 --- a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-5.hs +++ b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-5.hs @@ -1,3 +1,4 @@ -fib 0 = 0 -- this line is necessary because "something ^ 0" returns "fromInteger 1", which unfortunately - -- in our case is not our multiplicative identity (the identity matrix) but just a 1x1 matrix of 1 -fib n = last $ head $ unMat $ (Mat [[1,1],[1,0]]) ^ n +fib n = go n 0 1 + where + go n a b | n==0 = a + | otherwise = go (n-1) b (a+b) diff --git a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-6.hs b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-6.hs index ff9c2ccca8..eb85845a7f 100644 --- a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-6.hs +++ b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-6.hs @@ -1,20 +1 @@ -fibsteps (a,b) n - | n <= 0 = (a,b) - | otherwise = fibsteps (b, a+b) (n-1) - -fibnums :: [Integer] -fibnums = map fst $ iterate (`fibsteps` 1) (0,1) - -fibN2 :: Integer -> (Integer, Integer) -fibN2 m | m < 10 = fibsteps (0,1) m -fibN2 m = fibN2_next (n,r) (fibN2 n) - where (n,r) = quotRem m 3 - -fibN2_next (n,r) (f,g) | r==0 = (a,b) -- 3n ,3n+1 - | r==1 = (b,c) -- 3n+1,3n+2 - | r==2 = (c,d) -- 3n+2,3n+3 (*) - where - a = ( 5*f^3 + if even n then 3*f else (- 3*f) ) -- 3n - d = ( 5*g^3 + if even n then (- 3*g) else 3*g ) -- 3(n+1) (*) - b = ( g^3 + 3 * g * f^2 - f^3 ) -- 3n+1 - c = ( g^3 + 3 * g^2 * f + f^3 ) -- 3n+2 +fib = 0 : 1 : zipWith (+) fib (tail fib) diff --git a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-7.hs b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-7.hs index 3a908740e5..d5ff9995cc 100644 --- a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-7.hs +++ b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-7.hs @@ -1,2 +1 @@ - *Main> take 10 $ show $ fst $ fibN2 (10^6) - "1953282128" + fib = 0 : 1 : (zipWith (+) <*> tail) fib diff --git a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-8.hs b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-8.hs index 00d8c20448..bac976bc03 100644 --- a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-8.hs +++ b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-8.hs @@ -1 +1 @@ -let fib x = if x < 1 then 0 else (if x < 3 then 1 else (fib(x - 1) + fib(x - 2))) +fib = 0 : 1 : next fib where next (a: t@(b:_)) = (a+b) : next t diff --git a/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-9.hs b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-9.hs new file mode 100644 index 0000000000..093c22af12 --- /dev/null +++ b/Task/Fibonacci-sequence/Haskell/fibonacci-sequence-9.hs @@ -0,0 +1 @@ +fib = 0 : scanl (+) 1 fib diff --git a/Task/Fibonacci-sequence/Haxe/fibonacci-sequence-2.haxe b/Task/Fibonacci-sequence/Haxe/fibonacci-sequence-2.haxe index b99f722d0c..c900088855 100644 --- a/Task/Fibonacci-sequence/Haxe/fibonacci-sequence-2.haxe +++ b/Task/Fibonacci-sequence/Haxe/fibonacci-sequence-2.haxe @@ -1,18 +1,14 @@ class FibIter { - public var current:Int; - private var nextItem:Int; + private var current = 0; + private var nextItem = 1; private var limit:Int; - public function new(limit) { - current = 0; - nextItem = 1; - this.limit = limit; - } + public function new(limit) this.limit = limit; + + public function hasNext() return limit > 0; - public function hasNext() return limit > 0 - - public function next() { + public function next() { limit--; var ret = current; var temp = current + nextItem; diff --git a/Task/Fibonacci-sequence/Java/fibonacci-sequence-6.java b/Task/Fibonacci-sequence/Java/fibonacci-sequence-6.java new file mode 100644 index 0000000000..eca4fb5467 --- /dev/null +++ b/Task/Fibonacci-sequence/Java/fibonacci-sequence-6.java @@ -0,0 +1,18 @@ +import java.util.function.LongUnaryOperator; +import java.util.stream.LongStream; + +public class FibUtil { + public static LongStream fibStream() { + return LongStream.iterate( 1l, new LongUnaryOperator() { + private long lastFib = 0; + @Override public long applyAsLong( long operand ) { + long ret = operand + lastFib; + lastFib = operand; + return ret; + } + }); + } + public static long fib(long n) { + return fibStream().limit( n ).reduce((prev, last) -> last).getAsLong(); + } +} diff --git a/Task/Fibonacci-sequence/JavaScript/fibonacci-sequence-4.js b/Task/Fibonacci-sequence/JavaScript/fibonacci-sequence-4.js index 9c507fdc23..97864141c2 100644 --- a/Task/Fibonacci-sequence/JavaScript/fibonacci-sequence-4.js +++ b/Task/Fibonacci-sequence/JavaScript/fibonacci-sequence-4.js @@ -1,17 +1,17 @@ -function Y(dn) { - return (function(fn) { - return fn(fn); - }(function(fn) { - return dn(function() { - return fn(fn).apply(null, arguments); - }); - })); -} -var fib = Y(function(fn) { - return function(n) { - if (n === 0 || n === 1) { - return n; - } - return fn(n - 1) + fn(n - 2); - }; -}); +(function () { + 'use strict'; + + function fib(n) { + return Array.apply(null, Array(n + 1)) + .map(function (_, i, lst) { + return lst[i] = ( + i ? i < 2 ? 1 : + lst[i - 2] + lst[i - 1] : + 0 + ); + })[n]; + } + + return fib(32); + +})(); diff --git a/Task/Fibonacci-sequence/JavaScript/fibonacci-sequence-5.js b/Task/Fibonacci-sequence/JavaScript/fibonacci-sequence-5.js index cbb9a58664..9c507fdc23 100644 --- a/Task/Fibonacci-sequence/JavaScript/fibonacci-sequence-5.js +++ b/Task/Fibonacci-sequence/JavaScript/fibonacci-sequence-5.js @@ -1,10 +1,17 @@ -function* fibonacciGenerator() { - var prev = 0; - var curr = 1; - while (true) { - yield curr; - curr = curr + prev; - prev = curr - prev; - } +function Y(dn) { + return (function(fn) { + return fn(fn); + }(function(fn) { + return dn(function() { + return fn(fn).apply(null, arguments); + }); + })); } -var fib = fibonacciGenerator(); +var fib = Y(function(fn) { + return function(n) { + if (n === 0 || n === 1) { + return n; + } + return fn(n - 1) + fn(n - 2); + }; +}); diff --git a/Task/Fibonacci-sequence/JavaScript/fibonacci-sequence-6.js b/Task/Fibonacci-sequence/JavaScript/fibonacci-sequence-6.js new file mode 100644 index 0000000000..cbb9a58664 --- /dev/null +++ b/Task/Fibonacci-sequence/JavaScript/fibonacci-sequence-6.js @@ -0,0 +1,10 @@ +function* fibonacciGenerator() { + var prev = 0; + var curr = 1; + while (true) { + yield curr; + curr = curr + prev; + prev = curr - prev; + } +} +var fib = fibonacciGenerator(); diff --git a/Task/Fibonacci-sequence/JavaScript/fibonacci-sequence-7.js b/Task/Fibonacci-sequence/JavaScript/fibonacci-sequence-7.js new file mode 100644 index 0000000000..6e6003e9db --- /dev/null +++ b/Task/Fibonacci-sequence/JavaScript/fibonacci-sequence-7.js @@ -0,0 +1,35 @@ +(() => { + 'use strict'; + + // Nth member of fibonacci series + + // fib :: Int -> Int + function fib(n) { + return mapAccumL(([a, b]) => [ + [b, a + b], b + ], [0, 1], range(1, n))[0][0]; + }; + + // GENERIC FUNCTIONS + + // mapAccumL :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y]) + let mapAccumL = (f, acc, xs) => { + return xs.reduce((a, x) => { + let pair = f(a[0], x); + + return [pair[0], a[1].concat(pair[1])]; + }, [acc, []]); + } + + // range :: Int -> Int -> Maybe Int -> [Int] + let range = (m, n) => + Array.from({ + length: Math.floor(n - m) + 1 + }, (_, i) => m + i); + + + // TEST + return fib(32); + + // --> 2178309 +})(); diff --git a/Task/Fibonacci-sequence/JavaScript/fibonacci-sequence-8.js b/Task/Fibonacci-sequence/JavaScript/fibonacci-sequence-8.js new file mode 100644 index 0000000000..20f1368b43 --- /dev/null +++ b/Task/Fibonacci-sequence/JavaScript/fibonacci-sequence-8.js @@ -0,0 +1,22 @@ +(() => { + 'use strict'; + + // fib :: Int -> Int + let fib = n => range(1, n) + .reduce(([a, b]) => [b, a + b], [0, 1])[0]; + + + // GENERIC [m..n] + + // range :: Int -> Int -> [Int] + let range = (m, n) => + Array.from({ + length: Math.floor(n - m) + 1 + }, (_, i) => m + i); + + + // TEST + return fib(32); + + // --> 2178309 +})(); diff --git a/Task/Fibonacci-sequence/Kotlin/fibonacci-sequence.kotlin b/Task/Fibonacci-sequence/Kotlin/fibonacci-sequence.kotlin index fc5c035150..91228c19ab 100644 --- a/Task/Fibonacci-sequence/Kotlin/fibonacci-sequence.kotlin +++ b/Task/Fibonacci-sequence/Kotlin/fibonacci-sequence.kotlin @@ -23,10 +23,11 @@ enum class Fibonacci { abstract operator fun invoke(n: Long): Long } -fun main(args: Array) { +fun main(a: Array) { val r = 0..30L - Fibonacci.values() forEach { - print("\n${it.name()}: ") - r forEach { i -> print(" " + it(i)) } + Fibonacci.values().forEach { + print("${it.name}: ") + r.forEach { i -> print(" " + it(i)) } + println() } } diff --git a/Task/Fibonacci-sequence/Liberty-BASIC/fibonacci-sequence.liberty b/Task/Fibonacci-sequence/Liberty-BASIC/fibonacci-sequence-1.liberty similarity index 100% rename from Task/Fibonacci-sequence/Liberty-BASIC/fibonacci-sequence.liberty rename to Task/Fibonacci-sequence/Liberty-BASIC/fibonacci-sequence-1.liberty diff --git a/Task/Fibonacci-sequence/Liberty-BASIC/fibonacci-sequence-2.liberty b/Task/Fibonacci-sequence/Liberty-BASIC/fibonacci-sequence-2.liberty new file mode 100644 index 0000000000..55f94e7b23 --- /dev/null +++ b/Task/Fibonacci-sequence/Liberty-BASIC/fibonacci-sequence-2.liberty @@ -0,0 +1,34 @@ +print "Rosetta Code - Fibonacci sequence": print +print " n Fn" +for x=-12 to 12 '68 max + print using("### ", x); using("##############", FibonacciTerm(x)) +next x +print +[start] +input "Enter a term#: "; n$ +n$=lower$(trim$(n$)) +if n$="" then print "Program complete.": end +print FibonacciTerm(val(n$)) +goto [start] + +function FibonacciTerm(n) + n=int(n) + FTa=0: FTb=1: FTc=-1 + select case + case n=0 : FibonacciTerm=0 : exit function + case n=1 : FibonacciTerm=1 : exit function + case n=-1 : FibonacciTerm=-1 : exit function + case n>1 + for x=2 to n + FibonacciTerm=FTa+FTb + FTa=FTb: FTb=FibonacciTerm + next x + exit function + case n<-1 + for x=-2 to n step -1 + FibonacciTerm=FTa+FTc + FTa=FTc: FTc=FibonacciTerm + next x + exit function + end select +end function diff --git a/Task/Fibonacci-sequence/Lua/fibonacci-sequence.lua b/Task/Fibonacci-sequence/Lua/fibonacci-sequence.lua index 14e7974c8b..a28b1463b6 100644 --- a/Task/Fibonacci-sequence/Lua/fibonacci-sequence.lua +++ b/Task/Fibonacci-sequence/Lua/fibonacci-sequence.lua @@ -14,7 +14,24 @@ end --tail-recursive function a(n,u,s) if n<2 then return u+s end return a(n-1,u+s,u) end -function trfib(i) return a(i,1,0) end +function trfib(i) return a(i-1,1,0) end --table-recursive -fib_n = setmetatable({1, 1}, {__index = function(z,n) return z[n-1] + z[n-2] end}) +fib_n = setmetatable({1, 1}, {__index = function(z,n) return n<=0 and 0 or z[n-1] + z[n-2] end}) + +--table-recursive done properly (values are actually saved into table; also the first element +-- of Fibonacci sequence is 0, so the initial table should be {0, 1}). +fib_n = setmetatable({0, 1}, { + __index = function(t,n) + if n <= 0 then return 0 end + t[n] = t[n-1] + t[n-2] + return t[n] + end +}) + +--loop version +function lfibs(n) + local p0,p1=0,1 + for _=1,n do p0,p1 = p1,p0+p1 end + return p0 +end diff --git a/Task/Fibonacci-sequence/MIPS-Assembly/fibonacci-sequence.mips b/Task/Fibonacci-sequence/MIPS-Assembly/fibonacci-sequence.mips new file mode 100644 index 0000000000..2af84b424d --- /dev/null +++ b/Task/Fibonacci-sequence/MIPS-Assembly/fibonacci-sequence.mips @@ -0,0 +1,43 @@ + .text +main: li $v0, 5 # read integer from input. The read integer will be stroed in $v0 + syscall + + beq $v0, 0, is1 + beq $v0, 1, is1 + + li $s4, 1 # the counter which has to equal to $v0 + + li $s0, 1 + li $s1, 1 + +loop: add $s2, $s0, $s1 + addi $s4, $s4, 1 + beq $v0, $s4, iss2 + + add $s0, $s1, $s2 + addi $s4, $s4, 1 + beq $v0, $s4, iss0 + + add $s1, $s2, $s0 + addi $s4, $s4, 1 + beq $v0, $s4, iss1 + + b loop + +iss0: move $a0, $s0 + b print + +iss1: move $a0, $s1 + b print + +iss2: move $a0, $s2 + b print + + +is1: li $a0, 1 + b print + +print: li $v0, 1 + syscall + li $v0, 10 + syscall diff --git a/Task/Fibonacci-sequence/Maple/fibonacci-sequence.maple b/Task/Fibonacci-sequence/Maple/fibonacci-sequence.maple new file mode 100644 index 0000000000..daba8ddd0d --- /dev/null +++ b/Task/Fibonacci-sequence/Maple/fibonacci-sequence.maple @@ -0,0 +1,5 @@ +> f := n -> ifelse(n<3,1,f(n-1)+f(n-2)); +> f(2); + 1 +> f(3); + 2 diff --git a/Task/Fibonacci-sequence/Oberon-2/fibonacci-sequence.oberon-2 b/Task/Fibonacci-sequence/Oberon-2/fibonacci-sequence.oberon-2 new file mode 100644 index 0000000000..54baed746e --- /dev/null +++ b/Task/Fibonacci-sequence/Oberon-2/fibonacci-sequence.oberon-2 @@ -0,0 +1,60 @@ +MODULE Fibonacci; +IMPORT + Out := NPCT:Console; + +PROCEDURE Fibs(VAR r: ARRAY OF LONGREAL); +VAR + i: LONGINT; +BEGIN + r[0] := 1.0; r[1] := 1.0; + FOR i := 2 TO LEN(r) - 1 DO + r[i] := r[i - 2] + r[i - 1]; + END +END Fibs; + +PROCEDURE FibsR(n: LONGREAL): LONGREAL; +BEGIN + IF n < 2. THEN + RETURN n + ELSE + RETURN FibsR(n - 1) + FibsR(n - 2) + END +END FibsR; + +PROCEDURE Show(r: ARRAY OF LONGREAL); +VAR + i: LONGINT; +BEGIN + Out.String("First ");Out.Int(LEN(r),0);Out.String(" Fibonacci numbers");Out.Ln; + FOR i := 0 TO LEN(r) - 1 DO + Out.LongRealFix(r[i],8,0) + END; + Out.Ln +END Show; + +PROCEDURE Gen(s: LONGINT); +VAR + x: POINTER TO ARRAY OF LONGREAL; +BEGIN + NEW(x,s); + Fibs(x^); + Show(x^) +END Gen; + +PROCEDURE GenR(s: LONGINT); +VAR + i: LONGINT; +BEGIN + Out.String("First ");Out.Int(s,0);Out.String(" Fibonacci numbers (Recursive)");Out.Ln; + FOR i := 1 TO s DO + Out.LongRealFix(FibsR(i),8,0) + END; + Out.Ln +END GenR; + +BEGIN + Gen(10); + Gen(20); + GenR(10); + GenR(20); +END Fibonacci. diff --git a/Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-11.pari b/Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-11.pari index a8e222a86d..d61ad21f25 100644 --- a/Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-11.pari +++ b/Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-11.pari @@ -1,11 +1 @@ -fib(n)={ - if(n<0,return((-1)^(n+1)*fib(n))); - my(a=0,b=1,t); - while(n, - t=a+b; - a=b; - b=t; - n-- - ); - a -}; +apply(n->if(n<2,n,my(s=self());s(n-2)+s(n-1)), [1..10]) diff --git a/Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-12.pari b/Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-12.pari index 2f2e9ab577..160485b25a 100644 --- a/Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-12.pari +++ b/Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-12.pari @@ -1 +1,13 @@ -fib(n)=my(k=0);while(n--,k++;while(!issquare(5*k^2+4)&&!issquare(5*k^2-4),k++));k +F=[]; +fib(n)={ + if(n>#F, + F=concat(F, vector(n-#F)); + F[n]=fib(n-1)+fib(n-2) + , + if(n<2, + n + , + if(F[n],F[n],F[n]=fib(n-1)+fib(n-2)) + ) + ); +} diff --git a/Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-13.pari b/Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-13.pari new file mode 100644 index 0000000000..a8e222a86d --- /dev/null +++ b/Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-13.pari @@ -0,0 +1,11 @@ +fib(n)={ + if(n<0,return((-1)^(n+1)*fib(n))); + my(a=0,b=1,t); + while(n, + t=a+b; + a=b; + b=t; + n-- + ); + a +}; diff --git a/Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-14.pari b/Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-14.pari new file mode 100644 index 0000000000..49a2f5b231 --- /dev/null +++ b/Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-14.pari @@ -0,0 +1,7 @@ +matantihadamard(n)={ + matrix(n,n,i,j, + my(t=j-i+1); + if(t<1,t%2,t<3) + ); +} +fib(n)=matdet(matantihadamard(n)) diff --git a/Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-15.pari b/Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-15.pari new file mode 100644 index 0000000000..78ccd47534 --- /dev/null +++ b/Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-15.pari @@ -0,0 +1,7 @@ +fib(n)= +{ + my(g=2^(n+1)-1); + sum(i=2^(n-1),2^n-1, + bitor(i,i<<1)==g + ); +} diff --git a/Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-16.pari b/Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-16.pari new file mode 100644 index 0000000000..2f2e9ab577 --- /dev/null +++ b/Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-16.pari @@ -0,0 +1 @@ +fib(n)=my(k=0);while(n--,k++;while(!issquare(5*k^2+4)&&!issquare(5*k^2-4),k++));k diff --git a/Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-2.pari b/Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-2.pari index 42602306f3..0e6cd1f32e 100644 --- a/Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-2.pari +++ b/Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-2.pari @@ -1 +1 @@ -([1,1;1,0]^n)[1,2] +fibo(n)=([1,1;1,0]^n)[1,2] diff --git a/Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-9.pari b/Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-9.pari index 454bbf27c4..4ab19b6e14 100644 --- a/Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-9.pari +++ b/Task/Fibonacci-sequence/PARI-GP/fibonacci-sequence-9.pari @@ -1,10 +1,6 @@ fib(n)={ if(n<2, - if(n<0, - (-1)^(n+1)*fib(n) - , - n - ) + n , fib(n-1)+fib(n) ) diff --git a/Task/Fibonacci-sequence/Pascal/fibonacci-sequence-4.pascal b/Task/Fibonacci-sequence/Pascal/fibonacci-sequence-4.pascal new file mode 100644 index 0000000000..e19577f1ea --- /dev/null +++ b/Task/Fibonacci-sequence/Pascal/fibonacci-sequence-4.pascal @@ -0,0 +1,4 @@ +function FiboMax(n: integer):Extended; //maXbox +begin + result:= (pow((1+SQRT5)/2,n)-pow((1-SQRT5)/2,n))/SQRT5 +end; diff --git a/Task/Fibonacci-sequence/Pascal/fibonacci-sequence-5.pascal b/Task/Fibonacci-sequence/Pascal/fibonacci-sequence-5.pascal new file mode 100644 index 0000000000..144e54e50c --- /dev/null +++ b/Task/Fibonacci-sequence/Pascal/fibonacci-sequence-5.pascal @@ -0,0 +1,18 @@ +function Fibo_BigInt(n: integer): string; //maXbox + var tbig1, tbig2, tbig3: TInteger; + begin + result:= '0' + tbig1:= TInteger.create(1); //temp + tbig2:= TInteger.create(0); //result (a) + tbig3:= Tinteger.create(1); //b + for it:= 1 to n do begin + tbig1.assign(tbig2) + tbig2.assign(tbig3); + tbig1.add(tbig3); + tbig3.assign(tbig1); + end; + result:= tbig2.toString(false) + tbig3.free; + tbig2.free; + tbig1.free; + end; diff --git a/Task/Fibonacci-sequence/Perl-6/fibonacci-sequence-1.pl6 b/Task/Fibonacci-sequence/Perl-6/fibonacci-sequence-1.pl6 index 65f426f2ed..39ae057b34 100644 --- a/Task/Fibonacci-sequence/Perl-6/fibonacci-sequence-1.pl6 +++ b/Task/Fibonacci-sequence/Perl-6/fibonacci-sequence-1.pl6 @@ -1 +1 @@ -my constant @fib = 0, 1, *+* ... *; +constant @fib = 0, 1, *+* ... *; diff --git a/Task/Fibonacci-sequence/Perl-6/fibonacci-sequence-3.pl6 b/Task/Fibonacci-sequence/Perl-6/fibonacci-sequence-3.pl6 index 91118762c3..f52a6ad2eb 100644 --- a/Task/Fibonacci-sequence/Perl-6/fibonacci-sequence-3.pl6 +++ b/Task/Fibonacci-sequence/Perl-6/fibonacci-sequence-3.pl6 @@ -1,2 +1,2 @@ -my constant @neg_fib = 0, 1, *-* ... *; -sub fib ($n) { $n >= 0 and @fib[$n] or @neg_fib[-$n]; } +constant @neg-fib = 0, 1, *-* ... *; +sub fib ($n) { $n >= 0 ?? @fib[$n] !! @neg-fib[-$n] } diff --git a/Task/Fibonacci-sequence/Perl-6/fibonacci-sequence-5.pl6 b/Task/Fibonacci-sequence/Perl-6/fibonacci-sequence-5.pl6 index 9f73216174..1df565daca 100644 --- a/Task/Fibonacci-sequence/Perl-6/fibonacci-sequence-5.pl6 +++ b/Task/Fibonacci-sequence/Perl-6/fibonacci-sequence-5.pl6 @@ -1,3 +1,4 @@ +use experimental :cached; proto fib (Int $n --> Int) is cached {*} multi fib (0) { 0 } multi fib (1) { 1 } diff --git a/Task/Fibonacci-sequence/PowerShell/fibonacci-sequence-1.psh b/Task/Fibonacci-sequence/PowerShell/fibonacci-sequence-1.psh index 66fe630b33..1751cbad42 100644 --- a/Task/Fibonacci-sequence/PowerShell/fibonacci-sequence-1.psh +++ b/Task/Fibonacci-sequence/PowerShell/fibonacci-sequence-1.psh @@ -1,26 +1,9 @@ -function fib ($n) { - if ($n -eq 0) { return 0 } - if ($n -eq 1) { return 1 } - - $m = 1 - if ($n -lt 0) { - if ($n % 2 -eq -1) { - $m = 1 - } else { - $m = -1 - } - - $n = -$n +function FibonacciNumber ( $count ) +{ + $answer = @(0,1) + while ($answer.Length -le $count) + { + $answer += $answer[-1] + $answer[-2] } - - $a = 0 - $b = 1 - - for ($i = 1; $i -lt $n; $i++) { - $c = $a + $b - $a = $b - $b = $c - } - - return $m * $b + return $answer } diff --git a/Task/Fibonacci-sequence/PowerShell/fibonacci-sequence-2.psh b/Task/Fibonacci-sequence/PowerShell/fibonacci-sequence-2.psh index cdaad2c70b..59dc348a5b 100644 --- a/Task/Fibonacci-sequence/PowerShell/fibonacci-sequence-2.psh +++ b/Task/Fibonacci-sequence/PowerShell/fibonacci-sequence-2.psh @@ -1,8 +1,4 @@ -function fib($n) { - switch ($n) { - 0 { return 0 } - 1 { return 1 } - { $_ -lt 0 } { return [Math]::Pow(-1, -$n + 1) * (fib (-$n)) } - default { return (fib ($n - 1)) + (fib ($n - 2)) } - } -} +$count = 8 +$answer = @(0,1) +0..($count - $answer.Length) | Foreach { $answer += $answer[-1] + $answer[-2] } +$answer diff --git a/Task/Fibonacci-sequence/PowerShell/fibonacci-sequence-3.psh b/Task/Fibonacci-sequence/PowerShell/fibonacci-sequence-3.psh new file mode 100644 index 0000000000..cdaad2c70b --- /dev/null +++ b/Task/Fibonacci-sequence/PowerShell/fibonacci-sequence-3.psh @@ -0,0 +1,8 @@ +function fib($n) { + switch ($n) { + 0 { return 0 } + 1 { return 1 } + { $_ -lt 0 } { return [Math]::Pow(-1, -$n + 1) * (fib (-$n)) } + default { return (fib ($n - 1)) + (fib ($n - 2)) } + } +} diff --git a/Task/Fibonacci-sequence/Python/fibonacci-sequence-11.py b/Task/Fibonacci-sequence/Python/fibonacci-sequence-11.py new file mode 100644 index 0000000000..0c83030578 --- /dev/null +++ b/Task/Fibonacci-sequence/Python/fibonacci-sequence-11.py @@ -0,0 +1,11 @@ +from itertools import islice + +def fib(): + yield 0 + yield 1 + a, b = fib(), fib() + next(b) + while True: + yield next(a)+next(b) + +print(tuple(islice(fib(), 10))) diff --git a/Task/Fibonacci-sequence/Python/fibonacci-sequence-5.py b/Task/Fibonacci-sequence/Python/fibonacci-sequence-5.py index 24eb4007fa..5519a2ecdb 100644 --- a/Task/Fibonacci-sequence/Python/fibonacci-sequence-5.py +++ b/Task/Fibonacci-sequence/Python/fibonacci-sequence-5.py @@ -1,5 +1,7 @@ def fibFastRec(n): def fib(prvprv, prv, c): - if c < 1: return prvprv - else: return fib(prv, prvprv + prv, c - 1) + if c < 1: + return prvprv + else: + return fib(prv, prvprv + prv, c - 1) return fib(0, 1, n) diff --git a/Task/Fibonacci-sequence/Python/fibonacci-sequence-6.py b/Task/Fibonacci-sequence/Python/fibonacci-sequence-6.py index b87bd1fba7..231e92fdd0 100644 --- a/Task/Fibonacci-sequence/Python/fibonacci-sequence-6.py +++ b/Task/Fibonacci-sequence/Python/fibonacci-sequence-6.py @@ -1,4 +1,5 @@ -def fibGen(n,a=0,b=1): +def fibGen(n): + a, b = 0, 1 while n>0: yield a - a,b,n = b,a+b,n-1 + a, b, n = b, a+b, n-1 diff --git a/Task/Fibonacci-sequence/REXX/fibonacci-sequence.rexx b/Task/Fibonacci-sequence/REXX/fibonacci-sequence.rexx index 95464561b8..794f437cce 100644 --- a/Task/Fibonacci-sequence/REXX/fibonacci-sequence.rexx +++ b/Task/Fibonacci-sequence/REXX/fibonacci-sequence.rexx @@ -1,23 +1,23 @@ -/*REXX program calculates the Nth Fibonacci number, N can be zero or neg*/ -numeric digits 210000 /*be able to handle some big 'uns*/ -parse arg x y . /*allow a single number or range.*/ -if x=='' then do; x=-40; y=+40; end /*No input? Use range -40 ──► +40*/ -if y=='' then y=x /*if only one number, show fib(n)*/ -w=max(length(x), length(y)) /*used for making output pretty. */ -fw=10 /*minmum maximum width. Ka-razy.*/ - do j=x to y; q=fib(j) /*process each Fibonacci request.*/ - L=length(q) /*obtain the length (width) of Q.*/ - fw=max(fw, L) /*fib# length or the max so far. */ - say 'Fibonacci('right(j,w)") = " right(q,fw) /*right justify Q.*/ - if L>10 then say 'Fibonacci('right(j,w)") has a length of" L - end /*j*/ /* [↑] list a Fib seq. of x──►y */ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────FIB subroutine──────────────────────*/ -fib: procedure; parse arg n; a=0; b=1; na=abs(n) /*use |n| */ -if na<2 then return na /*handle 3 special cases (-1,0,1)*/ - /* [↓] method is non-recursive.*/ - do k=2 to na; s=a+b; a=b; b=s /*sum the numbers up to │n│ */ - end /*k*/ /* [↑] (only positive Fibs used)*/ - /* [↓] na//2 [same as] na/2==1 */ -if n>0 | na//2 then return s /*if positive or odd negative ···*/ - return -s /*return a negative Fib number. */ +/*REXX program calculates the Nth Fibonacci number, N can be zero or negative. */ +numeric digits 210000 /*be able to handle ginormous numbers. */ +parse arg x y . /*allow a single number or a range. */ +if x=='' | x=="," then do; x=-40; y=+40; end /*No input? Then use range -40 ──► +40*/ +if y=='' | y=="," then y=x /*if only one number, display fib(X).*/ +w=max(length(x), length(y) ) /*W: used for making formatted output.*/ +fw=10 /*Minimum maximum width. Sounds ka─razy*/ + do j=x to y; q=fib(j) /*process all of the Fibonacci requests*/ + L=length(q) /*obtain the length (decimal digs) of Q*/ + fw=max(fw, L) /*fib number length, or the max so far.*/ + say 'Fibonacci('right(j,w)") = " right(q,fw) /*right justify Q*/ + if L>10 then say 'Fibonacci('right(j, w)") has a length of" L + end /*j*/ /* [↑] list a Fib. sequence of x──►y */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +fib: procedure; parse arg n; an=abs(n) /*use │n│ (the absolute value of N).*/ + a=0; b=1; if an<2 then return an /*handle two special cases: zero & one.*/ + /* [↓] this method is non─recursive. */ + do k=2 to an; $=a+b; a=b; b=$ /*sum the numbers up to │n│ */ + end /*k*/ /* [↑] (only positive Fibs nums used).*/ + /* [↓] an//2 [same as] (an//2==1).*/ + if n>0 | an//2 then return $ /*Positive or even? Then return sum. */ + return -$ /*Negative and odd? Return negative sum*/ diff --git a/Task/Fibonacci-sequence/Rust/fibonacci-sequence-1.rust b/Task/Fibonacci-sequence/Rust/fibonacci-sequence-1.rust index 7f900b9c0c..e82ad2e343 100644 --- a/Task/Fibonacci-sequence/Rust/fibonacci-sequence-1.rust +++ b/Task/Fibonacci-sequence/Rust/fibonacci-sequence-1.rust @@ -1,30 +1,12 @@ -#![feature(zero_one)] -use std::num::One; -use std::ops::Add; - -struct Fib { - curr: T, - next: T, -} - -impl Fib where T: One { - fn new() -> Self { - Fib {curr: T::one(), next: T::one()} - } -} - -impl Iterator for Fib where T: Add + Copy { - type Item = T; - fn next(&mut self) -> Option{ - let new = self.curr + self.next; - self.curr = self.next; - self.next = new; - Some(self.curr) - } -} - +use std::mem; fn main() { - for i in Fib::::new() { - println!("{}", i); + let mut prev = 0; + // Rust needs this type hint for the checked_add method + let mut curr = 1usize; + + while let Some(n) = curr.checked_add(prev) { + prev = curr; + curr = n; + println!("{}", n); } } diff --git a/Task/Fibonacci-sequence/Rust/fibonacci-sequence-2.rust b/Task/Fibonacci-sequence/Rust/fibonacci-sequence-2.rust index 64a8e80e71..e982fec757 100644 --- a/Task/Fibonacci-sequence/Rust/fibonacci-sequence-2.rust +++ b/Task/Fibonacci-sequence/Rust/fibonacci-sequence-2.rust @@ -1,16 +1,12 @@ +use std::mem; fn main() { - fn fib(n: i32) -> i32 { - fn _fib(n: i32, a: i32, b: i32) -> i32 { - match (n, a, b) { - (0, _, _) => a, - _ => _fib(n-1, a+b, a) - } - } + fibonacci(0,1); +} - _fib(n, 0, 1) - } - - for n in 0..20 { - println!("{}", fib(n)); +fn fibonacci(mut prev: usize, mut curr: usize) { + mem::swap(&mut prev, &mut curr); + if let Some(n) = curr.checked_add(prev) { + println!("{}", n); + fibonacci(prev, n); } } diff --git a/Task/Fibonacci-sequence/Rust/fibonacci-sequence-3.rust b/Task/Fibonacci-sequence/Rust/fibonacci-sequence-3.rust new file mode 100644 index 0000000000..8f36c8c7a9 --- /dev/null +++ b/Task/Fibonacci-sequence/Rust/fibonacci-sequence-3.rust @@ -0,0 +1,14 @@ +#![feature(conservative_impl_trait)] + +fn main() { + for num in fibonacci_gen(10) { + println!("{}", num); + } +} + +fn fibonacci_gen(terms: i32) -> impl Iterator { + let sqrt_5 = 5.0f64.sqrt(); + let p = (1.0 +sqrt_5) / 2.0; + let q = 1.0/p; + (1..terms).map(move |n| ((p.powi(n) + q.powi(n)) / sqrt_5 + 0.5).floor()) +} diff --git a/Task/Fibonacci-sequence/Rust/fibonacci-sequence-4.rust b/Task/Fibonacci-sequence/Rust/fibonacci-sequence-4.rust new file mode 100644 index 0000000000..933fd50c9b --- /dev/null +++ b/Task/Fibonacci-sequence/Rust/fibonacci-sequence-4.rust @@ -0,0 +1,29 @@ +use std::mem; + +struct Fib { + prev: usize, + curr: usize, +} + +impl Fib { + fn new() -> Self { + Fib {prev: 0, curr: 1} + } +} + +impl Iterator for Fib { + type Item = usize; + fn next(&mut self) -> Option{ + mem::swap(&mut self.curr, &mut self.prev); + self.curr.checked_add(self.prev).map(|n| { + self.curr = n; + n + }) + } +} + +fn main() { + for num in Fib::new() { + println!("{}", num); + } +} diff --git a/Task/Fibonacci-sequence/SAS/fibonacci-sequence-1.sas b/Task/Fibonacci-sequence/SAS/fibonacci-sequence-1.sas new file mode 100644 index 0000000000..d049839412 --- /dev/null +++ b/Task/Fibonacci-sequence/SAS/fibonacci-sequence-1.sas @@ -0,0 +1,11 @@ +data fib; + a=0; + b=1; + do n=0 to 20; + f=a; + output; + a=b; + b=f+a; + end; + keep n f; +run; diff --git a/Task/Fibonacci-sequence/SAS/fibonacci-sequence-2.sas b/Task/Fibonacci-sequence/SAS/fibonacci-sequence-2.sas new file mode 100644 index 0000000000..d27d037865 --- /dev/null +++ b/Task/Fibonacci-sequence/SAS/fibonacci-sequence-2.sas @@ -0,0 +1,14 @@ +options cmplib=work.f; + +proc fcmp outlib=work.f.p; + function fib(n); + if n = 0 or n = 1 + then return(1); + else return(fib(n - 2) + fib(n - 1)); + endsub; +run; + +data _null_; + x = fib(5); + put 'fib(5) = ' x; +run; diff --git a/Task/Fibonacci-sequence/SAS/fibonacci-sequence.sas b/Task/Fibonacci-sequence/SAS/fibonacci-sequence.sas deleted file mode 100644 index f6951a14b5..0000000000 --- a/Task/Fibonacci-sequence/SAS/fibonacci-sequence.sas +++ /dev/null @@ -1,12 +0,0 @@ -/* building a table with fibonacci sequence */ -data fib; -a=0; -b=1; -do n=0 to 20; - f=a; - output; - a=b; - b=f+a; -end; -keep n f; -run; diff --git a/Task/Fibonacci-sequence/SQL/fibonacci-sequence-1.sql b/Task/Fibonacci-sequence/SQL/fibonacci-sequence-1.sql new file mode 100644 index 0000000000..b24357522e --- /dev/null +++ b/Task/Fibonacci-sequence/SQL/fibonacci-sequence-1.sql @@ -0,0 +1,4 @@ +select round ( exp ( sum (ln ( ( 1 + sqrt( 5 ) ) / 2) + ) over ( order by level ) ) / sqrt( 5 ) ) fibo +from dual +connect by level <= 10; diff --git a/Task/Fibonacci-sequence/SQL/fibonacci-sequence-2.sql b/Task/Fibonacci-sequence/SQL/fibonacci-sequence-2.sql new file mode 100644 index 0000000000..21d1585a33 --- /dev/null +++ b/Task/Fibonacci-sequence/SQL/fibonacci-sequence-2.sql @@ -0,0 +1,3 @@ +select round ( power( ( 1 + sqrt( 5 ) ) / 2, level ) / sqrt( 5 ) ) fib +from dual +connect by level <= 10; diff --git a/Task/Fibonacci-sequence/SQL/fibonacci-sequence.sql b/Task/Fibonacci-sequence/SQL/fibonacci-sequence-3.sql similarity index 100% rename from Task/Fibonacci-sequence/SQL/fibonacci-sequence.sql rename to Task/Fibonacci-sequence/SQL/fibonacci-sequence-3.sql diff --git a/Task/Fibonacci-sequence/Simula/fibonacci-sequence.simula b/Task/Fibonacci-sequence/Simula/fibonacci-sequence.simula new file mode 100644 index 0000000000..96cb600cc2 --- /dev/null +++ b/Task/Fibonacci-sequence/Simula/fibonacci-sequence.simula @@ -0,0 +1,14 @@ +INTEGER PROCEDURE fibonacci(n); +INTEGER n; +BEGIN + INTEGER lo, hi, temp, i; + lo := 0; + hi := 1; + FOR i := 1 STEP 1 UNTIL n - 1 DO + BEGIN + temp := hi; + hi := hi + lo; + lo := temp + END; + fibonacci := hi +END; diff --git a/Task/Fibonacci-sequence/SuperCollider/fibonacci-sequence-1.supercollider b/Task/Fibonacci-sequence/SuperCollider/fibonacci-sequence-1.supercollider new file mode 100644 index 0000000000..d35cd5354f --- /dev/null +++ b/Task/Fibonacci-sequence/SuperCollider/fibonacci-sequence-1.supercollider @@ -0,0 +1,2 @@ +f = { |n| if(n < 2) { n } { f.(n-1) + f.(n-2) } }; +(0..20).collect(f) diff --git a/Task/Fibonacci-sequence/SuperCollider/fibonacci-sequence-2.supercollider b/Task/Fibonacci-sequence/SuperCollider/fibonacci-sequence-2.supercollider new file mode 100644 index 0000000000..978a88add0 --- /dev/null +++ b/Task/Fibonacci-sequence/SuperCollider/fibonacci-sequence-2.supercollider @@ -0,0 +1,2 @@ +f = { |n| var u = neg(sign(n)); if(abs(n) < 2) { n } { f.(2 * u + n) + f.(u + n) } }; +(-20..20).collect(f) diff --git a/Task/Fibonacci-sequence/SuperCollider/fibonacci-sequence-3.supercollider b/Task/Fibonacci-sequence/SuperCollider/fibonacci-sequence-3.supercollider new file mode 100644 index 0000000000..3786922f2c --- /dev/null +++ b/Task/Fibonacci-sequence/SuperCollider/fibonacci-sequence-3.supercollider @@ -0,0 +1,9 @@ +( + f = { |n| + var sqrt5 = sqrt(5); + var p = (1 + sqrt5) / 2; + var q = reciprocal(p); + ((p ** n) + (q ** n) / sqrt5 + 0.5).trunc + }; + (0..20).collect(f) +) diff --git a/Task/Fibonacci-sequence/SuperCollider/fibonacci-sequence-4.supercollider b/Task/Fibonacci-sequence/SuperCollider/fibonacci-sequence-4.supercollider new file mode 100644 index 0000000000..dc83256f28 --- /dev/null +++ b/Task/Fibonacci-sequence/SuperCollider/fibonacci-sequence-4.supercollider @@ -0,0 +1,2 @@ +f = { |n| var a = [1, 1]; n.do { a = a.addFirst(a[0] + a[1]) }; a.reverse }; +f.(18) diff --git a/Task/Fibonacci-sequence/ZX-Spectrum-Basic/fibonacci-sequence.zx b/Task/Fibonacci-sequence/ZX-Spectrum-Basic/fibonacci-sequence.zx new file mode 100644 index 0000000000..7de2462cfa --- /dev/null +++ b/Task/Fibonacci-sequence/ZX-Spectrum-Basic/fibonacci-sequence.zx @@ -0,0 +1,9 @@ +10 REM Only positive numbers +20 LET n=10 +30 LET n1=0: LET n2=1 +40 FOR k=1 TO n +50 LET sum=n1+n2 +60 LET n1=n2 +70 LET n2=sum +80 NEXT k +90 PRINT n1 diff --git a/Task/Fibonacci-word-fractal/00DESCRIPTION b/Task/Fibonacci-word-fractal/00DESCRIPTION index 294d009e11..38c2f5c9db 100644 --- a/Task/Fibonacci-word-fractal/00DESCRIPTION +++ b/Task/Fibonacci-word-fractal/00DESCRIPTION @@ -1,3 +1,5 @@ +[[File:Fib_word_fractal.gif|613px||right]] + The [[Fibonacci word]] may be represented as a fractal as described [http://hal.archives-ouvertes.fr/docs/00/36/79/72/PDF/The_Fibonacci_word_fractal.pdf here]: :For F_wordm start with F_wordCharn=1 @@ -7,4 +9,8 @@ The [[Fibonacci word]] may be represented as a fractal as described [http://hal. ::Turn right if n is odd :next n and iterate until end of F_word -For this task create and display a fractal similar to [http://hal.archives-ouvertes.fr/docs/00/36/79/72/PDF/The_Fibonacci_word_fractal.pdf Fig 1]. + + +;Task: +Create and display a fractal similar to [http://hal.archives-ouvertes.fr/docs/00/36/79/72/PDF/The_Fibonacci_word_fractal.pdf Fig 1]. +

    diff --git a/Task/Fibonacci-word-fractal/Elixir/fibonacci-word-fractal.elixir b/Task/Fibonacci-word-fractal/Elixir/fibonacci-word-fractal.elixir index 7605fca8a0..671a434f08 100644 --- a/Task/Fibonacci-word-fractal/Elixir/fibonacci-word-fractal.elixir +++ b/Task/Fibonacci-word-fractal/Elixir/fibonacci-word-fractal.elixir @@ -9,8 +9,8 @@ defmodule Fibonacci do defp walk([], _, _, _, _, _, map), do: map defp walk([h|t], n, x, y, dx, dy, map) do - map2 = Dict.put(map, {x+dx, y+dy}, (if dx==0, do: "|", else: "-")) - |> Dict.put({x2=x+2*dx, y2=y+2*dy}, "+") + map2 = Map.put(map, {x+dx, y+dy}, (if dx==0, do: "|", else: "-")) + |> Map.put({x2=x+2*dx, y2=y+2*dy}, "+") if h == ?0 do if rem(n,2)==0, do: walk(t, n+1, x2, y2, dy, -dx, map2), else: walk(t, n+1, x2, y2, -dy, dx, map2) @@ -20,14 +20,12 @@ defmodule Fibonacci do end defp print(map) do - xkeys = Dict.keys(map) |> Enum.map(fn {x,_} -> x end) - xmin = Enum.min(xkeys) - xmax = Enum.max(xkeys) - ykeys = Dict.keys(map) |> Enum.map(fn {_,y} -> y end) - ymin = Enum.min(ykeys) - ymax = Enum.max(ykeys) + xkeys = Map.keys(map) |> Enum.map(fn {x,_} -> x end) + {xmin, xmax} = Enum.min_max(xkeys) + ykeys = Map.keys(map) |> Enum.map(fn {_,y} -> y end) + {ymin, ymax} = Enum.min_max(ykeys) Enum.each(ymin..ymax, fn y -> - IO.puts Enum.map_join(xmin..xmax, fn x -> Dict.get(map, {x,y}, " ") end) + IO.puts Enum.map(xmin..xmax, fn x -> Map.get(map, {x,y}, " ") end) end) end end diff --git a/Task/Fibonacci-word-fractal/Java/fibonacci-word-fractal.java b/Task/Fibonacci-word-fractal/Java/fibonacci-word-fractal.java new file mode 100644 index 0000000000..651ecd4b8b --- /dev/null +++ b/Task/Fibonacci-word-fractal/Java/fibonacci-word-fractal.java @@ -0,0 +1,67 @@ +import java.awt.*; +import javax.swing.*; + +public class FibonacciWordFractal extends JPanel { + String wordFractal; + + FibonacciWordFractal(int n) { + setPreferredSize(new Dimension(450, 620)); + setBackground(Color.white); + wordFractal = wordFractal(n); + } + + public String wordFractal(int n) { + if (n < 2) + return n == 1 ? "1" : ""; + + // we should really reserve fib n space here + StringBuilder f1 = new StringBuilder("1"); + StringBuilder f2 = new StringBuilder("0"); + + for (n = n - 2; n > 0; n--) { + String tmp = f2.toString(); + f2.append(f1); + + f1.setLength(0); + f1.append(tmp); + } + + return f2.toString(); + } + + void drawWordFractal(Graphics2D g, int x, int y, int dx, int dy) { + for (int n = 0; n < wordFractal.length(); n++) { + g.drawLine(x, y, x + dx, y + dy); + x += dx; + y += dy; + if (wordFractal.charAt(n) == '0') { + int tx = dx; + dx = (n % 2 == 0) ? -dy : dy; + dy = (n % 2 == 0) ? tx : -tx; + } + } + } + + @Override + public void paintComponent(Graphics gg) { + super.paintComponent(gg); + Graphics2D g = (Graphics2D) gg; + g.setRenderingHint(RenderingHints.KEY_ANTIALIASING, + RenderingHints.VALUE_ANTIALIAS_ON); + + drawWordFractal(g, 20, 20, 1, 0); + } + + public static void main(String[] args) { + SwingUtilities.invokeLater(() -> { + JFrame f = new JFrame(); + f.setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE); + f.setTitle("Fibonacci Word Fractal"); + f.setResizable(false); + f.add(new FibonacciWordFractal(23), BorderLayout.CENTER); + f.pack(); + f.setLocationRelativeTo(null); + f.setVisible(true); + }); + } +} diff --git a/Task/Fibonacci-word-fractal/JavaScript/fibonacci-word-fractal-1.js b/Task/Fibonacci-word-fractal/JavaScript/fibonacci-word-fractal-1.js new file mode 100644 index 0000000000..5469ed65c3 --- /dev/null +++ b/Task/Fibonacci-word-fractal/JavaScript/fibonacci-word-fractal-1.js @@ -0,0 +1,29 @@ +// Plot Fibonacci word/fractal +// FiboWFractal.js - 6/27/16 aev +function pFibowFractal(n,len,canvasId,color) { + // DCLs + var canvas = document.getElementById(canvasId); + var ctx = canvas.getContext("2d"); + var w = canvas.width; var h = canvas.height; + var fwv,fwe,fn,tx,x=10,y=10,dx=len,dy=0,nr; + // Cleaning canvas, setting plotting color, etc + ctx.fillStyle="white"; ctx.fillRect(0,0,w,h); + ctx.beginPath(); + ctx.moveTo(x,y); + fwv=fibword(n); fn=fwv.length; + // MAIN LOOP + for(var i=0; i + + + Fibonacci word/fractal + + + +

    Fibonacci word/fractal: n=31, len=2

    + + + + + + + + Fibonacci word/fractal + + + +

    Fibonacci word/fractal: n=31, len=1

    + + + diff --git a/Task/Fibonacci-word-fractal/PARI-GP/fibonacci-word-fractal-1.pari b/Task/Fibonacci-word-fractal/PARI-GP/fibonacci-word-fractal-1.pari new file mode 100644 index 0000000000..67cab55e7c --- /dev/null +++ b/Task/Fibonacci-word-fractal/PARI-GP/fibonacci-word-fractal-1.pari @@ -0,0 +1,46 @@ +\\ Fibonacci word/fractals +\\ 4/25/16 aev +fibword(n)={ +my(f1="1",f2="0",fw,fwn,n2); +if(n<=4, n=5);n2=n-2; +for(i=1,n2, fw=Str(f2,f1); f1=f2;f2=fw;); fwn=#fw; +fw=Vecsmall(fw); +for(i=1,fwn,fw[i]-=48); +return(fw); +} + +nextdir(n,d)={ +my(dir=-1); +if(d==0, if(n%2==0, dir=0,dir=1)); \\0-left,1-right +return(dir); +} + +plotfibofract(n,sz,len)={ +my(fwv,fn,dr,px=10,py=420,x=0,y=-len,g2=0, + ttl="Fibonacci word/fractal: n="); +plotinit(0); plotcolor(0,6); \\green +plotscale(0, -sz,sz, -sz,sz); +plotmove(0, px,py); +fwv=fibword(n); fn=#fwv; +for(i=1,fn, + plotrline(0,x,y); + dr=nextdir(i,fwv[i]); + if(dr==-1, next); + \\up + if(g2==0, y=0; if(dr, x=len;g2=1, x=-len;g2=3); next); + \\right + if(g2==1, x=0; if(dr, y=len;g2=2, y=-len;g2=0); next); + \\down + if(g2==2, y=0; if(dr, x=-len;g2=3, x=len;g2=1); next); + \\left + if(g2==3, x=0; if(dr, y=-len;g2=0, y=len;g2=2); next); + );\\fend i +plotdraw([0,-sz,-sz]); +print(" *** ",ttl,n," sz=",sz," len=",len," fw-len=",fn); + +} + +{\\ Executing: +plotfibofract(11,430,20); \\ Fibofrac1.png +plotfibofract(21,430,2); \\ Fibofrac2.png +} diff --git a/Task/Fibonacci-word-fractal/PARI-GP/fibonacci-word-fractal-2.pari b/Task/Fibonacci-word-fractal/PARI-GP/fibonacci-word-fractal-2.pari new file mode 100644 index 0000000000..9e73759b86 --- /dev/null +++ b/Task/Fibonacci-word-fractal/PARI-GP/fibonacci-word-fractal-2.pari @@ -0,0 +1,27 @@ +\\ Fibonacci word/fractals 2nd version +\\ 4/26/16 aev +fibword(n)={ +my(f1="1",f2="0",fw,fwn,n2); \\check n2 in v2 ADD it!! +if(n<=4, n=5); n2=n-2; +for(i=1,n2, fw=Str(f2,f1); f1=f2;f2=fw;); fwn=#fw; +fw=Vecsmall(fw); +for(i=1,fwn,fw[i]-=48); +return(fw); +} + +plotfibofract1(n,sz,len)={ +my(fwv,fn,dx=len,dy=0,nr,ttl="Fibonacci word/fractal, n="); +plotinit(0); plotcolor(0,5); \\red +plotscale(0, -sz,sz, -sz,sz); plotmove(0, 0,0); +fwv=fibword(n); fn=#fwv; +for(i=1,fn, plotrline(0,dx,dy); + if(fwv[i]==0, tx=dx; nr=i%2; if(!nr,dx=-dy;dy=tx, dx=dy;dy=-tx)); + );\\fend i +plotdraw([0,0,0]); +print(" *** ",ttl,n," sz=",sz," len=",len," fw-len=",fn); +} + +{\\ Executing: +plotfibofract1(17,500,6); \\ Fibofrac3.png +plotfibofract1(21,600,1); \\ Fibofrac4.png +} diff --git a/Task/Fibonacci-word-fractal/REXX/fibonacci-word-fractal.rexx b/Task/Fibonacci-word-fractal/REXX/fibonacci-word-fractal.rexx index 5dab8e5bfc..680dbc8908 100644 --- a/Task/Fibonacci-word-fractal/REXX/fibonacci-word-fractal.rexx +++ b/Task/Fibonacci-word-fractal/REXX/fibonacci-word-fractal.rexx @@ -1,41 +1,38 @@ -/*REXX program generates a Fibonacci word, then displays the fractal curve.*/ -parse arg ord . /*obtain optional arguments from the CL*/ -if ord=='' then ord=23 /*Not specified? Then use the default*/ -s=FibWord(ord) /*obtain the order of Fibonacci word.*/ - x=0; maxX=0; dx=0; b=' '; @.=b; xp=0 - y=0; maxY=0; dy=1; @.0.0=.; yp=0 - do n=1 for length(s); x=x+dx; y=y+dy /*advance the plot for the next point. */ - maxX=max(maxX,x); maxY=max(maxY,y) /*set the maximums for displaying plot.*/ - c='│'; if dx\==0 then c='─'; if n==1 then c='┌' /*The 1st plot?*/ - @.x.y=c /*assign a plotting character for curve*/ - if @(xp-1,yp)\==b & @(xp,yp-1)\==b then call @ xp,yp,'┐' /*fix-up.*/ - if @(xp-1,yp)\==b & @(xp,yp+1)\==b then call @ xp,yp,'┘' /* " */ - if @(xp+1,yp)\==b & @(xp,yp+1)\==b then call @ xp,yp,'└' /* " */ - if @(xp+1,yp)\==b & @(xp,yp-1)\==b then call @ xp,yp,'┌' /* " */ - xp=x; yp=y; z=substr(s,n,1) /*save old x,y; assign plot character.*/ - if z==1 then iterate /*Is Z equal to unity? Then ignore it.*/ - ox=dx; oy=dy; dx=0; dy=0 /*save DX,DY as the old versions. */ - d=-n//2; if d==0 then d=1 /*determine the sign for the chirality.*/ - if oy\==0 then dx=-sign(oy)*d /*Going north|south? Go east|west */ - if ox\==0 then dy= sign(ox)*d /* " east|west? " south|north */ +/*REXX program generates a Fibonacci word, then displays the fractal curve. */ +parse arg ord . /*obtain optional arguments from the CL*/ +if ord=='' then ord=23 /*Not specified? Then use the default*/ +s=FibWord(ord) /*obtain the order of Fibonacci word.*/ + x=0; maxX=0; dx=0; b=' '; @.=b; xp=0 + y=0; maxY=0; dy=1; @.0.0=.; yp=0 + do n=1 for length(s); x=x+dx; y=y+dy /*advance the plot for the next point. */ + maxX=max(maxX,x); maxY=max(maxY,y) /*set the maximums for displaying plot.*/ + c='│'; if dx\==0 then c="─"; if n==1 then c='┌' /*is this the first plot?*/ + @.x.y=c /*assign a plotting character for curve*/ + if @(xp-1,yp)\==b then if @(xp,yp-1)\==b then call @ xp,yp,'┐' /*fix─up a corner.*/ + if @(xp-1,yp)\==b then if @(xp,yp+1)\==b then call @ xp,yp,'┘' /* " " " */ + if @(xp+1,yp)\==b then if @(xp,yp+1)\==b then call @ xp,yp,'└' /* " " " */ + if @(xp+1,yp)\==b then if @(xp,yp-1)\==b then call @ xp,yp,'┌' /* " " " */ + xp=x; yp=y; z=substr(s,n,1) /*save old x,y; assign plot character.*/ + if z==1 then iterate /*Is Z equal to unity? Then ignore it.*/ + ox=dx; oy=dy; dx=0; dy=0 /*save DX,DY as the old versions. */ + d=-n//2; if d==0 then d=1 /*determine the sign for the chirality.*/ + if oy\==0 then dx=-sign(oy)*d /*Going north|south? Go east|west */ + if ox\==0 then dy= sign(ox)*d /* " east|west? " south|north */ end /*n*/ -call @ x,y,'∙' /*set the last point that was plotted. */ - do r=maxY to 0 by -1; _= /*show single row at a time, top first.*/ - do c=0 to maxX; _=_ || @.c.r; end /*c*/ - if _\='' then say strip(_,'T') /*if not blank, then display a line. */ +call @ x, y, '∙' /*set the last point that was plotted. */ - - if _\='' then call lineout 'FIBFRACT.OUT',strip(_,'T') /*write to file*/ - - - end /*r*/ /* [↑] only display the non-blank rows*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -@: parse arg xx,yy,p; if arg(3)=='' then return @.xx.yy; @.xx.yy=p; return -/*────────────────────────────────────────────────────────────────────────────*/ -FibWord: procedure; arg x; !.=0; !.1=1 /*obtain the order of Fibonacci word. */ - do k=3 to x; k1=k-1; k2=k-2 /*generate the Kth Fibonacci word. */ - !.k=!.k1 || !.k2 /*construct the next Fibonacci word. */ - end /*k*/ /* [↑] generate a Fibonacci word. */ -return !.x /*return the Xth Fibonacci word. */ + do r=maxY to 0 by -1; _= /*show single row at a time, top first.*/ + do c=0 to maxX; _=_ || @.c.r; end /*c*/; _=strip(_, 'T') /*build a line.*/ + if _=='' then iterate /*if the line is blank, then ignore it.*/ + say _; call lineout "FIBFRACT.OUT", _ /*display the line; also write to disk.*/ + end /*r*/ /* [↑] only display the non-blank rows*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +@: parse arg xx,yy,p; if arg(3)=='' then return @.xx.yy; @.xx.yy=p; return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +FibWord: procedure; parse arg x; !.=0; !.1=1 /*obtain the order of Fibonacci word. */ + do k=3 to x; k1=k-1; k2=k-2 /*generate the Kth " " */ + !.k=!.k1 || !.k2 /*construct the next " " */ + end /*k*/ /* [↑] generate a " " */ + return !.x /*return the Xth " " */ diff --git a/Task/Fibonacci-word/00DESCRIPTION b/Task/Fibonacci-word/00DESCRIPTION index b26ba86509..1919af165d 100644 --- a/Task/Fibonacci-word/00DESCRIPTION +++ b/Task/Fibonacci-word/00DESCRIPTION @@ -1,17 +1,24 @@ -The Fibonacci Word may be created in a manner analogous to the Fibonacci Sequence [http://hal.archives-ouvertes.fr/docs/00/36/79/72/PDF/The_Fibonacci_word_fractal.pdf as described here]: +The   Fibonacci Word   may be created in a manner analogous to the   Fibonacci Sequence   [http://hal.archives-ouvertes.fr/docs/00/36/79/72/PDF/The_Fibonacci_word_fractal.pdf as described here]: -: Define F_Word1 as 1; -: Define F_Word2 as 0; -: Form F_Word3 as F_Word2 concatenated with F_Word1 i.e "01" -: Form F_Wordn as F_Wordn-1 concatenated with F_wordn-2 + Define   F_Word1   as   '''1''' + Define   F_Word2   as   '''0''' + Form     F_Word3   as   F_Word2     concatenated with   F_Word1   i.e.:   '''01''' + Form     F_Wordn   as   F_Wordn-1   concatenated with   F_wordn-2 -For this task we shall do this for n = 37. You may display the first few but not the larger values of n, doing so will get me into trouble with them what be (again!). -Instead create a table for F_Words 1 to 37 which shows: -:The number of characters in the word -:The word's [[Entropy]]. +;Task: +Perform the above steps for     n = 37. -Related Tasks: +You may display the first few but not the larger values of   n. +
    {Doing so will get the task's author into trouble with them what be (again!).} -:::* [[Entropy]] -:::* [[Entropy/Narcissist]] +Instead, create a table for   F_Words   '''1'''   to   '''37'''   which shows: +::*   The number of characters in the word +::*   The word's [[Entropy]] + + +;Related tasks: +*   [[Fibonacci_word/fractal|Fibonacci word/fractal]] +*   [[Entropy]] +*   [[Entropy/Narcissist]] +

    diff --git a/Task/Fibonacci-word/APL/fibonacci-word.apl b/Task/Fibonacci-word/APL/fibonacci-word.apl new file mode 100644 index 0000000000..f0ff695927 --- /dev/null +++ b/Task/Fibonacci-word/APL/fibonacci-word.apl @@ -0,0 +1,3 @@ + F_WORD←{{⍵,,/⌽¯2↑⍵}⍣(0⌈⍺-2),¨⍵} + ENTROPY←{-+/R×2⍟R←(+⌿⍵∘.=∪⍵)÷⍴⍵} + FORMAT←{'N' 'LENGTH' 'ENTROPY'⍪(⍳⍵),↑{(⍴⍵),ENTROPY ⍵}¨⍵ F_WORD 1 0} diff --git a/Task/Fibonacci-word/Elixir/fibonacci-word.elixir b/Task/Fibonacci-word/Elixir/fibonacci-word.elixir index 0505afecae..ce42fab936 100644 --- a/Task/Fibonacci-word/Elixir/fibonacci-word.elixir +++ b/Task/Fibonacci-word/Elixir/fibonacci-word.elixir @@ -1,9 +1,9 @@ defmodule RC do def entropy(str) do leng = String.length(str) - String.to_char_list(str) - |> Enum.reduce(Map.new, fn c,acc -> Dict.update(acc, c, 1, &(&1+1)) end) - |> Dict.values + String.to_charlist(str) + |> Enum.reduce(Map.new, fn c,acc -> Map.update(acc, c, 1, &(&1+1)) end) + |> Map.values |> Enum.reduce(0, fn count, entropy -> freq = count / leng entropy - freq * :math.log2(freq) # log2 was added with Erlang/OTP 18 diff --git a/Task/Fibonacci-word/Lua/fibonacci-word.lua b/Task/Fibonacci-word/Lua/fibonacci-word.lua new file mode 100644 index 0000000000..b92caa1f1f --- /dev/null +++ b/Task/Fibonacci-word/Lua/fibonacci-word.lua @@ -0,0 +1,35 @@ +-- Return the base two logarithm of x +function log2 (x) return math.log(x) / math.log(2) end + +-- Return the Shannon entropy of X +function entropy (X) + local N, count, sum, i = X:len(), {}, 0 + for char = 1, N do + i = X:sub(char, char) + if count[i] then + count[i] = count[i] + 1 + else + count[i] = 1 + end + end + for n_i, count_i in pairs(count) do + sum = sum + count_i / N * log2(count_i / N) + end + return -sum +end + +-- Return a table of the first n Fibonacci words +function fibWords (n) + local fw = {1, 0} + while #fw < n do fw[#fw + 1] = fw[#fw] .. fw[#fw - 1] end + return fw +end + +-- Main procedure +print("n\tWord length\tEntropy") +for k, v in pairs(fibWords(37)) do + v = tostring(v) + io.write(k .. "\t" .. #v) + if string.len(#v) < 8 then io.write("\t") end + print("\t" .. entropy(v)) +end diff --git a/Task/Fibonacci-word/REXX/fibonacci-word.rexx b/Task/Fibonacci-word/REXX/fibonacci-word.rexx index 4fc936658a..758d32bdba 100644 --- a/Task/Fibonacci-word/REXX/fibonacci-word.rexx +++ b/Task/Fibonacci-word/REXX/fibonacci-word.rexx @@ -1,34 +1,32 @@ -/*REXX program lists number of chars in a fibonacci word, the word's entropy. */ -d=20; de=d+6; numeric digits d /*use more precision (the default is 9)*/ -parse arg N . /*get optional argument from the C.L. */ -if N=='' then N=42 /*Not specified? Then use the default.*/ -@.1=1; @.2=0 /*define some initial values of FIBword*/ -say center('N',5) center('length',12) center('entropy',de) center('Fib word',56) -say copies('─',5) copies('─' ,12) copies('─' ,de) copies('─' ,56) - /* [↓] display N fibonacci words. */ - do j=1 for N; j1=j-1; j2=j-2 /*use temporary variables for @ indices*/ - if j>2 then @.j=@.j1 || @.j2 /*calculate the FIBword if we need to.*/ - L=length(@.j) - if L<56 then Fw= @.j - else Fw= '{the word is too wide to display.}' - say right(j,4) right(L,12) ' ' entropy() ' ' Fw; drop @.j2 - end /*j*/ /*display text msg; free memory of @.j2*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -entropy: if L==1 then return left(0,d+2) /*handle special case of 1 character*/ -!.0=length(space(translate(@.j, , 1), 0)) /*this is a fast way to count zeroes*/ -!.1=L-!.0 /*also, calculate the number of ones*/ -S=0; do i=1 for 2; _=i-1 /*construct character from the ether*/ - S=S-!._/L*log2(!._/L) /*add (negatively) the entropies. */ - end /*i*/ -if S=1 then return left(1,d+2) /*return a left─justified "1" (one).*/ - return format(S,,d) /*normalize the sum (S) number. */ -/*────────────────────────────────────────────────────────────────────────────*/ -log2: procedure; parse arg x 1 xx; ig= x>1.5; is=1-2*(ig\==1); ii=0 - numeric digits digits()+5 /* [↓] precision of E must be >digits().*/ -e=2.7182818284590452353602874713526624977572470936999595749669676277240766303535 - do while ig & xx>1.5 | \ig&xx<.5; _=e; do j=-1; iz=xx* _**-is - if j>=0 then if ig & iz<1 | \ig&iz>.5 then leave; _=_*_; izz=iz; end /*j*/ - xx=izz; ii=ii+is*2**j; end /*while*/; x=x* e**-ii-1; z=0; _=-1; p=z - do k=1; _=-_*x; z=z+_/k; if z=p then leave; p=z; end /*k*/ - r=z+ii; if arg()==2 then return r; return r/log2(2,0) +/*REXX program displays the number of chars in a fibonacci word, and the word's entropy.*/ +d=20; de=d+6; numeric digits de /*use more precision (the default is 9)*/ +parse arg N . /*get optional argument from the C.L. */ +if N=='' | N=="," then N=42 /*Not specified? Then use the default.*/ +say center('N', 5) center("length", 12) center('entropy', de) center("Fib word", 56) +say copies('─', 5) copies("─" , 12) copies('─' , de) copies("─" , 56) +c=1 /* [↓] display N fibonacci words. */ + do j=1 for N; if j==2 then c=0 /*test for the case of J equals 2. */ + if j==3 then parse value 1 0 with a b /* " " " " " " " 3. */ + if j>2 then c=b || a; L=length(c) /*calculate the FIBword if we need to.*/ + if L<56 then Fw= c + else Fw= '{the word is too wide to display, length is: ' L"}" + say right(j,4) right(L,12) ' ' entropy() " " Fw + a=b; b=c /*define the new values for A and B.*/ + end /*j*/ /*display text msg; */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +entropy: if L==1 then return left(0, d+2) /*handle special case of one character.*/ + !.0=length( space( translate(c,,1), 0)) /*efficient way to count the "zeroes".*/ + !.1=L-!.0; $=0; do i=1 for 2; _=i-1 /*construct character from the ether. */ + $=$ -!._/L*log2(!._/L) /*add (negatively) the entropies. */ + end /*i*/ + if $=1 then return left(1, d+2) /*return a left─justified "1" (one). */ + return format($,,d) /*normalize the sum (S) number. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +log2: procedure; parse arg x 1 xx; ig=x>1.5; is=1-2*(ig\==1); numeric digits 5+digits() + e=2.71828182845904523536028747135266249775724709369995957496696762772407663035354759 + m=0; do while ig & xx>1.5 | \ig&xx<.5; _=e; do j=-1; iz=xx* _ ** - is + if j>=0 then if ig & iz<1 | \ig&iz>.5 then leave; _=_*_; izz=iz; end /*j*/ + xx=izz; m=m+is*2**j; end /*while*/; x=x* e** -m -1; z=0; _=-1; p=z + do k=1; _=-_*x; z=z+_/k; if z=p then leave; p=z; end /*k*/ + r=z+m; if arg()==2 then return r; return r / log2(2,.) diff --git a/Task/Fibonacci-word/ZX-Spectrum-Basic/fibonacci-word.zx b/Task/Fibonacci-word/ZX-Spectrum-Basic/fibonacci-word.zx new file mode 100644 index 0000000000..9656b4fcb1 --- /dev/null +++ b/Task/Fibonacci-word/ZX-Spectrum-Basic/fibonacci-word.zx @@ -0,0 +1,35 @@ +10 LET x$="1": LET y$="0": LET z$="" +20 PRINT "N, Length, Entropy, Word" +30 LET n=1 +40 PRINT n;" ";LEN x$;" "; +50 LET s$=x$: LET base=2: GO SUB 1000 +60 PRINT entropy +70 PRINT x$ +80 LET n=2 +90 PRINT n;" ";LEN y$;" "; +100 LET s$=y$: GO SUB 1000 +110 PRINT entropy +120 PRINT y$ +130 FOR n=1 TO 18 +140 LET x$="1": LET y$="0" +150 FOR i=1 TO n +160 LET z$=y$+x$ +170 LET p$=x$: LET x$=y$: LET y$=p$ +180 LET p$=y$: LET y$=z$: LET z$=p$ +190 NEXT i +200 LET x$="": LET z$="" +210 LET s$=y$: GO SUB 1000 +220 PRINT n+2;" ";LEN y$;" ";entropy +230 PRINT y$ AND (LEN y$<32) +240 NEXT n +250 STOP +1000 REM Calculate entropy +1010 LET sourcelen=LEN s$: LET entropy=0 +1020 DIM t(255) +1030 FOR j=1 TO sourcelen +1040 LET digit=VAL s$(j)+1: LET t(digit)=t(digit)+1 +1050 NEXT j +1060 FOR j=1 TO 255 +1070 IF t(j)>0 THEN LET prop=t(j)/sourcelen: LET entropy=entropy-(prop*LN (prop)/LN (base)) +1080 NEXT j +1090 RETURN diff --git a/Task/File-input-output/00DESCRIPTION b/Task/File-input-output/00DESCRIPTION index f00d5b2486..05b0954563 100644 --- a/Task/File-input-output/00DESCRIPTION +++ b/Task/File-input-output/00DESCRIPTION @@ -1,3 +1,12 @@ -{{selection|Short Circuit|Console Program Basics}} + {{selection|Short Circuit|Console Program Basics}} [[Category:Simple]] -In this task, the job is to create a file called "output.txt", and place in it the contents of the file "input.txt", ''via an intermediate variable.'' In other words, your program will demonstrate: (1) how to read from a file into a variable, and (2) how to write a variable's contents into a file. Oneliners that skip the intermediate variable are of secondary interest — operating systems have copy commands for that. +;Task: +Create a file called   "output.txt",   and place in it the contents of the file   "input.txt",   ''via an intermediate variable''. + +In other words, your program will demonstrate: +::#   how to read from a file into a variable +::#   how to write a variable's contents into a file + +
    +Oneliners that skip the intermediate variable are of secondary interest — operating systems have copy commands for that. +

    diff --git a/Task/File-input-output/Fortran/file-input-output.f b/Task/File-input-output/Fortran/file-input-output.f index d1df3d5326..0ddd658c7d 100644 --- a/Task/File-input-output/Fortran/file-input-output.f +++ b/Task/File-input-output/Fortran/file-input-output.f @@ -2,16 +2,16 @@ program FileIO integer, parameter :: out = 123, in = 124 integer :: err - character(len=1) :: c + character :: c open(out, file="output.txt", status="new", action="write", access="stream", iostat=err) - if ( err == 0 ) then + if (err == 0) then open(in, file="input.txt", status="old", action="read", access="stream", iostat=err) - if ( err == 0 ) then + if (err == 0) then err = 0 - do while ( err == 0 ) + do while (err == 0) read(unit=in, iostat=err) c - if ( err == 0 ) write(out) c + if (err == 0) write(out) c end do close(in) end if diff --git a/Task/File-input-output/Perl-6/file-input-output-1.pl6 b/Task/File-input-output/Perl-6/file-input-output-1.pl6 index 27b94003c5..542375efcb 100644 --- a/Task/File-input-output/Perl-6/file-input-output-1.pl6 +++ b/Task/File-input-output/Perl-6/file-input-output-1.pl6 @@ -1,5 +1 @@ -my $in = open "input.txt"; -my $out = open "output.txt", :w; -for $in.lines -> $line { - $out.say($line); -} +spurt "output.txt", slurp "input.txt"; diff --git a/Task/File-input-output/Perl-6/file-input-output-2.pl6 b/Task/File-input-output/Perl-6/file-input-output-2.pl6 index 5cab2b9fac..d62cc2b918 100644 --- a/Task/File-input-output/Perl-6/file-input-output-2.pl6 +++ b/Task/File-input-output/Perl-6/file-input-output-2.pl6 @@ -1 +1,7 @@ -(open "output.txt", :w).print(slurp "input.txt") +my $in = open "input.txt"; +my $out = open "output.txt", :w; +for $in.lines -> $line { + $out.say: $line; +} +$in.close; +$out.close; diff --git a/Task/File-modification-time/00DESCRIPTION b/Task/File-modification-time/00DESCRIPTION index 2803ead688..bb8769b73d 100644 --- a/Task/File-modification-time/00DESCRIPTION +++ b/Task/File-modification-time/00DESCRIPTION @@ -8,5 +8,7 @@ {{omit from|TI-83 BASIC}} {{omit from|TI-89 BASIC}} {{omit from|Axe}} {{omit from|ZX Spectrum Basic|Does not have a real time clock.}} -{{task|File System Operations}} -This task will attempt to get and set the modification time of a file. + +;Task: +Get and set the modification time of a file. +

    diff --git a/Task/File-modification-time/00META.yaml b/Task/File-modification-time/00META.yaml index d3da906d25..bccc01ef71 100644 --- a/Task/File-modification-time/00META.yaml +++ b/Task/File-modification-time/00META.yaml @@ -1,4 +1,4 @@ --- category: - Date and time -note: File modification time +note: File modification time|File System Operations diff --git a/Task/File-modification-time/Delphi/file-modification-time.delphi b/Task/File-modification-time/Delphi/file-modification-time.delphi index aeb29d35eb..a9c19a6904 100644 --- a/Task/File-modification-time/Delphi/file-modification-time.delphi +++ b/Task/File-modification-time/Delphi/file-modification-time.delphi @@ -1,4 +1,4 @@ -procedure GetModifiedDate(const aFilename: string): TDateTime; +function GetModifiedDate(const aFilename: string): TDateTime; var hFile: Integer; iDosTime: Integer; diff --git a/Task/File-modification-time/Perl-6/file-modification-time.pl6 b/Task/File-modification-time/Perl-6/file-modification-time.pl6 index 052f0820e5..309f461eda 100644 --- a/Task/File-modification-time/Perl-6/file-modification-time.pl6 +++ b/Task/File-modification-time/Perl-6/file-modification-time.pl6 @@ -6,7 +6,7 @@ class utimbuf is repr('CStruct') { submethod BUILD(:$atime, :$mtime) { $!actime = $atime; - $!modtime = $mtime; + $!modtime = $mtime.to-posix[0].round; } } diff --git a/Task/File-modification-time/REXX/file-modification-time.rexx b/Task/File-modification-time/REXX/file-modification-time.rexx index 3c2e86ff50..bd2c5b2549 100644 --- a/Task/File-modification-time/REXX/file-modification-time.rexx +++ b/Task/File-modification-time/REXX/file-modification-time.rexx @@ -1,8 +1,8 @@ -/*REXX program (Regina) to obtain/display a file's time of modification. */ -parse arg $ . /*get the fileID from the CL*/ -if $=='' then do; say "***error*** no filename was specified."; exit 13; end -q=stream($, 'C', "QUERY TIMESTAMP") /*get file's mod time info. */ -if q=='' then q="specified file doesn't exist." /*give an error indication. */ -say 'For file: ' $ /*display the file ID. */ -say 'timestamp of last modification: ' q /*display modification time.*/ - /*stick a fork in it, we're all done. */ +/*REXX program obtains and displays a file's time of modification. */ +parse arg $ . /*obtain required argument from the CL.*/ +if $=='' then do; say "***error*** no filename was specified."; exit 13; end +q=stream($, 'C', "QUERY TIMESTAMP") /*get file's modification time info. */ +if q=='' then q="specified file doesn't exist." /*set an error indication message. */ +say 'For file: ' $ /*display the file ID information. */ +say 'timestamp of last modification: ' q /*display the modification time info. */ + /*stick a fork in it, we're all done. */ diff --git a/Task/File-size/00DESCRIPTION b/Task/File-size/00DESCRIPTION index e4d955052f..4e6e1d1ef2 100644 --- a/Task/File-size/00DESCRIPTION +++ b/Task/File-size/00DESCRIPTION @@ -1 +1,2 @@ -In this task, the job is to verify the size of a file called "input.txt" for a file in the current working directory and another one in the file system root. +Verify the size of a file called     '''input.txt'''     for a file in the current working directory, and another one in the file system root. +

    diff --git a/Task/File-size/AWK/file-size-1.awk b/Task/File-size/AWK/file-size-1.awk index 2c1970f8e5..3c04639096 100644 --- a/Task/File-size/AWK/file-size-1.awk +++ b/Task/File-size/AWK/file-size-1.awk @@ -1,9 +1,11 @@ @load "filefuncs" +function filesize(name ,fd) { + if ( stat(name, fd) == -1) + return -1 # doesn't exist + else + return fd["size"] +} BEGIN { - printsize("input.txt") - printsize("/input.txt") -} -function printsize(name ,fd) { - stat(name, fd) - printf("%s\t%s\n", name, fd["size"]) + print filesize("input.txt") + print filesize("/input.txt") } diff --git a/Task/File-size/C++/file-size.cpp b/Task/File-size/C++/file-size-1.cpp similarity index 100% rename from Task/File-size/C++/file-size.cpp rename to Task/File-size/C++/file-size-1.cpp diff --git a/Task/File-size/C++/file-size-2.cpp b/Task/File-size/C++/file-size-2.cpp new file mode 100644 index 0000000000..77d8499138 --- /dev/null +++ b/Task/File-size/C++/file-size-2.cpp @@ -0,0 +1,8 @@ +#include +#include + +int main() +{ + std::cout << std::ifstream("input.txt", std::ios::binary | std::ios::ate).tellg() << "\n" + << std::ifstream("/input.txt", std::ios::binary | std::ios::ate).tellg() << "\n"; +} diff --git a/Task/File-size/Elena/file-size.elena b/Task/File-size/Elena/file-size.elena new file mode 100644 index 0000000000..19310a8eaf --- /dev/null +++ b/Task/File-size/Elena/file-size.elena @@ -0,0 +1,9 @@ +#import system. +#import system'io. + +#symbol program = +[ + console writeLine:("input.txt" file_path length). + + console writeLine:("\input.txt" file_path length). +]. diff --git a/Task/File-size/Fortran/file-size.f b/Task/File-size/Fortran/file-size.f new file mode 100644 index 0000000000..82a9018c7b --- /dev/null +++ b/Task/File-size/Fortran/file-size.f @@ -0,0 +1,12 @@ + 20 READ (INF,21, END = 30) L !R E A D A R E C O R D - but only its length. + 21 FORMAT(Q) !This obviously indicates the record's length. + NRECS = NRECS + 1 !CALL LONGCOUNT(NRECS,1) !C O U N T A R E C O R D. + NNBYTES = NNBYTES + L !CALL LONGCOUNT(NNBYTES,L) !Not counting any CRLF (or whatever) gibberish. + IF (L.LT.RMIN) THEN !Righto, now for the record lengths. + RMIN = L !This one is shorter. + RMINR = NRECS !Where it's at. + ELSE IF (L.GT.RMAX) THEN !Perhaps instead it is longer? + RMAX = L !Longer. + RMAXR = NRECS !Where it's at. + END IF !So much for the lengths. + GO TO 20 !All I wanted to know... diff --git a/Task/File-size/Lua/file-size.lua b/Task/File-size/Lua/file-size.lua new file mode 100644 index 0000000000..0496ba10c3 --- /dev/null +++ b/Task/File-size/Lua/file-size.lua @@ -0,0 +1,9 @@ +function GetFileSize( filename ) + local fp = io.open( filename ) + if fp == nil then + return nil + end + local filesize = fp:seek( "end" ) + fp:close() + return filesize +end diff --git a/Task/File-size/Maple/file-size-1.maple b/Task/File-size/Maple/file-size-1.maple new file mode 100644 index 0000000000..695a00ea58 --- /dev/null +++ b/Task/File-size/Maple/file-size-1.maple @@ -0,0 +1 @@ +FileTools:-Size( "input.txt" ) diff --git a/Task/File-size/Maple/file-size-2.maple b/Task/File-size/Maple/file-size-2.maple new file mode 100644 index 0000000000..4cf2ef9b67 --- /dev/null +++ b/Task/File-size/Maple/file-size-2.maple @@ -0,0 +1 @@ +FileTools:-Size( "/input.txt" ) diff --git a/Task/File-size/NetRexx/file-size.netrexx b/Task/File-size/NetRexx/file-size.netrexx index d827c09300..768f41a792 100644 --- a/Task/File-size/NetRexx/file-size.netrexx +++ b/Task/File-size/NetRexx/file-size.netrexx @@ -1,5 +1,5 @@ /* NetRexx */ -options replace format comments java crossref symbols binary +options replace format comments java symbols binary runSample(arg) return diff --git a/Task/File-size/Perl-6/file-size.pl6 b/Task/File-size/Perl-6/file-size-1.pl6 similarity index 100% rename from Task/File-size/Perl-6/file-size.pl6 rename to Task/File-size/Perl-6/file-size-1.pl6 diff --git a/Task/File-size/Perl-6/file-size-2.pl6 b/Task/File-size/Perl-6/file-size-2.pl6 new file mode 100644 index 0000000000..88de97faf4 --- /dev/null +++ b/Task/File-size/Perl-6/file-size-2.pl6 @@ -0,0 +1 @@ +say $*SPEC.rootdir.IO.child("input.txt").s; diff --git a/Task/File-size/Perl/file-size-1.pl b/Task/File-size/Perl/file-size-1.pl new file mode 100644 index 0000000000..6f68f5365a --- /dev/null +++ b/Task/File-size/Perl/file-size-1.pl @@ -0,0 +1,2 @@ +my $size1 = -s 'input.txt'; +my $size2 = -s '/input.txt'; diff --git a/Task/File-size/Perl/file-size-2.pl b/Task/File-size/Perl/file-size-2.pl new file mode 100644 index 0000000000..512a76f2c8 --- /dev/null +++ b/Task/File-size/Perl/file-size-2.pl @@ -0,0 +1,3 @@ +use File::Spec::Functions qw(catfile rootdir); +my $size1 = -s 'input.txt'; +my $size2 = -s catfile rootdir, 'input.txt'; diff --git a/Task/File-size/Perl/file-size-3.pl b/Task/File-size/Perl/file-size-3.pl new file mode 100644 index 0000000000..c6d08a3c14 --- /dev/null +++ b/Task/File-size/Perl/file-size-3.pl @@ -0,0 +1,2 @@ +my $size1 = (stat 'input.txt')[7]; # builtin stat() returns an array with file size at index 7 +my $size2 = (stat '/input.txt')[7]; diff --git a/Task/File-size/Perl/file-size.pl b/Task/File-size/Perl/file-size.pl deleted file mode 100644 index 216e107f5e..0000000000 --- a/Task/File-size/Perl/file-size.pl +++ /dev/null @@ -1,3 +0,0 @@ -use File::Spec::Functions qw(catfile rootdir); -print -s 'input.txt'; -print -s catfile rootdir, 'input.txt'; diff --git a/Task/File-size/REXX/file-size-1.rexx b/Task/File-size/REXX/file-size-1.rexx index ac89a50718..bbec7112c0 100644 --- a/Task/File-size/REXX/file-size-1.rexx +++ b/Task/File-size/REXX/file-size-1.rexx @@ -1,12 +1,11 @@ -/*REXX pgm to verify a file's size (by reading the lines) in CD & root. */ -parse arg iFID . /*let user specify the file ID. */ -if iFID=='' then iFID="FILESIZ.DAT" /*Not specified? Then use default*/ -say 'size of' iFID "=" filesize(iFID) 'bytes' /*current dir.*/ -say 'size of \..\'iFID "=" filesize('\..\'iFID) 'bytes' /* root dir.*/ -exit /*stick a fork in it, we're done.*/ - -/*──────────────────────────────────FILESIZE subroutine─────────────────*/ -filesize: parse arg f; $=0; do while lines(f)\==0 - $=$+length(charin(f,,1e6)) - end /*while*/ -return $ +/*REXX program verifies a file's size (by reading all the lines) in current dir & root.*/ +parse arg iFID . /*allow the user specify the file ID. */ +if iFID=='' | iFID=="," then iFID='FILESIZ.DAT' /*Not specified? Then use the default.*/ +say 'size of' iFID "=" fileSize(iFID) 'bytes' /*the current directory.*/ +say 'size of \..\'iFID "=" fileSize('\..\'iFID) 'bytes' /* " root " */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +fileSize: parse arg f; $=0; do while lines(f)\==0 + $=$+length(charin(f,,1e6)) + end /*while*/ + return $ diff --git a/Task/File-size/REXX/file-size-3.rexx b/Task/File-size/REXX/file-size-3.rexx index 2068d7f653..2fe3719a85 100644 --- a/Task/File-size/REXX/file-size-3.rexx +++ b/Task/File-size/REXX/file-size-3.rexx @@ -1,11 +1,10 @@ -/*REXX pgm to verify a file's size (by reading the lines) on default MD.*/ -parse arg iFID /*let user specify the file ID. */ -if iFID='' then iFID="FILESIZ DAT A" /*Not specified? Then use default*/ -say 'size of' iFID "=" filesize(iFID) 'bytes' /*on the default MD.*/ -exit /*stick a fork in it, we're done.*/ - -/*──────────────────────────────────FILESIZE subroutine─────────────────*/ -filesize: parse arg f; $=0; do while lines(f)\==0 - $=$+length(linein(f)) - end /*while*/ -return $ +/*REXX program verifies a file's size (by reading all the lines) on the default mDisk.*/ +parse arg iFID . /*allow the user specify the file ID. */ +if iFID=='' | iFID=="," then iFID='FILESIZ DAT' /*Not specified? Then use the default.*/ +say 'size of' iFID "=" filesize(iFID) 'bytes' /*on the default mDisk.*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +filesize: parse arg f; $=0; do while lines(f)\==0 + $=$+length(linein(f)) + end /*while*/ + return $ diff --git a/Task/Filter/00DESCRIPTION b/Task/Filter/00DESCRIPTION index 505835948c..9016e43eee 100644 --- a/Task/Filter/00DESCRIPTION +++ b/Task/Filter/00DESCRIPTION @@ -1,5 +1,9 @@ +;Task: Select certain elements from an Array into a new Array in a generic way. + + To demonstrate, select all even numbers from an Array. As an option, give a second solution which filters destructively, by modifying the original Array rather than creating a new Array. +

    diff --git a/Task/Filter/AppleScript/filter-3.applescript b/Task/Filter/AppleScript/filter-3.applescript new file mode 100644 index 0000000000..787a8f04f2 --- /dev/null +++ b/Task/Filter/AppleScript/filter-3.applescript @@ -0,0 +1,30 @@ +-- filter :: (a -> Bool) -> [a] -> [a] +-- filter :: (a -> Int -> Bool) -> [a] -> [a] +-- filter :: (a -> Int -> [a] -> Bool) -> [a] -> [a] +on filter(f, xs) + script mf + property lambda : f + end script + + set lst to {} + set lng to length of xs + repeat with i from 1 to lng + set v to item i of xs + if mf's lambda(v, i, xs) then + set end of lst to v + end if + end repeat + return lst +end filter + + +-- Ordinary AppleScript predicate function, rather than a script object + +-- isEven :: (a -> Bool) +on isEven(x) + x mod 2 = 0 +end isEven + +set lstRange to {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10} + +filter(isEven, lstRange) diff --git a/Task/Filter/Perl-6/filter-1.pl6 b/Task/Filter/Perl-6/filter-1.pl6 index 30f60c31be..d1d44810ca 100644 --- a/Task/Filter/Perl-6/filter-1.pl6 +++ b/Task/Filter/Perl-6/filter-1.pl6 @@ -1,2 +1,2 @@ -my @a = 1, 2, 3, 4, 5, 6; +my @a = 1..6; my @even = grep * %% 2, @a; diff --git a/Task/Filter/REXX/filter-1.rexx b/Task/Filter/REXX/filter-1.rexx index cf7644116a..b9d967cd5a 100644 --- a/Task/Filter/REXX/filter-1.rexx +++ b/Task/Filter/REXX/filter-1.rexx @@ -1,20 +1,19 @@ -/*REXX program selects all even numbers from an array ──► a new array.*/ -parse arg N seed . /*get optional parameters from CL*/ -if N=='' | N==',' then N=50 /*Not specified? Then use default*/ -if seed\=='' & seed\==',' then call random ,,seed /*for repeatability.*/ -old.= /*the OLD array, all null so far.*/ -new.= /*the NEW array, all null so far.*/ - do i=1 for N /*gen N random numbers ──► OLD*/ - old.i=random(1,99999) /*randum number 1 ──► 99999 */ +/*REXX program selects all even numbers from an array and puts them ──► a new array.*/ +parse arg N seed . /*obtain optional arguments from the CL*/ +if N=='' | N=="," then N=50 /*Not specified? Then use the default.*/ +if datatype(seed,'W') then call random ,,seed /*use the RANDOM seed for repeatability*/ +old.= /*the OLD array, all are null so far. */ +new.= /* " NEW " " " " " " */ + do i=1 for N /*generate N random numbers ──► OLD */ + old.i=random(1,99999) /*generate random number 1 ──► 99999*/ end /*i*/ -#=0 /*numb. of elements in NEW so far*/ - do j=1 for N /*process the OLD array elements.*/ - if old.j//2 \== 0 then iterate /*if element isn't even, skip it.*/ - #=#+1 /*bump the number of NEW elements*/ - new.#=old.j /*assign it to the NEW array. */ +#=0 /*number of elements in NEW (so far).*/ + do j=1 for N /*process the elements of the OLD array*/ + if old.j//2 \== 0 then iterate /*if element isn't even, then skip it.*/ + #=#+1 /*bump the number of NEW elements. */ + new.#=old.j /*assign the number to the NEW array.*/ end /*j*/ - do k=1 for # /*display all the NEW numbers. */ - say right('new.'k, 20) "=" right(new.k,9) /*show a line*/ - end /*k*/ - /*stick a fork in it, we're done.*/ + do k=1 for # /*display all the NEW numbers. */ + say right('new.'k, 20) "=" right(new.k,9) /*display a line (an array element). */ + end /*k*/ /*stick a fork in it, we're all done. */ diff --git a/Task/Filter/REXX/filter-4.rexx b/Task/Filter/REXX/filter-4.rexx index 435497c537..781085dd36 100644 --- a/Task/Filter/REXX/filter-4.rexx +++ b/Task/Filter/REXX/filter-4.rexx @@ -1,18 +1,17 @@ -/*REXX pgm find all even numbers from an array, marks a control array. */ -arse arg N seed . /*get optional parameters from CL*/ -f N=='' | N==',' then N=50 /*Not specified? Then use default*/ -f seed\=='' & seed\==',' then call random ,,seed /*for repeatability.*/ +/*REXX program finds all even numbers from an array, and marks a control array. */ +parse arg N seed . /*obtain optional arguments from the CL*/ +if N=='' | N=="," then N=50 /*Not specified? Then use the default.*/ +if datatype(seed,'W') then call random ,,seed /*use the RANDOM seed for repeatability*/ - do i=1 for N /*gen N random numbers ──► OLD*/ - @.i=random(1,99999) /*randum number 1 ──► 99999 */ - end /*i*/ -.=0 /*numb. of elements in NEW so far*/ - do j=1 for N /*process the OLD array elements.*/ - if @.j//2 \==0 then !.j=1 /*mark ! array that it's ¬even.*/ - end /*j*/ + do i=1 for N /*generate N random numbers ──► OLD */ + @.i=random(1,99999) /*generate random number 1 ──► 99999*/ + end /*i*/ +!.=0 /*number of elements in NEW (so far).*/ + do j=1 for N /*process the OLD array elements. */ + if @.j//2 \==0 then !.j=1 /*mark the ! array that it's ¬even. */ + end /*j*/ - do k=1 for N /*display all the @ even numbers.*/ - if !.k then iterate /*if it's marked ¬even, skip it.*/ - say right('array.'k, 20) "=" right(@.k,9) /*show a line*/ - end /*k*/ - /*stick a fork in it, we're done.*/ + do k=1 for N /*display all the @ even numbers. */ + if !.k then iterate /*if it's marked as not even, skip it.*/ + say right('array.'k, 20) "=" right(@.k,9) /*display a even number, filtered array*/ + end /*k*/ /*stick a fork in it, we're all done. */ diff --git a/Task/Filter/REXX/filter-5.rexx b/Task/Filter/REXX/filter-5.rexx index b40d3137b4..380c5e3f0d 100644 --- a/Task/Filter/REXX/filter-5.rexx +++ b/Task/Filter/REXX/filter-5.rexx @@ -1,18 +1,17 @@ -/*REXX pgm find all even numbers from an array, marks ¬ even numbers. */ -parse arg N seed . /*get optional parameters from CL*/ -if N=='' | N==',' then N=50 /*Not specified? Then use default*/ -if seed\=='' & seed\==',' then call random ,,seed /*for repeatability.*/ +/*REXX program finds all even numbers from an array, and marks the not even numbers.*/ +parse arg N seed . /*obtain optional arguments from the CL*/ +if N=='' | N=="," then N=50 /*Not specified? Then use the default.*/ +if datatype(seed,'W') then call random ,,seed /*use the RANDOM seed for repeatability*/ - do i=1 for N /*gen N random numbers ──► OLD*/ - @.i=random(1,99999) /*randum number 1 ──► 99999 */ + do i=1 for N /*generate N random numbers ──► OLD */ + @.i=random(1,99999) /*generate a random number 1 ──► 99999 */ end /*i*/ - do j=1 for N /*process the OLD array elements.*/ - if @.j//2 \==0 then @.j= /*mark @ array that it's ¬even.*/ + do j=1 for N /*process the OLD array elements. */ + if @.j//2 \==0 then @.j= /*mark the @ array that it's not even*/ end /*j*/ - do k=1 for N /*display all the @ even numbers.*/ - if @.k=='' then iterate /*if it's marked ¬even, skip it.*/ - say right('array.'k, 20) "=" right(@.k,9) /*show a line*/ - end /*k*/ - /*stick a fork in it, we're done.*/ + do k=1 for N /*display all the @ even numbers. */ + if @.k=='' then iterate /*if it's marked not even, then skip it*/ + say right('array.'k, 20) "=" right(@.k,9) /*display a line (an array element). */ + end /*k*/ /*stick a fork in it, we're all done. */ diff --git a/Task/Filter/ZX-Spectrum-Basic/filter.zx b/Task/Filter/ZX-Spectrum-Basic/filter.zx new file mode 100644 index 0000000000..20a555aff1 --- /dev/null +++ b/Task/Filter/ZX-Spectrum-Basic/filter.zx @@ -0,0 +1,14 @@ +10 LET items=100: LET filtered=0 +20 DIM a(items) +30 FOR i=1 TO items +40 LET a(i)=INT (RND*items) +50 NEXT i +60 FOR i=1 TO items +70 IF FN m(a(i),2)=0 THEN LET filtered=filtered+1: LET a(filtered)=a(i) +80 NEXT i +90 DIM b(filtered) +100 FOR i=1 TO filtered +110 LET b(i)=a(i): PRINT b(i);" "; +120 NEXT i +130 DIM a(1): REM To free memory (well, almost all) +140 DEF FN m(a,b)=a-INT (a/b)*b diff --git a/Task/Find-common-directory-path/00DESCRIPTION b/Task/Find-common-directory-path/00DESCRIPTION index 6dac691feb..ac9aae7efb 100644 --- a/Task/Find-common-directory-path/00DESCRIPTION +++ b/Task/Find-common-directory-path/00DESCRIPTION @@ -8,7 +8,8 @@ Test your routine using the forward slash '/' character as the directory separat Note: The resultant path should be the valid directory '/home/user1/tmp' and not the longest common string '/home/user1/tmp/cove'.
    If your language has a routine that performs this function (even if it does not have a changeable separator character), then mention it as part of the task. -'''''See Also:''''' + +;Related tasks * [[Longest common prefix]] -
    +

    diff --git a/Task/Find-common-directory-path/Perl-6/find-common-directory-path-2.pl6 b/Task/Find-common-directory-path/Perl-6/find-common-directory-path-2.pl6 index bef39f0b49..aecc14aafc 100644 --- a/Task/Find-common-directory-path/Perl-6/find-common-directory-path-2.pl6 +++ b/Task/Find-common-directory-path/Perl-6/find-common-directory-path-2.pl6 @@ -3,7 +3,7 @@ my @dirs := ; -my @comps := @dirs.map: { [ .comb(/ $sep [ . ]* /) ] }; +my @comps = @dirs.map: { [ .comb(/ $sep [ . ]* /) ] }; say "The longest common path is ", gather for 0..* -> $column { diff --git a/Task/Find-common-directory-path/Python/find-common-directory-path-3.py b/Task/Find-common-directory-path/Python/find-common-directory-path-3.py index 405c572993..dd4de492a1 100644 --- a/Task/Find-common-directory-path/Python/find-common-directory-path-3.py +++ b/Task/Find-common-directory-path/Python/find-common-directory-path-3.py @@ -1,16 +1,3 @@ ->>> from itertools import takewhile ->>> def allnamesequal(name): - return all(n==name[0] for n in name[1:]) - ->>> def commonprefix(paths, sep='/'): - bydirectorylevels = zip(*[p.split(sep) for p in paths]) - return sep.join(x[0] for x in takewhile(allnamesequal, bydirectorylevels)) - ->>> commonprefix(['/home/user1/tmp/coverage/test', - '/home/user1/tmp/covert/operator', '/home/user1/tmp/coven/members']) +>>> paths = ['/home/user1/tmp/coverage/test', '/home/user1/tmp/covert/operator', '/home/user1/tmp/coven/members'] +>>> os.path.dirname(os.path.commonprefix(paths)) '/home/user1/tmp' ->>> # And also ->>> commonprefix(['/home/user1/tmp', '/home/user1/tmp/coverage/test', - '/home/user1/tmp/covert/operator', '/home/user1/tmp/coven/members']) -'/home/user1/tmp' ->>> diff --git a/Task/Find-common-directory-path/Python/find-common-directory-path-4.py b/Task/Find-common-directory-path/Python/find-common-directory-path-4.py new file mode 100644 index 0000000000..405c572993 --- /dev/null +++ b/Task/Find-common-directory-path/Python/find-common-directory-path-4.py @@ -0,0 +1,16 @@ +>>> from itertools import takewhile +>>> def allnamesequal(name): + return all(n==name[0] for n in name[1:]) + +>>> def commonprefix(paths, sep='/'): + bydirectorylevels = zip(*[p.split(sep) for p in paths]) + return sep.join(x[0] for x in takewhile(allnamesequal, bydirectorylevels)) + +>>> commonprefix(['/home/user1/tmp/coverage/test', + '/home/user1/tmp/covert/operator', '/home/user1/tmp/coven/members']) +'/home/user1/tmp' +>>> # And also +>>> commonprefix(['/home/user1/tmp', '/home/user1/tmp/coverage/test', + '/home/user1/tmp/covert/operator', '/home/user1/tmp/coven/members']) +'/home/user1/tmp' +>>> diff --git a/Task/Find-common-directory-path/REXX/find-common-directory-path.rexx b/Task/Find-common-directory-path/REXX/find-common-directory-path.rexx index 1e426720e8..9a99a6626c 100644 --- a/Task/Find-common-directory-path/REXX/find-common-directory-path.rexx +++ b/Task/Find-common-directory-path/REXX/find-common-directory-path.rexx @@ -1,15 +1,16 @@ -/*REXX program finds common directory path for a list of files. */ -@.= /*define all file lists to null. */ -@.1 = '/home/user1/tmp/coverage/test' -@.2 = '/home/user1/tmp/covert/operator' -@.3 = '/home/user1/tmp/coven/members' -L=length(@.1) - do j=2 while @.j\=='' /*start with the second string. */ - _ = compare(@.j,@.1); if _==0 then iterate /*equal.*/ - L = min(L,_) /*find the minimum equal strings.*/ +/*REXX program finds the common directory path for a list of files. */ + @. = /*the default for all file lists (null)*/ + @.1 = '/home/user1/tmp/coverage/test' + @.2 = '/home/user1/tmp/covert/operator' + @.3 = '/home/user1/tmp/coven/members' +L=length(@.1) /*use the length of the first string. */ + do j=2 while @.j\=='' /*start search with the second string. */ + _=compare(@.j, @.1) /*use REXX compare BIF for comparison*/ + if _==0 then iterate /*Strings are equal? Then they're equal*/ + L=min(L, _) /*find the minimum length equal strings*/ end /*j*/ -common = left(@.1,lastpos('/',@.1,L)) /*find the shortest DIR string.*/ -if right(common,1)=='/' then common=left(common, max(0,length(common)-1)) -say 'common directory path: ' common /*[↑] handle trailing / delimiter*/ - /*stick a fork in it, we're done.*/ +common=left( @.1, lastpos('/', @.1,L) ) /*determine the shortest DIR string. */ +if right(common, 1)=='/' then common=left(common, max(0, length(common) - 1) ) +say 'common directory path: ' common /* [↑] handle trailing / delimiter*/ + /*stick a fork in it, we're all done. */ diff --git a/Task/Find-largest-left-truncatable-prime-in-a-given-base/00DESCRIPTION b/Task/Find-largest-left-truncatable-prime-in-a-given-base/00DESCRIPTION index 62752bd7c6..fb35054fd7 100644 --- a/Task/Find-largest-left-truncatable-prime-in-a-given-base/00DESCRIPTION +++ b/Task/Find-largest-left-truncatable-prime-in-a-given-base/00DESCRIPTION @@ -10,3 +10,4 @@ The task is to reconstruct as much, and possibly more, of the table in [https:// Related Tasks: * [[Miller-Rabin primality test]] +

    diff --git a/Task/Find-limit-of-recursion/00DESCRIPTION b/Task/Find-limit-of-recursion/00DESCRIPTION index 6b17c10eb9..cb55ed6110 100644 --- a/Task/Find-limit-of-recursion/00DESCRIPTION +++ b/Task/Find-limit-of-recursion/00DESCRIPTION @@ -1,2 +1,8 @@ -{{selection|Short Circuit|Console Program Basics}}[[Category:Basic language learning]][[Category:Programming environment operations]] [[Category:Simple]] +{{selection|Short Circuit|Console Program Basics}} +[[Category:Basic language learning]] +[[Category:Programming environment operations]] +[[Category:Simple]] + +;Task: Find the limit of recursion. +

    diff --git a/Task/Find-limit-of-recursion/BASIC/find-limit-of-recursion-1.basic b/Task/Find-limit-of-recursion/BASIC/find-limit-of-recursion-1.basic new file mode 100644 index 0000000000..ecfb30df02 --- /dev/null +++ b/Task/Find-limit-of-recursion/BASIC/find-limit-of-recursion-1.basic @@ -0,0 +1,4 @@ + 100 PRINT "RECURSION DEPTH" + 110 PRINT D" "; + 120 LET D = D + 1 + 130 GOSUB 110"RECURSION diff --git a/Task/Find-limit-of-recursion/BASIC/find-limit-of-recursion.basic b/Task/Find-limit-of-recursion/BASIC/find-limit-of-recursion-2.basic similarity index 100% rename from Task/Find-limit-of-recursion/BASIC/find-limit-of-recursion.basic rename to Task/Find-limit-of-recursion/BASIC/find-limit-of-recursion-2.basic diff --git a/Task/Find-limit-of-recursion/Perl-6/find-limit-of-recursion.pl6 b/Task/Find-limit-of-recursion/Perl-6/find-limit-of-recursion.pl6 index 8ca17b7a67..93be696de8 100644 --- a/Task/Find-limit-of-recursion/Perl-6/find-limit-of-recursion.pl6 +++ b/Task/Find-limit-of-recursion/Perl-6/find-limit-of-recursion.pl6 @@ -2,6 +2,7 @@ my $x = 0; recurse; sub recurse () { - say ++$x; + ++$x; + say $x if $x %% 1_000_000; recurse; } diff --git a/Task/Find-limit-of-recursion/PowerShell/find-limit-of-recursion.psh b/Task/Find-limit-of-recursion/PowerShell/find-limit-of-recursion.psh new file mode 100644 index 0000000000..100d62f3af --- /dev/null +++ b/Task/Find-limit-of-recursion/PowerShell/find-limit-of-recursion.psh @@ -0,0 +1,15 @@ +function TestDepth ( $N ) + { + $N + TestDepth ( $N + 1 ) + } + +try + { + TestDepth 1 | ForEach { $Depth = $_ } + } +catch + { + "Exception message: " + $_.Exception.Message + } +"Last level before error: " + $Depth diff --git a/Task/Find-limit-of-recursion/Python/find-limit-of-recursion-1.py b/Task/Find-limit-of-recursion/Python/find-limit-of-recursion-1.py index 280069ea65..09c24685d9 100644 --- a/Task/Find-limit-of-recursion/Python/find-limit-of-recursion-1.py +++ b/Task/Find-limit-of-recursion/Python/find-limit-of-recursion-1.py @@ -1,2 +1,2 @@ import sys -print sys.getrecursionlimit() +print(sys.getrecursionlimit()) diff --git a/Task/Find-limit-of-recursion/Python/find-limit-of-recursion-3.py b/Task/Find-limit-of-recursion/Python/find-limit-of-recursion-3.py new file mode 100644 index 0000000000..8f780fba38 --- /dev/null +++ b/Task/Find-limit-of-recursion/Python/find-limit-of-recursion-3.py @@ -0,0 +1,4 @@ +def recurse(counter): + print(counter) + counter += 1 + recurse(counter) diff --git a/Task/Find-limit-of-recursion/Python/find-limit-of-recursion-4.py b/Task/Find-limit-of-recursion/Python/find-limit-of-recursion-4.py new file mode 100644 index 0000000000..6d38cf4963 --- /dev/null +++ b/Task/Find-limit-of-recursion/Python/find-limit-of-recursion-4.py @@ -0,0 +1,3 @@ +File "", line 2, in recurse +RecursionError: maximum recursion depth exceeded while calling a Python object +996 diff --git a/Task/Find-limit-of-recursion/REXX/find-limit-of-recursion-1.rexx b/Task/Find-limit-of-recursion/REXX/find-limit-of-recursion-1.rexx index 2039f8650b..5ab3a5bdce 100644 --- a/Task/Find-limit-of-recursion/REXX/find-limit-of-recursion-1.rexx +++ b/Task/Find-limit-of-recursion/REXX/find-limit-of-recursion-1.rexx @@ -1,10 +1,11 @@ -/*REXX pgm finds the recursion limit: a subroutine that calls itself. */ -parse version x; say x; say -n=0 -call SELF 1 -exit /*this statement will never be executed.*/ -/*───────────────────────────SELF procedure─────────────────────────────*/ -self: procedure expose n -n=n+1 -say n -call self +/*REXX program finds the recursion limit: a subroutine that repeatably calls itself. */ +parse version x; say x; say /*display which REXX is being used. */ +#=0 /*initialize the numbers of invokes to 0*/ +call self /*invoke the SELF subroutine. */ + /* [↓] this will never be executed. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +self: procedure expose # /*declaring that SELF is a subroutine.*/ + #=#+1 /*bump number of times SELF is invoked. */ + say # /*display the number of invocations. */ + call self /*invoke ourselves recursively. */ diff --git a/Task/Find-limit-of-recursion/REXX/find-limit-of-recursion-2.rexx b/Task/Find-limit-of-recursion/REXX/find-limit-of-recursion-2.rexx index b96ecea964..5fc7f8c326 100644 --- a/Task/Find-limit-of-recursion/REXX/find-limit-of-recursion-2.rexx +++ b/Task/Find-limit-of-recursion/REXX/find-limit-of-recursion-2.rexx @@ -1,10 +1,10 @@ -/*REXX pgm finds the recursion limit: a subroutine that calls itself. */ -parse version x; say x; say -n=0 -call SELF 2 -exit /*this statement will never be executed.*/ - -/*───────────────────────────SELF subroutine────────────────────────────*/ -self: n=n+1 -say n -call self +/*REXX program finds the recursion limit: a subroutine that repeatably calls itself. */ +parse version x; say x; say /*display which REXX is being used. */ +#=0 /*initialize the numbers of invokes to 0*/ +call self /*invoke the SELF subroutine. */ + /* [↓] this will never be executed. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +self: #=#+1 /*bump number of times SELF is invoked. */ + say # /*display the number of invocations. */ + call self /*invoke ourselves recursively. */ diff --git a/Task/Find-limit-of-recursion/Smalltalk/find-limit-of-recursion-4.st b/Task/Find-limit-of-recursion/Smalltalk/find-limit-of-recursion-4.st new file mode 100644 index 0000000000..c370c74c49 --- /dev/null +++ b/Task/Find-limit-of-recursion/Smalltalk/find-limit-of-recursion-4.st @@ -0,0 +1,5 @@ +counter := 0. +down := [ counter := counter + 1. down value ]. +down on: RecursionError do:[ + 'depth is ' print. counter printNL +]. diff --git a/Task/Find-the-last-Sunday-of-each-month/00DESCRIPTION b/Task/Find-the-last-Sunday-of-each-month/00DESCRIPTION index 056b8f08fa..5f53147cd3 100644 --- a/Task/Find-the-last-Sunday-of-each-month/00DESCRIPTION +++ b/Task/Find-the-last-Sunday-of-each-month/00DESCRIPTION @@ -1,7 +1,4 @@ -Write a program or a script that returns the last Sundays of each month -of a given year. -The year may be given through any simple input method in your language -(command line, std in, etc.). +Write a program or a script that returns the last Sundays of each month of a given year. The year may be given through any simple input method in your language (command line, std in, etc). Example of an expected output: @@ -18,8 +15,9 @@ Example of an expected output: 2013-10-27 2013-11-24 2013-12-29 - -;Cf.: +
    +;Related tasks * [[Day of the week]] * [[Five weekends]] * [[Last Friday of each month]] +

    diff --git a/Task/Find-the-last-Sunday-of-each-month/AWK/find-the-last-sunday-of-each-month.awk b/Task/Find-the-last-Sunday-of-each-month/AWK/find-the-last-sunday-of-each-month.awk new file mode 100644 index 0000000000..da5fe5d13e --- /dev/null +++ b/Task/Find-the-last-Sunday-of-each-month/AWK/find-the-last-sunday-of-each-month.awk @@ -0,0 +1,17 @@ +# syntax: GAWK -f FIND_THE_LAST_SUNDAY_OF_EACH_MONTH.AWK [year] +BEGIN { + split("31,28,31,30,31,30,31,31,30,31,30,31",daynum_array,",") # days per month in non leap year + year = (ARGV[1] == "") ? strftime("%Y") : ARGV[1] + if (year % 400 == 0 || (year % 4 == 0 && year % 100 != 0)) { + daynum_array[2] = 29 + } + for (m=1; m<=12; m++) { + for (d=daynum_array[m]; d>=1; d--) { + if (strftime("%a",mktime(sprintf("%d %d %d 0 0 0",year,m,d))) == "Sun") { + printf("%04d-%02d-%02d\n",year,m,d) + break + } + } + } + exit(0) +} diff --git a/Task/Find-the-last-Sunday-of-each-month/AppleScript/find-the-last-sunday-of-each-month.applescript b/Task/Find-the-last-Sunday-of-each-month/AppleScript/find-the-last-sunday-of-each-month.applescript new file mode 100644 index 0000000000..1f27012f72 --- /dev/null +++ b/Task/Find-the-last-Sunday-of-each-month/AppleScript/find-the-last-sunday-of-each-month.applescript @@ -0,0 +1,190 @@ +-- lastSundaysOfYear :: Int -> [Date] +on lastSundaysOfYear(y) + + -- lastWeekDaysOfYear :: Int -> Int -> [Date] + script lastWeekDaysOfYear + on lambda(intYear, iWeekday) + + -- lastWeekDay :: Int -> Int -> Date + script lastWeekDay + on lambda(iLastDay, iMonth) + set iYear to intYear + + calendarDate(iYear, iMonth, iLastDay - ¬ + (((weekday of calendarDate(iYear, iMonth, iLastDay)) as integer) + ¬ + (7 - (iWeekday))) mod 7) + end lambda + end script + + map(lastWeekDay, lastDaysOfMonths(intYear)) + end lambda + + -- isLeapYear :: Int -> Bool + on isLeapYear(y) + (0 = y mod 4) and (0 ≠ y mod 100) or (0 = y mod 400) + end isLeapYear + + -- lastDaysOfMonths :: Int -> [Int] + on lastDaysOfMonths(y) + {31, cond(isLeapYear(y), 29, 28), 31, 30, 31, 30, 31, 31, 30, 31, 30, 31} + end lastDaysOfMonths + end script + + lastWeekDaysOfYear's lambda(y, Sunday as integer) +end lastSundaysOfYear + + +-- TEST +on run argv + + intercalate(linefeed, ¬ + map(isoRow, ¬ + transpose(map(lastSundaysOfYear, ¬ + apply(cond(class of argv is list and argv ≠ {}, ¬ + singleYearOrRange, fiveCurrentYears), argIntegers(argv)))))) + +end run + +-- ARGUMENT HANDLING + +-- Up to two optional command line arguments: [yearFrom], [yearTo] +-- (Default range in absence of arguments: from two years ago, to two years ahead) + +-- ~ $ osascript ~/Desktop/lastSundays.scpt +-- ~ $ osascript ~/Desktop/lastSundays.scpt 2013 +-- ~ $ osascript ~/Desktop/lastSundays.scpt 2013 2016 + +-- singleYearOrRange :: [Int] -> [Int] +on singleYearOrRange(argv) + apply(cond(length of argv > 0, my range, my fiveCurrentYears), argv) +end singleYearOrRange + +-- fiveCurrentYears :: () -> [Int] +on fiveCurrentYears(_) + set intThisYear to year of (current date) + range(intThisYear - 2, intThisYear + 2) +end fiveCurrentYears + +-- argIntegers :: maybe [String] -> [Int] +on argIntegers(argv) + if class of argv is list and argv ≠ {} then + {map(my parseInt, argv)} + else + {} + end if +end argIntegers + + +-- GENERIC FUNCTIONS ------------------------------------------------------------------------- + +-- Dates and date strings + +-- calendarDate :: Int -> Int -> Int -> Date +on calendarDate(intYear, intMonth, intDay) + tell (current date) + set {its year, its month, its day, its time} to ¬ + {intYear, intMonth, intDay, 0} + return it + end tell +end calendarDate + +-- isoDateString :: Date -> String +on isoDateString(dte) + (((year of dte) as string) & ¬ + "-" & text items -2 thru -1 of ¬ + ("0" & ((month of dte) as integer) as string)) & ¬ + "-" & text items -2 thru -1 of ¬ + ("0" & day of dte) +end isoDateString + +-- parseInt :: String -> Int +on parseInt(s) + s as integer +end parseInt + +-- Testing and tabulation + +-- transpose :: [[a]] -> [[a]] +on transpose(xss) + script column + on lambda(_, iCol) + script row + on lambda(xs) + item iCol of xs + end lambda + end script + + map(row, xss) + end lambda + end script + + map(column, item 1 of xss) +end transpose + +-- intercalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to ¬ + {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate + +-- isoRow :: [Date] -> String +on isoRow(lstDate) + intercalate(tab, map(my isoDateString, lstDate)) +end isoRow + +-- range :: Int -> Int -> [Int] +on range(m, n) + if n < m then + set d to -1 + else + set d to 1 + end if + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range + +-- Higher-order functions + +-- 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 + +-- 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 + +-- cond :: Bool -> (a -> b) -> (a -> b) -> (a -> b) +on cond(bool, f, g) + if bool then + f + else + g + end if +end cond + +-- apply (a -> b) -> a -> b +on apply(f, a) + mReturn(f)'s lambda(a) +end apply diff --git a/Task/Find-the-last-Sunday-of-each-month/Batch-File/find-the-last-sunday-of-each-month.bat b/Task/Find-the-last-Sunday-of-each-month/Batch-File/find-the-last-sunday-of-each-month.bat new file mode 100644 index 0000000000..7fb3b34bbb --- /dev/null +++ b/Task/Find-the-last-Sunday-of-each-month/Batch-File/find-the-last-sunday-of-each-month.bat @@ -0,0 +1,35 @@ +@echo off +setlocal enabledelayedexpansion +set /p yr= Enter year: +echo. +call:monthdays %yr% list +set mm=1 +for %%i in (!list!) do ( + call:calcdow !yr! !mm! %%i dow + set/a lsu=%%i-dow + set mf=0!mm! + echo !yr!-!mf:~-2!-!lsu! + set /a mm+=1 +) +pause +exit /b + +:monthdays yr &list +setlocal +call:isleap %1 ly +for /L %%i in (1,1,12) do ( + set /a "nn = 30 + ^!(((%%i & 9) + 6) %% 7) + ^!(%%i ^^ 2) * (ly - 2) + set list=!list! !nn! +) +endlocal & set %2=%list% +exit /b + +:calcdow yr mt dy &dow :: 0=sunday +setlocal +set/a a=(14-%2)/12,yr=%1-a,m=%2+12*a-2,"dow=(%3+yr+yr/4-yr/100+yr/400+31*m/12)%%7" +endlocal & set %~4=%dow% +exit /b + +:isleap yr &leap :: remove ^ if not delayed expansion +set /a "%2=^!(%1%%4)+(^!^!(%1%%100)-^!^!(%1%%400))" +exit /b diff --git a/Task/Find-the-last-Sunday-of-each-month/C/find-the-last-sunday-of-each-month.c b/Task/Find-the-last-Sunday-of-each-month/C/find-the-last-sunday-of-each-month.c index 739d0df4f5..89d577aa69 100644 --- a/Task/Find-the-last-Sunday-of-each-month/C/find-the-last-sunday-of-each-month.c +++ b/Task/Find-the-last-Sunday-of-each-month/C/find-the-last-sunday-of-each-month.c @@ -1,57 +1,20 @@ #include #include -#include -#define NUM_MONTHS 12 - -void LastSundays(int year) +int main(int argc, char *argv[]) { - time_t t; - struct tm* datetime; + int days[] = {31,29,31,30,31,30,31,31,30,31,30,31}; + int m, y, w; - int sunday=0; - int dayOfWeek=0; - int month=0; - int monthDay=0; - int isLeapYear=0; - int daysInMonth[NUM_MONTHS]={ - 31,28,31,30,31,30,31,31,30,31,30,31 - }; - - isLeapYear=(year%4==0 || ((year%100==0) && (year%400==0))); - - if(isLeapYear) - { - daysInMonth[1]=29; - } - - time(&t); - datetime = localtime(&t); - datetime->tm_year=year-1900; - for(month=0; month<12;month++) - { - datetime->tm_mon=month; - monthDay=daysInMonth[month]; - datetime->tm_mday=monthDay; - - t = mktime(datetime); - dayOfWeek=datetime->tm_wday; - - while(dayOfWeek!=sunday) - { - monthDay--; - datetime->tm_mday=monthDay; - t = mktime(datetime); - dayOfWeek=datetime->tm_wday; + if (argc < 2 || (y = atoi(argv[1])) <= 1752) return 1; + days[1] -= (y % 4) || (!(y % 100) && (y % 400)); + w = y * 365 + 97 * (y - 1) / 400 + 4; + for(m = 0; m < 12; m++) { + w = (w + days[m]) % 7; + printf("%d-%02d-%d\n", y, m + 1, + days[m] + (w < 5 ? -2 : 5) - w); } - printf("%d-%02d-%02d\n",year,month+1,monthDay); - } -} - -int main() -{ - LastSundays(2013); - return 0; + return 0; } diff --git a/Task/Find-the-last-Sunday-of-each-month/COBOL/find-the-last-sunday-of-each-month.cobol b/Task/Find-the-last-Sunday-of-each-month/COBOL/find-the-last-sunday-of-each-month.cobol new file mode 100644 index 0000000000..11207b5f57 --- /dev/null +++ b/Task/Find-the-last-Sunday-of-each-month/COBOL/find-the-last-sunday-of-each-month.cobol @@ -0,0 +1,48 @@ + program-id. last-sun. + data division. + working-storage section. + 1 wk-date. + 2 yr pic 9999. + 2 mo pic 99 value 1. + 2 da pic 99 value 1. + 1 rd-date redefines wk-date pic 9(8). + 1 binary. + 2 int-date pic 9(8). + 2 dow pic 9(4). + 2 sunday pic 9(4) value 7. + procedure division. + display "Enter a calendar year (1601 thru 9999): " + with no advancing + accept yr + if yr >= 1601 and <= 9999 + continue + else + display "Invalid year" + stop run + end-if + perform 12 times + move 1 to da + add 1 to mo + if mo > 12 *> to avoid y10k in 9999 + move 12 to mo + move 31 to da + end-if + compute int-date = function + integer-of-date (rd-date) + if mo =12 and da = 31 *> to avoid y10k in 9999 + continue + else + subtract 1 from int-date + end-if + compute rd-date = function + date-of-integer (int-date) + compute dow = function mod + ((int-date - 1) 7) + 1 + compute dow = function mod ((dow - sunday) 7) + subtract dow from da + display yr "-" mo "-" da + add 1 to mo + end-perform + stop run + . + end program last-sun. diff --git a/Task/Find-the-last-Sunday-of-each-month/Fortran/find-the-last-sunday-of-each-month-1.f b/Task/Find-the-last-Sunday-of-each-month/Fortran/find-the-last-sunday-of-each-month-1.f new file mode 100644 index 0000000000..6f38545665 --- /dev/null +++ b/Task/Find-the-last-Sunday-of-each-month/Fortran/find-the-last-sunday-of-each-month-1.f @@ -0,0 +1,2 @@ + D = DAYNUM(Y,M,D) !Daynumber from date. + DAYNUM(Y,M,D) = D !Date parts from a day number. diff --git a/Task/Find-the-last-Sunday-of-each-month/Fortran/find-the-last-sunday-of-each-month-2.f b/Task/Find-the-last-Sunday-of-each-month/Fortran/find-the-last-sunday-of-each-month-2.f new file mode 100644 index 0000000000..29a7951e7e --- /dev/null +++ b/Task/Find-the-last-Sunday-of-each-month/Fortran/find-the-last-sunday-of-each-month-2.f @@ -0,0 +1,256 @@ + MODULE DATEGNASH +C Calculate conforming to complex calendarical contortions. +C Astronomer Simon Newcomb determined that the tropical year of 1900 +c contained 31556925.9747 seconds, or 365.24219879 days. +c Subsequent definitions involve "no measurable differences", +c whereas in 45BC (when the Julian calendar was adopted), the year was +c 365.24232 days long, going by modern calculations. +c The "tropical" year is the time between the same equinoxes, and thus +c contains the effect of the precession of the Earth's axis, which would +c otherwise cause the seasons to likewise precess around the "fixed star" +c year, that being the time for midnight to point in the same direction +c amongst the "fixed" stars. Specifically, the vernal equinox +c (the northern hemisphere's spring equinox: cultural colonialism) +c is meant to hover around the 21'st of March, although it may fall +c within the 19'th or 20'th, which last has been the most popular in +c the 20'th century, until the leap year of 2000 resynchronised +c the civil calendar. +C By contrast, the computations of astrologers are still based on the +c constellations as oriented in Babylonian times... + +c So, to add .24219879 to 365 days... +c Adjustment per year Nett Discrepancy remaining. +c +1/4 +.25 +.25 -.00780121 5h 48m 45.98s +c -1/100 -.01 .24 +.00219879 -11m 14.02s +c +1/400 +.0025 .2425 -.00030121 -26.02s +c -1/4000 -.00025 .24225 -.00005121 -4.42s +c +c The remnant of -.00005121 (meaning that the calendar year is too long) +c amounts to needing to drop one day on 19,527 years, and while this could be +c accommodated nicely enough by -1/20000 to give a calendar year of +c 365.24420 days with a remaining discrepancy of -.00000121 or -.01sec/year, +c there is a problem. The Earth's spin is slowing by a similar amount. +c Similar to leap years and leap days are the leap seconds that since the +c development of clocks based on atomic oscillations, have been added or +c sometimes removed to keep clock time aligned with astronomical observations. +c This additional confusion is not further considered. + + TYPE DateBag !Pack three parts into one. + INTEGER DAY,MONTH,YEAR !The usual suspects. + END TYPE DateBag !Simple enough. + + CHARACTER*9 MONTHNAME(12),DAYNAME(0:6) !Re-interpretations. + PARAMETER (MONTHNAME = (/"January","February","March","April", + 1 "May","June","July","August","September","October","November", + 2 "December"/)) + PARAMETER (DAYNAME = (/"Sunday","Monday","Tuesday","Wednesday", + 1 "Thursday","Friday","Saturday"/)) !Index this array with DayNum mod 7. + CHARACTER*3 MTHNAME(12) !The standard abbreviations. + PARAMETER (MTHNAME = (/"JAN","FEB","MAR","APR","MAY","JUN", + 1 "JUL","AUG","SEP","OCT","NOV","DEC"/)) + + INTEGER*4 JDAYSHIFT !INTEGER*2 just isn't enough. + PARAMETER (JDAYSHIFT = 2415020) !Thus shall 31/12/1899 give 0, a Sunday, via DAYNUM. + DOUBLE PRECISION DAYSINYEAR !A real ache. + PARAMETER (DAYSINYEAR = 365.24219879D0) !The "D0" demands DOUBLE PRECISION precision. + INTEGER*4 SECONDSINDAY !This has its uses. + PARAMETER (SECONDSINDAY = 24*60*60) !86400. Disregarding "leap" seconds. + INTEGER NOTADAYNUMBER !Might as well settle on one value. + PARAMETER (NOTADAYNUMBER = -2147483648) !And everyone use it. + + PARAMETER NZBASEPLACE = "Mt. Cook Trig, Wellington." !Name the place. + DOUBLE PRECISION NZBASELAT,NZBASELONG !Alas, DATA statements do not allow arithmetic expressions. + PARAMETER (NZBASELAT = -((59.3 D0/60 + 17)/60 + 41)) !Degrees South, thus negative. + PARAMETER (NZBASELONG = ((34.65D0/60 + 46)/60 + 174)) !Degrees East are oriented as positive: left to right with N up. +C Seconds Minutes Degrees. +C This is the location of the Mt. Cook trigonometrical base point for New Zealand. +C (It's in the foyer of what used to be the Dominion Museum, Wellington) +C Determined by Henry Jackson, chief surveyor, in 1870. + + TYPE Terroir !Collate the attributes of location, as so far needed. + CHARACTER*28 PLACENAME !Name the location. + DOUBLE PRECISION LATITUDE,LONGITUDE !Locate the location. + DOUBLE PRECISION ZONETIME !The time zone of its civil clock, not necessarily a whole hour. + END TYPE Terroir !The nature of the climate, soil, etc. is not yet involved. + TYPE(Terroir) BASE !Righto, let's have one of them. + DATA BASE/Terroir("Mt. Cook Trig, Wellington.", !The compiler bungles if NZBASEPLACE is used here. + 1 NZBASELAT,NZBASELONG,+12.0)/ !Where it's at. +12 hours ahead = +180 degrees Eastward of Greenwhich. +Careful! New Zealand is not centred on longitude 180, but its civil clock's time zone is. + DOUBLE PRECISION SINBASELAT,COSBASELAT !Calculated in SOLARDIRECTION and ZAPME. + + CONTAINS !Let the madness begin. + + INTEGER*4 FUNCTION DAYNUM(YY,M,D) !Computes (JDayN - JDayShift), not JDayN. +C Conversion from a Gregorian calendar date to a Julian day number, JDayN. +C Valid for any Gregorian calendar date producing a Julian day number +C greater than zero, though remember that the Gregorian calendar +C was not used before y1582m10d15 and often, not after that either. +C thus in England (et al) when Wednesday 2'nd September 1752 (Julian style) +C was followed by Thursday the 14'th, occasioning the Eleven Day riots +C because creditors demanded a full month's payment instead of 19/30'ths. +C The zero of the Julian day number corresponds to the first of January +C 4713BC on the *Julian* calendar's naming scheme, as extended backwards +C with current usage into epochs when it did not exist: the proleptic Julian calendar. +c This function employs the naming scheme of the *Gregorian* calendar, +c and if extended backwards into epochs when it did not exist (thus the +c proleptic Gregorian calendar) it would compute a zero for y-4713m11d24 *if* +c it is supposed there was a year zero between 1BC and 1AD (as is convenient +c for modern mathematics and astronomers and their simple calculations), *but* +c 1BC immediately precedes 1AD without any year zero in between (and is a leap year) +c thus the adjustment below so that the date is y-4714m11d24 or 4714BCm11d24, +c not that this name was in use at the time... +c Although the Julian calendar (introduced by himself in what we would call 45BC, +c which was what the Romans occasionally called 709AUC) was provoked by the +c "years of confusion" resulting from arbitrary application of the rules +c for the existing Roman calendar, other confusions remain unresolved, +c so precise dating remains uncertain despite apparently precise specifications +c (and much later, Dennis the Short chose wrongly for the birth of Christ) +c and the Roman practice of inclusive reckoning meant that every four years +c was interpreted as every third (by our exclusive reckoning) so that the +c leap years were not as we now interpret them. This was resolved by Augustus +c but exactly when (and what date name is assigned) and whose writings used +c which system at the time of writing is a matter of more confusion, +c and this has continued for centuries. +C Accordingly, although an algorithm may give a regular sequence of date names, +c that does not mean that those date names were used at the time even if the +c calendar existed then, because the interpretation of the algorithm varied. +c This in turn means that a date given as being on the Julian calendar +c prior to about 10AD is not as definite as it may appear and its alignment +c with the astronomical day number is uncertain even though the calculation +c is quite definite. +c +C Computationally, year 1 is preceded by year 0, in a smooth progression. +C But there was never a year zero despite what astronomers like to say, +C so the formula's year 0 corresponds to 1BC, year -1 to 2BC, and so on back. +C Thus y-4713 in this counting would be 4714BC on the Gregorian calendar, +C were it to have existed then which it didn't. +C To conform to the civil usage, the incoming YY, presumed a proper BC (negative) +C and AD (positive) year is converted into the computational counting sequence, Y, +C and used in the formula. If a YY = 0 is (improperly) offered, it will manifest +C as 1AD. Thus YY = -4714 will lead to calculations with Y = -4713. +C Thus, 1BC is a leap year on the proleptic Gregorian calendar. +C For their convenience, astronomers decreed that a day starts at noon, so that +C in Europe, observations through the night all have the same day number. +C The current Western civil calendar however has the day starting just after midnight +C and that day's number lasts until the following midnight. +C +C There is no constraint on the values of D, which is just added as it stands. +C This means that if D = 0, the daynumber will be that of the last day of the +C previous month. Likewise, M = 0 or M = 13 will wrap around so that Y,M + 1,0 +C will give the last day of month M (whatever its length) as one day before +C the first day of the next month. +C +C Example: Y = 1970, M = 1, D = 1; JDAYN = 2440588, a Thursday but MOD(2440588,7) = 3. +C and with the adjustment JDAYSHIFT, DAYNUM = 25568; mod 7 = 4 and DAYNAME(4) = "Thursday". +C The Julian Day number 2440588.0 is for NOON that Thursday, 2440588.5 is twelve hours later. +C And Julian Day number 2440587.625 is for three a.m. Thursday. +C +C DAYNUM and MUNYAD are the infamous routines of H. F. Fliegel and T.C. van Flandern, +C presented in Communications of the ACM, Vol. 11, No. 10 (October, 1968). +Carefully typed in again by R.N.McLean (whom God preserve) December XXMMIIX. +C Though I remain puzzled as to why they used I,J,K for Y,M,D, +C given that the variables were named in the INTEGER statement anyway. + INTEGER*4 JDAYN !Without rebasing, this won't fit in INTEGER*2. + INTEGER YY,Y,M,MM,D !NB! Full year number, so 1970, not 70. +Caution: integer division in Fortran does not produce fractional results. +C The fractional part is discarded so that 4/3 gives 1 and -4/3 gives -1. +C Thus 4/3 might be Trunc(4/3) or 4 div 3 in other languages. Beware of negative numbers! + Y = YY !I can fiddle this copy without damaging the original's value. + IF (Y.LT.1) Y = Y + 1 !Thus YY = -2=2BC, -1=1BC, +1=1AD, ... becomes Y = -1, 0, 1, ... + MM = (M - 14)/12 !Calculate once. Note that this is integer division, truncating. + JDAYN = D - 32075 !This is the proper astronomer's Julian Day Number. + a + 1461*(Y + 4800 + MM)/4 + b + 367*(M - 2 - MM*12)/12 + c - 3*((Y + 4900 + MM)/100)/4 + DAYNUM = JDAYN - JDAYSHIFT !Thus, *NOT* the actual *Julian* Day Number. + END FUNCTION DAYNUM !But one such that Mod(n,7) gives day names. + +Could compute the day of the year somewhat as follows... +c DN:=D + (61*Month + (Month div 8)) div 2 - 30 +c + if Month > 2 then FebLength - 30 else 0; + + TYPE(DATEBAG) FUNCTION MUNYAD(DAYNUM) !Oh for palindromic programming! +Conversion from a Julian day number to a Gregorian calendar date. See JDAYN/DAYNUM. + INTEGER*4 DAYNUM,JDAYN !Without rebasing, this won't fit in INTEGER*2. + INTEGER Y,M,D,L,N !Y will be a full year number: 1950 not 50. + JDAYN = DAYNUM + JDAYSHIFT !Revert to a proper Julian day number. + L = JDAYN + 68569 !Further machinations of H. F. Fliegel and T.C. van Flandern. + N = 4*L/146097 + L = L - (146097*N + 3)/4 + Y = 4000*(L + 1)/1461001 + L = L - 1461*Y/4 + 31 + M = 80*L/2447 + D = L - 2447*M/80 + L = M/11 + M = M + 2 - 12*L + Y = 100*(N - 49) + Y + L + IF (Y.LT.1) Y = Y - 1 !The other side of conformity to BC/AD, as in DAYNUM. + MUNYAD%YEAR = Y !Now place for the world to see. + MUNYAD%MONTH = M + MUNYAD%DAY = D + END FUNCTION MUNYAD !A year has 365.2421988 days... + + CHARACTER*10 FUNCTION SLASHDATE(DAYNUM) !This is relatively innocent. +Caution! The Gregorian calendar did not exist prior to 15/10/1582! +Confine expected operation to four-digit years, since fixed-field sizes are in mind. +Can use this function in WRITE statements with FORMAT, since this function does not use them. +Compilers of lesser merit can concoct code that bungles such double usage otherwise. + INTEGER*4 DAYNUM !-32768 to 32767 is just not adequate. + TYPE(DATEBAG) D !Though these numbers are more restrained. + INTEGER N,L !Workers. + IF (DAYNUM.EQ.NOTADAYNUMBER) THEN !Perhaps some work can be dodged. + SLASHDATE = " Undated!!" !No proper day number has been placed. + RETURN !So give up, rather than show odd results. + END IF !So much for confusion. + D = MUNYAD(DAYNUM) !Get the pieces. + IF (D%DAY.GT.9) THEN !Here we go. + SLASHDATE(1:1) = CHAR(D%DAY/10 + ICHAR("0")) !Faster than a table look-up? + ELSE !Even if not, + SLASHDATE(1:1) = " " !This should be quick. + END IF !So much for the tens digit. + SLASHDATE(2:2) = CHAR(MOD(D%DAY,10) + ICHAR("0")) !The units digit. + SLASHDATE(3:3) = "/" !Enough of the day number. The separator. + IF (D%MONTH.GT.9) THEN !Now for the month. + SLASHDATE(4:4) = CHAR(D%MONTH/10 + ICHAR("0")) !The tens digit. + ELSE !Not so often used. A table beckons... + SLASHDATE(4:4) = " " !Some might desire leading zeroes here. + END IF !Enough of October, November and December. + SLASHDATE(5:5) = CHAR(MOD(D%MONTH,10) + ICHAR("0")) !The units digit. + SLASHDATE(6:6) = "/" !Enough of the month number. The separator. + L = 10 !The year value deserves a loop, it having four digits. + N = ABS(D%YEAR) !Should never be zero. 1BC is year -1 and 1AD is year = +1. + 1 SLASHDATE(L:L) = CHAR(MOD(N,10) + ICHAR("0")) !But if it is, this will place a zero. + N = N/10 !Drop a power of ten. + L = L - 1 !Step back for the next digit. + IF (L.GT.6) GO TO 1 !Thus always four digits, even if they lead with zero. + IF (N.GT.0) SLASHDATE(7:7) = "?" !Y > 9999? Might as well do something. + IF (D%YEAR.LT.0) SLASHDATE(7:7) = "-" !Years BC? Rather than give no indication. +c WRITE (SLASHDATE,1) D%DAY,D%MONTH,D%YEAR !Some compilers will bungle this. +c 1 FORMAT (I2,"/",I2,"/",I4) !If so, a local variable must be used. + RETURN !Enough. !As when SLASHDATE is invoked in a WRITE statement. + END FUNCTION SLASHDATE !Simple enough. + END MODULE DATEGNASH + + PROGRAM LASTSUNDAY + USE DATEGNASH + INTEGER D,W,M,Y + WRITE (6,1) + 1 FORMAT ("Employs the Gregorian calendar pattern.",/, + 1 "You specify a day of the week, then nominate a year.",/, + 2 "For each month of that year, this calculates the date ", + 3 "of the last such day.",// + 4 "So, what day (0 = Sunday, 6 = Saturday):",$) + READ (5,*) W + IF (W.LT.0 .OR. W.GT.6) STOP "Not a good week day number!" + + 10 WRITE (6,11) + 11 FORMAT ("What year (non-positive to quit):",$) + READ (5,*) Y + IF (Y.LE.0) STOP + DO M = 1,12 + D = DAYNUM(Y,M + 1,0) !Zeroth day = last day of previous month. + D = D - MOD(MOD(D - W,7) + 7,7) !Protect against MOD(D,7) giving negative values for D < 0. + WRITE (6,*) SLASHDATE(D)," : ",DAYNAME(MOD(D,7)) + END DO + GO TO 10 + END diff --git a/Task/Find-the-last-Sunday-of-each-month/Haskell/find-the-last-sunday-of-each-month.hs b/Task/Find-the-last-Sunday-of-each-month/Haskell/find-the-last-sunday-of-each-month.hs new file mode 100644 index 0000000000..691cd26d0e --- /dev/null +++ b/Task/Find-the-last-Sunday-of-each-month/Haskell/find-the-last-sunday-of-each-month.hs @@ -0,0 +1,17 @@ +import Data.Time.Calendar +import Data.Time.Calendar.WeekDate + +-- 1 for Monday to 7 for Sunday +findWeekDay dayOfWeek date = head $ filter isWeekDay $ map toDate [-6 .. 0] + where + toDate ago = addDays ago date + isWeekDay theDate = let (_ , _ , day) = toWeekDate theDate + in day == dayOfWeek + +weekDayDates dayOfWeek year = map (showGregorian . findWeekDay dayOfWeek) lastDaysInMonth + where + lastDaysInMonth = map findLastDay [1 .. 12] + findLastDay month = fromGregorian year month (gregorianMonthLength year month) + +sundayDates = weekDayDates 7 +main = readLn >>= mapM_ putStrLn.sundayDates diff --git a/Task/Find-the-last-Sunday-of-each-month/JavaScript/find-the-last-sunday-of-each-month.js b/Task/Find-the-last-Sunday-of-each-month/JavaScript/find-the-last-sunday-of-each-month-1.js similarity index 100% rename from Task/Find-the-last-Sunday-of-each-month/JavaScript/find-the-last-sunday-of-each-month.js rename to Task/Find-the-last-Sunday-of-each-month/JavaScript/find-the-last-sunday-of-each-month-1.js diff --git a/Task/Find-the-last-Sunday-of-each-month/JavaScript/find-the-last-sunday-of-each-month-2.js b/Task/Find-the-last-Sunday-of-each-month/JavaScript/find-the-last-sunday-of-each-month-2.js new file mode 100644 index 0000000000..0ca1548947 --- /dev/null +++ b/Task/Find-the-last-Sunday-of-each-month/JavaScript/find-the-last-sunday-of-each-month-2.js @@ -0,0 +1,73 @@ +(function () { + 'use strict'; + + // lastSundaysOfYear :: Int -> [Date] + function lastSundaysOfYear(y) { + return lastWeekDaysOfYear(y, days.sunday); + } + + // lastWeekDaysOfYear :: Int -> Int -> [Date] + function lastWeekDaysOfYear(y, iWeekDay) { + return [ + 31, + 0 === y % 4 && 0 !== y % 100 || 0 === y % 400 ? 29 : 28, + 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 + ] + .map(function (d, m) { + var dte = new Date(Date.UTC(y, m, d)); + + return new Date(Date.UTC( + y, m, d - ( + (dte.getDay() + (7 - iWeekDay)) % 7 + ) + )); + }); + } + + // isoDateString :: Date -> String + function isoDateString(dte) { + return dte.toISOString() + .substr(0, 10); + } + + // range :: Int -> Int -> [Int] + function range(m, n) { + return Array.apply(null, Array(n - m + 1)) + .map(function (x, i) { + return m + i; + }); + } + + // transpose :: [[a]] -> [[a]] + function transpose(lst) { + return lst[0].map(function (_, iCol) { + return lst.map(function (row) { + return row[iCol]; + }); + }); + } + + var days = { + sunday: 0, + monday: 1, + tuesday: 2, + wednesday: 3, + thursday: 4, + friday: 5, + saturday: 6 + } + + // TEST + + return transpose( + range(2012, 2016) + .map(lastSundaysOfYear) + ) + .map(function (row) { + return row + .map(isoDateString) + .join('\t'); + }) + .join('\n'); + +})(); diff --git a/Task/Find-the-last-Sunday-of-each-month/Liberty-BASIC/find-the-last-sunday-of-each-month.liberty b/Task/Find-the-last-Sunday-of-each-month/Liberty-BASIC/find-the-last-sunday-of-each-month.liberty new file mode 100644 index 0000000000..d2246e7f2e --- /dev/null +++ b/Task/Find-the-last-Sunday-of-each-month/Liberty-BASIC/find-the-last-sunday-of-each-month.liberty @@ -0,0 +1,80 @@ +yyyy=2013: if yyyy<1901 or yyyy>2099 then end +nda$="Lsu" +print "The last Sundays of "; yyyy +for mm=1 to 12 + x=NthDayOfMonth(yyyy, mm, nda$) + select case mm + case 1: print " January "; x + case 2: print " February "; x + case 3: print " March "; x + case 4: print " April "; x + case 5: print " May "; x + case 6: print " June "; x + case 7: print " July "; x + case 8: print " August "; x + case 9: print " September "; x + case 10: print " October "; x + case 11: print " November "; x + case 12: print " December "; x + end select +next mm +end + +function NthDayOfMonth(yyyy, mm, nda$) +' nda$ is a two-part code. The first character, n, denotes +' first, second, third, fourth, and last by 1, 2, 3, 4, or L. +' The last two characters, da, denote the day of the week by +' mo, tu, we, th, fr, sa, or su. For example: +' the nda$ for the second Monday of a month is "2mo"; +' the nda$ for the last Thursday of a month is "Lth". + if yyyy<1900 or yyyy>2099 or mm<1 or mm>12 then + NthDayOfMonth=0: exit function + end if + nda$=lower$(trim$(nda$)) + if len(nda$)<>3 then NthDayOfMonth=0: exit function + n$=left$(nda$,1): nC$="1234l" + da$=right$(nda$,2): daC$="tuwethfrsasumotuwethfrsasumo" + if not(instr(nC$,n$)) or not(instr(daC$,da$)) then + NthDayOfMonth=0: exit function + end if + NthDayOfMonth=1 + mm$=str$(mm): if mm<10 then mm$="0"+mm$ + db$=DayOfDate$(str$(yyyy)+mm$+"01") + if da$<>db$ then + x=instr(daC$,db$): y=instr(daC$,da$,x): NthDayOfMonth=1+(y-x)/2 + end if + dim MD(12) + MD(1)=31: MD(2)=28: MD(3)=31: MD(4)=30: MD(5)=31: MD(6)=30 + MD(7)=31: MD(8)=31: MD(9)=30: MD(10)=31: MD(11)=30: MD(12)=31 + if yyyy mod 4 = 0 then MD(2)=29 + if n$<>"1" then + if n$<>"l" then + NthDayOfMonth=NthDayOfMonth+((val(n$)-1)*7) + else + if NthDayOfMonth+27 2, m++, y--; m += 13); + (1461 * y) \ 4 + (306001 * m) \ 10000 + D[3] - 694024 + 2 - y \ 100 + y \ 400 +} + +\\ Date from Normalized Julian Day Number +njdate(J) = +{ + my (a = J + 2415019, b = (4 * a - 7468865) \ 146097, c, d, m, y); + + a += 1 + b - b \ 4 + 1524; + b = (20 * a - 2442) \ 7305; + c = (1461 * b) \ 4; + d = ((a - c) * 10000) \ 306001; + m = d - 1 - 12 * (d > 13); + y = b - 4715 - (m > 2); + d = a - c - (306001 * d) \ 10000; + + [y, m, d] +} + +for (m=1, 12, a=njd([2013,m+1,0]); print(njdate(a-(a+6)%7))) diff --git a/Task/Find-the-last-Sunday-of-each-month/PHP/find-the-last-sunday-of-each-month.php b/Task/Find-the-last-Sunday-of-each-month/PHP/find-the-last-sunday-of-each-month.php new file mode 100644 index 0000000000..3293445d76 --- /dev/null +++ b/Task/Find-the-last-Sunday-of-each-month/PHP/find-the-last-sunday-of-each-month.php @@ -0,0 +1,15 @@ + $mo { my $month-end = Date.new($year, $mo, Date.days-in-month($year, $mo)); say $month-end - $month-end.day-of-week % 7; diff --git a/Task/Find-the-last-Sunday-of-each-month/PowerShell/find-the-last-sunday-of-each-month-1.psh b/Task/Find-the-last-Sunday-of-each-month/PowerShell/find-the-last-sunday-of-each-month-1.psh new file mode 100644 index 0000000000..0f7a15656c --- /dev/null +++ b/Task/Find-the-last-Sunday-of-each-month/PowerShell/find-the-last-sunday-of-each-month-1.psh @@ -0,0 +1,13 @@ +function last-dayofweek { + param( + [Int][ValidatePattern("[1-9][0-9][0-9][0-9]")]$year, + [String][validateset('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday')]$dayofweek + ) + $date = (Get-Date -Year $year -Month 1 -Day 1) + while($date.DayOfWeek -ne $dayofweek) {$date = $date.AddDays(1)} + while($date.year -eq $year) { + if($date.Month -ne $date.AddDays(7).Month) {$date.ToString("yyyy-dd-MM")} + $date = $date.AddDays(7) + } +} +last-dayofweek 2013 "Sunday" diff --git a/Task/Find-the-last-Sunday-of-each-month/PowerShell/find-the-last-sunday-of-each-month-2.psh b/Task/Find-the-last-Sunday-of-each-month/PowerShell/find-the-last-sunday-of-each-month-2.psh new file mode 100644 index 0000000000..303610c8ea --- /dev/null +++ b/Task/Find-the-last-Sunday-of-each-month/PowerShell/find-the-last-sunday-of-each-month-2.psh @@ -0,0 +1,97 @@ +function Get-Date0fDayOfWeek +{ + [CmdletBinding(DefaultParameterSetName="None")] + [OutputType([datetime])] + Param + ( + [Parameter(Mandatory=$false, + ValueFromPipeline=$true, + ValueFromPipelineByPropertyName=$true, + Position=0)] + [ValidateRange(1,12)] + [int] + $Month = (Get-Date).Month, + + [Parameter(Mandatory=$false, + ValueFromPipelineByPropertyName=$true, + Position=1)] + [ValidateRange(1,9999)] + [int] + $Year = (Get-Date).Year, + + [Parameter(Mandatory=$true, ParameterSetName="Sunday")] + [switch] + $Sunday, + + [Parameter(Mandatory=$true, ParameterSetName="Monday")] + [switch] + $Monday, + + [Parameter(Mandatory=$true, ParameterSetName="Tuesday")] + [switch] + $Tuesday, + + [Parameter(Mandatory=$true, ParameterSetName="Wednesday")] + [switch] + $Wednesday, + + [Parameter(Mandatory=$true, ParameterSetName="Thursday")] + [switch] + $Thursday, + + [Parameter(Mandatory=$true, ParameterSetName="Friday")] + [switch] + $Friday, + + [Parameter(Mandatory=$true, ParameterSetName="Saturday")] + [switch] + $Saturday, + + [switch] + $First, + + [switch] + $Last, + + [switch] + $AsString, + + [Parameter(Mandatory=$false)] + [ValidateNotNullOrEmpty()] + [string] + $Format = "dd-MMM-yyyy" + ) + + Process + { + [datetime[]]$dates = 1..[DateTime]::DaysInMonth($Year,$Month) | ForEach-Object { + Get-Date -Year $Year -Month $Month -Day $_ -Hour 0 -Minute 0 -Second 0 | + Where-Object -Property DayOfWeek -Match $PSCmdlet.ParameterSetName + } + + if ($First -or $Last) + { + if ($AsString) + { + if ($First) {$dates[0].ToString($Format)} + if ($Last) {$dates[-1].ToString($Format)} + } + else + { + if ($First) {$dates[0]} + if ($Last) {$dates[-1]} + } + } + else + { + if ($AsString) + { + $dates | ForEach-Object {$_.ToString($Format)} + } + else + { + $dates + } + } + } +} diff --git a/Task/Find-the-last-Sunday-of-each-month/PowerShell/find-the-last-sunday-of-each-month-3.psh b/Task/Find-the-last-Sunday-of-each-month/PowerShell/find-the-last-sunday-of-each-month-3.psh new file mode 100644 index 0000000000..5c795b34d7 --- /dev/null +++ b/Task/Find-the-last-Sunday-of-each-month/PowerShell/find-the-last-sunday-of-each-month-3.psh @@ -0,0 +1 @@ +1..12 | Get-Date0fDayOfWeek -Year 2013 -Last -Sunday diff --git a/Task/Find-the-last-Sunday-of-each-month/PowerShell/find-the-last-sunday-of-each-month-4.psh b/Task/Find-the-last-Sunday-of-each-month/PowerShell/find-the-last-sunday-of-each-month-4.psh new file mode 100644 index 0000000000..8f9f685714 --- /dev/null +++ b/Task/Find-the-last-Sunday-of-each-month/PowerShell/find-the-last-sunday-of-each-month-4.psh @@ -0,0 +1 @@ +1..12 | Get-Date0fDayOfWeek -Year 2013 -Last -Sunday -AsString diff --git a/Task/Find-the-last-Sunday-of-each-month/PowerShell/find-the-last-sunday-of-each-month-5.psh b/Task/Find-the-last-Sunday-of-each-month/PowerShell/find-the-last-sunday-of-each-month-5.psh new file mode 100644 index 0000000000..14cd7511db --- /dev/null +++ b/Task/Find-the-last-Sunday-of-each-month/PowerShell/find-the-last-sunday-of-each-month-5.psh @@ -0,0 +1 @@ +1..12 | Get-Date0fDayOfWeek -Year 2013 -Last -Sunday -AsString -Format yyyy-MM-dd diff --git a/Task/Find-the-last-Sunday-of-each-month/Python/find-the-last-sunday-of-each-month-1.py b/Task/Find-the-last-Sunday-of-each-month/Python/find-the-last-sunday-of-each-month-1.py new file mode 100644 index 0000000000..342195d3cc --- /dev/null +++ b/Task/Find-the-last-Sunday-of-each-month/Python/find-the-last-sunday-of-each-month-1.py @@ -0,0 +1,13 @@ +import sys +import calendar + +year = 2013 +if len(sys.argv) > 1: + try: + year = int(sys.argv[-1]) + except ValueError: + pass + +for month in range(1, 13): + last_sunday = max(week[-1] for week in calendar.monthcalendar(year, month)) + print('{}-{}-{:2}'.format(year, calendar.month_abbr[month], last_sunday)) diff --git a/Task/Find-the-last-Sunday-of-each-month/Python/find-the-last-sunday-of-each-month-2.py b/Task/Find-the-last-Sunday-of-each-month/Python/find-the-last-sunday-of-each-month-2.py new file mode 100644 index 0000000000..c8871a37a8 --- /dev/null +++ b/Task/Find-the-last-Sunday-of-each-month/Python/find-the-last-sunday-of-each-month-2.py @@ -0,0 +1,12 @@ +2013-Jan-27 +2013-Feb-24 +2013-Mar-31 +2013-Apr-28 +2013-May-26 +2013-Jun-30 +2013-Jul-28 +2013-Aug-25 +2013-Sep-29 +2013-Oct-27 +2013-Nov-24 +2013-Dec-29 diff --git a/Task/Find-the-last-Sunday-of-each-month/Python/find-the-last-sunday-of-each-month.py b/Task/Find-the-last-Sunday-of-each-month/Python/find-the-last-sunday-of-each-month.py deleted file mode 100644 index 697b06bfac..0000000000 --- a/Task/Find-the-last-Sunday-of-each-month/Python/find-the-last-sunday-of-each-month.py +++ /dev/null @@ -1,42 +0,0 @@ -#!/usr/bin/python3 - -''' - Output: - 2013-Jan-27 - 2013-Feb-24 - 2013-Mar-31 - 2013-Apr-28 - 2013-May-26 - 2013-Jun-30 - 2013-Jul-28 - 2013-Aug-25 - 2013-Sep-29 - 2013-Oct-27 - 2013-Nov-24 - 2013-Dec-29 -''' - -import sys -import calendar - -YEAR = sys.argv[-1] -try: - year = int(YEAR) -except: - year = 2013 - YEAR = str(year) - -c = calendar.Calendar(firstweekday = 0) # Sunday is day 6. - -result = [] -for month in range(0+1,12+1): - MON = calendar.month_abbr[month] - # list of weeks of tuples has too much structure - # Use the overloaded list.__add__ operator to remove the week structure. - flatter = sum(c.monthdays2calendar(year, month), []) - # make a dictionary keyed by number of day of week, - # successively overwriting values. - SUNDAY = {b: a for (a, b) in flatter if a}[6] - result.append('{}-{}-{:2}'.format(YEAR, MON, SUNDAY)) - -print('\n'.join(result)) diff --git a/Task/Find-the-last-Sunday-of-each-month/Run-BASIC/find-the-last-sunday-of-each-month.run b/Task/Find-the-last-Sunday-of-each-month/Run-BASIC/find-the-last-sunday-of-each-month.run new file mode 100644 index 0000000000..48da28b8f9 --- /dev/null +++ b/Task/Find-the-last-Sunday-of-each-month/Run-BASIC/find-the-last-sunday-of-each-month.run @@ -0,0 +1,18 @@ +input "What year to calculate (yyyy) : ";year +print "Last Sundays in ";year;" are:" +dim month(12) +mo$ = "4 0 0 3 5 1 3 6 2 4 0 2" +mon$ = "31 28 31 30 31 30 31 31 30 31 30 31" + +if year < 2100 then leap = year - 1900 else leap = year - 1904 +m = ((year-1900) mod 7) + int(leap/4) mod 7 +for n = 1 to 12 + month(n) = (val(word$(mo$,n)) + m) mod 7 + month(n) = (val(word$(mo$,n)) + m) mod 7 +next +for n = 1 to 12 + for i = (val(word$(mon$,n)) - 6) to val(word$(mon$,n)) + x = (month(n) + i) mod 7 + if x = 4 then print year ; "-";right$("0"+str$(n),2);"-" ; i + next +next diff --git a/Task/Find-the-last-Sunday-of-each-month/Smalltalk/find-the-last-sunday-of-each-month.st b/Task/Find-the-last-Sunday-of-each-month/Smalltalk/find-the-last-sunday-of-each-month.st new file mode 100644 index 0000000000..c970c50ff4 --- /dev/null +++ b/Task/Find-the-last-Sunday-of-each-month/Smalltalk/find-the-last-sunday-of-each-month.st @@ -0,0 +1,9 @@ +Pharo Smalltalk + +[ :yr | | firstDay firstSunday | + firstDay := Date year: yr month: 1 day: 1. + firstSunday := firstDay addDays: (1 - firstDay dayOfWeek). + (0 to: 53) + collect: [ :each | firstSunday addDays: (each * 7) ] + thenSelect: [ :each | + (((Date daysInMonth: each monthIndex forYear: yr) - each dayOfMonth) <= 6) and: [ each year = yr ] ] ] diff --git a/Task/Find-the-missing-permutation/00DESCRIPTION b/Task/Find-the-missing-permutation/00DESCRIPTION index 38dda59fd6..abd82ebfc6 100644 --- a/Task/Find-the-missing-permutation/00DESCRIPTION +++ b/Task/Find-the-missing-permutation/00DESCRIPTION @@ -1,22 +1,5 @@ -These are all of the permutations of the symbols A, B, C and D, -except for one that's not listed. -Find that missing permutation. - -(cf. [[Permutations]]) - -There is an obvious method : -enumerating all permutations of A, B, C, D, and looking for the missing one. - -There is an alternate method. -Hint : if all permutations were here, -how many times would A appear in each position ? -What is the parity of this number ? - -There is another alternate method. -Hint: if you add up the letter values of each column, does a missing letter A, B, C, D -from each column cause the total value for each column to be unique? - -
    ABCD
    +
    +ABCD
     CABD
     ACDB
     DACB
    @@ -38,4 +21,31 @@ BADC
     BDAC
     CBDA
     DBCA
    -DCAB
    +DCAB +
    +Listed above are all of the permutations of the symbols   '''A''',   '''B''',   '''C''',   and   '''D''',   ''except''   for one permutation that's   ''not''   listed. + + +;Task: +Find that missing permutation. + + +;Methods: +* Obvious method: + enumerate all permutations of '''A''', '''B''', '''C''', and '''D''', + and then look for the missing permutation. + +* alternate method: + Hint: if all permutations were shown above, how many + times would '''A''' appear in each position? + What is the ''parity'' of this number? + +* another alternate method: + Hint: if you add up the letter values of each column, + does a missing letter '''A''', '''B''', '''C''', and '''D''' from each + column cause the total value for each column to be unique? + + +;Related task: +*   [[Permutations]]) +

    diff --git a/Task/Find-the-missing-permutation/AppleScript/find-the-missing-permutation.applescript b/Task/Find-the-missing-permutation/AppleScript/find-the-missing-permutation.applescript new file mode 100644 index 0000000000..e1f48a5261 --- /dev/null +++ b/Task/Find-the-missing-permutation/AppleScript/find-the-missing-permutation.applescript @@ -0,0 +1,210 @@ +use framework "Foundation" + +-- UNDER-REPRESENTED CHARACTER IN EACH OF N COLUMNS + +-- missingChar :: Record -> Character +script missingChar + -- mean :: [Num] -> Num + on mean(xs) + script sum + on lambda(a, b) + a + b + end lambda + end script + + foldl(sum, 0, xs) / (length of xs) + end mean + + -- Record -> Character + on lambda(rec) + set nMean to mean(allValues(rec)) + + script belowMean + on lambda(a, x, i) + set k to toLowerCase(x) + if a is missing value then + set v to keyValue(rec, k) + if v < nMean then + toUpperCase(x) + else + missing value + end if + else + a + end if + end lambda + end script + + foldl(belowMean, missing value, allKeys(rec)) + end lambda +end script + +-- Count of each character type in each character column + +-- colCounts :: [Character] -> Record +script colCounts + on lambda(xs) + script tally + on lambda(a, x) + set k to toLowerCase(x) + set v to keyValue(a, k) + if v is missing value then + set n to 1 + else + set n to v + 1 + end if + updatedRecord(a, k, n) + end lambda + end script + + foldl(tally, {name:""}, xs) + end lambda +end script + +-- TEST +on run + + map(missingChar, ¬ + map(colCounts, ¬ + transpose(map(curry(splitOn)'s lambda(""), ¬ + splitOn(space, ¬ + "ABCD CABD ACDB DACB BCDA ACBD " & ¬ + "ADCB CDAB DABC BCAD CADB CDBA " & ¬ + "CBAD ABDC ADBC BDCA DCBA BACD " & ¬ + "BADC BDAC CBDA DBCA DCAB"))))) as text + + --> "DBAC" +end run + + +--------------------------------------------------------------------------- + +-- GENERIC FUNCTIONS + +-- transpose :: [[a]] -> [[a]] +on transpose(xss) + script column + on lambda(_, iCol) + script row + on lambda(xs) + item iCol of xs + end lambda + end script + + map(row, xss) + end lambda + end script + + map(column, item 1 of xss) +end transpose + +-- curry :: (Script|Handler) -> Script +on curry(f) + script + on lambda(a) + script + on lambda(b) + lambda(a, b) of mReturn(f) + end lambda + end script + end lambda + end script +end curry + +-- 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 + +-- 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 + +-- splitOn :: Text -> Text -> [Text] +on splitOn(strDelim, strMain) + set {dlm, my text item delimiters} to {my text item delimiters, strDelim} + set xs to text items of strMain + set my text item delimiters to dlm + return xs +end splitOn + +-- ord :: Character -> Int +on ord(x) + id of x +end ord + +-- 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 + + +-- NSString + +-- toLowerCase :: String -> String +on toLowerCase(str) + set ca to current application + ((ca's NSString's stringWithString:(str))'s ¬ + lowercaseStringWithLocale:(ca's NSLocale's currentLocale())) as text +end toLowerCase + +-- toUpperCase :: String -> String +on toUpperCase(str) + set ca to current application + ((ca's NSString's stringWithString:(str))'s ¬ + uppercaseStringWithLocale:(ca's NSLocale's currentLocale())) as text +end toUpperCase + + +-- NSDictionary + +-- allKeys :: Record -> [String] +on allKeys(rec) + (current application's NSDictionary's dictionaryWithDictionary:rec)'s allKeys() as list +end allKeys + +-- allValues :: Record -> [a] +on allValues(rec) + (current application's NSDictionary's dictionaryWithDictionary:rec)'s allValues() as list +end allValues + +-- keyValue :: Record -> String -> Maybe String +on keyValue(rec, strKey) + set ca to current application + set v to (ca's NSDictionary's dictionaryWithDictionary:rec)'s objectForKey:strKey + if v is not missing value then + item 1 of ((ca's NSArray's arrayWithObject:v) as list) + else + missing value + end if +end keyValue + +-- updatedRecord :: Record -> String -> a -> Record +on updatedRecord(rec, strKey, varValue) + set ca to current application + set nsDct to (ca's NSMutableDictionary's dictionaryWithDictionary:rec) + nsDct's setValue:varValue forKey:strKey + item 1 of ((ca's NSArray's arrayWithObject:nsDct) as list) +end updatedRecord diff --git a/Task/Find-the-missing-permutation/JavaScript/find-the-missing-permutation-4.js b/Task/Find-the-missing-permutation/JavaScript/find-the-missing-permutation-4.js new file mode 100644 index 0000000000..2fddd050b4 --- /dev/null +++ b/Task/Find-the-missing-permutation/JavaScript/find-the-missing-permutation-4.js @@ -0,0 +1,33 @@ +(() => { + 'use strict'; + + // transpose :: [[a]] -> [[a]] + let transpose = xs => + xs[0].map((_, iCol) => xs + .map((row) => row[iCol])); + + + let xs = 'ABCD CABD ACDB DACB BCDA ACBD ADCB CDAB' + + ' DABC BCAD CADB CDBA CBAD ABDC ADBC BDCA DCBA' + + ' BACD BADC BDAC CBDA DBCA DCAB' + + return transpose(xs.split(' ') + .map(x => x.split(''))) + .map(col => col.reduce((a, x) => ( // count of each character in each column + a[x] = (a[x] || 0) + 1, + a + ), {})) + .map(dct => { // character with frequency below mean of distribution ? + let ks = Object.keys(dct), + xs = ks.map(k => dct[k]), + mean = xs.reduce((a, b) => a + b, 0) / xs.length; + + return ks.reduce( + (a, k) => a ? a : (dct[k] < mean ? k : undefined), + undefined + ); + }) + .join(''); // 4 chars as single string + + // --> 'DBAC' +})(); diff --git a/Task/Find-the-missing-permutation/K/find-the-missing-permutation-2.k b/Task/Find-the-missing-permutation/K/find-the-missing-permutation-2.k index 2e42d5bd51..cb86286bca 100644 --- a/Task/Find-the-missing-permutation/K/find-the-missing-permutation-2.k +++ b/Task/Find-the-missing-permutation/K/find-the-missing-permutation-2.k @@ -1,3 +1,3 @@ - table:{b@bunch then do - _=; do m=1 for bunch /*build a permutation. */ - _=_ || @.m /*add permutation──►list*/ - end /*m*/ - /* [↓] is in the list? */ - if wordpos(_,list)==0 then say _ ' is missing from the list.' - end - else do x=1 for things /*build a permutation. */ - do k=1 for ?-1 - if @.k==$.x then iterate x /*was permutation built?*/ - end /*k*/ - @.?=$.x /*define as being built.*/ - call permSet ?+1 /*call subr. recursively*/ - end /*x*/ -return + if ?>bunch then do; _= + do m=1 for bunch /*build a permutation. */ + _=_ || @.m /*add permutation──►list.*/ + end /*m*/ + /* [↓] is in the list? */ + if wordpos(_,list)==0 then say _ ' is missing from the list.' + end + else do x=1 for things /*build a permutation. */ + do k=1 for ?-1 + if @.k==$.x then iterate x /*was permutation built? */ + end /*k*/ + @.?=$.x /*define as being built. */ + call permSet ?+1 /*call subr. recursively.*/ + end /*x*/ + return diff --git a/Task/Find-the-missing-permutation/ZX-Spectrum-Basic/find-the-missing-permutation.zx b/Task/Find-the-missing-permutation/ZX-Spectrum-Basic/find-the-missing-permutation.zx new file mode 100644 index 0000000000..1976e53c06 --- /dev/null +++ b/Task/Find-the-missing-permutation/ZX-Spectrum-Basic/find-the-missing-permutation.zx @@ -0,0 +1,14 @@ +10 LET l$="ABCD CABD ACDB DACB BCDA ACBD ADCB CDAB DABC BCAD CADB CDBA CBAD ABDC ADBC BDCA DCBA BACD BADC BDAC CBDA DBCA DCAB" +20 LET length=LEN l$ +30 FOR a= CODE "A" TO CODE "D" +40 FOR b= CODE "A" TO CODE "D" +50 FOR c= CODE "A" TO CODE "D" +60 FOR d= CODE "A" TO CODE "D" +70 LET x$="" +80 IF a=b OR a=c OR a=d OR b=c OR b=d OR c=d THEN GO TO 140 +90 LET x$=CHR$ a+CHR$ b+CHR$ c+CHR$ d +100 FOR i=1 TO length STEP 5 +110 IF x$=l$(i TO i+3) THEN GO TO 140 +120 NEXT i +130 PRINT x$;" is missing" +140 NEXT d: NEXT c: NEXT b: NEXT a diff --git a/Task/First-class-environments/Haskell/first-class-environments-1.hs b/Task/First-class-environments/Haskell/first-class-environments-1.hs new file mode 100644 index 0000000000..fc7d219fa4 --- /dev/null +++ b/Task/First-class-environments/Haskell/first-class-environments-1.hs @@ -0,0 +1,4 @@ +hailstone n + | n == 1 = 1 + | even n = n `div` 2 + | odd n = 3*n + 1 diff --git a/Task/First-class-environments/Haskell/first-class-environments-2.hs b/Task/First-class-environments/Haskell/first-class-environments-2.hs new file mode 100644 index 0000000000..9a82f3eb7f --- /dev/null +++ b/Task/First-class-environments/Haskell/first-class-environments-2.hs @@ -0,0 +1,2 @@ +data Environment = Environment { count :: Int, value :: Int } + deriving Eq diff --git a/Task/First-class-environments/Haskell/first-class-environments-3.hs b/Task/First-class-environments/Haskell/first-class-environments-3.hs new file mode 100644 index 0000000000..af78999f2b --- /dev/null +++ b/Task/First-class-environments/Haskell/first-class-environments-3.hs @@ -0,0 +1 @@ +environments = [ Environment 0 n | n <- [1..12] ] diff --git a/Task/First-class-environments/Haskell/first-class-environments-4.hs b/Task/First-class-environments/Haskell/first-class-environments-4.hs new file mode 100644 index 0000000000..6cd3228528 --- /dev/null +++ b/Task/First-class-environments/Haskell/first-class-environments-4.hs @@ -0,0 +1,2 @@ +process (Environment c 1) = Environment c 1 +process (Environment c n) = Environment (c+1) (hailstone n) diff --git a/Task/First-class-environments/Haskell/first-class-environments-5.hs b/Task/First-class-environments/Haskell/first-class-environments-5.hs new file mode 100644 index 0000000000..25154839ec --- /dev/null +++ b/Task/First-class-environments/Haskell/first-class-environments-5.hs @@ -0,0 +1,5 @@ +process = execState $ do + n <- gets value + c <- gets count + when (n > 1) $ modify $ \env -> env { count = c + 1 } + modify $ \env -> env { value = hailstone n } diff --git a/Task/First-class-environments/Haskell/first-class-environments-6.hs b/Task/First-class-environments/Haskell/first-class-environments-6.hs new file mode 100644 index 0000000000..9f4df1ab1d --- /dev/null +++ b/Task/First-class-environments/Haskell/first-class-environments-6.hs @@ -0,0 +1,13 @@ +fixedPoint f x + | fx == x = [x] + | otherwise = x : fixedPoint f fx + where fx = f x + +prettyPrint field = putStrLn . foldMap (format.field) + where format n = (if n < 10 then " " else "") ++ show n ++ " " + +main = do + let result = fixedPoint (map process) environments + mapM_ (prettyPrint value) result + putStrLn (replicate 36 '-') + prettyPrint count (last result) diff --git a/Task/First-class-environments/Haskell/first-class-environments-7.hs b/Task/First-class-environments/Haskell/first-class-environments-7.hs new file mode 100644 index 0000000000..bfde6896f6 --- /dev/null +++ b/Task/First-class-environments/Haskell/first-class-environments-7.hs @@ -0,0 +1,6 @@ +main = do + let result = map (fixedPoint process) environments + mapM_ (prettyPrint value) result + putStrLn (replicate 36 '-') + putStrLn "Counts: " + prettyPrint (count . last) result diff --git a/Task/First-class-environments/Perl-6/first-class-environments.pl6 b/Task/First-class-environments/Perl-6/first-class-environments.pl6 index dfc8bfbba2..72dfb73141 100644 --- a/Task/First-class-environments/Perl-6/first-class-environments.pl6 +++ b/Task/First-class-environments/Perl-6/first-class-environments.pl6 @@ -2,14 +2,14 @@ my $calculator = sub ($n is rw) { return ($n == 1) ?? 1 !! $n %% 2 ?? $n div 2 !! $n * 3 + 1 }; -sub next (%this is rw, &get_next) { +sub next (%this, &get_next) { return %this if %this. == 1; %this..=&get_next; %this.++; return %this; }; -my @hailstones = map { $_ = %(value => $_, count => 0) }, 1 .. 12; +my @hailstones = map { %(value => $_, count => 0) }, 1 .. 12; while not all( map { $_. }, @hailstones ) == 1 { say [~] map { $_..fmt("%4s") }, @hailstones; diff --git a/Task/First-class-functions-Use-numbers-analogously/Ada/first-class-functions-use-numbers-analogously.ada b/Task/First-class-functions-Use-numbers-analogously/Ada/first-class-functions-use-numbers-analogously.ada index ab646a3ef5..7f8cfa89ec 100644 --- a/Task/First-class-functions-Use-numbers-analogously/Ada/first-class-functions-use-numbers-analogously.ada +++ b/Task/First-class-functions-Use-numbers-analogously/Ada/first-class-functions-use-numbers-analogously.ada @@ -3,7 +3,8 @@ procedure Firstclass is generic n1, n2 : Float; function Multiplier (m : Float) return Float; - function Multiplier (m : Float) return Float is begin + function Multiplier (m : Float) return Float is + begin return n1 * n2 * m; end Multiplier; @@ -15,7 +16,7 @@ begin declare function new_function is new Multiplier (num (i), inv (i)); begin - Ada.Text_IO.Put_Line (new_function (0.5)'Img); + Ada.Text_IO.Put_Line (Float'Image (new_function (0.5))); end; end loop; end Firstclass; diff --git a/Task/First-class-functions-Use-numbers-analogously/Groovy/first-class-functions-use-numbers-analogously.groovy b/Task/First-class-functions-Use-numbers-analogously/Groovy/first-class-functions-use-numbers-analogously.groovy new file mode 100644 index 0000000000..221d2f4f01 --- /dev/null +++ b/Task/First-class-functions-Use-numbers-analogously/Groovy/first-class-functions-use-numbers-analogously.groovy @@ -0,0 +1,11 @@ +def multiplier = { n1, n2 -> { m -> n1 * n2 * m } } + +def ε = 0.00000001 // tolerance(epsilon): acceptable level of "wrongness" to account for rounding error +[(2.0):0.5, (4.0):0.25, (6.0):(1/6.0)].each { num, inv -> + def new_function = multiplier(num, inv) + (1.0..5.0).each { trial -> + assert (new_function(trial) - trial).abs() < ε + printf('%5.3f * %5.3f * %5.3f == %5.3f\n', num, inv, trial, trial) + } + println() +} diff --git a/Task/First-class-functions-Use-numbers-analogously/Lua/first-class-functions-use-numbers-analogously.lua b/Task/First-class-functions-Use-numbers-analogously/Lua/first-class-functions-use-numbers-analogously.lua new file mode 100644 index 0000000000..034c1ae5b3 --- /dev/null +++ b/Task/First-class-functions-Use-numbers-analogously/Lua/first-class-functions-use-numbers-analogously.lua @@ -0,0 +1,19 @@ +-- This function returns another function that +-- keeps n1 and n2 in scope, ie. a closure. +function multiplier (n1, n2) + return function (m) + return n1 * n2 * m + end +end + +-- Multiple assignment a-go-go +local x, xi, y, yi = 2.0, 0.5, 4.0, 0.25 +local z, zi = x + y, 1.0 / ( x + y ) +local nums, invs = {x, y, z}, {xi, yi, zi} + +-- 'new_function' stores the closure and then has the 0.5 applied to it +-- (this 0.5 isn't in the task description but everyone else used it) +for k, v in pairs(nums) do + new_function = multiplier(v, invs[k]) + print(v .. " * " .. invs[k] .. " * 0.5 = " .. new_function(0.5)) +end diff --git a/Task/First-class-functions-Use-numbers-analogously/Rust/first-class-functions-use-numbers-analogously.rust b/Task/First-class-functions-Use-numbers-analogously/Rust/first-class-functions-use-numbers-analogously.rust new file mode 100644 index 0000000000..97aa4149e1 --- /dev/null +++ b/Task/First-class-functions-Use-numbers-analogously/Rust/first-class-functions-use-numbers-analogously.rust @@ -0,0 +1,20 @@ +#![feature(conservative_impl_trait)] +fn main() { + let (x, xi) = (2.0, 0.5); + let (y, yi) = (4.0, 0.25); + let z = x + y; + let zi = 1.0/z; + + let numlist = [x,y,z]; + let invlist = [xi,yi,zi]; + + let result = numlist.iter() + .zip(&invlist) + .map(|(x,y)| multiplier(*x,*y)(0.5)) + .collect::>(); + println!("{:?}", result); +} + +fn multiplier(x: f64, y: f64) -> impl Fn(f64) -> f64 { + move |m| x*y*m +} diff --git a/Task/First-class-functions/00DESCRIPTION b/Task/First-class-functions/00DESCRIPTION index cbcf7187b6..f78a772330 100644 --- a/Task/First-class-functions/00DESCRIPTION +++ b/Task/First-class-functions/00DESCRIPTION @@ -5,8 +5,14 @@ A language has [[wp:First-class function|first-class functions]] if it can do ea * Use functions as arguments to other functions * Use functions as return values of other functions + +
    +;Task: Write a program to create an ordered collection ''A'' of functions of a real number. At least one function should be built-in and at least one should be user-defined; try using the sine, cosine, and cubing functions. Fill another collection ''B'' with the inverse of each function in ''A''. Implement function composition as in [[Functional Composition]]. Finally, demonstrate that the result of applying the composition of each function in ''A'' and its inverse in ''B'' to a value, is the original value. (Within the limits of computational accuracy). (A solution need not actually call the collections "A" and "B". These names are only used in the preceding paragraph for clarity.) -C.f. [[First-class Numbers]] + +;Related task: +[[First-class Numbers]] +

    diff --git a/Task/First-class-functions/AppleScript/first-class-functions-1.applescript b/Task/First-class-functions/AppleScript/first-class-functions-1.applescript new file mode 100644 index 0000000000..31eceb2210 --- /dev/null +++ b/Task/First-class-functions/AppleScript/first-class-functions-1.applescript @@ -0,0 +1,56 @@ +-- Compose two functions, where each function is +-- a script object with a call(x) handler. +on compose(f, g) + script + on call(x) + f's call(g's call(x)) + end call + end script +end compose + +script increment + on call(n) + n + 1 + end call +end script + +script decrement + on call(n) + n - 1 + end call +end script + +script twice + on call(x) + x * 2 + end call +end script + +script half + on call(x) + x / 2 + end call +end script + +script cube + on call(x) + x ^ 3 + end call +end script + +script cuberoot + on call(x) + x ^ (1 / 3) + end call +end script + +set functions to {increment, twice, cube} +set inverses to {decrement, half, cuberoot} +set answers to {} +repeat with i from 1 to 3 + set end of answers to ¬ + compose(item i of inverses, ¬ + item i of functions)'s ¬ + call(0.5) +end repeat +answers -- Result: {0.5, 0.5, 0.5} diff --git a/Task/First-class-functions/AppleScript/first-class-functions-2.applescript b/Task/First-class-functions/AppleScript/first-class-functions-2.applescript new file mode 100644 index 0000000000..aee9141485 --- /dev/null +++ b/Task/First-class-functions/AppleScript/first-class-functions-2.applescript @@ -0,0 +1,104 @@ +on run {} + + set lstFn to {sin_, cos_, cube_} + set lstInvFn to {asin_, acos_, croot_} + + -- Form a list of three composed function objects, + -- and map testWithHalf() across the list to produce the results of + -- application of each composed function (base function composed with inverse) to 0.5 + + map(testWithHalf, zipWith(mCompose, lstFn, lstInvFn)) + + + --> {0.5, 0.5, 0.5} + +end run + +on testWithHalf(mf) + mf's lambda(0.5) +end testWithHalf + +-- Simple composition of two unadorned handlers into +-- a method of a script object +on mCompose(f, g) + script + on lambda(x) + mReturn(f)'s lambda(mReturn(g)'s lambda(x)) + end lambda + end script +end mCompose + +-- 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 + +-- 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 + +-- 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 + +-- cond :: Bool -> (a -> b) -> (a -> b) -> (a -> b) +on cond(bool, f, g) + if bool then + f + else + g + end if +end cond + +on sin:r + (do shell script "echo 's(" & r & ")' | bc -l") as real +end sin: + +on cos:r + (do shell script "echo 'c(" & r & ")' | bc -l") as real +end cos: + +on cube:x + x ^ 3 +end cube: + +on croot:x + x ^ (1 / 3) +end croot: + +on asin:r + (do shell script "echo 'a(" & r & "/sqrt(1-" & r & "^2))' | bc -l") as real +end asin: + +on acos:r + (do shell script "echo 'a(sqrt(1-" & r & "^2)/" & r & ")' | bc -l") as real +end acos: diff --git a/Task/First-class-functions/AppleScript/first-class-functions-3.applescript b/Task/First-class-functions/AppleScript/first-class-functions-3.applescript new file mode 100644 index 0000000000..d1a574529c --- /dev/null +++ b/Task/First-class-functions/AppleScript/first-class-functions-3.applescript @@ -0,0 +1 @@ +{0.5, 0.5, 0.5} diff --git a/Task/First-class-functions/AppleScript/first-class-functions.applescript b/Task/First-class-functions/AppleScript/first-class-functions.applescript deleted file mode 100644 index 933a6dd38f..0000000000 --- a/Task/First-class-functions/AppleScript/first-class-functions.applescript +++ /dev/null @@ -1,56 +0,0 @@ --- Compose two functions, where each function is --- a script object with a call(x) handler. -on compose(f, g) - script - on call(x) - f's call(g's call(x)) - end call - end script -end compose - -script increment - on call(n) - n + 1 - end call -end script - -script decrement - on call(n) - n - 1 - end call -end script - -script twice - on call(x) - x * 2 - end call -end script - -script half - on call(x) - x / 2 - end call -end script - -script cube - on call(x) - x ^ 3 - end call -end script - -script cuberoot - on call(x) - x ^ (1 / 3) - end call -end script - -set functions to {increment, twice, cube} -set inverses to {decrement, half, cuberoot} -set answers to {} -repeat with i from 1 to 3 - set end of answers to ¬ - compose(item i of inverses, ¬ - item i of functions)'s ¬ - call(0.5) -end repeat -answers -- Result: {0.5, 0.5, 0.5} diff --git a/Task/First-class-functions/Common-Lisp/first-class-functions-1.lisp b/Task/First-class-functions/Common-Lisp/first-class-functions-1.lisp index 8f1da1d8ca..870f7be8e4 100644 --- a/Task/First-class-functions/Common-Lisp/first-class-functions-1.lisp +++ b/Task/First-class-functions/Common-Lisp/first-class-functions-1.lisp @@ -3,11 +3,11 @@ (defun cube-root (x) (expt x (/ 3))) (loop with value = 0.5 - for function in (list #'sin #'cos #'cube ) + for func in (list #'sin #'cos #'cube ) for inverse in (list #'asin #'acos #'cube-root) - for composed = (compose inverse function) + for composed = (compose inverse func) do (format t "~&(~A ∘ ~A)(~A) = ~A~%" inverse - function + func value (funcall composed value))) diff --git a/Task/First-class-functions/Elena/first-class-functions.elena b/Task/First-class-functions/Elena/first-class-functions.elena new file mode 100644 index 0000000000..6b7c462f7a --- /dev/null +++ b/Task/First-class-functions/Elena/first-class-functions.elena @@ -0,0 +1,19 @@ +#import system. +#import system'routines. +#import system'math. +#import extensions'routines. + +#class(extension)op +{ + #method compose : f : g + = (self::g eval)::f eval. +} + +#symbol program = +[ + #var fs := (%"mathOp.sin[0]", %"mathOp.cos[0]", ()[ this power:3.0r ]). + #var gs := (%"mathOp.arcsin[0]", %"mathOp.arccos[0]", ()[ this power:(1.0r / 3) ]). + + fs zip:gs &into: (:f:g)[ 0.5r compose:f:g ] + run &each:printingLn. +]. diff --git a/Task/First-class-functions/Elixir/first-class-functions.elixir b/Task/First-class-functions/Elixir/first-class-functions.elixir new file mode 100644 index 0000000000..9a03538c2b --- /dev/null +++ b/Task/First-class-functions/Elixir/first-class-functions.elixir @@ -0,0 +1,14 @@ +defmodule First_class_functions do + def task(val) do + as = [&:math.sin/1, &:math.cos/1, fn x -> x * x * x end] + bs = [&:math.asin/1, &:math.acos/1, fn x -> :math.pow(x, 1/3) end] + Enum.zip(as, bs) + |> Enum.each(fn {a,b} -> IO.puts compose([a,b], val) end) + end + + defp compose(funs, x) do + Enum.reduce(funs, x, fn f,acc -> f.(acc) end) + end +end + +First_class_functions.task(0.5) diff --git a/Task/First-class-functions/GAP/first-class-functions.gap b/Task/First-class-functions/GAP/first-class-functions.gap index 22843d757d..4df57f8464 100644 --- a/Task/First-class-functions/GAP/first-class-functions.gap +++ b/Task/First-class-functions/GAP/first-class-functions.gap @@ -18,7 +18,7 @@ ApplyList := function(u, x) return v; end; -# Inverse and Sqrt are in the built-in library. Note that GAP doesn't have real numbers nor floating point numbers. Therefore, Sqrt yields values in cyclotomic fields. +# Inverse and Sqrt are in the built-in library. Note that Sqrt yields values in cyclotomic fields. # For example, # gap> Sqrt(7); # E(28)^3-E(28)^11-E(28)^15+E(28)^19-E(28)^23+E(28)^27 diff --git a/Task/First-class-functions/Haskell/first-class-functions.hs b/Task/First-class-functions/Haskell/first-class-functions.hs index 8f0bbeb344..13dd07fcc4 100644 --- a/Task/First-class-functions/Haskell/first-class-functions.hs +++ b/Task/First-class-functions/Haskell/first-class-functions.hs @@ -1,8 +1,18 @@ -Prelude> let cube x = x ^ 3 -Prelude> let croot x = x ** (1/3) -Prelude> let compose f g = \x -> f (g x) -- this is already implemented in Haskell as the "." operator -Prelude> -- we could have written "let compose f g x = f (g x)" but we show this for clarity -Prelude> let funclist = [sin, cos, cube] -Prelude> let funclisti = [asin, acos, croot] -Prelude> zipWith (\f inversef -> (compose inversef f) 0.5) funclist funclisti -[0.5,0.4999999999999999,0.5] +cube :: Floating a => a -> a +cube x = x ** 3.0 + +croot :: Floating a => a -> a +croot x = x ** (1/3) + +-- compose already exists in Haskell as the `.` operator +-- compose :: (a -> b) -> (b -> c) -> a -> c +-- compose f g = \x -> g (f x) + +funclist :: Floating a => [a -> a] +funclist = [sin, cos, cube ] + +invlist :: Floating a => [a -> a] +invlist = [asin, acos, croot] + +main :: IO () +main = print $ zipWith (\f i -> f . i $ 0.5) funclist invlist diff --git a/Task/First-class-functions/Oz/first-class-functions.oz b/Task/First-class-functions/Oz/first-class-functions-1.oz similarity index 74% rename from Task/First-class-functions/Oz/first-class-functions.oz rename to Task/First-class-functions/Oz/first-class-functions-1.oz index 70ca984c45..41b11a6763 100644 --- a/Task/First-class-functions/Oz/first-class-functions.oz +++ b/Task/First-class-functions/Oz/first-class-functions-1.oz @@ -1,12 +1,12 @@ declare fun {Compose F G} - fun {$ X} - {F {G X}} - end + fun {$ X} + {F {G X}} + end end - fun {Cube X} X*X*X end + fun {Cube X} {Number.pow X 3.0} end fun {CubeRoot X} {Number.pow X 1.0/3.0} end diff --git a/Task/First-class-functions/Oz/first-class-functions-2.oz b/Task/First-class-functions/Oz/first-class-functions-2.oz new file mode 100644 index 0000000000..05df319f58 --- /dev/null +++ b/Task/First-class-functions/Oz/first-class-functions-2.oz @@ -0,0 +1,3 @@ +0.5 +0.5 +0.5 diff --git a/Task/First-class-functions/REXX/first-class-functions.rexx b/Task/First-class-functions/REXX/first-class-functions.rexx index 0a3f0be5bd..220696e585 100644 --- a/Task/First-class-functions/REXX/first-class-functions.rexx +++ b/Task/First-class-functions/REXX/first-class-functions.rexx @@ -1,62 +1,59 @@ -/*REXX pgm demonstrating first-class functions (as a list of functions).*/ -A = 'd2x square sin cos' /*list of functions to test. */ -B = 'x2d sqrt Asin Acos' /*inverse functions of the above.*/ -w=digits() /*W=width of numbers to be shown.*/ - - do j=1 for words(A); say /*do functions: A,B collections.*/ - say center("number",w) center('function',3*w+1) center("inverse",4*w) - say copies("─",w) copies("─",3*w+1) copies("─",4*w) - if j<2 then call test j, 20 60 500 /*x2d,d2x; integers only.*/ - else call test j, 0 0.5 1 2 /*all else, floating pt. */ +/*REXX program demonstrates first─class functions (as a list of the names of functions).*/ +A = 'd2x square sin cos' /*a list of functions to demonstrate.*/ +B = 'x2d sqrt Asin Acos' /*the inverse functions of above list. */ +w=digits() /*W: width of numbers to be displayed.*/ + /* [↓] collection of A & B functions*/ + do j=1 for words(A); say; say /*step through the list; 2 blank lines*/ + say center("number",w) center('function', 3*w+1) center("inverse", 4*w) + say copies("─" ,w) copies("─", 3*w+1) copies("─", 4*w) + if j<2 then call test j, 20 60 500 /*functions X2D, D2X: integers only. */ + else call test j, 0 0.5 1 2 /*all other functions: floating point.*/ end /*j*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────subroutines (functions)───────────────────*/ -Acos: procedure; arg x; if x<-1|x>1 then call AcosErr; return .5*pi()-Asin(x) -r2r: return arg(1) // (2*pi()) /*normalize radians ──► 1 unit circle*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +Acos: procedure; parse arg x; if x<-1|x>1 then call AcosErr; return .5*pi()-Asin(x) +r2r: return arg(1) // (pi()*2) /*normalize radians ──► 1 unit circle*/ square: return arg(1) ** 2 +pi: pi=3.14159265358979323846264338327950288419716939937510582097494459230; return pi tellErr: say; say '*** error! ***'; say; say arg(1); say; exit 13 -tanErr: call tellErr 'tan('||x") causes division by zero, X=" ||x -AsinErr: call tellErr 'Asin(x), X must be in the range of -1 ──► +1, X=' ||x -AcosErr: call tellErr 'Acos(x), X must be in the range of -1 ──► +1, X=' ||x - -Asin: procedure; arg x; if x<-1 | x>1 then call AsinErr; s=x*x - if abs(x)>=.7 then return sign(x)*Acos(sqrt(1-s)); z=x; o=x; p=z - do j=2 by 2; o=o*s*(j-1)/j; z=z+o/(j+1); if z=p then leave; p=z; end - return z - -cos: procedure; parse arg x; x=r2r(x); a=abs(x); hpi=pi*.5 - numeric fuzz min(6,digits()-3); if a=pi() then return -1 - if a=hpi | a=hpi*3 then return 0 ; if a=pi()/3 then return .5 - if a=pi()*2/3 then return -.5; return .sinCos(1,1,-1) - -sin: procedure; arg x; x=r2r(x); numeric fuzz min(5,digits()-3) - if abs(x)=pi() then return 0; return .sinCos(x,x,1) - +tanErr: call tellErr 'tan(' || x") causes division by zero, X=" || x +AsinErr: call tellErr 'Asin(x), X must be in the range of -1 ──► +1, X=' || x +AcosErr: call tellErr 'Acos(x), X must be in the range of -1 ──► +1, X=' || x +/*──────────────────────────────────────────────────────────────────────────────────────*/ +Asin: procedure; parse arg x; if x<-1 | x>1 then call AsinErr; s=x*x + if abs(x)>=.7 then return sign(x)*Acos(sqrt(1-s)); z=x; o=x; p=z + do j=2 by 2; o=o*s*(j-1)/j; z=z+o/(j+1); if z=p then leave; p=z; end + return z +/*──────────────────────────────────────────────────────────────────────────────────────*/ +cos: procedure; parse arg x; x=r2r(x); a=abs(x); Hpi=pi*.5 + numeric fuzz min(6,digits()-3); if a=pi() then return -1 + if a=Hpi | a=Hpi*3 then return 0 ; if a=pi()/3 then return .5 + if a=pi()*2/3 then return -.5; return .sinCos(1,1,-1) +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sin: procedure; parse arg x; x=r2r(x); numeric fuzz min(5, digits()-3) + if abs(x)=pi() then return 0; return .sinCos(x,x,1) +/*──────────────────────────────────────────────────────────────────────────────────────*/ .sinCos: parse arg z 1 p,_,i; x=x*x - do k=2 by 2; _=-_*x/(k*(k+i));z=z+_;if z=p then leave;p=z;end; return z - -invoke: parse arg fn,v; q='"'; if datatype(v,'N') then q= - _=fn || '('q||v||q')'; interpret 'func='_; return func - -pi: pi=3.141592653589793238462643383279502884197169399375105820974944 ||, - 5923078164062862; return pi - -sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); i=; m.=9 - numeric digits 9; numeric form; h=d+6; if x<0 then do; x=-x; i='i'; end - parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_%2 - do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ - do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ - numeric digits d; return (g/1)i /*make complex if X < 0.*/ - -test: procedure expose A B w; parse arg fu,xList /*xList=bunch of #s*/ - do k=1 for words(xList); x=word(xList,k) - numeric digits digits()+5 /*higher precision.*/ - fun=word(A,fu); funV=invoke(fun,x) ; funInvoke=_ - inv=word(B,fu); invV=invoke(inv,funV); invInvoke=_ - numeric digits digits()-5 /*restore precision*/ - if datatype(funV,'N') then funV=funV/1 /*round to digits()*/ - if datatype(invV,'N') then invV=invV/1 /*round to digits()*/ - say center(x,w) right(funInvoke,2*w)'='left(funV,w), - right(invInvoke,3*w)'='left(invV,w) - end /*k*/ - return + do k=2 by 2; _=-_*x/(k*(k+i)); z=z+_; if z=p then leave; p=z; end; return z +/*──────────────────────────────────────────────────────────────────────────────────────*/ +invoke: parse arg fn,v; q='"'; if datatype(v,"N") then q= + _=fn || '('q || v || q")"; interpret 'func='_; return func +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); m.=9; numeric form + numeric digits; parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_%2 + h=d+6; do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ + do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ + numeric digits d; return g/1 +/*──────────────────────────────────────────────────────────────────────────────────────*/ +test: procedure expose A B w; parse arg fu,xList; d=digits() /*xList: numbers. */ + do k=1 for words(xList); x=word(xList, k) + numeric digits d+5 /*higher precision.*/ + fun=word(A, fu); funV=invoke(fun, x) ; fun@=_ + inv=word(B, fu); invV=invoke(inv, funV); inv@=_ + numeric digits d /*restore precision*/ + if datatype(funV, 'N') then funV=funV/1 /*round to digits()*/ + if datatype(invV, 'N') then invV=invV/1 /*round to digits()*/ + say center(x, w) right(fun@, 2*w)'='left(left('', funV>=0)funV, w), + right(inv@, 3*w)'='left(left('', invV>=0)invV, w) + end /*k*/ + return diff --git a/Task/First-class-functions/Rust/first-class-functions.rust b/Task/First-class-functions/Rust/first-class-functions.rust new file mode 100644 index 0000000000..ec500394f9 --- /dev/null +++ b/Task/First-class-functions/Rust/first-class-functions.rust @@ -0,0 +1,24 @@ +#![feature(conservative_impl_trait)] +fn main() { + let cube = |x: f64| x.powi(3); + let cube_root = |x: f64| x.powf(1.0 / 3.0); + + let flist : [&Fn(f64) -> f64; 3] = [&cube , &f64::sin , &f64::cos ]; + let invlist: [&Fn(f64) -> f64; 3] = [&cube_root, &f64::asin, &f64::acos]; + + let result = flist.iter() + .zip(&invlist) + .map(|(f,i)| compose(f,i)(0.5)) + .collect::>(); + + println!("{:?}", result); + +} + +fn compose<'a, F, G, T, U, V>(f: F, g: G) -> impl 'a + Fn(T) -> V + where F: 'a + Fn(T) -> U, + G: 'a + Fn(U) -> V, +{ + move |x| g(f(x)) + +} diff --git a/Task/First-class-functions/SuperCollider/first-class-functions.supercollider b/Task/First-class-functions/SuperCollider/first-class-functions.supercollider new file mode 100644 index 0000000000..75ca77dd5c --- /dev/null +++ b/Task/First-class-functions/SuperCollider/first-class-functions.supercollider @@ -0,0 +1,4 @@ +a = [sin(_), cos(_), { |x| x ** 3 }]; +b = [asin(_), acos(_), { |x| x ** (1/3) }]; +c = a.collect { |x, i| x <> b[i] }; +c.every { |x| x.(0.5) - 0.5 < 0.00001 } diff --git a/Task/Five-weekends/00DESCRIPTION b/Task/Five-weekends/00DESCRIPTION index 50d77bc3aa..e25d9bd7a9 100644 --- a/Task/Five-weekends/00DESCRIPTION +++ b/Task/Five-weekends/00DESCRIPTION @@ -1,19 +1,24 @@ The month of October in 2010 has five Fridays, five Saturdays, and five Sundays. -'''The task''' + +;Task: # Write a program to show all months that have this same characteristic of five full weekends from the year 1900 through 2100 (Gregorian calendar). # Show the ''number'' of months with this property (there should be 201). # Show at least the first and last five dates, in order. + '''Algorithm suggestions''' -*Count the number of Fridays, Saturdays, and Sundays in every month. -*Find all of the 31-day months that begin on Friday. +* Count the number of Fridays, Saturdays, and Sundays in every month. +* Find all of the 31-day months that begin on Friday. + '''Extra credit''' Count and/or show all of the years which do not have at least one five-weekend month (there should be 29). -;See also + +;Related tasks * [[Day of the week]] * [[Last Friday of each month]] * [[Find last sunday of each month]] +

    diff --git a/Task/Five-weekends/360-Assembly/five-weekends.360 b/Task/Five-weekends/360-Assembly/five-weekends.360 new file mode 100644 index 0000000000..6582c86410 --- /dev/null +++ b/Task/Five-weekends/360-Assembly/five-weekends.360 @@ -0,0 +1,100 @@ +* Five weekends 31/05/2016 +FIVEWEEK CSECT + USING FIVEWEEK,R13 base register + B 72(R15) skip savearea + DC 17F'0' savearea + STM R14,R12,12(R13) prolog + ST R13,4(R15) " + ST R15,8(R13) " + LR R13,R15 " + LM R10,R11,=AL8(0) nko=0; nok=0 + LH R6,Y1 y=y1 +LOOPY CH R6,Y2 do y=y1 to y2 + BH ELOOPY + MVI YF,X'00' yf=0 + LA R7,1 im=1 +LOOPIM C R7,=F'7' do im=1 to 7 + BH ELOOPIM + LR R1,R7 im + SLA R1,1 *2 (H) + LH R2,ML-2(R1) ml(im) + ST R2,M m=ml(im) + MVC D,=F'1' d=1 + L R4,M m + C R4,=F'2' if m<=2 + BH MSUP2 + L R8,M m + LA R8,12(R8) mw=m+12 + LR R9,R6 y + BCTR R9,0 yw=y-1 + B EMSUP2 +MSUP2 L R8,M mw=m + LR R9,R6 yw=y +EMSUP2 LR R4,R9 ym + SRDA R4,32 . + D R4,=F'100' yw/100 + ST R5,J j=yw/100 + ST R4,K k=yw//100 + LR R4,R8 mw + LA R4,1(R4) mw+1 + MH R4,=H'26' (mw+1)*26 + SRDA R4,32 . + D R4,=F'10' (mw+1)*26/10 + LR R2,R5 " + A R2,D d + A R2,K d+k + L R3,K k + SRA R3,2 k/4 + AR R2,R3 (mw+1)*26/10+k/4 + L R3,J j + SRA R3,2 j/4 + AR R2,R3 (mw+1)*26/10+k/4+j/4 + LA R5,5 5 + M R4,J 5*j + AR R2,R5 (mw+1)*26/10+k/4+j/4 + SRDA R2,32 . + D R2,=F'7' (d+(mw+1)*26/10+k+k/4+j/4+5*j)/7 + C R2,=F'6' if dow=friday + BNE NOFRIDAY + XDECO R6,XDEC y + MVC PG+0(4),XDEC+8 output y + LR R1,R7 im + MH R1,=H'3' *3 + LA R14,MN-3(R1) @mn(im) + MVC PG+5(3),0(R14) output mn(im) + XPRNT PG,8 print buffer + LA R11,1(R11) nok=nok+1 + MVI YF,X'01' yf=1 +NOFRIDAY LA R7,1(R7) im=im+1 + B LOOPIM +ELOOPIM L R4,YF yf + CLI YF,X'00' if yf=0 + BNE EYFNE0 + LA R10,1(R10) nko=nko+1 +EYFNE0 LA R6,1(R6) y=y+1 + B LOOPY +ELOOPY XDECO R11,XDEC nok + MVC PG+0(4),XDEC+8 output nok + MVC PG+4(12),=C' occurrences' + XPRNT PG,80 print buffer + XDECO R10,XDEC nko + MVC PG+0(4),XDEC+8 output nko + MVC PG+4(33),=C' years with no five weekend month' + XPRNT PG,80 print buffer + L R13,4(0,R13) epilog + LM R14,R12,12(R13) " + XR R15,R15 " + BR R14 exit +Y1 DC H'1900' year start +Y2 DC H'2100' year stop +ML DC H'1',H'3',H'5',H'7',H'8',H'10',H'12' +MN DC C'jan',C'mar',C'may',C'jul',C'aug',C'oct',C'dec' +YF DS X year flag +M DS F month +D DS F day +J DS F j=yw/100 +K DS F j=mod(yw,100) +PG DC CL80'....-' buffer +XDEC DS CL12 temp for XDECO + YREGS + END FIVEWEEK diff --git a/Task/Five-weekends/AppleScript/five-weekends.applescript b/Task/Five-weekends/AppleScript/five-weekends-1.applescript similarity index 100% rename from Task/Five-weekends/AppleScript/five-weekends.applescript rename to Task/Five-weekends/AppleScript/five-weekends-1.applescript diff --git a/Task/Five-weekends/AppleScript/five-weekends-2.applescript b/Task/Five-weekends/AppleScript/five-weekends-2.applescript new file mode 100644 index 0000000000..8c621b45dd --- /dev/null +++ b/Task/Five-weekends/AppleScript/five-weekends-2.applescript @@ -0,0 +1,145 @@ +on run + + fiveWeekends(1900, 2100) + +end run + +-- fiveWeekends :: Int -> Int -> Record +on fiveWeekends(fromYear, toYear) + set lstYears to range(fromYear, toYear) + + -- yearMonthString :: (Int, Int) -> String + script yearMonthString + on lambda(lstYearMonth) + ((item 1 of lstYearMonth) as string) & " " & ¬ + item (item 2 of lstYearMonth) of ¬ + {"January", "", "March", "", "May", "", ¬ + "July", "August", "", "October", "", "December"} + end lambda + end script + + -- addLongMonthsOfYear :: [(Int, Int)] -> [(Int, Int)] + script addLongMonthsOfYear + on lambda(lstYearMonth, intYear) + + -- yearMonth :: Int -> (Int, Int) + script yearMonth + on lambda(intMonth) + return {intYear, intMonth} + end lambda + end script + + lstYearMonth & ¬ + map(yearMonth, my longMonthsStartingFriday(intYear)) + end lambda + end script + + -- leanYear :: Int -> Bool + script leanYear + on lambda(intYear) + 0 = length of longMonthsStartingFriday(intYear) + end lambda + end script + + set lstFullMonths to map(yearMonthString, ¬ + foldl(addLongMonthsOfYear, {}, lstYears)) + + set lstLeanYears to filter(leanYear, lstYears) + + return {{|number|:length of lstFullMonths}, ¬ + {firstFive:(items 1 thru 5 of lstFullMonths)}, ¬ + {lastFive:(items -5 thru -1 of lstFullMonths)}, ¬ + {leanYearCount:length of lstLeanYears}, ¬ + {leanYears:lstLeanYears}} +end fiveWeekends + + +-- longMonthsStartingFriday :: Int -> [Int] +on longMonthsStartingFriday(intYear) + + -- startIsFriday :: Int -> Bool + script startIsFriday + on lambda(iMonth) + weekday of calendarDate(intYear, iMonth, 1) is Friday + end lambda + end script + + filter(startIsFriday, [1, 3, 5, 7, 8, 10, 12]) +end longMonthsStartingFriday + + +--------------------------------------------------------------------------- + +-- GENERIC FUNCTIONS + +-- calendarDate :: Int -> Int -> Int -> Date +on calendarDate(intYear, intMonth, intDay) + tell (current date) + set {its year, its month, its day, its time} to ¬ + {intYear, intMonth, intDay, 0} + return it + end tell +end calendarDate + +-- 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 + +-- 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 + +-- 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 + +-- range :: Int -> Int -> [Int] +on range(m, n) + if n < m then + set d to -1 + else + set d to 1 + end if + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range + +-- 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 diff --git a/Task/Five-weekends/AppleScript/five-weekends-3.applescript b/Task/Five-weekends/AppleScript/five-weekends-3.applescript new file mode 100644 index 0000000000..0a75de438c --- /dev/null +++ b/Task/Five-weekends/AppleScript/five-weekends-3.applescript @@ -0,0 +1,7 @@ +{{|number|:201}, +{firstFive:{"1901 March", "1902 August", "1903 May", "1904 January", "1904 July"}}, +{lastFive:{"2097 March", "2098 August", "2099 May", "2100 January", "2100 October"}}, +{leanYearCount:29}, +{leanYears:{1900, 1906, 1917, 1923, 1928, 1934, 1945, 1951, 1956, 1962, 1973, 1979, +1984, 1990, 2001, 2007, 2012, 2018, 2029, 2035, 2040, 2046, 2057, 2063, 2068, 2074, +2085, 2091, 2096}}} diff --git a/Task/Five-weekends/COBOL/five-weekends.cobol b/Task/Five-weekends/COBOL/five-weekends.cobol new file mode 100644 index 0000000000..3247c7ba46 --- /dev/null +++ b/Task/Five-weekends/COBOL/five-weekends.cobol @@ -0,0 +1,53 @@ + program-id. five-we. + data division. + working-storage section. + 1 wk binary. + 2 int-date pic 9(8). + 2 dow pic 9(4). + 2 friday pic 9(4) value 5. + 2 mo-sub pic 9(4). + 2 months-with-5 pic 9(4) value 0. + 2 years-no-5 pic 9(4) value 0. + 2 5-we-flag pic 9(4) value 0. + 88 5-we-true value 1 when false 0. + 1 31-day-mos pic 9(14) value 01030507081012. + 1 31-day-table redefines 31-day-mos. + 2 mo-no occurs 7 pic 99. + 1 cal-date. + 2 yr pic 9(4). + 2 mo pic 9(2). + 2 da pic 9(2) value 1. + procedure division. + perform varying yr from 1900 by 1 + until yr > 2100 + set 5-we-true to false + perform varying mo-sub from 1 by 1 + until mo-sub > 7 + move mo-no (mo-sub) to mo + compute int-date = function + integer-of-date (function numval (cal-date)) + compute dow = function mod + ((int-date - 1) 7) + 1 + if dow = friday + perform output-date + add 1 to months-with-5 + set 5-we-true to true + end-if + end-perform + if not 5-we-true + add 1 to years-no-5 + end-if + end-perform + perform output-counts + stop run + . + + output-counts. + display "Months with 5 weekends: " months-with-5 + display "Years without 5 weekends: " years-no-5 + . + + output-date. + display yr "-" mo + . + end program five-we. diff --git a/Task/Five-weekends/Common-Lisp/five-weekends.lisp b/Task/Five-weekends/Common-Lisp/five-weekends.lisp new file mode 100644 index 0000000000..7356ccb0cb --- /dev/null +++ b/Task/Five-weekends/Common-Lisp/five-weekends.lisp @@ -0,0 +1,46 @@ +;; Given a date, get the day of the week. Adapted from +;; http://lispcookbook.github.io/cl-cookbook/dates_and_times.html + +(defun day-of-week (day month year) + (nth-value + 6 + (decode-universal-time + (encode-universal-time 0 0 0 day month year 0) + 0))) + +(defparameter *long-months* '(1 3 5 7 8 10 12)) + +(defun sundayp (day month year) + (= (day-of-week day month year) 6)) + +(defun ends-on-sunday-p (month year) + (sundayp 31 month year)) + +;; We use the "long month that ends on Sunday" rule. +(defun has-five-weekends-p (month year) + (and (member month *long-months*) + (ends-on-sunday-p month year))) + +;; For the extra credit problem. +(defun has-at-least-one-five-weekend-month-p (year) + (let ((flag nil)) + (loop for month in *long-months* do + (if (has-five-weekends-p month year) + (setf flag t))) + flag)) + +(defun solve-it () + (let ((good-months '()) + (bad-years 0)) + (loop for year from 1900 to 2100 do + ;; First form in the PROGN is for the extra credit. + (progn (unless (has-at-least-one-five-weekend-month-p year) + (incf bad-years)) + (loop for month in *long-months* do + (when (has-five-weekends-p month year) + (push (list month year) good-months))))) + (let ((len (length good-months))) + (format t "~A months have five weekends.~%" len) + (format t "First 5 months: ~A~%" (subseq good-months (- len 5) len)) + (format t "Last 5 months: ~A~%" (subseq good-months 0 5)) + (format t "Years without a five-weekend month: ~A~%" bad-years)))) diff --git a/Task/Five-weekends/Java/five-weekends.java b/Task/Five-weekends/Java/five-weekends.java index bbdbaa3f93..122ae5a19c 100644 --- a/Task/Five-weekends/Java/five-weekends.java +++ b/Task/Five-weekends/Java/five-weekends.java @@ -3,7 +3,6 @@ import java.util.GregorianCalendar; public class FiveFSS { private static boolean[] years = new boolean[201]; - //dreizig tage habt september... private static int[] month31 = {Calendar.JANUARY, Calendar.MARCH, Calendar.MAY, Calendar.JULY, Calendar.AUGUST, Calendar.OCTOBER, Calendar.DECEMBER}; diff --git a/Task/Five-weekends/JavaScript/five-weekends-3.js b/Task/Five-weekends/JavaScript/five-weekends-3.js new file mode 100644 index 0000000000..e38d24fccd --- /dev/null +++ b/Task/Five-weekends/JavaScript/five-weekends-3.js @@ -0,0 +1,57 @@ +(function () { + 'use strict'; + + + // longMonthsStartingFriday :: Int -> Int + function longMonthsStartingFriday(y) { + return [0, 2, 4, 6, 7, 9, 11] + .filter(function (m) { + return (new Date(Date.UTC(y, m, 1))) + .getDay() === 5; + }); + } + + + // range :: Int -> Int -> [Int] + function range(m, n) { + return Array.apply(null, Array(n - m + 1)) + .map(function (x, i) { + return m + i; + }); + } + + var lstNames = [ + 'January', '', 'March', '', 'May', '', + 'July', 'August', '', 'October', '', 'December' + ], + + lstYears = range(1900, 2100), + + lstFullMonths = lstYears + .reduce(function (a, y) { + var strYear = y.toString(); + + return a.concat( + longMonthsStartingFriday(y) + .map(function (m) { + return strYear + ' ' + lstNames[m]; + }) + ); + }, []), + + lstLeanYears = lstYears + .filter(function (y) { + return longMonthsStartingFriday(y) + .length === 0; + }); + + return JSON.stringify({ + number: lstFullMonths.length, + firstFive: lstFullMonths.slice(0, 5), + lastFive: lstFullMonths.slice(-5), + leanYearCount: lstLeanYears.length + }, + null, 2 + ); + +})(); diff --git a/Task/Five-weekends/Lua/five-weekends.lua b/Task/Five-weekends/Lua/five-weekends.lua new file mode 100644 index 0000000000..dd050bb7a6 --- /dev/null +++ b/Task/Five-weekends/Lua/five-weekends.lua @@ -0,0 +1,30 @@ +local months={"JAN","MAR","MAY","JUL","AUG","OCT","DEC"} +local daysPerMonth={31+28,31+30,31+30,31,31+30,31+30,0} + +function find5weMonths(year) + local list={} + local startday=((year-1)*365+math.floor((year-1)/4)-math.floor((year-1)/100)+math.floor((year-1)/400))%7 + + for i,v in ipairs(daysPerMonth) do + if startday==4 then list[#list+1]=months[i] end + if i==1 and year%4==0 and year%100~=0 or year%400==0 then + startday=startday+1 + end + startday=(startday+v)%7 + end + return list +end + +local cnt_months=0 +local cnt_no5we=0 + +for y=1900,2100 do + local list=find5weMonths(y) + cnt_months=cnt_months+#list + if #list==0 then + cnt_no5we=cnt_no5we+1 + end + print(y.." "..#list..": "..table.concat(list,", ")) +end +print("Months with 5 weekends: ",cnt_months) +print("Years without 5 weekends in the same month:",cnt_no5we) diff --git a/Task/Five-weekends/NewLISP/five-weekends.newlisp b/Task/Five-weekends/NewLISP/five-weekends.newlisp new file mode 100644 index 0000000000..e9c30b507c --- /dev/null +++ b/Task/Five-weekends/NewLISP/five-weekends.newlisp @@ -0,0 +1,77 @@ +#!/usr/local/bin/newlisp + +(context 'KR) + +(define (Kraitchik year month day) + ; See https://en.wikipedia.org/wiki/Determination_of_the_day_of_the_week#Kraitchik.27s_variation + ; Function adapted for specific task (not for general usage). + (if (or (= 1 month) (= 2 month)) + (dec year) + ) + ;- - - - + (setf m-table '(_ 1 4 3 6 1 4 6 2 5 0 3 5)) ; - - - First element of list is dummy! + (setf m (m-table month)) + ;- - - - + (setf c-table '(0 5 3 1)) + (setf century%4 (mod (int (slice (string year) 0 2)) 4)) + (setf c (c-table century%4)) + ;- - - - + (setf yy* (slice (string year) -2)) + (if (= "0" (yy* 0)) + (setf yy* (yy* 1)) + ) + (setf yy (int yy*)) + (setf y (mod (+ (/ yy 4) yy) 7)) + ;- - - - + (setf dow-table '(6 0 1 2 3 4 5)) + (dow-table (mod (+ day m c y) 7)) +) + +(context 'MAIN) + +(setf Fives 0) +(setf NotFives 0) +(setf Report '()) +(setf months-table '((1 "Jan") (3 "Mar") (5 "May") (7 "Jul") (8 "Aug") (10 "Oct") (12 "Dec"))) + +(for (y 1900 2100) + (setf FivesFound 0) + (setf Names "") + (dolist (m '(1 3 5 7 8 10 12)) + (setf Dow (KR:Kraitchik y m 1)) + (if (= 5 Dow) + (begin + (++ FivesFound) + (setf Names (string Names " " (lookup m months-table))) + ) + ) + ) + + (if (zero? FivesFound) + (++ NotFives) + (begin + (setf Report (append Report (list (list y FivesFound (string "(" Names " )"))))) + (setf Fives (+ Fives FivesFound)) + ) + ) +) + + +;- - - - Display all report data +;(dolist (x Report) +; (println (x 0) ": " (x 1) " " (x 2)) +;) + + +;- - - - Display only first five and last five records +(dolist (x (slice Report 0 5)) + (println (x 0) ": " (x 1) " " (x 2)) +) +(println "...") +(dolist (x (slice Report -5)) + (println (x 0) ": " (x 1) " " (x 2)) +) + +(println "\nTotal months with five weekends: " Fives) +(println "Years with no five weekends months: " NotFives) +(exit) diff --git a/Task/Five-weekends/REXX/five-weekends-1.rexx b/Task/Five-weekends/REXX/five-weekends-1.rexx index 651ac6ceea..43a66812c8 100644 --- a/Task/Five-weekends/REXX/five-weekends-1.rexx +++ b/Task/Five-weekends/REXX/five-weekends-1.rexx @@ -1,38 +1,31 @@ -/*REXX program finds months with 5 weekends in them (given a date range)*/ -month. =31 /*month days; Feb. is done later.*/ -month.4=30; month.6=30; month.9=30; month.11=30 /*30-day months*/ -parse arg yStart yStop . /*get the "start" & "stop" years.*/ -if yStart=='' then yStart=1900 /*if not specified, use default. */ -if yStop =='' then yStop =2100 /* " " " " " */ -years=yStop-yStart+1 /*calculate the # of yrs in range*/ -haps=0 /*num of five weekends happenings*/ -!.=0 /*if a year has any five-weekends*/ - do y=yStart to yStop /*process the years specified. */ - do m=1 for 12; wd.=0 /*process each month, each year. */ - if m==2 then month.2=28+leapyear(y) /*handle #days in Feb*/ - do d=1 for month.m; dat_=y"-"right(m,2,0)'-'right(d,2,0) +/*REXX program finds months that contain five weekends (given a date range). */ +month. =31; month.2=0 /*month days; February is skipped. */ +month.4=30; month.6=30; month.9=30; month.11=30 /*all the months with thirty-days. */ +parse arg yStart yStop . /*get the "start" and "stop" years.*/ +if yStart=='' | yStart=="," then yStart= 1900 /*Not specified? Then use the default.*/ +if yStop =='' | yStop =="," then yStop = 2100 /* " " " " " " */ +years=yStop - yStart + 1 /*calculate the number of yrs in range.*/ +haps=0 /*number of five weekends happenings. */ +!.=0; @5w= 'five-weekend months' /*flag if a year has any five-weekends.*/ + do y=yStart to yStop /*process the years specified. */ + do m=1 for 12; wd.=0 /*process each month and also each year*/ + do d=1 for month.m; dat_= y"-"right(m,2,0)'-'right(d,2,0) parse upper value date('W', dat_, "I") with ? 3 - wd.?=wd.?+1 /*? is the 1st 2 chars of weekday*/ - end /*d*/ /*WD.su = # of Sundays in a month*/ - if wd.su\==5 | wd.fr\==5 | wd.sa\==5 then iterate /*5 W.E.s?*/ + wd.?=wd.?+1 /*? is the first two chars of weekday.*/ + end /*d*/ /*WD.su = number of Sundays in a month.*/ + if wd.su\==5 | wd.fr\==5 | wd.sa\==5 then iterate /*five weekends ?*/ say 'There are five weekends in' y date('M', dat_, "I") - haps=haps+1; !.y=1 /*bump ctr; indicate yr has 5 WEs*/ + haps=haps+1; !.y=1 /*bump counter; indicate yr has 5 WE's.*/ end /*m*/ end /*y*/ say -say 'There were ' haps " occurrence"s(haps) 'of five-weekend months in year's(years) yStart'──►'yStop +say "There were " haps ' occurrence's(haps) "of" @5w 'in year's(years) yStart"──►"yStop say; #=0 - do y=yStart to yStop; if !.y then iterate /*skip if OK*/ - #=#+1 - say 'Year ' y " doesn't have any five-weekend months." + do y=yStart to yStop; if !.y then iterate /*skip if OK.*/ + #=#+1; say 'Year ' y " doesn't have any" @5wem'.' end /*y*/ say -say "There are " # ' year's(#) "that haven't any five─weekend months in year"s(years) yStart'──►'yStop -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────LEAPYEAR subroutine─────────────────*/ -leapyear: procedure; parse arg y /*year could be: Y, YY, YYY, YYYY*/ -if length(y)==2 then y=left(right(date(),4),2)y /*adjust for YY year.*/ -if y//4\==0 then return 0 /* not ÷ by 4? Not a leap year.*/ -return y//100\==0 | y//400==0 /*apply 100 and 400 year rule. */ -/*──────────────────────────────────S subroutine────────────────────────*/ -s: if arg(1)==1 then return arg(3); return word(arg(2) 's',1) /*plural*/ +say "There are " # ' year's(#) "that haven't any" @5w 'in year's(years) yStart'──►'yStop +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +s: if arg(1)==1 then return arg(3); return word(arg(2) 's',1) /*pluralizer.*/ diff --git a/Task/Five-weekends/REXX/five-weekends-2.rexx b/Task/Five-weekends/REXX/five-weekends-2.rexx index 7c37644984..b0aa5953b7 100644 --- a/Task/Five-weekends/REXX/five-weekends-2.rexx +++ b/Task/Five-weekends/REXX/five-weekends-2.rexx @@ -1,43 +1,37 @@ -/*REXX program finds months with 5 weekends in them (given a date range)*/ -month. =31 /*month days; Feb. is done later.*/ -month.4=30; month.6=30; month.9=30; month.11=30 /*30-day months*/ +/*REXX program finds months that contain five weekends (given a date range). */ +month. =31; month,2=0 /*month days; February is skipped. */ +month.4=30; month.6=30; month.9=30; month.11=30 /*all the months with thirty-days. */ @months='January February March April May June July August September October November December' -parse arg yStart yStop . /*get the "start" & "stop" years.*/ -if yStart=='' then yStart=1900 /*if not specified, use default. */ -if yStop =='' then yStop =2100 /* " " " " " */ -years=yStop-yStart+1 /*calculate the # of yrs in range*/ -haps=0 /*num of five weekends happenings*/ -!.=0 /*if a year has any five-weekends*/ - do y=yStart to yStop /*process the years specified. */ - do m=1 for 12; wd.=0 /*process each month in each year*/ - if m==2 then month.2=28+leapyear(y) /*handle # days in Feb.*/ +parse arg yStart yStop . /*get the "start" and "stop" years.*/ +if yStart=='' | yStart=="," then yStart= 1900 /*Not specified? Then use the default.*/ +if yStop =='' | yStop =="," then yStop = 2100 /* " " " " " " */ +years=yStop - yStart + 1 /*calculate the number of yrs in range.*/ +haps=0 /*number of five weekends happenings. */ +!.=0; @5w= 'five-weekend months' /*flag if a year has any five-weekends.*/ + do y=yStart to yStop /*process the years specified. */ + do m=1 for 12; wd.=0 /*process each month and also each year*/ do d=1 for month.m - ?=dow(m,d,y) /*get day-of-week for mm/dd/yyyy.*/ - wd.?=wd.?+1 /*?: 1=Sun, 2=Mon, ∙∙∙ 7=Sat */ + ?=dow(m,d,y) /*get the day-of-week for mm/dd/yyyy*/ + wd.?=wd.?+1 /*?: 1=Sun, 2=Mon, 3=Tue ∙∙∙ 7=Sat.*/ end /*d*/ - if wd.1\==5 | wd.6\==5 | wd.7\==5 then iterate /*5 WEs ? */ - say 'There are five weekends in' y word(@months,m) - haps=haps+1; !.y=1 /*bump ctr; indicate yr has 5 WEs*/ - end /*m*/ + if wd.1\==5 | wd.6\==5 | wd.7\==5 then iterate /*not a weekend ? */ + say 'There are five weekends in' y word(@months, m) + haps=haps+1; !.y=1 /*bump counter; indicate yr has 5 WE's.*/ + end /*m*/ end /*y*/ say -say 'There were ' haps " occurrence"s(haps) 'of five-weekend months in year's(years) yStart'──►'yStop +say 'There were ' haps " occurrence"s(haps) 'of' @5w "in year"s(years) yStart'──►'yStop #=0; say - do y=yStart to yStop; if !.y then iterate /*skip if OK*/ + do y=yStart to yStop; if !.y then iterate /*skip if OK.*/ #=#+1 say 'Year ' y " doesn't have any five-weekend months." end /*y*/ say -say "There are " # ' year's(#) "that haven't any five─weekend months in year"s(years) yStart'──►'yStop -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────DOW─────────────────────────────────*/ -dow: procedure; parse arg m,d,y; if m<3 then do; m=m+12; y=y-1; end -yL=left(y,2); yr=right(y,2); w=(d+(m+1)*26%10+yr+yr%4+yL%4+5*yL) // 7 -if w==0 then w=7; return w /*Sunday=1, Monday=2, ... Saturday=7*/ -/*──────────────────────────────────LEAPYEAR subroutine─────────────────*/ -leapyear: procedure; parse arg y /*year could be: Y, YY, YYY, YYYY*/ -if length(y)==2 then y=left(right(date(),4),2)y /*adjust for YY year.*/ -if y//4\==0 then return 0 /* not ÷ by 4? Not a leap year.*/ -return y//100\==0 | y//400==0 /*apply 100 and 400 year rule. */ -/*──────────────────────────────────S subroutine────────────────────────*/ -s: if arg(1)==1 then return arg(3); return word(arg(2) 's',1) /*plural*/ +say "There are " # ' year's(#) "that haven't any" @5w 'in year's(years) yStart'──►'yStop +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +dow: procedure; parse arg m,d,y; if m<3 then do; m=m+12; y=y-1; end + yL=left(y,2); yr=right(y,2); w=(d+(m+1)*26%10+yr+yr%4+yL%4+5*yL) // 7 + if w==0 then w=7; return w /*Sunday=1, Monday=2, ... Saturday=7 */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +s: if arg(1)==1 then return arg(3); return word(arg(2) 's',1) /*pluralizer.*/ diff --git a/Task/Five-weekends/REXX/five-weekends-4.rexx b/Task/Five-weekends/REXX/five-weekends-4.rexx index c3b1f96107..26d8716a0e 100644 --- a/Task/Five-weekends/REXX/five-weekends-4.rexx +++ b/Task/Five-weekends/REXX/five-weekends-4.rexx @@ -1,28 +1,30 @@ -/*REXX program finds months with 5 weekends in them (given a date range)*/ -month. =31 /*month days; Feb. is skipped. */ -month.4=30; month.6=30; month.9=30; month.11=30 /*30-day months*/ -yStart=1900; yStop=2100 /*define start and stop years. */ -haps=0 /*num of five weekends happenings*/ -!.=0 /*if a year has any five-weekends*/ - do y=yStart to yStop /*process the years specified. */ - do m=1 for 12; wd.=0 /*each month except Feb, each yr.*/ - if m==2 then iterate /*if month is February, skip it. */ - do d=1 for month.m; dat_=y"-"right(m,2,0)'-'right(d,2,0) +/*REXX program finds months that contain five weekends (given a date range). */ +month. =31; month.2=0 /*month days; February is skipped. */ +month.4=30; month.6=30; month.9=30; month.11=30 /*all the months with thirty-days. */ +parse arg yStart yStop . /*get the "start" and "stop" years.*/ +if yStart=='' | yStart=="," then yStart= 1900 /*Not specified? Then use the default.*/ +if yStop =='' | yStop =="," then yStop = 2100 /* " " " " " " */ +years=yStop - yStart + 1 /*calculate the number of yrs in range.*/ +haps=0 /*number of five weekends happenings. */ +!.=0; @5w= 'five-weekend months' /*flag if a year has any five-weekends.*/ + do y=yStart to yStop /*process the years specified. */ + do m=1 for 12; wd.=0 /*process each month and also each year*/ + do d=1 for month.m; dat_= y"-"right(m, 2, 0)'-'right(d, 2, 0) parse upper value date('W', dat_, "I") with ? 3 - wd.?=wd.?+1 /*? is 1st 2 chars of tge weekday*/ - end /*d*/ /*WD.su=# of Sundays in the month*/ - if wd.su\==5 | wd.fr\==5 | wd.sa\==5 then iterate /*5 W.E.s?*/ - say 'There are five weekends in' y date('M', dat_, "I") - haps=haps+1; !.y=1 /*bump ctr; indicate yr has 5 WEs*/ + wd.?=wd.?+1 /*?: 1=Sun, 2=Mon, 3=Tue ∙∙∙ 7=Sat.*/ + end /*d*/ /*WD.su=number of Sundays in the month.*/ + if wd.su\==5 | wd.fr\==5 | wd.sa\==5 then iterate /*is this a weekend ? */ + say 'There are five weekends in' y date('M', dat_, "I") + haps=haps+1; !.y=1 /*bump counter; indicate yr has 5 WE's.*/ end /*m*/ end /*y*/ say -say 'There were ' haps " occurrences of five-weekend months in years" yStart'──►'yStop; say -#=0 - do y=yStart to yStop; if !.y then iterate /*skip if OK*/ - #=#+1 - say 'Year ' y " doesn't have any five-weekend months." - end /*y*/ +say 'There were ' haps " occurrence"s(haps) 'of' @5w "in year"s(years) yStart'──►'yStop +#=0; say + do y=yStart to yStop; if !.y then iterate /*skip if OK.*/ + #=#+1 + say 'Year ' y " doesn't have any five-weekend months." + end /*y*/ say -say "There are " # " years that haven't any five─weekend months in years" yStart'──►'yStop - /*stick a fork in it, we're done.*/ +say "There are " # ' year's(#) "that haven't any" @5w 'in year's(years) yStart'──►'yStop + /*stick a fork in it, we're all done. */ diff --git a/Task/Five-weekends/REXX/five-weekends-5.rexx b/Task/Five-weekends/REXX/five-weekends-5.rexx index 5466518fe2..022c8e66ae 100644 --- a/Task/Five-weekends/REXX/five-weekends-5.rexx +++ b/Task/Five-weekends/REXX/five-weekends-5.rexx @@ -1,23 +1,27 @@ -/*REXX program finds months with 5 weekends in them (given a date range)*/ -month.=31; yStart=1900; yStop=2100 /*month days; range of years. */ -month.2=0; month.4=0; month.6=0; month.9=0; month.11=0 /*¬31 day months*/ -haps=0 /*num of five weekends happenings*/ -!.=0 /*if a year has any five-weekends*/ - do y=yStart to yStop /*process the years specified. */ - do m=1 for 12; if month.m==0 then iterate /*test 31-day mons*/ - dat_=y"-"right(m,2,0)'-01' /*get date in the proper format. */ - if left(date('W',dat_,"I"),2)\=='Fr' then iterate /*Friday?*/ - say 'There are five weekends in' y date('M', dat_, "I") - haps=haps+1; !.y=1 /*bump ctr; indicate yr has 5 WEs*/ - end /*m*/ - end /*y*/ +/*REXX program finds months that contain five weekends (given a date range). */ +month. =31 /*days in "all" the months. */ +month.2=0; month.4=0; month.6=0; month.9=0; month.11=0 /*not 31 day months.*/ +month.4=30; month.6=30; month.9=30; month.11=30 /*all the months with thirty-days. */ +parse arg yStart yStop . /*get the "start" and "stop" years.*/ +if yStart=='' | yStart=="," then yStart= 1900 /*Not specified? Then use the default.*/ +if yStop =='' | yStop =="," then yStop = 2100 /* " " " " " " */ +years=yStop - yStart + 1 /*calculate the number of yrs in range.*/ +haps=0 /*number of five weekends happenings. */ +!.=0; @5w= 'five-weekend months' /*flag if a year has any five-weekends.*/ + do y=yStart to yStop /*process the years specified. */ + do m=1 for 12; if month.m==0 then iterate /*only test 31-day months.*/ + dat_= y"-"right(m,2,0)'-01' /*get the date in the desired format. */ + if left(date('W',dat_,"I"),2)\=='Fr' then iterate /*isn't not a Friday? */ + say 'There are five weekends in' y date('M', dat_, "I") + haps=haps+1; !.y=1 /*bump counter; indicate yr has 5 WE's.*/ + end /*m*/ + end /*y*/ say -say 'There were ' haps " occurrences of five-weekend months in years" yStart'──►'yStop; say -#=0 - do y=yStart to yStop; if !.y then iterate /*skip if OK*/ - #=#+1 - say 'Year ' y " doesn't have any five-weekend months." - end /*y*/ +say 'There were ' haps " occurrence"s(haps) 'of' @5w "in year"s(years) yStart'──►'yStop +#=0; say + do y=yStart to yStop; if !.y then iterate /*skip if OK.*/ + #=#+1 + say 'Year ' y " doesn't have any five-weekend months." + end /*y*/ say -say "There are " # " years that haven't any five─weekend months in years" yStart'──►'yStop - /*stick a fork in it, we're done.*/ +say "There are " # ' year's(#) "that haven't any" @5w 'in year's(years) yStart'──►'yStop diff --git a/Task/FizzBuzz/00DESCRIPTION b/Task/FizzBuzz/00DESCRIPTION index a9e8e1af66..1c7f2aa982 100644 --- a/Task/FizzBuzz/00DESCRIPTION +++ b/Task/FizzBuzz/00DESCRIPTION @@ -1,8 +1,17 @@ -Write a program that prints the integers from 1 to 100. +;Task: +Write a program that prints the integers from   '''1'''   to   '''100'''   (inclusive). -But for multiples of three print "Fizz" instead of the number, -and for the multiples of five print "Buzz".
    -For numbers which are multiples of both three and five print "FizzBuzz". [http://weblog.raganwald.com/2007/01/dont-overthink-fizzbuzz.html] -FizzBuzz was presented as the lowest level of comprehension -required to illustrate adequacy. [http://blog.codinghorror.com/fizzbuzz-the-programmers-stairway-to-heaven/] +But: +:*   for multiples of three,   print   '''Fizz'''     (instead of the number) +:*   for multiples of five,   print   '''Buzz'''     (instead of the number) +:*   for multiples of both three and five,   print   '''FizzBuzz'''     (instead of the number) + + +The   ''FizzBuzz''   problem was presented as the lowest level of comprehension required to illustrate adequacy. + + +;Also see: +*   (a blog)   [http://weblog.raganwald.com/2007/01/dont-overthink-fizzbuzz.html dont-overthink-fizzbuzz] +*   (a blog)   [http://blog.codinghorror.com/fizzbuzz-the-programmers-stairway-to-heaven/ fizzbuzz-the-programmers-stairway-to-heaven] +

    diff --git a/Task/FizzBuzz/AppleScript/fizzbuzz.applescript b/Task/FizzBuzz/AppleScript/fizzbuzz-1.applescript similarity index 100% rename from Task/FizzBuzz/AppleScript/fizzbuzz.applescript rename to Task/FizzBuzz/AppleScript/fizzbuzz-1.applescript diff --git a/Task/FizzBuzz/AppleScript/fizzbuzz-2.applescript b/Task/FizzBuzz/AppleScript/fizzbuzz-2.applescript new file mode 100644 index 0000000000..1df0778bd0 --- /dev/null +++ b/Task/FizzBuzz/AppleScript/fizzbuzz-2.applescript @@ -0,0 +1,88 @@ +on run + + intercalate(linefeed, ¬ + map(fizzBuzz, range(1, 100))) + +end run + + +-- fizzBuzz :: Int -> String +on fizzBuzz(x) + caseOf(x, [[my fizzAndBuzz, "FizzBuzz"], ¬ + [my fizz, "Fizz"], ¬ + [my buzz, "Buzz"]], ¬ + x as string) +end fizzBuzz + +-- fizzAndBuzz :: Int -> Bool +on fizzAndBuzz(n) + n mod 15 = 0 +end fizzAndBuzz + +-- fizz :: Int -> Bool +on fizz(n) + n mod 3 = 0 +end fizz + +-- buzz :: Int -> Bool +on buzz(n) + n mod 5 = 0 +end buzz + + +-- GENERIC LIBRARY FUNCTIONS + +-- caseOf :: a -> [(predicate, b)] -> Maybe b -> Maybe b +on caseOf(e, lstPV, default) + repeat with lstCase in lstPV + set {p, v} to contents of lstCase + if mReturn(p)'s lambda(e) then return v + end repeat + return default +end caseOf + +-- intercalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate + +-- 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 + +-- 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 + +-- range :: Int -> Int -> [Int] +on range(m, n) + if n < m then + set d to -1 + else + set d to 1 + end if + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range diff --git a/Task/FizzBuzz/AutoIt/fizzbuzz.autoit b/Task/FizzBuzz/AutoIt/fizzbuzz-1.autoit similarity index 100% rename from Task/FizzBuzz/AutoIt/fizzbuzz.autoit rename to Task/FizzBuzz/AutoIt/fizzbuzz-1.autoit diff --git a/Task/FizzBuzz/AutoIt/fizzbuzz-2.autoit b/Task/FizzBuzz/AutoIt/fizzbuzz-2.autoit new file mode 100644 index 0000000000..a0f2faf064 --- /dev/null +++ b/Task/FizzBuzz/AutoIt/fizzbuzz-2.autoit @@ -0,0 +1,25 @@ +#include + +; uncomment how you want to do the output +Func Out($Msg) + ConsoleWrite($Msg & @CRLF) + +;~ FileWriteLine("FizzBuzz.Log", $Msg) + +;~ $Btn = MsgBox($MB_OKCANCEL + $MB_ICONINFORMATION, "FizzBuzz", $Msg) +;~ If $Btn > 1 Then Exit ; Pressing 'Cancel'-button aborts the program +EndFunc ;==>Out + +Out("# FizzBuzz:") +For $i = 1 To 100 + If Mod($i, 15) = 0 Then + Out("FizzBuzz") + ElseIf Mod($i, 5) = 0 Then + Out("Buzz") + ElseIf Mod($i, 3) = 0 Then + Out("Fizz") + Else + Out($i) + EndIf +Next +Out("# Done.") diff --git a/Task/FizzBuzz/COBOL/fizzbuzz-4.cobol b/Task/FizzBuzz/COBOL/fizzbuzz-4.cobol new file mode 100644 index 0000000000..d4f2c46c86 --- /dev/null +++ b/Task/FizzBuzz/COBOL/fizzbuzz-4.cobol @@ -0,0 +1,29 @@ + >>SOURCE FORMAT FREE +identification division. +program-id. fizzbuzz. +data division. +working-storage section. +01 i pic 999. +01 fizz pic 999 value 3. +01 buzz pic 999 value 5. +procedure division. +start-fizzbuzz. + perform varying i from 1 by 1 until i > 100 + evaluate i also i + when fizz also buzz + display 'fizzbuzz' + add 3 to fizz + add 5 to buzz + when fizz also any + display 'fizz' + add 3 to fizz + when buzz also any + display 'buzz' + add 5 to buzz + when other + display i + end-evaluate + end-perform + stop run + . +end program fizzbuzz. diff --git a/Task/FizzBuzz/Clojure/fizzbuzz-11.clj b/Task/FizzBuzz/Clojure/fizzbuzz-11.clj new file mode 100644 index 0000000000..671b053149 --- /dev/null +++ b/Task/FizzBuzz/Clojure/fizzbuzz-11.clj @@ -0,0 +1,19 @@ +;;Using clojure maps +(defn fizzbuzz + [n] + (let [rule {3 "Fizz" + 5 "Buzz"} + divs (->> rule + (map first) + sort + (filter (comp (partial = 0) + (partial rem n))))] + (if (empty? divs) + (str n) + (->> divs + (map rule) + (apply str))))) + +(defn allfizzbuzz + [max] + (map fizzbuzz (range 1 (inc max)))) diff --git a/Task/FizzBuzz/Clojure/fizzbuzz-12.clj b/Task/FizzBuzz/Clojure/fizzbuzz-12.clj new file mode 100644 index 0000000000..d45f70ec49 --- /dev/null +++ b/Task/FizzBuzz/Clojure/fizzbuzz-12.clj @@ -0,0 +1,6 @@ +(take 100 + (map #(str %1 %2 (if-not (or %1 %2) %3)) + (cycle [nil nil "Fizz"]) + (cycle [nil nil nil nil "Buzz"]) + (rest (range)) + )) diff --git a/Task/FizzBuzz/Clojure/fizzbuzz-13.clj b/Task/FizzBuzz/Clojure/fizzbuzz-13.clj new file mode 100644 index 0000000000..39eab38623 --- /dev/null +++ b/Task/FizzBuzz/Clojure/fizzbuzz-13.clj @@ -0,0 +1,18 @@ +(take 100 + ( + (fn [& fbspec] + (let [ + fbseq #(->> (repeat nil) (cons %2) (take %1) reverse cycle) + strfn #(apply str (if (every? nil? (rest %&)) (first %&)) (rest %&)) + ] + (->> + fbspec + (partition 2) + (map #(apply fbseq %)) + (apply map strfn (rest (range))) + ) ;;endthread + ) ;;endlet + ) ;;endfn + 3 "Fizz" 5 "Buzz" 7 "Bazz" + ) ;;endfn apply +) ;;endtake diff --git a/Task/FizzBuzz/Clojure/fizzbuzz-8.clj b/Task/FizzBuzz/Clojure/fizzbuzz-8.clj index 0726c310ec..f1ded0180f 100644 --- a/Task/FizzBuzz/Clojure/fizzbuzz-8.clj +++ b/Task/FizzBuzz/Clojure/fizzbuzz-8.clj @@ -1 +1 @@ -(map #(nth (conj (cycle [% % "Fizz" % "Buzz" "Fizz" % % % "Buzz" % "Fizz" % % "FizzBuzz"]) %) %) (range 1 101)) +(map #(nth (conj (cycle [% % "Fizz" % "Buzz" "Fizz" % % "Fizz" "Buzz" % "Fizz" % % "FizzBuzz"]) %) %) (range 1 101)) diff --git a/Task/FizzBuzz/ColdFusion/fizzbuzz.cfm b/Task/FizzBuzz/ColdFusion/fizzbuzz-1.cfm similarity index 80% rename from Task/FizzBuzz/ColdFusion/fizzbuzz.cfm rename to Task/FizzBuzz/ColdFusion/fizzbuzz-1.cfm index d6158ae1b8..e035168c24 100644 --- a/Task/FizzBuzz/ColdFusion/fizzbuzz.cfm +++ b/Task/FizzBuzz/ColdFusion/fizzbuzz-1.cfm @@ -2,6 +2,6 @@ FizzBuzz Fizz Buzz - #i# + #i# diff --git a/Task/FizzBuzz/ColdFusion/fizzbuzz-2.cfm b/Task/FizzBuzz/ColdFusion/fizzbuzz-2.cfm new file mode 100644 index 0000000000..1a04809a41 --- /dev/null +++ b/Task/FizzBuzz/ColdFusion/fizzbuzz-2.cfm @@ -0,0 +1,7 @@ + +result = ""; + for(i=1;i<=100;i++){ + result=ListAppend(result, (i%15==0) ? "FizzBuzz": (i%5==0) ? "Buzz" : (i%3 eq 0)? "Fizz" : i ); + } + WriteOutput(result); + diff --git a/Task/FizzBuzz/Elixir/fizzbuzz-2.elixir b/Task/FizzBuzz/Elixir/fizzbuzz-2.elixir index 9ca685762e..dc927b94f1 100644 --- a/Task/FizzBuzz/Elixir/fizzbuzz-2.elixir +++ b/Task/FizzBuzz/Elixir/fizzbuzz-2.elixir @@ -1,9 +1,9 @@ #!/usr/bin/env elixir 1..100 |> Enum.map(fn i -> cond do - rem(i,3*5) == 0 -> "fizzbuzz" - rem(i,3) == 0 -> "fizz" - rem(i,5) == 0 -> "buzz" + rem(i,3*5) == 0 -> "FizzBuzz" + rem(i,3) == 0 -> "Fizz" + rem(i,5) == 0 -> "Buzz" true -> i end end) |> Enum.each(fn i -> IO.puts i end) diff --git a/Task/FizzBuzz/Elixir/fizzbuzz-3.elixir b/Task/FizzBuzz/Elixir/fizzbuzz-3.elixir index 71b44afb2e..3d7816f3f6 100644 --- a/Task/FizzBuzz/Elixir/fizzbuzz-3.elixir +++ b/Task/FizzBuzz/Elixir/fizzbuzz-3.elixir @@ -3,8 +3,8 @@ defmodule RC do fizz = Stream.cycle(["", "", "Fizz"]) buzz = Stream.cycle(["", "", "", "", "Buzz"]) Stream.zip(fizz, buzz) - |> Stream.with_index |> Enum.take(limit) + |> Enum.with_index |> Enum.each(fn {{f,b},i} -> IO.puts if f<>b=="", do: i+1, else: f<>b end) diff --git a/Task/FizzBuzz/Elixir/fizzbuzz-4.elixir b/Task/FizzBuzz/Elixir/fizzbuzz-4.elixir index f926e00d8a..45e460fa00 100644 --- a/Task/FizzBuzz/Elixir/fizzbuzz-4.elixir +++ b/Task/FizzBuzz/Elixir/fizzbuzz-4.elixir @@ -5,4 +5,4 @@ defmodule FizzBuzz do def fizzbuzz(n), do: n end -Enum.map(1..100, &FizzBuzz.fizzbuzz/1) +Enum.each(1..100, &IO.puts FizzBuzz.fizzbuzz &1) diff --git a/Task/FizzBuzz/Elixir/fizzbuzz-5.elixir b/Task/FizzBuzz/Elixir/fizzbuzz-5.elixir index a1cfd18e92..39199b9f7c 100644 --- a/Task/FizzBuzz/Elixir/fizzbuzz-5.elixir +++ b/Task/FizzBuzz/Elixir/fizzbuzz-5.elixir @@ -1,91 +1,7 @@ -defmodule BadFizz do - # Hand-rolls a bunch of AST before injecting the resulting FizzBuzz code. - defmacrop automate_fizz(fizzers, n) do - # To begin, we need to process fizzers to produce the various components - # we're using in the final assembly. As told by Mickens telling as Antonio - # Banderas, first you must specify a mapping function: - build_parts = (fn {fz, n} -> - ast_ref = {fz |> String.downcase |> String.to_atom, [], __MODULE__} - clist = List.duplicate("", n - 1) ++ [fz] - cycle = quote do: unquote(ast_ref) = unquote(clist) |> Stream.cycle - - {ast_ref, cycle} - end) - - # ...and then a reducing function: - collate = (fn - ({ast_ref, cycle}, {ast_refs, cycles}) -> - {[ast_ref | ast_refs], [cycle | cycles]} - end) - - # ...and then, my love, when you are done your computation is ready to run - # across thousands of fizzbuzz: - {ast_refs, cycles} = fizzers - |> Code.eval_quoted([], __ENV__) |> elem(0) # Gotta unwrap this mystery code~ - |> Enum.sort(fn ({_, ap}, {_, bp}) -> ap < bp end) # Sort so that Fizz, 3 < Buzz, 5 - |> Enum.map(build_parts) - |> Enum.reduce({[], []}, collate) - - # Setup the anonymous functions used by Enum.reduce to build our AST components. - # This was previously handled by List.foldl, but ejected because reduce/2's - # default behavior reduces repetition. - # - # ...I was tempted to move these into a macro themselves, and thought better of it. - build_zip = fn (varname, ast) -> - quote do: Stream.zip(unquote(varname), unquote(ast)) - end - build_tuple = fn (varname, ast) -> - {:{}, [], [varname, ast]} - end - build_concat = fn (varname, ast) -> - {:<>, - [context: __MODULE__, import: Kernel], # Hygiene values may change; accurate to Elixir 1.1.1 - [varname, ast]} - end - - # Toss cycles into a block by hand, then smash ast_refs into - # a few different computations on the cycle block results. - cycles = {:__block__, [], cycles} - tuple = ast_refs |> Enum.reduce(build_tuple) - zip = ast_refs |> Enum.reduce(build_zip) - concat = ast_refs |> Enum.reduce(build_concat) - - # Finally-- Now that all our components are assembled, we can put - # together the fizzbuzz stream pipeline. After quote ends, this - # block is injected into the caller's context. - quote do - unquote(cycles) - - unquote(zip) - |> Stream.with_index - |> Enum.take(unquote(n)) - |> Enum.each(fn - {unquote(tuple), i} -> - ccats = unquote(concat) - IO.puts if ccats == "", do: i + 1, else: ccats - end) - end - end - - @doc ~S""" - A fizzing, and possibly buzzing function. Somehow, you feel like you've - seen this before. An old friend, suddenly appearing in Kafkaesque nightmare... - - ...or worse, during a whiteboard interview. - """ - def fizz(n \\ 100) when is_number(n) do - # In reward for all that effort above, we now have the latest in - # programmer productivity: - # - # A DSL for building arbitrary fizzing, buzzing, bazzing, and more! - [{"Fizz", 3}, - {"Buzz", 5}#, - #{"Bar", 7}, - #{"Foo", 243}, # -> Always printed last (largest number) - #{"Qux", 34} - ] - |> automate_fizz(n) - end +f = fn(n) when rem(n,15)==0 -> "FizzBuzz" + (n) when rem(n,5)==0 -> "Fizz" + (n) when rem(n,3)==0 -> "Buzz" + (n) -> n end -BadFizz.fizz(100) # => Prints to stdout +for n <- 1..100, do: IO.puts f.(n) diff --git a/Task/FizzBuzz/Elixir/fizzbuzz-6.elixir b/Task/FizzBuzz/Elixir/fizzbuzz-6.elixir new file mode 100644 index 0000000000..29ccf3b380 --- /dev/null +++ b/Task/FizzBuzz/Elixir/fizzbuzz-6.elixir @@ -0,0 +1,4 @@ +Enum.each(1..100, fn i -> + str = "#{Enum.at([:Fizz], rem(i,3))}#{Enum.at([:Buzz], rem(i,5))}" + IO.puts if str=="", do: i, else: str +end) diff --git a/Task/FizzBuzz/Elixir/fizzbuzz-7.elixir b/Task/FizzBuzz/Elixir/fizzbuzz-7.elixir new file mode 100644 index 0000000000..a1cfd18e92 --- /dev/null +++ b/Task/FizzBuzz/Elixir/fizzbuzz-7.elixir @@ -0,0 +1,91 @@ +defmodule BadFizz do + # Hand-rolls a bunch of AST before injecting the resulting FizzBuzz code. + defmacrop automate_fizz(fizzers, n) do + # To begin, we need to process fizzers to produce the various components + # we're using in the final assembly. As told by Mickens telling as Antonio + # Banderas, first you must specify a mapping function: + build_parts = (fn {fz, n} -> + ast_ref = {fz |> String.downcase |> String.to_atom, [], __MODULE__} + clist = List.duplicate("", n - 1) ++ [fz] + cycle = quote do: unquote(ast_ref) = unquote(clist) |> Stream.cycle + + {ast_ref, cycle} + end) + + # ...and then a reducing function: + collate = (fn + ({ast_ref, cycle}, {ast_refs, cycles}) -> + {[ast_ref | ast_refs], [cycle | cycles]} + end) + + # ...and then, my love, when you are done your computation is ready to run + # across thousands of fizzbuzz: + {ast_refs, cycles} = fizzers + |> Code.eval_quoted([], __ENV__) |> elem(0) # Gotta unwrap this mystery code~ + |> Enum.sort(fn ({_, ap}, {_, bp}) -> ap < bp end) # Sort so that Fizz, 3 < Buzz, 5 + |> Enum.map(build_parts) + |> Enum.reduce({[], []}, collate) + + # Setup the anonymous functions used by Enum.reduce to build our AST components. + # This was previously handled by List.foldl, but ejected because reduce/2's + # default behavior reduces repetition. + # + # ...I was tempted to move these into a macro themselves, and thought better of it. + build_zip = fn (varname, ast) -> + quote do: Stream.zip(unquote(varname), unquote(ast)) + end + build_tuple = fn (varname, ast) -> + {:{}, [], [varname, ast]} + end + build_concat = fn (varname, ast) -> + {:<>, + [context: __MODULE__, import: Kernel], # Hygiene values may change; accurate to Elixir 1.1.1 + [varname, ast]} + end + + # Toss cycles into a block by hand, then smash ast_refs into + # a few different computations on the cycle block results. + cycles = {:__block__, [], cycles} + tuple = ast_refs |> Enum.reduce(build_tuple) + zip = ast_refs |> Enum.reduce(build_zip) + concat = ast_refs |> Enum.reduce(build_concat) + + # Finally-- Now that all our components are assembled, we can put + # together the fizzbuzz stream pipeline. After quote ends, this + # block is injected into the caller's context. + quote do + unquote(cycles) + + unquote(zip) + |> Stream.with_index + |> Enum.take(unquote(n)) + |> Enum.each(fn + {unquote(tuple), i} -> + ccats = unquote(concat) + IO.puts if ccats == "", do: i + 1, else: ccats + end) + end + end + + @doc ~S""" + A fizzing, and possibly buzzing function. Somehow, you feel like you've + seen this before. An old friend, suddenly appearing in Kafkaesque nightmare... + + ...or worse, during a whiteboard interview. + """ + def fizz(n \\ 100) when is_number(n) do + # In reward for all that effort above, we now have the latest in + # programmer productivity: + # + # A DSL for building arbitrary fizzing, buzzing, bazzing, and more! + [{"Fizz", 3}, + {"Buzz", 5}#, + #{"Bar", 7}, + #{"Foo", 243}, # -> Always printed last (largest number) + #{"Qux", 34} + ] + |> automate_fizz(n) + end +end + +BadFizz.fizz(100) # => Prints to stdout diff --git a/Task/FizzBuzz/Forth/fizzbuzz-4.fth b/Task/FizzBuzz/Forth/fizzbuzz-4.fth new file mode 100644 index 0000000000..eb7b25a8c2 --- /dev/null +++ b/Task/FizzBuzz/Forth/fizzbuzz-4.fth @@ -0,0 +1,8 @@ +: n ( n -- n+1 ) dup . 1+ ; +: f ( n -- n+1 ) ." Fizz " 1+ ; +: b ( n -- n+1 ) ." Buzz " 1+ ; +: fb ( n -- n+1 ) ." FizzBuzz " 1+ ; +: fb10 ( n -- n+10 ) n n f n b f n n f b ; +: fb15 ( n -- n+15 ) fb10 n f n n fb ; +: fb100 ( n -- n+100 ) fb15 fb15 fb15 fb15 fb15 fb15 fb10 ; +: .fizzbuzz ( -- ) 1 fb100 drop ; diff --git a/Task/FizzBuzz/Haskell/fizzbuzz-7.hs b/Task/FizzBuzz/Haskell/fizzbuzz-7.hs new file mode 100644 index 0000000000..1ebbac2dfd --- /dev/null +++ b/Task/FizzBuzz/Haskell/fizzbuzz-7.hs @@ -0,0 +1,12 @@ +import Data.Monoid + +fizzbuzz = max + <$> show + <*> "fizz" `when` divisibleBy 3 + <> "buzz" `when` divisibleBy 5 + <> "quxx" `when` divisibleBy 7 + where + when m p x = if p x then m else mempty + divisibleBy n x = x `mod` n == 0 + +main = mapM_ (putStrLn . fizzbuzz) [1..100] diff --git a/Task/FizzBuzz/K/fizzbuzz.k b/Task/FizzBuzz/K/fizzbuzz-1.k similarity index 100% rename from Task/FizzBuzz/K/fizzbuzz.k rename to Task/FizzBuzz/K/fizzbuzz-1.k diff --git a/Task/FizzBuzz/K/fizzbuzz-2.k b/Task/FizzBuzz/K/fizzbuzz-2.k new file mode 100644 index 0000000000..78fc38d860 --- /dev/null +++ b/Task/FizzBuzz/K/fizzbuzz-2.k @@ -0,0 +1,2 @@ + fizzbuzz:{:[0=x!15;`0:,"FizzBuzz";0=x!3;`0:,"Fizz";0=x!5;`0:,"Buzz";`0:,$x]} + fizzbuzz' 1+!100 diff --git a/Task/FizzBuzz/K/fizzbuzz-3.k b/Task/FizzBuzz/K/fizzbuzz-3.k new file mode 100644 index 0000000000..6e9a070c6a --- /dev/null +++ b/Task/FizzBuzz/K/fizzbuzz-3.k @@ -0,0 +1,8 @@ +fizzbuzz:{ + v:1+!x + i:(&0=)'v!/:3 5 15 + r:@[v;i 0;{"Fizz"}] + r:@[r;i 1;{"Buzz"}] + @[r;i 2;{"FizzBuzz"}]} + +`0:$fizzbuzz 100 diff --git a/Task/FizzBuzz/Kotlin/fizzbuzz.kotlin b/Task/FizzBuzz/Kotlin/fizzbuzz-1.kotlin similarity index 90% rename from Task/FizzBuzz/Kotlin/fizzbuzz.kotlin rename to Task/FizzBuzz/Kotlin/fizzbuzz-1.kotlin index b9ebdb9783..01c5cf6e46 100644 --- a/Task/FizzBuzz/Kotlin/fizzbuzz.kotlin +++ b/Task/FizzBuzz/Kotlin/fizzbuzz-1.kotlin @@ -1,4 +1,4 @@ -public fun fizzBuzz() { +fun fizzBuzz() { for (i in 1..100) { when { i % 15 == 0 -> println("FizzBuzz") diff --git a/Task/FizzBuzz/Kotlin/fizzbuzz-2.kotlin b/Task/FizzBuzz/Kotlin/fizzbuzz-2.kotlin new file mode 100644 index 0000000000..acbafdb9e3 --- /dev/null +++ b/Task/FizzBuzz/Kotlin/fizzbuzz-2.kotlin @@ -0,0 +1,7 @@ +fun fizzBuzz() { + fun fizzbuzz(x: Int) = if(x % 15 == 0) "FizzBuzz" else x + fun fizz(x: Any) = if(x is Int && x % 3 == 0) "Buzz" else x + fun buzz(x: Any) = if(x is Int && x.toInt() % 5 == 0) "Fizz" else x + + (1..100).map { fizzbuzz(it) }.map { fizz(it) }.map { buzz(it) }.forEach { println(it) } +} diff --git a/Task/FizzBuzz/Kotlin/fizzbuzz-3.kotlin b/Task/FizzBuzz/Kotlin/fizzbuzz-3.kotlin new file mode 100644 index 0000000000..6b29235775 --- /dev/null +++ b/Task/FizzBuzz/Kotlin/fizzbuzz-3.kotlin @@ -0,0 +1,11 @@ +fun fizzBuzz() { + fun fizz(x: Pair) = if(x.first % 3 == 0) x.apply { second.append("Fizz") } else x + fun buzz(x: Pair) = if(x.first % 5 == 0) x.apply { second.append("Buzz") } else x + fun none(x: Pair) = if(x.second.isBlank()) x.second.apply { append(x.first) } else x.second + + (1..100).map { Pair(it, StringBuilder()) } + .map { fizz(it) } + .map { buzz(it) } + .map { none(it) } + .forEach { println(it) } +} diff --git a/Task/FizzBuzz/MIPS-Assembly/fizzbuzz.mips b/Task/FizzBuzz/MIPS-Assembly/fizzbuzz.mips new file mode 100644 index 0000000000..26696214c8 --- /dev/null +++ b/Task/FizzBuzz/MIPS-Assembly/fizzbuzz.mips @@ -0,0 +1,74 @@ +################################# +# Fizz Buzz # +# MIPS Assembly targetings MARS # +# By Keith Stellyes # +# August 24, 2016 # +################################# + +# $a0 left alone for printing +# $a1 stores our counter +# $a2 is 1 if not evenly divisible + +.data + fizz: .asciiz "Fizz\n" + buzz: .asciiz "Buzz\n" + fizzbuzz: .asciiz "FizzBuzz\n" + newline: .asciiz "\n" + +.text +loop: + beq $a1,100,exit + add $a1,$a1,1 + + #test for counter mod 15 ("FIZZBUZZ") + div $a2,$a1,15 + mfhi $a2 + bnez $a2,loop_not_fb #jump past the fizzbuzz print logic if NOT MOD 15 + +#### PRINT FIZZBUZZ: #### + li $v0,4 #set syscall arg to PRINT_STRING + la $a0,fizzbuzz #set the PRINT_STRING arg to fizzbuzz + syscall #call PRINT_STRING + j loop #return to start +#### END PRINT FIZZBUZZ #### + +loop_not_fb: + div $a2,$a1,3 #divide $a1 (our counter) by 3 and store remainder in HI + mfhi $a2 #retrieve remainder (result of MOD) + bnez $a2, loop_not_f #jump past the fizz print logic if NOT MOD 3 + +#### PRINT FIZZ #### + li $v0,4 + la $a0,fizz + syscall + j loop +#### END PRINT FIZZ #### + +loop_not_f: + div $a2,$a1,5 + mfhi $a2 + bnez $a2,loop_not_b + +#### PRINT BUZZ #### + li $v0,4 + la $a0,buzz + syscall + j loop +#### END PRINT BUZZ #### + +loop_not_b: + #### PRINT THE INTEGER #### + li $v0,1 #set syscall arg to PRINT_INTEGER + move $a0,$a1 #set PRINT_INTEGER arg to contents of $a1 + syscall #call PRINT_INTEGER + + ### PRINT THE NEWLINE CHAR ### + li $v0,4 #set syscall arg to PRINT_STRING + la $a0,newline + syscall + + j loop #return to beginning + +exit: + li $v0,10 + syscall diff --git a/Task/FizzBuzz/MUMPS/fizzbuzz.mumps b/Task/FizzBuzz/MUMPS/fizzbuzz-1.mumps similarity index 100% rename from Task/FizzBuzz/MUMPS/fizzbuzz.mumps rename to Task/FizzBuzz/MUMPS/fizzbuzz-1.mumps diff --git a/Task/FizzBuzz/MUMPS/fizzbuzz-2.mumps b/Task/FizzBuzz/MUMPS/fizzbuzz-2.mumps new file mode 100644 index 0000000000..7fb7a0e785 --- /dev/null +++ b/Task/FizzBuzz/MUMPS/fizzbuzz-2.mumps @@ -0,0 +1,3 @@ +fizzbuzz + for i=1:1:100 do write ! + . write:(i#3)&(i#5) i write:'(i#3) "Fizz" write:'(i#5) "Buzz" diff --git a/Task/FizzBuzz/Perl-6/fizzbuzz-2.pl6 b/Task/FizzBuzz/Perl-6/fizzbuzz-2.pl6 index c4ee5f009c..24ee387657 100644 --- a/Task/FizzBuzz/Perl-6/fizzbuzz-2.pl6 +++ b/Task/FizzBuzz/Perl-6/fizzbuzz-2.pl6 @@ -2,4 +2,4 @@ multi sub fizzbuzz(Int $ where * %% 15) { 'FizzBuzz' } multi sub fizzbuzz(Int $ where * %% 5) { 'Buzz' } multi sub fizzbuzz(Int $ where * %% 3) { 'Fizz' } multi sub fizzbuzz(Int $number ) { $number } -(1 .. 100)».&fizzbuzz.join("\n").say; +(1 .. 100)».&fizzbuzz.say; diff --git a/Task/FizzBuzz/Perl-6/fizzbuzz-3.pl6 b/Task/FizzBuzz/Perl-6/fizzbuzz-3.pl6 index 4da34d6c98..2741c4f66a 100644 --- a/Task/FizzBuzz/Perl-6/fizzbuzz-3.pl6 +++ b/Task/FizzBuzz/Perl-6/fizzbuzz-3.pl6 @@ -1 +1 @@ -say 'Fizz' x $_ %% 3 ~ 'Buzz' x $_ %% 5 || $_ for 1 .. 100; +[1..100].map({[~] ($_%%3, $_%%5) »||» "" Z&& or $_ })».say diff --git a/Task/FizzBuzz/Perl-6/fizzbuzz-4.pl6 b/Task/FizzBuzz/Perl-6/fizzbuzz-4.pl6 index 40879a121b..4da34d6c98 100644 --- a/Task/FizzBuzz/Perl-6/fizzbuzz-4.pl6 +++ b/Task/FizzBuzz/Perl-6/fizzbuzz-4.pl6 @@ -1 +1 @@ -say "Fizz"x$_%%3~"Buzz"x$_%%5||$_ for 1..100 +say 'Fizz' x $_ %% 3 ~ 'Buzz' x $_ %% 5 || $_ for 1 .. 100; diff --git a/Task/FizzBuzz/Perl-6/fizzbuzz-5.pl6 b/Task/FizzBuzz/Perl-6/fizzbuzz-5.pl6 index 2fd0c40b74..40879a121b 100644 --- a/Task/FizzBuzz/Perl-6/fizzbuzz-5.pl6 +++ b/Task/FizzBuzz/Perl-6/fizzbuzz-5.pl6 @@ -1,8 +1 @@ -.say for - ( - (flat ('' xx 2, 'Fizz') xx *) - Z~ - (flat ('' xx 4, 'Buzz') xx *) - ) - Z|| - 1 .. 100; +say "Fizz"x$_%%3~"Buzz"x$_%%5||$_ for 1..100 diff --git a/Task/FizzBuzz/Perl-6/fizzbuzz-6.pl6 b/Task/FizzBuzz/Perl-6/fizzbuzz-6.pl6 new file mode 100644 index 0000000000..2fd0c40b74 --- /dev/null +++ b/Task/FizzBuzz/Perl-6/fizzbuzz-6.pl6 @@ -0,0 +1,8 @@ +.say for + ( + (flat ('' xx 2, 'Fizz') xx *) + Z~ + (flat ('' xx 4, 'Buzz') xx *) + ) + Z|| + 1 .. 100; diff --git a/Task/FizzBuzz/PowerShell/fizzbuzz-4.psh b/Task/FizzBuzz/PowerShell/fizzbuzz-4.psh new file mode 100644 index 0000000000..6ec22d1e90 --- /dev/null +++ b/Task/FizzBuzz/PowerShell/fizzbuzz-4.psh @@ -0,0 +1,14 @@ +filter fizz-buzz{ + @( + $_, + "Fizz", + "Buzz", + "FizzBuzz" + )[ + 2 * + ($_ -match '[05]$') + + ($_ -match '(^([369][0369]?|[258][147]|[147][258]))$') + ] +} + +1..100 | fizz-buzz diff --git a/Task/FizzBuzz/Processing/fizzbuzz-3 b/Task/FizzBuzz/Processing/fizzbuzz-3 new file mode 100644 index 0000000000..21badf0d7b --- /dev/null +++ b/Task/FizzBuzz/Processing/fizzbuzz-3 @@ -0,0 +1,12 @@ +for (int i = 1; i <= 100; i++) { + if (i % 3 == 0) { + print("Fizz"); + } + if (i % 5 == 0) { + print("Buzz"); + } + if (i % 3 != 0 && i % 5 != 0) { + print(i); + } + print("\n"); +} diff --git a/Task/FizzBuzz/REXX/fizzbuzz-1.rexx b/Task/FizzBuzz/REXX/fizzbuzz-1.rexx index aa990fe594..9729b86398 100644 --- a/Task/FizzBuzz/REXX/fizzbuzz-1.rexx +++ b/Task/FizzBuzz/REXX/fizzbuzz-1.rexx @@ -1,8 +1,8 @@ -/*REXX program displays numbers 1 ──► 100 for the FizzBuzz problem. */ - - do j=1 to 100; z=j /*╔═════════════════════════════╗*/ - if j//3 ==0 then z='Fizz' /*║ The IFs must be in ║*/ - if j//5 ==0 then z='Buzz' /*║ ascending order.║*/ - if j//(3*5)==0 then z='FizzBuzz' /*╚═════════════════════════════╝*/ - say right(z,8) - end /*j*/ /*stick a fork in it, we're done.*/ +/*REXX program displays numbers 1 ──► 100 (some transformed) for the FizzBuzz problem.*/ + /*╔═══════════════════════════════════╗*/ + do j=1 to 100; z= j /*║ ║*/ + if j//3 ==0 then z= 'Fizz' /*║ The divisors (//) of the IFs ║*/ + if j//5 ==0 then z= 'Buzz' /*║ must be in ascending order. ║*/ + if j//(3*5)==0 then z= 'FizzBuzz' /*║ ║*/ + say right(z, 8) /*╚═══════════════════════════════════╝*/ + end /*j*/ /*stick a fork in it, we're all done. */ diff --git a/Task/FizzBuzz/REXX/fizzbuzz-2.rexx b/Task/FizzBuzz/REXX/fizzbuzz-2.rexx index 0214638173..d53b369ac2 100644 --- a/Task/FizzBuzz/REXX/fizzbuzz-2.rexx +++ b/Task/FizzBuzz/REXX/fizzbuzz-2.rexx @@ -1,10 +1,10 @@ -/*REXX program displays numbers 1 ──► 100 for the FizzBuzz problem. */ - - do n=1 for 100 - select /*╔═════════════════════════════╗*/ - when n//15==0 then say 'FizzBuzz' /*║ The WHENs must be in ║*/ - when n//5 ==0 then say ' Buzz' /*║ descending order║*/ - when n//3 ==0 then say ' Fizz' /*╚═════════════════════════════╝*/ - otherwise say right(n,8) - end /*select*/ - end /*n*/ /*stick a fork in it, we're done.*/ +/*REXX program displays numbers 1 ──► 100 (some transformed) for the FizzBuzz problem.*/ + /*╔═══════════════════════════════════╗*/ + do j=1 to 100 /*║ ║*/ + select /*║ ║*/ + when j//15==0 then say 'FizzBuzz' /*║ The divisors (//) of the WHENs ║*/ + when j//5 ==0 then say ' Buzz' /*║ must be in descending order. ║*/ + when j//3 ==0 then say ' Fizz' /*║ ║*/ + otherwise say right(j, 8) /*╚═══════════════════════════════════╝*/ + end /*select*/ + end /*j*/ /*stick a fork in it, we're all done. */ diff --git a/Task/FizzBuzz/REXX/fizzbuzz-3.rexx b/Task/FizzBuzz/REXX/fizzbuzz-3.rexx index b176cb3342..23b7aaad03 100644 --- a/Task/FizzBuzz/REXX/fizzbuzz-3.rexx +++ b/Task/FizzBuzz/REXX/fizzbuzz-3.rexx @@ -1,8 +1,8 @@ -/*REXX program displays numbers 1 ──► 100 for the FizzBuzz problem. */ +/*REXX program displays numbers 1 ──► 100 (some transformed) for the FizzBuzz problem.*/ - do n=1 for 100; _= - if n//3 ==0 then _=_'Fizz' - if n//5 ==0 then _=_'Buzz' -/* if n//7 ==0 then _=_'Jazz' */ /*◄───note that this is a comment*/ - say right(word(_ n,1),8) - end /*n*/ /*stick a fork in it, we're done.*/ + do j=1 for 100; _= + if j//3 ==0 then _=_'Fizz' + if j//5 ==0 then _=_'Buzz' +/* if j//7 ==0 then _=_'Jazz' */ /* ◄─── note that this is a comment. */ + say right(word(_ j,1),8) + end /*j*/ /*stick a fork in it, we're all done. */ diff --git a/Task/FizzBuzz/REXX/fizzbuzz-4.rexx b/Task/FizzBuzz/REXX/fizzbuzz-4.rexx index 41694674d1..fcb182b419 100644 --- a/Task/FizzBuzz/REXX/fizzbuzz-4.rexx +++ b/Task/FizzBuzz/REXX/fizzbuzz-4.rexx @@ -1,6 +1,6 @@ -/*REXX program displays numbers 1 ──► 100 for the FizzBuzz problem. */ - /* [↓] concise & somewhat obtuse*/ - do n=1 for 100 - say right(word(word('Fizz',1+(n//3\==0))word('Buzz',1+(n//5\==0)) n,1),8) - end /*n*/ - /*stick a fork in it, we're done.*/ +/*REXX program displays numbers 1 ──► 100 (some transformed) for the FizzBuzz problem.*/ + /* [↓] concise, but somewhat obtuse. */ + do j=1 for 100 + say right(word(word('Fizz', 1+(j//3\==0))word('Buzz', 1+(j//5\==0)) j, 1), 8) + end /*j*/ + /*stick a fork in it, we're all done. */ diff --git a/Task/FizzBuzz/Ruby/fizzbuzz-2.rb b/Task/FizzBuzz/Ruby/fizzbuzz-2.rb index 8318b4c788..5fc9065a09 100644 --- a/Task/FizzBuzz/Ruby/fizzbuzz-2.rb +++ b/Task/FizzBuzz/Ruby/fizzbuzz-2.rb @@ -1,11 +1,11 @@ -1.upto(100) do |n| - if (n % 15).zero? - puts "FizzBuzz" +(1..100).each do |n| + puts if (n % 15).zero? + "FizzBuzz" elsif (n % 5).zero? - puts "Buzz" + "Buzz" elsif (n % 3).zero? - puts "Fizz" + "Fizz" else - puts n + n end end diff --git a/Task/FizzBuzz/Rust/fizzbuzz-1.rust b/Task/FizzBuzz/Rust/fizzbuzz-1.rust index 9369a60a94..f5fa200750 100644 --- a/Task/FizzBuzz/Rust/fizzbuzz-1.rust +++ b/Task/FizzBuzz/Rust/fizzbuzz-1.rust @@ -1,13 +1,12 @@ -#![feature(into_cow)] -use std::borrow::IntoCow; - +use std::borrow::Cow; fn main() { for i in 1..101 { - println!("{}", match (i%3, i%5) { - (0,0) => "FizzBuzz".into_cow(), - (0,_) => "Fizz".into_cow(), - (_,0) => "Buzz".into_cow(), - _ => i.to_string().into_cow(), - }); + let word: Cow<_> = match (i % 3, i % 5) { + (0,0) => "FizzBuzz".into(), + (0,_) => "Fizz".into(), + (_, 0) => "Buzz".into(), + _ => i.to_string().into(), + }; + println!("{}", word); } } diff --git a/Task/FizzBuzz/Rust/fizzbuzz-2.rust b/Task/FizzBuzz/Rust/fizzbuzz-2.rust index 9396e02b56..6691231910 100644 --- a/Task/FizzBuzz/Rust/fizzbuzz-2.rust +++ b/Task/FizzBuzz/Rust/fizzbuzz-2.rust @@ -1,10 +1,37 @@ -fn main() { - for i in 1..101 { - match (i % 3 == 0, i % 5 == 0) { - (true, true) => println!("FizzBuzz"), - (true, false) => println!("Fizz"), - (false, true) => println!("Buzz"), - (false, false) => println!("{}", i), - } + #![no_std] +#![feature(asm, lang_items, libc, no_std, start)] + +extern crate libc; + +const LEN: usize = 413; +static OUT: [u8; LEN] = *b"\ + 1\n2\nFizz\n4\nBuzz\nFizz\n7\n8\nFizz\nBuzz\n11\nFizz\n13\n14\nFizzBuzz\n\ + 16\n17\nFizz\n19\nBuzz\nFizz\n22\n23\nFizz\nBuzz\n26\nFizz\n28\n29\nFizzBuzz\n\ + 31\n32\nFizz\n34\nBuzz\nFizz\n37\n38\nFizz\nBuzz\n41\nFizz\n43\n44\nFizzBuzz\n\ + 46\n47\nFizz\n49\nBuzz\nFizz\n52\n53\nFizz\nBuzz\n56\nFizz\n58\n59\nFizzBuzz\n\ + 61\n62\nFizz\n64\nBuzz\nFizz\n67\n68\nFizz\nBuzz\n71\nFizz\n73\n74\nFizzBuzz\n\ + 76\n77\nFizz\n79\nBuzz\nFizz\n82\n83\nFizz\nBuzz\n86\nFizz\n88\n89\nFizzBuzz\n\ + 91\n92\nFizz\n94\nBuzz\nFizz\n97\n98\nFizz\nBuzz\n"; + +#[start] +fn start(_argc: isize, _argv: *const *const u8) -> isize { + unsafe { + asm!( + " + mov $$1, %rax + mov $$1, %rdi + mov $0, %rsi + mov $1, %rdx + syscall + " + : + : "r" (&OUT[0]) "r" (LEN) + : "rax", "rdi", "rsi", "rdx" + : + ); } + 0 } + +#[lang = "eh_personality"] extern fn eh_personality() {} +#[lang = "panic_fmt"] extern fn panic_fmt() {} diff --git a/Task/FizzBuzz/SAS/fizzbuzz.sas b/Task/FizzBuzz/SAS/fizzbuzz.sas new file mode 100644 index 0000000000..b7e0903893 --- /dev/null +++ b/Task/FizzBuzz/SAS/fizzbuzz.sas @@ -0,0 +1,8 @@ +data _null_; + do i=1 to 100; + if mod(i,15)=0 then put "FizzBuzz"; + else if mod(i,5)=0 then put "Buzz"; + else if mod(i,3)=0 then put "Fizz"; + else put i; + end; +run; diff --git a/Task/FizzBuzz/Simula/fizzbuzz.simula b/Task/FizzBuzz/Simula/fizzbuzz.simula new file mode 100644 index 0000000000..a267d5c16f --- /dev/null +++ b/Task/FizzBuzz/Simula/fizzbuzz.simula @@ -0,0 +1,15 @@ +begin + integer i; + for i := 1 step 1 until 100 do + begin + if mod( i, 15 ) = 0 then + outtext( "FizzBuzz" ) + else if mod( i, 3 ) = 0 then + outtext( "Fizz" ) + else if mod( i, 5 ) = 0 then + outtext( "Buzz" ) + else + outint( i, 3 ); + outimage + end; +end diff --git a/Task/FizzBuzz/Vala/fizzbuzz.vala b/Task/FizzBuzz/Vala/fizzbuzz.vala index dd86643adb..227d159d45 100644 --- a/Task/FizzBuzz/Vala/fizzbuzz.vala +++ b/Task/FizzBuzz/Vala/fizzbuzz.vala @@ -1,9 +1,10 @@ int main() { - for(int i = 1; i < 100; i++) { - if(i % 3 == 0) stdout.printf("Fizz"); - if(i % 5 == 0) stdout.printf("Buzz"); - if(i % 3 != 0 && i % 5 != 0) stdout.printf("%d", i); - stdout.printf("\n"); - } - return 0; + for (int i = 1; i <= 100; i++) { + if (i % 3 == 0) stdout.printf("Fizz\n"); + if (i % 5 == 0) stdout.printf("Buzz\n"); + if (i % 15 == 0) stdout.printf("FizzBuzz\n"); + if (i % 3 != 0 && i % 5 != 0) stdout.printf("%d\n", i); + + } +return 0;; } diff --git a/Task/FizzBuzz/ZX-Spectrum-Basic/fizzbuzz.zx b/Task/FizzBuzz/ZX-Spectrum-Basic/fizzbuzz.zx new file mode 100644 index 0000000000..ce0d642f48 --- /dev/null +++ b/Task/FizzBuzz/ZX-Spectrum-Basic/fizzbuzz.zx @@ -0,0 +1,8 @@ +10 DEF FN m(a,b)=a-INT (a/b)*b +20 FOR a=1 TO 100 +30 LET o$="" +40 IF FN m(a,3)=0 THEN LET o$="Fizz" +50 IF FN m(a,5)=0 THEN LET o$=o$+"Buzz" +60 IF o$="" THEN LET o$=STR$ a +70 PRINT o$ +80 NEXT a diff --git a/Task/Flatten-a-list/00DESCRIPTION b/Task/Flatten-a-list/00DESCRIPTION index 378c856c3d..67e840a397 100644 --- a/Task/Flatten-a-list/00DESCRIPTION +++ b/Task/Flatten-a-list/00DESCRIPTION @@ -1,6 +1,13 @@ -Write a function to flatten the nesting in an arbitrary [[wp:List (computing)|list]] of values. Your program should work on the equivalent of this list: - [[1], 2, [[3,4], 5], [[[]]], [[[6]]], 7, 8, []] +;Task: +Write a function to flatten the nesting in an arbitrary   [[wp:List (computing)|list]] of values. + + +Your program should work on the equivalent of this list: + [[1], 2, [[3, 4], 5], [[[]]], [[[6]]], 7, 8, []] Where the correct result would be the list: [1, 2, 3, 4, 5, 6, 7, 8] -C.f. [[Tree traversal]] + +;Related task: +*   [[Tree traversal]] +

    diff --git a/Task/Flatten-a-list/Ada/flatten-a-list-1.ada b/Task/Flatten-a-list/Ada/flatten-a-list-1.ada new file mode 100644 index 0000000000..5f0082c907 --- /dev/null +++ b/Task/Flatten-a-list/Ada/flatten-a-list-1.ada @@ -0,0 +1,32 @@ +generic + type Element_Type is private; + with function To_String (E : Element_Type) return String is <>; +package Nestable_Lists is + + type Node_Kind is (Data_Node, List_Node); + + type Node (Kind : Node_Kind); + + type List is access Node; + + type Node (Kind : Node_Kind) is record + Next : List; + case Kind is + when Data_Node => + Data : Element_Type; + when List_Node => + Sublist : List; + end case; + end record; + + procedure Append (L : in out List; E : Element_Type); + procedure Append (L : in out List; N : List); + + function Flatten (L : List) return List; + + function New_List (E : Element_Type) return List; + function New_List (N : List) return List; + + function To_String (L : List) return String; + +end Nestable_Lists; diff --git a/Task/Flatten-a-list/Ada/flatten-a-list-2.ada b/Task/Flatten-a-list/Ada/flatten-a-list-2.ada new file mode 100644 index 0000000000..653d8dfd0b --- /dev/null +++ b/Task/Flatten-a-list/Ada/flatten-a-list-2.ada @@ -0,0 +1,79 @@ +with Ada.Strings.Unbounded; + +package body Nestable_Lists is + + procedure Append (L : in out List; E : Element_Type) is + begin + if L = null then + L := new Node (Kind => Data_Node); + L.Data := E; + else + Append (L.Next, E); + end if; + end Append; + + procedure Append (L : in out List; N : List) is + begin + if L = null then + L := new Node (Kind => List_Node); + L.Sublist := N; + else + Append (L.Next, N); + end if; + end Append; + + function Flatten (L : List) return List is + Result : List; + Current : List := L; + Temp : List; + begin + while Current /= null loop + case Current.Kind is + when Data_Node => + Append (Result, Current.Data); + when List_Node => + Temp := Flatten (Current.Sublist); + while Temp /= null loop + Append (Result, Temp.Data); + Temp := Temp.Next; + end loop; + end case; + Current := Current.Next; + end loop; + return Result; + end Flatten; + + function New_List (E : Element_Type) return List is + begin + return new Node'(Kind => Data_Node, Data => E, Next => null); + end New_List; + + function New_List (N : List) return List is + begin + return new Node'(Kind => List_Node, Sublist => N, Next => null); + end New_List; + + function To_String (L : List) return String is + Current : List := L; + Result : Ada.Strings.Unbounded.Unbounded_String; + begin + Ada.Strings.Unbounded.Append (Result, "["); + while Current /= null loop + case Current.Kind is + when Data_Node => + Ada.Strings.Unbounded.Append + (Result, To_String (Current.Data)); + when List_Node => + Ada.Strings.Unbounded.Append + (Result, To_String (Current.Sublist)); + end case; + if Current.Next /= null then + Ada.Strings.Unbounded.Append (Result, ", "); + end if; + Current := Current.Next; + end loop; + Ada.Strings.Unbounded.Append (Result, "]"); + return Ada.Strings.Unbounded.To_String (Result); + end To_String; + +end Nestable_Lists; diff --git a/Task/Flatten-a-list/Ada/flatten-a-list-3.ada b/Task/Flatten-a-list/Ada/flatten-a-list-3.ada new file mode 100644 index 0000000000..7447e91e00 --- /dev/null +++ b/Task/Flatten-a-list/Ada/flatten-a-list-3.ada @@ -0,0 +1,29 @@ +with Ada.Text_IO; +with Nestable_Lists; + +procedure Flatten_A_List is + package Int_List is new Nestable_Lists + (Element_Type => Integer, + To_String => Integer'Image); + + List : Int_List.List := null; +begin + Int_List.Append (List, Int_List.New_List (1)); + Int_List.Append (List, 2); + Int_List.Append (List, Int_List.New_List (Int_List.New_List (3))); + Int_List.Append (List.Next.Next.Sublist.Sublist, 4); + Int_List.Append (List.Next.Next.Sublist, 5); + Int_List.Append (List, Int_List.New_List (Int_List.New_List (null))); + Int_List.Append (List, Int_List.New_List (Int_List.New_List + (Int_List.New_List (6)))); + Int_List.Append (List, 7); + Int_List.Append (List, 8); + Int_List.Append (List, null); + + declare + Flattened : constant Int_List.List := Int_List.Flatten (List); + begin + Ada.Text_IO.Put_Line (Int_List.To_String (List)); + Ada.Text_IO.Put_Line (Int_List.To_String (Flattened)); + end; +end Flatten_A_List; diff --git a/Task/Flatten-a-list/AppleScript/flatten-a-list-1.applescript b/Task/Flatten-a-list/AppleScript/flatten-a-list-1.applescript new file mode 100644 index 0000000000..77ea7c6a97 --- /dev/null +++ b/Task/Flatten-a-list/AppleScript/flatten-a-list-1.applescript @@ -0,0 +1,11 @@ +my_flatten({{1}, 2, {{3, 4}, 5}, {{{}}}, {{{6}}}, 7, 8, {}}) + +on my_flatten(aList) + if class of aList is not list then + return {aList} + else if length of aList is 0 then + return aList + else + return my_flatten(first item of aList) & (my_flatten(rest of aList)) + end if +end my_flatten diff --git a/Task/Flatten-a-list/AppleScript/flatten-a-list-2.applescript b/Task/Flatten-a-list/AppleScript/flatten-a-list-2.applescript new file mode 100644 index 0000000000..08924dd3fa --- /dev/null +++ b/Task/Flatten-a-list/AppleScript/flatten-a-list-2.applescript @@ -0,0 +1,68 @@ +-- quickSort :: (Ord a) => [a] -> [a] +on quickSort(xs) + set headTail to uncons(xs) + if headTail is not missing value then + set {h, t} to headTail + + -- lessOrEqual :: a -> Bool + script lessOrEqual + on lambda(x) + x ≤ h + end lambda + end script + + set {less, more} to partition(lessOrEqual, t) + + quickSort(less) & h & quickSort(more) + else + xs + end if +end quickSort + + +-- TEST +on run + + quickSort([11.8, 14.1, 21.3, 8.5, 16.7, 5.7]) + + --> {5.7, 8.5, 11.8, 14.1, 16.7, 21.3} + +end run + + + +-- GENERIC FUNCTIONS + +-- partition :: predicate -> List -> (Matches, nonMatches) +-- partition :: (a -> Bool) -> [a] -> ([a], [a]) +on partition(f, xs) + tell mReturn(f) + set lst to {{}, {}} + repeat with x in xs + set v to contents of x + set end of item ((lambda(v) as integer) + 1) of lst to v + end repeat + return {item 2 of lst, item 1 of lst} + end tell +end partition + +-- uncons :: [a] -> Maybe (a, [a]) +on uncons(xs) + if length of xs > 0 then + {item 1 of xs, rest of xs} + else + missing value + end if +end uncons + +-- 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 diff --git a/Task/Flatten-a-list/AppleScript/flatten-a-list-3.applescript b/Task/Flatten-a-list/AppleScript/flatten-a-list-3.applescript new file mode 100644 index 0000000000..e925a198a0 --- /dev/null +++ b/Task/Flatten-a-list/AppleScript/flatten-a-list-3.applescript @@ -0,0 +1 @@ +{1, 2, 3, 4, 5, 6, 7, 8} diff --git a/Task/Flatten-a-list/AppleScript/flatten-a-list.applescript b/Task/Flatten-a-list/AppleScript/flatten-a-list.applescript deleted file mode 100644 index 723b212c25..0000000000 --- a/Task/Flatten-a-list/AppleScript/flatten-a-list.applescript +++ /dev/null @@ -1,11 +0,0 @@ -my_flatten({{1}, 2, {{3, 4}, 5}, {{{}}}, {{{6}}}, 7, 8, {}}) - -on my_flatten(aList) - if class of aList is not list then - return {aList} - else if length of aList is 0 then - return aList - else - return my_flatten(first item of aList) & (my_flatten(rest of aList)) - end if -end my_flatten diff --git a/Task/Flatten-a-list/JavaScript/flatten-a-list-2.js b/Task/Flatten-a-list/JavaScript/flatten-a-list-2.js index 5fdb352af1..2ca0860365 100644 --- a/Task/Flatten-a-list/JavaScript/flatten-a-list-2.js +++ b/Task/Flatten-a-list/JavaScript/flatten-a-list-2.js @@ -1,3 +1,18 @@ -let flatten = list => list.reduce( - (a, b) => a.concat(Array.isArray(b) ? flatten(b) : b), [] -); +(function () { + 'use strict'; + + // flatten :: Tree a -> [a] + function flatten(t) { + return (t instanceof Array ? concatMap(flatten, t) : t); + } + + // concatMap :: (a -> [b]) -> [a] -> [b] + function concatMap(f, xs) { + return [].concat.apply([], xs.map(f)); + } + + return flatten( + [[1], 2, [[3, 4], 5], [[[]]], [[[6]]], 7, 8, []] + ); + +})(); diff --git a/Task/Flatten-a-list/JavaScript/flatten-a-list-3.js b/Task/Flatten-a-list/JavaScript/flatten-a-list-3.js new file mode 100644 index 0000000000..d73530593a --- /dev/null +++ b/Task/Flatten-a-list/JavaScript/flatten-a-list-3.js @@ -0,0 +1,4 @@ + // flatten :: Tree a -> [a] + function flatten(a) { + return a instanceof Array ? [].concat.apply([], a.map(flatten)) : a; + } diff --git a/Task/Flatten-a-list/JavaScript/flatten-a-list-4.js b/Task/Flatten-a-list/JavaScript/flatten-a-list-4.js new file mode 100644 index 0000000000..52ce4756ce --- /dev/null +++ b/Task/Flatten-a-list/JavaScript/flatten-a-list-4.js @@ -0,0 +1,13 @@ +(function () { + 'use strict'; + + // flatten :: Tree a -> [a] + function flatten(a) { + return a instanceof Array ? [].concat.apply([], a.map(flatten)) : a; + } + + return flatten( + [[1], 2, [[3, 4], 5], [[[]]], [[[6]]], 7, 8, []] + ); + +})(); diff --git a/Task/Flatten-a-list/JavaScript/flatten-a-list-5.js b/Task/Flatten-a-list/JavaScript/flatten-a-list-5.js new file mode 100644 index 0000000000..5fdb352af1 --- /dev/null +++ b/Task/Flatten-a-list/JavaScript/flatten-a-list-5.js @@ -0,0 +1,3 @@ +let flatten = list => list.reduce( + (a, b) => a.concat(Array.isArray(b) ? flatten(b) : b), [] +); diff --git a/Task/Flatten-a-list/JavaScript/flatten-a-list-6.js b/Task/Flatten-a-list/JavaScript/flatten-a-list-6.js new file mode 100644 index 0000000000..12916c79f3 --- /dev/null +++ b/Task/Flatten-a-list/JavaScript/flatten-a-list-6.js @@ -0,0 +1,12 @@ +function flatten(list) { + for (let i = 0; i < list.length; i++) { + while (true) { + if (Array.isArray(list[i])) { + list.splice(i, 1, ...list[i]); + } else { + break; + } + } + } + return list; +} diff --git a/Task/Flatten-a-list/Smalltalk/flatten-a-list.st b/Task/Flatten-a-list/Smalltalk/flatten-a-list-1.st similarity index 100% rename from Task/Flatten-a-list/Smalltalk/flatten-a-list.st rename to Task/Flatten-a-list/Smalltalk/flatten-a-list-1.st diff --git a/Task/Flatten-a-list/Smalltalk/flatten-a-list-2.st b/Task/Flatten-a-list/Smalltalk/flatten-a-list-2.st new file mode 100644 index 0000000000..49c4089b61 --- /dev/null +++ b/Task/Flatten-a-list/Smalltalk/flatten-a-list-2.st @@ -0,0 +1,18 @@ +flatDo := + [:element :action | + element isCollection ifTrue:[ + element do:[:el | flatDo value:el value:action] + ] ifFalse:[ + action value:element + ]. + ]. + +collection := { + {1} . 2 . { {3 . 4} . 5 } . + {{{}}} . {{{6}}} . 7 . 8 . {} + }. + +newColl := OrderedCollection new. +flatDo + value:collection + value:[:el | newColl add: el] diff --git a/Task/Flatten-a-list/Smalltalk/flatten-a-list-3.st b/Task/Flatten-a-list/Smalltalk/flatten-a-list-3.st new file mode 100644 index 0000000000..4bf8897afa --- /dev/null +++ b/Task/Flatten-a-list/Smalltalk/flatten-a-list-3.st @@ -0,0 +1 @@ +collection flatDo:[:el | newColl add:el] diff --git a/Task/Flatten-a-list/Standard-ML/flatten-a-list-1.ml b/Task/Flatten-a-list/Standard-ML/flatten-a-list-1.ml new file mode 100644 index 0000000000..f6d5c51965 --- /dev/null +++ b/Task/Flatten-a-list/Standard-ML/flatten-a-list-1.ml @@ -0,0 +1,3 @@ +datatype 'a nestedList = + L of 'a (* leaf *) + | N of 'a nestedList list (* node *) diff --git a/Task/Flatten-a-list/Standard-ML/flatten-a-list-2.ml b/Task/Flatten-a-list/Standard-ML/flatten-a-list-2.ml new file mode 100644 index 0000000000..ba23371b91 --- /dev/null +++ b/Task/Flatten-a-list/Standard-ML/flatten-a-list-2.ml @@ -0,0 +1,2 @@ +fun flatten (L x) = [x] + | flatten (N xs) = List.concat (map flatten xs) diff --git a/Task/Flatten-a-list/SuperCollider/flatten-a-list-1.supercollider b/Task/Flatten-a-list/SuperCollider/flatten-a-list-1.supercollider new file mode 100644 index 0000000000..49be8a5b4a --- /dev/null +++ b/Task/Flatten-a-list/SuperCollider/flatten-a-list-1.supercollider @@ -0,0 +1,3 @@ +a = [[1], 2, [[3, 4], 5], [[[]]], [[[6]]], 7, 8, []]; +a.flatten(1); // answers [ 1, 2, [ 3, 4 ], 5, [ [ ] ], [ [ 6 ] ], 7, 8 ] +a.flat; // answers [ 1, 2, 3, 4, 5, 6, 7, 8 ] diff --git a/Task/Flatten-a-list/SuperCollider/flatten-a-list-2.supercollider b/Task/Flatten-a-list/SuperCollider/flatten-a-list-2.supercollider new file mode 100644 index 0000000000..d9de27d770 --- /dev/null +++ b/Task/Flatten-a-list/SuperCollider/flatten-a-list-2.supercollider @@ -0,0 +1,14 @@ +( +f = { |x| + var res = res ?? List.new; + if(x.isSequenceableCollection) { + x.do { |each| + res.addAll(f.(each)) + } + } { + res.add(x); + }; + res +}; +f.([[1], 2, [[3, 4], 5], [[[]]], [[[6]]], 7, 8, []]); +) diff --git a/Task/Flatten-a-list/ZX-Spectrum-Basic/flatten-a-list.zx b/Task/Flatten-a-list/ZX-Spectrum-Basic/flatten-a-list.zx new file mode 100644 index 0000000000..c9d1885fe4 --- /dev/null +++ b/Task/Flatten-a-list/ZX-Spectrum-Basic/flatten-a-list.zx @@ -0,0 +1,7 @@ +10 LET f$="[" +20 LET n$="[[1], 2, [[3,4], 5], [[[]]], [[[6]]], 7, 8 []]" +30 FOR i=2 TO (LEN n$)-1 +40 IF n$(i)>"/" AND n$(i)<":" THEN LET f$=f$+n$(i): GO TO 60 +50 IF n$(i)="," AND f$(LEN f$)<>"," THEN LET f$=f$+"," +60 NEXT i +70 LET f$=f$+"]": PRINT f$ diff --git a/Task/Flipping-bits-game/00DESCRIPTION b/Task/Flipping-bits-game/00DESCRIPTION index fb78d36a45..324b5bcf49 100644 --- a/Task/Flipping-bits-game/00DESCRIPTION +++ b/Task/Flipping-bits-game/00DESCRIPTION @@ -8,10 +8,13 @@ columns at once, as one move. In an inversion any 1 becomes 0, and any 0 becomes 1 for that whole row or column. -;The Task: -The task is to create a program to score for the Flipping bits game. +;Task: +Create a program to score for the Flipping bits game. # The game should create an original random target configuration and a starting configuration. # Ensure that the starting position is ''never'' the target position. # The target position must be guaranteed as reachable from the starting position. (One possible way to do this is to generate the start position by legal flips from a random target position. The flips will always be reversible back to the target from the given start position). # The number of moves taken so far should be shown. + +
    Show an example of a short game here, on this page, for a 3 by 3 array of bits. +

    diff --git a/Task/Flipping-bits-game/Elixir/flipping-bits-game.elixir b/Task/Flipping-bits-game/Elixir/flipping-bits-game.elixir new file mode 100644 index 0000000000..d5d2dc147f --- /dev/null +++ b/Task/Flipping-bits-game/Elixir/flipping-bits-game.elixir @@ -0,0 +1,67 @@ +defmodule Flip_game do + @az Enum.map(?a..?z, &List.to_string([&1])) + @in2i Enum.concat(Enum.map(1..26, fn i -> {to_string(i), i} end), + Enum.with_index(@az) |> Enum.map(fn {c,i} -> {c,-i-1} end)) + |> Enum.into(Map.new) + + def play(n) when n>2 do + target = generate_target(n) + display(n, "Target: ", target) + board = starting_config(n, target) + play(n, target, board, 1) + end + + def play(n, target, board, moves) do + display(n, "Board: ", board) + ans = IO.gets("row/column to flip: ") |> String.strip |> String.downcase + new_board = case @in2i[ans] do + i when i in 1..n -> flip_row(n, board, i) + i when i in -1..-n -> flip_column(n, board, -i) + _ -> IO.puts "invalid input: #{ans}" + board + end + if target == new_board do + display(n, "Board: ", new_board) + IO.puts "You solved the game in #{moves} moves" + else + IO.puts "" + play(n, target, new_board, moves+1) + end + end + + defp generate_target(n) do + for i <- 1..n, j <- 1..n, into: Map.new, do: {{i, j}, :rand.uniform(2)-1} + end + + defp starting_config(n, target) do + Enum.concat(1..n, -1..-n) + |> Enum.take_random(n) + |> Enum.reduce(target, fn x,acc -> + if x>0, do: flip_row(n, acc, x), + else: flip_column(n, acc, -x) + end) + end + + defp flip_row(n, board, row) do + Enum.reduce(1..n, board, fn col,acc -> + Map.update!(acc, {row,col}, fn bit -> 1 - bit end) + end) + end + + defp flip_column(n, board, col) do + Enum.reduce(1..n, board, fn row,acc -> + Map.update!(acc, {row,col}, fn bit -> 1 - bit end) + end) + end + + defp display(n, title, board) do + IO.puts title + IO.puts " #{Enum.join(Enum.take(@az,n), " ")}" + Enum.each(1..n, fn row -> + :io.fwrite "~2w ", [row] + IO.puts Enum.map_join(1..n, " ", fn col -> board[{row, col}] end) + end) + end +end + +Flip_game.play(3) diff --git a/Task/Flipping-bits-game/Java/flipping-bits-game.java b/Task/Flipping-bits-game/Java/flipping-bits-game.java new file mode 100644 index 0000000000..53d2e7db01 --- /dev/null +++ b/Task/Flipping-bits-game/Java/flipping-bits-game.java @@ -0,0 +1,155 @@ +import java.awt.*; +import java.awt.event.*; +import java.util.*; +import javax.swing.*; + +public class FlippingBitsGame extends JPanel { + final int maxLevel = 7; + final int minLevel = 3; + + private Random rand = new Random(); + private int[][] grid, target; + private Rectangle box; + private int n = maxLevel; + private boolean solved = true; + + FlippingBitsGame() { + setPreferredSize(new Dimension(640, 640)); + setBackground(Color.white); + setFont(new Font("SansSerif", Font.PLAIN, 18)); + + box = new Rectangle(120, 90, 400, 400); + + startNewGame(); + + addMouseListener(new MouseAdapter() { + @Override + public void mousePressed(MouseEvent e) { + if (solved) { + startNewGame(); + } else { + int x = e.getX(); + int y = e.getY(); + + if (box.contains(x, y)) + return; + + if (x > box.x && x < box.x + box.width) { + flipCol((x - box.x) / (box.width / n)); + + } else if (y > box.y && y < box.y + box.height) + flipRow((y - box.y) / (box.height / n)); + + if (solved(grid, target)) + solved = true; + + printGrid(solved ? "Solved!" : "The board", grid); + } + repaint(); + } + }); + } + + void startNewGame() { + if (solved) { + + n = (n == maxLevel) ? minLevel : n + 1; + + grid = new int[n][n]; + target = new int[n][n]; + + do { + shuffle(); + + for (int i = 0; i < n; i++) + target[i] = Arrays.copyOf(grid[i], n); + + shuffle(); + + } while (solved(grid, target)); + + solved = false; + printGrid("The target", target); + printGrid("The board", grid); + } + } + + void printGrid(String msg, int[][] g) { + System.out.println(msg); + for (int[] row : g) + System.out.println(Arrays.toString(row)); + System.out.println(); + } + + boolean solved(int[][] a, int[][] b) { + for (int i = 0; i < n; i++) + if (!Arrays.equals(a[i], b[i])) + return false; + return true; + } + + void shuffle() { + for (int i = 0; i < n * n; i++) { + if (rand.nextBoolean()) + flipRow(rand.nextInt(n)); + else + flipCol(rand.nextInt(n)); + } + } + + void flipRow(int r) { + for (int c = 0; c < n; c++) { + grid[r][c] ^= 1; + } + } + + void flipCol(int c) { + for (int[] row : grid) { + row[c] ^= 1; + } + } + + void drawGrid(Graphics2D g) { + g.setColor(getForeground()); + + if (solved) + g.drawString("Solved! Click here to play again.", 180, 600); + else + g.drawString("Click next to a row or a column to flip.", 170, 600); + + int size = box.width / n; + + for (int r = 0; r < n; r++) + for (int c = 0; c < n; c++) { + g.setColor(grid[r][c] == 1 ? Color.blue : Color.orange); + g.fillRect(box.x + c * size, box.y + r * size, size, size); + g.setColor(getBackground()); + g.drawRect(box.x + c * size, box.y + r * size, size, size); + g.setColor(target[r][c] == 1 ? Color.blue : Color.orange); + g.fillRect(7 + box.x + c * size, 7 + box.y + r * size, 10, 10); + } + } + + @Override + public void paintComponent(Graphics gg) { + super.paintComponent(gg); + Graphics2D g = (Graphics2D) gg; + g.setRenderingHint(RenderingHints.KEY_ANTIALIASING, + RenderingHints.VALUE_ANTIALIAS_ON); + + drawGrid(g); + } + + public static void main(String[] args) { + SwingUtilities.invokeLater(() -> { + JFrame f = new JFrame(); + f.setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE); + f.setTitle("Flipping Bits Game"); + f.setResizable(false); + f.add(new FlippingBitsGame(), BorderLayout.CENTER); + f.pack(); + f.setLocationRelativeTo(null); + f.setVisible(true); + }); + } +} diff --git a/Task/Flipping-bits-game/JavaScript/flipping-bits-game.js b/Task/Flipping-bits-game/JavaScript/flipping-bits-game.js new file mode 100644 index 0000000000..5914bb8d3a --- /dev/null +++ b/Task/Flipping-bits-game/JavaScript/flipping-bits-game.js @@ -0,0 +1,96 @@ +function numOfRows(board) { return board.length; } +function numOfCols(board) { return board[0].length; } +function boardToString(board) { + // First the top-header + var header = ' '; + for (var c = 0; c < numOfCols(board); c++) + header += c + ' '; + + // Then the side-header + board + var sideboard = []; + for (var r = 0; r < numOfRows(board); r++) { + sideboard.push(r + ' [' + board[r].join(' ') + ']'); + } + + return header + '\n' + sideboard.join('\n'); +} +function flipRow(board, row) { + for (var c = 0; c < numOfCols(board); c++) { + board[row][c] = 1 - board[row][c]; + } +} +function flipCol(board, col) { + for (var r = 0; r < numOfRows(board); r++) { + board[r][col] = 1 - board[r][col]; + } +} + +function playFlippingBitsGame(rows, cols) { + rows = rows | 3; + cols = cols | 3; + var targetBoard = []; + var manipulatedBoard = []; + // Randomly generate two identical boards. + for (var r = 0; r < rows; r++) { + targetBoard.push([]); + manipulatedBoard.push([]); + for (var c = 0; c < cols; c++) { + targetBoard[r].push(Math.floor(Math.random() * 2)); + manipulatedBoard[r].push(targetBoard[r][c]); + } + } + // Naive-scramble one of the boards. + while (boardToString(targetBoard) == boardToString(manipulatedBoard)) { + var scrambles = rows * cols; + while (scrambles-- > 0) { + if (0 == Math.floor(Math.random() * 2)) { + flipRow(manipulatedBoard, Math.floor(Math.random() * rows)); + } + else { + flipCol(manipulatedBoard, Math.floor(Math.random() * cols)); + } + } + } + // Get the user to solve. + alert( + 'Try to match both boards.\n' + + 'Enter `r` or `c` to manipulate a row or col or enter `q` to quit.' + ); + var input = '', letter, num, moves = 0; + while (boardToString(targetBoard) != boardToString(manipulatedBoard) && input != 'q') { + input = prompt( + 'Target:\n' + boardToString(targetBoard) + + '\n\n\n' + + 'Board:\n' + boardToString(manipulatedBoard) + ); + try { + letter = input.charAt(0); + num = parseInt(input.slice(1)); + if (letter == 'q') + break; + if (isNaN(num) + || (letter != 'r' && letter != 'c') + || (letter == 'r' && num >= rows) + || (letter == 'c' && num >= cols) + ) { + throw new Error(''); + } + if (letter == 'r') { + flipRow(manipulatedBoard, num); + } + else { + flipCol(manipulatedBoard, num); + } + moves++; + } + catch(e) { + alert('Uh-oh, there seems to have been an input error'); + } + } + if (input == 'q') { + alert('~~ Thanks for playing ~~'); + } + else { + alert('Completed in ' + moves + ' moves.'); + } +} diff --git a/Task/Flipping-bits-game/Maple/flipping-bits-game.maple b/Task/Flipping-bits-game/Maple/flipping-bits-game.maple new file mode 100644 index 0000000000..7542ab9652 --- /dev/null +++ b/Task/Flipping-bits-game/Maple/flipping-bits-game.maple @@ -0,0 +1,107 @@ +FlippingBits := module() + export ModuleApply; + local gameSetup, flip, printGrid, checkInput; + local board; + + gameSetup := proc(n) + local r, c, i, toFlip, target; + randomize(): + target := Array( 1..n, 1..n, rand(0..1) ); + board := copy(target); + for i to rand(3..9)() do + toFlip := [0, 0]; + toFlip[1] := StringTools[Random](1, "rc"); + toFlip[2] := convert(rand(1..n)(), string); + flip(toFlip); + end do; + return target; + end proc; + + flip := proc(line) + local i, lineNum; + lineNum := parse(op(line[2..-1])); + for i to upperbound(board)[1] do + if line[1] = "R" then + board[lineNum, i] := `if`(board[lineNum, i] = 0, 1, 0); + else + board[i, lineNum] := `if`(board[i, lineNum] = 0, 1, 0); + end if; + end do; + return NULL; + end proc; + + printGrid := proc(grid) + local r, c; + for r to upperbound(board)[1] do + for c to upperbound(board)[1] do + printf("%a ", grid[r, c]); + end do; + printf("\n"); + end do; + printf("\n"); + return NULL; + end proc; + + checkInput := proc(input) + try + if input[1] = "" then + return false, ""; + elif not input[1] = "R" and not input[1] = "C" then + return false, "Please start with 'r' or 'c'."; + elif not type(parse(op(input[2..-1])), posint) then + error; + elif parse(op(input[2..-1])) < 1 or parse(op(input[2..-1])) > upperbound(board)[1] then + return false, "Row or column number too large or too small."; + end if; + catch: + return false, "Please indicate a row or column number." + end try; + return true, ""; + end proc; + + ModuleApply := proc(n) + local gameOver, toFlip, target, answer, restart; + restart := true; + while restart do + target := gameSetup(n); + while ArrayTools[IsEqual](target, board) do + target := gameSetup(n); + end do; + gameOver := false; + while not gameOver do + printf("The Target:\n"); + printGrid(target); + printf("The Board:\n"); + printGrid(board); + if ArrayTools[IsEqual](target, board) then + printf("You win!! Press enter to play again or type END to quit.\n\n"); + answer := StringTools[UpperCase](readline()); + gameOver := true; + if answer = "END" then + restart := false + end if; + else + toFlip := ["", ""]; + while not checkInput(toFlip)[1] and not gameOver do + ifelse (not op(checkInput(toFlip)[2..-1]) = "", printf("%s\n\n", op(checkInput(toFlip)[2..-1])), NULL); + printf("Please enter a row or column to flip. (ex: r1 or c2) Press enter for a new game or type END to quit.\n\n"); + answer := StringTools[UpperCase](readline()); + if answer = "END" or answer = "" then + gameOver := true; + if answer = "END" then + restart := false; + end if; + end if; + toFlip := [substring(answer, 1), substring(answer, 2..-1)]; + end do; + if not gameOver then + flip(toFlip); + end if; + end if; + end do; + end do; + printf("Game Over!\n"); + end proc; +end module: + +FlippingBits(3); diff --git a/Task/Flipping-bits-game/REXX/flipping-bits-game.rexx b/Task/Flipping-bits-game/REXX/flipping-bits-game.rexx index 2859ae6731..7653d874fe 100644 --- a/Task/Flipping-bits-game/REXX/flipping-bits-game.rexx +++ b/Task/Flipping-bits-game/REXX/flipping-bits-game.rexx @@ -1,86 +1,85 @@ -/*REXX program presents a "flipping bit" puzzle, user can solve via C.L.*/ -parse arg N u on off . /*get optional arguments. */ -if N=='' | N==',' then N=3 /*Size given? Then use default.*/ -if u=='' | u==',' then u=N /*number of bits initialized ON.*/ -if on =='' then on =1 /*character used for "on". */ -if off=='' then off=0 /*character used for "off". */ -col@='a b c d e f g h i j k l m n o p q r s t u v w x y z' /*for col id.*/ -cols=space(col@,0); upper cols /*letters to be used for columns.*/ -@.=off; !.=off /*set both arrays to "off" chars.*/ -tries=0 /*# of player's attempts used. */ - do while show(0) < u /* [↓] turn "on" U bits.*/ - r=random(1,N); c=random(1,N) /*get a random row and column.*/ - @.r.c=on ; !.r.c=on /*set (both) row & column to ON*/ - end /*while*/ /* [↑] keep going 'til U bits set*/ -oz=z /*keep the original array string.*/ -call show 1, ' ◄───target' /*show target for user to attain.*/ +/*REXX program presents a "flipping bit" puzzle. The user can solve via it via C.L. */ +parse arg N u on off . /*get optional arguments from the C.L. */ +if N=='' | N=="," then N =3 /*Size given? Then use default of 3.*/ +if u=='' | u=="," then u =N /*the number of bits initialized to ON.*/ +if on =='' then on =1 /*the character used for "on". */ +if off=='' then off=0 /* " " " " "off". */ +col@= 'a b c d e f g h i j k l m n o p q r s t u v w x y z' /*for the column id.*/ +cols=space(col@,0); upper cols /*letters to be used for the columns. */ +@.=off; !.=off /*set both arrays to "off" characters.*/ +tries=0 /*number of player's attempts (so far).*/ + do while show(0) < u /* [↓] turn "on" U number of bits.*/ + r=random(1,N); c=random(1,N) /*get a random row and column. */ + @.r.c=on ; !.r.c=on /*set (both) row and column to ON. */ + end /*while*/ /* [↑] keep going 'til U bits set.*/ +oz=z /*keep the original array string. */ +call show 1, ' ◄───target' /*show target for user to attain. */ - do random(1,2); call flip 'R',random(1,N) /*flip a row of bits*/ - call flip 'C',random(1,N) /* " " col " " */ - end /*random···*/ /* [↑] 1 or 2 times*/ + do random(1,2); call flip 'R',random(1,N) /*flip a row of bits. */ + call flip 'C',random(1,N) /* " " column " " */ + end /*random···*/ /* [↑] just perform 1 or 2 times. */ -if z==oz then call flip 'R',random(1,N) /*ensure it's not the target.*/ +if z==oz then call flip 'R',random(1,N) /*ensure it's not target we're flipping*/ - do until z==oz /*prompt until they get it right.*/ - call prompt /*get a row or column # from C.L.*/ - call flip left(?,1),substr(?,2) /*flip a user selected row or col*/ - call show 0 /*get image (Z) of updated array.*/ + do until z==oz /*prompt until they get it right. */ + call prompt /*get a row or column number from C.L. */ + call flip left(?,1),substr(?,2) /*flip a user selected row or column. */ + call show 0 /*get image (Z) of the updated array. */ end /*until···*/ -call show 1, ' ◄───your array' /*display the array to the screen*/ +call show 1, ' ◄───your array' /*display the array to the terminal. */ say '─────────Congrats! You did it in' tries "tries." -exit tries /*stick a fork in it, we're done.*/ -/*──────────────────────────────────FLIP subroutine────────────────────────*/ -flip: parse arg x,# /*X is R or C, # is which one.*/ - do c=1 for N while x=='R'; if @.#.c==on then @.#.c=off; else @.#.c=on; end - do r=1 for N while x=='C'; if @.r.#==on then @.r.#=off; else @.r.#=on; end -return /* [↑] the bits can be ON or OFF*/ -/*──────────────────────────────────PROMPTER subroutine─────────────────*/ -prompt: if tries\==0 then say '─────────bit array after play: ' tries -signal on halt /*another way for player to quit.*/ -!='─────────Please enter a row number or column letter, or Quit:' -call show 1, ' ◄───your array' /*display the array to the screen*/ +exit tries /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +halt: say 'program was halted!'; exit /*the REXX program was halted by user. */ +isInt: return datatype(arg(1),'W') /*returns 1 if arg is an integer.*/ +isLet: return datatype(arg(1),'M') /*returns 1 if arg is a letter. */ +terr: if ok then say '***error!***: illegal' arg(1); ok=0; return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +flip: parse arg x,# /*X is R or C; #: is which one.*/ + do c=1 for N while x=='R'; if @.#.c==on then @.#.c=off; else @.#.c=on; end + do r=1 for N while x=='C'; if @.r.#==on then @.r.#=off; else @.r.#=on; end + return /* [↑] the bits can be ON or OFF. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +prompt: if tries\==0 then say '─────────bit array after play: ' tries + signal on halt /*another method for the player to quit*/ + !='─────────Please enter a row number or column letter, or Quit:' + call show 1, ' ◄───your array' /*display the array to the terminal. */ - do forever; ok=1; say; say !; pull ? _ . 1 all /*prompt & get ans*/ - if abbrev('QUIT',?,1) then do; say 'quitting···'; exit 0; end - if ?=='' then do; call show 1,' ◄───target',.; ok=0 - call show 1,' ◄───your array' - end /* [↑] reshow targ*/ - if _\=='' then call terr 'too many args entered:' all - if \isInt(?) & \isLet(?) then call terr 'row/column: ' ? - if isLet(?) then a=pos(?,cols) - if isLet(?) & (a<1 | a>N) then call terr 'column: ' ? - if isLet(?) & length(?)>1 then call terr 'column: ' ? - if isLet(?) then ?='C'pos(?,cols) - if isInt(?) & (?<1 | ?>N) then call terr 'row: ' ? - if isInt(?) then ?=?/1 /*normalize number*/ - if isInt(?) then ?='R'? - if ok then leave /*No errors? Leave*/ - end /*forever*/ /*endeth da checks*/ + do forever; ok=1; say; say !; pull ? _ . 1 all /*prompt & get ans*/ + if abbrev('QUIT',?,1) then do; say 'quitting···'; exit 0; end + if ?=='' then do; call show 1," ◄───target",.; ok=0 + call show 1," ◄───your array" + end /* [↑] reshow targ*/ + if _\=='' then call terr 'too many args entered:' all + if \isInt(?) & \isLet(?) then call terr 'row/column: ' ? + if isLet(?) then a=pos(?,cols) + if isLet(?) & (a<1 | a>N) then call terr 'column: ' ? + if isLet(?) & length(?)>1 then call terr 'column: ' ? + if isLet(?) then ?='C'pos(?,cols) + if isInt(?) & (?<1 | ?>N) then call terr 'row: ' ? + if isInt(?) then ?=?/1 /*normalize number*/ + if isInt(?) then ?='R'? + if ok then leave /*No errors? Leave*/ + end /*forever*/ /*end of da checks*/ -tries=tries+1 /*bump da counter.*/ -return ? /*return response.*/ -/*──────────────────────────────────SHOW subroutine─────────────────────*/ -show: $=0; _=; z=; parse arg tell,tx,o /*$: # of ON bits.*/ -if tell then do /*are we telling? */ - say /*show blank line.*/ - say ' ' subword(col@,1,N) " column letter" - say 'row ╔'copies('═',N+N+1) /*prepend col hdrs*/ - end /* [↑] grid hdrs.*/ + tries=tries+1 /*bump da counter.*/ + return ? /*return response.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +show: $=0; _=; z=; parse arg tell,tx,o /*$: # of ON bits.*/ + if tell then do; say /*are we telling? */ + say ' ' subword(col@,1,N) " column letter" + say 'row ╔'copies('═',N+N+1) /*prepend col hdrs*/ + end /* [↑] grid hdrs.*/ - do r=1 for N /*show grid rows.*/ - do c=1 for N /*build grid cols.*/ - if o==. then do; z=z || !.r.c; _=_ !.r.c; $=$+(!.r.c==on); end - else do; z=z || @.r.c; _=_ @.r.c; $=$+(@.r.c==on); end - end /*c*/ /*··· and sum ONs.*/ - if tx\=='' then tar.r=_ tx /*build da target?*/ - if tell then say right(r,2) ' ║'_ tx; _= /*show the grid? */ - end /*r*/ /*show a grid row.*/ + do r=1 for N /*show grid rows.*/ + do c=1 for N /*build grid cols.*/ + if o==. then do; z=z || !.r.c; _=_ !.r.c; $=$+(!.r.c==on); end + else do; z=z || @.r.c; _=_ @.r.c; $=$+(@.r.c==on); end + end /*c*/ /*··· and sum ONs.*/ + if tx\=='' then tar.r=_ tx /*build da target?*/ + if tell then say right(r,2) ' ║'_ tx; _= /*show the grid? */ + end /*r*/ /*show a grid row.*/ -if tell then say /*show blank line.*/ -return $ /*$: # of ON bits.*/ -/*──────────────────────────────────one-liner subroutines───────────────*/ -halt: say 'program was halted!'; exit /*the REXX program was halted.*/ -isInt: return datatype(arg(1),'W') /*returns 1 if arg is an int. */ -isLet: return datatype(arg(1),'M') /*returns 1 if arg is a letter*/ -terr: if ok then say '***error!***: illegal' arg(1); ok=0; return + if tell then say /*show blank line.*/ + return $ /*$: # of ON bits.*/ diff --git a/Task/Flow-control-structures/00DESCRIPTION b/Task/Flow-control-structures/00DESCRIPTION index cc3385f61c..8e548f556d 100644 --- a/Task/Flow-control-structures/00DESCRIPTION +++ b/Task/Flow-control-structures/00DESCRIPTION @@ -1,5 +1,14 @@ {{Control Structures}} -In this task, we document common flow-control structures. -One common example of a flow-control structure is the goto construct. -Note that [[Conditional Structures]] and [[Iteration|Loop Structures]] -have their own articles/categories. + +;Task: +Document common flow-control structures. + +One common example of a flow-control structure is the   goto   construct. + +Note that   [[Conditional Structures]]   and   [[Iteration|Loop Structures]]   have their own articles/categories. + + +;Related tasks: +*   [[Conditional Structures]] +*   [[Iteration|Loop Structures]] +

    diff --git a/Task/Flow-control-structures/COBOL/flow-control-structures-4.cobol b/Task/Flow-control-structures/COBOL/flow-control-structures-4.cobol index b4575aaacc..161cfd10b6 100644 --- a/Task/Flow-control-structures/COBOL/flow-control-structures-4.cobol +++ b/Task/Flow-control-structures/COBOL/flow-control-structures-4.cobol @@ -1,23 +1,38 @@ - PROGRAM-ID. Perform-Example. + identification division. + program-id. altering. - PROCEDURE DIVISION. - Main. - PERFORM Moo - PERFORM Display-Stuff - PERFORM Boo THRU Moo + procedure division. + main section. - GOBACK - . + *> And now for some altering. + contrived. + ALTER story TO PROCEED TO beginning + GO TO story + . - Display-Stuff SECTION. - Foo. - DISPLAY "Foo " WITH NO ADVANCING - . + *> Jump to a part of the story + story. + GO. + . - Boo. - DISPLAY "Boo " WITH NO ADVANCING - . + *> the first part + beginning. + ALTER story TO PROCEED to middle + DISPLAY "This is the start of a changing story" + GO TO story + . - Moo. - DISPLAY "Moo" - . + *> the middle bit + middle. + ALTER story TO PROCEED to ending + DISPLAY "The story progresses" + GO TO story + . + + *> the climatic finish + ending. + DISPLAY "The story ends, happily ever after" + . + + *> fall through to the exit + exit program. diff --git a/Task/Flow-control-structures/COBOL/flow-control-structures-5.cobol b/Task/Flow-control-structures/COBOL/flow-control-structures-5.cobol new file mode 100644 index 0000000000..b4575aaacc --- /dev/null +++ b/Task/Flow-control-structures/COBOL/flow-control-structures-5.cobol @@ -0,0 +1,23 @@ + PROGRAM-ID. Perform-Example. + + PROCEDURE DIVISION. + Main. + PERFORM Moo + PERFORM Display-Stuff + PERFORM Boo THRU Moo + + GOBACK + . + + Display-Stuff SECTION. + Foo. + DISPLAY "Foo " WITH NO ADVANCING + . + + Boo. + DISPLAY "Boo " WITH NO ADVANCING + . + + Moo. + DISPLAY "Moo" + . diff --git a/Task/Flow-control-structures/Fortran/flow-control-structures-1.f b/Task/Flow-control-structures/Fortran/flow-control-structures-1.f new file mode 100644 index 0000000000..01703f2bfa --- /dev/null +++ b/Task/Flow-control-structures/Fortran/flow-control-structures-1.f @@ -0,0 +1,12 @@ + ... + ASSIGN 1101 to WHENCE !Remember my return point. + GO TO 1000 !Dive into a "subroutine" + 1101 CONTINUE !Resume. + ... + ASSIGN 1102 to WHENCE !Prepare for another invocation. + GO TO 1000 !Like GOSUB in BASIC. + 1102 CONTINUE !Carry on. + ... +Common code, far away. + 1000 do something !This has all the context available. + GO TO WHENCE !Return whence I came. diff --git a/Task/Flow-control-structures/Fortran/flow-control-structures-2.f b/Task/Flow-control-structures/Fortran/flow-control-structures-2.f new file mode 100644 index 0000000000..93a162a374 --- /dev/null +++ b/Task/Flow-control-structures/Fortran/flow-control-structures-2.f @@ -0,0 +1,4 @@ + ASSIGN 2000 TO WHENCE !Deviant "return" from 1000 to invoke 2000. + ASSIGN 1103 TO THENCE !Desired return from 2000. + GO TO 1000 + 1103 CONTINUE diff --git a/Task/Flow-control-structures/Fortran/flow-control-structures-3.f b/Task/Flow-control-structures/Fortran/flow-control-structures-3.f new file mode 100644 index 0000000000..f316e2d9ce --- /dev/null +++ b/Task/Flow-control-structures/Fortran/flow-control-structures-3.f @@ -0,0 +1,6 @@ + SUBROUTINE FRED(X,*,*) !With placeholders for unusual parameters. + ... + RETURN !Normal return from FRED. + ... + RETURN 2 !Return to the second label. + END diff --git a/Task/Flow-control-structures/Fortran/flow-control-structures-4.f b/Task/Flow-control-structures/Fortran/flow-control-structures-4.f new file mode 100644 index 0000000000..e3dbfabcf5 --- /dev/null +++ b/Task/Flow-control-structures/Fortran/flow-control-structures-4.f @@ -0,0 +1,9 @@ + XX:DO WHILE(condition) + statements... + NN:DO I = 1,N + statements... + IF (...) EXIT XX + IF (...) CYCLE NN + statements... + END DO NN + END DO XX diff --git a/Task/Floyds-triangle/00DESCRIPTION b/Task/Floyds-triangle/00DESCRIPTION index 6372b0d521..d9d26f264f 100644 --- a/Task/Floyds-triangle/00DESCRIPTION +++ b/Task/Floyds-triangle/00DESCRIPTION @@ -1,14 +1,19 @@ -[[wp:Floyd's triangle|Floyd's triangle]] lists the natural numbers in a right triangle aligned to the left where -* the first row is just 1 +[[wp:Floyd's triangle|Floyd's triangle]]   lists the natural numbers in a right triangle aligned to the left where +* the first row is   '''1'''     (unity) * successive rows start towards the left with the next number followed by successive naturals listing one more number than the line above. + The first few lines of a Floyd triangle looks like this: -
     1
    +
    + 1
      2  3
      4  5  6
      7  8  9 10
    -11 12 13 14 15
    +11 12 13 14 15 +
    -The task is to: -# Write a program to generate and display here the first n lines of a Floyd triangle.
    (Use n=5 and n=14 rows). -# Ensure that when displayed in a monospace font, the numbers line up in vertical columns as shown and that only one space separates numbers of the last row. + +;Task: +:# Write a program to generate and display here the first   n   lines of a Floyd triangle.
    (Use   n=5   and   n=14   rows). +:# Ensure that when displayed in a mono-space font, the numbers line up in vertical columns as shown and that only one space separates numbers of the last row. +

    diff --git a/Task/Floyds-triangle/CoffeeScript/floyds-triangle.coffee b/Task/Floyds-triangle/CoffeeScript/floyds-triangle.coffee new file mode 100644 index 0000000000..f591e29624 --- /dev/null +++ b/Task/Floyds-triangle/CoffeeScript/floyds-triangle.coffee @@ -0,0 +1,20 @@ +triangle = (array) -> for n in array + console.log "#{n} rows:" + printMe = 1 + printed = 0 + row = 1 + to_print = "" + while row <= n + cols = Math.ceil(Math.log10(n * (n - 1) / 2 + printed + 2.0)) + p = ("" + printMe).length + while p++ <= cols + to_print += ' ' + to_print += printMe + ' ' + if ++printed == row + console.log to_print + to_print = "" + row++ + printed = 0 + printMe++ + +triangle [5, 14] diff --git a/Task/Floyds-triangle/Kotlin/floyds-triangle.kotlin b/Task/Floyds-triangle/Kotlin/floyds-triangle.kotlin new file mode 100644 index 0000000000..6a8bb08d98 --- /dev/null +++ b/Task/Floyds-triangle/Kotlin/floyds-triangle.kotlin @@ -0,0 +1,16 @@ +fun main(args: Array) = args.forEach { Triangle(it.toInt()) } + +internal class Triangle(n: Int) { + init { + println("$n rows:") + var printMe = 1 + var printed = 0 + var row = 1 + while (row <= n) { + val cols = Math.ceil(Math.log10(n * (n - 1) / 2 + printed + 2.0)).toInt() + print("%${cols}d ".format(printMe)) + if (++printed == row) { println(); row++; printed = 0 } + printMe++ + } + } +} diff --git a/Task/Floyds-triangle/Maple/floyds-triangle.maple b/Task/Floyds-triangle/Maple/floyds-triangle.maple new file mode 100644 index 0000000000..c5f6d604ca --- /dev/null +++ b/Task/Floyds-triangle/Maple/floyds-triangle.maple @@ -0,0 +1,31 @@ +floyd := proc(rows) + local num, numRows, numInRow, i, digits; + digits := Array([]); + for i to 2 do + num := 1; + numRows := 1; + numInRow := 1; + while numRows <= rows do + if i = 2 then + printf(cat("%", digits[numInRow], "a "), num); + end if; + num := num + 1; + if i = 1 and numRows = rows then + digits(numInRow) := StringTools[Length](convert(num-1, string)); + end if; + if numInRow >= numRows then + if i = 2 then + printf("\n"); + end if; + numInRow := 1; + numRows := numRows + 1; + else + numInRow := numInRow +1; + end if; + end do; + end do; + return NULL; +end proc: + +floyd(5); +floyd(14); diff --git a/Task/Floyds-triangle/NetRexx/floyds-triangle-2.netrexx b/Task/Floyds-triangle/NetRexx/floyds-triangle-2.netrexx index 2fdc1a92ef..7af0993923 100644 --- a/Task/Floyds-triangle/NetRexx/floyds-triangle-2.netrexx +++ b/Task/Floyds-triangle/NetRexx/floyds-triangle-2.netrexx @@ -2,7 +2,7 @@ options replace format comments java crossref symbols binary /*REXX program constructs & displays Floyd's triangle for any number of rows.*/ parse arg numRows . -if numRows == '' then numRows = 1 -- assume 1 row is not given +if numRows == '' then numRows = 1 -- assume 1 row if not given maxVal = numRows * (numRows + 1) % 2 -- calculate the max value. say 'displaying a' numRows "row Floyd's triangle:" say diff --git a/Task/Floyds-triangle/Perl-6/floyds-triangle-1.pl6 b/Task/Floyds-triangle/Perl-6/floyds-triangle-1.pl6 new file mode 100644 index 0000000000..ddc3bc73a7 --- /dev/null +++ b/Task/Floyds-triangle/Perl-6/floyds-triangle-1.pl6 @@ -0,0 +1 @@ +constant @floyd = (1..*).rotor(1..*); diff --git a/Task/Floyds-triangle/Perl-6/floyds-triangle-2.pl6 b/Task/Floyds-triangle/Perl-6/floyds-triangle-2.pl6 new file mode 100644 index 0000000000..ac9ffc8abb --- /dev/null +++ b/Task/Floyds-triangle/Perl-6/floyds-triangle-2.pl6 @@ -0,0 +1 @@ +constant @floyd = gather for 1..* -> $s { take [++$ xx $s] } diff --git a/Task/Floyds-triangle/Perl-6/floyds-triangle.pl6 b/Task/Floyds-triangle/Perl-6/floyds-triangle-3.pl6 similarity index 76% rename from Task/Floyds-triangle/Perl-6/floyds-triangle.pl6 rename to Task/Floyds-triangle/Perl-6/floyds-triangle-3.pl6 index 457bf655a5..66f332491a 100644 --- a/Task/Floyds-triangle/Perl-6/floyds-triangle.pl6 +++ b/Task/Floyds-triangle/Perl-6/floyds-triangle-3.pl6 @@ -1,5 +1,3 @@ -constant @floyd = gather for 1..* -> $s { take [++$ xx $s] } - sub say-floyd($n) { my @formats = @floyd[$n-1].map: {"%{.chars}s"} diff --git a/Task/Floyds-triangle/REXX/floyds-triangle-2.rexx b/Task/Floyds-triangle/REXX/floyds-triangle-2.rexx index 02d123761a..1809dbe8f6 100644 --- a/Task/Floyds-triangle/REXX/floyds-triangle-2.rexx +++ b/Task/Floyds-triangle/REXX/floyds-triangle-2.rexx @@ -1,11 +1,12 @@ -/*REXX pgm constructs & displays Floyd's triangle for any number of rows*/ -parse arg rows .; if rows=='' then rows=5 /*Not specified? Use default*/ -maxV = rows * (rows+1) % 2 /*calculate the max value. */ -say 'displaying a' rows "row Floyd's triangle:"; say /*show header*/ -#=1; do r=1 for rows; i=0; _= /*row by row.*/ - do #=# for r; i=i+1 /*start a row*/ - _ = _ right(#, length(maxV-rows+i)) /*build a row*/ - end /*#*/ /*row is done*/ - say substr(_,2) /*suppress the 1st leading blank,*/ - end /*r*/ /* [↑] introduced by 1st abutt.*/ - /*stick a fork in it, we're done.*/ +/*REXX program constructs & displays Floyd's triangle for any number of specified rows.*/ +parse arg rows .; if rows=='' then rows=5 /*Not specified? Then use the default.*/ +mx=rows * (rows+1) % 2 /*calculate maximum value of any value.*/ +say 'displaying a ' rows " row Floyd's triangle:" /*show header for the triangle.*/ +say +#=1; do r=1 for rows; i=0; _= /*construct Floyd's triangle row by row*/ + do #=# for r; i=i+1 /*start to construct a row of triangle.*/ + _=_ right(#, length(mx-rows+i)) /*build a row of the Floyd's triangle. */ + end /*#*/ + say substr(_,2) /*remove 1st leading blank in the line,*/ + end /*r*/ /* [↑] introduced by first abutment. */ + /*stick a fork in it, we're all done. */ diff --git a/Task/Floyds-triangle/REXX/floyds-triangle-3.rexx b/Task/Floyds-triangle/REXX/floyds-triangle-3.rexx index d24ef2c0aa..848d5b36bf 100644 --- a/Task/Floyds-triangle/REXX/floyds-triangle-3.rexx +++ b/Task/Floyds-triangle/REXX/floyds-triangle-3.rexx @@ -1,11 +1,12 @@ -/*REXX pgm displays Floyd's triangle for any number of rows in base 16.*/ -parse arg rows .; if rows=='' then rows=6 /*Not specified? Use default*/ -maxV = rows * (rows+1) % 2 /*calculate the max value. */ -say 'displaying a' rows "row Floyd's triangle in base 16:"; say /*hdr*/ -#=1; do r=1 for rows; i=0; _= /*row by row.*/ - do #=# for r; i=i+1 /*start a row*/ - _ = _ right(d2x(#), length(d2x(maxV - rows + i))) - end /*#*/ /* [↑] the triangle row is done.*/ - say substr(_,2) /*suppress the 1st leading blank,*/ - end /*r*/ /* [↑] introduced by 1st abutt.*/ - /*stick a fork in it, we're done.*/ +/*REXX program constructs & displays Floyd's triangle for any number of rows in base 16.*/ +parse arg rows .; if rows=='' then rows=6 /*Not specified? Then use the default.*/ +mx=rows * (rows+1) % 2 /*calculate maximum value of any value.*/ +say 'displaying a ' rows " row Floyd's triangle in base 16:"; say /*show triangle hdr*/ +#=1 + do r=1 for rows; i=0; _= /*construct Floyd's triangle row by row*/ + do #=# for r; i=i+1 /*start to construct a row of triangle.*/ + _=_ right(d2x(#),length(d2x(mx-rows+i))) /*build a row of the Floyd's triangle. */ + end /*#*/ + say substr(_,2) /*remove 1st leading blank in the line,*/ + end /*r*/ /* [↑] introduced by first abutment. */ + /*stick a fork in it, we're all done. */ diff --git a/Task/Floyds-triangle/REXX/floyds-triangle-4.rexx b/Task/Floyds-triangle/REXX/floyds-triangle-4.rexx index 63ded583c2..f975650beb 100644 --- a/Task/Floyds-triangle/REXX/floyds-triangle-4.rexx +++ b/Task/Floyds-triangle/REXX/floyds-triangle-4.rexx @@ -1,47 +1,50 @@ -/*REXX pgm displays Floyd's triangle for any # of rows up to base 90.*/ -parse arg rows b .; if rows=='' then rows=5 /*Not given? Use default.*/ -if b=='' then b=10 /*use base 10 if not given.*/ -maxV = rows * (rows+1) % 2 /*calculate the max value. */ -say 'displaying a' rows "row Floyd's triangle in base" b':'; say -#=1; do r=1 for rows; i=0; _= /*row by row.*/ - do #=# for r; i=i+1 /*start a row*/ - _ = _ right(base(#, b), length(base(maxV-rows+i, b))) - end /*#*/ /*row is done*/ - say substr(_,2) /*suppress the 1st leading blank,*/ - end /*r*/ /* [↑] introduced by 1st abutt.*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────BASE subroutine─────────────────────*/ -base: procedure; parse arg x 1 ox,toB,inB /*get number, toBase, inBase*/ -@abc='abcdefghijklmnopqrstuvwxyz' /*lowercase Latin alphabet. */ -@abcU=@abc; upper @abcU /*go whole hog and extend 'em. */ -@@@='0123456789'@abc || @abcU /*prefix 'em with numeric digits.*/ -@@@=@@@'<>[]{}()?~!@#$%^&*_=|\/;:¢¬≈' /*add some special chars as well.*/ - /*handles up to base 90, special chars must be viewable.*/ -numeric digits 1000 /*what the hey, support gihugeics*/ -maxB=length(@@@) /*max base (radix) supported here*/ -if toB=='' | toB==',' then toB=10 /*if skipped, assume default (10)*/ -if inB=='' | inB==',' then inB=10 /* " " " " " */ -if inB<2 | inb>maxB then call erb 'inBase',inB /*bad boy inBase.*/ -if toB<2 | tob>maxB then call erb 'toBase',toB /* " " toBase.*/ -if x=='' then call erm /* " " number.*/ -sigX=left(x,1); if pos(sigX,"-+")\==0 then x=substr(x,2) /*X has sign?*/ - else sigX= /*no sign. */ -#=0; do j=1 for length(x) /*convert X, base inB ──► base 10*/ - _=substr(x, j, 1) /*pick off a numeral from X. */ - v=pos(_, @@@) /*get the value of this "digit". */ - if v==0 | v>inB then call erd x,j,inB /*illegal "digit"? */ - #=#*inB+v-1 /*construct new num, dig by dig. */ - end /*j*/ -y= - do while #>=toB /*convert #, base 10 ──► base toB*/ - y=substr(@@@, (#//toB)+1, 1)y /*construct the number for output*/ - #=#%toB /*··· and whittle # down also. */ - end /*while #≥toB*/ +/*REXX program constructs/shows Floyd's triangle for any number of rows in any base ≤90.*/ +parse arg rows radx . /*obtain optional arguments from the CL*/ +if rows=='' | rows=="," then rows= 5 /*Not specified? Then use the default.*/ +if radx=='' | radx=="," then radx=10 /* " " " " " " */ +mx=rows * (rows+1) % 2 /*calculate maximum value of any value.*/ +say 'displaying a ' rows " row Floyd's triangle in base" radx':'; say /*display hdr*/ +#=1 + do r=1 for rows; i=0; _= /*construct Floyd's triangle row by row*/ + do #=# for r; i=i+1 /*start to construct a row of triangle.*/ + _=_ right(base(#, radx), length(base(mx-rows+i, radx))) /*build triangle row*/ + end /*#*/ + say substr(_,2) /*remove 1st leading blank in the line,*/ + end /*r*/ /* [↑] introduced by first abutment. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +base: procedure; parse arg x 1 ox,toB,inB /*obtain number, toBase, inBase. */ + @abc='abcdefghijklmnopqrstuvwxyz' /*lowercase Latin alphabet. */ + @abcU=@abc; upper @abcU /*go whole hog and extend 'em. */ + @@@='0123456789'@abc || @abcU /*prefix 'em with numeric digits.*/ + @@@=@@@'<>[]{}()?~!@#$%^&*_=|\/;:¢¬≈' /*add some special chars as well.*/ + /*handles up to base 90, all chars must be viewable.*/ + numeric digits 1000 /*what the hey, support gihugeics*/ + mxB=length(@@@) /*max base (radix) supported here*/ + if toB=='' | toB=="," then toB=10 /*if skipped, assume default (10)*/ + if inB=='' | inB=="," then inB=10 /* " " " " " */ + if inB<2 | inb>mxB then call erb 'inBase',inB /*invalid/illegal arg: inBase. */ + if toB<2 | tob>mxB then call erb 'toBase',toB /* " " " toBase. */ + if x=='' then call erm /* " " " number. */ + sigX=left(x,1) + if pos(sigX,'-+')\==0 then x=substr(x,2) /*X number has a leading sign? */ + else sigX= /* ··· no leading sign.*/ + #=0; do j=1 for length(x) /*convert X, base inB ──► base 10*/ + _=substr(x, j, 1) /*pick off a numeral from X. */ + v=pos(_, @@@) /*get the value of this "digit". */ + if v==0 | v>inB then call erd x,j,inB /*is this an illegal "numeral" ? */ + #=#*inB+v-1 /*construct new num, dig by dig. */ + end /*j*/ + y= + do while # >= toB /*convert #, base 10 ──► base toB*/ + y=substr(@@@, (#//toB)+1, 1)y /*construct the number for output*/ + #=#%toB /* ··· and whittle # down also.*/ + end /*while*/ -y=sigX || substr(@@@, #+1, 1)y /*prepend the sign if it existed.*/ -return y /*rturn the number in base toB. */ -/*──────────────────────────────────error subroutines───────────────────*/ -erb: call ser 'illegal' arg(2) "base:" arg(1) "must be in range: 2──►" maxB -erd: call ser 'illegal "digit" in' x":" _ -erm: call ser 'no argument specified.' -ser: say; say '*** error! ***'; say arg(1); say; exit 13 + y=sigX || substr(@@@, #+1, 1)y /*prepend the sign if it existed.*/ + return y /*return the number in base toB.*/ +/*───────────────────────────────────────────────────────────────────────────────────────*/ +erb: call ser 'illegal' arg(2) "base:" arg(1) "must be in range: 2──►" mxB +erd: call ser 'illegal "digit" in' x":" _ +erm: call ser 'no argument specified.' +ser: say; say '*** error! ***'; say arg(1); say; exit 13 diff --git a/Task/Floyds-triangle/Run-BASIC/floyds-triangle.run b/Task/Floyds-triangle/Run-BASIC/floyds-triangle.run index 0d8d4ab488..f80fee145a 100644 --- a/Task/Floyds-triangle/Run-BASIC/floyds-triangle.run +++ b/Task/Floyds-triangle/Run-BASIC/floyds-triangle.run @@ -1,9 +1,14 @@ -input " Number of rows:"; rows -html "" -for r = 1 to rows ' r = rows - html "" - for c = 1 to r ' c = columns - j = j + 1 - html "" - next c -next r +input "Number of rows: "; rows +dim colSize(rows) +for col=1 to rows + colSize(col) = len(str$(col + rows * (rows-1)/2)) +next + +thisNum = 1 +for r = 1 to rows + for col = 1 to r + print right$( " "+str$(thisNum), colSize(col)); " "; + thisNum = thisNum + 1 + next + print +next diff --git a/Task/Floyds-triangle/ZX-Spectrum-Basic/floyds-triangle.zx b/Task/Floyds-triangle/ZX-Spectrum-Basic/floyds-triangle.zx new file mode 100644 index 0000000000..ef257c5238 --- /dev/null +++ b/Task/Floyds-triangle/ZX-Spectrum-Basic/floyds-triangle.zx @@ -0,0 +1,9 @@ +10 LET n=10: LET j=1: LET col=1 +20 FOR r=1 TO n +30 FOR j=j TO j+r-1 +40 PRINT TAB (col);j; +50 LET col=col+3 +60 NEXT j +70 PRINT +80 LET col=1 +90 NEXT r diff --git a/Task/Forest-fire/00DESCRIPTION b/Task/Forest-fire/00DESCRIPTION index 5386b19475..12c522eaec 100644 --- a/Task/Forest-fire/00DESCRIPTION +++ b/Task/Forest-fire/00DESCRIPTION @@ -1,17 +1,25 @@ {{wikipedia|Forest-fire model}}[[Category:Cellular automata]] + +
    +;Task: Implement the Drossel and Schwabl definition of the [[wp:Forest-fire model|forest-fire model]]. -It is basically a 2D [[wp:Cellular automaton|cellular automaton]] where each cell can be in three distinct states (''empty'', ''tree'' and ''burning'') and evolves according to the following rules (as given by Wikipedia) + +It is basically a 2D   [[wp:Cellular automaton|cellular automaton]]   where each cell can be in three distinct states (''empty'', ''tree'' and ''burning'') and evolves according to the following rules (as given by Wikipedia) # A burning cell turns into an empty cell # A tree will burn if at least one neighbor is burning -# A tree ignites with probability ''f'' even if no neighbor is burning -# An empty space fills with a tree with probability ''p'' +# A tree ignites with probability   ''f''   even if no neighbor is burning +# An empty space fills with a tree with probability   ''p'' -Neighborhood is the [[wp:Moore neighborhood|Moore neighborhood]]; boundary conditions are so that on the boundary the cells are always empty ("fixed" boundary condition). +
    Neighborhood is the   [[wp:Moore neighborhood|Moore neighborhood]];   boundary conditions are so that on the boundary the cells are always empty ("fixed" boundary condition). At the beginning, populate the lattice with empty and tree cells according to a specific probability (e.g. a cell has the probability 0.5 to be a tree). Then, let the system evolve. -Task's requirements do not include graphical display or the ability to change parameters (probabilities ''p'' and ''f'') through a graphical or command line interface. +Task's requirements do not include graphical display or the ability to change parameters (probabilities   ''p''   and   ''f'' )   through a graphical or command line interface. -'''See also''' [[Conway's Game of Life]] and [[Wireworld]]. + +;Related tasks: +*   See   [[Conway's Game of Life]] +*   See   [[Wireworld]]. +

    diff --git a/Task/Forest-fire/BASIC/forest-fire-3.basic b/Task/Forest-fire/BASIC/forest-fire-3.basic index 0726239fc7..ec0b111cdf 100644 --- a/Task/Forest-fire/BASIC/forest-fire-3.basic +++ b/Task/Forest-fire/BASIC/forest-fire-3.basic @@ -1,96 +1,108 @@ '[RC] Forest Fire -'written for FreeBASIC v16 +'written for FreeBASIC 'Program code based on BASIC256 from Rosettacode website 'http://rosettacode.org/wiki/Forest_fire#BASIC256 +'06-10-2016 updated/tweaked the code +'compile with fbc -s gui -dim fire as double -dim p as single -P = 0.003 : fire = 0.00003 -gen = 0 -N = 400 : M = 400 +#Define M 400 +#Define N 640 -dim f0(-1 to N+2,-1 to M+2) -dim fn(-1 to N+2,-1 to M+2) -dim number1 as double +Dim As Double p = 0.003 +Dim As Double fire = 0.00003 +'Dim As Double number1 +Dim As Integer gen, x, y +Dim As String press -white = 15 'color 15 is white -yellow = 14 'color 14 is yellow -black = 0 'color 0 is black -green = 2 'color 2 is green -red = 4 'color 4 is red +'f0() and fn() use memory from the memory pool +Dim As UByte f0(), fn() +ReDim f0(-1 To N +2, -1 To M +2) +ReDim fn(-1 To N +2, -1 To M +2) -screen 18 'Resolution 640x480 with at least 256 colors -randomize timer +Dim As UByte white = 15 'color 15 is white +Dim As UByte yellow = 14 'color 14 is yellow +Dim As UByte black = 0 'color 0 is black +Dim As UByte green = 2 'color 2 is green +Dim As UByte red = 4 'color 4 is red -locate 28,1 - BEEP +Screen 18 'Resolution 640x480 with at least 256 colors +Randomize Timer + +Locate 28,1 +Beep Print " Welcome to Forest Fire" -locate 29,1 -print " press any key to start" -sleep -locate 28,1 -Print " Welcome to Forest Fire" -locate 29,1 -print " " +Locate 29,1 +Print " press any key to start" +Sleep +'Locate 28,1 +'Print " Welcome to Forest Fire" +Locate 29,1 +Print " " ' 1 tree, 0 empty, 2 fire -color green ' this is green color for trees -for x = 1 to N - for y = 1 to M - if rnd < 0.5 then 'populate original tree density - f0(x,y) = 1 - pset (x,y) - end if - next y -next x +Color green ' this is green color for trees +For x = 1 To N + For y = 1 To M + If Rnd < 0.5 Then 'populate original tree density + f0(x,y) = 1 + PSet (x,y) + End If + Next y +Next x -color white -locate 29,1 -Print " Press any key to continue " -sleep -locate 29,1 +Color white +Locate 29,1 +Print " Press any key to continue " +Sleep +Locate 29,1 Print " Press 'space bar' to continue/pause, ESC to stop " -do -press$ = inkey$ - for x = 1 to N - for y = 1 to M - if not f0(x,y) and rnd

    max - n=max - EndIf - ProcedureReturn n -EndProcedure - -Procedure SpreadFire(x,y) - Protected cnt=0, i, j - For i=Limit(x-1, 0, #Width) To Limit(x+1, 0, #Width) - For j=Limit(y-1, 0, #Height) To Limit(y+1, 0, #Height) - If Forest(i,j)>=#Tree - Forest(i,j)=#Ignited - EndIf - Next - Next -EndProcedure - -Procedure InitMap() - Protected x, y, type - For y=1 To #Height - For x=1 To #Width - If Rnd()<=#SeedATree - type=#Tree - Else - type=#Empty - EndIf - Forest(x,y)=type - Next - Next -EndProcedure - -Procedure UpdateMap() - Protected x, y - For y=1 To #Height - For x=1 To #Width - Select Forest(x,y) - Case #Burning - Forest(x,y)=#Empty - SpreadFire(x,y) - Case #Ignited - Forest(x,y)=#Burning - Case #Empty - If Rnd()<=#p - Forest(x,y)=#Tree - EndIf - Default - If Rnd()<=#f - Forest(x,y)=#Burning - Else - Forest(x,y)+1 - EndIf - EndSelect - Next - Next -EndProcedure - -Procedure PresentMap() - Protected x, y, c - cnt+1 - SetWindowTitle(0,Title$+", time frame="+Str(cnt)) - StartDrawing(ImageOutput(1)) - For y=0 To OutputHeight()-1 - For x=0 To OutputWidth()-1 - Select Forest(x,y) - Case #Empty - c=#BackGround - Case #Burning, #Ignited - c=#Fire - Default - If Forest(x,y)<#Tree+#Old - c=#YoungTree - ElseIf Forest(x,y)<#Tree+2*#Old - c=#NormalTree - ElseIf Forest(x,y)<#Tree+3*#Old - c=#MatureTree - ElseIf Forest(x,y)<#Tree+4*#Old - c=#OldTree - Else ; Tree died of old age - Forest(x,y)=#Empty - c=#Black - EndIf - EndSelect - Plot(x,y,c) - Next - CompilerIf #UnLoadCPU>1 - Delay(1) - CompilerEndIf - Next - StopDrawing() - ImageGadget(1, 0, 0, #Width, #Height, ImageID(1)) -EndProcedure - -If OpenWindow(0, 10, 30, #Width, #Height, Title$, #PB_Window_MinimizeGadget) - SmartWindowRefresh(0, 1) - If CreateImage(1, #Width, #Height) - Define Event, freq - If ExamineDesktops() And DesktopFrequency(0) - freq=DesktopFrequency(0) - Else - freq=60 - EndIf - AddWindowTimer(0,0,5000/freq) - InitMap() - Repeat - Event = WaitWindowEvent() - Select Event - Case #PB_Event_CloseWindow - End - Case #PB_Event_Timer - CompilerIf #UnLoadCPU>0 - Delay(25) - CompilerEndIf - UpdateMap() - PresentMap() - EndSelect - ForEver - EndIf -EndIf +width%=80 +height%=50 +DIM world%(width%+2,height%+2,2) +clock%=0 +' +empty%=0 ! some mnemonic codes for the different states +burning%=1 +tree%=2 +' +f=0.0003 +p=0.03 +max_clock%=100 +' +@open_window +@setup_world +DO + clock%=clock%+1 + EXIT IF clock%>max_clock% + @display_world + @update_world +LOOP +@close_window +' +' Setup the world +' +PROCEDURE setup_world + LOCAL i%,j% + ' + RANDOMIZE 0 + ARRAYFILL world%(),empty% + ' with Probability 0.5, create tree in cells + FOR i%=1 TO width% + FOR j%=1 TO height% + IF RND>0.5 + world%(i%,j%,0)=tree% + ENDIF + NEXT j% + NEXT i% + ' + cur%=0 + new%=1 +RETURN +' +' Display world on window +' +PROCEDURE display_world + LOCAL size%,i%,j%,offsetx%,offsety%,x%,y% + ' + size%=5 + offsetx%=10 + offsety%=20 + ' + VSETCOLOR 0,15,15,15 ! colour for empty + VSETCOLOR 1,15,0,0 ! colour for burning + VSETCOLOR 2,0,15,0 ! colour for tree + VSETCOLOR 3,0,0,0 ! colour for text + DEFTEXT 3 + PRINT AT(1,1);"Clock: ";clock% + ' + FOR i%=1 TO width% + FOR j%=1 TO height% + x%=offsetx%+size%*i% + y%=offsety%+size%*j% + SELECT world%(i%,j%,cur%) + CASE empty% + DEFFILL 0 + CASE tree% + DEFFILL 2 + CASE burning% + DEFFILL 1 + ENDSELECT + PBOX x%,y%,x%+size%,y%+size% + NEXT j% + NEXT i% +RETURN +' +' Check if a neighbour is burning +' +FUNCTION neighbour_burning(i%,j%) + LOCAL x% + ' + IF world%(i%,j%-1,cur%)=burning% + RETURN TRUE + ENDIF + IF world%(i%,j%+1,cur%)=burning% + RETURN TRUE + ENDIF + FOR x%=-1 TO 1 + IF world%(i%-1,j%+x%,cur%)=burning% OR world%(i%+1,j%+x%,cur%)=burning% + RETURN TRUE + ENDIF + NEXT x% + RETURN FALSE +ENDFUNC +' +' Update the world state +' +PROCEDURE update_world + LOCAL i%,j% + ' + FOR i%=1 TO width% + FOR j%=1 TO height% + world%(i%,j%,new%)=world%(i%,j%,cur%) + SELECT world%(i%,j%,cur%) + CASE empty% + IF RND>1-p + world%(i%,j%,new%)=tree% + ENDIF + CASE tree% + IF @neighbour_burning(i%,j%) OR RND>1-f + world%(i%,j%,new%)=burning% + ENDIF + CASE burning% + world%(i%,j%,new%)=empty% + ENDSELECT + NEXT j% + NEXT i% + ' + cur%=1-cur% + new%=1-new% +RETURN +' +' open and clear window +' +PROCEDURE open_window + OPENW 1 + CLEARW 1 + VSETCOLOR 4,8,8,0 + DEFFILL 4 + PBOX 0,0,500,400 +RETURN +' +' close the window after keypress +' +PROCEDURE close_window + ~INP(2) + CLOSEW 1 +RETURN diff --git a/Task/Forest-fire/BASIC/forest-fire-5.basic b/Task/Forest-fire/BASIC/forest-fire-5.basic index 09e3fcf37b..c81d950b54 100644 --- a/Task/Forest-fire/BASIC/forest-fire-5.basic +++ b/Task/Forest-fire/BASIC/forest-fire-5.basic @@ -1,65 +1,167 @@ -Sub Run() - //Handy named constants - Const empty = 0 - Const tree = 1 - Const fire = 2 - Const ablaze = &cFF0000 //Using the &c numeric operator to indicate a color in hex - Const alive = &c00FF00 - Const dead = &c804040 +; Some systems reports high CPU-load while running this code. +; This may likely be due to the graphic driver used in the +; 2D-function Plot(). +; If experiencing this problem, please reduce the #Width & #Height +; or activate the parameter #UnLoadCPU below with a parameter 1 or 2. +; +; This code should work with the demo version of PureBasic on both PC & Linux - //Our forest - Dim worldPic As New Picture(480, 480, 32) - Dim newWorld(120, 120) As Integer - Dim oldWorld(120, 120) As Integer +; General parameters for the world +#f = 1e-6 +#p = 1e-2 +#SeedATree = 0.005 +#Width = 400 +#Height = 400 - //Initialize forest - Dim rand As New Random - For x as Integer = 0 to 119 - For y as Integer = 0 to 119 - if rand.InRange(0, 2) = 0 Or x = 119 or y = 119 or x = 0 or y = 0 Then - newWorld(x, y) = empty - worldPic.Graphics.ForeColor = dead - worldPic.Graphics.FillRect(x*4, y*4, 4, 4) - Else - newWorld(x, y) = tree - worldPic.Graphics.ForeColor = alive - worldPic.Graphics.FillRect(x*4, y*4, 4, 4) - end if +; Setting up colours +#Fire = $080CF7 +#BackGround = $BFD5D3 +#YoungTree = $00E300 +#NormalTree = $00AC00 +#MatureTree = $009500 +#OldTree = $007600 +#Black = $000000 + +; Depending on your hardware, use this to control the speed/CPU-load. +; 0 = No load reduction +; 1 = Only active about every second frame +; 2 = '1' & release the CPU after each horizontal line. +#UnLoadCPU = 0 + +Enumeration + #Empty =0 + #Ignited + #Burning + #Tree + #Old=#Tree+20 +EndEnumeration + +Global Dim Forest.i(#Width, #Height) +Global Title$="Forest fire in PureBasic" +Global Cnt + +Macro Rnd() + (Random(2147483647)/2147483647.0) +EndMacro + +Procedure Limit(n, min, max) + If nmax + n=max + EndIf + ProcedureReturn n +EndProcedure + +Procedure SpreadFire(x,y) + Protected cnt=0, i, j + For i=Limit(x-1, 0, #Width) To Limit(x+1, 0, #Width) + For j=Limit(y-1, 0, #Height) To Limit(y+1, 0, #Height) + If Forest(i,j)>=#Tree + Forest(i,j)=#Ignited + EndIf Next Next - oldWorld = newWorld +EndProcedure - //Burn, baby burn! - While Window1.stop = False - For x as Integer = 0 To 119 - For y As Integer = 0 to 119 - Dim willBurn As Integer = rand.InRange(0, Window1.burnProb.Value) - Dim willGrow As Integer = rand.InRange(0, Window1.growProb.Value) - if x = 119 or y = 119 or x = 0 or y = 0 Then - Continue - end if - Select Case oldWorld(x, y) - Case empty - If willGrow = (Window1.growProb.Value) Then - newWorld(x, y) = tree - worldPic.Graphics.ForeColor = alive - worldPic.Graphics.FillRect(x*4, y*4, 4, 4) - end if - Case tree - if oldWorld(x - 1, y) = fire Or oldWorld(x, y - 1) = fire Or oldWorld(x + 1, y) = fire Or oldWorld(x, y + 1) = fire Or oldWorld(x + 1, y + 1) = fire Or oldWorld(x - 1, y - 1) = fire Or oldWorld(x - 1, y + 1) = fire Or oldWorld(x + 1, y - 1) = fire Or willBurn = (Window1.burnProb.Value) Then - newWorld(x, y) = fire - worldPic.Graphics.ForeColor = ablaze - worldPic.Graphics.FillRect(x*4, y*4, 4, 4) - end if - Case fire - newWorld(x, y) = empty - worldPic.Graphics.ForeColor = dead - worldPic.Graphics.FillRect(x*4, y*4, 4, 4) - End Select - Next +Procedure InitMap() + Protected x, y, type + For y=1 To #Height + For x=1 To #Width + If Rnd()<=#SeedATree + type=#Tree + Else + type=#Empty + EndIf + Forest(x,y)=type Next - Window1.Canvas1.Graphics.DrawPicture(worldPic, 0, 0) - oldWorld = newWorld - me.Sleep(Window1.speed.Value) - Wend -End Sub + Next +EndProcedure + +Procedure UpdateMap() + Protected x, y + For y=1 To #Height + For x=1 To #Width + Select Forest(x,y) + Case #Burning + Forest(x,y)=#Empty + SpreadFire(x,y) + Case #Ignited + Forest(x,y)=#Burning + Case #Empty + If Rnd()<=#p + Forest(x,y)=#Tree + EndIf + Default + If Rnd()<=#f + Forest(x,y)=#Burning + Else + Forest(x,y)+1 + EndIf + EndSelect + Next + Next +EndProcedure + +Procedure PresentMap() + Protected x, y, c + cnt+1 + SetWindowTitle(0,Title$+", time frame="+Str(cnt)) + StartDrawing(ImageOutput(1)) + For y=0 To OutputHeight()-1 + For x=0 To OutputWidth()-1 + Select Forest(x,y) + Case #Empty + c=#BackGround + Case #Burning, #Ignited + c=#Fire + Default + If Forest(x,y)<#Tree+#Old + c=#YoungTree + ElseIf Forest(x,y)<#Tree+2*#Old + c=#NormalTree + ElseIf Forest(x,y)<#Tree+3*#Old + c=#MatureTree + ElseIf Forest(x,y)<#Tree+4*#Old + c=#OldTree + Else ; Tree died of old age + Forest(x,y)=#Empty + c=#Black + EndIf + EndSelect + Plot(x,y,c) + Next + CompilerIf #UnLoadCPU>1 + Delay(1) + CompilerEndIf + Next + StopDrawing() + ImageGadget(1, 0, 0, #Width, #Height, ImageID(1)) +EndProcedure + +If OpenWindow(0, 10, 30, #Width, #Height, Title$, #PB_Window_MinimizeGadget) + SmartWindowRefresh(0, 1) + If CreateImage(1, #Width, #Height) + Define Event, freq + If ExamineDesktops() And DesktopFrequency(0) + freq=DesktopFrequency(0) + Else + freq=60 + EndIf + AddWindowTimer(0,0,5000/freq) + InitMap() + Repeat + Event = WaitWindowEvent() + Select Event + Case #PB_Event_CloseWindow + End + Case #PB_Event_Timer + CompilerIf #UnLoadCPU>0 + Delay(25) + CompilerEndIf + UpdateMap() + PresentMap() + EndSelect + ForEver + EndIf +EndIf diff --git a/Task/Forest-fire/BASIC/forest-fire-6.basic b/Task/Forest-fire/BASIC/forest-fire-6.basic index 150d62e642..09e3fcf37b 100644 --- a/Task/Forest-fire/BASIC/forest-fire-6.basic +++ b/Task/Forest-fire/BASIC/forest-fire-6.basic @@ -1,11 +1,65 @@ -Sub Open() - //First method to run on the creation of a new Window. We instantiate an instance of our forestFire thread and run it. - Dim fire As New forestFire - fire.Run() -End Sub +Sub Run() + //Handy named constants + Const empty = 0 + Const tree = 1 + Const fire = 2 + Const ablaze = &cFF0000 //Using the &c numeric operator to indicate a color in hex + Const alive = &c00FF00 + Const dead = &c804040 -stop As Boolean //a globally accessible property of Window1. Boolean properties default to False. + //Our forest + Dim worldPic As New Picture(480, 480, 32) + Dim newWorld(120, 120) As Integer + Dim oldWorld(120, 120) As Integer -Sub Pushbutton1.Action() - stop = True + //Initialize forest + Dim rand As New Random + For x as Integer = 0 to 119 + For y as Integer = 0 to 119 + if rand.InRange(0, 2) = 0 Or x = 119 or y = 119 or x = 0 or y = 0 Then + newWorld(x, y) = empty + worldPic.Graphics.ForeColor = dead + worldPic.Graphics.FillRect(x*4, y*4, 4, 4) + Else + newWorld(x, y) = tree + worldPic.Graphics.ForeColor = alive + worldPic.Graphics.FillRect(x*4, y*4, 4, 4) + end if + Next + Next + oldWorld = newWorld + + //Burn, baby burn! + While Window1.stop = False + For x as Integer = 0 To 119 + For y As Integer = 0 to 119 + Dim willBurn As Integer = rand.InRange(0, Window1.burnProb.Value) + Dim willGrow As Integer = rand.InRange(0, Window1.growProb.Value) + if x = 119 or y = 119 or x = 0 or y = 0 Then + Continue + end if + Select Case oldWorld(x, y) + Case empty + If willGrow = (Window1.growProb.Value) Then + newWorld(x, y) = tree + worldPic.Graphics.ForeColor = alive + worldPic.Graphics.FillRect(x*4, y*4, 4, 4) + end if + Case tree + if oldWorld(x - 1, y) = fire Or oldWorld(x, y - 1) = fire Or oldWorld(x + 1, y) = fire Or oldWorld(x, y + 1) = fire Or oldWorld(x + 1, y + 1) = fire Or oldWorld(x - 1, y - 1) = fire Or oldWorld(x - 1, y + 1) = fire Or oldWorld(x + 1, y - 1) = fire Or willBurn = (Window1.burnProb.Value) Then + newWorld(x, y) = fire + worldPic.Graphics.ForeColor = ablaze + worldPic.Graphics.FillRect(x*4, y*4, 4, 4) + end if + Case fire + newWorld(x, y) = empty + worldPic.Graphics.ForeColor = dead + worldPic.Graphics.FillRect(x*4, y*4, 4, 4) + End Select + Next + Next + Window1.Canvas1.Graphics.DrawPicture(worldPic, 0, 0) + oldWorld = newWorld + me.Sleep(Window1.speed.Value) + Wend End Sub diff --git a/Task/Forest-fire/BASIC/forest-fire-7.basic b/Task/Forest-fire/BASIC/forest-fire-7.basic index 049ad7a6d4..150d62e642 100644 --- a/Task/Forest-fire/BASIC/forest-fire-7.basic +++ b/Task/Forest-fire/BASIC/forest-fire-7.basic @@ -1,25 +1,11 @@ -graphic #g, 200,200 -dim preGen(200,200) -dim newGen(200,200) +Sub Open() + //First method to run on the creation of a new Window. We instantiate an instance of our forestFire thread and run it. + Dim fire As New forestFire + fire.Run() +End Sub -for gen = 1 to 200 - for x = 1 to 199 - for y = 1 to 199 - select case preGen(x,y) - case 0 - if rnd(0) > .99 then newGen(x,y) = 1 : #g "color green ; set "; x; " "; y - case 2 - newGen(x,y) = 0 : #g "color brown ; set "; x; " "; y - case 1 - if preGen(x-1,y-1) = 2 or preGen(x-1,y) = 2 or preGen(x-1,y+1) = 2 _ - or preGen(x,y-1) = 2 or preGen(x,y+1) = 2 or preGen(x+1,y-1) = 2 _ - or preGen(x+1,y) = 2 or preGen(x+1,y+1) = 2 or rnd(0) > .999 then - #g "color red ; set "; x; " "; y - newGen(x,y) = 2 - end if - end select - preGen(x-1,y-1) = newGen(x-1,y-1) - next y - next x -next gen -render #g +stop As Boolean //a globally accessible property of Window1. Boolean properties default to False. + +Sub Pushbutton1.Action() + stop = True +End Sub diff --git a/Task/Forest-fire/BASIC/forest-fire-8.basic b/Task/Forest-fire/BASIC/forest-fire-8.basic index c6dab6da3f..049ad7a6d4 100644 --- a/Task/Forest-fire/BASIC/forest-fire-8.basic +++ b/Task/Forest-fire/BASIC/forest-fire-8.basic @@ -1,104 +1,25 @@ -Public Class ForestFire - Private _forest(,) As ForestState - Private _isBuilding As Boolean - Private _bm As Bitmap - Private _gen As Integer - Private _sw As Stopwatch +graphic #g, 200,200 +dim preGen(200,200) +dim newGen(200,200) - Private Const _treeStart As Double = 0.5 - Private Const _f As Double = 0.00001 - Private Const _p As Double = 0.001 - - Private Const _winWidth As Integer = 300 - Private Const _winHeight As Integer = 300 - - Private Enum ForestState - Empty - Burning - Tree - End Enum - - Private Sub ForestFire_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load - Me.ClientSize = New Size(_winWidth, _winHeight) - ReDim _forest(_winWidth, _winHeight) - - Dim rnd As New Random() - For i As Integer = 0 To _winHeight - 1 - For j As Integer = 0 To _winWidth - 1 - _forest(j, i) = IIf(rnd.NextDouble <= _treeStart, ForestState.Tree, ForestState.Empty) - Next - Next - - _sw = New Stopwatch - _sw.Start() - DrawForest() - Timer1.Start() - End Sub - - Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick - If _isBuilding Then Exit Sub - - _isBuilding = True - GetNextGeneration() - - DrawForest() - _isBuilding = False - End Sub - - Private Sub GetNextGeneration() - Dim forestCache(_winWidth, _winHeight) As ForestState - Dim rnd As New Random() - - For i As Integer = 0 To _winHeight - 1 - For j As Integer = 0 To _winWidth - 1 - Select Case _forest(j, i) - Case ForestState.Tree - If forestCache(j, i) <> ForestState.Burning Then - forestCache(j, i) = IIf(rnd.NextDouble <= _f, ForestState.Burning, ForestState.Tree) - End If - - Case ForestState.Burning - For i2 As Integer = i - 1 To i + 1 - If i2 = -1 OrElse i2 >= _winHeight Then Continue For - For j2 As Integer = j - 1 To j + 1 - If j2 = -1 OrElse i2 >= _winWidth Then Continue For - If _forest(j2, i2) = ForestState.Tree Then forestCache(j2, i2) = ForestState.Burning - Next - Next - forestCache(j, i) = ForestState.Empty - - Case Else - forestCache(j, i) = IIf(rnd.NextDouble <= _p, ForestState.Tree, ForestState.Empty) - End Select - Next - Next - - _forest = forestCache - _gen += 1 - End Sub - - Private Sub DrawForest() - Dim bmCache As New Bitmap(_winWidth, _winHeight) - - For i As Integer = 0 To _winHeight - 1 - For j As Integer = 0 To _winWidth - 1 - Select Case _forest(j, i) - Case ForestState.Tree - bmCache.SetPixel(j, i, Color.Green) - - Case ForestState.Burning - bmCache.SetPixel(j, i, Color.Red) - End Select - Next - Next - - _bm = bmCache - Me.Refresh() - End Sub - - Private Sub ForestFire_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint - e.Graphics.DrawImage(_bm, 0, 0) - - Me.Text = "Gen " & _gen.ToString() & " @ " & (_gen / (_sw.ElapsedMilliseconds / 1000)).ToString("F02") & " FPS: Forest Fire" - End Sub -End Class +for gen = 1 to 200 + for x = 1 to 199 + for y = 1 to 199 + select case preGen(x,y) + case 0 + if rnd(0) > .99 then newGen(x,y) = 1 : #g "color green ; set "; x; " "; y + case 2 + newGen(x,y) = 0 : #g "color brown ; set "; x; " "; y + case 1 + if preGen(x-1,y-1) = 2 or preGen(x-1,y) = 2 or preGen(x-1,y+1) = 2 _ + or preGen(x,y-1) = 2 or preGen(x,y+1) = 2 or preGen(x+1,y-1) = 2 _ + or preGen(x+1,y) = 2 or preGen(x+1,y+1) = 2 or rnd(0) > .999 then + #g "color red ; set "; x; " "; y + newGen(x,y) = 2 + end if + end select + preGen(x-1,y-1) = newGen(x-1,y-1) + next y + next x +next gen +render #g diff --git a/Task/Forest-fire/BASIC/forest-fire-9.basic b/Task/Forest-fire/BASIC/forest-fire-9.basic new file mode 100644 index 0000000000..c6dab6da3f --- /dev/null +++ b/Task/Forest-fire/BASIC/forest-fire-9.basic @@ -0,0 +1,104 @@ +Public Class ForestFire + Private _forest(,) As ForestState + Private _isBuilding As Boolean + Private _bm As Bitmap + Private _gen As Integer + Private _sw As Stopwatch + + Private Const _treeStart As Double = 0.5 + Private Const _f As Double = 0.00001 + Private Const _p As Double = 0.001 + + Private Const _winWidth As Integer = 300 + Private Const _winHeight As Integer = 300 + + Private Enum ForestState + Empty + Burning + Tree + End Enum + + Private Sub ForestFire_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load + Me.ClientSize = New Size(_winWidth, _winHeight) + ReDim _forest(_winWidth, _winHeight) + + Dim rnd As New Random() + For i As Integer = 0 To _winHeight - 1 + For j As Integer = 0 To _winWidth - 1 + _forest(j, i) = IIf(rnd.NextDouble <= _treeStart, ForestState.Tree, ForestState.Empty) + Next + Next + + _sw = New Stopwatch + _sw.Start() + DrawForest() + Timer1.Start() + End Sub + + Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick + If _isBuilding Then Exit Sub + + _isBuilding = True + GetNextGeneration() + + DrawForest() + _isBuilding = False + End Sub + + Private Sub GetNextGeneration() + Dim forestCache(_winWidth, _winHeight) As ForestState + Dim rnd As New Random() + + For i As Integer = 0 To _winHeight - 1 + For j As Integer = 0 To _winWidth - 1 + Select Case _forest(j, i) + Case ForestState.Tree + If forestCache(j, i) <> ForestState.Burning Then + forestCache(j, i) = IIf(rnd.NextDouble <= _f, ForestState.Burning, ForestState.Tree) + End If + + Case ForestState.Burning + For i2 As Integer = i - 1 To i + 1 + If i2 = -1 OrElse i2 >= _winHeight Then Continue For + For j2 As Integer = j - 1 To j + 1 + If j2 = -1 OrElse i2 >= _winWidth Then Continue For + If _forest(j2, i2) = ForestState.Tree Then forestCache(j2, i2) = ForestState.Burning + Next + Next + forestCache(j, i) = ForestState.Empty + + Case Else + forestCache(j, i) = IIf(rnd.NextDouble <= _p, ForestState.Tree, ForestState.Empty) + End Select + Next + Next + + _forest = forestCache + _gen += 1 + End Sub + + Private Sub DrawForest() + Dim bmCache As New Bitmap(_winWidth, _winHeight) + + For i As Integer = 0 To _winHeight - 1 + For j As Integer = 0 To _winWidth - 1 + Select Case _forest(j, i) + Case ForestState.Tree + bmCache.SetPixel(j, i, Color.Green) + + Case ForestState.Burning + bmCache.SetPixel(j, i, Color.Red) + End Select + Next + Next + + _bm = bmCache + Me.Refresh() + End Sub + + Private Sub ForestFire_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint + e.Graphics.DrawImage(_bm, 0, 0) + + Me.Text = "Gen " & _gen.ToString() & " @ " & (_gen / (_sw.ElapsedMilliseconds / 1000)).ToString("F02") & " FPS: Forest Fire" + End Sub +End Class diff --git a/Task/Forest-fire/Emacs-Lisp/forest-fire-1.l b/Task/Forest-fire/Emacs-Lisp/forest-fire-1.l new file mode 100644 index 0000000000..33496ab6e9 --- /dev/null +++ b/Task/Forest-fire/Emacs-Lisp/forest-fire-1.l @@ -0,0 +1,97 @@ +#!/usr/bin/env emacs -script +;; -*- lexical-binding: t -*- +;; run: ./forest-fire forest-fire.config +(require 'cl-lib) +;; (setq debug-on-error t) + +(defmacro swap (a b) + `(setq ,b (prog1 ,a (setq ,a ,b)))) + +(defconst burning ?B) +(defconst tree ?t) + +(cl-defstruct world rows cols data) + +(defun new-world (rows cols) + ;; When allocating the vector add padding so the border will always be empty. + (make-world :rows rows :cols cols :data (make-vector (* (1+ rows) (1+ cols)) nil))) + +(defmacro world--rows (w) + `(1+ (world-rows ,w))) + +(defmacro world--cols (w) + `(1+ (world-cols ,w))) + +(defmacro world-pt (w r c) + `(+ (* (mod ,r (world--rows ,w)) (world--cols ,w)) + (mod ,c (world--cols ,w)))) + +(defmacro world-ref (w r c) + `(aref (world-data ,w) (world-pt ,w ,r ,c))) + +(defun print-world (world) + (dotimes (r (world-rows world)) + (dotimes (c (world-cols world)) + (let ((cell (world-ref world r c))) + (princ (format "%c" (if (not (null cell)) + cell + ?.))))) + (terpri))) + +(defun random-probability () + (/ (float (random 1000000)) 1000000)) + +(defun initialize-world (world p) + (dotimes (r (world-rows world)) + (dotimes (c (world-cols world)) + (setf (world-ref world r c) (if (<= (random-probability) p) tree nil))))) + +(defun neighbors-burning (world row col) + (let ((n 0)) + (dolist (offset '((1 . 1) (1 . 0) (1 . -1) (0 . 1) (0 . -1) (-1 . 1) (-1 . 0) (-1 . -1))) + (when (eq (world-ref world (+ row (car offset)) (+ col (cdr offset))) burning) + (setq n (1+ n)))) + (> n 0))) + +(defun advance (old new p f) + (dotimes (r (world-rows old)) + (dotimes (c (world-cols old)) + (cond + ((eq (world-ref old r c) burning) + (setf (world-ref new r c) nil)) + ((null (world-ref old r c)) + (setf (world-ref new r c) (if (<= (random-probability) p) tree nil))) + ((eq (world-ref old r c) tree) + (setf (world-ref new r c) (if (or (neighbors-burning old r c) + (<= (random-probability) f)) + burning + tree))))))) + +(defun read-config (file-name) + (with-temp-buffer + (insert-file-contents-literally file-name) + (read (current-buffer)))) + +(defun get-config (key config) + (let ((val (assoc key config))) + (if (null val) + (error (format "missing value for %s" key)) + (cdr val)))) + +(defun simulate-forest (file-name) + (let* ((config (read-config file-name)) + (rows (get-config 'rows config)) + (cols (get-config 'cols config)) + (skip (get-config 'skip config)) + (a (new-world rows cols)) + (b (new-world rows cols))) + (initialize-world a (get-config 'tree config)) + (dotimes (time (get-config 'time config)) + (when (or (and (> skip 0) (= (mod time skip) 0)) + (<= skip 0)) + (princ (format "* time %d\n" time)) + (print-world a)) + (advance a b (get-config 'p config) (get-config 'f config)) + (swap a b)))) + +(simulate-forest (elt command-line-args-left 0)) diff --git a/Task/Forest-fire/Emacs-Lisp/forest-fire-2.l b/Task/Forest-fire/Emacs-Lisp/forest-fire-2.l new file mode 100644 index 0000000000..87dbf84db3 --- /dev/null +++ b/Task/Forest-fire/Emacs-Lisp/forest-fire-2.l @@ -0,0 +1,7 @@ +((rows . 10) + (cols . 45) + (time . 100) + (skip . 10) + (f . 0.001) ;; probability tree ignites + (p . 0.01) ;; probability empty space fills with a tree + (tree . 0.5)) ;; initial probability of tree in a new world diff --git a/Task/Forest-fire/REXX/forest-fire.rexx b/Task/Forest-fire/REXX/forest-fire.rexx index 3d3c268156..472c204cc0 100644 --- a/Task/Forest-fire/REXX/forest-fire.rexx +++ b/Task/Forest-fire/REXX/forest-fire.rexx @@ -1,60 +1,54 @@ -/*REXX pgm grows and displays a forest (with growth and fires (lightning). - ┌────────────────────────────elided version──────────────────────────┐ - ├──── original version has many more options & enhanced displays.────┤ - └────────────────────────────────────────────────────────────────────┘*/ -signal on syntax; signal on noValue /*handle run─time REXX pgm errors*/ -signal on halt /*handle forest life interruptus.*/ -parse value scrSize() with sd sw . /*the size of the term. display. */ -parse arg generations birth lightning randSeed . /*get optional args. */ -if randSeed\=='' then call random ,,randSeed /*want repeatability?*/ -generations = p(generations 100) /*maybe use 100 generations. */ - birth = p(strip(birth , ,'%') 50 ) * 100 /*calculate the %*/ - lightning = p(strip(lightning, ,'%') 1/8) * 100 /* " " "*/ -clearScreen = 1 /*(or 0) ─── uses CLS (DOS cmd)*/ - forest = 100**2 /* " " " " forest (field).*/ - bare! = ' ' /*glyph used to show a bare place*/ - fire! = '▒' /*well, close to a fire glyph. */ - tree! = '18'x /*this is an up─arrow [↑] glyph.*/ - rows = max(12, sd-2) /*shrink the screen rows by two. */ - cols = max(79, sw-1) /* " " " cols " one. */ - every = 999999999 /*shows a snapshot every Nth time*/ -$.=bare! /*forest: now a treeless field. */ -@.=$. /*ditto, the "shadow" forest. */ -gens=abs(generations) /*use this for convenience. */ -/*═════════════════════════════════════watch the forest grow and/or burn*/ - do life=1 for gens /*simulate a forest's life cycle.*/ - do r=1 for rows; rank=bare! /*start a rank with it being bare*/ - do c=2 for cols; ?=substr($.r,c,1); ??=? - select /*select da quickest choice first*/ - when ?==tree! then if ignite?() then ??=fire! - when ?==bare! then if random(1,forest)<=birth then ??=tree! - otherwise /*it's bare.*/ ??=bare! - end /*select*/ /* [↑] when┼if ≡ short circuit. */ - rank=rank || ?? /*build rank: 1 thingy at a time.*/ - end /*c*/ /*ignore column 1, start with 2. */ - @.r=rank /*and assign to alternate forest.*/ - end /*r*/ /* [↓] ···and, later, back again*/ +/*REXX program grows and displays a forest (with growth and fires caused by lightning).*/ +signal on halt /*handle any forest life interruptus. */ +parse value scrSize() with sd sw . /*the size of the terminal display. */ +parse arg generations birth lightning randSeed . /*obtain the optional arguments from CL*/ +if randSeed\=='' then call random ,,randSeed /*do we want RANDOM BIF repeatability?*/ +generations = p(generations 100) /*maybe use one hundred generations. */ + birth = p(strip(birth , ,'%') 50 ) *100 /*calculate the percentage for births. */ + lightning = p(strip(lightning, ,'%') 1/8) *100 /* " " " " lightning*/ +clearScreen = 1 /*(or 0) ─── uses CLS (a DOS command).*/ + bare! = ' ' /*the glyph used to show a bare place. */ + fire! = '▒' /*glyph is close to a conflagration. */ + tree! = '18'x /*this is an up─arrow [↑] glyph (tree).*/ + rows = max(12, sd-2) /*shrink the usable screen rows by two.*/ + cols = max(79, sw-1) /* " " " " cols " one.*/ + every = 999999999 /*shows a snapshot every Nth generation*/ + field = min(100000, rows*cols) /*the size of the forest area (field). */ +$.=bare! /*forest: it is now a treeless field. */ +@.=$. /*ditto, for the "shadow" forest. */ +gens=abs(generations) /*use this for convenience. */ + /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒observe the forest grow and/or burn. */ + do life=1 for gens /*simulate a forest's life cycle. */ + do r=1 for rows; rank=bare! /*start a forest rank as being bare. */ + do c=2 for cols; ?=substr($.r, c, 1); ??=? + select /*select the most likeliest choice 1st.*/ + when ?==tree! then if ignite?() then ??=fire! /*on fire ? */ + when ?==bare! then if random(1, field)<=birth then ??=tree! /*new growth.*/ + otherwise ??=bare! /*it's baren.*/ + end /*select*/ /* [↑] when (↑) if ≡ short circuit.*/ + rank=rank || ?? /*build rank: 1 forest "row" at a time*/ + end /*c*/ /*ignore column one, start with col two*/ + @.r=rank /*and assign rank to alternate forest. */ + end /*r*/ /* [↓] ··· and, later, yet back again.*/ - do r=1 for rows; $.r=@.r; end /*assign alternate cells ──► real*/ + do r=1 for rows; $.r=@.r; end /*r*/ /*assign alternate cells ──► real cells*/ if life//every==0 | generations>0 | life==gens then call showForest end /*life*/ -/*═════════════════════════════════════stop watching the forest grow. */ -halt: if life-1\==gens then say 'REXX program interrupted.' /*HALTed?*/ -exit /*stick a fork in it, we're done.*/ -/*───────────────────────────────SHOWFOREST subroutine──────────────────*/ -showForest: if clearScreen then 'CLS' /* ◄─── change this for your OS.*/ - do r=rows by -1 for rows /*show the forest in proper order*/ - say strip(substr($.r,2),'T') /*be neat about trailing blanks. */ - end /*r*/ /* [↑] that's to say, remove 'em*/ -say right(copies('═',cols)life, cols) /*show&tell for a stand of trees.*/ -return -/*──────────────────────────────────IGNITE? subroutine──────────────────────*/ -ignite?: if substr($.r,c+1,1)==fire! then return 1 /*is east on fire? */ - if substr($.r,c-1,1)==fire! then return 1; /* " west " " */ - rp=r+1; rm=r-1 /*curr. row offsets.*/ - if pos(fire!,substr($.rm,c-1,3)substr($.rp,c-1,3))\==0 then return 1 - return random(1,forest)<=lightning -/*───────────────────────────────1─liner subroutines─────────────────────────────────────────────────────────────────────────────────*/ -err: say; say; say center(' error! ',max(40,sw%2),"*"); say; do _=1 for arg(); say arg(_); say; end; say; exit 13 -noValue: syntax: call err 'REXX program' condition('C') "error",condition('D'),'REXX source statement (line' sigl"):",sourceline(sigl) -p: return word(arg(1),1) /*pick─a─word: first or second word.*/ + /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒stop observing the forest evolve. */ +halt: if life-1\==gens then say 'Forest simulation interrupted.' /*was this pgm HALTed?*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +ignite?: if substr($.r,c+1,1)==fire! then return 1 /*is east on fire? */ + if substr($.r,c-1,1)==fire! then return 1 /* " west " " */ + cm=c-1; rm=r-1; rp=r+1 /*curr. row offsets.*/ + if pos(fire!, substr($.rm, cm, 3)substr($.rp, cm,3))\==0 then return 1 + return random(1, field) <= lightning /*lightning ignition*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +p: return word(arg(1), 1) /*pick─a─word: first or second word.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +showForest: if clearScreen then 'CLS' /* ◄───change this command for your OS*/ + do r=rows by -1 for rows /*show the forest grid in proper order.*/ + say strip(substr($.r, 2), 'T') /*be smart/neat about trailing blanks. */ + end /*r*/ /* [↑] that is to say, remove them. */ + say right(copies('▒',cols)life,cols) /*show and tell for a stand of trees. */ + return diff --git a/Task/Forest-fire/Rust/forest-fire.rust b/Task/Forest-fire/Rust/forest-fire.rust new file mode 100644 index 0000000000..bd9782f808 --- /dev/null +++ b/Task/Forest-fire/Rust/forest-fire.rust @@ -0,0 +1,158 @@ +extern crate rand; +extern crate ansi_term; + +#[derive(Copy, Clone, PartialEq)] +enum Tile { + Empty, + Tree, + Burning, + Heating, +} + +impl fmt::Display for Tile { + fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { + let output = match *self { + Empty => Black.paint(" "), + Tree => Green.bold().paint("T"), + Burning => Red.bold().paint("B"), + Heating => Yellow.bold().paint("T"), + }; + write!(f, "{}", output) + } +} + +// This has been added to the nightly rust build as of March 24, 2016 +// Remove when in stable branch! +trait Contains { + fn contains(&self, T) -> bool; +} + +impl Contains for std::ops::Range { + fn contains(&self, elt: T) -> bool { + self.start <= elt && elt < self.end + } +} + +const NEW_TREE_PROB: f32 = 0.01; +const INITIAL_TREE_PROB: f32 = 0.5; +const FIRE_PROB: f32 = 0.001; + +const FOREST_WIDTH: usize = 60; +const FOREST_HEIGHT: usize = 30; + +const SLEEP_MILLIS: u64 = 25; + +use std::fmt; +use std::io; +use std::io::prelude::*; +use std::io::BufWriter; +use std::io::Stdout; +use std::process::Command; +use std::time::Duration; +use rand::Rng; +use ansi_term::Colour::*; + +use Tile::{Empty, Tree, Burning, Heating}; + +fn main() { + let sleep_duration = Duration::from_millis(SLEEP_MILLIS); + let mut forest = [[Tile::Empty; FOREST_WIDTH]; FOREST_HEIGHT]; + + prepopulate_forest(&mut forest); + print_forest(forest, 0); + + std::thread::sleep(sleep_duration); + + for generation in 1.. { + + for row in forest.iter_mut() { + for tile in row.iter_mut() { + update_tile(tile); + } + } + + for y in 0..FOREST_HEIGHT { + for x in 0..FOREST_WIDTH { + if forest[y][x] == Burning { + heat_neighbors(&mut forest, y, x); + } + } + } + + print_forest(forest, generation); + + std::thread::sleep(sleep_duration); + } +} + +fn prepopulate_forest(forest: &mut [[Tile; FOREST_WIDTH]; FOREST_HEIGHT]) { + for row in forest.iter_mut() { + for tile in row.iter_mut() { + *tile = if prob_check(INITIAL_TREE_PROB) { + Tree + } else { + Empty + }; + } + } +} + +fn update_tile(tile: &mut Tile) { + *tile = match *tile { + Empty => { + if prob_check(NEW_TREE_PROB) == true { + Tree + } else { + Empty + } + } + Tree => { + if prob_check(FIRE_PROB) == true { + Burning + } else { + Tree + } + } + Burning => Empty, + Heating => Burning, + } +} + +fn heat_neighbors(forest: &mut [[Tile; FOREST_WIDTH]; FOREST_HEIGHT], y: usize, x: usize) { + let neighbors = [(-1, -1), (-1, 0), (-1, 1), (0, -1), (0, 1), (1, -1), (1, 0), (1, 1)]; + + for &(xoff, yoff) in neighbors.iter() { + let nx: i32 = (x as i32) + xoff; + let ny: i32 = (y as i32) + yoff; + if (0..FOREST_WIDTH as i32).contains(nx) && (0..FOREST_HEIGHT as i32).contains(ny) && + forest[ny as usize][nx as usize] == Tree { + forest[ny as usize][nx as usize] = Heating + } + } +} + +fn prob_check(chance: f32) -> bool { + let roll = rand::thread_rng().gen::(); + if chance - roll > 0.0 { + true + } else { + false + } +} + +fn print_forest(forest: [[Tile; FOREST_WIDTH]; FOREST_HEIGHT], generation: u32) { + let mut writer = BufWriter::new(io::stdout()); + clear_screen(&mut writer); + writeln!(writer, "Generation: {}", generation + 1).unwrap(); + for row in forest.iter() { + for tree in row.iter() { + write!(writer, "{}", tree).unwrap(); + } + writer.write(b"\n").unwrap(); + } +} + +fn clear_screen(writer: &mut BufWriter) { + let output = Command::new("clear").output().unwrap(); + write!(writer, "{}", String::from_utf8_lossy(&output.stdout)).unwrap(); +} diff --git a/Task/Fork/00DESCRIPTION b/Task/Fork/00DESCRIPTION index a9ed59b4b7..e4f39abdfb 100644 --- a/Task/Fork/00DESCRIPTION +++ b/Task/Fork/00DESCRIPTION @@ -1 +1,4 @@ -In this task, the goal is to spawn a new [[process]] which can run simultaneously with, and independently of, the original parent process. +;Task: + +Spawn a new [[process]] which can run simultaneously with, and independently of, the original parent process. +

    diff --git a/Task/Fork/COBOL/fork.cobol b/Task/Fork/COBOL/fork.cobol new file mode 100644 index 0000000000..ba5908402a --- /dev/null +++ b/Task/Fork/COBOL/fork.cobol @@ -0,0 +1,30 @@ + identification division. + program-id. forking. + + data division. + working-storage section. + 01 pid usage binary-long. + + procedure division. + display "attempting fork" + + call "fork" returning pid + on exception + display "error: no fork linkage" upon syserr + end-call + + evaluate pid + when = 0 + display " child sleeps" + call "C$SLEEP" using 3 + display " child task complete" + when < 0 + display "error: fork result not ok" upon syserr + when > 0 + display "parent waits for child..." + call "wait" using by value 0 + display "parental responsibilities fulfilled" + end-evaluate + + goback. + end program forking. diff --git a/Task/Fork/Perl-6/fork.pl6 b/Task/Fork/Perl-6/fork.pl6 index 4c8eaa8253..4aa9a5ea2c 100644 --- a/Task/Fork/Perl-6/fork.pl6 +++ b/Task/Fork/Perl-6/fork.pl6 @@ -1,5 +1,5 @@ use NativeCall; -sub fork() returns Int is native { ... } +sub fork() returns int32 is native { ... } if fork() -> $pid { print "I am the proud parent of $pid.\n"; diff --git a/Task/Formatted-numeric-output/00DESCRIPTION b/Task/Formatted-numeric-output/00DESCRIPTION index 020b11157b..c0ab9b28c3 100644 --- a/Task/Formatted-numeric-output/00DESCRIPTION +++ b/Task/Formatted-numeric-output/00DESCRIPTION @@ -1,3 +1,6 @@ +;Task: Express a number in decimal as a fixed-length string with leading zeros. -For example, the number 7.125 could be expressed as "00007.125". + +For example, the number   '''7.125'''   could be expressed as   '''00007.125'''. +

    diff --git a/Task/Formatted-numeric-output/COBOL/formatted-numeric-output.cobol b/Task/Formatted-numeric-output/COBOL/formatted-numeric-output.cobol new file mode 100644 index 0000000000..dfbb3d7d8b --- /dev/null +++ b/Task/Formatted-numeric-output/COBOL/formatted-numeric-output.cobol @@ -0,0 +1,10 @@ +IDENTIFICATION DIVISION. +PROGRAM-ID. NUMERIC-OUTPUT-PROGRAM. +DATA DIVISION. +WORKING-STORAGE SECTION. +01 WS-EXAMPLE. + 05 X PIC 9(5)V9(3). +PROCEDURE DIVISION. + MOVE 7.125 TO X. + DISPLAY X UPON CONSOLE. + STOP RUN. diff --git a/Task/Formatted-numeric-output/Maple/formatted-numeric-output.maple b/Task/Formatted-numeric-output/Maple/formatted-numeric-output.maple new file mode 100644 index 0000000000..48a8432829 --- /dev/null +++ b/Task/Formatted-numeric-output/Maple/formatted-numeric-output.maple @@ -0,0 +1,16 @@ +printf("%f", Pi); + 3.141593 +printf("%.0f", Pi); + 3 +printf("%.2f", Pi); + 3.14 +printf("%08.2f", Pi); + 00003.14 +printf("%8.2f", Pi); + 3.14 +printf("%-8.2f|", Pi); + 3.14 | +printf("%+08.2f", Pi); + +0003.14 +printf("%+0*.*f",8, 2, Pi); + +0003.14 diff --git a/Task/Formatted-numeric-output/Rust/formatted-numeric-output.rust b/Task/Formatted-numeric-output/Rust/formatted-numeric-output.rust new file mode 100644 index 0000000000..d1a14a6012 --- /dev/null +++ b/Task/Formatted-numeric-output/Rust/formatted-numeric-output.rust @@ -0,0 +1,8 @@ +fn main() { + let x = 7.125; + + println!("{:9}", x); + println!("{:09}", x); + println!("{:9}", -x); + println!("{:09}", -x); +} diff --git a/Task/Formatted-numeric-output/ZX-Spectrum-Basic/formatted-numeric-output.zx b/Task/Formatted-numeric-output/ZX-Spectrum-Basic/formatted-numeric-output.zx new file mode 100644 index 0000000000..87c6b7c97a --- /dev/null +++ b/Task/Formatted-numeric-output/ZX-Spectrum-Basic/formatted-numeric-output.zx @@ -0,0 +1,11 @@ +10 LET n=7.125 +20 LET width=9 +30 GO SUB 1000 +40 PRINT AT 10,10;n$ +50 STOP +1000 REM Formatted fixed-length +1010 LET n$=STR$ n +1020 FOR i=1 TO width-LEN n$ +1030 LET n$="0"+n$ +1040 NEXT i +1050 RETURN diff --git a/Task/Forward-difference/00DESCRIPTION b/Task/Forward-difference/00DESCRIPTION index 0fe02145e3..3f6a9dd8b5 100644 --- a/Task/Forward-difference/00DESCRIPTION +++ b/Task/Forward-difference/00DESCRIPTION @@ -1,6 +1,14 @@ -Provide code that produces a list of numbers which is the n-th order forward difference, given a non-negative integer (specifying the order) and a list of numbers. -The first-order forward difference of a list of numbers (A) is a new list (B) where Bn = An+1 - An. List B should have one fewer element as a result. -The second-order forward difference of A will be tdefmodule Diff do +;Task: +Provide code that produces a list of numbers which is the   nth  order forward difference, given a non-negative integer (specifying the order) and a list of numbers. + + +The first-order forward difference of a list of numbers   '''A'''   is a new list   '''B''',   where   Bn = An+1 - An. + +List   '''B'''   should have one fewer element as a result. + +The second-order forward difference of   '''A'''   will be: +

    +tdefmodule Diff do
     	def forward(arr,i\\1) do
     		forward(arr,[],i)
     	end
    @@ -16,14 +24,22 @@ The second-order forward difference of A will be tdefmodule Diff do
     	def forward([val1|[val2|vals]],diffs,i) do
     		forward([val2|vals],diffs++[val2-val1],i)
     	end
    -endhe same as the first-order forward difference of B.
    -That new list will have two fewer elements than A and one less than B.
    +end
    +
    +The same as the first-order forward difference of   '''B'''. + +That new list will have two fewer elements than   '''A'''   and one less than   '''B'''. + The goal of this task is to repeat this process up to the desired order. -For a more formal description, see the related [http://mathworld.wolfram.com/ForwardDifference.html Mathworld article]. +For a more formal description, see the related   [http://mathworld.wolfram.com/ForwardDifference.html Mathworld article]. -Algorithmic options: -*Iterate through all previous forward differences and re-calculate a new array each time. -*Use this formula (from [[wp:Forward difference|Wikipedia]]): -:\Delta^n [f](x)= \sum_{k=0}^n {n \choose k} (-1)^{n-k} f(x+k) -:([[Pascal's Triangle]] may be useful for this option) + +;Algorithmic options: +* Iterate through all previous forward differences and re-calculate a new array each time. +* Use this formula (from [[wp:Forward difference|Wikipedia]]): + +::: \Delta^n [f](x)= \sum_{k=0}^n {n \choose k} (-1)^{n-k} f(x+k) + +::: ([[Pascal's Triangle]]   may be useful for this option.) +

    diff --git a/Task/Forward-difference/J/forward-difference-2.j b/Task/Forward-difference/J/forward-difference-2.j index 4f1db90cd7..c2d65f98f4 100644 --- a/Task/Forward-difference/J/forward-difference-2.j +++ b/Task/Forward-difference/J/forward-difference-2.j @@ -1 +1 @@ -fd=:}.-}:^: +fd=: }. - }: ^: diff --git a/Task/Forward-difference/J/forward-difference-3.j b/Task/Forward-difference/J/forward-difference-3.j index e19dc6020c..322bd95d35 100644 --- a/Task/Forward-difference/J/forward-difference-3.j +++ b/Task/Forward-difference/J/forward-difference-3.j @@ -1,4 +1,4 @@ - list =: 90 47 58 29 22 32 55 5 55 73 NB. Some numbers + list=: 90 47 58 29 22 32 55 5 55 73 NB. Some numbers 1 fd list _43 11 _29 _7 10 23 _50 50 18 diff --git a/Task/Forward-difference/REXX/forward-difference-1.rexx b/Task/Forward-difference/REXX/forward-difference-1.rexx index f4d94ef1a7..0493a2c37c 100644 --- a/Task/Forward-difference/REXX/forward-difference-1.rexx +++ b/Task/Forward-difference/REXX/forward-difference-1.rexx @@ -1,24 +1,23 @@ -/*REXX program computes the forward difference of a list of numbers. */ -numeric digits 100 /*ensure enough accuracy (decimal digs)*/ -parse arg e ',' N /*get a list: ε1 ε2 ε3 ε4 ··· , order */ -if e=='' then e='90 47 58 29 22 32 55 5 55 73' /*use some default numbers. */ -#=words(e) /*# is the number of elements in list.*/ - /* [↓] assign list numbers to @ array.*/ - do i=1 for #; @.i=word(e,i)/1; end /*process each number one at a time. */ - /* [↓] process the optional order. */ -if N=='' then parse value 0 # # with bot top N /*define default order range. */ - else parse var N bot 1 top /*Specified? Use only 1 order*/ -say right(# 'numbers:', 44) e /*display the header (title) and ··· */ -say left('',44)copies('─',length(e)+2) /*display the header fence. */ - /* [↓] where da rubber meets da road. */ - do o=bot to top; do r=1 for #; !.r=@.r; end; $= - do j=1 for o; d=!.j; do k=j+1 to #; parse value !.k !.k-d with d !.k; end - end /*j*/ - do i=o+1 to #; $=$ !.i/1; end - if $=='' then $='[null]' - say right(o,7)th(o)'─order forward difference vector =' $ - end /*o*/ - -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -th: arg ?; return word('th st nd rd',1+?//10*(?//100%10\==1)*(?//10<4)) +/*REXX program computes the forward difference of a list of numbers. */ +numeric digits 100 /*ensure enough accuracy (decimal digs)*/ +parse arg e ',' N /*get a list: ε1 ε2 ε3 ε4 ··· , order */ +if e=='' then e=90 47 58 29 22 32 55 5 55 73 /*Not specified? Then use the default.*/ +#=words(e) /*# is the number of elements in list.*/ + /* [↓] assign list numbers to @ array.*/ + do i=1 for #; @.i=word(e, i)/1; end /*i*/ /*process each number one at a time. */ + /* [↓] process the optional order. */ +if N=='' then parse value 0 # # with bot top N /*define the default order range. */ + else parse var N bot 1 top /*Not specified? Then use only 1 order*/ +say right(# 'numbers:', 44) e /*display the header title and ··· */ +say left('', 44)copies('─', length(e)+2) /* " " " fence. */ + /* [↓] where da rubber meets da road. */ + do o=bot to top; do r=1 for #; !.r=@.r; end /*r*/; $= + do j=1 for o; d=!.j; do k=j+1 to #; parse value !.k !.k-d with d !.k; end /*k*/ + end /*j*/ + do i=o+1 to #; $=$ !.i/1; end /*i*/ + if $=='' then $=' [null]' + say right(o, 7)th(o)'─order forward difference vector =' $ + end /*o*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +th: procedure; x=abs(arg(1)); return word('th st nd rd',1+x//10*(x//100%10\==1)*(x//10<4)) diff --git a/Task/Forward-difference/REXX/forward-difference-2.rexx b/Task/Forward-difference/REXX/forward-difference-2.rexx index 983f5ea480..7253161590 100644 --- a/Task/Forward-difference/REXX/forward-difference-2.rexx +++ b/Task/Forward-difference/REXX/forward-difference-2.rexx @@ -1,30 +1,29 @@ -/*REXX program computes the forward difference of a list of numbers. */ -numeric digits 100 /*ensure enough accuracy (decimal digs)*/ -parse arg e ',' N /*get a list: ε1 ε2 ε3 ε4 ··· , order */ -if e=='' then e='90 47 58 29 22 32 55 5 55 73' /*use some default numbers. */ -#=words(e) /*# is the number of elements in list.*/ - /* [↓] verify list items are numeric. */ - do i=1 for #; _=word(e,i) /*process each number one at a time. */ - if \datatype(_,'N') then call ser _ "isn't a valid number"; @.i=_/1 - end /*i*/ /* [↑] removes superfluous stuff. */ - /* [↓] process the optional order. */ -if N=='' then parse value 0 # # with bot top N /*define default order range. */ - else parse var N bot 1 top /*Specified? Use only 1 order*/ -if #==0 then call ser "no numbers were specified." -if N<0 then call ser N "(order) can't be negative." -if N># then call ser N "(order) can't be greater than" # -say right(# 'numbers:', 44) e /*display the header (title) and ··· */ -say left('',44)copies('─',length(e)+2) /*display the header fence. */ - /* [↓] where da rubber meets da road. */ - do o=bot to top; do r=1 for #; !.r=@.r; end; $= - do j=1 for o; d=!.j; do k=j+1 to #; parse value !.k !.k-d with d !.k; end - end /*j*/ - do i=o+1 to #; $=$ !.i/1; end - if $=='' then $=' [null]' - say right(o,7)th(o)'─order forward difference vector =' $ - end /*o*/ - -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -ser: say; say '***error!***'; say arg(1); say; exit 13 -th: arg ?; return word('th st nd rd',1+?//10*(?//100%10\==1)*(?//10<4)) +/*REXX program computes the forward difference of a list of numbers. */ +numeric digits 100 /*ensure enough accuracy (decimal digs)*/ +parse arg e ',' N /*get a list: ε1 ε2 ε3 ε4 ··· , order */ +if e=='' then e=90 47 58 29 22 32 55 5 55 73 /*Not specified? Then use the default.*/ +#=words(e) /*# is the number of elements in list.*/ + /* [↓] verify list items are numeric. */ + do i=1 for #; _=word(e, i) /*process each number one at a time. */ + if \datatype(_, 'N') then call ser _ "isn't a valid number"; @.i=_/1 + end /*i*/ /* [↑] removes superfluous stuff. */ + /* [↓] process the optional order. */ +if N=='' then parse value 0 # # with bot top N /*define the default order range. */ + else parse var N bot 1 top /*Not specified? Then use only 1 order*/ +if #==0 then call ser "no numbers were specified." +if N<0 then call ser N "(order) can't be negative." +if N># then call ser N "(order) can't be greater than" # +say right(# 'numbers:', 44) e /*display the header (title) and ··· */ +say left('', 44)copies('─', length(e)+2) /*display the header fence. */ + /* [↓] where da rubber meets da road. */ + do o=bot to top; do r=1 for #; !.r=@.r; end /*r*/; $= + do j=1 for o; d=!.j; do k=j+1 to #; parse value !.k !.k-d with d !.k; end /*k*/ + end /*j*/ + do i=o+1 to #; $=$ !.i/1; end /*i*/ + if $=='' then $=' [null]' + say right(o, 7)th(o)'─order forward difference vector =' $ + end /*o*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +ser: say; say '***error***'; say arg(1); say; exit 13 +th: procedure; x=abs(arg(1)); return word('th st nd rd',1+x//10*(x//100%10\==1)*(x//10<4)) diff --git a/Task/Forward-difference/REXX/forward-difference-3.rexx b/Task/Forward-difference/REXX/forward-difference-3.rexx index e7f359f44e..200daff3c9 100644 --- a/Task/Forward-difference/REXX/forward-difference-3.rexx +++ b/Task/Forward-difference/REXX/forward-difference-3.rexx @@ -1,34 +1,33 @@ -/*REXX program computes the forward difference of a list of numbers. */ -numeric digits 100 /*ensure enough accuracy (decimal digs)*/ -parse arg e ',' N /*get a list: ε1 ε2 ε3 ε4 ··· , order */ -if e=='' then e='90 47 58 29 22 32 55 5 55 73' /*use some default numbers. */ -#=words(e); w=5 /*# is the number of elements in list.*/ - /* [↓] verify list items are numeric. */ - do i=1 for #; _=word(e,i) /*process each number one at a time. */ - if \datatype(_,'N') then call ser _ "isn't a valid number"; @.i=_/1 - w=max(w,length(@.i)) /*use the maximum length of an element.*/ - end /*i*/ /* [↑] removes superfluous stuff. */ - /* [↓] process the optional order. */ -if N=='' then parse value 0 # # with bot top N /*define default order range. */ - else parse var N bot 1 top /*Specified? Use only 1 order*/ -if #==0 then call ser "no numbers were specified." -if N<0 then call ser N "(order) can't be negative." -if N># then call ser N "(order) can't be greater than" # -_=; do k=1 for #; _=_ right(@.k,w); end /*k*/; _=substr(_,2) -say right(# 'numbers:', 44) _ /*display the header (title) and ··· */ -say left('',44)copies('─',w*#+#) /*display the header fence. */ - /* [↓] where da rubber meets da road. */ - do o=bot to top; do r=1 for #; !.r=@.r; end /*r*/; $= - do j=1 for o; d=!.j; do k=j+1 to #; parse value !.k !.k-d with d !.k - w=max(w,length(!.k)) - end /*k*/ - end /*j*/ - do i=o+1 to #; $=$ right(!.i/1,w); end /*i*/ - if $=='' then $='[null]' - say right(o,7)th(o)'─order forward difference vector =' $ - end /*o*/ - -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -ser: say; say '***error!***'; say arg(1); say; exit 13 -th: arg ?; return word('th st nd rd',1+?//10*(?//100%10\==1)*(?//10<4)) +/*REXX program computes the forward difference of a list of numbers. */ +numeric digits 100 /*ensure enough accuracy (decimal digs)*/ +parse arg e ',' N /*get a list: ε1 ε2 ε3 ε4 ··· , order */ +if e=='' then e=90 47 58 29 22 32 55 5 55 73 /*Not specified? Then use the default.*/ +#=words(e); w=5 /*# is the number of elements in list.*/ + /* [↓] verify list items are numeric. */ + do i=1 for #; _=word(e, i) /*process each number one at a time. */ + if \datatype(_, 'N') then call ser _ "isn't a valid number"; @.i=_/1 + w=max(w, length(@.i)) /*use the maximum length of an element.*/ + end /*i*/ /* [↑] removes superfluous stuff. */ + /* [↓] process the optional order. */ +if N=='' then parse value 0 # # with bot top N /*define the default order range. */ + else parse var N bot 1 top /*Not specified? Then use only 1 order*/ +if #==0 then call ser "no numbers were specified." +if N<0 then call ser N "(order) can't be negative." +if N># then call ser N "(order) can't be greater than" # +_=; do k=1 for #; _=_ right(@.k, w); end /*k*/; _=substr(_, 2) +say right(# 'numbers:', 44) _ /*display the header title and ··· */ +say left('', 44)copies('─', w*#+#) /* " " " fence. */ + /* [↓] where da rubber meets da road. */ + do o=bot to top; do r=1 for #; !.r=@.r; end /*r*/; $= + do j=1 for o; d=!.j; do k=j+1 to #; parse value !.k !.k-d with d !.k + w=max(w, length(!.k)) + end /*k*/ + end /*j*/ + do i=o+1 to #; $=$ right(!.i/1, w); end /*i*/ + if $=='' then $=' [null]' + say right(o, 7)th(o)'─order forward difference vector =' $ + end /*o*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +ser: say; say '***error***'; say arg(1); say; exit 13 +th: procedure; x=abs(arg(1)); return word('th st nd rd',1+x//10*(x//100%10\==1)*(x//10<4)) diff --git a/Task/Forward-difference/ZX-Spectrum-Basic/forward-difference.zx b/Task/Forward-difference/ZX-Spectrum-Basic/forward-difference.zx new file mode 100644 index 0000000000..18df0d6933 --- /dev/null +++ b/Task/Forward-difference/ZX-Spectrum-Basic/forward-difference.zx @@ -0,0 +1,14 @@ +10 DATA 9,0,1,2,4,7,4,2,1,0 +20 LET p=1 +30 READ n: DIM b(n) +40 FOR i=1 TO n +50 READ b(i) +60 NEXT i +70 FOR j=1 TO p +80 FOR i=1 TO n-j +90 LET b(i)=b(i+1)-b(i) +100 NEXT i +110 NEXT j +120 FOR i=1 TO n-p +130 PRINT b(i);" "; +140 NEXT i diff --git a/Task/Four-bit-adder/00DESCRIPTION b/Task/Four-bit-adder/00DESCRIPTION index 94352a9a7d..4252da81e1 100644 --- a/Task/Four-bit-adder/00DESCRIPTION +++ b/Task/Four-bit-adder/00DESCRIPTION @@ -1,4 +1,6 @@ -The aim of this task is to "''simulate''" a four-bit adder "chip". +;Task: +"''Simulate''" a four-bit adder "chip". + This "chip" can be realized using four [[wp:Adder_(electronics)#Full_adder|1-bit full adder]]s. Each of these 1-bit full adders can be built with two [[wp:Adder_(electronics)#Half_adder|half adder]]s and an ''or'' [[wp:Logic gate|gate]]. Finally a half adder can be made using a ''xor'' gate and an ''and'' gate. The ''xor'' gate can be made using two ''not''s, two ''and''s and one ''or''. @@ -26,3 +28,4 @@ It is not mandatory to replicate the syntax of higher-order blocks in the atomic To test the implementation, show the sum of two four-bit numbers (in binary).
    +

    diff --git a/Task/Four-bit-adder/COBOL/four-bit-adder.cobol b/Task/Four-bit-adder/COBOL/four-bit-adder.cobol new file mode 100644 index 0000000000..cb527d79cf --- /dev/null +++ b/Task/Four-bit-adder/COBOL/four-bit-adder.cobol @@ -0,0 +1,107 @@ + program-id. test-add. + environment division. + configuration section. + special-names. + class bin is "0" "1". + data division. + working-storage section. + 1 parms. + 2 a-in pic 9999. + 2 b-in pic 9999. + 2 r-out pic 9999. + 2 c-out pic 9. + procedure division. + display "Enter 'A' value (4-bits binary): " + with no advancing + accept a-in + if a-in (1:) not bin + display "A is not binary" + stop run + end-if + display "Enter 'B' value (4-bits binary): " + with no advancing + accept b-in + if b-in (1:) not bin + display "B is not binary" + stop run + end-if + call "add-4b" using parms + display "Carry " c-out " result " r-out + stop run + . + end program test-add. + + program-id. add-4b. + data division. + working-storage section. + 1 wk binary. + 2 i pic 9(4). + 2 occurs 5. + 3 a-reg pic 9. + 3 b-reg pic 9. + 3 c-reg pic 9. + 3 r-reg pic 9. + 2 a pic 9. + 2 b pic 9. + 2 c pic 9. + 2 a-not pic 9. + 2 b-not pic 9. + 2 c-not pic 9. + 2 ha-1s pic 9. + 2 ha-1c pic 9. + 2 ha-1s-not pic 9. + 2 ha-1c-not pic 9. + 2 ha-2s pic 9. + 2 ha-2c pic 9. + 2 fa-s pic 9. + 2 fa-c pic 9. + linkage section. + 1 parms. + 2 a-in pic 9999. + 2 b-in pic 9999. + 2 r-out pic 9999. + 2 c-out pic 9. + procedure division using parms. + initialize wk + perform varying i from 1 by 1 + until i > 4 + move a-in (5 - i:1) to a-reg (i) + move b-in (5 - i:1) to b-reg (i) + end-perform + perform simulate-adder varying i from 1 by 1 + until i > 4 + move c-reg (5) to c-out + perform varying i from 1 by 1 + until i > 4 + move r-reg (i) to r-out (5 - i:1) + end-perform + exit program + . + + simulate-adder section. + move a-reg (i) to a + move b-reg (i) to b + move c-reg (i) to c + add a -1 giving a-not + add b -1 giving b-not + add c -1 giving c-not + + compute ha-1s = function max ( + function min ( a b-not ) + function min ( b a-not ) ) + compute ha-1c = function min ( a b ) + add ha-1s -1 giving ha-1s-not + add ha-1c -1 giving ha-1c-not + + compute ha-2s = function max ( + function min ( c ha-1s-not ) + function min ( ha-1s c-not ) ) + compute ha-2c = function min ( c ha-1c ) + + compute fa-s = ha-2s + compute fa-c = function max ( ha-1c ha-2c ) + + move fa-s to r-reg (i) + move fa-c to c-reg (i + 1) + . + end program add-4b. diff --git a/Task/Four-bit-adder/Elixir/four-bit-adder.elixir b/Task/Four-bit-adder/Elixir/four-bit-adder.elixir new file mode 100644 index 0000000000..6e1be42562 --- /dev/null +++ b/Task/Four-bit-adder/Elixir/four-bit-adder.elixir @@ -0,0 +1,47 @@ +defmodule RC do + use Bitwise + @bit_size 4 + + def four_bit_adder(a, b) do # returns pair {sum, carry} + a_bits = binary_string_to_bits(a) + b_bits = binary_string_to_bits(b) + Enum.zip(a_bits, b_bits) + |> List.foldr({[], 0}, fn {a_bit, b_bit}, {acc, carry} -> + {s, c} = full_adder(a_bit, b_bit, carry) + {[s | acc], c} + end) + end + + defp full_adder(a, b, c0) do + {s, c} = half_adder(c0, a) + {s, c1} = half_adder(s, b) + {s, bor(c, c1)} # returns pair {sum, carry} + end + + defp half_adder(a, b) do + {bxor(a, b), band(a, b)} # returns pair {sum, carry} + end + + def int_to_binary_string(n) do + Integer.to_string(n,2) |> String.rjust(@bit_size, ?0) + end + + defp binary_string_to_bits(s) do + String.codepoints(s) |> Enum.map(fn bit -> String.to_integer(bit) end) + end + + def task do + IO.puts " A B A B C S sum" + Enum.each(0..15, fn a -> + bin_a = int_to_binary_string(a) + Enum.each(0..15, fn b -> + bin_b = int_to_binary_string(b) + {sum, carry} = four_bit_adder(bin_a, bin_b) + :io.format "~2w + ~2w = ~s + ~s = ~w ~s = ~2w~n", + [a, b, bin_a, bin_b, carry, Enum.join(sum), Integer.undigits([carry | sum], 2)] + end) + end) + end +end + +RC.task diff --git a/Task/Four-bit-adder/Lua/four-bit-adder.lua b/Task/Four-bit-adder/Lua/four-bit-adder.lua index 925e267c5d..bbd0040eb2 100644 --- a/Task/Four-bit-adder/Lua/four-bit-adder.lua +++ b/Task/Four-bit-adder/Lua/four-bit-adder.lua @@ -1,64 +1,52 @@ -- Build XOR from AND, OR and NOT -function xor (a, b) - return (a and not b) or (b and not a) -end +function xor (a, b) return (a and not b) or (b and not a) end -- Can make half adder now XOR exists -function halfAdder (a, b) - local sum, carry - sum = xor(a, b) - carry = a and b - return sum, carry -end +function halfAdder (a, b) return xor(a, b), a and b end -- Full adder is two half adders with carry outputs OR'd function fullAdder (a, b, cIn) - local ha0s, ha0c = halfAdder(cIn, a) - local ha1s, ha1c = halfAdder(ha0s, b) - local cOut, s = ha0c or ha1c, ha1s - return cOut, s + local ha0s, ha0c = halfAdder(cIn, a) + local ha1s, ha1c = halfAdder(ha0s, b) + local cOut, s = ha0c or ha1c, ha1s + return cOut, s end -- Carry bits 'ripple' through adders, first returned value is overflow function fourBitAdder (a3, a2, a1, a0, b3, b2, b1, b0) -- LSB-first - local fa0c, fa0s = fullAdder(a0, b0, false) - local fa1c, fa1s = fullAdder(a1, b1, fa0c) - local fa2c, fa2s = fullAdder(a2, b2, fa1c) - local fa3c, fa3s = fullAdder(a3, b3, fa2c) - return fa3c, fa3s, fa2s, fa1s, fa0s -- Return as MSB-first + local fa0c, fa0s = fullAdder(a0, b0, false) + local fa1c, fa1s = fullAdder(a1, b1, fa0c) + local fa2c, fa2s = fullAdder(a2, b2, fa1c) + local fa3c, fa3s = fullAdder(a3, b3, fa2c) + return fa3c, fa3s, fa2s, fa1s, fa0s -- Return as MSB-first end -- Take string of noughts and ones, convert to native boolean type function toBool (bitString) - local boolList, bit = {} - for digit = 1, 4 do - bit = string.sub(string.format("%04d", bitString), digit, digit) - if bit == "0" then table.insert(boolList, false) end - if bit == "1" then table.insert(boolList, true) end - end - return boolList + local boolList, bit = {} + for digit = 1, 4 do + bit = string.sub(string.format("%04d", bitString), digit, digit) + if bit == "0" then table.insert(boolList, false) end + if bit == "1" then table.insert(boolList, true) end + end + return boolList end -- Take list of booleans, convert to string of binary digits (variadic) function toBits (...) - local bitString = "" - for i, bool in pairs{...} do - if bool then - bitString = bitString .. "1" - else - bitString = bitString .. "0" - end - end - return bitString + local bStr = "" + for i, bool in pairs{...} do + if bool then bStr = bStr .. "1" else bStr = bStr .. "0" end + end + return bStr end -- Little driver function to neaten use of the adder function add (n1, n2) - local A, B = toBool(n1), toBool(n2) - local v, s0, s1, s2, s3 = fourBitAdder ( A[1], A[2], A[3], A[4], - B[1], B[2], B[3], B[4] - ) - return toBits(s0, s1, s2, s3), v + local A, B = toBool(n1), toBool(n2) + local v, s0, s1, s2, s3 = fourBitAdder( A[1], A[2], A[3], A[4], + B[1], B[2], B[3], B[4] ) + return toBits(s0, s1, s2, s3), v end -- Main procedure (usage examples) diff --git a/Task/Four-bit-adder/PARI-GP/four-bit-adder.pari b/Task/Four-bit-adder/PARI-GP/four-bit-adder.pari index 3f2c72f309..f55a2def30 100644 --- a/Task/Four-bit-adder/PARI-GP/four-bit-adder.pari +++ b/Task/Four-bit-adder/PARI-GP/four-bit-adder.pari @@ -1,6 +1,6 @@ -xor(a,b)=(!a&b)|(a&!b); -halfadd(a,b)=[a&b,xor(a,b)]; -fulladd(a,b,c)=my(t=halfadd(a,c),s=halfadd(t[2],b));[t[1]|s[1],s[2]]; +xor(a,b)=(!a&b)||(a&!b); +halfadd(a,b)=[a&&b,xor(a,b)]; +fulladd(a,b,c)=my(t=halfadd(a,c),s=halfadd(t[2],b));[t[1]||s[1],s[2]]; add4(a3,a2,a1,a0,b3,b2,b1,b0)={ my(s0,s1,s2,s3); s0=fulladd(a0,b0,0); diff --git a/Task/Four-bit-adder/Perl-6/four-bit-adder.pl6 b/Task/Four-bit-adder/Perl-6/four-bit-adder.pl6 index b10a0cb3c1..b6a4e59c10 100644 --- a/Task/Four-bit-adder/Perl-6/four-bit-adder.pl6 +++ b/Task/Four-bit-adder/Perl-6/four-bit-adder.pl6 @@ -1,4 +1,4 @@ -sub xor ($a, $b) { ($a and not $b) or (not $a and $b) } +sub xor ($a, $b) { (($a and not $b) or (not $a and $b)) ?? 1 !! 0 } sub half-adder ($a, $b) { return xor($a, $b), ($a and $b); diff --git a/Task/Four-bit-adder/PowerShell/four-bit-adder.psh b/Task/Four-bit-adder/PowerShell/four-bit-adder-1.psh similarity index 100% rename from Task/Four-bit-adder/PowerShell/four-bit-adder.psh rename to Task/Four-bit-adder/PowerShell/four-bit-adder-1.psh diff --git a/Task/Four-bit-adder/PowerShell/four-bit-adder-2.psh b/Task/Four-bit-adder/PowerShell/four-bit-adder-2.psh new file mode 100644 index 0000000000..fbd60288b7 --- /dev/null +++ b/Task/Four-bit-adder/PowerShell/four-bit-adder-2.psh @@ -0,0 +1,131 @@ +$source = @' +using System; +using System.Collections.Generic; +using System.Linq; +using System.Text; + +namespace RosettaCodeTasks.FourBitAdder +{ + public struct BitAdderOutput + { + public bool S { get; set; } + public bool C { get; set; } + public override string ToString ( ) + { + return "S" + ( S ? "1" : "0" ) + "C" + ( C ? "1" : "0" ); + } + } + public struct Nibble + { + public bool _1 { get; set; } + public bool _2 { get; set; } + public bool _3 { get; set; } + public bool _4 { get; set; } + public override string ToString ( ) + { + return ( _4 ? "1" : "0" ) + + ( _3 ? "1" : "0" ) + + ( _2 ? "1" : "0" ) + + ( _1 ? "1" : "0" ); + } + } + public struct FourBitAdderOutput + { + public Nibble N { get; set; } + public bool C { get; set; } + public override string ToString ( ) + { + return N.ToString ( ) + "c" + ( C ? "1" : "0" ); + } + } + + public static class LogicGates + { + // Basic Gates + public static bool Not ( bool A ) { return !A; } + public static bool And ( bool A, bool B ) { return A && B; } + public static bool Or ( bool A, bool B ) { return A || B; } + + // Composite Gates + public static bool Xor ( bool A, bool B ) { return Or ( And ( A, Not ( B ) ), ( And ( Not ( A ), B ) ) ); } + } + + public static class ConstructiveBlocks + { + public static BitAdderOutput HalfAdder ( bool A, bool B ) + { + return new BitAdderOutput ( ) { S = LogicGates.Xor ( A, B ), C = LogicGates.And ( A, B ) }; + } + + public static BitAdderOutput FullAdder ( bool A, bool B, bool CI ) + { + BitAdderOutput HA1 = HalfAdder ( CI, A ); + BitAdderOutput HA2 = HalfAdder ( HA1.S, B ); + + return new BitAdderOutput ( ) { S = HA2.S, C = LogicGates.Or ( HA1.C, HA2.C ) }; + } + + public static FourBitAdderOutput FourBitAdder ( Nibble A, Nibble B, bool CI ) + { + + BitAdderOutput FA1 = FullAdder ( A._1, B._1, CI ); + BitAdderOutput FA2 = FullAdder ( A._2, B._2, FA1.C ); + BitAdderOutput FA3 = FullAdder ( A._3, B._3, FA2.C ); + BitAdderOutput FA4 = FullAdder ( A._4, B._4, FA3.C ); + + return new FourBitAdderOutput ( ) { N = new Nibble ( ) { _1 = FA1.S, _2 = FA2.S, _3 = FA3.S, _4 = FA4.S }, C = FA4.C }; + } + + public static void Test ( ) + { + Console.WriteLine ( "Four Bit Adder" ); + + for ( int i = 0; i < 256; i++ ) + { + Nibble A = new Nibble ( ) { _1 = false, _2 = false, _3 = false, _4 = false }; + Nibble B = new Nibble ( ) { _1 = false, _2 = false, _3 = false, _4 = false }; + if ( (i & 1) == 1) + { + A._1 = true; + } + if ( ( i & 2 ) == 2 ) + { + A._2 = true; + } + if ( ( i & 4 ) == 4 ) + { + A._3 = true; + } + if ( ( i & 8 ) == 8 ) + { + A._4 = true; + } + if ( ( i & 16 ) == 16 ) + { + B._1 = true; + } + if ( ( i & 32 ) == 32) + { + B._2 = true; + } + if ( ( i & 64 ) == 64 ) + { + B._3 = true; + } + if ( ( i & 128 ) == 128 ) + { + B._4 = true; + } + + Console.WriteLine ( "{0} + {1} = {2}", A.ToString ( ), B.ToString ( ), FourBitAdder( A, B, false ).ToString ( ) ); + + } + + Console.WriteLine ( ); + } + + } +} +'@ + +Add-Type -TypeDefinition $source -Language CSharpVersion3 diff --git a/Task/Four-bit-adder/PowerShell/four-bit-adder-3.psh b/Task/Four-bit-adder/PowerShell/four-bit-adder-3.psh new file mode 100644 index 0000000000..2cdfaffa72 --- /dev/null +++ b/Task/Four-bit-adder/PowerShell/four-bit-adder-3.psh @@ -0,0 +1 @@ +[RosettaCodeTasks.FourBitAdder.ConstructiveBlocks]::Test() diff --git a/Task/Four-bit-adder/REXX/four-bit-adder.rexx b/Task/Four-bit-adder/REXX/four-bit-adder.rexx index 290f2b5e77..87866eecda 100644 --- a/Task/Four-bit-adder/REXX/four-bit-adder.rexx +++ b/Task/Four-bit-adder/REXX/four-bit-adder.rexx @@ -1,30 +1,30 @@ -/*REXX program shows (all) the sums of a full 4─bit adder (with carry).*/ -call hdr1; call hdr2 /*note order of headers (& below)*/ - /* [↓] traipse all possibilities*/ +/*REXX program displays (all) the sums of a full 4─bit adder (with carry). */ +call hdr1; call hdr2 /*note the order of headers & trailers.*/ + /* [↓] traipse thru all possibilities.*/ do j=0 for 16 - do m=0 for 4; a.m=bit(j,m); end + do m=0 for 4; a.m=bit(j, m); end /*m*/ do k=0 for 16 - do m=0 for 4; b.m=bit(k,m); end + do m=0 for 4; b.m=bit(k, m); end /*m*/ sc=4bitAdder(a., b.) - z=a.3 a.2 a.1 a.0 '_+_' b.3 b.2 b.1 b.0 '_=_' sc ',' s.3 s.2 s.1 s.0 - say translate(space(z,0),,'_') /*remove all underbars (_) from Z*/ + z=a.3 a.2 a.1 a.0 '_+_' b.3 b.2 b.1 b.0 "_=_" sc ',' s.3 s.2 s.1 s.0 + say translate(space(z, 0), , '_') /*remove all the underbars (_) from Z. */ end /*k*/ end /*j*/ -call hdr2; call hdr1 /*display 2 headers (note order).*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────one─line subroutines────────────────*/ -bit: procedure; arg x,y; return substr(reverse(x2b(d2x(x))),y+1,1) -halfAdder: procedure expose c; parse arg x,y; c=x & y; return x && y -hdr1: say 'aaaa + bbbb = c, sum [c=carry]'; return -hdr2: say '════ ════ ══════' ; return -/*──────────────────────────────────FULLADDER subroutine────────────────*/ -fullAdder: procedure expose c; parse arg x,y,fc - _1 = halfAdder(fc,x); c1=c - _2 = halfAdder(_1,y); c=c | c1; return _2 -/*──────────────────────────────────4BITADDER subroutine────────────────*/ +call hdr2; call hdr1 /*display two trailers (note the order)*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +bit: procedure; parse arg x,y; return substr( reverse( x2b( d2x(x) ) ), y+1, 1) +halfAdder: procedure expose c; parse arg x,y; c=x & y; return x && y +hdr1: say 'aaaa + bbbb = c, sum [c=carry]'; return +hdr2: say '════ ════ ══════' ; return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +fullAdder: procedure expose c; parse arg x,y,fc + _1=halfAdder(fc, x); c1=c + _2=halfAdder(_1, y); c=c | c1; return _2 +/*──────────────────────────────────────────────────────────────────────────────────────*/ 4bitAdder: procedure expose s. a. b.; carry.=0 - do j=0 for 4; n=j-1 - s.j=fullAdder(a.j, b.j, carry.n); carry.j=c - end /*j*/ -return c + do j=0 for 4; n=j-1 + s.j=fullAdder(a.j, b.j, carry.n); carry.j=c + end /*j*/ + return c diff --git a/Task/Four-bit-adder/Sed/four-bit-adder-1.sed b/Task/Four-bit-adder/Sed/four-bit-adder-1.sed new file mode 100644 index 0000000000..6a7d47ba3a --- /dev/null +++ b/Task/Four-bit-adder/Sed/four-bit-adder-1.sed @@ -0,0 +1,52 @@ +#!/bin/sed -f +# (C) 2005,2014 by Mariusz Woloszyn :) +# https://en.wikipedia.org/wiki/Adder_(electronics) + +############################## +# PURE SED BINARY FULL ADDER # +############################## + + +# Input two lines, sanitize input +N +s/ //g +/^[01 ]\+\n[01 ]\+$/! { + i\ + ERROR: WRONG INPUT DATA + d + q +} +s/[ ]//g + +# Add place for Sum and Cary bit +s/$/\n\n0/ + +:LOOP +# Pick A,B and C bits and put that to hold +s/^\(.*\)\(.\)\n\(.*\)\(.\)\n\(.*\)\n\(.\)$/0\1\n0\3\n\5\n\6\2\4/ +h + +# Grab just A,B,C +s/^.*\n.*\n.*\n\(...\)$/\1/ + +# binary full adder module +# INPUT: 3bits (A,B,Carry in), for example 101 +# OUTPUT: 2bits (Carry, Sum), for wxample 10 +s/$/;000=00001=01010=01011=10100=01101=10110=10111=11/ +s/^\(...\)[^;]*;[^;]*\1=\(..\).*/\2/ + +# Append the sum to hold +H + +# Rewrite the output, append the sum bit to final sum +g +s/^\(.*\)\n\(.*\)\n\(.*\)\n...\n\(.\)\(.\)$/\1\n\2\n\5\3\n\4/ + +# Output result and exit if no more bits to process.. +/^\([0]*\)\n\([0]*\)\n/ { + s/^.*\n.*\n\(.*\)\n\(.\)/\2\1/ + s/^0\(.*\)/\1/ + q +} + +b LOOP diff --git a/Task/Four-bit-adder/Sed/four-bit-adder-2.sed b/Task/Four-bit-adder/Sed/four-bit-adder-2.sed new file mode 100644 index 0000000000..8c406f2d71 --- /dev/null +++ b/Task/Four-bit-adder/Sed/four-bit-adder-2.sed @@ -0,0 +1,14 @@ +./binAdder.sed +1111110111 +1 +1111111000 + +./binAdder.sed +10 +10001 +10011 + +./binAdder.sed +0 1 1 0 +0 0 0 1 +111 diff --git a/Task/Fractal-tree/00DESCRIPTION b/Task/Fractal-tree/00DESCRIPTION index b8844d4f56..cc7a94e453 100644 --- a/Task/Fractal-tree/00DESCRIPTION +++ b/Task/Fractal-tree/00DESCRIPTION @@ -1,6 +1,10 @@ Generate and draw a fractal tree. -To draw a fractal tree is simple: # Draw the trunk # At the end of the trunk, split by some angle and draw two branches # Repeat at the end of each branch until a sufficient level of branching is reached + + +;Related tasks +* [[Pythagoras_tree|Pythagoras Tree]] +

    diff --git a/Task/Fractal-tree/Frege/fractal-tree.frege b/Task/Fractal-tree/Frege/fractal-tree.frege new file mode 100644 index 0000000000..ef0b888e21 --- /dev/null +++ b/Task/Fractal-tree/Frege/fractal-tree.frege @@ -0,0 +1,79 @@ +module FractalTree where + +import Java.IO +import Prelude.Math + +data AffineTransform = native java.awt.geom.AffineTransform where + native new :: () -> STMutable s AffineTransform + native clone :: Mutable s AffineTransform -> STMutable s AffineTransform + native rotate :: Mutable s AffineTransform -> Double -> ST s () + native scale :: Mutable s AffineTransform -> Double -> Double -> ST s () + native translate :: Mutable s AffineTransform -> Double -> Double -> ST s () + +data BufferedImage = native java.awt.image.BufferedImage where + pure native type_3byte_bgr "java.awt.image.BufferedImage.TYPE_3BYTE_BGR" :: Int + native new :: Int -> Int -> Int -> STMutable s BufferedImage + native createGraphics :: Mutable s BufferedImage -> STMutable s Graphics2D + +data Color = pure native java.awt.Color where + pure native black "java.awt.Color.black" :: Color + pure native green "java.awt.Color.green" :: Color + pure native white "java.awt.Color.white" :: Color + pure native new :: Int -> Color + +data BasicStroke = pure native java.awt.BasicStroke where + pure native new :: Float -> BasicStroke + +data RenderingHints = native java.awt.RenderingHints where + pure native key_antialiasing "java.awt.RenderingHints.KEY_ANTIALIASING" :: RenderingHints_Key + pure native value_antialias_on "java.awt.RenderingHints.VALUE_ANTIALIAS_ON" :: Object + +data RenderingHints_Key = pure native java.awt.RenderingHints.Key + +data Graphics2D = native java.awt.Graphics2D where + native drawLine :: Mutable s Graphics2D -> Int -> Int -> Int -> Int -> ST s () + native drawOval :: Mutable s Graphics2D -> Int -> Int -> Int -> Int -> ST s () + native fillRect :: Mutable s Graphics2D -> Int -> Int -> Int -> Int -> ST s () + native setColor :: Mutable s Graphics2D -> Color -> ST s () + native setRenderingHint :: Mutable s Graphics2D -> RenderingHints_Key -> Object -> ST s () + native setStroke :: Mutable s Graphics2D -> BasicStroke -> ST s () + native setTransform :: Mutable s Graphics2D -> Mutable s AffineTransform -> ST s () + +data ImageIO = mutable native javax.imageio.ImageIO where + native write "javax.imageio.ImageIO.write" :: MutableIO BufferedImage -> String -> MutableIO File -> IO Bool throws IOException + +drawTree :: Mutable s Graphics2D -> Mutable s AffineTransform -> Int -> ST s () +drawTree g t i = do + let len = 10 -- ratio of length to thickness + shrink = 0.75 + angle = 0.3 -- radians + i' = i - 1 + g.setTransform t + g.drawLine 0 0 0 len + when (i' > 0) $ do + t.translate 0 (fromIntegral len) + t.scale shrink shrink + rt <- t.clone + t.rotate angle + rt.rotate (-angle) + drawTree g t i' + drawTree g rt i' + +main = do + let width = 900 + height = 800 + initScale = 20 + halfWidth = fromIntegral width / 2 + buffy <- BufferedImage.new width height BufferedImage.type_3byte_bgr + g <- buffy.createGraphics + g.setRenderingHint RenderingHints.key_antialiasing RenderingHints.value_antialias_on + g.setColor Color.black + g.fillRect 0 0 width height + g.setColor Color.green + t <- AffineTransform.new () + t.translate halfWidth (fromIntegral height) + t.scale initScale initScale + t.rotate pi + drawTree g t 16 + f <- File.new "FractalTreeFrege.png" + void $ ImageIO.write buffy "png" f diff --git a/Task/Fractal-tree/Haskell/fractal-tree-1.hs b/Task/Fractal-tree/Haskell/fractal-tree-1.hs new file mode 100644 index 0000000000..03c72d5227 --- /dev/null +++ b/Task/Fractal-tree/Haskell/fractal-tree-1.hs @@ -0,0 +1,8 @@ +import Graphics.Gloss + +type Model = [Picture -> Picture] + +fractal :: Int -> Model -> Picture -> Picture +fractal n model pict = pictures $ take n $ iterate (mconcat model) pict + +main = animate (InWindow "Tree" (800, 800) (0, 0)) white $ tree1 . (* 60) diff --git a/Task/Fractal-tree/Haskell/fractal-tree-2.hs b/Task/Fractal-tree/Haskell/fractal-tree-2.hs new file mode 100644 index 0000000000..2fc69d57f5 --- /dev/null +++ b/Task/Fractal-tree/Haskell/fractal-tree-2.hs @@ -0,0 +1,3 @@ +tree1 _ = fractal 10 branches $ Line [(0,0),(0,100)] + where branches = [ Translate 0 100 . Scale 0.75 0.75 . Rotate 30 + , Translate 0 100 . Scale 0.5 0.5 . Rotate (-30) ] diff --git a/Task/Fractal-tree/Haskell/fractal-tree-3.hs b/Task/Fractal-tree/Haskell/fractal-tree-3.hs new file mode 100644 index 0000000000..9461cd643b --- /dev/null +++ b/Task/Fractal-tree/Haskell/fractal-tree-3.hs @@ -0,0 +1,4 @@ +tree2 t = fractal 8 branches $ Line [(0,0),(0,100)] + where branches = [ Translate 0 100 . Scale 0.75 0.75 . Rotate t + , Translate 0 100 . Scale 0.6 0.6 . Rotate 0 + , Translate 0 100 . Scale 0.5 0.5 . Rotate (-2*t) ] diff --git a/Task/Fractal-tree/Haskell/fractal-tree-4.hs b/Task/Fractal-tree/Haskell/fractal-tree-4.hs new file mode 100644 index 0000000000..f1940629bd --- /dev/null +++ b/Task/Fractal-tree/Haskell/fractal-tree-4.hs @@ -0,0 +1,3 @@ +circles t = fractal 10 model $ Circle 100 + where model = [ Translate 0 50 . Scale 0.5 0.5 . Rotate t + , Translate 0 (-50) . Scale 0.5 0.5 . Rotate (-2*t) ] diff --git a/Task/Fractal-tree/Haskell/fractal-tree-5.hs b/Task/Fractal-tree/Haskell/fractal-tree-5.hs new file mode 100644 index 0000000000..65758459fd --- /dev/null +++ b/Task/Fractal-tree/Haskell/fractal-tree-5.hs @@ -0,0 +1,4 @@ +pithagor _ = fractal 10 model $ rectangleWire 100 100 + where model = [ Translate 50 100 . Scale s s . Rotate 45 + , Translate (-50) 100 . Scale s s . Rotate (-45)] + s = 1/sqrt 2 diff --git a/Task/Fractal-tree/Haskell/fractal-tree-6.hs b/Task/Fractal-tree/Haskell/fractal-tree-6.hs new file mode 100644 index 0000000000..97cf12e4c0 --- /dev/null +++ b/Task/Fractal-tree/Haskell/fractal-tree-6.hs @@ -0,0 +1,6 @@ +pentaflake _ = fractal 5 model $ pentagon + where model = map copy [0,72..288] + copy a = Scale s s . Rotate a . Translate 0 x + pentagon = Line [ (sin a, cos a) | a <- [0,2*pi/5..2*pi] ] + x = 2*cos(pi/5) + s = 1/(1+x) diff --git a/Task/Fractal-tree/Haskell/fractal-tree.hs b/Task/Fractal-tree/Haskell/fractal-tree-7.hs similarity index 100% rename from Task/Fractal-tree/Haskell/fractal-tree.hs rename to Task/Fractal-tree/Haskell/fractal-tree-7.hs diff --git a/Task/Fractal-tree/PARI-GP/fractal-tree.pari b/Task/Fractal-tree/PARI-GP/fractal-tree.pari new file mode 100644 index 0000000000..9bbdf60526 --- /dev/null +++ b/Task/Fractal-tree/PARI-GP/fractal-tree.pari @@ -0,0 +1,33 @@ +\\ Fractal tree (w/recursion) +\\ 4/10/16 aev +plotline(x1,y1,x2,y2)={plotmove(0, x1,y1);plotrline(0,x2-x1,y2-y1);} + +plottree(x,y,a,d)={ +my(x2,y2,d2r=Pi/180.0,a1=a*d2r,d1); +if(d<=0, return();); +if(d>0, d1=d*10.0; + x2=x+cos(a1)*d1; + y2=y+sin(a1)*d1; + plotline(x,y,x2,y2); + plottree(x2,y2,a-20,d-1); + plottree(x2,y2,a+20,d-1), + return(); + ); +} + +FractalTree(depth,size)={ +my(dx=1,dy=0,ttlb="Fractal Tree, depth ",ttl=Str(ttlb,depth)); +print1(" *** ",ttl); print(", size ",size); +plotinit(0); +plotcolor(0,6); \\green +plotscale(0, -size,size, 0,size); +plotmove(0, 0,0); +plottree(0,0,90,depth); +plotdraw([0,size,size]); +} + +{\\ Executing: +FractalTree(9,500); \\FracTree1.png +FractalTree(12,1100); \\FracTree2.png +FractalTree(15,1500); \\FracTree3.png +} diff --git a/Task/Fractal-tree/ZX-Spectrum-Basic/fractal-tree.zx b/Task/Fractal-tree/ZX-Spectrum-Basic/fractal-tree.zx new file mode 100644 index 0000000000..08959e7140 --- /dev/null +++ b/Task/Fractal-tree/ZX-Spectrum-Basic/fractal-tree.zx @@ -0,0 +1,31 @@ +10 LET level=12: LET long=45 +20 LET x=127: LET y=0 +30 LET rotation=PI/2 +40 LET a1=PI/9: LET a2=PI/9 +50 LET c1=0.75: LET c2=0.75 +60 DIM x(level): DIM y(level) +70 BORDER 0: PAPER 0: INK 4: CLS +80 GO SUB 100 +90 STOP +100 REM Tree +110 LET x(level)=x: LET y(level)=y +120 GO SUB 1000 +130 IF level=1 THEN GO TO 240 +140 LET level=level-1 +150 LET long=long*c1 +160 LET rotation=rotation-a1 +170 GO SUB 100 +180 LET long=long/c1*c2 +190 LET rotation=rotation+a1+a2 +200 GO SUB 100 +210 LET rotation=rotation-a2 +220 LET long=long/c2 +230 LET level=level+1 +240 LET x=x(level): LET y=y(level) +250 RETURN +1000 REM Draw +1010 LET yn=-SIN rotation*long+y +1020 LET xn=COS rotation*long+x +1030 PLOT x,y: DRAW xn-x,y-yn +1040 LET x=xn: LET y=yn +1050 RETURN diff --git a/Task/Fractran/00DESCRIPTION b/Task/Fractran/00DESCRIPTION index c12430617c..2a7569eedc 100644 --- a/Task/Fractran/00DESCRIPTION +++ b/Task/Fractran/00DESCRIPTION @@ -1,12 +1,14 @@ - '''[[wp:FRACTRAN|FRACTRAN]]''' is a Turing-complete esoteric programming language invented by the mathematician [[wp:John Horton Conway|John Horton Conway]]. +'''[[wp:FRACTRAN|FRACTRAN]]''' is a Turing-complete esoteric programming language invented by the mathematician [[wp:John Horton Conway|John Horton Conway]]. A FRACTRAN program is an ordered list of positive fractions P = (f_1, f_2, \ldots, f_m), together with an initial positive integer input n. + The program is run by updating the integer n as follows: * for the first fraction, f_i, in the list for which nf_i is an integer, replace n with nf_i ; * repeat this rule until no fraction in the list produces an integer when multiplied by n, then halt. +
    Conway gave a program for primes in FRACTRAN: : 17/91, 78/85, 19/51, 23/38, 29/33, 77/29, 95/23, 77/19, 1/17, 11/13, 13/11, 15/14, 15/2, 55/1 @@ -21,17 +23,23 @@ After 2, this sequence contains the following powers of 2: which are the prime powers of 2. -'''Your task''' is to -write a program that reads a list of fractions in a ''natural'' format from the keyboard or from a string, + +;Task: +Write a program that reads a list of fractions in a ''natural'' format from the keyboard or from a string, to parse it into a sequence of fractions (''i.e.'' two integers), and runs the FRACTRAN starting from a provided integer, writing the result at each step. It is also required that the number of step is limited (by a parameter easy to find). -'''Extra credit:''' Use this program to derive the first 20 or so prime numbers. +;Extra credit: +Use this program to derive the first '''20''' or so prime numbers. + + +;See also: For more on how to program FRACTRAN as a universal programming language, see: * J. H. Conway (1987). Fractran: A Simple Universal Programming Language for Arithmetic. In: Open Problems in Communication and Computation, pages 4–26. Springer. * J. H. Conway (2010). "FRACTRAN: A simple universal programming language for arithmetic". In Jeffrey C. Lagarias. The Ultimate Challenge: the 3x+1 problem. American Mathematical Society. pp. 249–264. ISBN 978-0-8218-4940-8. Zbl 1216.68068. * [http://scienceblogs.com/goodmath/2006/10/27/prime-number-pathology-fractra/Prime Number Pathology: Fractran] by Mark C. Chu-Carroll; October 27, 2006. +

    diff --git a/Task/Fractran/ALGOL-68/fractran.alg b/Task/Fractran/ALGOL-68/fractran.alg new file mode 100644 index 0000000000..c1d894374e --- /dev/null +++ b/Task/Fractran/ALGOL-68/fractran.alg @@ -0,0 +1,74 @@ +# as the numbers required for finding the first 20 primes are quite large, # +# we use Algol 68G's LONG LONG INT with a precision of 100 digits # +PR precision 100 PR + +# mode to hold fractions # +MODE FRACTION = STRUCT( INT numerator, INT denominator ); + +# define / between two INTs to yield a FRACTION # +OP / = ( INT a, b )FRACTION: ( a, b ); + +# mode to define a FRACTRAN progam # +MODE FRACTRAN = STRUCT( FLEX[0]FRACTION data + , LONG LONG INT n + , BOOL halted + ); +# prepares a FRACTRAN program for use - sets the initial value of n and halted to FALSE # +PRIO STARTAT = 1; +OP STARTAT = ( REF FRACTRAN f, INT start )REF FRACTRAN: +BEGIN + halted OF f := FALSE; + n OF f := start; + f +END; + +# sets n OF f to the next number in the sequence or sets halted OF f to TRUE if the sequence has ended # +OP NEXT = ( REF FRACTRAN f )LONG LONG INT: + IF halted OF f + THEN n OF f := 0 + ELSE + BOOL found := FALSE; + LONG LONG INT result := 0; + FOR pos FROM LWB data OF f TO UPB data OF f WHILE NOT found DO + LONG LONG INT value = n OF f * numerator OF ( ( data OF f )[ pos ] ); + INT denominator = denominator OF ( ( data OF f )[ pos ] ); + IF found := ( value MOD denominator = 0 ) THEN result := value OVER denominator FI + OD; + IF NOT found THEN halted OF f := TRUE FI; + n OF f := result + FI ; + +# generate and print the sequence of numbers from a FRACTRAN pogram # +PROC print fractran sequence = ( REF FRACTRAN f, INT start, INT limit )VOID: +BEGIN + VOID( f STARTAT start ); + print( ( "0: ", whole( start, 0 ) ) ); + FOR i TO limit + WHILE VOID( NEXT f ); + NOT halted OF f + DO + print( ( " " + whole( i, 0 ) + ": " + whole( n OF f, 0 ) ) ) + OD; + print( ( newline ) ) +END ; + +# print the first 16 elements from the primes FRACTRAN program # +FRACTRAN pf := ( ( 17/91, 78/85, 19/51, 23/38, 29/33, 77/29, 95/23, 77/19, 1/17, 11/13, 13/11, 15/14, 15/2, 55/1 ), 0, FALSE ); +print fractran sequence( pf, 2, 15 ); + +# find some primes using the pf FRACTRAN progam - n is prime for the members in the sequence that are 2^n # +INT primes found := 0; +VOID( pf STARTAT 2 ); +INT pos := 0; +print( ( "seq position prime sequence value", newline ) ); +WHILE primes found < 20 AND NOT halted OF pf DO + LONG LONG INT value := NEXT pf; + INT power of 2 := 0; + pos +:= 1; + WHILE value MOD 2 = 0 AND value > 0 DO power of 2 PLUSAB 1; value OVERAB 2 OD; + IF value = 1 THEN + # found a prime # + primes found +:= 1; + print( ( whole( pos, -12 ) + " " + whole( power of 2, -6 ) + " (" + whole( n OF pf, 0 ) + ")", newline ) ) + FI +OD diff --git a/Task/Fractran/Elixir/fractran.elixir b/Task/Fractran/Elixir/fractran.elixir new file mode 100644 index 0000000000..ba20d4614f --- /dev/null +++ b/Task/Fractran/Elixir/fractran.elixir @@ -0,0 +1,66 @@ +defmodule Fractran do + use Bitwise + + defp binary_to_ratio(b) do + [_, num, den] = Regex.run(~r/(\d+)\/(\d+)/, b) + {String.to_integer(num), String.to_integer(den)} + end + + def load(program) do + String.split(program) |> Enum.map(&binary_to_ratio(&1)) + end + + defp step(_, []), do: :halt + defp step(n, [f|fs]) do + {p, q} = mulrat(f, {n, 1}) + case q do + 1 -> p + _ -> step(n, fs) + end + end + + def exec(k, n, program) do + exec(k-1, n, fn (_) -> true end, program, [n]) |> Enum.reverse + end + + def exec(k, n, pred, program) do + exec(k-1, n, pred, program, [n]) |> Enum.reverse + end + + defp exec(0, _, _, _, steps), do: steps + defp exec(k, n, pred, program, steps) do + case step(n, program) do + :halt -> steps + m -> if pred.(m), do: exec(k-1, m, pred, program, [m|steps]), + else: exec(k, m, pred, program, steps) + end + end + + def is_pow2(n), do: band(n, n-1) == 0 + + def lowbit(n), do: lowbit(n, 0) + + defp lowbit(n, k) do + case band(n, 1) do + 0 -> lowbit(bsr(n, 1), k + 1) + 1 -> k + end + end + + # rational multiplication + defp mulrat({a, b}, {c, d}) do + {p, q} = {a*c, b*d} + g = gcd(p, q) + {div(p, g), div(q, g)} + end + + defp gcd(a, 0), do: a + defp gcd(a, b), do: gcd(b, rem(a, b)) +end + +primegen = Fractran.load("17/91 78/85 19/51 23/38 29/33 77/29 95/23 77/19 1/17 11/13 13/11 15/14 15/2 55/1") +IO.puts "The first few states of the Fractran prime automaton are:\n#{inspect Fractran.exec(20, 2, primegen)}\n" +prime = Fractran.exec(26, 2, &Fractran.is_pow2/1, primegen) + |> Enum.map(&Fractran.lowbit/1) + |> tl +IO.puts "The first few primes are:\n#{inspect prime}" diff --git a/Task/Fractran/Erlang/fractran.erl b/Task/Fractran/Erlang/fractran.erl new file mode 100644 index 0000000000..8dae1f0d2c --- /dev/null +++ b/Task/Fractran/Erlang/fractran.erl @@ -0,0 +1,59 @@ +#! /usr/bin/escript + +-mode(native). +-import(lists, [map/2, reverse/1]). + +binary_to_ratio(B) -> + {match, [_, Num, Den]} = re:run(B, "([0-9]+)/([0-9]+)"), + {binary_to_integer(binary:part(B, Num)), + binary_to_integer(binary:part(B, Den))}. + +load(Program) -> + map(fun binary_to_ratio/1, re:split(Program, "[ ]+")). + +step(_, []) -> halt; +step(N, [F|Fs]) -> + {P, Q} = mulrat(F, {N, 1}), + case Q of + 1 -> P; + _ -> step(N, Fs) + end. + +exec(K, N, Program) -> reverse(exec(K - 1, N, fun (_) -> true end, Program, [N])). +exec(K, N, Pred, Program) -> reverse(exec(K - 1, N, Pred, Program, [N])). + +exec(0, _, _, _, Steps) -> Steps; +exec(K, N, Pred, Program, Steps) -> + case step(N, Program) of + halt -> Steps; + M -> case Pred(M) of + true -> exec(K - 1, M, Pred, Program, [M|Steps]); + false -> exec(K, M, Pred, Program, Steps) + end + end. + + +is_pow2(N) -> N band (N - 1) =:= 0. + +lowbit(N) -> lowbit(N, 0). +lowbit(N, K) -> + case N band 1 of + 0 -> lowbit(N bsr 1, K + 1); + 1 -> K + end. + +main(_) -> + PrimeGen = load("17/91 78/85 19/51 23/38 29/33 77/29 95/23 77/19 1/17 11/13 13/11 15/14 15/2 55/1"), + io:format("The first few states of the Fractran prime automaton are: ~p~n~n", [exec(20, 2, PrimeGen)]), + io:format("The first few primes are: ~p~n", [tl(map(fun lowbit/1, exec(26, 2, fun is_pow2/1, PrimeGen)))]). + + +% rational multiplication + +mulrat({A, B}, {C, D}) -> + {P, Q} = {A*C, B*D}, + G = gcd(P, Q), + {P div G, Q div G}. + +gcd(A, 0) -> A; +gcd(A, B) -> gcd(B, A rem B). diff --git a/Task/Fractran/Fortran/fractran-1.f b/Task/Fractran/Fortran/fractran-1.f new file mode 100644 index 0000000000..394fe9480f --- /dev/null +++ b/Task/Fractran/Fortran/fractran-1.f @@ -0,0 +1,2 @@ +C:\Nicky\RosettaCode\FRACTRAN\FRACTRAN.for(6) : Warning: This name has not been given an explicit type. [M] + INTEGER P(M),Q(M)!The terms of the fractions. diff --git a/Task/Fractran/Fortran/fractran-2.f b/Task/Fractran/Fortran/fractran-2.f new file mode 100644 index 0000000000..6a079ed26a --- /dev/null +++ b/Task/Fractran/Fortran/fractran-2.f @@ -0,0 +1,49 @@ + INTEGER FUNCTION FRACTRAN(N,P,Q,M) !Notion devised by J. H. Conway. +Careful: the rule is N*P/Q being integer. N*6/3 is integer always because this is N*2/1, but 3 may not divide N. +Could check GCD(P,Q), dividing out the common denominator so MOD(N,Q) works. + INTEGER*8 N !The work variable. Modified! + INTEGER M !The number of fractions supplied. + INTEGER P(M),Q(M)!The terms of the fractions. + INTEGER I !A stepper. + DO I = 1,M !Search the supplied fractions, P(i)/Q(i). + IF (MOD(N,Q(I)).EQ.0) THEN !Does the denominator divide N? + N = N/Q(I)*P(I) !Yes, compute N*P/Q but trying to dodge overflow. + FRACTRAN = I !Report the hit. + RETURN !Done! + END IF !Otherwise, + END DO !Try the next fraction in the order supplied. + FRACTRAN = 0 !No hit. + END FUNCTION FRACTRAN !That's it! Even so, "Turing complete"... + + PROGRAM POKE + INTEGER FRACTRAN !Not the default type of function. + INTEGER P(66),Q(66) !Holds the fractions as P(i)/Q(i). + INTEGER*8 N !The working number. + INTEGER I,IT,L,M !Assistants. + + WRITE (6,1) !Announce. + 1 FORMAT ("Interpreter for J.H. Conway's FRACTRAN language.") + +Chew into an example programme. + OPEN (10,FILE = "Fractran.txt",STATUS="OLD",ACTION="READ") !Rather than compiled-in stuff. + READ (10,*) L !I need to know this without having to scan the input. + WRITE (6,2) L !Reveal in case of trouble. + 2 FORMAT (I0," fractions, as follow:") !Should the input evoke problems. + READ (10,*) (P(I),Q(I),I = 1,L) !Ask for the specified number of P,Q pairs. + WRITE (6,3) (P(I),Q(I),I = 1,L) !Show what turned up. + 3 FORMAT (24(I0,"/",I0:", ")) !As P(i)/Q(i) pairs. The colon means that there will be no trailing comma. + READ (10,*) N,M !The start value, and the step limit. + CLOSE (10) !Finished with input. + WRITE (6,4) N,M !Hopefully, all went well. + 4 FORMAT ("Start with N = ",I0,", step limit ",I0) + +Commence. + WRITE (6,10) 0,N !Splat a heading. + 10 FORMAT (/," Step #F: N",/,I6,4X,": ",I0) !Matched FORMAT 11. + DO I = 1,M !Here we go! + IT = FRACTRAN(N,P,Q,L) !Do it! + WRITE (6,11) I,IT,N !Show it! + 11 FORMAT (I6,I4,": ",I0) !N last, as it may be big. + IF (IT.LE.0) EXIT !No hit, so quit. + END DO !The next step. + END !Whee! diff --git a/Task/Fractran/Fortran/fractran-3.f b/Task/Fractran/Fortran/fractran-3.f new file mode 100644 index 0000000000..1a409a7c11 --- /dev/null +++ b/Task/Fractran/Fortran/fractran-3.f @@ -0,0 +1,11 @@ + DO I = 1,M !Here we go! + IT = FRACTRAN(N,P,Q,L) !Do it! + IF (POPCNT(N).EQ.1) WRITE (6,11) I,IT,N !Show it! + 11 FORMAT (I6,I4,": ",I0) !N last, as it may be big. + IF (IT.LE.0) EXIT !No hit, so quit. + IF (N.LE.0) THEN !Otherwise, worry about overflow. + WRITE (6,*) "Integer overflow!" !Justified. The test is not certain. + WRITE (6,11) I,IT,N !Alas, the step failed. + EXIT !Give in. + END IF !So much for overflow. + END DO !The next step. diff --git a/Task/Fractran/Fortran/fractran-4.f b/Task/Fractran/Fortran/fractran-4.f new file mode 100644 index 0000000000..6c05bac73a --- /dev/null +++ b/Task/Fractran/Fortran/fractran-4.f @@ -0,0 +1,188 @@ + MODULE CONWAYSIDEA !Notion devised by J. H. Conway. + USE PRIMEBAG !This is a common need. + INTEGER LASTP,ENUFF !Some size allowances. + PARAMETER (LASTP = 66, ENUFF = 66) !Should suffice for the example in mind. + INTEGER NPPOW(1:LASTP) !Represent N as a collection of powers of prime numbers. + TYPE FACTORED !But represent P and Q of freaction = P/Q + INTEGER PNUM(0:LASTP) !As a list of prime number indices with PNUM(0) the count. + INTEGER PPOW(LASTP) !And the powers. for the fingered primes. + END TYPE FACTORED !Rather than as a simple number multiplied out. + TYPE(FACTORED) FP(ENUFF),FQ(ENUFF) !Thus represent a factored fraction, P(i)/Q(i). + INTEGER PLIVE(ENUFF),NL !Helps subroutine SHOWN display NPPOW. + CONTAINS !Now for the details. + SUBROUTINE SHOWFACTORS(N) !First, to show an internal data structure. + TYPE(FACTORED) N !It is supplied as a list of prime factors. + INTEGER I !A stepper. + DO I = 1,N.PNUM(0) !Step along the list. + IF (I.GT.1) WRITE (MSG,"('x',$)") !Append a glyph for "multiply". + WRITE (MSG,"(I0,$)") PRIME(N.PNUM(I)) !The prime fingered in the list. + IF (N.PPOW(I).GT.1) WRITE (MSG,"('^',I0,$)") N.PPOW(I) !With an interesting power? + END DO !On to the next element in the list. + WRITE (MSG,1) N.PNUM(0) !End the line + 1 FORMAT (": Factor count ",I0) !With a count of prime factors. + END SUBROUTINE SHOWFACTORS !Hopefully, this will not be needed often. + + TYPE(FACTORED) FUNCTION FACTOR(IT) !Into a list of primes and their powers. + INTEGER IT,N !The number and a copy to damage. + INTEGER P,POW !A stepper and a power. + INTEGER F,NF !A factor and a counter. + IF (IT.LE.0) STOP "Factor only positive numbers!" !Or else... + N = IT !A copy I can damage. + NF = 0 !No factors found. + P = 0 !Because no primes have been tried. + PP:DO WHILE (IT.GT.1) !Step through the possibilities. + P = P + 1 !Another prime impends. + F = PRIME(P) !Grab a possible factor. + POW = 0 !It has no power yet. + FP:DO WHILE(MOD(N,F).EQ.0) !Well? + POW = POW + 1 !Count a factor.. + N = N/F !Reduce the number. + END DO FP !The P'th prime's power's produced. + IF (POW.GT.0) THEN !So, was it a factor? + IF (NF.GE.LASTP) THEN !Yes. Have I room in the list? + WRITE (MSG,1) IT,LASTP !Alas. + 1 FORMAT ("Factoring ",I0," but with provision for only ", + 1 I0," prime factors!") + FACTOR.PNUM(0) = NF !Place the count so far, + CALL SHOWFACTORS(FACTOR)!So this can be invoked. + STOP "Not enough storage!" !Quite. + END IF !But normally, + NF = NF + 1 !Admit another factor. + FACTOR.PNUM(NF) = P !Identify the prime. + FACTOR.PPOW(NF) = POW !Place its power. + END IF !So much for that factor. + IF (N.LE.1) EXIT PP !Perhaps nothing remains? + END DO PP !Try another prime. + FACTOR.PNUM(0) = NF !Place the count. + END FUNCTION FACTOR !Thus, a list of primes and their powers. + + INTEGER FUNCTION GCD(I,J) !Greatest common divisor. + INTEGER I,J !Of these two integers. + INTEGER N,M,R !Workers. + N = MAX(I,J) !Since I don't want to damage I or J, + M = MIN(I,J) !These copies might as well be the right way around. + 1 R = MOD(N,M) !Divide N by M to get the remainder R. + IF (R.GT.0) THEN !Remainder zero? + N = M !No. Descend a level. + M = R !M-multiplicity has been removed from N. + IF (R .GT. 1) GO TO 1 !No point dividing by one. + END IF !If R = 0, M divides N. + GCD = M !There we are. + END FUNCTION GCD !Euclid lives on! + + INTEGER FUNCTION FRACTRAN(L) !Applies Conway's idea to a list of fractions. +Could abandon all parameters since global variables have the details... + INTEGER L !The last fraction to consider. + INTEGER I,NF !Assistants. + DO I = 1,L !Step through the fractions in the order they were given. + NF = FQ(I).PNUM(0) !How many factors are listed in FQ(I)? + IF (ALL(NPPOW(FQ(I).PNUM(1:NF)) !Can N (as NPPOW) be divided by Q (as FQ)? + 1 .GE. FQ(I).PPOW(1:NF))) THEN !By comparing the supplies of prime factors. + FRACTRAN = I !Yes! + NPPOW(FQ(I).PNUM(1:NF)) = NPPOW(FQ(I).PNUM(1:NF)) !Remove prime powers from N + 1 - FQ(I).PPOW(1:NF) !Corresponding to Q. + NF = FP(I).PNUM(0) !Add powers to N + NPPOW(FP(I).PNUM(1:NF)) = NPPOW(FP(I).PNUM(1:NF)) !Corresponding to P. + 1 + FP(I).PPOW(1:NF) !Thus, N = N/Q*P. + RETURN !That's all it takes! No multiplies nor divides! + END IF !So much for that fraction. + END DO !This relies on ALL(zero tests) yielding true, as when Q = 1. + FRACTRAN = 0 !No hit. + END FUNCTION FRACTRAN !No massive multi-precision arithmetic! + + SUBROUTINE SHOWN(S,F) !Service routine to show the state after a step is calculated. +Could imaging a function I6FMT(23) that returns " 23" and " " for non-positive numbers. +Can't do it, as if this were invoked via a WRITE statement, re-entrant use of WRITE usually fails. + INTEGER S,F !Step number, Fraction number. + INTEGER I !A stepper. + CHARACTER*(9+4+1 + NL*6) ALINE !A scratchpad matching FORMAT 103. + WRITE (ALINE,103) S,F,NPPOW(PLIVE(1:NL)) !Show it! + 103 FORMAT (I9,I4,":",I6) !As a sequence of powers of primes. + IF (F.LE.0) ALINE(10:13) = "" !Scrub when no fraction is fingered. + DO I = 1,NL !Step along the live primes. + IF (NPPOW(PLIVE(I)).GT.0) CYCLE !Ignoring the empowered ones. + ALINE(15 + (I - 1)*6:14 + I*6) = "" !Blank out zero powers. + END DO !On to the next. + WRITE (MSG,"(A)") ALINE !Reveal at last. + END SUBROUTINE SHOWN !A struggle. + END MODULE CONWAYSIDEA !Simple... + + PROGRAM POKE + USE CONWAYSIDEA !But, where does he get his ideas from? + INTEGER P(ENUFF),Q(ENUFF) !Holds the fractions as P(i)/Q(i). + INTEGER N !The working number. + INTEGER LF !Last fraction given. + INTEGER LP !Last prime needed. + INTEGER MS !Maximum number of steps. + INTEGER I,IT !Assistants. + LOGICAL*1 PUSED(ENUFF) !Track the usage of prime numbers, + + MSG = 6 !Standard output. + WRITE (6,1) !Announce. + 1 FORMAT ("Interpreter for J. H. Conway's FRACTRAN language.") + +Chew into an example programme. + 10 OPEN (10,FILE = "Fractran.txt",STATUS="OLD",ACTION="READ") !Rather than compiled-in stuff. + READ (10,*) LF !I need to know this without having to scan the input. + WRITE (MSG,11) LF !Reveal in case of trouble. + 11 FORMAT (I0," fractions, as follow:") !Should the input evoke problems. + READ (10,*) (P(I),Q(I),I = 1,LF) !Ask for the specified number of P,Q pairs. + WRITE (MSG,12) (P(I),Q(I),I = 1,LF) !Show what turned up. + 12 FORMAT (24(I0,"/",I0:", ")) !As P(i)/Q(i) pairs. The colon means that there will be no trailing comma. + READ (10,*) N,MS !The start value, and the step limit. + CLOSE (10) !Finished with input. + WRITE (MSG,13) N,MS !Hopefully, all went well. + 13 FORMAT ("Start with N = ",I0,", step limit ",I0) + IF (.NOT.GRASPPRIMEBAG(66)) STOP "Gan't grab my file of primes!" !Attempt in hope. + +Convert the starting number to a more convenient form, an array of powers of successive prime numbers. + 20 FP(1) = FACTOR(N) !Borrow one of the factor list variables. + NPPOW = 0 !Clear all prime factor counts. + DO I = 1,FP(1).PNUM(0) !Now find what they are. + NPPOW(FP(1).PNUM(I)) = FP(1).PPOW(I) !Convert from a variable-length list + END DO !To a fixed-length random-access array. + PUSED = NPPOW.GT.0 !Note which primes have been used. + LP = FP(1).PNUM(FP(1).PNUM(0)) !Recall the last prime required. More later. +Convert the supplied P(i)/Q(i) fractions to lists of prime number factors and powers in FP(i) and FQ(i). + DO I = 1,LF !Step through the fractions. + IT = GCD(P(I),Q(I)) !Suspicion. + IF (IT.GT.1) THEN !Justified? + WRITE (MSG,21) I,P(I),Q(I),IT !Alas. Complain. The rule is N*(P/Q) being integer. + 21 FORMAT ("Fraction ",I3,", ",I0,"/",I0,!N*6/3 is integer always because this is N*2/1, but 3 may not divide N. + 1 " has common factor ",I0,"!") !By removing IT, + P(I) = P(I)/IT !The test need merely check if N is divisible by Q. + Q(I) = Q(I)/IT !And, as N is factorised in NPPOW + END IF !And Q in FQ, subtractions of powers only is needed. + FP(I) = FACTOR(P(I)) !Righto, form the factor list for P. + PUSED(FP(I).PNUM(1:FP(I).PNUM(0))) = .TRUE. !Mark which primes it fingers. + LP = MAX(LP,FP(I).PNUM(FP(I).PNUM(0))) !One has no prime factors: PNUM(0) = 0. + FQ(I) = FACTOR(Q(I)) !And likewise for Q. + PUSED(FQ(I).PNUM(1:FQ(I).PNUM(0))) = .TRUE. !Some primes may be omitted. + LP = MAX(LP,FQ(I).PNUM(FQ(I).PNUM(0))) !If no prime factors, PNUM(0) fingers element zero, which is zero. + END DO !All this messing about saves on multiplication and division. +Check which primes are in use, preparing an index of live primes.. + NL = 0 !No live primes. + DO I = 1,LP !Check up to the last prime. + IF (PUSED(I)) THEN !This one used? + NL = NL + 1 !Yes. Another. + PLIVE(NL) = I !Fingered. + END IF !So much for that prime. + END DO !On to the next. + WRITE (MSG,22) NL,LP,PRIME(LP) !Remark on usage. + 22 FORMAT ("Require ",I0," primes only, up to Prime(",I0,") = ",I0) !Presume always more than one prime. + IF (LP.GT.LASTP) STOP "But, that's too many for array NPPOW!" + +Cast forth a heading. + 100 WRITE (MSG,101) (PRIME(PLIVE(I)), I = 1,NL) !Splat a heading. + 101 FORMAT (/,14X,"N as powers of prime factors",/, !The prime heading, + 1 5X,"Step F#:",I6) !With primes beneath. + CALL SHOWN(0,0) !Initial state of N as NPPOW. Step zero, no fraction. + +Commence! + DO I = 1,MS !Here we go! + IT = FRACTRAN(LF) !Do it! + CALL SHOWN(I,IT) !Show it! + IF (IT.LE.0) EXIT !Quit it? + END DO !The next step. +Complete! + END !Whee! diff --git a/Task/Fractran/Fortran/fractran-5.f b/Task/Fractran/Fortran/fractran-5.f new file mode 100644 index 0000000000..65e4304ded --- /dev/null +++ b/Task/Fractran/Fortran/fractran-5.f @@ -0,0 +1,5 @@ + DO I = 1,MS !Here we go! + IT = FRACTRAN(LF) !Do it! + IF (ALL(NPPOW(2:LP).EQ.0)) CALL SHOWN(I,IT) !Show it! + IF (IT.LE.0) EXIT !Quit it? + END DO !The next step. diff --git a/Task/Fractran/Haskell/fractran.hs b/Task/Fractran/Haskell/fractran-1.hs similarity index 64% rename from Task/Fractran/Haskell/fractran.hs rename to Task/Fractran/Haskell/fractran-1.hs index e80a1ec778..62a7e07125 100644 --- a/Task/Fractran/Haskell/fractran.hs +++ b/Task/Fractran/Haskell/fractran-1.hs @@ -6,7 +6,3 @@ fractran fracts n = n : case find (\f -> n `mod` denominator f == 0) fracts of Nothing -> [] Just f -> fractran fracts $ truncate (fromIntegral n * f) - -main :: IO () -main = print $ take 15 $ fractran [17%91, 78%85, 19%51, 23%38, 29%33, 77%29, - 95%23, 77%19, 1%17, 11%13, 13%11, 15%14, 15%2, 55%1] 2 diff --git a/Task/Fractran/Haskell/fractran-2.hs b/Task/Fractran/Haskell/fractran-2.hs new file mode 100644 index 0000000000..ca7edb7ee2 --- /dev/null +++ b/Task/Fractran/Haskell/fractran-2.hs @@ -0,0 +1 @@ +import Data.List.Split (splitOn) diff --git a/Task/Fractran/Haskell/fractran-3.hs b/Task/Fractran/Haskell/fractran-3.hs new file mode 100644 index 0000000000..016f668261 --- /dev/null +++ b/Task/Fractran/Haskell/fractran-3.hs @@ -0,0 +1,3 @@ +readProgram :: String -> [Ratio a] +readProgram = map (toFrac . splitOn "/") . splitOn "," + where toFrac [n,d] = read n % read d diff --git a/Task/Fractran/Haskell/fractran-4.hs b/Task/Fractran/Haskell/fractran-4.hs new file mode 100644 index 0000000000..2295f7eabb --- /dev/null +++ b/Task/Fractran/Haskell/fractran-4.hs @@ -0,0 +1 @@ +import Data.Maybe (mapMaybe) diff --git a/Task/Fractran/Haskell/fractran-5.hs b/Task/Fractran/Haskell/fractran-5.hs new file mode 100644 index 0000000000..e2dba89ded --- /dev/null +++ b/Task/Fractran/Haskell/fractran-5.hs @@ -0,0 +1,6 @@ +primes = mapMaybe log2 $ fractran prog 2 + where + prog = [17 % 91, 78 % 85, 19 % 51, 23 % 38, 29 % 33 + ,77 % 29, 95 % 23, 77 % 19, 1 % 17, 11 % 13 + ,13 % 11, 15 % 14, 15 % 2, 55 % 1] + log2 = fmap (+ 1) . findIndex (== 2) . takeWhile even . iterate (`div` 2) diff --git a/Task/Fractran/OCaml/fractran.ocaml b/Task/Fractran/OCaml/fractran.ocaml new file mode 100644 index 0000000000..e7dd7a3157 --- /dev/null +++ b/Task/Fractran/OCaml/fractran.ocaml @@ -0,0 +1,43 @@ +open Num + +let get_input () = + num_of_int ( + try int_of_string Sys.argv.(1) + with _ -> 10) + +let get_max_steps () = + try int_of_string Sys.argv.(2) + with _ -> 50 + +let read_program () = + let line = read_line () in + let words = Str.split (Str.regexp " +") line in + List.map num_of_string words + +let is_int n = n =/ (integer_num n) + +let run_program num prog = + + let replace n = + let rec step = function + | [] -> None + | h :: t -> + let n' = h */ n in + if is_int n' then Some n' else step t in + step prog in + + let rec repeat m lim = + Printf.printf " %s\n" (string_of_num m); + if lim = 0 then print_endline "Reached max step limit" else + match replace m with + | None -> print_endline "Finished" + | Some x -> repeat x (lim-1) + in + + let max_steps = get_max_steps () in + repeat num max_steps + +let () = + let num = get_input () in + let prog = read_program () in + run_program num prog diff --git a/Task/Fractran/PARI-GP/fractran.pari b/Task/Fractran/PARI-GP/fractran.pari new file mode 100644 index 0000000000..8da0f05f3e --- /dev/null +++ b/Task/Fractran/PARI-GP/fractran.pari @@ -0,0 +1,15 @@ +\\ FRACTRAN +\\ 4/27/16 aev +fractran(val,ft,lim)={ +my(ftn=#ft,fti,di,L=List(),j=0); +while(val&&j, 0 +sub fractran(@program) { + 2, { +first Int, map (* * $_).narrow, @program } ... 0 } -constant FT = 2, &ft ... 0; -say FT[^100]; +say fractran(<17/91 78/85 19/51 23/38 29/33 77/29 95/23 77/19 1/17 11/13 13/11 + 15/14 15/2 55/1>)[^100]; diff --git a/Task/Fractran/Perl-6/fractran-2.pl6 b/Task/Fractran/Perl-6/fractran-2.pl6 index f1acd96448..d415b3e7dc 100644 --- a/Task/Fractran/Perl-6/fractran-2.pl6 +++ b/Task/Fractran/Perl-6/fractran-2.pl6 @@ -1,7 +1,4 @@ -constant FT = 2, &ft ... 0; -constant FT2 = FT.grep: { not $_ +& ($_ - 1) } -for 1..* -> $i { - given FT2[$i] { - say $i, "\t", .msb, "\t", $_; - } +for fractran <17/91 78/85 19/51 23/38 29/33 77/29 95/23 77/19 1/17 11/13 13/11 + 15/14 15/2 55/1> { + say $++, "\t", .msb, "\t", $_ if .log %% log(2); } diff --git a/Task/Fractran/REXX/fractran-1.rexx b/Task/Fractran/REXX/fractran-1.rexx index 404b69824c..2ea1602548 100644 --- a/Task/Fractran/REXX/fractran-1.rexx +++ b/Task/Fractran/REXX/fractran-1.rexx @@ -1,23 +1,24 @@ -/*REXX pgm runs FRACTRAN for a given set of fractions and from a given N*/ -numeric digits 999 /*be able to handle larger nums. */ -parse arg N terms fracs /*get optional arguments from CL.*/ -if N=='' | N==',' then N=2 /*N specified? No, use default.*/ -if terms==''|terms==',' then terms=100 /*TERMS specified? Use default.*/ -if fracs='' then fracs= , /*any fractions specified? No···*/ -'17/91, 78/85, 19/51, 23/38, 29/33, 77/29, 95/23, 77/19, 1/17, 11/13, 13/11, 15/14, 15/2, 55/1' -f=space(fracs,0) /* [↑] use default for fractions.*/ - do i=1 while f\==''; parse var f n.i '/' d.i ',' f - end /*i*/ /* [↑] parse all the fractions.*/ -#=i-1 /*the number of fractions found. */ -say # 'fractions:' fracs /*display # and actual fractions.*/ -say 'N is starting at ' N /*display the starting number N.*/ -say terms ' terms are being shown:' /*display a kind of header/title.*/ +/*REXX program runs FRACTRAN for a given set of fractions and from a specified N. */ +numeric digits 2000 /*be able to handle larger numbers. */ +parse arg N terms fracs /*obtain optional arguments from the CL*/ +if N=='' | N=="," then N=2 /*Not specified? Then use the default.*/ +if terms=='' | terms=="," then terms=100 /* " " " " " " */ +if fracs='' then fracs= '17/91, 78/85, 19/51, 23/38, 29/33, 77/29, 95/23,', + '77/19, 1/17, 11/13, 13/11, 15/14, 15/2, 55/1' + /* [↑] The default for the fractions. */ +f=space(fracs,0) /*remove all blanks from the FRACS list*/ + do #=1 while f\==''; parse var f n.# '/' d.# "," f + end /*#*/ /* [↑] parse all the fractions in list*/ +#=#-1 /*the number of fractions just found. */ +say # 'fractions:' fracs /*display number and actual fractions. */ +say 'N is starting at ' N /*display the starting number N. */ +say terms ' terms are being shown:' /*display a kind of header/title. */ - do j=1 for terms /*perform loop once for each term*/ - do k=1 for #; if N//d.k\==0 then iterate /*not an integer?*/ - say right('term' j,35) '──► ' N /*display the Nth term with N. */ - N = N % d.k * n.k /*calculate the next term (use %)*/ - leave /*go start calculating next term.*/ - end /*k*/ /* [↑] if integer, found a new N*/ - end /*j*/ - /*stick a fork in it, we're done.*/ + do j=1 for terms /*perform the DO loop for each term. */ + do k=1 for # /* " " " " " " fraction*/ + if N//d.k\==0 then iterate /*Not an integer? Then ignore it. */ + say right('term' j, 35) "──► " N /*display the Nth term with the N. */ + N=N % d.k * n.k /*calculate next term (use %≡integer ÷)*/ + iterate j /*go start calculating the next term. */ + end /*k*/ /* [↑] if an integer, we found a new N*/ + end /*j*/ /*stick a fork in it, we're all done. */ diff --git a/Task/Fractran/REXX/fractran-2.rexx b/Task/Fractran/REXX/fractran-2.rexx index abc6dbcf67..8d2b61958f 100644 --- a/Task/Fractran/REXX/fractran-2.rexx +++ b/Task/Fractran/REXX/fractran-2.rexx @@ -1,35 +1,35 @@ -/*REXX pgm runs FRACTRAN for a given set of fractions and from a given N*/ -numeric digits 999; w=length(digits()) /*be able to handle larger nums. */ -parse arg N terms fracs /*get optional arguments from CL.*/ -if N=='' | N==',' then N=2 /*N specified? No, use default.*/ -if terms==''|terms==',' then terms=100 /*TERMS specified? Use default.*/ -if fracs='' then fracs= , /*any fractions specified? No···*/ -'17/91, 78/85, 19/51, 23/38, 29/33, 77/29, 95/23, 77/19, 1/17, 11/13, 13/11, 15/14, 15/2, 55/1' -f=space(fracs,0) /* [↑] use default for fractions.*/ -L=length(N) /*length in decimal digits of N.*/ -tell= terms>0 /*flag: show # or a power of 2.*/ - do i=1 while f\==''; parse var f n.i '/' d.i ',' f - end /*i*/ /* [↑] parse all the fractions.*/ -!.=0 /*default value for powers of 2.*/ -if \tell then do p=0 until length(_)>digits(); _=2**p; !._=1 - if p<2 then @._=left('',w+9) '2**'left(p,w) " " +/*REXX program runs FRACTRAN for a given set of fractions and from a specified N. */ +numeric digits 999; w=length(digits()) /*be able to handle gihugeic numbers. */ +parse arg N terms fracs /*obtain optional arguments from the CL*/ +if N=='' | N=="," then N=2 /*Not specified? Then use the default.*/ +if terms=='' | terms=="," then terms=100 /* " " " " " " */ +if fracs='' then fracs= '17/91, 78/85, 19/51, 23/38, 29/33, 77/29, 95/23,', + '77/19, 1/17, 11/13, 13/11, 15/14, 15/2, 55/1' + /* [↑] The default for the fractions. */ +f=space(fracs, 0) /*remove all blanks from the FRACS list*/ + do #=1 while f\==''; parse var f n.# '/' d.# "," f + end /*#*/ /* [↑] parse all the fractions in list*/ +#=#-1 /*adjust the number of fractions found.*/ +tell= terms>0 /*flag: show number or a power of 2.*/ +!.=0; _=1 /*the default value for powers of 2. */ +if \tell then do p=1 until length(_)>digits(); _=_+_; !._=1 + if p==1 then @._=left('',w+9) "2**"left(p,w) ' ' else @._='(prime' right(p,w)") 2**"left(p,w) ' ' - end /*p*/ /* [↑] build powers of 2 tables.*/ -#=i-1 /*the number of fractions found. */ -say # 'fractions:' fracs /*display # and actual fractions.*/ -say 'N is starting at ' N /*display the starting number N.*/ -if tell then say terms ' terms are being shown:' /*display hdr.*/ - else say 'only powers of two are being shown:' /* " " */ -q='(max digits used: ' /*a literal used in the SAY below*/ + end /*p*/ /* [↑] build powers of 2 tables. */ +L=length(N) /*length in decimal digits of integer N*/ +say # 'fractions:' fracs /*display number and actual fractions. */ +say 'N is starting at ' N /*display the starting number N. */ +if tell then say terms ' terms are being shown:' /*display hdr.*/ + else say 'only powers of two are being shown:' /* " " */ +q='(max digits used:' /*a literal used in the SAY below. */ - do j=1 for abs(terms) /*perform loop once for each term*/ - do k=1 for #; if N//d.k\==0 then iterate /*not an integer?*/ - if tell then say right('term' j,35) '──► ' N /*display Nth term&N*/ - else if !.N then say right('term' j,15) '──►' @.N q, - right(L,w)") " N /*2ⁿ.*/ - N = N % d.k * n.k /*calculate the next term (use %)*/ - L=max(L, length(N)) /*maximum number of decimal digs.*/ - leave /*go start calculating next term.*/ - end /*k*/ /* [↑] if integer, found a new N*/ - end /*j*/ - /*stick a fork in it, we're done.*/ + do j=1 for abs(terms) /*perform DO loop once for each term. */ + do k=1 for # /* " " " " " " fraction*/ + if N//d.k\==0 then iterate /*Not an integer? Then ignore it. */ + if tell then say right('term' j, 35) "──► " N /*display Nth term and N.*/ + else if !.N then say right('term' j,15) "──►" @.N q right(L,w)") " N + N=N % d.k * n.k /*calculate next term (use %≡integer ÷)*/ + L=max(L, length(N)) /*the maximum number of decimal digits.*/ + iterate j /*go start calculating the next term. */ + end /*k*/ /* [↑] if an integer, we found a new N*/ + end /*j*/ /*stick a fork in it, we're done. */ diff --git a/Task/Fractran/Ruby/fractran.rb b/Task/Fractran/Ruby/fractran.rb index 9839dfdb3f..6ee7d3dbad 100644 --- a/Task/Fractran/Ruby/fractran.rb +++ b/Task/Fractran/Ruby/fractran.rb @@ -1,5 +1,5 @@ -str ="17/91, 78/85, 19/51, 23/38, 29/33, 77/29, 95/23, 77/19, 1/17, 11/13, 13/11, 15/14, 15/2, 55/1" -FractalProgram = str.split(',').map(&:to_r) #=> array of rationals +str = %w[17/91 78/85 19/51 23/38 29/33 77/29 95/23 77/19 1/17 11/13 13/11 15/14 15/2 55/1] +FractalProgram = str.map(&:to_r) #=> array of rationals Runner = Enumerator.new do |y| num = 2 @@ -14,5 +14,5 @@ prime_generator = Enumerator.new do |y| end # demo -p Runner.take(20) +p Runner.take(20).map(&:numerator) p prime_generator.take(20) diff --git a/Task/Function-composition/00DESCRIPTION b/Task/Function-composition/00DESCRIPTION index 395be0ecfe..fb38655805 100644 --- a/Task/Function-composition/00DESCRIPTION +++ b/Task/Function-composition/00DESCRIPTION @@ -1,7 +1,15 @@ -Create a function, compose, whose two arguments ''f'' and ''g'', are both functions with one argument. -The result of compose is to be a function of one argument, (lets call the argument ''x''), which works like applying function ''f'' to the result of applying function ''g'' to ''x'', i.e, -: compose(''f'', ''g'') (''x'') = ''f''(''g''(''x'')) +;Task: +Create a function, compose,   whose two arguments   ''f''   and   ''g'',   are both functions with one argument. + + +The result of compose is to be a function of one argument, (lets call the argument   ''x''),   which works like applying function   ''f''   to the result of applying function   ''g''   to   ''x''. + + +;Example: + compose(''f'', ''g'') (''x'') = ''f''(''g''(''x'')) + Reference: [[wp:Function composition (computer science)|Function composition]] Hint: In some languages, implementing compose correctly requires creating a [[wp:Closure (computer science)|closure]]. +

    diff --git a/Task/Function-composition/AppleScript/function-composition.applescript b/Task/Function-composition/AppleScript/function-composition-1.applescript similarity index 54% rename from Task/Function-composition/AppleScript/function-composition.applescript rename to Task/Function-composition/AppleScript/function-composition-1.applescript index f124afe5ac..5e0c17c763 100644 --- a/Task/Function-composition/AppleScript/function-composition.applescript +++ b/Task/Function-composition/AppleScript/function-composition-1.applescript @@ -1,23 +1,23 @@ -- Compose two functions where each function is -- a script object with a call(x) handler. on compose(f, g) - script - on call(x) - f's call(g's call(x)) - end call - end script + script + on call(x) + f's call(g's call(x)) + end call + end script end compose script sqrt - on call(x) - x ^ 0.5 - end call + on call(x) + x ^ 0.5 + end call end script script twice - on call(x) - 2 * x - end call + on call(x) + 2 * x + end call end script compose(sqrt, twice)'s call(32) diff --git a/Task/Function-composition/AppleScript/function-composition-2.applescript b/Task/Function-composition/AppleScript/function-composition-2.applescript new file mode 100644 index 0000000000..544b0a8fdd --- /dev/null +++ b/Task/Function-composition/AppleScript/function-composition-2.applescript @@ -0,0 +1,67 @@ +-- Compose (right to left) a list of ordinary 2nd class handlers (of arbitrary length) + +-- compose :: [(a -> a)] -> (a -> a) +on compose(fs) + script + on lambda(x) + script + on lambda(a, f) + mReturn(f)'s lambda(a) + end lambda + end script + + foldr(result, x, fs) + end lambda + end script +end compose + + +-- TEST + +on root(x) + x ^ 0.5 +end root + +on succ(x) + x + 1 +end succ + +on half(x) + x / 2 +end half + + +on run + + tell compose([half, succ, root]) to lambda(5) + + --> 1.61803398875 +end run + + + +-- GENERIC FUNCTIONS + +-- foldr :: (a -> b -> a) -> a -> [b] -> a +on foldr(f, startValue, xs) + tell mReturn(f) + set v to startValue + set lng to length of xs + repeat with i from lng to 1 by -1 + set v to lambda(v, item i of xs, i, xs) + end repeat + return v + end tell +end foldr + +-- 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 diff --git a/Task/Function-composition/Fortran/function-composition.f b/Task/Function-composition/Fortran/function-composition.f new file mode 100644 index 0000000000..7b9a9014e3 --- /dev/null +++ b/Task/Function-composition/Fortran/function-composition.f @@ -0,0 +1,79 @@ +module functions_module + implicit none + private ! all by default + public :: f,g + +contains + + pure function f(x) + implicit none + real, intent(in) :: x + real :: f + f = sin(x) + end function f + + pure function g(x) + implicit none + real, intent(in) :: x + real :: g + g = cos(x) + end function g + +end module functions_module + +module compose_module + implicit none + private ! all by default + public :: compose + + interface + pure function f(x) + implicit none + real, intent(in) :: x + real :: f + end function f + + pure function g(x) + implicit none + real, intent(in) :: x + real :: g + end function g + end interface + +contains + + impure function compose(x, fi, gi) + implicit none + real, intent(in) :: x + procedure(f), optional :: fi + procedure(g), optional :: gi + real :: compose + + procedure (f), pointer, save :: fpi => null() + procedure (g), pointer, save :: gpi => null() + + if(present(fi) .and. present(gi))then + fpi => fi + gpi => gi + compose = 0 + return + endif + + if(.not. associated(fpi)) error stop "fpi" + if(.not. associated(gpi)) error stop "gpi" + + compose = fpi(gpi(x)) + + contains + + end function compose + +end module compose_module + +program test_compose + use functions_module + use compose_module + implicit none + write(*,*) "prepare compose:", compose(0.0, f,g) + write(*,*) "run compose:", compose(0.5) +end program test_compose diff --git a/Task/Function-composition/JavaScript/function-composition-3.js b/Task/Function-composition/JavaScript/function-composition-3.js new file mode 100644 index 0000000000..168c991f51 --- /dev/null +++ b/Task/Function-composition/JavaScript/function-composition-3.js @@ -0,0 +1,49 @@ +(function () { + 'use strict'; + + + // iterativeComposed :: [f] -> f + function iterativeComposed(fs) { + + return function (x) { + var i = fs.length, + e = x; + + while (i--) e = fs[i](e); + return e; + } + } + + // foldComposed :: [f] -> f + function foldComposed(fs) { + + return function (x) { + return fs + .reduceRight(function (a, f) { + return f(a); + }, x); + }; + } + + + var sqrt = Math.sqrt, + + succ = function (x) { + return x + 1; + }, + + half = function (x) { + return x / 2; + }; + + + // Testing two different multiple composition ([f] -> f) functions + + return [iterativeComposed, foldComposed] + .map(function (compose) { + + // both functions compose from right to left + return compose([half, succ, sqrt])(5); + + }); +})(); diff --git a/Task/Function-composition/JavaScript/function-composition-4.js b/Task/Function-composition/JavaScript/function-composition-4.js new file mode 100644 index 0000000000..ca5bb79926 --- /dev/null +++ b/Task/Function-composition/JavaScript/function-composition-4.js @@ -0,0 +1,21 @@ +(() => { + 'use strict'; + + + // compose :: [(a -> a)] -> (a -> a) + let compose = fs => x => fs.reduceRight((a, f) => f(a), x); + + + // TEST a composition of 3 functions (right to left) + + let sqrt = Math.sqrt, + + succ = x => x + 1, + + half = x => x / 2; + + + return compose([half, succ, sqrt])(5); + + // --> 1.618033988749895 +})(); diff --git a/Task/Function-composition/SuperCollider/function-composition.supercollider b/Task/Function-composition/SuperCollider/function-composition.supercollider new file mode 100644 index 0000000000..983ef2034c --- /dev/null +++ b/Task/Function-composition/SuperCollider/function-composition.supercollider @@ -0,0 +1,4 @@ +f = { |x| x + 1 }; +g = { |x| x * 2 }; +h = g <> f; +h.(8); // returns 18 diff --git a/Task/Function-definition/00DESCRIPTION b/Task/Function-definition/00DESCRIPTION index 39b6282dc3..05610c38f1 100644 --- a/Task/Function-definition/00DESCRIPTION +++ b/Task/Function-definition/00DESCRIPTION @@ -1,7 +1,14 @@ A function is a body of code that returns a value. + The value returned may depend on arguments provided to the function. + +;Task: Write a definition of a function called "multiply" that takes two arguments and returns their product. + (Argument types should be chosen so as not to distract from showing how functions are created and values returned). -See also:[[Function prototype]] + +;Related task: +*   [[Function prototype]] +

    diff --git a/Task/Function-definition/6502-Assembly/function-definition.6502 b/Task/Function-definition/6502-Assembly/function-definition.6502 new file mode 100644 index 0000000000..6f5a5a0fac --- /dev/null +++ b/Task/Function-definition/6502-Assembly/function-definition.6502 @@ -0,0 +1,8 @@ +MULTIPLY: STX MULN ; 6502 has no "acc += xreg" instruction, + TXA ; so use a memory address +MULLOOP: DEY + CLC ; remember to clear the carry flag before + ADC MULN ; doing addition or subtraction + CPY #$01 + BNE MULLOOP + RTS diff --git a/Task/Function-definition/Kotlin/function-definition.kotlin b/Task/Function-definition/Kotlin/function-definition.kotlin new file mode 100644 index 0000000000..804c15a396 --- /dev/null +++ b/Task/Function-definition/Kotlin/function-definition.kotlin @@ -0,0 +1,7 @@ +// One-liner +fun multiply(a: Int, b: Int) = a * b + +// Proper function definition +fun multiplyProper(a: Int, b: Int): Int { + return a * b +} diff --git a/Task/Function-definition/Maple/function-definition.maple b/Task/Function-definition/Maple/function-definition.maple new file mode 100644 index 0000000000..b7df6f0993 --- /dev/null +++ b/Task/Function-definition/Maple/function-definition.maple @@ -0,0 +1 @@ +multiply:= (a, b) -> a * b; diff --git a/Task/Function-definition/Perl-6/function-definition-9.pl6 b/Task/Function-definition/Perl-6/function-definition-9.pl6 index ede10262aa..eed5ad8efb 100644 --- a/Task/Function-definition/Perl-6/function-definition-9.pl6 +++ b/Task/Function-definition/Perl-6/function-definition-9.pl6 @@ -1 +1 @@ -@list.grep( -> $obj { $obj.substr(0,1).lc.match(/<[0..9 a..f]>/) ) +@list.grep( -> $obj { $obj.substr(0,1).lc.match(/<[0..9 a..f]>/) } ) diff --git a/Task/Function-definition/Processing/function-definition b/Task/Function-definition/Processing/function-definition new file mode 100644 index 0000000000..19faf4b361 --- /dev/null +++ b/Task/Function-definition/Processing/function-definition @@ -0,0 +1,4 @@ +float multiply(float x, float y) +{ + return x * y; +} diff --git a/Task/Function-definition/SETL/function-definition.setl b/Task/Function-definition/SETL/function-definition.setl new file mode 100644 index 0000000000..430df64be9 --- /dev/null +++ b/Task/Function-definition/SETL/function-definition.setl @@ -0,0 +1,3 @@ +proc multiply( a, b ); + return a * b; +end proc; diff --git a/Task/Function-definition/Simula/function-definition.simula b/Task/Function-definition/Simula/function-definition.simula new file mode 100644 index 0000000000..919a114a67 --- /dev/null +++ b/Task/Function-definition/Simula/function-definition.simula @@ -0,0 +1,9 @@ +BEGIN + INTEGER PROCEDURE multiply(x, y); + INTEGER x, y; + BEGIN + multiply := x * y + END; + Outint(multiply(7,8), 2); + Outimage +END diff --git a/Task/Function-definition/TXR/function-definition-2.txr b/Task/Function-definition/TXR/function-definition-2.txr index 9571d20a15..d9d7cdfb91 100644 --- a/Task/Function-definition/TXR/function-definition-2.txr +++ b/Task/Function-definition/TXR/function-definition-2.txr @@ -1,2 +1,2 @@ -@(do (defun mult (a b) (* a b)) - (put-line `3 * 4 = @(mult 3 4)`)) +(defun mult (a b) (* a b)) + (put-line `3 * 4 = @(mult 3 4)`) diff --git a/Task/Function-frequency/00DESCRIPTION b/Task/Function-frequency/00DESCRIPTION index aa412d7240..b0a17ff96a 100644 --- a/Task/Function-frequency/00DESCRIPTION +++ b/Task/Function-frequency/00DESCRIPTION @@ -1,4 +1,4 @@ -Display - for a program or runtime environment (whatever suites the style of your language) - the top ten most frequently occurring functions (or also identifiers or tokens, if preferred). +Display - for a program or runtime environment (whatever suits the style of your language) - the top ten most frequently occurring functions (or also identifiers or tokens, if preferred). This is a static analysis: The question is not how often each function is actually executed at runtime, but how often it is used by the programmer. diff --git a/Task/Function-frequency/AWK/function-frequency.awk b/Task/Function-frequency/AWK/function-frequency.awk new file mode 100644 index 0000000000..5fe984a1a3 --- /dev/null +++ b/Task/Function-frequency/AWK/function-frequency.awk @@ -0,0 +1,160 @@ +# syntax: GAWK -f FUNCTION_FREQUENCY.AWK filename(s).AWK +# +# sorting: +# PROCINFO["sorted_in"] is used by GAWK +# SORTTYPE is used by Thompson Automation's TAWK +# +BEGIN { +# create array of keywords to be ignored by lexer + asplit("BEGIN:END:atan2:break:close:continue:cos:delete:" \ + "do:else:exit:exp:for:getline:gsub:if:in:index:int:" \ + "length:log:match:next:print:printf:rand:return:sin:" \ + "split:sprintf:sqrt:srand:strftime:sub:substr:system:tolower:toupper:while", + keywords,":") +# build the symbol-state table + split("00:00:00:00:00:00:00:00:00:00:" \ + "20:10:10:12:12:11:07:00:00:00:" \ + "08:08:08:08:08:33:08:00:00:00:" \ + "08:44:08:36:08:08:08:00:00:00:" \ + "08:44:45:42:42:41:08",machine,":") +# parse the input + state = 1 + for (;;) { + symb = lex() # get next symbol + nextstate = substr(machine[state symb],1,1) + act = substr(machine[state symb],2,1) + # perform required action + if (act == "0") { # do nothing + } + else if (act == "1") { # found a function call + if (!(inarray(tok,names))) { + names[++nnames] = tok + } + ++xnames[tok] + } + else if (act == "2") { # found a variable or array + if (tok in Local) { + tok = tok "(" funcname ")" + if (!(inarray(tok,names))) { + names[++nnames] = tok + } + ++xnames[tok] + } + else { + tok = tok "()" + if (!(inarray(tok,names))) { + names[++nnames] = tok + } + ++xnames[tok] + } + } + else if (act == "3") { # found a function definition + funcname = tok + } + else if (act == "4") { # found a left brace + braces++ + } + else if (act == "5") { # found a right brace + braces-- + if (braces == 0) { + delete Local + funcname = "" + nextstate = 1 + } + } + else if (act == "6") { # found a local variable declaration + Local[tok] = 1 + } + else if (act == "7") { # found end of file + break + } + else if (act == "8") { # found an error + printf("error: FILENAME=%s, FNR=%d\n",FILENAME,FNR) + exit(1) + } + state = nextstate # finished with current token + } +# format function names + for (i=1; i<=nnames; i++) { + if (index(names[i],"(") == 0) { + tmp_arr[xnames[names[i]]][names[i]] = "" + } + } +# print function names + PROCINFO["sorted_in"] = "@ind_num_desc" ; SORTTYPE = 9 + for (i in tmp_arr) { + PROCINFO["sorted_in"] = "@ind_str_asc" ; SORTTYPE = 1 + for (j in tmp_arr[i]) { + if (++shown <= 10) { + printf("%d %s\n",i,j) + } + } + } + exit(0) +} +function asplit(str,arr,fs, i,n,temp_asplit) { + n = split(str,temp_asplit,fs) + for (i=1; i<=n; i++) { + arr[temp_asplit[i]]++ + } +} +function inarray(val,arr, j) { + for (j in arr) { + if (arr[j] == val) { + return(j) + } + } + return("") +} +function lex() { + for (;;) { + if (tok == "(eof)") { + return(7) + } + while (length(line) == 0) { + if (getline line == 0) { + tok = "(eof)" + return(7) + } + } + sub(/^[ \t]+/,"",line) # remove white space, + sub(/^"([^"]|\\")*"/,"",line) # quoted strings, + sub(/^\/([^\/]|\\\/)+\//,"",line) # regular expressions, + sub(/^#.*/,"",line) # and comments + if (line ~ /^function /) { + tok = "function" + line = substr(line,10) + return(1) + } + else if (line ~ /^{/) { + tok = "{" + line = substr(line,2) + return(2) + } + else if (line ~ /^}/) { + tok = "}" + line = substr(line,2) + return(3) + } + else if (match(line,/^[A-Za-z_][A-Za-z_0-9]*\[/)) { + tok = substr(line,1,RLENGTH-1) + line = substr(line,RLENGTH+1) + return(5) + } + else if (match(line,/^[A-Za-z_][A-Za-z_0-9]*\(/)) { + tok = substr(line,1,RLENGTH-1) + line = substr(line,RLENGTH+1) + if (!(tok in keywords)) { return(6) } + } + else if (match(line,/^[A-Za-z_][A-Za-z_0-9]*/)) { + tok = substr(line,1,RLENGTH) + line = substr(line,RLENGTH+1) + if (!(tok in keywords)) { return(4) } + } + else { + match(line,/^[^A-Za-z_{}]/) + tok = substr(line,1,RLENGTH) + line = substr(line,RLENGTH+1) + } + } +} diff --git a/Task/Function-frequency/Common-Lisp/function-frequency.lisp b/Task/Function-frequency/Common-Lisp/function-frequency.lisp new file mode 100644 index 0000000000..73f42f4f2f --- /dev/null +++ b/Task/Function-frequency/Common-Lisp/function-frequency.lisp @@ -0,0 +1,34 @@ +(defun mapc-tree (fn tree) + "Apply FN to all elements in TREE." + (cond ((consp tree) + (mapc-tree fn (car tree)) + (mapc-tree fn (cdr tree))) + (t (funcall fn tree)))) + +(defun count-source (source) + "Load and count all function-bound symbols in a SOURCE file." + (load source) + (with-open-file (s source) + (let ((table (make-hash-table))) + (loop for data = (read s nil nil) + while data + do (mapc-tree + (lambda (x) + (when (and (symbolp x) (fboundp x)) + (incf (gethash x table 0)))) + data)) + table))) + +(defun hash-to-alist (table) + "Convert a hashtable to an alist." + (let ((alist)) + (maphash (lambda (k v) (push (cons k v) alist)) table) + alist)) + +(defun take (n list) + "Take at most N elements from LIST." + (loop repeat n for x in list collect x)) + +(defun top-10 (table) + "Get the top 10 from the source counts TABLE." + (take 10 (sort (hash-to-alist table) '> :key 'cdr))) diff --git a/Task/Function-frequency/J/function-frequency.j b/Task/Function-frequency/J/function-frequency.j index 92c6835acb..720b209a0b 100644 --- a/Task/Function-frequency/J/function-frequency.j +++ b/Task/Function-frequency/J/function-frequency.j @@ -1,29 +1,35 @@ - PRIMITIVES=: ;:'! !. !: " ". ": # #. #: $ $. $: % %. %: & &. &.: &: * *. *: + +. +: , ,. ,: - -. -: . .. .: / /. /: 0: 1: 2: 3: 4: 5: 6: 7: 8: 9: : :. :: ; ;. ;: < <. <: = =. =: > >. >: ? ?. ...' + IGNORE=: ;:'y(0)1',CR Filter=: (#~`)(`:6) - NB. monad top10 . y is a character vector of much j source code - top10=: 10 {. \:~@:((#;{.)/.~@:(e.&PRIMITIVES Filter@:;:)) + NB. extract tokens from a large body newline terminated of text + roughparse=: ;@(<@;: ::(''"_);._2) - top10 JSOURCE NB. JSOURCE are the j Zeckendorf verbs. -┌─┬──┐ -│6│=.│ -├─┼──┤ -│5│=:│ -├─┼──┤ -│4│@:│ -├─┼──┤ -│3│~ │ -├─┼──┤ -│3│: │ -├─┼──┤ -│3│+ │ -├─┼──┤ -│3│$ │ -├─┼──┤ -│2│|.│ -├─┼──┤ -│2│i.│ -├─┼──┤ -│2│/ │ -└─┴──┘ + NB. count frequencies and get the top x + top=: top=: {. \:~@:((#;{.)/.~) + + NB. read all installed script (.ijs) files and concatenate them + JSOURCE=: ;fread each 1&e.@('.ijs'&E.)@>Filter {."1 dirtree jpath '~install' + + 10 top (roughparse JSOURCE)-.IGNORE +┌─────┬──┐ +│49591│, │ +├─────┼──┤ +│40473│=:│ +├─────┼──┤ +│35593│; │ +├─────┼──┤ +│34096│=.│ +├─────┼──┤ +│24757│+ │ +├─────┼──┤ +│18726│" │ +├─────┼──┤ +│18564│< │ +├─────┼──┤ +│18446│/ │ +├─────┼──┤ +│16984│> │ +├─────┼──┤ +│14655│@ │ +└─────┴──┘ diff --git a/Task/Function-frequency/Perl/function-frequency.pl b/Task/Function-frequency/Perl/function-frequency.pl new file mode 100644 index 0000000000..194d5aadc2 --- /dev/null +++ b/Task/Function-frequency/Perl/function-frequency.pl @@ -0,0 +1,16 @@ +use PPI::Tokenizer; +my $Tokenizer = PPI::Tokenizer->new( '/path/to/your/script.pl' ); +my %counts; +while (my $token = $Tokenizer->get_token) { + # We consider all Perl identifiers. The following regex is close enough. + if ($token =~ /\A[\$\@\%*[:alpha:]]/) { + $counts{$token}++; + } +} +my @desc_by_occurrence = + sort {$counts{$b} <=> $counts{$a} || $a cmp $b} + keys(%counts); +my @top_ten_by_occurrence = @desc_by_occurrence[0 .. 9]; +foreach my $token (@top_ten_by_occurrence) { + print $counts{$token}, "\t", $token, "\n"; +} diff --git a/Task/Function-frequency/REXX/function-frequency-1.rexx b/Task/Function-frequency/REXX/function-frequency-1.rexx new file mode 100644 index 0000000000..1eaea73ca0 --- /dev/null +++ b/Task/Function-frequency/REXX/function-frequency-1.rexx @@ -0,0 +1,34 @@ +fid='pgm.rex' +cnt.=0 +funl='' +Do While lines(fid)>0 + l=linein(fid) + Do Until p=0 + p=pos('(',l) + If p>0 Then Do + do i=p-1 To 1 By -1 While is_tc(substr(l,i,1)) + End + fn=substr(l,i+1,p-i-1) + If fn<>'' Then + Call store fn + l=substr(l,p+1) + End + End + End +Do While funl<>'' + Parse Var funl fn funl + Say right(cnt.fn,3) fn + End +Exit +x=a(3)+bbbbb(5,c(555)) +special=date('S') 'DATE'() "date"() +is_tc: +abc='abcdefghijklmnopqrstuvwxyz' +Return pos(arg(1),abc||translate(abc)'1234567890_''"')>0 + +store: +Parse Arg fun +cnt.fun=cnt.fun+1 +If cnt.fun=1 Then + funl=funl fun +Return diff --git a/Task/Function-frequency/REXX/function-frequency-2.rexx b/Task/Function-frequency/REXX/function-frequency-2.rexx new file mode 100644 index 0000000000..fdb50005e4 --- /dev/null +++ b/Task/Function-frequency/REXX/function-frequency-2.rexx @@ -0,0 +1,510 @@ +/* REXX ****************************************** Version 11.12.2015 ** +* Rexx Tokenizer to find function invocations +*----------------------------------------------------------------------- +* Tokenization remembers the following for each token +* t.i text of token +* t.i.0t type of token: Cx/V/K/N/O/S/L +* comment/variable/keyword/constant/operator/string/label +* t.i.0il line of token in the input +* t.i.0ic col of token in the input +* t.i.0prev index of token starting previous instruction +* t.i.0ol line of token in the output +* t.i.0oc col of token in the output +*---------------------------------------------------------------------*/ + Call time 'R' + Parse Upper Arg fid '(' options + If fid='?' Then Do + Say 'Tokenike a REXX proram and list the function invocations found' + Say ' which are of the form symbol(... or ''string''(...' + Say ' (the left parenthesis must immediately follow the symbol' + Say ' or literal string.)' + Say 'Syntax:' + Say ' TKZ pgm < ( >' + Exit + End + g.=0 + Call init /* Initialize constants etc. */ + g.0cont='01'x + g.0breakc='02'x + cnt.=0 + Call readin /* Read input file into l.* */ + Call tokenize /* Tokenize the input */ + tk='' + Call process_tokens + g.0fun_list=wordsort(g.0fun_list) + Do While g.0fun_list>'' + Parse Var g.0fun_list fun g.0fun_list + Say right(cnt.fun,3) fun + End + Say time('E') 'seconds elapsed for' t.0 'tokens in' g.0lines 'lines.' + Exit + +init: +/*********************************************************************** +* Initialize constants etc. +***********************************************************************/ + g.='' + g.0debug=0 /* set debug off by default */ + + fid=strip(fid) + If fid='' Then /* no file specified */ + Exit exit(12 'no input file specified') + Parse Var fid fn '.' + + os=options /* options specified on command */ + g.0debug=0 /* turn off debug output */ + g.0tokens=0 /* No token file */ + Do While os<>'' /* process them individually */ + Parse Upper Var os o os /* pick one */ + Select + When abbrev('DEBUG',o,1) Then /* Debug specified */ + g.0debug=1 /* turn on debug output */ + When abbrev('TOKENS',o,1) Then /* Write a file with tokens */ + g.0tokens=1 + Otherwise /* anything else */ + Say 'Unknown option:' o /* tell the user and ignore it */ + End + End + + If g.0debug Then Do + g.0dbg=fn'.dbg'; '@erase' g.0dbg + End + If g.0tokens Then Do + g.0tkf=fn'.tok'; '@erase' g.0tkf + End + +/*********************************************************************** +* Language specifics +***********************************************************************/ + g.0special='+-*/%''";:<>^\=|,()& '/* special characters */ + /* chars that may start a var */ + g.0a='abcdefghijklmnopqrstuvwxyz'||, + 'ABCDEFGHIJKLMNOPQRSTUVWXYZ@#$!?_' + g.0n='1234567890' /* numeric characters */ + g.0vc=g.0a||g.0n||'.' /* var-character */ + /* multi-character operators */ + g.0opx='&& ** // << <<= <= <> == >< >= >> >>=', + '^< ^<< ^= ^== ^> ^>> \< \<< \= \== \> \>> ||' + + t.='' /* token list */ + Return + +readin: +/*********************************************************************** +* Read the file to be formatted +***********************************************************************/ + lc='' + i=0 + g.0lines=0 + Do While lines(fid)<>0 + li=linein(fid) + g.0lines=g.0lines+1 + If i>0 Then + lc=strip(l.i,'T') + If right(lc,1)=',' Then Do + l.i=left(lc,length(lc)-1) li + End + Else Do + i=i+1 + l.i=li + End + End + l.0=i + Call lineout fid + t=l.0+1 + l.t=g.0eof /* add a stopper at program end */ + l.0=t /* adjust number of lines */ + g.0il=t /* remember end of program */ + Return + +tokenize: +/*********************************************************************** +* First perform tokenization +* Input: l.* Program text +* Output: t.* Token list +* t.0t.i token type CA CB CC C comment begin/middle/end +* S string +* O operator (special character) +* V variable symbol +* N constant +* X end of text +* Note: special characters are treated as separate tokens +***********************************************************************/ + li=0 /* line index */ + ti=0 /* token index */ + Do While li'' /* work through the line */ + nbc=verify(l,' ') /* first non-blank column */ + g.0cc=g.0cc+nbc /* advance to this */ + If g.0newline='' Then Do + If t.ti.0ic='' Then + t.ti.0ic=0 + If g.0cc=t.ti.0ic+length(t.ti) Then Do + tj=ti+1 + t.tj.0ad=1 + End + End + l=substr(l,nbc) /* and continue with rest of line */ + Parse Var l c +1 l 1 c2 +2 /* get character(s) */ + g.0tb=g.0cc /* remember where token starts */ + Select /* take a decision */ + When c2='/*' Then /* comment starts here */ + Call comment /* process comment */ + When pos(c,'''"')>0 Then /* literal string starts here */ + Call string c /* process literal string */ + Otherwise /* neither comment nor literal */ + Call token /* get other token */ + End /* cmt, string, or token done */ + End /* end of loop over line */ + End /* end of loop over program */ + t.0=ti /* store number of tokens */ + Call dsp ti 'tokens' l.0 'lines' + Return +comment: +/*********************************************************************** +* Parse a comment +* Nested comments are supported +***********************************************************************/ + cbeg=t.ti.0il + l=substr(l,2) /* continue after slash-asterisk */ + g.0cc=g.0cc+1 /* update current char position */ + t='/*' /* token so far */ + incmt=1 /* indicate "within a comment" */ + Do Until incmt=0 /* loop until done */ + bc=pos('/*',l) /* next begin comment, if any */ + ec=pos('*/',l) /* next end comment, if any */ + Select /* decide */ + When bc>0 &, /* begin-comment found */ + (ec=0 | bc0 Then Do /* end-comment found */ + t=t||left(l,ec+1) /* add all to token */ + incmt=incmt-1 /* decrement nesting */ + l=substr(l,ec+2) /* continue after asterisk-slash */ + g.0cc=g.0cc+ec+1 /* update current char position */ + End + Otherwise Do /* no further comment bracket */ + Call addtoken t||l,ct() /* rest of line to token */ + li=li+1 /* proceed to next line */ + l=l.li /* contents of next line */ + g.0newline=1 + If l=g.0eof Then Do + Say 'Comment started in line' cbeg 'is not closed before EOF' + Exit err(58) + End + g.0cc=0 /* current char (none) */ + g.0tb=1 /* token (comment) starts here */ + End + End + End + Call addtoken t,ct() /* last (or only) comment token */ + If pos('*debug*',t)>0 Then g.0debug=1 + Return + +ct: +/*********************************************************************** +* Comment type +***********************************************************************/ + If incmt>0 Then Do /* within a comment */ + If t.ti.0t='CA' |, /* prev. token was start or cont */ + t.ti.0t='CB' Then Return 'CB' /* this is continuation */ + Else Return 'CA' /* this is start */ + End + Else Do /* comment is over */ + If t.ti.0t='CA' |, /* prev. token was start or cont */ + t.ti.0t='CB' Then Return 'CC' /* this is final part */ + Else Return 'C' /* this is just a comment */ + End +string: +/*********************************************************************** +* Parse a string +* take care of '111'B and '123'X +***********************************************************************/ + Parse Arg delim /* string delimiter found */ + t=delim /* star building the token */ + instr=1 /* note we are within a string */ + g.0ss=li + Do Until instr=0 /* continue until it is over */ + se=pos(delim,l) /* ending delimiter */ + If se>0 Then Do /* found */ + If substr(l,se+1,1)=delim Then Do /* but it is doubled */ + t=t||left(l,se+1) /* so add all so far to token */ + l=substr(l,se+2) /* and take rest of line */ + g.0cc=g.0cc+se+1 /* and set current character pos */ + End + Else Do /* not another one */ + instr=0 /* string is done */ + t=t||left(l,se) /* add the string data to token */ + l=substr(l,se+1) /* take the rest of the line */ + g.0cc=g.0cc+se /* and set current character pos */ + If pos(translate(left(l,1)),'BX')>0 Then + If pos(substr(l,2,1),g.0vc)=0 Then Do + t=t||left(l,1) /* add the char to the token */ + l=substr(l,2) /* take the rest of the line */ + g.0cc=g.0cc+1 /* and set current character pos */ + End + End + End + Else Do /* not found */ + Call addtoken t||l,'S' /* store the token */ + g.0lasttoken='' /* reset this switch */ + li=li+1 /* go on to the next line */ + If li>l.0 Then /* there is no next line */ + Exit err(60,'string starting in line' g.0ss, + 'does not end before end of file') + Else + Say 'string starting at line' g.0ss 'extended over line boundary' + l=l.li /* take contents of the next line */ + g.0cc=1 /* current char position */ + g.0tb=1 /* ?? */ + End + End + Call addtoken t,'S' /* store the token */ + Return +token: +/*********************************************************************** +* Parse a token +***********************************************************************/ + IF c=g.0comma & l='' Then Do + t=g.0cont + type='O' /* O (for operator - not quite...)*/ + End + Else Do + If pos(c,g.0special)>0 Then Do /* a special character */ + t=c /* take it as is */ + type='O' /* O (for operator - not quite...)*/ + End + Else Do /* some other character */ + nsp=verify(l,g.0special,'M') /* find delimiting character */ + If nsp>0 Then Do /* some character found */ + t=c||left(l,nsp-1) /* take all up to this character */ + l=substr(l,nsp) /* and continue from there */ + End + Else Do /* none found */ + t=c||l /* add rest of line to token */ + l='' /* and all is used up */ + End + g.0cc=g.0cc+length(t)-1 /* adjust current char position */ + If pos(right(t,1),'eE')>0 &, /* consider nxxxE+nn case */ + pos(left(l,1),'+-')>0 Then Do + If pos(left(t,1),'.1234567890')>0 Then /* start . or digit */ + If pos(substr(l,2,1),'1234567890')>0 Then Do /* dig after+- */ + nsp=verify(substr(l,2),g.0special,'M')+1 /* find end */ + If nsp>1 Then /* delimiting character found */ + exp=substr(l,2,nsp-2) /* exponent (if numeric) */ + Else + exp=substr(l,2) + If verify(exp,'0123456789')=0 Then Do + t=t||left(l,1)||exp + l=substr(l,length(exp)+2) + g.0cc=g.0cc+length(exp)+2 + End + End + End + Select + When isvar(t) Then /* token qualifies as variable */ + type='V' + When isconst(t) Then /* token is a constant symbol */ + type='N' + When t=g.0eof Then /* token is end of file indication*/ + type='X' + Otherwise Do /* anything else is an error */ + Say 'li='li + Say l + Say 'token error' + Trace ?R + Exit err(62,'token' t 'is neither variable nor constant') + End + End + If left(l,1)='(' Then + type=type||'F' + End + End + Call addtoken t,type /* store the token */ + Return +addtoken: +/*********************************************************************** +* Add a token to the token list +***********************************************************************/ + Parse Arg t,type /* token and its type */ + If type='O' Then Do /* operator (special character) */ + If pos(t,'><=&|/*')>0 Then Do /* char for composite operator */ + If wordpos(t.ti||t,g.0opx)>0 Then Do /* composite operator */ + t.ti=t.ti||t /* use concatenation */ + /* does not handle =/**/= */ + t='' /* we are done */ + Return + End + End + End + + If type='CC' & t='*/' Then Do /* The special case for SPA */ + Return + End + + ti=ti+1 /* increment index */ + t.ti=t /* store token's value */ + t.ti.0t=left(type,1) /* and its type */ + t.ti.0nl=g.0newline /* token starts a new line */ + g.0newline='' /* reset new line switch */ + If t.ti.0t='C' Then Do + t.ti.0t=type + If left(t.ti,3)='/* ' &, + right(t.ti,3)=' */' Then + t.ti='/*' strip(substr(t.ti,4,length(t.ti)-6)) '*/' + End + t.ti.0f=substr(type,2,1) /* 'F' if possibly a function */ + Call setpos ti li g.0tb /* and its position */ + If left(type,1)='C' Then /* ??? */ + If left(t.ti,2)<>'/*' Then Do + ts=strip(t.ti,'L') + t.ti.0oc=t.ti.0oc+length(t.ti)-length(ts) + t.ti=ts + End + If t.ti.0ol='' Then t.ti.0ol=li + If t.ti.0oc='' Then t.ti.0oc=0 + t.ti.0il=t.ti.0ol /* and its position */ + t.ti.0ic=t.ti.0oc /* and its position */ + Call dsp ti t.ti t.ti.0il'/'t.ti.0ic '->' t.ti.0ol'/'t.ti.0oc + t='' /* reset token variable */ + Return + +lookback: +/*********************************************************************** +* Look back if... +***********************************************************************/ + Do i_=ti To 1 By -1 + Select + When left(t.i_.0t,1)='C' Then Nop + When t.i_.0used<>1 &, + (t.i_=g.0comma |, + t.i_=g.0cont) Then Do + t.i_.0used=1 + t.i_=g.0cont + Return '0' + End + Otherwise + Return '1' + End + End + Return '1' + +isvar: +/*********************************************************************** +* Determine if a string qualifies as variable name +***********************************************************************/ + Parse Arg a_ +1 b_ + res=(pos(a_,g.0a)>0) &, + (verify(b_,g.0a||g.0n||'.')=0) + Return res + +isconst: +/*********************************************************************** +* Determine if a string qualifies as constant +***********************************************************************/ + Parse Arg a_ + res=(verify(a_,g.0a||g.0n||'.+-')=0) /* ??? */ + Return res + +setpos: + Parse Arg seti sol soc + setz='setpos:' t.seti t.seti.0ol'/'t.seti.0oc '-->', + sol'/'soc '('sigl')' + Call dsp setz + t.seti.0ol=sol + t.seti.0oc=soc + Return + +process_tokens: +/*********************************************************************** +* Process the token list +***********************************************************************/ + Do i=1 To t.0 + If g.0tokens Then + Call lineout g.0tkf,right(i,4) right(t.i.0il,3)'.'left(t.i.0ic,3), + right(t.i.0ol,3)'.'left(t.i.0oc,3), + left(t.i.0t,2) left(t.i,25) + If t.i='(' Then Do + j=i-1 + If t.j.0ol=t.i.0il & , + t.j.0oc+length(t.j)=t.i.0ic &, + pos(t.j.0t,'VS')>0 Then + Call store_f t.j + End + End + If g.0tokens Then + Call lineout g.0tkf + Return + +store_f: + Parse Arg funct + If wordpos(funct,g.0fun_list)=0 then + g.0fun_list=g.0fun_list funct + cnt.funct=cnt.funct+1 + Return + +dsp: +/*********************************************************************** +* Record (and display) a debug line +***********************************************************************/ + Parse Arg ol_.1 + If g.0debug>0 Then + Call lineout g.0dbg,ol_.1 + If g.0debug>1 Then + Say ol_.1 + Return + +wordsort: Procedure +/********************************************************************** +* Sort the list of words supplied as argument. Return the sorted list +**********************************************************************/ + Parse Arg wl + wa.='' + wa.0=0 + Do While wl<>'' + Parse Var wl w wl + Do i=1 To wa.0 + If wa.i>w Then Leave + End + If i<=wa.0 Then Do + Do j=wa.0 To i By -1 + ii=j+1 + wa.ii=wa.j + End + End + wa.i=w + wa.0=wa.0+1 + End + swl='' + Do i=1 To wa.0 + swl=swl wa.i + End + Return strip(swl) + +err: +/*********************************************************************** +* Diagnostic error exit +***********************************************************************/ + Parse Arg errnum, errtxt + Say 'err:' errnum errtxt + If t.ti.0il>g.0il Then + Say 'Error' arg(1) 'at end of file' + Else Do + Say 'Error' arg(1) 'around line' t.ti.0il', column' t.ti.0ic + _=t.ti.0il + Say l._ + Say copies(' ',t.ti.0ic-1)'|' + End + If errtxt<>'' Then Say ' 'errtxt + Exit 12 diff --git a/Task/Function-frequency/REXX/function-frequency.rexx b/Task/Function-frequency/REXX/function-frequency.rexx deleted file mode 100644 index 8b2f8a1370..0000000000 --- a/Task/Function-frequency/REXX/function-frequency.rexx +++ /dev/null @@ -1,48 +0,0 @@ -/*REXX pgm counts frequency of various subroutine/function invocations. */ -?.=0 /*initialize all funky counters. */ - do j=1 to 10 - factorial = !(j) - factorial_R = !r(j) - fibonacci = fib(j) - fibonacci_R = fibR(j) - hofstadterQ = hofsQ(j) - width = length(j) + length(length(j**j)) - end /*j*/ - -say 'number of invocations for ! (factorial) = ' ?.! -say 'number of invocations for ! recursive = ' ?.!r -say 'number of invocations for Fibonacci = ' ?.fib -say 'number of invocations for Fib recursive = ' ?.fibR -say 'number of invocations for Hofstadter Q = ' ?.hofsQ -say 'number of invocations for LENGTH = ' ?.length -exit /*stick a fork in it, we're done.*/ - -/*─────────────────────────────────────! (factorial) subroutine─────────*/ -!: procedure expose ?.; ?.!=?.!+1; parse arg x; !=1 - do j=2 to x; !=!*j; end; return ! - -/*─────────────────────────────────────!r (factorial) subroutine────────*/ -!r: procedure expose ?.; ?.!r=?.!r+1; parse arg x; if x<2 then return 1 - return x * !R(x-1) - -/*──────────────────────────────────FIB subroutine (non─recursive)──────*/ -fib: procedure expose ?.; ?.fib=?.fib+1; parse arg n; na=abs(n); a=0; b=1 - if na<2 then return na /*test for couple special cases. */ - do j=2 to na; s=a+b; a=b; b=s; end - if n>0 | na//2==1 then return s /*if positive or odd negative... */ - else return -s /*return a negative Fib number. */ - -/*──────────────────────────────────FIBR subroutine (recursive)─────────*/ -fibR: procedure expose ?.; ?.fibR=?.fibr+1; parse arg n; na=abs(n); s=1 - if na<2 then return na /*handle a couple special cases. */ - if n <0 then if n//2==0 then s=-1 - return (fibR(na-1)+fibR(na-2))*s - -/*──────────────────────────────────HOFSQ subroutine (recursive)────────*/ -hofsQ: procedure expose ?.; ?.hofsq=?.hofsq+1; parse arg n - if n<2 then return 1 - return hofsQ(n - hofsQ(n - 1)) + hofsQ(n - hofsQ(n - 2)) - -/*──────────────────────────────────LENGTH subroutine───────────────────*/ -length: procedure expose ?.; ?.length=?.length+1 - return 'LENGTH'(arg(1)) diff --git a/Task/Function-prototype/00DESCRIPTION b/Task/Function-prototype/00DESCRIPTION index db020a0b1c..bb8b4d9995 100644 --- a/Task/Function-prototype/00DESCRIPTION +++ b/Task/Function-prototype/00DESCRIPTION @@ -1,4 +1,8 @@ -Some languages provide the facility to declare functions and subroutines through the use of [[wp:Function prototype|function prototyping]]. The task is to demonstrate the methods available for declaring prototypes within the language. The provided solutions should include: +Some languages provide the facility to declare functions and subroutines through the use of [[wp:Function prototype|function prototyping]]. + + +;Task: +Demonstrate the methods available for declaring prototypes within the language. The provided solutions should include: * An explanation of any placement restrictions for prototype declarations * A prototype declaration for a function that does not require arguments @@ -9,4 +13,6 @@ Some languages provide the facility to declare functions and subroutines through * Example of prototype declarations for subroutines or procedures (if these differ from functions) * An explanation and example of any special forms of prototyping not covered by the above +
    Languages that do not provide function prototyping facilities should be omitted from this task. +

    diff --git a/Task/GUI-Maximum-window-dimensions/00DESCRIPTION b/Task/GUI-Maximum-window-dimensions/00DESCRIPTION index 18dfdaec7c..0db7c650e0 100644 --- a/Task/GUI-Maximum-window-dimensions/00DESCRIPTION +++ b/Task/GUI-Maximum-window-dimensions/00DESCRIPTION @@ -1,11 +1,17 @@ -The task is to determine the maximum height and width of a window that can fit within the physical display area of the screen without scrolling. This is effectively the screen size (not the total desktop area, which could be bigger than the screen display area) in pixels minus any adjustments for window decorations and menubars. The idea is to determine the physical display parameters for the maximum height and width of the usable display area in pixels (without scrolling). The values calculated should represent the usable desktop area of a window maximized to fit the the screen. +The task is to determine the maximum height and width of a window that can fit within the physical display area of the screen without scrolling. -=== Considerations === +This is effectively the screen size (not the total desktop area, which could be bigger than the screen display area) in pixels minus any adjustments for window decorations and menubars. -==== Multiple Monitors ==== +The idea is to determine the physical display parameters for the maximum height and width of the usable display area in pixels (without scrolling). -For multiple monitors, the values calculated should represent the size of the usable display area on the monitor which is related to the task (ie the monitor which would display a window if such instructions were given). +The values calculated should represent the usable desktop area of a window maximized to fit the the screen. -==== Tiling Window Managers ==== +;Considerations: + +;--- Multiple Monitors: +For multiple monitors, the values calculated should represent the size of the usable display area on the monitor which is related to the task (i.e.:   the monitor which would display a window if such instructions were given). + +;--- Tiling Window Managers For a tiling window manager, the values calculated should represent the maximum height and width of the display area of the maximum size a window can be created (without scrolling). This would typically be a full screen window (minus any areas occupied by desktop bars), unless the window manager has restrictions that prevents the creation of a full screen window, in which case the values represent the usable area of the desktop that occupies the maximum permissible window size (without scrolling). +

    diff --git a/Task/GUI-component-interaction/00DESCRIPTION b/Task/GUI-component-interaction/00DESCRIPTION index a3b2fabbe2..5471208bb1 100644 --- a/Task/GUI-component-interaction/00DESCRIPTION +++ b/Task/GUI-component-interaction/00DESCRIPTION @@ -24,17 +24,23 @@ Typically, the following is needed: * read and check input from the user * pop up dialogs to query the user for further information -The task: For a minimal "application", write a program that presents -a form with three components to the user: -A numeric input field ("Value") and two buttons ("increment" and "random"). + +;Task: +For a minimal "application", write a program that presents a form with three components to the user: +::* a numeric input field ("Value") +::* a button ("increment") +::* a button ("random") + The field is initialized to zero. + The user may manually enter a new value into the field, or increment its value with the "increment" button. + Entering a non-numeric value should be either impossible, or issue an error message. Pressing the "random" button presents a confirmation dialog, and resets the field's value to a random value if the answer is "Yes". -(This task may be regarded as an extension of the task [[Simple windowed application]]). +(This task may be regarded as an extension of the task [[Simple windowed application]]).

    diff --git a/Task/GUI-component-interaction/C/gui-component-interaction-1.c b/Task/GUI-component-interaction/C/gui-component-interaction-1.c new file mode 100644 index 0000000000..d3b44c5fc4 --- /dev/null +++ b/Task/GUI-component-interaction/C/gui-component-interaction-1.c @@ -0,0 +1,48 @@ +#include +#include "resource.h" + +BOOL CALLBACK DlgProc( HWND hwnd, UINT msg, WPARAM wPar, LPARAM lPar ) { + switch( msg ) { + + case WM_INITDIALOG: + srand( GetTickCount() ); + SetDlgItemInt( hwnd, IDC_INPUT, 0, FALSE ); + break; + + case WM_COMMAND: + switch( LOWORD(wPar) ) { + case IDC_INCREMENT: { + UINT n = GetDlgItemInt( hwnd, IDC_INPUT, NULL, FALSE ); + SetDlgItemInt( hwnd, IDC_INPUT, ++n, FALSE ); + } break; + case IDC_RANDOM: { + int reply = MessageBox( hwnd, + "Do you really want to\nget a random number?", + "Random input confirmation", MB_ICONQUESTION|MB_YESNO ); + if( reply == IDYES ) + SetDlgItemInt( hwnd, IDC_INPUT, rand(), FALSE ); + } break; + case IDC_QUIT: + SendMessage( hwnd, WM_CLOSE, 0, 0 ); + break; + default: ; + } + break; + + case WM_CLOSE: { + int reply = MessageBox( hwnd, + "Do you really want to quit?", + "Quit confirmation", MB_ICONQUESTION|MB_YESNO ); + if( reply == IDYES ) + EndDialog( hwnd, 0 ); + } break; + + default: ; + } + + return 0; +} + +int WINAPI WinMain( HINSTANCE hInst, HINSTANCE hPInst, LPSTR cmdLn, int show ) { + return DialogBox( hInst, MAKEINTRESOURCE(IDD_DLG), NULL, DlgProc ); +} diff --git a/Task/GUI-component-interaction/C/gui-component-interaction-2.c b/Task/GUI-component-interaction/C/gui-component-interaction-2.c new file mode 100644 index 0000000000..dad553d64c --- /dev/null +++ b/Task/GUI-component-interaction/C/gui-component-interaction-2.c @@ -0,0 +1,5 @@ +#define IDD_DLG 101 +#define IDC_INPUT 1001 +#define IDC_INCREMENT 1002 +#define IDC_RANDOM 1003 +#define IDC_QUIT 1004 diff --git a/Task/GUI-component-interaction/C/gui-component-interaction-3.c b/Task/GUI-component-interaction/C/gui-component-interaction-3.c new file mode 100644 index 0000000000..53764548cc --- /dev/null +++ b/Task/GUI-component-interaction/C/gui-component-interaction-3.c @@ -0,0 +1,14 @@ +#include +#include "resource.h" + +LANGUAGE LANG_NEUTRAL, SUBLANG_NEUTRAL +IDD_DLG DIALOG 0, 0, 154, 46 +STYLE DS_3DLOOK | DS_CENTER | DS_MODALFRAME | DS_SHELLFONT | WS_CAPTION | +WS_VISIBLE | WS_POPUP | WS_SYSMENU +CAPTION "GUI Component Interaction" +FONT 12, "Ms Shell Dlg" { + EDITTEXT IDC_INPUT, 7, 7, 140, 12, ES_AUTOHSCROLL | ES_NUMBER + PUSHBUTTON "Increment", IDC_INCREMENT, 7, 25, 50, 14 + PUSHBUTTON "Random", IDC_RANDOM, 62, 25, 50, 14 + PUSHBUTTON "Quit", IDC_QUIT, 117, 25, 30, 14 +} diff --git a/Task/GUI-component-interaction/Python/gui-component-interaction-1.py b/Task/GUI-component-interaction/Python/gui-component-interaction-1.py new file mode 100644 index 0000000000..0fee28ec0e --- /dev/null +++ b/Task/GUI-component-interaction/Python/gui-component-interaction-1.py @@ -0,0 +1,24 @@ +import random, tkMessageBox +from Tkinter import * +window = Tk() +window.geometry("300x50+100+100") +options = { "padx":5, "pady":5} +s=StringVar() +s.set(1) +def increase(): + s.set(int(s.get())+1) +def rand(): + if tkMessageBox.askyesno("Confirmation", "Reset to random value ?"): + s.set(random.randrange(0,5000)) +def update(e): + if not e.char.isdigit(): + tkMessageBox.showerror('Error', 'Invalid input !') + return "break" +e = Entry(text=s) +e.grid(column=0, row=0, **options) +e.bind('', update) +b1 = Button(text="Increase", command=increase, **options ) +b1.grid(column=1, row=0, **options) +b2 = Button(text="Random", command=rand, **options) +b2.grid(column=2, row=0, **options) +mainloop() diff --git a/Task/GUI-component-interaction/Python/gui-component-interaction.py b/Task/GUI-component-interaction/Python/gui-component-interaction-2.py similarity index 100% rename from Task/GUI-component-interaction/Python/gui-component-interaction.py rename to Task/GUI-component-interaction/Python/gui-component-interaction-2.py diff --git a/Task/GUI-enabling-disabling-of-controls/00DESCRIPTION b/Task/GUI-enabling-disabling-of-controls/00DESCRIPTION index 835d29c226..5634048522 100644 --- a/Task/GUI-enabling-disabling-of-controls/00DESCRIPTION +++ b/Task/GUI-enabling-disabling-of-controls/00DESCRIPTION @@ -19,10 +19,15 @@ dynamically enable and disable GUI components, to give some guidance to the user, and prohibit (inter)actions which are inappropriate in the current state of the application. -The task: Similar to the task [[GUI component interaction]] write a program -that presents a form with three components to the user: -A numeric input field ("Value") and two buttons ("increment" and "decrement"). +;Task: +Similar to the task [[GUI component interaction]], write a program +that presents a form with three components to the user: +::#   a numeric input field ("Value") +::#   a button   ("increment") +::#   a button   ("decrement") + +
    The field is initialized to zero. The user may manually enter a new value into the field, increment its value with the "increment" button, @@ -37,3 +42,4 @@ the value is greater than zero. Effectively, the user can now either increment up to 10, or down to zero. Manually entering values outside that range is still legal, but the buttons should reflect that and enable/disable accordingly. +

    diff --git a/Task/GUI-enabling-disabling-of-controls/C/gui-enabling-disabling-of-controls-1.c b/Task/GUI-enabling-disabling-of-controls/C/gui-enabling-disabling-of-controls-1.c new file mode 100644 index 0000000000..27e5cb3a5e --- /dev/null +++ b/Task/GUI-enabling-disabling-of-controls/C/gui-enabling-disabling-of-controls-1.c @@ -0,0 +1,80 @@ +#include +#include "resource.h" + +#define MIN_VALUE 0 +#define MAX_VALUE 10 + +BOOL CALLBACK DlgProc( HWND hwnd, UINT msg, WPARAM wPar, LPARAM lPar ); +void Increment( HWND hwnd ); +void Decrement( HWND hwnd ); +void SetControlsState( HWND hwnd ); + +int WINAPI WinMain( HINSTANCE hInst, HINSTANCE hPInst, LPSTR cmdLn, int show ) { + return DialogBox( hInst, MAKEINTRESOURCE(IDD_DLG), NULL, DlgProc ); +} + +BOOL CALLBACK DlgProc( HWND hwnd, UINT msg, WPARAM wPar, LPARAM lPar ) { + switch( msg ) { + + case WM_INITDIALOG: + srand( GetTickCount() ); + SetDlgItemInt( hwnd, IDC_INPUT, 0, FALSE ); + break; + + case WM_COMMAND: + switch( LOWORD(wPar) ) { + case IDC_INCREMENT: + Increment( hwnd ); + break; + case IDC_DECREMENT: + Decrement( hwnd ); + break; + case IDC_INPUT: + // update controls' state according + // to the contents of the input field + if( HIWORD(wPar) == EN_CHANGE ) SetControlsState( hwnd ); + break; + case IDC_QUIT: + SendMessage( hwnd, WM_CLOSE, 0, 0 ); + break; + default: ; + } + break; + + case WM_CLOSE: { + int reply = MessageBox( hwnd, + "Do you really want to quit?", + "Quit confirmation", MB_ICONQUESTION|MB_YESNO ); + if( reply == IDYES ) + EndDialog( hwnd, 0 ); + } break; + + default: ; + } + + return 0; +} + +void Increment( HWND hwnd ) { + UINT n = GetDlgItemInt( hwnd, IDC_INPUT, NULL, FALSE ); + + if( n < MAX_VALUE ) { + SetDlgItemInt( hwnd, IDC_INPUT, ++n, FALSE ); + SetControlsState( hwnd ); + } +} + +void Decrement( HWND hwnd ) { + UINT n = GetDlgItemInt( hwnd, IDC_INPUT, NULL, FALSE ); + + if( n > MIN_VALUE ) { + SetDlgItemInt( hwnd, IDC_INPUT, --n, FALSE ); + SetControlsState( hwnd ); + } +} + +void SetControlsState( HWND hwnd ) { + UINT n = GetDlgItemInt( hwnd, IDC_INPUT, NULL, FALSE ); + EnableWindow( GetDlgItem(hwnd,IDC_INCREMENT), nMIN_VALUE ); +} diff --git a/Task/GUI-enabling-disabling-of-controls/C/gui-enabling-disabling-of-controls-2.c b/Task/GUI-enabling-disabling-of-controls/C/gui-enabling-disabling-of-controls-2.c new file mode 100644 index 0000000000..80f274e834 --- /dev/null +++ b/Task/GUI-enabling-disabling-of-controls/C/gui-enabling-disabling-of-controls-2.c @@ -0,0 +1,5 @@ +#define IDD_DLG 101 +#define IDC_INPUT 1001 +#define IDC_INCREMENT 1002 +#define IDC_DECREMENT 1003 +#define IDC_QUIT 1004 diff --git a/Task/GUI-enabling-disabling-of-controls/C/gui-enabling-disabling-of-controls-3.c b/Task/GUI-enabling-disabling-of-controls/C/gui-enabling-disabling-of-controls-3.c new file mode 100644 index 0000000000..ca329dda62 --- /dev/null +++ b/Task/GUI-enabling-disabling-of-controls/C/gui-enabling-disabling-of-controls-3.c @@ -0,0 +1,14 @@ +#include +#include "resource.h" + +LANGUAGE LANG_NEUTRAL, SUBLANG_NEUTRAL +IDD_DLG DIALOG 0, 0, 154, 46 +STYLE DS_3DLOOK | DS_CENTER | DS_MODALFRAME | DS_SHELLFONT | WS_CAPTION | WS_VISIBLE | WS_POPUP | WS_SYSMENU +CAPTION "GUI Component Interaction" +FONT 12, "Ms Shell Dlg" { + EDITTEXT IDC_INPUT, 33, 7, 114, 12, ES_AUTOHSCROLL | ES_NUMBER + PUSHBUTTON "Increment", IDC_INCREMENT, 7, 25, 50, 14 + PUSHBUTTON "Decrement", IDC_DECREMENT, 62, 25, 50, 14, WS_DISABLED + PUSHBUTTON "Quit", IDC_QUIT, 117, 25, 30, 14 + RTEXT "Value:", -1, 10, 8, 20, 8 +} diff --git a/Task/Galton-box-animation/Haskell/galton-box-animation.hs b/Task/Galton-box-animation/Haskell/galton-box-animation.hs new file mode 100644 index 0000000000..35365eb7c8 --- /dev/null +++ b/Task/Galton-box-animation/Haskell/galton-box-animation.hs @@ -0,0 +1,47 @@ +import Data.Map hiding (map, filter) +import Graphics.Gloss +import Control.Monad.Random + +data Ball = Ball { position :: (Int, Int), turns :: [Int] } + +type World = ( Int -- number of rows of pins + , [Ball] -- sequence of balls + , Map Int Int ) -- counting bins + +updateWorld :: World -> World +updateWorld (nRows, balls, bins) + | y < -nRows-5 = (nRows, map update bs, bins <+> x) + | otherwise = (nRows, map update balls, bins) + where + (Ball (x,y) _) : bs = balls + + b <+> x = unionWith (+) b (singleton x 1) + + update (Ball (x,y) turns) + | -nRows <= y && y < 0 = Ball (x + head turns, y - 1) (tail turns) + | otherwise = Ball (x, y - 1) turns + +drawWorld :: World -> Picture +drawWorld (nRows, balls, bins) = pictures [ color red ballsP + , color black binsP + , color blue pinsP ] + where ballsP = foldMap (disk 1) $ takeWhile ((3 >).snd) $ map position balls + binsP = foldMapWithKey drawBin bins + pinsP = foldMap (disk 0.2) $ [1..nRows] >>= \i -> + [1..i] >>= \j -> [(2*j-i-1, -i-1)] + + disk r pos = trans pos $ circleSolid (r*10) + drawBin x h = trans (x,-nRows-7) + $ rectangleUpperSolid 20 (-fromIntegral h) + trans (x,y) = Translate (20 * fromIntegral x) (20 * fromIntegral y) + +startSimulation :: Int -> [Ball] -> IO () +startSimulation nRows balls = simulate display white 50 world drawWorld update + where display = InWindow "Galton box" (400, 400) (0, 0) + world = (nRows, balls, empty) + update _ _ = updateWorld + +main = evalRandIO balls >>= startSimulation 10 + where balls = mapM makeBall [1..] + makeBall y = Ball (0, y) <$> randomTurns + randomTurns = filter (/=0) <$> getRandomRs (-1, 1) diff --git a/Task/Galton-box-animation/Perl-6/galton-box-animation.pl6 b/Task/Galton-box-animation/Perl-6/galton-box-animation.pl6 index 817a7cf205..26c4badea7 100644 --- a/Task/Galton-box-animation/Perl-6/galton-box-animation.pl6 +++ b/Task/Galton-box-animation/Perl-6/galton-box-animation.pl6 @@ -42,7 +42,7 @@ sub display-board(@positions, @stats is copy, $halfstep) { # make some space above the picture say "" for ^10; - my @output-lines = map { [map *.clone, @$_].item }, @board-tmpl; + my @output-lines = map { [ @$_ ] }, @board-tmpl; # place the coins for @positions.kv -> $line, $pos { next unless $pos.defined; @@ -50,7 +50,7 @@ sub display-board(@positions, @stats is copy, $halfstep) { } # output the board with its coins for @output-lines -> @line { - say @line>>.chr.join(""); + say @line.chrs; } # show the statistics diff --git a/Task/Gamma-function/00DESCRIPTION b/Task/Gamma-function/00DESCRIPTION index 8c10cbf5cf..b126788ac0 100644 --- a/Task/Gamma-function/00DESCRIPTION +++ b/Task/Gamma-function/00DESCRIPTION @@ -1,9 +1,16 @@ -Implement one algorithm (or more) to compute the [[wp:Gamma function|Gamma]] (\Gamma) function (in the real field only). If your language has the function as builtin or you know a library which has it, compare your implementation's results with the results of the builtin/library function. +;Task: +Implement one algorithm (or more) to compute the [[wp:Gamma function|Gamma]] (\Gamma) function (in the real field only). + +If your language has the function as built-in or you know a library which has it, compare your implementation's results with the results of the built-in/library function. + The Gamma function can be defined as: -:\Gamma(x) = \displaystyle\int_0^\infty t^{x-1}e^{-t} dt +:::::: \Gamma(x) = \displaystyle\int_0^\infty t^{x-1}e^{-t} dt This suggests a straightforward (but inefficient) way of computing the \Gamma through numerical integration. + + Better suggested methods: * [[wp:Lanczos approximation|Lanczos approximation]] * [[wp:Stirling's approximation|Stirling's approximation]] +

    diff --git a/Task/Gamma-function/PARI-GP/gamma-function-2.pari b/Task/Gamma-function/PARI-GP/gamma-function-2.pari index 702c8029b5..7f3a388a50 100644 --- a/Task/Gamma-function/PARI-GP/gamma-function-2.pari +++ b/Task/Gamma-function/PARI-GP/gamma-function-2.pari @@ -1 +1 @@ -Gamma(x)=intnum(t=0,[[1],1],t^(x-1)/exp(t)) +Gamma(x)=intnum(t=0,[+oo,1],t^(x-1)/exp(t)) diff --git a/Task/Gamma-function/PowerShell/gamma-function.psh b/Task/Gamma-function/PowerShell/gamma-function.psh new file mode 100644 index 0000000000..06bb8e9529 --- /dev/null +++ b/Task/Gamma-function/PowerShell/gamma-function.psh @@ -0,0 +1,3 @@ +Add-Type -Path "C:\Program Files (x86)\Math\MathNet.Numerics.3.12.0\lib\net40\MathNet.Numerics.dll" + +1..20 | ForEach-Object {[MathNet.Numerics.SpecialFunctions]::Gamma($_ / 10)} diff --git a/Task/Gamma-function/REXX/gamma-function.rexx b/Task/Gamma-function/REXX/gamma-function.rexx index 6ee21bd1a3..4189ca6539 100644 --- a/Task/Gamma-function/REXX/gamma-function.rexx +++ b/Task/Gamma-function/REXX/gamma-function.rexx @@ -1,67 +1,67 @@ -/*REXX pgm calculates GAMMA using Taylor series coefficients, ≈80 decimal digs*/ - /*The GAMMA function symbol is the Greek capital letter: Γ */ -numeric digits 90 /*be able to handle extended precision.*/ -parse arg y z . /*allow specification of gamma argument*/ - /* [↓] either show a range or a ··· */ - do j=word(y 1,1) to word(z y 9,1) /* ··· single gamma value(s). */ - say 'gamma('j") =" gamma(j) /*compute gamma of J and display value.*/ - end /*j*/ -exit /*stick a fork in it, we're all done. */ -/*───────────────────────────────────GAMMA subroutine─────────────────────────────────*/ +/*REXX program calculates GAMMA using the Taylor series coefficients, ≈80 decimal digits*/ + /*The GAMMA function symbol is the Greek capital letter: Γ */ +numeric digits 90 /*be able to handle extended precision.*/ +parse arg LO HI . /*allow specification of gamma argument*/ + /* [↓] either show a range or a ··· */ + do j=word(LO 1, 1) to word(HI LO 9, 1) /* ··· single gamma value.*/ + say 'gamma('j") =" gamma(j) /*compute gamma of J and display value.*/ + end /*j*/ /* [↑] default LO is one; HI is nine.*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ gamma: procedure; parse arg x; xm=x-1; sum=0 - /*coefficients thanks to: Arne Fransén and Staffan Wrigge.*/ - #.1= 1 /* [↓] #.2 is the Euler-Mascheroni constant. */ - #.2= 0.57721566490153286060651209008240243104215933593992359880576723488486772677766467 - #.3=-0.65587807152025388107701951514539048127976638047858434729236244568387083835372210 - #.4=-0.04200263503409523552900393487542981871139450040110609352206581297618009687597599 - #.5= 0.16653861138229148950170079510210523571778150224717434057046890317899386605647425 - #.6=-0.04219773455554433674820830128918739130165268418982248637691887327545901118558900 - #.7=-0.00962197152787697356211492167234819897536294225211300210513886262731167351446074 - #.8= 0.00721894324666309954239501034044657270990480088023831800109478117362259497415854 - #.9=-0.00116516759185906511211397108401838866680933379538405744340750527562002584816653 -#.10=-0.00021524167411495097281572996305364780647824192337833875035026748908563946371678 -#.11= 0.00012805028238811618615319862632816432339489209969367721490054583804120355204347 -#.12=-0.00002013485478078823865568939142102181838229483329797911526116267090822918618897 -#.13=-0.00000125049348214267065734535947383309224232265562115395981534992315749121245561 -#.14= 0.00000113302723198169588237412962033074494332400483862107565429550539546040842730 -#.15=-0.00000020563384169776071034501541300205728365125790262933794534683172533245680371 -#.16= 0.00000000611609510448141581786249868285534286727586571971232086732402927723507435 -#.17= 0.00000000500200764446922293005566504805999130304461274249448171895337887737472132 -#.18=-0.00000000118127457048702014458812656543650557773875950493258759096189263169643391 -#.19= 0.00000000010434267116911005104915403323122501914007098231258121210871073927347588 -#.20= 0.00000000000778226343990507125404993731136077722606808618139293881943550732692987 -#.21=-0.00000000000369680561864220570818781587808576623657096345136099513648454655443000 -#.22= 0.00000000000051003702874544759790154813228632318027268860697076321173501048565735 -#.23=-0.00000000000002058326053566506783222429544855237419746091080810147188058196444349 -#.24=-0.00000000000000534812253942301798237001731872793994898971547812068211168095493211 -#.25= 0.00000000000000122677862823826079015889384662242242816545575045632136601135999606 -#.26=-0.00000000000000011812593016974587695137645868422978312115572918048478798375081233 -#.27= 0.00000000000000000118669225475160033257977724292867407108849407966482711074006109 -#.28= 0.00000000000000000141238065531803178155580394756670903708635075033452562564122263 -#.29=-0.00000000000000000022987456844353702065924785806336992602845059314190367014889830 -#.30= 0.00000000000000000001714406321927337433383963370267257066812656062517433174649858 -#.31= 0.00000000000000000000013373517304936931148647813951222680228750594717618947898583 -#.32=-0.00000000000000000000020542335517666727893250253513557337960820379352387364127301 -#.33= 0.00000000000000000000002736030048607999844831509904330982014865311695836363370165 -#.34=-0.00000000000000000000000173235644591051663905742845156477979906974910879499841377 -#.35=-0.00000000000000000000000002360619024499287287343450735427531007926413552145370486 -#.36= 0.00000000000000000000000001864982941717294430718413161878666898945868429073668232 -#.37=-0.00000000000000000000000000221809562420719720439971691362686037973177950067567580 -#.38= 0.00000000000000000000000000012977819749479936688244144863305941656194998646391332 -#.39= 0.00000000000000000000000000000118069747496652840622274541550997151855968463784158 -#.40=-0.00000000000000000000000000000112458434927708809029365467426143951211941179558301 -#.41= 0.00000000000000000000000000000012770851751408662039902066777511246477487720656005 -#.42=-0.00000000000000000000000000000000739145116961514082346128933010855282371056899245 -#.43= 0.00000000000000000000000000000000001134750257554215760954165259469306393008612196 -#.44= 0.00000000000000000000000000000000004639134641058722029944804907952228463057968680 -#.45=-0.00000000000000000000000000000000000534733681843919887507741819670989332090488591 -#.46= 0.00000000000000000000000000000000000032079959236133526228612372790827943910901464 -#.47=-0.00000000000000000000000000000000000000444582973655075688210159035212464363740144 -#.48=-0.00000000000000000000000000000000000000131117451888198871290105849438992219023663 -#.49= 0.00000000000000000000000000000000000000016470333525438138868182593279063941453996 -#.50=-0.00000000000000000000000000000000000000001056233178503581218600561071538285049997 -#.51= 0.00000000000000000000000000000000000000000026784429826430494783549630718908519485 -#.52= 0.00000000000000000000000000000000000000000002424715494851782689673032938370921241 + /*coefficients thanks to: Arne Fransén & Staffan Wrigge.*/ + #.1 = 1 /* [↓] #.2 is the Euler-Mascheroni constant. */ + #.2 = 0.57721566490153286060651209008240243104215933593992359880576723488486772677766467 + #.3 = -0.65587807152025388107701951514539048127976638047858434729236244568387083835372210 + #.4 = -0.04200263503409523552900393487542981871139450040110609352206581297618009687597599 + #.5 = 0.16653861138229148950170079510210523571778150224717434057046890317899386605647425 + #.6 = -0.04219773455554433674820830128918739130165268418982248637691887327545901118558900 + #.7 = -0.00962197152787697356211492167234819897536294225211300210513886262731167351446074 + #.8 = 0.00721894324666309954239501034044657270990480088023831800109478117362259497415854 + #.9 = -0.00116516759185906511211397108401838866680933379538405744340750527562002584816653 +#.10 = -0.00021524167411495097281572996305364780647824192337833875035026748908563946371678 +#.11 = 0.00012805028238811618615319862632816432339489209969367721490054583804120355204347 +#.12 = -0.00002013485478078823865568939142102181838229483329797911526116267090822918618897 +#.13 = -0.00000125049348214267065734535947383309224232265562115395981534992315749121245561 +#.14 = 0.00000113302723198169588237412962033074494332400483862107565429550539546040842730 +#.15 = -0.00000020563384169776071034501541300205728365125790262933794534683172533245680371 +#.16 = 0.00000000611609510448141581786249868285534286727586571971232086732402927723507435 +#.17 = 0.00000000500200764446922293005566504805999130304461274249448171895337887737472132 +#.18 = -0.00000000118127457048702014458812656543650557773875950493258759096189263169643391 +#.19 = 0.00000000010434267116911005104915403323122501914007098231258121210871073927347588 +#.20 = 0.00000000000778226343990507125404993731136077722606808618139293881943550732692987 +#.21 = -0.00000000000369680561864220570818781587808576623657096345136099513648454655443000 +#.22 = 0.00000000000051003702874544759790154813228632318027268860697076321173501048565735 +#.23 = -0.00000000000002058326053566506783222429544855237419746091080810147188058196444349 +#.24 = -0.00000000000000534812253942301798237001731872793994898971547812068211168095493211 +#.25 = 0.00000000000000122677862823826079015889384662242242816545575045632136601135999606 +#.26 = -0.00000000000000011812593016974587695137645868422978312115572918048478798375081233 +#.27 = 0.00000000000000000118669225475160033257977724292867407108849407966482711074006109 +#.28 = 0.00000000000000000141238065531803178155580394756670903708635075033452562564122263 +#.29 = -0.00000000000000000022987456844353702065924785806336992602845059314190367014889830 +#.30 = 0.00000000000000000001714406321927337433383963370267257066812656062517433174649858 +#.31 = 0.00000000000000000000013373517304936931148647813951222680228750594717618947898583 +#.32 = -0.00000000000000000000020542335517666727893250253513557337960820379352387364127301 +#.33 = 0.00000000000000000000002736030048607999844831509904330982014865311695836363370165 +#.34 = -0.00000000000000000000000173235644591051663905742845156477979906974910879499841377 +#.35 = -0.00000000000000000000000002360619024499287287343450735427531007926413552145370486 +#.36 = 0.00000000000000000000000001864982941717294430718413161878666898945868429073668232 +#.37 = -0.00000000000000000000000000221809562420719720439971691362686037973177950067567580 +#.38 = 0.00000000000000000000000000012977819749479936688244144863305941656194998646391332 +#.39 = 0.00000000000000000000000000000118069747496652840622274541550997151855968463784158 +#.40 = -0.00000000000000000000000000000112458434927708809029365467426143951211941179558301 +#.41 = 0.00000000000000000000000000000012770851751408662039902066777511246477487720656005 +#.42 = -0.00000000000000000000000000000000739145116961514082346128933010855282371056899245 +#.43 = 0.00000000000000000000000000000000001134750257554215760954165259469306393008612196 +#.44 = 0.00000000000000000000000000000000004639134641058722029944804907952228463057968680 +#.45 = -0.00000000000000000000000000000000000534733681843919887507741819670989332090488591 +#.46 = 0.00000000000000000000000000000000000032079959236133526228612372790827943910901464 +#.47 = -0.00000000000000000000000000000000000000444582973655075688210159035212464363740144 +#.48 = -0.00000000000000000000000000000000000000131117451888198871290105849438992219023663 +#.49 = 0.00000000000000000000000000000000000000016470333525438138868182593279063941453996 +#.50 = -0.00000000000000000000000000000000000000001056233178503581218600561071538285049997 +#.51 = 0.00000000000000000000000000000000000000000026784429826430494783549630718908519485 +#.52 = 0.00000000000000000000000000000000000000000002424715494851782689673032938370921241 #=52; do k=# by -1 for # sum=sum*xm + #.k end /*k*/ diff --git a/Task/Gaussian-elimination/Common-Lisp/gaussian-elimination.lisp b/Task/Gaussian-elimination/Common-Lisp/gaussian-elimination.lisp new file mode 100644 index 0000000000..ce81ca4842 --- /dev/null +++ b/Task/Gaussian-elimination/Common-Lisp/gaussian-elimination.lisp @@ -0,0 +1,17 @@ +(defmacro mapcar-1 (fn n list) + "Maps a function of two parameters where the first one is fixed, over a list" + `(mapcar #'(lambda (l) (funcall ,fn ,n l)) ,list) ) + + +(defun gauss (m) + (labels + ((redc (m) ; Reduce to triangular form + (if (null (cdr m)) + m + (cons (car m) (mapcar-1 #'cons 0 (redc (mapcar #'cdr (mapcar #'(lambda (r) (mapcar #'- (mapcar-1 #'* (caar m) r) + (mapcar-1 #'* (car r) (car m)))) (cdr m)))))) )) + (rev (m) ; Reverse each row except the last element + (reverse (mapcar #'(lambda (r) (append (reverse (butlast r)) (last r))) m)) )) + (catch 'result + (let ((m1 (redc (rev (redc m))))) + (reverse (mapcar #'(lambda (r) (let ((pivot (find-if-not #'zerop r))) (if pivot (/ (car (last r)) pivot) (throw 'result 'singular)))) m1)) )))) diff --git a/Task/Gaussian-elimination/Haskell/gaussian-elimination-1.hs b/Task/Gaussian-elimination/Haskell/gaussian-elimination-1.hs new file mode 100644 index 0000000000..d9a7961e75 --- /dev/null +++ b/Task/Gaussian-elimination/Haskell/gaussian-elimination-1.hs @@ -0,0 +1,110 @@ +foldlZipWith::(a -> b -> c) -> (d -> c -> d) -> d -> [a] -> [b] -> d +foldlZipWith _ _ u [] _ = u +foldlZipWith _ _ u _ [] = u +foldlZipWith f g u (x:xs) (y:ys) = foldlZipWith f g (g u (f x y)) xs ys + +foldl1ZipWith::(a -> b -> c) -> (c -> c -> c) -> [a] -> [b] -> c +foldl1ZipWith _ _ [] _ = error "First list is empty" +foldl1ZipWith _ _ _ [] = error "Second list is empty" +foldl1ZipWith f g (x:xs) (y:ys) = foldlZipWith f g (f x y) xs ys + +multAdd::(a -> b -> c) -> (c -> c -> c) -> [[a]] -> [[b]] -> [[c]] +multAdd f g xs ys = map (\us -> foldl1ZipWith (\u vs -> map (f u) vs) (zipWith g) us ys) xs + +mult:: Num a => [[a]] -> [[a]] -> [[a]] +mult xs ys = multAdd (*) (+) xs ys + +bubble::([a] -> c) -> (c -> c -> Bool) -> [[a]] -> [[b]] -> ([[a]],[[b]]) +bubble _ _ [] ts = ([],ts) +bubble _ _ rs [] = (rs,[]) +bubble f g (r:rs) (t:ts) = bub r t (f r) rs ts [] [] + where + bub l k _ [] _ xs ys = (l:xs,k:ys) + bub l k _ _ [] xs ys = (l:xs,k:ys) + bub l k m (u:us) (v:vs) xs ys = ans + where + mu = f u + ans | g m mu = bub l k m us vs (u:xs) (v:ys) + | otherwise = bub u v mu us vs (l:xs) (k:ys) + +pivot::Num a => [a] -> [a] -> [[a]] -> [[a]] -> ([[a]],[[a]]) +pivot xs ks ys ls = go ys ls [] [] + where + x = head xs + fun r = zipWith (\u v -> u*r - v*x) + val rs ts = let f = fun (head rs) in (tail $ f xs rs,f ks ts) + go [] _ us vs = (us,vs) + go _ [] us vs = (us,vs) + go rs ts us vs = go (tail rs) (tail ts) (es:us) (fs:vs) + where (es,fs) = val (head rs) (head ts) + +triangle::(Num a,Ord a) => [[a]] -> [[a]] -> ([[a]],[[a]]) +triangle as bs = go (as,bs) [] [] + where + go ([],_) us vs = (us,vs) + go (_,[]) us vs = (us,vs) + go (rs,ts) us vs = ans + where + (xs:ys,ks:ls) = bubble (abs.head) (>=) rs ts + ans = go (pivot xs ks ys ls) (xs:us) (ks:vs) + +solveTriangle::(Fractional a,Eq a) => [[a]] -> [[a]] -> [[a]] +solveTriangle [] _ = [] +solveTriangle _ [] = [] +solveTriangle as _ | not.null.dropWhile ((/= 0).head) $ as = [] +solveTriangle ([c]:as) (b:bs) = go as bs [map (/c) b] + where + val us vs ws = let u = head us in map (/u) $ zipWith (-) vs (head $ mult [tail us] ws) + go [] _ zs = zs + go _ [] zs = zs + go (x:xs) (y:ys) zs = go xs ys $ (val x y zs):zs + +solveGauss:: (Fractional a, Ord a) => [[a]] -> [[a]] -> [[a]] +solveGauss as bs = uncurry solveTriangle $ triangle as bs + +matI::(Num a) => Int -> [[a]] +matI n = [ [fromIntegral.fromEnum $ i == j | j <- [1..n]] | i <- [1..n]] + +task::[[Rational]] -> [[Rational]] -> IO() +task a b = do + let x = solveGauss a b + let u = map (map fromRational) x + let y = mult a x + let identity = matI (length x) + let a1 = solveGauss a identity + let h = mult a a1 + let z = mult a1 b + putStrLn "a =" + mapM_ print a + putStrLn "b =" + mapM_ print b + putStrLn "solve: a * x = b => x = solveGauss a b =" + mapM_ print x + putStrLn "u = fromRationaltoDouble x =" + mapM_ print u + putStrLn "verification: y = a * x = mult a x =" + mapM_ print y + putStrLn $ "test: y == b = " + print $ y == b + putStrLn "identity matrix: identity =" + mapM_ print identity + putStrLn "find: a1 = inv(a) => solve: a * a1 = identity => a1 = solveGauss a identity =" + mapM_ print a1 + putStrLn "verification: h = a * a1 = mult a a1 =" + mapM_ print h + putStrLn $ "test: h == identity = " + print $ h == identity + putStrLn "z = a1 * b = mult a1 b =" + mapM_ print z + putStrLn "test: z == x =" + print $ z == x + +main = do + let a = [[1.00, 0.00, 0.00, 0.00, 0.00, 0.00], + [1.00, 0.63, 0.39, 0.25, 0.16, 0.10], + [1.00, 1.26, 1.58, 1.98, 2.49, 3.13], + [1.00, 1.88, 3.55, 6.70, 12.62, 23.80], + [1.00, 2.51, 6.32, 15.88, 39.90, 100.28], + [1.00, 3.14, 9.87, 31.01, 97.41, 306.02]] + let b = [[-0.01], [0.61], [0.91], [0.99], [0.60], [0.02]] + task a b diff --git a/Task/Gaussian-elimination/Haskell/gaussian-elimination-2.hs b/Task/Gaussian-elimination/Haskell/gaussian-elimination-2.hs new file mode 100644 index 0000000000..41fa96b929 --- /dev/null +++ b/Task/Gaussian-elimination/Haskell/gaussian-elimination-2.hs @@ -0,0 +1,103 @@ +foldlZipWith::(a -> b -> c) -> (d -> c -> d) -> d -> [a] -> [b] -> d +foldlZipWith _ _ u [] _ = u +foldlZipWith _ _ u _ [] = u +foldlZipWith f g u (x:xs) (y:ys) = foldlZipWith f g (g u (f x y)) xs ys + +foldl1ZipWith::(a -> b -> c) -> (c -> c -> c) -> [a] -> [b] -> c +foldl1ZipWith _ _ [] _ = error "First list is empty" +foldl1ZipWith _ _ _ [] = error "Second list is empty" +foldl1ZipWith f g (x:xs) (y:ys) = foldlZipWith f g (f x y) xs ys + +multAdd::(a -> b -> c) -> (c -> c -> c) -> [[a]] -> [[b]] -> [[c]] +multAdd f g xs ys = map (\us -> foldl1ZipWith (\u vs -> map (f u) vs) (zipWith g) us ys) xs + +mult:: Num a => [[a]] -> [[a]] -> [[a]] +mult xs ys = multAdd (*) (+) xs ys + +triangle::(Fractional a, Ord a) => [[a]] -> [[a]] -> (a,[(([a],[a]),Int)]) +triangle as bs = pivot 1 [] $ zipWith3 (\x y i -> ((x,y),i)) as bs [(0::Int)..] + where + good rs ts = (abs.head.fst.fst $ ts) <= (abs.head.fst.fst $ rs) + go (us,vs) ((os,ps),i) = if o == 0 then ((rs,f vs ps),i) else ((f us rs,f vs ps),i) + where + (o,rs) = (head os,tail os) + f = zipWith (\x y -> y - x*o) + change i (ys:zs) = map (\xs -> if (==i).snd $ xs then ys else xs) zs + pivot d ls [] = (d,ls) + pivot d ls zs@((_,j):ys) = if u == 0 then (0,ls) else pivot e (ps:ls) ws + where + e = if i == j then u*d else -u*d + ws = map (go (map (/u) us,map (/u) vs)) $ if i == j then ys else change i zs + ps@((u:us,vs),i) = foldl1 (\rs ts -> if good rs ts then rs else ts) zs + +-- ((det,sol),permutation) = gauss as bs +-- det = determinant as +-- sol is solution of: as * sol = bs +-- perm is a permutation with: (matPerm perm) * as * sol = (matPerm perm) * bs +gauss::(Fractional a,Ord a) => [[a]] -> [[a]] -> ((a,[[a]]),[Int]) +gauss as bs = if 0 == det then ((0,[]),[]) else solveTriangle ms + where + (det,ms) = triangle as bs + solveTriangle ((([c],b),i):sys) = go sys [map (/c) b] [i] + where + val us vs ws = let u = head us in map (/u) $ zipWith (-) vs (head $ mult [tail us] ws) + go [] zs is = ((det,zs),is) + go (((x,y),i):sys) zs is = go sys ((val x y zs):zs) (i:is) + +solveGauss::(Fractional a,Ord a) => [[a]] -> [[a]] -> [[a]] +solveGauss as = snd.fst.gauss as + +matI::Num a => Int -> [[a]] +matI n = [ [fromIntegral.fromEnum $ i == j | i <- [1..n]] | j <- [1..n]] + +matPerm::Num a => [Int] -> [[a]] +matPerm ns = [ [fromIntegral.fromEnum $ i == j | (j,_) <- zip [0..] ns] | i <- ns] + +task::[[Rational]] -> [[Rational]] -> IO() +task a b = do + let ((d,x),perm) = gauss a b + let ps = matPerm perm + let u = map (map fromRational) x + let y = mult a x + let identity = matI (length x) + let a1 = solveGauss a identity + let h = mult a a1 + let z = mult a1 b + putStrLn "d = determinant a =" + print d + putStrLn "a =" + mapM_ print a + putStrLn "b =" + mapM_ print b + putStrLn "solve: a * x = b => x = solveGauss a b =" + mapM_ print x + putStrLn "u = fromRationaltoDouble x =" + mapM_ print u + putStrLn "verification: y = a * x = mult a x =" + mapM_ print y + putStrLn $ "test: y == b = " + print $ y == b + putStrLn "ps is the permutation associated to matrix a and ps =" + mapM_ print ps + putStrLn "identity matrix: identity =" + mapM_ print identity + putStrLn "find: a1 = inv(a) => solve: a * a1 = identity => a1 = solveGauss a identity =" + mapM_ print a1 + putStrLn "verification: h = a * a1 = mult a a1 =" + mapM_ print h + putStrLn $ "test: h == identity = " + print $ h == identity + putStrLn "z = a1 * b = mult a1 b =" + mapM_ print z + putStrLn "test: z == x =" + print $ z == x + +main = do + let a = [[1.00, 0.00, 0.00, 0.00, 0.00, 0.00], + [1.00, 0.63, 0.39, 0.25, 0.16, 0.10], + [1.00, 1.26, 1.58, 1.98, 2.49, 3.13], + [1.00, 1.88, 3.55, 6.70, 12.62, 23.80], + [1.00, 2.51, 6.32, 15.88, 39.90, 100.28], + [1.00, 3.14, 9.87, 31.01, 97.41, 306.02]] + let b = [[-0.01], [0.61], [0.91], [0.99], [0.60], [0.02]] + task a b diff --git a/Task/Gaussian-elimination/PowerShell/gaussian-elimination-1.psh b/Task/Gaussian-elimination/PowerShell/gaussian-elimination-1.psh new file mode 100644 index 0000000000..104acf61ac --- /dev/null +++ b/Task/Gaussian-elimination/PowerShell/gaussian-elimination-1.psh @@ -0,0 +1,53 @@ +function gauss($a,$b) { + $n = $a.count + for ($k = 0; $k -lt $n; $k++) { + $lmax, $max = $k, [Math]::Abs($a[$k][$k]) + for ($l = $k+1; $l -lt $n; $l++) { + $tmp = [Math]::Abs($a[$l][$k]) + if($max -lt $tmp) { + $max, $lmax = $tmp, $l + } + } + if ($k -ne $lmax) { + $a[$k], $a[$lmax] = $a[$lmax], $a[$k] + $b[$k], $b[$lmax] = $b[$lmax], $b[$k] + } + $akk = $a[$k][$k] + for ($i = $k+1; $i -lt $n; $i++){ + $aik = $a[$i][$k] + for ($j = $k; $j -lt $n; $j++) { + $a[$i][$j] = $a[$i][$j]*$akk - $a[$k][$j]*$aik + } + $b[$i] = $b[$i]*$akk - $b[$k]*$aik + } + } + for ($i = $n-1; $i -ge 0; $i--) { + for ($j = $i+1; $j -lt $n; $j++) { + $b[$i] -= $b[$j]*$a[$i][$j] + } + $b[$i] = $b[$i]/$a[$i][$i] + } + $b +} +function show($a) { + if($a) { + 0..($a.Count - 1) | foreach{ if($a[$_]){"$($a[$_][0..($a[$_].count -1)])"}else{""} } + } +} +$a =( +@(1.00, 0.00, 0.00, 0.00, 0.00, 0.00), +@(1.00, 0.63, 0.39, 0.25, 0.16, 0.10), +@(1.00, 1.26, 1.58, 1.98, 2.49, 3.13), +@(1.00, 1.88, 3.55, 6.70, 12.62, 23.80), +@(1.00, 2.51, 6.32, 15.88, 39.90, 100.28), +@(1.00, 3.14, 9.87, 31.01, 97.41, 306.02) +) +"a =" +show $a +"" +$b = @(-0.01, 0.61, 0.91, 0.99, 0.60, 0.02) +"b =" +$b +"" +"x =" +gauss $a $b diff --git a/Task/Gaussian-elimination/PowerShell/gaussian-elimination-2.psh b/Task/Gaussian-elimination/PowerShell/gaussian-elimination-2.psh new file mode 100644 index 0000000000..be38a8dfea --- /dev/null +++ b/Task/Gaussian-elimination/PowerShell/gaussian-elimination-2.psh @@ -0,0 +1,51 @@ +function gauss-jordan($a,$b) { + $n = $a.count + for ($k = 0; $k -lt $n; $k++) { + $lmax, $max = $k, [Math]::Abs($a[$k][$k]) + for ($l = $k+1; $l -lt $n; $l++) { + $tmp = [Math]::Abs($a[$l][$k]) + if($max -lt $tmp) { + $max, $lmax = $tmp, $l + } + } + if ($k -ne $lmax) { + $a[$k], $a[$lmax] = $a[$lmax], $a[$k] + $b[$k], $b[$lmax] = $b[$lmax], $b[$k] + } + $akk = $a[$k][$k] + for ($j = $k; $j -lt $n; $j++) {$a[$k][$j] /= $akk} + $b[$k] /= $akk + for ($i = 1; $i -lt $n; $i++){ + if ($i -ne $k) { + $aik = $a[$i][$k] + for ($j = $k; $j -lt $n; $j++) { + $a[$i][$j] = $a[$i][$j] - $a[$k][$j]*$aik + } + $b[$i] = $b[$i] - $b[$k]*$aik + } + } + } + $b +} +function show($a) { + if($a) { + 0..($a.Count - 1) | foreach{ if($a[$_]){"$($a[$_][0..($a[$_].count -1)])"}else{""} } + } +} +$a =( +@(1.00, 0.00, 0.00, 0.00, 0.00, 0.00), +@(1.00, 0.63, 0.39, 0.25, 0.16, 0.10), +@(1.00, 1.26, 1.58, 1.98, 2.49, 3.13), +@(1.00, 1.88, 3.55, 6.70, 12.62, 23.80), +@(1.00, 2.51, 6.32, 15.88, 39.90, 100.28), +@(1.00, 3.14, 9.87, 31.01, 97.41, 306.02) +) +"a =" +show $a +"" +$b = @(-0.01, 0.61, 0.91, 0.99, 0.60, 0.02) +"b =" +$b +"" +"x =" +gauss-jordan $a $b diff --git a/Task/Gaussian-elimination/REXX/gaussian-elimination-1.rexx b/Task/Gaussian-elimination/REXX/gaussian-elimination-1.rexx index 440caf5bb0..d6a9828c76 100644 --- a/Task/Gaussian-elimination/REXX/gaussian-elimination-1.rexx +++ b/Task/Gaussian-elimination/REXX/gaussian-elimination-1.rexx @@ -1,5 +1,14 @@ /* REXX --------------------------------------------------------------- * 07.08.2014 Walter Pachl translated from PL/I) +* improved to get integer results for, e.g. this input: + -6 -18 13 6 -6 -15 -2 -9 -231 + 2 20 9 2 16 -12 -18 -5 647 + 23 18 -14 -14 -1 16 25 -17 -907 + -8 -1 -19 4 3 -14 23 8 248 + 25 20 -6 15 0 -10 9 17 1316 + -13 -1 3 5 -2 17 14 -12 -1080 + 19 24 -21 -5 -19 0 -24 -17 1006 + 20 -3 -14 -16 -23 -25 -15 20 1496 *--------------------------------------------------------------------*/ Numeric Digits 20 Parse Arg t @@ -56,15 +65,17 @@ Exit Gauss_elimination: - do j = 1 to n - do i = j+1 to n /* For each of the rows beneath the current (pivot) row. */ - t = a.j.j / a.i.j - do k = j+1 to n /* Subtract a multiple of row i from row j. */ - a.i.k = a.j.k - t*a.i.k - end - b.i = b.j - t*b.i /* ... and the right-hand side. */ - end - end + Do j=1 to n-1 + ma=a.j.j + Do ja=j+1 To n + mb=a.ja.j + Do i=1 To n + new=a.j.i*mb-a.ja.i*ma + a.ja.i=new + End + b.ja=b.j*mb-b.ja*ma + End + End Return Backward_substitution: diff --git a/Task/Generate-Chess960-starting-position/00DESCRIPTION b/Task/Generate-Chess960-starting-position/00DESCRIPTION index 67e0a4a615..0713eb18e1 100644 --- a/Task/Generate-Chess960-starting-position/00DESCRIPTION +++ b/Task/Generate-Chess960-starting-position/00DESCRIPTION @@ -1,4 +1,4 @@ -'''[[wp:Chess960|Chess960]]''' is a variant of chess created by world champion [[wp:Bobby Fisher|Bobby Fisher]]. Unlike other variants of the game, Chess960 does not require a different material, but instead relies on a random initial position, with a few constraints: +'''[[wp:Chess960|Chess960]]'''   is a variant of chess created by world champion [[wp:Bobby Fisher|Bobby Fisher]]. Unlike other variants of the game, Chess960 does not require a different material, but instead relies on a random initial position, with a few constraints: * as in the standard chess game, all eight white pawns must be placed on the second rank. * White pieces must stand on the first rank as in the standard game, in random column order but with the two following constraints: @@ -6,7 +6,10 @@ ** the King must be between two rooks (with any number of other pieces between them all) * Black pawns and pieces must be placed respectively on the seventh and eighth ranks, mirroring the white pawns and pieces, just as in the standard game. (That is, their positions are not independently randomized.) -With those constraints there are 960 possible starting positions, thus the name of the variant. +
    +With those constraints there are '''960''' possible starting positions, thus the name of the variant. + ;Task: -The purpose of this task is to write a program that can randomly generate any one of the 960 Chess960 initial positions. You will show the result as the first rank displayed with [[wp:Chess symbols in Unicode|Chess symbols in Unicode: ♔♕♖♗♘]] or with the letters '''K'''ing '''Q'''ueen '''R'''ook '''B'''ishop k'''N'''ight. +The purpose of this task is to write a program that can randomly generate any one of the 960 Chess960 initial positions.   You will show the result as the first rank displayed with   [[wp:Chess symbols in Unicode|Chess symbols in Unicode: ♔♕♖♗♘]]   or with the letters   '''K'''ing   '''Q'''ueen   '''R'''ook   '''B'''ishop   k'''N'''ight. +

    diff --git a/Task/Generate-Chess960-starting-position/Clojure/generate-chess960-starting-position.clj b/Task/Generate-Chess960-starting-position/Clojure/generate-chess960-starting-position.clj new file mode 100644 index 0000000000..502fa26586 --- /dev/null +++ b/Task/Generate-Chess960-starting-position/Clojure/generate-chess960-starting-position.clj @@ -0,0 +1,38 @@ +(ns c960.core + (:gen-class) + (:require [clojure.string :as s])) + +;; legal starting rank - unicode chars for rook, knight, bishop, queen, king, bishop, knight, rook +(def starting-rank [\♖ \♘ \♗ \♕ \♔ \♗ \♘ \♖]) + +(defn bishops-legal? + "True if Bishops are odd number of indicies apart" + [rank] + (odd? (apply - (cons 0 (sort > (keep-indexed #(when (= \♗ %2) %1) rank)))))) + +(defn king-legal? + "True if the king is between two rooks" + [rank] + (let [king-&-rooks (filter #{\♔ \♖} rank)] + (and + (= 3 (count king-&-rooks)) + (= \u2654 (second king-&-rooks))))) + + +(defn c960 + "Return a legal rank for c960 chess" + ([] (c960 1)) + ([n] + (->> #(shuffle starting-rank) + repeatedly + (filter #(and (king-legal? %) (bishops-legal? %))) + (take n) + (map #(s/join ", " %))))) + + +(c960) +;; => "♗, ♖, ♔, ♕, ♘, ♘, ♖, ♗" +(c960) +;; => "♖, ♕, ♘, ♔, ♗, ♗, ♘, ♖" +(c960 4) +;; => ("♘, ♖, ♔, ♘, ♗, ♗, ♖, ♕" "♗, ♖, ♔, ♘, ♘, ♕, ♖, ♗" "♘, ♕, ♗, ♖, ♔, ♗, ♘, ♖" "♖, ♔, ♘, ♘, ♕, ♖, ♗, ♗") diff --git a/Task/Generate-Chess960-starting-position/Elixir/generate-chess960-starting-position-1.elixir b/Task/Generate-Chess960-starting-position/Elixir/generate-chess960-starting-position-1.elixir new file mode 100644 index 0000000000..0e35d04cf6 --- /dev/null +++ b/Task/Generate-Chess960-starting-position/Elixir/generate-chess960-starting-position-1.elixir @@ -0,0 +1,11 @@ +defmodule Chess960 do + @pieces ~w(♔ ♕ ♘ ♘ ♗ ♗ ♖ ♖) # ~w(K Q N N B B R R) + @regexes [~r/♗(..)*♗/, ~r/♖.*♔.*♖/] # [~r/B(..)*B/, ~r/R.*K.*R/] + + def shuffle do + row = Enum.shuffle(@pieces) |> Enum.join + if Enum.all?(@regexes, &Regex.match?(&1, row)), do: row, else: shuffle + end +end + +Enum.each(1..5, fn _ -> IO.puts Chess960.shuffle end) diff --git a/Task/Generate-Chess960-starting-position/Elixir/generate-chess960-starting-position-2.elixir b/Task/Generate-Chess960-starting-position/Elixir/generate-chess960-starting-position-2.elixir new file mode 100644 index 0000000000..3c94c3f48a --- /dev/null +++ b/Task/Generate-Chess960-starting-position/Elixir/generate-chess960-starting-position-2.elixir @@ -0,0 +1,13 @@ +defmodule Chess960 do + def construct do + row = Enum.reduce(~w[♕ ♘ ♘], ~w[♖ ♔ ♖], fn piece,acc -> + List.insert_at(acc, :rand.uniform(length(acc)+1)-1, piece) + end) + [Enum.random([0, 2, 4, 6]), Enum.random([1, 3, 5, 7])] + |> Enum.sort + |> Enum.reduce(row, fn pos,acc -> List.insert_at(acc, pos, "♗") end) + |> Enum.join + end +end + +Enum.each(1..5, fn _ -> IO.puts Chess960.construct end) diff --git a/Task/Generate-Chess960-starting-position/Elixir/generate-chess960-starting-position-3.elixir b/Task/Generate-Chess960-starting-position/Elixir/generate-chess960-starting-position-3.elixir new file mode 100644 index 0000000000..cab63d43e4 --- /dev/null +++ b/Task/Generate-Chess960-starting-position/Elixir/generate-chess960-starting-position-3.elixir @@ -0,0 +1,31 @@ +defmodule Chess960 do + @krn ~w(NNRKR NRNKR NRKNR NRKRN RNNKR RNKNR RNKRN RKNNR RKNRN RKRNN) + + def start_position, do: start_position(:rand.uniform(960)-1) + + def start_position(id) do + pos = List.duplicate(nil, 8) + q = div(id, 4) + r = rem(id, 4) + pos = List.replace_at(pos, r * 2 + 1, "B") + q = div(q, 4) + r = rem(q, 4) + pos = List.replace_at(pos, r * 2, "B") + q = div(q, 6) + r = rem(q, 6) + i = Enum.reject(0..7, &Enum.at(pos,&1)) |> Enum.at(r) + pos = List.replace_at(pos, i, "Q") + krn = Enum.at(@krn, q) |> String.codepoints + Enum.reject(0..7, &Enum.at(pos,&1)) + |> Enum.zip(krn) + |> Enum.reduce(pos, fn {i,x},acc -> List.replace_at(acc,i,x) end) + |> Enum.join + end +end + +IO.puts "Generate Start Position from ID number" +Enum.each([0,518,959], fn id -> + :io.format "~3w : ~s~n", [id, Chess960.start_position(id)] +end) +IO.puts "\nGenerate random Start Position" +Enum.each(1..5, fn _ -> IO.puts Chess960.start_position end) diff --git a/Task/Generate-Chess960-starting-position/Forth/generate-chess960-starting-position.fth b/Task/Generate-Chess960-starting-position/Forth/generate-chess960-starting-position.fth new file mode 100644 index 0000000000..770dd2d615 --- /dev/null +++ b/Task/Generate-Chess960-starting-position/Forth/generate-chess960-starting-position.fth @@ -0,0 +1,20 @@ +\ make starting position for Chess960, constructive + +\ 0 1 2 3 4 5 6 7 8 9 +create krn S" NNRKRNRNKRNRKNRNRKRNRNNKRRNKNRRNKRNRKNNRRKNRNRKRNN" mem, + +create pieces 8 allot + +: chess960 ( n -- ) + pieces 8 erase + 4 /mod swap 2* 1+ pieces + 'B swap c! + 4 /mod swap 2* pieces + 'B swap c! + 6 /mod swap pieces swap bounds begin dup c@ if swap 1+ swap then 2dup > while 1+ repeat drop 'Q swap c! + 5 * krn + pieces 8 bounds do i c@ 0= if dup c@ i c! 1+ then loop drop + cr pieces 8 type ; + +0 chess960 \ BBQNNRKR ok +518 chess960 \ RNBQKBNR ok +959 chess960 \ RKRNNQBB ok + +960 choose chess960 \ random position diff --git a/Task/Generate-Chess960-starting-position/Fortran/generate-chess960-starting-position.f b/Task/Generate-Chess960-starting-position/Fortran/generate-chess960-starting-position.f new file mode 100644 index 0000000000..ce7486c33b --- /dev/null +++ b/Task/Generate-Chess960-starting-position/Fortran/generate-chess960-starting-position.f @@ -0,0 +1,57 @@ +program chess960 + implicit none + + integer, pointer :: a,b,c,d,e,f,g,h + integer, target :: p(8) + a => p(1) + b => p(2) + c => p(3) + d => p(4) + e => p(5) + f => p(6) + g => p(7) + h => p(8) + + king: do a=2,7 ! King on an internal square + r1: do b=1,a-1 ! R1 left of the King + r2: do c=a+1,8 ! R2 right of the King + b1: do d=1,7,2 ! B1 on an odd square + if (skip_pos(d,4)) cycle + b2: do e=2,8,2 ! B2 on an even square + if (skip_pos(e,5)) cycle + queen: do f=1,8 ! Queen anywhere else + if (skip_pos(f,6)) cycle + n1: do g=1,7 ! First knight + if (skip_pos(g,7)) cycle + n2: do h=g+1,8 ! Second knight (indistinguishable from first) + if (skip_pos(h,8)) cycle + if (sum(p) /= 36) stop 'Loop error' ! Sanity check + call write_position + end do n2 + end do n1 + end do queen + end do b2 + end do b1 + end do r2 + end do r1 + end do king + +contains + + logical function skip_pos(i, n) + integer, intent(in) :: i, n + skip_pos = any(p(1:n-1) == i) + end function skip_pos + + subroutine write_position + integer :: i, j + character(len=15) :: position = ' ' + character(len=1), parameter :: names(8) = ['K','R','R','B','B','Q','N','N'] + do i=1,8 + j = 2*p(i)-1 + position(j:j) = names(i) + end do + write(*,'(a)') position + end subroutine write_position + +end program chess960 diff --git a/Task/Generate-Chess960-starting-position/JavaScript/generate-chess960-starting-position.js b/Task/Generate-Chess960-starting-position/JavaScript/generate-chess960-starting-position.js new file mode 100644 index 0000000000..417cf5cdfb --- /dev/null +++ b/Task/Generate-Chess960-starting-position/JavaScript/generate-chess960-starting-position.js @@ -0,0 +1,26 @@ +function ch960startPos() { + var rank = new Array(8), + // randomizer (our die) + d = function(num) { return Math.floor(Math.random() * ++num) }, + emptySquares = function() { + var arr = []; + for (var i = 0; i < 8; i++) if (rank[i] == undefined) arr.push(i); + return arr; + }; + // place one bishop on any black square + rank[d(2) * 2] = "♗"; + // place the other bishop on any white square + rank[d(2) * 2 + 1] = "♗"; + // place the queen on any empty square + rank[emptySquares()[d(5)]] = "♕"; + // place one knight on any empty square + rank[emptySquares()[d(4)]] = "♘"; + // place the other knight on any empty square + rank[emptySquares()[d(3)]] = "♘"; + // place the rooks and the king on the squares left, king in the middle + for (var x = 1; x <= 3; x++) rank[emptySquares()[0]] = x==2 ? "♔" : "♖"; + return rank; +} + +// test +for (var x = 1; x <= 10; x++) console.log(ch960startPos().join(" | ")); diff --git a/Task/Generate-Chess960-starting-position/Kotlin/generate-chess960-starting-position.kotlin b/Task/Generate-Chess960-starting-position/Kotlin/generate-chess960-starting-position.kotlin new file mode 100644 index 0000000000..00bb41f27b --- /dev/null +++ b/Task/Generate-Chess960-starting-position/Kotlin/generate-chess960-starting-position.kotlin @@ -0,0 +1,26 @@ +object Chess960 : Iterable { + override fun iterator() = patterns.iterator() + + private operator fun invoke(b: String, e: String) { + if (e.length <= 1) { + val s = b + e + if (s.is_valid()) patterns += s + } else + for (i in 0..e.length - 1) + invoke(b + e[i], e.substring(0, i) + e.substring(i + 1)) + } + + private fun String.is_valid(): Boolean { + val k = indexOf('K') + return indexOf('R') < k && k < lastIndexOf('R') && + indexOf('B') % 2 != lastIndexOf('B') % 2 + } + + private val patterns = sortedSetOf() + + init { invoke("", "KQRRNNBB") } +} + +fun main(args: Array) { + Chess960.forEachIndexed { i, s -> println("$i: $s") } +} diff --git a/Task/Generate-Chess960-starting-position/Lua/generate-chess960-starting-position.lua b/Task/Generate-Chess960-starting-position/Lua/generate-chess960-starting-position.lua new file mode 100644 index 0000000000..7c45974de8 --- /dev/null +++ b/Task/Generate-Chess960-starting-position/Lua/generate-chess960-starting-position.lua @@ -0,0 +1,29 @@ +-- Insert 'str' into 't' at a random position from 'left' to 'right' +function randomInsert (t, str, left, right) + local pos + repeat pos = math.random(left, right) until not t[pos] + t[pos] = str + return pos +end + +-- Generate a random Chess960 start position for white major pieces +function chess960 () + local t, b1, b2 = {} + local kingPos = randomInsert(t, "K", 2, 7) + randomInsert(t, "R", 1, kingPos - 1) + randomInsert(t, "R", kingPos + 1, 8) + b1 = randomInsert(t, "B", 1, 8) + b2 = randomInsert(t, "B", 1, 8) + while (b2 - b1) % 2 == 0 do + t[b2] = false + b2 = randomInsert(t, "B", 1, 8) + end + randomInsert(t, "Q", 1, 8) + randomInsert(t, "N", 1, 8) + randomInsert(t, "N", 1, 8) + return t +end + +-- Main procedure +math.randomseed(os.time()) +print(table.concat(chess960())) diff --git a/Task/Generate-Chess960-starting-position/PowerShell/generate-chess960-starting-position.psh b/Task/Generate-Chess960-starting-position/PowerShell/generate-chess960-starting-position.psh new file mode 100644 index 0000000000..eb0d918525 --- /dev/null +++ b/Task/Generate-Chess960-starting-position/PowerShell/generate-chess960-starting-position.psh @@ -0,0 +1,29 @@ +function Get-RandomChess960Start + { + $Starts = @() + + ForEach ( $Q in 0..3 ) { + ForEach ( $N1 in 0..4 ) { + ForEach ( $N2 in ($N1+1)..5 ) { + ForEach ( $B1 in 0..3 ) { + ForEach ( $B2 in 0..3 ) { + $BB = $B1 * 2 + ( $B1 -lt $B2 ) + $BW = $B2 * 2 + $Start = [System.Collections.ArrayList]( '♖', '♔', '♖' ) + $Start.Insert( $Q , '♕' ) + $Start.Insert( $N1, '♘' ) + $Start.Insert( $N2, '♘' ) + $Start.Insert( $BB, '♗' ) + $Start.Insert( $BW, '♗' ) + $Starts += ,$Start + }}}}} + + $Index = Get-Random 960 + $StartString = $Starts[$Index] -join '' + return $StartString + } + +Get-RandomChess960Start +Get-RandomChess960Start +Get-RandomChess960Start +Get-RandomChess960Start diff --git a/Task/Generate-Chess960-starting-position/Rust/generate-chess960-starting-position.rust b/Task/Generate-Chess960-starting-position/Rust/generate-chess960-starting-position.rust new file mode 100644 index 0000000000..48184d756f --- /dev/null +++ b/Task/Generate-Chess960-starting-position/Rust/generate-chess960-starting-position.rust @@ -0,0 +1,37 @@ +use std::collections::BTreeSet; + +struct Chess960 ( BTreeSet ); + +impl Chess960 { + fn invoke(&mut self, b: &str, e: &str) { + if e.len() <= 1 { + let s = b.to_string() + e; + if Chess960::is_valid(&s) { self.0.insert(s); } + } else { + for (i, c) in e.char_indices() { + let mut b = b.to_string(); + b.push(c); + let mut e = e.to_string(); + e.remove(i); + self.invoke(&b, &e); + } + } + } + + fn is_valid(s: &str) -> bool { + let k = s.find('K').unwrap(); + k > s.find('R').unwrap() && k < s.rfind('R').unwrap() && s.find('B').unwrap() % 2 != s.rfind('B').unwrap() % 2 + } +} + +// Program entry point. +fn main() { + let mut chess960 = Chess960(BTreeSet::new()); + chess960.invoke("", "KQRRNNBB"); + + let mut i = 0; + for p in chess960.0 { + println!("{}: {}", i, p); + i += 1; + } +} diff --git a/Task/Generate-Chess960-starting-position/Scala/generate-chess960-starting-position.scala b/Task/Generate-Chess960-starting-position/Scala/generate-chess960-starting-position.scala new file mode 100644 index 0000000000..3f0303e833 --- /dev/null +++ b/Task/Generate-Chess960-starting-position/Scala/generate-chess960-starting-position.scala @@ -0,0 +1,21 @@ +object Chess960 extends App { + private def apply(b: String, e: String) { + if (e.length <= 1) { + val s = b + e + if (is_valid(s)) patterns += s + } else + for (i <- 0 until e.length) + apply(b + e(i), e.substring(0, i) + e.substring(i + 1)) + } + + private def is_valid(s: String) = { + val k = s.indexOf('K') + if (k < s.indexOf('R')) false + else k < s.lastIndexOf('R') && s.indexOf('B') % 2 != s.lastIndexOf('B') % 2 + } + + private val patterns = scala.collection.mutable.SortedSet[String]() + + apply("", "KQRRNNBB") + for ((s, i) <- patterns.zipWithIndex) println(s"$i: $s") +} diff --git a/Task/Generate-lower-case-ASCII-alphabet/00DESCRIPTION b/Task/Generate-lower-case-ASCII-alphabet/00DESCRIPTION index 64226e20b6..4e2791c65d 100644 --- a/Task/Generate-lower-case-ASCII-alphabet/00DESCRIPTION +++ b/Task/Generate-lower-case-ASCII-alphabet/00DESCRIPTION @@ -1,11 +1,6 @@ -Generate an array, list, lazy sequence, or even an indexable string -of all the lower case ASCII characters, from 'a' to 'z'. - -If the standard library contains such sequence, show how to access it, -but don't fail to show how to generate a similar sequence. -For this basic task use a reliable style of coding, a style fit for a very large program, and use strong typing if available. - -It's bug prone to enumerate all the lowercase chars manually in the code. -During code review it's not immediate to spot the bug in a Tcl line like this contained in a page of code: +;Task: +Generate an array, list, lazy sequence, or even an indexable string of all the lower case ASCII characters, from a to z. If the standard library contains such a sequence, show how to access it, but don't fail to show how to generate a similar sequence. +For this basic task use a reliable style of coding, a style fit for a very large program, and use strong typing if available. It's bug prone to enumerate all the lowercase characters manually in the code. During code review it's not immediate obvious to spot the bug in a Tcl line like this contained in a page of code: set alpha {a b c d e f g h i j k m n o p q r s t u v w x y z} +

    diff --git a/Task/Generate-lower-case-ASCII-alphabet/6502-Assembly/generate-lower-case-ascii-alphabet.6502 b/Task/Generate-lower-case-ASCII-alphabet/6502-Assembly/generate-lower-case-ascii-alphabet.6502 new file mode 100644 index 0000000000..adf48202d4 --- /dev/null +++ b/Task/Generate-lower-case-ASCII-alphabet/6502-Assembly/generate-lower-case-ascii-alphabet.6502 @@ -0,0 +1,17 @@ +ASCLOW: PHA ; push contents of registers that we + TXA ; shall be using onto the stack + PHA + LDA #$61 ; ASCII "a" + LDX #$00 +ALLOOP: STA $2000,X + INX + CLC + ADC #$01 + CMP #$7B ; have we got beyond ASCII "z"? + BNE ALLOOP + LDA #$00 ; terminate the string with ASCII NUL + STA $2000,X + PLA ; retrieve register contents from + TAX ; the stack + PLA + RTS ; return diff --git a/Task/Generate-lower-case-ASCII-alphabet/APL/generate-lower-case-ascii-alphabet.apl b/Task/Generate-lower-case-ASCII-alphabet/APL/generate-lower-case-ascii-alphabet.apl new file mode 100644 index 0000000000..98c6192d95 --- /dev/null +++ b/Task/Generate-lower-case-ASCII-alphabet/APL/generate-lower-case-ascii-alphabet.apl @@ -0,0 +1 @@ + ⎕UCS 96+⍳26 diff --git a/Task/Generate-lower-case-ASCII-alphabet/AppleScript/generate-lower-case-ascii-alphabet-1.applescript b/Task/Generate-lower-case-ASCII-alphabet/AppleScript/generate-lower-case-ascii-alphabet-1.applescript new file mode 100644 index 0000000000..2d4f1eb221 --- /dev/null +++ b/Task/Generate-lower-case-ASCII-alphabet/AppleScript/generate-lower-case-ascii-alphabet-1.applescript @@ -0,0 +1,62 @@ +-- showCharRange :: String -> String -> [String] +on showCharRange(strFrom, strTo) + -- showChar :: Int -> String + script showChar + on lambda(intID) + character id intID + end lambda + end script + + map(showChar, range(id of strFrom, id of strTo)) +end showCharRange + + +-- TEST +on run + + {showCharRange("a", "z"), ¬ + showCharRange("🐐", "🐟")} + +end run + + +--------------------------------------------------------------------------- +-- GENERIC FUNCTIONS + +-- 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 + +-- 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 + +-- range :: Int -> Int -> [Int] +on range(m, n) + if n < m then + set d to -1 + else + set d to 1 + end if + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range diff --git a/Task/Generate-lower-case-ASCII-alphabet/AppleScript/generate-lower-case-ascii-alphabet-2.applescript b/Task/Generate-lower-case-ASCII-alphabet/AppleScript/generate-lower-case-ascii-alphabet-2.applescript new file mode 100644 index 0000000000..31d63e6824 --- /dev/null +++ b/Task/Generate-lower-case-ASCII-alphabet/AppleScript/generate-lower-case-ascii-alphabet-2.applescript @@ -0,0 +1,4 @@ +{{"a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", +"n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z"}, +{"🐐", "🐑", "🐒", "🐓", "🐔", "🐕", "🐖", "🐗", +"🐘", "🐙", "🐚", "🐛", "🐜", "🐝", "🐞", "🐟"}} diff --git a/Task/Generate-lower-case-ASCII-alphabet/COBOL/generate-lower-case-ascii-alphabet.cobol b/Task/Generate-lower-case-ASCII-alphabet/COBOL/generate-lower-case-ascii-alphabet.cobol new file mode 100644 index 0000000000..180205bdf1 --- /dev/null +++ b/Task/Generate-lower-case-ASCII-alphabet/COBOL/generate-lower-case-ascii-alphabet.cobol @@ -0,0 +1,17 @@ +identification division. +program-id. lower-case-alphabet-program. +data division. +working-storage section. +01 ascii-lower-case. + 05 lower-case-alphabet pic a(26). + 05 character-code pic 999. + 05 loop-counter pic 99. +procedure division. +control-paragraph. + perform add-next-letter-paragraph varying loop-counter from 1 by 1 + until loop-counter is greater than 26. + display lower-case-alphabet upon console. + stop run. +add-next-letter-paragraph. + add 97 to loop-counter giving character-code. + move function char(character-code) to lower-case-alphabet(loop-counter:1). diff --git a/Task/Generate-lower-case-ASCII-alphabet/Forth/generate-lower-case-ascii-alphabet-1.fth b/Task/Generate-lower-case-ASCII-alphabet/Forth/generate-lower-case-ascii-alphabet-1.fth index 3ebdb9da9d..632dfee978 100644 --- a/Task/Generate-lower-case-ASCII-alphabet/Forth/generate-lower-case-ascii-alphabet-1.fth +++ b/Task/Generate-lower-case-ASCII-alphabet/Forth/generate-lower-case-ascii-alphabet-1.fth @@ -1,24 +1 @@ -\ generate a string filled with the lowercase ASCII alphabet -\ RAW Forth is quite low level. Strings are simply named memory spaces in Forth. -\ Typically they return an address on the Forth Stack (a pointer) with a count value in CHARs -\ These examples use a string with the first byte containing the length of the string - -\ We show 2 ways to load the ASCII values - -create lalpha 27 chars allot \ create a string for 26 letters and count byte - -: ]lalpha ( index -- addr ) \ word to index the string like an array - lalpha char+ + ; - -\ method 1: use a loop -: fillit ( -- ) - 26 0 - do - [char] a I + \ calc. the ASCII value - I ]lalpha c! \ store the char (c!) in the string at I - loop - 26 lalpha c! ; \ store the count byte at the head of the string - - -\ method 2: load with a string literal -: Loadit s" abcdefghijklmnopqrstuvwxyz" lalpha PLACE ; +: printit 26 0 do [char] a I + emit loop ; diff --git a/Task/Generate-lower-case-ASCII-alphabet/Forth/generate-lower-case-ascii-alphabet-2.fth b/Task/Generate-lower-case-ASCII-alphabet/Forth/generate-lower-case-ascii-alphabet-2.fth index 3083e8d3e5..e4bff4a447 100644 --- a/Task/Generate-lower-case-ASCII-alphabet/Forth/generate-lower-case-ascii-alphabet-2.fth +++ b/Task/Generate-lower-case-ASCII-alphabet/Forth/generate-lower-case-ascii-alphabet-2.fth @@ -1,9 +1 @@ -fillit ok - -lalpha count type abcdefghijklmnopqrstuvwxyz ok - -loadit ok - -lalpha count type abcdefghijklmnopqrstuvwxyz ok - - ok +: printit2 [char] z 1+ [char] a do I emit loop ; diff --git a/Task/Generate-lower-case-ASCII-alphabet/Forth/generate-lower-case-ascii-alphabet-3.fth b/Task/Generate-lower-case-ASCII-alphabet/Forth/generate-lower-case-ascii-alphabet-3.fth new file mode 100644 index 0000000000..2b6cf34d23 --- /dev/null +++ b/Task/Generate-lower-case-ASCII-alphabet/Forth/generate-lower-case-ascii-alphabet-3.fth @@ -0,0 +1,17 @@ +create lalpha 27 chars allot \ create a string in memory for 26 letters and count byte + +: ]lalpha ( index -- addr ) \ index the string like an array (return an address) + lalpha char+ + ; + +\ method 1: fill memory with ascii values using a loop +: fillit ( -- ) + 26 0 + do + [char] a I + \ calc. the ASCII value, leave on the stack + I ]lalpha c! \ store the value on stack in the string at index I + loop + 26 lalpha c! ; \ store the count byte at the head of the string + + +\ method 2: load with a string literal +: Loadit s" abcdefghijklmnopqrstuvwxyz" lalpha PLACE ; diff --git a/Task/Generate-lower-case-ASCII-alphabet/Forth/generate-lower-case-ascii-alphabet-4.fth b/Task/Generate-lower-case-ASCII-alphabet/Forth/generate-lower-case-ascii-alphabet-4.fth new file mode 100644 index 0000000000..114c7cf793 --- /dev/null +++ b/Task/Generate-lower-case-ASCII-alphabet/Forth/generate-lower-case-ascii-alphabet-4.fth @@ -0,0 +1,8 @@ +printit abcdefghijklmnopqrstuvwxyz ok + +fillit ok +lalpha count type abcdefghijklmnopqrstuvwxyz ok +lalpha count erase ok +lalpha count type ok +loadit ok +lalpha count type abcdefghijklmnopqrstuvwxyz ok diff --git a/Task/Generate-lower-case-ASCII-alphabet/Icon/generate-lower-case-ascii-alphabet.icon b/Task/Generate-lower-case-ASCII-alphabet/Icon/generate-lower-case-ascii-alphabet-1.icon similarity index 100% rename from Task/Generate-lower-case-ASCII-alphabet/Icon/generate-lower-case-ascii-alphabet.icon rename to Task/Generate-lower-case-ASCII-alphabet/Icon/generate-lower-case-ascii-alphabet-1.icon diff --git a/Task/Generate-lower-case-ASCII-alphabet/Icon/generate-lower-case-ascii-alphabet-2.icon b/Task/Generate-lower-case-ASCII-alphabet/Icon/generate-lower-case-ascii-alphabet-2.icon new file mode 100644 index 0000000000..a03e8634b5 --- /dev/null +++ b/Task/Generate-lower-case-ASCII-alphabet/Icon/generate-lower-case-ascii-alphabet-2.icon @@ -0,0 +1,7 @@ +procedure lower_case_letters() # entry point for function lower_case_letters + return &lcase # returning lower caser letters represented by the set &lcase +end + +procedure main(param) # main procedure as entry point + write(lower_case_letters()) # output of result of function lower_case_letters() +end diff --git a/Task/Generate-lower-case-ASCII-alphabet/JavaScript/generate-lower-case-ascii-alphabet-6.js b/Task/Generate-lower-case-ASCII-alphabet/JavaScript/generate-lower-case-ascii-alphabet-6.js new file mode 100644 index 0000000000..4d194803af --- /dev/null +++ b/Task/Generate-lower-case-ASCII-alphabet/JavaScript/generate-lower-case-ascii-alphabet-6.js @@ -0,0 +1,20 @@ +(lstRanges => { + + // charRange :: Char -> Char -> [Char] + function charRange(cFrom, cTo) { + let [m, n] = [cFrom, cTo] + .map(s => s.codePointAt(0)); + + return Array.from({ + length: (n - m) + 1 + }, (_, i) => String.fromCodePoint(m + i)); + } + + + + // TEST + return lstRanges + .map(([from, to]) => charRange(from, to).join(' ')) + .join('\n') + +})([['a', 'z'], ['א','ת'],['α', 'ω'],['🐐', '🐟']]); diff --git a/Task/Generate-lower-case-ASCII-alphabet/K/generate-lower-case-ascii-alphabet.k b/Task/Generate-lower-case-ASCII-alphabet/K/generate-lower-case-ascii-alphabet.k new file mode 100644 index 0000000000..d76d54dd99 --- /dev/null +++ b/Task/Generate-lower-case-ASCII-alphabet/K/generate-lower-case-ascii-alphabet.k @@ -0,0 +1 @@ +`c$97+!26 diff --git a/Task/Generate-lower-case-ASCII-alphabet/Lua/generate-lower-case-ascii-alphabet.lua b/Task/Generate-lower-case-ASCII-alphabet/Lua/generate-lower-case-ascii-alphabet.lua index 90b770290b..acc7d65f7f 100644 --- a/Task/Generate-lower-case-ASCII-alphabet/Lua/generate-lower-case-ascii-alphabet.lua +++ b/Task/Generate-lower-case-ASCII-alphabet/Lua/generate-lower-case-ascii-alphabet.lua @@ -1,10 +1,8 @@ function getAlphabet () - local letters = {} - for ascii = 97, 122 do - table.insert(letters, string.char(ascii)) - end - return letters + local letters = {} + for ascii = 97, 122 do table.insert(letters, string.char(ascii)) end + return letters end local alpha = getAlphabet() -io.write(alpha[25] .. alpha[1] .. alpha[25] .. "\n") +print(alpha[25] .. alpha[1] .. alpha[25]) diff --git a/Task/Generate-lower-case-ASCII-alphabet/PARI-GP/generate-lower-case-ascii-alphabet.pari b/Task/Generate-lower-case-ASCII-alphabet/PARI-GP/generate-lower-case-ascii-alphabet.pari new file mode 100644 index 0000000000..395c486ed4 --- /dev/null +++ b/Task/Generate-lower-case-ASCII-alphabet/PARI-GP/generate-lower-case-ascii-alphabet.pari @@ -0,0 +1 @@ +Strchr(Vecsmall([97..122])) diff --git a/Task/Generate-lower-case-ASCII-alphabet/PowerShell/generate-lower-case-ascii-alphabet-1.psh b/Task/Generate-lower-case-ASCII-alphabet/PowerShell/generate-lower-case-ascii-alphabet-1.psh new file mode 100644 index 0000000000..7f8377956f --- /dev/null +++ b/Task/Generate-lower-case-ASCII-alphabet/PowerShell/generate-lower-case-ascii-alphabet-1.psh @@ -0,0 +1,2 @@ +$asString = 97..122 | ForEach-Object -Begin {$asArray = @()} -Process {$asArray += [char]$_} -End {$asArray -join('')} +$asString diff --git a/Task/Generate-lower-case-ASCII-alphabet/PowerShell/generate-lower-case-ascii-alphabet-2.psh b/Task/Generate-lower-case-ASCII-alphabet/PowerShell/generate-lower-case-ascii-alphabet-2.psh new file mode 100644 index 0000000000..baa38f5802 --- /dev/null +++ b/Task/Generate-lower-case-ASCII-alphabet/PowerShell/generate-lower-case-ascii-alphabet-2.psh @@ -0,0 +1 @@ +$asArray diff --git a/Task/Generate-lower-case-ASCII-alphabet/REXX/generate-lower-case-ascii-alphabet-2.rexx b/Task/Generate-lower-case-ASCII-alphabet/REXX/generate-lower-case-ascii-alphabet-2.rexx index 8c4db56916..f35dc36006 100644 --- a/Task/Generate-lower-case-ASCII-alphabet/REXX/generate-lower-case-ascii-alphabet-2.rexx +++ b/Task/Generate-lower-case-ASCII-alphabet/REXX/generate-lower-case-ascii-alphabet-2.rexx @@ -1,6 +1,6 @@ -/*REXX pgm creates an indexable string of lowercase ASCII characters a ──► z */ -LC='' /*set lowercase letters list to null*/ - do j=0 for 2**8; _=d2c(j) /*convert decimal J to character. */ - if datatype(_,'L') then LC=LC||_ /*Lowercase? Then add it to LC list*/ - end /*j*/ /* [↑] add lowercase letters ──► LC*/ -say LC /*stick a fork in it, we're all done*/ +/*REXX program creates an indexable string of lowercase ASCII or EBCDIC characters: a─►z*/ +$= /*set lowercase letters list to null. */ + do j=0 for 2**8; _=d2c(j) /*convert decimal J to a character. */ + if datatype(_, 'L') then $=$ || _ /*Is lowercase? Then add it to $ list.*/ + end /*j*/ /* [↑] add lowercase letters ──► $ */ +say $ /*stick a fork in it, we're all done. */ diff --git a/Task/Generate-lower-case-ASCII-alphabet/Rust/generate-lower-case-ascii-alphabet.rust b/Task/Generate-lower-case-ASCII-alphabet/Rust/generate-lower-case-ascii-alphabet.rust new file mode 100644 index 0000000000..d64aac9964 --- /dev/null +++ b/Task/Generate-lower-case-ASCII-alphabet/Rust/generate-lower-case-ascii-alphabet.rust @@ -0,0 +1,6 @@ +fn main() { + // An iterator over the lowercase alpha's + let ascii_iter = (0..26).map(|x| (x + 'a' as u8) as char); + + println!("{:?}", ascii_iter.collect::>()); +} diff --git a/Task/Generate-lower-case-ASCII-alphabet/S-lang/generate-lower-case-ascii-alphabet-1.slang b/Task/Generate-lower-case-ASCII-alphabet/S-lang/generate-lower-case-ascii-alphabet-1.slang new file mode 100644 index 0000000000..34e7f52bf5 --- /dev/null +++ b/Task/Generate-lower-case-ASCII-alphabet/S-lang/generate-lower-case-ascii-alphabet-1.slang @@ -0,0 +1 @@ +variable alpha_ch = ['a':'z'], a; diff --git a/Task/Generate-lower-case-ASCII-alphabet/S-lang/generate-lower-case-ascii-alphabet-2.slang b/Task/Generate-lower-case-ASCII-alphabet/S-lang/generate-lower-case-ascii-alphabet-2.slang new file mode 100644 index 0000000000..88f1ad5808 --- /dev/null +++ b/Task/Generate-lower-case-ASCII-alphabet/S-lang/generate-lower-case-ascii-alphabet-2.slang @@ -0,0 +1 @@ +variable alpha_st = array_map(String_Type, &char, alpha_ch); diff --git a/Task/Generate-lower-case-ASCII-alphabet/S-lang/generate-lower-case-ascii-alphabet-3.slang b/Task/Generate-lower-case-ASCII-alphabet/S-lang/generate-lower-case-ascii-alphabet-3.slang new file mode 100644 index 0000000000..34633b7472 --- /dev/null +++ b/Task/Generate-lower-case-ASCII-alphabet/S-lang/generate-lower-case-ascii-alphabet-3.slang @@ -0,0 +1,3 @@ +print(alpha_st[23]); +foreach a (alpha_ch) + () = printf("%c ", a); diff --git a/Task/Generate-lower-case-ASCII-alphabet/Smalltalk/generate-lower-case-ascii-alphabet.st b/Task/Generate-lower-case-ASCII-alphabet/Smalltalk/generate-lower-case-ascii-alphabet.st new file mode 100644 index 0000000000..61b73f897b --- /dev/null +++ b/Task/Generate-lower-case-ASCII-alphabet/Smalltalk/generate-lower-case-ascii-alphabet.st @@ -0,0 +1,6 @@ +| asciiLower | +asciiLower := String new. +97 to: 122 do: [:asciiCode | + asciiLower := asciiLower , asciiCode asCharacter +]. +^asciiLower diff --git a/Task/Generate-lower-case-ASCII-alphabet/SuperCollider/generate-lower-case-ascii-alphabet-1.supercollider b/Task/Generate-lower-case-ASCII-alphabet/SuperCollider/generate-lower-case-ascii-alphabet-1.supercollider new file mode 100644 index 0000000000..8079b11b2d --- /dev/null +++ b/Task/Generate-lower-case-ASCII-alphabet/SuperCollider/generate-lower-case-ascii-alphabet-1.supercollider @@ -0,0 +1,2 @@ +(97..122).asAscii; +// answers abcdefghijklmnopqrstuvwxyz diff --git a/Task/Generate-lower-case-ASCII-alphabet/SuperCollider/generate-lower-case-ascii-alphabet-2.supercollider b/Task/Generate-lower-case-ASCII-alphabet/SuperCollider/generate-lower-case-ascii-alphabet-2.supercollider new file mode 100644 index 0000000000..720d59c3c3 --- /dev/null +++ b/Task/Generate-lower-case-ASCII-alphabet/SuperCollider/generate-lower-case-ascii-alphabet-2.supercollider @@ -0,0 +1,2 @@ +"abcdefghijklmnopqrstuvwxyz".ascii +// answers [ 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122 ] diff --git a/Task/Generate-lower-case-ASCII-alphabet/ZX-Spectrum-Basic/generate-lower-case-ascii-alphabet.zx b/Task/Generate-lower-case-ASCII-alphabet/ZX-Spectrum-Basic/generate-lower-case-ascii-alphabet.zx new file mode 100644 index 0000000000..dd015336f9 --- /dev/null +++ b/Task/Generate-lower-case-ASCII-alphabet/ZX-Spectrum-Basic/generate-lower-case-ascii-alphabet.zx @@ -0,0 +1,5 @@ +10 DIM l$(26): LET init= CODE "a"-1 +20 FOR i=1 TO 26 +30 LET l$(i)=CHR$ (init+i) +40 NEXT i +50 PRINT l$ diff --git a/Task/Generator-Exponential/Elixir/generator-exponential.elixir b/Task/Generator-Exponential/Elixir/generator-exponential.elixir new file mode 100644 index 0000000000..55739950be --- /dev/null +++ b/Task/Generator-Exponential/Elixir/generator-exponential.elixir @@ -0,0 +1,47 @@ +defmodule Generator do + def filter( source_pid, remove_pid ) do + first_remove = next( remove_pid ) + spawn( fn -> filter_loop(source_pid, remove_pid, first_remove) end ) + end + + def next( pid ) do + send(pid, {:next, self}) + receive do + x -> x + end + end + + def power( m ), do: spawn( fn -> power_loop(m, 0) end ) + + def task do + squares_pid = power( 2 ) + cubes_pid = power( 3 ) + filter_pid = filter( squares_pid, cubes_pid ) + for _x <- 1..20, do: next(filter_pid) + for _x <- 1..10, do: next(filter_pid) + end + + defp filter_loop( pid1, pid2, n2 ) do + receive do + {:next, pid} -> + {n, new_n2} = filter_loop_next( next(pid1), n2, pid1, pid2 ) + send( pid, n ) + filter_loop( pid1, pid2, new_n2 ) + end + end + + defp filter_loop_next( n1, n2, pid1, pid2 ) when n1 > n2, do: + filter_loop_next( n1, next(pid2), pid1, pid2 ) + defp filter_loop_next( n, n, pid1, pid2 ), do: + filter_loop_next( next(pid1), next(pid2), pid1, pid2 ) + defp filter_loop_next( n1, n2, _pid1, _pid2 ), do: {n1, n2} + + defp power_loop( m, n ) do + receive do + {:next, pid} -> send( pid, round(:math.pow(n, m) ) ) + end + power_loop( m, n + 1 ) + end +end + +IO.inspect Generator.task diff --git a/Task/Generator-Exponential/Java/generator-exponential.java b/Task/Generator-Exponential/Java/generator-exponential.java new file mode 100644 index 0000000000..7cb5f7ec6e --- /dev/null +++ b/Task/Generator-Exponential/Java/generator-exponential.java @@ -0,0 +1,53 @@ +import java.util.function.LongSupplier; +import static java.util.stream.LongStream.generate; + +public class GeneratorExponential implements LongSupplier { + private LongSupplier source, filter; + private long s, f; + + public GeneratorExponential(LongSupplier source, LongSupplier filter) { + this.source = source; + this.filter = filter; + f = filter.getAsLong(); + } + + @Override + public long getAsLong() { + s = source.getAsLong(); + + while (s == f) { + s = source.getAsLong(); + f = filter.getAsLong(); + } + + while (s > f) { + f = filter.getAsLong(); + } + + return s; + } + + public static void main(String[] args) { + generate(new GeneratorExponential(new SquaresGen(), new CubesGen())) + .skip(20).limit(10) + .forEach(n -> System.out.printf("%d ", n)); + } +} + +class SquaresGen implements LongSupplier { + private long n; + + @Override + public long getAsLong() { + return n * n++; + } +} + +class CubesGen implements LongSupplier { + private long n; + + @Override + public long getAsLong() { + return n * n * n++; + } +} diff --git a/Task/Generator-Exponential/PHP/generator-exponential.php b/Task/Generator-Exponential/PHP/generator-exponential.php new file mode 100644 index 0000000000..68aa1ef74f --- /dev/null +++ b/Task/Generator-Exponential/PHP/generator-exponential.php @@ -0,0 +1,30 @@ +current(), $s2->current()]; + if ($v > $f) { + $s2->next(); + continue; + } else if ($v < $f) { + yield $v; + } + $s1->next(); + } +} + +list($squares, $cubes) = [powers(2), powers(3)]; +$f = filtered($squares, $cubes); +foreach (range(0, 19) as $i) { + $f->next(); +} +foreach (range(20, 29) as $i) { + echo $i, "\t", $f->current(), "\n"; + $f->next(); +} +?> diff --git a/Task/Generator-Exponential/Perl-6/generator-exponential.pl6 b/Task/Generator-Exponential/Perl-6/generator-exponential.pl6 index ce861d3411..1fba5c9455 100644 --- a/Task/Generator-Exponential/Perl-6/generator-exponential.pl6 +++ b/Task/Generator-Exponential/Perl-6/generator-exponential.pl6 @@ -1,13 +1,13 @@ -sub powers($m) { 0..* X** $m } +sub powers($m) { $m XR** 0..* } my @squares = powers(2); my @cubes = powers(3); -sub infix: (@orig,@veto) { +sub infix: (@orig,@veto) { gather for @veto -> $veto { take @orig.shift while @orig[0] before $veto; @orig.shift if @orig[0] eqv $veto; } } -say (@squares without @cubes)[20 ..^ 20+10].join(', '); +say (@squares with-out @cubes)[20 ..^ 20+10].join(', '); diff --git a/Task/Generator-Exponential/Ruby/generator-exponential-1.rb b/Task/Generator-Exponential/Ruby/generator-exponential-1.rb index e6648d6203..600291fb42 100644 --- a/Task/Generator-Exponential/Ruby/generator-exponential-1.rb +++ b/Task/Generator-Exponential/Ruby/generator-exponential-1.rb @@ -2,9 +2,7 @@ def powers(m) return enum_for(__method__, m) unless block_given? - - n = 0 - loop { yield n ** m; n += 1 } + 0.step{|n| yield n**m} end def squares_without_cubes diff --git a/Task/Generator-Exponential/Ruby/generator-exponential-2.rb b/Task/Generator-Exponential/Ruby/generator-exponential-2.rb index 83340be244..c890fd515f 100644 --- a/Task/Generator-Exponential/Ruby/generator-exponential-2.rb +++ b/Task/Generator-Exponential/Ruby/generator-exponential-2.rb @@ -2,17 +2,15 @@ def powers(m) return enum_for(__method__, m) unless block_given? - - n = 0 - loop { yield n ** m; n += 1 } + 0.step{|n| yield n**m} end def squares_without_cubes return enum_for(__method__) unless block_given? - cubes = powers(3) + cubes = powers(3) #no block, so this is the first generator c = cubes.next - squares = powers(2) + squares = powers(2) # second generator loop do s = squares.next c = cubes.next while c < s @@ -20,6 +18,6 @@ def squares_without_cubes end end -answer = squares_without_cubes +answer = squares_without_cubes # third generator 20.times { answer.next } p 10.times.map { answer.next } diff --git a/Task/Generator-Exponential/SuperCollider/generator-exponential-1.supercollider b/Task/Generator-Exponential/SuperCollider/generator-exponential-1.supercollider new file mode 100644 index 0000000000..8cc8ca51b4 --- /dev/null +++ b/Task/Generator-Exponential/SuperCollider/generator-exponential-1.supercollider @@ -0,0 +1,3 @@ +f = { |m| {:x, x<-(0..) } ** m }; +g = f.(2); +g.nextN(10); // answers [ 0, 1, 4, 9, 16, 25, 36, 49, 64, 81 ] diff --git a/Task/Generator-Exponential/SuperCollider/generator-exponential-2.supercollider b/Task/Generator-Exponential/SuperCollider/generator-exponential-2.supercollider new file mode 100644 index 0000000000..1a4ac9c21b --- /dev/null +++ b/Task/Generator-Exponential/SuperCollider/generator-exponential-2.supercollider @@ -0,0 +1,5 @@ +( +f = Pseries(0, 1) +g = f ** 2; +g.asStream.nextN(10); // answers [ 0, 1, 4, 9, 16, 25, 36, 49, 64, 81 ] +) diff --git a/Task/Generator-Exponential/SuperCollider/generator-exponential-3.supercollider b/Task/Generator-Exponential/SuperCollider/generator-exponential-3.supercollider new file mode 100644 index 0000000000..a9f3a8ebc8 --- /dev/null +++ b/Task/Generator-Exponential/SuperCollider/generator-exponential-3.supercollider @@ -0,0 +1,31 @@ +( +var filter = { |a, b, func| // both streams are assumed to be ordered + Prout { + var astr, bstr; + var aval, bval; + astr = a.asStream; + bstr = b.asStream; + bval = bstr.next; + while { + aval = astr.next; + aval.notNil + } { + while { + bval.notNil and: { bval < aval } + } { + bval = bstr.next; + }; + if(func.value(aval, bval)) { aval.yield }; + } + } +}; +var without = filter.(_, _, { |a, b| a != b }); // partially apply function + +f = Pseries(0, 1); + +g = without.(f ** 2, f ** 3); +h = g.drop(20); +h.asStream.nextN(10); +) + +answers: [ 529, 576, 625, 676, 784, 841, 900, 961, 1024, 1089 ] diff --git a/Task/Generic-swap/00DESCRIPTION b/Task/Generic-swap/00DESCRIPTION index 20bc477450..f7b4dce444 100644 --- a/Task/Generic-swap/00DESCRIPTION +++ b/Task/Generic-swap/00DESCRIPTION @@ -1,4 +1,6 @@ -The task is to write a generic swap function or operator which exchanges the values of two variables (or, more generally, any two storage places that can be assigned), regardless of their types. +;Task: +Write a generic swap function or operator which exchanges the values of two variables (or, more generally, any two storage places that can be assigned), regardless of their types. + If your solution language is statically typed please describe the way your language provides genericity. If variables are typed in the given language, it is permissible that the two variables be constrained to having a mutually compatible type, such that each is permitted to hold the value previously stored in the other without a type violation. @@ -13,3 +15,4 @@ Functional languages, whether static or dynamic, do not necessarily allow a dest Some static languages have difficulties with generic programming due to a lack of support for ([[Parametric Polymorphism]]). Do your best! +

    diff --git a/Task/Generic-swap/360-Assembly/generic-swap.360 b/Task/Generic-swap/360-Assembly/generic-swap.360 new file mode 100644 index 0000000000..68cce00d27 --- /dev/null +++ b/Task/Generic-swap/360-Assembly/generic-swap.360 @@ -0,0 +1,20 @@ +SWAP CSECT , control section start + BAKR 14,0 stack caller's registers + LR 12,15 entry point address to reg.12 + USING SWAP,12 use as base + MVC A,=C'5678____' init field A + MVC B,=C'____1234' init field B + LA 2,L address of length field in reg.2 + WTO TEXT=(2) Write To Operator, results in: +* +5678________1234 + XC A,B XOR A,B + XC B,A XOR B,A + XC A,B XOR A,B. A holds B, B holds A + WTO TEXT=(2) Write To Operator, results in: +* +____12345678____ + PR , return to caller + LTORG , literals displacement +L DC H'16' halfword containg decimal 16 +A DS CL8 field A, 8 bytes +B DS CL8 field B, 8 bytes + END SWAP program end diff --git a/Task/Generic-swap/Ada/generic-swap-1.ada b/Task/Generic-swap/Ada/generic-swap-1.ada index ab53b47489..d92c26c341 100644 --- a/Task/Generic-swap/Ada/generic-swap-1.ada +++ b/Task/Generic-swap/Ada/generic-swap-1.ada @@ -1,9 +1,9 @@ generic type Swap_Type is private; -- Generic parameter -procedure Generic_Swap(Left : in out Swap_Type; Right : in out Swap_Type); +procedure Generic_Swap (Left, Right : in out Swap_Type); -procedure Generic_Swap(Left : in out Swap_Type; Right : in out Swap_Type) is - Temp : Swap_Type := Left; +procedure Generic_Swap (Left, Right : in out Swap_Type) is + Temp : constant Swap_Type := Left; begin Left := Right; Right := Temp; diff --git a/Task/Generic-swap/Ada/generic-swap-2.ada b/Task/Generic-swap/Ada/generic-swap-2.ada index dbd56a4d7f..1bf43f2a68 100644 --- a/Task/Generic-swap/Ada/generic-swap-2.ada +++ b/Task/Generic-swap/Ada/generic-swap-2.ada @@ -1,7 +1,7 @@ with Generic_Swap; ... type T is ... -package T_Swap is new Generic_Swap(Swap_Type => T); -A,B:T; +procedure T_Swap is new Generic_Swap (Swap_Type => T); +A, B : T; ... -T_Swap(A,B); +T_Swap (A, B); diff --git a/Task/Generic-swap/PL-I/generic-swap-1.pli b/Task/Generic-swap/PL-I/generic-swap-1.pli index c9bcc17c1c..98f5117903 100644 --- a/Task/Generic-swap/PL-I/generic-swap-1.pli +++ b/Task/Generic-swap/PL-I/generic-swap-1.pli @@ -3,9 +3,3 @@ return ( 't=' || a || ';' || a || '=' || b || ';' || b '=t;' ); %end swap; %activate swap; - -The statement:- - swap (p, q); - -is replaced, at compile time, by the three statements: - t = p; p = q; q = t; diff --git a/Task/Generic-swap/PL-I/generic-swap-5.pli b/Task/Generic-swap/PL-I/generic-swap-5.pli new file mode 100644 index 0000000000..6e7bc420d4 --- /dev/null +++ b/Task/Generic-swap/PL-I/generic-swap-5.pli @@ -0,0 +1,4 @@ +%Swap:Procedure(a,b); + declare (a,b) character; /*These are proper strings of arbitrary length, pre-processor only.*/ + return ('Begin; declare t like '|| a ||'; t='|| a ||';'|| a ||'='|| b ||';'|| b ||'=t; End;'); +%End Swap; diff --git a/Task/Generic-swap/PL-I/generic-swap-6.pli b/Task/Generic-swap/PL-I/generic-swap-6.pli new file mode 100644 index 0000000000..a61a06dbd7 --- /dev/null +++ b/Task/Generic-swap/PL-I/generic-swap-6.pli @@ -0,0 +1,6 @@ +Begin; + declare t like this; + t = this; + this = that; + that = t; +End; diff --git a/Task/Generic-swap/TXR/generic-swap-1.txr b/Task/Generic-swap/TXR/generic-swap-1.txr new file mode 100644 index 0000000000..84af2a521c --- /dev/null +++ b/Task/Generic-swap/TXR/generic-swap-1.txr @@ -0,0 +1,5 @@ +(defmacro swp (left right) + (with-gensyms (tmp) + ^(let ((,tmp ,left)) + (set ,left ,right + ,right ,tmp)))) diff --git a/Task/Generic-swap/TXR/generic-swap-2.txr b/Task/Generic-swap/TXR/generic-swap-2.txr new file mode 100644 index 0000000000..d9d7f86151 --- /dev/null +++ b/Task/Generic-swap/TXR/generic-swap-2.txr @@ -0,0 +1,7 @@ +(defmacro swp (left right) + (with-gensyms (tmp lpl rpl) + ^(placelet ((,lpl ,left) + (,rpl ,right)) + (let ((,tmp ,lpl)) + (set ,lpl ,rpl + ,rpl ,tmp))))) diff --git a/Task/Generic-swap/TXR/generic-swap-3.txr b/Task/Generic-swap/TXR/generic-swap-3.txr new file mode 100644 index 0000000000..25e34f3f43 --- /dev/null +++ b/Task/Generic-swap/TXR/generic-swap-3.txr @@ -0,0 +1,7 @@ +(defmacro swp (left right :env env) + (with-gensyms (tmp) + (with-update-expander (l-getter l-setter) left env + (with-update-expander (r-getter r-setter) right env + ^(let ((,tmp (,l-getter))) + (,l-setter (,r-getter)) + (,r-setter ,tmp)))))) diff --git a/Task/Globally-replace-text-in-several-files/00DESCRIPTION b/Task/Globally-replace-text-in-several-files/00DESCRIPTION index e386c7cb60..ed479e3ec6 100644 --- a/Task/Globally-replace-text-in-several-files/00DESCRIPTION +++ b/Task/Globally-replace-text-in-several-files/00DESCRIPTION @@ -1 +1,6 @@ -The task is to replace every occurring instance of a piece of text in a group of text files with another one. For this task we want to replace the text "Goodbye London!" with "Hello New York!" for a list of files. +;Task: +Replace every occurring instance of a piece of text in a group of text files with another one. + + +For this task we want to replace the text   "'''Goodbye London!'''"   with   "'''Hello New York!'''"   for a list of files. +

    diff --git a/Task/Globally-replace-text-in-several-files/AWK/globally-replace-text-in-several-files.awk b/Task/Globally-replace-text-in-several-files/AWK/globally-replace-text-in-several-files-1.awk similarity index 100% rename from Task/Globally-replace-text-in-several-files/AWK/globally-replace-text-in-several-files.awk rename to Task/Globally-replace-text-in-several-files/AWK/globally-replace-text-in-several-files-1.awk diff --git a/Task/Globally-replace-text-in-several-files/AWK/globally-replace-text-in-several-files-2.awk b/Task/Globally-replace-text-in-several-files/AWK/globally-replace-text-in-several-files-2.awk new file mode 100644 index 0000000000..404d1d5e81 --- /dev/null +++ b/Task/Globally-replace-text-in-several-files/AWK/globally-replace-text-in-several-files-2.awk @@ -0,0 +1,5 @@ +@include "readfile" +BEGIN { + while(++i < ARGC) + print gensub("Goodbye London!","Hello New York!","g", readfile(ARGV[i])) > ARGV[i] +} diff --git a/Task/Globally-replace-text-in-several-files/C++/globally-replace-text-in-several-files.cpp b/Task/Globally-replace-text-in-several-files/C++/globally-replace-text-in-several-files-1.cpp similarity index 100% rename from Task/Globally-replace-text-in-several-files/C++/globally-replace-text-in-several-files.cpp rename to Task/Globally-replace-text-in-several-files/C++/globally-replace-text-in-several-files-1.cpp diff --git a/Task/Globally-replace-text-in-several-files/C++/globally-replace-text-in-several-files-2.cpp b/Task/Globally-replace-text-in-several-files/C++/globally-replace-text-in-several-files-2.cpp new file mode 100644 index 0000000000..ec1ec290a7 --- /dev/null +++ b/Task/Globally-replace-text-in-several-files/C++/globally-replace-text-in-several-files-2.cpp @@ -0,0 +1,18 @@ +#include +#include + +using namespace std; +using ist = istreambuf_iterator; +using ost = ostreambuf_iterator; + +int main(){ + auto from = "Goodbye London!", to = "Hello New York!"; + for(auto filename : {"a.txt", "b.txt", "c.txt"}) { + ifstream infile {filename}; + string content {ist {infile}, ist{}}; + infile.close(); + ofstream outfile {filename}; + regex_replace(ost {outfile}, begin(content), end(content), regex {from}, to); + } + return 0; +} diff --git a/Task/Globally-replace-text-in-several-files/Fortran/globally-replace-text-in-several-files.f b/Task/Globally-replace-text-in-several-files/Fortran/globally-replace-text-in-several-files.f new file mode 100644 index 0000000000..1fdfda35af --- /dev/null +++ b/Task/Globally-replace-text-in-several-files/Fortran/globally-replace-text-in-several-files.f @@ -0,0 +1,65 @@ + SUBROUTINE FILEHACK(FNAME,THIS,THAT) !Attacks a file! + CHARACTER*(*) FNAME !The name of the file, presumed to contain text. + CHARACTER*(*) THIS !The text sought in each record. + CHARACTER*(*) THAT !Its replacement, should it be found. + INTEGER F,T !Mnemonics for file unit numbers. + PARAMETER (F=66,T=67) !These should do. + INTEGER L !A length + CHARACTER*6666 ALINE !Surely sufficient? + LOGICAL AHIT !Could count them, but no report is called for. + INQUIRE(FILE = FNAME, EXIST = AHIT) !This mishap is frequent, so attend to it. + IF (.NOT.AHIT) RETURN !Nothing can be done! + OPEN (F,FILE=FNAME,STATUS="OLD",ACTION="READWRITE") !Grab the source file. + OPEN (T,STATUS="SCRATCH") !Request a temporary file. + AHIT = .FALSE. !None found so far. +Chew through the input, replacing THIS by THAT while writing to the temporary file.. + 10 READ (F,11,END = 20) L,ALINE(1:MIN(L,LEN(ALINE))) !Grab a record. + IF (L.GT.LEN(ALINE)) STOP "Monster record!" !Perhaps unmanageable. + 11 FORMAT (Q,A) !Obviously, Q = length of characters unread in the record. + L1 = 1 !Start at the start. + 12 L2 = INDEX(ALINE(L1:L),THIS) !Look from L1 onwards. + IF (L2.LE.0) THEN !A hit? + WRITE (T,13) ALINE(L1:L) !No. Finish with the remainder of the line. + 13 FORMAT (A) !Thus finishing the output line. + GO TO 10 !And try for the next record. + END IF !So much for not finding THIS. + 14 L2 = L1 + L2 - 2 !Otherwise, THIS is found, starting at L1. + WRITE (T,15) ALINE(L1:L2) !So roll the text up to the match, possibly none. + 15 FORMAT (A,$) !But not ending the record. + WRITE (T,15) THAT !Because THIS is replaced by THAT. + AHIT = .TRUE. !And we've found at least one match. + L1 = L2 + LEN(THIS) + 1 !Finger the first character beyond the matching THIS. + IF (L - L1 + 1 .GE. LEN(THIS)) GO TO 12 !Might another search succeed? + WRITE (T,13) ALINE(L1:L) !Nope. Finish the line with the tail end. + GO TO 10 !And try for another record. +Copy the temporary file back over the source file. Hope for no mishap and data loss! + 20 IF (AHIT) THEN !If there were no hits, there is nothing to do. + CLOSE (F) !Oh well. + REWIND T !Go back to the start. + OPEN (F,FILE="new"//FNAME,STATUS = "REPLACE",ACTION = "WRITE") !Overwrite... + 21 READ (T,11,END = 22) L,ALINE(1:MIN(L,LEN(ALINE))) !Grab a line. + IF (L.GT.LEN(ALINE)) STOP "Monster changed record!" !Once you start checking... + WRITE (F,13) ALINE(1:L) !In case LEN(THAT) > LEN(THIS) + GO TO 21 !Go grab the next line. + END IF !So much for the replacement of the file. + 22 CLOSE(T) !Finished: it will vanish. + CLOSE(F) !Hopefully, the buffers will be written. + END !So much for that. + + PROGRAM ATTACK + INTEGER N + PARAMETER (N = 6) !More than one, anyway. + CHARACTER*48 VICTIM(N) !Alternatively, the file names could be read from a file + DATA VICTIM/ !Along with the target and replacement texts in each case. + 1 "StaffStory.txt", + 2 "Accounts.dat", + 3 "TravelAgent.txt", + 4 "RemovalFirm.dat", + 5 "Addresses.txt", + 6 "SongLyrics.txt"/ !Invention flags. + + DO I = 1,N !So, step through the list. + CALL FILEHACK(VICTIM(I),"Goodbye London!","Hello New York!") !One by one. + END DO !On to the next. + + END diff --git a/Task/Globally-replace-text-in-several-files/PowerShell/globally-replace-text-in-several-files.psh b/Task/Globally-replace-text-in-several-files/PowerShell/globally-replace-text-in-several-files.psh new file mode 100644 index 0000000000..13665aadbe --- /dev/null +++ b/Task/Globally-replace-text-in-several-files/PowerShell/globally-replace-text-in-several-files.psh @@ -0,0 +1,6 @@ +$listfiles = @('file1.txt','file2.txt') +$old = 'Goodbye London!' +$new = 'Hello New York!' +foreach($file in $listfiles) { + (Get-Content $file).Replace($old,$new) | Set-Content $file +} diff --git a/Task/Globally-replace-text-in-several-files/REXX/globally-replace-text-in-several-files-1.rexx b/Task/Globally-replace-text-in-several-files/REXX/globally-replace-text-in-several-files-1.rexx index 927d3ee7e2..3168aa8417 100644 --- a/Task/Globally-replace-text-in-several-files/REXX/globally-replace-text-in-several-files-1.rexx +++ b/Task/Globally-replace-text-in-several-files/REXX/globally-replace-text-in-several-files-1.rexx @@ -1,28 +1,27 @@ -/*REXX program to read the files specified and globally replace a string*/ -old = 'Goodbye London!' /*old text to be replaced. */ -new = 'Hello New York!' /*new text used for replacement. */ -parse arg fileList; files=words(fileList); pad=left('',20) - hdr='────── file' /*eyecatcher.*/ - do f=1 for files; aFile=translate(word(fileList,f),,','); say; say - say hdr' is being read: ' aFile pad "("f 'out of' files "files)." - call linein aFile,1,0 /*position the file for input. */ - changes=0 /*# changes in the file (so far).*/ +/*REXX program reads the files specified and globally replaces a string. */ +old= "Goodbye London!" /*the old text to be replaced. */ +new= "Hello New York!" /* " new " used for replacement. */ +parse arg fileList /*obtain required list of files from CL*/ +files=words(fileList) /*the number of files in the file list.*/ - do j=1 while lines(aFile)\==0 /*read a file (if it exists). */ - @.j = linein(aFile) /*read a record from the file. */ - if pos(old,@.j)==0 then iterate /*Anything to change? No, skip.*/ - changes = changes+1 /*bump the change counter. */ - @.j = changestr(old,@.j,new) /*change this record, old ──► new*/ - end /*j*/ + do f=1 for files; fn=translate(word(fileList,f),,','); say; say + say '──────── file is being read: ' fn " ("f 'out of' files "files)." + call linein fn,1,0 /*position the file for input. */ + changes=0 /*the number of changes in file so far.*/ + do rec=0 while lines(fn)\==0 /*read a file (if it exists). */ + @.rec=linein(fn) /*read a record (line) from the file. */ + if pos(old, @.rec)==0 then iterate /*Anything to change? No, then skip. */ + changes=changes + 1 /*flag that file contents have changed.*/ + @.rec=changestr(old, @.rec, new) /*change the @.rec record, old ──► new.*/ + end /*rec*/ - say hdr ' was read: ' aFile", with " j-1 'records.' - if changes == 0 then do - say hdr ' not changed: ' aFile - iterate /*f*/ - end - call lineout aFile,,1 /*position the file for output. */ - say hdr 'being changed: ' aFile - do r=1 for j-1; call lineout aFile,@.r; end /*re-write file.*/ - say hdr 'was changed: ' aFile " with" changes 'lines changed.' - end /*f*/ - /*stick a fork in it, we're done.*/ + say '──────── file has been read: ' fn", with " rec 'records.' + if changes==0 then do; say '──────── file not changed: ' fn; iterate; end + call lineout fn,,1 /*position file for output at 1st line.*/ + say '──────── file being changed: ' fn + + do r=0 for rec; call lineout fn, @.r /*re─write the contents of the file. */ + end /*r*/ + + say '──────── file was changed: ' fn " with" changes 'lines changed.' + end /*f*/ /*stick a fork in it, we're all done. */ diff --git a/Task/Gray-code/Forth/gray-code.fth b/Task/Gray-code/Forth/gray-code.fth index 7425be01a6..b268181f37 100644 --- a/Task/Gray-code/Forth/gray-code.fth +++ b/Task/Gray-code/Forth/gray-code.fth @@ -1,21 +1,21 @@ -: >gray ( n -- n ) dup 2/ xor ; - +: >gray ( n -- n' ) dup 2/ xor ; \ n' = n xor (n logically right shifted 1 time) + \ 2/ is Forth divide by 2, ie: shift right 1 : gray> ( n -- n ) - 0 1 31 lshift ( g b mask ) + 0 1 31 lshift ( -- g b mask ) begin - >r + >r \ save a copy of mask on return stack 2dup 2/ xor r@ and or - r> 1 rshift - dup 0= + r> 1 rshift + dup 0= until - drop nip ; + drop nip ; \ clean the parameter stack leaving result only : test - 2 base ! + 2 base ! \ set system number base to 2. ie: Binary 32 0 do - cr i dup 5 .r ." ==> " + cr I dup 5 .r ." ==> " \ print numbers (binary) right justified 5 places >gray dup 5 .r ." ==> " gray> 5 .r loop - decimal ; + decimal ; \ revert to BASE 10 diff --git a/Task/Grayscale-image/00DESCRIPTION b/Task/Grayscale-image/00DESCRIPTION index f9585e1bc6..9e1131e988 100644 --- a/Task/Grayscale-image/00DESCRIPTION +++ b/Task/Grayscale-image/00DESCRIPTION @@ -1,5 +1,14 @@ -Many image processing algorithms are defined for [[wp:Grayscale|grayscale]] (or else monochromatic) images. Extend the data storage type defined [[Basic_bitmap_storage|on this page]] to support grayscale images. Define two operations, one to convert a color image to a grayscale image and one for the backward conversion. To get luminance of a color use the formula recommended by [http://www.cie.co.at/index_ie.html CIE]: +Many image processing algorithms are defined for [[wp:Grayscale|grayscale]] (or else monochromatic) images. -L = 0.2126·R + 0.7152·G + 0.0722·B + +;Task: +Extend the data storage type defined [[Basic_bitmap_storage|on this page]] to support grayscale images. + +Define two operations, one to convert a color image to a grayscale image and one for the backward conversion. + +To get luminance of a color use the formula recommended by [http://www.cie.co.at/index_ie.html CIE]: + + L = 0.2126 × R + 0.7152 × G + 0.0722 × B When using floating-point arithmetic make sure that rounding errors would not cause run-time problems or else distorted results when calculated luminance is stored as an unsigned integer. +

    diff --git a/Task/Grayscale-image/Perl-6/grayscale-image.pl6 b/Task/Grayscale-image/Perl-6/grayscale-image.pl6 index 4f149b2e6f..36159bf319 100644 --- a/Task/Grayscale-image/Perl-6/grayscale-image.pl6 +++ b/Task/Grayscale-image/Perl-6/grayscale-image.pl6 @@ -9,7 +9,7 @@ sub MAIN ($filename = 'default.ppm') { $out.say("P5\n$dim\n$depth"); - for $in.slurp.ords -> $r, $g, $b { + for $in.lines.ords -> $r, $g, $b { my $gs = $r * 0.2126 + $g * 0.7152 + $b * 0.0722; $out.print: chr($gs min 255); } diff --git a/Task/Grayscale-image/PureBasic/grayscale-image.purebasic b/Task/Grayscale-image/PureBasic/grayscale-image.purebasic index 06b886247d..26d8265a99 100644 --- a/Task/Grayscale-image/PureBasic/grayscale-image.purebasic +++ b/Task/Grayscale-image/PureBasic/grayscale-image.purebasic @@ -1,15 +1,34 @@ Procedure ImageGrayout(image) + Protected w, h, x, y, r, g, b, gray, color + w = ImageWidth(image) h = ImageHeight(image) StartDrawing(ImageOutput(image)) For x = 0 To w - 1 For y = 0 To h - 1 color = Point(x, y) - r = color & $ff - g = color >> 8 & $ff - b = color >> 16 & $ff + r = Red(color) + g = Green(color) + b = Blue(color) gray = 0.2126*r + 0.7152*g + 0.0722*b - Plot(x, y, gray + gray << 8 + gray << 16) + Plot(x, y, RGB(gray, gray, gray) + Next + Next + StopDrawing() +EndProcedure + +Procedure ImageToColor(image) + Protected w, h, x, y, v, gray + + w = ImageWidth(image) + h = ImageHeight(image) + StartDrawing(ImageOutput(image)) + For x = 0 To w - 1 + For y = 0 To h - 1 + gray = Point(x, y) + v = Red(gray) ;for gray, each of the color's components is the same + ;color = RGB(0.2126*v, 0.7152*v, 0.0722*v) + Plot(x, y, RGB(v, v, v)) Next Next StopDrawing() diff --git a/Task/Grayscale-image/REXX/grayscale-image-1.rexx b/Task/Grayscale-image/REXX/grayscale-image-1.rexx new file mode 100644 index 0000000000..9da1802395 --- /dev/null +++ b/Task/Grayscale-image/REXX/grayscale-image-1.rexx @@ -0,0 +1,15 @@ +/*REXX program converts a RGB (red─green─blue) image to a grayscale image. */ + blue= '00 00 ff'x /*define the blue color (hexadecimal).*/ + @.= blue /*set the entire image to blue color.*/ + width= 60 /* width of the image (in pixels). */ +height= 100 /*height " " " " " */ + + do col=1 for width + do row=1 for height /* [↓] C2D convert char ───> decimal*/ + r= left(@.col.row, 1) ; r=c2d(r) /*extract the component red & convert.*/ + g=substr(@.col.row, 2, 1) ; g=c2d(g) /* " " " green " " */ + b= right(@.col.row, 1) ; b=c2d(b) /* " " " blue " " */ + @.col.row=d2c((.2126*r+.7152*g +.0722*b)%1) /*convert RGB number ───► grayscale. */ + end /*row*/ /* [↑] D2C convert decimal ───> char*/ + end /*col*/ /* [↑] x%1 is the same as TRUNC(x) */ + /*stick a fork in it, we're all done. */ diff --git a/Task/Grayscale-image/REXX/grayscale-image-2.rexx b/Task/Grayscale-image/REXX/grayscale-image-2.rexx new file mode 100644 index 0000000000..e52429a3c3 --- /dev/null +++ b/Task/Grayscale-image/REXX/grayscale-image-2.rexx @@ -0,0 +1,14 @@ + blue= "00 00 ff"x /*define the blue color (hexadecimal).*/ + blue= '00 00 ff'x /*define the blue color (hexadecimal).*/ + blue= '0000ff'x /*define the blue color (hexadecimal).*/ + + blue= '00000000 00000000 11111111'b /*define the blue color (binary). */ + blue= '000000000000000011111111'b /*define the blue color (binary) */ + + blue= 'zzy' /*define the blue color (character). */ + /*not recommended because of rendering.*/ + /*where Z is the character '00'x */ + /*where Y is the character 'ff'x */ + + /*Both Z & Y are normally not viewable*/ + /*on most terminals (appear as blanks).*/ diff --git a/Task/Grayscale-image/REXX/grayscale-image.rexx b/Task/Grayscale-image/REXX/grayscale-image.rexx deleted file mode 100644 index afbe8ea833..0000000000 --- a/Task/Grayscale-image/REXX/grayscale-image.rexx +++ /dev/null @@ -1,16 +0,0 @@ -/*REXX program to convert a RGB image to grayscale. */ -blue='00 00 ff'x /*define the blue color. */ -image.=blue /*set the entire IMAGE to blue. */ - width= 60 /* width of the IMAGE. */ -height=100 /*height " " " */ - - do j=1 for width - do k=1 for height - r= left(image.j.k,1) ; r=c2d(r) /*extract red & convert*/ - g=substr(image.j.k,2,1) ; g=c2d(g) /* " green " " */ - b= right(image.j.k,1) ; b=c2d(b) /* " blue " " */ - ddd=right(trunc(.2126*r + .7152*g + .0722*b),3,0) /*──► greyscale.*/ - image.j.k=right(d2c(ddd,6),3,0) /*... and transform back.*/ - end /*j*/ - end /*k*/ - /*stick a fork in it, we're done.*/ diff --git a/Task/Greatest-common-divisor/00DESCRIPTION b/Task/Greatest-common-divisor/00DESCRIPTION index eaac028def..c74bf83660 100644 --- a/Task/Greatest-common-divisor/00DESCRIPTION +++ b/Task/Greatest-common-divisor/00DESCRIPTION @@ -1 +1,3 @@ -This task requires the finding of the greatest common divisor of two integers. +;Task: +Find the greatest common divisor of two integers. +

    diff --git a/Task/Greatest-common-divisor/360-Assembly/greatest-common-divisor.360 b/Task/Greatest-common-divisor/360-Assembly/greatest-common-divisor.360 new file mode 100644 index 0000000000..1e03804413 --- /dev/null +++ b/Task/Greatest-common-divisor/360-Assembly/greatest-common-divisor.360 @@ -0,0 +1,32 @@ +* Greatest common divisor 04/05/2016 +GCD CSECT + USING GCD,R15 use calling register + L R6,A u=a + L R7,B v=b +LOOPW LTR R7,R7 while v<>0 + BZ ELOOPW leave while + LR R8,R6 t=u + LR R6,R7 u=v + LR R4,R8 t + SRDA R4,32 shift to next reg + DR R4,R7 t/v + LR R7,R4 v=mod(t,v) + B LOOPW end while +ELOOPW LPR R9,R6 c=abs(u) + L R1,A a + XDECO R1,XDEC edit a + MVC PG+4(5),XDEC+7 move a to buffer + L R1,B b + XDECO R1,XDEC edit b + MVC PG+10(5),XDEC+7 move b to buffer + XDECO R9,XDEC edit c + MVC PG+17(5),XDEC+7 move c to buffer + XPRNT PG,80 print buffer + XR R15,R15 return code =0 + BR R14 return to caller +A DC F'1071' a +B DC F'1029' b +PG DC CL80'gcd(00000,00000)=00000' buffer +XDEC DS CL12 temp for edit + YREGS + END GCD diff --git a/Task/Greatest-common-divisor/AutoHotkey/greatest-common-divisor-2.ahk b/Task/Greatest-common-divisor/AutoHotkey/greatest-common-divisor-2.ahk index df30e5ad45..9ccc0b35e3 100644 --- a/Task/Greatest-common-divisor/AutoHotkey/greatest-common-divisor-2.ahk +++ b/Task/Greatest-common-divisor/AutoHotkey/greatest-common-divisor-2.ahk @@ -1,5 +1,5 @@ -gcd(a, b) { +GCD(a, b) { while b - t := b, b := Mod(a, b), a := t - return, a + b := Mod(a | 0x0, a := b) + return a } diff --git a/Task/Greatest-common-divisor/C/greatest-common-divisor-1.c b/Task/Greatest-common-divisor/C/greatest-common-divisor-1.c index 496c80c421..315c11e819 100644 --- a/Task/Greatest-common-divisor/C/greatest-common-divisor-1.c +++ b/Task/Greatest-common-divisor/C/greatest-common-divisor-1.c @@ -1,10 +1,7 @@ int gcd_iter(int u, int v) { - int t; - while (v) { - t = u; - u = v; - v = t % v; - } - return u < 0 ? -u : u; /* abs(u) */ + if (u < 0) u = -u; + if (v < 0) v = -v; + if (v) while ((u %= v) && (v %= u)); + return (u + v); } diff --git a/Task/Greatest-common-divisor/Clojure/greatest-common-divisor.clj b/Task/Greatest-common-divisor/Clojure/greatest-common-divisor-1.clj similarity index 100% rename from Task/Greatest-common-divisor/Clojure/greatest-common-divisor.clj rename to Task/Greatest-common-divisor/Clojure/greatest-common-divisor-1.clj diff --git a/Task/Greatest-common-divisor/Clojure/greatest-common-divisor-2.clj b/Task/Greatest-common-divisor/Clojure/greatest-common-divisor-2.clj new file mode 100644 index 0000000000..5bed420587 --- /dev/null +++ b/Task/Greatest-common-divisor/Clojure/greatest-common-divisor-2.clj @@ -0,0 +1,5 @@ +(defn gcd* + "greatest common divisor of a list of numbers" + [& lst] + (reduce gcd + lst)) diff --git a/Task/Greatest-common-divisor/Frege/greatest-common-divisor.frege b/Task/Greatest-common-divisor/Frege/greatest-common-divisor.frege new file mode 100644 index 0000000000..883f57ae57 --- /dev/null +++ b/Task/Greatest-common-divisor/Frege/greatest-common-divisor.frege @@ -0,0 +1,10 @@ +module gcd.GCD where + +pure native parseInt java.lang.Integer.parseInt :: String -> Int + +gcd' a 0 = a +gcd' a b = gcd' b (a `mod` b) + +main args = do + (a:b:_) = args + println $ gcd' (parseInt a) (parseInt b) diff --git a/Task/Greatest-common-divisor/Go/greatest-common-divisor-1.go b/Task/Greatest-common-divisor/Go/greatest-common-divisor-1.go index b8f3f6ad9f..d8130ff77d 100644 --- a/Task/Greatest-common-divisor/Go/greatest-common-divisor-1.go +++ b/Task/Greatest-common-divisor/Go/greatest-common-divisor-1.go @@ -2,14 +2,41 @@ package main import "fmt" -func gcd(x, y int) int { - for y != 0 { - x, y = y, x%y +func gcd(a, b int) int { + var bgcd func(a, b, res int) int + + bgcd = func(a, b, res int) int { + switch { + case a == b: + return res * a + case a % 2 == 0 && b % 2 == 0: + return bgcd(a/2, b/2, 2*res) + case a % 2 == 0: + return bgcd(a/2, b, res) + case b % 2 == 0: + return bgcd(a, b/2, res) + case a > b: + return bgcd(a-b, b, res) + default: + return bgcd(a, b-a, res) + } } - return x + + return bgcd(a, b, 1) } func main() { - fmt.Println(gcd(33, 77)) - fmt.Println(gcd(49865, 69811)) + type pair struct { + a int + b int + } + + var testdata []pair = []pair{ + pair{33, 77}, + pair{49865, 69811}, + } + + for _, v := range testdata { + fmt.Printf("gcd(%d, %d) = %d\n", v.a, v.b, gcd(v.a, v.b)) + } } diff --git a/Task/Greatest-common-divisor/Go/greatest-common-divisor-2.go b/Task/Greatest-common-divisor/Go/greatest-common-divisor-2.go index e62de01eb0..b8f3f6ad9f 100644 --- a/Task/Greatest-common-divisor/Go/greatest-common-divisor-2.go +++ b/Task/Greatest-common-divisor/Go/greatest-common-divisor-2.go @@ -1,12 +1,12 @@ package main -import ( - "fmt" - "math/big" -) +import "fmt" -func gcd(x, y int64) int64 { - return new(big.Int).GCD(nil, nil, big.NewInt(x), big.NewInt(y)).Int64() +func gcd(x, y int) int { + for y != 0 { + x, y = y, x%y + } + return x } func main() { diff --git a/Task/Greatest-common-divisor/Go/greatest-common-divisor-3.go b/Task/Greatest-common-divisor/Go/greatest-common-divisor-3.go new file mode 100644 index 0000000000..e62de01eb0 --- /dev/null +++ b/Task/Greatest-common-divisor/Go/greatest-common-divisor-3.go @@ -0,0 +1,15 @@ +package main + +import ( + "fmt" + "math/big" +) + +func gcd(x, y int64) int64 { + return new(big.Int).GCD(nil, nil, big.NewInt(x), big.NewInt(y)).Int64() +} + +func main() { + fmt.Println(gcd(33, 77)) + fmt.Println(gcd(49865, 69811)) +} diff --git a/Task/Greatest-common-divisor/Java/greatest-common-divisor-1.java b/Task/Greatest-common-divisor/Java/greatest-common-divisor-1.java index a0f3314018..385d52e19b 100644 --- a/Task/Greatest-common-divisor/Java/greatest-common-divisor-1.java +++ b/Task/Greatest-common-divisor/Java/greatest-common-divisor-1.java @@ -1,5 +1,5 @@ public static long gcd(long a, long b){ - long factor= Math.max(a, b); + long factor= Math.min(a, b); for(long loop= factor;loop > 1;loop--){ if(a % loop == 0 && b % loop == 0){ return loop; diff --git a/Task/Greatest-common-divisor/Java/greatest-common-divisor-3.java b/Task/Greatest-common-divisor/Java/greatest-common-divisor-3.java index a6fa55f613..e2c3d99fda 100644 --- a/Task/Greatest-common-divisor/Java/greatest-common-divisor-3.java +++ b/Task/Greatest-common-divisor/Java/greatest-common-divisor-3.java @@ -2,7 +2,7 @@ static int gcd(int a,int b) { int min=a>b?b:a,max=a+b-min, div=min; for(int i=1;i b then + -1 + else + 0 + end if +end wordAZ + +on wordZA(a, b) + if a < b then + -1 + else if a > b then + 1 + else + 0 + end if +end wordZA + +on wordLong(a, b) + (length of a) - (length of b) +end wordLong + +on wordShort(a, b) + (length of b) - (length of a) +end wordShort + +on cityMostPopulation(a, b) + (population of a) - (population of b) +end cityMostPopulation + +on cityLeastPopulation(a, b) + (population of b) - (population of a) +end cityLeastPopulation + +on cityNameAZ(a, b) + set strA to name of a + set strB to name of b + + if strA < strB then + 1 + else if strA > strB then + -1 + else + 0 + end if +end cityNameAZ + +on cityNameZA(a, b) + set strA to name of a + set strB to name of b + + if strA < strB then + -1 + else if strA > strB then + 1 + else + 0 + end if +end cityNameZA + + +-- GENERIC LIBRARY FUNCTIONS + +-- 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 diff --git a/Task/Greatest-element-of-a-list/AppleScript/greatest-element-of-a-list-3.applescript b/Task/Greatest-element-of-a-list/AppleScript/greatest-element-of-a-list-3.applescript new file mode 100644 index 0000000000..060c15beb9 --- /dev/null +++ b/Task/Greatest-element-of-a-list/AppleScript/greatest-element-of-a-list-3.applescript @@ -0,0 +1,3 @@ +{"alpha", "zeta", "epsilon", "mu", +{name:"Shanghai", population:24.15}, {name:"Tokyo", population:13.3}, +{name:"Beijing", population:21.5}, {name:"Tokyo", population:13.3}} diff --git a/Task/Greatest-element-of-a-list/Befunge/greatest-element-of-a-list.bf b/Task/Greatest-element-of-a-list/Befunge/greatest-element-of-a-list.bf new file mode 100644 index 0000000000..2d86c135ae --- /dev/null +++ b/Task/Greatest-element-of-a-list/Befunge/greatest-element-of-a-list.bf @@ -0,0 +1,3 @@ +v$9 < +>~:20g`#v_1+#^_20g,@ +^p02 < diff --git a/Task/Greatest-element-of-a-list/D/greatest-element-of-a-list.d b/Task/Greatest-element-of-a-list/D/greatest-element-of-a-list-1.d similarity index 100% rename from Task/Greatest-element-of-a-list/D/greatest-element-of-a-list.d rename to Task/Greatest-element-of-a-list/D/greatest-element-of-a-list-1.d diff --git a/Task/Greatest-element-of-a-list/D/greatest-element-of-a-list-2.d b/Task/Greatest-element-of-a-list/D/greatest-element-of-a-list-2.d new file mode 100644 index 0000000000..4680462e9a --- /dev/null +++ b/Task/Greatest-element-of-a-list/D/greatest-element-of-a-list-2.d @@ -0,0 +1,8 @@ +void main() +{ + import std.algorithm, std.stdio; + + auto a = [1, 234, 6, 54, 7, 54, 7, 3454, 237, 28].sort; + + a[$-1].writeln; +} diff --git a/Task/Greatest-element-of-a-list/Delphi/greatest-element-of-a-list.delphi b/Task/Greatest-element-of-a-list/Delphi/greatest-element-of-a-list.delphi index 95f08199a7..02e192fe51 100644 --- a/Task/Greatest-element-of-a-list/Delphi/greatest-element-of-a-list.delphi +++ b/Task/Greatest-element-of-a-list/Delphi/greatest-element-of-a-list.delphi @@ -1,2 +1,23 @@ -Math.MaxIntValue(); // Array of Integer -Math.MaxValue(); // Array of floating point (Single, Double or Extended) +program GElemLIst; +{$IFNDEF FPC} + {$Apptype Console} +{$ENDIF} + +uses + math; +const + MaxCnt = 10000; +var + IntArr : array of integer; + fltArr : array of double; + i: integer; +begin + setlength(fltArr,MaxCnt); //filled with 0 + setlength(IntArr,MaxCnt); //filled with 0.0 + randomize; + i := random(MaxCnt); //choose a random place + IntArr[i] := 1; + fltArr[i] := 1.0; + writeln(Math.MaxIntValue(IntArr)); // Array of Integer + writeln(Math.MaxValue(fltArr)); +end. diff --git a/Task/Greatest-element-of-a-list/Excel/greatest-element-of-a-list.excel b/Task/Greatest-element-of-a-list/Excel/greatest-element-of-a-list.excel new file mode 100644 index 0000000000..b4c537fde0 --- /dev/null +++ b/Task/Greatest-element-of-a-list/Excel/greatest-element-of-a-list.excel @@ -0,0 +1 @@ +=MAX(3;2;1;4;5;23;1;2) diff --git a/Task/Greatest-element-of-a-list/JavaScript/greatest-element-of-a-list-2.js b/Task/Greatest-element-of-a-list/JavaScript/greatest-element-of-a-list-2.js index 4160653903..76034ec4d6 100644 --- a/Task/Greatest-element-of-a-list/JavaScript/greatest-element-of-a-list-2.js +++ b/Task/Greatest-element-of-a-list/JavaScript/greatest-element-of-a-list-2.js @@ -1,59 +1,53 @@ (function () { - // Generalised max() function - // [a] -> (a -> n) -> a - function max(list, fnCompare) { - return list.reduce(function (acc, b) { - var a = acc || b, - lngDiff = fnCompare(a, b); - - return lngDiff ? (lngDiff > 0 ? b : a) : a; - }, null) + // (a -> a -> Ordering) -> [a] -> a + function maximumBy(f, xs) { + return xs.reduce(function (a, x) { + return a === undefined ? x : ( + f(x, a) > 0 ? x : a + ); + }, undefined); } - // Comparison functions for specific data types + // COMPARISON FUNCTIONS FOR SPECIFIC DATA TYPES + + //Ordering: (LT|EQ|GT) + // GT: 1 (or other positive n) + // EQ: 0 + // LT: -1 (or other negative n) function wordSortFirst(a, b) { - return a === null ? b : a === b ? 0 : a < b ? -1 : 1; + return a < b ? 1 : (a > b ? -1 : 0) } function wordSortLast(a, b) { - return a === null ? b : a === b ? 0 : a < b ? 1 : -1; + return a < b ? -1 : (a > b ? 1 : 0) } function wordLongest(a, b) { - var lngA = a ? a.length : b.length, - lngB = b.length; - - return lngA === lngB ? 0 : lngA > lngB ? -1 : 1; + return a.length - b.length; } function cityPopulationMost(a, b) { - var nA = a ? a.population : b.population, - nB = b.population; - - return nA === nB ? 0 : nA > nB ? -1 : 1; + return a.population - b.population; } function cityPopulationLeast(a, b) { - var nA = a ? a.population : b.population, - nB = b.population; - - return nA === nB ? 0 : nA < nB ? -1 : 1; + return b.population - a.population; } function cityNameSortFirst(a, b) { - var sA = a ? a.name : b.name, - sB = b.name; + var strA = a.name, + strB = b.name; - return sA === sB ? 0 : sA < sB ? -1 : 1; + return strA < strB ? 1 : (strA > strB ? -1 : 0); } function cityNameSortLast(a, b) { - var sA = a ? a.name : b.name, - sB = b.name; + var strA = a.name, + strB = b.name; - return sA === sB ? 0 : sA > sB ? -1 : 1; + return strA < strB ? -1 : (strA > strB ? 1 : 0); } var lstWords = [ @@ -62,38 +56,38 @@ ]; var lstCities = [ - { - name: 'Shanghai', - population: 24.15 + { + name: 'Shanghai', + population: 24.15 }, { - name: 'Karachi', - population: 23.5 + name: 'Karachi', + population: 23.5 }, { - name: 'Beijing', - population: 21.5 + name: 'Beijing', + population: 21.5 }, { - name: 'Tianjin', - population: 14.7 + name: 'Tianjin', + population: 14.7 }, { - name: 'Istanbul', - population: 14.4 + name: 'Istanbul', + population: 14.4 }, , { - name: 'Lagos', - population: 13.4 + name: 'Lagos', + population: 13.4 }, , { - name: 'Tokyo', - population: 13.3 + name: 'Tokyo', + population: 13.3 } ]; return [ - max(lstWords, wordSortFirst), - max(lstWords, wordSortLast), - max(lstWords, wordLongest), - max(lstCities, cityPopulationMost), - max(lstCities, cityPopulationLeast), - max(lstCities, cityNameSortFirst), - max(lstCities, cityNameSortLast) + maximumBy(wordSortFirst, lstWords), + maximumBy(wordSortLast, lstWords), + maximumBy(wordLongest, lstWords), + maximumBy(cityPopulationMost, lstCities), + maximumBy(cityPopulationLeast, lstCities), + maximumBy(cityNameSortFirst, lstCities), + maximumBy(cityNameSortLast, lstCities) ] })(); diff --git a/Task/Greatest-element-of-a-list/Logo/greatest-element-of-a-list.logo b/Task/Greatest-element-of-a-list/Logo/greatest-element-of-a-list.logo new file mode 100644 index 0000000000..7d4f6d2281 --- /dev/null +++ b/Task/Greatest-element-of-a-list/Logo/greatest-element-of-a-list.logo @@ -0,0 +1,7 @@ +to bigger :a :b + output ifelse [greater? :a :b] [:a] [:b] +end + +to max :lst + output reduce "bigger :lst +end diff --git a/Task/Greatest-element-of-a-list/Maxima/greatest-element-of-a-list.maxima b/Task/Greatest-element-of-a-list/Maxima/greatest-element-of-a-list.maxima index 9b5bc12134..945ab1886c 100644 --- a/Task/Greatest-element-of-a-list/Maxima/greatest-element-of-a-list.maxima +++ b/Task/Greatest-element-of-a-list/Maxima/greatest-element-of-a-list.maxima @@ -1,4 +1,4 @@ -: makelist(random(1000), 50)$ +u : makelist(random(1000), 50)$ /* Three solutions */ lreduce(max, u); diff --git a/Task/Greatest-element-of-a-list/Pascal/greatest-element-of-a-list.pascal b/Task/Greatest-element-of-a-list/Pascal/greatest-element-of-a-list.pascal new file mode 100644 index 0000000000..6902c03b4d --- /dev/null +++ b/Task/Greatest-element-of-a-list/Pascal/greatest-element-of-a-list.pascal @@ -0,0 +1,101 @@ +program GElemLIst; +{$IFNDEF FPC} + {$Apptype Console} +{$else} + {$Mode Delphi} +{$ENDIF} + +uses + sysutils; +const + MaxCnt = 1000000; +type + tMaxIntPos= record + mpMax, + mpPos : integer; + end; + tMaxfltPos= record + mpMax : double; + mpPos : integer; + end; + + +function FindMaxInt(const ia: array of integer):tMaxIntPos; +//delivers the highest Element and position of integer array +var + i : NativeInt; + tmp,max,ps: integer; +Begin + max := -MaxInt-1; + ps := -1; + //i = index of last Element + i := length(ia)-1; + IF i>=0 then Begin + max := ia[i]; + ps := i; + dec(i); + while i> 0 do begin + tmp := ia[i]; + IF max< tmp then begin + max := tmp; + ps := i; + end; + dec(i); + end; + end; + result.mpMax := Max; + result.mpPos := ps; +end; + +function FindMaxflt(const ia: array of double):tMaxfltPos; +//delivers the highest Element and position of double array +var + i, + ps: NativeInt; + max : double; + tmp : ^double;//for 32-bit version runs faster + +Begin + max := -MaxInt-1; + ps := -1; + //i = index of last Element + i := length(ia)-1; + IF i>=0 then Begin + max := ia[i]; + ps := i; + dec(i); + tmp := @ia[i]; + while i> 0 do begin + IF tmp^>max then begin + max := tmp^; + ps := i; + end; + dec(i); + dec(tmp); + end; + end; + result.mpMax := Max; + result.mpPos := ps; +end; + +var + IntArr : array of integer; + fltArr : array of double; + ErgInt : tMaxINtPos; + ErgFlt : tMaxfltPos; + i: NativeInt; +begin + randomize; + setlength(fltArr,MaxCnt); //filled with 0 + setlength(IntArr,MaxCnt); //filled with 0.0 + For i := High(fltArr) downto 0 do + fltArr[i] := MaxCnt*random(); + For i := High(IntArr) downto 0 do + IntArr[i] := round(fltArr[i]); + + ErgInt := FindMaxInt(IntArr); + writeln('FindMaxInt ',ErgInt.mpMax,' @ ',ErgInt.mpPos); + + Ergflt := FindMaxflt(fltArr); + writeln('FindMaxFlt ',Ergflt.mpMax:0:4,' @ ',Ergflt.mpPos); +end. diff --git a/Task/Greatest-element-of-a-list/REXX/greatest-element-of-a-list-1.rexx b/Task/Greatest-element-of-a-list/REXX/greatest-element-of-a-list-1.rexx index 94e7944044..cbf33d91fe 100644 --- a/Task/Greatest-element-of-a-list/REXX/greatest-element-of-a-list-1.rexx +++ b/Task/Greatest-element-of-a-list/REXX/greatest-element-of-a-list-1.rexx @@ -7,5 +7,5 @@ big=word(y,1) /*choose a initial biggest number*/ end /*j*/ say 'the biggest value in a list of ' words(y) " numbers is: " big - /* [↓] list of first twenty reversed primes*/ + /* [↑] list of first twenty reversed primes*/ /*stick a fork in it, we're done.*/ diff --git a/Task/Greatest-element-of-a-list/REXX/greatest-element-of-a-list-4.rexx b/Task/Greatest-element-of-a-list/REXX/greatest-element-of-a-list-4.rexx index 371d0e3073..a0bfa71650 100644 --- a/Task/Greatest-element-of-a-list/REXX/greatest-element-of-a-list-4.rexx +++ b/Task/Greatest-element-of-a-list/REXX/greatest-element-of-a-list-4.rexx @@ -1,6 +1,7 @@ /* REXX *************************************************************** -* If the list contains any character strings, the following will wotk +* If the list contains any character strings, the following will work * Note the use of >> (instead of >) to avoid numeric comparison +* Note that max() overrides the builtin function MAX * 30.07.2013 Walter Pachl **********************************************************************/ list='Walter Pachl living in Vienna' diff --git a/Task/Greatest-element-of-a-list/S-lang/greatest-element-of-a-list-1.slang b/Task/Greatest-element-of-a-list/S-lang/greatest-element-of-a-list-1.slang new file mode 100644 index 0000000000..d26dfa2373 --- /dev/null +++ b/Task/Greatest-element-of-a-list/S-lang/greatest-element-of-a-list-1.slang @@ -0,0 +1,2 @@ +variable a = [5, -2, 0, 4, 666, 7]; +print(max(a)); diff --git a/Task/Greatest-element-of-a-list/S-lang/greatest-element-of-a-list-2.slang b/Task/Greatest-element-of-a-list/S-lang/greatest-element-of-a-list-2.slang new file mode 100644 index 0000000000..45614ff2f6 --- /dev/null +++ b/Task/Greatest-element-of-a-list/S-lang/greatest-element-of-a-list-2.slang @@ -0,0 +1,2 @@ +a = {5, -2, 0, 4, 666, 7}; +print(max(list_to_array(a))); diff --git a/Task/Greatest-element-of-a-list/Smalltalk/greatest-element-of-a-list-3.st b/Task/Greatest-element-of-a-list/Smalltalk/greatest-element-of-a-list-3.st new file mode 100644 index 0000000000..798c7e5ce2 --- /dev/null +++ b/Task/Greatest-element-of-a-list/Smalltalk/greatest-element-of-a-list-3.st @@ -0,0 +1,4 @@ +| list | +list := #(1 2 3 4 20 10 9 8). +list inject: (list at: 1) into: [ :number :each | + number max: each ] diff --git a/Task/Greatest-element-of-a-list/ZX-Spectrum-Basic/greatest-element-of-a-list.zx b/Task/Greatest-element-of-a-list/ZX-Spectrum-Basic/greatest-element-of-a-list.zx new file mode 100644 index 0000000000..63fac3da72 --- /dev/null +++ b/Task/Greatest-element-of-a-list/ZX-Spectrum-Basic/greatest-element-of-a-list.zx @@ -0,0 +1,8 @@ +10 PRINT "Values"'' +20 LET z=0 +30 FOR x=1 TO INT (RND*10)+1 +40 LET y=RND*10-5 +50 PRINT y +60 LET z=(y AND y>z)+(z AND ysum then do; sum=s; at=j; L=k-j+1; end - end /*k*/ /* [↑] chose greatest sum of numbers. */ - end /*j*/ - -$=subword(@,at,L); if $=='' then $="[NULL]" /*Englishize the null. */ -say; say 'sum='sum/1 " sequence="$ /*stick a fork in it, we're all done. */ +/*REXX program finds and displays the shortest greatest continuous subsequence sum.*/ +parse arg @; w=words(@) /*get arg list; number words in list. */ +say 'words='w " list="@ /*show number words & LIST to terminal.*/ +sum=0; at=w+1 /*default sum, length, and "starts at".*/ +L=0 /* [↓] process the list of numbers. */ + do j=1 for w; f=word(@, j) /*select one number at a time from list*/ + do k=j to w; s=f /* [↓] process a sub─list of numbers. */ + do m=j+1 to k; s=s+word(@, m); end /*m*/ + if s>sum then do; sum=s; at=j; L=k-j+1; end + end /*k*/ /* [↑] chose greatest sum of numbers. */ + end /*j*/ +say +$=subword(@,at,L); if $=='' then $="[NULL]" /*Englishize the null (value). */ +say 'sum='sum/1 " sequence="$ /*stick a fork in it, we're all done. */ diff --git a/Task/Greatest-subsequential-sum/REXX/greatest-subsequential-sum-2.rexx b/Task/Greatest-subsequential-sum/REXX/greatest-subsequential-sum-2.rexx index 1c1e8ee026..a105a79c03 100644 --- a/Task/Greatest-subsequential-sum/REXX/greatest-subsequential-sum-2.rexx +++ b/Task/Greatest-subsequential-sum/REXX/greatest-subsequential-sum-2.rexx @@ -1,14 +1,14 @@ -/*REXX program finds the longest greatest continuous subsequence sum. */ -parse arg @; w=words(@) /*get arg list; number words in list. */ -say 'words='w " list="@ /*show number words & LIST to terminal,*/ -sum=0; L=0; at=w+1 /*default sum, length, and "starts at".*/ - /* [↓] process the list of numbers. */ - do j=1 for w; f=word(@,j) /*select one number at a time from list*/ - do k=j to w; _=k-j+1; s=f /* [↓] process a sub─list of numbers. */ - do m=j+1 to k; s=s+word(@,m); end /*m*/ - if (s==sum & _>L) | s>sum then do; sum=s; at=j; L=_; end - end /*k*/ /* [↑] chose the longest greatest sum.*/ - end /*j*/ - -$=subword(@,at,L); if $=='' then $="[NULL]" /*Englishize the null. */ -say; say 'sum='sum/1 " sequence="$ /*stick a fork in it, we're all done. */ +/*REXX program finds and displays the longest greatest continuous subsequence sum. */ +parse arg @; w=words(@) /*get arg list; number words in list. */ +say 'words='w " list="@ /*show number words & LIST to terminal,*/ +sum=0; at=w+1 /*default sum, length, and "starts at".*/ +L=0 /* [↓] process the list of numbers. */ + do j=1 for w; f=word(@,j) /*select one number at a time from list*/ + do k=j to w; _=k-j+1; s=f /* [↓] process a sub─list of numbers. */ + do m=j+1 to k; s=s+word(@, m); end /*m*/ + if (s==sum & _>L) | s>sum then do; sum=s; at=j; L=_; end + end /*k*/ /* [↑] chose the longest greatest sum.*/ + end /*j*/ +say +$=subword(@,at,L); if $=='' then $="[NULL]" /*Englishize the null (value). */ +say 'sum='sum/1 " sequence="$ /*stick a fork in it, we're all done. */ diff --git a/Task/Greatest-subsequential-sum/ZX-Spectrum-Basic/greatest-subsequential-sum.zx b/Task/Greatest-subsequential-sum/ZX-Spectrum-Basic/greatest-subsequential-sum.zx new file mode 100644 index 0000000000..84726df9d9 --- /dev/null +++ b/Task/Greatest-subsequential-sum/ZX-Spectrum-Basic/greatest-subsequential-sum.zx @@ -0,0 +1,28 @@ +10 DATA 12,0,1,2,-3,3,-1,0,-4,0,-1,-4,2 +20 DATA 11,-1,-2,3,5,6,-2,-1,4,-4,2,-1 +30 DATA 5,-1,-2,-3,-4,-5 +40 FOR n=1 TO 3 +50 READ l +60 DIM a(l) +70 FOR i=1 TO l +80 READ a(i) +90 PRINT a(i); +100 IF im THEN LET m=s: LET a=i: LET b=j +190 NEXT j +200 NEXT i +210 IF a>b THEN PRINT "[]": GO TO 280 +220 PRINT "["; +230 FOR i=a TO b +240 PRINT a(i); +250 IF i guess do + IO.puts "Is it #{guess}? Too Low." + guess(x, guess+1..b, div(guess+b+1, 2)) + end + defp guess(x, _, _) do IO.puts "Is it #{x}?" IO.puts " So the number is: #{x}" end - defp guess(x, a..b) when x < div(a+b, 2) do - IO.puts "Is it #{div(a+b, 2)}? Too High." - guess(x, a..div(a+b, 2)) - end - defp guess(x, a..b) when x > div(a+b, 2) do - IO.puts "Is it #{div(a+b, 2)}? Too Low." - guess(x, div(a+b+1, 2)..b) - end end Game.guess(1..100) diff --git a/Task/Guess-the-number-With-feedback--player-/ZX-Spectrum-Basic/guess-the-number-with-feedback--player-.zx b/Task/Guess-the-number-With-feedback--player-/ZX-Spectrum-Basic/guess-the-number-with-feedback--player-.zx new file mode 100644 index 0000000000..5288030beb --- /dev/null +++ b/Task/Guess-the-number-With-feedback--player-/ZX-Spectrum-Basic/guess-the-number-with-feedback--player-.zx @@ -0,0 +1,11 @@ +10 LET min=1: LET max=100 +20 PRINT "Think of a number between ";min;" and ";max +30 PRINT "I will try to guess your number." +40 LET guess=INT ((min+max)/2) +50 PRINT "My guess is ";guess +60 INPUT "Is it higuer than, lower than or equal to your number? ";a$ +65 LET a$=a$(1) +70 IF a$="L" OR a$="l" THEN LET min=guess+1: GO TO 40 +80 IF a$="H" OR a$="h" THEN LET max=guess-1: GO TO 40 +90 IF a$="E" OR a$="e" THEN PRINT "Goodbye.": STOP +100 PRINT "Sorry, I didn't understand your answer.": GO TO 60 diff --git a/Task/Guess-the-number-With-feedback/00DESCRIPTION b/Task/Guess-the-number-With-feedback/00DESCRIPTION index a81f6148f7..4113926eb7 100644 --- a/Task/Guess-the-number-With-feedback/00DESCRIPTION +++ b/Task/Guess-the-number-With-feedback/00DESCRIPTION @@ -1,4 +1,14 @@ -The task is to write a game that follows the following rules: -:The computer will choose a number between given set limits and asks the player for repeated guesses until the player guesses the target number correctly. At each guess, the computer responds with whether the guess was higher than, equal to, or less than the target - or signals that the input was inappropriate. +;Task: +Write a game (computer program) that follows the following rules: +::* The computer chooses a number between given set limits. +::* The player is asked for repeated guesses until the the target number is guessed correctly +::* At each guess, the computer responds with whether the guess is: +:::::* higher than the target, +:::::* equal to the target, +:::::* less than the target,   or +:::::* the input was inappropriate. -C.f: [[Guess the number/With Feedback (Player)]] + +;Related task: +*   [[Guess the number/With Feedback (Player)]] +

    diff --git a/Task/Guess-the-number-With-feedback/Elixir/guess-the-number-with-feedback.elixir b/Task/Guess-the-number-With-feedback/Elixir/guess-the-number-with-feedback.elixir index 2b5a0a31c8..89be6bf5b3 100644 --- a/Task/Guess-the-number-With-feedback/Elixir/guess-the-number-with-feedback.elixir +++ b/Task/Guess-the-number-With-feedback/Elixir/guess-the-number-with-feedback.elixir @@ -1,7 +1,6 @@ defmodule GuessingGame do def play(lower, upper) do - :random.seed(:os.timestamp) - play(lower, upper, :random.uniform(upper + 1 - lower) + lower - 1) + play(lower, upper, Enum.random(lower .. upper)) end defp play(lower, upper, number) do guess = Integer.parse(IO.gets "Guess a number (#{lower}-#{upper}): ") @@ -9,7 +8,7 @@ defmodule GuessingGame do {^number, _} -> IO.puts "Well guessed!" {n, _} when n in lower..upper -> - IO.puts if n > number, do: "Too high.", else: "Too low." + IO.puts if n > number, do: "Too high.", else: "Too low." play(lower, upper, number) _ -> IO.puts "Guess not in valid range." diff --git a/Task/Guess-the-number-With-feedback/Groovy/guess-the-number-with-feedback-1.groovy b/Task/Guess-the-number-With-feedback/Groovy/guess-the-number-with-feedback-1.groovy new file mode 100644 index 0000000000..8182d1f034 --- /dev/null +++ b/Task/Guess-the-number-With-feedback/Groovy/guess-the-number-with-feedback-1.groovy @@ -0,0 +1,20 @@ +def rand = new Random() // java.util.Random +def range = 1..100 // Range (inclusive) +def number = rand.nextInt(range.size()) + range.from // get a random number in the range + +println "The number is in ${range.toString()}" // print the range + +def guess +while (guess != number) { // keep running until correct guess + try { + print 'Guess the number: ' + guess = System.in.newReader().readLine() as int // read the guess in as int + switch (guess) { // check the guess against number + case { it < number }: println 'Your guess is too low'; break + case { it > number }: println 'Your guess is too high'; break + default: println 'Your guess is spot on!'; break + } + } catch (NumberFormatException ignored) { // catches all input that is not a number + println 'Please enter a number!' + } +} diff --git a/Task/Guess-the-number-With-feedback/Groovy/guess-the-number-with-feedback-2.groovy b/Task/Guess-the-number-With-feedback/Groovy/guess-the-number-with-feedback-2.groovy new file mode 100644 index 0000000000..1be49e61ad --- /dev/null +++ b/Task/Guess-the-number-With-feedback/Groovy/guess-the-number-with-feedback-2.groovy @@ -0,0 +1,15 @@ +The number is in 1..100 +Guess the number: ghfvkghj +Please enter a number! +Guess the number: 50 +Your guess is too low +Guess the number: 75 +Your guess is too low +Guess the number: 83 +Your guess is too low +Guess the number: 90 +Your guess is too low +Guess the number: 95 +Your guess is too high +Guess the number: 92 +Your guess is spot on! diff --git a/Task/Guess-the-number-With-feedback/PowerShell/guess-the-number-with-feedback.psh b/Task/Guess-the-number-With-feedback/PowerShell/guess-the-number-with-feedback.psh new file mode 100644 index 0000000000..3380644ee6 --- /dev/null +++ b/Task/Guess-the-number-With-feedback/PowerShell/guess-the-number-with-feedback.psh @@ -0,0 +1,45 @@ +function Get-Guess +{ + [int]$number = 1..100 | Get-Random + [int]$guess = 0 + [int[]]$guesses = @() + + Write-Host "Guess a number between 1 and 100" -ForegroundColor Cyan + + while ($guess -ne $number) + { + try + { + [int]$guess = Read-Host -Prompt "Guess" + + if ($guess -lt $number) + { + Write-Host "Greater than..." + } + elseif ($guess -gt $number) + { + Write-Host "Less than..." + } + else + { + Write-Host "You guessed it" + } + } + catch [Exception] + { + Write-Host "Input a number between 1 and 100." -ForegroundColor Yellow + continue + } + + $guesses += $guess + } + + [PSCustomObject]@{ + Number = $number + Guesses = $guesses + } +} + +$answer = Get-Guess + +Write-Host ("The number was {0} and it took {1} guesses to find it." -f $answer.Number, $answer.Guesses.Count) diff --git a/Task/Guess-the-number-With-feedback/REXX/guess-the-number-with-feedback.rexx b/Task/Guess-the-number-With-feedback/REXX/guess-the-number-with-feedback.rexx index 2aecd01e6c..8648c39ed1 100644 --- a/Task/Guess-the-number-With-feedback/REXX/guess-the-number-with-feedback.rexx +++ b/Task/Guess-the-number-With-feedback/REXX/guess-the-number-with-feedback.rexx @@ -1,36 +1,36 @@ -/*REXX program that plays the guessing (the number) game. */ - low=1 /*lower range for guessing game. */ -high=100 /*upper range for guessing game. */ -try=0 /*number of valid attempts. */ -r=random(1,100) /*get a random # (low ──> high).*/ - lows='too_low too_small too_little below under underneath too_puny' -highs='too_high too_big too_much above over over_the_top too_huge' -er!='*** error! ***' -prompt=centre("guess the number, it's between" low 'and', - high '(inclusive) ───or─── Quit:',79,"─") - - do ask=0; say; say prompt; say; pull g; g=space(g); say - do validate=0 +/*REXX program plays guess the number game with a human; the computer picks the number*/ + low= 1 /*the lower range for the guessing game*/ +high=100 /* " upper " " " " " */ + try= 0 /*the number of valid (guess) attempts.*/ + r=random(1, 100) /*get a random number (low ───◄ high).*/ + lows= 'too_low too_small too_little below under underneath too_puny' +highs= 'too_high too_big too_much above over over_the_top too_huge' + erm= '***error***' + @gtn= "guess the number, it's between" +prompt=centre(@gtn low 'and' high '(inclusive) ───or─── Quit:', 79, "─") + /* [↓] by 0 --- used to LEAVE aloop.*/ + do ask=0 by 0; say; say prompt; say; pull g; g=space(g); say + do validate=0 by 0 select - when g=='' then iterate ask - when abbrev('QUIT',g,1) then exit - when words(g)\==1 then say er! 'too many numbers entered:' g - when \datatype(g,'N') then say er! g "isn't numeric" - when \datatype(g,'W') then say er! g "isn't a whole number" - when ghigh then say er! g 'is above the higher limit of' high - otherwise leave validate + when g=='' then iterate ask + when abbrev('QUIT',g,1) then exit /*what a whoos.*/ + when words(g)\==1 then say erm 'too many numbers entered:' g + when \datatype(g,'N') then say erm g "isn't numeric" + when \datatype(g,'W') then say erm g "isn't a whole number" + when ghigh then say erm g 'is above the higher limit of' high + otherwise leave /*validate*/ end /*select*/ iterate ask end /*validate*/ try=try+1 if g=r then leave - if g>r then what=word(highs,random(1,words(highs))) - else what=word( lows,random(1,words( lows))) - say 'your guess of' g "is" translate(what'.',,"_") + if g>r then what=word(highs, random(1, words(highs))) + else what=word( lows, random(1, words( lows))) + say 'your guess of' g "is" translate(what'.', , "_") end /*ask*/ if try==1 then say 'Gadzooks!!! You guessed the number right away!' - else say 'Congratulations!, you guessed the number in' try "tries." - /*stick a fork in it, we're done.*/ + else say 'Congratulations!, you guessed the number in ' try " tries." + /*stick a fork in it, we're all done. */ diff --git a/Task/Guess-the-number-With-feedback/Racket/guess-the-number-with-feedback.rkt b/Task/Guess-the-number-With-feedback/Racket/guess-the-number-with-feedback.rkt index 06a4beb5ea..f06befc9f3 100644 --- a/Task/Guess-the-number-With-feedback/Racket/guess-the-number-with-feedback.rkt +++ b/Task/Guess-the-number-With-feedback/Racket/guess-the-number-with-feedback.rkt @@ -1,14 +1,18 @@ #lang racket -(define min 1) -(define max 10) -(define (guess-number (target (+ min (random (- max min))))) - (define guess (read)) - (cond ((not (number? guess)) (display "That's not a number!\n" (guess-number target))) - ((or (> guess max) (> min guess)) (display "Out of range!\n") (guess-number target)) - ((> guess target) (display "Too high!\n") (guess-number target)) - ((< guess target) (display "Too low!\n") (guess-number target)) - (else (display "Well guessed!\n")))) +(define (guess-number min max) + (define target (+ min (random (- max min -1)))) + (printf "I'm thinking of a number between ~a and ~a\n" min max) + (let loop ([prompt "Your guess"]) + (printf "~a: " prompt) + (flush-output) + (define guess (read)) + (define response + (cond [(not (exact-integer? guess)) "Please enter a valid integer"] + [(< guess target) "Too low"] + [(> guess target) "Too high"] + [else #f])) + (when response (printf "~a\n" response) (loop "Try again"))) + (printf "Well guessed!\n")) -(display (format "Guess a number between ~a and ~a\n" min max)) -(guess-number) +(guess-number 1 100) diff --git a/Task/Guess-the-number-With-feedback/ZX-Spectrum-Basic/guess-the-number-with-feedback.zx b/Task/Guess-the-number-With-feedback/ZX-Spectrum-Basic/guess-the-number-with-feedback.zx new file mode 100644 index 0000000000..223b6bd04f --- /dev/null +++ b/Task/Guess-the-number-With-feedback/ZX-Spectrum-Basic/guess-the-number-with-feedback.zx @@ -0,0 +1,5 @@ +ZX Spectrum Basic has no [[:Category:Conditional loops|conditional loop]] constructs, so we have to emulate them here using IF and GO TO. +1 LET n=INT (RND*10)+1 +2 INPUT "Guess a number that is between 1 and 10: ",g: IF g=n THEN PRINT "That's my number!": STOP +3 IF gn THEN PRINT "That guess is too high!": GO TO 2 diff --git a/Task/Guess-the-number/00DESCRIPTION b/Task/Guess-the-number/00DESCRIPTION index f9117028f2..4226c4779d 100644 --- a/Task/Guess-the-number/00DESCRIPTION +++ b/Task/Guess-the-number/00DESCRIPTION @@ -1,5 +1,14 @@ -The task is to write a program where the program chooses a number between 1 and 10. A player is then prompted to enter a guess. If the player guess wrong then the prompt appears again until the guess is correct. When the player has made a successful guess the computer will give a "Well guessed!" message, and the program will exit. +;Task: +Write a program where the program chooses a number between   '''1'''   and   '''10'''. -A [[:Category:Conditional loops|conditional loop]] may be used to repeat the guessing until the user is correct. +A player is then prompted to enter a guess.   If the player guesses wrong,   then the prompt appears again until the guess is correct. -Cf. [[Guess the number/With Feedback]], [[Bulls and cows]] +When the player has made a successful guess the computer will issue a   "Well guessed!"   message,   and the program exits. + +A   [[:Category:Conditional loops|conditional loop]]   may be used to repeat the guessing until the user is correct. + + +;Related tasks: +*   [[Guess the number/With Feedback]] +*   [[Bulls and cows]] +

    diff --git a/Task/Guess-the-number/AppleScript/guess-the-number.applescript b/Task/Guess-the-number/AppleScript/guess-the-number-1.applescript similarity index 100% rename from Task/Guess-the-number/AppleScript/guess-the-number.applescript rename to Task/Guess-the-number/AppleScript/guess-the-number-1.applescript diff --git a/Task/Guess-the-number/AppleScript/guess-the-number-2.applescript b/Task/Guess-the-number/AppleScript/guess-the-number-2.applescript new file mode 100644 index 0000000000..ebe8f21cce --- /dev/null +++ b/Task/Guess-the-number/AppleScript/guess-the-number-2.applescript @@ -0,0 +1,83 @@ +on run + -- isMatch :: Int -> Bool + script isMatch + on lambda(x) + tell x to its guess = its secret + end lambda + end script + + -- challenge :: () -> {secret: Int, guess: Int} + script challenge + on response() + set v to (text returned of (display dialog ¬ + "Guess the number in range 1-10" default answer ¬ + "" buttons {"Esc", "Check"} default button ¬ + "Check" cancel button "Esc")) + + if isInteger(v) then + v as integer + else + -1 + end if + end response + + on lambda(rec) + {secret:(random number from 1 to 10), guess:response() ¬ + of challenge, attempts:(attempts of rec) + 1} + end lambda + end script + + + -- MAIN LOOP + set rec to |until|(isMatch, challenge, {secret:-1, guess:0, attempts:0}) + + display dialog (((guess of rec) as string) & ": Well guessed ! " & ¬ + linefeed & linefeed & "Attempts: " & (attempts of rec)) +end run + + + +-- GENERIC LBRARY FUNCTIONS + +-- until :: (a -> Bool) -> (a -> a) -> a -> a +on |until|(p, f, x) + set mp to mReturn(p) + set mf to mReturn(f) + + script + property p : mp's lambda + property f : mf's lambda + + on lambda(v) + repeat until p(v) + set v to f(v) + end repeat + return v + end lambda + end script + + result's lambda(x) +end |until| + + +-- isInteger :: a -> Bool +on isInteger(e) + try + set n to e as integer + on error + return false + end try + true +end isInteger + +-- 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 diff --git a/Task/Guess-the-number/BASIC/guess-the-number-3.basic b/Task/Guess-the-number/BASIC/guess-the-number-3.basic index 49c036043a..9fb0d48fa8 100644 --- a/Task/Guess-the-number/BASIC/guess-the-number-3.basic +++ b/Task/Guess-the-number/BASIC/guess-the-number-3.basic @@ -1,9 +1,3 @@ -10 LET n=INT (RND*10)+1 -20 PRINT "I have thought of a number." -30 PRINT "Try to guess it!" -40 INPUT "Enter your guess: ";g -50 IF g=n THEN GO TO 100 -60 PRINT "Your guess was wrong. Try again!" -70 GO TO 40 - -100 PRINT "Well done! You guessed it." +1 LET n=INT (RND*10)+1 +2 INPUT "Guess a number that is between 1 and 10: ",g: IF g=n THEN PRINT "That's my number!": STOP +3 PRINT "Guess again!": GO TO 2 diff --git a/Task/Guess-the-number/Batch-File/guess-the-number.bat b/Task/Guess-the-number/Batch-File/guess-the-number.bat index 6272d66fc3..f20ee0e6f8 100644 --- a/Task/Guess-the-number/Batch-File/guess-the-number.bat +++ b/Task/Guess-the-number/Batch-File/guess-the-number.bat @@ -1,26 +1,18 @@ -@ECHO OFF +@echo off setlocal EnableDelayedExpansion -SET max=10 -SET min=1 - :begin - SET /A rand=%random% %% (max - min + 1)+ min + SET /A rand=%random% %% (10 - 1 + 1)+ 1 SET guess= SET /P guess=Pick a number between 1 and 10: - :loop IF "!guess!" == "" ( - GOTO end + EXIT ) SET /A guess=!guess! IF !guess! equ !rand! ( ECHO Well guessed^^! - GOTO end + EXIT ) SET guess= SET /P guess=Nope, guess again: GOTO loop - -:end - -ENDLOCAL diff --git a/Task/Guess-the-number/Eiffel/guess-the-number-1.e b/Task/Guess-the-number/Eiffel/guess-the-number-1.e new file mode 100644 index 0000000000..0b6e22b2c6 --- /dev/null +++ b/Task/Guess-the-number/Eiffel/guess-the-number-1.e @@ -0,0 +1,26 @@ +class + APPLICATION + +create + make + +feature {NONE} -- Initialization + + make + local + number_to_guess: INTEGER + do + number_to_guess := (create {RANDOMIZER}).random_integer_in_range (1 |..| 10) + from + print ("Please guess the number!%N") + io.read_integer + until + io.last_integer = number_to_guess + loop + print ("Please, guess again!%N") + io.read_integer + end + print ("Well guessed!%N") + end + +end diff --git a/Task/Guess-the-number/Eiffel/guess-the-number-2.e b/Task/Guess-the-number/Eiffel/guess-the-number-2.e new file mode 100644 index 0000000000..0466cd0c8f --- /dev/null +++ b/Task/Guess-the-number/Eiffel/guess-the-number-2.e @@ -0,0 +1,42 @@ +class + RANDOMIZER + +inherit + ANY + redefine + default_create + end + +feature {NONE} -- Initialization + + default_create + -- + local + time: TIME + do + sequence.do_nothing + end + +feature -- Access + + random_integer_in_range (a_range: INTEGER_INTERVAL): INTEGER + do + Result := (sequence.double_i_th (1) * a_range.upper).truncated_to_integer + a_range.lower + end + +feature {NONE} -- Implementation + + sequence: RANDOM + local + seed: INTEGER_32 + time: TIME + once + create time.make_now + seed := time.hour * + (60 + time.minute) * + (60 + time.second) * + (1000 + time.milli_second) + create Result.set_seed (seed) + end + +end diff --git a/Task/Guess-the-number/Eiffel/guess-the-number.e b/Task/Guess-the-number/Eiffel/guess-the-number.e deleted file mode 100644 index 85e3cce2ef..0000000000 --- a/Task/Guess-the-number/Eiffel/guess-the-number.e +++ /dev/null @@ -1,36 +0,0 @@ -class - APPLICATION - -create - make - -feature {NONE} - - make - local - number, seed: INTEGER_32 - random: RANDOM - do - from - until - seed > 0 - loop - io.put_string ("Enter a positive integer.%NYour play will be generated from it.%N") - io.read_integer - seed := io.last_integer - end - create random.set_seed (seed) - number := (random.double_i_th (seed) * 10.0).truncated_to_integer + 1 - io.put_string ("Please guess the number!%N") - from - io.read_integer - until - io.last_integer = number - loop - io.put_string ("Please guess again!%N") - io.read_integer - end - io.put_string ("Well guessed!%N") - end - -end diff --git a/Task/Guess-the-number/Elixir/guess-the-number.elixir b/Task/Guess-the-number/Elixir/guess-the-number.elixir index 454b4f9737..7a31a1d328 100644 --- a/Task/Guess-the-number/Elixir/guess-the-number.elixir +++ b/Task/Guess-the-number/Elixir/guess-the-number.elixir @@ -1,7 +1,6 @@ defmodule GuessingGame do def play do - :random.seed(:os.timestamp) - play(:random.uniform(10)) + play(Enum.random(1..10)) end defp play(number) do diff --git a/Task/Guess-the-number/Forth/guess-the-number.fth b/Task/Guess-the-number/Forth/guess-the-number.fth new file mode 100644 index 0000000000..031784a1f9 --- /dev/null +++ b/Task/Guess-the-number/Forth/guess-the-number.fth @@ -0,0 +1,11 @@ +\ tested with GForth 0.7.0 +: RND ( -- n) TIME&DATE 2DROP 2DROP DROP 10 MOD ; \ crude random number +: ASK ( -- ) CR ." Guess a number between 1 and 10? " ; +: GUESS ( -- n) PAD DUP 4 ACCEPT EVALUATE ; +: REPLY ( n n' -- n) 2DUP <> IF CR ." No, it's not " DUP . THEN ; + +: GAME ( -- ) + RND + BEGIN ASK GUESS REPLY OVER = UNTIL + CR ." Yes it was " . + CR ." Good guess!" ; diff --git a/Task/Guess-the-number/MIPS-Assembly/guess-the-number.mips b/Task/Guess-the-number/MIPS-Assembly/guess-the-number.mips new file mode 100644 index 0000000000..42d37499b2 --- /dev/null +++ b/Task/Guess-the-number/MIPS-Assembly/guess-the-number.mips @@ -0,0 +1,56 @@ +# WRITTEN: August 26, 2016 (at midnight...) + +# This targets MARS implementation and may not work on other implementations +# Specifically, using MARS' random syscall +.data + take_a_guess: .asciiz "Make a guess:" + good_job: .asciiz "Well guessed!" + +.text + #retrieve system time as a seed + li $v0,30 + syscall + + #use the high order time stored in $a1 as the seed arg + move $a1,$a0 + + #set the seed + li $v0,40 + syscall + + #generate number 0-9 (random int syscall generates a number where): + # 0 <= $v0 <= $a1 + li $a1,10 + li $v0,42 + syscall + + #increment the randomly generated number and store in $v1 + add $v1,$a0,1 + +loop: jal print_take_a_guess + jal read_int + + #go back to beginning of loop if user hasn't guessed right, + # else, just "fall through" to exit_procedure + bne $v0,$v1,loop + +exit_procedure: + #set syscall to print_string, then set good_job string as arg + li $v0,4 + la $a0,good_job + syscall + + #exit program + li $v0,10 + syscall + +print_take_a_guess: + li $v0,4 + la $a0,take_a_guess + syscall + jr $ra + +read_int: + li $v0,5 + syscall + jr $ra diff --git a/Task/Guess-the-number/PHP/guess-the-number.php b/Task/Guess-the-number/PHP/guess-the-number.php index bddb536334..3b4faf2bdc 100644 --- a/Task/Guess-the-number/PHP/guess-the-number.php +++ b/Task/Guess-the-number/PHP/guess-the-number.php @@ -12,19 +12,20 @@ else } -if($_POST["guess"]){ - $guess = htmlspecialchars($_POST['guess']); - - echo $guess . "
    "; - if ($guess != $number) - { - echo "Your guess is not correct"; - } - elseif($guess == $number) - { - echo "You got the correct number!"; - } - +if(isset($_POST["guess"])){ + if($_POST["guess"]){ + $guess = htmlspecialchars($_POST['guess']); + + echo $guess . "
    "; + if ($guess != $number) + { + echo "Your guess is not correct"; + } + elseif($guess == $number) + { + echo "You got the correct number!"; + } + } } ?> diff --git a/Task/Guess-the-number/PlainTeX/guess-the-number.tex b/Task/Guess-the-number/PlainTeX/guess-the-number.tex new file mode 100644 index 0000000000..32907e3076 --- /dev/null +++ b/Task/Guess-the-number/PlainTeX/guess-the-number.tex @@ -0,0 +1,15 @@ +\newlinechar`\^^J +\edef\tagetnumber{\number\numexpr1+\pdfuniformdeviate9}% +\message{^^JI'm thinking of a number between 1 and 10, try to guess it!}% +\newif\ifnotguessed +\notguessedtrue +\loop + \message{^^J^^JYour try: }\read -1 to \useranswer + \ifnum\useranswer=\tagetnumber\relax + \message{You win!^^J}\notguessedfalse + \else + \message{No, it's another number, try again...}% + \fi + \ifnotguessed +\repeat +\bye diff --git a/Task/Guess-the-number/Python/guess-the-number.py b/Task/Guess-the-number/Python/guess-the-number.py index d7a13addd2..272b0f2dae 100644 --- a/Task/Guess-the-number/Python/guess-the-number.py +++ b/Task/Guess-the-number/Python/guess-the-number.py @@ -1,8 +1,5 @@ -'Simple number guessing game' - import random - target, guess = random.randint(1, 10), 0 while target != guess: - guess = int(input('Guess my number between 1 and 10 until you get it right: ')) -print('Thats right!') + guess = int(input("Guess a number that is between 1 and 10: ")) +print("That's right!") diff --git a/Task/Guess-the-number/Racket/guess-the-number.rkt b/Task/Guess-the-number/Racket/guess-the-number.rkt index 6b9fa2ef24..4f467915ac 100644 --- a/Task/Guess-the-number/Racket/guess-the-number.rkt +++ b/Task/Guess-the-number/Racket/guess-the-number.rkt @@ -1,6 +1,8 @@ #lang racket -(define (guess-number (number (add1 (random 10)))) - (define guess (read)) - (if (= guess number) - (display "Well guessed!\n") - (guess-number number))) +(define (guess-number) + (define number (add1 (random 10))) + (let loop () + (define guess (read)) + (if (equal? guess number) + (display "Well guessed!\n") + (loop)))) diff --git a/Task/HTTP/00DESCRIPTION b/Task/HTTP/00DESCRIPTION index 8d0c135011..870317b30b 100644 --- a/Task/HTTP/00DESCRIPTION +++ b/Task/HTTP/00DESCRIPTION @@ -1,2 +1,5 @@ +;Task: Access and print a [[wp:Uniform Resource Locator|URL's]] content (the located resource) to the console. + There is a separate task for [[HTTPS Request]]s. +

    diff --git a/Task/HTTP/COBOL/http-1.cobol b/Task/HTTP/COBOL/http-1.cobol new file mode 100644 index 0000000000..a70cf23250 --- /dev/null +++ b/Task/HTTP/COBOL/http-1.cobol @@ -0,0 +1,292 @@ +COBOL >>SOURCE FORMAT IS FIXED + identification division. + program-id. curl-rosetta. + + environment division. + configuration section. + repository. + function read-url + function all intrinsic. + + data division. + working-storage section. + + copy "gccurlsym.cpy". + + 01 web-page pic x(16777216). + 01 curl-status usage binary-long. + + 01 cli pic x(7) external. + 88 helping values "-h", "-help", "help", spaces. + 88 displaying value "display". + 88 summarizing value "summary". + + *> *************************************************************** + procedure division. + accept cli from command-line + if helping then + display "./curl-rosetta [help|display|summary]" + goback + end-if + + *> + *> Read a web resource into fixed ram. + *> Caller is in charge of sizing the buffer, + *> (or getting trickier with the write callback) + *> Pass URL and working-storage variable, + *> get back libcURL error code or 0 for success + + move read-url("http://www.rosettacode.org", web-page) + to curl-status + + perform check + perform show + + goback. + *> *************************************************************** + + *> Now tesing the result, relying on the gccurlsym + *> GnuCOBOL Curl Symbol copy book + check. + if curl-status not equal zero then + display + curl-status " " + CURLEMSG(curl-status) upon syserr + end-if + . + + *> And display the page + show. + if summarizing then + display "Length: " stored-char-length(web-page) + end-if + if displaying then + display trim(web-page trailing) with no advancing + end-if + . + + REPLACE ALSO ==:EXCEPTION-HANDLERS:== BY + == + *> informational warnings and abends + soft-exception. + display space upon syserr + display "--Exception Report-- " upon syserr + display "Time of exception: " current-date upon syserr + display "Module: " module-id upon syserr + display "Module-path: " module-path upon syserr + display "Module-source: " module-source upon syserr + display "Exception-file: " exception-file upon syserr + display "Exception-status: " exception-status upon syserr + display "Exception-location: " exception-location upon syserr + display "Exception-statement: " exception-statement upon syserr + . + + hard-exception. + perform soft-exception + stop run returning 127 + . + ==. + + end program curl-rosetta. + *> *************************************************************** + + *> *************************************************************** + *> + *> The function hiding all the curl details + *> + *> Purpose: Call libcURL and read into memory + *> *************************************************************** + identification division. + function-id. read-url. + + environment division. + configuration section. + repository. + function all intrinsic. + + data division. + working-storage section. + + copy "gccurlsym.cpy". + + replace also ==:CALL-EXCEPTION:== by + == + on exception + perform hard-exception + ==. + + 01 curl-handle usage pointer. + 01 callback-handle usage procedure-pointer. + 01 memory-block. + 05 memory-address usage pointer sync. + 05 memory-size usage binary-long sync. + 05 running-total usage binary-long sync. + 01 curl-result usage binary-long. + + 01 cli pic x(7) external. + 88 helping values "-h", "-help", "help", spaces. + 88 displaying value "display". + 88 summarizing value "summary". + + linkage section. + 01 url pic x any length. + 01 buffer pic x any length. + 01 curl-status usage binary-long. + + *> *************************************************************** + procedure division using url buffer returning curl-status. + if displaying or summarizing then + display "Read: " url upon syserr + end-if + + *> initialize libcurl, hint at missing library if need be + call "curl_global_init" using by value CURL_GLOBAL_ALL + on exception + display + "need libcurl, link with -lcurl" upon syserr + stop run returning 1 + end-call + + *> initialize handle + call "curl_easy_init" returning curl-handle + :CALL-EXCEPTION: + end-call + if curl-handle equal NULL then + display "no curl handle" upon syserr + stop run returning 1 + end-if + + *> Set the URL + call "curl_easy_setopt" using + by value curl-handle + by value CURLOPT_URL + by reference concatenate(trim(url trailing), x"00") + :CALL-EXCEPTION: + end-call + + *> follow all redirects + call "curl_easy_setopt" using + by value curl-handle + by value CURLOPT_FOLLOWLOCATION + by value 1 + :CALL-EXCEPTION: + end-call + + *> set the call back to write to memory + set callback-handle to address of entry "curl-write-callback" + call "curl_easy_setopt" using + by value curl-handle + by value CURLOPT_WRITEFUNCTION + by value callback-handle + :CALL-EXCEPTION: + end-call + + *> set the curl handle data handling structure + set memory-address to address of buffer + move length(buffer) to memory-size + move 1 to running-total + + call "curl_easy_setopt" using + by value curl-handle + by value CURLOPT_WRITEDATA + by value address of memory-block + :CALL-EXCEPTION: + end-call + + *> some servers demand an agent + call "curl_easy_setopt" using + by value curl-handle + by value CURLOPT_USERAGENT + by reference concatenate("libcurl-agent/1.0", x"00") + :CALL-EXCEPTION: + end-call + + *> let curl do all the hard work + call "curl_easy_perform" using + by value curl-handle + returning curl-result + :CALL-EXCEPTION: + end-call + + *> the call back will handle filling ram, return the result code + move curl-result to curl-status + + *> curl clean up, more important if testing cookies + call "curl_easy_cleanup" using + by value curl-handle + returning omitted + :CALL-EXCEPTION: + end-call + + goback. + + :EXCEPTION-HANDLERS: + + end function read-url. + *> *************************************************************** + + *> *************************************************************** + *> Supporting libcurl callback + identification division. + program-id. curl-write-callback. + + environment division. + configuration section. + repository. + function all intrinsic. + + data division. + working-storage section. + 01 real-size usage binary-long. + + *> libcURL will pass a pointer to this structure in the callback + 01 memory-block based. + 05 memory-address usage pointer sync. + 05 memory-size usage binary-long sync. + 05 running-total usage binary-long sync. + + 01 content-buffer pic x(65536) based. + 01 web-space pic x(16777216) based. + 01 left-over usage binary-long. + + linkage section. + 01 contents usage pointer. + 01 element-size usage binary-long. + 01 element-count usage binary-long. + 01 memory-structure usage pointer. + + *> *************************************************************** + procedure division + using + by value contents + by value element-size + by value element-count + by value memory-structure + returning real-size. + + set address of memory-block to memory-structure + compute real-size = element-size * element-count end-compute + + *> Fence off the end of buffer + compute + left-over = memory-size - running-total + end-compute + if left-over > 0 and < real-size then + move left-over to real-size + end-if + + *> if there is more buffer, and data not zero length + if (left-over > 0) and (real-size > 1) then + set address of content-buffer to contents + set address of web-space to memory-address + + move content-buffer(1:real-size) + to web-space(running-total:real-size) + + add real-size to running-total + else + display "curl buffer sizing problem" upon syserr + end-if + + goback. + end program curl-write-callback. diff --git a/Task/HTTP/COBOL/http-2.cobol b/Task/HTTP/COBOL/http-2.cobol new file mode 100644 index 0000000000..2c159247b9 --- /dev/null +++ b/Task/HTTP/COBOL/http-2.cobol @@ -0,0 +1,192 @@ + *> manifest constants for libcurl + *> Usage: COPY occurlsym inside data division + *> Taken from include/curl/curl.h 2013-12-19 + + *> Functional enums + 01 CURL_MAX_HTTP_HEADER CONSTANT AS 102400. + + 78 CURL_GLOBAL_ALL VALUE 3. + + 78 CURLOPT_FOLLOWLOCATION VALUE 52. + 78 CURLOPT_WRITEDATA VALUE 10001. + 78 CURLOPT_URL VALUE 10002. + 78 CURLOPT_USERAGENT VALUE 10018. + 78 CURLOPT_WRITEFUNCTION VALUE 20011. + 78 CURLOPT_COOKIEFILE VALUE 10031. + 78 CURLOPT_COOKIEJAR VALUE 10082. + 78 CURLOPT_COOKIELIST VALUE 10135. + + *> Informationals + 78 CURLINFO_COOKIELIST VALUE 4194332. + + *> Result codes + 78 CURLE_OK VALUE 0. + *> Error codes + 78 CURLE_UNSUPPORTED_PROTOCOL VALUE 1. + 78 CURLE_FAILED_INIT VALUE 2. + 78 CURLE_URL_MALFORMAT VALUE 3. + 78 CURLE_OBSOLETE4 VALUE 4. + 78 CURLE_COULDNT_RESOLVE_PROXY VALUE 5. + 78 CURLE_COULDNT_RESOLVE_HOST VALUE 6. + 78 CURLE_COULDNT_CONNECT VALUE 7. + 78 CURLE_FTP_WEIRD_SERVER_REPLY VALUE 8. + 78 CURLE_REMOTE_ACCESS_DENIED VALUE 9. + 78 CURLE_OBSOLETE10 VALUE 10. + 78 CURLE_FTP_WEIRD_PASS_REPLY VALUE 11. + 78 CURLE_OBSOLETE12 VALUE 12. + 78 CURLE_FTP_WEIRD_PASV_REPLY VALUE 13. + 78 CURLE_FTP_WEIRD_227_FORMAT VALUE 14. + 78 CURLE_FTP_CANT_GET_HOST VALUE 15. + 78 CURLE_OBSOLETE16 VALUE 16. + 78 CURLE_FTP_COULDNT_SET_TYPE VALUE 17. + 78 CURLE_PARTIAL_FILE VALUE 18. + 78 CURLE_FTP_COULDNT_RETR_FILE VALUE 19. + 78 CURLE_OBSOLETE20 VALUE 20. + 78 CURLE_QUOTE_ERROR VALUE 21. + 78 CURLE_HTTP_RETURNED_ERROR VALUE 22. + 78 CURLE_WRITE_ERROR VALUE 23. + 78 CURLE_OBSOLETE24 VALUE 24. + 78 CURLE_UPLOAD_FAILED VALUE 25. + 78 CURLE_READ_ERROR VALUE 26. + 78 CURLE_OUT_OF_MEMORY VALUE 27. + 78 CURLE_OPERATION_TIMEDOUT VALUE 28. + 78 CURLE_OBSOLETE29 VALUE 29. + 78 CURLE_FTP_PORT_FAILED VALUE 30. + 78 CURLE_FTP_COULDNT_USE_REST VALUE 31. + 78 CURLE_OBSOLETE32 VALUE 32. + 78 CURLE_RANGE_ERROR VALUE 33. + 78 CURLE_HTTP_POST_ERROR VALUE 34. + 78 CURLE_SSL_CONNECT_ERROR VALUE 35. + 78 CURLE_BAD_DOWNLOAD_RESUME VALUE 36. + 78 CURLE_FILE_COULDNT_READ_FILE VALUE 37. + 78 CURLE_LDAP_CANNOT_BIND VALUE 38. + 78 CURLE_LDAP_SEARCH_FAILED VALUE 39. + 78 CURLE_OBSOLETE40 VALUE 40. + 78 CURLE_FUNCTION_NOT_FOUND VALUE 41. + 78 CURLE_ABORTED_BY_CALLBACK VALUE 42. + 78 CURLE_BAD_FUNCTION_ARGUMENT VALUE 43. + 78 CURLE_OBSOLETE44 VALUE 44. + 78 CURLE_INTERFACE_FAILED VALUE 45. + 78 CURLE_OBSOLETE46 VALUE 46. + 78 CURLE_TOO_MANY_REDIRECTS VALUE 47. + 78 CURLE_UNKNOWN_TELNET_OPTION VALUE 48. + 78 CURLE_TELNET_OPTION_SYNTAX VALUE 49. + 78 CURLE_OBSOLETE50 VALUE 50. + 78 CURLE_PEER_FAILED_VERIFICATION VALUE 51. + 78 CURLE_GOT_NOTHING VALUE 52. + 78 CURLE_SSL_ENGINE_NOTFOUND VALUE 53. + 78 CURLE_SSL_ENGINE_SETFAILED VALUE 54. + 78 CURLE_SEND_ERROR VALUE 55. + 78 CURLE_RECV_ERROR VALUE 56. + 78 CURLE_OBSOLETE57 VALUE 57. + 78 CURLE_SSL_CERTPROBLEM VALUE 58. + 78 CURLE_SSL_CIPHER VALUE 59. + 78 CURLE_SSL_CACERT VALUE 60. + 78 CURLE_BAD_CONTENT_ENCODING VALUE 61. + 78 CURLE_LDAP_INVALID_URL VALUE 62. + 78 CURLE_FILESIZE_EXCEEDED VALUE 63. + 78 CURLE_USE_SSL_FAILED VALUE 64. + 78 CURLE_SEND_FAIL_REWIND VALUE 65. + 78 CURLE_SSL_ENGINE_INITFAILED VALUE 66. + 78 CURLE_LOGIN_DENIED VALUE 67. + 78 CURLE_TFTP_NOTFOUND VALUE 68. + 78 CURLE_TFTP_PERM VALUE 69. + 78 CURLE_REMOTE_DISK_FULL VALUE 70. + 78 CURLE_TFTP_ILLEGAL VALUE 71. + 78 CURLE_TFTP_UNKNOWNID VALUE 72. + 78 CURLE_REMOTE_FILE_EXISTS VALUE 73. + 78 CURLE_TFTP_NOSUCHUSER VALUE 74. + 78 CURLE_CONV_FAILED VALUE 75. + 78 CURLE_CONV_REQD VALUE 76. + 78 CURLE_SSL_CACERT_BADFILE VALUE 77. + 78 CURLE_REMOTE_FILE_NOT_FOUND VALUE 78. + 78 CURLE_SSH VALUE 79. + 78 CURLE_SSL_SHUTDOWN_FAILED VALUE 80. + 78 CURLE_AGAIN VALUE 81. + + *> Error strings + 01 LIBCURL_ERRORS. + 02 CURLEVALUES. + 03 FILLER PIC X(30) VALUE "CURLE_UNSUPPORTED_PROTOCOL ". + 03 FILLER PIC X(30) VALUE "CURLE_FAILED_INIT ". + 03 FILLER PIC X(30) VALUE "CURLE_URL_MALFORMAT ". + 03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE4 ". + 03 FILLER PIC X(30) VALUE "CURLE_COULDNT_RESOLVE_PROXY ". + 03 FILLER PIC X(30) VALUE "CURLE_COULDNT_RESOLVE_HOST ". + 03 FILLER PIC X(30) VALUE "CURLE_COULDNT_CONNECT ". + 03 FILLER PIC X(30) VALUE "CURLE_FTP_WEIRD_SERVER_REPLY ". + 03 FILLER PIC X(30) VALUE "CURLE_REMOTE_ACCESS_DENIED ". + 03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE10 ". + 03 FILLER PIC X(30) VALUE "CURLE_FTP_WEIRD_PASS_REPLY ". + 03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE12 ". + 03 FILLER PIC X(30) VALUE "CURLE_FTP_WEIRD_PASV_REPLY ". + 03 FILLER PIC X(30) VALUE "CURLE_FTP_WEIRD_227_FORMAT ". + 03 FILLER PIC X(30) VALUE "CURLE_FTP_CANT_GET_HOST ". + 03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE16 ". + 03 FILLER PIC X(30) VALUE "CURLE_FTP_COULDNT_SET_TYPE ". + 03 FILLER PIC X(30) VALUE "CURLE_PARTIAL_FILE ". + 03 FILLER PIC X(30) VALUE "CURLE_FTP_COULDNT_RETR_FILE ". + 03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE20 ". + 03 FILLER PIC X(30) VALUE "CURLE_QUOTE_ERROR ". + 03 FILLER PIC X(30) VALUE "CURLE_HTTP_RETURNED_ERROR ". + 03 FILLER PIC X(30) VALUE "CURLE_WRITE_ERROR ". + 03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE24 ". + 03 FILLER PIC X(30) VALUE "CURLE_UPLOAD_FAILED ". + 03 FILLER PIC X(30) VALUE "CURLE_READ_ERROR ". + 03 FILLER PIC X(30) VALUE "CURLE_OUT_OF_MEMORY ". + 03 FILLER PIC X(30) VALUE "CURLE_OPERATION_TIMEDOUT ". + 03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE29 ". + 03 FILLER PIC X(30) VALUE "CURLE_FTP_PORT_FAILED ". + 03 FILLER PIC X(30) VALUE "CURLE_FTP_COULDNT_USE_REST ". + 03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE32 ". + 03 FILLER PIC X(30) VALUE "CURLE_RANGE_ERROR ". + 03 FILLER PIC X(30) VALUE "CURLE_HTTP_POST_ERROR ". + 03 FILLER PIC X(30) VALUE "CURLE_SSL_CONNECT_ERROR ". + 03 FILLER PIC X(30) VALUE "CURLE_BAD_DOWNLOAD_RESUME ". + 03 FILLER PIC X(30) VALUE "CURLE_FILE_COULDNT_READ_FILE ". + 03 FILLER PIC X(30) VALUE "CURLE_LDAP_CANNOT_BIND ". + 03 FILLER PIC X(30) VALUE "CURLE_LDAP_SEARCH_FAILED ". + 03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE40 ". + 03 FILLER PIC X(30) VALUE "CURLE_FUNCTION_NOT_FOUND ". + 03 FILLER PIC X(30) VALUE "CURLE_ABORTED_BY_CALLBACK ". + 03 FILLER PIC X(30) VALUE "CURLE_BAD_FUNCTION_ARGUMENT ". + 03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE44 ". + 03 FILLER PIC X(30) VALUE "CURLE_INTERFACE_FAILED ". + 03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE46 ". + 03 FILLER PIC X(30) VALUE "CURLE_TOO_MANY_REDIRECTS ". + 03 FILLER PIC X(30) VALUE "CURLE_UNKNOWN_TELNET_OPTION ". + 03 FILLER PIC X(30) VALUE "CURLE_TELNET_OPTION_SYNTAX ". + 03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE50 ". + 03 FILLER PIC X(30) VALUE "CURLE_PEER_FAILED_VERIFICATION". + 03 FILLER PIC X(30) VALUE "CURLE_GOT_NOTHING ". + 03 FILLER PIC X(30) VALUE "CURLE_SSL_ENGINE_NOTFOUND ". + 03 FILLER PIC X(30) VALUE "CURLE_SSL_ENGINE_SETFAILED ". + 03 FILLER PIC X(30) VALUE "CURLE_SEND_ERROR ". + 03 FILLER PIC X(30) VALUE "CURLE_RECV_ERROR ". + 03 FILLER PIC X(30) VALUE "CURLE_OBSOLETE57 ". + 03 FILLER PIC X(30) VALUE "CURLE_SSL_CERTPROBLEM ". + 03 FILLER PIC X(30) VALUE "CURLE_SSL_CIPHER ". + 03 FILLER PIC X(30) VALUE "CURLE_SSL_CACERT ". + 03 FILLER PIC X(30) VALUE "CURLE_BAD_CONTENT_ENCODING ". + 03 FILLER PIC X(30) VALUE "CURLE_LDAP_INVALID_URL ". + 03 FILLER PIC X(30) VALUE "CURLE_FILESIZE_EXCEEDED ". + 03 FILLER PIC X(30) VALUE "CURLE_USE_SSL_FAILED ". + 03 FILLER PIC X(30) VALUE "CURLE_SEND_FAIL_REWIND ". + 03 FILLER PIC X(30) VALUE "CURLE_SSL_ENGINE_INITFAILED ". + 03 FILLER PIC X(30) VALUE "CURLE_LOGIN_DENIED ". + 03 FILLER PIC X(30) VALUE "CURLE_TFTP_NOTFOUND ". + 03 FILLER PIC X(30) VALUE "CURLE_TFTP_PERM ". + 03 FILLER PIC X(30) VALUE "CURLE_REMOTE_DISK_FULL ". + 03 FILLER PIC X(30) VALUE "CURLE_TFTP_ILLEGAL ". + 03 FILLER PIC X(30) VALUE "CURLE_TFTP_UNKNOWNID ". + 03 FILLER PIC X(30) VALUE "CURLE_REMOTE_FILE_EXISTS ". + 03 FILLER PIC X(30) VALUE "CURLE_TFTP_NOSUCHUSER ". + 03 FILLER PIC X(30) VALUE "CURLE_CONV_FAILED ". + 03 FILLER PIC X(30) VALUE "CURLE_CONV_REQD ". + 03 FILLER PIC X(30) VALUE "CURLE_SSL_CACERT_BADFILE ". + 03 FILLER PIC X(30) VALUE "CURLE_REMOTE_FILE_NOT_FOUND ". + 03 FILLER PIC X(30) VALUE "CURLE_SSH ". + 03 FILLER PIC X(30) VALUE "CURLE_SSL_SHUTDOWN_FAILED ". + 03 FILLER PIC X(30) VALUE "CURLE_AGAIN ". + 01 FILLER REDEFINES LIBCURL_ERRORS. + 02 CURLEMSG OCCURS 81 TIMES PIC X(30). diff --git a/Task/HTTP/JavaScript/http-1.js b/Task/HTTP/JavaScript/http-1.js index 336fe95110..407e801e8c 100644 --- a/Task/HTTP/JavaScript/http-1.js +++ b/Task/HTTP/JavaScript/http-1.js @@ -1,4 +1,4 @@ -var req = new XMLHTTPRequest(); +var req = new XMLHttpRequest(); req.onload = function() { console.log(this.responseText); }; diff --git a/Task/HTTP/Perl/http-1.pl b/Task/HTTP/Perl/http-1.pl index 36f0956821..8821dbed42 100644 --- a/Task/HTTP/Perl/http-1.pl +++ b/Task/HTTP/Perl/http-1.pl @@ -1,2 +1,5 @@ -use LWP::Simple; -print get("http://www.rosettacode.org"); +use strict; use warnings; +require 5.014; # check HTTP::Tiny part of core +use HTTP::Tiny; + +print( HTTP::Tiny->new()->get( 'http://rosettacode.org')->{content} ); diff --git a/Task/HTTP/Perl/http-2.pl b/Task/HTTP/Perl/http-2.pl index 10b8260a83..ccb8ab2446 100644 --- a/Task/HTTP/Perl/http-2.pl +++ b/Task/HTTP/Perl/http-2.pl @@ -1,9 +1,3 @@ -use strict; -use LWP::UserAgent; - -my $url = 'http://www.rosettacode.org'; -my $response = LWP::UserAgent->new->get( $url ); - -$response->is_success or die "Failed to GET '$url': ", $response->status_line; - -print $response->as_string; +use LWP::Simple qw/get $ua/; +$ua->agent(undef) ; # cloudflare blocks default LWP agent +print( get("http://www.rosettacode.org") ); diff --git a/Task/HTTP/Perl/http-3.pl b/Task/HTTP/Perl/http-3.pl new file mode 100644 index 0000000000..471c19d5d8 --- /dev/null +++ b/Task/HTTP/Perl/http-3.pl @@ -0,0 +1,9 @@ +use strict; +use LWP::UserAgent; + +my $url = 'http://www.rosettacode.org'; +my $response = LWP::UserAgent->new->get( $url ); + +$response->is_success or die "Failed to GET '$url': ", $response->status_line; + +print $response->as_string diff --git a/Task/HTTP/Python/http-2.py b/Task/HTTP/Python/http-2.py index 00887667c4..03644afa91 100644 --- a/Task/HTTP/Python/http-2.py +++ b/Task/HTTP/Python/http-2.py @@ -1,2 +1,7 @@ -import urllib -print urllib.urlopen("http://rosettacode.org").read() +from http.client import HTTPConnection +conn = HTTPConnection("example.com") +# If you need to use set_tunnel, do so here. +conn.request("GET", "/") +# Alternatively, you can use connect(), followed by the putrequest, putheader and endheaders functions. +result = conn.getresponse() +r1 = result.read() # This retrieves the entire contents. diff --git a/Task/HTTP/Python/http-3.py b/Task/HTTP/Python/http-3.py index d0d4a06ab3..00887667c4 100644 --- a/Task/HTTP/Python/http-3.py +++ b/Task/HTTP/Python/http-3.py @@ -1,2 +1,2 @@ -import urllib2 -print urllib2.urlopen("http://rosettacode.org").read() +import urllib +print urllib.urlopen("http://rosettacode.org").read() diff --git a/Task/HTTP/Python/http-4.py b/Task/HTTP/Python/http-4.py new file mode 100644 index 0000000000..d0d4a06ab3 --- /dev/null +++ b/Task/HTTP/Python/http-4.py @@ -0,0 +1,2 @@ +import urllib2 +print urllib2.urlopen("http://rosettacode.org").read() diff --git a/Task/HTTP/REXX/http-1.rexx b/Task/HTTP/REXX/http-1.rexx new file mode 100644 index 0000000000..b904014fc0 --- /dev/null +++ b/Task/HTTP/REXX/http-1.rexx @@ -0,0 +1,5 @@ +/* ft=rexx */ +/* GET2.RX - Display contents of an URL on the terminal. */ +/* Usage: rexx get.rx http://rosettacode.org */ +parse arg url . +'curl' url diff --git a/Task/HTTP/REXX/http-2.rexx b/Task/HTTP/REXX/http-2.rexx new file mode 100644 index 0000000000..920212c19d --- /dev/null +++ b/Task/HTTP/REXX/http-2.rexx @@ -0,0 +1,8 @@ +/* ft=rexx */ +/* GET2.RX - Display contents of an URL on the terminal. */ +/* Usage: rexx get2.rx http://rosettacode.org */ +parse arg url . +address system 'curl' url with output stem stuff. +do i = 1 to stuff.0 + say stuff.i +end diff --git a/Task/HTTP/REXX/http-3.rexx b/Task/HTTP/REXX/http-3.rexx new file mode 100644 index 0000000000..038512e2ad --- /dev/null +++ b/Task/HTTP/REXX/http-3.rexx @@ -0,0 +1,6 @@ +/* ft=rexx */ +/* GET3.RX - Display contents of an URL on the terminal. */ +/* Usage: rexx get3.rx http://rosettacode.org */ +parse arg url . +address system 'curl' url with output fifo '' +address system 'more' with input fifo '' diff --git a/Task/HTTP/Rust/http-1.rust b/Task/HTTP/Rust/http-1.rust index f46ef69980..3c9fd1337d 100644 --- a/Task/HTTP/Rust/http-1.rust +++ b/Task/HTTP/Rust/http-1.rust @@ -1,2 +1,2 @@ -[dependencdies] +[dependencies] hyper = "0.6" diff --git a/Task/HTTP/Rust/http-2.rust b/Task/HTTP/Rust/http-2.rust index be976174ac..7691355346 100644 --- a/Task/HTTP/Rust/http-2.rust +++ b/Task/HTTP/Rust/http-2.rust @@ -1,3 +1,5 @@ +//cargo-deps: hyper="0.6" +// The above line can be used with cargo-script which makes cargo's dependency handling more convenient for small programs extern crate hyper; use std::io::Read; diff --git a/Task/HTTPS/00DESCRIPTION b/Task/HTTPS/00DESCRIPTION index 3ef351d1db..add65a4a90 100644 --- a/Task/HTTPS/00DESCRIPTION +++ b/Task/HTTPS/00DESCRIPTION @@ -1,3 +1,7 @@ -Print an HTTPS URL's content to the console. Checking the host certificate for validity is recommended. The client should not authenticate itself to the server — the webpage https://sourceforge.net/ supports that access policy — as that is the subject of other [[HTTPS request with authentication|tasks]]. +;Task: +Print an HTTPS URL's content to the console. Checking the host certificate for validity is recommended. + +The client should not authenticate itself to the server — the webpage https://sourceforge.net/ supports that access policy — as that is the subject of other [[HTTPS request with authentication|tasks]]. Readers may wish to contrast with the [[HTTP Request]] task, and also the task on [[HTTPS request with authentication]]. +

    diff --git a/Task/HTTPS/Fortran/https.f b/Task/HTTPS/Fortran/https.f new file mode 100644 index 0000000000..ae010e59ef --- /dev/null +++ b/Task/HTTPS/Fortran/https.f @@ -0,0 +1,17 @@ +program https_example + implicit none + character (len=:), allocatable :: code + character (len=:), allocatable :: command + logical:: waitForProcess + + ! execute Node.js code + code = "var https = require('https'); & + https.get('https://sourceforge.net/', function(res) {& + console.log('statusCode: ', res.statusCode);& + console.log('Is authorized:' + res.socket.authorized);& + console.log(res.socket.getPeerCertificate());& + res.on('data', function(d) {process.stdout.write(d);});});" + + command = 'node -e "' // code // '"' + call execute_command_line (command, wait=waitForProcess) +end program https_example diff --git a/Task/HTTPS/Ruby/https.rb b/Task/HTTPS/Ruby/https.rb index 6a1d5df7bd..0ed399e519 100644 --- a/Task/HTTPS/Ruby/https.rb +++ b/Task/HTTPS/Ruby/https.rb @@ -8,7 +8,7 @@ http.use_ssl = true http.verify_mode = OpenSSL::SSL::VERIFY_NONE http.start do - content = http.get("/") + content = http.get(uri) p [content.code, content.message] pp content.to_hash puts content.body diff --git a/Task/HTTPS/Unicon/https.unicon b/Task/HTTPS/Unicon/https.unicon new file mode 100644 index 0000000000..78c31fb34e --- /dev/null +++ b/Task/HTTPS/Unicon/https.unicon @@ -0,0 +1,7 @@ +# Requires Unicon version 13 +procedure main(arglist) + url := (\arglist[1] | "https://sourceforge.net/") + w := open(url, "m-") | stop("Cannot open " || url) + while write(read(w)) + close(w) +end diff --git a/Task/Hailstone-sequence/00DESCRIPTION b/Task/Hailstone-sequence/00DESCRIPTION index 1727cdeab1..d6f92d4d17 100644 --- a/Task/Hailstone-sequence/00DESCRIPTION +++ b/Task/Hailstone-sequence/00DESCRIPTION @@ -1,14 +1,21 @@ -The Hailstone sequence of numbers can be generated from a starting positive integer, n by: -* If n is 1 then the sequence ends. -* If n is even then the next n of the sequence = n/2 -* If n is odd then the next n of the sequence = (3 * n) + 1 +The Hailstone sequence of numbers can be generated from a starting positive integer,   n   by: +*   If   n   is     '''1'''     then the sequence ends. +*   If   n   is   '''even''' then the next   n   of the sequence   = n/2 +*   If   n   is   '''odd'''   then the next   n   of the sequence   = (3 * n) + 1 -The (unproven), [[wp:Collatz conjecture|Collatz conjecture]] is that the hailstone sequence for any starting number always terminates. -'''Task Description:''' -# Create a routine to generate the hailstone sequence for a number. -# Use the routine to show that the hailstone sequence for the number 27 has 112 elements starting with 27, 82, 41, 124 and ending with 8, 4, 2, 1 -# Show the number less than 100,000 which has the longest hailstone sequence together with that sequence's length.
    (But don't show the actual sequence!) +The (unproven),   [[wp:Collatz conjecture|Collatz conjecture]]   is that the hailstone sequence for any starting number always terminates. -'''See Also:'''
    -* [http://xkcd.com/710 xkcd] (humourous). + +The   ''hailstone sequence''   is also known as   ''hailstone numbers''   (because the values are usually subject to multiple descents and ascents like hailstones in a cloud).   The   ''hailstone sequence''   is also sometimes known as the   ''Collatz sequence''. + + +;Task: +#   Create a routine to generate the hailstone sequence for a number. +#   Use the routine to show that the hailstone sequence for the number 27 has 112 elements starting with 27, 82, 41, 124 and ending with 8, 4, 2, 1 +#   Show the number less than 100,000 which has the longest hailstone sequence together with that sequence's length.
      (But don't show the actual sequence!) + + +;See also: +*   [http://xkcd.com/710 xkcd] (humourous). +

    diff --git a/Task/Hailstone-sequence/BASIC/hailstone-sequence-3.basic b/Task/Hailstone-sequence/BASIC/hailstone-sequence-3.basic index 3eb772985a..25ddfbd791 100644 --- a/Task/Hailstone-sequence/BASIC/hailstone-sequence-3.basic +++ b/Task/Hailstone-sequence/BASIC/hailstone-sequence-3.basic @@ -85,7 +85,7 @@ Next Print "The longest sequence is for "; max_x; ", it has a sequence length of "; max_seq ' empty keyboard buffer -While Inkey <> "" : Var _key_ = Inkey : Wend +While Inkey <> "" : Wend Print : Print : Print "hit any key to end program" Sleep End diff --git a/Task/Hailstone-sequence/COBOL/hailstone-sequence.cobol b/Task/Hailstone-sequence/COBOL/hailstone-sequence.cobol new file mode 100644 index 0000000000..e952d06a97 --- /dev/null +++ b/Task/Hailstone-sequence/COBOL/hailstone-sequence.cobol @@ -0,0 +1,90 @@ + identification division. + program-id. hailstones. + remarks. cobc -x hailstones.cob. + + data division. + working-storage section. + 01 most constant as 1000000. + 01 coverage constant as 100000. + 01 stones usage binary-long. + 01 n usage binary-long. + 01 storm usage binary-long. + + 01 show-arg pic 9(6). + 01 show-default pic 99 value 27. + 01 show-sequence usage binary-long. + 01 longest usage binary-long occurs 2 times. + + 01 filler. + 05 hail usage binary-long + occurs 0 to most depending on stones. + 01 show pic z(10). + 01 low-range usage binary-long. + 01 high-range usage binary-long. + 01 range usage binary-long. + + + 01 remain usage binary-long. + 01 unused usage binary-long. + + procedure division. + accept show-arg from command-line + if show-arg less than 1 or greater than coverage then + move show-default to show-arg + end-if + move show-arg to show-sequence + + move 1 to longest(1) + perform hailstone varying storm + from 1 by 1 until storm > coverage + display "Longest at: " longest(2) " with " longest(1) " elements" + goback. + + *> ************************************************************** + hailstone. + move 0 to stones + move storm to n + perform until n equal 1 + if stones > most then + display "too many hailstones" upon syserr + stop run + end-if + + add 1 to stones + move n to hail(stones) + divide n by 2 giving unused remainder remain + if remain equal 0 then + divide 2 into n + else + compute n = 3 * n + 1 + end-if + end-perform + add 1 to stones + move n to hail(stones) + + if stones > longest(1) then + move stones to longest(1) + move storm to longest(2) + end-if + + if storm equal show-sequence then + display show-sequence ": " with no advancing + perform varying range from 1 by 1 until range > stones + move 5 to low-range + compute high-range = stones - 4 + if range < low-range or range > high-range then + move hail(range) to show + display function trim(show) with no advancing + if range < stones then + display ", " with no advancing + end-if + end-if + if range = low-range and stones > 8 then + display "..., " with no advancing + end-if + end-perform + display ": " stones " elements" + end-if + . + + end program hailstones. diff --git a/Task/Hailstone-sequence/Frink/hailstone-sequence.frink b/Task/Hailstone-sequence/Frink/hailstone-sequence.frink new file mode 100644 index 0000000000..facccd56f6 --- /dev/null +++ b/Task/Hailstone-sequence/Frink/hailstone-sequence.frink @@ -0,0 +1,30 @@ +hailstone[n] := +{ + results = new array + + while n != 1 + { + results.push[n] + if n mod 2 == 0 // n is even? + n = n / 2 + else + n = (3n + 1) + } + + results.push[1] + return results +} + +longestLen = 0 +longestN = 0 +for n = 1 to 100000 +{ + seq = hailstone[n] + if length[seq] > longestLen + { + longestLen = length[seq] + longestN = n + } +} + +println["$longestN has length $longestLen"] diff --git a/Task/Hailstone-sequence/Io/hailstone-sequence.io b/Task/Hailstone-sequence/Io/hailstone-sequence.io index 8f2c6e4167..5ec3459580 100644 --- a/Task/Hailstone-sequence/Io/hailstone-sequence.io +++ b/Task/Hailstone-sequence/Io/hailstone-sequence.io @@ -7,6 +7,7 @@ makeItHail := method(n, ) stones append(n) ) + stones ) out := makeItHail(27) diff --git a/Task/Hailstone-sequence/Kotlin/hailstone-sequence.kotlin b/Task/Hailstone-sequence/Kotlin/hailstone-sequence.kotlin index 776e8278aa..db16ea4555 100644 --- a/Task/Hailstone-sequence/Kotlin/hailstone-sequence.kotlin +++ b/Task/Hailstone-sequence/Kotlin/hailstone-sequence.kotlin @@ -1,29 +1,24 @@ import java.util.ArrayDeque -fun hailstone(n : Int) : ArrayDeque { +fun hailstone(n: Int): ArrayDeque { val hails = when { n == 1 -> ArrayDeque() n % 2 == 0 -> hailstone(n / 2) else -> hailstone(3 * n + 1) } - hails addFirst(n) + hails.addFirst(n) return hails } -fun main(args : Array) { +fun main(args: Array) { val hail27 = hailstone(27) - fun showSeq(s : List) = s map {it.toString()} reduce {a, b -> a + ", " + b} - System.out.println( - "Hailstone sequence for 27 is " + - showSeq(hail27 take(3)) + " ... " + showSeq(hail27 drop(hail27.size - 3)) + - " with length ${hail27.size}." - ) + fun showSeq(s: List) = s.map { it.toString() }.reduce { a, b -> a + ", " + b } + println("Hailstone sequence for 27 is " + showSeq(hail27.take(3)) + " ... " + + showSeq(hail27.drop(hail27.size - 3)) + " with length ${hail27.size}.") var longestHail = hailstone(1) - for (x in 1 .. 99999) - longestHail = array(hailstone(x), longestHail) maxBy {it.size} ?: longestHail - System.out.println( - "${longestHail.getFirst()} is the number less than 100000 with " + - "the longest sequence, having length ${longestHail.size}." - ) + for (x in 1..99999) + longestHail = arrayOf(hailstone(x), longestHail).maxBy { it.size } ?: longestHail + println("${longestHail.first} is the number less than 100000 with " + + "the longest sequence, having length ${longestHail.size}.") } diff --git a/Task/Hailstone-sequence/Mathematica/hailstone-sequence-1.math b/Task/Hailstone-sequence/Mathematica/hailstone-sequence-1.math index 42848f35f8..81847fcc01 100644 --- a/Task/Hailstone-sequence/Mathematica/hailstone-sequence-1.math +++ b/Task/Hailstone-sequence/Mathematica/hailstone-sequence-1.math @@ -1 +1 @@ -HailstoneFP[n_Integer] := Most[FixedPointList[Which[# == 1, 1, EvenQ[#] , #/2, OddQ[#], (3*# + 1)] &, n]] +HailstoneF[n_] := NestWhileList[If[OddQ@#, 3 # + 1, #/2] &, n, # > 1 &] diff --git a/Task/Hailstone-sequence/Mathematica/hailstone-sequence-2.math b/Task/Hailstone-sequence/Mathematica/hailstone-sequence-2.math index 444033c53b..0ffff40d48 100644 --- a/Task/Hailstone-sequence/Mathematica/hailstone-sequence-2.math +++ b/Task/Hailstone-sequence/Mathematica/hailstone-sequence-2.math @@ -1,3 +1 @@ -HailstoneR[1] := {1} -HailstoneR[n_Integer] := Prepend[HailstoneR[3 n + 1], n] /; OddQ[n] && n > 0 -HailstoneR[n_Integer] := Prepend[HailstoneR[n/2], n] /; EvenQ[n] && n > 0 +HailstoneFP[n_] := Most@FixedPointList[Switch[#, 1, 1, _?OddQ , 3# + 1, _, #/2] &, n] diff --git a/Task/Hailstone-sequence/Mathematica/hailstone-sequence-3.math b/Task/Hailstone-sequence/Mathematica/hailstone-sequence-3.math index e23afcd595..9766fbaf81 100644 --- a/Task/Hailstone-sequence/Mathematica/hailstone-sequence-3.math +++ b/Task/Hailstone-sequence/Mathematica/hailstone-sequence-3.math @@ -1,4 +1,3 @@ -hailstone[n_Integer] := Block[{sequence = {}, c = n}, - While[c > 1, c = If[EvenQ[c], c/2, 3 c + 1]; - AppendTo[sequence, c]]; - sequence] +HailstoneR[1] = {1} +HailstoneR[n_?OddQ] := Prepend[HailstoneR[3 n + 1], n] +HailstoneR[n_] := Prepend[HailstoneR[n/2], n] diff --git a/Task/Hailstone-sequence/Mathematica/hailstone-sequence-4.math b/Task/Hailstone-sequence/Mathematica/hailstone-sequence-4.math index 008b44e926..bc8ab7c3a2 100644 --- a/Task/Hailstone-sequence/Mathematica/hailstone-sequence-4.math +++ b/Task/Hailstone-sequence/Mathematica/hailstone-sequence-4.math @@ -1,12 +1,2 @@ -Hailstone[n_] := - NestWhileList[Which[Mod[#, 2] == 0, #/2, True, ( 3*# + 1) ] &, n, # != 1 &]; -c27 = Hailstone@27; -Print["Hailstone sequence for n = 27: [", c27[[;; 4]], "...", c27[[-4 ;;]], "]"] -Print["Length Hailstone[27] = ", Length@c27] - -longest = -1; comp = 0; -Do[temp = Length@Hailstone@i; - If[comp < temp, comp = temp; longest = i], - {i, 100000} - ] -Print["Longest Hailstone sequence at n = ", longest, "\nwith length = ", comp]; +HailstoneP[n_] := Module[{x = {n}, s = n}, + While[s > 1, x = {x, s = If[OddQ@s, 3 s + 1, s/2]}]; Flatten@x] diff --git a/Task/Hailstone-sequence/Mathematica/hailstone-sequence-5.math b/Task/Hailstone-sequence/Mathematica/hailstone-sequence-5.math index 916fedb5bf..1a3d24bca2 100644 --- a/Task/Hailstone-sequence/Mathematica/hailstone-sequence-5.math +++ b/Task/Hailstone-sequence/Mathematica/hailstone-sequence-5.math @@ -1 +1,14 @@ -With[{seq = HailstoneFP[27]}, { Length[seq], Take[seq, 4], Take[seq, -4]}] +Hailstone[n_] := + NestWhileList[Which[Mod[#, 2] == 0, #/2, True, ( 3*# + 1) ] &, n, # != 1 &]; + + +c27 = Hailstone@27; +Print["Hailstone sequence for n = 27: [", c27[[;; 4]], "...", c27[[-4 ;;]], "]"] +Print["Length Hailstone[27] = ", Length@c27] + +longest = -1; comp = 0; +Do[temp = Length@Hailstone@i; + If[comp < temp, comp = temp; longest = i], + {i, 100000} + ] +Print["Longest Hailstone sequence at n = ", longest, "\nwith length = ", comp]; diff --git a/Task/Hailstone-sequence/Mathematica/hailstone-sequence-6.math b/Task/Hailstone-sequence/Mathematica/hailstone-sequence-6.math index d95d8e083f..916fedb5bf 100644 --- a/Task/Hailstone-sequence/Mathematica/hailstone-sequence-6.math +++ b/Task/Hailstone-sequence/Mathematica/hailstone-sequence-6.math @@ -1 +1 @@ -Short[HailstoneFP[27],0.45] +With[{seq = HailstoneFP[27]}, { Length[seq], Take[seq, 4], Take[seq, -4]}] diff --git a/Task/Hailstone-sequence/Mathematica/hailstone-sequence-7.math b/Task/Hailstone-sequence/Mathematica/hailstone-sequence-7.math index d31f38fb6a..d95d8e083f 100644 --- a/Task/Hailstone-sequence/Mathematica/hailstone-sequence-7.math +++ b/Task/Hailstone-sequence/Mathematica/hailstone-sequence-7.math @@ -1 +1 @@ -MaximalBy[Table[{i, Length[HailstoneFP[i]]}, {i, 100000}], Last] +Short[HailstoneFP[27],0.45] diff --git a/Task/Hailstone-sequence/Mathematica/hailstone-sequence-8.math b/Task/Hailstone-sequence/Mathematica/hailstone-sequence-8.math new file mode 100644 index 0000000000..d31f38fb6a --- /dev/null +++ b/Task/Hailstone-sequence/Mathematica/hailstone-sequence-8.math @@ -0,0 +1 @@ +MaximalBy[Table[{i, Length[HailstoneFP[i]]}, {i, 100000}], Last] diff --git a/Task/Hailstone-sequence/PARI-GP/hailstone-sequence.pari b/Task/Hailstone-sequence/PARI-GP/hailstone-sequence-1.pari similarity index 100% rename from Task/Hailstone-sequence/PARI-GP/hailstone-sequence.pari rename to Task/Hailstone-sequence/PARI-GP/hailstone-sequence-1.pari diff --git a/Task/Hailstone-sequence/PARI-GP/hailstone-sequence-2.pari b/Task/Hailstone-sequence/PARI-GP/hailstone-sequence-2.pari new file mode 100644 index 0000000000..22ea500e73 --- /dev/null +++ b/Task/Hailstone-sequence/PARI-GP/hailstone-sequence-2.pari @@ -0,0 +1,22 @@ +\\ Get vector with Collatz sequence for the specified starting number. +\\ Limit vector to the lim length, or less, if 1 (one) term is reached (when lim=0). +\\ 3/26/2016 aev +Collatz(n,lim=0)={ +my(c=n,e=0,L=List(n)); if(lim==0, e=1; lim=n*10^6); +for(i=1,lim, if(c%2==0, c=c/2, c=3*c+1); listput(L,c); if(e&&c==1, break)); +return(Vec(L)); } +Collatzmax(ns,nf)={ +my(V,vn,mxn=1,mx,im=1); +print("Search range: ",ns,"..",nf); +for(i=ns,nf, V=Collatz(i); vn=#V; if(vn>mxn, mxn=vn; im=i); kill(V)); +print("Hailstone/Collatz(",im,") has the longest length = ",mxn); +} + +{ +\\ Required tests: +print("Required tests:"); +my(Vr,vrn); +Vr=Collatz(27); vrn=#Vr; +print("Hailstone/Collatz(27): ",Vr[1..4]," ... ",Vr[vrn-3..vrn],"; length = ",vrn); +Collatzmax(1,100000); +} diff --git a/Task/Hailstone-sequence/Pascal/hailstone-sequence.pascal b/Task/Hailstone-sequence/Pascal/hailstone-sequence.pascal index f060a674bd..be75123901 100644 --- a/Task/Hailstone-sequence/Pascal/hailstone-sequence.pascal +++ b/Task/Hailstone-sequence/Pascal/hailstone-sequence.pascal @@ -4,91 +4,106 @@ program ShowHailstoneSequence; {$Else} {$Apptype Console} // for delphi {$ENDIF} - uses SysUtils;// format -type - tIntArr = record - iaAktPos : integer; - iaMaxPos : integer; - iaArr : array of integer; - end; +const + maxN = 10*1000*1000;// for output 1000*1000*1000 -procedure GetHailstoneSequence(aStartingNumber: Integer;var aHailstoneList: tIntArr); +type + tiaArr = array[0..1000] of Uint64; + tIntArr = record + iaMaxPos : integer; + iaArr : tiaArr + end; + tpiaArr = ^tiaArr; + +function HailstoneSeqCnt(n: UInt64): NativeInt; +begin + result := 0; + //ensure n to be odd + while not(ODD(n)) do + Begin + inc(result); + n := n shr 1; + end; + + IF n > 1 then + repeat + //now n == odd -> so two steps in one can be made + repeat + n := (3*n+1) SHR 1;inc(result,2); + until NOT(Odd(n)); + //now n == even -> so only one step can be made + repeat + n := n shr 1; inc(result); + until odd(n); + until n = 1; +end; + +procedure GetHailstoneSequence(aStartingNumber: NativeUint;var aHailstoneList: tIntArr); var + maxPos: NativeInt; n: UInt64; + pArr : tpiaArr; begin with aHailstoneList do begin - iaAktPos := 0; - iaArr[iaAktPos] := aStartingNumber; - n := aStartingNumber; - while n <> 1 do - begin - if Odd(n) then - n := (3 * n) + 1 - else - n := n div 2; - inc(iaAktPos); - IF iaAktPos>iaMaxPos then - Begin - iaMaxPos := round(iaMaxPos*1.62)+2; - setlength(iaArr,iaMaxPos+1); - end; - iaArr[iaAktPos] := n; - end; + maxPos := 0; + pArr := @iaArr; end; + n := aStartingNumber; + pArr^[maxPos] := n; + while n <> 1 do + begin + if odd(n) then + n := (3*n+1) + else + n := n shr 1; + inc(maxPos); + pArr^[maxPos] := n; + end; + aHailstoneList.iaMaxPos := maxPos; end; var - i,Limit: Integer; + i,Limit: NativeInt; lList: tIntArr; - lMaxSequence: Integer; - lMaxLength: Integer; + lAverageLength:Uint64; + lMaxSequence: NativeInt; + lMaxLength,lgth: NativeInt; begin - try - with lList do - begin - setlength(iaArr,0+1); - iaMaxPos := 0; - iaAktPos := 0; - end; - - GetHailstoneSequence(27, lList); - with lList do - begin - i := iaAktPos+1; - Writeln(Format('27: %d elements', [i])); - Writeln(Format('[%d,%d,%d,%d ... %d,%d,%d,%d]', - [iaArr[0], iaArr[1], iaArr[2], iaArr[3], - iaArr[i - 4], iaArr[i - 3], iaArr[i - 2], iaArr[i - 1]])); - Writeln; - - lMaxSequence := 0; - lMaxLength := 0; - limit := 10; - for i := 1 to 10000000 do - begin - GetHailstoneSequence(i, lList); - if iaAktPos >= lMaxLength then - begin - IF i> limit then - begin - Writeln(Format('Longest sequence under %8d : %7d with %3d elements', - [limit,lMaxSequence, lMaxLength])); - limit := limit*10; - end; - lMaxSequence := i; - lMaxLength := iaAktPos+1; - end; - end; - Writeln(Format('Longest sequence under %8d : %7d with %3d elements', - [limit,lMaxSequence, lMaxLength])); - - end; - finally - setlength(lList.iaArr,0); + lList.iaMaxPos := 0; + GetHailstoneSequence(27, lList);//319804831 + with lList do + begin + Limit := iaMaxPos; + writeln(Format('sequence of %d has %d elements',[iaArr[0],Limit+1])); + write(iaArr[0],',',iaArr[1],',',iaArr[2],',',iaArr[3],'..'); + For i := iaMaxPos-3 to iaMaxPos-1 do + write(iaArr[i],','); + writeln(iaArr[iaMaxPos]); end; - writeln('game over, wait for >ENTER< '); - Readln; + Writeln; + + lMaxSequence := 0; + lMaxLength := 0; + i := 1; + limit := 10*i; + writeln(' Limit : number with max length | average length'); + repeat + lAverageLength:= 0; + repeat + lgth:= HailstoneSeqCnt(i); + inc(lAverageLength, lgth); + if lgth >= lMaxLength then + begin + lMaxSequence := i; + lMaxLength := lgth+1; + end; + inc(i); + until i = Limit; + Writeln(Format(' %10d : %9d | %4d | %7.3f', + [limit,lMaxSequence, lMaxLength,0.9*lAverageLength/Limit])); + limit := limit*10; + until Limit > maxN; end. diff --git a/Task/Hailstone-sequence/Perl-6/hailstone-sequence.pl6 b/Task/Hailstone-sequence/Perl-6/hailstone-sequence.pl6 index 17ef219abc..dc1fa8cb0c 100644 --- a/Task/Hailstone-sequence/Perl-6/hailstone-sequence.pl6 +++ b/Task/Hailstone-sequence/Perl-6/hailstone-sequence.pl6 @@ -4,5 +4,5 @@ my @h = hailstone(27); say "Length of hailstone(27) = {+@h}"; say ~@h; -my $m max= +hailstone($_) => $_ for 1..99_999; -say "Max length $m.key() was found for hailstone($m.value()) for numbers < 100_000"; +my $m = max (+hailstone($_) => $_ for 1..99_999); +say "Max length {$m.key} was found for hailstone({$m.value}) for numbers < 100_000"; diff --git a/Task/Hailstone-sequence/REBOL/hailstone-sequence.rebol b/Task/Hailstone-sequence/REBOL/hailstone-sequence.rebol new file mode 100644 index 0000000000..024058b931 --- /dev/null +++ b/Task/Hailstone-sequence/REBOL/hailstone-sequence.rebol @@ -0,0 +1,31 @@ +hail: func [ + "Returns the hailstone sequence for n" + n [integer!] + /local seq +] [ + seq: copy reduce [n] + while [n <> 1] [ + append seq n: either n % 2 == 0 [n / 2] [3 * n + 1] + ] + seq +] + +hs27: hail 27 +print [ + "the hail sequence of 27 has length" length? hs27 + "and has the form " copy/part hs27 3 "..." + back back back tail hs27 +] + +maxN: maxLen: 0 +repeat n 99999 [ + if (len: length? hail n) > maxLen [ + maxN: n + maxLen: len + ] +] + +print [ + "the number less than 100000 with the longest hail sequence is" + maxN "with length" maxLen +] diff --git a/Task/Hailstone-sequence/REXX/hailstone-sequence-1.rexx b/Task/Hailstone-sequence/REXX/hailstone-sequence-1.rexx index 12ff10f6f0..905f25444f 100644 --- a/Task/Hailstone-sequence/REXX/hailstone-sequence-1.rexx +++ b/Task/Hailstone-sequence/REXX/hailstone-sequence-1.rexx @@ -1,28 +1,26 @@ -/*REXX pgm tests a number and also a range for hailstone (Collatz) sequences. */ -numeric digits 20 /*be able to handle gihugeic numbers. */ -parse arg x y . /*get optional arguments from the C.L. */ -if x=='' | x==',' then x=27 /*No 1st argument? Then use default.*/ -if y=='' | y==',' then y=100000-1 /* " 2nd " " " " */ -$=hailstone(x) /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒task 1▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/ -say x ' has a hailstone sequence of ' words($) -say ' and starts with: ' subword($, 1, 4) " ∙∙∙" -say ' and ends with: ∙∙∙' subword($, max(5, words($)-3)) -if y==0 then exit /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒task 2▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/ +/*REXX program tests a number and also a range for hailstone (Collatz) sequences. */ +numeric digits 20 /*be able to handle gihugeic numbers. */ +parse arg x y . /*get optional arguments from the C.L. */ +if x=='' | x=="," then x= 27 /*No 1st argument? Then use default.*/ +if y=='' | y=="," then y= 100000 - 1 /* " 2nd " " " " */ +$=hailstone(x) /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒task 1▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/ +say x ' has a hailstone sequence of ' words($) +say ' and starts with: ' subword($, 1, 4) " ∙∙∙" +say ' and ends with: ∙∙∙' subword($, max(5, words($)-3)) +if y==0 then exit /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒task 2▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/ say -w=0; do j=1 for y /*traipse through the range of numbers.*/ - call hailstone j /*compute the hailstone sequence for J.*/ - if #hs<=w then iterate /*Not big 'nuff? Then keep traipsing.*/ - bigJ=j; w=#hs /*remember what # has biggest hailstone*/ - end /*j*/ -say '(between 1──►'y") " bigJ ' has the longest hailstone sequence:' w -say 'and took' -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────HAILSTONE subroutine──────────────────────*/ -hailstone: procedure expose #hs; parse arg n 1 s /*N & S are set to 1st arg.*/ - - do #hs=1 while n\==1 /*keep loop while N isn't unity. */ - if n//2 then n=n*3 + 1 /*N is odd ? Then calculate 3*n + 1 */ - else n=n%2 /*" " even? Then calculate fast ÷ */ - s=s n /* [↑] % is REXX integer division. */ - end /*#hs*/ /* [↑] append N to the sequence list*/ -return s /*return the S string to the invoker.*/ +w=0; do j=1 for y /*traipse through the range of numbers.*/ + call hailstone j /*compute the hailstone sequence for J.*/ + if #hs<=w then iterate /*Not big 'nuff? Then keep traipsing.*/ + bigJ=j; w=#hs /*remember what # has biggest hailstone*/ + end /*j*/ +say '(between 1 ──►' y") " bigJ ' has the longest hailstone sequence: ' w +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +hailstone: procedure expose #hs; parse arg n 1 s /*N and S: are set to the 1st argument.*/ + do #hs=1 while n\==1 /*keep loop while N isn't unity. */ + if n//2 then n=n*3 + 1 /*N is odd ? Then calculate 3*n + 1 */ + else n=n%2 /*" " even? Then calculate fast ÷ */ + s=s n /* [↑] % is REXX integer division. */ + end /*#hs*/ /* [↑] append N to the sequence list*/ + return s /*return the S string to the invoker.*/ diff --git a/Task/Hailstone-sequence/REXX/hailstone-sequence-2.rexx b/Task/Hailstone-sequence/REXX/hailstone-sequence-2.rexx index b160cf41d5..0ee9ad1658 100644 --- a/Task/Hailstone-sequence/REXX/hailstone-sequence-2.rexx +++ b/Task/Hailstone-sequence/REXX/hailstone-sequence-2.rexx @@ -1,38 +1,37 @@ -/*REXX pgm tests a number and also a range for hailstone (Collatz) sequences. */ -!.=0; !.0=1; !.2=1; !.4=1; !.6=1; !.8=1 /*assign even digits to be "true". */ -numeric digits 20; @.=0 /*handle big numbers; initialize array.*/ -parse arg x y z .; !.h=y /*get optional arguments from the C,L. */ -if x=='' | x==',' then x=27 /*No 1st argument? Then use default.*/ -if y=='' | y==',' then y=100000-1 /* " 2nd " " " " */ -if z=='' | z==',' then z=12 /*head/tail number? " " " */ -$=hailstone(x) /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒task 1▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/ -say x ' has a hailstone sequence of ' words($) -say ' and starts with: ' subword($, 1, z) " ∙∙∙" -say ' and ends with: ∙∙∙' subword($, max(z+1, words($)-z+1)) -say /*Z: show first & last Z numbers*/ -if y==0 then exit /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒task 2▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/ -w=0; do j=1 for y /*traipse through the range of numbers.*/ - $=hailstone(j) /*compute the hailstone sequence for J.*/ - #hs=words($) /*find the length of the hailstone seq.*/ - if #hs<=w then iterate /*Not big 'nuff? Then keep traipsing.*/ - bigJ=j; w=#hs /*remember what # has biggest hailstone*/ +/*REXX program tests a number and also a range for hailstone (Collatz) sequences. */ +!.=0; !.0=1; !.2=1; !.4=1; !.6=1; !.8=1 /*assign even numerals to be "true". */ +numeric digits 20; @.=0 /*handle big numbers; initialize array.*/ +parse arg x y z .; !.h=y /*get optional arguments from the C,L. */ +if x=='' | x=="," then x= 27 /*No 1st argument? Then use default.*/ +if y=='' | y=="," then y=100000 - 1 /* " 2nd " " " " */ +if z=='' | z=="," then z= 12 /*head/tail number? " " " */ +hm=max(y, 40000) /*use memoization (maximum num for @.)*/ +$=hailstone(x) /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒task 1▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/ +say x ' has a hailstone sequence of ' words($) +say ' and starts with: ' subword($, 1, z) " ∙∙∙" +say ' and ends with: ∙∙∙' subword($, max(z+1, words($)-z+1)) +if y==0 then exit /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒task 2▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/ +say +w=0; do j=1 for y; $=hailstone(j) /*traipse through the range of numbers.*/ + #hs=words($) /*find the length of the hailstone seq.*/ + if #hs<=w then iterate /*Not big enough? Then keep traipsing.*/ + bigJ=j; w=#hs /*remember what # has biggest hailstone*/ end /*j*/ -say '(between 1──►'y") " bigJ ' has the longest hailstone sequence:' w -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────HAILSTONE subroutine──────────────────────*/ -hailstone: procedure expose @. !.; parse arg n 1 s 1 o /*N,S,O are 1st arg.*/ -@.1= /*handle the special case for unity (1)*/ - do while @.n==0 /*loop while the residual is unknown. */ - parse var n '' -1 L /*extract the last decimal digit of N.*/ - if !.L then n=n%2 /*N is even? Then calculate fast ÷ */ - else n=n*3 + 1 /*? ? odd ? Then calculate 3*n + 1 */ - s=s n /* [↑] %: is the REXX integer division*/ - end /*#hs*/ /* [↑] append N to the sequence list*/ -s=s @.n /*append the number to a sequence list.*/ -@.o=subword(s,2) /*use memoization for this hailstone #.*/ -r=s; h=!.h - do while r\==''; parse var r _ r /*get next the subsequence. */ - if @._\==0 then return s /*Already found? Return S. */ - if _>! then return s /*Out of range? Return S. */ - @._=r /*assign the subsequence #. */ - end /*while*/ +say '(between 1 ──►' y") " bigJ ' has the longest hailstone sequence: ' w +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +hailstone: procedure expose @. !. hm; parse arg n 1 s 1 o,@.1 /*N,S,O: are the 1st arg*/ + do while @.n==0 /*loop while the residual is unknown. */ + parse var n '' -1 L /*extract the last decimal digit of N.*/ + if !.L then n=n%2 /*N is even? Then calculate fast ÷ */ + else n=n*3 + 1 /*? ? odd ? Then calculate 3*n + 1 */ + s=s n /* [↑] %: is the REXX integer division*/ + end /*while*/ /* [↑] append N to the sequence list*/ + s=s @.n /*append the number to a sequence list.*/ + @.o=subword(s, 2); parse var s _ r /*use memoization for this hailstone #.*/ + do while r\==''; parse var r _ r /*obtain the next hailstone sequence. */ + if @._\==0 then leave /*Was number already found? Return S.*/ + if _>hm then iterate /*Is number out of range? Ignore it.*/ + @._=r /*assign subsequence number to array. */ + end /*while*/ + return s diff --git a/Task/Hailstone-sequence/S-lang/hailstone-sequence.slang b/Task/Hailstone-sequence/S-lang/hailstone-sequence.slang new file mode 100644 index 0000000000..680ff8dbfa --- /dev/null +++ b/Task/Hailstone-sequence/S-lang/hailstone-sequence.slang @@ -0,0 +1,45 @@ +% lst=1, return list of elements; lst=0 just return length +define hailstone(n, lst) +{ + variable l; + if (lst) l = {n}; + else l = 1; + + while (n > 1) { + if (n mod 2) + n = 3 * n + 1; + else + n /= 2; + if (lst) + list_append(l, n); + else + l++; + % if (prn) () = printf("%d, ", n); + } + % if (prn) () = printf("\n"); + return l; +} + +variable har = list_to_array(hailstone(27, 1)), more = 0; +() = printf("Hailstone(27) has %d elements starting with:\n\t", length(har)); + +foreach $1 (har[[0:3]]) + () = printf("%d, ", $1); + +() = printf("\nand ending with:\n\t"); +foreach $1 (har[[length(har)-4:]]) { + if (more) () = printf(", "); + more = printf("%d", $1); +} + +() = printf("\ncalculating...\r"); +variable longest, longlen = 0, h; +_for $1 (2, 99999, 1) { + $2 = hailstone($1, 0); + if ($2 > longlen) { + longest = $1; + longlen = $2; + () = printf("longest sequence started w/%d and had %d elements \r", longest, longlen); + } +} +() = printf("\n"); diff --git a/Task/Hailstone-sequence/ZX-Spectrum-Basic/hailstone-sequence.zx b/Task/Hailstone-sequence/ZX-Spectrum-Basic/hailstone-sequence.zx new file mode 100644 index 0000000000..167cfb2d13 --- /dev/null +++ b/Task/Hailstone-sequence/ZX-Spectrum-Basic/hailstone-sequence.zx @@ -0,0 +1,21 @@ +10 LET n=27: LET s=1 +20 GO SUB 1000 +30 PRINT '"Sequence length = ";seqlen +40 LET maxlen=0: LET s=0 +50 FOR m=2 TO 100000 +60 LET n=m +70 GO SUB 1000 +80 IF seqlen>maxlen THEN LET maxlen=seqlen: LET maxnum=m +90 NEXT m +100 PRINT "The number with the longest hailstone sequence is ";maxnum +110 PRINT "Its sequence length is ";maxlen +120 STOP +1000 REM Hailstone +1010 LET l=0 +1020 IF s THEN PRINT n;" "; +1030 IF n=1 THEN LET seqlen=l+1: RETURN +1040 IF FN m(n,2)=0 THEN LET n=INT (n/2): GO TO 1060 +1050 LET n=3*n+1 +1060 LET l=l+1 +1070 GO TO 1020 +2000 DEF FN m(a,b)=a-INT (a/b)*b diff --git a/Task/Hamming-numbers/00DESCRIPTION b/Task/Hamming-numbers/00DESCRIPTION index 151dc1940e..266e1b418e 100644 --- a/Task/Hamming-numbers/00DESCRIPTION +++ b/Task/Hamming-numbers/00DESCRIPTION @@ -1,12 +1,20 @@ -'''[[wp:Hamming numbers|Hamming numbers]]''' are numbers of the form -: H = 2^i \cdot 3^j \cdot 5^k, \; \mathrm{where} \; i, j, k \geq 0. -''Hamming numbers'' are also known as ''ugly numbers'' and also ''5-smooth numbers''   (numbers whose prime divisors are less or equal to 5). +'''[[wp:Hamming numbers|Hamming numbers]]''' are numbers of the form   + H = 2i × 3j × 5k +where + i, j, k ≥ 0 -Generate the sequence of Hamming numbers, ''in increasing order''. In particular: -# Show the first twenty Hamming numbers. -# Show the 1691st Hamming number (the last one below 2^{31}). -# Show the one millionth Hamming number (if the language – or a convenient library – supports arbitrary-precision integers). -'''References''' -# [[wp:Hamming numbers|Hamming numbers]] -# [[wp:Smooth number|Smooth number]] -# [http://dobbscodetalk.com/index.php?option=com_content&task=view&id=913&Itemid=85 Hamming problem] from Dr. Dobb's CodeTalk (dead link as of Sep 2011; parts of the thread [http://drdobbs.com/blogs/architecture-and-design/228700538 here] and [http://www.jsoftware.com/jwiki/Essays/Hamming%20Number here]). +''Hamming numbers''   are also known as   ''ugly numbers''   and also   ''5-smooth numbers''   (numbers whose prime divisors are less or equal to 5). + + +;Task: +Generate the sequence of Hamming numbers, ''in increasing order''.   In particular: +# Show the   first twenty   Hamming numbers. +# Show the   1691st   Hamming number (the last one below   231). +# Show the   one millionth   Hamming number (if the language – or a convenient library – supports arbitrary-precision integers). + + +;References: +* [[wp:Hamming numbers|Hamming numbers]] +* [[wp:Smooth number|Smooth number]] +* [http://dobbscodetalk.com/index.php?option=com_content&task=view&id=913&Itemid=85 Hamming problem] from Dr. Dobb's CodeTalk (dead link as of Sep 2011; parts of the thread [http://drdobbs.com/blogs/architecture-and-design/228700538 here] and [http://www.jsoftware.com/jwiki/Essays/Hamming%20Number here]). +

    diff --git a/Task/Hamming-numbers/Clojure/hamming-numbers-2.clj b/Task/Hamming-numbers/Clojure/hamming-numbers-2.clj index a5e0941df1..2f70f49e6f 100644 --- a/Task/Hamming-numbers/Clojure/hamming-numbers-2.clj +++ b/Task/Hamming-numbers/Clojure/hamming-numbers-2.clj @@ -2,12 +2,12 @@ "Computes the unbounded sequence of Hamming 235 numbers." [] (letfn [(merge [xs ys] - (let [xv (first xs), yv (first ys)] - (if (< xv yv) (cons xv (lazy-seq (merge (next xs) ys))) - (cons yv (lazy-seq (merge xs (next ys))))))), + (if (nil? xs) ys + (let [xv (first xs), yv (first ys)] + (if (< xv yv) (cons xv (lazy-seq (merge (next xs) ys))) + (cons yv (lazy-seq (merge xs (next ys)))))))), (smult [m s] ;; equiv to map (* m) s -- faster - (cons (*' m (first s)) (lazy-seq (smult m (next s)))))] - (do (def s5 (cons 5 (lazy-seq (smult 5 s5)))) - (def s35 (cons 3 (lazy-seq (merge s5 (smult 3 s35))))) - (def s235 (cons 2 (lazy-seq (merge s35 (smult 2 s235))))) - (cons 1 (lazy-seq s235))))) + (cons (*' m (first s)) (lazy-seq (smult m (next s))))), + (u [s n] (let [r (atom nil)] + (reset! r (merge s (smult n (cons 1 (lazy-seq @r)))))))] + (cons 1 (lazy-seq (reduce u nil (list 5 3 2)))))) diff --git a/Task/Hamming-numbers/Go/hamming-numbers-3.go b/Task/Hamming-numbers/Go/hamming-numbers-3.go new file mode 100644 index 0000000000..2e402f575b --- /dev/null +++ b/Task/Hamming-numbers/Go/hamming-numbers-3.go @@ -0,0 +1,110 @@ +// Hamming project main.go +package main + +import ( + "fmt" + "math/big" + "time" +) + +type lazyList struct { + head *big.Int + tail *lazyList + contf func() *lazyList +} + +func (oll *lazyList) next() *lazyList { + if oll.contf != nil { // not thread-safe + oll.tail = oll.contf() + oll.contf = nil + } + return oll.tail +} + +func merge(a *lazyList, b *lazyList) *lazyList { + rslt := new(lazyList) + x := a.head + y := b.head + if x.Cmp(y) < 0 { + rslt.head = x + rslt.contf = func() *lazyList { + return merge(a.next(), b) + } + } else { + rslt.head = y + rslt.contf = func() *lazyList { + return merge(a, b.next()) + } + } + return rslt +} + +func llmult(m *big.Int, ll *lazyList) *lazyList { + rslt := new(lazyList) + rslt.head = new(big.Int).Set(big.NewInt(0)).Mul(m, ll.head) + rslt.contf = func() *lazyList { + return llmult(m, ll.next()) + } + return rslt +} + +func u(s *lazyList, n *big.Int) *lazyList { + rslt := new(lazyList) + cr := new(lazyList) + cr.head = big.NewInt(1) + cr.contf = func() *lazyList { + return rslt + } + if s == nil { + rslt = llmult(n, cr) + } else { + rslt = merge(s, llmult(n, cr)) + } + return rslt +} + +func Hamming() func() *big.Int { + prms := []int64{5, 3, 2} + curr := new(lazyList) + curr.head = big.NewInt(1) + curr.contf = func() *lazyList { + var r *lazyList = nil + for _, v := range prms { + r = u(r, big.NewInt(v)) + } + return r + } + return func() *big.Int { + temp := curr + curr = curr.next() + return temp.head + } +} + +func main() { + n := 1000000 + + hamiter := Hamming() + rarr := make([]*big.Int, 20) + for i, _ := range rarr { + rarr[i] = hamiter() + } + fmt.Println(rarr) + + hamiter = Hamming() + for i := 1; i < 1691; i++ { + hamiter() + } + fmt.Println(hamiter()) + + strt := time.Now() + + hamiter = Hamming() + for i := 1; i < n; i++ { + hamiter() + } + rslt := hamiter() + + end := time.Now() + fmt.Printf("Found the %vth Hamming number as %v in %v.\r\n", n, rslt.String(), end.Sub(strt)) +} diff --git a/Task/Hamming-numbers/Go/hamming-numbers-4.go b/Task/Hamming-numbers/Go/hamming-numbers-4.go new file mode 100644 index 0000000000..eae338d45a --- /dev/null +++ b/Task/Hamming-numbers/Go/hamming-numbers-4.go @@ -0,0 +1,148 @@ +package main + +import ( + "fmt" + "math/big" + "time" +) + +// constants as expanded integers to minimize round-off errors, and +// reduce execution time using integer operations not float... +const cLAA2 uint64 = 35184372088832 // 2.0f64.ln() * 2.0f64.powi(45)).round() as u64; +const cLBA2 uint64 = 55765910372219 // 3.0f64.ln() / 2.0f64.ln() * 2.0f64.powi(45)).round() as u64; +const cLCA2 uint64 = 81695582054030 // 5.0f64.ln() / 2.0f64.ln() * 2.0f64.powi(45)).round() as u64; + +type logelm struct { // log representation of an element with only allowable powers + exp2 uint16 + exp3 uint16 + exp5 uint16 + logr uint64 // log representation used for comparison only - not exact +} + +func (self *logelm) lte(othr *logelm) bool { + if self.logr <= othr.logr { + return true + } else { + return false + } +} +func (self *logelm) mul2() logelm { + return logelm{ + exp2: self.exp2 + 1, + exp3: self.exp3, + exp5: self.exp5, + logr: self.logr + cLAA2, + } +} +func (self *logelm) mul3() logelm { + return logelm{ + exp2: self.exp2, + exp3: self.exp3 + 1, + exp5: self.exp5, + logr: self.logr + cLBA2, + } +} +func (self *logelm) mul5() logelm { + return logelm{ + exp2: self.exp2, + exp3: self.exp3, + exp5: self.exp5 + 1, + logr: self.logr + cLCA2, + } +} + +func log_nodups_hamming(n uint) *big.Int { + if n < 1 { + panic("log_nodups_hamming: argument < 1!") + } + if n < 2 { // trivial case of first in sequence + return big.NewInt(1) + } + if n > 1.2e15 { + panic("log_nodups_hamming: argument too large!") + } + + one := logelm{} + next5, merge := one.mul5(), one.mul3() + next53, next532 := merge.mul3(), one.mul2() + + g := make([]logelm, 1, 65536) + g[0] = one // never used, just so append works + h := make([]logelm, 1, 65536) + h[0] = one // never used, just so append works + + i, j := 1, 1 + for m := uint(1); m < n; m++ { + cph := cap(h) + if i >= cph/2 { + nm := copy(h[0:i], h[i:]) + h = h[0:nm:cph] + i = 0 + } + if next532.lte(&merge) { + h = append(h, next532) + next532 = h[i].mul2() + i++ + } else { + h = append(h, merge) + if next53.lte(&next5) { + merge = next53 + next53 = g[j].mul3() + j++ + } else { + merge = next5 + next5 = next5.mul5() + } + cpg := cap(g) + if j >= cpg/2 { + nm := copy(g[0:j], g[j:]) + g = g[0:nm:cpg] + j = 0 + } + g = append(g, merge) + } + } + + two, three, five := big.NewInt(2), big.NewInt(3), big.NewInt(5) + o := h[len(h)-1] // convert last element to big integer... + ob := big.NewInt(1) + for i := uint16(0); i < o.exp2; i++ { + ob.Mul(two, ob) + } + for i := uint16(0); i < o.exp3; i++ { + ob.Mul(three, ob) + } + for i := uint16(0); i < o.exp5; i++ { + ob.Mul(five, ob) + } + return ob +} + +func main() { + n := uint(1e6) + + rarr := make([]*big.Int, 20) + for i, _ := range rarr { + rarr[i] = log_nodumps_hamming(i) + } + fmt.Println(rarr) + + fmt.Println(log_nodups_hamming(1691)) + + strt := time.Now() + + rslt := log_nodups_hamming(n) + + end := time.Now() + + rs := rslt.String() + lrs := len(rs) + fmt.Printf("%v digits:\r\n", lrs) + ndx := 0 + for ; ndx < lrs-100; ndx += 100 { + fmt.Println(rs[ndx : ndx+100]) + } + fmt.Println(rs[ndx:]) + + fmt.Printf("This last found the %vth hamming number in %v.\r\n", n, end.Sub(strt)) +} diff --git a/Task/Hamming-numbers/Go/hamming-numbers-5.go b/Task/Hamming-numbers/Go/hamming-numbers-5.go new file mode 100644 index 0000000000..b3e4b12b7a --- /dev/null +++ b/Task/Hamming-numbers/Go/hamming-numbers-5.go @@ -0,0 +1,122 @@ +package main + +import ( + "fmt" + "math" + "math/big" + "sort" + "time" +) + +type logrep struct { + lg float64 + x2, x3, x5 uint32 +} +type logreps []logrep +func (s logreps) Len() int { // necessary methods for sorting + return len(s) +} +func (s logreps) Swap(i, j int) { + s[i], s[j] = s[j], s[i] +} +func (s logreps) Less(i, j int) bool { + return s[j].lg < s[i].lg // sort in decreasing order (reverse order compare) +} + +func nthHamming(n uint64) (uint32, uint32, uint32) { + if n < 2 { + if n < 1 { + panic("nthHamming: argument is zero!") + } + return 0, 0, 0 + } + const lb3 = 1.5849625007211561814537389439478 // math.Log2(3.0) + const lb5 = 2.3219280948873623478703194294894 // math.Log2(5.0) + fctr := 6.0 * lb3 * lb5 + crctn := math.Log2(math.Sqrt(30.0)) // from WP formula + lgest := math.Pow(fctr*float64(n), 1.0/3.0) - crctn + var frctn float64 + if n < 1000000000 { + frctn = 0.509 + } else { + frctn = 0.106 + } + lghi := math.Pow(fctr*(float64(n)+frctn*lgest), 1.0/3.0) - crctn + lglo := 2.0*lgest - lghi // and a lower limit of the upper "band" + var count uint64 = 0 + bnd := make(logreps, 0) // give it one value so doubling size works + klmt := uint32(lghi/lb5) + 1 + for k := uint32(0); k < klmt; k++ { + p := float64(k) * lb5 + jlmt := uint32((lghi-p)/lb3) + 1 + for j := uint32(0); j < jlmt; j++ { + q := p + float64(j)*lb3 + ir := lghi - q + lg := q + math.Floor(ir) // current log value estimated + count += uint64(ir) + 1 + if lg >= lglo { + bnd = append(bnd, logrep{lg, uint32(ir), j, k}) + } + } + } + if n > count { + panic("nthHamming: band high estimate is too low!") + } + ndx := int(count - n) + if ndx >= bnd.Len() { + panic("nthHamming: band low estimate is too high!") + } + sort.Sort(bnd) // sort decreasing order due definition of Less above + + rslt := bnd[ndx] + return rslt.x2, rslt.x3, rslt.x5 +} + +func convertTpl2BigInt(x2, x3, x5 uint32) *big.Int { + result := big.NewInt(1) + two := big.NewInt(2) + three := big.NewInt(3) + five := big.NewInt(5) + for i := uint32(0); i < x2; i++ { + result.Mul(result, two) + } + for i := uint32(0); i < x3; i++ { + result.Mul(result, three) + } + for i := uint32(0); i < x5; i++ { + result.Mul(result, five) + } + return result +} + +func main() { + for i := 1; i <= 20; i++ { + fmt.Printf("%v ", convertTpl2BigInt(nthHamming(uint64(i)))) + } + fmt.Println() + fmt.Println(convertTpl2BigInt(nthHamming(1691))) + + strt := time.Now() + x2, x3, x5 := nthHamming(uint64(1e6)) + end := time.Now() + + fmt.Printf("2^%v times 3^%v times 5^%v\r\n", x2, x3, x5) + lrslt := convertTpl2BigInt(x2, x3, x5) + lgrslt := (float64(x2) + math.Log2(3.0)*float64(x3) + + math.Log2(5.0)*float64(x5)) * math.Log10(2.0) + exp := math.Floor(lgrslt) + mant := math.Pow(10.0, lgrslt-exp) + fmt.Printf("Approximately: %vE+%v\r\n", mant, exp) + rs := lrslt.String() + lrs := len(rs) + fmt.Printf("%v digits:\r\n", lrs) + if lrs <= 10000 { + ndx := 0 + for ; ndx < lrs-100; ndx += 100 { + fmt.Println(rs[ndx : ndx+100]) + } + fmt.Println(rs[ndx:]) + } + + fmt.Printf("This last found the %vth hamming number in %v.\r\n", n, end.Sub(strt)) +} diff --git a/Task/Hamming-numbers/Haskell/hamming-numbers-2.hs b/Task/Hamming-numbers/Haskell/hamming-numbers-2.hs index a8feb257f2..3d0723e955 100644 --- a/Task/Hamming-numbers/Haskell/hamming-numbers-2.hs +++ b/Task/Hamming-numbers/Haskell/hamming-numbers-2.hs @@ -1,12 +1,13 @@ -hamming = 1:foldl u [] [5,3,2] where - u s n = ar where - ar = merge s (n:map (n*) ar) - merge [] b = b - merge a@(x:xs) b@(y:ys) - | x < y = x:merge xs b - | otherwise = y:merge a ys +hamming = 1 : foldr u [] [2,3,5] where + u n s = -- fix (merge s . map (n*) . (1:)) + r where + r = merge s (map (n*) (1:r)) + +merge [] b = b +merge a@(x:xs) b@(y:ys) | x < y = x : merge xs b + | otherwise = y : merge a ys main = do - print $ take 20 hamming - print $ hamming !! 1690 - print $ hamming !! (1000000-1) + print $ take 20 (hamming ()) + print $ (hamming ()) !! 1690 + print $ (hamming ()) !! (1000000-1) diff --git a/Task/Hamming-numbers/Haskell/hamming-numbers-5.hs b/Task/Hamming-numbers/Haskell/hamming-numbers-5.hs index 32ea1828e9..fe5efa1bc3 100644 --- a/Task/Hamming-numbers/Haskell/hamming-numbers-5.hs +++ b/Task/Hamming-numbers/Haskell/hamming-numbers-5.hs @@ -1,44 +1,40 @@ -- directly find n-th Hamming number, in ~ O(n^{2/3}) time --- by Will Ness, based on "top band" idea by Louis Klauder, from DDJ discussion --- http://drdobbs.com/blogs/architecture-and-design/228700538 +-- based on "top band" idea by Louis Klauder, from DDJ discussion +-- by Will Ness, original post: drdobbs.com/blogs/architecture-and-design/228700538 -{-# OPTIONS -O2 -XBangPatterns #-} -import Data.List (sortBy) -import Data.Function (on) +import Data.List +import Data.Function main = let (r,t) = nthHam 1000000 in print t >> print (trival t) -lg3 = logBase 2 3; lg5 = logBase 2 5 -logval (i,j,k) = fromIntegral i + fromIntegral j*lg3 + fromIntegral k*lg5 +lb3 = logBase 2 3; lb5 = logBase 2 5; lb30_2 = logBase 2 30 / 2 trival (i,j,k) = 2^i * 3^j * 5^k -estval n = (6*lg3*lg5* fromIntegral n)**(1/3) -- estimated logval, base 2 -rngval n - | n > 500000 = (2.4496 , 0.0076 ) -- empirical estimation - | n > 50000 = (2.4424 , 0.0146 ) -- correction, base 2 - | n > 500 = (2.3948 , 0.0723 ) -- (dist,width) - | n > 1 = (2.2506 , 0.2887 ) -- around (log $ sqrt 30), - | otherwise = (2.2506 , 0.5771 ) -- says WP +estval n + | n > 500000 = (v - lb30_2 + (3/v), 6/v) -- the space tweak! (thx, GBG!) + | n > 500000 = (v - 2.4496 , 0.0076 ) -- empirical estimation + | n > 50000 = (v - 2.4424 , 0.0146 ) -- correction, base 2 + | n > 500 = (v - 2.3948 , 0.0723 ) -- (dist,width) + | n > 1 = (v - 2.2506 , 0.2887 ) -- around (log $ sqrt 30), + | otherwise = (v - 2.2506 , 0.5771 ) -- says WP + where v = (6*lb3*lb5* fromIntegral n)**(1/3) -- estimated logval, base 2 -nthHam :: Int -> (Double, (Int, Int, Int)) -nthHam n -- n: 1-based: 1,2,3... +nthHam :: Integer -> (Double, (Int, Int, Int)) -- ( 64bit: use Int!!! NB! ) +nthHam n -- n: 1-based: 1,2,3... + | n <= 0 = error $ "n is 1--based: must be n > 0: " ++ show n | w >= 1 = error $ "Breach of contract: (w < 1): " ++ show w | m < 0 = error $ "Not enough triples generated: " ++ show (c,n) | m >= nb = error $ "Generated band is too narrow: " ++ show (m,nb) - | otherwise = res + | otherwise = sortBy (flip compare `on` fst) b !! m -- m-th from top in sorted band where - (d,w) = rngval n -- correction dist, width - hi = estval n - d -- hi > logval > hi-w - (m,nb) = ( fromIntegral $ c - n, length b ) -- m 0-based from top, |band| - (s,res) = ( sortBy (flip compare `on` fst) b, s!!m ) -- sorted decreasing, result - (c,b) = f 0 -- total count, the band - [ ( i+1, -- total triples w/ this (j,k) - [ (r,(i,j,k)) | frac < w ] ) -- store it, if inside band - | k <- [ 0 .. floor ( hi /lg5) ], let p = fromIntegral k*lg5, - j <- [ 0 .. floor ((hi-p)/lg3) ], let q = fromIntegral j*lg3 + p, - let (i,frac) = pr (hi-q) ; r = hi-frac ] -- r = i + q - -- f 0 z == (sum $ map fst z, concat $ map snd z) - where pr = properFraction - f !c [] = (c,[]) -- code as a loop - f !c ((c1,b1):r) = let (cr,br) = f (c+c1) r -- to prevent space leak - in case b1 of { [v] -> (cr,v:br) - ; _ -> (cr, br) } + (hi,w) = estval n -- hi > logval > hi-w + m = fromIntegral (c - n) -- target index, from top + nb = length b -- length of the band + (c,b) = foldl_ (\(c,b) (i,t)-> let c2=c+i in c2`seq` -- ( total count, the band ) + case t of []-> (c2,b);[v]->(c2,v:b) ) (0,[]) -- ( =~= mconcat ) + [ ( fromIntegral i+1, -- total triples w/ this (j,k) + [ (r,(i,j,k)) | frac < w ] ) -- store it, if inside band + | k <- [ 0 .. floor ( hi /lb5) ], let p = fromIntegral k*lb5, + j <- [ 0 .. floor ((hi-p)/lb3) ], let q = fromIntegral j*lb3 + p, + let (i,frac) = pr (hi-q) ; r = hi - frac -- r = i + q + ] where pr = properFraction -- pr 1.24 => (1,0.24) + foldl_ = foldl' diff --git a/Task/Hamming-numbers/Haskell/hamming-numbers-6.hs b/Task/Hamming-numbers/Haskell/hamming-numbers-6.hs new file mode 100644 index 0000000000..bfbeb1500d --- /dev/null +++ b/Task/Hamming-numbers/Haskell/hamming-numbers-6.hs @@ -0,0 +1,43 @@ +{-# OPTIONS -O2 -XBangPatterns #-} + +import Data.Word +import Data.List (sortBy) +import Data.Function (on) + +main = let t = nthHam 1000000000000 in print t >> print (trival t) + +lb3 = logBase 2 3; lb5 = logBase 2 5 +lbrt30 = logBase 2 $ sqrt 30 :: Double -- estimate adjustment as per WP +trival (i,j,k) = 2^i * 3^j * 5^k +estval2 n = (6*lb3*lb5*n)**(1/3) - lbrt30 -- estimated logval, base 2 +crctn n + | n < 1000 = 0.509 -- empirical correction terms + | n < 1000000 = 0.206 + | n < 1000000000 = 0.122 -- further divisions have little effect as already small + | otherwise = 0.105 -- very slowly decrease from this point for a billion + +nthHam :: Word64 -> (Int, Int, Int) +nthHam n -- n: 1-based 1,2,3... + | n < 2 = case n of + 0 -> error "nthHam: Argument is zero!" + _ -> (0, 0, 0) -- trivial case for 1 + | m < 0 = error $ "Not enough triples generated: " ++ show (c,n) + | m >= nb = error $ "Generated band is too narrow: " ++ show (m,nb) + | otherwise = case res of (_, tv) -> tv -- 2^i * 3^j * 5^k + where + (fr,est)= (crctn n, estval2 $ fromIntegral n) -- fraction of log2 error, est val + (hi,lo) = (estval2 (fromIntegral n + fr*est), 2*est-hi) -- hi > logval2 > hi-w + (c,b) = let klmt = floor (hi/lb5) in + let loopk k !ck bndk = + if k > klmt then (ck, bndk) else + let p = fromIntegral k*lb5; jlmt = floor ((hi-p)/lb3) in + let loopj j !cj bndj = + if j > jlmt then loopk (k+1) cj bndj else + let q = fromIntegral j*lb3 + p in + let (i, frac) = properFraction (hi-q); r = hi-frac in + if r < lo then loopj (j+1) (fromIntegral i+cj+1) bndj else + loopj (j+1) (fromIntegral i+cj+1) ((r,(i,j,k)):bndj) in + loopj 0 ck bndk in + loopk 0 0 [] + (m,nb) = ( fromIntegral $ c - n, length b ) -- m 0-based from top, |band| + (s,res) = ( sortBy (flip compare `on` fst) b, s!!m ) -- sorted decreasing, result< diff --git a/Task/Hamming-numbers/Kotlin/hamming-numbers-2.kotlin b/Task/Hamming-numbers/Kotlin/hamming-numbers-2.kotlin index 0fcb0d3e3d..32971039fc 100644 --- a/Task/Hamming-numbers/Kotlin/hamming-numbers-2.kotlin +++ b/Task/Hamming-numbers/Kotlin/hamming-numbers-2.kotlin @@ -5,15 +5,15 @@ val One = BigInteger.ONE val Three = BigInteger.valueOf(3) val Five = BigInteger.valueOf(5) -fun PriorityQueue.update(x: BigInteger) { - add(x shiftLeft(1)) - add(x multiply(Three)) - add(x multiply(Five)) +fun PriorityQueue.update(x: BigInteger) : PriorityQueue { + add(x.shiftLeft(1)) + add(x.multiply(Three)) + add(x.multiply(Five)) + return this } fun hamming(n: Int): BigInteger { - val frontier = PriorityQueue() - frontier.update(One) + val frontier = PriorityQueue().update(One) var lowest = One repeat(n - 1) { lowest = frontier.poll() ?: lowest @@ -29,5 +29,5 @@ fun hamming(i : Iterable) : Iterable = i.map { hamming(it) } fun main(args: Array) { val r = 1..20 println("Hamming($r) = " + hamming(r)) - arrayOf(1691, 1000000).forEach { println("Hamming(${it}) = " + hamming(it)) } + arrayOf(1691, 1000000).forEach { println("Hamming($it) = " + hamming(it)) } } diff --git a/Task/Hamming-numbers/Kotlin/hamming-numbers-3.kotlin b/Task/Hamming-numbers/Kotlin/hamming-numbers-3.kotlin index 5e887399eb..c7770ea7d5 100644 --- a/Task/Hamming-numbers/Kotlin/hamming-numbers-3.kotlin +++ b/Task/Hamming-numbers/Kotlin/hamming-numbers-3.kotlin @@ -5,16 +5,16 @@ val One = BigInteger.ONE val Three = BigInteger.valueOf(3) val Five = BigInteger.valueOf(5) -fun PriorityQueue.update(x: BigInteger) { - add(x shiftLeft 1) - add(x multiply Three) - add(x multiply Five) +infix fun PriorityQueue.update(x: BigInteger) : PriorityQueue { + add(x.shiftLeft(1)) + add(x.multiply(Three)) + add(x.multiply(Five)) + return this } fun hamming(a: Any?): Any = when (a) { is Number -> { - val pq = PriorityQueue() - pq update One + val pq = PriorityQueue() update One var lowest = One repeat(a.toInt() - 1) { lowest = pq.poll() ?: lowest diff --git a/Task/Hamming-numbers/Kotlin/hamming-numbers-4.kotlin b/Task/Hamming-numbers/Kotlin/hamming-numbers-4.kotlin new file mode 100644 index 0000000000..c8fd71c571 --- /dev/null +++ b/Task/Hamming-numbers/Kotlin/hamming-numbers-4.kotlin @@ -0,0 +1,48 @@ +import java.math.BigInteger as BI + +data class LazyList(val head: T, val lztail: Lazy?>) { + fun toSequence() = generateSequence(this) { it.lztail.value } + .map { it.head } +} + +fun hamming(): LazyList { + fun merge(s1: LazyList, s2: LazyList): LazyList { + val s1v = s1.head; val s2v = s2.head + if (s1v < s2v) { + return LazyList(s1v, lazy({->merge(s1.lztail.value!!, s2)})) + } else { + return LazyList(s2v, lazy({->merge(s1, s2.lztail.value!!)})) + } + } + fun llmult(m: BI, s: LazyList): LazyList { + fun llmlt(ss: LazyList): LazyList { + return LazyList(m * ss.head, lazy({->llmlt(ss.lztail.value!!)})) + } + return llmlt(s) + } + fun u(s: LazyList?, n: Long): LazyList { + var r: LazyList? = null // mutable nullable so can do the below + if (s == null) { // recursively referenced variables are ugly!!! + r = llmult(BI.valueOf(n), LazyList(BI.valueOf(1), lazy{ -> r })) + } else { // recursively referenced variables only work with lazy + r = merge(s, llmult(BI.valueOf(n), // or a loop race limit + LazyList(BI.valueOf(1), lazy{ -> r }))) + } + return r + } + val prms = arrayOf(5L, 3L, 2L) + val thunk = {->prms.fold?>(null, {s, n -> u(s,n)})!!} + return LazyList(BI.valueOf(1), lazy(thunk)) +} + +fun main(args: Array) { + tailrec fun nth(n: Int, h: LazyList): BI = + if (n > 1) { nth(n - 1, h.lztail.value!!) } + else { h.head } // non-generic faster: boxing optimized away + println(hamming().toSequence().take(20).toList()) + println(nth(1691, hamming())) + val strt = System.currentTimeMillis() + println(nth(1000000, hamming())) + val stop = System.currentTimeMillis() + println("Took ${stop - strt} milliseconds for the last.") +} diff --git a/Task/Hamming-numbers/OCaml/hamming-numbers-1.ocaml b/Task/Hamming-numbers/OCaml/hamming-numbers-1.ocaml new file mode 100644 index 0000000000..2bfde4b46a --- /dev/null +++ b/Task/Hamming-numbers/OCaml/hamming-numbers-1.ocaml @@ -0,0 +1,24 @@ +module ISet = Set.Make(struct type t = int let compare=compare end) + +let pq = ref (ISet.singleton 1) + +let next () = + let m = ISet.min_elt !pq in + pq := ISet.(remove m !pq |> add (2*m) |> add (3*m) |> add (5*m)); + m + +let () = + + print_string "The first 20 are: "; + + for i = 1 to 20 + do + Printf.printf "%d " (next ()) + done; + + for i = 21 to 1690 + do + ignore (next ()) + done; + + Printf.printf "\nThe 1691st is %d\n" (next ()); diff --git a/Task/Hamming-numbers/OCaml/hamming-numbers-2.ocaml b/Task/Hamming-numbers/OCaml/hamming-numbers-2.ocaml new file mode 100644 index 0000000000..61ccb203a0 --- /dev/null +++ b/Task/Hamming-numbers/OCaml/hamming-numbers-2.ocaml @@ -0,0 +1,25 @@ +open Big_int + +module APSet = Set.Make( + struct + type t = big_int + let compare = compare_big_int + end) + +let pq = ref (APSet.singleton (big_int_of_int 1)) + +let next () = + let m = APSet.min_elt !pq in + let ( * ) = mult_int_big_int in + pq := APSet.(remove m !pq |> add (2*m) |> add (3*m) |> add (5*m)); + m + +let () = + let n = 1_000_000 in + + for i = 1 to (n-1) + do + ignore (next ()) + done; + + Printf.printf "\nThe %dth is %s\n" n (string_of_big_int (next ())); diff --git a/Task/Hamming-numbers/REXX/hamming-numbers-1.rexx b/Task/Hamming-numbers/REXX/hamming-numbers-1.rexx index 32fb0417c8..bed6d8c6fb 100644 --- a/Task/Hamming-numbers/REXX/hamming-numbers-1.rexx +++ b/Task/Hamming-numbers/REXX/hamming-numbers-1.rexx @@ -1,21 +1,21 @@ -/*REXX program computes Hamming numbers: 1 ──► 20, # 1691, the one millionth.*/ -numeric digits 100 /*ensure enough decimal digits. */ -call hamming 1, 20 /*show the 1st ──► twentieth Hamming #s*/ -call hamming 1691 /*show the 1,691st Hamming number. */ -call hamming 1000000 /*show the 1 millionth Hamming number.*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ +/*REXX program computes Hamming numbers: 1 ──► 20, # 1691, and the one millionth. */ +numeric digits 100 /*ensure enough decimal digits. */ +call hamming 1, 20 /*show the 1st ──► twentieth Hamming #s*/ +call hamming 1691 /*show the 1,691st Hamming number. */ +call hamming 1000000 /*show the 1 millionth Hamming number.*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ hamming: procedure; parse arg x,y; if y=='' then y=x; w=length(y) - #2=1; #3=1; #5=1; @.=0; @.1=1 - do n=2 for y-1 - @.n = min(2*@.#2, 3*@.#3, 5*@.#5) /*pick the minimum of 3 Hamming numbers*/ - if 2*@.#2 == @.n then #2 = #2+1 /*number already defined? Use next #. */ - if 3*@.#3 == @.n then #3 = #3+1 /* " " " " " " */ - if 5*@.#5 == @.n then #5 = #5+1 /* " " " " " " */ - end /*n*/ /* [↑] maybe assign next 3 Hamming #s.*/ - do j=x to y /*W is used to align the (output) index*/ - say 'Hamming('right(j,w)") =" @.j /*display 'em, Dano.*/ - end /*j*/ + #2=1; #3=1; #5=1; @.=0; @.1=1 + do n=2 for y-1 + @.n = min(2*@.#2, 3*@.#3, 5*@.#5) /*pick the minimum of 3 (Hamming) #s.*/ + if 2*@.#2 == @.n then #2 = #2+1 /*number already defined? Use next #*/ + if 3*@.#3 == @.n then #3 = #3+1 /* " " " " " "*/ + if 5*@.#5 == @.n then #5 = #5+1 /* " " " " " "*/ + end /*n*/ /* [↑] maybe assign next 3 Hamming#s*/ + do j=x to y + say 'Hamming('right(j,w)") =" @.j + end /*j*/ -say right( 'length of last Hamming number =' length(@.y), 70); say -return + say right( 'length of last Hamming number =' length(@.y), 70); say + return diff --git a/Task/Hamming-numbers/REXX/hamming-numbers-2.rexx b/Task/Hamming-numbers/REXX/hamming-numbers-2.rexx index 70550fb045..d2ea932df2 100644 --- a/Task/Hamming-numbers/REXX/hamming-numbers-2.rexx +++ b/Task/Hamming-numbers/REXX/hamming-numbers-2.rexx @@ -1,27 +1,27 @@ -/*REXX program computes Hamming numbers: 1 ──► 20, # 1691, the one millionth.*/ -numeric digits 100 /*ensure enough decimal digits. */ -call hamming 1, 20 /*show the 1st ──► twentieth Hamming #s*/ -call hamming 1691 /*show the 1,691st Hamming number. */ -call hamming 1000000 /*show the 1 millionth Hamming number.*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -hamming: procedure; parse arg x,y; if y=='' then y=x; w=length(y) - #2=1; #3=1; #5=1; @.=0; @.1=1 - do n=2 for y-1 - _2 = @.#2 + @.#2 /*this is faster than: 2 * @.#2 */ - _3 = 3 * @.#3 - _5 = 5 * @.#5 - m =_2 /*assume a minimum of the 3 Hamming #s.*/ - if _3 < m then m =_3 /*is this number less than the minimum?*/ - if _5 < m then m =_5 /* " " " " " " " */ - @.n = m /*now, assign the next Hamming number. */ - if _2 == m then #2 = #2 + 1 /*number already defined? Use next #. */ - if _3 == m then #3 = #3 + 1 /* " " " " " " */ - if _5 == m then #5 = #5 + 1 /* " " " " " " */ - end /*n*/ /* [↑] maybe assign next 3 Hamming #s.*/ - do j=x to y /*W is used to align the (output) index*/ - say 'Hamming('right(j,w)") =" @.j /*display 'em, Dano.*/ - end /*j*/ +/*REXX program computes Hamming numbers: 1 ──► 20, # 1691, and the one millionth.*/ +numeric digits 100 /*ensure enough decimal digits. */ +call hamming 1, 20 /*show the 1st ──► twentieth Hamming #s*/ +call hamming 1691 /*show the 1,691st Hamming number. */ +call hamming 1000000 /*show the 1 millionth Hamming number.*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +hamming: procedure; parse arg x,y; if y=='' then y=x; w=length(y) + #2=1; #3=1; #5=1; @.=0; @.1=1 + do n=2 for y-1 + _2 = @.#2 + @.#2 /*this is faster than: @.#2 * 2 */ + _3 = @.#3 * 3 + _5 = @.#5 * 5 + m = _2 /*assume a minimum (of the 3 Hammings).*/ + if _3 < m then m = _3 /*is this number less than the minimum?*/ + if _5 < m then m = _5 /* " " " " " " " */ + @.n = m /*now, assign the next Hamming number.*/ + if _2 == m then #2 = #2 + 1 /*number already defined? Use next #.*/ + if _3 == m then #3 = #3 + 1 /* " " " " " " */ + if _5 == m then #5 = #5 + 1 /* " " " " " " */ + end /*n*/ /* [↑] maybe assign next Hamming #'s. */ + do j=x to y + say 'Hamming('right(j, w)") =" @.j + end /*j*/ -say right( 'length of last Hamming number =' length(@.y), 70); say -return + say right( 'length of last Hamming number =' length(@.y), 70); say + return diff --git a/Task/Hamming-numbers/Racket/hamming-numbers.rkt b/Task/Hamming-numbers/Racket/hamming-numbers-1.rkt similarity index 100% rename from Task/Hamming-numbers/Racket/hamming-numbers.rkt rename to Task/Hamming-numbers/Racket/hamming-numbers-1.rkt diff --git a/Task/Hamming-numbers/Racket/hamming-numbers-2.rkt b/Task/Hamming-numbers/Racket/hamming-numbers-2.rkt new file mode 100644 index 0000000000..33912daa98 --- /dev/null +++ b/Task/Hamming-numbers/Racket/hamming-numbers-2.rkt @@ -0,0 +1,27 @@ +#lang racket +(require racket/stream) +(define first stream-first) +(define rest stream-rest) + +(define (hamming) + (define (merge s1 s2) + (let ([x1 (first s1)] + [x2 (first s2)]) + (if (< x1 x2) ; don't have to handle duplicate case + (stream-cons x1 (merge (rest s1) s2)) + (stream-cons x2 (merge s1 (rest s2)))))) + (define (smult m s) ; faster than using map (* m) + (define (smlt ss) + (stream-cons (* m (first ss)) (smlt (rest ss)))) + (smlt s)) + (define (u s n) + (if (stream-empty? s) ; checking here more efficient than in merge + (letrec ([r (smult n (stream-cons 1 r))]) + r) + (letrec ([r (merge s (smult n (stream-cons 1 r)))]) + r))) + (stream-cons 1 (stream-fold u empty-stream '(5 3 2)))) + +(for/list ([i 20] [x (hamming)]) x) (newline) +(stream-ref (hamming) 1690) (newline) +(stream-ref (hamming) 999999) (newline) diff --git a/Task/Hamming-numbers/Rust/hamming-numbers-1.rust b/Task/Hamming-numbers/Rust/hamming-numbers-1.rust new file mode 100644 index 0000000000..5f7d414ac6 --- /dev/null +++ b/Task/Hamming-numbers/Rust/hamming-numbers-1.rust @@ -0,0 +1,70 @@ +extern crate num; +num::bigint::BigUint; + +use std::time::Instant; + +fn basic_hamming(n: usize) -> BigUint { + let two = BigUint::from(2u8); + let three = BigUint::from(3u8); + let five = BigUint::from(5u8); + let mut h = vec![BigUint::from(0u8); n]; + h[0] = BigUint::from(1u8); + let mut x2 = BigUint::from(2u8); + let mut x3 = BigUint::from(3u8); + let mut x5 = BigUint::from(5u8); + let mut i = 0usize; let mut j = 0usize; let mut k = 0usize; + + // BigUint comparisons are expensive, so do it only as necessary... + fn min3(x: &BigUint, y: &BigUint, z: &BigUint) -> (usize, BigUint) { + let (cs, r1) = if y == z { (0x6, y) } + else if y < z { (2, y) } else { (4, z) }; + if x == r1 { (cs | 1, x.clone()) } + else if x < r1 { (1, x.clone()) } else { (cs, r1.clone()) } + } + + let mut c = 1; + while c < n { // satisfy borrow checker with extra blocks: { } + let (cs, e1) = { min3(&x2, &x3, &x5) }; + h[c] = e1; // vector now owns the generated value + if (cs & 1) != 0 { i += 1; x2 = &two * &h[i] } + if (cs & 2) != 0 { j += 1; x3 = &three * &h[j] } + if (cs & 4) != 0 { k += 1; x5 = &five * &h[k] } + c += 1; + } + + match h.pop() { + Some(v) => v, + _ => panic!("basic_hamming: arg is zero; no elements") + } +} + +fn main() { + print!("["); + for (i, h) in (1..21).map(basic_hamming).enumerate() { + if i != 0 { print!(",") } + print!(" {}", h) + } + println!(" ]"); + println!("{}", basic_hamming(1691)); + + let strt = Instant::now(); + + let rslt = basic_hamming(1000000); + + let elpsd = strt.elapsed(); + let secs = elpsd.as_secs(); + let millis = (elpsd.subsec_nanos() / 1000000)as u64; + let dur = secs * 1000 + millis; + + let rs = rslt.to_str_radix(10); + let mut s = rs.as_str(); + println!("{} digits:", s.len()); + while s.len() > 100 { + let (f, r) = s.split_at(100); + s = r; + println!("{}", f); + } + println!("{}", s); + + println!("This last took {} milliseconds", dur); +} diff --git a/Task/Hamming-numbers/Rust/hamming-numbers-2.rust b/Task/Hamming-numbers/Rust/hamming-numbers-2.rust new file mode 100644 index 0000000000..7aa05249f9 --- /dev/null +++ b/Task/Hamming-numbers/Rust/hamming-numbers-2.rust @@ -0,0 +1,32 @@ +fn nodups_hamming(n: usize) -> BigUint { + let two = BigUint::from(2u8); + let three = BigUint::from(3u8); + let five = BigUint::from(5u8); + let mut m = vec![BigUint::from(0u8); 1]; + m[0] = BigUint::from(1u8); + let mut h = vec![BigUint::from(0u8); n]; + h[0] = BigUint::from(1u8); + if n > 1 { + m.push(BigUint::from(3u8)); // for initial x53 advance + h[1] = BigUint::from(2u8); // for initial x532 advance + } + let mut x5 = BigUint::from(5u8); + let mut x53 = BigUint::from(9u8); // 3 times 3 because already merged one step + let mut mrg = BigUint::from(3u8); + let mut x532 = BigUint::from(2u8); + + let mut i = 0usize; let mut j = 1usize; + let mut c = 1usize; + while c < n { // satisfy borrow checker with extra blocks: { } + if &x532 < &mrg { h[c] = x532; i += 1; x532 = &two * &h[i]; } + else { h[c] = mrg; + if &x53 < &x5 { mrg = x53; j += 1; x53 = &three * &m[j]; } + else { mrg = x5.clone(); x5 = &five * &x5; }; + m.push(mrg.clone()); }; + c += 1; + } + match h.pop() { + Some(v) => v, + _ => panic!("nodups_hamming: arg is zero; no elements") + } +} diff --git a/Task/Hamming-numbers/Rust/hamming-numbers-3.rust b/Task/Hamming-numbers/Rust/hamming-numbers-3.rust new file mode 100644 index 0000000000..25dd702712 --- /dev/null +++ b/Task/Hamming-numbers/Rust/hamming-numbers-3.rust @@ -0,0 +1,83 @@ +fn log_nodups_hamming(n: u64) -> BigUint { + if n <= 0 { panic!("nodups_hamming: arg is zero; no elements") } + if n < 2 { return BigUint::from(1u8) } // trivial case for n == 1 + if n > 1.2e13 as u64 { panic!("log_nodups_hamming: argument too large to guarantee results!") } + + // constants as expanded integers to minimize round-off errors, and + // reduce execution time using integer operations not float... + const LAA2: u64 = 35184372088832; // 2.0f64.powi(45)).round() as u64; + const LBA2: u64 = 55765910372219; // 3.0f64.log2() * 2.0f64.powi(45)).round() as u64; + const LCA2: u64 = 81695582054030; // 5.0f64.log2() * 2.0f64.powi(45)).round() as u64; + + #[derive(Clone, Copy)] + struct Logelm { // log representation of an element with only allowable powers + exp2: u16, + exp3: u16, + exp5: u16, + logr: u64 // log representation used for comparison only - not exact + } + + impl Logelm { + fn lte(&self, othr: &Logelm) -> bool { + if self.logr <= othr.logr { true } else { false } + } + fn mul2(&self) -> Logelm { + Logelm { exp2: self.exp2 + 1, logr: self.logr + LAA2, .. *self } + } + fn mul3(&self) -> Logelm { + Logelm { exp3: self.exp3 + 1, logr: self.logr + LBA2, .. *self } + } + fn mul5(&self) -> Logelm { + Logelm { exp5: self.exp5 + 1, logr: self.logr + LCA2, .. *self } + } + } + + let one = Logelm { exp2: 0, exp3: 0, exp5: 0, logr: 0 }; + let mut x532 = one.mul2(); + let mut mrg = one.mul3(); + let mut x53 = one.mul3().mul3(); // advance as mrg has the former value... + let mut x5 = one.mul5(); + + let mut h = Vec::with_capacity(65536); // vec!(one.clone(); 0); + let mut m = Vec::::with_capacity(65536); // vec!(one.clone(); 0); + + let mut i = 0usize; let mut j = 0usize; + for _ in 1 .. n { + let cph = h.capacity(); + if i > cph / 2 { // drain extra unneeded values... + h.drain(0 .. i); + i = 0; + } + if x532.lte(&mrg) { + h.push(x532); + x532 = h[i].mul2(); + i += 1; + } else { + h.push(mrg); + if x53.lte(&x5) { + mrg = x53; + x53 = m[j].mul3(); + j += 1; + } else { + mrg = x5; + x5 = x5.mul5(); + } + let cpm = m.capacity(); + if j > cpm / 2 { // drain extra unneeded values... + m.drain(0 .. j); + j = 0; + } + m.push(mrg); + } + } + + let o = &h[&h.len() - 1]; + let two = BigUint::from(2u8); + let three = BigUint::from(3u8); + let five = BigUint::from(5u8); + let mut ob = BigUint::from(1u8); // convert to BigUint at the end + for _ in 0 .. o.exp2 { ob = ob * &two } + for _ in 0 .. o.exp3 { ob = ob * &three } + for _ in 0 .. o.exp5 { ob = ob * &five } + ob +} diff --git a/Task/Hamming-numbers/Rust/hamming-numbers-4.rust b/Task/Hamming-numbers/Rust/hamming-numbers-4.rust new file mode 100644 index 0000000000..3577a3044e --- /dev/null +++ b/Task/Hamming-numbers/Rust/hamming-numbers-4.rust @@ -0,0 +1,131 @@ +extern crate num; // requires dependency on the num library +use num::bigint::BigUint; + +use std::time::Instant; + +fn log_nodups_hamming_iter() -> Box> { + // constants as expanded integers to minimize round-off errors, and + // reduce execution time using integer operations not float... + const LAA2: u64 = 35184372088832; // 2.0f64.powi(45)).round() as u64; + const LBA2: u64 = 55765910372219; // 3.0f64.log2() * 2.0f64.powi(45)).round() as u64; + const LCA2: u64 = 81695582054030; // 5.0f64.log2() * 2.0f64.powi(45)).round() as u64; + + #[derive(Clone, Copy)] + struct Logelm { // log representation of an element with only allowable powers + exp2: u16, + exp3: u16, + exp5: u16, + logr: u64 // log representation used for comparison only - not exact + } + impl Logelm { + fn lte(&self, othr: &Logelm) -> bool { + if self.logr <= othr.logr { true } else { false } + } + fn mul2(&self) -> Logelm { + Logelm { exp2: self.exp2 + 1, logr: self.logr + LAA2, .. *self } + } + fn mul3(&self) -> Logelm { + Logelm { exp3: self.exp3 + 1, logr: self.logr + LBA2, .. *self } + } + fn mul5(&self) -> Logelm { + Logelm { exp5: self.exp5 + 1, logr: self.logr + LCA2, .. *self } + } + } + + let one = Logelm { exp2: 0, exp3: 0, exp5: 0, logr: 0 }; + let mut x532 = one.mul2(); + let mut mrg = one.mul3(); + let mut x53 = one.mul3().mul3(); // advance as mrg has the former value... + let mut x5 = one.mul5(); + + let mut h = Vec::with_capacity(65536); + let mut m = Vec::::with_capacity(65536); + + let mut i = 0usize; let mut j = 0usize; + Box::new((0u64 .. ).map(move |it| if it < 1 { (0, 0, 0) } else { + let cph = h.capacity(); + if i > cph / 2 { + h.drain(0 .. i); + i = 0; + } + if x532.lte(&mrg) { + h.push(x532); + x532 = h[i].mul2(); + i += 1; + } else { + h.push(mrg); + if x53.lte(&x5) { + mrg = x53; + x53 = m[j].mul3(); + j += 1; + } else { + mrg = x5; + x5 = x5.mul5(); + } + let cpm = m.capacity(); + if j > cpm / 2 { + m.drain(0 .. j); + j = 0; + } + m.push(mrg); + } + let o = &h[&h.len() - 1]; + (o.exp2, o.exp3, o.exp5) + })) +} + +fn convert_log2big(o: (u16, u16, u16)) -> BigUint { + let two = BigUint::from(2u8); + let three = BigUint::from(3u8); + let five = BigUint::from(5u8); + let (x2, x3, x5) = o; + let mut ob = BigUint::from(1u8); // convert to BigUint at the end + for _ in 0 .. x2 { ob = ob * &two } + for _ in 0 .. x3 { ob = ob * &three } + for _ in 0 .. x5 { ob = ob * &five } + ob +} + +fn main() { + print!("["); + for (i, h) in log_nodups_hamming_iter().take(20).map(convert_log2big).enumerate() { + if i != 0 { print!(",") } + print!(" {}", h) + } + println!(" ]"); + println!("{}", convert_log2big(log_nodups_hamming_iter().take(1691).last().unwrap())); + + let strt = Instant::now(); + +// let rslt = convert_log2big(log_nodups_hamming_iter().take(1000000000).last().unwrap()); + let mut it = log_nodups_hamming_iter().into_iter(); + for _ in 0 .. 100-1 { // a little faster; less one level of iteration + let _ = it.next(); + } + let rslt = convert_log2big(it.next().unwrap()); + + let elpsd = strt.elapsed(); + let secs = elpsd.as_secs(); + let millis = (elpsd.subsec_nanos() / 1000000)as u64; + let dur = secs * 1000 + millis; + + println!("2^{} times 3^{} times 5^{}", rslt.0, rslt.1, rslt.2); + let rs = convert_log2big(rslt).to_str_radix(10); + let mut s = rs.as_str(); + println!("{} digits:", s.len()); + let lg3 = 3.0f64.log2(); + let lg5 = 5.0f64.log2(); + let lg = (rslt.0 as f64 + rslt.1 as f64 * lg3 + + rslt.2 as f64 * lg5) * 2.0f64.log10(); + println!("Approximately {}E+{}", 10.0f64.powf(lg.fract()), lg.trunc()); + if s.len() <= 10000 { + while s.len() > 100 { + let (f, r) = s.split_at(100); + s = r; + println!("{}", f); + } + println!("{}", s); + } + + println!("This last took {} milliseconds.", dur); +} diff --git a/Task/Hamming-numbers/Rust/hamming-numbers-5.rust b/Task/Hamming-numbers/Rust/hamming-numbers-5.rust new file mode 100644 index 0000000000..05ef353564 --- /dev/null +++ b/Task/Hamming-numbers/Rust/hamming-numbers-5.rust @@ -0,0 +1,255 @@ +extern crate num; +use num::bigint::BigUint; + +use std::rc::Rc; +use std::iter::FromIterator; +use std::cell::{UnsafeCell, RefCell}; +use std::mem; + +use std::time::Instant; + +// since Box T + 'a> doesn't currently work and +// FnBox, which does work, (version 1.13) is UnStable; +// use the boilerplate Invoke trait and Thunk +// from the old removed thunk standard library... + +pub trait Invoke { + fn invoke(self: Box) -> R; +} + +impl R> Invoke for F { + #[inline(always)] + fn invoke(self: Box) -> R { (*self)() } +} + +pub struct Thunk<'a, R>(Box + 'a>); + +impl<'a, R: 'a> Thunk<'a, R> { + #[inline(always)] + fn new R>(func: F) -> Thunk<'a, R> { + Thunk(Box::new(func)) + } + #[inline(always)] + fn invoke(self) -> R { self.0.invoke() } +} + +// actual Lazy implementation starts here... + +use self::LazyState::*; + +pub struct Lazy<'a, T: 'a>(UnsafeCell>); + +enum LazyState<'a, T: 'a> { + Unevaluated(Thunk<'a, T>), + EvaluationInProgress, + Evaluated(T) +} + +impl<'a, T: 'a> Lazy<'a, T>{ + #[inline] + pub fn new<'b, F>(thunk: F) -> Lazy<'b, T> + where F: 'b + FnOnce() -> T { + Lazy(UnsafeCell::new(Unevaluated(Thunk::new(thunk)))) + } + #[inline] + pub fn evaluated(val: T) -> Lazy<'a, T> { + Lazy(UnsafeCell::new(Evaluated(val))) + } + #[inline] + fn force<'b>(&'b self) { // not thread-safe + unsafe { + match *self.0.get() { + Evaluated(_) => return, // nothing required; already Evaluated + EvaluationInProgress => panic!("Lazy::force called recursively!!!"), + _ => () // need to do following something else if Unevaluated... + } // following eliminates recursive race; drops neither on replace... + match mem::replace(&mut *self.0.get(), EvaluationInProgress) { + Unevaluated(thnk) => { // thnk can't call force on the same Lazy + *self.0.get() = Evaluated(thnk.invoke()); + }, + _ => unreachable!() // already took care of other cases in above match. + } + } + } + #[inline] + pub fn value<'b>(&'b self) -> &'b T { + self.force(); // evaluatate if not evealutated + match unsafe { &*self.0.get() } { + &Evaluated(ref v) => v, // return value + _ => { unreachable!() } // previous force guarantees never not Evaluated + } + } + #[inline] + pub fn unwrap<'b>(self) -> T where T: 'b { // consumes the object to produce the value + self.force(); // evaluatate if not evealutated + match unsafe { self.0.into_inner() } { + Evaluated(v) => v, + _ => unreachable!() // previous code guarantees never not Evaluated + } + } +} + +// now for immutable persistent (memoized) LazyList via Lazy above + +type RcLazyListNode<'a, T: 'a> = Rc>>; + +use self::LazyList::*; + +#[derive(Clone)] +enum LazyList<'a, T: 'a + Clone> { + /// The Empty List + Empty, + /// A list with one member and possibly another list. + Cons(T, RcLazyListNode<'a, T>) +} + +impl<'a, T: 'a + Clone> LazyList<'a, T> { + #[inline] + pub fn cons(v: T, cntf: F) -> LazyList<'a, T> + where F: 'a + FnOnce() -> LazyList<'a, T> { + Cons(v, Rc::new(Lazy::new(cntf))) + } + #[inline] + pub fn head<'b>(&'b self) -> &'b T { + if let Cons(ref hd, _) = *self { return hd } + panic!("LazyList::head called on an Empty LazyList!!!") + } + #[inline] + pub fn tail<'b>(&'b self) -> &'b Lazy<'a, LazyList<'a, T>> { + if let Cons(_, ref rlln) = *self { return &*rlln } + panic!("LazyList::tail called on an Empty LazyList!!!") + } + #[inline] + pub fn unwrap(self) -> (T, RcLazyListNode<'a, T>) { // consumes the object + if let Cons(hd, rlln) = self { + return (hd, rlln) } + panic!("LazyList::unwrap called on an Empty LazyList!!!") + } +} + +impl<'a, T: 'a + Clone> Iterator for LazyList<'a, T> { + type Item = T; + #[inline] + fn next(&mut self) -> Option { + if let Empty = *self { return None } + let oldll = mem::replace(self, Empty); + let (hd, rlln) = oldll.unwrap(); + let mut newll = rlln.value().clone(); + mem::swap(self, &mut newll); // self now contains tail, newll contains the Empty + Some(hd) + } +} + +// implements worker wrapper recursion closures using shared RcMFn variable... + +type RcMFn<'a, T: 'a> = Rc T + 'a>>>; + +//#[derive(Clone)] +//struct RcMFn<'a, T: 'a>(Rc T + 'a>>>); + +trait RcMFnMethods<'a, T> { + fn create T + 'a>(v: F) -> RcMFn<'a, T>; + fn invoke(&self, v: T) -> T; + fn set T + 'a>(&self, v: F); +} + +impl<'a, T: 'a> RcMFnMethods<'a, T> for RcMFn<'a, T> { + fn create T + 'a>(v: F) -> RcMFn<'a, T> { // creates new value wrapper + Rc::new(UnsafeCell::new(Box::new(v))) + } + #[inline(always)] // needs to be faster to be worth it + fn invoke(&self, v: T) -> T { + unsafe { (*(*(*self).get()))(v) } + } + fn set T + 'a>(&self, v: F) { + unsafe { *self.get() = Box::new(v); } + } +} + +// implementation for a reference-counted, interior-mutable variable +// necessary for such things as sharing data and recursive variables + +type RcMVar = Rc>; + +//#[derive(Clone)] +//struct RcMVar(Rc>); + +trait RcMVarMethods { + fn create(v: T) -> Self; + fn get(self: &Self) -> T; + fn set(self: &Self, v: T); +} + +impl RcMVarMethods for RcMVar { + fn create(v: T) -> RcMVar { // creates new value wrapped in RcMVar + Rc::new(RefCell::new(v)) + } + #[inline] + fn get(&self) -> T { + self.borrow().clone() + } + fn set(&self, v: T) { + *self.borrow_mut() = v; + } +} + +fn hammings() -> Box>> { + type LL<'a> = LazyList<'a, Rc>; + fn merge<'a>(x: LL<'a>, y: LL<'a>) -> LL<'a> { + let lte = { x.head() <= y.head() }; // private context for borrow + if lte { + let (hdx, tlx) = x.unwrap(); + LL::cons(hdx, move || merge(tlx.value().clone(), y)) + } else { + let (hdy, tly) = y.unwrap(); + LL::cons(hdy, move || merge(x, tly.value().clone())) + } + } + fn smult<'a>(m: BigUint, s: LL<'a>) -> LL<'a> { // like map m * but faster... + let smlt = RcMFn::create(move |ss: LL<'a>| ss); + let csmlt = smlt.clone(); + smlt.set(move |ss: LL<'a>| { + let (hd, tl) = ss.unwrap(); + let ccsmlt = csmlt.clone(); + LL::cons(Rc::new(&m * &*hd), move || ccsmlt.invoke(tl.value().clone())) + }); + smlt.invoke(s) + } + fn u<'a>(s: LL<'a>, n: usize) -> LL<'a> { + let nb = BigUint::from(n); + let rslt = RcMVar::create(Empty); + let crslt = rslt.clone(); // same interior data... + let cll = LL::cons(Rc::new(BigUint::from(1u8)), move || crslt.get()); // gets future value + // below sets future value for above closure... + rslt.set(if let Empty = s { smult(nb, cll) } else { merge(s, smult(nb, cll)) }); + rslt.get() + } + fn rll<'a>() -> LL<'a> { [5, 3, 2].into_iter() + .fold(Empty, |ll, n| u(ll, *n) ) } + let hmng = LL::cons(Rc::new(BigUint::from(1u8)), move || rll()); + Box::new(hmng.into_iter()) +} + +fn main() { + print!("["); + for (i, h) in hammings().take(20).enumerate() { + if i != 0 { print!(",") } + print!(" {}", h) + } + println!(" ]"); + + println!("{}", hammings().take(1691).last().unwrap()); + + let strt = Instant::now(); + + let rslt = hammings().take(1000000).last().unwrap(); + + let elpsd = strt.elapsed(); + let secs = elpsd.as_secs(); + let millis = (elpsd.subsec_nanos() / 1000000)as u64; + let dur = secs * 1000 + millis; + + println!("{}", rslt); + + println!("This last took {} milliseconds.", dur); +} diff --git a/Task/Hamming-numbers/Rust/hamming-numbers-6.rust b/Task/Hamming-numbers/Rust/hamming-numbers-6.rust new file mode 100644 index 0000000000..5c7be7dd76 --- /dev/null +++ b/Task/Hamming-numbers/Rust/hamming-numbers-6.rust @@ -0,0 +1,95 @@ +extern crate num; // requires dependency on the num library +use num::bigint::BigUint; + +use std::time::Instant; + +fn nth_hamming(n: u64) -> (u32, u32, u32) { + if n < 2 { + if n <= 0 { panic!("nth_hamming: argument is zero; no elements") } + return (0, 0, 0) // trivial case for n == 1 + } + + let lg3 = 3.0f64.ln() / 2.0f64.ln(); // log base 2 of 3 + let lg5 = 5.0f64.ln() / 2.0f64.ln(); // log base 2 of 5 + let fctr = 6.0f64 * lg3 * lg5; + let crctn = 30.0f64.sqrt().ln() / 2.0f64.ln(); // log base 2 of sqrt 30 + let lgest = (fctr * n as f64).powf(1.0f64/3.0f64) + - crctn; // from WP formula + let frctn = if n < 1000000000 { 0.509f64 } else { 0.105f64 }; + let lghi = (fctr * (n as f64 + frctn * lgest)).powf(1.0f64/3.0f64) + - crctn; // calculate hi log limit based on log(N) - WP article + let lglo = 2.0f64 * lgest - lghi; // and a lower limit of the upper "band" + let mut count = 0; // need to use extended precision, might go over + let mut bnd = Vec::with_capacity(0); + let klmt = (lghi / lg5) as u32 + 1; + for k in 0 .. klmt { // i, j, k values can be just u32 values + let p = k as f64 * lg5; + let jlmt = ((lghi - p) / lg3) as u32 + 1; + for j in 0 .. jlmt { + let q = p + j as f64 * lg3; + let ir = lghi - q; + let lg = q + (ir as u32) as f64; // current log value (estimated) + count += ir as u64 + 1; + if lg >= lglo { + bnd.push((lg, (ir as u32, j, k))) + } + } + } + if n > count { panic!("nth_hamming: band high estimate is too low!") }; + let ndx = (count - n) as usize; + if ndx >= bnd.len() { panic!("nth_hamming: band low estimate is too high!") }; + bnd.sort_by(|a, b| b.0.partial_cmp(&a.0).unwrap()); // sort decreasing order + + bnd[ndx].1 +} + +fn convert_log2big(o: (u32, u32, u32)) -> BigUint { + let two = BigUint::from(2u8); + let three = BigUint::from(3u8); + let five = BigUint::from(5u8); + let (x2, x3, x5) = o; + let mut ob = BigUint::from(1u8); // convert to BigUint at the end + for _ in 0 .. x2 { ob = ob * &two } + for _ in 0 .. x3 { ob = ob * &three } + for _ in 0 .. x5 { ob = ob * &five } + ob +} + +fn main() { + print!("["); + for (i, h) in (1 .. 21).map(nth_hamming).enumerate() { + if i != 0 { print!(",") } + print!(" {}", convert_log2big(h)) + } + println!(" ]"); + println!("{}", convert_log2big(nth_hamming(1691))); + + let strt = Instant::now(); + + let rslt = nth_hamming(1000000); + + let elpsd = strt.elapsed(); + let secs = elpsd.as_secs(); + let millis = (elpsd.subsec_nanos() / 1000000)as u64; + let dur = secs * 1000 + millis; + + println!("2^{} times 3^{} times 5^{}", rslt.0, rslt.1, rslt.2); + let rs = convert_log2big(rslt).to_str_radix(10); + let mut s = rs.as_str(); + println!("{} digits:", s.len()); + let lg3 = 3.0f64.log2(); + let lg5 = 5.0f64.log2(); + let lg = (rslt.0 as f64 + rslt.1 as f64 * lg3 + + rslt.2 as f64 * lg5) * 2.0f64.log10(); + println!("Approximately {}E+{}", 10.0f64.powf(lg.fract()), lg.trunc()); + if s.len() <= 10000 { + while s.len() > 100 { + let (f, r) = s.split_at(100); + s = r; + println!("{}", f); + } + println!("{}", s); + } + + println!("This last took {} milliseconds.", dur); +} diff --git a/Task/Hamming-numbers/Scala/hamming-numbers-4.scala b/Task/Hamming-numbers/Scala/hamming-numbers-4.scala index 45ff339304..d827eff613 100644 --- a/Task/Hamming-numbers/Scala/hamming-numbers-4.scala +++ b/Task/Hamming-numbers/Scala/hamming-numbers-4.scala @@ -1,13 +1,12 @@ def hamming(): Stream[BigInt] = { def merge(a: Stream[BigInt], b: Stream[BigInt]): Stream[BigInt] = { - val av = a.head; val bv = b.head - if (av < bv) av #:: merge(a.tail, b) - else bv #:: merge(a, b.tail) - } - def smult(m:BigInt, s: Stream[BigInt]): Stream[BigInt] = - (m * s.head) #:: smult(m, s.tail) // equiv to map (m *) s - faster - lazy val s5: Stream[BigInt] = 5 #:: smult(5, s5) - lazy val s35: Stream[BigInt] = 3 #:: merge(s5, smult(3, s35)) - lazy val s235: Stream[BigInt] = 2 #:: merge(s35, smult(2, s235)) - 1 #:: s235 - } + if (a.isEmpty) b else { + val av = a.head; val bv = b.head + if (av < bv) av #:: merge(a.tail, b) + else bv #:: merge(a, b.tail) } } + def smult(m:Int, s: Stream[BigInt]): Stream[BigInt] = + (m * s.head) #:: smult(m, s.tail) // equiv to map (m *) s; faster + def u(s: Stream[BigInt], n: Int): Stream[BigInt] = { + lazy val r: Stream[BigInt] = merge(s, smult(n, 1 #:: r)) + r } + 1 #:: List(5, 3, 2).foldLeft(Stream.empty[BigInt]) { u } } diff --git a/Task/Hamming-numbers/Scheme/hamming-numbers-2.ss b/Task/Hamming-numbers/Scheme/hamming-numbers-2.ss index 1c15857856..27a188dc33 100644 --- a/Task/Hamming-numbers/Scheme/hamming-numbers-2.ss +++ b/Task/Hamming-numbers/Scheme/hamming-numbers-2.ss @@ -1,14 +1,17 @@ (define (hamming) + (define (foldl f z l) + (define (foldls zs ls) + (if (null? ls) zs (foldls (f zs (car ls)) (cdr ls)))) + (foldls z l)) (define (merge a b) - (let ((x (car a)) (y (car b))) - (if (< x y) (cons x (delay (merge (force (cdr a)) b))) - (cons y (delay (merge a (force (cdr b)))))))) - (define (smult m s) (cons (* m (car s)) - (delay (smult m (force (cdr s)))))) ;; equiv to map (* m) s - (define s5 (cons 5 (delay (smult 5 s5)))) - (define s35 (cons 3 (delay (merge s5 (smult 3 s35))))) - (define s235 (cons 2 (delay (merge s35 (smult 2 s235))))) - (cons 1 (delay s235))) + (if (null? a) b + (let ((x (car a)) (y (car b))) + (if (< x y) (cons x (delay (merge (force (cdr a)) b))) + (cons y (delay (merge a (force (cdr b))))))))) + (define (smult m s) (cons (* m (car s)) ;; equiv to map (* m) s; faster + (delay (smult m (force (cdr s)))))) + (define (u s n) (letrec ((a (merge s (smult n (cons 1 (delay a)))))) a)) + (cons 1 (delay (foldl u '() '(5 3 2))))) ;;; test... (define (stream-take->list n strm) diff --git a/Task/Hamming-numbers/ZX-Spectrum-Basic/hamming-numbers.zx b/Task/Hamming-numbers/ZX-Spectrum-Basic/hamming-numbers.zx new file mode 100644 index 0000000000..1a616d1f86 --- /dev/null +++ b/Task/Hamming-numbers/ZX-Spectrum-Basic/hamming-numbers.zx @@ -0,0 +1,17 @@ +10 FOR h=1 TO 20: GO SUB 1000: NEXT h +20 LET h=1691: GO SUB 1000 +30 STOP +1000 REM Hamming +1010 DIM a(h) +1030 LET a(1)=1: LET x2=2: LET x3=3: LET x5=5: LET i=1: LET j=1: LET k=1 +1040 FOR n=2 TO h +1050 LET m=x2 +1060 IF m>x3 THEN LET m=x3 +1070 IF m>x5 THEN LET m=x5 +1080 LET a(n)=m +1090 IF m=x2 THEN LET i=i+1: LET x2=2*a(i) +1100 IF m=x3 THEN LET j=j+1: LET x3=3*a(j) +1110 IF m=x5 THEN LET k=k+1: LET x5=5*a(k) +1120 NEXT n +1130 PRINT "H(";h;")= ";a(h) +1140 RETURN diff --git a/Task/Handle-a-signal/00DESCRIPTION b/Task/Handle-a-signal/00DESCRIPTION index a63536252c..2ad9e31cd5 100644 --- a/Task/Handle-a-signal/00DESCRIPTION +++ b/Task/Handle-a-signal/00DESCRIPTION @@ -14,7 +14,9 @@ Most general purpose operating systems provide interrupt facilities, sometimes c Unhandled signals generally terminate a program in a disorderly manner. Signal handlers are created so that the program behaves in a well-defined manner upon receipt of a signal. -For this task you will provide a program that displays a single integer -on each line of output at the rate of one integer in each half second. -Upon receipt of the SigInt signal (often created by the user typing ctrl-C) the program will cease printing integers to its output, print the number of seconds -the program has run, and then the program will terminate. + +;Task: +Provide a program that displays a single integer on each line of output at the rate of one integer in each half second. + +Upon receipt of the SigInt signal (often created by the user typing ctrl-C) the program will cease printing integers to its output, print the number of seconds the program has run, and then the program will terminate. +

    diff --git a/Task/Handle-a-signal/COBOL/handle-a-signal.cobol b/Task/Handle-a-signal/COBOL/handle-a-signal.cobol new file mode 100644 index 0000000000..4f6954a84b --- /dev/null +++ b/Task/Handle-a-signal/COBOL/handle-a-signal.cobol @@ -0,0 +1,44 @@ + identification division. + program-id. signals. + data division. + working-storage section. + 01 signal-flag pic 9 external. + 88 signalled value 1. + 01 half-seconds usage binary-long. + 01 start-time usage binary-c-long. + 01 end-time usage binary-c-long. + 01 handler usage program-pointer. + 01 SIGINT constant as 2. + + procedure division. + call "gettimeofday" using start-time null + set handler to entry "handle-sigint" + call "signal" using by value SIGINT by value handler + + perform until exit + if signalled then exit perform end-if + call "CBL_OC_NANOSLEEP" using 500000000 + if signalled then exit perform end-if + add 1 to half-seconds + display half-seconds + end-perform + + call "gettimeofday" using end-time null + subtract start-time from end-time + display "Program ran for " end-time " seconds" + goback. + end program signals. + + identification division. + program-id. handle-sigint. + data division. + working-storage section. + 01 signal-flag pic 9 external. + + linkage section. + 01 the-signal usage binary-long. + + procedure division using by value the-signal returning omitted. + move 1 to signal-flag + goback. + end program handle-sigint. diff --git a/Task/Handle-a-signal/Perl-6/handle-a-signal.pl6 b/Task/Handle-a-signal/Perl-6/handle-a-signal.pl6 index 94bc669861..66c0d2a7f4 100644 --- a/Task/Handle-a-signal/Perl-6/handle-a-signal.pl6 +++ b/Task/Handle-a-signal/Perl-6/handle-a-signal.pl6 @@ -1,4 +1,4 @@ -signal(Signal::SIGINT).tap: { +signal(SIGINT).tap: { note "Took { now - INIT now } seconds."; exit; } diff --git a/Task/Handle-a-signal/REXX/handle-a-signal.rexx b/Task/Handle-a-signal/REXX/handle-a-signal.rexx index 722440892f..c344c9a82e 100644 --- a/Task/Handle-a-signal/REXX/handle-a-signal.rexx +++ b/Task/Handle-a-signal/REXX/handle-a-signal.rexx @@ -1,20 +1,15 @@ -/*REXX program displays integers until a Ctrl─C is pressed, then show*/ -/* the number of seconds that have elapsed since start of pgm execution.*/ +/*REXX program displays integers until a Ctrl─C is pressed, then shows the number of */ +/*────────────────────────────────── seconds that have elapsed since start of execution.*/ +call time 'Reset' /*reset the REXX elapsed timer. */ +signal on halt /*HALT: signaled via a Ctrl─C in DOS.*/ -call time 'E' /*reset the REXX elapsed timer. */ -signal on halt /*HALT is signaled via a Ctrl─C.*/ + do j=1 /*start with unity and go ye forth. */ + say right(j,20) /*display the integer right-justified. */ + t=time('E') /*get the REXX elapsed time in seconds.*/ + do forever; u=time('Elapsed') /* " " " " " " " */ + if ut+.5 then iterate j /* ◄═══ passed midnight or ½ second. */ + end /*forever*/ + end /*j*/ - do j=1 /*start with 1 and go ye forth. */ - say right(j,20) /*display integer right-justified*/ - t=time('E') /*get the elapsed time in seconds*/ - do forever; u=time('E') /*get the elapsed time in seconds./ - if ut+.5 then iterate j /* ◄═══ means we passed ½ second.*/ - end /*forever*/ - end /*j*/ - -say 'Program control should never ever get here, said Captain Dunsel.' - -/*──────────────────────────────────HALT subroutine─────────────────────*/ -halt: say 'program HALTed, it ran for' format(time("E"),,2) 'seconds.' - /*stick a fork in it, we're done.*/ +halt: say 'program HALTed, it ran for' format(time("ELapsed"),,2) 'seconds.' + /*stick a fork in it, we're all done. */ diff --git a/Task/Happy-numbers/00DESCRIPTION b/Task/Happy-numbers/00DESCRIPTION index b446795518..400742679d 100644 --- a/Task/Happy-numbers/00DESCRIPTION +++ b/Task/Happy-numbers/00DESCRIPTION @@ -5,8 +5,12 @@ From Wikipedia, the free encyclopedia: Display an example of your output here. -'''Task:''' Find and print the first 8 happy numbers. -See also: +;task: +Find and print the first 8 happy numbers. + + +;See also * [[oeis:A007770|The     happy numbers on OEIS:   A007770]] * [[oeis:A031177|The unhappy numbers on OEIS;   A031177]] +

    diff --git a/Task/Happy-numbers/AppleScript/happy-numbers-1.applescript b/Task/Happy-numbers/AppleScript/happy-numbers-1.applescript new file mode 100644 index 0000000000..96aeef9542 --- /dev/null +++ b/Task/Happy-numbers/AppleScript/happy-numbers-1.applescript @@ -0,0 +1,32 @@ +on run + set howManyHappyNumbers to 8 + set happyNumberList to {} + set globalCounter to 1 + + repeat howManyHappyNumbers times + repeat while not isHappy(globalCounter) + set globalCounter to globalCounter + 1 + end repeat + set end of happyNumberList to globalCounter + set globalCounter to globalCounter + 1 + end repeat + log happyNumberList +end run + +on isHappy(numberToCheck) + set localCycle to {} + repeat while (numberToCheck ≠ 1) + if localCycle contains numberToCheck then + exit repeat + end if + set end of localCycle to numberToCheck + set tempNumber to 0 + repeat while (numberToCheck > 0) + set digitOfNumber to numberToCheck mod 10 + set tempNumber to tempNumber + (digitOfNumber ^ 2) + set numberToCheck to (numberToCheck - digitOfNumber) / 10 + end repeat + set numberToCheck to tempNumber + end repeat + return (numberToCheck = 1) +end isHappy diff --git a/Task/Happy-numbers/AppleScript/happy-numbers-2.applescript b/Task/Happy-numbers/AppleScript/happy-numbers-2.applescript new file mode 100644 index 0000000000..0595df944e --- /dev/null +++ b/Task/Happy-numbers/AppleScript/happy-numbers-2.applescript @@ -0,0 +1,131 @@ +-- isHappy :: Int -> Bool +on isHappy(n) + + -- endsInOne :: [Int] -> Int -> Bool + script endsInOne + + -- sumOfSquaredDigits :: Int -> Int + script sumOfSquaredDigits + + -- digitSquared :: Int -> Int -> Int + script digitSquared + on lambda(a, x) + (a + (x as integer) ^ 2) as integer + end lambda + end script + + on lambda(n) + foldl(digitSquared, 0, splitOn("", n as string)) + end lambda + end script + + -- [Int] -> Int -> Bool + on lambda(s, n) + if n = 1 then + true + else + if s contains n then + false + else + lambda(s & n, lambda(n) of sumOfSquaredDigits) + end if + end if + end lambda + end script + + endsInOne's lambda({}, n) +end isHappy + + +-- TEST +on run + + -- seriesLength :: {n:Int, xs:[Int]} -> Bool + script seriesLength + property target : 8 + + on lambda(rec) + length of xs of rec = target of seriesLength + end lambda + end script + + -- succTest :: {n:Int, xs:[Int]} -> {n:Int, xs:[Int]} + script succTest + on lambda(rec) + set xs to xs of rec + set n to n of rec + + script testResult + on lambda(x) + if isHappy(x) then + xs & x + else + xs + end if + end lambda + end script + + {n:n + 1, xs:testResult's lambda(n)} + end lambda + end script + + xs of |until|(seriesLength, succTest, {n:1, xs:{}}) + + --> {1, 7, 10, 13, 19, 23, 28, 31} +end run + + + +-- GENERIC FUNCTIONS + +-- 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 + +-- until :: (a -> Bool) -> (a -> a) -> a -> a +on |until|(p, f, x) + set mp to mReturn(p) + set mf to mReturn(f) + + script + property p : mp's lambda + property f : mf's lambda + + on lambda(v) + repeat until p(v) + set v to f(v) + end repeat + return v + end lambda + end script + + result's lambda(x) +end |until| + +-- splitOn :: Text -> Text -> [Text] +on splitOn(strDelim, strMain) + set {dlm, my text item delimiters} to {my text item delimiters, strDelim} + set xs to text items of strMain + set my text item delimiters to dlm + return xs +end splitOn + +-- 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 diff --git a/Task/Happy-numbers/AppleScript/happy-numbers-3.applescript b/Task/Happy-numbers/AppleScript/happy-numbers-3.applescript new file mode 100644 index 0000000000..9fce257307 --- /dev/null +++ b/Task/Happy-numbers/AppleScript/happy-numbers-3.applescript @@ -0,0 +1 @@ +{1, 7, 10, 13, 19, 23, 28, 31} diff --git a/Task/Happy-numbers/AppleScript/happy-numbers.applescript b/Task/Happy-numbers/AppleScript/happy-numbers.applescript deleted file mode 100644 index 9deba2cf39..0000000000 --- a/Task/Happy-numbers/AppleScript/happy-numbers.applescript +++ /dev/null @@ -1,32 +0,0 @@ -on run - set howManyHappyNumbers to 8 - set happyNumberList to {} - set globalCounter to 1 - - repeat howManyHappyNumbers times - repeat while not isHappy(globalCounter) - set globalCounter to globalCounter + 1 - end repeat - set end of happyNumberList to globalCounter - set globalCounter to globalCounter + 1 - end repeat - log happyNumberList -end run - -on isHappy(numberToCheck) - set localCycle to {} - repeat while (numberToCheck ≠ 1) - if localCycle contains numberToCheck then - exit repeat - end if - set end of localCycle to numberToCheck - set tempNumber to 0 - repeat while (numberToCheck > 0) - set digitOfNumber to numberToCheck mod 10 - set tempNumber to tempNumber + (digitOfNumber ^ 2) - set numberToCheck to (numberToCheck - digitOfNumber) / 10 - end repeat - set numberToCheck to tempNumber - end repeat - return (numberToCheck = 1) -end isHappy diff --git a/Task/Happy-numbers/JavaScript/happy-numbers.js b/Task/Happy-numbers/JavaScript/happy-numbers-1.js similarity index 100% rename from Task/Happy-numbers/JavaScript/happy-numbers.js rename to Task/Happy-numbers/JavaScript/happy-numbers-1.js diff --git a/Task/Happy-numbers/JavaScript/happy-numbers-2.js b/Task/Happy-numbers/JavaScript/happy-numbers-2.js new file mode 100644 index 0000000000..c92ac25a78 --- /dev/null +++ b/Task/Happy-numbers/JavaScript/happy-numbers-2.js @@ -0,0 +1,25 @@ +(() => { + 'use strict'; + + // isHappy :: Int -> Bool + function isHappy(n) { + let f = n => n.toString() + .split('') + .reduce((a, x) => a + Math.pow(parseInt(x, 10), 2), 0), + p = (s, n) => n === 1 ? true : ( + s.has(n) ? false : p(s.add(n), f(n)) + ); + return p(new Set(), n); + } + + // TEST + + // range :: Int -> Int -> [Int] + let range = (m, n) => Array.from({ + length: Math.floor(n - m) + 1 + }, (_, i) => m + i); + + return range(1, 50) + .filter(isHappy) + .slice(0, 8); +})() diff --git a/Task/Happy-numbers/JavaScript/happy-numbers-3.js b/Task/Happy-numbers/JavaScript/happy-numbers-3.js new file mode 100644 index 0000000000..5800fcce68 --- /dev/null +++ b/Task/Happy-numbers/JavaScript/happy-numbers-3.js @@ -0,0 +1 @@ +[1, 7, 10, 13, 19, 23, 28, 31] diff --git a/Task/Happy-numbers/JavaScript/happy-numbers-4.js b/Task/Happy-numbers/JavaScript/happy-numbers-4.js new file mode 100644 index 0000000000..4d9502d888 --- /dev/null +++ b/Task/Happy-numbers/JavaScript/happy-numbers-4.js @@ -0,0 +1,35 @@ +(() => { + 'use strict'; + + // isHappy :: Int -> Bool + let isHappy = n => { + let f = n => n.toString() + .split('') + .reduce((a, x) => a + Math.pow(parseInt(x, 10), 2), 0), + p = (s, n) => n === 1 ? true : ( + s.has(n) ? false : p(s.add(n), f(n)) + ); + return p(new Set(), n); + }, + + // until :: (a -> Bool) -> (a -> a) -> a -> a + until = (p, f, x) => { + let v = x; + while (!p(v)) v = f(v); + return v; + }; + + return until( + m => m.xs.length === 8, + m => { + let n = m.n; + return { + n: n + 1, + xs: isHappy(n) ? m.xs.concat(n) : m.xs + }; + }, { + n: 1, + xs: [] + } + ).xs; +})(); diff --git a/Task/Happy-numbers/JavaScript/happy-numbers-5.js b/Task/Happy-numbers/JavaScript/happy-numbers-5.js new file mode 100644 index 0000000000..5800fcce68 --- /dev/null +++ b/Task/Happy-numbers/JavaScript/happy-numbers-5.js @@ -0,0 +1 @@ +[1, 7, 10, 13, 19, 23, 28, 31] diff --git a/Task/Happy-numbers/REXX/happy-numbers-1.rexx b/Task/Happy-numbers/REXX/happy-numbers-1.rexx index d250d87058..8fb8f111be 100644 --- a/Task/Happy-numbers/REXX/happy-numbers-1.rexx +++ b/Task/Happy-numbers/REXX/happy-numbers-1.rexx @@ -1,19 +1,19 @@ -/*REXX program computes and displays a specified number of happy numbers. */ -parse arg limit . /*get optional arguments from the C.L. */ -if limit=='' | limit==',' then limit=8 /*Not specified? Then use the default.*/ -haps=0 /*count of the happy numbers (so far).*/ +/*REXX program computes and displays a specified amount of happy numbers. */ +parse arg limit . /*obtain optional argument from the CL.*/ +if limit=='' | limit=="," then limit=8 /*Not specified? Then use the default.*/ +haps=0 /*count of the happy numbers (so far).*/ - do n=1 while hapssw then do /*if the list is too long, then split */ - say strip($) /*··· and display what we've got. */ - $=n /*Set the next line to overflow. */ - end /* [↑] now contains overflow. */ + if !.s then do; !.n=1; iterate n; end /*is S unhappy? Then Q is also. */ + if @.s then leave /*Have we found a happy number? */ + q=s /*try the Q sum to see if it's happy.*/ + end /*until*/ + @.n=1 /*mark N as a happy number. */ + haps=haps+1 /*bump the count of the happy numbers. */ + if hapssw then do /*if the list is too long, then split */ + say strip($) /* ··· and display what we've got. */ + $=n /*Set the next line to overflow. */ + end /* [↑] new line now contains overflow.*/ end /*n*/ -if $\='' then say strip($) /*display any residual happy numbers. */ - /*stick a fork in it, we're all done. */ +if $\='' then say strip($) /*display any residual happy numbers. */ + /*stick a fork in it, we're all done. */ diff --git a/Task/Happy-numbers/ZX-Spectrum-Basic/happy-numbers.zx b/Task/Happy-numbers/ZX-Spectrum-Basic/happy-numbers.zx new file mode 100644 index 0000000000..8f2c4c5e72 --- /dev/null +++ b/Task/Happy-numbers/ZX-Spectrum-Basic/happy-numbers.zx @@ -0,0 +1,16 @@ +10 FOR i=1 TO 100 +20 GO SUB 1000 +30 IF isHappy=1 THEN PRINT i;" is a happy number" +40 NEXT i +50 STOP +1000 REM Is Happy? +1010 LET isHappy=0: LET count=0: LET num=i +1020 IF count=50 OR isHappy=1 THEN RETURN +1030 LET n$=STR$ (num) +1040 LET count=count+1 +1050 LET isHappy=0 +1060 FOR j=1 TO LEN n$ +1070 LET isHappy=isHappy+VAL n$(j)^2 +1080 NEXT j +1090 LET num=isHappy +1100 GO TO 1020 diff --git a/Task/Harshad-or-Niven-series/00DESCRIPTION b/Task/Harshad-or-Niven-series/00DESCRIPTION index 332183f0c2..fb47fb33cf 100644 --- a/Task/Harshad-or-Niven-series/00DESCRIPTION +++ b/Task/Harshad-or-Niven-series/00DESCRIPTION @@ -3,12 +3,16 @@ {{omit from|Openscad}} {{omit from|TPP}} -The [http://mathworld.wolfram.com/HarshadNumber.html Harshad] or Niven numbers are positive integers >= 1 that are divisible by the sum of their digits. +The [http://mathworld.wolfram.com/HarshadNumber.html Harshad] or Niven numbers are positive integers ≥ 1 that are divisible by the sum of their digits. -For example, 42 is a [[oeis:A005349|Harshad number]] as 42 is divisible by (4+2) without remainder. -Assume that the series is defined as the numbers in increasing order. +For example,   '''42'''   is a [[oeis:A005349|Harshad number]] as   '''42'''   is divisible by   ('''4''' + '''2''')   without remainder. +
    Assume that the series is defined as the numbers in increasing order. + +;Task: The task is to create a function/method/procedure to generate successive members of the Harshad sequence. + Use it to list the first twenty members of the sequence and list the first Harshad number greater than 1000. Show your output here. +

    diff --git a/Task/Harshad-or-Niven-series/Perl-6/harshad-or-niven-series.pl6 b/Task/Harshad-or-Niven-series/Perl-6/harshad-or-niven-series.pl6 index e51bdf7806..a688d57b37 100644 --- a/Task/Harshad-or-Niven-series/Perl-6/harshad-or-niven-series.pl6 +++ b/Task/Harshad-or-Niven-series/Perl-6/harshad-or-niven-series.pl6 @@ -1,4 +1,4 @@ -constant @harshad = grep { $_ %% [+] .comb }, 1 .. *; +constant @harshad = grep { $_ %% .comb.sum }, 1 .. *; say @harshad[^20]; say @harshad.first: * > 1000; diff --git a/Task/Harshad-or-Niven-series/PowerShell/harshad-or-niven-series-1.psh b/Task/Harshad-or-Niven-series/PowerShell/harshad-or-niven-series-1.psh new file mode 100644 index 0000000000..ac90265591 --- /dev/null +++ b/Task/Harshad-or-Niven-series/PowerShell/harshad-or-niven-series-1.psh @@ -0,0 +1,2 @@ + 1..1000 | Where { $_ % ( [int[]][string[]][char[]][string]$_ | Measure -Sum ).Sum -eq 0 } | Select -First 20 +1001..2000 | Where { $_ % ( [int[]][string[]][char[]][string]$_ | Measure -Sum ).Sum -eq 0 } | Select -First 1 diff --git a/Task/Harshad-or-Niven-series/PowerShell/harshad-or-niven-series-2.psh b/Task/Harshad-or-Niven-series/PowerShell/harshad-or-niven-series-2.psh new file mode 100644 index 0000000000..75f74df807 --- /dev/null +++ b/Task/Harshad-or-Niven-series/PowerShell/harshad-or-niven-series-2.psh @@ -0,0 +1,41 @@ +function Get-HarshadNumbers + { + <# + .SYNOPSIS + Returns numbers in the Harshad or Niven series. + + .DESCRIPTION + Returns all integers in the given range that are evenly divisible by the sum of their digits + in ascending order. + + .PARAMETER Minimum + Lower bound of the range to search for Harshad numbers. Defaults to 1. + + .PARAMETER Maximum + Upper bound of the range to search for Harshad numbers. Defaults to 2,147,483,647 + + .PARAMETER Count + Maximum number of Harshad numbers to return. + #> + + [cmdletbinding()] + Param ( + [int]$Minimum = 1, + [int]$Maximum = [int]::MaxValue, + [int]$Count ) + + # Skip any non-positive numbers in the specified range + $Minimum = [math]::Max( 1, $Minimum ) + + # If the adjusted range has any numbers in it... + If ( $Maximum -ge $Minimum ) + { + # If a count was specified, build a parameter for the Select statement to kill the pipeline when the count is achieved. + If ( $Count ) { $SelectParam = @{ First = $Count } } + Else { $SelectParam = @{} } + + # For each number in the range, test the remainder of it divided it by iteself (converted to a string, + # then a character array, then a string array, then an integer array, then summed). + $Minimum..$Maximum | Where { $_ % ( [int[]][string[]][char[]][string]$_ | Measure -Sum ).Sum -eq 0 } | Select @SelectParam + } + } diff --git a/Task/Harshad-or-Niven-series/PowerShell/harshad-or-niven-series-3.psh b/Task/Harshad-or-Niven-series/PowerShell/harshad-or-niven-series-3.psh new file mode 100644 index 0000000000..d802146f68 --- /dev/null +++ b/Task/Harshad-or-Niven-series/PowerShell/harshad-or-niven-series-3.psh @@ -0,0 +1,2 @@ +Get-HarshadNumbers -Count 20 +Get-HarshadNumbers -Minimum 1001 -Count 1 diff --git a/Task/Harshad-or-Niven-series/REXX/harshad-or-niven-series-1.rexx b/Task/Harshad-or-Niven-series/REXX/harshad-or-niven-series-1.rexx index 548e988b4d..9d67f5192b 100644 --- a/Task/Harshad-or-Niven-series/REXX/harshad-or-niven-series-1.rexx +++ b/Task/Harshad-or-Niven-series/REXX/harshad-or-niven-series-1.rexx @@ -1,21 +1,18 @@ -/*REXX program finds the first A Niven numbers; also first Niven number > B.*/ -parse arg A B . /*get optional arguments from the C.L. */ -if A=='' | A==',' then A= 20 /*Not specified? Then use the default.*/ -if B=='' | B==',' then B=1000 /* " " " " " " */ -numeric digits 1+max(8, length(A), length(B)) /*enable use of any sized #s*/ -#=0; $= /*set Niven numbers count; Niven list.*/ - - do j=1 until #==A /* [↓] let's go Niven number hunting. */ - if j//sumDigs(j)==0 then do; #=#+1; $=$ j; end /*bump count; append──►list.*/ - end /*j*/ +/*REXX program finds the first A Niven numbers; it also finds first Niven number > B.*/ +parse arg A B . /*obtain optional arguments from the CL*/ +if A=='' | A==',' then A= 20 /*Not specified? Then use the default.*/ +if B=='' | B==',' then B=1000 /* " " " " " " */ +numeric digits 1+max(8, length(A), length(B)) /*enable the use of any sized numbers. */ +#=0; $= /*set Niven numbers count; Niven list.*/ + do j=1 until #==A /*◄───── let's go Niven number hunting.*/ + if j//sumDigs(j)==0 then do; #=#+1; $=$ j; end + end /*j*/ /* [↑] bump count; append J ──► list.*/ say 'first' A 'Niven numbers:' $ - do t=B+1 until t//sumDigs(t)==0; end /*hunt for a Niven (or Harshad) number.*/ + do t=B+1 until t//sumDigs(t)==0; end /*hunt for a Niven (or Harshad) number.*/ -say 'first Niven number >' B " is: " t -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -sumDigs: procedure; parse arg x; s=0 - do k=1 for length(x); s=s+substr(x,k,1); end /*k*/ - return s +say 'first Niven number >' B " is: " t +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sumDigs: procedure; parse arg x; s=0; do k=1 for length(x); s=s+substr(x,k,1); end /*k*/ diff --git a/Task/Harshad-or-Niven-series/REXX/harshad-or-niven-series-2.rexx b/Task/Harshad-or-Niven-series/REXX/harshad-or-niven-series-2.rexx index c091915ffd..bf139e07a0 100644 --- a/Task/Harshad-or-Niven-series/REXX/harshad-or-niven-series-2.rexx +++ b/Task/Harshad-or-Niven-series/REXX/harshad-or-niven-series-2.rexx @@ -1,21 +1,19 @@ -/*REXX program finds the first A Niven numbers; also first Niven number > B.*/ -parse arg A B . /*get optional arguments from the C.L. */ -if A=='' | A==',' then A= 20 /*Not specified? Then use the default.*/ -if B=='' | B==',' then B=1000 /* " " " " " " */ -numeric digits 1+max(8, length(A), length(B)) /*enable use of any sized #s*/ -#=0; $= /*set Niven numbers count; Niven list.*/ - - do j=1 until #==A /* [↓] let's go Niven number hunting. */ - if isNiven(j) then do; #=#+1; $=$ j; end /*bump count; append──►list.*/ - end /*j*/ +/*REXX program finds the first A Niven numbers; it also finds first Niven number > B.*/ +parse arg A B . /*obtain optional arguments from the CL*/ +if A=='' | A==',' then A= 20 /*Not specified? Then use the default.*/ +if B=='' | B==',' then B=1000 /* " " " " " " */ +numeric digits 1+max(8, length(A), length(B)) /*enable the use of any sized numbers. */ +#=0; $= /*set Niven numbers count; Niven list.*/ + do j=1 until #==A /*◄───── let's go Niven number hunting.*/ + if isNiven(j) then do; #=#+1; $=$ j; end + end /*j*/ /* [↑] bump count; append J ──► list.*/ say 'first' A 'Niven numbers:' $ - do t=B+1 until isNiven(t); end /*hunt for a Niven (or Harshad) number.*/ + do t=B+1 until isNiven(t); end /*hunt for a Niven (or Harshad) number.*/ -say 'first Niven number >' B " is: " t -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -isNiven: procedure; parse arg x; s=0 - do k=1 for length(x); s=s+substr(x,k,1); end /*k*/ +say 'first Niven number >' B " is: " t +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +isNiven: procedure; parse arg x; s=0; do k=1 for length(x); s=s+substr(x,k,1); end /*k*/ return x//s==0 diff --git a/Task/Harshad-or-Niven-series/REXX/harshad-or-niven-series-3.rexx b/Task/Harshad-or-Niven-series/REXX/harshad-or-niven-series-3.rexx index 50240f0ad5..a43893666c 100644 --- a/Task/Harshad-or-Niven-series/REXX/harshad-or-niven-series-3.rexx +++ b/Task/Harshad-or-Niven-series/REXX/harshad-or-niven-series-3.rexx @@ -1,22 +1,21 @@ -/*REXX program finds the first A Niven numbers; also first Niven number > B.*/ -parse arg A B . /*get optional arguments from the C.L. */ -if A=='' | A==',' then A= 20 /*Not specified? Then use the default.*/ -if B=='' | B==',' then B=1000 /* " " " " " " */ -numeric digits 1+max(8, length(A), length(B)) /*enable use of any sized #s*/ -#=0; $= /*set Niven numbers count; Niven list.*/ - - do j=1 until #==A /* [↓] let's go Niven number hunting. */ - if isNiven(j) then do; #=#+1; $=$ j; end /*bump count; append──►list.*/ - end /*j*/ +/*REXX program finds the first A Niven numbers; it also finds first Niven number > B.*/ +parse arg A B . /*obtain optional arguments from the CL*/ +if A=='' | A==',' then A= 20 /*Not specified? Then use the default.*/ +if B=='' | B==',' then B=1000 /* " " " " " " */ +numeric digits 1+max(8, length(A), length(B)) /*enable the use of any sized numbers. */ +#=0; $= /*set Niven numbers count; Niven list.*/ + do j=1 until #==A /*◄───── let's go Niven number hunting.*/ + if isNiven(j) then do; #=#+1; $=$ j; end + end /*j*/ /* [↑] bump count; append J ──► list.*/ say 'first' A 'Niven numbers:' $ - do t=B+1 until isNiven(t); end /*hunt for a Niven (or Harshad) number.*/ + do t=B+1 until isNiven(t); end /*hunt for a Niven (or Harshad) number.*/ -say 'first Niven number >' B " is: " t -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -isNiven: procedure; parse arg x 1 s 2 q /*use first digit for S (the sum),*/ - do while q\==''; parse var q _ 2 q; s=s+_; end /*k*/ - /* ↑ */ - return x//s==0 /* └──◄is destructively parsed*/ +say 'first Niven number >' B " is: " t +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +isNiven: procedure; parse arg x 1 sum 2 q /*use the first decimal digit for SUM.*/ + do while q\==''; parse var q _ 2 q; sum=sum+_; end /*k*/ + /* ↑ */ + return x//sum==0 /* └───◄ is destructively parsed. */ diff --git a/Task/Harshad-or-Niven-series/REXX/harshad-or-niven-series-4.rexx b/Task/Harshad-or-Niven-series/REXX/harshad-or-niven-series-4.rexx new file mode 100644 index 0000000000..9de9dc9972 --- /dev/null +++ b/Task/Harshad-or-Niven-series/REXX/harshad-or-niven-series-4.rexx @@ -0,0 +1,26 @@ +/*REXX program finds the first A Niven numbers; it also finds first Niven number > B.*/ +parse arg A B . /*obtain optional arguments from the CL*/ +if A=='' | A==',' then A= 20 /*Not specified? Then use the default.*/ +if B=='' | B==',' then B=1000 /* " " " " " " */ +tell= A>0; A=abs(A) /*flag for showing a Niven numbers list*/ +A=abs(a) +numeric digits 1+max(8, length(A), length(B)) /*enable the use of any sized numbers. */ +#=0; $= /*set Niven numbers count; Niven list.*/ + do j=1 until #==A /*◄───── let's go Niven number hunting.*/ + if isNiven(j) then do; #=#+1; !.#=j; end + end /*j*/ /* [↑] bump count; append J ──► list.*/ +w=length(!.w) /*W: is the width of largest Niven #.*/ +if tell then do + say 'first' A 'Niven numbers:'; do k=1 for #; say right(!.k, w); end /*k*/ + end + else say 'last of the' A 'Niven numbers: ' !.# +say + do t=B+1 until isNiven(t); end /*hunt for a Niven (or Harshad) number.*/ + +say 'first Niven number >' B " is: " t +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +isNiven: procedure; parse arg x 1 sum 2 q /*use the first decimal digit for SUM.*/ + do while q\==''; parse var q _ 2 q; sum=sum+_; end /*k*/ + /* ↑ */ + return x//sum==0 /* └───◄ is destructively parsed. */ diff --git a/Task/Harshad-or-Niven-series/ZX-Spectrum-Basic/harshad-or-niven-series.zx b/Task/Harshad-or-Niven-series/ZX-Spectrum-Basic/harshad-or-niven-series.zx new file mode 100644 index 0000000000..d033a1c620 --- /dev/null +++ b/Task/Harshad-or-Niven-series/ZX-Spectrum-Basic/harshad-or-niven-series.zx @@ -0,0 +1,17 @@ +10 LET k=0: LET n=0 +20 IF k=20 THEN GO TO 60 +30 LET n=n+1: GO SUB 1000 +40 IF isHarshad THEN PRINT n;" ";: LET k=k+1 +50 GO TO 20 +60 LET n=1001 +70 GO SUB 1000: IF NOT isHarshad THEN LET n=n+1: GO TO 70 +80 PRINT '"First Harshad number larger than 1000 is ";n +90 STOP +1000 REM is Harshad? +1010 LET s=0: LET n$=STR$ n +1020 FOR i=1 TO LEN n$ +1030 LET s=s+VAL n$(i) +1040 NEXT i +1050 LET isHarshad=NOT FN m(n,s) +1060 RETURN +1100 DEF FN m(a,b)=a-INT (a/b)*b diff --git a/Task/Hash-from-two-arrays/00DESCRIPTION b/Task/Hash-from-two-arrays/00DESCRIPTION index e46baf619e..53ff4b70f1 100644 --- a/Task/Hash-from-two-arrays/00DESCRIPTION +++ b/Task/Hash-from-two-arrays/00DESCRIPTION @@ -3,8 +3,12 @@ {{omit from|TI-83 BASIC}} {{omit from|TI-89 BASIC}} +;Task: Using two Arrays of equal length, create a Hash object where the elements from one array (the keys) are linked to the elements of the other (the values) -Related task: [[Associative arrays/Creation]] + +;Related task: +*   [[Associative arrays/Creation]] +

    diff --git a/Task/Hash-from-two-arrays/JavaScript/hash-from-two-arrays-3.js b/Task/Hash-from-two-arrays/JavaScript/hash-from-two-arrays-3.js new file mode 100644 index 0000000000..c0c45c0a20 --- /dev/null +++ b/Task/Hash-from-two-arrays/JavaScript/hash-from-two-arrays-3.js @@ -0,0 +1,6 @@ +function arrToObj(keys, vals) { + return keys.reduce(function(map, key, index) { + map[key] = vals[index]; + return map; + }, {}); +} diff --git a/Task/Hash-from-two-arrays/PARI-GP/hash-from-two-arrays.pari b/Task/Hash-from-two-arrays/PARI-GP/hash-from-two-arrays.pari new file mode 100644 index 0000000000..6e6354a68c --- /dev/null +++ b/Task/Hash-from-two-arrays/PARI-GP/hash-from-two-arrays.pari @@ -0,0 +1 @@ +hash(key, value)=Map(matrix(#key,2,x,y,if(y==1,key[x],value[x]))); diff --git a/Task/Hash-from-two-arrays/Perl-6/hash-from-two-arrays-1.pl6 b/Task/Hash-from-two-arrays/Perl-6/hash-from-two-arrays-1.pl6 index 3af0bf6178..803851feb6 100644 --- a/Task/Hash-from-two-arrays/Perl-6/hash-from-two-arrays-1.pl6 +++ b/Task/Hash-from-two-arrays/Perl-6/hash-from-two-arrays-1.pl6 @@ -1,3 +1,4 @@ my @keys = ; -my @vals = ^5; -my %hash = flat @keys Z @vals; +my @values = ^5; + +my %hash = @keys Z=> @values; diff --git a/Task/Hash-from-two-arrays/Perl-6/hash-from-two-arrays-2.pl6 b/Task/Hash-from-two-arrays/Perl-6/hash-from-two-arrays-2.pl6 index 4a1c69dfbf..c1c0ccf518 100644 --- a/Task/Hash-from-two-arrays/Perl-6/hash-from-two-arrays-2.pl6 +++ b/Task/Hash-from-two-arrays/Perl-6/hash-from-two-arrays-2.pl6 @@ -1,2 +1,2 @@ -my @v = ; -my %hash = @v Z=> @v.keys; +my %hash; +%hash{@keys} = @values; diff --git a/Task/Hash-from-two-arrays/Perl-6/hash-from-two-arrays-3.pl6 b/Task/Hash-from-two-arrays/Perl-6/hash-from-two-arrays-3.pl6 index 0f1c24a928..773150f498 100644 --- a/Task/Hash-from-two-arrays/Perl-6/hash-from-two-arrays-3.pl6 +++ b/Task/Hash-from-two-arrays/Perl-6/hash-from-two-arrays-3.pl6 @@ -1,2 +1 @@ -my %hash; -%hash{@keys} = @vals; +%( @keys Z=> @values ) diff --git a/Task/Hash-from-two-arrays/Perl-6/hash-from-two-arrays-4.pl6 b/Task/Hash-from-two-arrays/Perl-6/hash-from-two-arrays-4.pl6 index d6aa0241b9..1cf4f9990c 100644 --- a/Task/Hash-from-two-arrays/Perl-6/hash-from-two-arrays-4.pl6 +++ b/Task/Hash-from-two-arrays/Perl-6/hash-from-two-arrays-4.pl6 @@ -1 +1 @@ -%( Z=> ^5 ) +{ @keys »=>« @values } # Will fail if the lists differ in length diff --git a/Task/Hash-from-two-arrays/REXX/hash-from-two-arrays.rexx b/Task/Hash-from-two-arrays/REXX/hash-from-two-arrays.rexx index 4b8318759e..2de44fc702 100644 --- a/Task/Hash-from-two-arrays/REXX/hash-from-two-arrays.rexx +++ b/Task/Hash-from-two-arrays/REXX/hash-from-two-arrays.rexx @@ -4,7 +4,7 @@ values='triangle quadrilateral pentagon hexagon heptagon octagon nonagon decagon keys ='thuhree vour phive sicks zeaven ate nein den duzun' /* [↑] superfluous blanks added to humorous */ /* keys just because it looks prettier. */ -call hash values,keys /*nothing, then let's leave Dodge*/ /*hash the keys to the values. */ +call hash values,keys /*hash the keys to the values. */ parse arg query . /*get what was specified on C.L. */ if query=='' then exit /*Nothing? Then leave Dodge City*/ pad=left('',30) /*used for padding the display. */ diff --git a/Task/Hash-join/00DESCRIPTION b/Task/Hash-join/00DESCRIPTION index b1e370dc0b..3875e7d664 100644 --- a/Task/Hash-join/00DESCRIPTION +++ b/Task/Hash-join/00DESCRIPTION @@ -1,38 +1,118 @@ -The classic [[wp:Hash Join|hash join]] algorithm for an inner join of two relations has the following steps: -
      -
    • Hash phase: Create a hash table for one of the two relations by applying a hash - function to the join attribute of each row. Ideally we should create a hash table for the - smaller relation, thus optimizing for creation time and memory size of the hash table.
    • -
    • Join phase: Scan the larger relation and find the relevant rows by looking in the - hash table created before.
    • -
    +An [[wp:Join_(SQL)#Inner_join|inner join]] is an operation that combines two data tables into one table, based on matching column values. The simplest way of implementing this operation is the [[wp:Nested loop join|nested loop join]] algorithm, but a more scalable alternative is the [[wp:hash join|hash join]] algorithm. -The algorithm is as follows: +{{task heading}} - '''for each''' tuple ''s'' '''in''' ''S'' '''do''' - '''let''' ''h'' = hash on join attributes ''s''(b) - '''place''' ''s'' '''in''' hash table ''Sh'' '''in''' bucket '''keyed by''' hash value ''h'' - '''for each''' tuple ''r'' '''in''' ''R'' '''do''' - '''let''' ''h'' = hash on join attributes ''r''(a) - '''if''' ''h'' indicates a nonempty bucket (''B'') of hash table ''Sh'' - '''if''' ''h'' matches any ''s'' in ''B'' - '''concatenate''' ''r'' and ''s'' - '''place''' relation in ''Q'' +Implement the "hash join" algorithm, and demonstrate that it passes the test-case listed below. -'''Task:''' implement the Hash Join algorithm and show the result of joining two tables with it. -You should use your implementation to show the joining of these tables: -
    ";j;"
    - - - - - - -
    AgeName
    27Jonah
    18Alan
    28Glory
    18Popeye
    28Alan
    - - - - - - -
    NameNemesis
    JonahWhales
    JonahSpiders
    AlanGhosts
    AlanZombies
    GloryBuffy
    +You should represent the tables as data structures that feel natural in your programming language. + +{{task heading|Guidance}} + +The "hash join" algorithm consists of two steps: + +# '''Hash phase:''' Create a [[wp:Multimap|multimap]] from one of the two tables, mapping from each join column value to all the rows that contain it.
    +#* The multimap must support hash-based lookup which scales better than a simple linear search, because that's the whole point of this algorithm. +#* Ideally we should create the multimap for the ''smaller'' table, thus minimizing its creation time and memory size. +# '''Join phase:''' Scan the other table, and find matching rows by looking in the multimap created before. + +
    +In pseudo-code, the algorithm could be expressed as follows: + + '''let''' ''A'' = the first input table (or ideally, the larger one) + '''let''' ''B'' = the second input table (or ideally, the smaller one) + '''let''' ''jA'' = the join column ID of table ''A'' + '''let''' ''jB'' = the join column ID of table ''B'' + '''let''' ''MB'' = a multimap for mapping from single values to multiple rows of table ''B'' (starts out empty) + '''let''' ''C'' = the output table (starts out empty) + + '''for each''' row ''b'' '''in''' table ''B''''':''' + '''place''' ''b'' '''in''' multimap ''MB'' under key ''b''(''jB'') + + '''for each''' row ''a'' '''in''' table ''A''''':''' + '''for each''' row ''b'' '''in''' multimap ''MB'' under key ''a''(''jA'')''':''' + '''let''' ''c'' = the concatenation of row ''a'' and row ''b'' + '''place''' row ''c'' in table ''C'' + +{{task heading|Test-case}} + +{| class="wikitable" +|- +! Input +! Output +|- +| + +{| style="border:none; border-collapse:collapse;" +|- +| style="border:none" | ''A'' = +| style="border:none" | + +{| class="wikitable" +|- +! Age !! Name +|- +| 27 || Jonah +|- +| 18 || Alan +|- +| 28 || Glory +|- +| 18 || Popeye +|- +| 28 || Alan +|} + +| style="border:none; padding-left:1.5em;" rowspan="2" | +| style="border:none" | ''B'' = +| style="border:none" | + +{| class="wikitable" +|- +! Character !! Nemesis +|- +| Jonah || Whales +|- +| Jonah || Spiders +|- +| Alan || Ghosts +|- +| Alan || Zombies +|- +| Glory || Buffy +|} + +|- +| style="border:none" | ''jA'' = +| style="border:none" | Name (i.e. column 1) + +| style="border:none" | ''jB'' = +| style="border:none" | Character (i.e. column 0) +|} + +| + +{| class="wikitable" style="margin-left:1em" +|- +! A.Age !! A.Name !! B.Character !! B.Nemesis +|- +| 27 || Jonah || Jonah || Whales +|- +| 27 || Jonah || Jonah || Spiders +|- +| 18 || Alan || Alan || Ghosts +|- +| 18 || Alan || Alan || Zombies +|- +| 28 || Glory || Glory || Buffy +|- +| 28 || Alan || Alan || Ghosts +|- +| 28 || Alan || Alan || Zombies +|} + +|} + +The order of the rows in the output table is not significant.
    +If you're using numerically indexed arrays to represent table rows (rather than referring to columns by name), you could represent the output rows in the form [[27, "Jonah"], ["Jonah", "Whales"]]. + +

    diff --git a/Task/Hash-join/AppleScript/hash-join.applescript b/Task/Hash-join/AppleScript/hash-join.applescript new file mode 100644 index 0000000000..0cde4e04df --- /dev/null +++ b/Task/Hash-join/AppleScript/hash-join.applescript @@ -0,0 +1,129 @@ +use framework "Foundation" -- Yosemite onwards, for record-handling functions + +-- hashJoin :: [Record] -> [Record] -> String -> [Record] +on hashJoin(tblA, tblB, strJoin) + set {jA, jB} to splitOn("=", strJoin) + + script instanceOfjB + on lambda(a, x) + set strID to keyValue(x, jB) + + set maybeInstances to keyValue(a, strID) + if maybeInstances is not missing value then + updatedRecord(a, strID, maybeInstances & {x}) + else + updatedRecord(a, strID, [x]) + end if + end lambda + end script + + set M to foldl(instanceOfjB, {name:"multiMap"}, tblB) + + script joins + on lambda(a, x) + set matches to keyValue(M, keyValue(x, jA)) + if matches is not missing value then + script concat + on lambda(row) + x & row + end lambda + end script + + a & map(concat, matches) + else + a + end if + end lambda + end script + + foldl(joins, {}, tblA) +end hashJoin + +-- TEST +on run + set lstA to [¬ + {age:27, |name|:"Jonah"}, ¬ + {age:18, |name|:"Alan"}, ¬ + {age:28, |name|:"Glory"}, ¬ + {age:18, |name|:"Popeye"}, ¬ + {age:28, |name|:"Alan"}] + + set lstB to [¬ + {|character|:"Jonah", nemesis:"Whales"}, ¬ + {|character|:"Jonah", nemesis:"Spiders"}, ¬ + {|character|:"Alan", nemesis:"Ghosts"}, ¬ + {|character|:"Alan", nemesis:"Zombies"}, ¬ + {|character|:"Glory", nemesis:"Buffy"}, ¬ + {|character|:"Bob", nemesis:"foo"}] + + hashJoin(lstA, lstB, "name=character") +end run + + +-- RECORD PRIMITIVES + +-- keyValue :: String -> Record -> Maybe a +on keyValue(rec, strKey) + set ca to current application + set v to (ca's NSDictionary's dictionaryWithDictionary:rec)'s objectForKey:strKey + if v is not missing value then + item 1 of ((ca's NSArray's arrayWithObject:v) as list) + else + missing value + end if +end keyValue + +-- updatedRecord :: Record -> String -> a -> Record +on updatedRecord(rec, strKey, varValue) + set ca to current application + set nsDct to (ca's NSMutableDictionary's dictionaryWithDictionary:rec) + nsDct's setValue:varValue forKey:strKey + item 1 of ((ca's NSArray's arrayWithObject:nsDct) as list) +end updatedRecord + + +-- GENERIC PRIMITIVES + +-- 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 + +-- 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 + +-- splitOn :: Text -> Text -> [Text] +on splitOn(strDelim, strMain) + set {dlm, my text item delimiters} to {my text item delimiters, strDelim} + set lstParts to text items of strMain + set my text item delimiters to dlm + return lstParts +end splitOn + +-- 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 diff --git a/Task/Hash-join/Forth/hash-join.fth b/Task/Hash-join/Forth/hash-join.fth new file mode 100644 index 0000000000..d8fb24b2b3 --- /dev/null +++ b/Task/Hash-join/Forth/hash-join.fth @@ -0,0 +1,84 @@ +include FMS-SI.f +include FMS-SILib.f + +\ Since the same join attribute, Name, occurs more than once +\ in both tables for this problem we need a hash table that +\ will accept and retrieve multiple identical keys if we want +\ an efficient solution for large tables. We make use +\ of the hash collision handling feature of class hash-table. + +\ Subclass hash-table-m allows multiple entries with the same key. +\ After a get: hit one can inspect for additional entries with +\ the same key by using next: until false is returned. + +:class hash-table-m string+ dup >r !: r> ; + +hash-table-m R 1 r init +s" Whales " obj s" Jonah" r insert: +s" Spiders " obj s" Jonah" r insert: +s" Ghosts " obj s" Alan" r insert: +s" Buffy " obj s" Glory" r insert: +s" Zombies " obj s" Alan" r insert: +s" Vampires " obj s" Jonah" r insert: +\ end hash phase + +\ create Age Name table S +o{ o{ 27 'Jonah' } + o{ 18 'Alan' } + o{ 28 'Glory' } + o{ 18 'Popeye' } + o{ 28 'Alan' } } value s + +\ Q is a place to store the relation +object-list2 Q + +\ join phase +: join \ { obj | list -- } + 0 locals| list obj | + 1 obj at: @: r get: \ hash the join-attribute and search table r + if \ we have a match, so concatenate and save in q + heap> object-list2 to list list q add: \ start a new sub-list in q + 0 obj at: copy: list add: \ place age from list s in q + 1 obj at: copy: list add: \ place join-attribute (name) from list s in q + ( str-obj ) copy: list add: \ place first nemesis in q + begin + r next: \ check for more nemeses + while + ( str-obj ) copy: list add: \ place next nemesis in q + repeat + then ; + +: probe + begin + s each: \ for each tuple object in s + while + ( obj ) join \ pass the object to function join + repeat ; + +probe \ execute the probe function + +q p: \ print the saved relation + +\ free allocated memory +s modifySTRef' l ((map (x,) v) ++) readSTRef l -test = mapM_ print $ hashJoin +main = mapM_ print $ hashJoin [(1, "Jonah"), (2, "Alan"), (3, "Glory"), (4, "Popeye")] snd [("Jonah", "Whales"), ("Jonah", "Spiders"), diff --git a/Task/Hash-join/Haskell/hash-join-2.hs b/Task/Hash-join/Haskell/hash-join-2.hs index 26d6f96b76..bff390b11c 100644 --- a/Task/Hash-join/Haskell/hash-join-2.hs +++ b/Task/Hash-join/Haskell/hash-join-2.hs @@ -7,10 +7,10 @@ import Control.Applicative mapJoin xs fx ys fy = joined where yMap = foldl' f M.empty ys f m y = M.insertWith (++) (fy y) [y] m - joined = concat . catMaybes . - map (\x -> map (x,) <$> M.lookup (fx x) yMap) $ xs + joined = concat . + mapMaybe (\x -> map (x,) <$> M.lookup (fx x) yMap) $ xs -test = mapM_ print $ mapJoin +main = mapM_ print $ mapJoin [(1, "Jonah"), (2, "Alan"), (3, "Glory"), (4, "Popeye")] snd [("Jonah", "Whales"), ("Jonah", "Spiders"), diff --git a/Task/Hash-join/Java/hash-join.java b/Task/Hash-join/Java/hash-join.java new file mode 100644 index 0000000000..f8875d1633 --- /dev/null +++ b/Task/Hash-join/Java/hash-join.java @@ -0,0 +1,40 @@ +import java.util.*; + +public class HashJoin { + + public static void main(String[] args) { + String[][] table1 = {{"27", "Jonah"}, {"18", "Alan"}, {"28", "Glory"}, + {"18", "Popeye"}, {"28", "Alan"}}; + + String[][] table2 = {{"Jonah", "Whales"}, {"Jonah", "Spiders"}, + {"Alan", "Ghosts"}, {"Alan", "Zombies"}, {"Glory", "Buffy"}, + {"Bob", "foo"}}; + + hashJoin(table1, 1, table2, 0).stream() + .forEach(r -> System.out.println(Arrays.deepToString(r))); + } + + static List hashJoin(String[][] records1, int idx1, + String[][] records2, int idx2) { + + List result = new ArrayList<>(); + Map> map = new HashMap<>(); + + for (String[] record : records1) { + List v = map.getOrDefault(record[idx1], new ArrayList<>()); + v.add(record); + map.put(record[idx1], v); + } + + for (String[] record : records2) { + List lst = map.get(record[idx2]); + if (lst != null) { + lst.stream().forEach(r -> { + result.add(new String[][]{r, record}); + }); + } + } + + return result; + } +} diff --git a/Task/Hash-join/JavaScript/hash-join.js b/Task/Hash-join/JavaScript/hash-join.js new file mode 100644 index 0000000000..49c1da66e0 --- /dev/null +++ b/Task/Hash-join/JavaScript/hash-join.js @@ -0,0 +1,55 @@ +(() => { + 'use strict'; + + // hashJoin :: [Dict] -> [Dict] -> String -> [Dict] + let hashJoin = (tblA, tblB, strJoin) => { + + let [jA, jB] = strJoin.split('='), + M = tblB.reduce((a, x) => { + let id = x[jB]; + return ( + a[id] ? a[id].push(x) : a[id] = [x], + a + ); + }, {}); + + return tblA.reduce((a, x) => { + let match = M[x[jA]]; + return match ? ( + a.concat(match.map(row => dictConcat(x, row))) + ) : a; + }, []); + }, + + // dictConcat :: Dict -> Dict -> Dict + dictConcat = (dctA, dctB) => { + let ok = Object.keys; + return ok(dctB).reduce( + (a, k) => (a['B_' + k] = dctB[k]) && a, + ok(dctA).reduce( + (a, k) => (a['A_' + k] = dctA[k]) && a, {} + ) + ); + }; + + + // TEST + let lstA = [ + { age: 27, name: 'Jonah' }, + { age: 18, name: 'Alan' }, + { age: 28, name: 'Glory' }, + { age: 18, name: 'Popeye' }, + { age: 28, name: 'Alan' } + ], + lstB = [ + { character: 'Jonah', nemesis: 'Whales' }, + { character: 'Jonah', nemesis: 'Spiders' }, + { character: 'Alan', nemesis: 'Ghosts' }, + { character:'Alan', nemesis: 'Zombies' }, + { character: 'Glory', nemesis: 'Buffy' }, + { character: 'Bob', nemesis: 'foo' } + ]; + + return hashJoin(lstA, lstB, 'name=character'); + +})(); diff --git a/Task/Hash-join/Perl-6/hash-join-1.pl6 b/Task/Hash-join/Perl-6/hash-join-1.pl6 new file mode 100644 index 0000000000..9d6ccf8933 --- /dev/null +++ b/Task/Hash-join/Perl-6/hash-join-1.pl6 @@ -0,0 +1,7 @@ +sub hash-join(@a, &a, @b, &b) { + my %hash := @b.classify(&b); + + @a.map: -> $a { + |(%hash{a $a} // next).map: -> $b { [$a, $b] } + } +} diff --git a/Task/Hash-join/Perl-6/hash-join-2.pl6 b/Task/Hash-join/Perl-6/hash-join-2.pl6 new file mode 100644 index 0000000000..72171cb678 --- /dev/null +++ b/Task/Hash-join/Perl-6/hash-join-2.pl6 @@ -0,0 +1,17 @@ +my @A = + [27, "Jonah"], + [18, "Alan"], + [28, "Glory"], + [18, "Popeye"], + [28, "Alan"], +; + +my @B = + ["Jonah", "Whales"], + ["Jonah", "Spiders"], + ["Alan", "Ghosts"], + ["Alan", "Zombies"], + ["Glory", "Buffy"], +; + +.say for hash-join @A, *[1], @B, *[0]; diff --git a/Task/Hash-join/Perl-6/hash-join.pl6 b/Task/Hash-join/Perl-6/hash-join.pl6 deleted file mode 100644 index 8320528b31..0000000000 --- a/Task/Hash-join/Perl-6/hash-join.pl6 +++ /dev/null @@ -1,18 +0,0 @@ -my @A = [1, "Jonah"], - [2, "Alan"], - [3, "Glory"], - [4, "Popeye"]; - -my @B = ["Jonah", "Whales"], - ["Jonah", "Spiders"], - ["Alan", "Ghosts"], - ["Alan", "Zombies"], - ["Glory", "Buffy"]; - -sub hash-join(@a, &a, @b, &b) { - my %hash{Any}; - %hash{.&a} = $_ for @a; - ([%hash{.&b} // next, $_] for @b); -} - -.perl.say for hash-join @A, *.[1], @B, *.[0]; diff --git a/Task/Hash-join/PicoLisp/hash-join.l b/Task/Hash-join/PicoLisp/hash-join.l new file mode 100644 index 0000000000..783c21c00e --- /dev/null +++ b/Task/Hash-join/PicoLisp/hash-join.l @@ -0,0 +1,24 @@ +(de A + (27 . Jonah) + (18 . Alan) + (28 . Glory) + (18 . Popeye) + (28 . Alan) ) + +(de B + (Jonah . Whales) + (Jonah . Spiders) + (Alan . Ghosts) + (Alan . Zombies) + (Glory . Buffy) ) + +(for X B + (let K (cons (char (hash (car X))) (car X)) + (if (idx 'M K T) + (push (caar @) (cdr X)) + (set (car K) (list (cdr X))) ) ) ) + +(for X A + (let? Y (car (idx 'M (cons (char (hash (cdr X))) (cdr X)))) + (for Z (caar Y) + (println (car X) (cdr X) (cdr Y) Z) ) ) ) diff --git a/Task/Hash-join/REXX/hash-join.rexx b/Task/Hash-join/REXX/hash-join.rexx index 6b4f907512..8a6d64401f 100644 --- a/Task/Hash-join/REXX/hash-join.rexx +++ b/Task/Hash-join/REXX/hash-join.rexx @@ -1,32 +1,31 @@ -/*REXX program demonstrates the classic hash join algorithm for two relations.*/ - S. = ; R. = - S.1 = 27 'Jonah' ; R.1 = 'Jonah Whales' - S.2 = 18 'Alan' ; R.2 = 'Jonah Spiders' - S.3 = 28 'Glory' ; R.3 = 'Alan Ghosts' - S.4 = 18 'Popeye' ; R.4 = 'Alan Zombies' - S.5 = 28 'Alan' ; R.5 = 'Glory Buffy' -hash.= /*initialize the hash table (array). */ - do #=1 while S.#\==''; parse var S.# age name /*extract information*/ - hash.name=hash.name # /*build a hash table entry with its idx*/ - end /*#*/ /* [↑] REXX does the heavy work here. */ -#=#-1 /*adjust for the DO loop (#) overage.*/ - do j=1 while R.j\=='' /*process a nemesis for a name element.*/ - parse var R.j x nemesis /*extract the name and its nemesis. */ - if hash.x=='' then do; #=#+1 /*Not in hash? Then a new name; bump #*/ - S.#=',' x /*add a new name to the S table. */ - hash.x=# /* " " " " " " hash " */ - end /* [↑] this DO isn't used today. */ - do k=1 for words(hash.x); _=word(hash.x,k) /*get the pointer.*/ - S._=S._ nemesis /*add the nemesis ──► applicable hash. */ - end /*k*/ - end /*j*/ -_='─' /*the character used for the separator.*/ -pad=left('',6-2) /*spacing used in header and the output*/ -say pad center('age',3) pad center('name',20 } pad center('nemesis',30 ) -say pad center('───',3) pad center('' ,20,_) pad center('' ,30,_) +/*REXX program demonstrates the classic hash join algorithm for two relations. */ + S. = ; R. = + S.1 = 27 'Jonah' ; R.1 = "Jonah Whales" + S.2 = 18 'Alan' ; R.2 = "Jonah Spiders" + S.3 = 28 'Glory' ; R.3 = "Alan Ghosts" + S.4 = 18 'Popeye' ; R.4 = "Alan Zombies" + S.5 = 28 'Alan' ; R.5 = "Glory Buffy" +hash.= /*initialize the hash table (array). */ + do #=1 while S.#\==''; parse var S.# age name /*extract information*/ + hash.name=hash.name # /*build a hash table entry with its idx*/ + end /*#*/ /* [↑] REXX does the heavy work here. */ +#=#-1 /*adjust for the DO loop (#) overage.*/ + do j=1 while R.j\=='' /*process a nemesis for a name element.*/ + parse var R.j x nemesis /*extract the name and its nemesis. */ + if hash.x=='' then do; #=# + 1 /*Not in hash? Then a new name; bump #*/ + S.#=',' x /*add a new name to the S table. */ + hash.x=# /* " " " " " " hash " */ + end /* [↑] this DO isn't used today. */ + do k=1 for words(hash.x); _=word(hash.x, k) /*obtain the pointer.*/ + S._=S._ nemesis /*add the nemesis ──► applicable hash. */ + end /*k*/ + end /*j*/ +_='─' /*the character used for the separator.*/ +pad=left('', 4) /*spacing used in header and the output*/ +say pad center('age', 3) pad center("name", 20 ) pad center('nemesis', 30 ) +say pad center('───', 3) pad center("" , 20, _) pad center('' , 30, _) - do n=1 for #; parse var S.n age name nems /*get information.*/ - if nems=='' then iterate /*No nemesis? Skip*/ - say pad right(age,3) pad center(name,20) pad nems /*display an S. */ - end /*n*/ - /*stick a fork in it, we're all done. */ + do n=1 for #; parse var S.n age name nems /*obtain information.*/ + if nems=='' then iterate /*No nemesis? Skip. */ + say pad right(age,3) pad center(name,20) pad center(nems,30) /*display an "S". */ + end /*n*/ /*stick a fork in it, we're all done. */ diff --git a/Task/Hash-join/Run-BASIC/hash-join.run b/Task/Hash-join/Run-BASIC/hash-join.run new file mode 100644 index 0000000000..35b0c92a05 --- /dev/null +++ b/Task/Hash-join/Run-BASIC/hash-join.run @@ -0,0 +1,25 @@ +sqliteconnect #mem, ":memory:" + +#mem execute("CREATE TABLE t_age(age,name)") +#mem execute("CREATE TABLE t_name(name,nemesis)") + +#mem execute("INSERT INTO t_age VALUES(27,'Jonah')") +#mem execute("INSERT INTO t_age VALUES(18,'Alan')") +#mem execute("INSERT INTO t_age VALUES(28,'Glory')") +#mem execute("INSERT INTO t_age VALUES(18,'Popeye')") +#mem execute("INSERT INTO t_age VALUES(28,'Alan')") + +#mem execute("INSERT INTO t_name VALUES('Jonah','Whales')") +#mem execute("INSERT INTO t_name VALUES('Jonah','Spiders')") +#mem execute("INSERT INTO t_name VALUES('Alan','Ghosts')") +#mem execute("INSERT INTO t_name VALUES('Alan','Zombies')") +#mem execute("INSERT INTO t_name VALUES('Glory','Buffy')") + +#mem execute("SELECT *,t_age.name FROM t_age LEFT JOIN t_name ON t_name.name = t_age.name") +WHILE #mem hasanswer() + #row = #mem #nextrow() + age = #row age() + name$ = #row name$() + nemesis$ = #row nemesis$() +print age;" ";name$;" ";nemesis$ +WEND diff --git a/Task/Haversine-formula/00DESCRIPTION b/Task/Haversine-formula/00DESCRIPTION index 2b280115aa..ca6d1c120c 100644 --- a/Task/Haversine-formula/00DESCRIPTION +++ b/Task/Haversine-formula/00DESCRIPTION @@ -1,13 +1,19 @@ -{{Wikipedia}}The '''haversine formula''' is an equation important in navigation, -giving great-circle distances between two points on a sphere -from their longitudes and latitudes. -It is a special case of a more general formula in spherical trigonometry, -the '''law of haversines''', relating the sides and angles of spherical "triangles". +{{Wikipedia}} -'''Task:''' Implement a great-circle distance function, or use a library function, -to show the great-circle distance between Nashville International Airport (BNA) -in Nashville, TN, USA: N 36°7.2', W 86°40.2' (36.12, -86.67) -and Los Angeles International Airport (LAX) in Los Angeles, CA, USA: N 33°56.4', W 118°24.0' (33.94, -118.40). +
    +The '''haversine formula''' is an equation important in navigation, giving great-circle distances between two points on a sphere from their longitudes and latitudes. + +It is a special case of a more general formula in spherical trigonometry, the '''law of haversines''', relating the sides and angles of spherical "triangles". + + +;Task: +Implement a great-circle distance function, or use a library function, +to show the great-circle distance between: +* Nashville International Airport (BNA)   in Nashville, TN, USA,   which is: + '''N''' 36°7.2', '''W''' 86°40.2' (36.12, -86.67) -and- +* Los Angeles International Airport (LAX)  in Los Angeles, CA, USA,   which is: + '''N''' 33°56.4', '''W''' 118°24.0' (33.94, -118.40) +
     User Kaimbridge clarified on the Talk page:
    @@ -40,3 +46,4 @@ examples in real applications, it is better to use the
     6371 km.  This value is recommended by the International Union of
     Geodesy and Geophysics and it minimizes the RMS relative error between the
     great circle and geodesic distance.
    +

    diff --git a/Task/Haversine-formula/ABAP/haversine-formula.abap b/Task/Haversine-formula/ABAP/haversine-formula.abap index 36f39df8a0..3bf05e4be9 100644 --- a/Task/Haversine-formula/ABAP/haversine-formula.abap +++ b/Task/Haversine-formula/ABAP/haversine-formula.abap @@ -1,9 +1,22 @@ -DATA : lat1 TYPE char20 VALUE '36.12' , - lon1 TYPE char20 VALUE '-86.67' , - lat2 TYPE char20 VALUE '33.94' , - lon2 TYPE char20 VALUE '-118.4' , - distance TYPE p DECIMALS 1 . -CONSTANTS : pi TYPE char20 VALUE '3.141592654', - earth_radius TYPE char20 VALUE '6372.8' ."in km -distance = earth_radius * acos( cos( ( 90 - lat1 ) * ( pi / 180 ) ) * cos( ( 90 - lat2 ) * ( pi / 180 ) ) + sin( ( 90 - lat1 ) * ( pi / 180 ) ) * sin( ( 90 - lat2 ) * ( pi / 180 ) ) * cos( ( lon1 - lon2 ) * ( pi / 180 ) ) ) . + DATA: X1 TYPE F, Y1 TYPE F, + X2 TYPE F, Y2 TYPE F, YD TYPE F, + PI TYPE F, + PI_180 TYPE F, + MINUS_1 TYPE F VALUE '-1'. + +PI = ACOS( MINUS_1 ). +PI_180 = PI / 180. + +LATITUDE1 = 36,12 . LONGITUDE1 = -86,67 . +LATITUDE2 = 33,94 . LONGITUDE2 = -118,4 . + + X1 = LATITUDE1 * PI_180. + Y1 = LONGITUDE1 * PI_180. + X2 = LATITUDE2 * PI_180. + Y2 = LONGITUDE2 * PI_180. + YD = Y2 - Y1. + + DISTANCE = 20000 / PI * + ACOS( SIN( X1 ) * SIN( X2 ) + COS( X1 ) * COS( X2 ) * COS( YD ) ). + WRITE : 'Distance between given points = ' , distance , 'km .' . diff --git a/Task/Haversine-formula/AMPL/haversine-formula.ampl b/Task/Haversine-formula/AMPL/haversine-formula.ampl new file mode 100644 index 0000000000..ae926adc63 --- /dev/null +++ b/Task/Haversine-formula/AMPL/haversine-formula.ampl @@ -0,0 +1,21 @@ +set location; +set geo; + +param coord{i in location, j in geo}; +param dist{i in location, j in location}; + +data; + +set location := BNA LAX; +set geo := LAT LON; + +param coord: + LAT LON := + BNA 36.12 -86.67 + LAX 33.94 -118.4 +; + +let dist['BNA','LAX'] := 2 * 6372.8 * asin (sqrt(sin(atan(1)/45*(coord['LAX','LAT']-coord['BNA','LAT'])/2)^2 + cos(atan(1)/45*coord['BNA','LAT']) * cos(atan(1)/45*coord['LAX','LAT']) * sin(atan(1)/45*(coord['LAX','LON'] - coord +['BNA','LON'])/2)^2)); + +printf "The distance between the two points is approximately %f km.\n", dist['BNA','LAX']; diff --git a/Task/Haversine-formula/APL/haversine-formula.apl b/Task/Haversine-formula/APL/haversine-formula.apl new file mode 100644 index 0000000000..abff0ae171 --- /dev/null +++ b/Task/Haversine-formula/APL/haversine-formula.apl @@ -0,0 +1,3 @@ +r←6371 +hf←{(p q)←○⍺ ⍵÷180 ⋄ 2×rׯ1○(+/(2*⍨1○(p-q)÷2)×1(×/2○⊃¨p q))*÷2} +36.12 ¯86.67 hf 33.94 ¯118.40 diff --git a/Task/Haversine-formula/JavaScript/haversine-formula.js b/Task/Haversine-formula/JavaScript/haversine-formula-1.js similarity index 100% rename from Task/Haversine-formula/JavaScript/haversine-formula.js rename to Task/Haversine-formula/JavaScript/haversine-formula-1.js diff --git a/Task/Haversine-formula/JavaScript/haversine-formula-2.js b/Task/Haversine-formula/JavaScript/haversine-formula-2.js new file mode 100644 index 0000000000..6722b76ec3 --- /dev/null +++ b/Task/Haversine-formula/JavaScript/haversine-formula-2.js @@ -0,0 +1,36 @@ +((x, y) => { + 'use strict'; + + // haversine :: (Num, Num) -> (Num, Num) -> Num + let haversine = ([lat1, lon1], [lat2, lon2]) => { + // Math lib function names + let [pi, asin, sin, cos, sqrt, pow, round] = + ['PI', 'asin', 'sin', 'cos', 'sqrt', 'pow', 'round'] + .map(k => Math[k]), + + // degrees as radians + [rlat1, rlat2, rlon1, rlon2] = [lat1, lat2, lon1, lon2] + .map(x => x / 180 * pi), + + dLat = rlat2 - rlat1, + dLon = rlon2 - rlon1, + radius = 6372.8; // km + + // km + return round( + radius * 2 * asin( + sqrt( + pow(sin(dLat / 2), 2) + + pow(sin(dLon / 2), 2) * + cos(rlat1) * cos(rlat2) + ) + ) * 100 + ) / 100; + }; + + // TEST + return haversine(x, y); + + // --> 2887.26 + +})([36.12, -86.67], [33.94, -118.40]); diff --git a/Task/Haversine-formula/PowerShell/haversine-formula-1.psh b/Task/Haversine-formula/PowerShell/haversine-formula-1.psh new file mode 100644 index 0000000000..cf949c8823 --- /dev/null +++ b/Task/Haversine-formula/PowerShell/haversine-formula-1.psh @@ -0,0 +1,6 @@ +Add-Type -AssemblyName System.Device + +$BNA = New-Object System.Device.Location.GeoCoordinate 36.12, -86.67 +$LAX = New-Object System.Device.Location.GeoCoordinate 33.94, -118.40 + +$BNA.GetDistanceTo( $LAX ) / 1000 diff --git a/Task/Haversine-formula/PowerShell/haversine-formula-2.psh b/Task/Haversine-formula/PowerShell/haversine-formula-2.psh new file mode 100644 index 0000000000..63e016605b --- /dev/null +++ b/Task/Haversine-formula/PowerShell/haversine-formula-2.psh @@ -0,0 +1,28 @@ +function Get-GreatCircleDistance ( $Coord1, $Coord2 ) + { + # Convert decimal degrees to radians + $Lat1 = $Coord1[0] / 180 * [math]::Pi + $Long1 = $Coord1[1] / 180 * [math]::Pi + $Lat2 = $Coord2[0] / 180 * [math]::Pi + $Long2 = $Coord2[1] / 180 * [math]::Pi + + # Mean Earth radius (km) + $R = 6371 + + # Haversine formula + $ArcLength = 2 * $R * + [math]::Asin( + [math]::Sqrt( + [math]::Sin( ( $Lat1 - $Lat2 ) / 2 ) * + [math]::Sin( ( $Lat1 - $Lat2 ) / 2 ) + + [math]::Cos( $Lat1 ) * + [math]::Cos( $Lat2 ) * + [math]::Sin( ( $Long1 - $Long2 ) / 2 ) * + [math]::Sin( ( $Long1 - $Long2 ) / 2 ) ) ) + return $ArcLength + } + +$BNA = 36.12, -86.67 +$LAX = 33.94, -118.40 + +Get-GreatCircleDistance $BNA $LAX diff --git a/Task/Haversine-formula/REXX/haversine-formula.rexx b/Task/Haversine-formula/REXX/haversine-formula.rexx index 3d5a0aa024..90b05203b7 100644 --- a/Task/Haversine-formula/REXX/haversine-formula.rexx +++ b/Task/Haversine-formula/REXX/haversine-formula.rexx @@ -1,59 +1,53 @@ -/*REXX program calculates distance between Nashville and Los Angles airports.*/ -call pi; numeric digits length(pi)%2 /*use ½ of the decimal digs that PI has*/ +/*REXX program calculates the distance between Nashville and Los Angles airports.*/ +call pi; numeric digits length(pi)%2 /*use half of decimal digits of PI. */ say " Nashville: north 36º 7.2', west 86º 40.2' = 36.12º, -86.67º" say " Los Angles: north 33º 56.4', west 118º 24.0' = 33.94º, -118.40º" -@using_radius='using the mean radius of the earth as ' /*literal for SAY.*/ -radii.=.; radii.1=6372.8; radii.2=6371 /*mean radii of the earth in kilometers*/ -say; m=1/0.621371192237 /*M: length of one mile in kilometers.*/ - do radius=1 while radii.radius\==. /*calc. distance using specific radius.*/ - d=surfaceDistance( 36.12, -86.67, 33.94, -118.4, radii.radius) - say - say center(@using_radius radii.radius ' kilometers', 75, '─') - say ' Distance between: ' format(d/1 ,,2) " kilometers," - say ' or ' format(d/m ,,2) " statute miles," - say ' or ' format(d/m*5280/6076.1,,2) " nautical (or air miles)." - end /*radius*/ /*only display └───◄ 2 digits of dist.*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -surfaceDistance: arg th1,ph1,th2,ph2,r /*use haversine formula for distance.*/ -numeric digits digits()*2 /*double the number of decimal digits. */ - ph1 = d2r(ph1-ph2) /*convert degrees ──► radians & reduce.*/ - th1 = d2r(th1); th2 = d2r(th2) /* " " " " " " */ - x = cos(ph1) * cos(th1) - cos(th2) - y = sin(ph1) * cos(th1) - z = sin(th1) - sin(th2) -return Asin( sqrt( x**2 + y**2 + z**2) / 2 ) * r * 2 -/*═════════════════════════════general subroutines════════════════════════════*/ -d2d: return arg(1) // 360 /*normalize degrees to a unit circle. */ -d2r: return r2r(arg(1)*pi() / 180) /*normalize and convert deg ──► radians*/ -r2d: return d2d((arg(1)*180 / pi())) /*normalize and convert rad ──► degrees*/ -r2r: return arg(1) // (pi()*2) /*normalize radians to a unit circle. */ -p: return word(arg(1),1) /*pick the first of two words (numbers)*/ -pi: pi=3.141592653589793238462643383279502884197169399375105820975; return pi - -Acos: procedure; parse arg x; if x<-1 | x>1 then call $81r -1,1,x,"ACOS" - return .5*pi()-Asin(x) /*$81R says argument X is out of range,*/ - /* ··· and the sub isn't included here.*/ -Asin: procedure; parse arg x 1 z 1 o 1 p; a=abs(x); aa=a*a - if a>1 then call $81r -1,1,x,"ASIN" /*X argument is out of range.*/ - if a>=sqrt(2)*.5 then return sign(x) * Acos(sqrt(1-aa), '-ASIN') - do j=2 by 2 until p=z; p=z; o=o*aa*(j-1)/j; z=z+o/(j+1); end - return z /* [↑] compute until no more noise. */ - +@using_radius= 'using the mean radius of the earth as ' /*a literal for SAY.*/ +radii.=.; radii.1=6372.8; radii.2=6371 /*mean radii of the earth in kilometers*/ +say; m=1/0.621371192237 /*M: one statute mile in " */ + do radius=1 while radii.radius\==. /*calc. distance using specific radius.*/ + d=surfaceDistance( 36.12, -86.67, 33.94, -118.4, radii.radius); say + say center(@using_radius radii.radius ' kilometers', 75, '─') + say ' Distance between: ' format(d/1 ,,2) " kilometers," + say ' or ' format(d/m ,,2) " statute miles," + say ' or ' format(d/m*5280/6076.1,,2) " nautical (or air miles)." + end /*radius*/ /*these └───◄ displays 2 decimal digs.*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +Acos: return .5*pi() - aSin( arg(1) ) +d2d: return arg(1) // 360 /*normalize degrees to a unit circle. */ +d2r: return r2r(arg(1)*pi() / 180) /*normalize and convert deg ──► radians*/ +r2d: return d2d((arg(1)*180 / pi())) /*normalize and convert rad ──► degrees*/ +r2r: return arg(1) // (pi()*2) /*normalize radians to a unit circle. */ +p: return word(arg(1),1) /*pick the first of two words (numbers)*/ +pi: pi=3.141592653589793238462643383279502884197169399375105820975; return pi +/*──────────────────────────────────────────────────────────────────────────────────────*/ +surfaceDistance: parse arg th1,ph1,th2,ph2,r /*use haversine formula for distance.*/ + numeric digits digits() * 2 /*double the number of decimal digits. */ + ph1= d2r(ph1 - ph2) /*convert degrees ──► radians & reduce.*/ + th1= d2r(th1); th2 = d2r(th2) /* " " " " " " */ + x= cos(ph1) * cos(th1) - cos(th2) + y= sin(ph1) * cos(th1) + z= sin(th1) - sin(th2) + return Asin( sqrt( x**2 + y**2 + z**2) / 2 ) * r * 2 +/*──────────────────────────────────────────────────────────────────────────────────────*/ +Asin: procedure; parse arg x 1 z 1 o 1 p; a=abs(x); aa=a*a + if a>=sqrt(2) * .5 then return sign(x) * Acos(sqrt(1-aa)) + do j=2 by 2 until p=z; p=z; o=o*aa*(j-1)/j; z=z+o/(j+1); end /*j*/ + return z /* [↑] compute until no more noise. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ cos: procedure; parse arg x; x=r2r(x); a=abs(x); Hpi=pi*.5 numeric fuzz min(6,digits()-3); if a=pi() then return -1 if a=Hpi | a=Hpi*3 then return 0; if a=pi()/3 then return .5 - if a=pi()*2/3 then return -.5; return .sinCos(1,1,-1) - -sin: procedure; parse arg x; x=r2r(x); numeric fuzz min(5, digits()-3) - if abs(x)=pi() then return 0; return .sinCos(x,x,1) - -.sinCos: parse arg z,_,i; q=x*x; p=z; do k=2 by 2; _=-_*q/(k*(k+i)); z=z+_ - if z=p then leave; p=z; end; return z /*used by SIN & COS*/ - -sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); i=; m.=9 - numeric digits 9; numeric form; h=d+6; if x<0 then do; x=-x; i='i'; end - parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_%2 - do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ - do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ - numeric digits d; return (g/1)i /*make complex if X < 0.*/ + if a=pi()*2/3 then return -.5; return .sinCos(1,1,-1) +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sin: procedure; parse arg x; x=r2r(x); numeric fuzz min(5, digits()-3) + if abs(x)=pi() then return 0; return .sinCos(x,x,1) +/*──────────────────────────────────────────────────────────────────────────────────────*/ +.sinCos: parse arg z 1 p,_,i; q=x*x + do k=2 by 2; _=-_*q/(k*(k+i)); z=z+_; if z=p then leave; p=z; end; return z +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); m.=9; numeric form; h=d+6 + numeric digits; parse value format(x,2,1,,0) 'E0' with g "E" _ .; g=g * .5'e'_ % 2 + do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ + do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ diff --git a/Task/Haversine-formula/Rust/haversine-formula.rust b/Task/Haversine-formula/Rust/haversine-formula.rust new file mode 100644 index 0000000000..fea545d6a3 --- /dev/null +++ b/Task/Haversine-formula/Rust/haversine-formula.rust @@ -0,0 +1,19 @@ +use std::f64; + +static R: f64 = 6372.8; + +fn haversine_dist(mut th1: f64, mut ph1: f64, mut th2: f64, ph2: f64) -> f64 { + ph1 -= ph2; + ph1 = ph1.to_radians(); + th1 = th1.to_radians(); + th2 = th2.to_radians(); + let dz: f64 = th1.sin() - th2.sin(); + let dx: f64 = ph1.cos() * th1.cos() - th2.cos(); + let dy: f64 = ph1.sin() * th1.cos(); + ((dx * dx + dy * dy + dz * dz).sqrt() / 2.0).asin() * 2.0 * R +} + +fn main() { + let d: f64 = haversine_dist(36.12, -86.67, 33.94, -118.4); + println!("Distance: {} km ({} mi)", d, d / 1.609344); +} diff --git a/Task/Haversine-formula/XQuery/haversine-formula.xquery b/Task/Haversine-formula/XQuery/haversine-formula.xquery new file mode 100644 index 0000000000..8ce9c8f994 --- /dev/null +++ b/Task/Haversine-formula/XQuery/haversine-formula.xquery @@ -0,0 +1,16 @@ +declare namespace xsd = "http://www.w3.org/2001/XMLSchema"; +declare namespace math = "http://www.w3.org/2005/xpath-functions/math"; + +declare function local:haversine($lat1 as xsd:float, $lon1 as xsd:float, $lat2 as xsd:float, $lon2 as xsd:float) + as xsd:float +{ + let $dlat := ($lat2 - $lat1) * math:pi() div 180 + let $dlon := ($lon2 - $lon1) * math:pi() div 180 + let $rlat1 := $lat1 * math:pi() div 180 + let $rlat2 := $lat2 * math:pi() div 180 + let $a := math:sin($dlat div 2) * math:sin($dlat div 2) + math:sin($dlon div 2) * math:sin($dlon div 2) * math:cos($rlat1) * math:cos($rlat2) + let $c := 2 * math:atan2(math:sqrt($a), math:sqrt(1-$a)) + return xsd:float($c * 6371.0) +}; + +local:haversine(36.12, -86.67, 33.94, -118.4) diff --git a/Task/Haversine-formula/ZX-Spectrum-Basic/haversine-formula.zx b/Task/Haversine-formula/ZX-Spectrum-Basic/haversine-formula.zx new file mode 100644 index 0000000000..68b95f84c5 --- /dev/null +++ b/Task/Haversine-formula/ZX-Spectrum-Basic/haversine-formula.zx @@ -0,0 +1,11 @@ +10 LET diam=2*6372.8 +20 LET Lg1m2=FN r((-86.67)-(-118.4)) +30 LET Lt1=FN r(36.12) +40 LET Lt2=FN r(33.94) +50 LET dz=SIN (Lt1)-SIN (Lt2) +60 LET dx=COS (Lg1m2)*COS (Lt1)-COS (Lt2) +70 LET dy=SIN (Lg1m2)*COS (Lt1) +80 LET hDist=ASN ((dx*dx+dy*dy+dz*dz)^0.5/2)*diam +90 PRINT "Haversine distance: ";hDist;" km." +100 STOP +1000 DEF FN r(a)=a*0.017453293: REM convert degree to radians diff --git a/Task/Hello-world-Graphical/00DESCRIPTION b/Task/Hello-world-Graphical/00DESCRIPTION index b7bd88b526..71c9928e49 100644 --- a/Task/Hello-world-Graphical/00DESCRIPTION +++ b/Task/Hello-world-Graphical/00DESCRIPTION @@ -1,3 +1,7 @@ -In this User Output task, the goal is to display the string "Goodbye, World!" on a [[GUI]] object (alert box, plain window, text area, etc.). +;Task: +Display the string       '''Goodbye, World!'''       on a [[GUI]] object   (alert box, plain window, text area, etc.). -See also: [[Hello world/Text]] + +;Related task: +*   [[Hello world/Text]] +

    diff --git a/Task/Hello-world-Graphical/BASIC256/hello-world-graphical.basic256 b/Task/Hello-world-Graphical/BASIC256/hello-world-graphical.basic256 index 6cec5e7fcf..4f4cb29187 100644 --- a/Task/Hello-world-Graphical/BASIC256/hello-world-graphical.basic256 +++ b/Task/Hello-world-Graphical/BASIC256/hello-world-graphical.basic256 @@ -3,4 +3,4 @@ font "times new roman", 20,100 color orange rect 10,10, 140,30 color red -text 10,10, "Hello World" +text 10,10, "Goodbye, World!" diff --git a/Task/Hello-world-Graphical/COBOL/hello-world-graphical-3.cobol b/Task/Hello-world-Graphical/COBOL/hello-world-graphical-3.cobol index 2ca2d99859..8d188d6524 100644 --- a/Task/Hello-world-Graphical/COBOL/hello-world-graphical-3.cobol +++ b/Task/Hello-world-Graphical/COBOL/hello-world-graphical-3.cobol @@ -2,5 +2,5 @@ xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation" xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml" Title="Hello world/Graphical"> - Hello, World! + Goodbye, World! diff --git a/Task/Hello-world-Graphical/Common-Lisp/hello-world-graphical-2.lisp b/Task/Hello-world-Graphical/Common-Lisp/hello-world-graphical-2.lisp index c94551c88d..1b8a5afb02 100644 --- a/Task/Hello-world-Graphical/Common-Lisp/hello-world-graphical-2.lisp +++ b/Task/Hello-world-Graphical/Common-Lisp/hello-world-graphical-2.lisp @@ -4,7 +4,7 @@ (clim-stream-pane) ()) (define-application-frame hello-world () - ((greeting :initform "Hello World" + ((greeting :initform "Goodbye World" :accessor greeting)) (:pane (make-pane 'hello-world-pane))) diff --git a/Task/Hello-world-Graphical/Fortran/hello-world-graphical-1.f b/Task/Hello-world-Graphical/Fortran/hello-world-graphical-1.f new file mode 100644 index 0000000000..8a9c1b69a3 --- /dev/null +++ b/Task/Hello-world-Graphical/Fortran/hello-world-graphical-1.f @@ -0,0 +1,5 @@ +program hello + use windows + integer :: res + res = MessageBox(0, LOC("Hello, World"), LOC("Window Title"), MB_OK) +end program diff --git a/Task/Hello-world-Graphical/Fortran/hello-world-graphical-2.f b/Task/Hello-world-Graphical/Fortran/hello-world-graphical-2.f new file mode 100644 index 0000000000..16c5731f83 --- /dev/null +++ b/Task/Hello-world-Graphical/Fortran/hello-world-graphical-2.f @@ -0,0 +1,5 @@ +program hello + use user32 + integer :: res + res = MessageBox(0, "Hello, World", "Window Title", MB_OK) +end program diff --git a/Task/Hello-world-Graphical/Fortran/hello-world-graphical-3.f b/Task/Hello-world-Graphical/Fortran/hello-world-graphical-3.f new file mode 100644 index 0000000000..7cedbcb305 --- /dev/null +++ b/Task/Hello-world-Graphical/Fortran/hello-world-graphical-3.f @@ -0,0 +1,40 @@ +module handlers_m + use iso_c_binding + use gtk + implicit none + + contains + + subroutine destroy (widget, gdata) bind(c) + type(c_ptr), value :: widget, gdata + call gtk_main_quit () + end subroutine destroy + +end module handlers_m + +program test + use iso_c_binding + use gtk + use handlers_m + implicit none + + type(c_ptr) :: window + type(c_ptr) :: box + type(c_ptr) :: button + + call gtk_init () + window = gtk_window_new (GTK_WINDOW_TOPLEVEL) + call gtk_window_set_default_size(window, 500, 20) + call gtk_window_set_title(window, "gtk-fortran"//c_null_char) + call g_signal_connect (window, "destroy"//c_null_char, c_funloc(destroy)) + box = gtk_hbox_new (TRUE, 10_c_int); + call gtk_container_add (window, box) + button = gtk_button_new_with_label ("Goodbye, World!"//c_null_char) + call gtk_box_pack_start (box, button, FALSE, FALSE, 0_c_int) + call g_signal_connect (button, "clicked"//c_null_char, c_funloc(destroy)) + call gtk_widget_show (button) + call gtk_widget_show (box) + call gtk_widget_show (window) + call gtk_main () + +end program test diff --git a/Task/Hello-world-Graphical/Frege/hello-world-graphical.frege b/Task/Hello-world-Graphical/Frege/hello-world-graphical.frege new file mode 100644 index 0000000000..ba92ecf568 --- /dev/null +++ b/Task/Hello-world-Graphical/Frege/hello-world-graphical.frege @@ -0,0 +1,12 @@ +package HelloWorldGraphical where + +import Java.Swing + +main _ = do + frame <- JFrame.new "Goodbye, world!" + frame.setDefaultCloseOperation(JFrame.dispose_on_close) + label <- JLabel.new "Goodbye, world!" + cp <- frame.getContentPane + cp.add label + frame.pack + frame.setVisible true diff --git a/Task/Hello-world-Graphical/HicEst/hello-world-graphical.hicest b/Task/Hello-world-Graphical/HicEst/hello-world-graphical.hicest new file mode 100644 index 0000000000..3888b21856 --- /dev/null +++ b/Task/Hello-world-Graphical/HicEst/hello-world-graphical.hicest @@ -0,0 +1 @@ +WRITE(Messagebox='!') 'Goodbye, World!' diff --git a/Task/Hello-world-Graphical/Java/hello-world-graphical.java b/Task/Hello-world-Graphical/Java/hello-world-graphical-1.java similarity index 100% rename from Task/Hello-world-Graphical/Java/hello-world-graphical.java rename to Task/Hello-world-Graphical/Java/hello-world-graphical-1.java diff --git a/Task/Hello-world-Graphical/Java/hello-world-graphical-2.java b/Task/Hello-world-Graphical/Java/hello-world-graphical-2.java new file mode 100644 index 0000000000..1c71c6a179 --- /dev/null +++ b/Task/Hello-world-Graphical/Java/hello-world-graphical-2.java @@ -0,0 +1,21 @@ +import javax.swing.*; +import java.awt.*; + +public class HelloWorld { + public static void main(String[] args) { + + SwingUtilities.invokeLater(() -> { + JOptionPane.showMessageDialog(null, "Goodbye, world!"); + JFrame frame = new JFrame("Goodbye, world!"); + JTextArea text = new JTextArea("Goodbye, world!"); + JButton button = new JButton("Goodbye, world!"); + + frame.setLayout(new FlowLayout()); + frame.add(button); + frame.add(text); + frame.pack(); + frame.setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE); + frame.setVisible(true); + }); + } +} diff --git a/Task/Hello-world-Graphical/Kotlin/hello-world-graphical.kotlin b/Task/Hello-world-Graphical/Kotlin/hello-world-graphical.kotlin new file mode 100644 index 0000000000..7881a242b5 --- /dev/null +++ b/Task/Hello-world-Graphical/Kotlin/hello-world-graphical.kotlin @@ -0,0 +1,14 @@ +import java.awt.* +import javax.swing.* + +fun main(args: Array) { + JOptionPane.showMessageDialog(null, "Goodbye, World!") // in alert box + with(JFrame("Goodbye, World!")) { // on title bar + layout = FlowLayout() + add(JButton("Goodbye, World!")) // on button + add(JTextArea("Goodbye, World!")) // in editable area + pack() + defaultCloseOperation = JFrame.EXIT_ON_CLOSE + isVisible = true + } +} diff --git a/Task/Hello-world-Graphical/Ruby/hello-world-graphical-4.rb b/Task/Hello-world-Graphical/Ruby/hello-world-graphical-4.rb new file mode 100644 index 0000000000..ca6a7c7afb --- /dev/null +++ b/Task/Hello-world-Graphical/Ruby/hello-world-graphical-4.rb @@ -0,0 +1,16 @@ +require 'gosu' + +class Window < Gosu::Window + + def initialize + super(150, 50, false) + @font = Gosu::Font.new(self, "Arial", 32) + end + + def draw + @font.draw("Hello world", 0, 10, 1, 1, 1) + end + +end + +Window.new.show diff --git a/Task/Hello-world-Graphical/Ruby/hello-world-graphical-5.rb b/Task/Hello-world-Graphical/Ruby/hello-world-graphical-5.rb new file mode 100644 index 0000000000..2abf4765cb --- /dev/null +++ b/Task/Hello-world-Graphical/Ruby/hello-world-graphical-5.rb @@ -0,0 +1,6 @@ +#_Note: this code must not be executed through a GUI +require 'green_shoes' + +Shoes.app do + para "Hello world" +end diff --git a/Task/Hello-world-Graphical/Ruby/hello-world-graphical-6.rb b/Task/Hello-world-Graphical/Ruby/hello-world-graphical-6.rb new file mode 100644 index 0000000000..5d974a7e0f --- /dev/null +++ b/Task/Hello-world-Graphical/Ruby/hello-world-graphical-6.rb @@ -0,0 +1,2 @@ +require 'win32ole' +WIN32OLE.new('WScript.Shell').popup("Hello world") diff --git a/Task/Hello-world-Graphical/Rust/hello-world-graphical.rust b/Task/Hello-world-Graphical/Rust/hello-world-graphical.rust new file mode 100644 index 0000000000..50b34941d9 --- /dev/null +++ b/Task/Hello-world-Graphical/Rust/hello-world-graphical.rust @@ -0,0 +1,22 @@ +// cargo-deps: gtk +extern crate gtk; +use gtk::traits::*; +use gtk::{Window, WindowType, WindowPosition}; +use gtk::signal::Inhibit; + +fn main() { + gtk::init().unwrap(); + let window = Window::new(WindowType::Toplevel).unwrap(); + + window.set_title("Goodbye, World!"); + window.set_border_width(10); + window.set_window_position(WindowPosition::Center); + window.set_default_size(350, 70); + window.connect_delete_event(|_,_| { + gtk::main_quit(); + Inhibit(false) + }); + + window.show_all(); + gtk::main(); +} diff --git a/Task/Hello-world-Graphical/Scala/hello-world-graphical-3.scala b/Task/Hello-world-Graphical/Scala/hello-world-graphical-3.scala index 12223a18cc..01c1203176 100644 --- a/Task/Hello-world-Graphical/Scala/hello-world-graphical-3.scala +++ b/Task/Hello-world-Graphical/Scala/hello-world-graphical-3.scala @@ -3,6 +3,6 @@ import swing._ object HelloDotNetWorld { def main(args: Array[String]) { System.Windows.Forms.MessageBox.Show - ("Hello, .net world!") + ("Goodbye, World!") } } diff --git a/Task/Hello-world-Line-printer/00DESCRIPTION b/Task/Hello-world-Line-printer/00DESCRIPTION index 61a0487a52..54563b8b5d 100644 --- a/Task/Hello-world-Line-printer/00DESCRIPTION +++ b/Task/Hello-world-Line-printer/00DESCRIPTION @@ -1,8 +1,14 @@ {{omit from|PARI/GP}} {{omit from|ML/I|Does not have printer-related functions}} -Cause a line printer attached to the computer to print a line containing the message Hello World! +;Task: +Cause a line printer attached to the computer to print a line containing the message:   Hello World! + + +;Note: +A line printer is not the same as standard output. + +A   [[wp:line printer|line printer]]   was an older-style printer which prints one line at a time to a continuous ream of paper. -'''Note:''' A line printer is not the same as standard output. -A [[wp:line printer|line printer]] was an older-style printer which prints one line at a time to a continuous ream of paper. With some systems, a line printer can be any device attached to an appropriate port (such as a parallel port). +

    diff --git a/Task/Hello-world-Line-printer/360-Assembly/hello-world-line-printer.360 b/Task/Hello-world-Line-printer/360-Assembly/hello-world-line-printer.360 new file mode 100644 index 0000000000..9b273048c0 --- /dev/null +++ b/Task/Hello-world-Line-printer/360-Assembly/hello-world-line-printer.360 @@ -0,0 +1,13 @@ +HELLO CSECT + PRINT NOGEN + BALR 12,0 + USING *,12 + OPEN LNPRNTR + LA 6,HW + PUT LNPRNTR + CLOSE LNPRNTR + EOJ +LNPRNTR DTFPR DEVADDR=SYSLST,IOAREA1=L1 +L1 DS 0CL133 +HW DC C'Hello World!' + END HELLO diff --git a/Task/Hello-world-Line-printer/Forth/hello-world-line-printer.fth b/Task/Hello-world-Line-printer/Forth/hello-world-line-printer.fth new file mode 100644 index 0000000000..4d8eacbd3f --- /dev/null +++ b/Task/Hello-world-Line-printer/Forth/hello-world-line-printer.fth @@ -0,0 +1,26 @@ +\ No operating system, embedded device, printer output example + +defer emit \ deferred words in Forth are a place holder for an + \ execution token (XT) that is assigned later. + \ When executed the deferred word simply runs that assigned routine + +: type ( addr count -- ) \ type a string uses emit + bounds ?do i c@ emit loop ; \ type is used by all other text output words in the system + +HEX +: CR ( -- ) 0A emit 0D emit ; \ send a carriage return, linefeed pair with emit + +\ memory mapped I/O addresses for the printer port +B02E constant scsr \ serial control status register +B02F constant scdr \ serial control data register + +: printer-emit ( char -- ) \ output 'char' to the printer serial port + begin scsr C@ 80 and until \ loop until the port shows a ready bit + scdr C! \ C! (char store) writes a byte to an address + 20 ms ; \ 32 mS delay to prevent over-runs + +: console-emit ( char -- ) ... \ defined in the Forth system, usually assembler + +\ vector control words +: >console ['] console-emit is EMIT ; \ assign the execution token of console-emit to EMIT +: >printer ['] printer-emit is EMIT ; \ assign the execution token of printer-emit to EMIT diff --git a/Task/Hello-world-Line-printer/Perl-6/hello-world-line-printer-1.pl6 b/Task/Hello-world-Line-printer/Perl-6/hello-world-line-printer-1.pl6 new file mode 100644 index 0000000000..5fc0b087ae --- /dev/null +++ b/Task/Hello-world-Line-printer/Perl-6/hello-world-line-printer-1.pl6 @@ -0,0 +1,3 @@ +my $lp = open '/dev/lp0', :w; +$lp.say: 'Hello World!'; +$lp.close; diff --git a/Task/Hello-world-Line-printer/Perl-6/hello-world-line-printer-2.pl6 b/Task/Hello-world-Line-printer/Perl-6/hello-world-line-printer-2.pl6 new file mode 100644 index 0000000000..cd8066b5b9 --- /dev/null +++ b/Task/Hello-world-Line-printer/Perl-6/hello-world-line-printer-2.pl6 @@ -0,0 +1,4 @@ +given open '/dev/lp0', :w { + .say: 'Hello World!'; + .close; +} diff --git a/Task/Hello-world-Line-printer/Perl-6/hello-world-line-printer.pl6 b/Task/Hello-world-Line-printer/Perl-6/hello-world-line-printer.pl6 deleted file mode 100644 index 0bc9cc6a5c..0000000000 --- a/Task/Hello-world-Line-printer/Perl-6/hello-world-line-printer.pl6 +++ /dev/null @@ -1,5 +0,0 @@ -given open '/dev/lp0', :w { # Open the device for writing as the default - .say('Hello World!'); # Send it the string - .close; -# ^ The prefix "." says "use the default device here" -} diff --git a/Task/Hello-world-Line-printer/REXX/hello-world-line-printer.rexx b/Task/Hello-world-Line-printer/REXX/hello-world-line-printer.rexx index 8067d2d97b..2e756412e9 100644 --- a/Task/Hello-world-Line-printer/REXX/hello-world-line-printer.rexx +++ b/Task/Hello-world-Line-printer/REXX/hello-world-line-printer.rexx @@ -1,2 +1,3 @@ -str='Hello World' -'@ECHO' str ">PRN" +/*REXX program prints a string to the (DOS) line printer via redirection to a printer.*/ +$= 'Hello World!' /*define a string to be used for output*/ +'@ECHO' $ ">PRN" /*stick a fork in it, we're all done. */ diff --git a/Task/Hello-world-Line-printer/Rust/hello-world-line-printer.rust b/Task/Hello-world-Line-printer/Rust/hello-world-line-printer.rust new file mode 100644 index 0000000000..ee78a79810 --- /dev/null +++ b/Task/Hello-world-Line-printer/Rust/hello-world-line-printer.rust @@ -0,0 +1,7 @@ +use std::fs::OpenOptions; +use std::io::Write; + +fn main() { + let file = OpenOptions::new().write(true).open("/dev/lp0").unwrap(); + file.write(b"Hello, World!").unwrap(); +} diff --git a/Task/Hello-world-Newbie/00DESCRIPTION b/Task/Hello-world-Newbie/00DESCRIPTION index 86510ff971..87543fa777 100644 --- a/Task/Hello-world-Newbie/00DESCRIPTION +++ b/Task/Hello-world-Newbie/00DESCRIPTION @@ -1,3 +1,6 @@ +{{omit from|ABAP|There's no newbie frienly way to install ABAP. It's part of the enterprise NetWeaver Application Server.}} + +;Task: Guide a new user of a language through the steps necessary to install the programming language and selection of a [[Editor|text editor]] if needed, to run the languages' example in the [[Hello world/Text]] task. @@ -8,8 +11,8 @@ to run the languages' example in the [[Hello world/Text]] task. * Remember to state where to view the output. * If particular IDE's or editors are required that are not standard, then point to/explain their installation too. + ;Note: * If it is more natural for a language to give output via a GUI or to a file etc, then use that method of output rather than as text to a terminal/command-line, but remember to give instructions on how to view the output generated. * You may use sub-headings if giving instructions for multiple platforms. - -{{omit from|ABAP|There's no newbie frienly way to install ABAP. It's part of the enterprise NetWeaver Application Server.}} +

    diff --git a/Task/Hello-world-Newbie/Befunge/hello-world-newbie.bf b/Task/Hello-world-Newbie/Befunge/hello-world-newbie.bf new file mode 100644 index 0000000000..c34ddb91fd --- /dev/null +++ b/Task/Hello-world-Newbie/Befunge/hello-world-newbie.bf @@ -0,0 +1 @@ +"!dlrow olleH">:#,_@ diff --git a/Task/Hello-world-Newbie/C++/hello-world-newbie.cpp b/Task/Hello-world-Newbie/C++/hello-world-newbie.cpp new file mode 100644 index 0000000000..947da3a7c0 --- /dev/null +++ b/Task/Hello-world-Newbie/C++/hello-world-newbie.cpp @@ -0,0 +1,6 @@ +#include +int main() { + using namespace std; + cout << "Hello, World!" << endl; + return 0; +} diff --git a/Task/Hello-world-Newbie/Eiffel/hello-world-newbie-1.e b/Task/Hello-world-Newbie/Eiffel/hello-world-newbie-1.e new file mode 100644 index 0000000000..952f148eae --- /dev/null +++ b/Task/Hello-world-Newbie/Eiffel/hello-world-newbie-1.e @@ -0,0 +1,10 @@ +class + APPLICATION +create + make +feature + make + do + print ("Hello World!") + end +end diff --git a/Task/Hello-world-Newbie/Eiffel/hello-world-newbie-2.e b/Task/Hello-world-Newbie/Eiffel/hello-world-newbie-2.e new file mode 100644 index 0000000000..3d0bea8361 --- /dev/null +++ b/Task/Hello-world-Newbie/Eiffel/hello-world-newbie-2.e @@ -0,0 +1 @@ +class APPLICATION ... end diff --git a/Task/Hello-world-Newbie/Eiffel/hello-world-newbie-3.e b/Task/Hello-world-Newbie/Eiffel/hello-world-newbie-3.e new file mode 100644 index 0000000000..6f376e9e80 --- /dev/null +++ b/Task/Hello-world-Newbie/Eiffel/hello-world-newbie-3.e @@ -0,0 +1 @@ +create make diff --git a/Task/Hello-world-Newbie/Eiffel/hello-world-newbie-4.e b/Task/Hello-world-Newbie/Eiffel/hello-world-newbie-4.e new file mode 100644 index 0000000000..149a0eb631 --- /dev/null +++ b/Task/Hello-world-Newbie/Eiffel/hello-world-newbie-4.e @@ -0,0 +1 @@ +make do ... end diff --git a/Task/Hello-world-Newbie/Eiffel/hello-world-newbie-5.e b/Task/Hello-world-Newbie/Eiffel/hello-world-newbie-5.e new file mode 100644 index 0000000000..cdcb995f34 --- /dev/null +++ b/Task/Hello-world-Newbie/Eiffel/hello-world-newbie-5.e @@ -0,0 +1 @@ +print ( ... ) diff --git a/Task/Hello-world-Newbie/Eiffel/hello-world-newbie-6.e b/Task/Hello-world-Newbie/Eiffel/hello-world-newbie-6.e new file mode 100644 index 0000000000..dd95e45598 --- /dev/null +++ b/Task/Hello-world-Newbie/Eiffel/hello-world-newbie-6.e @@ -0,0 +1 @@ +inherit ANY diff --git a/Task/Hello-world-Newbie/Groovy/hello-world-newbie-1.groovy b/Task/Hello-world-Newbie/Groovy/hello-world-newbie-1.groovy new file mode 100644 index 0000000000..b19419394b --- /dev/null +++ b/Task/Hello-world-Newbie/Groovy/hello-world-newbie-1.groovy @@ -0,0 +1 @@ +println 'Hello to the Groovy world' diff --git a/Task/Hello-world-Newbie/Groovy/hello-world-newbie-2.groovy b/Task/Hello-world-Newbie/Groovy/hello-world-newbie-2.groovy new file mode 100644 index 0000000000..7be37d5cce --- /dev/null +++ b/Task/Hello-world-Newbie/Groovy/hello-world-newbie-2.groovy @@ -0,0 +1,2 @@ +String hello = 'Hello to the Groovy world' +println hello diff --git a/Task/Hello-world-Newbie/Groovy/hello-world-newbie-3.groovy b/Task/Hello-world-Newbie/Groovy/hello-world-newbie-3.groovy new file mode 100644 index 0000000000..93201e70b7 --- /dev/null +++ b/Task/Hello-world-Newbie/Groovy/hello-world-newbie-3.groovy @@ -0,0 +1,2 @@ +assert hello.contains('Groovy') +assert hello.startsWith('Hello') diff --git a/Task/Hello-world-Newbie/Lua/hello-world-newbie.lua b/Task/Hello-world-Newbie/Lua/hello-world-newbie.lua new file mode 100644 index 0000000000..3ee8f5af13 --- /dev/null +++ b/Task/Hello-world-Newbie/Lua/hello-world-newbie.lua @@ -0,0 +1 @@ +io.write("Hello world, from ",_VERSION,"!\n") diff --git a/Task/Hello-world-Newline-omission/00DESCRIPTION b/Task/Hello-world-Newline-omission/00DESCRIPTION index 7e91882923..24224969f5 100644 --- a/Task/Hello-world-Newline-omission/00DESCRIPTION +++ b/Task/Hello-world-Newline-omission/00DESCRIPTION @@ -1,7 +1,13 @@ -Some languages automatically insert a newline after outputting a string, unless measures are taken to prevent its output. The purpose of this task is to output the string "Goodbye, World!" without a trailing newline. +Some languages automatically insert a newline after outputting a string, unless measures are taken to prevent its output. -'''See also''' -* [[Hello world/Graphical]] -* [[Hello world/Line Printer]] -* [[Hello world/Standard error]] -* [[Hello world/Text]] + +;Task: +Display the string   Goodbye, World!   without a trailing newline. + + +;Related tasks: +*   [[Hello world/Graphical]] +*   [[Hello world/Line Printer]] +*   [[Hello world/Standard error]] +*   [[Hello world/Text]] +

    diff --git a/Task/Hello-world-Newline-omission/ALGOL-68/hello-world-newline-omission.alg b/Task/Hello-world-Newline-omission/ALGOL-68/hello-world-newline-omission.alg new file mode 100644 index 0000000000..7638b90c4c --- /dev/null +++ b/Task/Hello-world-Newline-omission/ALGOL-68/hello-world-newline-omission.alg @@ -0,0 +1,3 @@ +BEGIN + print ("Goodbye, World!") +END diff --git a/Task/Hello-world-Newline-omission/Brainf---/hello-world-newline-omission.bf b/Task/Hello-world-Newline-omission/Brainf---/hello-world-newline-omission.bf index f7fa31cb1a..36ae25cfa3 100644 --- a/Task/Hello-world-Newline-omission/Brainf---/hello-world-newline-omission.bf +++ b/Task/Hello-world-Newline-omission/Brainf---/hello-world-newline-omission.bf @@ -1,3 +1,3 @@ -+++++[>++++>+>+>++++>>+++<<<+<+<++[>++>+++>+++>++++>+>+[<]>>-]<-] ->>+.>>+..<.--.++>>+.<<+.>>>-.>++.[<]++++[>++++<-]>.>>.+++.------.<-.[>]<+. - G oo d b y e , W o r l d ! +>+++++[>++++>+>+>++++>>+++<<<+<+<++[>++>+++>+++>++++>+>+[<]>>-]<-]>> ++.>>+..<.--.++>>+.<<+.>>>-.>++.[<]++++[>++++<-]>.>>.+++.------.<-.[>]<+.[-] +[G oo d b y e , W o r l d !] diff --git a/Task/Hello-world-Newline-omission/CoffeeScript/hello-world-newline-omission.coffee b/Task/Hello-world-Newline-omission/CoffeeScript/hello-world-newline-omission.coffee new file mode 100644 index 0000000000..d448bc5ec1 --- /dev/null +++ b/Task/Hello-world-Newline-omission/CoffeeScript/hello-world-newline-omission.coffee @@ -0,0 +1 @@ +process.stdout.write "Goodbye, World!" diff --git a/Task/Hello-world-Newline-omission/Fortran/hello-world-newline-omission.f b/Task/Hello-world-Newline-omission/Fortran/hello-world-newline-omission-1.f similarity index 100% rename from Task/Hello-world-Newline-omission/Fortran/hello-world-newline-omission.f rename to Task/Hello-world-Newline-omission/Fortran/hello-world-newline-omission-1.f diff --git a/Task/Hello-world-Newline-omission/Fortran/hello-world-newline-omission-2.f b/Task/Hello-world-Newline-omission/Fortran/hello-world-newline-omission-2.f new file mode 100644 index 0000000000..b7bf3fed4f --- /dev/null +++ b/Task/Hello-world-Newline-omission/Fortran/hello-world-newline-omission-2.f @@ -0,0 +1,3 @@ + WRITE (6,1) "Goodbye, World!" + 1 FORMAT (A,$) + END diff --git a/Task/Hello-world-Newline-omission/JavaScript/hello-world-newline-omission.js b/Task/Hello-world-Newline-omission/JavaScript/hello-world-newline-omission.js new file mode 100644 index 0000000000..0e6a93754f --- /dev/null +++ b/Task/Hello-world-Newline-omission/JavaScript/hello-world-newline-omission.js @@ -0,0 +1 @@ +process.stdout.write("Goodbye, World!"); diff --git a/Task/Hello-world-Newline-omission/Kotlin/hello-world-newline-omission.kotlin b/Task/Hello-world-Newline-omission/Kotlin/hello-world-newline-omission.kotlin new file mode 100644 index 0000000000..a8d4e60ae8 --- /dev/null +++ b/Task/Hello-world-Newline-omission/Kotlin/hello-world-newline-omission.kotlin @@ -0,0 +1 @@ +fun main(args: Array) = print("Goodbye, World!") diff --git a/Task/Hello-world-Newline-omission/Oberon-2/hello-world-newline-omission.oberon-2 b/Task/Hello-world-Newline-omission/Oberon-2/hello-world-newline-omission.oberon-2 index 7ee6f92bda..27752af1fa 100644 --- a/Task/Hello-world-Newline-omission/Oberon-2/hello-world-newline-omission.oberon-2 +++ b/Task/Hello-world-Newline-omission/Oberon-2/hello-world-newline-omission.oberon-2 @@ -1,5 +1,5 @@ MODULE HelloWorld; IMPORT Out; BEGIN - Out.String("Hello World") + Out.String("Goodbye, world!") END HelloWorld. diff --git a/Task/Hello-world-Newline-omission/PicoLisp/hello-world-newline-omission.l b/Task/Hello-world-Newline-omission/PicoLisp/hello-world-newline-omission.l index f809cd9841..5af753123f 100644 --- a/Task/Hello-world-Newline-omission/PicoLisp/hello-world-newline-omission.l +++ b/Task/Hello-world-Newline-omission/PicoLisp/hello-world-newline-omission.l @@ -1 +1 @@ -(prin "Goodbye, world") +(prin "Goodbye, World!") diff --git a/Task/Hello-world-Newline-omission/Run-BASIC/hello-world-newline-omission.run b/Task/Hello-world-Newline-omission/Run-BASIC/hello-world-newline-omission.run new file mode 100644 index 0000000000..06eb32599c --- /dev/null +++ b/Task/Hello-world-Newline-omission/Run-BASIC/hello-world-newline-omission.run @@ -0,0 +1 @@ +print "Goodbye, World!"; diff --git a/Task/Hello-world-Newline-omission/SETL/hello-world-newline-omission.setl b/Task/Hello-world-Newline-omission/SETL/hello-world-newline-omission.setl new file mode 100644 index 0000000000..6a62a0dac5 --- /dev/null +++ b/Task/Hello-world-Newline-omission/SETL/hello-world-newline-omission.setl @@ -0,0 +1 @@ +nprint( 'Goodbye, World!' ); diff --git a/Task/Hello-world-Newline-omission/TXR/hello-world-newline-omission.txr b/Task/Hello-world-Newline-omission/TXR/hello-world-newline-omission.txr index 25ea3674e7..329c263876 100644 --- a/Task/Hello-world-Newline-omission/TXR/hello-world-newline-omission.txr +++ b/Task/Hello-world-Newline-omission/TXR/hello-world-newline-omission.txr @@ -1,2 +1,2 @@ -$txr -c '@(do (format t "Goodbye, world!"))' +$ txr -e '(put-string "Goodbye, world!")' Goodbye, world!$ diff --git a/Task/Hello-world-Standard-error/00DESCRIPTION b/Task/Hello-world-Standard-error/00DESCRIPTION index 8594e2f7dc..7586809f79 100644 --- a/Task/Hello-world-Standard-error/00DESCRIPTION +++ b/Task/Hello-world-Standard-error/00DESCRIPTION @@ -1,4 +1,4 @@ - {{selection|Short Circuit|Console Program Basics}} +{{selection|Short Circuit|Console Program Basics}} [[Category:Streams]] {{omit from|Applesoft BASIC}} {{omit from|bc|Always prints to standard output.}} @@ -15,8 +15,12 @@ A common practice in computing is to send error messages to a different output stream than [[User Output - text|normal text console messages]]. The normal messages print to what is called "standard output" or "standard out". + The error messages print to "standard error". This separation can be used to redirect error messages to a different place than normal messages. -Show how to print a message to standard error by printing "Goodbye, World!" on that stream. + +;Task: +Show how to print a message to standard error by printing     '''Goodbye, World!'''     on that stream. +

    diff --git a/Task/Hello-world-Standard-error/BASIC/hello-world-standard-error.basic b/Task/Hello-world-Standard-error/BASIC/hello-world-standard-error.basic index 9df0bc8f18..e2789f379d 100644 --- a/Task/Hello-world-Standard-error/BASIC/hello-world-standard-error.basic +++ b/Task/Hello-world-Standard-error/BASIC/hello-world-standard-error.basic @@ -1,2 +1,2 @@ 10 PRINT #1;"Goodbye, World!" -20 PAUSE 5: REM allow time for the user to see the error message +20 PAUSE 50: REM allow time for the user to see the error message diff --git a/Task/Hello-world-Standard-error/REXX/hello-world-standard-error-1.rexx b/Task/Hello-world-Standard-error/REXX/hello-world-standard-error-1.rexx index a1ec6ead2c..fb0ce5439f 100644 --- a/Task/Hello-world-Standard-error/REXX/hello-world-standard-error-1.rexx +++ b/Task/Hello-world-Standard-error/REXX/hello-world-standard-error-1.rexx @@ -1 +1 @@ -say 'Goodbye, World!' +call lineout 'STDERR', "Goodbye, World!" diff --git a/Task/Hello-world-Standard-error/REXX/hello-world-standard-error-2.rexx b/Task/Hello-world-Standard-error/REXX/hello-world-standard-error-2.rexx index fb0ce5439f..cc51ebfe35 100644 --- a/Task/Hello-world-Standard-error/REXX/hello-world-standard-error-2.rexx +++ b/Task/Hello-world-Standard-error/REXX/hello-world-standard-error-2.rexx @@ -1 +1,2 @@ -call lineout 'STDERR', "Goodbye, World!" +msgText = 'Goodbye, World!' +call charout 'STDERR', msgText diff --git a/Task/Hello-world-Standard-error/REXX/hello-world-standard-error-3.rexx b/Task/Hello-world-Standard-error/REXX/hello-world-standard-error-3.rexx index cc51ebfe35..5d1d4f463b 100644 --- a/Task/Hello-world-Standard-error/REXX/hello-world-standard-error-3.rexx +++ b/Task/Hello-world-Standard-error/REXX/hello-world-standard-error-3.rexx @@ -1,2 +1,14 @@ -msgText = 'Goodbye, World!' -call charout 'STDERR', msgText +/* REXX --------------------------------------------------------------- +* 07.07.2014 Walter Pachl +* enter the appropriate command shown in a command prompt. +* "rexx serr.rex 2>err.txt" +* or "regina serr.rex 2>err.txt" +* 2>file will redirect the stderr stream to the specified file. +* I don't know any other way to catch this stream +*--------------------------------------------------------------------*/ +Parse Version v +Say v +Call lineout 'stderr','Good bye, world!' +Call lineout ,'Hello, world!' +Say 'and this is the error output:' +'type err.txt' diff --git a/Task/Hello-world-Standard-error/Rust/hello-world-standard-error-1.rust b/Task/Hello-world-Standard-error/Rust/hello-world-standard-error-1.rust new file mode 100644 index 0000000000..f4f70e6e54 --- /dev/null +++ b/Task/Hello-world-Standard-error/Rust/hello-world-standard-error-1.rust @@ -0,0 +1,9 @@ +use std::io::{self,Write}; + +fn main() { + writeln!(&mut io::stderr(), "Goodbye, world!").expect("Could not write to stderr"); + // writeln! supports formatted strings so the following works as well + let goodbye = "Goodbye"; + let world = "world"; + writeln!(&mut io::stderr(), "{}, {}!", goodbye, world).expect("Could not write to stderr"); +} diff --git a/Task/Hello-world-Standard-error/Rust/hello-world-standard-error-2.rust b/Task/Hello-world-Standard-error/Rust/hello-world-standard-error-2.rust new file mode 100644 index 0000000000..e29c720f7f --- /dev/null +++ b/Task/Hello-world-Standard-error/Rust/hello-world-standard-error-2.rust @@ -0,0 +1,9 @@ + use std::io::{self, Write}; +fn main() { + io::stderr().write(b"Goodbye, world!").expect("Could not write to stderr"); + // With some finagling, you can do a formatted string here as well + let goodbye = "Goodbye"; + let world = "world"; + io::stderr().write(&*format!("{}, {}!", goodbye, world).as_bytes()).expect("Could not write to stderr"); + // Clearly, if you want formatted strings there's no reason not to just use writeln! +} diff --git a/Task/Hello-world-Standard-error/Rust/hello-world-standard-error.rust b/Task/Hello-world-Standard-error/Rust/hello-world-standard-error.rust deleted file mode 100644 index a6b1cb50dd..0000000000 --- a/Task/Hello-world-Standard-error/Rust/hello-world-standard-error.rust +++ /dev/null @@ -1,6 +0,0 @@ -use std::io::{self,Write}; - -fn main() { - let mut stderr = io::stderr(); - let bytes_read_or_error = stderr.write(b"Goodbye, World!\n"); -} diff --git a/Task/Hello-world-Standard-error/S-lang/hello-world-standard-error.slang b/Task/Hello-world-Standard-error/S-lang/hello-world-standard-error.slang new file mode 100644 index 0000000000..ebf21e591b --- /dev/null +++ b/Task/Hello-world-Standard-error/S-lang/hello-world-standard-error.slang @@ -0,0 +1 @@ +() = fputs("Goodbye, World!\n", stderr); diff --git a/Task/Hello-world-Text/00DESCRIPTION b/Task/Hello-world-Text/00DESCRIPTION index a47a3a264e..02089fa932 100644 --- a/Task/Hello-world-Text/00DESCRIPTION +++ b/Task/Hello-world-Text/00DESCRIPTION @@ -1,10 +1,13 @@ {{selection|Short Circuit|Console Program Basics}} [[Category:Simple]] -In this User Output task, the goal is to display the string "Hello world!" [sic] on a text console. -'''See also''' -* [[Hello world/Graphical]] -* [[Hello world/Line Printer]] -* [[Hello world/Newline omission]] -* [[Hello world/Standard error]] -* [[Hello world/Web server]] +;Task: +Display the string '''Hello world!''' on a text console. + +;Related tasks: +*   [[Hello world/Graphical]] +*   [[Hello world/Line Printer]] +*   [[Hello world/Newline omission]] +*   [[Hello world/Standard error]] +*   [[Hello world/Web server]] +

    diff --git a/Task/Hello-world-Text/APL/hello-world-text.apl b/Task/Hello-world-Text/APL/hello-world-text.apl new file mode 100644 index 0000000000..adb9840044 --- /dev/null +++ b/Task/Hello-world-Text/APL/hello-world-text.apl @@ -0,0 +1 @@ +'Hello world!' diff --git a/Task/Hello-world-Text/Babel/hello-world-text.pb b/Task/Hello-world-Text/Babel/hello-world-text.pb index 6adf1e451a..002e128db3 100644 --- a/Task/Hello-world-Text/Babel/hello-world-text.pb +++ b/Task/Hello-world-Text/Babel/hello-world-text.pb @@ -1 +1 @@ -((main { "Hello world!" << })) +"Hello world!" << diff --git a/Task/Hello-world-Text/Ela/hello-world-text.ela b/Task/Hello-world-Text/Ela/hello-world-text.ela index 969a3192b9..9f97cd5697 100644 --- a/Task/Hello-world-Text/Ela/hello-world-text.ela +++ b/Task/Hello-world-Text/Ela/hello-world-text.ela @@ -1,2 +1,2 @@ open monad io -do putStrLn "Googbye, World!" ::: IO +do putStrLn "Hello world!" ::: IO diff --git a/Task/Hello-world-Text/Elena/hello-world-text-1.elena b/Task/Hello-world-Text/Elena/hello-world-text-1.elena index 1a0079060e..063e09abb6 100644 --- a/Task/Hello-world-Text/Elena/hello-world-text-1.elena +++ b/Task/Hello-world-Text/Elena/hello-world-text-1.elena @@ -1,4 +1,4 @@ -#symbol Program = +#symbol program = [ system'console writeLine:"Hello world!". ]. diff --git a/Task/Hello-world-Text/Elena/hello-world-text-2.elena b/Task/Hello-world-Text/Elena/hello-world-text-2.elena index fa06f6a031..6621721e07 100644 --- a/Task/Hello-world-Text/Elena/hello-world-text-2.elena +++ b/Task/Hello-world-Text/Elena/hello-world-text-2.elena @@ -1,5 +1,5 @@ -[[ - #define start ::= "?" < system'console.eval&writeLine( > $literal < ) >; -]] +#import system. +#import system'dynamic. -? "Hello world!" +#symbol program + = Tape("Hello world!",system'console,%"writeLine[1]"). diff --git a/Task/Hello-world-Text/LaTeX/hello-world-text.tex b/Task/Hello-world-Text/LaTeX/hello-world-text.tex new file mode 100644 index 0000000000..b699f32ea4 --- /dev/null +++ b/Task/Hello-world-Text/LaTeX/hello-world-text.tex @@ -0,0 +1,5 @@ +\documentclass{scrartcl} + +\begin{document} +Hello World! +\end{document} diff --git a/Task/Hello-world-Text/MIPS-Assembly/hello-world-text.mips b/Task/Hello-world-Text/MIPS-Assembly/hello-world-text.mips index 65359dd6b3..90a71cfe73 100644 --- a/Task/Hello-world-Text/MIPS-Assembly/hello-world-text.mips +++ b/Task/Hello-world-Text/MIPS-Assembly/hello-world-text.mips @@ -1,10 +1,11 @@ - .data -hello: .asciiz "Hello world!" + .data #section for declaring variables +hello: .asciiz "Hello world!" #asciiz automatically adds the null terminator. If it's .ascii it doesn't have it. - .text -main: - la $a0, hello - li $v0, 4 - syscall - li $v0, 10 - syscall + .text # beginning of code +main: # a label, which can be used with jump and branching instructions. + la $a0, hello # load the address of hello into $a0 + li $v0, 4 # set the syscall to print the string at the address $a0 + syscall # make the system call + + li $v0, 10 # set the syscall to exit + syscall # make the system call diff --git a/Task/Hello-world-Text/Onyx/hello-world-text.onyx b/Task/Hello-world-Text/Onyx/hello-world-text.onyx index 7b9a5bda79..41ca45254e 100644 --- a/Task/Hello-world-Text/Onyx/hello-world-text.onyx +++ b/Task/Hello-world-Text/Onyx/hello-world-text.onyx @@ -1 +1 @@ -`Hello world!\n' print +`Hello world!\n' print flush diff --git a/Task/Hello-world-Text/Openscad/hello-world-text.scad b/Task/Hello-world-Text/Openscad/hello-world-text.scad index a560d61ce1..d4656e1e2e 100644 --- a/Task/Hello-world-Text/Openscad/hello-world-text.scad +++ b/Task/Hello-world-Text/Openscad/hello-world-text.scad @@ -1 +1,3 @@ -echo("Hello world!"); +echo("Hello world!"); // writes to the console +text("Hello world!"); // creates 2D text in the object space +linear_extrude(height=10) text("Hello world!"); // creates 3D text in the object space diff --git a/Task/Hello-world-Text/PostScript/hello-world-text-1.ps b/Task/Hello-world-Text/PostScript/hello-world-text-1.ps index d2d42ca3d5..68d604b1ba 100644 --- a/Task/Hello-world-Text/PostScript/hello-world-text-1.ps +++ b/Task/Hello-world-Text/PostScript/hello-world-text-1.ps @@ -1 +1,5 @@ -(Hello world!) == +%!PS +/Helvetica 20 selectfont +70 700 moveto +(Hello world!) show +showpage diff --git a/Task/Hello-world-Text/PostScript/hello-world-text-2.ps b/Task/Hello-world-Text/PostScript/hello-world-text-2.ps index 9d858c3664..d2d42ca3d5 100644 --- a/Task/Hello-world-Text/PostScript/hello-world-text-2.ps +++ b/Task/Hello-world-Text/PostScript/hello-world-text-2.ps @@ -1 +1 @@ -(Hello world!) = +(Hello world!) == diff --git a/Task/Hello-world-Text/PostScript/hello-world-text-3.ps b/Task/Hello-world-Text/PostScript/hello-world-text-3.ps index 984ff1d327..9d858c3664 100644 --- a/Task/Hello-world-Text/PostScript/hello-world-text-3.ps +++ b/Task/Hello-world-Text/PostScript/hello-world-text-3.ps @@ -1 +1 @@ -(Hello world!) print +(Hello world!) = diff --git a/Task/Hello-world-Text/PostScript/hello-world-text-4.ps b/Task/Hello-world-Text/PostScript/hello-world-text-4.ps new file mode 100644 index 0000000000..984ff1d327 --- /dev/null +++ b/Task/Hello-world-Text/PostScript/hello-world-text-4.ps @@ -0,0 +1 @@ +(Hello world!) print diff --git a/Task/Hello-world-Text/PostScript/hello-world-text-5.ps b/Task/Hello-world-Text/PostScript/hello-world-text-5.ps new file mode 100644 index 0000000000..4a0110666b --- /dev/null +++ b/Task/Hello-world-Text/PostScript/hello-world-text-5.ps @@ -0,0 +1,8 @@ +%!PS +/Helvetica 20 selectfont +70 700 moveto +(Hello world!) dup dup dup += print == % prints three times to the console +show % prints to document +1 0 div % provokes error message +showpage diff --git a/Task/Hello-world-Text/Processing/hello-world-text b/Task/Hello-world-Text/Processing/hello-world-text new file mode 100644 index 0000000000..b078aeee5c --- /dev/null +++ b/Task/Hello-world-Text/Processing/hello-world-text @@ -0,0 +1 @@ +println("Hello world!"); diff --git a/Task/Hello-world-Text/Python/hello-world-text-4.py b/Task/Hello-world-Text/Python/hello-world-text-4.py new file mode 100644 index 0000000000..c91772d420 --- /dev/null +++ b/Task/Hello-world-Text/Python/hello-world-text-4.py @@ -0,0 +1 @@ +import __hello__ diff --git a/Task/Hello-world-Text/Python/hello-world-text-5.py b/Task/Hello-world-Text/Python/hello-world-text-5.py new file mode 100644 index 0000000000..70e097041d --- /dev/null +++ b/Task/Hello-world-Text/Python/hello-world-text-5.py @@ -0,0 +1 @@ +import __phello__ diff --git a/Task/Hello-world-Text/Python/hello-world-text-6.py b/Task/Hello-world-Text/Python/hello-world-text-6.py new file mode 100644 index 0000000000..fcc6ec4504 --- /dev/null +++ b/Task/Hello-world-Text/Python/hello-world-text-6.py @@ -0,0 +1 @@ +import __phello__.spam diff --git a/Task/Hello-world-Text/Ruby/hello-world-text-4.rb b/Task/Hello-world-Text/Ruby/hello-world-text-4.rb new file mode 100644 index 0000000000..febfaab9c3 --- /dev/null +++ b/Task/Hello-world-Text/Ruby/hello-world-text-4.rb @@ -0,0 +1 @@ +$>.puts "Hello world!" diff --git a/Task/Hello-world-Text/Ruby/hello-world-text-5.rb b/Task/Hello-world-Text/Ruby/hello-world-text-5.rb new file mode 100644 index 0000000000..5f8419bf21 --- /dev/null +++ b/Task/Hello-world-Text/Ruby/hello-world-text-5.rb @@ -0,0 +1 @@ +$>.write "Hello world!\n" diff --git a/Task/Hello-world-Text/X86-Assembly/hello-world-text-3.x86 b/Task/Hello-world-Text/X86-Assembly/hello-world-text-3.x86 new file mode 100644 index 0000000000..9bf26d251b --- /dev/null +++ b/Task/Hello-world-Text/X86-Assembly/hello-world-text-3.x86 @@ -0,0 +1,23 @@ +// No "main" used +// compile with `gcc -nostdlib` +#define SYS_WRITE $1 +#define STDOUT $1 +#define SYS_EXIT $60 +#define MSGLEN $14 + +.global _start +.text + +_start: + movq $message, %rsi // char * + movq SYS_WRITE, %rax + movq STDOUT, %rdi + movq MSGLEN, %rdx + syscall // sys_write(message, stdout, 0x14); + + movq SYS_EXIT, %rax + xorq %rdi, %rdi // The exit code. + syscall // exit(0) + +.data +message: .ascii "Hello, world!\n" diff --git a/Task/Hello-world-Web-server/00DESCRIPTION b/Task/Hello-world-Web-server/00DESCRIPTION index fe46d63d0c..d905dcdd75 100644 --- a/Task/Hello-world-Web-server/00DESCRIPTION +++ b/Task/Hello-world-Web-server/00DESCRIPTION @@ -9,10 +9,16 @@ The browser is the new [[GUI]] ! -The task is to serve our standard text "Goodbye, World!" to http://localhost:8080/ so that it can be viewed with a web browser.
    + +;Task: +Serve our standard text   Goodbye, World!   to   http://localhost:8080/   so that it can be viewed with a web browser. + The provided solution must start or implement a server that accepts multiple client connections and serves text as requested. Note that starting a web browser or opening a new window with this URL -is not part of the task.
    +is not part of the task. + Additionally, it is permissible to serve the provided page as a plain text file (there is no requirement to serve properly formatted [[HTML]] here). + The browser will generally do the right thing with simple text like this. +

    diff --git a/Task/Hello-world-Web-server/Fortran/hello-world-web-server.f b/Task/Hello-world-Web-server/Fortran/hello-world-web-server.f new file mode 100644 index 0000000000..f1a42256a3 --- /dev/null +++ b/Task/Hello-world-Web-server/Fortran/hello-world-web-server.f @@ -0,0 +1,14 @@ +program http_example + implicit none + character (len=:), allocatable :: code + character (len=:), allocatable :: command + logical :: waitForProcess + + ! Execute a Node.js code + code = "const http = require('http'); http.createServer((req, res) => & + {res.end('Hello World from a Node.js server started from Fortran!')}).listen(8080);" + + command = 'node -e "' // code // '"' + call execute_command_line (command, wait=waitForProcess) + +end program http_example diff --git a/Task/Hello-world-Web-server/Python/hello-world-web-server.py b/Task/Hello-world-Web-server/Python/hello-world-web-server.py index 5290634d93..470afa0631 100644 --- a/Task/Hello-world-Web-server/Python/hello-world-web-server.py +++ b/Task/Hello-world-Web-server/Python/hello-world-web-server.py @@ -1,8 +1,8 @@ -def app(environ, start_response): - start_response('200 OK', []) - yield "Goodbye, World!" +from wsgiref.simple_server import make_server -if __name__ == '__main__': - from wsgiref.simple_server import make_server - server = make_server('127.0.0.1', 8080, app) - server.serve_forever() +def app(environ, start_response): + start_response('200 OK', [('Content-Type','text/html')]) + yield b"

    Goodbye, World!

    " + +server = make_server('127.0.0.1', 8080, app) +server.serve_forever() diff --git a/Task/Hello-world-Web-server/Ruby/hello-world-web-server-2.rb b/Task/Hello-world-Web-server/Ruby/hello-world-web-server-2.rb index 7569c667f5..2d0885e94e 100644 --- a/Task/Hello-world-Web-server/Ruby/hello-world-web-server-2.rb +++ b/Task/Hello-world-Web-server/Ruby/hello-world-web-server-2.rb @@ -1,2 +1,4 @@ -require 'sinatra' -get("/") { "Goodbye, World!" } +require 'webrick' +WEBrick::HTTPServer.new(:Port => 80).tap {|srv| + srv.mount_proc('/') {|request, response| response.body = "Goodbye, World!"} +}.start diff --git a/Task/Hello-world-Web-server/Ruby/hello-world-web-server-3.rb b/Task/Hello-world-Web-server/Ruby/hello-world-web-server-3.rb new file mode 100644 index 0000000000..7569c667f5 --- /dev/null +++ b/Task/Hello-world-Web-server/Ruby/hello-world-web-server-3.rb @@ -0,0 +1,2 @@ +require 'sinatra' +get("/") { "Goodbye, World!" } diff --git a/Task/Hello-world-Web-server/Rust/hello-world-web-server.rust b/Task/Hello-world-Web-server/Rust/hello-world-web-server.rust index 88b15098c9..e5d7c62a17 100644 --- a/Task/Hello-world-Web-server/Rust/hello-world-web-server.rust +++ b/Task/Hello-world-Web-server/Rust/hello-world-web-server.rust @@ -1,28 +1,27 @@ -use std::io::net::tcp::{TcpListener, TcpStream}; -use std::io::net::ip::{Ipv4Addr, SocketAddr}; -use std::io::{Acceptor, Listener}; +use std::net::{Shutdown, TcpListener}; +use std::thread; +use std::io::Write; + +const RESPONSE: &'static [u8] = b"HTTP/1.1 200 OK\r +Content-Type: text/html; charset=UTF-8\r\n\r +Bye-bye baby bye-bye + +

    Goodbye, world!

    \r"; -fn handle_client(mut stream: TcpStream) { - let response = bytes!("HTTP/1.1 200 OK\r\nContent-Type: text/html; charset=UTF-8\r\n\r\nBye-bye baby bye-bye

    Goodbye, world!

    \r\n"); - match stream.write(response) { - Ok(()) => println!("Response send!"), - Err(e) => println!("Failed sending response: {}!", e), - } - drop(stream); -} fn main() { - let addr = SocketAddr { ip: Ipv4Addr(127, 0, 0, 1), port: 8080 }; - let listener = TcpListener::bind(addr).unwrap(); + let listener = TcpListener::bind("127.0.0.1:8080").unwrap(); - let mut acceptor = listener.listen(); - println!("Listening for connections on port {}", addr.port); - - for stream in acceptor.incoming() { - spawn(proc() { - handle_client(stream.unwrap()); - }) + for stream in listener.incoming() { + thread::spawn(move || { + let mut stream = stream.unwrap(); + match stream.write(RESPONSE) { + Ok(_) => println!("Response sent!"), + Err(e) => println!("Failed sending response: {}!", e), + } + stream.shutdown(Shutdown::Write).unwrap(); + }); } - - drop(acceptor); } diff --git a/Task/Here-document/00DESCRIPTION b/Task/Here-document/00DESCRIPTION index b95c50e04f..06cf55d69c 100644 --- a/Task/Here-document/00DESCRIPTION +++ b/Task/Here-document/00DESCRIPTION @@ -4,10 +4,17 @@ {{omit from|GW-BASIC}} {{omit from|MATLAB|MATLAB has no multiline string literal functionality}} -A here document (or "heredoc") is a way of specifying a text block, preserving the line breaks, indentation and other whitespace within the text. +A   ''here document''   (or "heredoc")   is a way of specifying a text block, preserving the line breaks, indentation and other whitespace within the text. -Depending on the language being used a here document is constructed using a command followed by "<<" (or some other symbol) followed by a token string. +Depending on the language being used, a   ''here document''   is constructed using a command followed by "<<" (or some other symbol) followed by a token string. -The text block will then start on the next line, and will be followed by the chosen token at the beginning of the following line, which is used to mark the end of the textblock. +The text block will then start on the next line, and will be followed by the chosen token at the beginning of the following line, which is used to mark the end of the text block. -The task is to demonstrate the use of here documents within the language. + +;Task: +Demonstrate the use of   ''here documents''   within the language. + + +;Related task: +*   [[Documentation]] +

    diff --git a/Task/Here-document/Fortran/here-document.f b/Task/Here-document/Fortran/here-document.f new file mode 100644 index 0000000000..489f8f1340 --- /dev/null +++ b/Task/Here-document/Fortran/here-document.f @@ -0,0 +1,17 @@ + INTEGER I !A stepper. + CHARACTER*666 I AM !Sufficient space. + I AM = " ''a'',   ''b'',   and   ''c''   is given by: -:A = \sqrt{s(s-a)(s-b)(s-c)}, +:::: A = \sqrt{s(s-a)(s-b)(s-c)}, -where ''s'' is half the perimeter of the triangle; that is, +where   ''s''   is half the perimeter of the triangle; that is, -:s=\frac{a+b+c}{2}. +:::: s=\frac{a+b+c}{2}. +
    '''[http://www.had2know.com/academics/heronian-triangles-generator-calculator.html Heronian triangles]''' are triangles whose sides ''and area'' are all integers. -:An example is the triangle with sides 3, 4, 5 whose area is 6 (and whose perimeter is 12). +: An example is the triangle with sides   '''3, 4, 5'''   whose area is   '''6'''   (and whose perimeter is   '''12'''). -Note that any triangle whose sides are all an integer multiple of 3,4,5; such as 6,8,10, will -also be a Heronian triangle. +
    +Note that any triangle whose sides are all an integer multiple of   '''3, 4, 5''';   such as   '''6, 8, 10,'''   will also be a Heronian triangle. Define a '''Primitive Heronian triangle''' as a Heronian triangle where the greatest common divisor -of all three sides is 1. This will exclude, for example triangle 6,8,10 +of all three sides is   '''1'''   (unity). -'''The task''' is to: +This will exclude, for example, triangle   '''6, 8, 10.''' + + +;Task: # Create a named function/method/procedure/... that implements Hero's formula. # Use the function to generate all the ''primitive'' Heronian triangles with sides <= 200. # Show the count of how many triangles are found. # Order the triangles by first increasing area, then by increasing perimeter, then by increasing maximum side lengths # Show the first ten ordered triangles in a table of sides, perimeter, and area. # Show a similar ordered table for those triangles with area = 210 + +
    Show all output here. -'''Note''': when generating triangles it may help to restrict a <= b <= c +'''Note''': when generating triangles it may help to restrict a <= b <= c diff --git a/Task/Heronian-triangles/ALGOL-68/heronian-triangles.alg b/Task/Heronian-triangles/ALGOL-68/heronian-triangles.alg new file mode 100644 index 0000000000..a635ed5850 --- /dev/null +++ b/Task/Heronian-triangles/ALGOL-68/heronian-triangles.alg @@ -0,0 +1,83 @@ +# mode to hold details of a Heronian triangle # +MODE HERONIAN = STRUCT( INT a, b, c, area, perimeter ); +# returns the details of the Heronian Triangle with sides a, b, c or nil if it isn't one # +PROC try ht = ( INT a, b, c )REF HERONIAN: + BEGIN + REF HERONIAN t := NIL; + REAL s = ( a + b + c ) / 2; + REAL area squared = s * ( s - a ) * ( s - b ) * ( s - c ); + IF area squared > 0 THEN + # a, b, c does form a triangle # + REAL area = sqrt( area squared ); + IF ENTIER area = area THEN + # the area is integral so the triangle is Heronian # + t := HEAP HERONIAN := ( a, b, c, ENTIER area, a + b + c ) + FI + FI; + t + END # try ht # ; +# returns the GCD of a and b # +PROC gcd = ( INT a, b )INT: IF b = 0 THEN a ELSE gcd( b, a MOD b ) FI; +# prints the details of the Heronian triangle t # +PROC ht print = ( REF HERONIAN t )VOID: + print( ( whole( a OF t, -4 ), whole( b OF t, -5 ), whole( c OF t, -5 ), whole( area OF t, -5 ), whole( perimeter OF t, -10 ), newline ) ); +# prints headings for the Heronian Triangle table # +PROC ht title = VOID: print( ( " a b c area perimeter", newline, "---- ---- ---- ---- ---------", newline ) ); + +BEGIN + # construct ht as a table of the Heronian Triangles with sides up to 200 # + [ 1 : 1000 ]REF HERONIAN ht; + REF HERONIAN t; + INT ht count := 0; + + FOR c TO 200 DO + FOR b TO c DO + FOR a TO b DO + IF gcd( gcd( a, b ), c ) = 1 THEN + t := try ht( a, b, c ); + IF REF HERONIAN(t) ISNT REF HERONIAN(NIL) THEN + ht[ ht count +:= 1 ] := t + FI + FI + OD + OD + OD; + + # sort the table on ascending area, perimeter and max side length # + # note we constructed the triangles with c as the longest side # + BEGIN + INT lower := 1, upper := ht count; + WHILE upper := upper - 1; + BOOL swapped := FALSE; + FOR i FROM lower TO upper DO + REF HERONIAN h := ht[ i ]; + REF HERONIAN k := ht[ i + 1 ]; + IF area OF k < area OF h OR ( area OF k = area OF h + AND ( perimeter OF k < perimeter OF h + OR ( perimeter OF k = perimeter OF h + AND c OF k < c OF h + ) + ) + ) + THEN + ht[ i ] := k; + ht[ i + 1 ] := h; + swapped := TRUE + FI + OD; + swapped + DO SKIP OD; + + # display the triangles # + print( ( "There are ", whole( ht count, 0 ), " Heronian triangles with sides up to 200", newline ) ); + ht title; + FOR ht pos TO 10 DO ht print( ht( ht pos ) ) OD; + print( ( " ...", newline ) ); + print( ( "Heronian triangles with area 210:", newline ) ); + ht title; + FOR ht pos TO ht count DO + REF HERONIAN t := ht[ ht pos ]; + IF area OF t = 210 THEN ht print( t ) FI + OD + END +END diff --git a/Task/Heronian-triangles/ALGOL-W/heronian-triangles.alg b/Task/Heronian-triangles/ALGOL-W/heronian-triangles.alg new file mode 100644 index 0000000000..bd8da16086 --- /dev/null +++ b/Task/Heronian-triangles/ALGOL-W/heronian-triangles.alg @@ -0,0 +1,97 @@ +begin + % record to hold details of a Heronian triangle % + record Heronian ( integer a, b, c, area, perimeter ); + % returns the details of the Heronian Triangle with sides a, b, c or nil if it isn't one % + reference(Heronian) procedure tryHt( integer value a, b, c ) ; + begin + real s, areaSquared, area; + reference(Heronian) t; + s := ( a + b + c ) / 2; + areaSquared := s * ( s - a ) * ( s - b ) * ( s - c ); + t := null; + if areaSquared > 0 then begin + % a, b, c does form a triangle % + area := sqrt( areaSquared ); + if entier( area ) = area then begin + % the area is integral so the triangle is Heronian % + t := Heronian( a, b, c, entier( area ), a + b + c ) + end + end; + t + end tryHt ; + + % returns the GCD of a and b % + integer procedure gcd( integer value a, b ) ; if b = 0 then a else gcd( b, a rem b ); + + % prints the details of the Heronian triangle t % + procedure htPrint( reference(Heronian) value t ) ; write( i_w := 4, s_w := 1, a(t), b(t), c(t), area(t), " ", perimeter(t) ); + % prints headings for the Heronian Triangle table % + procedure htTitle ; begin write( " a b c area perimeter" ); write( "---- ---- ---- ---- ---------" ) end; + + begin + % construct ht as a table of the Heronian Triangles with sides up to 200 % + reference(Heronian) array ht ( 1 :: 1000 ); + reference(Heronian) t; + integer htCount; + + htCount := 0; + for c := 1 until 200 do begin + for b := 1 until c do begin + for a := 1 until b do begin + if gcd( gcd( a, b ), c ) = 1 then begin + t := tryHt( a, b, c ); + if t not = null then begin + htCount := htCount + 1; + ht( htCount ) := t + end + end + end + end + end; + + % sort the table on ascending area, perimeter and max side length % + % note we constructed the triangles with c as the longest side % + begin + integer lower, upper; + reference(Heronian) k, h; + logical swapped; + lower := 1; + upper := htCount; + while begin + upper := upper - 1; + swapped := false; + for i := lower until upper do begin + h := ht( i ); + k := ht( i + 1 ); + if area(k) < area(h) or ( area(k) = area(h) + and ( perimeter(k) < perimeter(h) + or ( perimeter(k) = perimeter(h) + and c(k) < c(h) + ) + ) + ) + then begin + ht( i ) := k; + ht( i + 1 ) := h; + swapped := true; + end + end; + swapped + end + do begin end; + end; + + % display the triangles % + write( "There are ", htCount, " Heronian triangles with sides up to 200" ); + htTitle; + for htPos := 1 until 10 do htPrint( ht( htPos ) ); + write( " ..." ); + write( "Heronian triangles with area 210:" ); + htTitle; + for htPos := 1 until htCount do begin + reference(Heronian) t; + t := ht( htPos ); + if area(t) = 210 then htPrint( t ) + end + end +end. diff --git a/Task/Heronian-triangles/AppleScript/heronian-triangles.applescript b/Task/Heronian-triangles/AppleScript/heronian-triangles.applescript new file mode 100644 index 0000000000..20b8803890 --- /dev/null +++ b/Task/Heronian-triangles/AppleScript/heronian-triangles.applescript @@ -0,0 +1,258 @@ +use framework "Foundation" + +property ca : current application + +-- heroniansOfSideUpTo :: Int -> [(Int, Int, Int)] +on heroniansOfSideUpTo(n) + script sideA + on lambda(a) + script sideB + on lambda(b) + script sideC + -- primitiveHeronian :: Int -> Int -> Int -> Bool + on primitiveHeronian(x, y, z) + (x ≤ y and y ≤ z) and (x + y > z) and ¬ + gcd(gcd(x, y), z) = 1 and ¬ + isIntegerValue(hArea(x, y, z)) + end primitiveHeronian + + on lambda(c) + if primitiveHeronian(a, b, c) then + [[a, b, c]] + else + [] + end if + end lambda + end script + + concatMap(sideC, range(b, n)) + end lambda + end script + + concatMap(sideB, range(a, n)) + end lambda + end script + + concatMap(sideA, range(1, n)) +end heroniansOfSideUpTo + + + +-- TEST + +on run + set n to 200 + + set lstHeron to sortByKeys(map(triangleDimensions, ¬ + heroniansOfSideUpTo(n)), ¬ + {"area", "perimeter", "maxSide"}) + + set lstCols to {"sides", "perimeter", "area"} + set lstColWidths to [20, 15, 0] + set area to 210 + + script areaFilter + -- Record -> [Record] + on lambda(recTriangle) + if area of recTriangle = area then + [recTriangle] + else + [] + end if + end lambda + end script + + intercalate(" + +", {("Number of triangles found (with sides <= 200): " & ¬ + length of lstHeron as string), ¬ + ¬ + tabulation("First 10, ordered by area, perimeter, longest side", ¬ + items 1 thru 10 of lstHeron, lstCols, lstColWidths), ¬ + ¬ + tabulation("Area = 210", ¬ + concatMap(areaFilter, lstHeron), lstCols, lstColWidths)}) +end run + + + +-- triangleDimensions :: (Int, Int, Int) -> +-- {sides: (Int, Int, Int), area: Int, perimeter: Int, maxSize: Int} +on triangleDimensions(lstSides) + set {x, y, z} to lstSides + {sides:[x, y, z], area:hArea(x, y, z) as integer, perimeter:x + y + z, maxSide:z} +end triangleDimensions + +-- hArea :: Int -> Int -> Int -> Num +on hArea(x, y, z) + set s to (x + y + z) / 2 + set a to s * (s - x) * (s - y) * (s - z) + + if a > 0 then + a ^ 0.5 + else + 0 + end if +end hArea + +-- gcd :: Int -> Int -> Int +on gcd(m, n) + if n = 0 then + m + else + gcd(n, m mod n) + end if +end gcd + + +-- TABLE FORMATTING + +-- tabulation :: [Record] -> [String] -> String -> [Integer] -> String +on tabulation(strLegend, lstRecords, lstKeys, lstWidths) + script heading + on lambda(strTitle, iCol) + set str to toCapitalized(strTitle) + str & nreps(space, (item iCol of lstWidths) - (length of str)) + end lambda + end script + + script lineString + on lambda(rec) + script fieldString + -- fieldString :: String -> Int -> String + on lambda(strKey, i) + set v to keyValue(rec, strKey) + + if class of v is list then + set strData to ("(" & intercalate(", ", v) & ")") + else + set strData to v as string + end if + + strData & nreps(space, (item i of (lstWidths)) - (length of strData)) + end lambda + end script + + tab & intercalate(tab, map(fieldString, lstKeys)) + end lambda + end script + + strLegend & ":" & linefeed & linefeed & ¬ + tab & intercalate(tab, ¬ + map(heading, lstKeys)) & linefeed & ¬ + intercalate(linefeed, map(lineString, lstRecords)) +end tabulation + +-- isIntegerValue :: Num -> Bool +on isIntegerValue(n) + {real, integer} contains class of n and (n = (n as integer)) +end isIntegerValue + + +-- sortByKeys :: [Record] -> [String] -> [Record] +on sortByKeys(lstRecords, lstKeys) + script keyDescriptor + on lambda(strKey) + ca's NSSortDescriptor's ¬ + sortDescriptorWithKey:(strKey) ascending:true + end lambda + end script + + ((ca's NSArray's arrayWithArray:lstRecords)'s ¬ + sortedArrayUsingDescriptors:(map(keyDescriptor, lstKeys))) as list +end sortByKeys + + +-- keyValue :: Record -> String -> a +on keyValue(rec, strKey) + item 1 of ((ca's NSArray's ¬ + arrayWithObject:((ca's NSDictionary's dictionaryWithDictionary:rec)'s ¬ + objectForKey:strKey)) as list) +end keyValue + +-- GENERIC FUNCTIONS + +-- concatMap :: (a -> [b]) -> [a] -> [b] +on concatMap(f, xs) + script append + on lambda(a, b) + a & b + end lambda + end script + foldl(append, {}, map(f, xs)) +end concatMap + +-- 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 + +-- 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 + +-- range :: Int -> Int -> [Int] +on range(m, n) + set d to 1 + if n < m then set d to -1 + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range + + +-- intercalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate + +-- Text -> Text +on toCapitalized(str) + ((ca's NSString's stringWithString:(str))'s ¬ + capitalizedStringWithLocale:(ca's NSLocale's currentLocale())) as text +end toCapitalized + +-- String -> Int -> String +on nreps(s, n) + set o to "" + if n < 1 then return o + + repeat while (n > 1) + if (n mod 2) > 0 then set o to o & s + set n to (n div 2) + set s to (s & s) + end repeat + return o & s +end nreps + +-- 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 diff --git a/Task/Heronian-triangles/C++/heronian-triangles.cpp b/Task/Heronian-triangles/C++/heronian-triangles.cpp new file mode 100644 index 0000000000..45f58f8458 --- /dev/null +++ b/Task/Heronian-triangles/C++/heronian-triangles.cpp @@ -0,0 +1,86 @@ +#include +#include +#include +#include +#include + +int gcd(int a, int b) +{ + int rem = 1, dividend, divisor; + std::tie(divisor, dividend) = std::minmax(a, b); + while (rem != 0) { + rem = dividend % divisor; + if (rem != 0) { + dividend = divisor; + divisor = rem; + } + } + return divisor; +} + +struct Triangle +{ + int a; + int b; + int c; +}; + +int perimeter(const Triangle& triangle) +{ + return triangle.a + triangle.b + triangle.c; +} + +double area(const Triangle& t) +{ + double p_2 = perimeter(t) / 2.; + double area_sq = p_2 * ( p_2 - t.a ) * ( p_2 - t.b ) * ( p_2 - t.c ); + return sqrt(area_sq); +} + +std::vector generate_triangles(int side_limit = 200) +{ + std::vector result; + for(int a = 1; a <= side_limit; ++a) + for(int b = 1; b <= a; ++b) + for(int c = a+1-b; c <= b; ++c) // skip too-small values of c, which will violate triangle inequality + { + Triangle t{a, b, c}; + double t_area = area(t); + if(t_area == 0) continue; + if( std::floor(t_area) == std::ceil(t_area) && gcd(a, gcd(b, c)) == 1) + result.push_back(t); + } + return result; +} + +bool compare(const Triangle& lhs, const Triangle& rhs) +{ + return std::make_tuple(area(lhs), perimeter(lhs), std::max(lhs.a, std::max(lhs.b, lhs.c))) < + std::make_tuple(area(rhs), perimeter(rhs), std::max(rhs.a, std::max(rhs.b, rhs.c))); +} + +struct area_compare +{ + bool operator()(const Triangle& t, int i) { return area(t) < i; } + bool operator()(int i, const Triangle& t) { return i < area(t); } +}; + +int main() +{ + auto tri = generate_triangles(); + std::cout << "There are " << tri.size() << " primitive Heronian triangles with sides up to 200\n\n"; + + std::cout << "First ten when ordered by increasing area, then perimeter, then maximum sides:\n"; + std::sort(tri.begin(), tri.end(), compare); + std::cout << "area\tperimeter\tsides\n"; + for(int i = 0; i < 10; ++i) + std::cout << area(tri[i]) << '\t' << perimeter(tri[i]) << "\t\t" << + tri[i].a << 'x' << tri[i].b << 'x' << tri[i].c << '\n'; + + std::cout << "\nAll with area 210 subject to the previous ordering:\n"; + auto range = std::equal_range(tri.begin(), tri.end(), 210, area_compare()); + std::cout << "area\tperimeter\tsides\n"; + for(auto it = range.first; it != range.second; ++it) + std::cout << area(*it) << '\t' << perimeter(*it) << "\t\t" << + it->a << 'x' << it->b << 'x' << it->c << '\n'; +} diff --git a/Task/Heronian-triangles/CoffeeScript/heronian-triangles.coffee b/Task/Heronian-triangles/CoffeeScript/heronian-triangles.coffee new file mode 100644 index 0000000000..56813f3199 --- /dev/null +++ b/Task/Heronian-triangles/CoffeeScript/heronian-triangles.coffee @@ -0,0 +1,47 @@ +heronArea = (a, b, c) -> + s = (a + b + c) / 2 + Math.sqrt s * (s - a) * (s - b) * (s - c) + +isHeron = (h) -> h % 1 == 0 and h > 0 + +gcd = (a, b) -> + leftover = 1 + dividend = if a > b then a else b + divisor = if a > b then b else a + until leftover == 0 + leftover = dividend % divisor + if leftover > 0 + dividend = divisor + divisor = leftover + divisor + +list = [] +for c in [1..200] + for b in [1..c] + for a in [1..b] + area = heronArea(a, b, c) + if gcd(gcd(a, b), c) == 1 and isHeron(area) + list.push new Array(a, b, c, a + b + c, area) + +sort = (list) -> + swapped = true + while swapped + swapped = false + for i in [1..list.length-1] + if list[i][4] < list[i - 1][4] or list[i][4] == list[i - 1][4] and list[i][3] < list[i - 1][3] + temp = list[i] + list[i] = list[i - 1] + list[i - 1] = temp + swapped = true +sort list + +# some results: +console.log 'primitive Heronian triangles with sides up to 200: ' + list.length +console.log 'First ten when ordered by increasing area, then perimeter:' +for i in list[0..10-1] + console.log i[0..2].join(' x ') + ', p = ' + i[3] + ', a = ' + i[4] + +console.log '\nHeronian triangles with area = 210:' +for i in list + if i[4] == 210 + console.log i[0..2].join(' x ') + ', p = ' + i[3] diff --git a/Task/Heronian-triangles/Go/heronian-triangles.go b/Task/Heronian-triangles/Go/heronian-triangles.go new file mode 100644 index 0000000000..615a71209c --- /dev/null +++ b/Task/Heronian-triangles/Go/heronian-triangles.go @@ -0,0 +1,70 @@ +package main + +import ( + "fmt" + "math" + "sort" +) + +const ( + n = 200 + header = "\nSides P A" +) + +func gcd(a, b int) int { + leftover := 1 + var dividend, divisor int + if (a > b) { dividend, divisor = a, b } else { dividend, divisor = b, a } + + for (leftover != 0) { + leftover = dividend % divisor + if (leftover > 0) { + dividend, divisor = divisor, leftover + } + } + return divisor +} + +func is_heron(h float64) bool { + return h > 0 && math.Mod(h, 1) == 0.0 +} + +// by_area_perimeter implements sort.Interface for [][]int based on the area first and perimeter value +type by_area_perimeter [][]int + +func (a by_area_perimeter) Len() int { return len(a) } +func (a by_area_perimeter) Swap(i, j int) { a[i], a[j] = a[j], a[i] } +func (a by_area_perimeter) Less(i, j int) bool { + return a[i][4] < a[j][4] || a[i][4] == a[j][4] && a[i][3] < a[j][3] +} + +func main() { + var l [][]int + for c := 1; c <= n; c++ { + for b := 1; b <= c; b++ { + for a := 1; a <= b; a++ { + if (gcd(gcd(a, b), c) == 1) { + p := a + b + c + s := float64(p) / 2.0 + area := math.Sqrt(s * (s - float64(a)) * (s - float64(b)) * (s - float64(c))) + if (is_heron(area)) { + l = append(l, []int{a, b, c, p, int(area)}) + } + } + } + } + } + + fmt.Printf("Number of primitive Heronian triangles with sides up to %d: %d", n, len(l)) + sort.Sort(by_area_perimeter(l)) + fmt.Printf("\n\nFirst ten when ordered by increasing area, then perimeter:" + header) + for i := 0; i < 10; i++ { fmt.Printf("\n%3d", l[i]) } + + a := 210 + fmt.Printf("\n\nArea = %d%s", a, header) + for _, it := range l { + if (it[4] == a) { + fmt.Printf("\n%3d", it) + } + } +} diff --git a/Task/Heronian-triangles/Java/heronian-triangles.java b/Task/Heronian-triangles/Java/heronian-triangles.java new file mode 100644 index 0000000000..5b58d0be0e --- /dev/null +++ b/Task/Heronian-triangles/Java/heronian-triangles.java @@ -0,0 +1,77 @@ +import java.util.ArrayList; + +public class Heron { + public static void main(String[] args) { + ArrayList list = new ArrayList<>(); + + for (int c = 1; c <= 200; c++) { + for (int b = 1; b <= c; b++) { + for (int a = 1; a <= b; a++) { + + if (gcd(gcd(a, b), c) == 1 && isHeron(heronArea(a, b, c))){ + int area = (int) heronArea(a, b, c); + list.add(new int[]{a, b, c, a + b + c, area}); + } + } + } + } + sort(list); + + System.out.printf("Number of primitive Heronian triangles with sides up " + + "to 200: %d\n\nFirst ten when ordered by increasing area, then" + + " perimeter:\nSides Perimeter Area", list.size()); + + for (int i = 0; i < 10; i++) { + System.out.printf("\n%d x %d x %d %d %d", + list.get(i)[0], list.get(i)[1], list.get(i)[2], + list.get(i)[3], list.get(i)[4]); + } + + System.out.printf("\n\nArea = 210\nSides Perimeter Area"); + for (int i = 0; i < list.size(); i++) { + if (list.get(i)[4] == 210) + System.out.printf("\n%d x %d x %d %d %d", + list.get(i)[0], list.get(i)[1], list.get(i)[2], + list.get(i)[3], list.get(i)[4]); + } + } + + public static double heronArea(int a, int b, int c) { + double s = (a + b + c) / 2f; + return Math.sqrt(s * (s - a) * (s - b) * (s - c)); + } + + public static boolean isHeron(double h) { + return h % 1 == 0 && h > 0; + } + + public static int gcd(int a, int b) { + int leftover = 1, dividend = a > b ? a : b, divisor = a > b ? b : a; + while (leftover != 0) { + leftover = dividend % divisor; + if (leftover > 0) { + dividend = divisor; + divisor = leftover; + } + } + return divisor; + } + + public static void sort(ArrayList list) { + boolean swapped = true; + int[] temp; + while (swapped) { + swapped = false; + for (int i = 1; i < list.size(); i++) { + if (list.get(i)[4] < list.get(i - 1)[4] || + list.get(i)[4] == list.get(i - 1)[4] && + list.get(i)[3] < list.get(i - 1)[3]) { + temp = list.get(i); + list.set(i, list.get(i - 1)); + list.set(i - 1, temp); + swapped = true; + } + } + } + } +} diff --git a/Task/Heronian-triangles/JavaScript/heronian-triangles-2.js b/Task/Heronian-triangles/JavaScript/heronian-triangles-2.js index c4aad17b75..88cb16834d 100644 --- a/Task/Heronian-triangles/JavaScript/heronian-triangles-2.js +++ b/Task/Heronian-triangles/JavaScript/heronian-triangles-2.js @@ -1,23 +1,82 @@ -Primitive Heronian triangles with sides up to 200: 517 +(function (n) { -First ten when ordered by increasing area, then perimeter: -Sides Perimeter Area -3 x 4 x 5 12 6 -5 x 5 x 6 16 12 -5 x 5 x 8 18 12 -4 x 13 x 15 32 24 -5 x 12 x 13 30 30 -9 x 10 x 17 36 36 -3 x 25 x 26 54 36 -7 x 15 x 20 42 42 -10 x 13 x 13 36 60 -8 x 15 x 17 40 60 + var chain = function (xs, f) { // Monadic bind/chain + return [].concat.apply([], xs.map(f)); + }, -Area = 210 -Sides Perimeter Area -17 x 25 x 28 70 210 -20 x 21 x 29 70 210 -12 x 35 x 37 84 210 -17 x 28 x 39 84 210 -7 x 65 x 68 140 210 -3 x 148 x 149 300 210 + hArea = function (x, y, z) { + var s = (x + y + z) / 2, + a = s * (s - x) * (s - y) * (s - z); + return a ? Math.sqrt(a) : 0; + }, + + gcd = function (m, n) { return n ? gcd(n, m % n) : m; }, + + rng = function (m, n) { + return Array.apply(null, Array(n - m + 1)).map(function (x, i) { + return m + i; + }); + }, + + sum = function (a, x) { return a + x; }; + + // DEFINING THE SORTED SUB-SET IN TERMS OF A LIST MONAD + + var lstHeron = chain( rng(1, n), function (x) { + return chain( rng(x, n), function (y) { + return chain( rng(y, n), function (z) { + + return ( + (x + y > z) && + gcd(gcd(x, y), z) === 1 && // Primitive. + (function () { // Heronian. + var a = hArea(x, y, z); + return a && (a === parseInt(a, 10)) + })() + ) ? [[x, y, z]] : []; // Monadic inject or fail + + })})}).sort(function (a, b) { + var dArea = hArea.apply(null, a) - hArea.apply(null, b); + if (dArea) return dArea; + else { + var dPerim = a.reduce(sum, 0) - b.reduce(sum, 0); + return dPerim ? dPerim : (a[2] - b[2]); + } + }); + + // OUPUT FORMATTED AS TWO WIKITABLES + + var lstColumns = ['Sides Perimeter Area'.split(' ')], + fnData = function (lst) { + return [JSON.stringify(lst), lst.reduce(sum, 0), hArea.apply(null, lst)]; + }, + wikiTable = function (lstRows, blnHeaderRow, strStyle) { + return '{| class="wikitable" ' + ( + strStyle ? 'style="' + strStyle + '"' : '' + ) + lstRows.map(function (lstRow, iRow) { + var strDelim = ((blnHeaderRow && !iRow) ? '!' : '|'); + + return '\n|-\n' + strDelim + ' ' + lstRow.map(function (v) { + return typeof v === 'undefined' ? ' ' : v; + }).join(' ' + strDelim + strDelim + ' '); + }).join('') + '\n|}'; + }; + + return 'Found: ' + lstHeron.length + + ' primitive Heronian triangles with sides up to ' + n + '.\n\n' + + '(Showing first 10, sorted by increasing area, ' + + 'perimeter, and longest side)\n\n' + + wikiTable( + lstColumns.concat(lstHeron.slice(0, 10).map(fnData)), + true + ) + '\n\n' + + 'All primitive Heronian triangles in this range where area = 210\n' + + '\n(also in order of increasing perimeter and longest side)\n\n' + + wikiTable( + lstColumns.concat(lstHeron.filter(function (x) { + return 210 === hArea.apply(null, x); + }).map(fnData)), + true + ) + '\n\n'; + +})(200); diff --git a/Task/Heronian-triangles/Kotlin/heronian-triangles.kotlin b/Task/Heronian-triangles/Kotlin/heronian-triangles.kotlin new file mode 100644 index 0000000000..65d15e2d6f --- /dev/null +++ b/Task/Heronian-triangles/Kotlin/heronian-triangles.kotlin @@ -0,0 +1,64 @@ +import java.util.* + +object Heron { + private val n = 200 + + fun run() { + val l = ArrayList() + for (c in 1..n) + for (b in 1..c) + for (a in 1..b) + if (gcd(gcd(a, b), c) == 1) { + val p = a + b + c + val s = p / 2.0 + val area = Math.sqrt(s * (s - a) * (s - b) * (s - c)) + if (isHeron(area)) + l.add(intArrayOf(a, b, c, p, area.toInt())) + } + print("Number of primitive Heronian triangles with sides up to $n: " + l.size) + + sort(l) + print("\n\nFirst ten when ordered by increasing area, then perimeter:" + header) + for (i in 0..10 - 1) { + print(format(l[i])) + } + val a = 210 + print("\n\nArea = $a" + header) + l.filter { it[4] == a }.forEach { print(format(it)) } + } + + private fun gcd(a: Int, b: Int): Int { + var leftover = 1 + var dividend = if (a > b) a else b + var divisor = if (a > b) b else a + while (leftover != 0) { + leftover = dividend % divisor + if (leftover > 0) { + dividend = divisor + divisor = leftover + } + } + return divisor + } + + fun sort(l: MutableList) { + var swapped = true + while (swapped) { + swapped = false + for (i in 1..l.size - 1) + if (l[i][4] < l[i - 1][4] || l[i][4] == l[i - 1][4] && l[i][3] < l[i - 1][3]) { + val temp = l[i] + l[i] = l[i - 1] + l[i - 1] = temp + swapped = true + } + } + } + + private fun isHeron(h: Double) = h.mod(1) == 0.0 && h > 0 + + private val header = "\nSides Perimeter Area" + private fun format(a: IntArray) = "\n%3d x %3d x %3d %5d %10d".format(a[0], a[1], a[2], a[3], a[4]) +} + +fun main(args: Array) = Heron.run() diff --git a/Task/Heronian-triangles/Lua/heronian-triangles.lua b/Task/Heronian-triangles/Lua/heronian-triangles.lua new file mode 100644 index 0000000000..7a70424082 --- /dev/null +++ b/Task/Heronian-triangles/Lua/heronian-triangles.lua @@ -0,0 +1,61 @@ +-- Returns the details of the Heronian Triangle with sides a, b, c or nil if it isn't one +local function tryHt( a, b, c ) + local result + local s = ( a + b + c ) / 2; + local areaSquared = s * ( s - a ) * ( s - b ) * ( s - c ); + if areaSquared > 0 then + -- a, b, c does form a triangle + local area = math.sqrt( areaSquared ); + if math.floor( area ) == area then + -- the area is integral so the triangle is Heronian + result = { a = a, b = b, c = c, perimeter = a + b + c, area = area } + end + end + return result +end + +-- Returns the GCD of a and b +local function gcd( a, b ) return ( b == 0 and a ) or gcd( b, a % b ) end + +-- Prints the details of the Heronian triangle t +local function htPrint( t ) print( string.format( "%4d %4d %4d %4d %4d", t.a, t.b, t.c, t.area, t.perimeter ) ) end +-- Prints headings for the Heronian Triangle table +local function htTitle() print( " a b c area perimeter" ); print( "---- ---- ---- ---- ---------" ) end + +-- Construct ht as a table of the Heronian Triangles with sides up to 200 +local ht = {}; +for c = 1, 200 do + for b = 1, c do + for a = 1, b do + local t = gcd( gcd( a, b ), c ) == 1 and tryHt( a, b, c ); + if t then + ht[ #ht + 1 ] = t + end + end + end +end + +-- sort the table on ascending area, perimiter and max side length +-- note we constructed the triangles with c as the longest side +table.sort( ht, function( a, b ) + return a.area < b.area or ( a.area == b.area + and ( a.perimeter < b.perimeter + or ( a.perimiter == b.perimiter + and a.c < b.c + ) + ) + ) + end + ); + +-- Display the triangles +print( "There are " .. #ht .. " Heronian triangles with sides up to 200" ); +htTitle(); +for htPos = 1, 10 do htPrint( ht[ htPos ] ) end +print( " ..." ); +print( "Heronian triangles with area 210:" ); +htTitle(); +for htPos = 1, #ht do + local t = ht[ htPos ]; + if t.area == 210 then htPrint( t ) end +end diff --git a/Task/Heronian-triangles/Pascal/heronian-triangles.pascal b/Task/Heronian-triangles/Pascal/heronian-triangles.pascal new file mode 100644 index 0000000000..439569cb72 --- /dev/null +++ b/Task/Heronian-triangles/Pascal/heronian-triangles.pascal @@ -0,0 +1,101 @@ +program heronianTriangles ( input, output ); +type + (* record to hold details of a Heronian triangle *) + Heronian = record a, b, c, area, perimeter : integer end; + refHeronian = ^Heronian; + +var + + ht : array [ 1 .. 1000 ] of refHeronian; + htCount, htPos : integer; + a, b, c, i : integer; + lower, upper : integer; + k, h, t : refHeronian; + swapped : boolean; + + (* returns the details of the Heronian Triangle with sides a, b, c or nil if it isn't one *) + function tryHt( a, b, c : integer ) : refHeronian; + var + s, areaSquared, area : real; + t : refHeronian; + begin + s := ( a + b + c ) / 2; + areaSquared := s * ( s - a ) * ( s - b ) * ( s - c ); + t := nil; + if areaSquared > 0 then begin + (* a, b, c does form a triangle *) + area := sqrt( areaSquared ); + if trunc( area ) = area then begin + (* the area is integral so the triangle is Heronian *) + new(t); + t^.a := a; t^.b := b; t^.c := c; t^.area := trunc( area ); t^.perimeter := a + b + c + end + end; + tryHt := t + end (* tryHt *) ; + + (* returns the GCD of a and b *) + function gcd( a, b : integer ) : integer; + begin + if b = 0 then gcd := a else gcd := gcd( b, a mod b ) + end (* gcd *) ; + + (* prints the details of the Heronian triangle t *) + procedure htPrint( t : refHeronian ) ; begin writeln( t^.a:4, t^.b:5, t^.c:5, t^.area:5, t^.perimeter:10 ) end; + (* prints headings for the Heronian Triangle table *) + procedure htTitle ; begin writeln( ' a b c area perimeter' ); writeln( '---- ---- ---- ---- ---------' ) end; + +begin + (* construct ht as a table of the Heronian Triangles with sides up to 200 *) + htCount := 0; + for c := 1 to 200 do begin + for b := 1 to c do begin + for a := 1 to b do begin + if gcd( gcd( a, b ), c ) = 1 then begin + t := tryHt( a, b, c ); + if t <> nil then begin + htCount := htCount + 1; + ht[ htCount ] := t + end + end + end + end + end; + + (* sort the table on ascending area, perimeter and max side length *) + (* note we constructed the triangles with c as the longest side *) + lower := 1; + upper := htCount; + repeat + upper := upper - 1; + swapped := false; + for i := lower to upper do begin + h := ht[ i ]; + k := ht[ i + 1 ]; + if ( k^.area < h^.area ) or ( ( k^.area = h^.area ) + and ( ( k^.perimeter < h^.perimeter ) + or ( ( k^.perimeter = h^.perimeter ) + and ( k^.c < h^.c ) + ) + ) + ) + then begin + ht[ i ] := k; + ht[ i + 1 ] := h; + swapped := true + end + end; + until not swapped; + + (* display the triangles *) + writeln( 'There are ', htCount:1, ' Heronian triangles with sides up to 200' ); + htTitle; + for htPos := 1 to 10 do htPrint( ht[ htPos ] ); + writeln( ' ...' ); + writeln( 'Heronian triangles with area 210:' ); + htTitle; + for htPos := 1 to htCount do begin + t := ht[ htPos ]; + if t^.area = 210 then htPrint( t ) + end +end. diff --git a/Task/Heronian-triangles/REXX/heronian-triangles-1.rexx b/Task/Heronian-triangles/REXX/heronian-triangles-1.rexx index 4cd799acf9..eb6ab32e13 100644 --- a/Task/Heronian-triangles/REXX/heronian-triangles-1.rexx +++ b/Task/Heronian-triangles/REXX/heronian-triangles-1.rexx @@ -1,50 +1,50 @@ -/*REXX program generates primitive Heronian triangles by side length and area.*/ -parse arg N first area . /*get optional arguments from C.L.*/ -if N=='' | N==',' then N=200 /*Not specified? Then use default.*/ -if first=='' | first==',' then first= 10 /* " " " " " */ -if area=='' | area==',' then area=210 /* " " " " " */ -numeric digits 99; numeric digits max(9, 1+length(N**5)) /*ensure 'nuff digs.*/ -call Heron; HT='Heronian triangles' /*invoke the Heron subroutine. */ +/*REXX program generates & displays primitive Heronian triangles by side length and area*/ +parse arg N first area . /*obtain optional arguments from the CL*/ +if N=='' | N==',' then N=200 /*Not specified? Then use the default.*/ +if first=='' | first==',' then first= 10 /* " " " " " " */ +if area=='' | area==',' then area=210 /* " " " " " " */ +numeric digits 99; numeric digits max(9, 1+length(N**5)) /*ensure 'nuff decimal digits.*/ +call Heron; HT= 'Heronian triangles' /*invoke the Heron subroutine. */ say # ' primitive' HT "found with sides up to " N ' (inclusive).' -call show , 'listing of the first ' first ' primitive' HT":" -call show area, 'listing of the (above) found primitive' HT "with an area of " area -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -Heron: @.=0; #=0; minP=9e9; maxP=0; maxA=0; minA=9e9; Ln=length(N) /* _ */ - #.=0; #.2=1 #.3=1; #.7=1; #.8=1 /*digits ¬good √ */ - do a=3 to N /*start at a minimum side length of 3. */ - even= a//2==0 /*if A is even, B and C must be odd.*/ - do b=a+even to N by 1+even; ab=a+b /*AB: is a shortcut sum.*/ - if b//2==0 then bump=1 /*B is even? Then C≡odd.*/ - else if even then bump=0 /*A is even? " " " */ - else bump=1 /*A & B odd, biz as usual*/ - do c=b+bump to N by 2; s=(ab+c)%2 /*calculate ½perimeter: S*/ - _=s*(s-a)*(s-b)*(s-c); if _<=0 then iterate /*_ isn't positive, skip.*/ - parse var _ '' -1 z ; if #.z then iterate /*last dig ¬square, skip.*/ - ar=hIsqrt(_); if ar*ar\==_ then iterate /*area ¬ an integer,skip.*/ - if hGCD(a,b,c)\==1 then iterate /*GCD of sides ¬ 1, skip.*/ - #=#+1; p=ab+c /*primitive Heron triang.*/ - minP=min( p,minP); maxP=max( p,maxP); Lp=length(maxP) - minA=min(ar,minA); maxA=max(ar,maxA); La=length(maxA) - _=@.ar.p.0+1 /*bump triangle counter. */ - @.ar.p.0=_; @.ar.p._=right(a,Ln) right(b,Ln) right(c,Ln) /*unique.*/ - end /*c*/ /* [↑] keep each unique perimeter #. */ +call show , 'Listing of the first ' first ' primitive' HT":" +call show area, 'Listing of the (above) found primitive' HT "with an area of " area +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +Heron: @.=0; minP=9e9; maxP=0; maxA=0; minA=9e9; Ln=length(N) /* __*/ + #=0; #.=0; #.2=1; #.3=1; #.7=1; #.8=1 /*digits ¬good √ */ + do a=3 to N /*start at a minimum side length of 3. */ + even= a//2==0 /*if A is even, B and C must be odd.*/ + do b=a+even to N by 1+even; ab=a + b /*AB: is a "shortcut" sum. */ + if b//2==0 then bump=1 /*B is even? Then C is odd. */ + else if even then bump=0 /*A is even? " " " " */ + else bump=1 /*A & B odd, then biz as usual. */ + do c=b+bump to N by 2; s=(ab+c)%2 /*calculate ½ of the perimeter: S */ + _=s*(s-a)*(s-b)*(s-c); if _<=0 then iterate /*is _ not positive? Skip it*/ + parse var _ '' -1 z ; if #.z then iterate /*Last digit not square? Skip it*/ + ar=hIsqrt(_); if ar*ar\==_ then iterate /*Is area not an integer? Skip it*/ + if hGCD(a, b, c)\==1 then iterate /*GCD of sides not equal 1? Skip it*/ + #=#+1; p=ab+c /*primitive Heronian triangle. */ + minP=min( p, minP); maxP=max( p, maxP); Lp=length(maxP) + minA=min(ar, minA); maxA=max(ar, maxA); La=length(maxA) + _=@.ar.p.0 + 1 /*bump Heronian triangle counter. */ + @.ar.p.0=_; @.ar.p._=right(a, Ln) right(b, Ln) right(c, Ln) /*unique. */ + end /*c*/ /* [↑] keep each unique perimeter#*/ end /*b*/ end /*a*/ -return # /*return number of Heronian triangles. */ +return # /*return number of Heronian triangles. */ /*────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/ hGCD: procedure; parse arg x; do j=2 for 2; y=arg(j); do until y==0; parse value x//y y with y x; end; end; return x -/*────────────────────────────────────────────────────────────────────────────*/ -hIsqrt: procedure; parse arg x; q=1;r=0; do while q<=x; q=q*4; end; do while q>1 - q=q%4; _=x-r-q; r=r%2; if _>=0 then parse value _ r+q with x r; end; return r -/*────────────────────────────────────────────────────────────────────────────*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +hIsqrt: procedure; parse arg x; q=1; r=0; do while q<=x; q=q*4; end; do while q>1 + q=q%4; _=x-r-q; r=r%2; if _>=0 then parse value _ r+q with x r; end; return r +/*──────────────────────────────────────────────────────────────────────────────────────*/ show: m=0; say; say; parse arg ae; say arg(2); if ae\=='' then first=9e9 -say; $=left('',9); $a=$"area:"; $p=$'perimeter:'; $s=$"sides:" /*literals*/ - do i=minA to maxA; if ae\=='' & i\==ae then iterate /*= area? */ - do j=minP to maxP until m>=first /*only display the FIRST entries.*/ - do k=1 for @.i.j.0; m=m+1 /*display each perimeter entry. */ - say right(m,9) $a right(i,La) $p right(j,Lp) $s @.i.j.k - end /*k*/ - end /*j*/ /* [↑] use the known perimeters. */ - end /*i*/ /* [↑] show any found triangles. */ -return + say; $=left('',9); $a=$"area:"; $p=$'perimeter:'; $s=$"sides:" /*literals*/ + do i=minA to maxA; if ae\=='' & i\==ae then iterate /*= area? */ + do j=minP to maxP until m>=first /*only display the FIRST entries.*/ + do k=1 for @.i.j.0; m=m+1 /*display each perimeter entry. */ + say right(m,9) $a right(i, La) $p right(j, Lp) $s @.i.j.k + end /*k*/ + end /*j*/ /* [↑] use the known perimeters. */ + end /*i*/ /* [↑] show any found triangles. */ + return diff --git a/Task/Heronian-triangles/REXX/heronian-triangles-2.rexx b/Task/Heronian-triangles/REXX/heronian-triangles-2.rexx index c1fbc55e34..627b0ec4bc 100644 --- a/Task/Heronian-triangles/REXX/heronian-triangles-2.rexx +++ b/Task/Heronian-triangles/REXX/heronian-triangles-2.rexx @@ -1,46 +1,45 @@ -/*REXX program generates primitive Heronian triangles by side length and area.*/ -parse arg N first area . /*get optional arguments from C.L.*/ -if N=='' | N==',' then N=200 /*Not specified? Then use default.*/ -if first=='' | first==',' then first= 10 /* " " " " " */ -if area=='' | area==',' then area=210 /* " " " " " */ -numeric digits 99; numeric digits max(9, 1+length(N**5)) /*ensure 'nuff digs.*/ -call Heron; HT='Heronian triangles' /*invoke the Heron subroutine. */ +/*REXX program generates & displays primitive Heronian triangles by side length and area*/ +parse arg N first area . /*obtain optional arguments from the CL*/ +if N=='' | N==',' then N=200 /*Not specified? Then use the default.*/ +if first=='' | first==',' then first= 10 /* " " " " " " */ +if area=='' | area==',' then area=210 /* " " " " " " */ +numeric digits 99; numeric digits max(9, 1+length(N**5)) /*ensure 'nuff decimal digits.*/ +call Heron; HT= 'Heronian triangles' /*invoke the Heron subroutine. */ say # ' primitive' HT "found with sides up to " N ' (inclusive).' -call show , 'listing of the first ' first ' primitive' HT":" -call show area, 'listing of the (above) found primitive' HT "with an area of " area -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -Heron: @.=0; #=0; !.=.; minP=9e9; maxA=0; maxP=0; minA=9e9; Ln=length(N) - do i=5 for N**2%2; _=i*i; !._=i; end /*pre-calculate fast √. */ - do a=3 to N /*start at a minimum side length of 3. */ - even= a//2==0 /*if A is even, B and C must be odd.*/ - do b=a+even to N by 1+even; ab=a+b /*AB: is a shortcut sum.*/ - if b//2==0 then bump=1 /*B is even? Then C≡odd.*/ - else if even then bump=0 /*A is even? " " " */ - else bump=1 /*A & B odd, biz as usual*/ - do c=b+bump to N by 2; s=(ab+c)%2 /*calculate Perimeter, S.*/ - _=s*(s-a)*(s-b)*(s-c); if !._==. then iterate /*_ isn't a square, skip.*/ - ar=!._; if ar*ar\==_ then iterate /*area ¬ an integer,skip.*/ - if hGCD(a,b,c)\==1 then iterate /*GCD of sides ¬ 1, skip.*/ - #=#+1; p=ab+c /*primitive Heron triang.*/ +call show , 'Listing of the first ' first ' primitive' HT":" +call show area, 'Listing of the (above) found primitive' HT "with an area of " area +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +Heron: @.=0; #=0; !.=.; minP=9e9; maxA=0; maxP=0; minA=9e9; Ln=length(N) /* __ */ + do i=5 to N**2%2; _=i*i; !._=i; end /*pre-calculate a fast √ */ + do a=3 to N /*start at a minimum side length of 3. */ + even= a//2==0 /*if A is even, B and C must be odd.*/ + do b=a+even to N by 1+even; ab=a+b /*AB: is a shortcut sum. */ + if b//2==0 then bump=1 /*B is even? Then C is odd. */ + else if even then bump=0 /*A is even? " " " " */ + else bump=1 /*A & B odd, biz as usual. */ + do c=b+bump to N by 2; s=(ab+c)%2 /*calculate perimeter: S. */ + _=s*(s-a)*(s-b)*(s-c); if !._==. then iterate /*Is _ not a square? Skip.*/ + ar=!._; if ar*ar\==_ then iterate /*Area not an integer? Skip.*/ + if hGCD(a,b,c)\==1 then iterate /*GCD of sides not 1? Skip.*/ + #=#+1; p=ab+c /*primitive Heronian triangle*/ minP=min( p,minP); maxP=max( p,maxP); Lp=length(maxP) minA=min(ar,minA); maxA=max(ar,maxA); La=length(maxA); @.ar= - _=@.ar.p.0+1 /*bump triangle counter. */ + _=@.ar.p.0+1 /*bump the triangle counter.*/ @.ar.p.0=_; @.ar.p._=right(a,Ln) right(b,Ln) right(c,Ln) /*unique.*/ - end /*c*/ /* [↑] keep each unique perimeter #. */ + end /*c*/ /* [↑] keep each unique perimeter #. */ end /*b*/ end /*a*/ -return # /*return number of Heronian triangles. */ +return # /*return number of Heronian triangles. */ /*────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/ hGCD: procedure; parse arg x; do j=2 for 2; y=arg(j); do until y==0; parse value x//y y with y x; end; end; return x -/*────────────────────────────────────────────────────────────────────────────*/ -show: m=0; say; say; parse arg ae; say arg(2); if ae\=='' then first=9e9 -say; $=left('',9); $a=$"area:"; $p=$'perimeter:'; $s=$"sides:" /*literals*/ - do i=minA to maxA; if ae\=='' & i\==ae then iterate /*= area? */ - do j=minP to maxP until m>=first /*only display the FIRST entries.*/ - do k=1 for @.i.j.0; m=m+1 /*display each perimeter entry. */ - say right(m,9) $a right(i,La) $p right(j,Lp) $s @.i.j.k - end /*k*/ - end /*j*/ /* [↑] use the known perimeters. */ - end /*i*/ /* [↑] show any found triangles. */ -return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +show: m=0; say; say; parse arg ae; say arg(2); if ae\=='' then first=9e9 + say; $=left('',9); $a=$"area:"; $p=$'perimeter:'; $s=$"sides:" /*literals*/ + do i=minA to maxA; if ae\=='' & i\==ae then iterate /*= area? */ + do j=minP to maxP until m>=first /*only display the FIRST entries.*/ + do k=1 for @.i.j.0; m=m+1 /*display each perimeter entry. */ + say right(m,9) $a right(i, La) $p right(j, Lp) $s @.i.j.k + end /*k*/ + end /*j*/ /* [↑] use the known perimeters. */ + end /*i*/ /* [↑] show any found triangles. */ diff --git a/Task/Hickerson-series-of-almost-integers/ALGOL-68/hickerson-series-of-almost-integers.alg b/Task/Hickerson-series-of-almost-integers/ALGOL-68/hickerson-series-of-almost-integers.alg new file mode 100644 index 0000000000..25adde7947 --- /dev/null +++ b/Task/Hickerson-series-of-almost-integers/ALGOL-68/hickerson-series-of-almost-integers.alg @@ -0,0 +1,37 @@ +# determine whether the first few Hickerson numbers really are "near integers" # +# The Hickerson number n is defined by: h(n) = n! / ( 2 * ( (ln 2)^(n+1) ) ) # +# so: h(1) = 1 / ( 2 * ( ( ln 2 ) ^ 2 ) # +# and: h(n) = ( n / ln 2 ) * h(n-1) # + +# set the precision of LONG LONG numbers # +PR precision 100 PR + +# calculate the Hickerson numbers # +LONG LONG REAL ln2 = long long ln( 2 ); +[ 1 : 18 ]LONG LONG REAL h; + +h[ 1 ] := 0.5 / ( ln2 * ln2 ); +FOR n FROM 2 TO UPB h +DO + h[ n ] := ( n * h[ n - 1 ] ) / ln2 +OD; + +# determine the first digit after the point in each h(n) - if it is 0 or 9 # +# the number is a "near integer" # + +FOR n TO UPB h +DO + INT first decimal = SHORTEN SHORTEN ( ( ENTIER ( h[ n ] * 10 ) ) MOD 10 ); + print( ( whole( n, -4 ) + , " " + , fixed( h[ n ], 40, 4 ) + , IF first decimal = 0 OR first decimal = 9 + THEN + " a near integer" + ELSE + " NOT a near integer" + FI + , newline + ) + ) +OD diff --git a/Task/Hickerson-series-of-almost-integers/Haskell/hickerson-series-of-almost-integers.hs b/Task/Hickerson-series-of-almost-integers/Haskell/hickerson-series-of-almost-integers.hs index 46865413ad..954daf1ce3 100644 --- a/Task/Hickerson-series-of-almost-integers/Haskell/hickerson-series-of-almost-integers.hs +++ b/Task/Hickerson-series-of-almost-integers/Haskell/hickerson-series-of-almost-integers.hs @@ -1,14 +1,18 @@ import Data.Number.CReal -- from numbers -hickerson :: Int -> CReal +import qualified Data.Number.CReal as C + +hickerson :: Int -> C.CReal hickerson n = (fromIntegral $ product [1..n]) / (2 * (log 2 ^ (n + 1))) +charAfter :: Char -> String -> Char +charAfter ch string = ( dropWhile (/= ch) string ) !! 1 + +isAlmostInteger :: C.CReal -> Bool +isAlmostInteger = (`elem` ['0', '9']) . charAfter '.' . show + checkHickerson :: Int -> String -checkHickerson n = - let h = hickerson n - postDecimalPointDigit = dropWhile (/='.') (show h) !! 1 - almostIntegral = '0' == postDecimalPointDigit || '9' == postDecimalPointDigit - in "h(" ++ show n ++ ") = " ++ showCReal 4 h ++ " which is" ++ (if almostIntegral then "" else " NOT") ++ " almost integral." +checkHickerson n = show $ (n, hickerson n, isAlmostInteger $ hickerson n) main :: IO () -main = mapM_ putStrLn [checkHickerson n | n <- [1..18]] +main = mapM_ putStrLn $ map checkHickerson [1..18] diff --git a/Task/Hickerson-series-of-almost-integers/Java/hickerson-series-of-almost-integers.java b/Task/Hickerson-series-of-almost-integers/Java/hickerson-series-of-almost-integers.java new file mode 100644 index 0000000000..1f8a2941cf --- /dev/null +++ b/Task/Hickerson-series-of-almost-integers/Java/hickerson-series-of-almost-integers.java @@ -0,0 +1,27 @@ +import java.math.*; + +public class Hickerson { + + final static String LN2 = "0.693147180559945309417232121458"; + + public static void main(String[] args) { + for (int n = 1; n <= 17; n++) + System.out.printf("%2s is almost integer: %s%n", n, almostInteger(n)); + } + + static boolean almostInteger(int n) { + BigDecimal a = new BigDecimal(LN2); + a = a.pow(n + 1).multiply(BigDecimal.valueOf(2)); + + long f = n; + while (--n > 1) + f *= n; + + BigDecimal b = new BigDecimal(f); + b = b.divide(a, MathContext.DECIMAL128); + + BigInteger c = b.movePointRight(1).toBigInteger().mod(BigInteger.TEN); + + return c.toString().matches("0|9"); + } +} diff --git a/Task/Hickerson-series-of-almost-integers/REXX/hickerson-series-of-almost-integers-2.rexx b/Task/Hickerson-series-of-almost-integers/REXX/hickerson-series-of-almost-integers-2.rexx index 6520719ca8..88c5aab66c 100644 --- a/Task/Hickerson-series-of-almost-integers/REXX/hickerson-series-of-almost-integers-2.rexx +++ b/Task/Hickerson-series-of-almost-integers/REXX/hickerson-series-of-almost-integers-2.rexx @@ -1,17 +1,20 @@ /*REXX program to calculate and show the Hickerson series (are near integer). */ -numeric digits 250 /*be able to calculate big factorials. */ +numeric digits length(ln2()) - 1 /*be able to calculate big factorials. */ parse arg N . /*get optional number of values to use.*/ -if N=='' then N=18 /*Not specified? Then use the default. */ - /* [+] compute possible Hickerson #s. */ +if N=='' then N=18 /*Not specified? Then use the default.*/ + /* [↓] compute possible Hickerson #s. */ do j=1 for N; #=Hickerson(j) /*traipse thru a range of Hickerson #s.*/ - t=#*10%1; ?=right(t, 1) /*massage number to obtain FDD past DP.*/ - if ?==0 | ?==9 then _= '(almost an integer)' /*da number is, */ - else _= ' ' /* or it ain't. */ - say right(j,3) _ format(#,,5) /*show the number with 9 decimal digits*/ - end /*j*/ /*FDD=1st decimal digit past dec. point*/ + ?=right(#*10%1, 1) /*get 1st decimal digit past dec. point*/ + if ?==0 | ?==9 then _= 'almost integer' /*the number is, */ + else _= ' ' /* or it ain't. */ + say right(j,3) _ format(#,,5) /*show number with 5 dec digs fraction.*/ + end /*j*/ exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────one─liner subroutines─────────────────────*/ -!: procedure; parse arg x; !=1; do j=2 to x; !=!*j; end; return ! /* ◄─── compute the factorial of X. */ -Hickerson: procedure; parse arg z; return !(z) / (2*ln2() ** (z+1)) -ln2: return .6931471805599453094172321214581765680755001343602552541206800094933936219696947156058633269964186875420014, - || 81020570685733685520235758130557032670751635075961930727570828371435190307038623891673471123350115364497955239120475 +/*─────────────────────────────────────────────────────────────────────────────────────────────────────────*/ +!: procedure; parse arg x; !=1; do j=2 to x; !=!*j; end; return ! /* ◄──compute X factorial*/ +Hickerson: procedure; parse arg z; return !(z) / (2*ln2() ** (z+1)) +ln2: return .69314718055994530941723212145817656807550013436025525412068000949339362196969471560586332699641, + || 8687542001481020570685733685520235758130557032670751635075961930727570828371435190307038623891673471123, + || 3501153644979552391204751726815749320651555247341395258829504530070953263666426541042391578149520437404, + || 3038550080194417064167151864471283996817178454695702627163106454615025720740248163777338963855069526066, + || 83411372738737229289564935470257626520988596932019650585547647033067936544325476327449512504060694381470 diff --git a/Task/Hickerson-series-of-almost-integers/REXX/hickerson-series-of-almost-integers-3.rexx b/Task/Hickerson-series-of-almost-integers/REXX/hickerson-series-of-almost-integers-3.rexx new file mode 100644 index 0000000000..1524f1fae2 --- /dev/null +++ b/Task/Hickerson-series-of-almost-integers/REXX/hickerson-series-of-almost-integers-3.rexx @@ -0,0 +1,19 @@ +/*REXX program to calculate and show the Hickerson series (are near integer). */ +numeric digits length(ln2()) - 1 /*be able to calculate big factorials. */ +parse arg N . /*get optional number of values to use.*/ +if N=='' then N=18 /*Not specified? Then use the default.*/ +!=1 /* [↓] compute possible Hickerson #s. */ + do j=1 for N; #=Hickerson(j) /*traipse thru a range of Hickerson #s.*/ + ?=right(#*10%1, 1) /*get 1st decimal digit past dec. point*/ + if ?==0 | ?==9 then _= 'almost integer' /*the number is, */ + else _= ' ' /* or it ain't. */ + say right(j,3) _ format(#,,5) /*show number with 5 dec digs fraction.*/ + end /*j*/ +exit /*stick a fork in it, we're all done. */ +/*─────────────────────────────────────────────────────────────────────────────────────────────────────────*/ +Hickerson: parse arg z; !=!*z; return ! / (2*ln2() ** (z+1)) +ln2: return .69314718055994530941723212145817656807550013436025525412068000949339362196969471560586332699641, + || 8687542001481020570685733685520235758130557032670751635075961930727570828371435190307038623891673471123, + || 3501153644979552391204751726815749320651555247341395258829504530070953263666426541042391578149520437404, + || 3038550080194417064167151864471283996817178454695702627163106454615025720740248163777338963855069526066, + || 83411372738737229289564935470257626520988596932019650585547647033067936544325476327449512504060694381470 diff --git a/Task/Higher-order-functions/00DESCRIPTION b/Task/Higher-order-functions/00DESCRIPTION index 3f1af96ce2..680b2953f7 100644 --- a/Task/Higher-order-functions/00DESCRIPTION +++ b/Task/Higher-order-functions/00DESCRIPTION @@ -1,3 +1,7 @@ +;Task: Pass a function ''as an argument'' to another function. -C.f. [[First-class functions]] + +;Related task: +*   [[First-class functions]] +

    diff --git a/Task/Higher-order-functions/AppleScript/higher-order-functions.applescript b/Task/Higher-order-functions/AppleScript/higher-order-functions-1.applescript similarity index 67% rename from Task/Higher-order-functions/AppleScript/higher-order-functions.applescript rename to Task/Higher-order-functions/AppleScript/higher-order-functions-1.applescript index ea9cbcc149..8dbfde7e00 100644 --- a/Task/Higher-order-functions/AppleScript/higher-order-functions.applescript +++ b/Task/Higher-order-functions/AppleScript/higher-order-functions-1.applescript @@ -1,25 +1,25 @@ -- This handler takes a script object (singer) -- with another handler (call). on sing about topic by singer - call of singer for "Of " & topic & " I sing" + call of singer for "Of " & topic & " I sing" end sing -- Define a handler in a script object, -- then pass the script object. script cellos - on call for what - say what using "Cellos" - end call + on call for what + say what using "Cellos" + end call end script sing about "functional programming" by cellos -- Pass a different handler. This one is a closure -- that uses a variable (voice) from its context. on hire for voice - script - on call for what - say what using voice - end call - end script + script + on call for what + say what using voice + end call + end script end hire sing about "closures" by (hire for "Pipe Organ") diff --git a/Task/Higher-order-functions/AppleScript/higher-order-functions-2.applescript b/Task/Higher-order-functions/AppleScript/higher-order-functions-2.applescript new file mode 100644 index 0000000000..f19a156054 --- /dev/null +++ b/Task/Higher-order-functions/AppleScript/higher-order-functions-2.applescript @@ -0,0 +1,116 @@ +on run + -- PASSING FUNCTIONS AS ARGUMENTS TO + -- MAP, FOLD/REDUCE, AND FILTER, ACROSS A LIST + + set lstRange to {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10} + + map(squared, lstRange) + --> {0, 1, 4, 9, 16, 25, 36, 49, 64, 81, 100} + + foldl(summed, 0, map(squared, lstRange)) + --> 385 + + filter(isEven, lstRange) + --> {0, 2, 4, 6, 8, 10} + + + -- OR MAPPING OVER A LIST OF FUNCTIONS + + map(testFunction, {doubled, squared, isEven}) + + --> {{0, 2, 4, 6, 8, 10, 12, 14, 16, 18, 20}, + -- {0, 1, 4, 9, 16, 25, 36, 49, 64, 81, 100}, + -- {true, false, true, false, true, false, true, false, true, false, true}} +end run + +-- testFunction :: (a -> b) -> [b] +on testFunction(f) + map(f, {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10}) +end testFunction + + +-- MAP, REDUCE, FILTER + +-- Returns a new list consisting of the results of applying the +-- provided function to each element of the first list +-- 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 + +-- Applies a function against an accumulator and +-- each list element (from left-to-right) to reduce it +-- to a single return value + +-- In some languages, like JavaScript, this is called reduce() + +-- Arguments: function, initial value of accumulator, list +-- 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 + + +-- Sublist of those elements for which the predicate +-- function returns true +-- filter :: (a -> Bool) -> [a] -> [a] +-- 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 + +-- 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 + +-- HANDLER FUNCTIONS TO BE PASSED AS ARGUMENTS + +-- squared :: Number -> Number +on squared(x) + x * x +end squared + +-- doubled :: Number -> Number +on doubled(x) + x * 2 +end doubled + +-- summed :: Number -> Number -> Number +on summed(a, b) + a + b +end summed + +-- isEven :: Int -> Bool +on isEven(x) + x mod 2 = 0 +end isEven diff --git a/Task/Higher-order-functions/AppleScript/higher-order-functions-3.applescript b/Task/Higher-order-functions/AppleScript/higher-order-functions-3.applescript new file mode 100644 index 0000000000..ad900678db --- /dev/null +++ b/Task/Higher-order-functions/AppleScript/higher-order-functions-3.applescript @@ -0,0 +1,3 @@ +{{0, 2, 4, 6, 8, 10, 12, 14, 16, 18, 20}, +{0, 1, 4, 9, 16, 25, 36, 49, 64, 81, 100}, +{true, false, true, false, true, false, true, false, true, false, true}} diff --git a/Task/Higher-order-functions/AutoHotkey/higher-order-functions.ahk b/Task/Higher-order-functions/AutoHotkey/higher-order-functions.ahk index 12888d060f..2751f715c1 100644 --- a/Task/Higher-order-functions/AutoHotkey/higher-order-functions.ahk +++ b/Task/Higher-order-functions/AutoHotkey/higher-order-functions.ahk @@ -1,9 +1,15 @@ f(x) { -return x + return "This " . x } -g(x, y) { -msgbox %x% -msgbox %y% + +g(x) { + return "That " . x } -g(f("RC Function as an Argument AHK implementation"), "Non-function argument") + +show(fun) { + msgbox % %fun%("works") +} + +show(Func("f")) ; either create a Func object +show("g") ; or just name the function return diff --git a/Task/Higher-order-functions/Java/higher-order-functions.java b/Task/Higher-order-functions/Java/higher-order-functions-1.java similarity index 100% rename from Task/Higher-order-functions/Java/higher-order-functions.java rename to Task/Higher-order-functions/Java/higher-order-functions-1.java diff --git a/Task/Higher-order-functions/Java/higher-order-functions-2.java b/Task/Higher-order-functions/Java/higher-order-functions-2.java new file mode 100644 index 0000000000..cabec1214c --- /dev/null +++ b/Task/Higher-order-functions/Java/higher-order-functions-2.java @@ -0,0 +1,19 @@ +public class ListenerTest { + public static void main(String[] args) { + JButton testButton = new JButton("Test Button"); + testButton.addActionListener(new ActionListener(){ + @Override public void actionPerformed(ActionEvent ae){ + System.out.println("Click Detected by Anon Class"); + } + }); + + testButton.addActionListener(e -> System.out.println("Click Detected by Lambda Listner")); + + // Swing stuff + JFrame frame = new JFrame("Listener Test"); + frame.setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE); + frame.add(testButton, BorderLayout.CENTER); + frame.pack(); + frame.setVisible(true); + } +} diff --git a/Task/Higher-order-functions/Kotlin/higher-order-functions-1.kotlin b/Task/Higher-order-functions/Kotlin/higher-order-functions-1.kotlin new file mode 100644 index 0000000000..70d9b430df --- /dev/null +++ b/Task/Higher-order-functions/Kotlin/higher-order-functions-1.kotlin @@ -0,0 +1,7 @@ +fun main(args: Array) { + val list = listOf(1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0, 9.0, 10.0) + var a = list.map({ x -> x + 2 }).average() + var h = list.map({ x -> x * x }).average() + var g = list.map({ x -> x * x * x }).average() + println("A = %f G = %f H = %f".format(a, g, h)) +} diff --git a/Task/Higher-order-functions/Kotlin/higher-order-functions-2.kotlin b/Task/Higher-order-functions/Kotlin/higher-order-functions-2.kotlin new file mode 100644 index 0000000000..e277d82010 --- /dev/null +++ b/Task/Higher-order-functions/Kotlin/higher-order-functions-2.kotlin @@ -0,0 +1,6 @@ +inline fun higherOrderFunction(x: Int, y: Int, function: (Int, Int) -> Int) = function(x, y) + +fun main(args: Array) { + val result = higherOrderFunction(3, 5) { x, y -> x + y } + println(result) +} diff --git a/Task/Higher-order-functions/REXX/higher-order-functions.rexx b/Task/Higher-order-functions/REXX/higher-order-functions.rexx index f9778b7d4f..033cd9bdad 100644 --- a/Task/Higher-order-functions/REXX/higher-order-functions.rexx +++ b/Task/Higher-order-functions/REXX/higher-order-functions.rexx @@ -1,20 +1,18 @@ -/*REXX program demonstrates passing a function as a name to another function. */ - n=3735928559 -funcName = 'fib' ; q= 10; call someFunk funcName, q; call tell -funcName = 'fact' ; q= 6; call someFunk funcName, q; call tell -funcName = 'square' ; q= 13; call someFunk funcName, q; call tell -funcName = 'cube' ; q= 3; call someFunk funcName, q; call tell - q=721; call someFunk 'reverse',q; call tell -say copies('═', 30) /*display a nice separator fence */ -say 'done as' d2x(n)"." /*prove that variable N is still intact*/ -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────one─liner subroutines─────────────────────*/ +/*REXX program demonstrates passing a function (as a name) to another function. */ + n=3735928559 +funcName = 'fib' ; q= 10; call someFunk funcName, q; call tell +funcName = 'fact' ; q= 6; call someFunk funcName, q; call tell +funcName = 'square' ; q= 13; call someFunk funcName, q; call tell +funcName = 'cube' ; q= 3; call someFunk funcName, q; call tell + q=721; call someFunk 'reverse',q; call tell +say copies('═', 30) /*display a nice separator fence */ +say 'done as' d2x(n). /*prove that variable N is still intact*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ cube: return n**3 -fact: !=1; do j=2 to n; !=!*j; end; return ! +fact: !=1; do j=2 to n; !=!*j; end; return ! +fib: if n<2 then return n; _=0; a=0; b=1; do j=2 to n; _=a+b; a=b; b=_; end; return _ reverse: return 'REVERSE'(n) -someFunk: procedure; arg ?,n; signal value (?); say result 'result'; return +someFunk: procedure; arg ?,n; signal value (?); say result 'result'; return square: return n**2 -tell: say right(funcName'('q") = ",20) result; return -/*────────────────────────────────────────────────────────────────────────────*/ -fib: if n==0 | n==1 then return n; _=0; a=0; b=1 - do j=2 to n; _=a+b; a=b; b=_; end; return _ +tell: say right(funcName'('q") = ",20) result; return diff --git a/Task/Higher-order-functions/SuperCollider/higher-order-functions.supercollider b/Task/Higher-order-functions/SuperCollider/higher-order-functions.supercollider new file mode 100644 index 0000000000..782ac4d27a --- /dev/null +++ b/Task/Higher-order-functions/SuperCollider/higher-order-functions.supercollider @@ -0,0 +1,2 @@ +f = { |x, y| x.(y) }; // a function that takes a function and calls it with an argument +f.({ |x| x + 1 }, 5); // returns 5 diff --git a/Task/Higher-order-functions/ZX-Spectrum-Basic/higher-order-functions.zx b/Task/Higher-order-functions/ZX-Spectrum-Basic/higher-order-functions.zx new file mode 100644 index 0000000000..2efe18ed53 --- /dev/null +++ b/Task/Higher-order-functions/ZX-Spectrum-Basic/higher-order-functions.zx @@ -0,0 +1,3 @@ +10 DEF FN f(f$,x,y)=VAL ("FN "+f$+"("+STR$ (x)+","+STR$ (y)+")") +20 DEF FN n(x,y)=(x+y)^2 +30 PRINT FN f("n",10,11) diff --git a/Task/History-variables/00DESCRIPTION b/Task/History-variables/00DESCRIPTION index 4c0401a214..b5d8f38dcf 100644 --- a/Task/History-variables/00DESCRIPTION +++ b/Task/History-variables/00DESCRIPTION @@ -18,5 +18,6 @@ Demonstrate History variable support: * non-destructively display the history * recall the three values. -For extra points, if the language of choice does not support history variables, +
    For extra points, if the language of choice does not support history variables, demonstrate how this might be implemented. +

    diff --git a/Task/History-variables/AspectJ/history-variables-1.aspectj b/Task/History-variables/AspectJ/history-variables-1.aspectj index 7aa0bf2d55..b7fae1f37a 100644 --- a/Task/History-variables/AspectJ/history-variables-1.aspectj +++ b/Task/History-variables/AspectJ/history-variables-1.aspectj @@ -1,12 +1,13 @@ public class HistoryVariable { - public HistoryVariable(final Object v) + private Object value; + + public HistoryVariable(Object v) { - super(); value = v; } - public void update(final Object v) + public void update(Object v) { value = v; } @@ -25,6 +26,4 @@ public class HistoryVariable public void dispose() { } - - private Object value; } diff --git a/Task/History-variables/Common-Lisp/history-variables.lisp b/Task/History-variables/Common-Lisp/history-variables.lisp new file mode 100644 index 0000000000..42bd392f28 --- /dev/null +++ b/Task/History-variables/Common-Lisp/history-variables.lisp @@ -0,0 +1,23 @@ +(defmacro make-hvar (value) + `(list ,value)) + +(defmacro get-hvar (hvar) + `(car ,hvar)) + +(defmacro set-hvar (hvar value) + `(push ,value ,hvar)) + +;; Make sure that setf macro can be used +(defsetf get-hvar set-hvar) + +(defmacro undo-hvar (hvar) + `(pop ,hvar)) + +(let ((v (make-hvar 1))) + (format t "Initial value = ~a~%" (get-hvar v)) + (set-hvar v 2) + (setf (get-hvar v) 3) ;; Alternative using setf + (format t "Current value = ~a~%" (get-hvar v)) + (undo-hvar v) + (undo-hvar v) + (format t "Restored value = ~a~%" (get-hvar v))) diff --git a/Task/History-variables/REXX/history-variables-1.rexx b/Task/History-variables/REXX/history-variables-1.rexx index 4dc32bb869..c95377b847 100644 --- a/Task/History-variables/REXX/history-variables-1.rexx +++ b/Task/History-variables/REXX/history-variables-1.rexx @@ -1,22 +1,22 @@ -/*REXX pgm shows a method to track history of assignments to a REXX var.*/ -varset!.=0 /*initialize the whole shebang. */ -call varset 'fluid',min(0,-5/2,-1) ; say 'fluid=' fluid -call varset 'fluid',3.14159 ; say 'fluid=' fluid -call varset 'fluid',' Santa Claus' ; say 'fluid=' fluid -call varset 'fluid',,999 +/*REXX program demonstrates a method to track history of assignments to a REXX variable.*/ +varSet!.=0 /*initialize the all of the VARSET!'s. */ +call varSet 'fluid',min(0,-5/2,-1) ; say 'fluid=' fluid +call varSet 'fluid',3.14159 ; say 'fluid=' fluid +call varSet 'fluid',' Santa Claus' ; say 'fluid=' fluid +call varSet 'fluid',,999 say 'There were' result "assignments (sets) for the FLUID variable." -exit /*stick a fork in it, we're done.*/ -/*─────────────────────────────────────VARSET subroutine────────────────*/ -varset: arg ?x; parse arg ?z, ?v, ?L /*varName, value, optional-List. */ -if ?L=='' then do /*not list, so set the X variable*/ - ?_=varset!.0.?x+1 /*bump the history count (SETs). */ - varset!.0.?x=?_ /* ... and store it in "database"*/ - varset!.?_.?x=?v /* ... and store the SET value.*/ - call value(?x),?v /*now, set the real X variable.*/ - return ?v /*also, return the value for FUNC*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +varSet: arg ?x; parse arg ?z, ?v, ?L /*obtain varName, value, optional─List.*/ +if ?L=='' then do /*not la ist, so set the X variable.*/ + ?_=varSet!.0.?x+1 /*bump the history count (# of SETs). */ + varSet!.0.?x=?_ /* ... and store it in the "database"*/ + varSet!.?_.?x=?v /* ... and store the SET value. */ + call value(?x),?v /*now, set the real X variable. */ + return ?v /*also, return the value for function. */ end -say /*show blank line for readability*/ - do ?j=1 to ?L while ?j<=varset!.0.?x /*list "set" history.*/ - say 'history entry' ?j "for var" ?z":" varset!.?J.?x - end /*?j*/ -return ?j-1 /*return the num of assignments. */ +say /*show a blank line for readability. */ + do ?j=1 to ?L while ?j<=varSet!.0.?x /*display the list of "set" history. */ + say 'history entry' ?j "for var" ?z":" varSet!.?J.?x + end /*?j*/ +return ?j-1 /*return the number of assignments. */ diff --git a/Task/Hofstadter-Conway-$10,000-sequence/00DESCRIPTION b/Task/Hofstadter-Conway-$10,000-sequence/00DESCRIPTION index 66aa36c8d4..c1930ad70f 100644 --- a/Task/Hofstadter-Conway-$10,000-sequence/00DESCRIPTION +++ b/Task/Hofstadter-Conway-$10,000-sequence/00DESCRIPTION @@ -1,11 +1,12 @@ The definition of the sequence is colloquially described as: -* Starting with the list [1,1], -* Take the last number in the list so far: 1, I'll call it x. -* Count forward x places from the beginning of the list to find the first number to add (1) -* Count backward x places from the end of the list to find the second number to add (1) -* Add the two indexed numbers from the list and the result becomes the next number in the list (1+1) -* This would then produce [1,1,2] where 2 is the third element of the sequence. -Note that indexing for the description above starts from alternately the left and right ends of the list and starts from an index of ''one''. +*   Starting with the list [1,1], +*   Take the last number in the list so far: 1, I'll call it x. +*   Count forward x places from the beginning of the list to find the first number to add (1) +*   Count backward x places from the end of the list to find the second number to add (1) +*   Add the two indexed numbers from the list and the result becomes the next number in the list (1+1) +*   This would then produce [1,1,2] where 2 is the third element of the sequence. + +
    Note that indexing for the description above starts from alternately the left and right ends of the list and starts from an index of ''one''. A less wordy description of the sequence is: a(1)=a(2)=1 @@ -15,24 +16,29 @@ The sequence begins: 1, 1, 2, 2, 3, 4, 4, 4, 5, ... Interesting features of the sequence are that: -* a(n)/n tends to 0.5 as n grows towards infinity. -* a(n)/n where n is a power of 2 is 0.5 -* For n>4 the maximal value of a(n)/n between successive powers of 2 decreases. +*   a(n)/n   tends to   0.5   as   n   grows towards infinity. +*   a(n)/n   where   n   is a power of   2   is   0.5 +*   For   n>4   the maximal value of   a(n)/n   between successive powers of 2 decreases. + +[[File:Hofstadter conway 10K.gif|center|a(n) / n   for   n   in   1..256]] -[[File:Hofstadter conway 10K.gif|center|a(n) / n for n in 1..256]]
    The sequence is so named because [[wp:John Horton Conway|John Conway]] [http://www.nytimes.com/1988/08/30/science/intellectual-duel-brash-challenge-swift-response.html offered a prize] of $10,000 to the first person who could -find the first position, p in the sequence where - |a(n)/n| < 0.55 for all n > p. +find the first position,   p   in the sequence where + │a(n)/n│ < 0.55 for all n > p It was later found that [[wp:Douglas Hofstadter|Hofstadter]] had also done prior work on the sequence. -The 'prize' was won quite quickly by [http://www.research.avayalabs.com/gcm/usa/en-us/people/all/mallows.htm Dr. Colin L. Mallows] who proved the properties of the sequence and allowed him to find the value of n. (Which is much smaller than the 3,173,375,556. quoted in the NYT article) +The 'prize' was won quite quickly by [http://www.research.avayalabs.com/gcm/usa/en-us/people/all/mallows.htm Dr. Colin L. Mallows] who proved the properties of the sequence and allowed him to find the value of   n   (which is much smaller than the 3,173,375,556 quoted in the NYT article). -
    '''The task is to:''' -# Create a routine to generate members of the Hofstadter-Conway $10,000 sequence. -# Use it to show the maxima of a(n)/n between successive powers of two up to 2**20 -# As a stretch goal: Compute the value of n that would have won the prize and confirm it is true for n up to 2**20 -References: -* [http://www.jstor.org/stable/2324028 Conways Challenge Sequence], Mallows' own account. -* [http://mathworld.wolfram.com/Hofstadter-Conway10000-DollarSequence.html Mathworld Article]. +;Task: +#   Create a routine to generate members of the Hofstadter-Conway $10,000 sequence. +#   Use it to show the maxima of   a(n)/n   between successive powers of two up to   2**20 +#   As a stretch goal:   compute the value of   n   that would have won the prize and confirm it is true for   n   up to 2**20 + + +
    +;Also see: +*   [http://www.jstor.org/stable/2324028 Conways Challenge Sequence], Mallows' own account. +*   [http://mathworld.wolfram.com/Hofstadter-Conway10000-DollarSequence.html Mathworld Article]. +

    diff --git a/Task/Hofstadter-Conway-$10,000-sequence/360-Assembly/hofstadter-conway-$10,000-sequence.360 b/Task/Hofstadter-Conway-$10,000-sequence/360-Assembly/hofstadter-conway-$10,000-sequence.360 new file mode 100644 index 0000000000..22bfdee097 --- /dev/null +++ b/Task/Hofstadter-Conway-$10,000-sequence/360-Assembly/hofstadter-conway-$10,000-sequence.360 @@ -0,0 +1,85 @@ +* Hofstadter-Conway $10,000 sequence 07/05/2016 +HOFSTADT START + B 72(R15) skip savearea + DC 17F'0' savearea + STM R14,R12,12(R13) save registers + ST R13,4(R15) link backward SA + ST R15,8(R13) link forward SA + LR R13,R15 establish addressability + USING HOFSTADT,R13 set base register + LA R4,2 pow2=2 + LA R8,4 p2=2**pow2 + MVC A+0,=F'1' a(1)=1 + MVC A+4,=F'1' a(2)=1 + LA R6,3 n=3 +LOOPN C R6,UPRDIM do n=3 to uprdim + BH ELOOPN + LR R1,R6 n + SLA R1,2 + L R5,A-8(R1) a(n-1) + LR R1,R5 + SLA R1,2 + L R2,A-4(R1) a(a(n-1)) + LR R1,R6 n + SR R1,R5 n-a(n-1) + SLA R1,2 + L R3,A-4(R1) a(n-a(n-1) + AR R2,R3 a(a(n-1))+a(n-a(n-1)) + LR R1,R6 n + SLA R1,2 + ST R2,A-4(R1) a(n)=a(a(n-1))+a(n-a(n-1)) + LR R1,R6 n + SLA R1,2 + L R2,A-4(R1) a(n) + MH R2,=H'10000' fixed point 4dec + SRDA R2,32 + DR R2,R6 /n + LR R7,R3 r=a(n)/n + C R7,=F'5500' if r>=0.55 + BL EIF1 + LR R9,R6 mallows=n +EIF1 C R7,PEAK if r>peak + BNH EIF2 + ST R7,PEAK peak=r + ST R6,PEAKPOS peakpos=n +EIF2 CR R6,R8 if n=p2 + BNE EIF3 + LR R1,R4 pow2 + BCTR R1,0 pow2-1 + XDECO R1,XDEC edit pow2-1 + MVC PG1+18(2),XDEC+10 + XDECO R4,XDEC edit pow2 + MVC PG1+27(2),XDEC+10 + L R1,PEAK peak + XDECO R1,XDEC edit peak + MVC PG1+35(4),XDEC+8 + L R1,PEAKPOS peakpos + XDECO R1,XDEC edit peakpos + MVC PG1+45(5),XDEC+7 + XPRNT PG1,80 print buffer + LA R4,1(R4) pow2=pow2+1 + SLA R8,1 p2=2**pow2 + MVC PEAK,=F'5000' peak=0.5 +EIF3 LA R6,1(R6) n=n+1 + B LOOPN +ELOOPN L R1,L l + XDECO R1,XDEC edit l + MVC PG2+6(2),XDEC+10 + XDECO R9,XDEC edit mallows + MVC PG2+29(5),XDEC+7 + XPRNT PG2,80 print buffer +RETURN L R13,4(0,R13) restore savearea pointer + LM R14,R12,12(R13) restore registers + XR R15,R15 return code = 0 + BR R14 return to caller + LTORG +L DC F'12' +UPRDIM DC F'4096' 2^L +PEAK DC F'5000' 0.5 fixed point 4dec +PEAKPOS DC F'0' +XDEC DS CL12 +PG1 DC CL80'maximum between 2^xx and 2^xx is 0.xxxx at n=xxxxx' +PG2 DC CL80'for l=xx : mallows number is xxxxx' +A DS 4096F array a(uprdim) + REGEQU + END HOFSTADT diff --git a/Task/Hofstadter-Conway-$10,000-sequence/REXX/hofstadter-conway-$10,000-sequence.rexx b/Task/Hofstadter-Conway-$10,000-sequence/REXX/hofstadter-conway-$10,000-sequence.rexx index d64a4c86bc..bd675d0de3 100644 --- a/Task/Hofstadter-Conway-$10,000-sequence/REXX/hofstadter-conway-$10,000-sequence.rexx +++ b/Task/Hofstadter-Conway-$10,000-sequence/REXX/hofstadter-conway-$10,000-sequence.rexx @@ -1,32 +1,23 @@ -/*REXX program solves the Hofstadter-Conway $10,000 prize (puzzle). */ -hC.=; !.=0; @.=0; w=0; wi=0; few=70; L= +/*REXX program solves the Hofstadter─Conway sequence $10,000 prize (puzzle). */ +@pref= 'Maximum of a(n) ÷ n between ' /*a prologue for the text of message. */ +H.=.; H.1=1; H.2=1; !.=0; @.=0 /*initialize some REXX variables. */ +win=0 + do k=0 to 20; p.k=2**k; maxp=p.k /*build an array of the powers of two. */ + end /*k*/ +r=1 /*R: is the range of the power of two.*/ + do n=1 for maxp; if n> p.r then r=r+1 /*for golf coders, same as: r=r+(n>p.r)*/ + _=H(n)/n; if _>=.55 then win=n /*get next seq number; if ≥.55, a win? */ + if _<=@.r then iterate /*less than previous? Then keep looking*/ + @.r=_; !.r=n /*@.r and !.r are like ginkgo biloba.*/ + end /*n*/ /* ··· or in other words, memoization.*/ - do i=1 for few; L=L hc(i) /*build the 1st 70 numbers in sequence.*/ - end /*i*/ - /*wearing a belt & suspenders, show ···*/ -say 'The first' few "numbers in the Hofstadter─Conway sequence:" -say strip(L) /*display the list, trees have to die. */ -say /*show a blank line for the eyeballs. */ - do k=0 to 20 /*build an array of the powers of two. */ - p.k=2**k /*Bang-bang!. Er, ··· I mean pow-pow.*/ - maxp=p.k /* ··· and remember who's da big 'un.*/ - end /*k*/ -r=1 /*R: is the range of the power of two.*/ - do n=1 for maxp /*heck, let's get cracking then ··· */ - if n>p.r then r=r+1 /*for golf coders: r = r + (n>p.r) */ - _=hc(n)/n; if _>=.55 then w=n /*get next seq number; if ≥.55, a win? */ - if _<=@.r then iterate /*less than prev? Then keep truckin'.*/ - @.r=_; !.r=n /*@.r and !.r are like ginkgo biloba.*/ - end /*n*/ - -pref='Maximum of a(n) ÷ n between ' /*prefix for the text of message.*/ - - do j=1 for 20; range='2**'right(j-1,2) "───► 2**"right(j,2) - say pref range '(inclusive) is ' left(@.j,8) ' at n='right(!.j,7) - end /*j*/ + do j=1 for 20; range= '2**'right(j-1, 2) "───► 2**"right( j, 2) + say @pref range '(inclusive) is ' left(@.j, 9) " at n="right(!.j, 7) + end /*j*/ say -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -hC: procedure expose hC.; parse arg n; if n<3 then return 1 - if hC.n=='' then hC.n = hC(hC(n-1)) + hC(n-hC(n-1)) - return hC.n /*return with the goodie stuff (high). */ +say 'The winning number is: ' win /*and the money shot is ··· */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +H: procedure expose H.; parse arg z + if H.z==. then do; m=z-1; $=H.m; _=z-$; H.z=H.$+H._; end + return H.z diff --git a/Task/Hofstadter-Conway-$10,000-sequence/ZX-Spectrum-Basic/hofstadter-conway-$10,000-sequence.zx b/Task/Hofstadter-Conway-$10,000-sequence/ZX-Spectrum-Basic/hofstadter-conway-$10,000-sequence.zx new file mode 100644 index 0000000000..75fe52e8b3 --- /dev/null +++ b/Task/Hofstadter-Conway-$10,000-sequence/ZX-Spectrum-Basic/hofstadter-conway-$10,000-sequence.zx @@ -0,0 +1,12 @@ +10 DIM a(2000) +20 LET a(1)=1: LET a(2)=1 +30 LET pow2=2: LET p2=2^pow2 +40 LET peak=0.5: LET peakpos=0 +50 FOR n=3 TO 2000 +60 LET a(n)=a(a(n-1))+a(n-a(n-1)) +70 LET r=a(n)/n +80 IF r>0.55 THEN LET Mallows=n +90 IF r>peak THEN LET peak=r: LET peakpos=n +100 IF n=p2 THEN PRINT "Maximum (2^";pow2-1;", 2^";pow2;") is ";peak;" at n=";peakpos: LET pow2=pow2+1: LET p2=2^pow2: LET peak=0.5 +110 NEXT n +120 PRINT "Mallows number is ";Mallows diff --git a/Task/Hofstadter-Figure-Figure-sequences/00DESCRIPTION b/Task/Hofstadter-Figure-Figure-sequences/00DESCRIPTION index 367064692c..ecba38e22d 100644 --- a/Task/Hofstadter-Figure-Figure-sequences/00DESCRIPTION +++ b/Task/Hofstadter-Figure-Figure-sequences/00DESCRIPTION @@ -1,19 +1,27 @@ These two sequences of positive integers are defined as: -:\begin{align} +:::: \begin{align} R(1)&=1\ ;\ S(1)=2 \\ R(n)&=R(n-1)+S(n-1), \quad n>1. -\end{align} -:The sequence S(n) is further defined as the sequence of positive integers ''not'' present in R(n). -Sequence R starts: 1, 3, 7, 12, 18, ...
    -Sequence S starts: 2, 4, 5, 6, 8, ... +\end{align}
    + +
    +The sequence S(n) is further defined as the sequence of positive integers '''''not''''' present in R(n). + +Sequence R starts: + 1, 3, 7, 12, 18, ... +Sequence S starts: + 2, 4, 5, 6, 8, ... + + +;Task: +# Create two functions named '''ffr''' and '''ffs''' that when given '''n''' return '''R(n)''' or '''S(n)''' respectively.
    (Note that R(1) = 1 and S(1) = 2 to avoid off-by-one errors). +# No maximum value for '''n''' should be assumed. +# Calculate and show that the first ten values of '''R''' are:
    1, 3, 7, 12, 18, 26, 35, 45, 56, and 69 +# Calculate and show that the first 40 values of '''ffr''' plus the first 960 values of '''ffs''' include all the integers from 1 to 1000 exactly once. -Task: -# Create two functions named ffr and ffs that when given n return R(n) or S(n) respectively.
    (Note that R(1) = 1 and S(1) = 2 to avoid off-by-one errors). -# No maximum value for n should be assumed. -# Calculate and show that the first ten values of R are: 1, 3, 7, 12, 18, 26, 35, 45, 56, and 69 -# Calculate and show that the first 40 values of ffr plus the first 960 values of ffs include all the integers from 1 to 1000 exactly once. ;References: * Sloane's [http://oeis.org/A005228 A005228] and [http://oeis.org/A030124 A030124]. -* [http://mathworld.wolfram.com/HofstadterFigure-FigureSequence.html Wolfram Mathworld] +* [http://mathworld.wolfram.com/HofstadterFigure-FigureSequence.html Wolfram MathWorld] * Wikipedia: [[wp:Hofstadter_sequence#Hofstadter_Figure-Figure_sequences|Hofstadter Figure-Figure sequences]]. +

    diff --git a/Task/Hofstadter-Figure-Figure-sequences/C++/hofstadter-figure-figure-sequences-1.cpp b/Task/Hofstadter-Figure-Figure-sequences/C++/hofstadter-figure-figure-sequences-1.cpp new file mode 100644 index 0000000000..85fbbed85d --- /dev/null +++ b/Task/Hofstadter-Figure-Figure-sequences/C++/hofstadter-figure-figure-sequences-1.cpp @@ -0,0 +1,66 @@ +#include +#include +#include +#include + +using namespace std; + +unsigned hofstadter(unsigned rlistSize, unsigned slistSize) +{ + auto n = rlistSize > slistSize ? rlistSize : slistSize; + auto rlist = new vector { 1, 3, 7 }; + auto slist = new vector { 2, 4, 5, 6 }; + auto list = rlistSize > 0 ? rlist : slist; + auto target_size = rlistSize > 0 ? rlistSize : slistSize; + + while (list->size() > target_size) list->pop_back(); + + while (list->size() < target_size) + { + auto lastIndex = rlist->size() - 1; + auto lastr = (*rlist)[lastIndex]; + auto r = lastr + (*slist)[lastIndex]; + rlist->push_back(r); + for (auto s = lastr + 1; s < r && list->size() < target_size;) + slist->push_back(s++); + } + + auto v = (*list)[n - 1]; + delete rlist; + delete slist; + return v; +} + +ostream& operator<<(ostream& os, const set& s) +{ + cout << '(' << s.size() << "):"; + auto i = 0; + for (auto c = s.begin(); c != s.end();) + { + if (i++ % 20 == 0) os << endl; + os << setw(5) << *c++; + } + return os; +} + +int main(int argc, const char* argv[]) +{ + const auto v1 = atoi(argv[1]); + const auto v2 = atoi(argv[2]); + set r, s; + for (auto n = 1; n <= v2; n++) + { + if (n <= v1) + r.insert(hofstadter(n, 0)); + s.insert(hofstadter(0, n)); + } + cout << "R" << r << endl; + cout << "S" << s << endl; + + int m = max(*r.rbegin(), *s.rbegin()); + for (auto n = 1; n <= m; n++) + if (r.count(n) == s.count(n)) + clog << "integer " << n << " either in both or neither set" << endl; + + return 0; +} diff --git a/Task/Hofstadter-Figure-Figure-sequences/C++/hofstadter-figure-figure-sequences-2.cpp b/Task/Hofstadter-Figure-Figure-sequences/C++/hofstadter-figure-figure-sequences-2.cpp new file mode 100644 index 0000000000..da6dab9af6 --- /dev/null +++ b/Task/Hofstadter-Figure-Figure-sequences/C++/hofstadter-figure-figure-sequences-2.cpp @@ -0,0 +1,10 @@ +% ./hofstadter 40 100 2> /dev/null +R(40): + 1 3 7 12 18 26 35 45 56 69 83 98 114 131 150 170 191 213 236 260 + 285 312 340 369 399 430 462 495 529 565 602 640 679 719 760 802 845 889 935 982 +S(100): + 2 4 5 6 8 9 10 11 13 14 15 16 17 19 20 21 22 23 24 25 + 27 28 29 30 31 32 33 34 36 37 38 39 40 41 42 43 44 46 47 48 + 49 50 51 52 53 54 55 57 58 59 60 61 62 63 64 65 66 67 68 70 + 71 72 73 74 75 76 77 78 79 80 81 82 84 85 86 87 88 89 90 91 + 92 93 94 95 96 97 99 100 101 102 103 104 105 106 107 108 109 110 111 112 diff --git a/Task/Hofstadter-Figure-Figure-sequences/CoffeeScript/hofstadter-figure-figure-sequences.coffee b/Task/Hofstadter-Figure-Figure-sequences/CoffeeScript/hofstadter-figure-figure-sequences.coffee new file mode 100644 index 0000000000..c8b47e1ed9 --- /dev/null +++ b/Task/Hofstadter-Figure-Figure-sequences/CoffeeScript/hofstadter-figure-figure-sequences.coffee @@ -0,0 +1,26 @@ +R = [ null, 1 ] +S = [ null, 2 ] + +extend_sequences = (n) -> + current = Math.max(R[R.length - 1], S[S.length - 1]) + i = undefined + while R.length <= n or S.length <= n + i = Math.min(R.length, S.length) - 1 + current += 1 + if current == R[i] + S[i] + R.push current + else + S.push current + +ff = (X, n) -> + extend_sequences n + X[n] + +console.log 'R(' + i + ') = ' + ff(R, i) for i in [1..10] +int_array = ([1..40].map (i) -> ff(R, i)).concat [1..960].map (i) -> ff(S, i) +int_array.sort (a, b) -> a - b + +for i in [1..1000] + if int_array[i - 1] != i + throw 'Something\'s wrong!' +console.log '1000 integer check ok.' diff --git a/Task/Hofstadter-Figure-Figure-sequences/Common-Lisp/hofstadter-figure-figure-sequences.lisp b/Task/Hofstadter-Figure-Figure-sequences/Common-Lisp/hofstadter-figure-figure-sequences.lisp new file mode 100644 index 0000000000..bb071d4c53 --- /dev/null +++ b/Task/Hofstadter-Figure-Figure-sequences/Common-Lisp/hofstadter-figure-figure-sequences.lisp @@ -0,0 +1,34 @@ +;;; equally doable with a list +(flet ((seq (i) (make-array 1 :element-type 'integer + :initial-element i + :fill-pointer 1 + :adjustable t))) + (let ((rr (seq 1)) (ss (seq 2))) + (labels ((extend-r () + (let* ((l (1- (length rr))) + (r (+ (aref rr l) (aref ss l))) + (s (elt ss (1- (length ss))))) + (vector-push-extend r rr) + (loop while (<= s r) do + (if (/= (incf s) r) + (vector-push-extend s ss)))))) + (defun seq-r (n) + (loop while (> n (length rr)) do (extend-r)) + (elt rr (1- n))) + + (defun seq-s (n) + (loop while (> n (length ss)) do (extend-r)) + (elt ss (1- n)))))) + +(defun take (f n) + (loop for x from 1 to n collect (funcall f x))) + +(format t "First of R: ~a~%" (take #'seq-r 10)) + +(mapl (lambda (l) (if (and (cdr l) + (/= (1+ (car l)) (cadr l))) + (error "not in sequence"))) + (sort (append (take #'seq-r 40) + (take #'seq-s 960)) + #'<)) +(princ "Ok") diff --git a/Task/Hofstadter-Figure-Figure-sequences/REXX/hofstadter-figure-figure-sequences-1.rexx b/Task/Hofstadter-Figure-Figure-sequences/REXX/hofstadter-figure-figure-sequences-1.rexx index 0cd1e76aad..41971e4cf2 100644 --- a/Task/Hofstadter-Figure-Figure-sequences/REXX/hofstadter-figure-figure-sequences-1.rexx +++ b/Task/Hofstadter-Figure-Figure-sequences/REXX/hofstadter-figure-figure-sequences-1.rexx @@ -1,43 +1,43 @@ -/*REXX program calculates and verifies the Hofstadter Figure─Figure sequences.*/ -parse arg x top bot . /*obtain optional arguments from the CL*/ -if x=='' | x==',' then x= 10 /*Not specified? Then use the default.*/ -if top=='' | top==',' then top=1000 /* " " " " " " */ -if bot=='' | bot==',' then bot= 40 /* " " " " " " */ -low=1; if x<0 then low=abs(x) /*only display a single │X│ value? */ -r.=0; r.1=1; rr.=r.; rr.1=1; s.=r.; s.1=2 /*initialize the R RR S arrays.*/ -errs=0; $.=0 - do i=low to abs(x) /*display the 1st X values of R & S.*/ - say right('R('i") =", 20) right(ffr(i), 7), - right('S('i") =", 20) right(ffs(i), 7) - end /*i*/ -if x<1 then exit - do m=1 for bot; r=ffr(m); $.r=1 - end /*m*/ /* [↑] calculate the 1st 40 R values.*/ - - do n=1 for top-bot; s=ffs(n) - if $.s then call ser 'duplicate number in R and S lists:' s; $.s=1 - end /*n*/ /* [↑] calculate the 1st 960 S values.*/ - - do v=1 for top - if \$.v then call ser 'missing R │ S:' v - end /*v*/ /* [↑] are all 1≤ numbers ≤1k present?*/ +/*REXX program calculates and verifies the Hofstadter Figure─Figure sequences. */ +parse arg x top bot . /*obtain optional arguments from the CL*/ +if x=='' | x=="," then x= 10 /*Not specified? Then use the default.*/ +if top=='' | top=="," then top=1000 /* " " " " " " */ +if bot=='' | bot=="," then bot= 40 /* " " " " " " */ +low=1; if x<0 then low=abs(x) /*only display a single │X│ value? */ +r.=0; r.1=1; rr.=r.; rr.1=1; s.=r.; s.1=2 /*initialize the R, RR, and S arrays.*/ +errs=0 /*the number of errors found (so far).*/ + do i=low to abs(x) /*display the 1st X values of R & S.*/ + say right('R('i") =",20) right(FFR(i),7) right('S('i") =",20) right(FFS(i),7) + end /*i*/ + /* [↑] list the 1st X Fig─Fig numbers.*/ +if x<1 then exit /*if X isn't positive, then we're done.*/ +$.=0 /*initialize the memoization ($) array.*/ + do m=1 for bot; r=FFR(m); $.r=1 /*calculate the first forty R values.*/ + end /*m*/ /* [↑] ($.) is used for memoization. */ + /* [↓] check for duplicate #s in R & S*/ + do n=1 for top-bot; s=FFS(n) /*calculate the value of FFS(n). */ + if $.s then call ser 'duplicate number in R and S lists:' s; $.s=1 + end /*n*/ /* [↑] calculate the 1st 960 S values.*/ + /* [↓] check for missing values in R│S*/ + do v=1 for top; if \$.v then call ser 'missing R │ S:' v + end /*v*/ /* [↑] are all 1≤ numbers ≤1k present?*/ say if errs==0 then say 'verification completed for all numbers from 1 ──►' top " [inclusive]." else say 'verification failed with' errs "errors." -exit /*stick a fork in it, we're done.*/ -/*────────────────────────────────────────────────────────────────────────────*/ -ffr: procedure expose r. s. rr.; parse arg n /*obtain the number from the arg.*/ - if r.n\==0 then return r.n /*Defined? Then return the value.*/ - _=ffr(n-1) + ffs(n-1) /*calculate the FFR & FFS values.*/ - r.n=_; rr._=1; return _ /*assign value to R & RR; return.*/ -/*────────────────────────────────────────────────────────────────────────────*/ -ffs: procedure expose r. s. rr.; parse arg n /*search for ¬null R or S number.*/ - if s.n==0 then do k=1 for n /* [↓] 1st IF is a SHORT CIRCUIT*/ - if s.k\==0 then if r.k\==0 then iterate - call ffr k /*define R.k via FFR subroutine*/ - km=k-1; _=s.km+1 /*the next S number, possibly.*/ - _=_+rr._; s.k=_ /*define an element of S array.*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +FFR: procedure expose r. rr. s.; parse arg n /*obtain the number from the arguments.*/ + if r.n\==0 then return r.n /*R.n defined? Then return the value.*/ + _=FFR(n-1) + FFS(n-1) /*calculate the FFR and FFS values.*/ + r.n=_; rr._=1; return _ /*assign the value to R & RR; return.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +FFS: procedure expose r. s. rr.; parse arg n /*search for not null R or S number. */ + if s.n==0 then do k=1 for n /* [↓] 1st IF is a SHORT CIRCUIT. */ + if s.k\==0 then if r.k\==0 then iterate /*are both defined?*/ + call FFR k /*define R.k via the FFR subroutine*/ + km=k-1; _=s.km+1 /*calc. the next S number, possibly.*/ + _=_+rr._; s.k=_ /*define an element of the S array. */ end /*k*/ - return s.n /*return S.n value to the invoker*/ -/*────────────────────────────────────────────────────────────────────────────*/ -ser: errs=errs+1; say '***error***!' arg(1); return + return s.n /*return S.n value to the invoker. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +ser: errs=errs+1; say '***error***' arg(1); return diff --git a/Task/Hofstadter-Q-sequence/00DESCRIPTION b/Task/Hofstadter-Q-sequence/00DESCRIPTION index ed250259b0..25cd5b4cb7 100644 --- a/Task/Hofstadter-Q-sequence/00DESCRIPTION +++ b/Task/Hofstadter-Q-sequence/00DESCRIPTION @@ -1,14 +1,21 @@ The [[wp:Hofstadter_sequence#Hofstadter_Q_sequence|Hofstadter Q sequence]] is defined as: -:\begin{align} + +:: \begin{align} Q(1)&=Q(2)=1, \\ Q(n)&=Q\big(n-Q(n-1)\big)+Q\big(n-Q(n-2)\big), \quad n>2. \end{align} + + It is defined like the [[Fibonacci sequence]], but whereas the next term in the Fibonacci sequence is the sum of the previous two terms, in the Q sequence the previous two terms tell you how far to go back in the Q sequence to find the two numbers to sum to make the next term of the sequence. + ;Task: * Confirm and display that the first ten terms of the sequence are: 1, 1, 2, 3, 3, 4, 5, 5, 6, and 6 -* Confirm and display that the 1000th term is: 502 +* Confirm and display that the 1000th term is:   502 + ;Optional extra credit -* Count and display how many times a member of the sequence is less than its preceding term for terms up to and including the 100,000'th term. -* Ensure that the extra credit solution 'safely' handles being initially asked for an n'th term where n is large.
    (This point is to ensure that caching and/or recursion limits, if it is a concern, is correctly handled). +* Count and display how many times a member of the sequence is less than its preceding term for terms up to and including the 100,000th term. +* Ensure that the extra credit solution   ''safely''   handles being initially asked for an '''n'''th term where   '''n'''   is large. +
    (This point is to ensure that caching and/or recursion limits, if it is a concern, is correctly handled). +

    diff --git a/Task/Hofstadter-Q-sequence/C++/hofstadter-q-sequence.cpp b/Task/Hofstadter-Q-sequence/C++/hofstadter-q-sequence.cpp index 57d70bc677..05c404acfc 100644 --- a/Task/Hofstadter-Q-sequence/C++/hofstadter-q-sequence.cpp +++ b/Task/Hofstadter-Q-sequence/C++/hofstadter-q-sequence.cpp @@ -1,21 +1,20 @@ #include -int main( ) { - int hofstadters[100000] ; - hofstadters[ 0 ] = 1 ; - hofstadters[ 1 ] = 1 ; - for ( int i = 3 ; i < 100000 ; i++ ) +int main() { + const int size = 100000; + int hofstadters[size] = { 1, 1 }; + for (int i = 3 ; i < size; i++) hofstadters[ i - 1 ] = hofstadters[ i - 1 - hofstadters[ i - 1 - 1 ]] + - hofstadters[ i - 1 - hofstadters[ i - 2 - 1 ]] ; - std::cout << "The first 10 numbers are:\n" ; - for ( int i = 0 ; i < 10 ; i++ ) - std::cout << hofstadters[ i ] << std::endl ; - std::cout << "The 1000'th term is " << hofstadters[ 999 ] << " !" << std::endl ; - int less_than_preceding = 0 ; - for ( int i = 0 ; i < 99999 ; i++ ) { - if ( hofstadters[ i + 1 ] < hofstadters[ i ] ) - less_than_preceding++ ; - } - std::cout << less_than_preceding << " times a number was preceded by a greater number!\n" ; - return 0 ; + hofstadters[ i - 1 - hofstadters[ i - 2 - 1 ]]; + std::cout << "The first 10 numbers are: "; + for (int i = 0; i < 10; i++) + std::cout << hofstadters[ i ] << ' '; + std::cout << std::endl << "The 1000'th term is " << hofstadters[ 999 ] << " !" << std::endl; + int less_than_preceding = 0; + for (int i = 0; i < size - 1; i++) + if (hofstadters[ i + 1 ] < hofstadters[ i ]) + less_than_preceding++; + std::cout << "In array of size: " << size << ", "; + std::cout << less_than_preceding << " times a number was preceded by a greater number!" << std::endl; + return 0; } diff --git a/Task/Hofstadter-Q-sequence/CoffeeScript/hofstadter-q-sequence.coffee b/Task/Hofstadter-Q-sequence/CoffeeScript/hofstadter-q-sequence.coffee new file mode 100644 index 0000000000..95833fd208 --- /dev/null +++ b/Task/Hofstadter-Q-sequence/CoffeeScript/hofstadter-q-sequence.coffee @@ -0,0 +1,11 @@ +hofstadterQ = do -> + memo = [ 1 ,1, 1] + Q = (n) -> + result = memo[n] + if typeof result != 'number' + result = memo[n] = Q(n - Q(n - 1)) + Q(n - Q(n - 2)) + result + +# some results: +console.log 'Q(' + i + ') = ' + hofstadterQ(i) for i in [1..10] +console.log 'Q(1000) = ' + hofstadterQ(1000) diff --git a/Task/Hofstadter-Q-sequence/Elixir/hofstadter-q-sequence.elixir b/Task/Hofstadter-Q-sequence/Elixir/hofstadter-q-sequence.elixir new file mode 100644 index 0000000000..1aee87716a --- /dev/null +++ b/Task/Hofstadter-Q-sequence/Elixir/hofstadter-q-sequence.elixir @@ -0,0 +1,24 @@ +defmodule Hofstadter do + defp flip(v2, v1) when v1 > v2, do: 1 + defp flip(_v2, _v1), do: 0 + + defp list_terms(max, n, acc), do: Enum.map_join(n..max, ", ", &acc[&1]) + + defp hofstadter(n, n, acc, flips) do + IO.puts "The first ten terms are: #{list_terms(10, 1, acc)}" + IO.puts "The 1000'th term is #{acc[1000]}" + IO.puts "Number of flips: #{flips}" + end + defp hofstadter(max, n, acc, flips) do + qn1 = acc[n-1] + qn = acc[n - qn1] + acc[n - acc[n-2]] + hofstadter(max, n+1, Map.put(acc, n, qn), flips + flip(qn, qn1)) + end + + def main(max \\ 100_000) do + acc = %{1 => 1, 2 => 1} + hofstadter(max+1, 3, acc, 0) + end +end + +Hofstadter.main diff --git a/Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-4.hs b/Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-4.hs index d7ed082956..40d00cdae6 100644 --- a/Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-4.hs +++ b/Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-4.hs @@ -1,18 +1,16 @@ -import Data.Array - q = qq (listArray (1,2) [1,1]) 1 where - qq ar n = (arr!n) : qq arr (n+1) where - l = snd (bounds ar) - step n =arr!(n - (fromIntegral (arr!(n - 1)))) + - arr!(n - (fromIntegral (arr!(n - 2)))) - arr :: Array Int Integer - arr | n <= l = ar - | otherwise = listArray (1, l*2)$ - ([ar!i | i <- [1..l]] ++ - [step i | i <- [l+1..l*2]]) + qq ar n = (arr!n) : qq arr (n+1) where + l = snd (bounds ar) + step n =arr!(n - (fromIntegral (arr!(n - 1)))) + + arr!(n - (fromIntegral (arr!(n - 2)))) + arr :: Array Int Integer + arr | n <= l = ar + | otherwise = listArray (1, l*2)$ + ([ar!i | i <- [1..l]] ++ + [step i | i <- [l+1..l*2]]) main = do - putStr("first 10: "); print (take 10 q) - putStr("1000-th: "); print (q !! 999) - putStr("flips: ") - print $ length $ filter id $ take 100000 (zipWith (>) q (tail q)) + putStr("first 10: "); print (take 10 q) + putStr("1000-th: "); print (q !! 999) + putStr("flips: ") + print $ length $ filter id $ take 100000 (zipWith (>) q (tail q)) diff --git a/Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-5.hs b/Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-5.hs index cbce25054e..d7722cbb4d 100644 --- a/Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-5.hs +++ b/Task/Hofstadter-Q-sequence/Haskell/hofstadter-q-sequence-5.hs @@ -2,19 +2,20 @@ import Data.Array import Data.Int (Int64) q = qq [listArray (1,2) [1,1]] 1 where - qq a n = seek aa n : qq aa (1 + n) where - aa | n <= l = a - | otherwise = listArray (l+1,l*2) (take l $ drop 2 lst):a - where - l = snd (bounds $ head a) - lst = seek a (l-1):seek a l:(ext lst (l+1)) - ext (q1:q2:qs) i = (g (i-q2) + g (i-q1)):ext (q2:qs) (1+i) - g = seek aa - seek (ar:ars) n - | n >= fst (bounds ar) = ar ! n - | otherwise = seek ars n + qq a n = seek aa n : qq aa (1 + n) where + aa | n <= l = a + | otherwise = listArray (l+1,l*2) (take l $ drop 2 lst):a + where + l = snd (bounds $ head a) + lst = seek a (l-1):seek a l:(ext lst (l+1)) + ext (q1:q2:qs) i = (g (i-q2) + g (i-q1)):ext (q2:qs) (1+i) + g = seek aa + seek (ar:ars) n + | n >= fst (bounds ar) = ar ! n + | otherwise = seek ars n -- Only a perf test. Task can be done exactly the same as above main = print $ sum qqq - where qqq :: [Int64] - qqq = map fromIntegral $ take 3000000 q + where + qqq :: [Int64] + qqq = map fromIntegral $ take 3000000 q diff --git a/Task/Hofstadter-Q-sequence/JavaScript/hofstadter-q-sequence.js b/Task/Hofstadter-Q-sequence/JavaScript/hofstadter-q-sequence-1.js similarity index 100% rename from Task/Hofstadter-Q-sequence/JavaScript/hofstadter-q-sequence.js rename to Task/Hofstadter-Q-sequence/JavaScript/hofstadter-q-sequence-1.js diff --git a/Task/Hofstadter-Q-sequence/JavaScript/hofstadter-q-sequence-2.js b/Task/Hofstadter-Q-sequence/JavaScript/hofstadter-q-sequence-2.js new file mode 100644 index 0000000000..ec137c8bd2 --- /dev/null +++ b/Task/Hofstadter-Q-sequence/JavaScript/hofstadter-q-sequence-2.js @@ -0,0 +1,40 @@ +(() => { + 'use strict'; + + // hofQSeq :: Int -> [Int] + const hofQSeq = x => + x > 2 ? tail(foldl((Q, n) => + n < 3 ? Q : Q.concat( + Q[n - Q[n - 1]] + Q[n - Q[n - 2]] + ), [0, 1, 1], + range(1, x))) : (x > 0 ? take(x, [1, 1]) : undefined); + + + // GENERIC FUNCTIONS ------------------------------------------- + + // foldl :: (b -> a -> b) -> b -> [a] -> b + const foldl = (f, a, xs) => xs.reduce(f, a), + + // range :: Int -> Int -> [Int] + range = (m, n) => + Array.from({ + length: Math.floor(n - m) + 1 + }, (_, i) => m + i), + + // tail :: [a] -> [a] + tail = xs => xs.length ? xs.slice(1) : undefined, + + // last :: [a] -> a + last = xs => xs.length ? xs.slice(-1)[0] : undefined, + + // Int -> [a] -> [a] + take = (n, xs) => xs.slice(0, n); + + // TEST -------------------------------------------------------- + return { + firstTen: hofQSeq(10), + thousandth: last(hofQSeq(1000)), + 'Q x < xs[i - 1] ? a + 1 : a, 0) + }; +})(); diff --git a/Task/Hofstadter-Q-sequence/JavaScript/hofstadter-q-sequence-3.js b/Task/Hofstadter-Q-sequence/JavaScript/hofstadter-q-sequence-3.js new file mode 100644 index 0000000000..8f9169247d --- /dev/null +++ b/Task/Hofstadter-Q-sequence/JavaScript/hofstadter-q-sequence-3.js @@ -0,0 +1,3 @@ +{"firstTen":[1, 1, 2, 3, 3, 4, 5, 5, 6, 6], + "thousandth":502, + "Q $a, $b { +my @Q = 1, 1, -> $a, $b { (state $n = 1)++; @Q[$n - $a] + @Q[$n - $b] } ... *; diff --git a/Task/Hofstadter-Q-sequence/REXX/hofstadter-q-sequence-1.rexx b/Task/Hofstadter-Q-sequence/REXX/hofstadter-q-sequence-1.rexx index e19fc22129..e422a46711 100644 --- a/Task/Hofstadter-Q-sequence/REXX/hofstadter-q-sequence-1.rexx +++ b/Task/Hofstadter-Q-sequence/REXX/hofstadter-q-sequence-1.rexx @@ -1,33 +1,33 @@ -/*REXX program generates Hofstadter Q sequence for any N. */ -parse arg a b c d . /*get optional values from the CL*/ -if \datatype(a,'W') then a= 10 /*A not specified? Use default.*/ -if \datatype(b,'W') then b= -1000 /*B " " " " */ -if \datatype(c,'W') then c= -100000 /*C " " " " */ -if \datatype(d,'W') then d=-1000000 /*D " " " " */ -q.=1; ac= abs(c) /* [↑] neg #s don't show values.*/ +/*REXX program generates the Hofstadter Q sequence for any specified N. */ +parse arg a b c d . /*obtain optional arguments from the CL*/ +if \datatype(a, 'W') then a= 10 /*Not specified? Then use the default.*/ +if \datatype(b, 'W') then b= -1000 /* " " " " " " */ +if \datatype(c, 'W') then c= -100000 /* " " " " " " */ +if \datatype(d, 'W') then d= -1000000 /* " " " " " " */ +q.=1; ac= abs(c) /* [↑] negative #'s don't show values.*/ call HofstadterQ a -call HofstadterQ b; say; say abs(b)th(b) 'value is:' result; say +call HofstadterQ b; say; say abs(b)th(b) 'value is:' result; say call HofstadterQ c -downs=0; do j=2 for ac-1; jm=j-1 +downs=0; do j=2 for ac-1; jm=j-1 downs=downs + (q.j2 then if q.j==1 then do; jm1=j-1; jm2=j-2 - _1=j-q.jm1; _2=j-q.jm2 - q.j=q._1+q._2 - end - if ox>0 then say right(j,w) right(q.j,w) /*show if OX>0*/ - end /*j*/ -return q.x /*return the │X│th term to caller*/ -/*──────────────────────────────────TH subroutine───────────────────────────────────────────────*/ -th: procedure; parse arg x; x=abs(x); return word('th st nd rd',1+x//10*(x//100%10\==1)*(x//10<4)) +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +HofstadterQ: procedure expose q.; parse arg x 1 ox /*get number to generate through.*/ + /* [↑] OX is the same as X. */ +x=abs(x) /*use the absolute value for X. */ +w=length(x) /*use for right justified output.*/ + do j=1 for x /* [↓] use short─circuit IF test*/ + if j>2 then if q.j==1 then do; jm1=j-1; jm2=j-2 + _1=j - q.jm1; _2=j - q.jm2 + q.j=q._1 + q._2 + end + if ox>0 then say right(j,w) right(q.j,w) /*display the number if OX > 0. */ + end /*j*/ +return q.x /*return the │X│th term to caller*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +th: procedure; x=abs(arg(1)); return word('th st nd rd',1+x//10*(x//100%10\==1)*(x//10<4)) diff --git a/Task/Hofstadter-Q-sequence/REXX/hofstadter-q-sequence-2.rexx b/Task/Hofstadter-Q-sequence/REXX/hofstadter-q-sequence-2.rexx index f0de592ffc..e613bd400d 100644 --- a/Task/Hofstadter-Q-sequence/REXX/hofstadter-q-sequence-2.rexx +++ b/Task/Hofstadter-Q-sequence/REXX/hofstadter-q-sequence-2.rexx @@ -1,31 +1,32 @@ -/*REXX program generates Hofstadter Q sequence for any N. */ -parse arg a b c . /*get optional values from the CL*/ -if \datatype(a,'W') then a= 10 /*A not specified? Use default.*/ -if \datatype(b,'W') then b= -1000 /*B " " " " */ -if \datatype(c,'W') then c= -100000 /*C " " " " */ -if \datatype(d,'W') then d=-1000000 /*D " " " " */ -q.=1; ac= abs(c) /* [↑] neg #s don't show values.*/ +/*REXX program generates the Hofstadter Q sequence for any specified N. */ +parse arg a b c d . /*obtain optional arguments from the CL*/ +if \datatype(a, 'W') then a= 10 /*Not specified? Then use the default.*/ +if \datatype(b, 'W') then b= -1000 /* " " " " " " */ +if \datatype(c, 'W') then c= -100000 /* " " " " " " */ +if \datatype(d, 'W') then d= -1000000 /* " " " " " " */ +q.=1; ac= abs(c) /* [↑] negative #'s don't show values.*/ call HofstadterQ a -call HofstadterQ b; say; say abs(b)th(b) 'value is:' result; say +call HofstadterQ b; say; say abs(b)th(b) 'value is:' result; say call HofstadterQ c -downs=0; do j=2 for ac-1; downs=downs+(q.j2 then if q.j==1 then q.j=q(j-q(j-1)) + q(j-q(j-2)) if ox>0 then say right(j,w) right(q.j,w) /*if X>0, tell*/ end /*j*/ -return q.x /*return the │X│th term to caller*/ -/*──────────────────────────────────Q subroutine────────────────────────*/ -q: parse arg ?; return q.? /*return value of Q.? to invoker.*/ -/*──────────────────────────────────TH subroutine───────────────────────────────────────────────*/ -th: procedure; parse arg x; x=abs(x); return word('th st nd rd',1+x//10*(x//100%10\==1)*(x//10<4)) +return q.x /*return the │X│th term to caller*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +q: parse arg ?; return q.? /*return value of Q.? to invoker.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +th: procedure; x=abs(arg(1)); return word('th st nd rd',1+x//10*(x//100%10\==1)*(x//10<4)) diff --git a/Task/Hofstadter-Q-sequence/REXX/hofstadter-q-sequence-3.rexx b/Task/Hofstadter-Q-sequence/REXX/hofstadter-q-sequence-3.rexx index cc1ac71966..f4821713e7 100644 --- a/Task/Hofstadter-Q-sequence/REXX/hofstadter-q-sequence-3.rexx +++ b/Task/Hofstadter-Q-sequence/REXX/hofstadter-q-sequence-3.rexx @@ -1,34 +1,34 @@ -/*REXX pgm generates Hofstadter Q sequence (using recursion) for any N. */ -parse arg a b c . /*get optional values from the CL*/ -if \datatype(a,'W') then a= 10 /*A not specified? Use default.*/ -if \datatype(b,'W') then b= -1000 /*B " " " " */ -if \datatype(c,'W') then c= -100000 /*C " " " " */ -if \datatype(d,'W') then d=-1000000 /*D " " " " */ -q.=0; q.1=1; q.2=1; ac= abs(c) /* [↑] neg #s don't show values.*/ +/*REXX program generates the Hofstadter Q sequence for any specified N. */ +parse arg a b c d . /*obtain optional arguments from the CL*/ +if \datatype(a, 'W') then a= 10 /*Not specified? Then use the default.*/ +if \datatype(b, 'W') then b= -1000 /* " " " " " " */ +if \datatype(c, 'W') then c= -100000 /* " " " " " " */ +if \datatype(d, 'W') then d= -1000000 /* " " " " " " */ +q.=0; q.1=1; q.2=1; ac= abs(c) /* [↑] negative #'s don't show values.*/ call HofstadterQ a -call HofstadterQ b; say; say abs(b)th(b) 'value is:' result; say +call HofstadterQ b; say; say abs(b)th(b) 'value is:' result; say call HofstadterQ c -downs=0; do j=2 for ac-1; jm=j-1 +downs=0; do j=2 for ac-1; jm=j-1 downs=downs + (q.j0 then say right(j,w) right(q.j,w) /*show if OX>0*/ - end /*j*/ -return q.x /*return the Xth term to caller.*/ -/*──────────────────────────────────QR subroutine───────────────────────*/ -QR: procedure expose q.; parse arg n /*function is recursive. */ -if q.n==0 then q.n=QR(n-QR(n-1)) + QR(n-QR(n-2)) /*¬defined? Define it*/ -return q.n /*return with the value. */ -/*──────────────────────────────────TH subroutine───────────────────────────────────────────────*/ -th: procedure; parse arg x; x=abs(x); return word('th st nd rd',1+x//10*(x//100%10\==1)*(x//10<4)) +say downs 'terms are less then the previous term,' ac || th(ac) "term is:" q.ac +call HofstadterQ d; ad=abs(d); say +say 'The' ad || th(ad) "term is" q.ad +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +HofstadterQ: procedure expose q.; parse arg x 1 ox /*get number to generate through.*/ + /* [↑] OX is the same as X. */ +x=abs(x) /*use the absolute value for X. */ +w=length(x) /*use for right justified output.*/ + do j=1 for x + if q.j==0 then q.j=QR(j) /*Not defined? Then define it.*/ + if ox>0 then say right(j,w) right(q.j,w) /*show if OX>0*/ + end /*j*/ +return q.x /*return the │X│th term to caller*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +QR: procedure expose q.; parse arg n /*this QR function is recursive.*/ + if q.n==0 then q.n=QR(n-QR(n-1)) + QR(n-QR(n-2)) /*Not defined? Then define it.*/ + return q.n /*return the value to the invoker*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +th: procedure; x=abs(arg(1)); return word('th st nd rd',1+x//10*(x//100%10\==1)*(x//10<4)) diff --git a/Task/Hofstadter-Q-sequence/ZX-Spectrum-Basic/hofstadter-q-sequence.zx b/Task/Hofstadter-Q-sequence/ZX-Spectrum-Basic/hofstadter-q-sequence.zx new file mode 100644 index 0000000000..de2638c550 --- /dev/null +++ b/Task/Hofstadter-Q-sequence/ZX-Spectrum-Basic/hofstadter-q-sequence.zx @@ -0,0 +1,18 @@ +10 PRINT "First 10 terms of Q = " +20 FOR i=1 TO 10: GO SUB 1000: PRINT s;" ";: NEXT i: PRINT +30 LET i=1000 +40 PRINT "1000th term = ";: GO SUB 1000: PRINT s +50 PRINT "Term is less than preceding term ";c;" times" +100 STOP +1000 REM Qsequence subroutine +1010 IF i<3 THEN LET s=1: RETURN +1020 IF i=3 THEN LET s=2: RETURN +1030 DIM q(i) +1040 LET q(1)=1: LET q(2)=1: LET q(3)=2 +1050 LET c=0 +1060 FOR j=3 TO i +1070 LET q(j)=q(j-q(j-1))+q(j-q(j-2)) +1080 IF q(j)
    diff --git a/Task/Holidays-related-to-Easter/360-Assembly/holidays-related-to-easter.360 b/Task/Holidays-related-to-Easter/360-Assembly/holidays-related-to-easter.360 new file mode 100644 index 0000000000..f9af6d47e5 --- /dev/null +++ b/Task/Holidays-related-to-Easter/360-Assembly/holidays-related-to-easter.360 @@ -0,0 +1,183 @@ +* Holidays related to Easter 29/05/2016 +HOLIDAYS CSECT + USING HOLIDAYS,R13 base register + B 72(R15) skip savearea + DC 17F'0' savearea + STM R14,R12,12(R13) prolog + ST R13,4(R15) " + ST R15,8(R13) " + LR R13,R15 " + LA R9,2 nn=2 +LOOPNN C R9,=F'2' if nn=2 + BNE NN2 +NN1 MVC I1,=F'400' i1=400 + MVC I2,=F'2100' i2=2100 + MVC I3,=F'100' i3=100 + B NN3 +NN2 MVC I1,=F'2010' i1=2010 + MVC I2,=F'2020' i2=2020 + MVC I3,=F'1' i3=1 +NN3 MVC PG(L'PGT),PGT pg=pgt + L R1,I1 i1 + XDECO R1,XDEC edit i1 + MVC PG+24(4),XDEC+8 output i1 + L R1,I2 i2 + XDECO R1,XDEC edit i2 + MVC PG+32(4),XDEC+8 output i2 + L R1,I3 i3 + XDECO R1,XDEC edit i3 + MVC PG+42(3),XDEC+9 output i3 + XPRNT PG,L'PGT print buffer + L R6,I1 y=i1 +LOOPY C R6,I2 do y=i1 to i2 by i3 + BH ELOOPY leave y + LR R4,R6 y + SRDA R4,32 ~ + D R4,=F'19' /19 + ST R4,A a=y//19 + LR R4,R6 y + SRDA R4,32 ~ + D R4,=F'100' /100 + ST R5,B b=y/100 + ST R4,C c=y//100 + L R4,B b + SRDA R4,32 ~ + D R4,=F'4' /4 + ST R5,D d=b/4 + ST R4,E e=b//4 + L R4,B b + LA R4,8(R4) +8 + SRDA R4,32 ~ + D R4,=F'25' /25 + ST R5,F f=(b+8)/25 + L R4,B b + S R4,F -f + LA R4,1(R4) +1 + SRDA R4,32 ~ + D R4,=F'3' /3 + ST R5,G g=(b-f+1)/3 + L R5,A a + M R4,=F'19' *19 + LR R4,R5 . + A R4,B +b + S R4,D -d + S R4,G -g + LA R4,15(R4) +15 + SRDA R4,32 ~ + D R4,=F'30' /30 + ST R4,H h=(19*a+b-d-g+15)//30 + L R4,C c + SRDA R4,32 ~ + D R4,=F'4' /4 + ST R5,I i=c/4 + ST R4,K k=c//4 + L R4,E e + SLA R4,1 <<1 <=> *2 + LA R4,32(R4) +32 + L R2,I i + SLA R2,1 <<1 <=> *2 + AR R2,R4 32+2*e+2*i + S R2,H -h + S R2,K -k + SRDA R2,32 ~ + D R2,=F'7' /7 + ST R2,L l=(32+2*e+2*i-h-k)//7 + L R5,H h + M R4,=F'11' *11 + A R5,A +a + L R3,L l + M R2,=F'22' *22 + AR R3,R5 a+11*h+22*l + LR R4,R3 . + SRDA R4,32 ~ + D R4,=F'451' /451 + ST R5,M m=(a+11*h+22*l)/451 + L R2,H h + A R2,L +l + L R5,M m + M R4,=F'7' *7 + SR R2,R5 (h+l)-(7*m) + LA R2,114(R2) +114 + ST R2,N n=h+l-7*m+114 + L R4,N n + SRDA R4,32 ~ + D R4,=F'31' /31 + ST R5,XM xm=n/31 + LA R4,1(R4) +1 + ST R4,XD xd=n//31+1 + LA R10,PG pgi=0 + MVC PG,=CL84' ' pg=' ' + XDECO R6,XDEC edit y + MVC 0(4,R10),XDEC+8 output y + LA R10,4(R10) pgi=pgi+3 + LA R8,5 loop counter for loopi + LA R7,1 i=1 +LOOPI LR R1,R7 do i=1 to 5; r1=i + SLA R1,1 *2 + LH R2,OFFSET-2(R1) offset(i) + L R4,XD xd + AR R4,R2 wd=xd+offset(i) +WHILE L R1,XM xm + SLA R1,1 *2 + LH R2,DAYS-2(R1) days(xm) + CR R4,R2 while wd>days(xm) + BNH WEND leave while + SR R4,R2 wd=wd-days(xm) + L R2,XM xm + LA R2,1(R2) xm+1 + ST R2,XM xm=xm+1 + B WHILE loop while +WEND ST R4,XD xd=wd + LA R10,1(R10) pgi=pgi+1 + LR R1,R7 i + MH R1,=AL2(L'HOLIDAY) *9 + LA R14,HOLIDAY-9(R1) @holiday(i) + MVC 0(L'HOLIDAY,R10),0(R14) output holiday(i) + LA R10,9(R10) pgi=pgi+9 + L R1,XD xd + XDECO R1,XDEC edit xd + MVC 0(3,R10),XDEC+9 output xd + LA R10,3(R10) pgi=pgi+3 + L R1,XM xm + MH R1,=AL2(L'MONTH) *3 + LA R14,MONTH-3(R1) @month(xm) + MVC 0(L'MONTH,R10),0(R14) output month(xm) + LA R10,3(R10) pgi=pgi+3 + LA R7,1(R7) i+1 + BCT R8,LOOPI next i + XPRNT PG,L'PG print buffer + A R6,I3 y=y+i3 + B LOOPY next y +ELOOPY BCT R9,LOOPNN next nn + L R13,4(0,R13) epilog + LM R14,R12,12(R13) " + XR R15,R15 " + BR R14 exit +A DS F a=y//19 +B DS F b=y/100 +C DS F c=y//100 +D DS F d=b/4 +E DS F e=b//4 +F DS F f=(b+8)/25 +G DS F g=(b-f+1)/3 +H DS F h=(19*a+b-d-g+15)//30 +I DS F i=c/4 +K DS F k=c//4 +L DS F l=(32+2*e+2*i-h-k)//7 +M DS F m=(a+11*h+22*l)/451 +N DS F n=h+l-7*m+114 +XM DS F month +XD DS F day +I1 DS F from year i1 +I2 DS F to year i2 +I3 DS F step year i3 +MONTH DC CL3'jan',CL3'feb',CL3'mar',CL3'apr',CL3'may',CL3'jun' +DAYS DC H'31',H'28',H'31',H'30',H'31',H'30' +HOLIDAY DC CL9'Easter',CL9'Ascension',CL9'Pentecost' + DC CL9'Trinity',CL9'Corpus' +OFFSET DC H'0',H'39',H'10',H'7',H'4' +PGT DC CL45'Christian holidays from .... to .... step ...' +PG DC CL84' ' buffer +XDEC DS CL12 temp for edit + YREGS + END HOLIDAYS diff --git a/Task/Holidays-related-to-Easter/Erlang/holidays-related-to-easter.erl b/Task/Holidays-related-to-Easter/Erlang/holidays-related-to-easter.erl new file mode 100644 index 0000000000..f4e10d6a82 --- /dev/null +++ b/Task/Holidays-related-to-Easter/Erlang/holidays-related-to-easter.erl @@ -0,0 +1,63 @@ +-module(holidays). +-export([task/0]). + +offsets(easter) -> 0; +offsets(ascension) -> 39; +offsets(pentecost) -> 49; +offsets(trinity) -> 56; +offsets(corpus) -> 60. + +month(Month) -> + element(Month, { "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" } ). + +easter_date(Year) -> + A = Year rem 19, + B = Year div 100, + C = Year rem 100, + D = B div 4, + E = B rem 4, + F = (B + 8) div 25, + G = (B - F + 1) div 3, + H = (19*A + B - D - G + 15) rem 30, + I = C div 4, + K = C rem 4, + L = (32 + 2*E + 2*I - H - K) rem 7, + M = (A + 11*H + 22*L) div 451, + Numerator = H + L - 7*M + 114, + Month = Numerator div 31, + Day = Numerator rem 31 + 1, + {Year, Month, Day}. + +holidays() -> + [ easter, ascension, pentecost, trinity, corpus ]. + +holidays(Year) -> + io:format("~4w:", [Year]), + Gday = calendar:date_to_gregorian_days(easter_date(Year)), + holidays(Gday, holidays()). + +holidays(_, []) -> + io:format("~n"); +holidays(Gday, [H | T]) -> + Offset = offsets(H), + {_Year, Month, Day} = calendar:gregorian_days_to_date(Gday + Offset), + io:format("~6w ~3s", [Day, month(Month)]), + holidays(Gday, T). + +title([]) -> + io:format("~n"); +title([H | T]) -> + io:format(" ~9s", [H]), + title(T). + +task() -> + io:format("Year:"), + title(holidays()), + task(400, 2100, 100), + task(2010, 2020, 1). + +task(Year, Max, _) when Year > Max -> + io:format("~n"); +task(Year, Max, Step) -> + holidays(Year), + task(Year+Step, Max, Step). diff --git a/Task/Holidays-related-to-Easter/Lua/holidays-related-to-easter.lua b/Task/Holidays-related-to-Easter/Lua/holidays-related-to-easter.lua new file mode 100644 index 0000000000..66b8dfdd8e --- /dev/null +++ b/Task/Holidays-related-to-Easter/Lua/holidays-related-to-easter.lua @@ -0,0 +1,38 @@ +local Time = require("time") + +function div (x, y) return math.floor(x / y) end + +function easter (year) + local G = year % 19 + local C = div(year, 100) + local H = (C - div(C, 4) - div((8 * C + 13), 25) + 19 * G + 15) % 30 + local I = H - div(H, 28) * (1 - div(29, H + 1)) * (div(21 - G, 11)) + local J = (year + div(year, 4) + I + 2 - C + div(C, 4)) % 7 + local L = I - J + local month = 3 + div(L + 40, 44) + return month, L + 28 - 31 * div(month, 4) +end + +function holidays (year) + local dates = {} + dates.easter = Time.date(year, easter(year)) + dates.ascension = dates.easter + Time.days(39) + dates.pentecost = dates.easter + Time.days(49) + dates.trinity = dates.easter + Time.days(56) + dates.corpus = dates.easter + Time.days(60) + return dates +end + +function puts (...) + for k, v in pairs{...} do io.write(tostring(v):sub(6, 10), "\t") end +end + +function show (year, d) + io.write(year, "\t") + puts(d.easter, d.ascension, d.pentecost, d.trinity, d.corpus) + print() +end + +print("Year\tEaster\tAscen.\tPent.\tTrinity\tCorpus") +for year = 1600, 2100, 100 do show(year, holidays(year)) end +for year = 2010, 2020 do show(year, holidays(year)) end diff --git a/Task/Holidays-related-to-Easter/PowerShell/holidays-related-to-easter-1.psh b/Task/Holidays-related-to-Easter/PowerShell/holidays-related-to-easter-1.psh new file mode 100644 index 0000000000..d7a335dc88 --- /dev/null +++ b/Task/Holidays-related-to-Easter/PowerShell/holidays-related-to-easter-1.psh @@ -0,0 +1,71 @@ +function Get-Easter +{ + [CmdletBinding()] + [OutputType([PSCustomObject])] + Param + ( + [Parameter(Mandatory=$true, + ValueFromPipeline=$true, + ValueFromPipelineByPropertyName=$true, + Position=0)] + [int] + $Year + ) + + Begin + { + $holidayOffset = [ordered]@{ + Easter = 0 + Ascension = 39 + Pentecost = 49 + Trinity = 56 + Corpus = 60 + } + + function Get-DateOfEaster ([int]$Year) + { + [int]$a = $Year % 19 + [int]$b = [Math]::Truncate($Year / 100) + [int]$c = $Year % 100 + [int]$d = [Math]::Truncate($b / 4) + [int]$e = $b % 4 + [int]$f = [Math]::Truncate(($b + 8) / 25) + [int]$g = [Math]::Truncate(($b - $f + 1) / 3) + [int]$h = ((19 * $a) + $b - $d - $g + 15) % 30 + [int]$i = [Math]::Truncate($c / 4) + [int]$j = $c % 4 + [int]$k = (32 + 2 * ($e + $i) - $h - $j) % 7 + [int]$l = [Math]::Truncate(($a + (11 * $h) + (22 * $k)) / 451) + [int]$m = [Math]::Truncate(($h + $k - (7 * $l) + 114) / 31) + [int]$d = (($h + $k - (7 * $l) + 114) % 31) + 1 + + Get-Date -Year $Year -Month $m -Day $d + } + + function Get-Holiday ([int]$Year) + { + $easter = Get-DateOfEaster -Year $Year + + $holidays = foreach ($key in $holidayOffset.Keys) + { + $easter.AddDays($holidayOffset.$key) + } + + [PSCustomObject]@{ + Year = $Year + Easter = $holidays[0].ToString("ddd dd MMM") + Ascension = $holidays[1].ToString("ddd dd MMM") + Pentecost = $holidays[2].ToString("ddd dd MMM") + Trinity = $holidays[3].ToString("ddd dd MMM") + Corpus = $holidays[4].ToString("ddd dd MMM") + } + } + } + Process + { + foreach ($y in $Year) + { + Get-Holiday -Year $y + } + } +} diff --git a/Task/Holidays-related-to-Easter/PowerShell/holidays-related-to-easter-2.psh b/Task/Holidays-related-to-Easter/PowerShell/holidays-related-to-easter-2.psh new file mode 100644 index 0000000000..15e2ef3928 --- /dev/null +++ b/Task/Holidays-related-to-Easter/PowerShell/holidays-related-to-easter-2.psh @@ -0,0 +1,8 @@ +$years = for ($i = 400; $i -le 2100; $i+=100) {$i} +$years0400to2100 = $years | Get-Easter +$years2010to2020 = 2010..2020 | Get-Easter + +Write-Host "Christian holidays, related to Easter, for each centennial from 400 to 2100 AD:" +$years0400to2100 | Format-Table +Write-Host "Christian holidays, related to Easter, for years from 2010 to 2020 AD:" +$years2010to2020 | Format-Table diff --git a/Task/Honeycombs/Java/honeycombs.java b/Task/Honeycombs/Java/honeycombs.java new file mode 100644 index 0000000000..dbc6a6093e --- /dev/null +++ b/Task/Honeycombs/Java/honeycombs.java @@ -0,0 +1,131 @@ +import java.awt.*; +import java.awt.event.*; +import javax.swing.*; + +public class Honeycombs extends JFrame { + + public static void main(String[] args) { + SwingUtilities.invokeLater(() -> { + JFrame f = new Honeycombs(); + f.setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE); + f.setVisible(true); + }); + } + + public Honeycombs() { + add(new HoneycombsPanel(), BorderLayout.CENTER); + setTitle("Honeycombs"); + setResizable(false); + pack(); + setLocationRelativeTo(null); + } +} + +class HoneycombsPanel extends JPanel { + + Hexagon[] comb; + + public HoneycombsPanel() { + setPreferredSize(new Dimension(600, 500)); + setBackground(Color.white); + setFocusable(true); + + addMouseListener(new MouseAdapter() { + @Override + public void mousePressed(MouseEvent e) { + for (Hexagon hex : comb) + if (hex.contains(e.getX(), e.getY())) { + hex.setSelected(); + break; + } + repaint(); + } + }); + + addKeyListener(new KeyAdapter() { + @Override + public void keyPressed(KeyEvent e) { + for (Hexagon hex : comb) + if (hex.letter == Character.toUpperCase(e.getKeyChar())) { + hex.setSelected(); + break; + } + repaint(); + } + }); + + char[] letters = "LRDGITPFBVOKANUYCESM".toCharArray(); + comb = new Hexagon[20]; + + int x1 = 150, y1 = 100, x2 = 225, y2 = 143, w = 150, h = 87; + for (int i = 0; i < comb.length; i++) { + int x, y; + if (i < 12) { + x = x1 + (i % 3) * w; + y = y1 + (i / 3) * h; + } else { + x = x2 + (i % 2) * w; + y = y2 + ((i - 12) / 2) * h; + } + comb[i] = new Hexagon(x, y, w / 3, letters[i]); + } + + requestFocus(); + } + + @Override + public void paintComponent(Graphics gg) { + super.paintComponent(gg); + Graphics2D g = (Graphics2D) gg; + g.setRenderingHint(RenderingHints.KEY_ANTIALIASING, + RenderingHints.VALUE_ANTIALIAS_ON); + + g.setFont(new Font("SansSerif", Font.BOLD, 30)); + g.setStroke(new BasicStroke(3)); + + for (Hexagon hex : comb) + hex.draw(g); + } +} + +class Hexagon extends Polygon { + final Color baseColor = Color.yellow; + final Color selectedColor = Color.magenta; + final char letter; + + private boolean hasBeenSelected; + + Hexagon(int x, int y, int halfWidth, char c) { + letter = c; + for (int i = 0; i < 6; i++) + addPoint((int) (x + halfWidth * Math.cos(i * Math.PI / 3)), + (int) (y + halfWidth * Math.sin(i * Math.PI / 3))); + getBounds(); + } + + void setSelected() { + hasBeenSelected = true; + } + + void draw(Graphics2D g) { + g.setColor(hasBeenSelected ? selectedColor : baseColor); + g.fillPolygon(this); + + g.setColor(Color.black); + g.drawPolygon(this); + + g.setColor(hasBeenSelected ? Color.black : Color.red); + drawCenteredString(g, String.valueOf(letter)); + } + + void drawCenteredString(Graphics2D g, String s) { + FontMetrics fm = g.getFontMetrics(); + int asc = fm.getAscent(); + int dec = fm.getDescent(); + + int x = bounds.x + (bounds.width - fm.stringWidth(s)) / 2; + int y = bounds.y + (asc + (bounds.height - (asc + dec)) / 2); + + g.drawString(s, x, y); + } +} diff --git a/Task/Honeycombs/Liberty-BASIC/honeycombs.liberty b/Task/Honeycombs/Liberty-BASIC/honeycombs.liberty new file mode 100644 index 0000000000..af98e3752b --- /dev/null +++ b/Task/Honeycombs/Liberty-BASIC/honeycombs.liberty @@ -0,0 +1,137 @@ +NoMainWin +Dim hxc(20,2), ltr(26) +Global sw, sh, radius, radChk, mx, my, h$, last +h$="#g": radius = 40: radChk = 35 * 35: last = 0 +sw = 400: sh = 380: WindowWidth = sw+6: WindowHeight= sh+32 +Open "Liberty BASIC - Honeycombs" For graphics_nsb_nf As #g +#g "Down; Cls; TrapClose xit" + +Call shuffle +Call grid 75, 15, "0 0 0", "255 215 32", "0 0 0" + +#g "SetFocus; when characterInput getKey; when leftButtonDown chkClick" +Wait + +Sub xit h$ + Close #h$:End +End Sub + +'Assign ASCII values of A thru Z to ltr() array and randomize order of letters +Sub shuffle + For i = 1 To 26 + ltr(i) = i+64 + Next + For i = 1 To 77 + r1 = Int(Rnd(1)*26)+1 + r2 = Int(Rnd(1)*26)+1 + temp = ltr(r1): ltr(r1) = ltr(r2): ltr(r2) = temp + Next +End Sub + +'Draw the hex cells and fill with 20 out of 26 random letters +Sub grid ox, oy, fc$, bc$, tc$ + cx = ox: cy = oy + For i = 1 To 5 + If (i And 1)=0 Then cy = oy + 76 Else cy = oy + 42 + For j = 1 To 4 + count = count + 1: letter$ = Chr$(ltr(count)) + Call cell, cx, cy, fc$, bc$, tc$, letter$ + hxc(count,0)=cx: hxc(count,1)=cy: cy = cy + 70 + Next + cx = cx + 61 + Next +End Sub + +'Draw a filled hex cell and printed the letter associated with cell +Sub cell cx, cy, fc$, bc$, tc$, lt$ + lastx = cx + radius: lasty = cy + For f = 1.04719755 To 6.2831853 Step 1.0471955 + nx = Cos(f)*radius+cx: ny = Sin(f)*radius+cy + #g "Size 2; Color ";bc$;";BackColor ";bc$ + Call triFill cx, cy, lastx, lasty, nx, ny + #g "Size 5; Color ";fc$ + #g "Line ";lastx;" ";lasty;" ";nx;" ";ny;";Size 1" + lastx = nx: lasty = ny + Next + #g "Font Courier_New 36 Bold" + #g "Color ";tc$;";BackColor ";bc$ + #g "Place ";cx-15;" ";cy+15;";\";lt$ +End Sub + +'Check for a mouse click in a hex cell +Sub chkClick h$, x, y + mx = MouseX + my = MouseY + For i = 1 To 20 + If pnc(mx,my,hxc(i,0),hxc(i,1)) = 1 Then 'selected hex cell found + If hxc(i,2)=0 Then + hxc(i,2)=1 'when set to 1, hex cell & letter no longer selectable + key$ = Chr$(ltr(i)) + Call cell hxc(i,0),hxc(i,1),"0 0 0","80 0 128","255 255 255",key$ + Call showLetter key$ + Exit For + End If + End If + Next +End Sub + +'Allow letter selection via keyboard +Sub getKey h$, char$ + key$ = Upper$(Inkey$) + 'Poll ESC key to exit at any time + If key$=Chr$(27) Then Call xit h$ + idx = Instr("ABCDEFGHIJKLMNOPQRSTUVWXYZ",key$) + If idx <> 0 Then + For i = 1 To 20 + If idx+64 = ltr(i) Then 'letter matching key press found + If hxc(i,2)=0 Then + hxc(i,2)=1 'when set to 1, hex cell & letter no longer selectable + Call cell hxc(i,0),hxc(i,1),"0 0 0","80 0 128","255 255 255",key$ + Call showLetter key$ + Exit For + End If + End If + Next + End If +End Sub + +'Print letters selected at bottom of screen +Sub showLetter key$ + #g "Font Courier_New 18 Bold" + #g "Color Black;BackColor white" + #g "Place ";last*18+20;" 365;\"; key$ + last = last + 1 + 'When 20th letter selected; exit + If last > 19 Then Call xit h$ +End Sub + +'Draw a filled triangle +Sub triFill x1,y1, x2,y2, x3,y3 + If x2x3 Then slope1=(y3-y1)/(x3-x1) + length=x2-x1 + If length<>0 Then + slope2=(y2-y1)/(x2-x1) + For x = 0 To length + #g "Line ";Int(x+x1);" ";Int(x*slope1+y1);" ";Int(x+x1);" ";Int(x*slope2+y1) + Next + End If + y = length*slope1+y1 :length=x3-x2 + If length<>0 Then + slope3=(y3-y2)/(x3-x2) + For x = 0 To length + #g "Line ";Int(x+x2);" ";Int(x*slope1+y);" ";Int(x+x2);" ";Int(x*slope3+y2) + Next + End If +End Sub + +'Point in Circle function +Function pnc(ax, ay, bx, by) + If (bx-ax)*(bx-ax)+(by-ay)*(by-ay) <= radChk Then + pnc=1 + Else + pnc=0 + End If +End Function diff --git a/Task/Horizontal-sundial-calculations/00DESCRIPTION b/Task/Horizontal-sundial-calculations/00DESCRIPTION index c7fc56d4d1..d8011347f1 100644 --- a/Task/Horizontal-sundial-calculations/00DESCRIPTION +++ b/Task/Horizontal-sundial-calculations/00DESCRIPTION @@ -1,5 +1,10 @@ +;Task: Create a program that calculates the hour, sun hour angle, dial hour line angle from 6am to 6pm for an ''operator'' entered location. + For example, the user is prompted for a location and inputs the latitude and longitude 4°57′S 150°30′W (4.95°S 150.5°W of [[wp:Jules Verne|Jules Verne]]'s ''[[wp:The Mysterious Island|Lincoln Island]]'', aka ''[[wp:Ernest Legouve Reef|Ernest Legouve Reef]])'', with a legal meridian of 150°W. -Wikipedia: A [[wp:sundial|sundial]] is a device that measures time by the position of the [[wp:Sun|Sun]]. In common designs such as the horizontal sundial, the sun casts a [[wp:shadow|shadow]] from its ''style'' (also called its [[wp:Gnomon|Gnomon]], a thin rod or a sharp, straight edge) onto a flat surface marked with lines indicating the hours of the day. As the sun moves across the sky, the shadow-edge progressively aligns with different hour-lines on the plate. Such designs rely on the style being aligned with the axis of the Earth's rotation. Hence, if such a sundial is to tell the correct time, the style must point towards [[wp:true north|true north]] (not the [[wp:North Magnetic Pole|north]] or [[wp:Magnetic South Pole|south magnetic pole]]) and the style's angle with horizontal must equal the sundial's geographical [[wp:latitude|latitude]]. +(Note: the "meridian" is approximately the same concept as the "longitude" - the distinction is that the meridian is used to determine when it is "noon" for official purposes. This will typically be slightly different from when the sun appears at its highest location, because of the structure of time zones. For most, but not all, time zones (hour wide zones with hour zero centred on Greenwich), the legal meridian will be an even multiple of 15 degrees.) + +Wikipedia: A [[wp:sundial|sundial]] is a device that measures time by the position of the [[wp:Sun|Sun]]. In common designs such as the horizontal sundial, the sun casts a [[wp:shadow|shadow]] from its ''style'' (also called its [[wp:Gnomon|Gnomon]], a thin rod or a sharp, straight edge) onto a flat surface marked with lines indicating the hours of the day (also called the [[wp:Sundial#Terminology|dial face]] or dial plate). As the sun moves across the sky, the shadow-edge progressively aligns with different hour-lines on the plate. Such designs rely on the style being aligned with the axis of the Earth's rotation. Hence, if such a sundial is to tell the correct time, the style must point towards [[wp:true north|true north]] (not the [[wp:North Magnetic Pole|north]] or [[wp:Magnetic South Pole|south magnetic pole]]) and the style's angle with horizontal must equal the sundial's geographical [[wp:latitude|latitude]]. +

    diff --git a/Task/Horizontal-sundial-calculations/OoRexx/horizontal-sundial-calculations.rexx b/Task/Horizontal-sundial-calculations/OoRexx/horizontal-sundial-calculations.rexx new file mode 100644 index 0000000000..2e02ffc5dd --- /dev/null +++ b/Task/Horizontal-sundial-calculations/OoRexx/horizontal-sundial-calculations.rexx @@ -0,0 +1,38 @@ +/*REXX pgm shows: hour, sun hour angle, dial hour line angle, 6am ---> 6pm*/ +/* Use trigonometric functions provided by rxCalc */ +parse arg lat lng mer . /*get the optional arguments from the CL*/ + /*None specified? Then use the default of Jules */ + /*Verne's Lincoln Island, aka Ernest Legouve Reef.*/ + +if lat=='' | lat==',' then lat=-4.95 /*Not specified? Then use the default.*/ +if lng=='' | lng==',' then lng=-150.5 /* " " " " " " */ +if mer=='' | mer==',' then mer=-150 /* " " " " " " */ +L=max(length(lat), length(lng), length(mer)) +say ' latitude:' right(lat,L) +say ' longitude:' right(lng,L) +say ' legal meridian:' right(mer,L) +sineLat=rxCalcSin(lat,,'D') +w1=max(length('hour') ,length('midnight'))+2 +w2=max(length('sun hour') ,length('angle'))+2 +w3=max(length('dial hour'),length('line angle'))+2 +indent=left('',30) /*make the presentation prettier. */ +say indent center(' ',w1) center('sun hour',w2) center('dial hour' ,w3) +say indent center('hour',w1) center('angle' ,w2) center('line angle',w3) +call sep /*add a separator line for the eyeballs*/ + +do h=-6 to 6 /*Okey dokey then, let's get busy. */ + select + when abs(h)==12 then hc='midnight' /*above the arctic circle? */ + when h<0 then hc=-h 'am' /*convert the hour for human beans. */ + when h==0 then hc='noon' /* ... easier to understand now. */ + when h>0 then hc=h 'pm' /* ... even more meaningful. */ + end /*select*/ + hra=15*h-lng+mer + hla=rxCalcArctan(sineLat*rxCalctan(hra,,'D'),,'D') + say indent center(hc,w1) right(format(hra,,1),w2) right(format(hla,,1),w3) + end +call sep +Exit +sep: say indent copies('-',w1) copies('-',w2) copies('-',w3) + Return +::Requires rxMath Library diff --git a/Task/Horizontal-sundial-calculations/PowerShell/horizontal-sundial-calculations.psh b/Task/Horizontal-sundial-calculations/PowerShell/horizontal-sundial-calculations.psh new file mode 100644 index 0000000000..35f0746cc3 --- /dev/null +++ b/Task/Horizontal-sundial-calculations/PowerShell/horizontal-sundial-calculations.psh @@ -0,0 +1,50 @@ +function Get-Sundial +{ + [CmdletBinding()] + [OutputType([PSCustomObject])] + Param + ( + [Parameter(Mandatory=$true)] + [ValidateRange(-90,90)] + [double] + $Latitude, + + + [Parameter(Mandatory=$true)] + [ValidateRange(-180,180)] + [double] + $Longitude, + + + [Parameter(Mandatory=$true)] + [ValidateRange(-180,180)] + [double] + $Meridian + ) + + [double]$sinLat = [Math]::Sin($Latitude*2*[Math]::PI/360) + + $object = [PSCustomObject]@{ + "Sine of Latitude" = [Math]::Round($sinLat,3) + "Longitude Difference" = $Longitude - $Meridian + } + + [int[]]$hours = -6..6 + + $hoursArray = foreach ($hour in $hours) + { + [double]$hra = (15 * $hour) - ($Longitude - $Meridian) + [double]$hla = [Math]::Atan($sinLat*[Math]::Tan($hra*2*[Math]::PI/360))*360/(2*[Math]::PI) + [PSCustomObject]@{ + "Hour" = "{0,8}" -f ((Get-Date -Hour ($hour + 12) -Minute 0).ToString("t")) + "Sun Hour Angle" = [Math]::Round($hra,3) + "Dial Hour Line Angle" = [Math]::Round($hla,3) + } + } + + $object | Add-Member -MemberType NoteProperty -Name Hours -Value $hoursArray -PassThru +} + +$sundial = Get-Sundial -Latitude -4.95 -Longitude -150.5 -Meridian -150 +$sundial | Select-Object -Property "Sine of Latitude", "Longitude Difference" | Format-List +$sundial.Hours | Format-Table -AutoSize diff --git a/Task/Horizontal-sundial-calculations/ZX-Spectrum-Basic/horizontal-sundial-calculations.zx b/Task/Horizontal-sundial-calculations/ZX-Spectrum-Basic/horizontal-sundial-calculations.zx new file mode 100644 index 0000000000..4d29f011ca --- /dev/null +++ b/Task/Horizontal-sundial-calculations/ZX-Spectrum-Basic/horizontal-sundial-calculations.zx @@ -0,0 +1,17 @@ +10 DEF FN r(x)=x*PI/180 +20 DEF FN d(x)=x*180/PI +30 INPUT "Enter latitude (degrees): ";latitude +40 INPUT "Enter longitude (degrees): ";longitude +50 INPUT "Enter legal meridian (degrees): ";meridian +60 PRINT "Latitude: ";latitude +70 PRINT "Longitude:";longitude +80 PRINT "Legal meridian: ";meridian +90 PRINT '" Sun Dial" +100 PRINT "Time hour angle hour line ang." +110 PRINT "________________________________" +120 FOR h=6 TO 18 +130 LET hra=15*h-longitude+meridian-180 +140 LET hla=FN d(ATN (SIN (FN r(latitude))*TAN (FN r(hra)))) +150 IF ABS (hra)>90 THEN LET hla=hla+180*SGN (hra*latitude) +160 PRINT h;" ";hra;" ";hla +170 NEXT h diff --git a/Task/Horners-rule-for-polynomial-evaluation/Common-Lisp/horners-rule-for-polynomial-evaluation.lisp b/Task/Horners-rule-for-polynomial-evaluation/Common-Lisp/horners-rule-for-polynomial-evaluation-1.lisp similarity index 100% rename from Task/Horners-rule-for-polynomial-evaluation/Common-Lisp/horners-rule-for-polynomial-evaluation.lisp rename to Task/Horners-rule-for-polynomial-evaluation/Common-Lisp/horners-rule-for-polynomial-evaluation-1.lisp diff --git a/Task/Horners-rule-for-polynomial-evaluation/Common-Lisp/horners-rule-for-polynomial-evaluation-2.lisp b/Task/Horners-rule-for-polynomial-evaluation/Common-Lisp/horners-rule-for-polynomial-evaluation-2.lisp new file mode 100644 index 0000000000..1758ec1dc1 --- /dev/null +++ b/Task/Horners-rule-for-polynomial-evaluation/Common-Lisp/horners-rule-for-polynomial-evaluation-2.lisp @@ -0,0 +1,7 @@ +(defun horner (x a) + (loop :with y = 0 + :for i :from (1- (length a)) :downto 0 + :do (setf y (+ (aref a i) (* y x))) + :finally (return y))) + +(horner 1.414 #(-2 0 1)) diff --git a/Task/Horners-rule-for-polynomial-evaluation/Fortran/horners-rule-for-polynomial-evaluation-2.f b/Task/Horners-rule-for-polynomial-evaluation/Fortran/horners-rule-for-polynomial-evaluation-2.f index 9a8bdab124..396ffe2c36 100644 --- a/Task/Horners-rule-for-polynomial-evaluation/Fortran/horners-rule-for-polynomial-evaluation-2.f +++ b/Task/Horners-rule-for-polynomial-evaluation/Fortran/horners-rule-for-polynomial-evaluation-2.f @@ -2,9 +2,9 @@ IMPLICIT NONE INTEGER I,N DOUBLE PRECISION A(N),X,Y,HORNER - Y=A(N) - DO I=N-1,1,-1 - Y=Y*X+A(I) + Y = A(N) + DO I = N - 1,1,-1 + Y = Y*X + A(I) END DO HORNER=Y END diff --git a/Task/Horners-rule-for-polynomial-evaluation/Fortran/horners-rule-for-polynomial-evaluation-3.f b/Task/Horners-rule-for-polynomial-evaluation/Fortran/horners-rule-for-polynomial-evaluation-3.f index e931074893..d68fbade5a 100644 --- a/Task/Horners-rule-for-polynomial-evaluation/Fortran/horners-rule-for-polynomial-evaluation-3.f +++ b/Task/Horners-rule-for-polynomial-evaluation/Fortran/horners-rule-for-polynomial-evaluation-3.f @@ -1,14 +1,14 @@ SUBROUTINE HORNER2(N,A,X,Y,Z) C COMPUTE POLYNOMIAL VALUE AND DERIVATIVE C SEE "ROUNDOFF IN POLYNOMIAL EVALUATION", W. KAHAN, 1986 -C POLY: A(1)+A(2)*X+...+A(N)*X**(N-1) +C POLY: A(1) + A(2)*X + ... + A(N)*X**(N-1) C Y: VALUE, Z: DERIVATIVE IMPLICIT NONE INTEGER I,N DOUBLE PRECISION A(N),X,Y,Z - Z=0.0D0 - Y=A(N) - DO 10 I=N-1,1,-1 - Z=Z*X+Y - 10 Y=Y*X+A(I) + Z = 0.0D0 + Y = A(N) + DO 10 I = N - 1,1,-1 + Z = Z*X + Y + 10 Y = Y*X + A(I) END diff --git a/Task/Horners-rule-for-polynomial-evaluation/Oberon-2/horners-rule-for-polynomial-evaluation.oberon-2 b/Task/Horners-rule-for-polynomial-evaluation/Oberon-2/horners-rule-for-polynomial-evaluation.oberon-2 new file mode 100644 index 0000000000..a1d14b84fa --- /dev/null +++ b/Task/Horners-rule-for-polynomial-evaluation/Oberon-2/horners-rule-for-polynomial-evaluation.oberon-2 @@ -0,0 +1,28 @@ +MODULE HornerRule; +IMPORT + Out; + +TYPE + Coefs = POINTER TO ARRAY OF LONGINT; +VAR + coefs: Coefs; + +PROCEDURE Eval(coefs: ARRAY OF LONGINT;size,x: LONGINT): LONGINT; +VAR + i,acc: LONGINT; +BEGIN + acc := 0; + FOR i := LEN(coefs) - 1 TO 0 BY -1 DO + acc := acc * x + coefs[i] + END; + RETURN acc +END Eval; + +BEGIN + NEW(coefs,4); + coefs[0] := -19; + coefs[1] := 7; + coefs[2] := -4; + coefs[3] := 6; + Out.Int(Eval(coefs^,4,3),0);Out.Ln +END HornerRule. diff --git a/Task/Horners-rule-for-polynomial-evaluation/R/horners-rule-for-polynomial-evaluation-1.r b/Task/Horners-rule-for-polynomial-evaluation/R/horners-rule-for-polynomial-evaluation-1.r index f5ff5b6abc..8ab73ba331 100644 --- a/Task/Horners-rule-for-polynomial-evaluation/R/horners-rule-for-polynomial-evaluation-1.r +++ b/Task/Horners-rule-for-polynomial-evaluation/R/horners-rule-for-polynomial-evaluation-1.r @@ -1,9 +1,9 @@ horner <- function(a, x) { - iv <- 0 - for(i in length(a):1) { - iv <- iv * x + a[i] + y <- 0 + for(c in rev(a)) { + y <- y * x + c } - iv + y } cat(horner(c(-19, 7, -4, 6), 3), "\n") diff --git a/Task/Horners-rule-for-polynomial-evaluation/REXX/horners-rule-for-polynomial-evaluation-1.rexx b/Task/Horners-rule-for-polynomial-evaluation/REXX/horners-rule-for-polynomial-evaluation-1.rexx index 7050cba02a..aa5cab3ea2 100644 --- a/Task/Horners-rule-for-polynomial-evaluation/REXX/horners-rule-for-polynomial-evaluation-1.rexx +++ b/Task/Horners-rule-for-polynomial-evaluation/REXX/horners-rule-for-polynomial-evaluation-1.rexx @@ -1,25 +1,19 @@ -/*REXX program shows using Horner's rule for polynomial evaluation.*/ -numeric digits 30 /*use extra numeric precision. */ -parse arg x poly /*get value of X and coefficients*/ -equ= /*start with equation clean slate*/ - /*works for any degree equation. */ - do deg=0 until poly=='' /*get the equation's coefficients*/ - parse var poly c.deg poly /*get a equation coefficient.*/ - c.deg = c.deg / 1 /*normalize it (by dividing by 1)*/ - if c.deg>=0 then c.deg = '+'c.deg /*if ¬ neg, then prefix a + sign.*/ - equ=equ c.deg /*concatenate it to the equation.*/ - if deg\==0 & c.deg\=0 then equ= , /*if not the first coefficient & */ - equ'∙x^'deg /* not 0, append power (^) of X.*/ - equ = equ ' ' /*insert some blanks, look pretty*/ - end /*deg*/ - -say ' x = ' x -say ' degree = ' deg -say ' equation = ' equ -a=c.deg - do j=deg by -1 for deg /*apply Horner's rule.*/ - _ = j-1 - a = a*x + c._ - end /*j*/ -say -say ' answer = ' a /*stick a fork in it, we're done.*/ +/*REXX program demonstrates using Horner's rule for polynomial evaluation. */ +numeric digits 30 /*use extra numeric precision. */ +parse arg x poly /*get value of X and the coefficients. */ +$= /*start with a clean slate equation. */ + do deg=0 until poly=='' /*get the equation's coefficients. */ + parse var poly c.deg poly; c.deg=c.deg/1 /*get equation coefficient & normalize.*/ + if c.deg>=0 then c.deg= '+'c.deg /*if ¬ negative, then prefix with a + */ + $=$ c.deg /*concatenate it to the equation. */ + if deg\==0 & c.deg\=0 then $=$'∙x^'deg /*¬1st coefficient & ¬0? Append X pow.*/ + $=$ ' ' /*insert some blanks, make it look nice*/ + end /*deg*/ +say ' x = ' x +say ' degree = ' deg +say ' equation = ' $ +a=c.deg /*A: is the accumulator (or answer). */ + do j=deg-1 by -1 for deg; a=a*x+c.j /*apply Horner's rule to the equations.*/ + end /*j*/ +say /*display a blank line for readability.*/ +say ' answer = ' a /*stick a fork in it, we're all done. */ diff --git a/Task/Hostname/00DESCRIPTION b/Task/Hostname/00DESCRIPTION index d6241dbee7..0cd4fac22e 100644 --- a/Task/Hostname/00DESCRIPTION +++ b/Task/Hostname/00DESCRIPTION @@ -1 +1,3 @@ +;Task: Find the name of the host on which the routine is running. +

    diff --git a/Task/Hough-transform/00DESCRIPTION b/Task/Hough-transform/00DESCRIPTION index 870a252c10..e3e0006922 100644 --- a/Task/Hough-transform/00DESCRIPTION +++ b/Task/Hough-transform/00DESCRIPTION @@ -1,4 +1,7 @@ -Implement the [[wp:Hough transform|Hough transform]], which is used as part of feature extraction with digital images. It is a tool that makes it far easier to identify straight lines in the source image, whatever their orientation. +;Task: +Implement the [[wp:Hough transform|Hough transform]], which is used as part of feature extraction with digital images. + +It is a tool that makes it far easier to identify straight lines in the source image, whatever their orientation. The transform maps each point in the target image, (\rho,\theta), to the average color of the pixels on the corresponding line of the source image (in (x,y)-space, where the line corresponds to points of the form x\cos\theta + y\sin\theta = \rho). The idea is that where there is a straight line in the original image, it corresponds to a bright (or dark, depending on the color of the background field) spot; by applying a suitable filter to the results of the transform, it is possible to extract the locations of the lines in the original image. @@ -6,3 +9,4 @@ The transform maps each point in the target image, (\rho,\theta), t The target space actually uses polar coordinates, but is conventionally plotted on rectangular coordinates for display. There's no specification of exactly how to map polar coordinates to a flat surface for display, but a convenient method is to use one axis for \theta and the other for \rho, with the center of the source image being the origin. There is also a spherical Hough transform, which is more suited to identifying planes in 3D data. +

    diff --git a/Task/Hough-transform/Kotlin/hough-transform.kotlin b/Task/Hough-transform/Kotlin/hough-transform.kotlin new file mode 100644 index 0000000000..118cad676f --- /dev/null +++ b/Task/Hough-transform/Kotlin/hough-transform.kotlin @@ -0,0 +1,93 @@ +import java.awt.image.* +import java.io.File +import javax.imageio.* + +internal class ArrayData(val dataArray: IntArray, val width: Int, val height: Int) { + + constructor(width: Int, height: Int) : this(IntArray(width * height), width, height) { + } + + operator fun get(x: Int, y: Int) = dataArray[y * width + x] + + operator fun set(x: Int, y: Int, value: Int) { + dataArray[y * width + x] = value + } + + operator fun invoke(thetaAxisSize: Int, rAxisSize: Int, minContrast: Int): ArrayData { + val maxRadius = Math.ceil(Math.hypot(width.toDouble(), height.toDouble())).toInt() + val halfRAxisSize = rAxisSize.ushr(1) + val outputData = ArrayData(thetaAxisSize, rAxisSize) + // x output ranges from 0 to pi + // y output ranges from -maxRadius to maxRadius + val sinTable = DoubleArray(thetaAxisSize) + val cosTable = DoubleArray(thetaAxisSize) + for (theta in thetaAxisSize - 1 downTo 0) { + val thetaRadians = theta * Math.PI / thetaAxisSize + sinTable[theta] = Math.sin(thetaRadians) + cosTable[theta] = Math.cos(thetaRadians) + } + + for (y in height - 1 downTo 0) + for (x in width - 1 downTo 0) + if (contrast(x, y, minContrast)) + for (theta in thetaAxisSize - 1 downTo 0) { + val r = cosTable[theta] * x + sinTable[theta] * y + val rScaled = Math.round(r * halfRAxisSize / maxRadius).toInt() + halfRAxisSize + outputData.accumulate(theta, rScaled, 1) + } + + return outputData + } + + fun writeOutputImage(filename: String) { + val max = dataArray.max()!! + val image = BufferedImage(width, height, BufferedImage.TYPE_INT_ARGB) + for (y in 0..height - 1) + for (x in 0..width - 1) { + val n = Math.min(Math.round(this[x, y] * 255.0 / max).toInt(), 255) + image.setRGB(x, height - 1 - y, n shl 16 or (n shl 8) or 0x90 or -0x01000000) + } + + ImageIO.write(image, "PNG", File(filename)) + } + + private fun accumulate(x: Int, y: Int, delta: Int) { + set(x, y, get(x, y) + delta) + } + + private fun contrast(x: Int, y: Int, minContrast: Int): Boolean { + val centerValue = get(x, y) + for (i in 8 downTo 0) + if (i != 4) { + val newx = x + i % 3 - 1 + val newy = y + i / 3 - 1 + if (newx >= 0 && newx < width && newy >= 0 && newy < height + && Math.abs(get(newx, newy) - centerValue) >= minContrast) + return true + } + return false + } +} + +internal fun readInputFromImage(filename: String): ArrayData { + val image = ImageIO.read(File(filename)) + val w = image.width + val h = image.height + val rgbData = image.getRGB(0, 0, w, h, null, 0, w) + // flip y axis when reading image + val array = ArrayData(w, h) + for (y in 0..h - 1) + for (x in 0..w - 1) { + var rgb = rgbData[y * w + x] + rgb = ((rgb and 0xFF0000).ushr(16) * 0.30 + (rgb and 0xFF00).ushr(8) * 0.59 + (rgb and 0xFF) * 0.11).toInt() + array[x, h - 1 - y] = rgb + } + + return array +} + +fun main(args: Array) { + val inputData = readInputFromImage(args[0]) + val minContrast = if (args.size >= 4) 64 else args[4].toInt() + inputData(args[2].toInt(), args[3].toInt(), minContrast).writeOutputImage(args[1]) +} diff --git a/Task/Hough-transform/Scala/hough-transform.scala b/Task/Hough-transform/Scala/hough-transform.scala new file mode 100644 index 0000000000..59ddf3dcb5 --- /dev/null +++ b/Task/Hough-transform/Scala/hough-transform.scala @@ -0,0 +1,83 @@ +import java.awt.image._ +import java.io.File +import javax.imageio._ + +object HoughTransform extends App { + override def main(args: Array[String]) { + val inputData = readDataFromImage(args(0)) + val minContrast = if (args.length >= 4) 64 else args(4).toInt + inputData(args(2).toInt, args(3).toInt, minContrast).writeOutputImage(args(1)) + } + + private def readDataFromImage(filename: String) = { + val image = ImageIO.read(new File(filename)) + val width = image.getWidth + val height = image.getHeight + val rgbData = image.getRGB(0, 0, width, height, null, 0, width) + val arrayData = new ArrayData(width, height) + for (y <- 0 until height; x <- 0 until width) { + var rgb = rgbData(y * width + x) + rgb = (((rgb & 0xFF0000) >>> 16) * 0.30 + ((rgb & 0xFF00) >>> 8) * 0.59 + + (rgb & 0xFF) * 0.11).toInt + arrayData(x, height - 1 - y) = rgb + } + arrayData + } +} + +class ArrayData(val width: Int, val height: Int) { + def update(x: Int, y: Int, value: Int) { + dataArray(x)(y) = value + } + + def apply(thetaAxisSize: Int, rAxisSize: Int, minContrast: Int) = { + val maxRadius = Math.ceil(Math.hypot(width, height)).toInt + val halfRAxisSize = rAxisSize >>> 1 + val outputData = new ArrayData(thetaAxisSize, rAxisSize) + val sinTable = Array.ofDim[Double](thetaAxisSize) + val cosTable = sinTable.clone() + for (theta <- thetaAxisSize - 1 until -1 by -1) { + val thetaRadians = theta * Math.PI / thetaAxisSize + sinTable(theta) = Math.sin(thetaRadians) + cosTable(theta) = Math.cos(thetaRadians) + } + for (y <- height - 1 until -1 by -1; x <- width - 1 until -1 by -1) + if (contrast(x, y, minContrast)) + for (theta <- thetaAxisSize - 1 until -1 by -1) { + val r = cosTable(theta) * x + sinTable(theta) * y + val rScaled = Math.round(r * halfRAxisSize / maxRadius).toInt + halfRAxisSize + outputData.dataArray(theta)(rScaled) += 1 + } + + outputData + } + + def writeOutputImage(filename: String) { + var max = Int.MinValue + for (y <- 0 until height; x <- 0 until width) { + val v = dataArray(x)(y) + if (v > max) max = v + } + val image = new BufferedImage(width, height, BufferedImage.TYPE_INT_ARGB) + for (y <- 0 until height; x <- 0 until width) { + val n = Math.min(Math.round(dataArray(x)(y) * 255.0 / max).toInt, 255) + image.setRGB(x, height - 1 - y, (n << 16) | (n << 8) | 0x90 | -0x01000000) + } + ImageIO.write(image, "PNG", new File(filename)) + } + + private def contrast(x: Int, y: Int, minContrast: Int): Boolean = { + val centerValue = dataArray(x)(y) + for (i <- 8 until -1 by -1 if i != 4) { + val newx = x + (i % 3) - 1 + val newy = y + (i / 3) - 1 + if (newx >= 0 && newx < width && newy >= 0 && newy < height && + Math.abs(dataArray(newx)(newy) - centerValue) >= minContrast) + return true + } + + false + } + + private val dataArray = Array.ofDim[Int](width, height) +} diff --git a/Task/Huffman-coding/00DESCRIPTION b/Task/Huffman-coding/00DESCRIPTION index 000609ea64..a63eaf1c76 100644 --- a/Task/Huffman-coding/00DESCRIPTION +++ b/Task/Huffman-coding/00DESCRIPTION @@ -17,6 +17,12 @@ A Huffman encoding can be computed by first creating a tree of nodes: ## Add the new node to the queue. # The remaining node is the root node and the tree is complete. +
    Traverse the constructed binary tree from root to leaves assigning and accumulating a '0' for one branch and a '1' for the other at each node. The accumulated zeros and ones at each leaf constitute a Huffman encoding for those symbols and weights: -'''Using the characters and their frequency from the string ''"this is an example for huffman encoding"'', create a program to generate a Huffman encoding for each character as a table.''' + +;Task: +Using the characters and their frequency from the string: +:::::   ''' '' this is an example for huffman encoding '' ''' +create a program to generate a Huffman encoding for each character as a table. +

    diff --git a/Task/Huffman-coding/C/huffman-coding-2.c b/Task/Huffman-coding/C/huffman-coding-2.c index 9c33cacbdc..feecbeab0f 100644 --- a/Task/Huffman-coding/C/huffman-coding-2.c +++ b/Task/Huffman-coding/C/huffman-coding-2.c @@ -106,7 +106,8 @@ void decode(const char *s, node t) int main(void) { int i; - const char *str = "this is an example for huffman encoding", buf[1024]; + const char *str = "this is an example for huffman encoding"; + char buf[1024]; init(str); for (i = 0; i < 128; i++) diff --git a/Task/Huffman-coding/Kotlin/huffman-coding.kotlin b/Task/Huffman-coding/Kotlin/huffman-coding.kotlin new file mode 100644 index 0000000000..a486d5f948 --- /dev/null +++ b/Task/Huffman-coding/Kotlin/huffman-coding.kotlin @@ -0,0 +1,52 @@ +abstract class HuffmanTree(var freq: Int) : Comparable { + override fun compareTo(other: HuffmanTree) = freq - other.freq +} + +class HuffmanLeaf(freq: Int, var value: Char) : HuffmanTree(freq) + +class HuffmanNode(var left: HuffmanTree, var right: HuffmanTree) : HuffmanTree(left.freq + right.freq) + +fun buildTree(charFreqs: IntArray) : HuffmanTree { + val trees = PriorityQueue() + + charFreqs.forEachIndexed { index, freq -> + if(freq > 0) trees.offer(HuffmanLeaf(freq, index.toChar())) + } + + assert(trees.size > 0) + while (trees.size > 1) { + val a = trees.poll() + val b = trees.poll() + trees.offer(HuffmanNode(a, b)) + } + + return trees.poll() +} + +fun printCodes(tree: HuffmanTree, prefix: StringBuffer) { + when(tree) { + is HuffmanLeaf -> println("${tree.value}\t${tree.freq}\t$prefix") + is HuffmanNode -> { + //traverse left + prefix.append('0') + printCodes(tree.left, prefix) + prefix.deleteCharAt(prefix.lastIndex) + //traverse right + prefix.append('1') + printCodes(tree.right, prefix) + prefix.deleteCharAt(prefix.lastIndex) + } + } +} + +fun main(args: Array) { + val test = "this is an example for huffman encoding" + + val maxIndex = test.max()!!.toInt() + 1 + val freqs = IntArray(maxIndex) //256 enough for latin ASCII table, but dynamic size is more fun + test.forEach { freqs[it.toInt()] += 1 } + + val tree = buildTree(freqs) + println("SYMBOL\tWEIGHT\tHUFFMAN CODE") + printCodes(tree, StringBuffer()) +} diff --git a/Task/Huffman-coding/Oberon-2/huffman-coding.oberon-2 b/Task/Huffman-coding/Oberon-2/huffman-coding.oberon-2 new file mode 100644 index 0000000000..6c16df7b48 --- /dev/null +++ b/Task/Huffman-coding/Oberon-2/huffman-coding.oberon-2 @@ -0,0 +1,91 @@ +MODULE HuffmanEncoding; +IMPORT + Object, + PriorityQueue, + Strings, + Out; +TYPE + Leaf = POINTER TO LeafDesc; + LeafDesc = RECORD + (Object.ObjectDesc) + c: CHAR; + END; + + Inner = POINTER TO InnerDesc; + InnerDesc = RECORD + (Object.ObjectDesc) + left,right: Object.Object; + END; + +VAR + str: ARRAY 128 OF CHAR; + i: INTEGER; + f: ARRAY 96 OF INTEGER; + q: PriorityQueue.Queue; + a: PriorityQueue.Node; + b: PriorityQueue.Node; + c: PriorityQueue.Node; + h: ARRAY 64 OF CHAR; + +PROCEDURE NewLeaf(c: CHAR): Leaf; +VAR + x: Leaf; +BEGIN + NEW(x);x.c := c; RETURN x +END NewLeaf; + +PROCEDURE NewInner(l,r: Object.Object): Inner; +VAR + x: Inner; +BEGIN + NEW(x); x.left := l; x.right := r; RETURN x +END NewInner; + + +PROCEDURE Preorder(n: Object.Object; VAR x: ARRAY OF CHAR); +BEGIN + IF n IS Leaf THEN + Out.Char(n(Leaf).c);Out.String(": ");Out.String(h);Out.Ln + ELSE + IF n(Inner).left # NIL THEN + Strings.Append("0",x); + Preorder(n(Inner).left,x); + Strings.Delete(x,(Strings.Length(x) - 1),1) + END; + IF n(Inner).right # NIL THEN + Strings.Append("1",x); + Preorder(n(Inner).right,x); + Strings.Delete(x,(Strings.Length(x) - 1),1) + END + END +END Preorder; + +BEGIN + str := "this is an example for huffman encoding"; + + (* Collect letter frecuencies *) + i := 0; + WHILE str[i] # 0X DO INC(f[ORD(CAP(str[i])) - ORD(' ')]);INC(i) END; + + (* Create Priority Queue *) + NEW(q);q.Clear(); + + (* Insert into the queue *) + i := 0; + WHILE (i < LEN(f)) DO + IF f[i] # 0 THEN + q.Insert(f[i]/Strings.Length(str),NewLeaf(CHR(i + ORD(' ')))) + END; + INC(i) + END; + + (* create tree *) + WHILE q.Length() > 1 DO + q.Remove(a);q.Remove(b); + q.Insert(a.w + b.w,NewInner(a.d,b.d)); + END; + + (* tree traversal *) + h[0] := 0X;q.Remove(c);Preorder(c.d,h); + +END HuffmanEncoding. diff --git a/Task/Huffman-coding/Perl-6/huffman-coding-1.pl6 b/Task/Huffman-coding/Perl-6/huffman-coding-1.pl6 index 963aeaa85f..5d0879a286 100644 --- a/Task/Huffman-coding/Perl-6/huffman-coding-1.pl6 +++ b/Task/Huffman-coding/Perl-6/huffman-coding-1.pl6 @@ -1,17 +1,13 @@ -sub huffman ($s) { - my $de = $s.chars; - my @q = $s.comb.classify({$_}).map({[+.value / $de, .key]}).sort; - while @q > 1 { - my ($a,$b) = @q.splice(0,2); - @q = sort flat $[$a[0] + $b[0], [$a[1], $b[1]]], @q; +sub huffman (%frequencies) { + my @queue = %frequencies.map({ [.value, .key] }).sort; + while @queue > 1 { + given @queue.splice(0, 2) -> ([$freq1, $node1], [$freq2, $node2]) { + @queue = (|@queue, [$freq1 + $freq2, [$node1, $node2]]).sort; + } } - sort *.value, gather walk @q[0][1], ''; + hash gather walk @queue[0][1], ''; } -multi walk (@node, $prefix) { - walk @node[0], $prefix ~ 1; - walk @node[1], $prefix ~ 0; -} -multi walk ($node, $prefix) { take $node => $prefix } - -say .perl for huffman('this is an example for huffman encoding'); +multi walk ($node, $prefix) { take $node => $prefix; } +multi walk ([$node1, $node2], $prefix) { walk $node1, $prefix ~ '0'; + walk $node2, $prefix ~ '1'; } diff --git a/Task/Huffman-coding/Perl-6/huffman-coding-2.pl6 b/Task/Huffman-coding/Perl-6/huffman-coding-2.pl6 index 0a66baa1b6..1917e3f124 100644 --- a/Task/Huffman-coding/Perl-6/huffman-coding-2.pl6 +++ b/Task/Huffman-coding/Perl-6/huffman-coding-2.pl6 @@ -1,9 +1,11 @@ -my $str = 'this is an example for huffman encoding'; -my %enc = huffman $str; -my %dec = %enc.invert; -say $str; -my $huf = %enc{$str.comb}.join; -say $huf; -my $rx = join('|', map { "'" ~ .key ~ "'" }, %dec); -$rx = EVAL '/' ~ $rx ~ '/'; -say $huf.subst(/<$rx>/, -> $/ {%dec{~$/}}, :g); +sub huffman (%frequencies) { + my @queue = %frequencies.map: { .value => (hash .key => '') }; + while @queue > 1 { + @queue.=sort; + my $x = @queue.shift; + my $y = @queue.shift; + @queue.push: ($x.key + $y.key) => hash $x.value.deepmap('0' ~ *), + $y.value.deepmap('1' ~ *); + } + @queue[0].value; +} diff --git a/Task/Huffman-coding/Perl-6/huffman-coding-3.pl6 b/Task/Huffman-coding/Perl-6/huffman-coding-3.pl6 new file mode 100644 index 0000000000..76b3ecb3b4 --- /dev/null +++ b/Task/Huffman-coding/Perl-6/huffman-coding-3.pl6 @@ -0,0 +1,3 @@ +for huffman 'this is an example for huffman encoding'.comb.Bag { + say "'{.key}' : {.value}"; +} diff --git a/Task/Huffman-coding/Perl-6/huffman-coding-4.pl6 b/Task/Huffman-coding/Perl-6/huffman-coding-4.pl6 new file mode 100644 index 0000000000..962260e1ad --- /dev/null +++ b/Task/Huffman-coding/Perl-6/huffman-coding-4.pl6 @@ -0,0 +1,10 @@ +my $original = 'this is an example for huffman encoding'; + +my %encode-key = huffman $original.comb.Bag; +my %decode-key = %encode-key.invert; +my @codes = %decode-key.keys; + +my $encoded = $original.subst: /./, { %encode-key{$_} }, :g; +my $decoded = $encoded .subst: /@codes/, { %decode-key{$_} }, :g; + +.say for $original, $encoded, $decoded; diff --git a/Task/Huffman-coding/PowerShell/huffman-coding.psh b/Task/Huffman-coding/PowerShell/huffman-coding.psh new file mode 100644 index 0000000000..56dc0affc7 --- /dev/null +++ b/Task/Huffman-coding/PowerShell/huffman-coding.psh @@ -0,0 +1,61 @@ +function Get-HuffmanEncodingTable ( $String ) + { + # Create leaf nodes + $ID = 0 + $Nodes = [char[]]$String | + Group-Object | + ForEach { $ID++; $_ } | + Select @{ Label = 'Symbol' ; Expression = { $_.Name } }, + @{ Label = 'Count' ; Expression = { $_.Count } }, + @{ Label = 'ID' ; Expression = { $ID } }, + @{ Label = 'Parent' ; Expression = { 0 } }, + @{ Label = 'Code' ; Expression = { '' } } + + # Grow stems under leafs + ForEach ( $Branch in 2..($Nodes.Count) ) + { + # Get the two nodes with the lowest count + $LowNodes = $Nodes | Where Parent -eq 0 | Sort Count | Select -First 2 + + # Create a new stem node + $ID++ + $Nodes += '' | + Select @{ Label = 'Symbol' ; Expression = { '' } }, + @{ Label = 'Count' ; Expression = { $LowNodes[0].Count + $LowNodes[1].Count } }, + @{ Label = 'ID' ; Expression = { $ID } }, + @{ Label = 'Parent' ; Expression = { 0 } }, + @{ Label = 'Code' ; Expression = { '' } } + + # Put the two nodes in the new stem node + $LowNodes[0].Parent = $ID + $LowNodes[1].Parent = $ID + + # Assign 0 and 1 to the left and right nodes + $LowNodes[0].Code = '0' + $LowNodes[1].Code = '1' + } + + # Assign coding to nodes + ForEach ( $Node in $Nodes[($Nodes.Count-2)..0] ) + { + $Node.Code = ( $Nodes | Where ID -eq $Node.Parent ).Code + $Node.Code + } + + $EncodingTable = $Nodes | Where { $_.Symbol } | Select Symbol, Code | Sort Symbol + return $EncodingTable + } + +# Get table for given string +$String = "this is an example for huffman encoding" +$HuffmanEncodingTable = Get-HuffmanEncodingTable $String + +# Display table +$HuffmanEncodingTable | Format-Table -AutoSize + +# Encode string +$EncodedString = $String +ForEach ( $Node in $HuffmanEncodingTable ) + { + $EncodedString = $EncodedString.Replace( $Node.Symbol, $Node.Code ) + } +$EncodedString diff --git a/Task/Huffman-coding/PureBasic/huffman-coding.purebasic b/Task/Huffman-coding/PureBasic/huffman-coding.purebasic index 4e65deba87..f7068f6ffe 100644 --- a/Task/Huffman-coding/PureBasic/huffman-coding.purebasic +++ b/Task/Huffman-coding/PureBasic/huffman-coding.purebasic @@ -12,8 +12,8 @@ Structure ztree right.l EndStructure -Dim memc.c(0) -memc()=@SampleString +Dim memc.c(datalen) +CopyMemory(@SampleString, @memc(0), datalen * SizeOf(Character)) Dim tree.ztree(255) @@ -23,7 +23,7 @@ For i=0 To datalen-1 tree(memc(i))\ischar=1 Next -SortStructuredArray(tree(),#PB_Sort_Descending,OffsetOf(ztree\number),#PB_Sort_Character) +SortStructuredArray(tree(),#PB_Sort_Descending,OffsetOf(ztree\number),#PB_Integer) For i=0 To 255 If tree(i)\number=0 diff --git a/Task/Huffman-coding/Scala/huffman-coding.scala b/Task/Huffman-coding/Scala/huffman-coding-1.scala similarity index 100% rename from Task/Huffman-coding/Scala/huffman-coding.scala rename to Task/Huffman-coding/Scala/huffman-coding-1.scala diff --git a/Task/Huffman-coding/Scala/huffman-coding-2.scala b/Task/Huffman-coding/Scala/huffman-coding-2.scala new file mode 100644 index 0000000000..5423f17a86 --- /dev/null +++ b/Task/Huffman-coding/Scala/huffman-coding-2.scala @@ -0,0 +1,43 @@ +// this version uses immutable data only, recursive functions and pattern matching +object Huffman { + sealed trait Tree[+A] + case class Leaf[A](value: A) extends Tree[A] + case class Branch[A](left: Tree[A], right: Tree[A]) extends Tree[A] + + // recursively build the binary tree needed to Huffman encode the text + def merge(xs: List[(Tree[Char], Int)]): List[(Tree[Char], Int)] = { + if (xs.length == 1) xs else { + val l = xs.head + val r = xs.tail.head + val merged = (Branch(l._1, r._1), l._2 + r._2) + merge((merged :: xs.drop(2)).sortBy(_._2)) + } + } + + // recursively search the branches of the tree for the required character + def contains(tree: Tree[Char], char: Char): Boolean = tree match { + case Leaf(c) => if (c == char) true else false + case Branch(l, r) => contains(l, char) || contains(r, char) + } + + // recursively build the path string required to traverse the tree to the required character + def encodeChar(tree: Tree[Char], char: Char): String = { + def go(tree: Tree[Char], char: Char, code: String): String = tree match { + case Leaf(_) => code + case Branch(l, r) => if (contains(l, char)) go(l, char, code + '0') else go(r, char, code + '1') + } + go(tree, char, "") + } + + def main(args: Array[String]) { + val text = "this is an example for huffman encoding" + // transform the text into a list of tuples. + // each tuple contains a Leaf node containing a unique character and an Int representing that character's weight + val frequencies = text.groupBy(chars => chars).mapValues(group => group.length).toList.map(x => (Leaf(x._1), x._2)).sortBy(_._2) + // build the Huffman Tree for this text + val huffmanTree = merge(frequencies).head._1 + // output the resulting character codes + println("Char\tWeight\tCode") + frequencies.foreach(x => println(x._1.value + "\t" + x._2 + s"/${text.length}" + s"\t${encodeChar(huffmanTree, x._1.value)}")) + } +} diff --git a/Task/I-before-E-except-after-C/00DESCRIPTION b/Task/I-before-E-except-after-C/00DESCRIPTION index 4501b9a851..91abd7cfab 100644 --- a/Task/I-before-E-except-after-C/00DESCRIPTION +++ b/Task/I-before-E-except-after-C/00DESCRIPTION @@ -1,21 +1,28 @@ -The phrase [[wp:I before E except after C|"I before E, except after C"]] is a +The phrase     [[wp:I before E except after C| "I before E, except after C"]]     is a widely known mnemonic which is supposed to help when spelling English words. -;Task Description: -Using the word list from [http://www.puzzlers.org/pub/wordlists/unixdict.txt http://www.puzzlers.org/pub/wordlists/unixdict.txt], check if the two sub-clauses -of the phrase are plausible individually: -# ''"I before E when not preceded by C"'' -# ''"E before I when preceded by C"'' -If both sub-phrases are plausible then the original phrase can be said to be plausible.
    +;Task: +Using the word list from   [http://www.puzzlers.org/pub/wordlists/unixdict.txt http://www.puzzlers.org/pub/wordlists/unixdict.txt], +
    check if the two sub-clauses of the phrase are plausible individually: +:::#   ''"I before E when not preceded by C"'' +:::#   ''"E before I when preceded by C"'' + +
    +If both sub-phrases are plausible then the original phrase can be said to be plausible. + Something is plausible if the number of words having the feature is more than two times the number of words having the opposite feature (where feature is 'ie' or 'ei' preceded or not by 'c' as appropriate). + ;Stretch goal: As a stretch goal use the entries from the table of [http://ucrel.lancs.ac.uk/bncfreq/lists/1_2_all_freq.txt Word Frequencies in Written and Spoken English: based on the British National Corpus], (selecting those rows with three space or tab separated words only), to see if the phrase is plausible when word frequencies are taken into account. + ''Show your output here as well as your program.'' + ;cf.: * [http://news.bbc.co.uk/1/hi/education/8110573.stm Schools to rethink 'i before e'] - BBC news, 20 June 2009 * [http://www.youtube.com/watch?v=duqlZXiIZqA I Before E Except After C] - [[wp:QI|QI]] Series 8 Ep 14, (humorous) * [http://ucrel.lancs.ac.uk/bncfreq/ Companion website] for the book: "Word Frequencies in Written and Spoken English: based on the British National Corpus". +

    diff --git a/Task/I-before-E-except-after-C/ALGOL-68/i-before-e-except-after-c.alg b/Task/I-before-E-except-after-C/ALGOL-68/i-before-e-except-after-c.alg new file mode 100644 index 0000000000..3193288160 --- /dev/null +++ b/Task/I-before-E-except-after-C/ALGOL-68/i-before-e-except-after-c.alg @@ -0,0 +1,80 @@ +# tests the plausibility of "i before e except after c" using unixdict.txt # + +# implements the plausibility test specified by the task # +# returns TRUE if with > 2 * without # +PROC plausible = ( INT with, without )BOOL: with > 2 * without; + +# shows the plausibility of with and without # +PROC show plausibility = ( STRING legend, INT with, without )VOID: + print( ( legend, IF plausible( with, without ) THEN " is plausible" ELSE " is not plausible" FI, newline ) ); + +IF FILE input file; + STRING file name = "unixdict.txt"; + open( input file, file name, stand in channel ) /= 0 +THEN + # failed to open the file # + print( ( "Unable to open """ + file name + """", newline ) ) +ELSE + # file opened OK # + BOOL at eof := FALSE; + # set the EOF handler for the file # + on logical file end( input file, ( REF FILE f )BOOL: + BEGIN + # note that we reached EOF on the # + # latest read # + at eof := TRUE; + # return TRUE so processing can continue # + TRUE + END + ); + INT cei := 0; + INT xei := 0; + INT cie := 0; + INT xie := 0; + WHILE STRING word; + get( input file, ( word, newline ) ); + NOT at eof + DO + # examine the word for cie, xie (x /= c), cei and xei (x /= c) # + FOR pos FROM LWB word TO UPB word DO word[ pos ] := to lower( word[ pos ] ) OD; + IF word = "ie" THEN + xie +:= 1 + ELIF word = "ei" THEN + xei +:= 1 + ELSE + INT length = ( UPB word - LWB word ) + 1; + IF length > 1 THEN + IF word[ LWB word ] = "i" AND word[ LWB word + 1 ] = "e" THEN + # word starts ie # + xie +:= 1 + ELIF word[ LWB word ] = "e" AND word[ LWB word + 1 ] = "i" THEN + # word starts ei # + xei +:= 1 + FI; + FOR pos FROM LWB word + 1 TO UPB word - 1 DO + IF word[ pos ] = "i" AND word[ pos + 1 ] = "e" THEN + # have i before e, check the preceeding character # + IF word[ pos - 1 ] = "c" THEN cie ELSE xie FI +:= 1 + ELIF word[ pos ] = "e" AND word[ pos + 1 ] = "i" THEN + # have e before i, check the preceeding character # + IF word[ pos - 1 ] = "c" THEN cei ELSE xei FI +:= 1 + FI + OD + FI + FI + OD; + # close the file # + close( input file ); + + # test the hypothesis # + print( ( "cie occurances: ", whole( cie, 0 ), newline ) ); + print( ( "xie occurances: ", whole( xie, 0 ), newline ) ); + print( ( "cei occurances: ", whole( cei, 0 ), newline ) ); + print( ( "xei occurances: ", whole( xei, 0 ), newline ) ); + show plausibility( "i before e except after c", xie, cie ); + show plausibility( "e before i except after c", xei, cei ); + show plausibility( "i before e when after c", cie, xie ); + show plausibility( "e before i when after c", cei, xei ); + show plausibility( "i before e in general", xie + cie, xei + cei ); + show plausibility( "e before i in general", xei + cei, xie + cie ) +FI diff --git a/Task/I-before-E-except-after-C/Clojure/i-before-e-except-after-c.clj b/Task/I-before-E-except-after-C/Clojure/i-before-e-except-after-c.clj new file mode 100644 index 0000000000..7b99461852 --- /dev/null +++ b/Task/I-before-E-except-after-C/Clojure/i-before-e-except-after-c.clj @@ -0,0 +1,53 @@ +(ns i-before-e.core + (:require [clojure.string :as s]) + (:gen-class)) + +(def patterns {:cie #"cie" :ie #"(? line + s/trim + (s/split #"\s") + format-line))) + +(defn -main [] + (with-open [rdr (clojure.java.io/reader "http://www.puzzlers.org/pub/wordlists/unixdict.txt")] + (i-before-e-except-after-c-plausible? "Check unixdist list" (apply-freq-1 (line-seq rdr)))) + (with-open [rdr (clojure.java.io/reader "http://ucrel.lancs.ac.uk/bncfreq/lists/1_2_all_freq.txt")] + (i-before-e-except-after-c-plausible? "Word frequencies (stretch goal)" (map format-freq-line (drop 1 (line-seq rdr)))))) diff --git a/Task/I-before-E-except-after-C/Lua/i-before-e-except-after-c.lua b/Task/I-before-E-except-after-C/Lua/i-before-e-except-after-c.lua new file mode 100644 index 0000000000..23c7043e82 --- /dev/null +++ b/Task/I-before-E-except-after-C/Lua/i-before-e-except-after-c.lua @@ -0,0 +1,32 @@ +-- Needed to get dictionary file from web server +local http = require("socket.http") + +-- Return count of words that contain pattern +function count (pattern, wordList) + local total = 0 + for word in wordList:gmatch("%S+") do + if word:match(pattern) then total = total + 1 end + end + return total +end + +-- Check plausibility of case given its opposite +function plaus (case, opposite, words) + if count(case, words) > 2 * count(opposite, words) then + print("PLAUSIBLE") + return true + else + print("IMPLAUSIBLE") + return false + end +end + +-- Main procedure +local page = http.request("http://www.puzzlers.org/pub/wordlists/unixdict.txt") +io.write("I before E when not preceded by C: ") +local sub1 = plaus("[^c]ie", "cie", page) +io.write("E before I when preceded by C: ") +local sub2 = plaus("cei", "[^c]ei", page) +io.write("Overall the phrase is ") +if not (sub1 and sub2) then io.write("not ") end +print("plausible.") diff --git a/Task/I-before-E-except-after-C/PicoLisp/i-before-e-except-after-c.l b/Task/I-before-E-except-after-C/PicoLisp/i-before-e-except-after-c.l new file mode 100644 index 0000000000..374dff4a6c --- /dev/null +++ b/Task/I-before-E-except-after-C/PicoLisp/i-before-e-except-after-c.l @@ -0,0 +1,31 @@ +(de ibEeaC (File . Prg) + (let + (Cie (let N 0 (in File (while (from "cie") (run Prg)))) + Nie (let N 0 (in File (while (from "ie") (run Prg)))) + Cei (let N 0 (in File (while (from "cei") (run Prg)))) + Nei (let N 0 (in File (while (from "ei") (run Prg)))) ) + (prinl "cie: " Cie) + (prinl "nie: " (dec 'Nie Cie)) + (prinl "cei: " Cei) + (prinl "nei: " (dec 'Nei Cei)) + (let (NotI (> (* 3 Cie) Nie) NotE (> Nei (* 3 Cei))) + (prinl + "I before E except after C: is" + (and NotI " not") + " plausible" ) + (prinl + "E before I when after C: is" + (and NotE " not") + " plausible" ) + (prinl + "Overall rule is" + (and (or NotI NotE) " not") + " plausible" ) ) ) ) + +(ibEeaC "unixdict.txt" + (inc 'N) ) + +(prinl) + +(ibEeaC "1_2_all_freq.txt" + (inc 'N (format (stem (line) "\t"))) ) diff --git a/Task/I-before-E-except-after-C/REXX/i-before-e-except-after-c-1.rexx b/Task/I-before-E-except-after-C/REXX/i-before-e-except-after-c-1.rexx index 9427d56bcf..e1229b4b8e 100644 --- a/Task/I-before-E-except-after-C/REXX/i-before-e-except-after-c-1.rexx +++ b/Task/I-before-E-except-after-C/REXX/i-before-e-except-after-c-1.rexx @@ -1,37 +1,36 @@ -/*REXX pgm shows plausibility of I before E when not preceded by C, and*/ -/*────────────────────────────── E before I when preceded by C. */ -#.=0 /*zero out various word counters.*/ -parse arg iFID .; if iFID=='' then iFID='UNIXDICT.TXT' /*use default?*/ +/*REXX program shows plausibility of "I before E" when not preceded by C, and */ +/*───────────────────────────────────── "E before I" when preceded by C. */ +parse arg iFID . /*obtain optional argument from the CL.*/ +if iFID=='' | iFID=="," then iFID='UNIXDICT.TXT' /*Not specified? Then use the default.*/ +#.=0 /*zero out the various word counters. */ + do r=0 while lines(iFID)\==0 /*keep reading the dictionary 'til done*/ + u=space( lineIn(iFID), 0); upper u /*elide superfluous blanks and tabs. */ + if u=='' then iterate /*Is it a blank line? Then ignore it.*/ + #.words=#.words + 1 /*keep running count of number of words*/ + if pos('EI',u)\==0 & pos('IE',u)\==0 then #.both=#.both + 1 /*the word has both.*/ + call find 'ie' /*look for ie */ + call find 'ei' /* " " ei */ + end /*r*/ - do r=0 while lines(ifid)\==0; _=linein(iFID) /*get a single line.*/ - u=translate(space(_,0)) /*elide superfluous blanks & tabs*/ - if u=='' then iterate /*if a blank line, then ignore it*/ - #.words=#.words+1 /*keep a running count of #words.*/ - if pos('EI',u)\==0 & pos('IE',u)\==0 then #.both=#.both+1 /*has both.*/ - call find 'ie' - call find 'ei' - end /*r*/ - -L=length(#.words) /*use this to align the output #s*/ -say 'lines in the ' ifid ' dictionary: ' r -say 'words in the ' ifid ' dictionary: ' #.words +L=length(#.words) /*use this to align the output numbers.*/ +say 'lines in the ' iFID " dictionary: " r +say 'words in the ' iFID " dictionary: " #.words say say 'words with "IE" and "EI" (in same word): ' right(#.both,L) say 'words with "IE" and preceded by "C": ' right(#.ie.c ,L) say 'words with "IE" and not preceded by "C": ' right(#.ie.z ,L) say 'words with "EI" and preceded by "C": ' right(#.ei.c ,L) say 'words with "EI" and not preceded by "C": ' right(#.ei.z ,L) -say; mantra='The spelling mantra ' -p1=#.ie.z/max(1,#.ei.z); phrase='"I before E when not preceded by C"' +say; mantra= 'The spelling mantra ' +p1=#.ie.z/max(1,#.ei.z); phrase= '"I before E when not preceded by C"' say mantra phrase ' is ' word("im", 1+(p1>2))'plausible.' -p2=#.ie.c/max(1,#.ei.c); phrase='"E before I when preceded by C"' +p2=#.ie.c/max(1,#.ei.c); phrase= '"E before I when preceded by C"' say mantra phrase ' is ' word("im", 1+(p2>2))'plausible.' -po=p1>2 & p2>2; say 'Overall, it is' word("im",1+po)'plausible.' -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────FIND subroutine─────────────────────*/ -find: arg x; s=1; do forever; _=pos(x,u,s); if _==0 then leave - if substr(u,_-1+(_==1)*999,1)=='C' then #.x.c=#.x.c+1 - else #.x.z=#.x.z+1 - s=_+1 /*handle case of multiple finds. */ +po=(p1>2 & p2>2); say 'Overall, it is' word("im",1+po)'plausible.' +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +find: arg x; s=1; do forever; _=pos(x, u, s); if _==0 then return + if substr(u, _-1+(_==1)*999, 1)=='C' then #.x.c=#.x.c + 1 + else #.x.z=#.x.z + 1 + s=_+1 /*handle the cases of multiple finds. */ end /*forever*/ -return diff --git a/Task/I-before-E-except-after-C/REXX/i-before-e-except-after-c-2.rexx b/Task/I-before-E-except-after-C/REXX/i-before-e-except-after-c-2.rexx index 9ffb08b9f7..633c0ee56c 100644 --- a/Task/I-before-E-except-after-C/REXX/i-before-e-except-after-c-2.rexx +++ b/Task/I-before-E-except-after-C/REXX/i-before-e-except-after-c-2.rexx @@ -1,66 +1,62 @@ -/*REXX pgm shows plausibility of I before E when not preceded by C, and*/ -/*────────────────────────────── E before I when preceded by C using a*/ -/*────────────────────────────── weighted frequency for each word. */ -#.=0 /*zero out various word counters.*/ -parse arg iFID wFID . -if iFID=='' | iFID==',' then iFID='UNIXDICT.TXT' /*use the default? */ -if wFID=='' | wFID==',' then wFID='WORDFREQ.TXT' /*use the default? */ -tabs=xrange('0'x, "f"x) -f.=1 /*default word freq. multiplier. */ +/*REXX program shows plausibility of "I before E" when not preceded by C, and */ +/*───────────────────────────────────── "E before I" when preceded by C, using a */ +/*───────────────────────────────────── weighted frequency for each word. */ +parse arg iFID wFID . /*obtain optional arguments from the CL*/ +if iFID=='' | iFID=="," then iFID='UNIXDICT.TXT' /*Not specified? Then use the default.*/ +if wFID=='' | wFID=="," then wFID='WORDFREQ.TXT' /* " " " " " " */ +tabs=xrange(, "f"x) /*get kinds of "tabs": '00'x ──► '0f'x*/ +#.=0 /*zero out the various word counters. */ +f.=1 /*default word frequency multiplier. */ + do recs=0 while lines(wFID)\==0 + u=translate( linein(wFID), , tabs); upper u /*translate various tabs and low hexes.*/ + u=translate(u, '*', "~") /*translate tildes (~) to an asterisk.*/ + if u=='' then iterate /*Is this a blank line? Then ignore it*/ + freq=word(u, words(u)) /*obtain the last token on the line. */ + if \datatype(freq, 'W') then iterate /*Is it not an integer? Then ignore it*/ + parse var u w.1 '/' w.2 . /*handle case of: ααα/ßßß ··· */ - do recs=0 while lines(wFID)\==0; _=linein(wFID) /*get a record. */ - u=translate(_,,tabs); upper u /*trans various tabs & low hexex.*/ - u=translate(u,'*', "~") /*translate tildes to an asterisk*/ - if u=='' then iterate /*if a blank line, then ignore it*/ - freq=word(u,words(u)) /*get the last token on the line.*/ - if \datatype(freq,'W') then iterate /*Not numeric? Then ignore it. */ - parse var u w.1 '/' w.2 . /*handle case of: ααα/ßßß ... */ + do j=1 for 2; w.j=word(w.j, 1) /*strip leading and/or trailing blanks.*/ + _=w.j; if _=='' then iterate /*if not present, then ignore it. */ + if j==2 then if w.2==w.1 then iterate /*second word ≡ first word? Then skip.*/ + #.freqs=#.freqs + 1 /*bump word counter in the FREQ list.*/ + f._=f._ + freq /*add to a word's frequency count. */ + end /*ws*/ + end /*recs*/ - do j=1 for 2; w.j=word(w.j,1) /*strip leading/trailing blanks */ - _=w.j; if _=='' then iterate /*if not present, then ignore it.*/ - if j==2 then if w.2==w.1 then iterate /*2nd word=1st word? skip.*/ - #.freqs = #.freqs + 1 /*bump word count in FREQ list.*/ - f._ = f._ + freq /*add to a word's frequency count*/ - end /*ws*/ - - end /*recs*/ - -if recs\==0 then say 'lines in the ' wFID ' list: ' recs -if #.freqs\==0 then say 'words in the ' wFID ' list: ' #.freqs -if #.freqs==0 then weighted= - else weighted=' (weighted)' +if recs\==0 then say 'lines in the ' wFID " list: " recs +if #.freqs\==0 then say 'words in the ' wFID " list: " #.freqs +if #.freqs ==0 then weighted= + else weighted= ' (weighted)' say + do r=0 while lines(iFID)\==0 /*keep reading the dictionary 'til done*/ + u=space( linein(iFID), 0); upper u /*elide superfluous blanks and tabs. */ + if u=='' then iterate /*Is it a blank line? Then ignore it.*/ + #.words=#.words + 1 /*keep running count of number of words*/ + one=f.u + if pos('EI',u)\==0 & pos('IE',u)\==0 then #.both=#.both + one /*the word has both.*/ + call find 'ie' /*look for ie */ + call find 'ei' /* " " ei */ + end /*r*/ - do r=0 while lines(iFID)\==0; _=linein(iFID) /*get a single line.*/ - u=space(_,0); upper u /*elide superfluous blanks & tabs*/ - if u=='' then iterate /*if a blank line, then ignore it*/ - #.words=#.words+1 /*keep a running count of #words.*/ - one=f.u - if pos('EI',u)\==0 & pos('IE',u)\==0 then #.both=#.both+one /*has both*/ - call find 'ie' - call find 'ei' - end /*r*/ - -L=length(#.words) /*use this to align the output #s*/ -say 'lines in the ' iFID ' dictionary: ' r -say 'words in the ' iFID ' dictionary: ' #.words +L=length(#.words) /*use this to align the output numbers.*/ +say 'lines in the ' iFID ' dictionary: ' r +say 'words in the ' iFID ' dictionary: ' #.words say say 'words with "IE" and "EI" (in same word): ' right(#.both,L) weighted say 'words with "IE" and preceded by "C": ' right(#.ie.c ,L) weighted say 'words with "IE" and not preceded by "C": ' right(#.ie.z ,L) weighted say 'words with "EI" and preceded by "C": ' right(#.ei.c ,L) weighted say 'words with "EI" and not preceded by "C": ' right(#.ei.z ,L) weighted -say; mantra='The spelling mantra ' -p1=#.ie.z/max(1,#.ei.z); phrase='"I before E when not preceded by C"' +say; mantra= 'The spelling mantra ' +p1=#.ie.z/max(1,#.ei.z); phrase= '"I before E when not preceded by C"' say mantra phrase ' is ' word("im", 1+(p1>2))'plausible.' -p2=#.ie.c/max(1,#.ei.c); phrase='"E before I when preceded by C"' +p2=#.ie.c/max(1,#.ei.c); phrase= '"E before I when preceded by C"' say mantra phrase ' is ' word("im", 1+(p2>2))'plausible.' -po=p1>2 & p2>2; say 'Overall, it is' word("im",1+po)'plausible.' -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────FIND subroutine─────────────────────*/ -find: arg x; s=1; do forever; _=pos(x,u,s); if _==0 then leave - if substr(u,_-1+(_==1)*999,1)=='C' then #.x.c=#.x.c+one - else #.x.z=#.x.z+one - s=_+1 /*handle case of multiple finds. */ - end /*forever*/ -return +po=(p1>2 & p2>2); say 'Overall, it is' word("im",1+po)'plausible.' +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +find: arg x; s=1; do forever; _=pos(x, u, s); if _==0 then return + if substr(u, _-1+(_==1)*999, 1)=='C' then #.x.c=#.x.c + one + else #.x.z=#.x.z + one + s=_+1 /*handle the cases of multiple finds. */ + end /*forever*/ diff --git a/Task/I-before-E-except-after-C/VBScript/i-before-e-except-after-c.vb b/Task/I-before-E-except-after-C/VBScript/i-before-e-except-after-c.vb new file mode 100644 index 0000000000..41f01c4eba --- /dev/null +++ b/Task/I-before-E-except-after-C/VBScript/i-before-e-except-after-c.vb @@ -0,0 +1,48 @@ +Set objFSO = CreateObject("Scripting.FileSystemObject") +Set srcFile = objFSO.OpenTextFile(objFSO.GetParentFolderName(WScript.ScriptFullName) &_ + "\unixdict.txt",1,False,0) + +cei = 0 : cie = 0 : ei = 0 : ie = 0 + +Do Until srcFile.AtEndOfStream + word = srcFile.ReadLine + If InStr(word,"cei") Then + cei = cei + 1 + ElseIf InStr(word,"cie") Then + cie = cie + 1 + ElseIf InStr(word,"ei") Then + ei = ei + 1 + ElseIf InStr(word,"ie") Then + ie = ie + 1 + End If +Loop + +FirstClause = False +SecondClause = False +Overall = False + +'testing the first clause +If ie > ei*2 Then + WScript.StdOut.WriteLine "I before E when not preceded by C is plausible." + FirstClause = True +Else + WScript.StdOut.WriteLine "I before E when not preceded by C is NOT plausible." +End If + +'testing the second clause +If cei > cie*2 Then + WScript.StdOut.WriteLine "E before I when not preceded by C is plausible." + SecondClause = True +Else + WScript.StdOut.WriteLine "E before I when not preceded by C is NOT plausible." +End If + +'overall clause +If FirstClause And SecondClause Then + WScript.StdOut.WriteLine "Overall it is plausible." +Else + WScript.StdOut.WriteLine "Overall it is NOT plausible." +End If + +srcFile.Close +Set objFSO = Nothing diff --git a/Task/IBAN/Common-Lisp/iban.lisp b/Task/IBAN/Common-Lisp/iban.lisp index c4f950505c..11e439bba5 100644 --- a/Task/IBAN/Common-Lisp/iban.lisp +++ b/Task/IBAN/Common-Lisp/iban.lisp @@ -23,12 +23,13 @@ ;; a built in function to verify for alphanumeric characters, but it includes characters beyond ASCII range. ;; (defun IBAN-characters (iban) - (flet ((valid-alphanum (ch) (or (and (char<= #\A ch) (char>= #\Z ch)) (and (char<= #\0 ch) (char>= #\9 ch))))) - (loop :for char :across iban - :finally (return t) - :do - (when (not (valid-alphanum char)) - (return nil))))) + (flet ((valid-alphanum (ch) + (or (and (char<= #\A ch) + (char>= #\Z ch)) + (and (char<= #\0 ch) + (char>= #\9 ch))))) + (loop for char across iban + always (valid-alphanum char)))) ;; ;; The function IBAN-length verifies that the length of the number is correct. The code lengths diff --git a/Task/IBAN/Elixir/iban.elixir b/Task/IBAN/Elixir/iban.elixir new file mode 100644 index 0000000000..4905cd8875 --- /dev/null +++ b/Task/IBAN/Elixir/iban.elixir @@ -0,0 +1,36 @@ +defmodule IBAN do + @len %{ AL: 28, AD: 24, AT: 20, AZ: 28, BE: 16, BH: 22, BA: 20, BR: 29, + BG: 22, CR: 21, HR: 21, CY: 28, CZ: 24, DK: 18, DO: 28, EE: 20, + FO: 18, FI: 18, FR: 27, GE: 22, DE: 22, GI: 23, GR: 27, GL: 18, + GT: 28, HU: 28, IS: 26, IE: 22, IL: 23, IT: 27, KZ: 20, KW: 30, + LV: 21, LB: 28, LI: 21, LT: 20, LU: 20, MK: 19, MT: 31, MR: 27, + MU: 30, MC: 27, MD: 24, ME: 22, NL: 18, NO: 15, PK: 24, PS: 29, + PL: 28, PT: 25, RO: 24, SM: 27, SA: 24, RS: 22, SK: 24, SI: 19, + ES: 24, SE: 24, CH: 21, TN: 24, TR: 26, AE: 23, GB: 22, VG: 24 } + + def valid?(iban) do + iban = String.replace(iban, ~r/\s/, "") + if Regex.match?(~r/^[\dA-Z]+$/, iban) do + cc = String.slice(iban, 0..1) |> String.to_atom + if String.length(iban) == @len[cc] do + {left, right} = String.split_at(iban, 4) + num = String.codepoints(right <> left) + |> Enum.map_join(fn c -> String.to_integer(c,36) end) + |> String.to_integer + rem(num,97) == 1 + else + false + end + else + false + end + end +end + +[ "GB82 WEST 1234 5698 7654 32", + "gb82 west 1234 5698 7654 32", + "GB82 WEST 1234 5698 7654 320", + "GB82WEST12345698765432", + "GB82 TEST 1234 5698 7654 32", + "ZZ12 3456 7890 1234 5678 12" ] +|> Enum.each(fn iban -> IO.puts "#{IBAN.valid?(iban)}\t#{iban}" end) diff --git a/Task/IBAN/Haskell/iban.hs b/Task/IBAN/Haskell/iban.hs index 7e6962a6c1..1047b49760 100644 --- a/Task/IBAN/Haskell/iban.hs +++ b/Task/IBAN/Haskell/iban.hs @@ -1,4 +1,5 @@ import Data.Char (toUpper) +import Data.Maybe (fromJust) validateIBAN :: String -> Either String String validateIBAN [] = Left "No IBAN number." @@ -38,12 +39,9 @@ validateIBAN xs = -- convert the letters to numbers and -- convert the result to an integer p4 :: Integer - p4 = read $ concat $ convertLetters p3 - convertLetters [] = [] - convertLetters (x:xs) - | x `elem` digits = [x] : convertLetters xs - | otherwise = let (Just ys) = lookup x replDigits - in ys : convertLetters xs + p4 = read $ concat $ map convertLetter p3 + convertLetter x | x `elem` digits = [x] + | otherwise = fromJust $ lookup x replDigits -- see if the number is valid check = if sane then if p4 `mod` 97 == 1 diff --git a/Task/IBAN/JavaScript/iban.js b/Task/IBAN/JavaScript/iban.js new file mode 100644 index 0000000000..2ab1b99999 --- /dev/null +++ b/Task/IBAN/JavaScript/iban.js @@ -0,0 +1,27 @@ +var ibanLen = { + NO:15, BE:16, DK:18, FI:18, FO:18, GL:18, NL:18, MK:19, + SI:19, AT:20, BA:20, EE:20, KZ:20, LT:20, LU:20, CR:21, + CH:21, HR:21, LI:21, LV:21, BG:22, BH:22, DE:22, GB:22, + GE:22, IE:22, ME:22, RS:22, AE:23, GI:23, IL:23, AD:24, + CZ:24, ES:24, MD:24, PK:24, RO:24, SA:24, SE:24, SK:24, + VG:24, TN:24, PT:25, IS:26, TR:26, FR:27, GR:27, IT:27, + MC:27, MR:27, SM:27, AL:28, AZ:28, CY:28, DO:28, GT:28, + HU:28, LB:28, PL:28, BR:29, PS:29, KW:30, MU:30, MT:31 +} + +function isValid(iban) { + iban = iban.replace(/\s/g, '') + if (!iban.match(/^[\dA-Z]+$/)) return false + var len = iban.length + if (len != ibanLen[iban.substr(0,2)]) return false + iban = iban.substr(4) + iban.substr(0,4) + for (var s='', i=0; i') // true +document.write(isValid('GB82 WEST 1.34 5698 7654 32'), '
    ') // false +document.write(isValid('GB82 WEST 1234 5698 7654 325'), '
    ') // false +document.write(isValid('GB82 TEST 1234 5698 7654 32'), '
    ') // false +document.write(isValid('SA03 8000 0000 6080 1016 7519'), '
    ') // true diff --git a/Task/IBAN/Lua/iban.lua b/Task/IBAN/Lua/iban.lua new file mode 100644 index 0000000000..f26e702800 --- /dev/null +++ b/Task/IBAN/Lua/iban.lua @@ -0,0 +1,24 @@ +local length= +{ + AL=28, AD=24, AT=20, AZ=28, BH=22, BE=16, BA=20, BR=29, BG=22, CR=21, + HR=21, CY=28, CZ=24, DK=18, DO=28, EE=20, FO=18, FI=18, FR=27, GE=22, + DE=22, GI=23, GR=27, GL=18, GT=28, HU=28, IS=26, IE=22, IL=23, IT=27, + JO=30, KZ=20, KW=30, LV=21, LB=28, LI=21, LT=20, LU=20, MK=19, MT=31, + MR=27, MU=30, MC=27, MD=24, ME=22, NL=18, NO=15, PK=24, PS=29, PL=28, + PT=25, QA=29, RO=24, SM=27, SA=24, RS=22, SK=24, SI=19, ES=24, SE=24, + CH=21, TN=24, TR=26, AE=23, GB=22, VG=24 +} + +function validate(iban) + iban=iban:gsub("%s","") + local l=length[iban:sub(1,2)] + if not l or l~=#iban or iban:match("[^%d%u]") then + return false -- invalid character, country code or length + end + local mod=0 + local rotated=iban:sub(5)..iban:sub(1,4) + for c in rotated:gmatch(".") do + mod=(mod..tonumber(c,36)) % 97 + end + return mod==1 +end diff --git a/Task/IBAN/OCaml/iban.ocaml b/Task/IBAN/OCaml/iban.ocaml new file mode 100644 index 0000000000..dd18c9defa --- /dev/null +++ b/Task/IBAN/OCaml/iban.ocaml @@ -0,0 +1,106 @@ +#load "str.cma" +#load "nums.cma" (* for module Big_int *) + + +(* Countries and length of their IBAN. *) +(* Taken from https://en.wikipedia.org/wiki/International_Bank_Account_Number#IBAN_formats_by_country *) +let countries = [ + ("AL", 28); ("AD", 24); ("AT", 20); ("AZ", 28); ("BH", 22); ("BE", 16); + ("BA", 20); ("BR", 29); ("BG", 22); ("CR", 21); ("HR", 21); ("CY", 28); + ("CZ", 24); ("DK", 18); ("DO", 28); ("TL", 23); ("EE", 20); ("FO", 18); + ("FI", 18); ("FR", 27); ("GE", 22); ("DE", 22); ("GI", 23); ("GR", 27); + ("GL", 18); ("GT", 28); ("HU", 28); ("IS", 26); ("IE", 22); ("IL", 23); + ("IT", 27); ("JO", 30); ("KZ", 20); ("XK", 20); ("KW", 30); ("LV", 21); + ("LB", 28); ("LI", 21); ("LT", 20); ("LU", 20); ("MK", 19); ("MT", 31); + ("MR", 27); ("MU", 30); ("MC", 27); ("MD", 24); ("ME", 22); ("NL", 18); + ("NO", 15); ("PK", 24); ("PS", 29); ("PL", 28); ("PT", 25); ("QA", 29); + ("RO", 24); ("SM", 27); ("SA", 24); ("RS", 22); ("SK", 24); ("SI", 19); + ("ES", 24); ("SE", 24); ("CH", 21); ("TN", 24); ("TR", 26); ("AE", 23); + ("GB", 22); ("VG", 24); ("DZ", 24); ("AO", 25); ("BJ", 28); ("BF", 27); + ("BI", 16); ("CM", 27); ("CV", 25); ("IR", 26); ("CI", 28); ("MG", 27); + ("ML", 28); ("MZ", 25); ("SN", 28); ("UA", 29) +] +(* Put the countries in a Hashtbl for faster search... *) +let tbl_countries = + let htbl = Hashtbl.create (List.length countries) in + let _ = List.iter (fun (k, v) -> Hashtbl.add htbl k v) countries in + htbl + + +(* Delete spaces and put all letters in upper case. *) +let clean_iban iban = + Str.global_replace (Str.regexp " +") "" iban + |> String.uppercase_ascii + + +(* Each country has an IBAN with a specific length. *) +let check_length ib = + let iso_length = List.hd countries |> fst |> String.length in + let country_code = String.sub ib 0 iso_length in + try + Hashtbl.find tbl_countries country_code = String.length ib + with + Not_found -> false + + +(* Convert a string into a list of chars. *) +let charlist_of_string s = + let l = String.length s in + let rec doloop i = + if i >= l then [] + else s.[i] :: doloop (i + 1) + in + doloop 0 + + +(* Letters are associated to values: A=10, B=11, ..., Z=35. *) +let val_of_char c = + match c with + | '0' .. '9' -> int_of_char c - int_of_char '0' + | 'A' .. 'Z' -> int_of_char c - int_of_char 'A' + 10 + | _ -> failwith (Printf.sprintf "Character not allowed: %c" c) + + +(* Compute the mod-97 value and check it is equal to 1. *) +let check_mod97 ib = + let l = String.length ib + and taken = 4 in + let prefix = String.sub ib 0 taken + and rest = String.sub ib taken (l - taken) in + let newval = rest ^ prefix (* move the 4 initial characters to the end of the string *) + |> charlist_of_string (* convert the string into a list of chars *) + |> List.map val_of_char (* convert each char into its integer value *) + |> List.map string_of_int (* convert the integers into strings... *) + |> List.fold_left (^) "" in (* ...and concatenate said strings *) + (* Now compute the mod-97 using the Big Integers provided by OCaml, and + * compare the result to 1. *) + Big_int.eq_big_int + (Big_int.mod_big_int (Big_int.big_int_of_string newval) + (Big_int.big_int_of_int 97)) + (Big_int.big_int_of_int 1) + + +(* Do the validation as described in the Wikipedia article at + * https://en.wikipedia.org/wiki/International_Bank_Account_Number#Validating_the_IBAN *) +let validate iban = + let ib = clean_iban iban in + check_length ib && check_mod97 ib + + +let () = + let ibans = [ + ("GB82 WEST 1234 5698 7654 32", true); + ("GB82 TEST 1234 5698 7654 32", false); + ("GB81 WEST 1234 5698 7654 32", false); + ("GB82 WEST 1234 5698 7654 3", false); + ("SA03 8000 0000 6080 1016 7519", true); + ("CH93 0076 2011 6238 5295 7", true); + ("\"Completely incorrect iban\"", false) + ] in + let testit (ib, exp) = + let res = validate ib in + Printf.printf "%s is %svalid. Expected %b [%s]\n" + ib (if res then "" else "not ") + exp (if res = exp then "PASS" else "FAIL") + in + List.iter (fun pair -> testit pair) ibans diff --git a/Task/IBAN/PowerShell/iban-1.psh b/Task/IBAN/PowerShell/iban-1.psh new file mode 100644 index 0000000000..aaed91360c --- /dev/null +++ b/Task/IBAN/PowerShell/iban-1.psh @@ -0,0 +1,60 @@ +@' +"Country","Length","Example" +"Albania",28,"AL47212110090000000235698741" +"Andorra",24,"AD1200012030200359100100" +"Austria",20,"AT611904300235473201" +"Belgium",16,"BE68539007547034" +"Bosnia and Herzegovina",20,"BA391290079401028494" +"Bulgaria",22,"BG80BNBG96611020345678" +"Croatia",21,"HR1210010051863000160" +"Cyprus",28,"CY17002001280000001200527600" +"Czech Republic",24,"CZ6508000000192000145399" +"Denmark",18,"DK5000400440116243" +"Estonia",20,"EE382200221020145685" +"Faroe Islands",18,"FO1464600009692713" +"Finland",18,"FI2112345600000785" +"France",27,"FR1420041010050500013M02606" +"Georgia",22,"GE29NB0000000101904917" +"Germany",22,"DE89370400440532013000" +"Gibraltar",23,"GI75NWBK000000007099453" +"Greece",27,"GR1601101250000000012300695" +"Greenland",18,"GL8964710001000206" +"Hungary",28,"HU42117730161111101800000000" +"Iceland",26,"IS140159260076545510730339" +"Ireland",22,"IE29AIBK93115212345678" +"Italy",27,"IT60X0542811101000000123456" +"Kosovo",20,"XK051212012345678906" +"Latvia",21,"LV80BANK0000435195001" +"Liechtenstein",21,"LI21088100002324013AA" +"Lithuania",20,"LT121000011101001000" +"Luxembourg",20,"LU280019400644750000" +"Macedonia",19,"MK07300000000042425" +"Malta",31,"MT84MALT011000012345MTLCAST001S" +"Moldova",24,"MD24AG000225100013104168" +"Monaco",27,"MC5813488000010051108001292" +"Montenegro",22,"ME25505000012345678951" +"Netherlands",18,"NL91ABNA0417164300" +"Norway",15,"NO9386011117947" +"Poland",28,"PL27114020040000300201355387" +"Portugal",25,"PT50000201231234567890154" +"Romania",24,"RO49AAAA1B31007593840000" +"San Marino",27,"SM86U0322509800000000270100" +"Serbia",22,"RS35260005601001611379" +"Slovakia",24,"SK3112000000198742637541" +"Slovenia",19,"SI56191000000123438" +"Spain",24,"ES9121000418450200051332" +"Sweden",24,"SE3550000000054910000003" +"Switzerland",21,"CH9300762011623852957" +"Ukraine",29,"UA573543470006762462054925026" +"United Kingdom",22,"GB29NWBK60161331926819" +'@ -split "`r`n" | Set-Content -Path .\IBAN.csv -Force + +$ibans = foreach ($iban in Import-Csv -Path .\IBAN.csv) +{ + $iban | Select-Object -Property Country, + @{Name='Code' ; Expression={$iban.Example.Substring(0,2)}}, + @{Name='Length'; Expression={[int]$iban.Length}}, + Example +} + +$ibans diff --git a/Task/IBAN/PowerShell/iban-2.psh b/Task/IBAN/PowerShell/iban-2.psh new file mode 100644 index 0000000000..1c437949ce --- /dev/null +++ b/Task/IBAN/PowerShell/iban-2.psh @@ -0,0 +1,10 @@ +$regex = [regex]'[a-zA-Z]{2}[0-9]{2}[a-zA-Z0-9]{6}[0-9]{5}([a-zA-Z0-9]?){0,16}' + +foreach ($iban in $ibans) +{ + [PSCustomObject]@{ + Country = $iban.Country + Example = $iban.Example + IsValid = $regex.IsMatch($iban.Example) + } +} diff --git a/Task/IBAN/SNOBOL4/iban.sno b/Task/IBAN/SNOBOL4/iban.sno new file mode 100644 index 0000000000..d0bffbfa97 --- /dev/null +++ b/Task/IBAN/SNOBOL4/iban.sno @@ -0,0 +1,81 @@ +* IBAN - International Bank Account Number validation + DEFINE('ibantable()') :(iban_table_end) +ibantable + ibantable = TABLE(70) + ibancodes = ++ 'AL28AD24AT20AZ28BE16BH22BA20BR29BG22CR21' ++ 'HR21CY28CZ24DK18DO28EE20FO18FI18FR27GE22' ++ 'DE22GI23GR27GL18GT28HU28IS26IE22IL23IT27' ++ 'KZ20KW30LV21LB28LI21LT20LU20MK19MT31MR27' ++ 'MU30MC27MD24ME22NL18NO15PK24PS29PL28PT25' ++ 'RO24SM27SA24RS22SK24SI19ES24SE24CH21TN24' ++ 'TR26AE23GB22VG24' + nordeacodes = ++ 'DZ24AO25BJ28FB27BI16CM27CV25IR26CI28MG27' ++ 'ML28MZ25SN28UA29' + allcodes = ibancodes nordeacodes +iban1 allcodes LEN(2) . country LEN(2) . length = :F(return) + ibantable = length :(iban1) +iban_table_end + + DEFINE('tonumbers(tonumbers)letter,p') :(tonumbers_end) +tonumbers + tonumbers ANY(&UCASE) . letter :f(RETURN) + &UCASE @p letter + tonumbers letter = p + 10 :(tonumbers) +tonumbers_end + +* modulo for long integers +* + DEFINE('mod(m,n)') :(mod_end) +mod m LEN(9) . r = :f(modresult) + mod = REMDR(CONVERT(r,"INTEGER"), n) +mod0 m LEN(7) . r = :f(modresult) + mod = mod r + mod = REMDR(mod, n) :(mod0) +modresult + mod = GT(SIZE(m), 0) REMDR(mod m, n) :(RETURN) +mod_end + + DEFINE('invalid(l,t)') :(invalid_end) +invalid + OUTPUT = "Invalid IBAN: " l ": " t :(RETURN) +invalid_end + +***** main ***** + ibant = ibantable() + FREEZE(ibant) + + INPUT(.INPUT, 28,,'iban.dat') +read line = INPUT :f(END) + country = checkdigits = line2 = +** GB82 WEST 1234 5698 7654 32 +** Uppercase line2 and remove spaces. + line2 = REPLACE(line, &LCASE, &UCASE) +space line2 ANY(" ") = :s(space) + +** GB82WEST12345698765432 +** Capture country code and checkdigits. + line2 LEN(2) . country LEN(2) . checkdigits + +** 1. Is the country code known? + IDENT(ibant) ++ invalid(line, "unlisted country: " country) :s(read) + +** 2. Is the length correct for the country? + NE(SIZE(line2), ibant) ++ invalid(line, "length: " SIZE(line2) ++ " not " ibant) :s(read) + +** 3. Move first four chars to end of line. +** Convert line2 letters to numbers. +** 3214282912345698765432161182 + line2 = SUBSTR(line2,5) SUBSTR(line2,1,4) + line2 = tonumbers(line2) +** Mod_97 of line2 = 1? + modsum = mod(line2, 97) + NE(modsum, 1) ++ invalid(line, "mod_97 " modsum " not = 1") :s(read) + + OUTPUT = "valid IBAN: " line :(read) +END diff --git a/Task/Identity-matrix/00DESCRIPTION b/Task/Identity-matrix/00DESCRIPTION index 663048ff07..dacb9a6676 100644 --- a/Task/Identity-matrix/00DESCRIPTION +++ b/Task/Identity-matrix/00DESCRIPTION @@ -1,7 +1,11 @@ -Build an [[wp:identity matrix|identity matrix]] of a size known at runtime. +;Task: +Build an   [[wp:identity matrix|identity matrix]]   of a size known at run-time. + + +An ''identity matrix'' is a square matrix of size '''''n'' × ''n''''', +
    where the diagonal elements are all '''1'''s (ones), +
    and all the other elements are all '''0'''s (zeroes). -An identity matrix is a square matrix, of size ''n'' × ''n'', -where the diagonal elements are all 1s, and the other elements are all 0s. I_n = \begin{bmatrix} 1 & 0 & 0 & \cdots & 0 \\ @@ -10,3 +14,10 @@ where the diagonal elements are all 1s, and the other elements are all 0s. \vdots & \vdots & \vdots & \ddots & \vdots \\ 0 & 0 & 0 & \cdots & 1 \\ \end{bmatrix} + + +;Related tasks: +*   [[Spiral matrix]] +*   [[Zig-zag matrix]] +*   [[Ulam_spiral_(for_primes)]] +

    diff --git a/Task/Identity-matrix/ALGOL-W/identity-matrix.alg b/Task/Identity-matrix/ALGOL-W/identity-matrix.alg new file mode 100644 index 0000000000..457f705691 --- /dev/null +++ b/Task/Identity-matrix/ALGOL-W/identity-matrix.alg @@ -0,0 +1,22 @@ +begin + % set m to an identity matrix of size s % + procedure makeIdentity( real array m ( *, * ) + ; integer value s + ) ; + for i := 1 until s do begin + for j := 1 until s do m( i, j ) := 0.0; + m( i, i ) := 1.0 + end makeIdentity ; + + % test the makeIdentity procedure % + begin + real array id5( 1 :: 5, 1 :: 5 ); + makeIdentity( id5, 5 ); + r_format := "A"; r_w := 6; r_d := 1; % set output format for reals % + for i := 1 until 5 do begin + write(); + for j := 1 until 5 do writeon( id5( i, j ) ) + end for_i ; + end text + +end. diff --git a/Task/Identity-matrix/AppleScript/identity-matrix.applescript b/Task/Identity-matrix/AppleScript/identity-matrix.applescript new file mode 100644 index 0000000000..f2819a1ebe --- /dev/null +++ b/Task/Identity-matrix/AppleScript/identity-matrix.applescript @@ -0,0 +1,77 @@ +-- idMatrix :: Int -> [(0|1)] +on idMatrix(n) + set xs to range(1, n) + + script row + on lambda(x) + script zeroOrOne + on lambda(i) + cond(i = x, 1, 0) + end lambda + end script + + map(zeroOrOne, xs) + end lambda + end script + + map(row, xs) +end idMatrix + + +-- TEST +on run + + idMatrix(5) + +end run + + + +-- GENERIC FUNCTIONS ------------------------------------------ + +-- 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 + +-- 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 + +-- cond :: Bool -> a -> a -> a +on cond(bool, f, g) + if bool then + f + else + g + end if +end cond + +-- range :: Int -> Int -> [Int] +on range(m, n) + if n < m then + set d to -1 + else + set d to 1 + end if + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range diff --git a/Task/Identity-matrix/Elena/identity-matrix.elena b/Task/Identity-matrix/Elena/identity-matrix.elena new file mode 100644 index 0000000000..ee807cdf78 --- /dev/null +++ b/Task/Identity-matrix/Elena/identity-matrix.elena @@ -0,0 +1,14 @@ +#import system. +#import extensions. +#import system'routines. +#import system'collections. + +#symbol program= +[ + #var n := console write:"Enter the matrix size:" readLine toInt. + + #var identity := n repeat &each: i = [ n repeat &each: j = [ (i == j)iif:1:0 ] summarize:(ArrayList new) ] summarize:(ArrayList new). + + identity run &each: + row = [ console writeLine:row ]. +]. diff --git a/Task/Identity-matrix/Fortran/identity-matrix-3.f b/Task/Identity-matrix/Fortran/identity-matrix-3.f new file mode 100644 index 0000000000..61cf416b96 --- /dev/null +++ b/Task/Identity-matrix/Fortran/identity-matrix-3.f @@ -0,0 +1,3 @@ + DO 1 I = 1,N + DO 1 J = 1,N + 1 A(I,J) = (I/J)*(J/I) diff --git a/Task/Identity-matrix/Java/identity-matrix.java b/Task/Identity-matrix/Java/identity-matrix.java index ab23e0a972..6b5c24ec09 100644 --- a/Task/Identity-matrix/Java/identity-matrix.java +++ b/Task/Identity-matrix/Java/identity-matrix.java @@ -1,30 +1,13 @@ -public class IdentityMatrix { +public class PrintIdentityMatrix { - public static int[][] matrix(int n){ - int[][] array = new int[n][n]; - - for(int row=0; row array[i][i] = 1); + + Arrays.stream(array) + .map((int[] a) -> Arrays.toString(a)) + .forEach(System.out::println); + } } -By Sani Yusuf @saniyusuf. diff --git a/Task/Identity-matrix/JavaScript/identity-matrix-1.js b/Task/Identity-matrix/JavaScript/identity-matrix-1.js new file mode 100644 index 0000000000..630398c440 --- /dev/null +++ b/Task/Identity-matrix/JavaScript/identity-matrix-1.js @@ -0,0 +1,8 @@ +function idMatrix(n) { + return Array.apply(null, new Array(n)) + .map(function (x, i, xs) { + return xs.map(function (_, k) { + return i === k ? 1 : 0; + }) + }); +} diff --git a/Task/Identity-matrix/JavaScript/identity-matrix-2.js b/Task/Identity-matrix/JavaScript/identity-matrix-2.js new file mode 100644 index 0000000000..4316a87c8d --- /dev/null +++ b/Task/Identity-matrix/JavaScript/identity-matrix-2.js @@ -0,0 +1,13 @@ +(() => { + + // idMatrix :: Int -> [[0 | 1]] + const idMatrix = n => Array.from({ + length: n + }, (_, i) => Array.from({ + length: n + }, (_, j) => i !== j ? 0 : 1)); + + + // TEST + return idMatrix(5); +})(); diff --git a/Task/Identity-matrix/JavaScript/identity-matrix-3.js b/Task/Identity-matrix/JavaScript/identity-matrix-3.js new file mode 100644 index 0000000000..dac012ce07 --- /dev/null +++ b/Task/Identity-matrix/JavaScript/identity-matrix-3.js @@ -0,0 +1,2 @@ +[[1, 0, 0, 0, 0], [0, 1, 0, 0, 0], [0, 0, 1, 0, 0], +[0, 0, 0, 1, 0], [0, 0, 0, 0, 1]] diff --git a/Task/Identity-matrix/JavaScript/identity-matrix.js b/Task/Identity-matrix/JavaScript/identity-matrix.js deleted file mode 100644 index 12d4e61c60..0000000000 --- a/Task/Identity-matrix/JavaScript/identity-matrix.js +++ /dev/null @@ -1,3 +0,0 @@ -function im(n) { - return Array.apply(null, new Array(n)).map(function(x, i, a) { return a.map(function(y, k) { return i === k ? 1 : 0; }) }); -} diff --git a/Task/Identity-matrix/Perl-6/identity-matrix-3.pl6 b/Task/Identity-matrix/Perl-6/identity-matrix-3.pl6 index fee0567cbe..1bb0f88fca 100644 --- a/Task/Identity-matrix/Perl-6/identity-matrix-3.pl6 +++ b/Task/Identity-matrix/Perl-6/identity-matrix-3.pl6 @@ -1,3 +1,3 @@ sub identity-matrix($n) { - ([1, |(0 xx $n-1)].item, *.rotate(-1).item ... *)[^$n] + [1, |(0 xx $n-1)], *.rotate(-1) ... *[*-1] } diff --git a/Task/Identity-matrix/PowerShell/identity-matrix-1.psh b/Task/Identity-matrix/PowerShell/identity-matrix-1.psh index c3b099c293..77fbed6ccd 100644 --- a/Task/Identity-matrix/PowerShell/identity-matrix-1.psh +++ b/Task/Identity-matrix/PowerShell/identity-matrix-1.psh @@ -1,21 +1,17 @@ -function id($n) { - if($n -gt 0) { - $array = @(1..$n | foreach{ @(0) }) - 0..($n-1) | foreach{ - $i = $_ - $array[$i] = @(switch(0..($n-1)){ - $i {1} - default {0} - }) +function identity($n) { + if(0 -lt $n) { + $array = @(0) * $n + foreach ($i in 0..($n-1)) { + $array[$i] = @(0) * $n + $array[$i][$i] = 1 } $array } else { @() } } function show($a) { - if($a.Count -gt 0) { - $n = $a.Count - 1 - 0..$n | foreach{ "$($a[$_][0..$n])" } + if($a) { + 0..($a.Count - 1) | foreach{ if($a[$_]){"$($a[$_])"}else{""} } } } -$array = id 4 +$array = identity 4 show $array diff --git a/Task/Identity-matrix/R/identity-matrix-2.r b/Task/Identity-matrix/R/identity-matrix-2.r index 6171cb3b61..66f870cff5 100644 --- a/Task/Identity-matrix/R/identity-matrix-2.r +++ b/Task/Identity-matrix/R/identity-matrix-2.r @@ -1,4 +1,7 @@ - [,1] [,2] [,3] -[1,] 1 0 0 -[2,] 0 1 0 -[3,] 0 0 1 +Identity_matrix=function(size){ + x=matrix(0,size,size) + for (i in 1:size) { + x[i,i]=1 + } + return(x) +} diff --git a/Task/Identity-matrix/R/identity-matrix.r b/Task/Identity-matrix/R/identity-matrix.r deleted file mode 100644 index 8c8d5178f9..0000000000 --- a/Task/Identity-matrix/R/identity-matrix.r +++ /dev/null @@ -1 +0,0 @@ -diag(3) diff --git a/Task/Identity-matrix/VBScript/identity-matrix.vb b/Task/Identity-matrix/VBScript/identity-matrix-1.vb similarity index 100% rename from Task/Identity-matrix/VBScript/identity-matrix.vb rename to Task/Identity-matrix/VBScript/identity-matrix-1.vb diff --git a/Task/Identity-matrix/VBScript/identity-matrix-2.vb b/Task/Identity-matrix/VBScript/identity-matrix-2.vb new file mode 100644 index 0000000000..4e1d6beaef --- /dev/null +++ b/Task/Identity-matrix/VBScript/identity-matrix-2.vb @@ -0,0 +1,15 @@ +n = 8 + +arr = Identity(n) + +for i = 0 to n-1 + for j = 0 to n-1 + wscript.stdout.Write arr(i,j) & " " + next + wscript.stdout.writeline +next + +Function Identity (size) + Execute Replace("dim a(#,#):for i=0 to #:for j=0 to #:a(i,j)=0:next:a(i,i)=1:next","#",size-1) + Identity = a +End Function diff --git a/Task/Identity-matrix/Vala/identity-matrix.vala b/Task/Identity-matrix/Vala/identity-matrix.vala new file mode 100644 index 0000000000..a061d4d56b --- /dev/null +++ b/Task/Identity-matrix/Vala/identity-matrix.vala @@ -0,0 +1,25 @@ +int main (string[] args) { + if (args.length < 2) { + print ("Please, input an integer > 0.\n"); + return 0; + } + var n = int.parse (args[1]); + if (n <= 0) { + print ("Please, input an integer > 0.\n"); + return 0; + } + int[,] array = new int[n, n]; + for (var i = 0; i < n; i ++) { + for (var j = 0; j < n; j ++) { + if (i == j) array[i,j] = 1; + else array[i,j] = 0; + } + } + for (var i = 0; i < n; i ++) { + for (var j = 0; j < n; j ++) { + print ("%d ", array[i,j]); + } + print ("\b\n"); + } + return 0; +} diff --git a/Task/Image-noise/Factor/image-noise.factor b/Task/Image-noise/Factor/image-noise.factor index 5345f2bf43..c2b31bb99f 100644 --- a/Task/Image-noise/Factor/image-noise.factor +++ b/Task/Image-noise/Factor/image-noise.factor @@ -1,18 +1,25 @@ USING: accessors calendar images images.viewer kernel math math.parser models models.arrow random sequences threads timers -ui.gadgets ui.gadgets.labels ui.gadgets.packs ; -IN: bw-noise +ui ui.gadgets ui.gadgets.labels ui.gadgets.packs ; +IN: rosetta-code.image-noise -CONSTANT: pixels { B{ 0 0 0 } B{ 255 255 255 } } +: bits>pixels ( bits -- bits' pixels ) + [ -1 shift ] [ 1 bitand ] bi 255 * ; inline + +: ?generate-more-bits ( a bits -- a bits' ) + over 32 mod zero? [ drop random-32 ] when ; inline : ( dim -- bytes ) - product [ pixels random ] { } replicate-as concat ; + [ 0 0 ] dip product [ + ?generate-more-bits + [ 1 + ] [ bits>pixels ] bi* + ] B{ } replicate-as 2nip ; : ( -- image ) - - { 320 240 } [ >>dim ] [ >>bitmap ] bi - RGB >>component-order - ubyte-components >>component-type ; + + { 320 240 } [ >>dim ] [ >>bitmap ] bi + L >>component-order + ubyte-components >>component-type ; TUPLE: bw-noise-gadget < image-control timers cnt old-cnt fps-model ; @@ -22,26 +29,33 @@ TUPLE: bw-noise-gadget < image-control timers cnt old-cnt fps-model ; : update-cnt ( gadget -- ) [ cnt>> ] [ old-cnt<< ] bi ; + : fps ( gadget -- fps ) [ cnt>> ] [ old-cnt>> ] bi - ; + : fps-monitor ( gadget -- ) [ fps ] [ update-cnt ] [ fps-model>> set-model ] tri ; : start-animation ( gadget -- ) [ [ animate-image ] curry 1 nanoseconds every ] [ timers>> push ] bi ; + : start-fps ( gadget -- ) [ [ fps-monitor ] curry 1 seconds every ] [ timers>> push ] bi ; + : setup-timers ( gadget -- ) [ start-animation ] [ start-fps ] bi ; + : stop-animation ( gadget -- ) - timers>> [ [ stop-timer ] each ] [ 0 swap set-length ] bi ; + timers>> [ [ stop-timer ] each ] [ delete-all ] bi ; M: bw-noise-gadget graft* [ call-next-method ] [ setup-timers ] bi ; + M: bw-noise-gadget ungraft* [ stop-animation ] [ call-next-method ] bi ; : ( -- gadget ) bw-noise-gadget new-image-gadget* 0 >>cnt 0 >>old-cnt 0 >>fps-model V{ } clone >>timers ; + : fps-gadget ( model -- gadget ) [ number>string ] "FPS: "
    -;Cf.: +
    +;Related tasks * [[Five weekends]] * [[Day of the week]] * [[Find the last Sunday of each month]] +

    diff --git a/Task/Last-Friday-of-each-month/AppleScript/last-friday-of-each-month.applescript b/Task/Last-Friday-of-each-month/AppleScript/last-friday-of-each-month.applescript new file mode 100644 index 0000000000..aec3d70d55 --- /dev/null +++ b/Task/Last-Friday-of-each-month/AppleScript/last-friday-of-each-month.applescript @@ -0,0 +1,193 @@ +-- lastFridaysOfYear :: Int -> [Date] +on lastFridaysOfYear(y) + + -- lastWeekDaysOfYear :: Int -> Int -> [Date] + script lastWeekDaysOfYear + on lambda(intYear, iWeekday) + + -- lastWeekDay :: Int -> Int -> Date + script lastWeekDay + on lambda(iLastDay, iMonth) + set iYear to intYear + + calendarDate(iYear, iMonth, iLastDay - ¬ + (((weekday of calendarDate(iYear, iMonth, iLastDay)) as integer) + ¬ + (7 - (iWeekday))) mod 7) + end lambda + end script + + map(lastWeekDay, lastDaysOfMonths(intYear)) + end lambda + + -- isLeapYear :: Int -> Bool + on isLeapYear(y) + (0 = y mod 4) and (0 ≠ y mod 100) or (0 = y mod 400) + end isLeapYear + + -- lastDaysOfMonths :: Int -> [Int] + on lastDaysOfMonths(y) + {31, cond(isLeapYear(y), 29, 28), 31, 30, 31, 30, 31, 31, 30, 31, 30, 31} + end lastDaysOfMonths + end script + + lastWeekDaysOfYear's lambda(y, Friday as integer) +end lastFridaysOfYear + + +-- TEST +on run argv + + intercalate(linefeed, ¬ + map(isoRow, ¬ + transpose(map(lastFridaysOfYear, ¬ + apply(cond(class of argv is list and argv ≠ {}, ¬ + singleYearOrRange, fiveCurrentYears), argIntegers(argv)))))) + +end run + + +-- ARGUMENT HANDLING + +-- Up to two optional command line arguments: [yearFrom], [yearTo] +-- (Default range in absence of arguments: from two years ago, to two years ahead) + +-- ~ $ osascript ~/Desktop/lastFridays.scpt +-- ~ $ osascript ~/Desktop/lastFridays.scpt 2013 +-- ~ $ osascript ~/Desktop/lastFridays.scpt 2013 2016 + +-- singleYearOrRange :: [Int] -> [Int] +on singleYearOrRange(argv) + apply(cond(length of argv > 0, my range, my fiveCurrentYears), argv) +end singleYearOrRange + +-- fiveCurrentYears :: () -> [Int] +on fiveCurrentYears(_) + set intThisYear to year of (current date) + range(intThisYear - 2, intThisYear + 2) +end fiveCurrentYears + +-- argIntegers :: maybe [String] -> [Int] +on argIntegers(argv) + -- parseInt :: String -> Int + script parseInt + on lambda(s) + s as integer + end lambda + end script + + if class of argv is list and argv ≠ {} then + {map(parseInt, argv)} + else + {} + end if +end argIntegers + + +-- GENERIC FUNCTIONS + +-- Dates and date strings + +-- calendarDate :: Int -> Int -> Int -> Date +on calendarDate(intYear, intMonth, intDay) + tell (current date) + set {its year, its month, its day, its time} to ¬ + {intYear, intMonth, intDay, 0} + return it + end tell +end calendarDate + +-- isoDateString :: Date -> String +on isoDateString(dte) + (((year of dte) as string) & ¬ + "-" & text items -2 thru -1 of ¬ + ("0" & ((month of dte) as integer) as string)) & ¬ + "-" & text items -2 thru -1 of ¬ + ("0" & day of dte) +end isoDateString + + + +-- Testing and tabulation + +-- transpose :: [[a]] -> [[a]] +on transpose(xss) + script column + on lambda(_, iCol) + script row + on lambda(xs) + item iCol of xs + end lambda + end script + + map(row, xss) + end lambda + end script + + map(column, item 1 of xss) +end transpose + +-- intercalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to ¬ + {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate + +-- isoRow :: [Date] -> String +on isoRow(lstDate) + intercalate(tab, map(my isoDateString, lstDate)) +end isoRow + +-- 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 + +-- range :: Int -> Int -> [Int] +on range(m, n) + if n < m then + set d to -1 + else + set d to 1 + end if + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range + +-- 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 + +-- cond :: Bool -> (a -> b) -> (a -> b) -> (a -> b) +on cond(bool, f, g) + if bool then + f + else + g + end if +end cond + +-- apply (a -> b) -> a -> b +on apply(f, a) + mReturn(f)'s lambda(a) +end apply diff --git a/Task/Last-Friday-of-each-month/COBOL/last-friday-of-each-month.cobol b/Task/Last-Friday-of-each-month/COBOL/last-friday-of-each-month.cobol new file mode 100644 index 0000000000..6d326802ec --- /dev/null +++ b/Task/Last-Friday-of-each-month/COBOL/last-friday-of-each-month.cobol @@ -0,0 +1,48 @@ + program-id. last-fri. + data division. + working-storage section. + 1 wk-date. + 2 yr pic 9999. + 2 mo pic 99 value 1. + 2 da pic 99 value 1. + 1 rd-date redefines wk-date pic 9(8). + 1 binary. + 2 int-date pic 9(8). + 2 dow pic 9(4). + 2 friday pic 9(4) value 5. + procedure division. + display "Enter a calendar year (1601 thru 9999): " + with no advancing + accept yr + if yr >= 1601 and <= 9999 + continue + else + display "Invalid year" + stop run + end-if + perform 12 times + move 1 to da + add 1 to mo + if mo > 12 *> to avoid y10k in 9999 + move 12 to mo + move 31 to da + end-if + compute int-date = function + integer-of-date (rd-date) + if mo =12 and da = 31 *> to avoid y10k in 9999 + continue + else + subtract 1 from int-date + end-if + compute rd-date = function + date-of-integer (int-date) + compute dow = function mod + ((int-date - 1) 7) + 1 + compute dow = function mod ((dow - friday) 7) + subtract dow from da + display yr "-" mo "-" da + add 1 to mo + end-perform + stop run + . + end program last-fri. diff --git a/Task/Last-Friday-of-each-month/Java/last-friday-of-each-month.java b/Task/Last-Friday-of-each-month/Java/last-friday-of-each-month-1.java similarity index 100% rename from Task/Last-Friday-of-each-month/Java/last-friday-of-each-month.java rename to Task/Last-Friday-of-each-month/Java/last-friday-of-each-month-1.java diff --git a/Task/Last-Friday-of-each-month/Java/last-friday-of-each-month-2.java b/Task/Last-Friday-of-each-month/Java/last-friday-of-each-month-2.java new file mode 100644 index 0000000000..89fa4eeb17 --- /dev/null +++ b/Task/Last-Friday-of-each-month/Java/last-friday-of-each-month-2.java @@ -0,0 +1,28 @@ +var last_friday_of_month, print_last_fridays_of_month; + +last_friday_of_month = function(year, month) { + var i, last_day; + i = 0; + while (true) { + last_day = new Date(year, month, i); + if (last_day.getDay() === 5) { + return last_day.toDateString(); + } + i -= 1; + } +}; + +print_last_fridays_of_month = function(year) { + var month, results; + results = []; + for (month = 1; month <= 12; ++month) { + results.push(console.log(last_friday_of_month(year, month))); + } + return results; +}; + +(function() { + var year; + year = parseInt(process.argv[2]); + return print_last_fridays_of_month(year); +})(); diff --git a/Task/Last-Friday-of-each-month/Java/last-friday-of-each-month-3.java b/Task/Last-Friday-of-each-month/Java/last-friday-of-each-month-3.java new file mode 100644 index 0000000000..54a99ed0fa --- /dev/null +++ b/Task/Last-Friday-of-each-month/Java/last-friday-of-each-month-3.java @@ -0,0 +1,13 @@ +>node lastfriday.js 2015 +Fri Jan 30 2015 +Fri Feb 27 2015 +Fri Mar 27 2015 +Fri Apr 24 2015 +Fri May 29 2015 +Fri Jun 26 2015 +Fri Jul 31 2015 +Fri Aug 28 2015 +Fri Sep 25 2015 +Fri Oct 30 2015 +Fri Nov 27 2015 +Fri Dec 25 2015 diff --git a/Task/Last-Friday-of-each-month/Java/last-friday-of-each-month-4.java b/Task/Last-Friday-of-each-month/Java/last-friday-of-each-month-4.java new file mode 100644 index 0000000000..737fc7c322 --- /dev/null +++ b/Task/Last-Friday-of-each-month/Java/last-friday-of-each-month-4.java @@ -0,0 +1,76 @@ +(function () { + 'use strict'; + + // lastFridaysOfYear :: Int -> [Date] + function lastFridaysOfYear(y) { + return lastWeekDaysOfYear(y, days.friday); + } + + // lastWeekDaysOfYear :: Int -> Int -> [Date] + function lastWeekDaysOfYear(y, iWeekDay) { + return [ + 31, + 0 === y % 4 && 0 !== y % 100 || 0 === y % 400 ? 29 : 28, + 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 + ] + .map(function (d, m) { + var dte = new Date(Date.UTC(y, m, d)); + + return new Date(Date.UTC( + y, m, d - ( + (dte.getDay() + (7 - iWeekDay)) % 7 + ) + )); + }); + } + + + + + // isoDateString :: Date -> String + function isoDateString(dte) { + return dte.toISOString() + .substr(0, 10); + } + + // range :: Int -> Int -> [Int] + function range(m, n) { + return Array.apply(null, Array(n - m + 1)) + .map(function (x, i) { + return m + i; + }); + } + + // transpose :: [[a]] -> [[a]] + function transpose(lst) { + return lst[0].map(function (_, iCol) { + return lst.map(function (row) { + return row[iCol]; + }); + }); + } + + var days = { + sunday: 0, + monday: 1, + tuesday: 2, + wednesday: 3, + thursday: 4, + friday: 5, + saturday: 6 + } + + // TEST + + return transpose( + range(2012, 2016) + .map(lastFridaysOfYear) + ) + .map(function (row) { + return row + .map(isoDateString) + .join('\t'); + }) + .join('\n'); + +})(); diff --git a/Task/Last-Friday-of-each-month/Lua/last-friday-of-each-month.lua b/Task/Last-Friday-of-each-month/Lua/last-friday-of-each-month.lua new file mode 100644 index 0000000000..3971947d7d --- /dev/null +++ b/Task/Last-Friday-of-each-month/Lua/last-friday-of-each-month.lua @@ -0,0 +1,20 @@ +function isLeapYear (y) + return (y % 4 == 0 and y % 100 ~=0) or y % 400 == 0 +end + +function dayOfWeek (y, m, d) + local t = os.time({year = y, month = m, day = d}) + return os.date("%A", t) +end + +function lastWeekdays (wday, year) + local monthLength, day = {31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31} + if isLeapYear(year) then monthLength[2] = 29 end + for month = 1, 12 do + day = monthLength[month] + while dayOfWeek(year, month, day) ~= wday do day = day - 1 end + print(year .. "-" .. month .. "-" .. day) + end +end + +lastWeekdays("Friday", tonumber(arg[1])) diff --git a/Task/Last-Friday-of-each-month/PARI-GP/last-friday-of-each-month.pari b/Task/Last-Friday-of-each-month/PARI-GP/last-friday-of-each-month.pari new file mode 100644 index 0000000000..d0f5d4f130 --- /dev/null +++ b/Task/Last-Friday-of-each-month/PARI-GP/last-friday-of-each-month.pari @@ -0,0 +1,27 @@ +\\ Normalized Julian Day Number from date +njd(D) = +{ + my (m = D[2], y = D[1]); + + if (D[2] > 2, m++, y--; m += 13); + + (1461 * y) \ 4 + (306001 * m) \ 10000 + D[3] - 694024 + 2 - y \ 100 + y \ 400 +} + +\\ Date from Normalized Julian Day Number +njdate(J) = +{ + my (a = J + 2415019, b = (4 * a - 7468865) \ 146097, c, d, m, y); + + a += 1 + b - b \ 4 + 1524; + b = (20 * a - 2442) \ 7305; + c = (1461 * b) \ 4; + d = ((a - c) * 10000) \ 306001; + m = d - 1 - 12 * (d > 13); + y = b - 4715 - (m > 2); + d = a - c - (306001 * d) \ 10000; + + [y, m, d] +} + +for (m=1, 12, a=njd([2012,m+1,0]); print(njdate(a-(a+1)%7))) diff --git a/Task/Last-Friday-of-each-month/PowerShell/last-friday-of-each-month-1.psh b/Task/Last-Friday-of-each-month/PowerShell/last-friday-of-each-month-1.psh new file mode 100644 index 0000000000..2cf2ebf717 --- /dev/null +++ b/Task/Last-Friday-of-each-month/PowerShell/last-friday-of-each-month-1.psh @@ -0,0 +1,13 @@ +function last-dayofweek { + param( + [Int][ValidatePattern("[1-9][0-9][0-9][0-9]")]$year, + [String][validateset('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday')]$dayofweek + ) + $date = (Get-Date -Year $year -Month 1 -Day 1) + while($date.DayOfWeek -ne $dayofweek) {$date = $date.AddDays(1)} + while($date.year -eq $year) { + if($date.Month -ne $date.AddDays(7).Month) {$date.ToString("yyyy-dd-MM")} + $date = $date.AddDays(7) + } +} +last-dayofweek 2012 "Friday" diff --git a/Task/Last-Friday-of-each-month/PowerShell/last-friday-of-each-month-2.psh b/Task/Last-Friday-of-each-month/PowerShell/last-friday-of-each-month-2.psh new file mode 100644 index 0000000000..303610c8ea --- /dev/null +++ b/Task/Last-Friday-of-each-month/PowerShell/last-friday-of-each-month-2.psh @@ -0,0 +1,97 @@ +function Get-Date0fDayOfWeek +{ + [CmdletBinding(DefaultParameterSetName="None")] + [OutputType([datetime])] + Param + ( + [Parameter(Mandatory=$false, + ValueFromPipeline=$true, + ValueFromPipelineByPropertyName=$true, + Position=0)] + [ValidateRange(1,12)] + [int] + $Month = (Get-Date).Month, + + [Parameter(Mandatory=$false, + ValueFromPipelineByPropertyName=$true, + Position=1)] + [ValidateRange(1,9999)] + [int] + $Year = (Get-Date).Year, + + [Parameter(Mandatory=$true, ParameterSetName="Sunday")] + [switch] + $Sunday, + + [Parameter(Mandatory=$true, ParameterSetName="Monday")] + [switch] + $Monday, + + [Parameter(Mandatory=$true, ParameterSetName="Tuesday")] + [switch] + $Tuesday, + + [Parameter(Mandatory=$true, ParameterSetName="Wednesday")] + [switch] + $Wednesday, + + [Parameter(Mandatory=$true, ParameterSetName="Thursday")] + [switch] + $Thursday, + + [Parameter(Mandatory=$true, ParameterSetName="Friday")] + [switch] + $Friday, + + [Parameter(Mandatory=$true, ParameterSetName="Saturday")] + [switch] + $Saturday, + + [switch] + $First, + + [switch] + $Last, + + [switch] + $AsString, + + [Parameter(Mandatory=$false)] + [ValidateNotNullOrEmpty()] + [string] + $Format = "dd-MMM-yyyy" + ) + + Process + { + [datetime[]]$dates = 1..[DateTime]::DaysInMonth($Year,$Month) | ForEach-Object { + Get-Date -Year $Year -Month $Month -Day $_ -Hour 0 -Minute 0 -Second 0 | + Where-Object -Property DayOfWeek -Match $PSCmdlet.ParameterSetName + } + + if ($First -or $Last) + { + if ($AsString) + { + if ($First) {$dates[0].ToString($Format)} + if ($Last) {$dates[-1].ToString($Format)} + } + else + { + if ($First) {$dates[0]} + if ($Last) {$dates[-1]} + } + } + else + { + if ($AsString) + { + $dates | ForEach-Object {$_.ToString($Format)} + } + else + { + $dates + } + } + } +} diff --git a/Task/Last-Friday-of-each-month/PowerShell/last-friday-of-each-month-3.psh b/Task/Last-Friday-of-each-month/PowerShell/last-friday-of-each-month-3.psh new file mode 100644 index 0000000000..3f8bcbbe71 --- /dev/null +++ b/Task/Last-Friday-of-each-month/PowerShell/last-friday-of-each-month-3.psh @@ -0,0 +1 @@ +1..12 | Get-Date0fDayOfWeek -Year 2012 -Last -Friday diff --git a/Task/Last-Friday-of-each-month/PowerShell/last-friday-of-each-month-4.psh b/Task/Last-Friday-of-each-month/PowerShell/last-friday-of-each-month-4.psh new file mode 100644 index 0000000000..55d85a0dd9 --- /dev/null +++ b/Task/Last-Friday-of-each-month/PowerShell/last-friday-of-each-month-4.psh @@ -0,0 +1 @@ +1..12 | Get-Date0fDayOfWeek -Year 2012 -Last -Friday -AsString diff --git a/Task/Last-Friday-of-each-month/PowerShell/last-friday-of-each-month-5.psh b/Task/Last-Friday-of-each-month/PowerShell/last-friday-of-each-month-5.psh new file mode 100644 index 0000000000..c09634b659 --- /dev/null +++ b/Task/Last-Friday-of-each-month/PowerShell/last-friday-of-each-month-5.psh @@ -0,0 +1 @@ +1..12 | Get-Date0fDayOfWeek -Year 2012 -Last -Friday -AsString -Format yyyy-MM-dd diff --git a/Task/Last-Friday-of-each-month/Python/last-friday-of-each-month-1.py b/Task/Last-Friday-of-each-month/Python/last-friday-of-each-month-1.py index 162191728b..e5f5ed6010 100644 --- a/Task/Last-Friday-of-each-month/Python/last-friday-of-each-month-1.py +++ b/Task/Last-Friday-of-each-month/Python/last-friday-of-each-month-1.py @@ -1,15 +1,7 @@ import calendar -c=calendar.Calendar() -fridays={} -year=raw_input("year") -for item in c.yeardatescalendar(int(year)): - for i1 in item: - for i2 in i1: - for i3 in i2: - if "Fri" in i3.ctime() and year in i3.ctime(): - month,day=str(i3).rsplit("-",1) - fridays[month]=day -for item in sorted((month+"-"+day for month,day in fridays.items()), - key=lambda x:int(x.split("-")[1])): - print item +def lastFridays(year): + for month in range(1, 13): + last_friday = max(week[calendar.FRIDAY] + for week in calendar.monthcalendar(year, month)) + print('{:4d}-{:02d}-{:02d}'.format(year, month, last_friday)) diff --git a/Task/Last-Friday-of-each-month/Python/last-friday-of-each-month-2.py b/Task/Last-Friday-of-each-month/Python/last-friday-of-each-month-2.py index 6d4172b1b5..162191728b 100644 --- a/Task/Last-Friday-of-each-month/Python/last-friday-of-each-month-2.py +++ b/Task/Last-Friday-of-each-month/Python/last-friday-of-each-month-2.py @@ -2,12 +2,13 @@ import calendar c=calendar.Calendar() fridays={} year=raw_input("year") -add=list.__add__ -for day in reduce(add,reduce(add,reduce(add,c.yeardatescalendar(int(year))))): - - if "Fri" in day.ctime() and year in day.ctime(): - month,day=str(day).rsplit("-",1) - fridays[month]=day +for item in c.yeardatescalendar(int(year)): + for i1 in item: + for i2 in i1: + for i3 in i2: + if "Fri" in i3.ctime() and year in i3.ctime(): + month,day=str(i3).rsplit("-",1) + fridays[month]=day for item in sorted((month+"-"+day for month,day in fridays.items()), key=lambda x:int(x.split("-")[1])): diff --git a/Task/Last-Friday-of-each-month/Python/last-friday-of-each-month-3.py b/Task/Last-Friday-of-each-month/Python/last-friday-of-each-month-3.py index 44d0ca45e9..6d4172b1b5 100644 --- a/Task/Last-Friday-of-each-month/Python/last-friday-of-each-month-3.py +++ b/Task/Last-Friday-of-each-month/Python/last-friday-of-each-month-3.py @@ -1,12 +1,9 @@ import calendar -from itertools import chain -f=chain.from_iterable c=calendar.Calendar() fridays={} year=raw_input("year") add=list.__add__ - -for day in f(f(f(c.yeardatescalendar(int(year))))): +for day in reduce(add,reduce(add,reduce(add,c.yeardatescalendar(int(year))))): if "Fri" in day.ctime() and year in day.ctime(): month,day=str(day).rsplit("-",1) diff --git a/Task/Last-Friday-of-each-month/Python/last-friday-of-each-month-4.py b/Task/Last-Friday-of-each-month/Python/last-friday-of-each-month-4.py new file mode 100644 index 0000000000..44d0ca45e9 --- /dev/null +++ b/Task/Last-Friday-of-each-month/Python/last-friday-of-each-month-4.py @@ -0,0 +1,17 @@ +import calendar +from itertools import chain +f=chain.from_iterable +c=calendar.Calendar() +fridays={} +year=raw_input("year") +add=list.__add__ + +for day in f(f(f(c.yeardatescalendar(int(year))))): + + if "Fri" in day.ctime() and year in day.ctime(): + month,day=str(day).rsplit("-",1) + fridays[month]=day + +for item in sorted((month+"-"+day for month,day in fridays.items()), + key=lambda x:int(x.split("-")[1])): + print item diff --git a/Task/Last-Friday-of-each-month/REXX/last-friday-of-each-month.rexx b/Task/Last-Friday-of-each-month/REXX/last-friday-of-each-month.rexx index ca4a33df38..e9376f22aa 100644 --- a/Task/Last-Friday-of-each-month/REXX/last-friday-of-each-month.rexx +++ b/Task/Last-Friday-of-each-month/REXX/last-friday-of-each-month.rexx @@ -1,62 +1,35 @@ -/*REXX program displays dates of last Fridays of each month for any year*/ +/*REXX program displays the dates of the last Fridays of each month for any given year.*/ parse arg yyyy - do j=1 for 12 - say lastDOW('Friday',j,yyyy) - end /*j*/ -exit /*stick a fork in it, we're done.*/ -/*┌────────────────────────────────────────────────────────────────────┐ - │ lastDOW: procedure to return the date of the last day-of-week of │ - │ any particular month of any particular year. │ - │ │ - │ The day-of-week must be specified (it can be in any case, │ - │ (lower-/mixed-/upper-case) as an English name of the spelled day │ - │ of the week, with a minimum length that causes no ambiguity. │ - │ I.E.: W for Wednesday, Sa for Saturday, Su for Sunday ... │ - │ │ - │ The month can be specified as an integer 1 ──► 12 │ - │ 1=January 2=February 3=March ... 12=December │ - │ or the English name of the month, with a minimum length that │ - │ causes no ambiguity. I.E.: Jun for June, D for December. │ - │ If omitted [or an asterisk(*)], the current month is used. │ - │ │ - │ The year is specified as an integer or just the last two digits │ - │ (two digit years are assumed to be in the current century, and │ - │ there is no windowing for a two-digit year). │ - │ If omitted [or an asterisk(*)], the current year is used. │ - │ Years < 100 must be specified with (at least 2) leading zeroes.│ - │ │ - │ Method used: find the "day number" of the 1st of the next month, │ - │ then subtract one (this gives the "day number" of the last day of │ - │ the month, bypassing the leapday mess). The last day-of-week is │ - │ then obtained straightforwardly, or via subtraction. │ - └────────────────────────────────────────────────────────────────────┘*/ -lastdow: procedure; arg dow .,mm .,yy . /*DOW = day of week*/ -parse arg a.1,a.2,a.3 /*orig args, errmsg*/ -if mm=='' | mm=='*' then mm=left(date('U'),2) /*use default month*/ -if yy=='' | yy=='*' then yy=left(date('S'),4) /*use default year */ -if length(yy)==2 then yy=left(date('S'),2)yy /*append century. */ - /*Note mandatory leading blank in strings below.*/ + do j=1 for 12 + say lastDOW('Friday', j, yyyy) /*find last Friday for the Jth month.*/ + end /*j*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +lastDOW: procedure; arg dow .,mm .,yy .; parse arg a.1,a.2,a.3 /*DOW = day of week*/ +if mm=='' | mm=='*' then mm=left( date('U'), 2) /*use default month*/ +if yy=='' | yy=='*' then yy=left( date('S'), 4) /*use default year */ +if length(yy)==2 then yy=left( date('S'), 2)yy /*append century. */ + /*Note mandatory leading blank in strings below*/ $=" Monday TUesday Wednesday THursday Friday SAturday SUnday" -!=" JAnuary February MARch APril MAY JUNe JULy AUgust September", - " October November December" -upper $ ! /*uppercase strings*/ +!=" JAnuary February MARch APril MAY JUNe JULy AUgust September October November December" +upper $ ! /*uppercase strings*/ if dow=='' then call .er "wasn't specified",1 if arg()>3 then call .er 'arguments specified',4 - do j=1 for 3 /*any plural args ?*/ + do j=1 for 3 /*any plural args ?*/ if words(arg(j))>1 then call .er 'is illegal:',j end -dw=pos(' 'dow,$) /*find day-of-week*/ +dw=pos(' 'dow,$) /*find day-of-week*/ if dw==0 then call .er 'is invalid:',1 if dw\==lastpos(' 'dow,$) then call .er 'is ambigious:',1 -if datatype(mm,'month') then /*if MM is alpha...*/ +if datatype(mm,'M') then /*is MM alphabetic?*/ do - m=pos(' 'mm,!) /*maybe its good...*/ + m=pos(' 'mm,!) /*maybe its good...*/ if m==0 then call .er 'is invalid:',1 if m\==lastpos(' 'mm,!) then call .er 'is ambigious:',2 - mm=wordpos(word(substr(!,m),1),!)-1 /*now, use true Mon*/ + mm=wordpos( word( substr(!, m), 1), !) - 1 /*now, use true Mon*/ end if \datatype(mm,'W') then call .er "isn't an integer:",2 @@ -66,13 +39,13 @@ if yy=0 then call .er "can't be 0 (zero):",3 if yy<0 then call .er "can't be negative:",3 if yy>9999 then call .er "can't be > 9999:",3 -tdow=wordpos(word(substr($,dw),1),$)-1 /*target DOW, 0──►6*/ - /*day# of last dom.*/ +tdow=wordpos(word(substr($,dw),1),$)-1 /*target DOW, 0──►6*/ + /*day# of last dom.*/ _=date('B',right(yy+(mm=12),4)right(mm//12+1,2,0)"01",'S')-1 -?=_//7 /*calc. DOW, 0──►6*/ -if ?\==tdow then _=_-?-7+tdow+7*(?>tdow) /*not DOW? Adjust.*/ -return date('weekday',_,"B") date(,_,'B') /*return the answer*/ - -.er: arg ,_;say; say '***error!*** (in LASTDOW)';say /*tell error, and */ - say word('day-of-week month year excess',arg(2)) arg(1) a._ - say; exit 13 /*... then exit. */ +?=_ // 7 /*calc. DOW, 0──►6*/ +if ?\==tdow then _=_ - ? - 7 + tdow + 7 * (?>tdow) /*not DOW? Adjust.*/ +return date('weekday', _, "B") date(, _, 'B') /*return the answer*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +.er: arg ,_; say; say '***error*** (in LASTDOW)'; say /*tell error, and */ + say word('day-of-week month year excess',arg(2)) arg(1) a._ + say; exit 13 /*... then exit. */ diff --git a/Task/Last-Friday-of-each-month/Ruby/last-friday-of-each-month-2.rb b/Task/Last-Friday-of-each-month/Ruby/last-friday-of-each-month-2.rb index 2f4740d752..9a5cd62c90 100644 --- a/Task/Last-Friday-of-each-month/Ruby/last-friday-of-each-month-2.rb +++ b/Task/Last-Friday-of-each-month/Ruby/last-friday-of-each-month-2.rb @@ -1,10 +1,7 @@ -require 'rubygems' -require 'activesupport' +require 'date' def last_friday(year, month) - d = Date.new(year, month, 1).end_of_month - until d.wday == 5 - d = d.yesterday - end + d = Date.new(year, month, -1) + d = d.prev_day until d.friday? d end diff --git a/Task/Last-Friday-of-each-month/SQL/last-friday-of-each-month.sql b/Task/Last-Friday-of-each-month/SQL/last-friday-of-each-month.sql index 9322cbc6dc..7c30b15820 100644 --- a/Task/Last-Friday-of-each-month/SQL/last-friday-of-each-month.sql +++ b/Task/Last-Friday-of-each-month/SQL/last-friday-of-each-month.sql @@ -1,11 +1,4 @@ -select -to_char( max( trunc( to_date ( :yr, 'yyyy' ), 'yyyy' ) + level - 1 ), -'yyyy-mm-dd Dy' ) lastfriday +select to_char( next_day( last_day( add_months( to_date( + :yr||'01','yyyymm' ),level-1))-7,'Fri') ,'yyyy-mm-dd Dy') lastfriday from dual -where -to_char ( trunc( to_date ( :yr, 'yyyy' ), 'yyyy' ) + level - 1, 'Dy' ) = 'Fri' -connect by level < trunc( to_date ( :yr + 1 , 'yyyy' ), 'yyyy') -- trunc( to_date ( :yr, 'yyyy' ) ,'yyyy' ) + 1 -group by -to_char( trunc( to_date ( :yr, 'yyyy' ), 'yyyy' ) + level - 1, 'yyyymm' ) -order by 1 +connect by level <= 12; diff --git a/Task/Last-Friday-of-each-month/Smalltalk/last-friday-of-each-month.st b/Task/Last-Friday-of-each-month/Smalltalk/last-friday-of-each-month.st new file mode 100644 index 0000000000..fa9030d7b4 --- /dev/null +++ b/Task/Last-Friday-of-each-month/Smalltalk/last-friday-of-each-month.st @@ -0,0 +1,9 @@ +Pharo Smalltalk + +[ :yr | | firstDay firstFriday | + firstDay := Date year: yr month: 1 day: 1. + firstFriday := firstDay addDays: (6 - firstDay dayOfWeek). + (0 to: 53) + collect: [ :each | firstFriday addDays: (each * 7) ] + thenSelect: [ :each | + (((Date daysInMonth: each monthIndex forYear: yr) - each dayOfMonth) <= 6) and: [ each year = yr ] ] ] diff --git a/Task/Last-letter-first-letter/00DESCRIPTION b/Task/Last-letter-first-letter/00DESCRIPTION index d36b7eaacd..82c00c5f25 100644 --- a/Task/Last-letter-first-letter/00DESCRIPTION +++ b/Task/Last-letter-first-letter/00DESCRIPTION @@ -1,22 +1,32 @@ -A certain childrens game involves starting with a word in a particular category. Each participant in turn says a word, but that word must begin with the final letter of the previous word. Once a word has been given, it cannot be repeated. If an opponent cannot give a word in the category, they fall out of the game. For example, with "animals" as the category, +A certain children's game involves starting with a word in a particular category.   Each participant in turn says a word, but that word must begin with the final letter of the previous word.   Once a word has been given, it cannot be repeated.   If an opponent cannot give a word in the category, they fall out of the game. -
    Child 1: dog
    +
    +For example, with   "animals"   as the category,
    +
    +Child 1: dog
     Child 2: goldfish
     Child 1: hippopotamus
     Child 2: snake
     ...
     
    -;Task Description -Take the following selection of 70 English Pokemon names (extracted from [[wp:List of Pokémon|Wikipedia's list of Pokemon]]) and generate the/a sequence with the highest possible number of Pokemon names where the subsequent name starts with the final letter of the preceding name. No Pokemon name is to be repeated. -
    audino bagon baltoy banette bidoof braviary bronzor carracosta charmeleon
    +;Task:
    +Take the following selection of 70 English Pokemon names   (extracted from   [[wp:List of Pokémon|Wikipedia's list of Pokemon]])   and generate the/a sequence with the highest possible number of Pokemon names where the subsequent name starts with the final letter of the preceding name.
    +
    +No Pokemon name is to be repeated.
    +
    +
    +audino bagon baltoy banette bidoof braviary bronzor carracosta charmeleon
     cresselia croagunk darmanitan deino emboar emolga exeggcute gabite
     girafarig gulpin haxorus heatmor heatran ivysaur jellicent jumpluff kangaskhan
     kricketune landorus ledyba loudred lumineon lunatone machamp magnezone mamoswine
     nosepass petilil pidgeotto pikachu pinsir poliwrath poochyena porygon2
     porygonz registeel relicanth remoraid rufflet sableye scolipede scrafty seaking
     sealeo silcoon simisear snivy snorlax spoink starly tirtouga trapinch treecko
    -tyrogue vigoroth vulpix wailord wartortle whismur wingull yamask
    +tyrogue vigoroth vulpix wailord wartortle whismur wingull yamask +
    -Extra brownie points for dealing with the full list of 646 names. + +Extra brownie points for dealing with the full list of   646   names. +

    diff --git a/Task/Last-letter-first-letter/Elixir/last-letter-first-letter.elixir b/Task/Last-letter-first-letter/Elixir/last-letter-first-letter.elixir index 85a37b6a60..766bb1daad 100644 --- a/Task/Last-letter-first-letter/Elixir/last-letter-first-letter.elixir +++ b/Task/Last-letter-first-letter/Elixir/last-letter-first-letter.elixir @@ -15,7 +15,7 @@ defmodule LastLetter_FirstLetter do defp add_name(first, sequences, seq) do last_letter = String.last(hd(seq)) - potentials = Dict.get(first, last_letter, []) -- seq + potentials = Map.get(first, last_letter, []) -- seq if potentials == [] do [Enum.reverse(seq) | sequences] else @@ -25,14 +25,14 @@ defmodule LastLetter_FirstLetter do end names = ~w( -audino bagon baltoy banette bidoof braviary bronzor carracosta charmeleon -cresselia croagunk darmanitan deino emboar emolga exeggcute gabite -girafarig gulpin haxorus heatmor heatran ivysaur jellicent jumpluff kangaskhan -kricketune landorus ledyba loudred lumineon lunatone machamp magnezone mamoswine -nosepass petilil pidgeotto pikachu pinsir poliwrath poochyena porygon2 -porygonz registeel relicanth remoraid rufflet sableye scolipede scrafty seaking -sealeo silcoon simisear snivy snorlax spoink starly tirtouga trapinch treecko -tyrogue vigoroth vulpix wailord wartortle whismur wingull yamask + audino bagon baltoy banette bidoof braviary bronzor carracosta charmeleon + cresselia croagunk darmanitan deino emboar emolga exeggcute gabite + girafarig gulpin haxorus heatmor heatran ivysaur jellicent jumpluff kangaskhan + kricketune landorus ledyba loudred lumineon lunatone machamp magnezone mamoswine + nosepass petilil pidgeotto pikachu pinsir poliwrath poochyena porygon2 + porygonz registeel relicanth remoraid rufflet sableye scolipede scrafty seaking + sealeo silcoon simisear snivy snorlax spoink starly tirtouga trapinch treecko + tyrogue vigoroth vulpix wailord wartortle whismur wingull yamask ) LastLetter_FirstLetter.search(names) diff --git a/Task/Last-letter-first-letter/REXX/last-letter-first-letter-1.rexx b/Task/Last-letter-first-letter/REXX/last-letter-first-letter-1.rexx index 36abde7f8a..0cb163c894 100644 --- a/Task/Last-letter-first-letter/REXX/last-letter-first-letter-1.rexx +++ b/Task/Last-letter-first-letter/REXX/last-letter-first-letter-1.rexx @@ -1,4 +1,4 @@ -/*REXX pgm to find longest path of word's last-letter ──► to 1st-letter.*/ +/*REXX program finds the longest path of word's last─letter ───► first-letter. */ @='audino bagon baltoy banette bidoof braviary bronzor carracosta charmeleon cresselia croagunk darmanitan', 'deino emboar emolga exeggcute gabite girafarig gulpin haxorus heatmor heatran ivysaur jellicent', 'jumpluff kangaskhan kricketune landorus ledyba loudred lumineon lunatone machamp magnezone mamoswine', @@ -6,42 +6,38 @@ 'remoraid rufflet sableye scolipede scrafty seaking sealeo silcoon simisear snivy snorlax spoink', 'starly tirtouga trapinch treecko tyrogue vigoroth vulpix wailord wartortle whismur wingull yamask' #=words(@) -parse arg limit .; if limit\=='' then #=limit /*allow a scan limit.*/ -@.=; $$$= /*nullify array, and longest path*/ - do i=1 for # /*build a stemmed array from list*/ - @.i=word(@,i) +parse arg limit .; if limit\=='' then #=limit /*allow user to specify a scan limit. */ +@.=; $$$= /*nullify array; and also longest path.*/ + do i=1 for # /*build a stemmed array from the list. */ + @.i=word(@, i) end /*i*/ -soFar=0 /*the initial maximum path length*/ - do j=1 for # - parse value @.1 @.j with @.j @.1 - call scanner $$$,2 +MP=0; MPL=0 /*the initial Maximum Path Length. */ + do j=1 for # /* ─ ─ ─ */ + parse value @.1 @.j with @.j @.1; call scan $$$, 2 parse value @.1 @.j with @.j @.1 end /*j*/ -L=words($$$) -say 'Of' # "words," MP 'path's(MP) "have the maximum path length of" L'.' +g=words($$$) +say 'Of' # "words," MP 'path's(MP) "have the maximum path length of" g'.' say; say 'One example path of that length is:' - do m=1 for L; say left('',39) word($$$,m); end /*m*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────S subroutine────────────────────────*/ -s: if arg(1)==1 then return arg(3); return word(arg(2) 's',1) -/*──────────────────────────────────SCANNER subroutine (recursive)──────*/ -scanner: procedure expose @. MP # soFar $$$; parse arg $$$,!; _=!-1 -lastChar=right(@._,1) /*last char of penultimate word. */ - - do i=! to # /*scan for the longest word path.*/ - if left(@.i,1)==lastChar then /*is the first-char = last-char? */ - do - if !==soFar then MP=MP+1 /*bump the maximum paths counter.*/ - else if !>soFar then do; $$$=@.1 /*rebuild.*/ - do n=2 to !-1 - $$$=$$$ @.n - end /*n*/ - $$$=$$$ @.i /*add last*/ - MP=1; soFar=! /*new path*/ - end - parse value @.! @.i with @.i @.! - call scanner $$$, !+1 /*recursive scan for longest path*/ - parse value @.! @.i with @.i @.! - end - end /*i*/ -return /*exhausted this particular scan.*/ + do m=1 for g; say left('', 39) word($$$, m); end /*m*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +s: if arg(1)==1 then return arg(3); return word(arg(2) 's', 1) +/*──────────────────────────────────────────────────────────────────────────────────────*/ +scan: procedure expose @. MP # MPL $$$; parse arg $$$,!; _=!-1 + parse var @._ '' -1 LC /*obtain the last character of prev. @ */ + /* [↓] PARSE obtains first char of @.i*/ + do i=! to #; parse var @.i _ 2 /* [↓] scan for the longest word path.*/ + if _==LC then do /*is the first-char = last-char? */ + if !==MPL then MP=MP+1 /*bump the Maximum Paths counter. */ + else if !>MPL then do; $$$=@.1 /*rebuild. */ + do n=2 to !-1; $$$=$$$ @.n + end /*n*/ + $$$=$$$ @.i /*add last.*/ + MP=1; MPL=! /*new path.*/ + end + parse value @.! @.i with @.i @.!; call scan $$$, !+1 + parse value @.! @.i with @.i @.! + end /*if─then*/ + end /*i*/ + return /*exhausted this particular scan. */ diff --git a/Task/Last-letter-first-letter/REXX/last-letter-first-letter-2.rexx b/Task/Last-letter-first-letter/REXX/last-letter-first-letter-2.rexx index 5789144035..581929d7c2 100644 --- a/Task/Last-letter-first-letter/REXX/last-letter-first-letter-2.rexx +++ b/Task/Last-letter-first-letter/REXX/last-letter-first-letter-2.rexx @@ -1,4 +1,4 @@ -/*REXX pgm to find longest path of word's last-letter ──► to 1st-letter.*/ +/*REXX program finds the longest path of word's last─letter ───► first-letter. */ @='audino bagon baltoy banette bidoof braviary bronzor carracosta charmeleon cresselia croagunk darmanitan', 'deino emboar emolga exeggcute gabite girafarig gulpin haxorus heatmor heatran ivysaur jellicent', 'jumpluff kangaskhan kricketune landorus ledyba loudred lumineon lunatone machamp magnezone mamoswine', @@ -6,63 +6,55 @@ 'remoraid rufflet sableye scolipede scrafty seaking sealeo silcoon simisear snivy snorlax spoink', 'starly tirtouga trapinch treecko tyrogue vigoroth vulpix wailord wartortle whismur wingull yamask' #=words(@) -parse arg limit .; if limit\=='' then #=limit /*allow a scan limit.*/ -@.=; $$$=; ig=0 /*nullify array and longest path.*/ -call build@. /*build a stemmed array from list*/ - do v=# by -1 for # /*scrub list for unusuable words.*/ - F= left(@.v,1) /*first letter of the word. */ - L=right(@.v,1) /* last " " " " */ - if !.1.F>1 | !.9.L>1 then iterate /*is a dead word?*/ - @=delword(@,v,1) /*delete from @. */ - say 'ignorning dead word:' @.v; ig=ig+1 - end /*v*/ +parse arg limit .; if limit\=='' then #=limit /*allow user to specify a scan limit. */ +@.=; $$$=; ig=0 /*nullify array and the longest path. */ +call build@ /*build a stemmed array from the @ list*/ + do v=# by -1 for # /*scrub the @ list for unusuable words.*/ + F= left(@.v,1) /*the first letter of the word. */ + L=right(@.v,1) /* " last " " " " */ + if !.1.F>1 | !.9.L>1 then iterate /*is this a dead word?*/ + @=delword(@,v,1) /*delete from @ list.*/ + say 'ignorning dead word:' @.v; ig=ig+1 + end /*v*/ -if ig\==0 then do - call build@. - say; say 'ignoring' ig "dead word"s(ig)'.'; say - end -soFar=0 /*the initial maximum path length*/ - do j=1 for # - parse value @.1 @.j with @.j @.1 - call scanner $$$,2 - parse value @.1 @.j with @.j @.1 - end /*j*/ +if ig\==0 then do + call build@ + say; say 'ignoring' ig "dead word"s(ig)'.'; say + end +MP=0; MPL=0 /*the initial Maximum Path Length. */ + do j=1 for # /* ─ ─ ─ */ + parse value @.1 @.j with @.j @.1; call scan $$$,2 + parse value @.1 @.j with @.j @.1 + end /*j*/ g=words($$$) -say 'Of' # "words," MP 'path's(MP) "have the maximum path length of" g'.' +say 'Of' # "words," MP 'path's(MP) "have the maximum path length of" g'.' say; say 'One example path of that length is:' - do m=1 for g /*display a list of words to term*/ - say left('',39) word($$$,m) - end /*m*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────BUILD suroutine─────────────────────*/ -build@.: !.=0; do i=1 for # /*build a stemmed array from list*/ - @.i=word(@,i) - F= left(@.i,1); !.1.F=!.1.F+1 /*count 1st chars*/ - L=right(@.i,1); !.9.L=!.9.L+1 /*count last chars*/ - end /*i*/ + do m=1 for L; say left('', 39) word($$$, m); end /*m*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +build@: !.=0; do i=1 for #; @.i=word(@, i) /*build a stemmed array from the list. */ + F= left(@.i, 1); !.1.F=!.1.F + 1 /*count first characters.*/ + L=right(@.i, 1); !.9.L=!.9.L + 1 /*count last characters.*/ + end /*i*/ return -/*──────────────────────────────────S subroutine────────────────────────*/ -s: if arg(1)==1 then return arg(3); return word(arg(2) 's',1) -/*──────────────────────────────────SCANNER subroutine (recursive)──────*/ -scanner: procedure expose @. MP # !. soFar $$$; parse arg $$$,!; _=!-1 -lastChar=right(@._,1) /*last char of penultimate word. */ -if !.1.lastchar==0 then return /*is this a dead-end word? */ - - do i=! to # /*scan for the longest word path.*/ - if left(@.i,1)==lastChar then /*is the first-char = last-char? */ - do - if !==soFar then MP=MP+1 /*bump the maximum paths counter.*/ - else if !>soFar then do; $$$=@.1 /*rebuild it*/ - do n=2 to !-1 - $$$=$$$ @.n - end /*n*/ - $$$=$$$ @.i /*add last. */ - MP=1; soFar=! /*new path. */ - end - parse value @.! @.i with @.i @.! - call scanner $$$,!+1 /*recursive scan for longest path*/ - parse value @.! @.i with @.i @.! - end - end /*i*/ - -return /*exhausted this particular scan.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +s: if arg(1)==1 then return arg(3); return word(arg(2) 's', 1) +/*──────────────────────────────────────────────────────────────────────────────────────*/ +scan: procedure expose @. MP # !. MPL $$$; parse arg $$$,!; _=!-1 + parse var @._ '' -1 LC /*obtain the last character of prev. @ */ + if !.1.LC==0 then return /*is this a dead-end word? */ + /* [↓] PARSE obtains first char of @.i*/ + do i=! to #; parse var @.i _ 2 /*scan for the longest word path. */ + if _==LC then do /*is the first-character = last-char? */ + if !==MPL then MP=MP+1 /*bump the Maximum Paths Counter. */ + else if !>MPL then do; $$$=@.1 /*rebuild. */ + do n=2 to !-1; $$$=$$$ @.n + end /*n*/ + $$$=$$$ @.i /*add last.*/ + MP=1; MPL=! /*new path.*/ + end + parse value @.! @.i with @.i @.!; call scan $$$,!+1 + parse value @.! @.i with @.i @.! + end /*if─then*/ + end /*i*/ + return /*exhausted this particular scan. */ diff --git a/Task/Leap-year/BASIC/leap-year.basic b/Task/Leap-year/BASIC/leap-year-1.basic similarity index 100% rename from Task/Leap-year/BASIC/leap-year.basic rename to Task/Leap-year/BASIC/leap-year-1.basic diff --git a/Task/Leap-year/BASIC/leap-year-2.basic b/Task/Leap-year/BASIC/leap-year-2.basic new file mode 100644 index 0000000000..5961d257d6 --- /dev/null +++ b/Task/Leap-year/BASIC/leap-year-2.basic @@ -0,0 +1 @@ +10 DEF FNLY(Y)=(Y/4=INT(Y/4))*((Y/100<>INT(Y/100))+(Y/400=INT(Y/400))) diff --git a/Task/Leap-year/COBOL/leap-year.cobol b/Task/Leap-year/COBOL/leap-year-1.cobol similarity index 100% rename from Task/Leap-year/COBOL/leap-year.cobol rename to Task/Leap-year/COBOL/leap-year-1.cobol diff --git a/Task/Leap-year/COBOL/leap-year-2.cobol b/Task/Leap-year/COBOL/leap-year-2.cobol new file mode 100644 index 0000000000..3f8ee7948e --- /dev/null +++ b/Task/Leap-year/COBOL/leap-year-2.cobol @@ -0,0 +1,33 @@ + program-id. leap-yr. + *> Given a year, where 1601 <= year <= 9999 + *> Determine if the year is a leap year + data division. + working-storage section. + 1 input-year pic 9999. + 1 binary. + 2 int-date pic 9(8). + 2 cal-mo-day pic 9(4). + procedure division. + display "Enter calendar year (1601 thru 9999): " + with no advancing + accept input-year + if input-year >= 1601 and <= 9999 + then + *> if the 60th day of a year is Feb 29 + *> then the year is a leap year + compute int-date = function integer-of-day + ( input-year * 1000 + 60 ) + compute cal-mo-day = function mod ( + (function date-of-integer ( int-date )) 10000 ) + display "Year " input-year space with no advancing + if cal-mo-day = 229 + display "is a leap year" + else + display "is NOT a leap year" + end-if + else + display "Input date is not within range" + end-if + stop run + . + end program leap-yr. diff --git a/Task/Leap-year/Excel/leap-year.excel b/Task/Leap-year/Excel/leap-year.excel index 40c3e681a4..b97fb21fdd 100644 --- a/Task/Leap-year/Excel/leap-year.excel +++ b/Task/Leap-year/Excel/leap-year.excel @@ -1 +1 @@ -=IF(OR(NOT(MOD(A1;400));AND(NOT(MOD(A1;4));MOD(A1;100)));"Leap Year";"Not a Leap Year") +=IF(OR(NOT(MOD(A1,400)),AND(NOT(MOD(A1,4)),MOD(A1,100))),"Leap Year","Not a Leap Year") diff --git a/Task/Leap-year/Kotlin/leap-year.kotlin b/Task/Leap-year/Kotlin/leap-year.kotlin new file mode 100644 index 0000000000..adc36fa6e0 --- /dev/null +++ b/Task/Leap-year/Kotlin/leap-year.kotlin @@ -0,0 +1 @@ +fun isLeapYear(year: Int) = year % 400 == 0 || (year % 100 != 0 && year % 4 == 0) diff --git a/Task/Leap-year/LOLCODE/leap-year.lol b/Task/Leap-year/LOLCODE/leap-year.lol new file mode 100644 index 0000000000..f2231aaa32 --- /dev/null +++ b/Task/Leap-year/LOLCODE/leap-year.lol @@ -0,0 +1,46 @@ +BTW Determine if a Gregorian calendar year is leap +HAI 1.3 +HOW IZ I Leap YR Year + BOTH SAEM 0 AN MOD OF Year AN 4 + O RLY? + YA RLY + BOTH SAEM 0 AN MOD OF Year AN 100 + O RLY? + YA RLY + BOTH SAEM 0 AN MOD OF Year AN 400 + O RLY? + YA RLY + FOUND YR WIN + NO WAI + FOUND YR FAIL + OIC + NO WAI + FOUND YR WIN + OIC + NO WAI + FOUND YR FAIL + OIC +IF U SAY SO + +I HAS A Yearz ITZ A BUKKIT +Yearz HAS A SRS 0 ITZ 1900 +Yearz HAS A SRS 1 ITZ 1904 +Yearz HAS A SRS 2 ITZ 1994 +Yearz HAS A SRS 3 ITZ 1996 +Yearz HAS A SRS 4 ITZ 1997 +Yearz HAS A SRS 5 ITZ 2000 + +IM IN YR Loop UPPIN YR Index WILE DIFFRINT Index AN 6 + I HAS A Yr ITZ Yearz'Z SRS Index + I HAS A Not + I IZ Leap YR Yr MKAY + O RLY? + YA RLY + Not R "" + NO WAI + Not R " NOT" + OIC + VISIBLE Yr " is" Not " a leap year" +IM OUTTA YR Loop + +KTHXBYE diff --git a/Task/Leap-year/Maple/leap-year.maple b/Task/Leap-year/Maple/leap-year.maple new file mode 100644 index 0000000000..88f2613e68 --- /dev/null +++ b/Task/Leap-year/Maple/leap-year.maple @@ -0,0 +1,7 @@ +isLeapYear := proc(year) + if not year mod 4 = 0 or (year mod 100 = 0 and not year mod 400 = 0) then + return false; + else + return true; + end if; +end proc: diff --git a/Task/Leap-year/Mathematica/leap-year.math b/Task/Leap-year/Mathematica/leap-year.math index d197479042..cdf17ea12e 100644 --- a/Task/Leap-year/Mathematica/leap-year.math +++ b/Task/Leap-year/Mathematica/leap-year.math @@ -1 +1 @@ -isLeapYear[y_]:= y~Mod~4 == 0 && (y~Mod~100 != 0 || y~Mod~400 == 0) +LeapYearQ[2002] diff --git a/Task/Leap-year/Pascal/leap-year.pascal b/Task/Leap-year/Pascal/leap-year.pascal new file mode 100644 index 0000000000..98ff15e8a9 --- /dev/null +++ b/Task/Leap-year/Pascal/leap-year.pascal @@ -0,0 +1,17 @@ +program LeapYear; +uses + sysutils;//includes isLeapYear + +procedure TestYear(y: word); +begin + if IsLeapYear(y) then + writeln(y,' is a leap year') + else + writeln(y,' is NO leap year'); +end; +Begin + TestYear(1900); + TestYear(2000); + TestYear(2100); + TestYear(1904); +end. diff --git a/Task/Leap-year/PowerShell/leap-year.psh b/Task/Leap-year/PowerShell/leap-year.psh index 7dd3f17ae3..d3a36133a7 100644 --- a/Task/Leap-year/PowerShell/leap-year.psh +++ b/Task/Leap-year/PowerShell/leap-year.psh @@ -1,12 +1,2 @@ -function isLeapYear ($year) -{ - If (([System.Int32]::TryParse($year, [ref]0)) -and ($year -le 9999)) - { - $bool = [datetime]::isleapyear($year) - } - else - { - throw "Year format invalid. Use only numbers up to 9999." - } - return $bool -} +$Year = 2016 +[System.DateTime]::IsLeapYear( $Year ) diff --git a/Task/Leap-year/Ruby/leap-year.rb b/Task/Leap-year/Ruby/leap-year.rb new file mode 100644 index 0000000000..7cb5675342 --- /dev/null +++ b/Task/Leap-year/Ruby/leap-year.rb @@ -0,0 +1,3 @@ +require 'date' + +Date.leap?(year) diff --git a/Task/Leap-year/Rust/leap-year.rust b/Task/Leap-year/Rust/leap-year.rust index b9d4c96e02..f538236a6c 100644 --- a/Task/Leap-year/Rust/leap-year.rust +++ b/Task/Leap-year/Rust/leap-year.rust @@ -1,7 +1,5 @@ fn is_leap(year: i32) -> bool { - if year % 100 == 0 { - year % 400 == 0 - } else { - year % 4 == 0 + let factor = |x| year % x == 0; + factor(4) && (!factor(100) || factor(400)) } } diff --git a/Task/Least-common-multiple/00DESCRIPTION b/Task/Least-common-multiple/00DESCRIPTION index 77ff72c187..cf2e4ffe61 100644 --- a/Task/Least-common-multiple/00DESCRIPTION +++ b/Task/Least-common-multiple/00DESCRIPTION @@ -1,13 +1,24 @@ +;Task: Compute the least common multiple of two integers. -Given ''m'' and ''n'', the least common multiple is the smallest positive integer that has both ''m'' and ''n'' as factors. For example, the least common multiple of 12 and 18 is 36, because 12 is a factor (12 × 3 = 36), and 18 is a factor (18 × 2 = 36), and there is no positive integer less than 36 that has both factors. As a special case, if either ''m'' or ''n'' is zero, then the least common multiple is zero. +Given   ''m''   and   ''n'',   the least common multiple is the smallest positive integer that has both   ''m''   and   ''n''   as factors. -One way to calculate the least common multiple is to iterate all the multiples of ''m'', until you find one that is also a multiple of ''n''. -If you already have ''gcd'' for [[greatest common divisor]], then this formula calculates ''lcm''. +;Example: +The least common multiple of 12 and 18 is 36, because 12 is a factor (12 × 3 = 36), and 18 is a factor (18 × 2 = 36), and there is no positive integer less than 36 that has both factors.   As a special case, if either   ''m''   or   ''n''   is zero, then the least common multiple is zero. -\operatorname{lcm}(m, n) = \frac{|m \times n|}{\operatorname{gcd}(m, n)} +One way to calculate the least common multiple is to iterate all the multiples of   ''m'',   until you find one that is also a multiple of   ''n''. -One can also find ''lcm'' by merging the [[prime decomposition]]s of both ''m'' and ''n''. +If you already have   ''gcd''   for [[greatest common divisor]],   then this formula calculates   ''lcm''. -References: [http://mathworld.wolfram.com/LeastCommonMultiple.html MathWorld], [[wp:Least common multiple|Wikipedia]]. + +:::: \operatorname{lcm}(m, n) = \frac{|m \times n|}{\operatorname{gcd}(m, n)} + + +One can also find   ''lcm''   by merging the [[prime decomposition]]s of both   ''m''   and   ''n''. + + +;References: +*   [http://mathworld.wolfram.com/LeastCommonMultiple.html MathWorld]. +*   [[wp:Least common multiple|Wikipedia]]. +

    diff --git a/Task/Least-common-multiple/APL/least-common-multiple-1.apl b/Task/Least-common-multiple/APL/least-common-multiple-1.apl new file mode 100644 index 0000000000..0b20b1c716 --- /dev/null +++ b/Task/Least-common-multiple/APL/least-common-multiple-1.apl @@ -0,0 +1,2 @@ + 12^18 +36 diff --git a/Task/Least-common-multiple/APL/least-common-multiple-2.apl b/Task/Least-common-multiple/APL/least-common-multiple-2.apl new file mode 100644 index 0000000000..4a4f7102ba --- /dev/null +++ b/Task/Least-common-multiple/APL/least-common-multiple-2.apl @@ -0,0 +1,3 @@ + LCM←{(|⍺×⍵)÷⍺∨⍵} + 12 LCM 18 +36 diff --git a/Task/Least-common-multiple/AppleScript/least-common-multiple-1.applescript b/Task/Least-common-multiple/AppleScript/least-common-multiple-1.applescript new file mode 100644 index 0000000000..21f1b5a54f --- /dev/null +++ b/Task/Least-common-multiple/AppleScript/least-common-multiple-1.applescript @@ -0,0 +1,44 @@ +-- lcm :: Integral a => a -> a -> a +on lcm(x, y) + if x = 0 or y = 0 then + 0 + else + abs(x div (gcd(x, y)) * y) + end if +end lcm + + +-- TEST +on run + + lcm(12, 18) + + --> 36 +end run + + +-- GENERAL FUNCTIONS + +-- abs :: Num a => a -> a +on abs(x) + if x < 0 then + -x + else + x + end if +end abs + +-- gcd :: Integral a => a -> a -> a +on gcd(x, y) + script _gcd + on lambda(a, b) + if b = 0 then + a + else + lambda(b, a mod b) + end if + end lambda + end script + + _gcd's lambda(abs(x), abs(y)) +end gcd diff --git a/Task/Least-common-multiple/AppleScript/least-common-multiple-2.applescript b/Task/Least-common-multiple/AppleScript/least-common-multiple-2.applescript new file mode 100644 index 0000000000..7facc89938 --- /dev/null +++ b/Task/Least-common-multiple/AppleScript/least-common-multiple-2.applescript @@ -0,0 +1 @@ +36 diff --git a/Task/Least-common-multiple/Brat/least-common-multiple.brat b/Task/Least-common-multiple/Brat/least-common-multiple.brat new file mode 100644 index 0000000000..274c3d5328 --- /dev/null +++ b/Task/Least-common-multiple/Brat/least-common-multiple.brat @@ -0,0 +1,12 @@ +gcd = { a, b | + true? { a == 0 } + { b } + { gcd(b % a, a) } +} + +lcm = { a, b | + a * b / gcd(a, b) +} + +p lcm(12, 18) # 36 +p lcm(14, 21) # 42 diff --git a/Task/Least-common-multiple/JavaScript/least-common-multiple.js b/Task/Least-common-multiple/JavaScript/least-common-multiple-1.js similarity index 100% rename from Task/Least-common-multiple/JavaScript/least-common-multiple.js rename to Task/Least-common-multiple/JavaScript/least-common-multiple-1.js diff --git a/Task/Least-common-multiple/JavaScript/least-common-multiple-2.js b/Task/Least-common-multiple/JavaScript/least-common-multiple-2.js new file mode 100644 index 0000000000..cd18df6b2a --- /dev/null +++ b/Task/Least-common-multiple/JavaScript/least-common-multiple-2.js @@ -0,0 +1,18 @@ +(() => { + 'use strict'; + + // gcd :: Integral a => a -> a -> a + let gcd = (x, y) => { + let _gcd = (a, b) => (b === 0 ? a : _gcd(b, a % b)), + abs = Math.abs; + return _gcd(abs(x), abs(y)); + } + + // lcm :: Integral a => a -> a -> a + let lcm = (x, y) => + x === 0 || y === 0 ? 0 : Math.abs(Math.floor(x / gcd(x, y)) * y); + + // TEST + return lcm(12, 18); + +})(); diff --git a/Task/Least-common-multiple/Kotlin/least-common-multiple.kotlin b/Task/Least-common-multiple/Kotlin/least-common-multiple.kotlin new file mode 100644 index 0000000000..9c01fe93a5 --- /dev/null +++ b/Task/Least-common-multiple/Kotlin/least-common-multiple.kotlin @@ -0,0 +1,3 @@ +fun gcd(a: Int, b: Int): Int = if (b == 0) a else gcd(b, a % b) + +fun lcm(a: Int, b: Int) = a * b / gcd(a, b) diff --git a/Task/Least-common-multiple/REXX/least-common-multiple-1.rexx b/Task/Least-common-multiple/REXX/least-common-multiple-1.rexx index 506f07a181..d838e61195 100644 --- a/Task/Least-common-multiple/REXX/least-common-multiple-1.rexx +++ b/Task/Least-common-multiple/REXX/least-common-multiple-1.rexx @@ -1,24 +1,24 @@ -/*REXX pgm finds LCM (Least Common Multiple) of any number of integers.*/ -numeric digits 10000 /*can handle 10,000 digit numbers*/ -say 'the LCM of 19 & 0 is: ' lcm(19 0) -say 'the LCM of 0 & 85 is: ' lcm( 0 85) -say 'the LCM of 14 & -6 is: ' lcm(14, -6) -say 'the LCM of 18 & 12 is: ' lcm(18 12) -say 'the LCM of 18 & 12 & -5 is: ' lcm(18 12, -5) -say 'the LCM of 18 & 12 & -5 & 97 is: ' lcm(18, 12, -5, 97) -say 'the LCM of 2**19-1 & 2**521-1 is: ' lcm(2**19-1 2**521-1) - /* [↑] 7th, 13th Mersenne primes*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────LCM subroutine──────────────────────*/ -lcm: procedure; parse arg $,_; $=$ _; do i=3 to arg(); $=$ arg(i); end -parse var $ x $ /*obtain the first value in args.*/ -x=abs(x) /*use the absolute value of X. */ - do while $\=='' /*process the remainder of args. */ - parse var $ ! $; !=abs(!) /*pick off the next arg (ABS val)*/ - if !==0 then return 0 /*if zero, then LCM is also zero.*/ - d=x*! /*calculate part of the LCM here */ - do until !==0; parse value x//! ! with ! x - end /*until*/ /* [↑] this is a short&fast GCD.*/ - x=d%x /*divide the pre─calculated value*/ - end /*while*/ /* [↑] process subsequent args. */ -return x /*return with the LCM of the args*/ +/*REXX program finds the LCM (Least Common Multiple) of any number of integers. */ +numeric digits 10000 /*can handle 10k decimal digit numbers.*/ +say 'the LCM of 19 and 0 is ───► ' lcm(19 0 ) +say 'the LCM of 0 and 85 is ───► ' lcm( 0 85 ) +say 'the LCM of 14 and -6 is ───► ' lcm(14, -6 ) +say 'the LCM of 18 and 12 is ───► ' lcm(18 12 ) +say 'the LCM of 18 and 12 and -5 is ───► ' lcm(18 12, -5 ) +say 'the LCM of 18 and 12 and -5 and 97 is ───► ' lcm(18, 12, -5, 97) +say 'the LCM of 2**19-1 and 2**521-1 is ───► ' lcm(2**19-1 2**521-1) + /* [↑] 7th & 13th Mersenne primes.*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +lcm: procedure; parse arg $,_; $=$ _; do i=3 to arg(); $=$ arg(i); end /*i*/ + parse var $ x $ /*obtain the first value in args. */ + x=abs(x) /*use the absolute value of X. */ + do while $\=='' /*process the remainder of args. */ + parse var $ ! $; !=abs(!) /*pick off the next arg (ABS val).*/ + if !==0 then return 0 /*if zero, then LCM is also zero. */ + d=x*! /*calculate part of the LCM here. */ + do until !==0; parse value x//! ! with ! x + end /*until*/ /* [↑] this is a short & fast GCD*/ + x=d%x /*divide the pre─calculated value.*/ + end /*while*/ /* [↑] process subsequent args. */ + return x /*return with the LCM of the args.*/ diff --git a/Task/Left-factorials/00DESCRIPTION b/Task/Left-factorials/00DESCRIPTION index 9dbd710359..4d9f11e6e4 100644 --- a/Task/Left-factorials/00DESCRIPTION +++ b/Task/Left-factorials/00DESCRIPTION @@ -1,24 +1,41 @@ -''Left factorials'', !n, may refer to either ''subfactorials'' or to ''factorial sums''; -the same notation can be confusingly seen used for the two different definitions. +'''Left factorials''',   !n,   may refer to either   ''subfactorials''   or to   ''factorial sums''; +
    the same notation can be confusingly seen used for the two different definitions. -Sometimes, ''subfactorials'' (also known as ''derangements'') use any of the notations: -:::::::*   !''n''` -:::::::*   !n' -:::::::*   ''n''¡ +Sometimes,   ''subfactorials''   (also known as ''derangements'')   may use any of the notations: +:::::::*   !''n''` +:::::::*   !''n'' +:::::::*   ''n''¡ -
    This Rosetta Code task will be using this formula for ''left factorial'': -: !n = \sum_{k=0}^{n-1} k! +(It may not be visually obvious, but the last example uses an upside-down exclamation mark.) + + +
    This Rosetta Code task will be using this formula for '''left factorial''': + +:::   !n = \sum_{k=0}^{n-1} k! + where -:!0 = 0 + +:::   !0 = 0 + + + ;Task Display the left factorials for: * zero through ten (inclusive) * 20 through 110 (inclusive) by tens + +
    Display the length (in decimal digits) of the left factorials for: * 1,000,   2,000   through   10,000   (inclusive), by thousands. + + ;Also see -* The OEIS entry: [http://oeis.org/A003422 A003422 left factorials] -* The MathWorld entry: [http://mathworld.wolfram.com/LeftFactorial.html left factorial] -* The MathWorld entry: [http://mathworld.wolfram.com/FactorialSums.html factorial sums] -* The MathWorld entry: [http://mathworld.wolfram.com/Subfactorial.html subfactorial] -* The Rosetta Code entry: [http://rosettacode.org/wiki/Permutations/Derangements permutations/derangements (subfactorials)] +*   The OEIS entry: [http://oeis.org/A003422 A003422 left factorials] +*   The MathWorld entry: [http://mathworld.wolfram.com/LeftFactorial.html left factorial] +*   The MathWorld entry: [http://mathworld.wolfram.com/FactorialSums.html factorial sums] +*   The MathWorld entry: [http://mathworld.wolfram.com/Subfactorial.html subfactorial] + + +;Related task: +*   [http://rosettacode.org/wiki/Permutations/Derangements permutations/derangements (subfactorials)] +

    diff --git a/Task/Left-factorials/C++/left-factorials.cpp b/Task/Left-factorials/C++/left-factorials.cpp new file mode 100644 index 0000000000..b1da8df8cb --- /dev/null +++ b/Task/Left-factorials/C++/left-factorials.cpp @@ -0,0 +1,127 @@ +#include +#include +#include +#include +#include +using namespace std; + +#if 1 // optimized for 64-bit architecture +typedef unsigned long usingle; +typedef unsigned long long udouble; +const int word_len = 32; +#else // optimized for 32-bit architecture +typedef unsigned short usingle; +typedef unsigned long udouble; +const int word_len = 16; +#endif + +class bignum { +private: + // rep_.size() == 0 if and only if the value is zero. + // Otherwise, the word rep_[0] keeps the least significant bits. + vector rep_; +public: + explicit bignum(usingle n = 0) { if (n > 0) rep_.push_back(n); } + bool equals(usingle n) const { + if (n == 0) return rep_.empty(); + if (rep_.size() > 1) return false; + return rep_[0] == n; + } + bignum add(usingle addend) const { + bignum result(0); + udouble sum = addend; + for (size_t i = 0; i < rep_.size(); ++i) { + sum += rep_[i]; + result.rep_.push_back(sum & (((udouble)1 << word_len) - 1)); + sum >>= word_len; + } + if (sum > 0) result.rep_.push_back((usingle)sum); + return result; + } + bignum add(const bignum& addend) const { + bignum result(0); + udouble sum = 0; + size_t sz1 = rep_.size(); + size_t sz2 = addend.rep_.size(); + for (size_t i = 0; i < max(sz1, sz2); ++i) { + if (i < sz1) sum += rep_[i]; + if (i < sz2) sum += addend.rep_[i]; + result.rep_.push_back(sum & (((udouble)1 << word_len) - 1)); + sum >>= word_len; + } + if (sum > 0) result.rep_.push_back((usingle)sum); + return result; + } + bignum multiply(usingle factor) const { + bignum result(0); + udouble product = 0; + for (size_t i = 0; i < rep_.size(); ++i) { + product += (udouble)rep_[i] * factor; + result.rep_.push_back(product & (((udouble)1 << word_len) - 1)); + product >>= word_len; + } + if (product > 0) + result.rep_.push_back((usingle)product); + return result; + } + void divide(usingle divisor, bignum& quotient, usingle& remainder) const { + quotient.rep_.resize(0); + udouble dividend = 0; + remainder = 0; + for (size_t i = rep_.size(); i > 0; --i) { + dividend = ((udouble)remainder << word_len) + rep_[i - 1]; + usingle quo = (usingle)(dividend / divisor); + remainder = (usingle)(dividend % divisor); + if (quo > 0 || i < rep_.size()) + quotient.rep_.push_back(quo); + } + reverse(quotient.rep_.begin(), quotient.rep_.end()); + } +}; + +ostream& operator<<(ostream& os, const bignum& x); + +ostream& operator<<(ostream& os, const bignum& x) { + string rep; + bignum dividend = x; + bignum quotient; + usingle remainder; + while (true) { + dividend.divide(10, quotient, remainder); + rep += (char)('0' + remainder); + if (quotient.equals(0)) break; + dividend = quotient; + } + reverse(rep.begin(), rep.end()); + os << rep; + return os; +} + +bignum lfact(usingle n); + +bignum lfact(usingle n) { + bignum result(0); + bignum f(1); + for (usingle k = 1; k <= n; ++k) { + result = result.add(f); + f = f.multiply(k); + } + return result; +} + +int main() { + for (usingle i = 0; i <= 10; ++i) { + cout << "!" << i << " = " << lfact(i) << endl; + } + + for (usingle i = 20; i <= 110; i += 10) { + cout << "!" << i << " = " << lfact(i) << endl; + } + + for (usingle i = 1000; i <= 10000; i += 1000) { + stringstream ss; + ss << lfact(i); + cout << "!" << i << " has " << ss.str().size() + << " digits." << endl; + } +} diff --git a/Task/Left-factorials/Clojure/left-factorials.clj b/Task/Left-factorials/Clojure/left-factorials.clj new file mode 100644 index 0000000000..9a4f65978d --- /dev/null +++ b/Task/Left-factorials/Clojure/left-factorials.clj @@ -0,0 +1,19 @@ +(ns left-factorial + (:gen-class)) + +(defn left-factorial [n] + " Compute by updating the state [fact summ] for each k, where k equals 1 to n + Update is next state is [k*fact (summ+k)" + (second + (reduce (fn [[fact summ] k] + [(*' fact k) (+ summ fact)]) + [1 0] (range 1 (inc n))))) + +(doseq [n (range 11)] + (println (format "!%-3d = %5d" n (left-factorial n)))) + +(doseq [n (range 20 111 10)] +(println (format "!%-3d = %5d" n (biginteger (left-factorial n))))) + +(doseq [n (range 1000 10001 1000)] + (println (format "!%-5d has %5d digits" n (count (str (biginteger (left-factorial n))))))) diff --git a/Task/Left-factorials/Lua/left-factorials.lua b/Task/Left-factorials/Lua/left-factorials.lua new file mode 100644 index 0000000000..83827300cd --- /dev/null +++ b/Task/Left-factorials/Lua/left-factorials.lua @@ -0,0 +1,28 @@ +-- Lua bindings for GNU bc +require("bc") + +-- Return table of factorials from 0 to n +function facsUpTo (n) + local f, fList = bc.number(1), {} + fList[0] = 1 + for i = 1, n do + f = bc.mul(f, i) + fList[i] = f + end + return fList +end + +-- Return left factorial of n +function leftFac (n) + local sum = bc.number(0) + for k = 0, n - 1 do sum = bc.add(sum, facList[k]) end + return bc.tostring(sum) +end + +-- Main procedure +facList = facsUpTo(10000) +for i = 0, 10 do print("!" .. i .. " = " .. leftFac(i)) end +for i = 20, 110, 10 do print("!" .. i .. " = " .. leftFac(i)) end +for i = 1000, 10000, 1000 do + print("!" .. i .. " contains " .. #leftFac(i) .. " digits") +end diff --git a/Task/Left-factorials/REXX/left-factorials.rexx b/Task/Left-factorials/REXX/left-factorials.rexx index 897ec66a71..712497e3b5 100644 --- a/Task/Left-factorials/REXX/left-factorials.rexx +++ b/Task/Left-factorials/REXX/left-factorials.rexx @@ -1,22 +1,22 @@ -/*REXX pgm computes/shows the left factorial (or width) of N (or range).*/ -parse arg bot top inc . /*obtain optional args from C.L. */ -if bot=='' then bot=1 /*BOT defined? Then use default.*/ -td= bot<0 /*if BOT < 0, only show # digs.*/ -bot=abs(bot) /*use the |bot| for the DO loop.*/ -if top=='' then top=bot /* " " top " " " " */ -if inc='' then inc=1 /* " " inc " " " " */ -@='left ! of ' /*a literal used in the display. */ -w=length(H) /*width of largest number request*/ - do j=bot to top by inc /*traipse through #'s requested.*/ - if td then say @ right(j,w) " ───► " length(L!(j)) ' digits' - else say @ right(j,w) " ───► " L!(j) - end /*j*/ /* [↑] show either L! or #digits*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────L! subroutine───────────────────────*/ -L!: procedure; parse arg x .; if x<3 then return x; s=4 /*shortcuts.*/ -!=2; do f=3 to x-1 /*compute L! for all numbers───►X*/ - !=!*f /*compute intermediate factorial.*/ - if pos(.,!)\==0 then numeric digits digits()*1.5%1 /*bump digs.*/ - s=s+! /*add the factorial ───► L! sum.*/ - end /*f*/ /* [↑] handles gi-hugeic numbers*/ -return s /*return the sum (L!) to invoker.*/ +/*REXX program computes/display the left factorial (or its width) of N (or range). */ +parse arg bot top inc . /*obtain optional argumenst from the CL*/ +if bot=='' | bot=="," then bot= 1 /*Not specified: Then use the default.*/ +if top=='' | top=="," then top=bot /* " " " " " " */ +if inc='' | inc=="," then inc= 1 /* " " " " " " */ +tellDigs= (bot<0) /*if BOT < 0, only show # of digits. */ +bot=abs(bot) /*use the │bot│ for the DO loop. */ +@= 'left ! of ' /*a handy literal used in the display. */ +w=length(H) /*width of the largest number request. */ + do j=bot to top by inc /*traipse through the numbers requested*/ + if tellDigs then say @ right(j,w) " ───► " length(L!(j)) ' digits' + else say @ right(j,w) " ───► " L!(j) + end /*j*/ /* [↑] show either L! or # of digits*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +L!: procedure; parse arg x .; if x<3 then return x; s=4 /*some shortcuts. */ +!=2; do f=3 to x-1 /*compute L! for all numbers ─── ► X.*/ + !=!*f /*compute intermediate factorial. */ + if pos(.,!)\==0 then numeric digits digits()*1.5%1 /*bump decimal digits.*/ + s=s+! /*add the factorial ───► L! sum. */ + end /*f*/ /* [↑] handles gihugeic numbers. */ +return s /*return the sum (L!) to the invoker.*/ diff --git a/Task/Left-factorials/Rust/left-factorials.rust b/Task/Left-factorials/Rust/left-factorials.rust new file mode 100644 index 0000000000..0345afe3aa --- /dev/null +++ b/Task/Left-factorials/Rust/left-factorials.rust @@ -0,0 +1,123 @@ +#[cfg(target_pointer_width = "64")] +type USingle = u32; +#[cfg(target_pointer_width = "64")] +type UDouble = u64; +#[cfg(target_pointer_width = "64")] +const WORD_LEN: i32 = 32; + +#[cfg(not(target_pointer_width = "64"))] +type USingle = u16; +#[cfg(not(target_pointer_width = "64"))] +type UDouble = u32; +#[cfg(not(target_pointer_width = "64"))] +const WORD_LEN: i32 = 16; + +use std::cmp; + +#[derive(Debug,Clone)] +struct BigNum { + // rep_.size() == 0 if and only if the value is zero. + // Otherwise, the word rep_[0] keeps the least significant bits. + rep_: Vec, +} + +impl BigNum { + pub fn new(n: USingle) -> BigNum { + let mut result = BigNum { rep_: vec![] }; + if n > 0 { result.rep_.push(n); } + result + } + pub fn equals(&self, n: USingle) -> bool { + if n == 0 { return self.rep_.is_empty() } + if self.rep_.len() > 1 { return false } + self.rep_[0] == n + } + pub fn add_big(&self, addend: &BigNum) -> BigNum { + let mut result = BigNum::new(0); + let mut sum = 0 as UDouble; + let sz1 = self.rep_.len(); + let sz2 = addend.rep_.len(); + for i in 0..cmp::max(sz1, sz2) { + if i < sz1 { sum += self.rep_[i] as UDouble } + if i < sz2 { sum += addend.rep_[i] as UDouble } + result.rep_.push(sum as USingle); + sum >>= WORD_LEN; + } + if sum > 0 { result.rep_.push(sum as USingle) } + result + } + pub fn multiply(&self, factor: USingle) -> BigNum { + let mut result = BigNum::new(0); + let mut product = 0 as UDouble; + for i in 0..self.rep_.len() { + product += self.rep_[i] as UDouble * factor as UDouble; + result.rep_.push(product as USingle); + product >>= WORD_LEN; + } + if product > 0 { + result.rep_.push(product as USingle); + } + result + } + pub fn divide(&self, divisor: USingle, quotient: &mut BigNum, + remainder: &mut USingle) { + quotient.rep_.truncate(0); + let mut dividend: UDouble; + *remainder = 0; + for i in 0..self.rep_.len() { + let j = self.rep_.len() - 1 - i; + dividend = ((*remainder as UDouble) << WORD_LEN) + + self.rep_[j] as UDouble; + let quo = (dividend / divisor as UDouble) as USingle; + *remainder = (dividend % divisor as UDouble) as USingle; + if quo > 0 || j < self.rep_.len() - 1 { + quotient.rep_.push(quo); + } + } + quotient.rep_.reverse(); + } + fn to_string(&self) -> String { + let mut rep = String::new(); + let mut dividend = (*self).clone(); + let mut remainder = 0 as USingle; + let mut quotient = BigNum::new(0); + loop { + dividend.divide(10, &mut quotient, &mut remainder); + rep.push(('0' as USingle + remainder) as u8 as char); + if quotient.equals(0) { break; } + dividend = quotient.clone(); + } + rep.chars().rev().collect::() + } +} + +use std::fmt; +impl fmt::Display for BigNum { + fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { + write!(f, "{}", self.to_string()) + } +} + +fn lfact(n: USingle) -> BigNum { + let mut result = BigNum::new(0); + let mut f = BigNum::new(1); + for k in 1 as USingle..n + 1 { + result = result.add_big(&f); + f = f.multiply(k); + } + result +} + +fn main() { + for i in 0..11 { + println!("!{} = {}", i, lfact(i)); + } + for i in 2..12 { + let j = i * 10; + println!("!{} = {}", j, lfact(j)); + } + for i in 1..11 { + let j = i * 1000; + println!("!{} has {} digits.", j, lfact(j).to_string().len()); + } +} diff --git a/Task/Letter-frequency/00DESCRIPTION b/Task/Letter-frequency/00DESCRIPTION index 354b775026..490d57f8c5 100644 --- a/Task/Letter-frequency/00DESCRIPTION +++ b/Task/Letter-frequency/00DESCRIPTION @@ -1,4 +1,6 @@ +;Task: Open a text file and count the occurrences of each letter. Some of these programs count all characters (including punctuation), but some only count letters A to Z. +

    diff --git a/Task/Letter-frequency/Elixir/letter-frequency.elixir b/Task/Letter-frequency/Elixir/letter-frequency.elixir index e7c900f15e..c97779d888 100644 --- a/Task/Letter-frequency/Elixir/letter-frequency.elixir +++ b/Task/Letter-frequency/Elixir/letter-frequency.elixir @@ -1,11 +1,9 @@ file = hd(System.argv) -case File.read(file) do - {:ok, binary} -> String.upcase(binary) - |> String.codepoints - |> Enum.filter(fn c -> c =~ ~r/[A-Z]/ end) - |> Enum.reduce(Map.new, fn c,acc -> Dict.update(acc, c, 1, &(&1+1)) end) - |> Enum.sort_by(fn {_k,v} -> -v end) - |> Enum.each(fn {k,v} -> IO.puts "#{k} #{v}" end) - {:error, reason} -> IO.inspect reason -end +File.read!(file) +|> String.upcase +|> String.graphemes +|> Enum.filter(fn c -> c =~ ~r/[A-Z]/ end) +|> Enum.reduce(Map.new, fn c,acc -> Map.update(acc, c, 1, &(&1+1)) end) +|> Enum.sort_by(fn {_k,v} -> -v end) +|> Enum.each(fn {k,v} -> IO.puts "#{k} #{v}" end) diff --git a/Task/Letter-frequency/Julia/letter-frequency.julia b/Task/Letter-frequency/Julia/letter-frequency.julia index 67b2afa4ff..0f5e6f9751 100644 --- a/Task/Letter-frequency/Julia/letter-frequency.julia +++ b/Task/Letter-frequency/Julia/letter-frequency.julia @@ -1,5 +1,5 @@ function freq(file) h = Dict{Char, Integer}() - for x in open(readchomp,file) h[x] = get(h,x,0)+1 end + for x in open(readstring ,file) h[x] = get(h,x,0)+1 end sort(collect(h)) end diff --git a/Task/Letter-frequency/OCaml/letter-frequency.ocaml b/Task/Letter-frequency/OCaml/letter-frequency-1.ocaml similarity index 100% rename from Task/Letter-frequency/OCaml/letter-frequency.ocaml rename to Task/Letter-frequency/OCaml/letter-frequency-1.ocaml diff --git a/Task/Letter-frequency/OCaml/letter-frequency-2.ocaml b/Task/Letter-frequency/OCaml/letter-frequency-2.ocaml new file mode 100644 index 0000000000..a83505d6ff --- /dev/null +++ b/Task/Letter-frequency/OCaml/letter-frequency-2.ocaml @@ -0,0 +1,10 @@ +open Batteries + +let frequency file = + let freq = Hashtbl.create 52 in + File.with_file_in file + (Enum.iter (fun c -> Hashtbl.modify_def 1 c succ freq) % Text.chars_of); + List.iter (fun (k,v) -> Text.write_text stdout k; + Printf.printf " %d\n" v) + @@ List.sort (fun (_,v) (_,v') -> compare v v') + @@ Hashtbl.fold (fun k v l -> (Text.of_uchar k,v) :: l) freq [] diff --git a/Task/Letter-frequency/PowerShell/letter-frequency.psh b/Task/Letter-frequency/PowerShell/letter-frequency.psh new file mode 100644 index 0000000000..58bd086255 --- /dev/null +++ b/Task/Letter-frequency/PowerShell/letter-frequency.psh @@ -0,0 +1,9 @@ +function frequency ($string) { + $arr = $string.ToUpper().ToCharArray() |where{$_ -match '[A-KL-Z]'} + $n = $arr.count + $arr | group | foreach{ + [pscustomobject]@{letter = "$($_.name)"; frequency = "$([math]::round($($_.Count/$n),5))"; count = "$($_.count)"} + } | sort letter +} +$file = "$($MyInvocation.MyCommand.Name )" #Put the name of your file here +frequency $(get-content $file -Raw) diff --git a/Task/Levenshtein-distance/00DESCRIPTION b/Task/Levenshtein-distance/00DESCRIPTION index 748ce174e2..4a19a8769b 100644 --- a/Task/Levenshtein-distance/00DESCRIPTION +++ b/Task/Levenshtein-distance/00DESCRIPTION @@ -1,13 +1,25 @@ {{Wikipedia}} + +
    In information theory and computer science, the '''Levenshtein distance''' is a [[wp:string metric|metric]] for measuring the amount of difference between two sequences (i.e. an [[wp:edit distance|edit distance]]). The Levenshtein distance between two strings is defined as the minimum number of edits needed to transform one string into the other, with the allowable edit operations being insertion, deletion, or substitution of a single character. -For example, the Levenshtein distance between "'''kitten'''" and "'''sitting'''" is 3, since the following three edits change one into the other, and there is no way to do it with fewer than three edits: -# '''k'''itten '''s'''itten (substitution of 'k' with 's') -# sitt'''e'''n sitt'''i'''n (substitution of 'e' with 'i') -# sittin sittin'''g''' (insert 'g' at the end). -''The Levenshtein distance between "'''rosettacode'''", "'''raisethysword'''" is 8; The distance between two strings is same as that when both strings is reversed.'' -'''Task :''' Implements a Levenshtein distance function, or uses a library function, to show the Levenshtein distance between "kitten" and "sitting". +;Example: +The Levenshtein distance between "'''kitten'''" and "'''sitting'''" is 3, since the following three edits change one into the other, and there isn't a way to do it with fewer than three edits: +::#   '''k'''itten   '''s'''itten   (substitution of 'k' with 's') +::#   sitt'''e'''n   sitt'''i'''n   (substitution of 'e' with 'i') +::#   sittin   sittin'''g'''   (insert 'g' at the end). -'''Other edit distance at Rosettacode.org''' : -*[[Longest common subsequence]] +
    +''The Levenshtein distance between   "'''rosettacode'''",   "'''raisethysword'''"   is   '''8'''. + +''The distance between two strings is same as that when both strings are reversed.'' + + +;Task; +Implements a Levenshtein distance function, or uses a library function, to show the Levenshtein distance between   "kitten"   and   "sitting". + + +;Related task: +*   [[Longest common subsequence]] +

    diff --git a/Task/Levenshtein-distance/AWK/levenshtein-distance.awk b/Task/Levenshtein-distance/AWK/levenshtein-distance-1.awk similarity index 100% rename from Task/Levenshtein-distance/AWK/levenshtein-distance.awk rename to Task/Levenshtein-distance/AWK/levenshtein-distance-1.awk diff --git a/Task/Levenshtein-distance/AWK/levenshtein-distance-2.awk b/Task/Levenshtein-distance/AWK/levenshtein-distance-2.awk new file mode 100644 index 0000000000..d957822675 --- /dev/null +++ b/Task/Levenshtein-distance/AWK/levenshtein-distance-2.awk @@ -0,0 +1,28 @@ +#!/usr/bin/awk -f + +function levdist(str1, str2, l1, l2, tog, arr, i, j, a, b, c) { + if (str1 == str2) { + return 0 + } else if (str1 == "" || str2 == "") { + return length(str1 str2) + } else if (substr(str1, 1, 1) == substr(str2, 1, 1)) { + a = 2 + while (substr(str1, a, 1) == substr(str2, a, 1)) a++ + return levdist(substr(str1, a), substr(str2, a)) + } else if (substr(str1, l1=length(str1), 1) == substr(str2, l2=length(str2), 1)) { + b = 1 + while (substr(str1, l1-b, 1) == substr(str2, l2-b, 1)) b++ + return levdist(substr(str1, 1, l1-b), substr(str2, 1, l2-b)) + } + for (i = 0; i <= l2; i++) arr[0, i] = i + for (i = 1; i <= l1; i++) { + arr[tog = ! tog, 0] = i + for (j = 1; j <= l2; j++) { + a = arr[! tog, j ] + 1 + b = arr[ tog, j-1] + 1 + c = arr[! tog, j-1] + (substr(str1, i, 1) != substr(str2, j, 1)) + arr[tog, j] = (((a<=b)&&(a<=c)) ? a : ((b<=a)&&(b<=c)) ? b : c) + } + } + return arr[tog, j-1] +} diff --git a/Task/Levenshtein-distance/AppleScript/levenshtein-distance-1.applescript b/Task/Levenshtein-distance/AppleScript/levenshtein-distance-1.applescript new file mode 100644 index 0000000000..b117774ba5 --- /dev/null +++ b/Task/Levenshtein-distance/AppleScript/levenshtein-distance-1.applescript @@ -0,0 +1,55 @@ +set dist to findLevenshteinDistance for "sunday" against "saturday" +to findLevenshteinDistance for s1 against s2 + script o + property l : s1 + property m : s2 + end script + if s1 = s2 then return 0 + set ll to length of s1 + set lm to length of s2 + if ll = 0 then return lm + if lm = 0 then return ll + + set v0 to {} + + repeat with i from 1 to (lm + 1) + set end of v0 to (i - 1) + end repeat + set item -1 of v0 to 0 + copy v0 to v1 + + repeat with i from 1 to ll + -- calculate v1 (current row distances) from the previous row v0 + + -- first element of v1 is A[i+1][0] + -- edit distance is delete (i+1) chars from s to match empty t + set item 1 of v1 to i + -- use formula to fill in the rest of the row + repeat with j from 1 to lm + if item i of o's l = item j of o's m then + set cost to 0 + else + set cost to 1 + end if + set item (j + 1) of v1 to min3 for ((item j of v1) + 1) against ((item (j + 1) of v0) + 1) by ((item j of v0) + cost) + end repeat + copy v1 to v0 + end repeat + return item (lm + 1) of v1 +end findLevenshteinDistance + +to min3 for anInt against anOther by theThird + if anInt < anOther then + if theThird < anInt then + return theThird + else + return anInt + end if + else + if theThird < anOther then + return theThird + else + return anOther + end if + end if +end min3 diff --git a/Task/Levenshtein-distance/AppleScript/levenshtein-distance-2.applescript b/Task/Levenshtein-distance/AppleScript/levenshtein-distance-2.applescript new file mode 100644 index 0000000000..75eb69fb7a --- /dev/null +++ b/Task/Levenshtein-distance/AppleScript/levenshtein-distance-2.applescript @@ -0,0 +1,157 @@ +-- levenshtein :: String -> String -> Int +on levenshtein(sa, sb) + set {s1, s2} to {characters of sa, characters of sb} + + script + on lambda(ns, c) + script minPath + on lambda(z, c1xy) + set {c1, x, y} to c1xy + minimum({y + 1, z + 1, x + fromEnum(c1 is not c)}) + end lambda + end script + + set {n, ns1} to uncons(ns) + scanl(minPath, n + 1, zip3(s1, ns, ns1)) + end lambda + end script + + |last|(foldl(result, range(0, length of s1), s2)) +end levenshtein + + +-- TEST ------------------------------------------------------------------------------ + +on run + script test + on lambda(xs) + levenshtein(item 1 of xs, item 2 of xs) + end lambda + end script + + map(test, [["kitten", "sitting"], ["sitting", "kitten"], ¬ + ["rosettacode", "raisethysword"], ["raisethysword", "rosettacode"]]) + + --> {3, 3, 8, 8} +end run + + +-- GENERIC FUNCTIONS ------------------------------------------------------------ + +-- minimum :: [a] -> a +on minimum(xs) + script min + on lambda(a, x) + if x < a or a is missing value then + x + else + a + end if + end lambda + end script + + foldl(min, missing value, xs) +end minimum + +-- fromEnum :: Enum a => a -> Int +on fromEnum(x) + if class of x is boolean then + x as integer + else + id of x + end if +end fromEnum + +-- uncons :: [a] -> Maybe (a, [a]) +on uncons(xs) + if length of xs > 0 then + {item 1 of xs, rest of xs} + else + missing value + end if +end uncons + +-- 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 + +-- zip3 :: [a] -> [b] -> [c] -> [(a, b, c)] +on zip3(xs, ys, zs) + script + on lambda(x, i) + [x, item i of ys, item i of zs] + end lambda + end script + + map(result, items 1 thru ¬ + minimum({length of xs, length of ys, length of zs}) of xs) +end zip3 + +-- last :: [a] -> a +on |last|(xs) + if length of xs > 0 then + item -1 of xs + else + missing value + end if +end |last| + +-- range :: Int -> Int -> [Int] +on range(m, n) + if n < m then + set d to -1 + else + set d to 1 + end if + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range + +-- 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 + +-- 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 diff --git a/Task/Levenshtein-distance/AppleScript/levenshtein-distance-3.applescript b/Task/Levenshtein-distance/AppleScript/levenshtein-distance-3.applescript new file mode 100644 index 0000000000..085bbb73f3 --- /dev/null +++ b/Task/Levenshtein-distance/AppleScript/levenshtein-distance-3.applescript @@ -0,0 +1 @@ +{3, 3, 8, 8} diff --git a/Task/Levenshtein-distance/AppleScript/levenshtein-distance.applescript b/Task/Levenshtein-distance/AppleScript/levenshtein-distance.applescript deleted file mode 100644 index f4c22b3c6c..0000000000 --- a/Task/Levenshtein-distance/AppleScript/levenshtein-distance.applescript +++ /dev/null @@ -1,55 +0,0 @@ -set dist to findLevenshteinDistance for "sunday" against "saturday" -to findLevenshteinDistance for s1 against s2 - script o - property l : s1 - property m : s2 - end script - if s1 = s2 then return 0 - set ll to length of s1 - set lm to length of s2 - if ll = 0 then return lm - if lm = 0 then return ll - - set v0 to {} - - repeat with i from 1 to (lm + 1) - set end of v0 to (i - 1) - end repeat - set item -1 of v0 to 0 - copy v0 to v1 - - repeat with i from 1 to ll - -- calculate v1 (current row distances) from the previous row v0 - - -- first element of v1 is A[i+1][0] - -- edit distance is delete (i+1) chars from s to match empty t - set item 1 of v1 to i - -- use formula to fill in the rest of the row - repeat with j from 1 to lm - if item i of o's l = item j of o's m then - set cost to 0 - else - set cost to 1 - end if - set item (j + 1) of v1 to min3 for ((item j of v1) + 1) against ((item (j + 1) of v0) + 1) by ((item j of v0) + cost) - end repeat - copy v1 to v0 - end repeat - return item (lm + 1) of v1 -end findLevenshteinDistance - -to min3 for anInt against anOther by theThird - if anInt < anOther then - if theThird < anInt then - return theThird - else - return anInt - end if - else - if theThird < anOther then - return theThird - else - return anOther - end if - end if -end min3 diff --git a/Task/Levenshtein-distance/Elixir/levenshtein-distance.elixir b/Task/Levenshtein-distance/Elixir/levenshtein-distance.elixir index e8028302fb..0fba6f6c99 100644 --- a/Task/Levenshtein-distance/Elixir/levenshtein-distance.elixir +++ b/Task/Levenshtein-distance/Elixir/levenshtein-distance.elixir @@ -4,9 +4,9 @@ defmodule Levenshtein do tb = String.downcase(b) |> to_char_list |> List.to_tuple m = tuple_size(ta) n = tuple_size(tb) - costs = Enum.reduce(0..m, %{}, fn i,acc -> Dict.put(acc, {i,0}, i) end) - cost2 = Enum.reduce(0..n, costs, fn j,acc -> Dict.put(acc, {0,j}, j) end) - cost3 = Enum.reduce(0..n-1, cost2, fn j, acc -> + costs = Enum.reduce(0..m, %{}, fn i,acc -> Map.put(acc, {i,0}, i) end) + costs = Enum.reduce(0..n, costs, fn j,acc -> Map.put(acc, {0,j}, j) end) + Enum.reduce(0..n-1, costs, fn j, acc -> Enum.reduce(0..m-1, acc, fn i, map -> d = if elem(ta, i) == elem(tb, j) do map[ {i,j} ] @@ -15,10 +15,10 @@ defmodule Levenshtein do map[ {i+1, j } ] + 1, # insertion map[ {i , j } ] + 1 ]) # substitution end - Dict.put(map, {i+1, j+1}, d) + Map.put(map, {i+1, j+1}, d) end) end) - cost3[ {m,n} ] + |> Map.get({m,n}) end end diff --git a/Task/Levenshtein-distance/Io/levenshtein-distance.io b/Task/Levenshtein-distance/Io/levenshtein-distance.io new file mode 100644 index 0000000000..0de72ab1b9 --- /dev/null +++ b/Task/Levenshtein-distance/Io/levenshtein-distance.io @@ -0,0 +1,6 @@ +Io 20110905 +Io> Range ; "kitten" levenshtein("sitting") +==> 3 +Io> "rosettacode" levenshtein("raisethysword") +==> 8 +Io> diff --git a/Task/Levenshtein-distance/JavaScript/levenshtein-distance-1.js b/Task/Levenshtein-distance/JavaScript/levenshtein-distance-1.js new file mode 100644 index 0000000000..8977b5a5ba --- /dev/null +++ b/Task/Levenshtein-distance/JavaScript/levenshtein-distance-1.js @@ -0,0 +1,31 @@ +function levenshtein(a, b) { + var t = [], u, i, j, m = a.length, n = b.length; + if (!m) { return n; } + if (!n) { return m; } + for (j = 0; j <= n; j++) { t[j] = j; } + for (i = 1; i <= m; i++) { + for (u = [i], j = 1; j <= n; j++) { + u[j] = a[i - 1] === b[j - 1] ? t[j - 1] : Math.min(t[j - 1], t[j], u[j - 1]) + 1; + } t = u; + } return u[n]; +} + +// tests +[ ['', '', 0], + ['yo', '', 2], + ['', 'yo', 2], + ['yo', 'yo', 0], + ['tier', 'tor', 2], + ['saturday', 'sunday', 3], + ['mist', 'dist', 1], + ['tier', 'tor', 2], + ['kitten', 'sitting', 3], + ['stop', 'tops', 2], + ['rosettacode', 'raisethysword', 8], + ['mississippi', 'swiss miss', 8] +].forEach(function(v) { + var a = v[0], b = v[1], t = v[2], d = levenshtein(a, b); + if (d !== t) { + console.log('levenstein("' + a + '","' + b + '") was ' + d + ' should be ' + t); + } +}); diff --git a/Task/Levenshtein-distance/JavaScript/levenshtein-distance-2.js b/Task/Levenshtein-distance/JavaScript/levenshtein-distance-2.js new file mode 100644 index 0000000000..998f367ca0 --- /dev/null +++ b/Task/Levenshtein-distance/JavaScript/levenshtein-distance-2.js @@ -0,0 +1,73 @@ +(() => { + 'use strict'; + + // levenshtein :: String -> String -> Int + const levenshtein = (sa, sb) => { + const [s1, s2] = [sa.split(''), sb.split('')]; + + return last(s2.reduce((ns, c) => { + const [n, ns1] = uncons(ns); + + return scanl( + (z, [c1, x, y]) => + minimum( + [y + 1, z + 1, x + fromEnum(c1 != c)] + ), + n + 1, + zip3(s1, ns, ns1) + ); + }, range(0, s1.length))); + }; + + + /*********************************************************************/ + // GENERIC FUNCTIONS + + // minimum :: [a] -> a + const minimum = xs => + xs.reduce((a, x) => (x < a || a === undefined ? x : a), undefined); + + // fromEnum :: Enum a => a -> Int + const fromEnum = x => { + const type = typeof x; + return type === 'boolean' ? ( + x ? 1 : 0 + ) : (type === 'string' ? x.charCodeAt(0) : undefined); + }; + + // uncons :: [a] -> Maybe (a, [a]) + const uncons = xs => xs.length ? [xs[0], xs.slice(1)] : undefined; + + // scanl :: (b -> a -> b) -> b -> [a] -> [b] + const scanl = (f, a, xs) => { + for (var lst = [a], lng = xs.length, i = 0; i < lng; i++) { + a = f(a, xs[i], i, xs), lst.push(a); + } + return lst; + }; + + // zip3 :: [a] -> [b] -> [c] -> [(a,b,c)] + const zip3 = (xs, ys, zs) => + xs.slice(0, Math.min(xs.length, ys.length, zs.length)) + .map((x, i) => [x, ys[i], zs[i]]); + + // last :: [a] -> a + const last = xs => xs.length ? xs.slice(-1) : undefined; + + // range :: Int -> Int -> [Int] + const range = (m, n) => + Array.from({ + length: Math.floor(n - m) + 1 + }, (_, i) => m + i); + + /*********************************************************************/ + // TEST + return [ + ["kitten", "sitting"], + ["sitting", "kitten"], + ["rosettacode", "raisethysword"], + ["raisethysword", "rosettacode"] + ].map(pair => levenshtein.apply(null, pair)); + + // -> [3, 3, 8, 8] +})(); diff --git a/Task/Levenshtein-distance/JavaScript/levenshtein-distance-3.js b/Task/Levenshtein-distance/JavaScript/levenshtein-distance-3.js new file mode 100644 index 0000000000..0da83f898d --- /dev/null +++ b/Task/Levenshtein-distance/JavaScript/levenshtein-distance-3.js @@ -0,0 +1 @@ +[3, 3, 8, 8] diff --git a/Task/Levenshtein-distance/JavaScript/levenshtein-distance.js b/Task/Levenshtein-distance/JavaScript/levenshtein-distance.js deleted file mode 100644 index 297533e426..0000000000 --- a/Task/Levenshtein-distance/JavaScript/levenshtein-distance.js +++ /dev/null @@ -1,24 +0,0 @@ -function levenshtein(str1, str2) { - var m = str1.length, - n = str2.length, - d = [], - i, j; - - if (!m) return n; - if (!n) return m; - - for (i = 0; i <= m; i++) d[i] = [i]; - for (j = 0; j <= n; j++) d[0][j] = j; - - for (j = 1; j <= n; j++) { - for (i = 1; i <= m; i++) { - if (str1[i-1] == str2[j-1]) d[i][j] = d[i - 1][j - 1]; - else d[i][j] = Math.min(d[i-1][j], d[i][j-1], d[i-1][j-1]) + 1; - } - } - return d[m][n]; -} - -console.log(levenshtein("kitten", "sitting")); -console.log(levenshtein("stop", "tops")); -console.log(levenshtein("rosettacode", "raisethysword")); diff --git a/Task/Levenshtein-distance/PARI-GP/levenshtein-distance.pari b/Task/Levenshtein-distance/PARI-GP/levenshtein-distance.pari new file mode 100644 index 0000000000..da88c413fb --- /dev/null +++ b/Task/Levenshtein-distance/PARI-GP/levenshtein-distance.pari @@ -0,0 +1,23 @@ +\\ Levenshtein distance between two words +\\ 6/21/16 aev +levensDist(s1,s2)={ +my(n1=#s1,n2=#s2,v1=Vecsmall(s1),v2=Vecsmall(s2),c, + n11=n1+1,n21=n2+1,t=vector(n21,z,z-1),u0=vector(n21),u=u0); +if(s1==s2, return(0)); if(!n1, return(n2)); if(!n2, return(n1)); +for(i=2,n11, u=u0; u[1]=i-1; + for(j=2,n21, + if(v1[i-1]==v2[j-1], c=t[j-1], c=vecmin([t[j-1],t[j],u[j-1]])+1); + u[j]=c; + );\\fend j + t=u; +);\\fend i +print(" *** Levenshtein distance = ",t[n21]," for strings: ",s1,", ",s2); +return(t[n21]); +} +{ \\ Testing: +levensDist("kitten","sitting"); +levensDist("rosettacode","raisethysword"); +levensDist("Saturday","Sunday"); +levensDist("oX","X"); +levensDist("X","oX"); +} diff --git a/Task/Levenshtein-distance/Perl/levenshtein-distance.pl b/Task/Levenshtein-distance/Perl/levenshtein-distance.pl index 95e23b87a3..cb73d0062c 100644 --- a/Task/Levenshtein-distance/Perl/levenshtein-distance.pl +++ b/Task/Levenshtein-distance/Perl/levenshtein-distance.pl @@ -4,8 +4,8 @@ my %cache; sub leven { my ($s, $t) = @_; - return length($t) if !$s; - return length($s) if !$t; + return length($t) if $s eq ''; + return length($s) if $t eq ''; $cache{$s}{$t} //= # try commenting out this line do { diff --git a/Task/Levenshtein-distance/PowerShell/levenshtein-distance-1.psh b/Task/Levenshtein-distance/PowerShell/levenshtein-distance-1.psh new file mode 100644 index 0000000000..8767921862 --- /dev/null +++ b/Task/Levenshtein-distance/PowerShell/levenshtein-distance-1.psh @@ -0,0 +1,59 @@ +function Get-LevenshteinDistance +{ + [CmdletBinding()] + [OutputType([PSCustomObject])] + Param + ( + [Parameter(Mandatory=$true, Position=0)] + [ValidateNotNullOrEmpty()] + [Alias("s")] + [string] + $ReferenceObject, + + [Parameter(Mandatory=$true, Position=1)] + [ValidateNotNullOrEmpty()] + [Alias("t")] + [string] + $DifferenceObject + ) + + [int]$n = $ReferenceObject.Length + [int]$m = $DifferenceObject.Length + + $d = New-Object -TypeName 'System.Object[,]' -ArgumentList ($n + 1),($m + 1) + + $outputObject = [PSCustomObject]@{ + ReferenceObject = $ReferenceObject + DifferenceObject = $DifferenceObject + Distance = $null + } + + for ($i = 0; $i -le $n; $i++) + { + $d[$i, 0] = $i + } + + for ($i = 0; $i -le $m; $i++) + { + $d[0, $i] = $i + } + + for ($i = 1; $i -le $m; $i++) + { + for ($j = 1; $j -le $n; $j++) + { + if ($ReferenceObject[$j - 1] -eq $DifferenceObject[$i - 1]) + { + $d[$j, $i] = $d[($j - 1), ($i - 1)] + } + else + { + $d[$j, $i] = [Math]::Min([Math]::Min(($d[($j - 1), $i] + 1), ($d[$j, ($i - 1)] + 1)), ($d[($j - 1), ($i - 1)] + 1)) + } + } + } + + $outputObject.Distance = $d[$n, $m] + + $outputObject +} diff --git a/Task/Levenshtein-distance/PowerShell/levenshtein-distance-2.psh b/Task/Levenshtein-distance/PowerShell/levenshtein-distance-2.psh new file mode 100644 index 0000000000..9c89eef81e --- /dev/null +++ b/Task/Levenshtein-distance/PowerShell/levenshtein-distance-2.psh @@ -0,0 +1,2 @@ +Get-LevenshteinDistance "kitten" "sitting" +Get-LevenshteinDistance rosettacode raisethysword diff --git a/Task/Levenshtein-distance/Rust/levenshtein-distance.rust b/Task/Levenshtein-distance/Rust/levenshtein-distance.rust index 206938727a..ea79dfeb23 100644 --- a/Task/Levenshtein-distance/Rust/levenshtein-distance.rust +++ b/Task/Levenshtein-distance/Rust/levenshtein-distance.rust @@ -3,10 +3,12 @@ fn main() { println!("{}", levenshtein_distance("saturday", "sunday")); println!("{}", levenshtein_distance("rosettacode", "raisethysword")); } - fn levenshtein_distance(word1: &str, word2: &str) -> usize { - let word1_length = word1.len() + 1; - let word2_length = word2.len() + 1; + let w1 = word1.chars().collect::>(); + let w2 = word2.chars().collect::>(); + + let word1_length = w1.len() + 1; + let word2_length = w2.len() + 1; let mut matrix = vec![vec![0]]; @@ -15,17 +17,15 @@ fn levenshtein_distance(word1: &str, word2: &str) -> usize { for j in 1..word2_length { for i in 1..word1_length { - let x: usize = if word1.chars().nth(i - 1) == word2.chars().nth(j - 1) { + let x: usize = if w1[i-1] == w2[j-1] { matrix[j-1][i-1] - } - else { - let min_distance = [matrix[j][i-1], matrix[j-1][i], matrix[j-1][i-1]]; - *min_distance.iter().min().unwrap() + 1 + } else { + 1 + std::cmp::min( + std::cmp::min(matrix[j][i-1], matrix[j-1][i]) + , matrix[j-1][i-1]) }; - matrix[j].push(x); } } - matrix[word2_length-1][word1_length-1] } diff --git a/Task/Linear-congruential-generator/C++/linear-congruential-generator.cpp b/Task/Linear-congruential-generator/C++/linear-congruential-generator-1.cpp similarity index 100% rename from Task/Linear-congruential-generator/C++/linear-congruential-generator.cpp rename to Task/Linear-congruential-generator/C++/linear-congruential-generator-1.cpp diff --git a/Task/Linear-congruential-generator/C++/linear-congruential-generator-2.cpp b/Task/Linear-congruential-generator/C++/linear-congruential-generator-2.cpp new file mode 100644 index 0000000000..955edf1c9d --- /dev/null +++ b/Task/Linear-congruential-generator/C++/linear-congruential-generator-2.cpp @@ -0,0 +1,20 @@ +#include +#include + +int main() { + + std::linear_congruential_engine bsd_rand(0); + std::linear_congruential_engine ms_rand(0); + + std::cout << "BSD RAND:" << std::endl << "========" << std::endl; + for (int i = 0; i < 10; i++) { + std::cout << bsd_rand() << std::endl; + } + std::cout << std::endl; + std::cout << "MS RAND:" << std::endl << "========" << std::endl; + for (int i = 0; i < 10; i++) { + std::cout << (ms_rand() >> 16) << std::endl; + } + + return 0; +} diff --git a/Task/Linear-congruential-generator/Haskell/linear-congruential-generator.hs b/Task/Linear-congruential-generator/Haskell/linear-congruential-generator.hs index dc22eaa46e..e0a7bfb44c 100644 --- a/Task/Linear-congruential-generator/Haskell/linear-congruential-generator.hs +++ b/Task/Linear-congruential-generator/Haskell/linear-congruential-generator.hs @@ -1,5 +1,5 @@ -bsd n = r:bsd r where r = ((n * 1103515245 + 12345) `rem` 2^31) -msr n = (r `div` 2^16):msr r where r = (214013 * n + 2531011) `rem` 2^31 +bsd = tail . iterate (\n -> (n * 1103515245 + 12345) `mod` 2^31) +msr = map (`div` 2^16) . tail . iterate (\n -> (214013 * n + 2531011) `mod` 2^31) main = do print $ take 10 $ bsd 0 -- can take seeds other than 0, of course diff --git a/Task/Linear-congruential-generator/Java/linear-congruential-generator.java b/Task/Linear-congruential-generator/Java/linear-congruential-generator.java new file mode 100644 index 0000000000..15af4f0c0f --- /dev/null +++ b/Task/Linear-congruential-generator/Java/linear-congruential-generator.java @@ -0,0 +1,23 @@ +import java.util.stream.IntStream; +import static java.util.stream.IntStream.iterate; + +public class LinearCongruentialGenerator { + final static int mask = (1 << 31) - 1; + + public static void main(String[] args) { + System.out.println("BSD:"); + randBSD(0).limit(10).forEach(System.out::println); + + System.out.println("\nMS:"); + randMS(0).limit(10).forEach(System.out::println); + } + + static IntStream randBSD(int seed) { + return iterate(seed, s -> (s * 1_103_515_245 + 12_345) & mask).skip(1); + } + + static IntStream randMS(int seed) { + return iterate(seed, s -> (s * 214_013 + 2_531_011) & mask).skip(1) + .map(i -> i >> 16); + } +} diff --git a/Task/Linear-congruential-generator/Perl-6/linear-congruential-generator.pl6 b/Task/Linear-congruential-generator/Perl-6/linear-congruential-generator.pl6 index 1c94b9d4ed..504a42b165 100644 --- a/Task/Linear-congruential-generator/Perl-6/linear-congruential-generator.pl6 +++ b/Task/Linear-congruential-generator/Perl-6/linear-congruential-generator.pl6 @@ -8,8 +8,8 @@ sub ms { ) } -say 'BSD LCG first 10 values (fist one is the seed):'; +say 'BSD LCG first 10 values (first one is the seed):'; .say for bsd(0)[^10]; -say "\nMS LCG first 10 values (fist one is the seed):"; +say "\nMS LCG first 10 values (first one is the seed):"; .say for ms(0)[^10]; diff --git a/Task/Linear-congruential-generator/Run-BASIC/linear-congruential-generator.run b/Task/Linear-congruential-generator/Run-BASIC/linear-congruential-generator.run new file mode 100644 index 0000000000..1ad87f559e --- /dev/null +++ b/Task/Linear-congruential-generator/Run-BASIC/linear-congruential-generator.run @@ -0,0 +1,16 @@ +global bsd +global ms +print "Num ___Bsd___";chr$(9);"__Ms_" +for i = 1 to 10 + print using("##",i);using("############",bsdRnd());chr$(9);using("#####",msRnd()) +next i + +function bsdRnd() + bsdRnd = (1103515245 * bsd + 12345) mod (2 ^ 31) + bsd = bsdRnd +end function + +function msRnd() + ms = (214013 * ms + 2531011) mod (2 ^ 31) + msRnd = int(ms / 2 ^ 16) +end function diff --git a/Task/List-comprehensions/00DESCRIPTION b/Task/List-comprehensions/00DESCRIPTION index 0656c517fd..6ced18bd14 100644 --- a/Task/List-comprehensions/00DESCRIPTION +++ b/Task/List-comprehensions/00DESCRIPTION @@ -1,10 +1,19 @@ -{{Omit From|C}}{{Omit From|Java}}{{Omit From|Modula-3}}{{omit from|ACL2}}{{omit from|BBC BASIC}} +{{Omit From|C}} +{{Omit From|Java}} +{{Omit From|Modula-3}} +{{omit from|ACL2}} +{{omit from|BBC BASIC}} A [[wp:List_comprehension|list comprehension]] is a special syntax in some programming languages to describe lists. It is similar to the way mathematicians describe sets, with a ''set comprehension'', hence the name. -Some attributes of a list comprehension are that: -# They should be distinct from (nested) for loops and the use of map & filter functions within the syntax of the language. +Some attributes of a list comprehension are: +# They should be distinct from (nested) for loops and the use of map and filter functions within the syntax of the language. # They should return either a list or an iterator (something that returns successive members of a collection, in order). # The syntax has parts corresponding to that of [[wp:Set-builder_notation|set-builder notation]]. -Write a list comprehension that builds the list of all [[Pythagorean triples]] with elements between 1 and n. If the language has multiple ways for expressing such a construct (for example, direct list comprehensions and generators), write one example for each. + +;Task: +Write a list comprehension that builds the list of all [[Pythagorean triples]] with elements between   '''1'''   and   '''n'''. + +If the language has multiple ways for expressing such a construct (for example, direct list comprehensions and generators), write one example for each. +

    diff --git a/Task/List-comprehensions/AppleScript/list-comprehensions-1.applescript b/Task/List-comprehensions/AppleScript/list-comprehensions-1.applescript new file mode 100644 index 0000000000..bdc237d268 --- /dev/null +++ b/Task/List-comprehensions/AppleScript/list-comprehensions-1.applescript @@ -0,0 +1,120 @@ +-- List comprehension by direct and unsugared use of list monad + +-- pythagoreanTriples :: Int -> [(Int, Int, Int)] +on pythagoreanTriples(maxInteger) + script X + on lambda(X) + script Y + on lambda(Y) + script Z + on lambda(Z) + if X * X + Y * Y = Z * Z then + unit([X, Y, Z]) + else + [] + end if + end lambda + end script + + bind(Z, range(1 + Y, maxInteger)) + end lambda + end script + + bind(Y, range(1 + X, maxInteger)) + end lambda + end script + + bind(X, range(1, maxInteger)) + +end pythagoreanTriples + + +on run + -- Pythagorean triples drawn from integers in the range [1..n] + -- {(x, y, z) | x <- [1..n], y <- [x+1..n], z <- [y+1..n], (x^2 + y^2 = z^2)} + + pythagoreanTriples(25) + + --> {{3, 4, 5}, {5, 12, 13}, {6, 8, 10}, {7, 24, 25}, {8, 15, 17}, {9, 12, 15}, {12, 16, 20}, {15, 20, 25}} + +end run + + +-- MONADIC FUNCTIONS (for list monad) + +-- Monadic bind for lists is simply ConcatMap +-- which applies a function f directly to each value in the list, +-- and returns the set of results as a concat-flattened list + +-- bind :: (a -> [b]) -> [a] -> [b] +on bind(f, xs) + -- concat :: a -> a -> [a] + script concat + on lambda(a, b) + a & b + end lambda + end script + + foldl(concat, {}, map(f, xs)) +end bind + +-- Monadic return/unit/inject for lists: just wraps a value in a list +-- a -> [a] +on unit(a) + [a] +end unit + + +--------------------------------------------------------------------------- + +-- GENERIC LIBRARY FUNCTIONS + +-- 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 + +-- 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 + +-- 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 + +-- range :: Int -> Int -> [Int] +on range(m, n) + if n < m then + set d to -1 + else + set d to 1 + end if + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range diff --git a/Task/List-comprehensions/AppleScript/list-comprehensions-2.applescript b/Task/List-comprehensions/AppleScript/list-comprehensions-2.applescript new file mode 100644 index 0000000000..d2e40a7400 --- /dev/null +++ b/Task/List-comprehensions/AppleScript/list-comprehensions-2.applescript @@ -0,0 +1 @@ +{{3, 4, 5}, {5, 12, 13}, {6, 8, 10}, {7, 24, 25}, {8, 15, 17}, {9, 12, 15}, {12, 16, 20}, {15, 20, 25}} diff --git a/Task/List-comprehensions/Haskell/list-comprehensions-1.hs b/Task/List-comprehensions/Haskell/list-comprehensions-1.hs index 70b0a513ab..c9c6fe51e7 100644 --- a/Task/List-comprehensions/Haskell/list-comprehensions-1.hs +++ b/Task/List-comprehensions/Haskell/list-comprehensions-1.hs @@ -1 +1,2 @@ +pyth :: (Enum t, Eq t, Num t) => t -> [(t, t, t)] pyth n = [(x,y,z) | x <- [1..n], y <- [x..n], z <- [y..n], x^2 + y^2 == z^2] diff --git a/Task/List-comprehensions/Haskell/list-comprehensions-2.hs b/Task/List-comprehensions/Haskell/list-comprehensions-2.hs index 3e99ac72c4..069859f8a2 100644 --- a/Task/List-comprehensions/Haskell/list-comprehensions-2.hs +++ b/Task/List-comprehensions/Haskell/list-comprehensions-2.hs @@ -1,5 +1,6 @@ -import Control.Monad +import Control.Monad (guard) +pyth :: (Enum t, Eq t, Num t) => t -> [(t, t, t)] pyth n = do x <- [1..n] y <- [x..n] diff --git a/Task/List-comprehensions/JavaScript/list-comprehensions-1.js b/Task/List-comprehensions/JavaScript/list-comprehensions-1.js index cd25787037..71da2f3371 100644 --- a/Task/List-comprehensions/JavaScript/list-comprehensions-1.js +++ b/Task/List-comprehensions/JavaScript/list-comprehensions-1.js @@ -1,14 +1,32 @@ -function range(begin, end) { - for (let i = begin; i < end; ++i) - yield i; -} +// USING A LIST MONAD DIRECTLY, WITHOUT SPECIAL SYNTAX FOR LIST COMPREHENSIONS -function triples(n) { - return [[x,y,z] for each (x in range(1,n+1)) - for each (y in range(x,n+1)) - for each (z in range(y,n+1)) - if (x*x + y*y == z*z) ] -} +(function (n) { -for each (var triple in triples(20)) - print(triple); + return mb(r(1, n), function (x) { // x <- [1..n] + return mb(r(1 + x, n), function (y) { // y <- [1+x..n] + return mb(r(1 + y, n), function (z) { // z <- [1+y..n] + + return x * x + y * y === z * z ? [[x, y, z]] : []; + + })})}); + + + // LIBRARY FUNCTIONS + + // Monadic bind for lists + function mb(xs, f) { + return [].concat.apply([], xs.map(f)); + } + + // Monadic return for lists is simply lambda x -> [x] + // as in [[x, y, z]] : [] above + + // Integer range [m..n] + function r(m, n) { + return Array.apply(null, Array(n - m + 1)) + .map(function (n, x) { + return m + x; + }); + } + +})(100); diff --git a/Task/List-comprehensions/JavaScript/list-comprehensions-2.js b/Task/List-comprehensions/JavaScript/list-comprehensions-2.js index 346cfacb71..cd25787037 100644 --- a/Task/List-comprehensions/JavaScript/list-comprehensions-2.js +++ b/Task/List-comprehensions/JavaScript/list-comprehensions-2.js @@ -1,31 +1,14 @@ -(function(n) { +function range(begin, end) { + for (let i = begin; i < end; ++i) + yield i; +} - // USING A LIST MONAD DIRECTLY, WITHOUT LIST COMPREHENSION NOTATION +function triples(n) { + return [[x,y,z] for each (x in range(1,n+1)) + for each (y in range(x,n+1)) + for each (z in range(y,n+1)) + if (x*x + y*y == z*z) ] +} - return mb( rng(1, n), function(x) { - return mb( rng(1 + x, n), function(y) { - return mb( rng(1 + y, n), function(z) { - - return ( x * x + y * y === z * z ) ? mReturn([x, y, z]) : []; - - })})}); - - /******************************************************************/ - - // Monadic bind (chain) for lists - function mb(xs, f) { - return [].concat.apply([], xs.map(f)); - } - - // Monadic return (inject) for lists - function mReturn(a) { - return [a]; - } - - function rng(m, n) { - return Array.apply(null, Array(n - m + 1)).map( - function (x, i) { return m + i; } - ); - } - -})(100); +for each (var triple in triples(20)) + print(triple); diff --git a/Task/List-comprehensions/JavaScript/list-comprehensions-3.js b/Task/List-comprehensions/JavaScript/list-comprehensions-3.js new file mode 100644 index 0000000000..448e6f49d0 --- /dev/null +++ b/Task/List-comprehensions/JavaScript/list-comprehensions-3.js @@ -0,0 +1,18 @@ + (n => { + + let flatMap = (xs, f) => [].concat.apply([], xs.map(f)), + + range = (m, n) => Array.from({ + length: (n - m) + 1 + }, (_, i) => m + i); + + + return flatMap(range(1, n), (x) => + flatMap(range(1 + x, n), (y) => + flatMap(range(1 + y, n), (z) => + x * x + y * y === z * z ? [ + [x, y, z] + ] : [] + ))); + + })(20); diff --git a/Task/List-comprehensions/Julia/list-comprehensions-1.julia b/Task/List-comprehensions/Julia/list-comprehensions-1.julia new file mode 100644 index 0000000000..9541e6484c --- /dev/null +++ b/Task/List-comprehensions/Julia/list-comprehensions-1.julia @@ -0,0 +1,11 @@ +julia> n = 20 +20 + +julia> [(x, y, z) for x = 1:n for y = x:n for z = y:n if x^2 + y^2 == z^2] +6-element Array{Tuple{Int64,Int64,Int64},1}: + (3,4,5) + (5,12,13) + (6,8,10) + (8,15,17) + (9,12,15) + (12,16,20) diff --git a/Task/List-comprehensions/Julia/list-comprehensions-2.julia b/Task/List-comprehensions/Julia/list-comprehensions-2.julia new file mode 100644 index 0000000000..b12fae4fea --- /dev/null +++ b/Task/List-comprehensions/Julia/list-comprehensions-2.julia @@ -0,0 +1,11 @@ +julia> ((x, y, z) for x = 1:n for y = x:n for z = y:n if x^2 + y^2 == z^2) +Base.Flatten{Base.Generator{UnitRange{Int64},##33#37}}(Base.Generator{UnitRange{Int64},##33#37}(#33,1:20)) + +julia> collect(ans) +6-element Array{Tuple{Int64,Int64,Int64},1}: + (3,4,5) + (5,12,13) + (6,8,10) + (8,15,17) + (9,12,15) + (12,16,20) diff --git a/Task/List-comprehensions/Julia/list-comprehensions-3.julia b/Task/List-comprehensions/Julia/list-comprehensions-3.julia new file mode 100644 index 0000000000..749ac6a3dc --- /dev/null +++ b/Task/List-comprehensions/Julia/list-comprehensions-3.julia @@ -0,0 +1,23 @@ +julia> [i + j for i in 1:5, j in 1:5] +5×5 Array{Int64,2}: + 2 3 4 5 6 + 3 4 5 6 7 + 4 5 6 7 8 + 5 6 7 8 9 + 6 7 8 9 10 + +julia> [i + j for i in 1:5, j in 1:5, k in 1:2] +5×5×2 Array{Int64,3}: +[:, :, 1] = + 2 3 4 5 6 + 3 4 5 6 7 + 4 5 6 7 8 + 5 6 7 8 9 + 6 7 8 9 10 + +[:, :, 2] = + 2 3 4 5 6 + 3 4 5 6 7 + 4 5 6 7 8 + 5 6 7 8 9 + 6 7 8 9 10 diff --git a/Task/List-comprehensions/Julia/list-comprehensions.julia b/Task/List-comprehensions/Julia/list-comprehensions.julia deleted file mode 100644 index 6b8ae26d2e..0000000000 --- a/Task/List-comprehensions/Julia/list-comprehensions.julia +++ /dev/null @@ -1,2 +0,0 @@ -const n = 20 -sort(filter(x -> x[1] < x[2] && x[1]^2 + x[2]^2 == x[3]^2, [(a, b, c) for a=1:n, b=1:n, c=1:n])) diff --git a/Task/List-comprehensions/SuperCollider/list-comprehensions-1.supercollider b/Task/List-comprehensions/SuperCollider/list-comprehensions-1.supercollider index f6a46fbc13..f733ad84a4 100644 --- a/Task/List-comprehensions/SuperCollider/list-comprehensions-1.supercollider +++ b/Task/List-comprehensions/SuperCollider/list-comprehensions-1.supercollider @@ -1,11 +1,10 @@ -var pyth = { - arg n = 10; // default +var pyth = { |n| all {: [x,y,z], x <- (1..n), y <- (x..n), z <- (y..n), (x**2) + (y**2) == (z**2) - }; + } }; -pyth.value(20); // example call +pyth.(20) // example call diff --git a/Task/Literals-Floating-point/00DESCRIPTION b/Task/Literals-Floating-point/00DESCRIPTION index 875ade1fa3..2165c1c855 100644 --- a/Task/Literals-Floating-point/00DESCRIPTION +++ b/Task/Literals-Floating-point/00DESCRIPTION @@ -1,7 +1,13 @@ -Programming languages have different ways of expressing floating-point literals. Show how floating-point literals can be expressed in your language: decimal or other bases, exponential notation, and any other special features. +Programming languages have different ways of expressing floating-point literals. + + +;Task: +Show how floating-point literals can be expressed in your language: decimal or other bases, exponential notation, and any other special features. You may want to include a regular expression or BNF/ABNF/EBNF defining allowable formats for your language. -See also [[Literals/Integer]]. -Cf. [[Extreme floating point values]] +;Related tasks: +*   [[Literals/Integer]] +*   [[Extreme floating point values]] +

    diff --git a/Task/Literals-Floating-point/ALGOL-68/literals-floating-point.alg b/Task/Literals-Floating-point/ALGOL-68/literals-floating-point.alg new file mode 100644 index 0000000000..291e561c0d --- /dev/null +++ b/Task/Literals-Floating-point/ALGOL-68/literals-floating-point.alg @@ -0,0 +1,24 @@ +# floating point literals are called REAL denotations in Algol 68 # +# They have the following forms: # +# 1: a digit sequence followed by "." followed by a digit sequence # +# 2: a "." followed by a digit sequence # +# 3: forms 1 or 2 followed by "e" followed by an optional sign # +# followed by a digit sequence # +# 4: a digit sequence follows by "e" followed by an optional sign # +# followed by a digit sequence # +# # +# The "e" indicates the following optionally-signed digit sequence is # +# the exponent of the literal. # +# If the implementation allows, a "times ten to the power symbol" # +# can be used to replace "e" - e.g. a subscript "10" character # +# # +# spaces can appear anywhere in the denotation # +# Examples: # +REAL r; +r := 1.234; +r := .987; +r := 4.2e-9; +r := .4e+23; +r := 1e10; +r := 3.142e-23; +r := 1 234 567 . 9 e - 4; diff --git a/Task/Literals-Floating-point/Kotlin/literals-floating-point.kotlin b/Task/Literals-Floating-point/Kotlin/literals-floating-point.kotlin new file mode 100644 index 0000000000..b721045363 --- /dev/null +++ b/Task/Literals-Floating-point/Kotlin/literals-floating-point.kotlin @@ -0,0 +1,4 @@ +1.0 // double +1.234e-10 // double +728832f // float +728832F // float diff --git a/Task/Literals-Floating-point/Perl-6/literals-floating-point.pl6 b/Task/Literals-Floating-point/Perl-6/literals-floating-point.pl6 index 28124899be..ec58ef86e4 100644 --- a/Task/Literals-Floating-point/Perl-6/literals-floating-point.pl6 +++ b/Task/Literals-Floating-point/Perl-6/literals-floating-point.pl6 @@ -1,4 +1,5 @@ -6.02e23 # standard E notation -:10<6.02 * 10 ** 23> # radix notation -:5<11.002 * 10 ** 23> # exponent is still decimal -:5<11.002*:5<20>**:5<43>> # all in base 5 +2e2 # same as 200e0, 2e2, 200.0e0 and 2.0e2 +6.02e23 +-2e48 +1e-9 +1e0 diff --git a/Task/Literals-Integer/00DESCRIPTION b/Task/Literals-Integer/00DESCRIPTION index 1ece0949b4..79288eba87 100644 --- a/Task/Literals-Integer/00DESCRIPTION +++ b/Task/Literals-Integer/00DESCRIPTION @@ -1,9 +1,15 @@ Some programming languages have ways of expressing integer literals in bases other than the normal base ten. + +;Task: Show how integer literals can be expressed in as many bases as your language allows. -Note: this should '''not''' involve the calling of any functions/methods but should be interpreted by the compiler or interpreter as an integer written to a given base. + +Note:   this should '''not''' involve the calling of any functions/methods, but should be interpreted by the compiler or interpreter as an integer written to a given base. Also show any other ways of expressing literals, e.g. for different types of integers. -See also [[Literals/Floating point]]. + +;Related task: +*   [[Literals/Floating point]] +

    diff --git a/Task/Literals-Integer/COBOL/literals-integer-1.cobol b/Task/Literals-Integer/COBOL/literals-integer-1.cobol new file mode 100644 index 0000000000..1e8b471861 --- /dev/null +++ b/Task/Literals-Integer/COBOL/literals-integer-1.cobol @@ -0,0 +1,2 @@ +display B#10 ", " O#01234567 ", " -0123456789 ", " + H#0123456789ABCDEF ", " X#0123456789ABCDEF ", " 1;2;3;4 diff --git a/Task/Literals-Integer/COBOL/literals-integer-2.cobol b/Task/Literals-Integer/COBOL/literals-integer-2.cobol new file mode 100644 index 0000000000..b396bab24a --- /dev/null +++ b/Task/Literals-Integer/COBOL/literals-integer-2.cobol @@ -0,0 +1,2 @@ +if 1234 = 1,2,3,4 then display "Decimal point is not comma" end-if +if 1234 = 1;2;3;4 then display "literals are equal, semi-colons ignored" end-if diff --git a/Task/Literals-Integer/Elena/literals-integer.elena b/Task/Literals-Integer/Elena/literals-integer.elena new file mode 100644 index 0000000000..8b2a4743f8 --- /dev/null +++ b/Task/Literals-Integer/Elena/literals-integer.elena @@ -0,0 +1,2 @@ + #var n := 1234. // decimal number + #var x := 1234h. // hexadecimal number diff --git a/Task/Literals-Integer/Pascal/literals-integer.pascal b/Task/Literals-Integer/Pascal/literals-integer.pascal new file mode 100644 index 0000000000..ae863a392c --- /dev/null +++ b/Task/Literals-Integer/Pascal/literals-integer.pascal @@ -0,0 +1,4 @@ +const + INT_VALUE = 15; + OCTAL_VALUE = &017; + BINARY_VALUE = %1111; diff --git a/Task/Literals-Integer/REXX/literals-integer.rexx b/Task/Literals-Integer/REXX/literals-integer.rexx index 91116ec73d..41e49c9171 100644 --- a/Task/Literals-Integer/REXX/literals-integer.rexx +++ b/Task/Literals-Integer/REXX/literals-integer.rexx @@ -1,6 +1,8 @@ thing = 37 thing = '37' /*this is exactly the same as above. */ thing = "37" /*this is exactly the same as above also. */ +thing = '25'x /*this as well, expressed in hexadecimal. */ +thing = '00100101'b /*this too, expressed as binary. */ say 'base 10=' thing say 'base 2=' x2b(d2x(thing)) diff --git a/Task/Literals-String/00DESCRIPTION b/Task/Literals-String/00DESCRIPTION index e191b92f11..609f01eeb3 100644 --- a/Task/Literals-String/00DESCRIPTION +++ b/Task/Literals-String/00DESCRIPTION @@ -1,5 +1,15 @@ +;Task: Show literal specification of characters and strings. -If supported, show how verbatim strings (quotes where escape sequences are quoted literally) and here-strings work. + +If supported, show how the following work: +:*   ''verbatim strings''   (quotes where escape sequences are quoted literally) +:*   ''here-strings''   + +
    Also, discuss which quotes expand variables. -* Related tasks: [[Special characters]], [[Here document]] + +;Related tasks: +*   [[Special characters]] +*   [[Here document]] +

    diff --git a/Task/Literals-String/Ela/literals-string-1.ela b/Task/Literals-String/Ela/literals-string-1.ela new file mode 100644 index 0000000000..07183c1578 --- /dev/null +++ b/Task/Literals-String/Ela/literals-string-1.ela @@ -0,0 +1 @@ +c = 'c' diff --git a/Task/Literals-String/Ela/literals-string-2.ela b/Task/Literals-String/Ela/literals-string-2.ela new file mode 100644 index 0000000000..42182d4153 --- /dev/null +++ b/Task/Literals-String/Ela/literals-string-2.ela @@ -0,0 +1 @@ +str = "Hello, world!" diff --git a/Task/Literals-String/Ela/literals-string-3.ela b/Task/Literals-String/Ela/literals-string-3.ela new file mode 100644 index 0000000000..ed09e0069b --- /dev/null +++ b/Task/Literals-String/Ela/literals-string-3.ela @@ -0,0 +1,2 @@ +c = '\t' +str = "first line\nsecond line\nthird line" diff --git a/Task/Literals-String/Ela/literals-string-4.ela b/Task/Literals-String/Ela/literals-string-4.ela new file mode 100644 index 0000000000..8264aa2544 --- /dev/null +++ b/Task/Literals-String/Ela/literals-string-4.ela @@ -0,0 +1,2 @@ +vs = <[This is a + verbatim string]> diff --git a/Task/Literals-String/Elena/literals-string.elena b/Task/Literals-String/Elena/literals-string.elena new file mode 100644 index 0000000000..c11eae87b0 --- /dev/null +++ b/Task/Literals-String/Elena/literals-string.elena @@ -0,0 +1,4 @@ + #var c := #65. // character + #var s := "some text". // UTF-8 literal + #var w := "some wide text". // UTF-16 literal + #var s2 := "text with ""quotes"" and "#13#10"two lines". diff --git a/Task/Literals-String/Fortran/literals-string-1.f b/Task/Literals-String/Fortran/literals-string-1.f new file mode 100644 index 0000000000..9ca3de3ddc --- /dev/null +++ b/Task/Literals-String/Fortran/literals-string-1.f @@ -0,0 +1,7 @@ + DIMENSION ATWT(12) + PRINT 1 + 1 FORMAT (12HElement Name,F9.4) + DO 10 I = 1,12 + READ 1,ATWT(I) + 10 PRINT 1,ATWT(I) + END diff --git a/Task/Literals-String/Fortran/literals-string-2.f b/Task/Literals-String/Fortran/literals-string-2.f new file mode 100644 index 0000000000..3addcfa865 --- /dev/null +++ b/Task/Literals-String/Fortran/literals-string-2.f @@ -0,0 +1,5 @@ + TEXT = 'That''s right!' !Only apostrophes as delimiters. Doubling required. + TEXT = "That's right!" !Chose quotes, so that apostrophes may be used freely. + TEXT = "He said ""That's right!""" !Give in, and use quotes for a "quoted string" source style. + TEXT = 'He said "That''s right!"' !Though one may dabble in inconsistency. + TEXT = 23HHe said "That's right!" !Some later compilers allowed Hollerith to escape from FORMAT. diff --git a/Task/Literals-String/Fortran/literals-string-3.f b/Task/Literals-String/Fortran/literals-string-3.f new file mode 100644 index 0000000000..4b8992b7df --- /dev/null +++ b/Task/Literals-String/Fortran/literals-string-3.f @@ -0,0 +1 @@ + TEXT = "That's"//CHAR(10)//"right!" !For an ASCII linefeed (or newline) character. diff --git a/Task/Logical-operations/00DESCRIPTION b/Task/Logical-operations/00DESCRIPTION index a7d54c6e0c..490a5212b9 100644 --- a/Task/Logical-operations/00DESCRIPTION +++ b/Task/Logical-operations/00DESCRIPTION @@ -1,5 +1,10 @@ - {{basic data operation}} [[Category:Simple]] +{{basic data operation}} +[[Category:Simple]] + +;Task: Write a function that takes two logical (boolean) values, and outputs the result of "and" and "or" on both arguments as well as "not" on the first arguments. + If the programming language doesn't provide a separate type for logical values, use the type most commonly used for that purpose. If the language supports additional logical operations on booleans such as XOR, list them as well. +

    diff --git a/Task/Logical-operations/APL/logical-operations.apl b/Task/Logical-operations/APL/logical-operations.apl new file mode 100644 index 0000000000..e1b374cf70 --- /dev/null +++ b/Task/Logical-operations/APL/logical-operations.apl @@ -0,0 +1 @@ + LOGICALOPS←{(⍺∧⍵)(⍺∨⍵)(~⍺)(⍺⍲⍵)(⍺⍱⍵)(⍺≠⍵)} diff --git a/Task/Logical-operations/Groovy/logical-operations-2.groovy b/Task/Logical-operations/Groovy/logical-operations-2.groovy index 46d823351c..544af248bf 100644 --- a/Task/Logical-operations/Groovy/logical-operations-2.groovy +++ b/Task/Logical-operations/Groovy/logical-operations-2.groovy @@ -1,4 +1 @@ -logical(true, true) -logical(true, false) -logical(false, false) -logical(false, true) +[true, false].each { a -> [true, false].each { b-> logical(a, b) } } diff --git a/Task/Logical-operations/REXX/logical-operations.rexx b/Task/Logical-operations/REXX/logical-operations.rexx index decd2af83d..26c695bc30 100644 --- a/Task/Logical-operations/REXX/logical-operations.rexx +++ b/Task/Logical-operations/REXX/logical-operations.rexx @@ -1,31 +1,27 @@ -/*REXX program to show some binary (AKA bit or logical) operations. */ -x=1; y=0 - /*═════════════════════════════════════════════════echo X,Y values*/ -call TT 'name', "value" -call TT 'x' , x -call TT 'y' , y - /*═════════════════════════════════════════════════negate X,Y values*/ -call TT 'name', "negated" -call TT 'x' , \x /*some REXXes support the ¬ char.*/ -call TT 'y' , \y - /*═════════════════════════════════════════════════AND X,Y values*/ -call TT 'value','value',"AND"; do x=0 to 1 - do y=0 to 1; call TT x,y, x & y; end - end - /*═════════════════════════════════════════════════OR X,Y values*/ -call TT 'value','value',"OR"; do x=0 to 1 - do y=0 to 1; call TT x,y, x | y; end - end - /*═════════════════════════════════════════════════XOR X,Y values*/ -call TT 'value','value',"XOR"; do x=0 for 2 - do y=0 for 2; call TT x,y, x && y; end - end -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────TT subroutine───────────────────────*/ -TT: parse arg a.1,a.2,a.3,a.4; hdr=length(a.1)\==1; if hdr then say; w=7 - do TT=0 to hdr; _= - do k=1 for arg(); _=_ center(a.k,w); end /*k*/ - say _ - a.=copies('─',w) - end /*TT*/ -return +/*REXX program demonstrates some binary (also known as bit or logical) operations.*/ + x=1; y=0; @v= 'value' /*set initial values of X & Y; literal.*/ + /* [↓] echo the X and Y values.*/ +call TT 'name', "value" /*display the header (title) line. */ +call TT 'x' , x /*display "x" and then the value of X.*/ +call TT 'y' , y /* " "y" " " " " " Y */ + /* [↓] negate the X; then the Y value.*/ +call TT 'name', "negated" /*some REXXes support the ¬ character*/ +call TT 'x' , \x /*display "x" and then the value of ¬X*/ +call TT 'y' , \y /* " "y" " " " " " ¬Y*/ + /*both DO loops use 0 and 1 for values.*/ +call TT @v, @v, 'AND'; do x=0 for 2; do y=0 for 2; call TT x, y, x & y; end /*y*/ + end /*x*/ + +call TT @v, @v, 'OR'; do x=0 for 2; do y=0 for 2; call TT x, y, x | y; end /*y*/ + end /*x*/ + +call TT @v, @v, 'XOR'; do x=0 for 2; do y=0 for 2; call TT x, y, x && y; end /*y*/ + end /*x*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +TT: parse arg @.1,@.2,@.3,@.4; hdr=length(@.1)\==1; if hdr then say; w=7 + do j=0 to hdr; _=; do k=1 for arg(); _=_ center(@.k,w); end /*k*/ + say _ + @.=copies('═', w) /*define the header separator line. */ + end /*j*/ /*W: is used for the width of a column*/ + return diff --git a/Task/Logical-operations/Vala/logical-operations.vala b/Task/Logical-operations/Vala/logical-operations.vala new file mode 100644 index 0000000000..38009d8815 --- /dev/null +++ b/Task/Logical-operations/Vala/logical-operations.vala @@ -0,0 +1,14 @@ +public class Program { + private static void print_logic (bool a, bool b) { + print ("a and b is %s\n", (a && b).to_string ()); + print ("a or b is %s\n", (a || b).to_string ()); + print ("not a %s\n", (!a).to_string ()); + } + public static int main (string[] args) { + if (args.length < 3) error ("Provide 2 arguments!"); + bool a = bool.parse (args[1]); + bool b = bool.parse (args[2]); + print_logic (a, b); + return 0; + } +} diff --git a/Task/Long-multiplication/00DESCRIPTION b/Task/Long-multiplication/00DESCRIPTION index 88749172ad..2847c95bbd 100644 --- a/Task/Long-multiplication/00DESCRIPTION +++ b/Task/Long-multiplication/00DESCRIPTION @@ -1,8 +1,15 @@ -In this task, explicitly implement [[wp:long multiplication|long multiplication]]. This is one possible approach to arbitrary-precision integer algebra. +;Task: +Explicitly implement   [[wp:long multiplication|long multiplication]]. -[[Category:Arbitrary precision]] [[Category:Arithmetic operations]] +This is one possible approach to arbitrary-precision integer algebra. -For output, display the result of 2^64 * 2^64. The decimal representation of 2^64 is: - 18446744073709551616 -The output of 2^64 * 2^64 is 2^128, and that is: - 340282366920938463463374607431768211456 + +For output, display the result of   264 * 264. + + +The decimal representation of   264   is: + 18,446,744,073,709,551,616 + +The output of   264 * 264   is   2128,   and is: + 340,282,366,920,938,463,463,374,607,431,768,211,456 +

    diff --git a/Task/Long-multiplication/00META.yaml b/Task/Long-multiplication/00META.yaml index a34a05e951..b83416c7c6 100644 --- a/Task/Long-multiplication/00META.yaml +++ b/Task/Long-multiplication/00META.yaml @@ -1,2 +1,5 @@ --- +category: +- Arbitrary precision +- Arithmetic operations note: Arbitrary precision diff --git a/Task/Long-multiplication/Haskell/long-multiplication-2.hs b/Task/Long-multiplication/Haskell/long-multiplication-2.hs index 2f20007789..b9d97f01ba 100644 --- a/Task/Long-multiplication/Haskell/long-multiplication-2.hs +++ b/Task/Long-multiplication/Haskell/long-multiplication-2.hs @@ -1,3 +1,3 @@ procedure main() -write(2^64*2^64) + write(2^64*2^64) end diff --git a/Task/Long-multiplication/JavaScript/long-multiplication-1.js b/Task/Long-multiplication/JavaScript/long-multiplication-1.js new file mode 100644 index 0000000000..3b60af9204 --- /dev/null +++ b/Task/Long-multiplication/JavaScript/long-multiplication-1.js @@ -0,0 +1,22 @@ +function mult(strNum1,strNum2){ + + var a1 = strNum1.split("").reverse(); + var a2 = strNum2.toString().split("").reverse(); + var aResult = new Array; + + for ( var iterNum1 = 0; iterNum1 < a1.length; iterNum1++ ) { + for ( var iterNum2 = 0; iterNum2 < a2.length; iterNum2++ ) { + var idxIter = iterNum1 + iterNum2; // Get the current array position. + aResult[idxIter] = a1[iterNum1] * a2[iterNum2] + ( idxIter >= aResult.length ? 0 : aResult[idxIter] ); + + if ( aResult[idxIter] > 9 ) { // Carrying + aResult[idxIter + 1] = Math.floor( aResult[idxIter] / 10 ) + ( idxIter + 1 >= aResult.length ? 0 : aResult[idxIter + 1] ); + aResult[idxIter] -= Math.floor( aResult[idxIter] / 10 ) * 10; + } + } + } + return aResult.reverse().join(""); +} + + +mult('18446744073709551616', '18446744073709551616') diff --git a/Task/Long-multiplication/JavaScript/long-multiplication-2.js b/Task/Long-multiplication/JavaScript/long-multiplication-2.js new file mode 100644 index 0000000000..3d86241551 --- /dev/null +++ b/Task/Long-multiplication/JavaScript/long-multiplication-2.js @@ -0,0 +1,98 @@ +(function () { + 'use strict'; + + // Javascript lacks an unbounded integer type + // so this multiplication function takes and returns + // long integer strings rather than any kind of native integer + + + // longMult :: (String | Integer) -> (String | Integer) -> String + function longMult(num1, num2) { + return largeIntegerString( + digitProducts(digits(num1), digits(num2)) + ); + } + + + + // digitProducts :: [Int] -> [Int] -> [Int] + function digitProducts(xs, ys) { + return multTable(xs, ys) + .map(function (zs, i) { + return Array.apply(null, Array(i)) + .map(function () { + return 0; + }) + .concat(zs); + }) + .reduce(function (a, x) { + if (a) { + var lng = a.length; + + return x.map(function (y, i) { + return y + (i < lng ? a[i] : 0); + }) + + } else return x; + }) + } + + + // largeIntegerString :: [Int] -> String + function largeIntegerString(lstColumnValues) { + var dctProduct = lstColumnValues + .reduceRight(function (a, x) { + var intSum = x + a.carried, + intDigit = intSum % 10; + + return { + digits: intDigit + .toString() + a.digits, + carried: (intSum - intDigit) / 10 + }; + }, { + digits: '', + carried: 0 + }); + + return (dctProduct.carried > 0 ? ( + dctProduct.carried.toString() + ) : '') + dctProduct.digits; + } + + + // multTables :: [Int] -> [Int] -> [[Int]] + function multTable(xs, ys) { + return ys.map(function (y) { + return xs.map(function (x) { + return x * y; + }) + }); + } + + // digits :: (Integer | String) -> [Integer] + function digits(n) { + return (typeof n === 'string' ? n : n.toString()) + .split('') + .map(function (x) { + return parseInt(x, 10); + }); + } + + + // TEST showing that larged bounded integer inputs give only rounded results + // whereas integer string inputs allow for full precision on this scale (2^128) + + + return { + fromIntegerStrings: longMult( + '18446744073709551616', + '18446744073709551616' + ), + fromBoundedIntegers: longMult( + 18446744073709551616, + 18446744073709551616 + ) + }; + +})(); diff --git a/Task/Long-multiplication/JavaScript/long-multiplication.js b/Task/Long-multiplication/JavaScript/long-multiplication.js deleted file mode 100644 index 9e89579f99..0000000000 --- a/Task/Long-multiplication/JavaScript/long-multiplication.js +++ /dev/null @@ -1,18 +0,0 @@ -function mult(num1,num2){ - var a1 = num1.split("").reverse(); - var a2 = num2.split("").reverse(); - var aResult = new Array; - - for ( iterNum1 = 0; iterNum1 < a1.length; iterNum1++ ) { - for ( iterNum2 = 0; iterNum2 < a2.length; iterNum2++ ) { - idxIter = iterNum1 + iterNum2; // Get the current array position. - aResult[idxIter] = a1[iterNum1] * a2[iterNum2] + ( idxIter >= aResult.length ? 0 : aResult[idxIter] ); - - if ( aResult[idxIter] > 9 ) { // Carrying - aResult[idxIter + 1] = Math.floor( aResult[idxIter] / 10 ) + ( idxIter + 1 >= aResult.length ? 0 : aResult[idxIter + 1] ); - aResult[idxIter] -= Math.floor( aResult[idxIter] / 10 ) * 10; - } - } - } - return aResult.reverse().join(""); -} diff --git a/Task/Long-multiplication/Kotlin/long-multiplication.kotlin b/Task/Long-multiplication/Kotlin/long-multiplication.kotlin new file mode 100644 index 0000000000..b912de3715 --- /dev/null +++ b/Task/Long-multiplication/Kotlin/long-multiplication.kotlin @@ -0,0 +1,36 @@ +fun String.toDigits() = mapIndexed { i, c -> + if (!c.isDigit()) + throw IllegalArgumentException("Invalid digit $c found at position $i") + c - '0' +}.reversed() + +operator fun String.times(n: String): String { + val left = toDigits() + val right = n.toDigits() + val result = IntArray(left.size + right.size) + + right.mapIndexed { rightPos, rightDigit -> + var tmp = 0 + left.indices.forEach { leftPos -> + tmp += result[leftPos + rightPos] + rightDigit * left[leftPos] + result[leftPos + rightPos] = tmp % 10 + tmp /= 10 + } + var destPos = rightPos + left.size + while (tmp != 0) { + tmp += (result[destPos].toLong() and 0xFFFFFFFFL).toInt() + result[destPos] = tmp % 10 + tmp /= 10 + destPos++ + } + } + + return result.foldRight(StringBuilder(result.size), { digit, sb -> + if (digit != 0 || sb.length > 0) sb.append('0' + digit) + sb + }).toString() +} + +fun main(args: Array) { + println("18446744073709551616" * "18446744073709551616") +} diff --git a/Task/Long-multiplication/REXX/long-multiplication-1.rexx b/Task/Long-multiplication/REXX/long-multiplication-1.rexx index ee1b963658..f76d0b8c87 100644 --- a/Task/Long-multiplication/REXX/long-multiplication-1.rexx +++ b/Task/Long-multiplication/REXX/long-multiplication-1.rexx @@ -1,27 +1,25 @@ -/*REXX program performs long multiplication on two numbers (without the "E").*/ -numeric digits 3000 /*be able to handle gihugeic input #s. */ -parse arg x y . /*obtain the optional one or two #s. */ -if x=='' then x=2**64 /*Not specified? Then use the default.*/ -if y=='' then y=x /* " " " " " " */ -if x<0 && y<0 then sign='-' /*there only a single negative number? */ - else sign= /*no, then result sign must be positive*/ -xx=x; x=strip(x, 'T', .) /*remove any trailing decimal points. */ -yy=y; y=strip(y, 'T', .) /* " " " " ". */ -_=left(x,1); if _=='-' | _=='+' then x=substr(x,2) /*elide leading ± signs*/ -_=left(y,1); if _=='-' | _=='+' then y=substr(y,2) /* " " " " */ -dp=0; Lx=length(x); Ly=length(y) /*get the lengths of the new X and Y. */ -f=pos(., x); if f\==0 then dp= Lx-f /*calculate size of decimal fraction. */ -f=pos(., y); if f\==0 then dp=dp+Ly-f /* " " " " " */ -x=space(translate(x, , .), 0) /*remove decimal point if there is any.*/ -y=space(translate(y, , .), 0) /* " " " " " " " */ -Lx=length(x); Ly=length(y) /*get the lengths of the new X and Y. */ -numeric digits max(digits(), Lx+Ly) /*use a new decimal digits precision.*/ -$=0 /*P: is the product (so far). */ - do j=Ly by -1 for Ly /*almost like REXX does it, ··· but no.*/ - $=$ + ((x*substr(y, j, 1))copies(0, Ly-j) ) - end /*j*/ -f=length($)-dp /*does product has enough decimal digs?*/ -if f<0 then $=copies(0, abs(f)+1)$ /*Negative? Add leading 0s for INSERT.*/ -say ' built─in:' xx '*' yy '──►' xx*yy -say 'long mult:' xx '*' yy '──►' sign||strip(insert(.,$,length($)-dp),'T',.) - /*stick a fork in it, we're all done. */ +/*REXX program performs long multiplication on two numbers (without the "E"). */ +numeric digits 300 /*be able to handle gihugeic input #s. */ +parse arg x y . /*obtain optional arguments from the CL*/ +if x=='' | x=="," then x=2**64 /*Not specified? Then use the default.*/ +if y=='' | y=="," then y=x /* " " " " " " */ +if x<0 && y<0 then sign= '-' /*there only a single negative number? */ + else sign= /*no, then result sign must be positive*/ +xx=x; x=strip(x, 'T', .); x1=left(x, 1) /*remove any trailing decimal points. */ +yy=y; y=strip(y, 'T', .); y1=left(y, 1) /* " " " " " */ +if x1=='-' | x1=="+" then x=substr(x, 2) /*remove a leading ± sign. */ +if y1=='-' | y1=="+" then y=substr(y, 2) /* " " " " " */ +parse var x '.' xf; parse var y "." yf /*obtain the fractional part of X and Y*/ +#=length(xf || yf) /*#: digits past the decimal points (.)*/ +x=space( translate( x, , .), 0) /*remove decimal point if there is any.*/ +y=space( translate( y, , .), 0) /* " " " " " " " */ +Lx=length(x); Ly=length(y) /*get the lengths of the new X and Y. */ +numeric digits max(digits(), Lx + Ly) /*use a new decimal digits precision.*/ +$=0 /*$: is the product (so far). */ + do j=Ly by -1 for Ly /*almost like REXX does it, ··· but no.*/ + $=$ + ((x*substr(y, j, 1))copies(0, Ly-j) ) + end /*j*/ +f=length($) - # /*does product has enough decimal digs?*/ +if f<0 then $=copies(0, abs(f) + 1)$ /*Negative? Add leading 0s for INSERT.*/ +say 'long mult:' xx "*" yy '──►' sign || strip( insert(., $, length($) - #), 'T', .) +say ' built─in:' xx "*" yy '──►' xx*yy /*stick a fork in it, we're all done. */ diff --git a/Task/Longest-common-subsequence/C++/longest-common-subsequence-1.cpp b/Task/Longest-common-subsequence/C++/longest-common-subsequence-1.cpp index 3f04c7ba85..81d68f8a96 100644 --- a/Task/Longest-common-subsequence/C++/longest-common-subsequence-1.cpp +++ b/Task/Longest-common-subsequence/C++/longest-common-subsequence-1.cpp @@ -5,6 +5,7 @@ #include #include #include // for lower_bound() +#include // for prev() using namespace std; @@ -36,7 +37,7 @@ protected: typedef deque MATCHES; // return the LCS as a linked list of matched index pairs - uint64_t LCS::Pairs(MATCHES& matches, shared_ptr *pairs) { + uint64_t Pairs(MATCHES& matches, shared_ptr *pairs) { auto trace = pairs != nullptr; PAIRS traces; THRESHOLD threshold; @@ -79,6 +80,7 @@ protected: if (limit == threshold.end()) { // insert case threshold.push_back(index2); + limit = prev(threshold.end()); if (trace) { auto prefix = index3 > 0 ? traces[index3 - 1] : nullptr; auto last = make_shared(index1, index2, prefix); diff --git a/Task/Longest-common-subsequence/C/longest-common-subsequence-1.c b/Task/Longest-common-subsequence/C/longest-common-subsequence-1.c index 1bd2ab999d..9e66259d91 100644 --- a/Task/Longest-common-subsequence/C/longest-common-subsequence-1.c +++ b/Task/Longest-common-subsequence/C/longest-common-subsequence-1.c @@ -1,46 +1,36 @@ -#include -#include #include +#include -#define MAX(A,B) (((A)>(B))? (A) : (B)) +#define MAX(a, b) (a > b ? a : b) -char * lcs(const char *a,const char * b) { - int lena = strlen(a)+1; - int lenb = strlen(b)+1; - - int bufrlen = 40; - char bufr[40], *result; - - int i,j; - const char *x, *y; - int *la = calloc(lena*lenb, sizeof( int)); - int **lengths = malloc( lena*sizeof( int*)); - for (i=0; i0) && (j>0) ) { - if (lengths[i][j] == lengths[i-1][j]) i -= 1; - else if (lengths[i][j] == lengths[i][j-1]) j-= 1; - else { -// assert( a[i-1] == b[j-1]); - *--result = a[i-1]; - i-=1; j-=1; - } + t = c[n][m]; + *s = malloc(t); + for (i = n, j = m, k = t - 1; k >= 0;) { + if (a[i - 1] == b[j - 1]) + (*s)[k] = a[i - 1], i--, j--, k--; + else if (c[i][j - 1] > c[i - 1][j]) + j--; + else + i--; } - free(la); free(lengths); - return strdup(result); + free(c); + free(z); + return t; } diff --git a/Task/Longest-common-subsequence/C/longest-common-subsequence-2.c b/Task/Longest-common-subsequence/C/longest-common-subsequence-2.c index 7431671410..3c785ed3dd 100644 --- a/Task/Longest-common-subsequence/C/longest-common-subsequence-2.c +++ b/Task/Longest-common-subsequence/C/longest-common-subsequence-2.c @@ -1,5 +1,10 @@ -int main() -{ - printf("%s\n", lcs("thisisatest", "testing123testing")); // tsitest +int main () { + char a[] = "thisisatest"; + char b[] = "testing123testing"; + int n = sizeof a - 1; + int m = sizeof b - 1; + char *s = NULL; + int t = lcs(a, n, b, m, &s); + printf("%.*s\n", t, s); // tsitest return 0; } diff --git a/Task/Longest-common-subsequence/Elixir/longest-common-subsequence-1.elixir b/Task/Longest-common-subsequence/Elixir/longest-common-subsequence-1.elixir new file mode 100644 index 0000000000..a8128b45a9 --- /dev/null +++ b/Task/Longest-common-subsequence/Elixir/longest-common-subsequence-1.elixir @@ -0,0 +1,14 @@ +defmodule LCS do + def lcs(a, b) do + lcs(to_charlist(a), to_charlist(b), []) |> to_string + end + + defp lcs([h|at], [h|bt], res), do: lcs(at, bt, [h|res]) + defp lcs([_|at]=a, [_|bt]=b, res) do + Enum.max_by([lcs(a, bt, res), lcs(at, b, res)], &length/1) + end + defp lcs(_, _, res), do: res |> Enum.reverse +end + +IO.puts LCS.lcs("thisisatest", "testing123testing") +IO.puts LCS.lcs('1234','1224533324') diff --git a/Task/Longest-common-subsequence/Elixir/longest-common-subsequence.elixir b/Task/Longest-common-subsequence/Elixir/longest-common-subsequence-2.elixir similarity index 51% rename from Task/Longest-common-subsequence/Elixir/longest-common-subsequence.elixir rename to Task/Longest-common-subsequence/Elixir/longest-common-subsequence-2.elixir index f3f8326e86..16ac195830 100644 --- a/Task/Longest-common-subsequence/Elixir/longest-common-subsequence.elixir +++ b/Task/Longest-common-subsequence/Elixir/longest-common-subsequence-2.elixir @@ -1,36 +1,34 @@ defmodule LCS do - def lcs_length(s,t) do - {l,_c} = lcs_length(s,t,Map.new) - l - end + def lcs_length(s,t), do: lcs_length(s,t,Map.new) |> elem(0) - defp lcs_length([],t,cache), do: {0,Dict.put(cache,{[],t},0)} - defp lcs_length(s,[],cache), do: {0,Dict.put(cache,{s,[]},0)} + defp lcs_length([],t,cache), do: {0,Map.put(cache,{[],t},0)} + defp lcs_length(s,[],cache), do: {0,Map.put(cache,{s,[]},0)} defp lcs_length([h|st]=s,[h|tt]=t,cache) do {l,c} = lcs_length(st,tt,cache) - {l+1,Dict.put(c,{s,t},l+1)} + {l+1,Map.put(c,{s,t},l+1)} end defp lcs_length([_sh|st]=s,[_th|tt]=t,cache) do - if Dict.has_key?(cache,{s,t}) do - {Dict.get(cache,{s,t}),cache} + if Map.has_key?(cache,{s,t}) do + {Map.get(cache,{s,t}),cache} else {l1,c1} = lcs_length(s,tt,cache) {l2,c2} = lcs_length(st,t,c1) - l = Enum.max([l1,l2]) - {l,Dict.put(c2,{s,t},l)} + l = max(l1,l2) + {l,Map.put(c2,{s,t},l)} end end def lcs(s,t) do + {s,t} = {to_charlist(s),to_charlist(t)} {_,c} = lcs_length(s,t,Map.new) - lcs(s,t,c,[]) + lcs(s,t,c,[]) |> to_string end defp lcs([],_,_,acc), do: Enum.reverse(acc) defp lcs(_,[],_,acc), do: Enum.reverse(acc) defp lcs([h|st],[h|tt],cache,acc), do: lcs(st,tt,cache,[h|acc]) defp lcs([_sh|st]=s,[_th|tt]=t,cache,acc) do - if Dict.get(cache,{s,tt}) > Dict.get(cache,{st,t}) do + if Map.get(cache,{s,tt}) > Map.get(cache,{st,t}) do lcs(s,tt,cache,acc) else lcs(st,t,cache,acc) @@ -38,5 +36,5 @@ defmodule LCS do end end -IO.puts LCS.lcs('thisisatest','testing123testing') -IO.puts LCS.lcs('1234','1224533324') +IO.puts LCS.lcs("thisisatest","testing123testing") +IO.puts LCS.lcs("1234","1224533324") diff --git a/Task/Longest-common-subsequence/Perl-6/longest-common-subsequence-3.pl6 b/Task/Longest-common-subsequence/Perl-6/longest-common-subsequence-3.pl6 new file mode 100644 index 0000000000..8e422e4c4f --- /dev/null +++ b/Task/Longest-common-subsequence/Perl-6/longest-common-subsequence-3.pl6 @@ -0,0 +1,32 @@ +sub lcs(Str $xstr, Str $ystr) { + my ($a,$b) = ([$xstr.comb],[$ystr.comb]); + + my $positions; + for $a.kv -> $i,$x { $positions{$x} +|= 1 +< $i }; + + my $S = +^0; + my $Vs = []; + my ($y,$u); + for (0..+$b-1) -> $j { + $y = $positions{$b[$j]} // 0; + $u = $S +& $y; + $S = ($S + $u) +| ($S - $u); + $Vs[$j] = $S; + } + + my ($i,$j) = (+$a-1, +$b-1); + my $result = ""; + while ($i >= 0 && $j >= 0) { + if ($Vs[$j] +& (1 +< $i)) { $i-- } + else { + unless ($j && +^$Vs[$j-1] +& (1 +< $i)) { + $result = $a[$i] ~ $result; + $i--; + } + $j--; + } + } + return $result; +} + +say lcs("thisisatest", "testing123testing"); diff --git a/Task/Longest-common-subsequence/Perl/longest-common-subsequence.pl b/Task/Longest-common-subsequence/Perl/longest-common-subsequence.pl index 89fcea6c0b..2ac3a38154 100644 --- a/Task/Longest-common-subsequence/Perl/longest-common-subsequence.pl +++ b/Task/Longest-common-subsequence/Perl/longest-common-subsequence.pl @@ -1,6 +1,14 @@ -use Algorithm::Diff qw/ LCS /; +sub lcs { + my ($a, $b) = @_; + if (!length($a) || !length($b)) { + return ""; + } + if (substr($a, 0, 1) eq substr($b, 0, 1)) { + return substr($a, 0, 1) . lcs(substr($a, 1), substr($b, 1)); + } + my $c = lcs(substr($a, 1), $b) || ""; + my $d = lcs($a, substr($b, 1)) || ""; + return length($c) > length($d) ? $c : $d; +} -my @a = split //, 'thisisatest'; -my @b = split //, 'testing123testing'; - -print LCS( \@a, \@b ); +print lcs("thisisatest", "testing123testing") . "\n"; diff --git a/Task/Longest-common-subsequence/PowerShell/longest-common-subsequence-1.psh b/Task/Longest-common-subsequence/PowerShell/longest-common-subsequence-1.psh new file mode 100644 index 0000000000..2cc3231a43 --- /dev/null +++ b/Task/Longest-common-subsequence/PowerShell/longest-common-subsequence-1.psh @@ -0,0 +1,47 @@ +function Get-Lcs ($ReferenceObject, $DifferenceObject) +{ + $longestCommonSubsequence = @() + $x = $ReferenceObject.Length + $y = $DifferenceObject.Length + + $lengths = New-Object -TypeName 'System.Object[,]' -ArgumentList ($x + 1), ($y + 1) + + for($i = 0; $i -lt $x; $i++) + { + for ($j = 0; $j -lt $y; $j++) + { + if ($ReferenceObject[$i] -ceq $DifferenceObject[$j]) + { + $lengths[($i+1),($j+1)] = $lengths[$i,$j] + 1 + } + else + { + $lengths[($i+1),($j+1)] = [Math]::Max(($lengths[($i+1),$j]),($lengths[$i,($j+1)])) + } + } + } + + while (($x -ne 0) -and ($y -ne 0)) + { + if ( $lengths[$x,$y] -eq $lengths[($x-1),$y]) + { + --$x + } + elseif ($lengths[$x,$y] -eq $lengths[$x,($y-1)]) + { + --$y + } + else + { + if ($ReferenceObject[($x-1)] -ceq $DifferenceObject[($y-1)]) + { + $longestCommonSubsequence = ,($ReferenceObject[($x-1)]) + $longestCommonSubsequence + } + + --$x + --$y + } + } + + $longestCommonSubsequence +} diff --git a/Task/Longest-common-subsequence/PowerShell/longest-common-subsequence-2.psh b/Task/Longest-common-subsequence/PowerShell/longest-common-subsequence-2.psh new file mode 100644 index 0000000000..03bb65a78a --- /dev/null +++ b/Task/Longest-common-subsequence/PowerShell/longest-common-subsequence-2.psh @@ -0,0 +1 @@ +(Get-Lcs -ReferenceObject "thisisatest" -DifferenceObject "testing123testing") -join "" diff --git a/Task/Longest-common-subsequence/PowerShell/longest-common-subsequence-3.psh b/Task/Longest-common-subsequence/PowerShell/longest-common-subsequence-3.psh new file mode 100644 index 0000000000..cfc6bc515c --- /dev/null +++ b/Task/Longest-common-subsequence/PowerShell/longest-common-subsequence-3.psh @@ -0,0 +1 @@ +Get-Lcs -ReferenceObject @(1,2,3,4) -DifferenceObject @(1,2,2,4,5,3,3,3,2,4) diff --git a/Task/Longest-common-subsequence/PowerShell/longest-common-subsequence-4.psh b/Task/Longest-common-subsequence/PowerShell/longest-common-subsequence-4.psh new file mode 100644 index 0000000000..3fbb81e6a0 --- /dev/null +++ b/Task/Longest-common-subsequence/PowerShell/longest-common-subsequence-4.psh @@ -0,0 +1,25 @@ +$list1 + +ID X Y +-- - - + 1 101 201 + 2 102 202 + 3 103 203 + 4 104 204 + 5 105 205 + 6 106 206 + 7 107 207 + 8 108 208 + 9 109 209 + +$list2 + +ID X Y +-- - - + 1 101 201 + 3 103 203 + 5 105 205 + 7 107 207 + 9 109 209 + +Get-Lcs -ReferenceObject $list1.ID -DifferenceObject $list2.ID diff --git a/Task/Longest-common-subsequence/Python/longest-common-subsequence-3.py b/Task/Longest-common-subsequence/Python/longest-common-subsequence-3.py index cccda58e5a..1041977141 100644 --- a/Task/Longest-common-subsequence/Python/longest-common-subsequence-3.py +++ b/Task/Longest-common-subsequence/Python/longest-common-subsequence-3.py @@ -6,8 +6,7 @@ def lcs(a, b): if x == y: lengths[i+1][j+1] = lengths[i][j] + 1 else: - lengths[i+1][j+1] = \ - max(lengths[i+1][j], lengths[i][j+1]) + lengths[i+1][j+1] = max(lengths[i+1][j], lengths[i][j+1]) # read the substring out from the matrix result = "" x, y = len(a), len(b) diff --git a/Task/Longest-common-subsequence/Scala/longest-common-subsequence-1.scala b/Task/Longest-common-subsequence/Scala/longest-common-subsequence-1.scala new file mode 100644 index 0000000000..3d2e4ae42b --- /dev/null +++ b/Task/Longest-common-subsequence/Scala/longest-common-subsequence-1.scala @@ -0,0 +1,11 @@ + def lcs[T]: (List[T], List[T]) => List[T] = { + case (_, Nil) => Nil + case (Nil, _) => Nil + case (x :: xs, y :: ys) if x == y => x :: lcs(xs, ys) + case (x :: xs, y :: ys) => { + (lcs(x :: xs, ys), lcs(xs, y :: ys)) match { + case (xs, ys) if xs.length > ys.length => xs + case (xs, ys) => ys + } + } + } diff --git a/Task/Longest-common-subsequence/Scala/longest-common-subsequence-2.scala b/Task/Longest-common-subsequence/Scala/longest-common-subsequence-2.scala new file mode 100644 index 0000000000..ff432a4dd6 --- /dev/null +++ b/Task/Longest-common-subsequence/Scala/longest-common-subsequence-2.scala @@ -0,0 +1,16 @@ + case class Memoized[A1, A2, B](f: (A1, A2) => B) extends ((A1, A2) => B) { + val cache = scala.collection.mutable.Map.empty[(A1, A2), B] + def apply(x: A1, y: A2) = cache.getOrElseUpdate((x, y), f(x, y)) + } + + lazy val lcsM: Memoized[List[Char], List[Char], List[Char]] = Memoized { + case (_, Nil) => Nil + case (Nil, _) => Nil + case (x :: xs, y :: ys) if x == y => x :: lcsM(xs, ys) + case (x :: xs, y :: ys) => { + (lcsM(x :: xs, ys), lcsM(xs, y :: ys)) match { + case (xs, ys) if xs.length > ys.length => xs + case (xs, ys) => ys + } + } + } diff --git a/Task/Longest-common-subsequence/Scala/longest-common-subsequence.scala b/Task/Longest-common-subsequence/Scala/longest-common-subsequence.scala deleted file mode 100644 index 01de964635..0000000000 --- a/Task/Longest-common-subsequence/Scala/longest-common-subsequence.scala +++ /dev/null @@ -1,68 +0,0 @@ -object LCS extends App { - - // recursive version: - def lcsr(a: String, b: String): String = { - if (a.size==0 || b.size==0) "" - else if (a==b) a - else - if(a(a.size-1)==b(b.size-1)) lcsr(a.substring(0,a.size-1),b.substring(0,b.size-1))+a(a.size-1) - else { - val x = lcsr(a,b.substring(0,b.size-1)) - val y = lcsr(a.substring(0,a.size-1),b) - if (x.size > y.size) x else y - } - } - - // dynamic programming version: - def lcsd(a: String, b: String): String = { - if (a.size==0 || b.size==0) "" - else if (a==b) a - else { - val lengths = Array.ofDim[Int](a.size+1,b.size+1) - for (i <- 0 until a.size) - for (j <- 0 until b.size) - if (a(i) == b(j)) - lengths(i+1)(j+1) = lengths(i)(j) + 1 - else - lengths(i+1)(j+1) = scala.math.max(lengths(i+1)(j),lengths(i)(j+1)) - - // read the substring out from the matrix - val sb = new StringBuilder() - var x = a.size - var y = b.size - do { - if (lengths(x)(y) == lengths(x-1)(y)) - x -= 1 - else if (lengths(x)(y) == lengths(x)(y-1)) - y -= 1 - else { - assert(a(x-1) == b(y-1)) - sb += a(x-1) - x -= 1 - y -= 1 - } - } while (x!=0 && y!=0) - sb.toString.reverse - } - } - - val elapsed: (=> Unit) => Long = f => {val s = System.currentTimeMillis; f; (System.currentTimeMillis - s)/1000} - - val pairs = List(("thisiaatest","testing123testing") - ,("","x") - ,("x","x") - ,("beginning-middle-ending", "beginning-diddle-dum-ending")) - - var s = "" - println("recursive version:") - pairs foreach {p => - println{val t = elapsed(s = lcsr(p._1,p._2)) - "lcsr(\""+p._1+"\",\""+p._2+"\") = \""+s+"\" ("+t+" sec)"} - } - - println("\n"+"dynamic programming version:") - pairs foreach {p => - println{val t = elapsed(s = lcsd(p._1,p._2)) - "lcsd(\""+p._1+"\",\""+p._2+"\") = \""+s+"\" ("+t+" sec)"} - } -} diff --git a/Task/Longest-increasing-subsequence/Elixir/longest-increasing-subsequence-1.elixir b/Task/Longest-increasing-subsequence/Elixir/longest-increasing-subsequence-1.elixir new file mode 100644 index 0000000000..bf5a94e533 --- /dev/null +++ b/Task/Longest-increasing-subsequence/Elixir/longest-increasing-subsequence-1.elixir @@ -0,0 +1,19 @@ +defmodule Longest_increasing_subsequence do + # Naive implementation + def lis(l) do + (for ss <- combos(l), ss == Enum.sort(ss), do: ss) + |> Enum.max_by(fn ss -> length(ss) end) + end + + defp combos(l) do + Enum.reduce(1..length(l), [[]], fn k, acc -> acc ++ (combos(k, l)) end) + end + defp combos(1, l), do: (for x <- l, do: [x]) + defp combos(k, l) when k == length(l), do: [l] + defp combos(k, [h|t]) do + (for subcombos <- combos(k-1, t), do: [h | subcombos]) ++ combos(k, t) + end +end + +IO.inspect Longest_increasing_subsequence.lis([3,2,6,4,5,1]) +IO.inspect Longest_increasing_subsequence.lis([0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]) diff --git a/Task/Longest-increasing-subsequence/Elixir/longest-increasing-subsequence-2.elixir b/Task/Longest-increasing-subsequence/Elixir/longest-increasing-subsequence-2.elixir new file mode 100644 index 0000000000..beb5211a1a --- /dev/null +++ b/Task/Longest-increasing-subsequence/Elixir/longest-increasing-subsequence-2.elixir @@ -0,0 +1,28 @@ +defmodule Longest_increasing_subsequence do + # Patience sort implementation + def patience_lis(l), do: patience_lis(l, []) + + defp patience_lis([h | t], []), do: patience_lis(t, [[{h,[]}]]) + defp patience_lis([h | t], stacks), do: patience_lis(t, place_in_stack(h, stacks, [])) + defp patience_lis([], []), do: [] + defp patience_lis([], stacks), do: get_previous(stacks) |> recover_lis |> Enum.reverse + + defp place_in_stack(e, [stack = [{h,_} | _] | tstacks], prevstacks) when h > e do + prevstacks ++ [[{e, get_previous(prevstacks)} | stack] | tstacks] + end + defp place_in_stack(e, [stack | tstacks], prevstacks) do + place_in_stack(e, tstacks, prevstacks ++ [stack]) + end + defp place_in_stack(e, [], prevstacks) do + prevstacks ++ [[{e, get_previous(prevstacks)}]] + end + + defp get_previous(stack = [_|_]), do: hd(List.last(stack)) + defp get_previous([]), do: [] + + defp recover_lis({e, prev}), do: [e | recover_lis(prev)] + defp recover_lis([]), do: [] +end + +IO.inspect Longest_increasing_subsequence.patience_lis([3,2,6,4,5,1]) +IO.inspect Longest_increasing_subsequence.patience_lis([0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15]) diff --git a/Task/Longest-increasing-subsequence/PowerShell/longest-increasing-subsequence-1.psh b/Task/Longest-increasing-subsequence/PowerShell/longest-increasing-subsequence-1.psh new file mode 100644 index 0000000000..50a6ae3ea2 --- /dev/null +++ b/Task/Longest-increasing-subsequence/PowerShell/longest-increasing-subsequence-1.psh @@ -0,0 +1,48 @@ +function Get-LongestSubsequence ( [int[]]$A ) + { + If ( $A.Count -lt 2 ) { return $A } + + # Start with an "empty" pile + # (We will only store the top value in each "pile".) + $Pile = @( [int]::MaxValue ) + $Last = 0 + + # Hashtable to hold the back pointers + $BP = @{} + + # For each number in the orginal sequence... + ForEach ( $N in $A ) + { + # Find the first pile with a value greater than N + $i = 0..$Last | Where { $N -lt $Pile[$_] } | Select -First 1 + + # Place N on the pile + $Pile[$i] = $N + + # Set the back pointer for this value to the value of the previous pile + $BP["$N"] = $Pile[$i-1] + + # If this is the previously empty pile, add a new empty pile + If ( $i -eq $Last ) + { + $Pile += @( [int]::MaxValue ) + $Last++ + } + } + + # Ignore the empty pile + $Last-- + + # Start with the value of the last pile + $N = $Pile[$Last] + $S = @( $N ) + + # Add the remainder of the values by walking through the back pointers + ForEach ( $i in $Last..1 ) + { + $S += ( $N = $BP["$N"] ) + } + + # Return the series (reversed into the correct order) + return $S[$Last..0] + } diff --git a/Task/Longest-increasing-subsequence/PowerShell/longest-increasing-subsequence-2.psh b/Task/Longest-increasing-subsequence/PowerShell/longest-increasing-subsequence-2.psh new file mode 100644 index 0000000000..e7d719b116 --- /dev/null +++ b/Task/Longest-increasing-subsequence/PowerShell/longest-increasing-subsequence-2.psh @@ -0,0 +1,2 @@ +( Get-LongestSubsequence 3, 2, 6, 4, 5, 1 ) -join ', ' +( Get-LongestSubsequence 0, 8, 4, 12, 2, 10, 6, 16, 14, 1, 9, 5, 13, 3, 11, 7, 15 ) -join ', ' diff --git a/Task/Longest-increasing-subsequence/Python/longest-increasing-subsequence-1.py b/Task/Longest-increasing-subsequence/Python/longest-increasing-subsequence-1.py index 0bd1953c8d..cb717fccd0 100644 --- a/Task/Longest-increasing-subsequence/Python/longest-increasing-subsequence-1.py +++ b/Task/Longest-increasing-subsequence/Python/longest-increasing-subsequence-1.py @@ -1,8 +1,8 @@ def longest_increasing_subsequence(X): """Returns the Longest Increasing Subsequence in the Given List/Array""" - N = length(X) - P = [0 for i in range(N)] - M = [0 for i in range(N+1)] + N = len(X) + P = [0] * N + M = [0] * (N+1) L = 0 for i in range(N): lo = 1 @@ -24,8 +24,8 @@ def longest_increasing_subsequence(X): S = [] k = M[L] for i in range(L-1, -1, -1): - S.append(X[k]) - k = P[k] + S.append(X[k]) + k = P[k] return S[::-1] if __name__ == '__main__': diff --git a/Task/Longest-increasing-subsequence/Scala/longest-increasing-subsequence.scala b/Task/Longest-increasing-subsequence/Scala/longest-increasing-subsequence-1.scala similarity index 100% rename from Task/Longest-increasing-subsequence/Scala/longest-increasing-subsequence.scala rename to Task/Longest-increasing-subsequence/Scala/longest-increasing-subsequence-1.scala diff --git a/Task/Longest-increasing-subsequence/Scala/longest-increasing-subsequence-2.scala b/Task/Longest-increasing-subsequence/Scala/longest-increasing-subsequence-2.scala new file mode 100644 index 0000000000..c1e82e984f --- /dev/null +++ b/Task/Longest-increasing-subsequence/Scala/longest-increasing-subsequence-2.scala @@ -0,0 +1,6 @@ +def powerset[A](s: List[A]) = (0 to s.size).map(s.combinations(_)).reduce(_++_) +def isSorted(l:List[Int])(f: (Int, Int) => Boolean) = l.view.zip(l.tail).forall(x => f(x._1,x._2)) +def sequence(set: List[Int])(f: (Int, Int) => Boolean) = powerset(set).filter(_.nonEmpty).filter(x => isSorted(x)(f)).toList.maxBy(_.length) + +sequence(set)(_<_) +sequence(set)(_>_) diff --git a/Task/Longest-increasing-subsequence/VBScript/longest-increasing-subsequence.vb b/Task/Longest-increasing-subsequence/VBScript/longest-increasing-subsequence.vb new file mode 100644 index 0000000000..97e23b1d5a --- /dev/null +++ b/Task/Longest-increasing-subsequence/VBScript/longest-increasing-subsequence.vb @@ -0,0 +1,37 @@ +Function LIS(arr) + n = UBound(arr) + Dim p() + ReDim p(n) + Dim m() + ReDim m(n) + l = 0 + For i = 0 To n + lo = 1 + hi = l + Do While lo <= hi + middle = Int((lo+hi)/2) + If arr(m(middle)) < arr(i) Then + lo = middle + 1 + Else + hi = middle - 1 + End If + Loop + newl = lo + p(i) = m(newl-1) + m(newl) = i + If newL > l Then + l = newl + End If + Next + Dim s() + ReDim s(l) + k = m(l) + For i = l-1 To 0 Step - 1 + s(i) = arr(k) + k = p(k) + Next + LIS = Join(s,",") +End Function + +WScript.StdOut.WriteLine LIS(Array(3,2,6,4,5,1)) +WScript.StdOut.WriteLine LIS(Array(0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15)) diff --git a/Task/Longest-string-challenge/00DESCRIPTION b/Task/Longest-string-challenge/00DESCRIPTION index 6534ba0039..8bc20fbd8c 100644 --- a/Task/Longest-string-challenge/00DESCRIPTION +++ b/Task/Longest-string-challenge/00DESCRIPTION @@ -1,64 +1,71 @@ -'''Background''' +;Background: +This "longest string challenge" is inspired by a problem that used to be given to students learning Icon. Students were expected to try to solve the problem in Icon and another language with which the student was already familiar. The basic problem is quite simple; the challenge and fun part came through the introduction of restrictions. Experience has shown that the original restrictions required some adjustment to bring out the intent of the challenge and make it suitable for Rosetta Code. -:This "longest string challenge" is inspired by a problem that used to be given to students learning Icon. Students were expected to try to solve the problem in Icon and another language with which the student was already familiar. The basic problem is quite simple; the challenge and fun part came through the introduction of restrictions. Experience has shown that the original restrictions required some adjustment to bring out the intent of the challenge and make it suitable for Rosetta Code. +The original programming challenge and some solutions can be found at [https://tapestry.tucson.az.us/twiki/bin/view/Main/LongestStringsPuzzle Unicon Programming TWiki / Longest Strings Puzzle]. (See notes on the talk page if you have trouble with the site). -:The original programming challenge and some solutions can be found at [https://tapestry.tucson.az.us/twiki/bin/view/Main/LongestStringsPuzzle Unicon Programming TWiki / Longest Strings Puzzle]. (See notes on the talk page if you have trouble with the site). -'''Basic problem statement:''' +;Basic problem statement +Write a program that reads lines from standard input and, upon end of file, writes the longest line to standard output. +If there are ties for the longest line, the program writes out all the lines that tie. +If there is no input, the program should produce no output. -:Write a program that reads lines from standard input and, upon end of file, writes the longest line to standard output. -:If there are ties for the longest line, the program writes out all the lines that tie. -:If there is no input, the program should produce no output. -'''Task''' +;Task +Implement a solution to the basic problem that adheres to the spirit of the restrictions (see below). -:Implement a solution to the basic problem that adheres to the spirit of the restrictions (see below). +Describe how you circumvented or got around these 'restrictions' and met the 'spirit' of the challenge. Your supporting description may need to describe any challenges to interpreting the restrictions and how you made this interpretation. You should state any assumptions, warnings, or other relevant points. The central idea here is to make the task a bit more interesting by thinking outside of the box and perhaps by showing off the capabilities of your language in a creative way. Because there is potential for considerable variation between solutions, the description is key to helping others see what you've done. -:Describe how you circumvented or got around these 'restrictions' and met the 'spirit' of the challenge. Your supporting description may need to describe any challenges to interpreting the restrictions and how you made this interpretation. You should state any assumptions, warnings, or other relevant points. The central idea here is to make the task a bit more interesting by thinking outside of the box and perhaps by showing off the capabilities of your language in a creative way. Because there is potential for considerable variation between solutions, the description is key to helping others see what you've done. - -:This task is likely to encourage a variety of different types of solutions. They should be substantially different approaches. +This task is likely to encourage a variety of different types of solutions. They should be substantially different approaches. Given the input: -
    a
    +
    +a
     bb
     ccc
     ddd
     ee
     f
    -ggg
    +ggg +
    the output should be (possibly rearranged): -
    ccc
    +
    +ccc
     ddd
    -ggg
    +ggg +
    -'''Original list of restrictions:''' -:1. No comparison operators may be used. -:2. No arithmetic operations, such as addition and subtraction, may be used. -:3. The only datatypes you may use are integer and string. In particular, you may not use lists. +;Original list of restrictions -An additional restriction became apparent in the discussion. -:4. Do not re-read the input file. Avoid using files as a replacement for lists. +# No comparison operators may be used. +# No arithmetic operations, such as addition and subtraction, may be used. +# The only datatypes you may use are integer and string. In particular, you may not use lists. +# Do not re-read the input file. Avoid using files as a replacement for lists (this restriction became apparent in the discussion). -'''Intent of Restrictions''' -:Because of the variety of languages on Rosetta Code and the wide variety of concepts used in them, there needs to be a bit of clarification and guidance here to get to the spirit of the challenge and the intent of the restrictions. +;Intent of restrictions: +Because of the variety of languages on Rosetta Code and the wide variety of concepts used in them, there needs to be a bit of clarification and guidance here to get to the spirit of the challenge and the intent of the restrictions. -::The basic problem can be solved very conventionally, but that's boring and pedestrian. The original intent here wasn't to unduly frustrate people with interpreting the restrictions, it was to get people to think outside of their particular box and have a bit of fun doing it. +The basic problem can be solved very conventionally, but that's boring and pedestrian. The original intent here wasn't to unduly frustrate people with interpreting the restrictions, it was to get people to think outside of their particular box and have a bit of fun doing it. -::The guiding principle here should be to be creative in demonstrating some of the capabilities of the programming language being used. If you need to bend the restrictions a bit, explain why and try to follow the intent. If you think you've implemented a 'cheat', call out the fragment yourself and ask readers if they can spot why. If you absolutely can't get around one of the restrictions, explain why in your description. +The guiding principle here should be to be creative in demonstrating some of the capabilities of the programming language being used. If you need to bend the restrictions a bit, explain why and try to follow the intent. If you think you've implemented a 'cheat', call out the fragment yourself and ask readers if they can spot why. If you absolutely can't get around one of the restrictions, explain why in your description. -::Now having said that, the restrictions require some elaboration. +Now having said that, the restrictions require some elaboration. -:::* In general, the restrictions are meant to avoid the explicit use of these features. -:::* "No comparison operators may be used" - At some level there must be some test that allows the solution to get at the length and determine if one string is longer. Comparison operators, in particular any less/greater comparison should be avoided. Representing the length of any string as a number should also be avoided. Various approaches allow for detecting the end of a string. Some of these involve implicitly using equal/not-equal; however, explicitly using equal/not-equal should be acceptable. -:::* "No arithmetic operations" - Again, at some level something may have to advance through the string. Often there are ways a language can do this implicitly advance a cursor or pointer without explicitly using a +, - , ++, --, add, subtract, etc. -:::* The datatype restrictions are amongst the most difficult to reinterpret. In the language of the original challenge strings are atomic datatypes and structured datatypes like lists are quite distinct and have many different operations that apply to them. This becomes a bit fuzzier with languages with a different programming paradigm. The intent would be to avoid using an easy structure to accumulate the longest strings and spit them out. There will be some natural reinterpretation here. -:::: To make this a bit more concrete, here are a couple of specific examples: -::::: In C, a string is an array of chars, so using a couple of arrays as strings is in the spirit while using a second array in a non-string like fashion would violate the intent. -::::: In APL or J, arrays are the core of the language so ruling them out is unfair. Meeting the spirit will come down to how they are used. -:::: Please keep in mind these are just examples and you may hit new territory finding a solution. There will be other cases like these. Explain your reasoning. You may want to open a discussion on the talk page as well. -:::* The added "No rereading" restriction is for practical reasons, re-reading stdin should be broken. I haven't outright banned the use of other files but I've discouraged them as it is basically another form of a list. Somewhere there may be a language that just sings when doing file manipulation and where that makes sense; however, for most there should be a way to accomplish without resorting to an externality. +* In general, the restrictions are meant to avoid the explicit use of these features. +* "No comparison operators may be used" - At some level there must be some test that allows the solution to get at the length and determine if one string is longer. Comparison operators, in particular any less/greater comparison should be avoided. Representing the length of any string as a number should also be avoided. Various approaches allow for detecting the end of a string. Some of these involve implicitly using equal/not-equal; however, explicitly using equal/not-equal should be acceptable. +* "No arithmetic operations" - Again, at some level something may have to advance through the string. Often there are ways a language can do this implicitly advance a cursor or pointer without explicitly using a +, - , ++, --, add, subtract, etc. +* The datatype restrictions are amongst the most difficult to reinterpret. In the language of the original challenge strings are atomic datatypes and structured datatypes like lists are quite distinct and have many different operations that apply to them. This becomes a bit fuzzier with languages with a different programming paradigm. The intent would be to avoid using an easy structure to accumulate the longest strings and spit them out. There will be some natural reinterpretation here. -:At the end of the day for the implementer this should be a bit of fun. As an implementer you represent the expertise in your language, the reader may have no knowledge of your language. For the reader it should give them insight into how people think outside the box in other languages. Comments, especially for non-obvious (to the reader) bits will be extremely helpful. While the implementations may be a bit artificial in the context of this task, the general techniques may be useful elsewhere. + +To make this a bit more concrete, here are a couple of specific examples: +In C, a string is an array of chars, so using a couple of arrays as strings is in the spirit while using a second array in a non-string like fashion would violate the intent. +In APL or J, arrays are the core of the language so ruling them out is unfair. Meeting the spirit will come down to how they are used. + +Please keep in mind these are just examples and you may hit new territory finding a solution. There will be other cases like these. Explain your reasoning. You may want to open a discussion on the talk page as well. +* The added "No rereading" restriction is for practical reasons, re-reading stdin should be broken. I haven't outright banned the use of other files but I've discouraged them as it is basically another form of a list. Somewhere there may be a language that just sings when doing file manipulation and where that makes sense; however, for most there should be a way to accomplish without resorting to an externality. + + +At the end of the day for the implementer this should be a bit of fun. As an implementer you represent the expertise in your language, the reader may have no knowledge of your language. For the reader it should give them insight into how people think outside the box in other languages. Comments, especially for non-obvious (to the reader) bits will be extremely helpful. While the implementations may be a bit artificial in the context of this task, the general techniques may be useful elsewhere. +

    diff --git a/Task/Longest-string-challenge/ALGOL-68/longest-string-challenge.alg b/Task/Longest-string-challenge/ALGOL-68/longest-string-challenge-1.alg similarity index 100% rename from Task/Longest-string-challenge/ALGOL-68/longest-string-challenge.alg rename to Task/Longest-string-challenge/ALGOL-68/longest-string-challenge-1.alg diff --git a/Task/Longest-string-challenge/ALGOL-68/longest-string-challenge-2.alg b/Task/Longest-string-challenge/ALGOL-68/longest-string-challenge-2.alg new file mode 100644 index 0000000000..ccc700b42e --- /dev/null +++ b/Task/Longest-string-challenge/ALGOL-68/longest-string-challenge-2.alg @@ -0,0 +1,94 @@ +# The standard SIGN operator returns -1 if its operand is < 0 # +# , 0 if its operand is 0 # +# , 1 if its operand is > 0 # +# This array maps he results of SIGN to FALSE or TRUE for the # +# ATLEASTASLONGAS operator defined below # +[ -1 : 1 ]BOOL not shorter; +not shorter[ -1 ] := FALSE; +not shorter[ 0 ] := FALSE; +not shorter[ 1 ] := TRUE; + +# Set the priorities for the dyadic operators defined below # +# 9 is the highest priority, so a LOMGERTHAN b AND ... # +# is parsed correctly # +PRIO ATLEASTASLONGAS = 9 + , LONGERTHAN = 9 + ; + + +OP NONEMPTYSTRING = ( STRING a )STRING: " " + a[ AT 1 ]; + +# STRING x is at least as long as STRING y if the substring # +# of x from the upper bound of y to the end of x is at least # +# one character long # +# Note that Algol 68 doesn't raise an error if the substring # +# start position is after the upper bound of the string, but # +# does object if the start position is before the lower bound # +# - hence the need for the NONEMPTYSTRING operator to ensure # +# we don't try executing a[ 0 : ] when b is "" # +OP ATLEASTASLONGAS = ( STRING x, STRING y )BOOL: + BEGIN + STRING a = NONEMPTYSTRING x; + STRING b = NONEMPTYSTRING y; + not shorter[ SIGN UPB a[ UPB b : ] ] + END # ATLEASTASLONGAS # ; + +# x is longer than y if x is at least as long as y and # +# y is not at least as long as x # +OP LONGERTHAN = ( STRING x, STRING y )BOOL: x ATLEASTASLONGAS y AND NOT ( y ATLEASTASLONGAS x ); +# additional LONGERTHAN operators to handle single chatracter # +# STRINGs which are actually CHAR values in Algol 68 # +# Not needed for the task, but useful for testing LONGERTHAN # +OP LONGERTHAN = ( CHAR x, CHAR y )BOOL: FALSE; +OP LONGERTHAN = ( CHAR x, STRING y )BOOL: STRING( x ) LONGERTHAN y; +OP LONGERTHAN = ( STRING x, CHAR y )BOOL: x LONGERTHAN STRING( y ); + +COMMENT # basic test of LONGERTHAN: # C-MMENT +print( ( "abc" LONGERTHAN "bbcd", "ABC" LONGERTHAN "", "" LONGERTHAN "abc", "DEF" LONGERTHAN "DEF", "abcd" LONGERTHAN "a", newline ) ); +C-MMENT COMMENT + +PROC read line = ( REF FILE f )STRING: + BEGIN + STRING line; + get( f, ( line, newline ) ); + IF at eof THEN "" ELSE line FI + END # read line # ; + +# EOF handler for standard input # +BOOL at eof := FALSE; +on logical file end( stand in, ( REF FILE f )BOOL: + BEGIN + at eof := TRUE; + TRUE + END + ); + + +# recursively find the longest line(s) in the specified file # +# and print them # +PROC print longest lines = ( REF FILE f, STRING longest so far )STRING: + BEGIN + IF at eof THEN + longest so far + ELSE + STRING s = read line( f ); + STRING t = IF s LONGERTHAN longest so far + THEN + print longest lines( f, s ) + ELSE + print longest lines( f, longest so far ) + FI; + IF s ATLEASTASLONGAS t AND t ATLEASTASLONGAS s + THEN + # this line is as long as the longest # + print( ( s, newline ) ); + s + ELSE + # shorter line - return the longest # + t + FI + FI + END # print longest lines # ; + +# find the logest lines from standard inoout # +VOID( print longest lines( stand in, read line( stand in ) ) ) diff --git a/Task/Longest-string-challenge/Clojure/longest-string-challenge.clj b/Task/Longest-string-challenge/Clojure/longest-string-challenge.clj new file mode 100644 index 0000000000..78069ade76 --- /dev/null +++ b/Task/Longest-string-challenge/Clojure/longest-string-challenge.clj @@ -0,0 +1,30 @@ +ns longest-string + (:gen-class)) + +(defn longer [a b] + " if a is longer, it returns the characters in a after length b characters have been removed + otherwise it returns nil " + (if (or (empty? a) (empty? b)) + (not-empty a) + (recur (rest a) (rest b)))) + +(defn get-input [] + " Gets the data from standard input as a lazy-sequence of lines (i.e. reads lines as needed by caller + Input is terminated by a zero length line (i.e. line with just " + (let [line (read-line)] + (if (> (count line) 0) + (lazy-seq (cons line (get-input))) + nil))) + +(defn process [] + " Returns list of longest lines " + (first ; takes lines from [lines longest] + (reduce (fn [[lines longest] x] + (cond + (longer x longest) [x x] ; new longer line + (not (longer longest x)) [(str lines "\n" x) longest] ; append x to previous longest + :else [lines longest])) ; keep previous lines & longest + ["" ""] (get-input)))) + +(println "Input text:") +(println "Output:\n" (process)) diff --git a/Task/Longest-string-challenge/PowerShell/longest-string-challenge-1.psh b/Task/Longest-string-challenge/PowerShell/longest-string-challenge-1.psh new file mode 100644 index 0000000000..d91097dcec --- /dev/null +++ b/Task/Longest-string-challenge/PowerShell/longest-string-challenge-1.psh @@ -0,0 +1,40 @@ +# Get-Content strips out any type of line break and creates an array of strings +# We'll join them back together and put a specific type of line break back in +$File = ( Get-Content C:\Test\File.txt ) -join "`n" + +$LongestString = $LongestStrings = '' + +# While the file string still still exists +While ( $File ) + { + # Set the String to the first string and File to any remaining strings + $String, $File = $File.Split( "`n", 2 ) + + # Strip off characters until one or both strings are zero length + $A = $LongestString + $B = $String + While ( $A -and $B ) + { + $A = $A.Substring( 1 ) + $B = $B.Substring( 1 ) + } + + # If A is zero length... + If ( -not $A ) + { + # If $B is not zero length (and therefore String is longer than LongestString)... + If ( $B ) + { + $LongestString = $String + $LongestStrings = $String + } + # Else ($B is also zero length, and therefore String is the same length as LongestString)... + Else + { + $LongestStrings = $LongestStrings, $String -join "`n" + } + } + } + +# Output longest strings +$LongestStrings.Split( "`n" ) diff --git a/Task/Longest-string-challenge/PowerShell/longest-string-challenge-2.psh b/Task/Longest-string-challenge/PowerShell/longest-string-challenge-2.psh new file mode 100644 index 0000000000..7a15683bb0 --- /dev/null +++ b/Task/Longest-string-challenge/PowerShell/longest-string-challenge-2.psh @@ -0,0 +1,12 @@ +@' +a +bb +ccc +ddd +ee +f +ggg +'@ -split "`r`n" | + Group-Object -Property Length | + Sort-Object -Property Name -Descending | + Select-Object -Property Count, @{Name="Length"; Expression={[int]$_.Name}}, Group -First 1 diff --git a/Task/Look-and-say-sequence/00DESCRIPTION b/Task/Look-and-say-sequence/00DESCRIPTION index 1c13de8581..9943cac596 100644 --- a/Task/Look-and-say-sequence/00DESCRIPTION +++ b/Task/Look-and-say-sequence/00DESCRIPTION @@ -1,23 +1,26 @@ -The [[wp:Look and say sequence|Look and say sequence]] is a recursively defined sequence of numbers studied most notably by [[wp:John Horton Conway|John Conway]]. +The   [[wp:Look and say sequence|Look and say sequence]]   is a recursively defined sequence of numbers studied most notably by   [[wp:John Horton Conway|John Conway]]. + '''Sequence Definition''' * Take a decimal number * ''Look'' at the number, visually grouping consecutive runs of the same digit. * ''Say'' the number, from left to right, group by group; as how many of that digit there are - followed by the digit grouped. -:This becomes the next number of the sequence. +: This becomes the next number of the sequence. + '''An example:''' -* Starting with the number 1, you have ''one'' 1 which produces 11. -* Starting with 11, you have ''two'' 1's i.e. 21 -* Starting with 21, you have ''one'' 2, then ''one'' 1 i.e. (12)(11) which becomes 1211 -* Starting with 1211 you have ''one'' 1, ''one'' 2, then ''two'' 1's i.e. (11)(12)(21) which becomes 111221 +* Starting with the number 1,   you have ''one'' 1 which produces 11 +* Starting with 11,   you have ''two'' 1's.   I.E.:   21 +* Starting with 21,   you have ''one'' 2, then ''one'' 1.   I.E.:   (12)(11) which becomes 1211 +* Starting with 1211,   you have ''one'' 1, ''one'' 2, then ''two'' 1's.   I.E.:   (11)(12)(21) which becomes 111221 -'''Task description''' -:Write a program to generate successive members of the look-and-say sequence. -'''See also''' -* [https://www.youtube.com/watch?v=ea7lJkEhytA Look-and-Say Numbers (feat John Conway)], A Numberphile Video. -* This task is related to, and an application of, the [[Run-length encoding]] task. -* Sequence [https://oeis.org/A005150 A005150] on The On-Line Encyclopedia of Integer Sequences. +;Task: +Write a program to generate successive members of the look-and-say sequence. -__TOC__ + +;See also: +*   [https://www.youtube.com/watch?v=ea7lJkEhytA Look-and-Say Numbers (feat John Conway)], A Numberphile Video. +*   This task is related to, and an application of, the [[Run-length encoding]] task. +*   Sequence [https://oeis.org/A005150 A005150] on The On-Line Encyclopedia of Integer Sequences. +

    diff --git a/Task/Look-and-say-sequence/OCaml/look-and-say-sequence-1.ocaml b/Task/Look-and-say-sequence/OCaml/look-and-say-sequence-1.ocaml index 6538e1bc02..2ed74d3104 100644 --- a/Task/Look-and-say-sequence/OCaml/look-and-say-sequence-1.ocaml +++ b/Task/Look-and-say-sequence/OCaml/look-and-say-sequence-1.ocaml @@ -1,35 +1,5 @@ -let aux s = - let len = String.length s in - let rec aux c i n acc = - if i >= len - then List.rev((n,c)::acc) - else - if c = s.[i] - then aux c (succ i) (succ n) acc - else aux s.[i] (succ i) 1 ((n,c)::acc) - in - aux s.[0] 1 1 [] - -let lookandsay num = - let l = aux num in - let s = - List.map (fun (n,c) -> - (string_of_int n) ^ (String.make 1 c)) l - in - String.concat "" s - -let fold_loop f ini n = - let rec aux i acc = - if i >= n - then (acc) - else aux (succ i) (f acc i) - in - aux 0 ini - -let _ = - fold_loop - (fun num _ -> - let next = lookandsay num in - print_endline next; - (next)) - (string_of_int 1) 10 +let rec seeAndSay = function + | [], nys -> List.rev nys + | x::xs, [] -> seeAndSay(xs, [x; 1]) + | x::xs, y::n::nys when x=y -> seeAndSay(xs, y::1+n::nys) + | x::xs, nys -> seeAndSay(xs, x::1::nys) diff --git a/Task/Look-and-say-sequence/OCaml/look-and-say-sequence-2.ocaml b/Task/Look-and-say-sequence/OCaml/look-and-say-sequence-2.ocaml index cb4af37f10..a9fe5d4db4 100644 --- a/Task/Look-and-say-sequence/OCaml/look-and-say-sequence-2.ocaml +++ b/Task/Look-and-say-sequence/OCaml/look-and-say-sequence-2.ocaml @@ -1,14 +1,14 @@ -#load "str.cma";; +> let gen n = + let xs = Array.create n [1] in + for i=1 to n-1 do + xs.(i) <- seeAndSay(xs.(i-1), []) + done; + xs;; +val gen : int -> int list array = -let lookandsay = - Str.global_substitute (Str.regexp "\\(.\\)\\1*") - (fun s -> string_of_int (String.length (Str.matched_string s)) ^ - Str.matched_group 1 s) - -let () = - let num = ref "1" in - print_endline !num; - for i = 1 to 10 do - num := lookandsay !num; - print_endline !num; - done +> gen 10;; +- : int list array = + [|[1]; [1; 1]; [2; 1]; [1; 2; 1; 1]; [1; 1; 1; 2; 2; 1]; [3; 1; 2; 2; 1; 1]; + [1; 3; 1; 1; 2; 2; 2; 1]; [1; 1; 1; 3; 2; 1; 3; 2; 1; 1]; + [3; 1; 1; 3; 1; 2; 1; 1; 1; 3; 1; 2; 2; 1]; + [1; 3; 2; 1; 1; 3; 1; 1; 1; 2; 3; 1; 1; 3; 1; 1; 2; 2; 1; 1]|] diff --git a/Task/Look-and-say-sequence/OCaml/look-and-say-sequence-3.ocaml b/Task/Look-and-say-sequence/OCaml/look-and-say-sequence-3.ocaml index 2c6e92abb3..cb4af37f10 100644 --- a/Task/Look-and-say-sequence/OCaml/look-and-say-sequence-3.ocaml +++ b/Task/Look-and-say-sequence/OCaml/look-and-say-sequence-3.ocaml @@ -1,16 +1,13 @@ -open Pcre +#load "str.cma";; -let lookandsay str = - let rex = regexp "(.)\\1*" in - let subs = exec_all ~rex str in - let ar = Array.map (fun sub -> get_substring sub 0) subs in - let ar = Array.map (fun s -> String.length s, s.[0]) ar in - let ar = Array.map (fun (n,c) -> (string_of_int n) ^ (String.make 1 c)) ar in - let res = String.concat "" (Array.to_list ar) in - (res) +let lookandsay = + Str.global_substitute (Str.regexp "\\(.\\)\\1*") + (fun s -> string_of_int (String.length (Str.matched_string s)) ^ + Str.matched_group 1 s) let () = - let num = ref(string_of_int 1) in + let num = ref "1" in + print_endline !num; for i = 1 to 10 do num := lookandsay !num; print_endline !num; diff --git a/Task/Look-and-say-sequence/OCaml/look-and-say-sequence-4.ocaml b/Task/Look-and-say-sequence/OCaml/look-and-say-sequence-4.ocaml index 9998d463ac..2c6e92abb3 100644 --- a/Task/Look-and-say-sequence/OCaml/look-and-say-sequence-4.ocaml +++ b/Task/Look-and-say-sequence/OCaml/look-and-say-sequence-4.ocaml @@ -1,42 +1,17 @@ -(* see http://oeis.org/A005150 *) +open Pcre -let look_and_say s = -let n = String.length s -and buf = Buffer.create 0 -and prev = ref s.[0] -and count = ref 0 in -let append () = Buffer.add_char buf (char_of_int (48 + !count)); - Buffer.add_char buf !prev in -String.iter (fun c -> - if c = !prev then incr count else - begin - append (); - prev := c; - count := 1 - end -) s; -append (); -Buffer.contents buf;; +let lookandsay str = + let rex = regexp "(.)\\1*" in + let subs = exec_all ~rex str in + let ar = Array.map (fun sub -> get_substring sub 0) subs in + let ar = Array.map (fun s -> String.length s, s.[0]) ar in + let ar = Array.map (fun (n,c) -> (string_of_int n) ^ (String.make 1 c)) ar in + let res = String.concat "" (Array.to_list ar) in + (res) -(* what about length of successive strings ? *) -let iter f a n = -let rec aux r n v = if n = 0 - then List.rev(r::v) - else aux (f r) (n - 1) (r::v) in -aux a n [];; - -let las = iter look_and_say "1";; - -(* the first sixty terms *) - -List.map (String.length) (las 59);; -(* - [1; 2; 2; 4; 6; 6; 8; 10; 14; 20; 26; 34; 46; 62; 78; 102; 134; 176; 226; - 302; 408; 528; 678; 904; 1182; 1540; 2012; 2606; 3410; 4462; 5808; 7586; - 9898; 12884; 16774; 21890; 28528; 37158; 48410; 63138; 82350; 107312; - 139984; 182376; 237746; 310036; 403966; 526646; 686646; 894810; 1166642; - 1520986; 1982710; 2584304; 3369156; 4391702; 5724486; 7462860; 9727930; - 12680852] -*) - -(* see http://oeis.org/A005341 *) +let () = + let num = ref(string_of_int 1) in + for i = 1 to 10 do + num := lookandsay !num; + print_endline !num; + done diff --git a/Task/Look-and-say-sequence/OCaml/look-and-say-sequence-5.ocaml b/Task/Look-and-say-sequence/OCaml/look-and-say-sequence-5.ocaml new file mode 100644 index 0000000000..9998d463ac --- /dev/null +++ b/Task/Look-and-say-sequence/OCaml/look-and-say-sequence-5.ocaml @@ -0,0 +1,42 @@ +(* see http://oeis.org/A005150 *) + +let look_and_say s = +let n = String.length s +and buf = Buffer.create 0 +and prev = ref s.[0] +and count = ref 0 in +let append () = Buffer.add_char buf (char_of_int (48 + !count)); + Buffer.add_char buf !prev in +String.iter (fun c -> + if c = !prev then incr count else + begin + append (); + prev := c; + count := 1 + end +) s; +append (); +Buffer.contents buf;; + +(* what about length of successive strings ? *) +let iter f a n = +let rec aux r n v = if n = 0 + then List.rev(r::v) + else aux (f r) (n - 1) (r::v) in +aux a n [];; + +let las = iter look_and_say "1";; + +(* the first sixty terms *) + +List.map (String.length) (las 59);; +(* + [1; 2; 2; 4; 6; 6; 8; 10; 14; 20; 26; 34; 46; 62; 78; 102; 134; 176; 226; + 302; 408; 528; 678; 904; 1182; 1540; 2012; 2606; 3410; 4462; 5808; 7586; + 9898; 12884; 16774; 21890; 28528; 37158; 48410; 63138; 82350; 107312; + 139984; 182376; 237746; 310036; 403966; 526646; 686646; 894810; 1166642; + 1520986; 1982710; 2584304; 3369156; 4391702; 5724486; 7462860; 9727930; + 12680852] +*) + +(* see http://oeis.org/A005341 *) diff --git a/Task/Look-and-say-sequence/Perl-6/look-and-say-sequence.pl6 b/Task/Look-and-say-sequence/Perl-6/look-and-say-sequence.pl6 index c1618234f5..ebbdd0862f 100644 --- a/Task/Look-and-say-sequence/Perl-6/look-and-say-sequence.pl6 +++ b/Task/Look-and-say-sequence/Perl-6/look-and-say-sequence.pl6 @@ -1,8 +1 @@ -my @look-and-say = ( - '1', - *.comb(/(.)$0*/).map({ .chars ~ .substr(0,1) }).join - ... - * -); - -.say for @look-and-say[^10]; +.say for '1', *.subst(/(.)$0*/, { .chars ~ .[0] }, :g) ... *; diff --git a/Task/Loop-over-multiple-arrays-simultaneously/00DESCRIPTION b/Task/Loop-over-multiple-arrays-simultaneously/00DESCRIPTION index dd6399992f..07402bde0b 100644 --- a/Task/Loop-over-multiple-arrays-simultaneously/00DESCRIPTION +++ b/Task/Loop-over-multiple-arrays-simultaneously/00DESCRIPTION @@ -1,13 +1,20 @@ -Loop over multiple arrays (or lists or tuples or whatever they're called in -your language) and print the ''i''th element of each. -Use your language's "for each" loop if it has one, otherwise iterate +;Task: +Loop over multiple arrays   (or lists or tuples or whatever they're called in +your language)   and display the   ''i'' th   element of each. + +Use your language's   "for each"   loop if it has one, otherwise iterate through the collection in order with some other loop. -For this example, loop over the arrays (a,b,c), -(A,B,C) and (1,2,3) -to produce the output -
    aA1
    -bB2
    -cC3
    +For this example, loop over the arrays: + (a,b,c) + (A,B,C) + (1,2,3) +to produce the output: + aA1 + bB2 + cC3 + +
    If possible, also describe what happens when the arrays are of different lengths. +

    diff --git a/Task/Loop-over-multiple-arrays-simultaneously/AppleScript/loop-over-multiple-arrays-simultaneously.applescript b/Task/Loop-over-multiple-arrays-simultaneously/AppleScript/loop-over-multiple-arrays-simultaneously.applescript new file mode 100644 index 0000000000..1cec0d540d --- /dev/null +++ b/Task/Loop-over-multiple-arrays-simultaneously/AppleScript/loop-over-multiple-arrays-simultaneously.applescript @@ -0,0 +1,89 @@ +-- zipListsWith :: ([a] -> b) -> [[a]] -> [[b]] +on zipListsWith(f, xss) + set lngLists to length of xss + + -- appliedToNths :: a -> Int -> [b] + script appliedToNths + on lambda(_, i) + -- nthItem :: [a] -> a + script nthItem + on lambda(xs) + item i of xs + end lambda + end script + + if i ≤ lngLists then + apply(f, (map(nthItem, xss))) + else + {} + end if + end lambda + end script + + if lngLists > 0 then + map(appliedToNths, item 1 of xss) + else + [] + end if +end zipListsWith + + + +-- TEST + +-- Function to apply: + +-- concatList [String] -> String +on concatList(lst) + intercalate("", lst) +end concatList + +on run + -- Application: + + intercalate(linefeed, ¬ + zipListsWith(concatList, ¬ + [["a", "b", "c"], ["A", "B", "C"], [1, 2, 3]])) + +end run + + + +-- GENERIC FUNCTIONS + +-- apply (a -> b) -> a -> b +on apply(f, a) + mReturn(f)'s lambda(a) +end apply + +-- intercalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate + +-- 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 + +-- 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 diff --git a/Task/Loop-over-multiple-arrays-simultaneously/C++/loop-over-multiple-arrays-simultaneously-3.cpp b/Task/Loop-over-multiple-arrays-simultaneously/C++/loop-over-multiple-arrays-simultaneously-3.cpp new file mode 100644 index 0000000000..621e711857 --- /dev/null +++ b/Task/Loop-over-multiple-arrays-simultaneously/C++/loop-over-multiple-arrays-simultaneously-3.cpp @@ -0,0 +1,21 @@ +#include +#include + +int main(int argc, char* argv[]) +{ + auto lowers = std::vector({'a', 'b', 'c'}); + auto uppers = std::vector({'A', 'B', 'C'}); + auto nums = std::vector({1, 2, 3}); + + auto ilow = lowers.cbegin(); + auto iup = uppers.cbegin(); + auto inum = nums.cbegin(); + + for(; ilow != lowers.end() + and iup != uppers.end() + and inum != nums.end() + ; ++ilow, ++iup, ++inum) + { + std::cout << *ilow << *iup << *inum << "\n"; + } +} diff --git a/Task/Loop-over-multiple-arrays-simultaneously/C++/loop-over-multiple-arrays-simultaneously-4.cpp b/Task/Loop-over-multiple-arrays-simultaneously/C++/loop-over-multiple-arrays-simultaneously-4.cpp new file mode 100644 index 0000000000..6bf3c0f7aa --- /dev/null +++ b/Task/Loop-over-multiple-arrays-simultaneously/C++/loop-over-multiple-arrays-simultaneously-4.cpp @@ -0,0 +1,21 @@ +#include +#include + +int main(int argc, char* argv[]) +{ + char lowers[] = {'a', 'b', 'c'}; + char uppers[] = {'A', 'B', 'C'}; + int nums[] = {1, 2, 3}; + + auto ilow = std::begin(lowers); + auto iup = std::begin(uppers); + auto inum = std::begin(nums); + + for(; ilow != std::end(lowers) + and iup != std::end(uppers) + and inum != std::end(nums) + ; ++ilow, ++iup, ++inum ) + { + std::cout << *ilow << *iup << *inum << "\n"; + } +} diff --git a/Task/Loop-over-multiple-arrays-simultaneously/C++/loop-over-multiple-arrays-simultaneously-5.cpp b/Task/Loop-over-multiple-arrays-simultaneously/C++/loop-over-multiple-arrays-simultaneously-5.cpp new file mode 100644 index 0000000000..67d6bbbad6 --- /dev/null +++ b/Task/Loop-over-multiple-arrays-simultaneously/C++/loop-over-multiple-arrays-simultaneously-5.cpp @@ -0,0 +1,21 @@ +#include +#include + +int main(int argc, char* argv[]) +{ + auto lowers = std::array({'a', 'b', 'c'}); + auto uppers = std::array({'A', 'B', 'C'}); + auto nums = std::array({1, 2, 3}); + + auto ilow = lowers.cbegin(); + auto iup = uppers.cbegin(); + auto inum = nums.cbegin(); + + for(; ilow != lowers.end() + and iup != uppers.end() + and inum != nums.end() + ; ++ilow, ++iup, ++inum ) + { + std::cout << *ilow << *iup << *inum << "\n"; + } +} diff --git a/Task/Loop-over-multiple-arrays-simultaneously/C++/loop-over-multiple-arrays-simultaneously-6.cpp b/Task/Loop-over-multiple-arrays-simultaneously/C++/loop-over-multiple-arrays-simultaneously-6.cpp new file mode 100644 index 0000000000..9da6e8093f --- /dev/null +++ b/Task/Loop-over-multiple-arrays-simultaneously/C++/loop-over-multiple-arrays-simultaneously-6.cpp @@ -0,0 +1,23 @@ +#include +#include +#include + +int main(int argc, char* argv[]) +{ + auto lowers = std::array({'a', 'b', 'c'}); + auto uppers = std::array({'A', 'B', 'C'}); + auto nums = std::array({1, 2, 3}); + + auto const minsize = std::min( + lowers.size(), + std::min( + uppers.size(), + nums.size() + ) + ); + + for(size_t i = 0; i < minsize; ++i) + { + std::cout << lowers[i] << uppers[i] << nums[i] << "\n"; + } +} diff --git a/Task/Loop-over-multiple-arrays-simultaneously/Ela/loop-over-multiple-arrays-simultaneously-1.ela b/Task/Loop-over-multiple-arrays-simultaneously/Ela/loop-over-multiple-arrays-simultaneously-1.ela index e1690a5d1e..467824dd74 100644 --- a/Task/Loop-over-multiple-arrays-simultaneously/Ela/loop-over-multiple-arrays-simultaneously-1.ela +++ b/Task/Loop-over-multiple-arrays-simultaneously/Ela/loop-over-multiple-arrays-simultaneously-1.ela @@ -1,6 +1,12 @@ -open console list imperative +open monad io list imperative xs = zipWith3 (\x y z -> show x ++ show y ++ show z) ['a','b','c'] -['A','B','C'] [1,2,3] + ['A','B','C'] [1,2,3] -each writen xs +print x = do putStrLn x + +print_and_calc xs = do + xss <- return xs + return $ each print xss + +print_and_calc xs ::: IO diff --git a/Task/Loop-over-multiple-arrays-simultaneously/Elena/loop-over-multiple-arrays-simultaneously-1.elena b/Task/Loop-over-multiple-arrays-simultaneously/Elena/loop-over-multiple-arrays-simultaneously-1.elena new file mode 100644 index 0000000000..573efe5a4c --- /dev/null +++ b/Task/Loop-over-multiple-arrays-simultaneously/Elena/loop-over-multiple-arrays-simultaneously-1.elena @@ -0,0 +1,17 @@ +#import system. + +#symbol program = +[ + #var a1 := ("a","b","c"). + #var a2 := ("A","B","C"). + #var a3 := (1,2,3). + + #var i := Integer new:0. + #loop (i < a1 length)? + [ + console writeLine:(a1@i + a2@i + (a3@i) literal). + i := i + 1. + ]. + + console readChar. +]. diff --git a/Task/Loop-over-multiple-arrays-simultaneously/Elena/loop-over-multiple-arrays-simultaneously-2.elena b/Task/Loop-over-multiple-arrays-simultaneously/Elena/loop-over-multiple-arrays-simultaneously-2.elena new file mode 100644 index 0000000000..690e577d90 --- /dev/null +++ b/Task/Loop-over-multiple-arrays-simultaneously/Elena/loop-over-multiple-arrays-simultaneously-2.elena @@ -0,0 +1,16 @@ +#import system. +#import system'routines. + +#symbol program = +[ + #var a1 := ("a","b","c"). + #var a2 := ("A","B","C"). + #var a3 := (1,2,3). + #var zipped := (a1 zip: a2 &into:(:first:second) [ first + second ]) + zip: a3 &into:(:first:second) [ first + (second literal)]. + + zipped run &each: e + [ console writeLine:e. ]. + + console readChar. +]. diff --git a/Task/Loop-over-multiple-arrays-simultaneously/JavaScript/loop-over-multiple-arrays-simultaneously-5.js b/Task/Loop-over-multiple-arrays-simultaneously/JavaScript/loop-over-multiple-arrays-simultaneously-5.js index a1bce16d6f..9d1865b7f3 100644 --- a/Task/Loop-over-multiple-arrays-simultaneously/JavaScript/loop-over-multiple-arrays-simultaneously-5.js +++ b/Task/Loop-over-multiple-arrays-simultaneously/JavaScript/loop-over-multiple-arrays-simultaneously-5.js @@ -1,24 +1,33 @@ -(function (lists) { +(function () { + 'use strict'; - // [[a]] -> [[a]] - function zip(lists) { - var lng = lists.length, - lstHead = lng ? [].concat.apply([], lists.map(function (lst) { - return lst.length ? [lst[0]] : []; - })) : []; - - return lstHead.length === lng ? [lstHead].concat( - zip(lists.map(function (x) { - return x.slice(1); - })) - ) : []; + // zipListsWith :: ([a] -> b) -> [[a]] -> [[b]] + function zipListsWith(f, xss) { + return (xss.length ? xss[0] : []) + .map(function (_, i) { + return f(xss.map(function (xs) { + return xs[i]; + })); + }); } - // [a] -> s + + + + // Sample function over a list + + // concat :: [a] -> s function concat(lst) { return ''.concat.apply('', lst); } - return zip(lists).map(concat).join('\n') -})([["a", "b", "c"], ["A", "B", "C"], [1, 2, 3]]); + // TEST + + return zipListsWith( + concat, + [["a", "b", "c"], ["A", "B", "C"], [1, 2, 3]] + ) + .join('\n'); + +})(); diff --git a/Task/Loop-over-multiple-arrays-simultaneously/Perl-6/loop-over-multiple-arrays-simultaneously-1.pl6 b/Task/Loop-over-multiple-arrays-simultaneously/Perl-6/loop-over-multiple-arrays-simultaneously-1.pl6 index 0f84b4d315..47872a9841 100644 --- a/Task/Loop-over-multiple-arrays-simultaneously/Perl-6/loop-over-multiple-arrays-simultaneously-1.pl6 +++ b/Task/Loop-over-multiple-arrays-simultaneously/Perl-6/loop-over-multiple-arrays-simultaneously-1.pl6 @@ -1,3 +1,3 @@ -for
    Z Z 1, 2, 3 -> $x, $y, $z { +for Z Z 1, 2, 3 -> ($x, $y, $z) { say $x, $y, $z; } diff --git a/Task/Loop-over-multiple-arrays-simultaneously/Perl-6/loop-over-multiple-arrays-simultaneously-4.pl6 b/Task/Loop-over-multiple-arrays-simultaneously/Perl-6/loop-over-multiple-arrays-simultaneously-4.pl6 new file mode 100644 index 0000000000..bd9e1c02a0 --- /dev/null +++ b/Task/Loop-over-multiple-arrays-simultaneously/Perl-6/loop-over-multiple-arrays-simultaneously-4.pl6 @@ -0,0 +1 @@ +for ^Inf Z -> ($i, $letter) { ... } diff --git a/Task/Loop-over-multiple-arrays-simultaneously/Perl-6/loop-over-multiple-arrays-simultaneously-5.pl6 b/Task/Loop-over-multiple-arrays-simultaneously/Perl-6/loop-over-multiple-arrays-simultaneously-5.pl6 new file mode 100644 index 0000000000..e2b1c9a367 --- /dev/null +++ b/Task/Loop-over-multiple-arrays-simultaneously/Perl-6/loop-over-multiple-arrays-simultaneously-5.pl6 @@ -0,0 +1 @@ +for .kv -> $i, $letter { ... } diff --git a/Task/Loop-over-multiple-arrays-simultaneously/PowerShell/loop-over-multiple-arrays-simultaneously-1.psh b/Task/Loop-over-multiple-arrays-simultaneously/PowerShell/loop-over-multiple-arrays-simultaneously-1.psh new file mode 100644 index 0000000000..1628eb92c8 --- /dev/null +++ b/Task/Loop-over-multiple-arrays-simultaneously/PowerShell/loop-over-multiple-arrays-simultaneously-1.psh @@ -0,0 +1,10 @@ +function zip3 ($a1, $a2, $a3) +{ + while ($a1) + { + $x, $a1 = $a1 + $y, $a2 = $a2 + $z, $a3 = $a3 + [Tuple]::Create($x, $y, $z) + } +} diff --git a/Task/Loop-over-multiple-arrays-simultaneously/PowerShell/loop-over-multiple-arrays-simultaneously-2.psh b/Task/Loop-over-multiple-arrays-simultaneously/PowerShell/loop-over-multiple-arrays-simultaneously-2.psh new file mode 100644 index 0000000000..cef9d6aa67 --- /dev/null +++ b/Task/Loop-over-multiple-arrays-simultaneously/PowerShell/loop-over-multiple-arrays-simultaneously-2.psh @@ -0,0 +1 @@ +zip3 @('a','b','c') @('A','B','C') @(1,2,3) diff --git a/Task/Loop-over-multiple-arrays-simultaneously/PowerShell/loop-over-multiple-arrays-simultaneously-3.psh b/Task/Loop-over-multiple-arrays-simultaneously/PowerShell/loop-over-multiple-arrays-simultaneously-3.psh new file mode 100644 index 0000000000..b385114163 --- /dev/null +++ b/Task/Loop-over-multiple-arrays-simultaneously/PowerShell/loop-over-multiple-arrays-simultaneously-3.psh @@ -0,0 +1 @@ +zip3 @('a','b','c') @('A','B','C') @(1,2,3) | ForEach-Object {$_.Item1 + $_.Item2 + $_.Item3} diff --git a/Task/Loop-over-multiple-arrays-simultaneously/REXX/loop-over-multiple-arrays-simultaneously-1.rexx b/Task/Loop-over-multiple-arrays-simultaneously/REXX/loop-over-multiple-arrays-simultaneously-1.rexx index cb73fe32bf..9674dbd5cb 100644 --- a/Task/Loop-over-multiple-arrays-simultaneously/REXX/loop-over-multiple-arrays-simultaneously-1.rexx +++ b/Task/Loop-over-multiple-arrays-simultaneously/REXX/loop-over-multiple-arrays-simultaneously-1.rexx @@ -1,5 +1,4 @@ -/*REXX program shows how to simultaneously loop over - multiple arrays.*/ +/*REXX program shows how to simultaneously loop over multiple arrays.*/ x. = ' '; x.1 = "a"; x.2 = 'b'; x.3 = "c" y. = ' '; y.1 = "A"; y.2 = 'B'; y.3 = "C" z. = ' '; z.1 = "1"; z.2 = '2'; z.3 = "3" @@ -7,5 +6,4 @@ z. = ' '; z.1 = "1"; z.2 = '2'; z.3 = "3" do j=1 until output='' output = x.j || y.j || z.j say output - end /*j*/ /*stick a fork in it, we're -done.*/ + end /*j*/ /*stick a fork in it, we're done.*/ diff --git a/Task/Loop-over-multiple-arrays-simultaneously/REXX/loop-over-multiple-arrays-simultaneously-2.rexx b/Task/Loop-over-multiple-arrays-simultaneously/REXX/loop-over-multiple-arrays-simultaneously-2.rexx index 56c342dffd..110d9b9473 100644 --- a/Task/Loop-over-multiple-arrays-simultaneously/REXX/loop-over-multiple-arrays-simultaneously-2.rexx +++ b/Task/Loop-over-multiple-arrays-simultaneously/REXX/loop-over-multiple-arrays-simultaneously-2.rexx @@ -1,12 +1,9 @@ -/*REXX program shows how to simultaneously loop over - multiple arrays.*/ +/*REXX program shows how to simultaneously loop over multiple arrays.*/ x.=' '; x.1="a"; x.2='b'; x.3="c"; x.4='d' y.=' '; y.1="A"; y.2='B'; y.3="C"; -z.=' '; z.1= 1 ; z.2= 2 ; z.3= 3 ; z.4= 4; z.5= - 5 +z.=' '; z.1= 1 ; z.2= 2 ; z.3= 3 ; z.4= 4; z.5= 5 do j=1 until output='' output=x.j || y.j || z.j say output - end /*j*/ /*stick a fork in it, we're -done.*/ + end /*j*/ /*stick a fork in it, we're done.*/ diff --git a/Task/Loop-over-multiple-arrays-simultaneously/REXX/loop-over-multiple-arrays-simultaneously-3.rexx b/Task/Loop-over-multiple-arrays-simultaneously/REXX/loop-over-multiple-arrays-simultaneously-3.rexx index c8483d642b..67dd5db656 100644 --- a/Task/Loop-over-multiple-arrays-simultaneously/REXX/loop-over-multiple-arrays-simultaneously-3.rexx +++ b/Task/Loop-over-multiple-arrays-simultaneously/REXX/loop-over-multiple-arrays-simultaneously-3.rexx @@ -1,10 +1,8 @@ -/*REXX program shows how to simultaneously loop over - multiple lists.*/ +/*REXX program shows how to simultaneously loop over multiple lists.*/ x = 'a b c d' y = 'A B C' z = 1 2 3 4 do j=1 until output='' output = word(x,j) || word(y,j) || word(z,j) say output - end /*j*/ /*stick a fork in it, we're -done.*/ + end /*j*/ /*stick a fork in it, we're done.*/ diff --git a/Task/Loop-over-multiple-arrays-simultaneously/REXX/loop-over-multiple-arrays-simultaneously-4.rexx b/Task/Loop-over-multiple-arrays-simultaneously/REXX/loop-over-multiple-arrays-simultaneously-4.rexx index 06b41905a6..d5f2e69be4 100644 --- a/Task/Loop-over-multiple-arrays-simultaneously/REXX/loop-over-multiple-arrays-simultaneously-4.rexx +++ b/Task/Loop-over-multiple-arrays-simultaneously/REXX/loop-over-multiple-arrays-simultaneously-4.rexx @@ -1,9 +1,7 @@ -/*REXX program shows how to simultaneously loop over - multiple lists.*/ +/*REXX program shows how to simultaneously loop over multiple lists.*/ x = 'a b c d' y = 'A B C' z = 1 2 3 4 ..LAST do j=1 for max(words(x), words(y), words(z)) say word(x,j) || word(y,j) || word(z,j) - end /*j*/ /*stick a fork in it, we're -done.*/ + end /*j*/ /*stick a fork in it, we're done.*/ diff --git a/Task/Loop-over-multiple-arrays-simultaneously/SuperCollider/loop-over-multiple-arrays-simultaneously-1.supercollider b/Task/Loop-over-multiple-arrays-simultaneously/SuperCollider/loop-over-multiple-arrays-simultaneously-1.supercollider new file mode 100644 index 0000000000..646e645a21 --- /dev/null +++ b/Task/Loop-over-multiple-arrays-simultaneously/SuperCollider/loop-over-multiple-arrays-simultaneously-1.supercollider @@ -0,0 +1,2 @@ +#x, y, z = [["a", "b", "c"], ["A", "B", "C"], ["1", "2", "3"]]; +3.collect { |i| x[i] ++ y[i] ++ z[i] } diff --git a/Task/Loop-over-multiple-arrays-simultaneously/SuperCollider/loop-over-multiple-arrays-simultaneously-2.supercollider b/Task/Loop-over-multiple-arrays-simultaneously/SuperCollider/loop-over-multiple-arrays-simultaneously-2.supercollider new file mode 100644 index 0000000000..fdd5f075b0 --- /dev/null +++ b/Task/Loop-over-multiple-arrays-simultaneously/SuperCollider/loop-over-multiple-arrays-simultaneously-2.supercollider @@ -0,0 +1 @@ +[["a", "b", "c"], ["A", "B", "C"], ["1", "2", "3"]].flop.collect { |x| x.join } diff --git a/Task/Loop-over-multiple-arrays-simultaneously/SuperCollider/loop-over-multiple-arrays-simultaneously-3.supercollider b/Task/Loop-over-multiple-arrays-simultaneously/SuperCollider/loop-over-multiple-arrays-simultaneously-3.supercollider new file mode 100644 index 0000000000..c08a28bdf4 --- /dev/null +++ b/Task/Loop-over-multiple-arrays-simultaneously/SuperCollider/loop-over-multiple-arrays-simultaneously-3.supercollider @@ -0,0 +1 @@ +[["a", "b", "c"], ["A", "B", "C"], ["1", "2", "3"]].flop.collect(_.join) diff --git a/Task/Loop-over-multiple-arrays-simultaneously/SuperCollider/loop-over-multiple-arrays-simultaneously-4.supercollider b/Task/Loop-over-multiple-arrays-simultaneously/SuperCollider/loop-over-multiple-arrays-simultaneously-4.supercollider new file mode 100644 index 0000000000..e303dcd418 --- /dev/null +++ b/Task/Loop-over-multiple-arrays-simultaneously/SuperCollider/loop-over-multiple-arrays-simultaneously-4.supercollider @@ -0,0 +1 @@ +["a", "b", "c"] +++ ["A", "B", "C"] +++ ["1", "2", "3"] diff --git a/Task/Loop-over-multiple-arrays-simultaneously/SuperCollider/loop-over-multiple-arrays-simultaneously-5.supercollider b/Task/Loop-over-multiple-arrays-simultaneously/SuperCollider/loop-over-multiple-arrays-simultaneously-5.supercollider new file mode 100644 index 0000000000..c5e14be863 --- /dev/null +++ b/Task/Loop-over-multiple-arrays-simultaneously/SuperCollider/loop-over-multiple-arrays-simultaneously-5.supercollider @@ -0,0 +1 @@ +[["a", "b", "c"], ["A", "B", "C"], ["1", "2", "3"]].reduce('+++') diff --git a/Task/Loop-over-multiple-arrays-simultaneously/SuperCollider/loop-over-multiple-arrays-simultaneously.supercollider b/Task/Loop-over-multiple-arrays-simultaneously/SuperCollider/loop-over-multiple-arrays-simultaneously.supercollider deleted file mode 100644 index 5ac19a31fb..0000000000 --- a/Task/Loop-over-multiple-arrays-simultaneously/SuperCollider/loop-over-multiple-arrays-simultaneously.supercollider +++ /dev/null @@ -1,2 +0,0 @@ -([\a,\b,\c]+++[\A,\B,\C]+++[1,2,3]).do({|array| -array.do(_.post); "".postln }) diff --git a/Task/Loop-over-multiple-arrays-simultaneously/ZX-Spectrum-Basic/loop-over-multiple-arrays-simultaneously.zx b/Task/Loop-over-multiple-arrays-simultaneously/ZX-Spectrum-Basic/loop-over-multiple-arrays-simultaneously-1.zx similarity index 100% rename from Task/Loop-over-multiple-arrays-simultaneously/ZX-Spectrum-Basic/loop-over-multiple-arrays-simultaneously.zx rename to Task/Loop-over-multiple-arrays-simultaneously/ZX-Spectrum-Basic/loop-over-multiple-arrays-simultaneously-1.zx diff --git a/Task/Loop-over-multiple-arrays-simultaneously/ZX-Spectrum-Basic/loop-over-multiple-arrays-simultaneously-2.zx b/Task/Loop-over-multiple-arrays-simultaneously/ZX-Spectrum-Basic/loop-over-multiple-arrays-simultaneously-2.zx new file mode 100644 index 0000000000..6c3e6888dc --- /dev/null +++ b/Task/Loop-over-multiple-arrays-simultaneously/ZX-Spectrum-Basic/loop-over-multiple-arrays-simultaneously-2.zx @@ -0,0 +1,6 @@ +10 READ size: DIM a$(size): DIM b$(size): DIM c$(size) +20 FOR i=1 TO size +30 READ a$(i),b$(i),c$(i) +40 PRINT a$(i);b$(i);c$(i) +50 NEXT i +60 DATA 3,"a","A","1","b","B","2","c","C","3" diff --git a/Task/Loops-Break/Ada/loops-break.ada b/Task/Loops-Break/Ada/loops-break.ada index a3f5b1931c..ab5d3e8a45 100644 --- a/Task/Loops-Break/Ada/loops-break.ada +++ b/Task/Loops-Break/Ada/loops-break.ada @@ -2,7 +2,7 @@ with Ada.Text_IO; use Ada.Text_IO; with Ada.Numerics.Discrete_Random; procedure Test_Loop_Break is - type Value_Type is range 1..20; + type Value_Type is range 0..19; package Random_Values is new Ada.Numerics.Discrete_Random (Value_Type); use Random_Values; Dice : Generator; diff --git a/Task/Loops-Break/BASIC/loops-break-3.basic b/Task/Loops-Break/BASIC/loops-break-3.basic new file mode 100644 index 0000000000..a79c9b38d0 --- /dev/null +++ b/Task/Loops-Break/BASIC/loops-break-3.basic @@ -0,0 +1,5 @@ +10 LET a = INT (RND * 20) +20 PRINT a +30 IF a = 10 THEN STOP +40 PRINT INT (RND * 20) +50 GO TO 10 diff --git a/Task/Loops-Break/C/loops-break.c b/Task/Loops-Break/C/loops-break.c index 70c0d146d5..a0d14fe1ee 100644 --- a/Task/Loops-Break/C/loops-break.c +++ b/Task/Loops-Break/C/loops-break.c @@ -2,16 +2,16 @@ #include #include -int main() { - int a, b; +#define LOWER 0 +#define UPPER 19 +int main() { srand(time(NULL)); - while (1) { - a = rand() % 20; /* not exactly uniformly distributed, but doesn't matter */ + + for (;;) { + unsigned a = LOWER + rand() / (RAND_MAX / (UPPER - LOWER + 1) + 1); printf("%d\n", a); if (a == 10) break; - b = rand() % 20; /* not exactly uniformly distributed, but doesn't matter */ - printf("%d\n", b); } return 0; } diff --git a/Task/Loops-Break/CoffeeScript/loops-break.coffee b/Task/Loops-Break/CoffeeScript/loops-break.coffee new file mode 100644 index 0000000000..38396b94d9 --- /dev/null +++ b/Task/Loops-Break/CoffeeScript/loops-break.coffee @@ -0,0 +1,4 @@ +loop + print a = Math.random() * 20 // 1 + break if a == 10 + print Math.random() * 20 // 1 diff --git a/Task/Loops-Break/Common-Lisp/loops-break.lisp b/Task/Loops-Break/Common-Lisp/loops-break.lisp index 0725851ee9..9bc44887ad 100644 --- a/Task/Loops-Break/Common-Lisp/loops-break.lisp +++ b/Task/Loops-Break/Common-Lisp/loops-break.lisp @@ -1,7 +1,4 @@ -(loop - (setq a (random 20)) - (print a) - (if (= a 10) - (return)) - (setq b (random 20)) - (print b)) +(loop for a = (random 20) + do (print a) + until (= a 10) + do (print (random 20))) diff --git a/Task/Loops-Break/Elixir/loops-break.elixir b/Task/Loops-Break/Elixir/loops-break.elixir index 8c460d4857..5d1259be3e 100644 --- a/Task/Loops-Break/Elixir/loops-break.elixir +++ b/Task/Loops-Break/Elixir/loops-break.elixir @@ -1,15 +1,13 @@ defmodule Loops do - def break do - :random.seed(:os.timestamp) - break(:random.uniform(20)-1) + def break, do: break(random) + + defp break(10), do: IO.puts 10 + defp break(r) do + IO.puts "#{r},\t#{random}" + break(random) end - def break(10), do: IO.puts 10 - def break(r) do - IO.write r - IO.puts ",\t#{:random.uniform(20)-1}" - break(:random.uniform(20)-1) - end + defp random, do: Enum.random(0..19) end Loops.break diff --git a/Task/Loops-Break/Io/loops-break.io b/Task/Loops-Break/Io/loops-break.io new file mode 100644 index 0000000000..e3e8a53ae7 --- /dev/null +++ b/Task/Loops-Break/Io/loops-break.io @@ -0,0 +1,7 @@ +loop( + a := Random value(0,20) floor + write(a) + if( a == 10, writeln ; break) + b := Random value(0,20) floor + writeln(" ",b) +) diff --git a/Task/Loops-Break/JavaScript/loops-break-3.js b/Task/Loops-Break/JavaScript/loops-break-3.js index d2ec01bcf8..d361170756 100644 --- a/Task/Loops-Break/JavaScript/loops-break-3.js +++ b/Task/Loops-Break/JavaScript/loops-break-3.js @@ -1,34 +1,14 @@ -18 -10 -16 -10 -8 -0 -13 -3 -2 -14 -15 -17 -14 -7 -10 -8 -0 -2 -0 -2 -5 -16 -3 -16 -6 -7 -19 -0 -16 -9 -7 -11 -17 -10 +console.log( + (function streamTillInitialTen() { + var nFirst = Math.floor(Math.random() * 20); + + if (nFirst === 10) return [10]; + + return [ + nFirst, + Math.floor(Math.random() * 20) + ].concat( + streamTillInitialTen() + ); + })().join('\n') +); diff --git a/Task/Loops-Break/Kotlin/loops-break.kotlin b/Task/Loops-Break/Kotlin/loops-break.kotlin new file mode 100644 index 0000000000..ad8065134c --- /dev/null +++ b/Task/Loops-Break/Kotlin/loops-break.kotlin @@ -0,0 +1,11 @@ +import java.util.Random + +fun main(args: Array) { + val rand = Random() + while (true) { + val a = rand.nextInt(20) + println(a) + if (a == 10) break + println(rand.nextInt(20)) + } +} diff --git a/Task/Loops-Break/Python/loops-break.py b/Task/Loops-Break/Python/loops-break.py index 60252f7a9a..9985219320 100644 --- a/Task/Loops-Break/Python/loops-break.py +++ b/Task/Loops-Break/Python/loops-break.py @@ -1,9 +1,9 @@ -import random +from random import randrange while True: - a = random.randrange(20) - print a + a = randrange(20) + print(a) if a == 10: break - b = random.randrange(20) - print b + b = randrange(20) + print(b) diff --git a/Task/Loops-Break/Rust/loops-break.rust b/Task/Loops-Break/Rust/loops-break.rust index 91bba217d6..427fc6af78 100644 --- a/Task/Loops-Break/Rust/loops-break.rust +++ b/Task/Loops-Break/Rust/loops-break.rust @@ -1,15 +1,14 @@ -use rand::Rng; +// cargo-deps: rand extern crate rand; +use rand::distributions::{Range, IndependentSample}; fn main() { - let mut rng = rand::thread_rng(); loop { - let num = rng.gen_range(0, 20); - println!("{}", num); + let num = Range::new(0, 19 + 1).ind_sample(&mut rand::thread_rng()); if num == 10 { + println!("{}", num); break; } - println!("{}", rng.gen_range(0, 20)); } } diff --git a/Task/Loops-Continue/00DESCRIPTION b/Task/Loops-Continue/00DESCRIPTION index 212ffa5efc..51874ceb71 100644 --- a/Task/Loops-Continue/00DESCRIPTION +++ b/Task/Loops-Continue/00DESCRIPTION @@ -1,8 +1,12 @@ {{omit from|GUISS}} {{omit from|M4}} + +;Task: Show the following output using one loop. 1, 2, 3, 4, 5 6, 7, 8, 9, 10 + Try to achieve the result by forcing the next iteration within the loop upon a specific condition, if your language allows it. +

    diff --git a/Task/Loops-Continue/Io/loops-continue.io b/Task/Loops-Continue/Io/loops-continue.io new file mode 100644 index 0000000000..236473a05b --- /dev/null +++ b/Task/Loops-Continue/Io/loops-continue.io @@ -0,0 +1,5 @@ +for(i,1,10, + write(i) + if(i%5 == 0, writeln() ; continue) + write(" ,") +) diff --git a/Task/Loops-Continue/REXX/loops-continue-1.rexx b/Task/Loops-Continue/REXX/loops-continue-1.rexx new file mode 100644 index 0000000000..264d0105b3 --- /dev/null +++ b/Task/Loops-Continue/REXX/loops-continue-1.rexx @@ -0,0 +1,11 @@ +/*REXX program illustrates an example of a DO loop with an ITERATE (continue). */ + + do j=1 for 10 /*this is equivalent to: DO J=1 TO 10 */ + call charout , j /*write the integer to the terminal. */ + if j//5\==0 then do /*Not a multiple of five? Then ··· */ + call charout , ", " /* write a comma to the terminal, ··· */ + iterate /* ··· & then go back for next integer.*/ + end + say /*force REXX to display on next line. */ + end /*j*/ + /*stick a fork in it, we're all done. */ diff --git a/Task/Loops-Continue/REXX/loops-continue-2.rexx b/Task/Loops-Continue/REXX/loops-continue-2.rexx new file mode 100644 index 0000000000..057f8e4a17 --- /dev/null +++ b/Task/Loops-Continue/REXX/loops-continue-2.rexx @@ -0,0 +1,8 @@ +/*REXX program illustrates an example of a DO loop with an ITERATE (continue). */ +$= /*nullify the variable used for display*/ + do j=1 for 10 /*this is equivalent to: DO J=1 TO 10 */ + $=$ || j', ' /*append the integer to a placeholder. */ + if j//5==0 then say left($, length($) - 2) /*Is J a multiple of five? Then SAY.*/ + if j==5 then $= /*start the display line over again. */ + end /*j*/ + /*stick a fork in it, we're all done. */ diff --git a/Task/Loops-Continue/REXX/loops-continue.rexx b/Task/Loops-Continue/REXX/loops-continue.rexx deleted file mode 100644 index 4a49897492..0000000000 --- a/Task/Loops-Continue/REXX/loops-continue.rexx +++ /dev/null @@ -1,11 +0,0 @@ -/*REXX program illustrates a DO loop with an ITERATE (continue). */ - - do j=1 for 10 /*equivalent to: DO J=1 TO 10 */ - call charout , j /*write the integer to terminal. */ - if j//5\==0 then do /*Not a multiple of five? Then..*/ - call charout , ", " /*write a comma to the terminal, */ - iterate /*... & then go back for next int*/ - end - say /*force REXX display to next line*/ - end /*j*/ - /*stick a fork in it, we're done.*/ diff --git a/Task/Loops-Do-while/360-Assembly/loops-do-while-1.360 b/Task/Loops-Do-while/360-Assembly/loops-do-while-1.360 new file mode 100644 index 0000000000..2ec7cddd63 --- /dev/null +++ b/Task/Loops-Do-while/360-Assembly/loops-do-while-1.360 @@ -0,0 +1,19 @@ +* Do-While +DOWHILE CSECT + USING DOWHILE,12 set base register + LR 12,15 load base register + SR 6,6 v=0 +LOOP LA 6,1(6) repeat; v=v+1 + STC 6,WTOTXT v + OI WTOTXT,X'F0' make printable + WTO MF=(E,WTOMSG) display v + LR 4,6 v + SRDA 4,32 shift to reg 5 + D 4,=F'6' v/6 so r4=remain & r5=quotient + LTR 4,4 until v mod 6=0 + BNZ LOOP loop +ENDLOOP BR 14 return to caller +WTOMSG DS 0F full word alignment for wto +WTOLEN DC AL2(5),H'0' length of wto buffer (4+1) +WTOTXT DC C' ' wto text + END DOWHILE diff --git a/Task/Loops-Do-while/360-Assembly/loops-do-while-2.360 b/Task/Loops-Do-while/360-Assembly/loops-do-while-2.360 new file mode 100644 index 0000000000..9208e7c004 --- /dev/null +++ b/Task/Loops-Do-while/360-Assembly/loops-do-while-2.360 @@ -0,0 +1,21 @@ +* Do-While 27/06/2016 +DOWHILE CSECT + USING DOWHILE,12 set base register + LR 12,15 init base register + SR 6,6 v=0 + LA 4,1 init reg 4 + DO UNTIL=(LTR,4,Z,4) do until v mod 6=0 + LA 6,1(6) v=v+1 + STC 6,WTOTXT v + OI WTOTXT,X'F0' make editable + WTO MF=(E,WTOMSG) display v + LR 4,6 v + SRDA 4,32 shift dividend to reg 5 + D 4,=F'6' v/6 so r4=remain & r5=quotient + ENDDO , end do + BR 14 return to caller +WTOMSG DS 0F full word alignment for wto +WTOLEN DC AL2(L'WTOTXT+4) length of WTO buffer + DC H'0' must be zero +WTOTXT DS C one char + END DOWHILE diff --git a/Task/Loops-Do-while/360-Assembly/loops-do-while.360 b/Task/Loops-Do-while/360-Assembly/loops-do-while.360 deleted file mode 100644 index ce1e1dbd08..0000000000 --- a/Task/Loops-Do-while/360-Assembly/loops-do-while.360 +++ /dev/null @@ -1,26 +0,0 @@ -DOWHILE CSECT , -This program's control section - BAKR 14,0 -Caller's registers to linkage stack - LR 12,15 -load entry point address into Reg 12 - USING DOWHILE,12 -tell assembler we use Reg 12 as base - XR 9,9 -clear Reg 9 - divident value - LA 6,6 -load divisor value 6 in Reg 6 - LA 8,WTOLEN -address of WTO area in Reg 8 -LOOP DS 0H - LA 9,1(,9) -add 1 to divident Reg 9 - ST 9,FW2 -store it - LM 4,5,FDOUBLE -load into even/odd register pair - STH 9,WTOTXT -store divident in text area - MVI WTOTXT,X'F0' -first of two bytes zero - OI WTOTXT+1,X'F0' -make second byte printable - WTO TEXT=(8) -print it (Write To Operator macro) - DR 4,6 -divide Reg pair 4,5 by Reg 6 - LTR 5,5 -test quotient (remainder in Reg 4) - BNZ RETURN -if one: 6 iterations, exit loop. - B LOOP -if zero: loop again. -RETURN PR , -return to caller. -FDOUBLE DC 0FD - DC F'0' -FW2 DC F'0' -WTOLEN DC H'2' -fixed WTO length of two -WTOTXT DC CL2' ' - END DOWHILE diff --git a/Task/Loops-Do-while/Common-Lisp/loops-do-while-1.lisp b/Task/Loops-Do-while/Common-Lisp/loops-do-while-1.lisp index f154ca4492..bb17aac1a5 100644 --- a/Task/Loops-Do-while/Common-Lisp/loops-do-while-1.lisp +++ b/Task/Loops-Do-while/Common-Lisp/loops-do-while-1.lisp @@ -1,5 +1,5 @@ -(setq val 0) -(loop do - (incf val) - (print val) - while (/= 0 (mod val 6))) +(let ((val 0)) + (loop do + (incf val) + (print val) + while (/= 0 (mod val 6)))) diff --git a/Task/Loops-Do-while/Frink/loops-do-while.frink b/Task/Loops-Do-while/Frink/loops-do-while.frink new file mode 100644 index 0000000000..ca994a47b2 --- /dev/null +++ b/Task/Loops-Do-while/Frink/loops-do-while.frink @@ -0,0 +1,6 @@ +n = 0 +do +{ + n = n + 1 + println[n] +} while n mod 6 != 0 diff --git a/Task/Loops-Do-while/Go/loops-do-while.go b/Task/Loops-Do-while/Go/loops-do-while.go index eee23b654a..b0ceae348f 100644 --- a/Task/Loops-Do-while/Go/loops-do-while.go +++ b/Task/Loops-Do-while/Go/loops-do-while.go @@ -3,11 +3,9 @@ package main import "fmt" func main() { - for value := 0;; { - value++ - fmt.Println(value) - if value % 6 == 0 { - break - } - } + var value int + for ok := true; ok; ok = value%6 != 0 { + value++ + fmt.Println(value) + } } diff --git a/Task/Loops-Do-while/JavaScript/loops-do-while-6.js b/Task/Loops-Do-while/JavaScript/loops-do-while-6.js new file mode 100644 index 0000000000..d6e7bc6983 --- /dev/null +++ b/Task/Loops-Do-while/JavaScript/loops-do-while-6.js @@ -0,0 +1,46 @@ +(() => { + 'use strict'; + + // unfoldr :: (b -> Maybe (a, b)) -> b -> [a] + function unfoldr(mf, v) { + for (var lst = [], a = v, m; + (m = mf(a)) && m.valid;) { + lst.push(m.value), a = m.new; + } + return lst; + } + + // until :: (a -> Bool) -> (a -> a) -> a -> a + function until(p, f, x) { + let v = x; + while(!p(v)) v = f(v); + return v; + } + + let result1 = unfoldr( + x => { + return { + value: x, + valid: (x % 6) !== 0, + new: x + 1 + } + }, + 1 + ); + + let result2 = until( + m => (m.n % 6) === 0, + m => { + return { + n : m.n + 1, + xs : m.xs.concat(m.n) + }; + }, + { + n: 1, + xs: [] + } + ).xs; + + return [result1, result2]; +})(); diff --git a/Task/Loops-Do-while/JavaScript/loops-do-while-7.js b/Task/Loops-Do-while/JavaScript/loops-do-while-7.js new file mode 100644 index 0000000000..0d41b5b698 --- /dev/null +++ b/Task/Loops-Do-while/JavaScript/loops-do-while-7.js @@ -0,0 +1 @@ +[[1, 2, 3, 4, 5], [1, 2, 3, 4, 5]] diff --git a/Task/Loops-Do-while/Julia/loops-do-while-1.julia b/Task/Loops-Do-while/Julia/loops-do-while-1.julia new file mode 100644 index 0000000000..fcdef4f834 --- /dev/null +++ b/Task/Loops-Do-while/Julia/loops-do-while-1.julia @@ -0,0 +1,14 @@ +julia> i = 0 +0 + +julia> while true + println(i) + i += 1 + i % 6 == 0 || break + end +0 +1 +2 +3 +4 +5 diff --git a/Task/Loops-Do-while/Julia/loops-do-while-2.julia b/Task/Loops-Do-while/Julia/loops-do-while-2.julia new file mode 100644 index 0000000000..6cf833e19e --- /dev/null +++ b/Task/Loops-Do-while/Julia/loops-do-while-2.julia @@ -0,0 +1,26 @@ +julia> @eval macro $(:do)(block, when::Symbol, condition) + when ≠ :when && error("@do expected `when` got `$s`") + quote + let + $block + while $condition + $block + end + end + end |> esc + end +@do (macro with 1 method) + +julia> i = 0 +0 + +julia> @do begin + @show i + i += 1 + end when i % 6 ≠ 0 +i = 0 +i = 1 +i = 2 +i = 3 +i = 4 +i = 5 diff --git a/Task/Loops-Do-while/Julia/loops-do-while-3.julia b/Task/Loops-Do-while/Julia/loops-do-while-3.julia new file mode 100644 index 0000000000..c362376401 --- /dev/null +++ b/Task/Loops-Do-while/Julia/loops-do-while-3.julia @@ -0,0 +1,25 @@ +julia> macro do_while(condition, block) + quote + let + $block + while $condition + $block + end + end + end |> esc + end +@do_while (macro with 1 method) + +julia> i = 0 +0 + +julia> @do_while i % 6 ≠ 0 begin + @show i + i += 1 + end +i = 0 +i = 1 +i = 2 +i = 3 +i = 4 +i = 5 diff --git a/Task/Loops-Do-while/Julia/loops-do-while.julia b/Task/Loops-Do-while/Julia/loops-do-while.julia deleted file mode 100644 index 362312e9e2..0000000000 --- a/Task/Loops-Do-while/Julia/loops-do-while.julia +++ /dev/null @@ -1,8 +0,0 @@ -i = 0 -while true - println(i) - i += 1 - if i%6 == 0 - break - end -end diff --git a/Task/Loops-Do-while/MIPS-Assembly/loops-do-while.mips b/Task/Loops-Do-while/MIPS-Assembly/loops-do-while.mips new file mode 100644 index 0000000000..a37c9148c0 --- /dev/null +++ b/Task/Loops-Do-while/MIPS-Assembly/loops-do-while.mips @@ -0,0 +1,13 @@ + .text +main: li $s0, 0 # start at 0. + li $s1, 6 +loop: addi $s0, $s0, 1 # add 1 to $s0 + div $s0, $s1 # divide $s0 by $s1. Result is in the multiplication/division registers + mfhi $s3 # copy the remainder from the higher multiplication register to $s3 + move $a0, $s0 # variable must be in $a0 to print + li $v0, 1 # 1 must be in $v0 to tell the assembler to print an integer + syscall # print the integer in $a0 + bnez $s3, loop # if $s3 is not 0, jump to loop + + li $v0, 10 + syscall # syscall to end the program diff --git a/Task/Loops-Do-while/SAS/loops-do-while.sas b/Task/Loops-Do-while/SAS/loops-do-while.sas index 7b62f5ab5e..e718020613 100644 --- a/Task/Loops-Do-while/SAS/loops-do-while.sas +++ b/Task/Loops-Do-while/SAS/loops-do-while.sas @@ -2,7 +2,7 @@ data _null_; n=0; do until(mod(n,6)=0); - n=n+1; - put n; + n+1; + put n; end; run; diff --git a/Task/Loops-Do-while/UNIX-Shell/loops-do-while-3.sh b/Task/Loops-Do-while/UNIX-Shell/loops-do-while-3.sh new file mode 100644 index 0000000000..d9d615e495 --- /dev/null +++ b/Task/Loops-Do-while/UNIX-Shell/loops-do-while-3.sh @@ -0,0 +1,4 @@ +for ((val=1;;val++)) { + print $val + (( val % 6 )) || break +} diff --git a/Task/Loops-Downward-for/00DESCRIPTION b/Task/Loops-Downward-for/00DESCRIPTION index 41861e83c1..e7e122640e 100644 --- a/Task/Loops-Downward-for/00DESCRIPTION +++ b/Task/Loops-Downward-for/00DESCRIPTION @@ -1 +1,3 @@ -Write a for loop which writes a countdown from 10 to 0. +;Task: +Write a   ''for''   loop which writes a countdown from   '''10'''   to   '''0'''. +

    diff --git a/Task/Loops-Downward-for/Io/loops-downward-for.io b/Task/Loops-Downward-for/Io/loops-downward-for.io new file mode 100644 index 0000000000..1a37dea709 --- /dev/null +++ b/Task/Loops-Downward-for/Io/loops-downward-for.io @@ -0,0 +1,3 @@ +for(i,10,0,-1, + i println +) diff --git a/Task/Loops-Downward-for/J/loops-downward-for-2.j b/Task/Loops-Downward-for/J/loops-downward-for-2.j index f92fb4ccd3..b12fb28d1a 100644 --- a/Task/Loops-Downward-for/J/loops-downward-for-2.j +++ b/Task/Loops-Downward-for/J/loops-downward-for-2.j @@ -1 +1 @@ -thru=: <./ + i.@(+*)@-~ +thru=: <. + i.@(+*)@-~ diff --git a/Task/Loops-Downward-for/Objeck/loops-downward-for.objeck b/Task/Loops-Downward-for/Objeck/loops-downward-for.objeck index 07a363bccb..8f85c2e969 100644 --- a/Task/Loops-Downward-for/Objeck/loops-downward-for.objeck +++ b/Task/Loops-Downward-for/Objeck/loops-downward-for.objeck @@ -1,3 +1,3 @@ -for(i := 10; i >= 0; i -= 1;) { +for(i := 10; i >= 0; i--;) { i->PrintLine(); }; diff --git a/Task/Loops-Downward-for/SNOBOL4/loops-downward-for.sno b/Task/Loops-Downward-for/SNOBOL4/loops-downward-for.sno new file mode 100644 index 0000000000..feb90b42fe --- /dev/null +++ b/Task/Loops-Downward-for/SNOBOL4/loops-downward-for.sno @@ -0,0 +1,5 @@ + COUNT = 10 +LOOP OUTPUT = COUNT + COUNT = COUNT - 1 + GE(COUNT, 0) :S(LOOP) +END diff --git a/Task/Loops-Downward-for/Simula/loops-downward-for.simula b/Task/Loops-Downward-for/Simula/loops-downward-for.simula new file mode 100644 index 0000000000..42e4a09d56 --- /dev/null +++ b/Task/Loops-Downward-for/Simula/loops-downward-for.simula @@ -0,0 +1,8 @@ +BEGIN + Integer i; + for i := 10 step -1 until 0 do + BEGIN + OutInt(i, 2); + OutImage + END +END diff --git a/Task/Loops-For-with-a-specified-step/00DESCRIPTION b/Task/Loops-For-with-a-specified-step/00DESCRIPTION index f28f44c47c..9fece5f7c2 100644 --- a/Task/Loops-For-with-a-specified-step/00DESCRIPTION +++ b/Task/Loops-For-with-a-specified-step/00DESCRIPTION @@ -1 +1,2 @@ Demonstrate a for-loop where the step-value is greater than one. +

    diff --git a/Task/Loops-For-with-a-specified-step/360-Assembly/loops-for-with-a-specified-step-1.360 b/Task/Loops-For-with-a-specified-step/360-Assembly/loops-for-with-a-specified-step-1.360 new file mode 100644 index 0000000000..2ec060301e --- /dev/null +++ b/Task/Loops-For-with-a-specified-step/360-Assembly/loops-for-with-a-specified-step-1.360 @@ -0,0 +1,20 @@ +* Loops/For with a specified step 12/08/2015 +LOOPFORS CSECT + USING LOOPFORS,R12 + LR R12,R15 +* == Algol style ================ test at the beginning + LA R3,BUF idx=0 + LA R5,0 from 5 (from-step=0) + LA R6,5 step 5 + LA R7,25 to 25 +LOOPI BXH R5,R6,ELOOPI for i=5 to 25 step 5 + XDECO R5,XDEC edit i + MVC 0(4,R3),XDEC+8 output i + LA R3,4(R3) idx=idx+4 + B LOOPI next i +ELOOPI XPRNT BUF,80 print buffer + BR R14 +BUF DC CL80' ' buffer +XDEC DS CL12 temp for edit + YREGS + END LOOPFORS diff --git a/Task/Loops-For-with-a-specified-step/360-Assembly/loops-for-with-a-specified-step-2.360 b/Task/Loops-For-with-a-specified-step/360-Assembly/loops-for-with-a-specified-step-2.360 new file mode 100644 index 0000000000..3f418cefe7 --- /dev/null +++ b/Task/Loops-For-with-a-specified-step/360-Assembly/loops-for-with-a-specified-step-2.360 @@ -0,0 +1,10 @@ +* == Fortran style ============== test at the end + LA R3,BUF idx=0 + LA R5,5 from 5 + LA R6,5 step 5 + LA R7,25 to 25 +LOOPJ XDECO R5,XDEC for j=5 to 25 step 5; edit j + MVC 0(4,R3),XDEC+8 output j + LA R3,4(R3) idx=idx+4 + BXLE R5,R6,LOOPJ next j + XPRNT BUF,80 print buffer diff --git a/Task/Loops-For-with-a-specified-step/360-Assembly/loops-for-with-a-specified-step-3.360 b/Task/Loops-For-with-a-specified-step/360-Assembly/loops-for-with-a-specified-step-3.360 new file mode 100644 index 0000000000..3b6ec27c1e --- /dev/null +++ b/Task/Loops-For-with-a-specified-step/360-Assembly/loops-for-with-a-specified-step-3.360 @@ -0,0 +1,12 @@ +* == Algol style ================ test at the beginning + LA R3,BUF idx=0 + LA R5,5 from 5 + LA R6,5 step 5 + LA R7,25 to 25 + DO WHILE=(CR,R5,LE,R7) for i=5 to 25 step 5 + XDECO R5,XDEC edit i + MVC 0(4,R3),XDEC+8 output i + LA R3,4(R3) idx=idx+4 + AR R5,R6 i=i+step + ENDDO , next i + XPRNT BUF,80 print buffer diff --git a/Task/Loops-For-with-a-specified-step/360-Assembly/loops-for-with-a-specified-step-4.360 b/Task/Loops-For-with-a-specified-step/360-Assembly/loops-for-with-a-specified-step-4.360 new file mode 100644 index 0000000000..541172017a --- /dev/null +++ b/Task/Loops-For-with-a-specified-step/360-Assembly/loops-for-with-a-specified-step-4.360 @@ -0,0 +1,8 @@ +* == Fortran style ============== test at the end + LA R3,BUF idx=0 + DO FROM=(R5,5),TO=(R7,25),BY=(R6,5) for i=5 to 25 step 5 + XDECO R5,XDEC edit i + MVC 0(4,R3),XDEC+8 output i + LA R3,4(R3) idx=idx+4 + ENDDO , next i + XPRNT BUF,80 print buffer diff --git a/Task/Loops-For-with-a-specified-step/360-Assembly/loops-for-with-a-specified-step.360 b/Task/Loops-For-with-a-specified-step/360-Assembly/loops-for-with-a-specified-step.360 deleted file mode 100644 index 38dd77dfcc..0000000000 --- a/Task/Loops-For-with-a-specified-step/360-Assembly/loops-for-with-a-specified-step.360 +++ /dev/null @@ -1,20 +0,0 @@ -* Loops/For with a specified step 12/08/2015 -LOOPFORS CSECT - USING LOOPFORS,R12 - LR R12,R15 -BEGIN LA R3,MVC - SR R5,R5 index - LA R6,5 step 5 - LA R7,25 to 25 -LOOPI BXH R5,R6,ELOOPI for i=5 to 25 step 5 - XDECO R5,XDEC - MVC 0(4,R3),XDEC+8 - LA R3,4(R3) -NEXTI B LOOPI next i -ELOOPI XPRNT MVC,80 - XR R15,R15 - BR R14 -MVC DC CL80' ' -XDEC DS CL12 - YREGS - END LOOPFORS diff --git a/Task/Loops-For-with-a-specified-step/ALGOL-60/loops-for-with-a-specified-step.alg b/Task/Loops-For-with-a-specified-step/ALGOL-60/loops-for-with-a-specified-step.alg new file mode 100644 index 0000000000..2000a9771b --- /dev/null +++ b/Task/Loops-For-with-a-specified-step/ALGOL-60/loops-for-with-a-specified-step.alg @@ -0,0 +1,2 @@ +FOR i:=5 UNTIL 25 STEP 5 DO + OUTINTEGER(i) diff --git a/Task/Loops-For-with-a-specified-step/BASIC/loops-for-with-a-specified-step-1.basic b/Task/Loops-For-with-a-specified-step/BASIC/loops-for-with-a-specified-step-1.basic index aeb4689ae4..c3e890aede 100644 --- a/Task/Loops-For-with-a-specified-step/BASIC/loops-for-with-a-specified-step-1.basic +++ b/Task/Loops-For-with-a-specified-step/BASIC/loops-for-with-a-specified-step-1.basic @@ -1,4 +1 @@ -for i = 2 to 8 step 2 - print i; ", "; -next i -print "who do we appreciate?" +FOR I = 2 TO 8 STEP 2 : PRINT I; ", "; : NEXT I : PRINT "WHO DO WE APPRECIATE?" diff --git a/Task/Loops-For-with-a-specified-step/BASIC/loops-for-with-a-specified-step-2.basic b/Task/Loops-For-with-a-specified-step/BASIC/loops-for-with-a-specified-step-2.basic index c3e890aede..aeb4689ae4 100644 --- a/Task/Loops-For-with-a-specified-step/BASIC/loops-for-with-a-specified-step-2.basic +++ b/Task/Loops-For-with-a-specified-step/BASIC/loops-for-with-a-specified-step-2.basic @@ -1 +1,4 @@ -FOR I = 2 TO 8 STEP 2 : PRINT I; ", "; : NEXT I : PRINT "WHO DO WE APPRECIATE?" +for i = 2 to 8 step 2 + print i; ", "; +next i +print "who do we appreciate?" diff --git a/Task/Loops-For-with-a-specified-step/Elena/loops-for-with-a-specified-step.elena b/Task/Loops-For-with-a-specified-step/Elena/loops-for-with-a-specified-step.elena new file mode 100644 index 0000000000..537c60560c --- /dev/null +++ b/Task/Loops-For-with-a-specified-step/Elena/loops-for-with-a-specified-step.elena @@ -0,0 +1,10 @@ +#import system. +#import extensions. + +#symbol program = +[ + 2 to:8 &by:2 &doEach:i + [ + console writeLine:i. + ]. +]. diff --git a/Task/Loops-For-with-a-specified-step/Io/loops-for-with-a-specified-step.io b/Task/Loops-For-with-a-specified-step/Io/loops-for-with-a-specified-step.io new file mode 100644 index 0000000000..def1971c95 --- /dev/null +++ b/Task/Loops-For-with-a-specified-step/Io/loops-for-with-a-specified-step.io @@ -0,0 +1,4 @@ +for(i,2,8,2, + write(i,", ") +) +write("who do we appreciate?") diff --git a/Task/Loops-For-with-a-specified-step/R/loops-for-with-a-specified-step.r b/Task/Loops-For-with-a-specified-step/R/loops-for-with-a-specified-step-1.r similarity index 100% rename from Task/Loops-For-with-a-specified-step/R/loops-for-with-a-specified-step.r rename to Task/Loops-For-with-a-specified-step/R/loops-for-with-a-specified-step-1.r diff --git a/Task/Loops-For-with-a-specified-step/R/loops-for-with-a-specified-step-2.r b/Task/Loops-For-with-a-specified-step/R/loops-for-with-a-specified-step-2.r new file mode 100644 index 0000000000..2b8ede36b8 --- /dev/null +++ b/Task/Loops-For-with-a-specified-step/R/loops-for-with-a-specified-step-2.r @@ -0,0 +1 @@ +cat(paste(c(seq(2, 8, by=2), "who do we appreciate?\n"), collapse=", ")) diff --git a/Task/Loops-For-with-a-specified-step/Scheme/loops-for-with-a-specified-step-1.ss b/Task/Loops-For-with-a-specified-step/Scheme/loops-for-with-a-specified-step-1.ss new file mode 100644 index 0000000000..7d0ae474fa --- /dev/null +++ b/Task/Loops-For-with-a-specified-step/Scheme/loops-for-with-a-specified-step-1.ss @@ -0,0 +1,4 @@ +(do ((i 2 (+ i 2))) ; list of variables, initials and steps -- you can iterate over several at once + ((>= i 9)) ; exit condition + (display i) ; body + (newline)) diff --git a/Task/Loops-For-with-a-specified-step/Scheme/loops-for-with-a-specified-step-2.ss b/Task/Loops-For-with-a-specified-step/Scheme/loops-for-with-a-specified-step-2.ss new file mode 100644 index 0000000000..950d80644a --- /dev/null +++ b/Task/Loops-For-with-a-specified-step/Scheme/loops-for-with-a-specified-step-2.ss @@ -0,0 +1,5 @@ +(let loop ((i 2)) ; function name, parameters and starting values + (cond ((< i 9) + (display i) + (newline) + (loop (+ i 2)))))) ; tail-recursive call, won't create a new stack frame diff --git a/Task/Loops-For-with-a-specified-step/Scheme/loops-for-with-a-specified-step.ss b/Task/Loops-For-with-a-specified-step/Scheme/loops-for-with-a-specified-step-3.ss similarity index 100% rename from Task/Loops-For-with-a-specified-step/Scheme/loops-for-with-a-specified-step.ss rename to Task/Loops-For-with-a-specified-step/Scheme/loops-for-with-a-specified-step-3.ss diff --git a/Task/Loops-For-with-a-specified-step/Scheme/loops-for-with-a-specified-step-4.ss b/Task/Loops-For-with-a-specified-step/Scheme/loops-for-with-a-specified-step-4.ss new file mode 100644 index 0000000000..6940922dd9 --- /dev/null +++ b/Task/Loops-For-with-a-specified-step/Scheme/loops-for-with-a-specified-step-4.ss @@ -0,0 +1,11 @@ +(define-syntax for-loop + (syntax-rules () + ((for-loop index start end step body ...) + (let ((evaluated-end end) (evaluated-step step)) + (let loop ((i start)) + (if (< i evaluated-end) + ((lambda (index) body ... (loop (+ i evaluated-step))) i))))))) + +(for-loop i 2 9 2 + (display i) + (newline)) diff --git a/Task/Loops-For-with-a-specified-step/Simula/loops-for-with-a-specified-step.simula b/Task/Loops-For-with-a-specified-step/Simula/loops-for-with-a-specified-step.simula new file mode 100644 index 0000000000..34005681d2 --- /dev/null +++ b/Task/Loops-For-with-a-specified-step/Simula/loops-for-with-a-specified-step.simula @@ -0,0 +1,4 @@ + BEGIN + INTEGER i; + FOR i:=5 UNTIL 25 STEP 5 DO OutInt(i,5) + END diff --git a/Task/Loops-For-with-a-specified-step/UNIX-Shell/loops-for-with-a-specified-step-3.sh b/Task/Loops-For-with-a-specified-step/UNIX-Shell/loops-for-with-a-specified-step-3.sh index 6d8ebc4f80..eb74a33add 100644 --- a/Task/Loops-For-with-a-specified-step/UNIX-Shell/loops-for-with-a-specified-step-3.sh +++ b/Task/Loops-For-with-a-specified-step/UNIX-Shell/loops-for-with-a-specified-step-3.sh @@ -1,3 +1,5 @@ -for (( x=2; $x<=8; x=$x+2 )); do - printf "%d, " $x +x=2 +while [[$x -le 8]]; do + echo $x + ((x=x+2)) done diff --git a/Task/Loops-For-with-a-specified-step/UNIX-Shell/loops-for-with-a-specified-step-4.sh b/Task/Loops-For-with-a-specified-step/UNIX-Shell/loops-for-with-a-specified-step-4.sh index 65675d30fc..682dfc4028 100644 --- a/Task/Loops-For-with-a-specified-step/UNIX-Shell/loops-for-with-a-specified-step-4.sh +++ b/Task/Loops-For-with-a-specified-step/UNIX-Shell/loops-for-with-a-specified-step-4.sh @@ -1,4 +1,5 @@ -for x in {2..8..2} -do - echo $x +x=2 +while ((x<=8)); do + echo $x + ((x+=2)) done diff --git a/Task/Loops-For-with-a-specified-step/UNIX-Shell/loops-for-with-a-specified-step-5.sh b/Task/Loops-For-with-a-specified-step/UNIX-Shell/loops-for-with-a-specified-step-5.sh index 598fa1ee77..6d8ebc4f80 100644 --- a/Task/Loops-For-with-a-specified-step/UNIX-Shell/loops-for-with-a-specified-step-5.sh +++ b/Task/Loops-For-with-a-specified-step/UNIX-Shell/loops-for-with-a-specified-step-5.sh @@ -1,3 +1,3 @@ -foreach x (`jot - 2 8 2`) - echo $x -end +for (( x=2; $x<=8; x=$x+2 )); do + printf "%d, " $x +done diff --git a/Task/Loops-For-with-a-specified-step/UNIX-Shell/loops-for-with-a-specified-step-6.sh b/Task/Loops-For-with-a-specified-step/UNIX-Shell/loops-for-with-a-specified-step-6.sh new file mode 100644 index 0000000000..65675d30fc --- /dev/null +++ b/Task/Loops-For-with-a-specified-step/UNIX-Shell/loops-for-with-a-specified-step-6.sh @@ -0,0 +1,4 @@ +for x in {2..8..2} +do + echo $x +done diff --git a/Task/Loops-For-with-a-specified-step/UNIX-Shell/loops-for-with-a-specified-step-7.sh b/Task/Loops-For-with-a-specified-step/UNIX-Shell/loops-for-with-a-specified-step-7.sh new file mode 100644 index 0000000000..598fa1ee77 --- /dev/null +++ b/Task/Loops-For-with-a-specified-step/UNIX-Shell/loops-for-with-a-specified-step-7.sh @@ -0,0 +1,3 @@ +foreach x (`jot - 2 8 2`) + echo $x +end diff --git a/Task/Loops-For-with-a-specified-step/VBA/loops-for-with-a-specified-step.vba b/Task/Loops-For-with-a-specified-step/VBA/loops-for-with-a-specified-step.vba new file mode 100644 index 0000000000..287e03c4cf --- /dev/null +++ b/Task/Loops-For-with-a-specified-step/VBA/loops-for-with-a-specified-step.vba @@ -0,0 +1,6 @@ +Sub MyLoop() + For i = 2 To 8 Step 2 + Debug.Print i; + Next i + Debug.Print +End Sub diff --git a/Task/Loops-For-with-a-specified-step/VBScript/loops-for-with-a-specified-step.vb b/Task/Loops-For-with-a-specified-step/VBScript/loops-for-with-a-specified-step.vb new file mode 100644 index 0000000000..0edb41994e --- /dev/null +++ b/Task/Loops-For-with-a-specified-step/VBScript/loops-for-with-a-specified-step.vb @@ -0,0 +1,5 @@ + buffer="" + For i = 2 To 8 Step 2 + buffer=buffer & i & " " + Next + wscript.echo buffer diff --git a/Task/Loops-For-with-a-specified-step/Visual-Basic-.NET/loops-for-with-a-specified-step.visual b/Task/Loops-For-with-a-specified-step/Visual-Basic-.NET/loops-for-with-a-specified-step.visual new file mode 100644 index 0000000000..abbba13031 --- /dev/null +++ b/Task/Loops-For-with-a-specified-step/Visual-Basic-.NET/loops-for-with-a-specified-step.visual @@ -0,0 +1,10 @@ +Public Class FormPG + Private Sub FormPG_Load(sender As Object, e As EventArgs) Handles MyBase.Load + Dim i As Integer, buffer As String + buffer = "" + For i = 2 To 8 Step 2 + buffer = buffer & i & " " + Next i + Debug.Print(buffer) + End Sub +End Class diff --git a/Task/Loops-For-with-a-specified-step/Visual-Basic/loops-for-with-a-specified-step.vb b/Task/Loops-For-with-a-specified-step/Visual-Basic/loops-for-with-a-specified-step.vb new file mode 100644 index 0000000000..287e03c4cf --- /dev/null +++ b/Task/Loops-For-with-a-specified-step/Visual-Basic/loops-for-with-a-specified-step.vb @@ -0,0 +1,6 @@ +Sub MyLoop() + For i = 2 To 8 Step 2 + Debug.Print i; + Next i + Debug.Print +End Sub diff --git a/Task/Loops-For/00DESCRIPTION b/Task/Loops-For/00DESCRIPTION index a610234102..8b0ffcc121 100644 --- a/Task/Loops-For/00DESCRIPTION +++ b/Task/Loops-For/00DESCRIPTION @@ -1,12 +1,21 @@ {{omit from|GUISS}} -“For” loops are used to make some block of code be iterated a number of times, setting a variable or parameter to a monotonically increasing integer value for each execution of the block of code. Common extensions of this allow other counting patterns or iterating over abstract structures other than the integers. -For this task, show how two loops may be nested within each other, with the number of iterations performed by the inner for loop being controlled by the outer for loop. Specifically print out the following pattern by using one for loop nested in another: +“'''For'''”   loops are used to make some block of code be iterated a number of times, setting a variable or parameter to a monotonically increasing integer value for each execution of the block of code. + +Common extensions of this allow other counting patterns or iterating over abstract structures other than the integers. + + +;Task: +Show how two loops may be nested within each other, with the number of iterations performed by the inner for loop being controlled by the outer for loop. + +Specifically print out the following pattern by using one for loop nested in another:
    *
     **
     ***
     ****
     *****
    + ;Reference: * [[wp:For loop|For loop]] Wikipedia. +

    diff --git a/Task/Loops-For/360-Assembly/loops-for-1.360 b/Task/Loops-For/360-Assembly/loops-for-1.360 new file mode 100644 index 0000000000..6c15d25492 --- /dev/null +++ b/Task/Loops-For/360-Assembly/loops-for-1.360 @@ -0,0 +1,22 @@ +* Loops/For - BXH Algol 27/07/2015 +LOOPFOR CSECT + USING LOOPFORC,R12 + LR R12,R15 set base register +BEGIN LA R2,0 from 1 (from-step=0) + LA R4,1 step 1 + LA R5,5 to 5 +LOOPI BXH R2,R4,ELOOPI for i=1 to 5 (R2=i) + LA R8,BUFFER-1 ipx=-1 + LA R3,0 from 1 (from-step=0) + LA R6,1 step 1 + LR R7,R2 to i +LOOPJ BXH R3,R6,ELOOPJ for j:=1 to i (R3=j) + LA R8,1(R8) ipx=ipx+1 + MVI 0(R8),C'*' buffer(ipx)='*' + B LOOPJ next j +ELOOPJ XPRNT BUFFER,L'BUFFER print buffer + B LOOPI next i +ELOOPI BR R14 return to caller +BUFFER DC CL80' ' buffer + YREGS + END LOOPFOR diff --git a/Task/Loops-For/360-Assembly/loops-for-2.360 b/Task/Loops-For/360-Assembly/loops-for-2.360 new file mode 100644 index 0000000000..b34af7f33d --- /dev/null +++ b/Task/Loops-For/360-Assembly/loops-for-2.360 @@ -0,0 +1,20 @@ +* Loops/For - struct 29/06/2016 +LOOPFOR CSECT + USING LOOPFORC,R12 + LR R12,R15 set base register + LA R2,1 from 1 + DO WHILE=(CH,R2,LE,=H'5') for i=1 to 5 (R2=i) + LA R8,BUFFER-1 ipx=-1 + LA R3,1 from 1 + DO WHILE=(CR,R3,LE,R2) for j:=1 to i (R3=j) + LA R8,1(R8) ipx=ipx+1 + MVI 0(R8),C'*' buffer(ipx)='*' + LA R3,1(R3) j=j+1 (step) + ENDDO , next j + XPRNT BUFFER,L'BUFFER print buffer + LA R2,1(R2) i=i+1 (step) + ENDDO , next i + BR R14 return to caller +BUFFER DC CL80' ' buffer + YREGS + END LOOPFOR diff --git a/Task/Loops-For/360-Assembly/loops-for.360 b/Task/Loops-For/360-Assembly/loops-for.360 deleted file mode 100644 index 295c7eecf4..0000000000 --- a/Task/Loops-For/360-Assembly/loops-for.360 +++ /dev/null @@ -1,23 +0,0 @@ -LOOPFORC CSECT - USING LOOPFORC,R12 - LR R12,R15 set base register -BEGIN SR R2,R2 from 1 - LA R4,1 by 1 - LA R5,5 to 5 -LOOPI BXH R2,R4,ELOOPI i (R2) - LA R8,BUFFER-1 - SR R3,R3 from 1 - LA R6,1 by 1 - LR R7,R2 to i -LOOPJ BXH R3,R6,ELOOPJ j (R3) - LA R8,1(R8) - MVI 0(R8),C'*' - B LOOPJ -ELOOPJ XPRNT BUFFER,L'BUFFER - B LOOPI -ELOOPI EQU * -RETURN XR R15,R15 set return code - BR R14 return to caller -BUFFER DC CL80' ' - YREGS - END LOOPFORC diff --git a/Task/Loops-For/BASIC/loops-for-10.basic b/Task/Loops-For/BASIC/loops-for-10.basic index 5ceebe6ca5..4274287f65 100644 --- a/Task/Loops-For/BASIC/loops-for-10.basic +++ b/Task/Loops-For/BASIC/loops-for-10.basic @@ -1,6 +1,11 @@ -FOR i = 1 TO 5 - FOR j = 1 TO i - PRINT "*"; - NEXT j - PRINT -NEXT i +If OpenConsole() + Define i, j + For i=1 To 5 + For j=1 To i + Print("*") + Next j + PrintN("") + Next i + Print(#LFCR$+"Press ENTER to quit"): Input() + CloseConsole() +EndIf diff --git a/Task/Loops-For/BASIC/loops-for-11.basic b/Task/Loops-For/BASIC/loops-for-11.basic index 92571e13cc..5ceebe6ca5 100644 --- a/Task/Loops-For/BASIC/loops-for-11.basic +++ b/Task/Loops-For/BASIC/loops-for-11.basic @@ -1,7 +1,6 @@ -Public OutConsole As Scripting.TextStream -For i = 0 To 4 - For j = 0 To i - OutConsole.Write "*" - Next j - OutConsole.WriteLine -Next i +FOR i = 1 TO 5 + FOR j = 1 TO i + PRINT "*"; + NEXT j + PRINT +NEXT i diff --git a/Task/Loops-For/BASIC/loops-for-12.basic b/Task/Loops-For/BASIC/loops-for-12.basic index a38aab1aa9..92571e13cc 100644 --- a/Task/Loops-For/BASIC/loops-for-12.basic +++ b/Task/Loops-For/BASIC/loops-for-12.basic @@ -1,6 +1,7 @@ -For x As Integer = 0 To 4 - For y As Integer = 0 To x - Console.Write("*") - Next - Console.WriteLine() -Next +Public OutConsole As Scripting.TextStream +For i = 0 To 4 + For j = 0 To i + OutConsole.Write "*" + Next j + OutConsole.WriteLine +Next i diff --git a/Task/Loops-For/BASIC/loops-for-13.basic b/Task/Loops-For/BASIC/loops-for-13.basic index f47f2192b5..a38aab1aa9 100644 --- a/Task/Loops-For/BASIC/loops-for-13.basic +++ b/Task/Loops-For/BASIC/loops-for-13.basic @@ -1,6 +1,6 @@ -10 FOR i = 1 TO 5 -20 FOR j = 1 TO i -30 PRINT "*"; -40 NEXT j -50 PRINT -60 NEXT i +For x As Integer = 0 To 4 + For y As Integer = 0 To x + Console.Write("*") + Next + Console.WriteLine() +Next diff --git a/Task/Loops-For/BASIC/loops-for-7.basic b/Task/Loops-For/BASIC/loops-for-7.basic index d3ebfb48cb..140c1f6d51 100644 --- a/Task/Loops-For/BASIC/loops-for-7.basic +++ b/Task/Loops-For/BASIC/loops-for-7.basic @@ -1,19 +1,7 @@ -OPENCONSOLE - -FOR X=1 TO 5 - - FOR Y=1 TO X - - LOCATE X,Y:PRINT"*" - - NEXT Y - -NEXT X - -PRINT - -CLOSECONSOLE - +FOR n = 1 to 5 CYCLE + FOR k = 1 to n CYCLE + print "*"; + REPEAT + PRINT +REPEAT END - -'Could also have been written the same way as the Creative Basic example, with no LOCATE command. diff --git a/Task/Loops-For/BASIC/loops-for-8.basic b/Task/Loops-For/BASIC/loops-for-8.basic index e4a28dceba..d3ebfb48cb 100644 --- a/Task/Loops-For/BASIC/loops-for-8.basic +++ b/Task/Loops-For/BASIC/loops-for-8.basic @@ -1,6 +1,19 @@ -for i = 1 to 5 - for j = 1 to i - print "*"; - next - print -next +OPENCONSOLE + +FOR X=1 TO 5 + + FOR Y=1 TO X + + LOCATE X,Y:PRINT"*" + + NEXT Y + +NEXT X + +PRINT + +CLOSECONSOLE + +END + +'Could also have been written the same way as the Creative Basic example, with no LOCATE command. diff --git a/Task/Loops-For/BASIC/loops-for-9.basic b/Task/Loops-For/BASIC/loops-for-9.basic index 4274287f65..e4a28dceba 100644 --- a/Task/Loops-For/BASIC/loops-for-9.basic +++ b/Task/Loops-For/BASIC/loops-for-9.basic @@ -1,11 +1,6 @@ -If OpenConsole() - Define i, j - For i=1 To 5 - For j=1 To i - Print("*") - Next j - PrintN("") - Next i - Print(#LFCR$+"Press ENTER to quit"): Input() - CloseConsole() -EndIf +for i = 1 to 5 + for j = 1 to i + print "*"; + next + print +next diff --git a/Task/Loops-For/Elena/loops-for.elena b/Task/Loops-For/Elena/loops-for.elena new file mode 100644 index 0000000000..9595a6ab51 --- /dev/null +++ b/Task/Loops-For/Elena/loops-for.elena @@ -0,0 +1,13 @@ +#import system. +#import extensions. + +#symbol program = +[ + 0 till:5 &doEach:i + [ + 0 to:i &doEach:j + [ console write:"*". ]. + + console writeLine. + ]. +]. diff --git a/Task/Loops-For/Elixir/loops-for.elixir b/Task/Loops-For/Elixir/loops-for-1.elixir similarity index 100% rename from Task/Loops-For/Elixir/loops-for.elixir rename to Task/Loops-For/Elixir/loops-for-1.elixir diff --git a/Task/Loops-For/Elixir/loops-for-2.elixir b/Task/Loops-For/Elixir/loops-for-2.elixir new file mode 100644 index 0000000000..f55d97b8c8 --- /dev/null +++ b/Task/Loops-For/Elixir/loops-for-2.elixir @@ -0,0 +1 @@ +for i <- 1..5, do: IO.puts (for j <- 1..i, do: "*") diff --git a/Task/Loops-For/Kotlin/loops-for.kotlin b/Task/Loops-For/Kotlin/loops-for.kotlin new file mode 100644 index 0000000000..c8a0f1e1da --- /dev/null +++ b/Task/Loops-For/Kotlin/loops-for.kotlin @@ -0,0 +1,6 @@ +fun main(args: Array) { + (1..5).forEach { + (1..it).forEach { print('*') } + println() + } +} diff --git a/Task/Loops-For/Onyx/loops-for.onyx b/Task/Loops-For/Onyx/loops-for.onyx new file mode 100644 index 0000000000..cdbb0302be --- /dev/null +++ b/Task/Loops-For/Onyx/loops-for.onyx @@ -0,0 +1 @@ +1 1 5 {dup {`*'} repeat bdup bpop ncat `\n' cat print} for flush diff --git a/Task/Loops-For/REXX/loops-for-1.rexx b/Task/Loops-For/REXX/loops-for-1.rexx index 661dbc0185..930b67364e 100644 --- a/Task/Loops-For/REXX/loops-for-1.rexx +++ b/Task/Loops-For/REXX/loops-for-1.rexx @@ -1,7 +1,10 @@ - do i=1 to 5 - s='' - do j=1 to i - s=s || '*' - end - say s - end +/*REXX program demonstrates an outer DO loop controlling the inner DO loop with a "FOR".*/ + + do j=1 for 5 /*this is the same as: do j=1 to 5 */ + $= /*initialize the value to a null string*/ + do k=1 for j /*only loop for a J number of times*/ + $=$ || '*' /*using concatenation (||) for build.*/ + end /*k*/ + say $ /*display character string being built.*/ + end /*j*/ + /*stick a fork in it, we're all done. */ diff --git a/Task/Loops-For/REXX/loops-for-2.rexx b/Task/Loops-For/REXX/loops-for-2.rexx index 1a391e6743..588f539e01 100644 --- a/Task/Loops-For/REXX/loops-for-2.rexx +++ b/Task/Loops-For/REXX/loops-for-2.rexx @@ -1,7 +1,10 @@ - do i=1 for 5 - s='' - do i - s=s'*' - end - say s - end +/*REXX program demonstrates an outer DO loop controlling the inner DO loop with a "FOR".*/ + + do j=1 for 5 /*this is the same as: do j=1 to 5 */ + $= /*initialize the value to a null string*/ + do k=1 for j /*only loop for a J number of times*/ + $=$'*' /*using abutment for the construction. */ + end /*k*/ + say $ /*display character string being built.*/ + end /*j*/ + /*stick a fork in it, we're all done. */ diff --git a/Task/Loops-For/SAS/loops-for.sas b/Task/Loops-For/SAS/loops-for.sas index d9717ddbb7..d543623ad8 100644 --- a/Task/Loops-For/SAS/loops-for.sas +++ b/Task/Loops-For/SAS/loops-for.sas @@ -8,3 +8,14 @@ do n=1 to 5; put a; end; run; + +/* Possible without the inner loop. Notice TRIM is replaced with STRIP, +otherwise there is a blank space on the left */ + +data _null_; +length a $5; +do n=1 to 5; + a=strip(a) !! "*"; + put a; +end; +run; diff --git a/Task/Loops-For/SETL/loops-for.setl b/Task/Loops-For/SETL/loops-for.setl new file mode 100644 index 0000000000..4ae1f67dd4 --- /dev/null +++ b/Task/Loops-For/SETL/loops-for.setl @@ -0,0 +1,6 @@ +for i in {1..5} loop + for j in {1..i} loop + nprint( '*' ); + end loop; + print; -- new line +end loop; diff --git a/Task/Loops-For/VBA/loops-for.vba b/Task/Loops-For/VBA/loops-for.vba new file mode 100644 index 0000000000..9ff14475bd --- /dev/null +++ b/Task/Loops-For/VBA/loops-for.vba @@ -0,0 +1,11 @@ +Option Explicit +Sub LoopEx() + Dim i As Long, j As Long, s As String + For i = 1 To 5 + s = "" + For j = 1 To i + s = s + "*" + Next + Debug.Print s + Next +End Sub diff --git a/Task/Loops-For/VBScript/loops-for.vb b/Task/Loops-For/VBScript/loops-for.vb new file mode 100644 index 0000000000..8e33660368 --- /dev/null +++ b/Task/Loops-For/VBScript/loops-for.vb @@ -0,0 +1,9 @@ +Option Explicit +Dim i, j, s +For i = 1 To 5 + s = "" + For j = 1 To i + s = s + "*" + Next + WScript.Echo s +Next diff --git a/Task/Loops-For/Vala/loops-for.vala b/Task/Loops-For/Vala/loops-for.vala new file mode 100644 index 0000000000..42fd2cd456 --- /dev/null +++ b/Task/Loops-For/Vala/loops-for.vala @@ -0,0 +1,9 @@ +int main (string[] args) { + for (var i = 1; i <= 5; i++) { + for (var j = 1; j <= i; j++) { + stdout.putc ('*'); + } + stdout.putc ('\n'); + } + return 0; +} diff --git a/Task/Loops-Foreach/00DESCRIPTION b/Task/Loops-Foreach/00DESCRIPTION index 9d74eb5b50..a7821a45cf 100644 --- a/Task/Loops-Foreach/00DESCRIPTION +++ b/Task/Loops-Foreach/00DESCRIPTION @@ -1 +1,4 @@ -Loop through and print each element in a collection in order. Use your language's "for each" loop if it has one, otherwise iterate through the collection in order with some other loop. +Loop through and print each element in a collection in order. + +Use your language's "for each" loop if it has one, otherwise iterate through the collection in order with some other loop. +

    diff --git a/Task/Loops-Foreach/Elena/loops-foreach.elena b/Task/Loops-Foreach/Elena/loops-foreach.elena new file mode 100644 index 0000000000..ff7f588427 --- /dev/null +++ b/Task/Loops-Foreach/Elena/loops-foreach.elena @@ -0,0 +1,10 @@ +#import system. +#import system'routines. +#import extensions'routines. + +#symbol program = +[ + #var things := ("Apple", "Banana", "Coconut"). + + things run &each:printingLn. +]. diff --git a/Task/Loops-Foreach/PowerShell/loops-foreach.psh b/Task/Loops-Foreach/PowerShell/loops-foreach.psh index 8088c7cb49..3da2a844bf 100644 --- a/Task/Loops-Foreach/PowerShell/loops-foreach.psh +++ b/Task/Loops-Foreach/PowerShell/loops-foreach.psh @@ -1,3 +1,7 @@ -foreach ($x in $collection) { - Write-Host $x +$colors = "Black","Blue","Cyan","Gray","Green","Magenta","Red","White","Yellow", + "DarkBlue","DarkCyan","DarkGray","DarkGreen","DarkMagenta","DarkRed","DarkYellow" + +foreach ($color in $colors) +{ + Write-Host "$color" -ForegroundColor $color } diff --git a/Task/Loops-Infinite/00DESCRIPTION b/Task/Loops-Infinite/00DESCRIPTION index 3da81f59cd..9b3cf917d2 100644 --- a/Task/Loops-Infinite/00DESCRIPTION +++ b/Task/Loops-Infinite/00DESCRIPTION @@ -1 +1,3 @@ -Specifically print out "SPAM" followed by a newline in an infinite loop. +;Task: +Print out       '''SPAM'''       followed by a   ''newline''   in an infinite loop. +

    diff --git a/Task/Loops-Infinite/Elena/loops-infinite.elena b/Task/Loops-Infinite/Elena/loops-infinite.elena new file mode 100644 index 0000000000..8974c26c17 --- /dev/null +++ b/Task/Loops-Infinite/Elena/loops-infinite.elena @@ -0,0 +1,9 @@ +#import system. + +#symbol program = +[ + #loop true? + [ + console writeLine:"span". + ]. +]. diff --git a/Task/Loops-Infinite/JavaScript/loops-infinite-1.js b/Task/Loops-Infinite/JavaScript/loops-infinite-1.js index 41d072760b..91818d42a7 100644 --- a/Task/Loops-Infinite/JavaScript/loops-infinite-1.js +++ b/Task/Loops-Infinite/JavaScript/loops-infinite-1.js @@ -1 +1 @@ -for (;;) print("SPAM"); +for (;;) console.log("SPAM"); diff --git a/Task/Loops-Infinite/JavaScript/loops-infinite-2.js b/Task/Loops-Infinite/JavaScript/loops-infinite-2.js index 6655dd9096..7ce6c0916c 100644 --- a/Task/Loops-Infinite/JavaScript/loops-infinite-2.js +++ b/Task/Loops-Infinite/JavaScript/loops-infinite-2.js @@ -1 +1 @@ -while (true) print("SPAM"); +while (true) console.log("SPAM"); diff --git a/Task/Loops-Infinite/S-lang/loops-infinite.slang b/Task/Loops-Infinite/S-lang/loops-infinite.slang new file mode 100644 index 0000000000..7d99556d20 --- /dev/null +++ b/Task/Loops-Infinite/S-lang/loops-infinite.slang @@ -0,0 +1 @@ +forever print("SPAM"); diff --git a/Task/Loops-N-plus-one-half/00DESCRIPTION b/Task/Loops-N-plus-one-half/00DESCRIPTION index f07a044dfb..7f17c8b675 100644 --- a/Task/Loops-N-plus-one-half/00DESCRIPTION +++ b/Task/Loops-N-plus-one-half/00DESCRIPTION @@ -1,10 +1,17 @@ -Quite often one needs loops which, in the last iteration, -execute only part of the loop body. pas -The goal of this task is to demonstrate the best way to do this. +Quite often one needs loops which, in the last iteration, execute only part of the loop body. + +;Goal: +Demonstrate the best way to do this. + + +;Task: Write a loop which writes the comma-separated list 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 using separate output statements for the number and the comma from within the body of the loop. -See also: [[Loop/Break]] + +;Related task: +*   [[Loop/Break]] +

    diff --git a/Task/Loops-N-plus-one-half/REXX/loops-n-plus-one-half-1.rexx b/Task/Loops-N-plus-one-half/REXX/loops-n-plus-one-half-1.rexx index 37bb3f2308..972a399c13 100644 --- a/Task/Loops-N-plus-one-half/REXX/loops-n-plus-one-half-1.rexx +++ b/Task/Loops-N-plus-one-half/REXX/loops-n-plus-one-half-1.rexx @@ -1,7 +1,7 @@ -/*REXX program to display: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 */ +/*REXX program displays: 1,2,3,4,5,6,7,8,9,10 */ - do j=1 to 10 - call charout ,j /*write the DO loop index (no LF)*/ - if j<10 then call charout ,", " /*append a comma for 1-digit nums*/ - end /*j*/ - /*stick a fork in it, we're done.*/ + do j=1 to 10 + call charout ,j /*write the DO loop index (no LF). */ + if j<10 then call charout ,"," /*append a comma for one-digit numbers.*/ + end /*j*/ + /*stick a fork in it, we're all done. */ diff --git a/Task/Loops-N-plus-one-half/REXX/loops-n-plus-one-half-2.rexx b/Task/Loops-N-plus-one-half/REXX/loops-n-plus-one-half-2.rexx index 6ceeb39fab..32ce7f15f9 100644 --- a/Task/Loops-N-plus-one-half/REXX/loops-n-plus-one-half-2.rexx +++ b/Task/Loops-N-plus-one-half/REXX/loops-n-plus-one-half-2.rexx @@ -1,6 +1,6 @@ -/*REXX program to display: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 */ +/*REXX program displays: 1,2,3,4,5,6,7,8,9,10 */ - do j=1 for 10 /*using FOR is faster than TO.*/ - call charout ,j ||copies(', ',j<10) /*show J, maybe append a comma.*/ - end /*j*/ - /*stick a fork in it, we're done.*/ + do j=1 for 10 /*using FOR is faster than TO. */ + call charout ,j || left(',',j<10) /*display J, maybe append a comma (,).*/ + end /*j*/ + /*stick a fork in it, we're all done. */ diff --git a/Task/Loops-N-plus-one-half/S-lang/loops-n-plus-one-half.slang b/Task/Loops-N-plus-one-half/S-lang/loops-n-plus-one-half.slang new file mode 100644 index 0000000000..cc61994c6d --- /dev/null +++ b/Task/Loops-N-plus-one-half/S-lang/loops-n-plus-one-half.slang @@ -0,0 +1,6 @@ +variable more = 0, i; +foreach i ([1:10]) { + if (more) () = printf(", "); + printf("%d", i); + more = 1; +} diff --git a/Task/Loops-Nested/00DESCRIPTION b/Task/Loops-Nested/00DESCRIPTION index 9441448c62..3f91e09e08 100644 --- a/Task/Loops-Nested/00DESCRIPTION +++ b/Task/Loops-Nested/00DESCRIPTION @@ -1,3 +1,6 @@ Show a nested loop which searches a two-dimensional array filled with random numbers uniformly distributed over [1,\ldots,20]. + The loops iterate rows and columns of the array printing the elements until the value 20 is met. + Specifically, this task also shows how to [[Loop/Break|break]] out of nested loops. +

    diff --git a/Task/Loops-Nested/C++/loops-nested.cpp b/Task/Loops-Nested/C++/loops-nested-1.cpp similarity index 100% rename from Task/Loops-Nested/C++/loops-nested.cpp rename to Task/Loops-Nested/C++/loops-nested-1.cpp diff --git a/Task/Loops-Nested/C++/loops-nested-2.cpp b/Task/Loops-Nested/C++/loops-nested-2.cpp new file mode 100644 index 0000000000..26b7ce59e4 --- /dev/null +++ b/Task/Loops-Nested/C++/loops-nested-2.cpp @@ -0,0 +1,24 @@ +#include +#include +#include + +using namespace std; +int main() +{ + int arr[10][10]; + srand(time(NULL)); + for(auto& row: arr) + for(auto& col: row) + col = rand() % 20 + 1; + + for(auto& row : arr) { + for(auto& col: row) { + cout << ' ' << col; + if (col == 20) goto out; + } + cout << endl; + } + out: + + return 0; +} diff --git a/Task/Loops-Nested/Elixir/loops-nested.elixir b/Task/Loops-Nested/Elixir/loops-nested-1.elixir similarity index 92% rename from Task/Loops-Nested/Elixir/loops-nested.elixir rename to Task/Loops-Nested/Elixir/loops-nested-1.elixir index fe2c0e9c93..15d32d345d 100644 --- a/Task/Loops-Nested/Elixir/loops-nested.elixir +++ b/Task/Loops-Nested/Elixir/loops-nested-1.elixir @@ -1,6 +1,5 @@ defmodule Loops do def nested do - :random.seed(:os.timestamp) list = Enum.shuffle(1..20) |> Enum.chunk(5) IO.inspect list, char_lists: :as_lists try do diff --git a/Task/Loops-Nested/Elixir/loops-nested-2.elixir b/Task/Loops-Nested/Elixir/loops-nested-2.elixir new file mode 100644 index 0000000000..8f2c4b7b4c --- /dev/null +++ b/Task/Loops-Nested/Elixir/loops-nested-2.elixir @@ -0,0 +1,10 @@ +list = Enum.shuffle(1..20) |> Enum.chunk(5) +IO.inspect list, char_lists: :as_lists +Enum.any?(list, fn row -> + IO.puts "" + Enum.any?(row, fn x -> + IO.write "#{x} " + x == 20 + end) +end) +IO.puts "done" diff --git a/Task/Loops-Nested/Kotlin/loops-nested.kotlin b/Task/Loops-Nested/Kotlin/loops-nested.kotlin new file mode 100644 index 0000000000..b03b167c02 --- /dev/null +++ b/Task/Loops-Nested/Kotlin/loops-nested.kotlin @@ -0,0 +1,19 @@ +import java.util.Random + +fun main(args: Array) { + val r = Random() + val a = Array(10) { IntArray(10) { r.nextInt(20) + 1 } } + println("array:") + for (i in a.indices) println("row $i: " + a[i].asList()) + + println("search:") + Outer@ for (i in a.indices) { + print("row $i: ") + for (j in a[i].indices) { + print(" " + a[i][j]) + if (a[i][j] == 20) break@Outer + } + println() + } + println() +} diff --git a/Task/Loops-Nested/REXX/loops-nested.rexx b/Task/Loops-Nested/REXX/loops-nested.rexx index 2ebb3f87c1..6a1fd83129 100644 --- a/Task/Loops-Nested/REXX/loops-nested.rexx +++ b/Task/Loops-Nested/REXX/loops-nested.rexx @@ -1,22 +1,22 @@ -/*REXX program loops through a 2-dimensional array to look for a '20'. */ -parse arg rows cols targ . /*obtain optional args from C.L. */ -if rows=='' | rows==',' then rows=60 /*Rows not specified? Use default*/ -if cols=='' | cols==',' then cols=10 /*Cols " " " " */ -if targ=='' | targ==',' then targ=20 /*Targ " " " " */ -w=max(length(rows),length(cols),length(targ)) /*for formatting output.*/ -not='not' /* [↓] construct the 2-dim array.*/ - do row=1 for rows /*1st dimension of the array. */ - do col=1 for cols /*2nd " " " " */ - @.row.col=random(1,targ) /*generate some random numbers. */ +/*REXX program loops through a two-dimensional array to search for a '20' (twenty). */ +parse arg rows cols targ . /*obtain optional arguments from the CL*/ +if rows=='' | rows=="," then rows=60 /*Rows not specified? Then use default*/ +if cols=='' | cols=="," then cols=10 /*Cols " " " " " */ +if targ=='' | targ=="," then targ=20 /*Targ " " " " " */ +w=max(length(rows), length(cols), length(targ)) /*W: used for formatting the output. */ +not= 'not' /* [↓] construct the 2─dimension array*/ + do row=1 for rows /*ROW is the 1st dimension of array. */ + do col=1 for cols /*COL " " 2nd " " " */ + @.row.col=random(1, targ) /*create some positive random integers.*/ end /*row*/ end /*col*/ -/*═════════════════════════════════════now, search for the target {20}.*/ - do r=1 for rows + + do r=1 for rows /* ◄───────────────── now, search for the target {20}.*/ do c=1 for cols - say left('@.'r"."c,3+w+w) '=' right(@.r.c,w) /*display.*/ - if @.r.c==targ then do; not=; leave r; end /*found ? */ + say left('@.'r"."c, 3+w+w) '=' right(@.r.c, w) /*show an array element.*/ + if @.r.c==targ then do; not=; leave r; end /*found the targ number?*/ end /*c*/ end /*r*/ -say right(space('Target' not 'found:') targ, 33, '─') - /*stick a fork in it, we're done.*/ +say right( space( 'Target' not "found:" ) targ, 33, '─') + /*stick a fork in it, we're all done. */ diff --git a/Task/Loops-Nested/Ruby/loops-nested-2.rb b/Task/Loops-Nested/Ruby/loops-nested-2.rb index f62835297d..9d336da538 100644 --- a/Task/Loops-Nested/Ruby/loops-nested-2.rb +++ b/Task/Loops-Nested/Ruby/loops-nested-2.rb @@ -1,8 +1,10 @@ -slices = (1..20).to_a.shuffle.each_slice(4) +p slices = [*1..20].shuffle.each_slice(4) slices.any? do |slice| + puts slice.any? do |element| - puts element + print "#{element} " element == 20 end end +puts "done" diff --git a/Task/Loops-While/00DESCRIPTION b/Task/Loops-While/00DESCRIPTION index f828d8be82..b60a826415 100644 --- a/Task/Loops-While/00DESCRIPTION +++ b/Task/Loops-While/00DESCRIPTION @@ -1,3 +1,9 @@ {{omit from|GUISS|No loops and we cannot read values}} -Start an integer value at 1024. Loop while it is greater than 0. + +;Task: +Start an integer value at   '''1024'''. + +Loop while it is greater than zero. + Print the value (with a newline) and divide it by two each time through the loop. +

    diff --git a/Task/Loops-While/360-Assembly/loops-while-1.360 b/Task/Loops-While/360-Assembly/loops-while-1.360 new file mode 100644 index 0000000000..cddeb1ecba --- /dev/null +++ b/Task/Loops-While/360-Assembly/loops-while-1.360 @@ -0,0 +1,19 @@ +* While 27/06/2016 +WHILELOO CSECT program's control section + USING WHILELOO,12 set base register + LR 12,15 load base register + LA 6,1024 v=1024 +LOOP LTR 6,6 while v>0 + BNP ENDLOOP . + CVD 6,PACKED convert v to packed decimal + OI PACKED+7,X'0F' prepare unpack + UNPK WTOTXT,PACKED packed decimal to zoned printable + WTO MF=(E,WTOMSG) display v + SRA 6,1 v=v/2 by right shift + B LOOP end while +ENDLOOP BR 14 return to caller +PACKED DS PL8 packed decimal +WTOMSG DS 0F full word alignment for wto +WTOLEN DC AL2(8),H'0' length of wto buffer (4+1) +WTOTXT DC CL4' ' wto text + END WHILELOO diff --git a/Task/Loops-While/360-Assembly/loops-while-2.360 b/Task/Loops-While/360-Assembly/loops-while-2.360 new file mode 100644 index 0000000000..b84a73a8dd --- /dev/null +++ b/Task/Loops-While/360-Assembly/loops-while-2.360 @@ -0,0 +1,18 @@ +* While 27/06/2016 +WHILELOO CSECT + USING WHILELOO,12 set base register + LR 12,15 load base register + LA 6,1024 v=1024 + DO WHILE=(LTR,6,P,6) do while v>0 + CVD 6,PACKED convert v to packed decimal + OI PACKED+7,X'0F' prepare unpack + UNPK WTOTXT,PACKED packed decimal to zoned printable + WTO MF=(E,WTOMSG) display + SRA 6,1 v=v/2 by right shift + ENDDO , end while + BR 14 return to caller +PACKED DS PL8 packed decimal +WTOMSG DS 0F full word alignment for wto +WTOLEN DC AL2(8),H'0' length of wto buffer (4+1) +WTOTXT DC CL4' ' wto text + END WHILELOO diff --git a/Task/Loops-While/360-Assembly/loops-while.360 b/Task/Loops-While/360-Assembly/loops-while.360 deleted file mode 100644 index e2f83fae8d..0000000000 --- a/Task/Loops-While/360-Assembly/loops-while.360 +++ /dev/null @@ -1,27 +0,0 @@ -WHILE CSECT , This program's control section - BAKR 14,0 Caller's registers to linkage stack - LR 12,15 load entry point address into Reg 12 - LA 13,0 inidicate caller no savearea - USING WHILE,12 tell assembler we use Reg 12 as base - XR 3,3 Register 3 zero. - XR 4,4 clear even divident reg - LA 5,1024 load odd divident reg - LA 9,2 divisor in reg 9 - LA 8,WTOLEN address of WTO area in Reg 8 - MVC WTOTXT,=C'1024' - WTO TEXT=(8) write to operator initial value 1024 -LOOP DS 0H - DR 4,9 divide r4/5 by r9 - CLR 3,4 less than zero? - BL RETURN yes, return - CVD 5,PACKED convert result to (packed) decimal - OI PACKED+7,X'0F' prepare unpack - XC WTOTXT,WTOTXT clear wto text - UNPK WTOTXT,PACKED packed decimal to zoned (printable) - WTO TEXT=(8) and write-to-operator - B LOOP loop. -RETURN PR , return to caller. -WTOLEN DC H'4' fixed WTO length of four -WTOTXT DS CL4 -PACKED DS CL8 - END WHILE diff --git a/Task/Loops-While/Elena/loops-while.elena b/Task/Loops-While/Elena/loops-while.elena new file mode 100644 index 0000000000..59f122f8c7 --- /dev/null +++ b/Task/Loops-While/Elena/loops-while.elena @@ -0,0 +1,12 @@ +#import system. + +#symbol program = +[ + #var(type:int)i := 1024. + #loop (i > 0)? + [ + console writeLine:i. + + i := i / 2. + ]. +]. diff --git a/Task/Loops-While/Racket/loops-while-2.rkt b/Task/Loops-While/Racket/loops-while-2.rkt index d33eed33fe..6bf852ffac 100644 --- a/Task/Loops-While/Racket/loops-while-2.rkt +++ b/Task/Loops-While/Racket/loops-while-2.rkt @@ -5,7 +5,7 @@ body ... (loop)))) -(define n 0) -(while (< n 10) +(define n 1024) +(while (positive? n) (displayln n) - (set! n (add1 n))) + (set! n (sub1 n))) diff --git a/Task/Lucas-Lehmer-test/00DESCRIPTION b/Task/Lucas-Lehmer-test/00DESCRIPTION index 36ab256d4d..36c874b895 100644 --- a/Task/Lucas-Lehmer-test/00DESCRIPTION +++ b/Task/Lucas-Lehmer-test/00DESCRIPTION @@ -1,4 +1,7 @@ Lucas-Lehmer Test: for p an odd prime, the Mersenne number 2^p-1 is prime if and only if 2^p-1 divides S(p-1) where S(n+1)=(S(n))^2-2, and S(1)=4. -The following programs calculate all Mersenne primes up to the implementation's -maximum precision, or the 47th Mersenne prime. (Which ever comes first). + +;Task: +Calculate all Mersenne primes up to the implementation's +maximum precision, or the 47th Mersenne prime   (whichever comes first). +

    diff --git a/Task/Lucas-Lehmer-test/PowerShell/lucas-lehmer-test-1.psh b/Task/Lucas-Lehmer-test/PowerShell/lucas-lehmer-test-1.psh new file mode 100644 index 0000000000..aee2fce968 --- /dev/null +++ b/Task/Lucas-Lehmer-test/PowerShell/lucas-lehmer-test-1.psh @@ -0,0 +1,28 @@ +function Get-MersennePrime ([bigint]$Maximum = 4800) +{ + [bigint]$n = [bigint]::One + + for ($exp = 2; $exp -lt $Maximum; $exp++) + { + if ($exp -eq 2) + { + $s = 0 + } + else + { + $s = 4 + } + + $n = ($n + 1) * 2 - 1 + + for ($i = 1; $i -le $exp - 2; $i++) + { + $s = ($s * $s - 2) % $n + } + + if ($s -eq 0) + { + $exp + } + } +} diff --git a/Task/Lucas-Lehmer-test/PowerShell/lucas-lehmer-test-2.psh b/Task/Lucas-Lehmer-test/PowerShell/lucas-lehmer-test-2.psh new file mode 100644 index 0000000000..96ef6cfae8 --- /dev/null +++ b/Task/Lucas-Lehmer-test/PowerShell/lucas-lehmer-test-2.psh @@ -0,0 +1 @@ +Get-MersennePrime | Format-Wide {"{0,4}" -f $_} -Column 4 -Force diff --git a/Task/Ludic-numbers/00DESCRIPTION b/Task/Ludic-numbers/00DESCRIPTION index b96738bfb1..d8915c5dd9 100644 --- a/Task/Ludic-numbers/00DESCRIPTION +++ b/Task/Ludic-numbers/00DESCRIPTION @@ -1,29 +1,39 @@ -[https://oeis.org/wiki/Ludic_numbers Ludic numbers] are related to prime numbers as they are generated by a sieve quite like the [[Sieve of Eratosthenes]] is used to generate prime numbers. +[https://oeis.org/wiki/Ludic_numbers Ludic numbers]   are related to prime numbers as they are generated by a sieve quite like the [[Sieve of Eratosthenes]] is used to generate prime numbers. -The first ludic number is 1. -
    To generate succeeding ludic numbers create an array of increasing integers starting from 2 +The first ludic number is   1. + +To generate succeeding ludic numbers create an array of increasing integers starting from   2. :2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 ... (Loop) -* Take the first member of the resultant array as the next Ludic number 2. -* Remove every '''2'nd''' indexed item from the array (including the first). +* Take the first member of the resultant array as the next ludic number   2. +* Remove every   '''2nd'''   indexed item from the array (including the first). ::2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 ... * (Unrolling a few loops...) -* Take the first member of the resultant array as the next Ludic number 3. -* Remove every '''3'rd''' indexed item from the array (including the first). +* Take the first member of the resultant array as the next ludic number   3. +* Remove every   '''3rd'''   indexed item from the array (including the first). ::3 5 7 9 11 13 15 17 19 21 23 25 27 29 31 33 35 37 39 41 43 45 47 49 51 ... -* Take the first member of the resultant array as the next Ludic number 5. -* Remove every '''5'th''' indexed item from the array (including the first). +* Take the first member of the resultant array as the next ludic number   5. +* Remove every   '''5th'''   indexed item from the array (including the first). ::5 7 11 13 17 19 23 25 29 31 35 37 41 43 47 49 53 55 59 61 65 67 71 73 77 ... -* Take the first member of the resultant array as the next Ludic number 7. -* Remove every '''7'th''' indexed item from the array (including the first). +* Take the first member of the resultant array as the next ludic number   7. +* Remove every   '''7th'''   indexed item from the array (including the first). ::7 11 13 17 23 25 29 31 37 41 43 47 53 55 59 61 67 71 73 77 83 85 89 91 97 ... -* ... -* Take the first member of the current array as the next Ludic number L. -* Remove every '''L'th''' indexed item from the array (including the first). -* ... +* ... +* Take the first member of the current array as the next ludic number   L. +* Remove every   '''Lth'''   indexed item from the array (including the first). +* ... + + ;Task: * Generate and show here the first 25 ludic numbers. * How many ludic numbers are there less than or equal to 1000? -* Show the 2000..2005'th ludic numbers. -* A triplet is any three numbers x, x+2, x+6 where all three numbers are also ludic numbers. Show all triplets of ludic numbers < 250 (Stretch goal) +* Show the 2000..2005th ludic numbers. + + +
    +;Stretch goal: +Show all triplets of ludic numbers < 250. +* A triplet is any three numbers     x,   x+2,   x+6     where all three numbers are also ludic numbers. + +

    diff --git a/Task/Ludic-numbers/360-Assembly/ludic-numbers.360 b/Task/Ludic-numbers/360-Assembly/ludic-numbers.360 new file mode 100644 index 0000000000..0cbdabe3c2 --- /dev/null +++ b/Task/Ludic-numbers/360-Assembly/ludic-numbers.360 @@ -0,0 +1,122 @@ +* Ludic numbers 23/04/2016 +LUDICN CSECT + USING LUDICN,R15 set base register + LH R9,NMAX r9=nmax + SRA R9,1 r9=nmax/2 + LA R6,2 i=2 +LOOPI1 CR R6,R9 do i=2 to nmax/2 + BH ELOOPI1 + LA R1,LUDIC-1(R6) @ludic(i) + CLI 0(R1),X'01' if ludic(i) + BNE ELOOPJ1 + SR R8,R8 n=0 + LA R7,1(R6) j=i+1 +LOOPJ1 CH R7,NMAX do j=i+1 to nmax + BH ELOOPJ1 + LA R1,LUDIC-1(R7) @ludic(j) + CLI 0(R1),X'01' if ludic(j) + BNE NOTJ1 + LA R8,1(R8) n=n+1 +NOTJ1 CR R8,R6 if n=i + BNE NDIFI + LA R1,LUDIC-1(R7) @ludic(j) + MVI 0(R1),X'00' ludic(j)=false + SR R8,R8 n=0 +NDIFI LA R7,1(R7) j=j+1 + B LOOPJ1 +ELOOPJ1 LA R6,1(R6) i=i+1 + B LOOPI1 +ELOOPI1 XPRNT =C'First 25 ludic numbers:',23 + LA R10,BUF @buf=0 + SR R8,R8 n=0 + LA R6,1 i=1 +LOOPI2 CH R6,NMAX do i=1 to nmax + BH ELOOPI2 + LA R1,LUDIC-1(R6) @ludic(i) + CLI 0(R1),X'01' if ludic(i) + BNE NOTI2 + XDECO R6,XDEC i + MVC 0(4,R10),XDEC+8 output i + LA R10,4(R10) @buf=@buf+4 + LA R8,1(R8) n=n+1 + LR R2,R8 n + SRDA R2,32 + D R2,=F'5' r2=mod(n,5) + LTR R2,R2 if mod(n,5)=0 + BNZ NOTI2 + XPRNT BUF,20 + LA R10,BUF @buf=0 +NOTI2 EQU * + CH R8,=H'25' if n=25 + BE ELOOPI2 + LA R6,1(R6) i=i+1 + B LOOPI2 +ELOOPI2 MVC BUF(25),=C'Ludic numbers below 1000:' + SR R8,R8 n=0 + LA R6,1 i=1 +LOOPI3 CH R6,=H'999' do i=1 to 999 + BH ELOOPI3 + LA R1,LUDIC-1(R6) @ludic(i) + CLI 0(R1),X'01' if ludic(i) + BNE NOTI3 + LA R8,1(R8) n=n+1 +NOTI3 LA R6,1(R6) i=i+1 + B LOOPI3 +ELOOPI3 XDECO R8,XDEC edit n + MVC BUF+25(6),XDEC+6 output n + XPRNT BUF,31 print buffer + MVC BUF(80),=CL80'Ludic numbers 2000 to 2005:' + LA R10,BUF+28 @buf=28 + SR R8,R8 n=0 + LA R6,1 i=1 +LOOPI4 CH R6,NMAX do i=1 to nmax + BH ELOOPI4 + LA R1,LUDIC-1(R6) @ludic(i) + CLI 0(R1),X'01' if ludic(i) + BNE NOTI4 + LA R8,1(R8) n=n+1 + CH R8,=H'2000' if n>=2000 + BL NOTI4 + XDECO R6,XDEC edit i + MVC 0(6,R10),XDEC+6 output i + LA R10,6(R10) @buf=@buf+6 + CH R8,=H'2005' if n=2005 + BE ELOOPI4 +NOTI4 LA R6,1(R6) i=i+1 + B LOOPI4 +ELOOPI4 XPRNT BUF,80 print buffer + XPRNT =C'Ludic triplets below 250:',25 + LA R6,1 i=1 +LOOPI5 CH R6,=H'243' do i=1 to 243 + BH ELOOPI5 + LA R1,LUDIC-1(R6) @ludic(i) + CLI 0(R1),X'01' if ludic(i) + BNE ITERI5 + LA R1,LUDIC+1(R6) @ludic(i+2) + CLI 0(R1),X'01' if ludic(i+2) + BNE ITERI5 + LA R1,LUDIC+5(R6) @ludic(i+6) + CLI 0(R1),X'01' if ludic(i+6) + BNE ITERI5 + MVC BUF+0(1),=C'[' [ + XDECO R6,XDEC edit i + MVC BUF+1(4),XDEC+8 output i + LA R2,2(R6) i+2 + XDECO R2,XDEC edit i+2 + MVC BUF+5(4),XDEC+8 output i+2 + LA R2,6(R6) i+6 + XDECO R2,XDEC edit i+6 + MVC BUF+9(4),XDEC+8 output i+6 + MVC BUF+13(1),=C']' ] + XPRNT BUF,14 print buffer +ITERI5 LA R6,1(R6) i=i+1 + B LOOPI5 +ELOOPI5 XR R15,R15 set return code + BR R14 return to caller + LTORG +BUF DS CL80 buffer +XDEC DS CL12 decimal editor +NMAX DC H'25000' nmax +LUDIC DC 25000X'01' ludic(nmax)=true + YREGS + END LUDICN diff --git a/Task/Ludic-numbers/ALGOL-68/ludic-numbers.alg b/Task/Ludic-numbers/ALGOL-68/ludic-numbers.alg new file mode 100644 index 0000000000..3f39cb619c --- /dev/null +++ b/Task/Ludic-numbers/ALGOL-68/ludic-numbers.alg @@ -0,0 +1,59 @@ +# find some Ludic numbers # + +# sieve the Ludic numbers up to 30 000 # +INT max number = 30 000; +[ 1 : max number ]INT candidates; +FOR n TO UPB candidates DO candidates[ n ] := n OD; +FOR n FROM 2 TO UPB candidates OVER 2 DO + IF candidates[ n ] /= 0 THEN + # have a ludic number # + INT number count := -1; + FOR remove pos FROM n TO UPB candidates DO + IF candidates[ remove pos ] /= 0 THEN + # have a number we haven't elminated yet # + number count +:= 1; + IF number count = n THEN + # this number should be removed # + candidates[ remove pos ] := 0; + number count := 0 + FI + FI + OD + FI +OD; +# show some Ludic numbers and counts # +print( ( "Ludic numbers: " ) ); +INT ludic count := 0; +FOR n TO UPB candidates DO + IF candidates[ n ] /= 0 THEN + # have a ludic number # + ludic count +:= 1; + IF ludic count < 26 THEN + # this is one of the first few Ludic numbers # + print( ( " ", whole( n, 0 ) ) ); + IF ludic count = 25 THEN + print( ( " ...", newline ) ) + FI + FI; + IF ludic count = 2000 THEN + print( ( "Ludic numbers 2000-2005: ", whole( n, 0 ) ) ) + ELIF ludic count > 2000 AND ludic count < 2006 THEN + print( ( " ", whole( n, 0 ) ) ); + IF ludic count = 2005 THEN + print( ( newline ) ) + FI + FI + FI; + IF n = 1000 THEN + # count ludic numbers up to 1000 # + print( ( "There are ", whole( ludic count, 0 ), " Ludic numbers up to 1000", newline ) ) + FI +OD; +# find the Ludic triplets below 250 # +print( ( "Ludic triplets below 250:", newline ) ); +FOR n TO 250 - 6 DO + IF candidates[ n ] /= 0 AND candidates[ n + 2 ] /= 0 AND candidates[ n + 6 ] /= 0 THEN + # have a triplet # + print( ( " ", whole( n, -3 ), ", ", whole( n + 2, -3 ), ", ", whole( n + 6, -3 ), newline ) ) + FI +OD diff --git a/Task/Ludic-numbers/C-sharp/ludic-numbers.cs b/Task/Ludic-numbers/C-sharp/ludic-numbers.cs new file mode 100644 index 0000000000..f863ec1003 --- /dev/null +++ b/Task/Ludic-numbers/C-sharp/ludic-numbers.cs @@ -0,0 +1,68 @@ +using System; +using System.Linq; +using System.Collections.Generic; + +public class Program +{ + public static void Main() + { + Console.WriteLine("First 25 ludic numbers:"); + Console.WriteLine(string.Join(", ", LudicNumbers(150).Take(25))); + Console.WriteLine(); + + Console.WriteLine($"There are {LudicNumbers(1001).Count()} ludic numbers below 1000"); + Console.WriteLine(); + + foreach (var ludic in LudicNumbers(22000).Skip(1999).Take(6) + .Select((n, i) => $"#{i+2000} = {n}")) { + Console.WriteLine(ludic); + } + Console.WriteLine(); + + Console.WriteLine("Triplets below 250:"); + var queue = new Queue(5); + foreach (int x in LudicNumbers(255)) { + if (queue.Count == 5) queue.Dequeue(); + queue.Enqueue(x); + if (x - 6 < 250 && queue.Contains(x - 6) && queue.Contains(x - 4)) { + Console.WriteLine($"{x-6}, {x-4}, {x}"); + } + } + } + + public static IEnumerable LudicNumbers(int limit) { + yield return 1; + //Like a linked list, but with value types. + //Create 2 extra entries at the start to avoid ugly index calculations + //and another at the end to avoid checking for index-out-of-bounds. + Entry[] values = Enumerable.Range(0, limit + 1).Select(n => new Entry(n)).ToArray(); + for (int i = 2; i < limit; i = values[i].Next) { + yield return values[i].N; + int start = i; + while (start < limit) { + Unlink(values, start); + for (int step = 0; step < i && start < limit; step++) + start = values[start].Next; + } + } + } + + static void Unlink(Entry[] values, int index) { + values[values[index].Prev].Next = values[index].Next; + values[values[index].Next].Prev = values[index].Prev; + } + +} + +struct Entry +{ + public Entry(int n) : this() { + N = n; + Prev = n - 1; + Next = n + 1; + } + + public int N { get; } + public int Prev { get; set; } + public int Next { get; set; } +} diff --git a/Task/Ludic-numbers/Elixir/ludic-numbers.elixir b/Task/Ludic-numbers/Elixir/ludic-numbers.elixir index f4a6c75984..1540b6e296 100644 --- a/Task/Ludic-numbers/Elixir/ludic-numbers.elixir +++ b/Task/Ludic-numbers/Elixir/ludic-numbers.elixir @@ -1,26 +1,21 @@ defmodule Ludic do - def numbers, do: numbers(100000) - - def numbers(n) when is_integer(n) do + def numbers(n \\ 100000) do [h|t] = Enum.to_list(1..n) numbers(t, [h]) end defp numbers(list, nums) when length(list) < hd(list), do: Enum.reverse(nums, list) - defp numbers(list, nums) do - h = hd(list) - ludic = Enum.with_index(list) |> - Enum.filter_map(fn{_,i} -> rem(i,h)!=0 end, fn{n,_} -> n end) - numbers(ludic, [h | nums]) + defp numbers([h|_]=list, nums) do + Enum.drop_every(list, h) |> numbers([h | nums]) end def task do IO.puts "First 25 : #{inspect numbers(200) |> Enum.take(25)}" IO.puts "Below 1000: #{length(numbers(1000))}" tuple = numbers(25000) |> List.to_tuple - IO.puts "2000..2005th: #{ inspect Enum.map(1999..2004, fn i -> elem(tuple, i) end) }" + IO.puts "2000..2005th: #{ inspect for i <- 1999..2004, do: elem(tuple, i) }" ludic = numbers(250) - triple = for x<-ludic, Enum.member?(ludic, x+2), Enum.member?(ludic, x+6), do: [x, x+2, x+6] + triple = for x <- ludic, x+2 in ludic, x+6 in ludic, do: [x, x+2, x+6] IO.puts "Triples below 250: #{inspect triple, char_lists: :as_lists}" end end diff --git a/Task/Ludic-numbers/Lua/ludic-numbers.lua b/Task/Ludic-numbers/Lua/ludic-numbers.lua new file mode 100644 index 0000000000..f95a1c194f --- /dev/null +++ b/Task/Ludic-numbers/Lua/ludic-numbers.lua @@ -0,0 +1,46 @@ +-- Return table of ludic numbers below limit +function ludics (limit) + local ludList, numList, index = {1}, {} + for n = 2, limit do table.insert(numList, n) end + while #numList > 0 do + index = numList[1] + table.insert(ludList, index) + for key = #numList, 1, -1 do + if key % index == 1 then table.remove(numList, key) end + end + end + return ludList +end + +-- Return true if n is found in t or false otherwise +function foundIn (t, n) + for k, v in pairs(t) do + if v == n then return true end + end + return false +end + +-- Display msg followed by all values in t +function show (msg, t) + io.write(msg) + for _, v in pairs(t) do io.write(" " .. v) end + print("\n") +end + +-- Main procedure +local first25, under1k, inRange, tripList, triplets = {}, 0, {}, {}, {} +for k, v in pairs(ludics(30000)) do + if k <= 25 then table.insert(first25, v) end + if v <= 1000 then under1k = under1k + 1 end + if k >= 2000 and k <= 2005 then table.insert(inRange, v) end + if v < 250 then table.insert(tripList, v) end +end +for _, x in pairs(tripList) do + if foundIn(tripList, x + 2) and foundIn(tripList, x + 6) then + table.insert(triplets, "\n{" .. x .. "," .. x+2 .. "," .. x+6 .. "}") + end +end +show("First 25:", first25) +print(under1k .. " are less than or equal to 1000\n") +show("2000th to 2005th:", inRange) +show("Triplets:", triplets) diff --git a/Task/Ludic-numbers/PARI-GP/ludic-numbers-1.pari b/Task/Ludic-numbers/PARI-GP/ludic-numbers-1.pari new file mode 100644 index 0000000000..d6ec2f7d72 --- /dev/null +++ b/Task/Ludic-numbers/PARI-GP/ludic-numbers-1.pari @@ -0,0 +1,31 @@ +\\ Creating Vlf - Vector of ludic numbers' flags, +\\ where the index of each flag=1 is the ludic number. +\\ 2/28/16 aev +ludic(maxn)={my(Vlf=vector(maxn,z,1),n2=maxn\2,k,j1); +for(i=2,n2, + if(Vlf[i], k=0; j1=i+1; + for(j=j1,maxn, if(Vlf[j], k++); if(k==i, Vlf[j]=0; k=0)) + ); + ); +return(Vlf); +} + +{ +\\ Required tests: +my(Vr,L=List(),k=0,maxn=25000); +Vr=ludic(maxn); +print("The first 25 Ludic numbers: "); +for(i=1,maxn, if(Vr[i]==1, k++; print1(i," "); if(k==25, break))); +print("");print(""); +k=0; +for(i=1,999, if(Vr[i]==1, k++)); +print("Ludic numbers below 1000: ",k); +print(""); +k=0; +print("Ludic numbers 2000 to 2005: "); +for(i=1,maxn, if(Vr[i]==1, k++; if(k>=2000&&k<=2005, listput(L,i)); if(k>2005, break))); +for(i=1,6, print1(L[i]," ")); +print(""); print(""); +print("Ludic Triplets below 250: "); +for(i=1,250, if(Vr[i]&&Vr[i+2]&&Vr[i+6], print1("(",i," ",i+2," ",i+6,") "))); +} diff --git a/Task/Ludic-numbers/PARI-GP/ludic-numbers-2.pari b/Task/Ludic-numbers/PARI-GP/ludic-numbers-2.pari new file mode 100644 index 0000000000..01596e06ae --- /dev/null +++ b/Task/Ludic-numbers/PARI-GP/ludic-numbers-2.pari @@ -0,0 +1,25 @@ +\\ Creating Vl - Vector of ludic numbers. +\\ 2/28/16 aev +ludic2(maxn)={my(Vw=vector(maxn, x, x+1),Vl=Vec([1]),vwn=#Vw,i); +while(vwn>0, i=Vw[1]; Vl=concat(Vl,[i]); + Vw=vector((vwn*(i-1))\i,x,Vw[(x*i+i-2)\(i-1)]); vwn=#Vw +); return(Vl); +} +{ +\\ Required tests: +my(Vr,L=List(),k=0,maxn=22000,vrs,vi); +Vr=ludic2(maxn); vrs=#Vr; +print("The first 25 Ludic numbers: "); +for(i=1,25, print1(Vr[i]," ")); +print("");print(""); +k=0; +for(i=1,vrs, if(Vr[i]<1000, k++, break)); +print("Ludic numbers below 1000: ",k); +print(""); +k=0; +print("Ludic numbers 2000 to 2005: "); +for(i=2000,2005, print1(Vr[i]," ")); +print("");print(""); +print("Ludic Triplets below 250: "); +for(i=1,vrs, vi=Vr[i]; if(i==1,print1("(",vi," ",vi+2," ",vi+6,") "); next); if(vi+6<250,if(Vr[i+1]==vi+2&&Vr[i+2]==vi+6, print1("(",vi," ",vi+2," ",vi+6,") ")))); +} diff --git a/Task/Ludic-numbers/PL-I/ludic-numbers.pli b/Task/Ludic-numbers/PL-I/ludic-numbers.pli index 2077ffb622..47453cca80 100644 --- a/Task/Ludic-numbers/PL-I/ludic-numbers.pli +++ b/Task/Ludic-numbers/PL-I/ludic-numbers.pli @@ -32,6 +32,7 @@ Ludic: procedure; put skip list ('Triples are:'); put skip; i = 1; + put edit ('(', L(1), L(3), L(5), ') ' ) (A, 3 F(4), A); do i = 1 by 1 while (L(i+2) <= 250); if (L(i) = L(i+1) - 2) & (L(i) = L(i+2) - 6) then put edit ('(', L(i), L(i+1), L(i+2), ') ' ) (A, 3 F(4), A); diff --git a/Task/Ludic-numbers/Pascal/ludic-numbers-1.pascal b/Task/Ludic-numbers/Pascal/ludic-numbers-1.pascal new file mode 100644 index 0000000000..b53be03f57 --- /dev/null +++ b/Task/Ludic-numbers/Pascal/ludic-numbers-1.pascal @@ -0,0 +1,144 @@ +program lucid; +{$IFDEF FPC} + {$MODE objFPC} // useful for x64 +{$ENDIF} + +const + //66164 -> last < 1000*1000; + maxLudicCnt = 2005;//must be > 1 +type + + tDelta = record + dNum, + dCnt : LongInt; + end; + + tpDelta = ^tDelta; + tLudicList = array of tDelta; + + tArrdelta =array[0..0] of tDelta; + tpLl = ^tArrdelta; + +function isLudic(plL:tpLl;maxIdx:nativeInt):boolean; +var + i, + cn : NativeInt; +Begin + //check if n is 'hit' by a prior ludic number + For i := 1 to maxIdx do + with plL^[i] do + Begin + //Mask read modify write reread + //dec(dCnt);IF dCnt= 0 + cn := dCnt; + IF cn = 1 then + Begin + dcnt := dNum; + isLudic := false; + EXIT; + end; + dcnt := cn-1; + end; + isLudic := true; +end; + +procedure CreateLudicList(var Ll:tLudicList); +var + plL : tpLl; + n,LudicCnt : NativeUint; +begin + // special case 1 + n := 1; + Ll[0].dNum := 1; + + plL := @Ll[0]; + LudicCnt := 0; + repeat + inc(n); + If isLudic(plL,LudicCnt ) then + Begin + inc(LudicCnt); + with plL^[LudicCnt] do + Begin + dNum := n; + dCnt := n; + end; + IF (LudicCnt >= High(LL)) then + BREAK; + end; + until false; +end; + +procedure firstN(var Ll:tLudicList;cnt: NativeUint); +var + i : NativeInt; +Begin + writeln('First ',cnt,' ludic numbers:'); + For i := 0 to cnt-2 do + write(Ll[i].dNum,','); + writeln(Ll[cnt-1].dNum); +end; + +procedure triples(var Ll:tLudicList;max: NativeUint); +var + i, + chk : NativeUint; +Begin + // special case 1,3,7 + writeln('Ludic triples below ',max); + write('(',ll[0].dNum,',',ll[2].dNum,',',ll[4].dNum,') '); + + For i := 1 to High(Ll) do + Begin + chk := ll[i].dNum; + If chk> max then + break; + If (ll[i+2].dNum = chk+6) AND (ll[i+1].dNum = chk+2) then + write('(',ll[i].dNum,',',ll[i+1].dNum,',',ll[i+2].dNum,') '); + end; + writeln; + writeln; +end; + +procedure LastLucid(var Ll:tLudicList;start,cnt: NativeUint); +var + limit,i : NativeUint; +Begin + dec(start); + limit := high(Ll); + IF cnt >= limit then + cnt := limit; + if start+cnt >limit then + start := limit-cnt; + writeln(Start+1,'.th to ',Start+cnt+1,'.th ludic number'); + For i := 0 to cnt-1 do + write(Ll[i+start].dNum,','); + writeln(Ll[start+cnt].dNum); + writeln; +end; + +function CountLudic(var Ll:tLudicList;Limit: NativeUint):NativeUint; +var + i,res : NativeUint; +Begin + res := 0; + For i := 0 to High(Ll) do begin + IF Ll[i].dnum <= Limit then + inc(res) + else + BREAK; + CountLudic:= res; +end; + +end; +var + LudicList : tLudicList; +BEGIN + setlength(LudicList,maxLudicCnt); + CreateLudicList(LudicList); + firstN(LudicList,25); + writeln('There are ',CountLudic(LudicList,1000),' ludic numbers below 1000'); + LastLucid(LudicList,2000,5); + LastLucid(LudicList,maxLudicCnt,5); + triples(LudicList,250);//all-> (LudicList,LudicList[High(LudicList)].dNum); +END. diff --git a/Task/Ludic-numbers/Pascal/ludic-numbers-2.pascal b/Task/Ludic-numbers/Pascal/ludic-numbers-2.pascal new file mode 100644 index 0000000000..97031b58a2 --- /dev/null +++ b/Task/Ludic-numbers/Pascal/ludic-numbers-2.pascal @@ -0,0 +1,151 @@ +program ludic; +{$IFDEF FPC}{$MODE DELPHI}{$ELSE}{$APPTYPE CONSOLE}{$ENDIF} +uses + sysutils; +const + MAXNUM =21511;// > 1 + //1561333;-> 100000 ludic numbers + //1561243,1561291,1561301,1561307,1561313,1561333 +type + tarrLudic = array of byte; + tLudics = array of LongWord; + +var + Ludiclst : tarrLudic; + +procedure Firsttwentyfive; +var + i,actLudic : NativeInt; +Begin + writeln('First 25 ludic numbers'); + actLudic:= 1; + For i := 1 to 25 do + Begin + write(actLudic:3,','); + inc(actLudic,Ludiclst[actLudic]); + IF i MOD 5 = 0 then + writeln(#8#32); + end; + writeln; +end; + +procedure CountBelowOneThousand; +var + cnt,actLudic : NativeInt; +Begin + write('Count of ludic numbers below 1000 = '); + actLudic:= 1; + cnt := 1; + while actLudic <= 1000 do + Begin + inc(actLudic,Ludiclst[actLudic]); + inc(cnt); + end; + dec(cnt); + writeln(cnt);writeln; +end; + +procedure Show2000til2005; +var + cnt,actLudic : NativeInt; +Begin + writeln('ludic number #2000 to #2005'); + actLudic:= 1; + cnt := 1; + while cnt < 2000 do + Begin + inc(actLudic,Ludiclst[actLudic]); + inc(cnt); + end; + while cnt < 2005 do + Begin + write(actLudic,','); + inc(actLudic,Ludiclst[actLudic]); + inc(cnt); + end; + writeln(actLudic);writeln; +end; + +procedure ShowTriplets; +var + actLudic,lastDelta : NativeInt; +Begin + writeln('ludic numbers triplets below 250'); + actLudic:= 1; + while actLudic < 250-5 do + Begin + IF (Ludiclst[actLudic] <> 0) AND + (Ludiclst[actLudic+2] <> 0) AND + (Ludiclst[actLudic+6] <> 0) then + writeln('{',actLudic,'|',actLudic+2,'|',actLudic+6,'} '); + inc(actLudic); + end; + writeln; +end; + +procedure CheckMaxdist; +var + actLudic,Delta,MaxDelta : NativeInt; +Begin + MaxDelta := 0; + actLudic:= 1; + repeat + delta := Ludiclst[actLudic]; + inc(actLudic,delta); + IF MAxDelta= MAXNUM; + writeln('MaxDist ',MAxDelta);writeln; +end; + +function GetLudics:tLudics; +//Array of byte containing the distance to next ludic number +//eliminated numbers are set to 0 +var + i,actLudic,actcnt,delta,actPos,lastPos,ludicCnt: NativeInt; +Begin + setlength(Ludiclst,MAXNUM+1); + For i := MAXNUM downto 0 do + Ludiclst[i]:= 1; + actLudic := 1; + ludicCnt := 1; + + repeat + inc(actLudic,Ludiclst[actLudic]); + IF actLudic> MAXNUM then + BREAK; + inc(ludicCnt); + actPos := actLudic; + actcnt := 0; + // Only if there are enough ludics left + IF MaxNum-ludicCnt-actPos > actPos then + Begin + //eliminate every element in actLudic-distance + //delta so i can set Ludiclst[actpos] to zero + delta := Ludiclst[actpos]; + repeat + lastPos := actPos; + inc(actpos,delta); + if actPos>=MAXNUM then + BREAK; + delta := Ludiclst[actpos]; + inc(actcnt); + IF actcnt= actLudic then + Begin + inc(Ludiclst[LastPos],delta); + //mark as not ludic + Ludiclst[actpos] := 0; + actcnt := 0; + end; + until false; + end; + until false; + writeln(ludicCnt,' ludic numbers upto ',MAXNUM,#13#10); +end; + +BEGIN + GetLudics; + CheckMaxdist; + Firsttwentyfive;CountBelowOneThousand;Show2000til2005;ShowTriplets ; + setlength(Ludiclst,0) +END. diff --git a/Task/Ludic-numbers/PowerShell/ludic-numbers-1.psh b/Task/Ludic-numbers/PowerShell/ludic-numbers-1.psh new file mode 100644 index 0000000000..8532fcc054 --- /dev/null +++ b/Task/Ludic-numbers/PowerShell/ludic-numbers-1.psh @@ -0,0 +1,18 @@ +# Start with a pool large enough to meet the requirements +$Pool = [System.Collections.ArrayList]( 2..22000 ) + +# Start with 1, because it's grandfathered in +$Ludic = @( 1 ) + +# While the size of the pool is still larger than the next Ludic number... +While ( $Pool.Count -gt $Pool[0] ) + { + # Add the next Ludic number to the list + $Ludic += $Pool[0] + + # Remove from the pool all entries whose index is a multiple of the next Ludic number + [math]::Truncate( ( $Pool.Count - 1 )/ $Pool[0])..0 | ForEach { $Pool.RemoveAt( $_ * $Pool[0] ) } + } + +# Add the rest of the numbers in the pool to the list of Ludic numbers +$Ludic += $Pool.ToArray() diff --git a/Task/Ludic-numbers/PowerShell/ludic-numbers-2.psh b/Task/Ludic-numbers/PowerShell/ludic-numbers-2.psh new file mode 100644 index 0000000000..9c853c84a4 --- /dev/null +++ b/Task/Ludic-numbers/PowerShell/ludic-numbers-2.psh @@ -0,0 +1,15 @@ +# Display the first 25 Ludic numbers +$Ludic[0..24] -join ", " +'' + +# Display the count of all Ludic numbers under 1000 +$Ludic.Where{ $_ -le 1000 }.Count +'' + +# Display the 2000th through the 2005th Ludic number +$Ludic[1999..2004] -join ", " +'' + +# Display all Ludic triplets less than 250 +$TripletStart = $Ludic.Where{ $_ -lt 244 -and ( $_ + 2 ) -in $Ludic -and ( $_ + 6 ) -in $Ludic } +$TripletStart.ForEach{ $_, ( $_ + 2 ), ( $_ + 6 ) -join ", " } diff --git a/Task/Ludic-numbers/REXX/ludic-numbers.rexx b/Task/Ludic-numbers/REXX/ludic-numbers.rexx index ddfbb08bae..b1e558cd2e 100644 --- a/Task/Ludic-numbers/REXX/ludic-numbers.rexx +++ b/Task/Ludic-numbers/REXX/ludic-numbers.rexx @@ -1,39 +1,40 @@ -/*REXX program to display (a range of) ludic numbers, or a count of same*/ -parse arg N count bot top triples . /*obtain optional parameters/args*/ -if N=='' then N=25 /*Not specified? Use the default.*/ -if count=='' then count=1000 /* " " " " " */ -if bot=='' then bot=2000 /* " " " " " */ -if top=='' then top=2005 /* " " " " " */ -if triples=='' then triples=250-1 /* " " " " " */ -say 'The first ' N " ludic numbers: " ludic(n) +/*REXX program displays (a range of) ludic numbers, or a count of when a range is used.*/ +parse arg N count bot top triples . /*obtain optional arguments from the CL*/ +if N=='' | N=="," then N=25 /*Not specified? Then use the default.*/ +if count=='' | count=="," then count=1000 /* " " " " " " */ +if bot=='' | bot=="," then bot=2000 /* " " " " " " */ +if top=='' | top=="," then top=2005 /* " " " " " " */ +if triples=='' | triples=="," then triples=250-1 /* " " " " " " */ +say 'The first ' N " ludic numbers: " ludic(n) /*display title for what's coming next.*/ say -say "There are " words(ludic(-count)) ' ludic numbers from 1───►'count " (inclusive)." +say "There are " words(ludic(-count)) ' ludic numbers from 1───►'count " (inclusive)." say say "The " bot ' to ' top " ludic numbers are: " ludic(bot,top) $=ludic(-triples) 0 0; #=0; @= say - do j=1 for words($); _=word($,j) /*it is known that ludic _ exists*/ - if wordpos(_+2,$)==0 | wordpos(_+6,$)==0 then iterate /*¬triple.*/ - #=#+1; @=@ '◄'_ _+2 _+6"► " /*bump triple counter, and ··· */ - end /*j*/ /* [↑] append found triple ──► @*/ + do j=1 for words($); _=word($,j) /*it is known that ludic _ exists. */ + if wordpos(_+2, $)==0 | wordpos(_+6, $)==0 then iterate /*Not triple? Skip it.*/ + #=#+1; @=@ '◄'_ _+2 _+6"► " /*bump the triple counter, and ··· */ + end /*j*/ /* [↑] append the found triple ──► @ */ if @=='' then say 'From 1──►'triples", no triples found." - else say 'From 1──►'triples", " # ' triples found:' @ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────LUDIC subroutine────────────────────*/ -ludic: procedure; parse arg m 1 mm,h; am=abs(m); if h\=='' then am=h -$=1 2; @= /*$=ludic #s superset, @=# series*/ - /* [↓] construct a ludic series.*/ - do j=3 by 2 to am * max(1,15*((m>0)|h\=='')); @=@ j; end; @=@' ' - /* [↑] high limit: approx|exact */ - do while words(@)\==0 /* [↓] examine the first word. */ - f=word(@,1); $=$ f /*append this first word to list.*/ - do d=1 by f while d<=words(@) /*use 1st #, elide all occurances*/ - @=changestr(' 'word(@,d)" ",@, ' . ') /*delete the # in the seq#*/ - end /*d*/ /* [↑] done eliding "1st" number*/ - @=translate(@,,.) /*translate periods to blanks. */ - end /*forever*/ /* [↑] done eliding ludic #s. */ -@=space(@) /*remove extra blanks from list. */ + else say 'From 1──►'triples", " # ' triples found:' @ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +ludic: procedure; parse arg m,h; am=abs(m); if h\=='' then am=h; $=1 2; yes=m>0 | h\=='' +@= /*$≡ludic numbers superset; @≡sequence*/ + do j=3 by 2 to am*max(1, 15*yes) /*construct an initial list of numbers.*/ + @=@ j /* [↓] construct a ludic sequence. */ + end /*j*/ /* [↑] high limit: approx or exact. */ +@=@' ' /*append a blank to the number sequence*/ + do while words(@)\==0; f=word(@,1) /* [↓] examine the first word. */ + $=$ f /*append this first word to the list. */ + do d=1 by f while d<=words(@) /*use 1st number, elide all occurrences*/ + y=word(@,d) /*obtain the Yth word of @ string.*/ + @=changestr(' 'y" ", @, ' . ') /*delete the number in the sequence. */ + end /*d*/ /* [↑] done eliding the "1st" number. */ + @=translate(@, , .) /*translate periods (dots) to blanks. */ + end /*while*/ /* [↑] done eliding ludic numbers. */ -if h=='' then return subword($,1,am) /*return a range of ludic numbers*/ - return subword($,m,h-m+1) /*return a section of a range.*/ +if h=='' then return subword($, 1, am) /*return a range of ludic numbers. */ + return subword($, am, h-m+1) /*return a section of a range. */ diff --git a/Task/Luhn-test-of-credit-card-numbers/00DESCRIPTION b/Task/Luhn-test-of-credit-card-numbers/00DESCRIPTION index e8ff41f40b..394f3c5c25 100644 --- a/Task/Luhn-test-of-credit-card-numbers/00DESCRIPTION +++ b/Task/Luhn-test-of-credit-card-numbers/00DESCRIPTION @@ -1,4 +1,5 @@ {{omit from|GUISS}} + The [[wp:Luhn algorithm|Luhn test]] is used by some credit card companies to distinguish valid credit card numbers from what could be a random selection of digits. Those companies using credit card numbers that can be validated by the Luhn test have numbers that pass the following test: @@ -9,6 +10,7 @@ Those companies using credit card numbers that can be validated by the Luhn test :# Sum the partial sums of the even digits to form s2 # If s1 + s2 ends in zero then the original number is in the form of a valid credit card number as verified by the Luhn test. +
    For example, if the trial number is 49927398716:
    Reverse the digits:
       61789372994
    @@ -25,10 +27,17 @@ The even digits:
     
     s1 + s2 = 70 which ends in zero which means that 49927398716 passes the Luhn test
    -The task is to '''write a function/method/procedure/subroutine that will validate a number with the Luhn test, and use it to validate the following numbers:''' -:49927398716 -:49927398717 -:1234567812345678 -:1234567812345670 -Cf. [[SEDOLs|SEDOL]], [[Calculate International Securities Identification Number|ISIN]] +;Task: +Write a function/method/procedure/subroutine that will validate a number with the Luhn test, and +
    use it to validate the following numbers: + 49927398716 + 49927398717 + 1234567812345678 + 1234567812345670 + +
    +;Related tasks: +*   [[SEDOLs|SEDOL]] +*   [[Calculate International Securities Identification Number|ISIN]] +

    diff --git a/Task/Luhn-test-of-credit-card-numbers/360-Assembly/luhn-test-of-credit-card-numbers.360 b/Task/Luhn-test-of-credit-card-numbers/360-Assembly/luhn-test-of-credit-card-numbers.360 new file mode 100644 index 0000000000..feb2a17fcd --- /dev/null +++ b/Task/Luhn-test-of-credit-card-numbers/360-Assembly/luhn-test-of-credit-card-numbers.360 @@ -0,0 +1,122 @@ +* Luhn test of credit card numbers 22/05/2016 +LUHNTEST CSECT + USING LUHNTEST,R13 base register + B 72(R15) skip savearea + DC 17F'0' savearea + STM R14,R12,12(R13) prolog + ST R13,4(R15) " + ST R15,8(R13) " + LR R13,R15 " + LA R9,T @t(k) + LA R8,N for n +LOOPK EQU * for k=1 to n + LR R4,R9 @t(k),@s[1] + LA R6,1 from i=1 + LA R7,M to m +LOOPI1 CR R6,R7 for i=1 to m + BH ELOOPI1 leave i + CLI 0(R4),C' ' if mid(s,i,1)=" " + BNE ITERI1 then + BCTR R6,0 i-1 + ST R6,L l=i-1 + B ELOOPI1 exit for +* end if +ITERI1 LA R4,1(R4) next @s[i] + LA R6,1(R6) i=i+1 + B LOOPI1 next i +ELOOPI1 EQU * out of loop i + MVC W,BLANK w=" " + LA R4,W iw=@w + LR R5,R9 is=@s + A R5,L is=@s+l + BCTR R5,0 is=s+l-1 + L R6,L i=l + LA R7,1 to 1 +LOOPI2 CR R6,R7 for i=l to 1 by -1 + BL ELOOPI2 leave i + MVC 0(1,R4),0(R5) mid(w,iw,1)=mid(s,is,1) + LA R4,1(R4) iw=iw+1 + BCTR R5,0 is=is-1 + BCTR R6,0 i=i-1 + B LOOPI2 next i +ELOOPI2 EQU * out of loop i + LA R11,0 s1=0 + LA R12,0 s2=0 + LA R6,1 i=1 + L R7,L to l +LOOPI3 CR R6,R7 for i=1 to l + BH ELOOPI3 leave i + LA R2,W-1 @w-1 + AR R2,R6 w[i] + MVC CI,0(R2) ci=mid(w,i,1) + NI CI,X'0F' zap upper half byte + LR R4,R6 i + SRDA R4,32 >>32 + D R4,=F'2' i/2 + LTR R4,R4 if mod(i,2)>0 + BNH NOTMOD then + XR R2,R2 clear + IC R2,CI z=cint(mid(w,i,1)) + AR R11,R2 s1=s1+cint(mid(w,i,1)) + B EIFMOD else +NOTMOD XR R2,R2 clear + IC R2,CI cint(mid(w,i,1)) + SLA R2,1 *2 + ST R2,Z z=cint(mid(w,i,1))*2 + C R2,=F'10' if z<10 + BNL GE10 then + A R12,Z s2=s2+z + B EIF10 else +GE10 L R2,Z z + CVD R2,PL8 binary to packed + UNPK CL16,PL8 packed to zoned + OI CL16+15,X'F0' zoned to char (zap sign) + MVC X(1),CL16+15 x=right(cstr(z),1) + NI X,X'0F' zap upper half byte + XR R2,R2 r2=0 + IC R2,X r2=cint(right(cstr(z),1)) + AR R12,R2 s2=s2+r2 + LA R12,1(R12) s2=s2+cint(right(cstr(z),1))+1 +EIF10 EQU * end if +EIFMOD EQU * end if + LA R6,1(R6) i=i+1 + B LOOPI3 next i +ELOOPI3 EQU * out of loop i + LR R1,R11 s1 + AR R1,R12 s1+s2 + CVD R1,PL8 binary to packed + UNPK CL16,PL8 packed to zoned + CLI CL16+15,X'C0' if right(cstr(s1+s2),1)="0" + BNE NOTZERO then + MVC R,=CL8'Valid' r="Valid" + B ECLI else +NOTZERO MVC R,=CL8'Invalid' r="Invalid" +ECLI EQU * end if + MVC PG(M),0(R9) t(k) + MVC PG+M+1(L'R),R r + XPRNT PG,L'PG print buffer + LA R9,M(R9) at=at+m + BCT R8,LOOPK next k + L R13,4(0,R13) epilog + LM R14,R12,12(R13) " + XR R15,R15 " + BR R14 exit +N EQU (TEND-T)/L'T +M EQU 20 +T DC CL(M)'49927398716 ' + DC CL(M)'49927398717 ' + DC CL(M)'1234567812345678 ' + DC CL(M)'1234567812345670 ' +TEND DS 0C +W DS CL(M) +BLANK DC CL(M)' ' +L DS F +Z DS F +PL8 DS PL8 +CL16 DS CL16 +CI DS C +X DS C +R DS CL8 +PG DC CL80' ' buffer + YREGS + END LUHNTEST diff --git a/Task/Luhn-test-of-credit-card-numbers/Ada/luhn-test-of-credit-card-numbers.ada b/Task/Luhn-test-of-credit-card-numbers/Ada/luhn-test-of-credit-card-numbers.ada index 1eb73dc18e..f4403786d7 100644 --- a/Task/Luhn-test-of-credit-card-numbers/Ada/luhn-test-of-credit-card-numbers.ada +++ b/Task/Luhn-test-of-credit-card-numbers/Ada/luhn-test-of-credit-card-numbers.ada @@ -1,25 +1,30 @@ -with Ada.Text_IO; use Ada.Text_IO; -procedure luhn is - function luhn_test(num : String) return Boolean is - sum : Integer := 0; - odd : Boolean := True; - int : Integer; - begin - for p in reverse num'Range loop - int := Integer'Value(num(p..p)); - if odd then - sum := sum + int; - else - sum := sum + (int*2 mod 10) + (int / 5); - end if; - odd := not odd; - end loop; - return (sum mod 10)=0; - end luhn_test; +with Ada.Text_IO; +use Ada.Text_IO; + +procedure Luhn is + + function Luhn_Test (Number: String) return Boolean is + Sum : Natural := 0; + Odd : Boolean := True; + Digit: Natural range 0 .. 9; + begin + for p in reverse Number'Range loop + Digit := Integer'Value (Number (p..p)); + if Odd then + Sum := Sum + Digit; + else + Sum := Sum + (Digit*2 mod 10) + (Digit / 5); + end if; + Odd := not Odd; + end loop; + return (Sum mod 10) = 0; + end Luhn_Test; begin -put_line(Boolean'Image(luhn_test("49927398716"))); -put_line(Boolean'Image(luhn_test("49927398717"))); -put_line(Boolean'Image(luhn_test("1234567812345678"))); -put_line(Boolean'Image(luhn_test("1234567812345670"))); -end luhn; + + Put_Line (Boolean'Image (Luhn_Test ("49927398716"))); + Put_Line (Boolean'Image (Luhn_Test ("49927398717"))); + Put_Line (Boolean'Image (Luhn_Test ("1234567812345678"))); + Put_Line (Boolean'Image (Luhn_Test ("1234567812345670"))); + +end Luhn; diff --git a/Task/Luhn-test-of-credit-card-numbers/C++/luhn-test-of-credit-card-numbers-3.cpp b/Task/Luhn-test-of-credit-card-numbers/C++/luhn-test-of-credit-card-numbers-3.cpp new file mode 100644 index 0000000000..a033a1a71b --- /dev/null +++ b/Task/Luhn-test-of-credit-card-numbers/C++/luhn-test-of-credit-card-numbers-3.cpp @@ -0,0 +1,94 @@ +#include +#include + +template +struct find_impl; + +template +struct find_impl<0, A, Args...> { + using type = std::integral_constant; +}; + +template +struct find_impl<0, A, B, Args...> { + using type = std::integral_constant; +}; + +template +struct find_impl { + using type = typename find_impl::type; +}; + +namespace detail { +template +struct append_sequence +{}; + +template +struct append_sequence> { + using type = std::tuple; +}; + +template +struct reverse_sequence { + using type = std::tuple<>; +}; + +template +struct reverse_sequence { + using type = typename append_sequence< + T, + typename reverse_sequence::type + >::type; +}; +} + +template +using rule3 = typename find_impl::type; + +template +struct calc + : std::integral_constant +{}; + +template +struct calc + : std::integral_constant::type::value> +{}; + +template +struct luhn_impl; + +template +struct luhn_impl { + using type = typename calc::type; +}; + +template +struct luhn_impl { + using type = + typename luhn_impl::type, !Dgt, B, Args...>::type; +}; + +template +struct luhn; + +template +struct luhn> { + using type = typename luhn_impl, true, Args::value...>::type; + constexpr static bool result = (type::value % 10) == 0; +}; + +template +bool operator "" _luhn() { + return luhn...>::type>::result; +} + +int main() { + std::cout << std::boolalpha; + std::cout << 49927398716_luhn << std::endl; + std::cout << 49927398717_luhn << std::endl; + std::cout << 1234567812345678_luhn << std::endl; + std::cout << 1234567812345670_luhn << std::endl; + return 0; +} diff --git a/Task/Luhn-test-of-credit-card-numbers/Clojure/luhn-test-of-credit-card-numbers.clj b/Task/Luhn-test-of-credit-card-numbers/Clojure/luhn-test-of-credit-card-numbers.clj index 6fec88bb3a..ed671b119f 100644 --- a/Task/Luhn-test-of-credit-card-numbers/Clojure/luhn-test-of-credit-card-numbers.clj +++ b/Task/Luhn-test-of-credit-card-numbers/Clojure/luhn-test-of-credit-card-numbers.clj @@ -1,9 +1,9 @@ (defn luhn? [cc] - (let [factors (flatten (repeat [1 2])) - numbers (map #(Character/digit % 10) (seq cc)) - sum (reduce + (map #(int (+ (/ %1 10) (mod %1 10))) - (map * (reverse numbers) factors)))] + (let [factors (cycle [1 2]) + numbers (map #(Character/digit % 10) cc) + sum (reduce + (map #(+ (quot % 10) (mod % 10)) + (map * (reverse numbers) factors)))] (zero? (mod sum 10)))) -(doseq [n [49927398716 49927398717 1234567812345678 1234567812345670]] +(doseq [n ["49927398716" "49927398717" "1234567812345678" "1234567812345670"]] (println (luhn? n))) diff --git a/Task/Luhn-test-of-credit-card-numbers/Elixir/luhn-test-of-credit-card-numbers.elixir b/Task/Luhn-test-of-credit-card-numbers/Elixir/luhn-test-of-credit-card-numbers.elixir index 74c7cc42cf..73fdd116ff 100644 --- a/Task/Luhn-test-of-credit-card-numbers/Elixir/luhn-test-of-credit-card-numbers.elixir +++ b/Task/Luhn-test-of-credit-card-numbers/Elixir/luhn-test-of-credit-card-numbers.elixir @@ -1,18 +1,13 @@ defmodule Luhn do - def test(digits) do - to_char_list(digits) |> Enum.reverse |> Enum.map(&(&1-?0)) |> luhn_sum |> check + def valid?(cc) when is_binary(cc), do: String.to_integer(cc) |> valid? + def valid?(cc) when is_integer(cc) do + 0 == Integer.digits(cc) + |> Enum.reverse + |> Enum.chunk(2, 2, [0]) + |> Enum.reduce(0, fn([odd, even], sum) -> Enum.sum([sum, odd | Integer.digits(even*2)]) end) + |> rem(10) end - - defp luhn_sum([odd, even | rest]) when even >= 5, do: - odd + 2 * even - 10 + 1 + luhn_sum(rest) - defp luhn_sum([odd, even | rest]), do: - odd + 2 * even + luhn_sum(rest) - defp luhn_sum([odd]), do: odd - defp luhn_sum([]), do: 0 - - defp check(sum) when rem(sum,10)==0, do: :valid - defp check(_sum), do: :invalid end numbers = ~w(49927398716 49927398717 1234567812345678 1234567812345670) -Enum.each(numbers, fn x -> IO.puts "#{x}: #{Luhn.test(x)}" end) +for n <- numbers, do: IO.puts "#{n}: #{Luhn.valid?(n)}" diff --git a/Task/Luhn-test-of-credit-card-numbers/Perl-6/luhn-test-of-credit-card-numbers-1.pl6 b/Task/Luhn-test-of-credit-card-numbers/Perl-6/luhn-test-of-credit-card-numbers-1.pl6 index ecf6a300fe..455c2a58ca 100644 --- a/Task/Luhn-test-of-credit-card-numbers/Perl-6/luhn-test-of-credit-card-numbers-1.pl6 +++ b/Task/Luhn-test-of-credit-card-numbers/Perl-6/luhn-test-of-credit-card-numbers-1.pl6 @@ -1,7 +1,6 @@ -sub luhn-test ($cc-number --> Bool) { - my @digits = $cc-number.comb.reverse; - my $s1 = [+] @digits[0,2...@digits.end]; - my $s2 = [+] @digits[1,3...@digits.end].map({[+] ($^a * 2).comb}); - - return ($s1 + $s2) %% 10; +sub luhn-test ($number --> Bool) { + my @digits = $number.comb.reverse; + my $sum = @digits[0,2...*].sum + + @digits[1,3...*].map({ |($_ * 2).comb }).sum; + return $sum %% 10; } diff --git a/Task/Luhn-test-of-credit-card-numbers/Perl-6/luhn-test-of-credit-card-numbers-2.pl6 b/Task/Luhn-test-of-credit-card-numbers/Perl-6/luhn-test-of-credit-card-numbers-2.pl6 index 89e511f1fd..08a3d52006 100644 --- a/Task/Luhn-test-of-credit-card-numbers/Perl-6/luhn-test-of-credit-card-numbers-2.pl6 +++ b/Task/Luhn-test-of-credit-card-numbers/Perl-6/luhn-test-of-credit-card-numbers-2.pl6 @@ -1,14 +1,14 @@ use Test; -my @cc-numbers = +my %cc-numbers = '49927398716' => True, '49927398717' => False, '1234567812345678' => False, '1234567812345670' => True; -plan @cc-numbers.elems; +plan %cc-numbers.elems; -for @cc-numbers».kv -> $cc, $expected-result { - is luhn-test($cc), $expected-result, +for %cc-numbers.kv -> $cc, $expected-result { + is luhn-test(+$cc), $expected-result, "$cc {$expected-result ?? 'passes' !! 'does not pass'} the Luhn test."; } diff --git a/Task/Luhn-test-of-credit-card-numbers/Perl/luhn-test-of-credit-card-numbers-1.pl b/Task/Luhn-test-of-credit-card-numbers/Perl/luhn-test-of-credit-card-numbers-1.pl index cbcf17a0fa..f72c1784f3 100644 --- a/Task/Luhn-test-of-credit-card-numbers/Perl/luhn-test-of-credit-card-numbers-1.pl +++ b/Task/Luhn-test-of-credit-card-numbers/Perl/luhn-test-of-credit-card-numbers-1.pl @@ -1,4 +1,4 @@ -sub validate +sub luhn_test { my @rev = reverse split //,$_[0]; my ($sum1,$sum2,$i) = (0,0,0); @@ -11,7 +11,7 @@ sub validate } return ($sum1+$sum2) % 10 == 0; } -print validate('49927398716'); -print validate('49927398717'); -print validate('1234567812345678'); -print validate('1234567812345670'); +print luhn_test('49927398716'); +print luhn_test('49927398717'); +print luhn_test('1234567812345678'); +print luhn_test('1234567812345670'); diff --git a/Task/Luhn-test-of-credit-card-numbers/PowerShell/luhn-test-of-credit-card-numbers-1.psh b/Task/Luhn-test-of-credit-card-numbers/PowerShell/luhn-test-of-credit-card-numbers-1.psh new file mode 100644 index 0000000000..2238da6191 --- /dev/null +++ b/Task/Luhn-test-of-credit-card-numbers/PowerShell/luhn-test-of-credit-card-numbers-1.psh @@ -0,0 +1,60 @@ +function Test-LuhnNumber +{ + <# + .SYNOPSIS + Tests validity of credit card numbers. + .DESCRIPTION + Tests validity of credit card numbers using the Luhn test. + .PARAMETER Number + The number must be 11 or 16 digits. + .EXAMPLE + Test-LuhnNumber 49927398716 + .EXAMPLE + [int64[]]$numbers = 49927398716, 49927398717, 1234567812345678, 1234567812345670 + C:\PS>$numbers | ForEach-Object { + "{0,-17}: {1}" -f $_,"$(if(Test-LuhnNumber $_) {'Is valid.'} else {'Is not valid.'})" + } + #> + [CmdletBinding()] + [OutputType([bool])] + Param + ( + [Parameter(Mandatory=$true, + Position=0)] + [ValidateScript({$_.Length -eq 11 -or $_.Length -eq 16})] + [ValidatePattern("^\d+$")] + [string] + $Number + ) + + $digits = ([Regex]::Matches($Number,'.','RightToLeft')).Value + + $digits | + ForEach-Object ` + -Begin {$i = 1} ` + -Process {if ($i++ % 2) {$_}} | + ForEach-Object ` + -Begin {$sumOdds = 0} ` + -Process {$sumOdds += [Char]::GetNumericValue($_)} + $digits | + ForEach-Object ` + -Begin {$i = 0} ` + -Process {if ($i++ % 2) {$_}} | + ForEach-Object ` + -Process {[Char]::GetNumericValue($_) * 2} | + ForEach-Object ` + -Begin {$sumEvens = 0} ` + -Process { + $_number = $_.ToString() + if ($_number.Length -eq 1) + { + $sumEvens += [Char]::GetNumericValue($_number) + } + elseif ($_number.Length -eq 2) + { + $sumEvens += [Char]::GetNumericValue($_number[0]) + [Char]::GetNumericValue($_number[1]) + } + } + + ($sumOdds + $sumEvens).ToString()[-1] -eq "0" +} diff --git a/Task/Luhn-test-of-credit-card-numbers/PowerShell/luhn-test-of-credit-card-numbers-2.psh b/Task/Luhn-test-of-credit-card-numbers/PowerShell/luhn-test-of-credit-card-numbers-2.psh new file mode 100644 index 0000000000..941d8adee3 --- /dev/null +++ b/Task/Luhn-test-of-credit-card-numbers/PowerShell/luhn-test-of-credit-card-numbers-2.psh @@ -0,0 +1 @@ +Test-LuhnNumber 49927398716 diff --git a/Task/Luhn-test-of-credit-card-numbers/PowerShell/luhn-test-of-credit-card-numbers-3.psh b/Task/Luhn-test-of-credit-card-numbers/PowerShell/luhn-test-of-credit-card-numbers-3.psh new file mode 100644 index 0000000000..d63c5df9dd --- /dev/null +++ b/Task/Luhn-test-of-credit-card-numbers/PowerShell/luhn-test-of-credit-card-numbers-3.psh @@ -0,0 +1,3 @@ +49927398716, 49927398717, 1234567812345678, 1234567812345670 | ForEach-Object { + "{0,-17}: {1}" -f $_,"$(if(Test-LuhnNumber $_) {'Is valid.'} else {'Is not valid.'})" +} diff --git a/Task/Luhn-test-of-credit-card-numbers/REXX/luhn-test-of-credit-card-numbers-1.rexx b/Task/Luhn-test-of-credit-card-numbers/REXX/luhn-test-of-credit-card-numbers-1.rexx index 910a1e25f2..3ee1e901ca 100644 --- a/Task/Luhn-test-of-credit-card-numbers/REXX/luhn-test-of-credit-card-numbers-1.rexx +++ b/Task/Luhn-test-of-credit-card-numbers/REXX/luhn-test-of-credit-card-numbers-1.rexx @@ -1,17 +1,17 @@ -/*REXX program validates credit card numbers using the Luhn algorithm. */ -#.=; #.1=49927398716 /*the 1st sample credit card number. */ - #.2=49927398717 /* " 2nd " " " " */ - #.3=1234567812345678 /* " 3rd " " " " */ - #.4=1234567812345670 /* " 4th " " " " */ - do k=1 while #.k\=='' /*validate all the credit card numbers.*/ - say right(#.k,30) LuhnTest(#.k) ' the Luhn test for a credit card number.' - end /*k*/ /* [↑] show if number passed │ flunked*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -LuhnTest: procedure; parse arg x; $=0 /*get credit card number; zero $ sum. */ -y=reverse(left(0,length(x)//2)x) /*add leading zero if needed, reverse. */ - do j=1 to length(y)-1 by 2; _=2*substr(y,j+1,1) - $=$ + substr(y,j,1) + left(_,1) + substr(_,2,1,0) - end /*j*/ /* [↑] sum the odd and even digits.*/ -if $//10==0 then return ' passed' /*if ending in zero, then the # passed.*/ - else return 'flunked' /*if ¬ ending in 0, then not so good. */ +/*REXX program validates credit card numbers using the Luhn algorithm. */ +@luhnCCN= ' the Luhn test, credit card number: ' /*literal for displaying passed/flunked*/ +#.=; #.1=49927398716 /*the 1st sample credit card number. */ + #.2=49927398717 /* " 2nd " " " " */ + #.3=1234567812345678 /* " 3rd " " " " */ + #.4=1234567812345670 /* " 4th " " " " */ + do k=1 while #.k\=='' /*validate all the credit card numbers.*/ + say right(Luhn(#.k),9) @luhnCCN #.k /*display if number passed or flunked. */ + end /*k*/ /* [↑] function returns passed│flunked.*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +Luhn: procedure; parse arg x; $=0 /*get credit card number; zero $ sum. */ + y=reverse(left(0, length(x) // 2)x) /*add leading zero if needed, reverse. */ + do j=1 to length(y)-1 by 2; _=2*substr(y,j+1,1) + $=$ + substr(y,j,1) + left(_,1) + substr(_,2,1,0) + end /*j*/ /* [↑] sum the odd and even digits.*/ + return word('passed flunked',1+($//10==0)) /*$ ending in zero? Then the # passed.*/ diff --git a/Task/MD4/C/md4-1.c b/Task/MD4/C/md4-1.c new file mode 100644 index 0000000000..ae4bf478c9 --- /dev/null +++ b/Task/MD4/C/md4-1.c @@ -0,0 +1,250 @@ +/* + * + * Author: George Mossessian + * + * The MD4 hash algorithm, as described in https://tools.ietf.org/html/rfc1320 + */ + + +#include +#include +#include + +char *MD4(char *str, int len); //this is the prototype you want to call. Everything else is internal. + +typedef struct string{ + char *c; + int len; + char sign; +}string; + +static uint32_t *MD4Digest(uint32_t *w, int len); +static void setMD4Registers(uint32_t AA, uint32_t BB, uint32_t CC, uint32_t DD); +static uint32_t changeEndianness(uint32_t x); +static void resetMD4Registers(void); +static string stringCat(string first, string second); +static string uint32ToString(uint32_t l); +static uint32_t stringToUint32(string s); + +static const char *BASE16 = "0123456789abcdef="; + +#define F(X,Y,Z) (((X)&(Y))|((~(X))&(Z))) +#define G(X,Y,Z) (((X)&(Y))|((X)&(Z))|((Y)&(Z))) +#define H(X,Y,Z) ((X)^(Y)^(Z)) + +#define LEFTROTATE(A,N) ((A)<<(N))|((A)>>(32-(N))) + +#define MD4ROUND1(a,b,c,d,x,s) a += F(b,c,d) + x; a = LEFTROTATE(a, s); +#define MD4ROUND2(a,b,c,d,x,s) a += G(b,c,d) + x + (uint32_t)0x5A827999; a = LEFTROTATE(a, s); +#define MD4ROUND3(a,b,c,d,x,s) a += H(b,c,d) + x + (uint32_t)0x6ED9EBA1; a = LEFTROTATE(a, s); + +static uint32_t A = 0x67452301; +static uint32_t B = 0xefcdab89; +static uint32_t C = 0x98badcfe; +static uint32_t D = 0x10325476; + +string newString(char * c, int t){ + string r; + int i; + if(c!=NULL){ + r.len = (t<=0)?strlen(c):t; + r.c=(char *)malloc(sizeof(char)*(r.len+1)); + for(i=0; i>4)]; + out.c[j++]=BASE16[(in.c[i] & 0x0F)]; + } + out.c[j]='\0'; + return out; +} + + +string uint32ToString(uint32_t l){ + string s = newString(NULL,4); + int i; + for(i=0; i<4; i++){ + s.c[i] = (l >> (8*(3-i))) & 0xFF; + } + return s; +} + +uint32_t stringToUint32(string s){ + uint32_t l; + int i; + l=0; + for(i=0; i<4; i++){ + l = l|(((uint32_t)((unsigned char)s.c[i]))<<(8*(3-i))); + } + return l; +} + +char *MD4(char *str, int len){ + string m=newString(str, len); + string digest; + uint32_t *w; + uint32_t *hash; + uint64_t mlen=m.len; + unsigned char oneBit = 0x80; + int i, wlen; + + + m=stringCat(m, newString((char *)&oneBit,1)); + + //append 0 ≤ k < 512 bits '0', such that the resulting message length in bits + // is congruent to −64 ≡ 448 (mod 512)4 + i=((56-m.len)%64); + if(i<0) i+=64; + m=stringCat(m,newString(NULL, i)); + + w = malloc(sizeof(uint32_t)*(m.len/4+2)); + + //append length, in bits (hence <<3), least significant word first + for(i=0; i>29) & 0xFFFFFFFF; + + wlen=i; + + + //change endianness, but not for the appended message length, for some reason? + for(i=0; i> 8) | ((x & 0xFF000000) >> 24); +} + +void setMD4Registers(uint32_t AA, uint32_t BB, uint32_t CC, uint32_t DD){ + A=AA; + B=BB; + C=CC; + D=DD; +} + +void resetMD4Registers(void){ + setMD4Registers(0x67452301, 0xefcdab89, 0x98badcfe, 0x10325476); +} diff --git a/Task/MD4/C/md4-2.c b/Task/MD4/C/md4-2.c new file mode 100644 index 0000000000..dfb90e3ebd --- /dev/null +++ b/Task/MD4/C/md4-2.c @@ -0,0 +1 @@ +printf("%s\n", MD4("Rosetta Code", 12)); diff --git a/Task/MD4/PARI-GP/md4-1.pari b/Task/MD4/PARI-GP/md4-1.pari new file mode 100644 index 0000000000..a44f97bd3f --- /dev/null +++ b/Task/MD4/PARI-GP/md4-1.pari @@ -0,0 +1,27 @@ +#include +#include + +#define HEX(x) (((x) < 10)? (x)+'0': (x)-10+'a') + +/* + * PARI/GP func: MD4 hash + * + * gp code: install("plug_md4", "s", "MD4", ""); + */ +GEN plug_md4(char *text) +{ + char md[MD4_DIGEST_LENGTH]; + char hash[sizeof(md) * 2 + 1]; + int i; + + MD4((unsigned char*)text, strlen(text), (unsigned char*)md); + + for (i = 0; i < sizeof(md); i++) { + hash[i+i] = HEX((md[i] >> 4) & 0x0f); + hash[i+i+1] = HEX(md[i] & 0x0f); + } + + hash[sizeof(md) * 2] = 0; + + return strtoGENstr(hash); +} diff --git a/Task/MD4/PARI-GP/md4-2.pari b/Task/MD4/PARI-GP/md4-2.pari new file mode 100644 index 0000000000..33884e4c6b --- /dev/null +++ b/Task/MD4/PARI-GP/md4-2.pari @@ -0,0 +1,3 @@ +install("plug_md4", "s", "MD4", "~/libmd4.so"); + +MD4("Rosetta Code") diff --git a/Task/MD4/Perl-6/md4.pl6 b/Task/MD4/Perl-6/md4.pl6 index a69f157565..842b30d469 100644 --- a/Task/MD4/Perl-6/md4.pl6 +++ b/Task/MD4/Perl-6/md4.pl6 @@ -28,12 +28,12 @@ sub md4($str) { when 56..63 { $term = True; @block.push(0x80); - @block.push(0 xx 63 - $_); + @block.push(slip 0 xx 63 - $_); @x = pack-le @block; } when 0..55 { @block.push($term ?? 0 !! 0x80); - @block.push(0 xx 55 - $_); + @block.push(slip 0 xx 55 - $_); @x = pack-le @block; my $bit_len = $buflen +< 3; diff --git a/Task/MD4/Rust/md4.rust b/Task/MD4/Rust/md4.rust new file mode 100644 index 0000000000..620d736b77 --- /dev/null +++ b/Task/MD4/Rust/md4.rust @@ -0,0 +1,200 @@ +// MD4, based on RFC 1186 and RFC 1320. +// +// https://www.ietf.org/rfc/rfc1186.txt +// https://tools.ietf.org/html/rfc1320 +// + +use std::fmt::Write; +use std::mem; + +// Let not(X) denote the bit-wise complement of X. +// Let X v Y denote the bit-wise OR of X and Y. +// Let X xor Y denote the bit-wise XOR of X and Y. +// Let XY denote the bit-wise AND of X and Y. + +// f(X,Y,Z) = XY v not(X)Z +fn f(x: u32, y: u32, z: u32) -> u32 { + (x & y) | (!x & z) +} + +// g(X,Y,Z) = XY v XZ v YZ +fn g(x: u32, y: u32, z: u32) -> u32 { + (x & y) | (x & z) | (y & z) +} + +// h(X,Y,Z) = X xor Y xor Z +fn h(x: u32, y: u32, z: u32) -> u32 { + x ^ y ^ z +} + +// Round 1 macro +// Let [A B C D i s] denote the operation +// A = (A + f(B,C,D) + X[i]) <<< s +macro_rules! md4round1 { + ( $a:expr, $b:expr, $c:expr, $d:expr, $i:expr, $s:expr, $x:expr) => { + { + // Rust defaults to non-overflowing arithmetic, so we need to specify wrapping add. + $a = ($a.wrapping_add( f($b, $c, $d) ).wrapping_add( $x[$i] ) ).rotate_left($s); + } + }; +} + +// Round 2 macro +// Let [A B C D i s] denote the operation +// A = (A + g(B,C,D) + X[i] + 5A827999) <<< s . +macro_rules! md4round2 { + ( $a:expr, $b:expr, $c:expr, $d:expr, $i:expr, $s:expr, $x:expr) => { + { + $a = ($a.wrapping_add( g($b, $c, $d)).wrapping_add($x[$i]).wrapping_add(0x5a827999_u32)).rotate_left($s); + } + }; +} + +// Round 3 macro +// Let [A B C D i s] denote the operation +// A = (A + h(B,C,D) + X[i] + 6ED9EBA1) <<< s . +macro_rules! md4round3 { + ( $a:expr, $b:expr, $c:expr, $d:expr, $i:expr, $s:expr, $x:expr) => { + { + $a = ($a.wrapping_add(h($b, $c, $d)).wrapping_add($x[$i]).wrapping_add(0x6ed9eba1_u32)).rotate_left($s); + } + }; +} + +fn convert_byte_vec_to_u32(mut bytes: Vec) -> Vec { + + bytes.shrink_to_fit(); + let num_bytes = bytes.len(); + let num_words = num_bytes / 4; + unsafe { + let words = Vec::from_raw_parts(bytes.as_mut_ptr() as *mut u32, num_words, num_words); + mem::forget(bytes); + words + } +} + +// Returns a 128-bit MD4 hash as an array of four 32-bit words. +// Based on RFC 1186 from https://www.ietf.org/rfc/rfc1186.txt +fn md4>>(input: T) -> [u32; 4] { + + let mut bytes = input.into().to_vec(); + let initial_bit_len = (bytes.len() << 3) as u64; + + // Step 1. Append padding bits + // Append one '1' bit, then append 0 ≤ k < 512 bits '0', such that the resulting message + // length in bis is congruent to 448 (mod 512). + // Since our message is in bytes, we use one byte with a set high-order bit (0x80) plus + // a variable number of zero bytes. + + // Append zeros + // Number of padding bytes needed is 448 bits (56 bytes) modulo 512 bits (64 bytes) + bytes.push(0x80_u8); + while (bytes.len() % 64) != 56 { + bytes.push(0_u8); + } + + // Everything after this operates on 32-bit words, so reinterpret the buffer. + let mut w = convert_byte_vec_to_u32(bytes); + + // Step 2. Append length + // A 64-bit representation of b (the length of the message before the padding bits were added) + // is appended to the result of the previous step, low-order bytes first. + w.push(initial_bit_len as u32); // Push low-order bytes first + w.push((initial_bit_len >> 32) as u32); + + // Step 3. Initialize MD buffer + let mut a = 0x67452301_u32; + let mut b = 0xefcdab89_u32; + let mut c = 0x98badcfe_u32; + let mut d = 0x10325476_u32; + + // Step 4. Process message in 16-word blocks + let n = w.len(); + for i in 0..n / 16 { + + // Select the next 512-bit (16-word) block to process. + let x = &w[i * 16..i * 16 + 16]; + + let aa = a; + let bb = b; + let cc = c; + let dd = d; + + // [Round 1] + md4round1!(a, b, c, d, 0, 3, x); // [A B C D 0 3] + md4round1!(d, a, b, c, 1, 7, x); // [D A B C 1 7] + md4round1!(c, d, a, b, 2, 11, x); // [C D A B 2 11] + md4round1!(b, c, d, a, 3, 19, x); // [B C D A 3 19] + md4round1!(a, b, c, d, 4, 3, x); // [A B C D 4 3] + md4round1!(d, a, b, c, 5, 7, x); // [D A B C 5 7] + md4round1!(c, d, a, b, 6, 11, x); // [C D A B 6 11] + md4round1!(b, c, d, a, 7, 19, x); // [B C D A 7 19] + md4round1!(a, b, c, d, 8, 3, x); // [A B C D 8 3] + md4round1!(d, a, b, c, 9, 7, x); // [D A B C 9 7] + md4round1!(c, d, a, b, 10, 11, x);// [C D A B 10 11] + md4round1!(b, c, d, a, 11, 19, x);// [B C D A 11 19] + md4round1!(a, b, c, d, 12, 3, x); // [A B C D 12 3] + md4round1!(d, a, b, c, 13, 7, x); // [D A B C 13 7] + md4round1!(c, d, a, b, 14, 11, x);// [C D A B 14 11] + md4round1!(b, c, d, a, 15, 19, x);// [B C D A 15 19] + + // [Round 2] + md4round2!(a, b, c, d, 0, 3, x); //[A B C D 0 3] + md4round2!(d, a, b, c, 4, 5, x); //[D A B C 4 5] + md4round2!(c, d, a, b, 8, 9, x); //[C D A B 8 9] + md4round2!(b, c, d, a, 12, 13, x);//[B C D A 12 13] + md4round2!(a, b, c, d, 1, 3, x); //[A B C D 1 3] + md4round2!(d, a, b, c, 5, 5, x); //[D A B C 5 5] + md4round2!(c, d, a, b, 9, 9, x); //[C D A B 9 9] + md4round2!(b, c, d, a, 13, 13, x);//[B C D A 13 13] + md4round2!(a, b, c, d, 2, 3, x); //[A B C D 2 3] + md4round2!(d, a, b, c, 6, 5, x); //[D A B C 6 5] + md4round2!(c, d, a, b, 10, 9, x); //[C D A B 10 9] + md4round2!(b, c, d, a, 14, 13, x);//[B C D A 14 13] + md4round2!(a, b, c, d, 3, 3, x); //[A B C D 3 3] + md4round2!(d, a, b, c, 7, 5, x); //[D A B C 7 5] + md4round2!(c, d, a, b, 11, 9, x); //[C D A B 11 9] + md4round2!(b, c, d, a, 15, 13, x);//[B C D A 15 13] + + // [Round 3] + md4round3!(a, b, c, d, 0, 3, x); //[A B C D 0 3] + md4round3!(d, a, b, c, 8, 9, x); //[D A B C 8 9] + md4round3!(c, d, a, b, 4, 11, x); //[C D A B 4 11] + md4round3!(b, c, d, a, 12, 15, x);//[B C D A 12 15] + md4round3!(a, b, c, d, 2, 3, x); //[A B C D 2 3] + md4round3!(d, a, b, c, 10, 9, x); //[D A B C 10 9] + md4round3!(c, d, a, b, 6, 11, x); //[C D A B 6 11] + md4round3!(b, c, d, a, 14, 15, x);//[B C D A 14 15] + md4round3!(a, b, c, d, 1, 3, x); //[A B C D 1 3] + md4round3!(d, a, b, c, 9, 9, x); //[D A B C 9 9] + md4round3!(c, d, a, b, 5, 11, x); //[C D A B 5 11] + md4round3!(b, c, d, a, 13, 15, x);//[B C D A 13 15] + md4round3!(a, b, c, d, 3, 3, x); //[A B C D 3 3] + md4round3!(d, a, b, c, 11, 9, x); //[D A B C 11 9] + md4round3!(c, d, a, b, 7, 11, x); //[C D A B 7 11] + md4round3!(b, c, d, a, 15, 15, x);//[B C D A 15 15] + + a = a.wrapping_add(aa); + b = b.wrapping_add(bb); + c = c.wrapping_add(cc); + d = d.wrapping_add(dd); + } + + // Step 5. Output + // The message digest produced as output is A, B, C, D. That is, we begin with the low-order + // byte of A, and end with the high-order byte of D. + [u32::from_be(a), u32::from_be(b), u32::from_be(c), u32::from_be(d)] +} + +fn digest_to_str(digest: &[u32]) -> String { + let mut s = String::new(); + for &word in digest { + write!(&mut s, "{:08x}", word).unwrap(); + } + s +} + +fn main() { + let val = "Rosetta Code"; + println!("md4(\"{}\") = {}", val, digest_to_str(&md4(val))); +} diff --git a/Task/MD5-Implementation/J/md5-implementation-1.j b/Task/MD5-Implementation/J/md5-implementation-1.j index 06a6515e75..029d81834f 100644 --- a/Task/MD5-Implementation/J/md5-implementation-1.j +++ b/Task/MD5-Implementation/J/md5-implementation-1.j @@ -1,3 +1,4 @@ +NB. convert/misc/md5 NB. RSA Data Security, Inc. MD5 Message-Digest Algorithm NB. version: 1.0.2 NB. @@ -6,18 +7,32 @@ NB. J implementation -- (C) 2003 Oleg Kobchenko; NB. NB. 09/04/2003 Oleg Kobchenko NB. 03/31/2007 Oleg Kobchenko j601, JAL +NB. 12/17/2015 G.Pruss 64-bit +NB. ~60+ times slower than using the jqt library require 'convert' +coclass 'pcrypt' NB. lt= (*. -.)~ gt= *. -. ge= +. -. xor= ~: '`lt gt ge xor'=: (20 b.)`(18 b.)`(27 b.)`(22 b.) -'`and or rot sh'=: (17 b.)`(23 b.)`(32 b.)`(33 b.) +'`and or sh'=: (17 b.)`(23 b.)`(33 b.) + +3 : 0 '' +if. IF64 do. +rot=: (16bffffffff and sh or ] sh~ 32 -~ [) NB. (y << x) | (y >>> (32 - x)) +add=: ((16bffffffff&and)@+)"0 +else. +rot=: (32 b.) add=: (+&(_16&sh) (16&sh@(+ _16&sh) or and&65535@]) +&(and&65535))"0 +end. +EMPTY +) + hexlist=: tolower@:,@:hfd@:,@:(|."1)@(256 256 256 256&#:) cmn=: 4 : 0 - 'x s t'=. x [ 'q a b'=. y - b add s rot (a add q) add (x add t) +'x s t'=. x [ 'q a b'=. y +b add s rot (a add q) add (x add t) ) ff=: cmn (((1&{ and 2&{) or 1&{ lt 3&{) , 2&{.) @@ -27,55 +42,57 @@ ii=: cmn (( 2&{ xor 1&{ ge 3&{ ) , 2&{.) op=: ff`gg`hh`ii I=: ".;._2(0 : 0) - 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 - 1 6 11 0 5 10 15 4 9 14 3 8 13 2 7 12 - 5 8 11 14 1 4 7 10 13 0 3 6 9 12 15 2 - 0 7 14 5 12 3 10 1 8 15 6 13 4 11 2 9 +0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 +1 6 11 0 5 10 15 4 9 14 3 8 13 2 7 12 +5 8 11 14 1 4 7 10 13 0 3 6 9 12 15 2 +0 7 14 5 12 3 10 1 8 15 6 13 4 11 2 9 ) S=: 4 4$7 12 17 22 5 9 14 20 4 11 16 23 6 10 15 21 T=: |:".;._2(0 : 0) - _680876936 _165796510 _378558 _198630844 - _389564586 _1069501632 _2022574463 1126891415 - 606105819 643717713 1839030562 _1416354905 - _1044525330 _373897302 _35309556 _57434055 - _176418897 _701558691 _1530992060 1700485571 - 1200080426 38016083 1272893353 _1894986606 - _1473231341 _660478335 _155497632 _1051523 - _45705983 _405537848 _1094730640 _2054922799 - 1770035416 568446438 681279174 1873313359 - _1958414417 _1019803690 _358537222 _30611744 - _42063 _187363961 _722521979 _1560198380 - _1990404162 1163531501 76029189 1309151649 - 1804603682 _1444681467 _640364487 _145523070 - _40341101 _51403784 _421815835 _1120210379 - _1502002290 1735328473 530742520 718787259 - 1236535329 _1926607734 _995338651 _343485551 + _680876936 _165796510 _378558 _198630844 + _389564586 _1069501632 _2022574463 1126891415 + 606105819 643717713 1839030562 _1416354905 +_1044525330 _373897302 _35309556 _57434055 + _176418897 _701558691 _1530992060 1700485571 + 1200080426 38016083 1272893353 _1894986606 +_1473231341 _660478335 _155497632 _1051523 + _45705983 _405537848 _1094730640 _2054922799 + 1770035416 568446438 681279174 1873313359 +_1958414417 _1019803690 _358537222 _30611744 + _42063 _187363961 _722521979 _1560198380 +_1990404162 1163531501 76029189 1309151649 + 1804603682 _1444681467 _640364487 _145523070 + _40341101 _51403784 _421815835 _1120210379 +_1502002290 1735328473 530742520 718787259 + 1236535329 _1926607734 _995338651 _343485551 ) norm=: 3 : 0 - n=. 16 * 1 + _6 sh 8 + #y - b=. n#0 [ y=. a.i.y - for_i. i. #y do. - b=. ((j { b) or (8*4|i) sh i{y) (j=. _2 sh i) } b - end. - b=. ((j { b) or (8*4|i) sh 128) (j=._2 sh i=.#y) } b - _16]\ (8 * #y) (n-2) } b +n=. 16 * 1 + _6 sh 8 + #y +b=. n#0 [ y=. a.i.y +for_i. i. #y do. + b=. ((j { b) or (8*4|i) sh i{y) (j=. _2 sh i) } b +end. +b=. ((j { b) or (8*4|i) sh 128) (j=._2 sh i=.#y) } b +_16]\ (8 * #y) (n-2) } b ) NB.*md5 v MD5 Message-Digest Algorithm NB. diagest=. md5 message md5=: 3 : 0 - X=. norm y - q=. r=. 1732584193 _271733879 _1732584194 271733878 - for_x. X do. - for_j. i.4 do. - l=. ((j{I){x) ,. (16$j{S) ,. j{T - for_i. i.16 do. - r=. _1|.((i{l) (op@.j) r),}.r - end. +X=. norm y +q=. r=. 1732584193 _271733879 _1732584194 271733878 +for_x. X do. + for_j. i.4 do. + l=. ((j{I){x) ,. (16$j{S) ,. j{T + for_i. i.16 do. + r=. _1|.((i{l) (op@.j) r),}.r end. - q=. r=. r add q end. - hexlist r + q=. r=. r add q +end. +hexlist r ) + +md5_z_=: md5_pcrypt_ diff --git a/Task/MD5-Implementation/Perl-6/md5-implementation.pl6 b/Task/MD5-Implementation/Perl-6/md5-implementation.pl6 index 912f014163..a438619de1 100644 --- a/Task/MD5-Implementation/Perl-6/md5-implementation.pl6 +++ b/Task/MD5-Implementation/Perl-6/md5-implementation.pl6 @@ -1,25 +1,22 @@ -use Test; +sub infix:<⊞>(uint32 $a, uint32 $b --> uint32) { ($a + $b) +& 0xffffffff } +sub infix:«<<<»(uint32 $a, UInt $n --> uint32) { ($a +< $n) +& 0xffffffff +| ($a +> (32-$n)) } -sub prefix:<¬>(\x) { (+^ x) % 2**32 } -sub infix:<⊞>(\x, \y) { (x + y) % 2**32 } -sub infix:«<<<»(\x, \n) { (x +< n) % 2**32 +| (x +> (32-n)) } +constant FGHI = { ($^a +& $^b) +| (+^$a +& $^c) }, + { ($^a +& $^c) +| ($^b +& +^$c) }, + { $^a +^ $^b +^ $^c }, + { $^b +^ ($^a +| +^$^c) }; -constant FGHI = -> \X, \Y, \Z { (X +& Y) +| (¬X +& Z) }, - -> \X, \Y, \Z { (X +& Z) +| (Y +& ¬Z) }, - -> \X, \Y, \Z { X +^ Y +^ Z }, - -> \X, \Y, \Z { Y +^ (X +| ¬Z) }; - -constant S = flat (7, 12, 17, 22) xx 4, - (5, 9, 14, 20) xx 4, - (4, 11, 16, 23) xx 4, - (6, 10, 15, 21) xx 4; +constant _S = flat (7, 12, 17, 22) xx 4, + (5, 9, 14, 20) xx 4, + (4, 11, 16, 23) xx 4, + (6, 10, 15, 21) xx 4; constant T = (floor(abs(sin($_ + 1)) * 2**32) for ^64); constant k = flat ( $_ for ^16), - ((5*$_ + 1) % 16 for ^16), - ((3*$_ + 5) % 16 for ^16), - ((7*$_ ) % 16 for ^16); + ((5*$_ + 1) % 16 for ^16), + ((3*$_ + 5) % 16 for ^16), + ((7*$_ ) % 16 for ^16); sub little-endian($w, $n, *@v) { my \step1 = ($w X* ^$n).eager; # temporary bug workaround @@ -34,25 +31,24 @@ sub md5-pad(Blob $msg) flat @padded.map({ :256[$^d,$^c,$^b,$^a] }), little-endian(32, 2, bits); } -sub md5-block(@H is rw, @X) +sub md5-block(@H, @X) { - my ($A, $B, $C, $D) = @H; - for ^64 -> \i { - my \f = FGHI[i div 16]($B, $C, $D); - ($A, $B, $C, $D) - = ($D, $B ⊞ (($A ⊞ f ⊞ T[i] ⊞ @X[k[i]]) <<< S[i]), $B, $C); - } + my uint32 ($A, $B, $C, $D) = @H; + ($A, $B, $C, $D) = ($D, $B ⊞ (($A ⊞ FGHI[$_ div 16]($B, $C, $D) ⊞ T[$_] ⊞ @X[k[$_]]) <<< _S[$_]), $B, $C) for ^64; @H «⊞=» ($A, $B, $C, $D); } sub md5(Blob $msg --> Blob) { - my @M = md5-pad($msg); - my @H = 0x67452301, 0xefcdab89, 0x98badcfe, 0x10325476; + my uint32 @M = md5-pad($msg); + my uint32 @H = 0x67452301, 0xefcdab89, 0x98badcfe, 0x10325476; md5-block(@H, @M[$_ .. $_+15]) for 0, 16 ...^ +@M; Blob.new: little-endian(8, 4, @H); } +use Test; +plan 7; + for 'd41d8cd98f00b204e9800998ecf8427e', '', '0cc175b9c0f1b6a831c399e269772661', 'a', '900150983cd24fb0d6963f7d28e17f72', 'abc', diff --git a/Task/MD5-Implementation/Perl/md5-implementation.pl b/Task/MD5-Implementation/Perl/md5-implementation.pl new file mode 100644 index 0000000000..8e6d098191 --- /dev/null +++ b/Task/MD5-Implementation/Perl/md5-implementation.pl @@ -0,0 +1,164 @@ +use strict; +use warnings; +use integer; +use Test::More; + +BEGIN { plan tests => 7 } + +sub A() { 0x67_45_23_01 } +sub B() { 0xef_cd_ab_89 } +sub C() { 0x98_ba_dc_fe } +sub D() { 0x10_32_54_76 } +sub MAX() { 0xFFFFFFFF } + +sub padding { + my $l = length (my $msg = shift() . chr(128)); + $msg .= "\0" x (($l%64<=56?56:120)-$l%64); + $l = ($l-1)*8; + $msg .= pack 'VV', $l & MAX , ($l >> 16 >> 16); +} + +sub rotate_left($$) { + ($_[0] << $_[1]) | (( $_[0] >> (32 - $_[1]) ) & ((1 << $_[1]) - 1)); +} + +sub gen_code { + # Discard upper 32 bits on 64 bit archs. + my $MSK = ((1 << 16) << 16) ? ' & ' . MAX : ''; + my %f = ( + FF => "X0=rotate_left((X3^(X1&(X2^X3)))+X0+X4+X6$MSK,X5)+X1$MSK;", + GG => "X0=rotate_left((X2^(X3&(X1^X2)))+X0+X4+X6$MSK,X5)+X1$MSK;", + HH => "X0=rotate_left((X1^X2^X3)+X0+X4+X6$MSK,X5)+X1$MSK;", + II => "X0=rotate_left((X2^(X1|(~X3)))+X0+X4+X6$MSK,X5)+X1$MSK;", + ); + + my %s = ( # shift lengths + S11 => 7, S12 => 12, S13 => 17, S14 => 22, S21 => 5, S22 => 9, S23 => 14, + S24 => 20, S31 => 4, S32 => 11, S33 => 16, S34 => 23, S41 => 6, S42 => 10, + S43 => 15, S44 => 21 + ); + + my $insert = "\n"; + while(defined( my $data = )) { + chomp $data; + next unless $data =~ /^[FGHI]/; + my ($func,@x) = split /,/, $data; + my $c = $f{$func}; + $c =~ s/X(\d)/$x[$1]/g; + $c =~ s/(S\d{2})/$s{$1}/; + $c =~ s/^(.*)=rotate_left\((.*),(.*)\)\+(.*)$//; + + my $su = 32 - $3; + my $sh = (1 << $3) - 1; + + $c = "$1=(((\$r=$2)<<$3)|((\$r>>$su)&$sh))+$4"; + + $insert .= "\t$c\n"; + } + close DATA; + + my $dump = ' + sub round { + my ($a,$b,$c,$d) = @_[0 .. 3]; + my $r;' . $insert . ' + $_[0]+$a' . $MSK . ', $_[1]+$b ' . $MSK . + ', $_[2]+$c' . $MSK . ', $_[3]+$d' . $MSK . '; + }'; + eval $dump; +} + +gen_code(); + +sub _encode_hex { unpack 'H*', $_[0] } + +sub md5 { + my $message = padding(join'',@_); + my ($a,$b,$c,$d) = (A,B,C,D); + my $i; + for $i (0 .. (length $message)/64-1) { + my @X = unpack 'V16', substr $message,$i*64,64; + ($a,$b,$c,$d) = round($a,$b,$c,$d,@X); + } + pack 'V4',$a,$b,$c,$d; +} + +my $strings = { + 'd41d8cd98f00b204e9800998ecf8427e' => '', + '0cc175b9c0f1b6a831c399e269772661' => 'a', + '900150983cd24fb0d6963f7d28e17f72' => 'abc', + 'f96b697d7cb7938d525a2f31aaf161d0' => 'message digest', + 'c3fcd3d76192e4007dfb496cca67e13b' => 'abcdefghijklmnopqrstuvwxyz', + 'd174ab98d277d9f5a5611c2c9f419d9f' => 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789', + '57edf4a22be3c955ac49da2e2107b67a' => '12345678901234567890123456789012345678901234567890123456789012345678901234567890', +}; + +for my $k (keys %$strings) { + my $digest = _encode_hex md5($strings->{$k}); + is($digest, $k, "$digest is MD5 digest $strings->{$k}"); +} + +__DATA__ +FF,$a,$b,$c,$d,$_[4],7,0xd76aa478,/* 1 */ +FF,$d,$a,$b,$c,$_[5],12,0xe8c7b756,/* 2 */ +FF,$c,$d,$a,$b,$_[6],17,0x242070db,/* 3 */ +FF,$b,$c,$d,$a,$_[7],22,0xc1bdceee,/* 4 */ +FF,$a,$b,$c,$d,$_[8],7,0xf57c0faf,/* 5 */ +FF,$d,$a,$b,$c,$_[9],12,0x4787c62a,/* 6 */ +FF,$c,$d,$a,$b,$_[10],17,0xa8304613,/* 7 */ +FF,$b,$c,$d,$a,$_[11],22,0xfd469501,/* 8 */ +FF,$a,$b,$c,$d,$_[12],7,0x698098d8,/* 9 */ +FF,$d,$a,$b,$c,$_[13],12,0x8b44f7af,/* 10 */ +FF,$c,$d,$a,$b,$_[14],17,0xffff5bb1,/* 11 */ +FF,$b,$c,$d,$a,$_[15],22,0x895cd7be,/* 12 */ +FF,$a,$b,$c,$d,$_[16],7,0x6b901122,/* 13 */ +FF,$d,$a,$b,$c,$_[17],12,0xfd987193,/* 14 */ +FF,$c,$d,$a,$b,$_[18],17,0xa679438e,/* 15 */ +FF,$b,$c,$d,$a,$_[19],22,0x49b40821,/* 16 */ +GG,$a,$b,$c,$d,$_[5],5,0xf61e2562,/* 17 */ +GG,$d,$a,$b,$c,$_[10],9,0xc040b340,/* 18 */ +GG,$c,$d,$a,$b,$_[15],14,0x265e5a51,/* 19 */ +GG,$b,$c,$d,$a,$_[4],20,0xe9b6c7aa,/* 20 */ +GG,$a,$b,$c,$d,$_[9],5,0xd62f105d,/* 21 */ +GG,$d,$a,$b,$c,$_[14],9,0x2441453,/* 22 */ +GG,$c,$d,$a,$b,$_[19],14,0xd8a1e681,/* 23 */ +GG,$b,$c,$d,$a,$_[8],20,0xe7d3fbc8,/* 24 */ +GG,$a,$b,$c,$d,$_[13],5,0x21e1cde6,/* 25 */ +GG,$d,$a,$b,$c,$_[18],9,0xc33707d6,/* 26 */ +GG,$c,$d,$a,$b,$_[7],14,0xf4d50d87,/* 27 */ +GG,$b,$c,$d,$a,$_[12],20,0x455a14ed,/* 28 */ +GG,$a,$b,$c,$d,$_[17],5,0xa9e3e905,/* 29 */ +GG,$d,$a,$b,$c,$_[6],9,0xfcefa3f8,/* 30 */ +GG,$c,$d,$a,$b,$_[11],14,0x676f02d9,/* 31 */ +GG,$b,$c,$d,$a,$_[16],20,0x8d2a4c8a,/* 32 */ +HH,$a,$b,$c,$d,$_[9],4,0xfffa3942,/* 33 */ +HH,$d,$a,$b,$c,$_[12],11,0x8771f681,/* 34 */ +HH,$c,$d,$a,$b,$_[15],16,0x6d9d6122,/* 35 */ +HH,$b,$c,$d,$a,$_[18],23,0xfde5380c,/* 36 */ +HH,$a,$b,$c,$d,$_[5],4,0xa4beea44,/* 37 */ +HH,$d,$a,$b,$c,$_[8],11,0x4bdecfa9,/* 38 */ +HH,$c,$d,$a,$b,$_[11],16,0xf6bb4b60,/* 39 */ +HH,$b,$c,$d,$a,$_[14],23,0xbebfbc70,/* 40 */ +HH,$a,$b,$c,$d,$_[17],4,0x289b7ec6,/* 41 */ +HH,$d,$a,$b,$c,$_[4],11,0xeaa127fa,/* 42 */ +HH,$c,$d,$a,$b,$_[7],16,0xd4ef3085,/* 43 */ +HH,$b,$c,$d,$a,$_[10],23,0x4881d05,/* 44 */ +HH,$a,$b,$c,$d,$_[13],4,0xd9d4d039,/* 45 */ +HH,$d,$a,$b,$c,$_[16],11,0xe6db99e5,/* 46 */ +HH,$c,$d,$a,$b,$_[19],16,0x1fa27cf8,/* 47 */ +HH,$b,$c,$d,$a,$_[6],23,0xc4ac5665,/* 48 */ +II,$a,$b,$c,$d,$_[4],6,0xf4292244,/* 49 */ +II,$d,$a,$b,$c,$_[11],10,0x432aff97,/* 50 */ +II,$c,$d,$a,$b,$_[18],15,0xab9423a7,/* 51 */ +II,$b,$c,$d,$a,$_[9],21,0xfc93a039,/* 52 */ +II,$a,$b,$c,$d,$_[16],6,0x655b59c3,/* 53 */ +II,$d,$a,$b,$c,$_[7],10,0x8f0ccc92,/* 54 */ +II,$c,$d,$a,$b,$_[14],15,0xffeff47d,/* 55 */ +II,$b,$c,$d,$a,$_[5],21,0x85845dd1,/* 56 */ +II,$a,$b,$c,$d,$_[12],6,0x6fa87e4f,/* 57 */ +II,$d,$a,$b,$c,$_[19],10,0xfe2ce6e0,/* 58 */ +II,$c,$d,$a,$b,$_[10],15,0xa3014314,/* 59 */ +II,$b,$c,$d,$a,$_[17],21,0x4e0811a1,/* 60 */ +II,$a,$b,$c,$d,$_[8],6,0xf7537e82,/* 61 */ +II,$d,$a,$b,$c,$_[15],10,0xbd3af235,/* 62 */ +II,$c,$d,$a,$b,$_[6],15,0x2ad7d2bb,/* 63 */ +II,$b,$c,$d,$a,$_[13],21,0xeb86d391,/* 64 */ diff --git a/Task/MD5-Implementation/REXX/md5-implementation.rexx b/Task/MD5-Implementation/REXX/md5-implementation.rexx index 700ce37093..0fbbdcce47 100644 --- a/Task/MD5-Implementation/REXX/md5-implementation.rexx +++ b/Task/MD5-Implementation/REXX/md5-implementation.rexx @@ -1,124 +1,115 @@ -/*REXX program to test the MD5 procedure as per the test suite in the */ -/* IETF RFC (1321) ─── The MD5 Message─Digest Algorithm. April 1992. */ +/*REXX program tests the MD5 procedure (below) as per a test suite the IETF RFC (1321).*/ +msg.1 = /*─────MD5 test suite [from above doc].*/ +msg.2 = 'a' +msg.3 = 'abc' +msg.4 = 'message digest' +msg.5 = 'abcdefghijklmnopqrstuvwxyz' +msg.6 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789' +msg.7 = 12345678901234567890123456789012345678901234567890123456789012345678901234567890 +msg.0 = 7 /* [↑] last value doesn't need quotes.*/ + do m=1 for msg.0; say /*process each of the seven messages. */ + say ' in =' msg.m /*display the in message. */ + say 'out =' MD5(msg.m) /* " " out " */ + end /*m*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +MD5: procedure; parse arg !; numeric digits 20 /*insure there's enough decimal digits.*/ + a='67452301'x; b="efcdab89"x; c='98badcfe'x; d="10325476"x; x00='0'x; x80="80"x + #=length(!) /*length in bytes of the input message.*/ + L=#*8//512; if L<448 then plus=448-L /*is the length less than 448 ? */ + if L>448 then plus=960-L /* " " " greater " " */ + if L=448 then plus=512 /* " " " equal to " */ + x00000000='00000000'x /* [↓] a little of this, ··· */ + $=! || x80 || copies( x00, plus%8 -1 )reverse(right(d2c(8 * #), 4, x00)) || x00000000 + /* [↑] ··· and a little of that.*/ + do j=0 to length($)%64-1 /*process the message (lots of steps).*/ + a_=a; b_=b; c_=c; d_=d /*save the original values for later.*/ + chunk=j*64 /*calculate the size of the chunks. */ + do k=1 for 16 /*process the message in chunks. */ + !.k=reverse( substr($, chunk + 1 + 4*(k-1), 4) ) /*magic stuff.*/ + end /*k*/ -/*─────────────────────────────────────Md5 test suite (from above doc). */ -msg.1='' -msg.2='a' -msg.3='abc' -msg.4='message digest' -msg.5='abcdefghijklmnopqrstuvwxyz' -msg.6='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789' -msg.7='12345678901234567890123456789012345678901234567890123456789012345678901234567890' -msg.0=7 - do m=1 for msg.0 - say ' in =' msg.m - say 'out =' MD5(msg.m) - say - end /*m*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────MD5 subroutine──────────────────────*/ -MD5: procedure; parse arg !; numeric digits 20 /*insure enough digits.*/ -parse value '67452301'x 'efcdab89'x '98badcfe'x '10325476'x with a b c d -#=length(!) -L=#*8 // 512 - select - when L<448 then plus=448-L - when L>448 then plus=960-L - when L=448 then plus=512 - end /*select*/ + a = .part1( a, b, c, d, 0, 7, 3614090360) /*■■■■ 1 ■■■■*/ + d = .part1( d, a, b, c, 1, 12, 3905402710) /*■■■■ 2 ■■■■*/ + c = .part1( c, d, a, b, 2, 17, 606105819) /*■■■■ 3 ■■■■*/ + b = .part1( b, c, d, a, 3, 22, 3250441966) /*■■■■ 4 ■■■■*/ + a = .part1( a, b, c, d, 4, 7, 4118548399) /*■■■■ 5 ■■■■*/ + d = .part1( d, a, b, c, 5, 12, 1200080426) /*■■■■ 6 ■■■■*/ + c = .part1( c, d, a, b, 6, 17, 2821735955) /*■■■■ 7 ■■■■*/ + b = .part1( b, c, d, a, 7, 22, 4249261313) /*■■■■ 8 ■■■■*/ + a = .part1( a, b, c, d, 8, 7, 1770035416) /*■■■■ 9 ■■■■*/ + d = .part1( d, a, b, c, 9, 12, 2336552879) /*■■■■ 10 ■■■■*/ + c = .part1( c, d, a, b, 10, 17, 4294925233) /*■■■■ 11 ■■■■*/ + b = .part1( b, c, d, a, 11, 22, 2304563134) /*■■■■ 12 ■■■■*/ + a = .part1( a, b, c, d, 12, 7, 1804603682) /*■■■■ 13 ■■■■*/ + d = .part1( d, a, b, c, 13, 12, 4254626195) /*■■■■ 14 ■■■■*/ + c = .part1( c, d, a, b, 14, 17, 2792965006) /*■■■■ 15 ■■■■*/ + b = .part1( b, c, d, a, 15, 22, 1236535329) /*■■■■ 16 ■■■■*/ + a = .part2( a, b, c, d, 1, 5, 4129170786) /*■■■■ 17 ■■■■*/ + d = .part2( d, a, b, c, 6, 9, 3225465664) /*■■■■ 18 ■■■■*/ + c = .part2( c, d, a, b, 11, 14, 643717713) /*■■■■ 19 ■■■■*/ + b = .part2( b, c, d, a, 0, 20, 3921069994) /*■■■■ 20 ■■■■*/ + a = .part2( a, b, c, d, 5, 5, 3593408605) /*■■■■ 21 ■■■■*/ + d = .part2( d, a, b, c, 10, 9, 38016083) /*■■■■ 22 ■■■■*/ + c = .part2( c, d, a, b, 15, 14, 3634488961) /*■■■■ 23 ■■■■*/ + b = .part2( b, c, d, a, 4, 20, 3889429448) /*■■■■ 24 ■■■■*/ + a = .part2( a, b, c, d, 9, 5, 568446438) /*■■■■ 25 ■■■■*/ + d = .part2( d, a, b, c, 14, 9, 3275163606) /*■■■■ 26 ■■■■*/ + c = .part2( c, d, a, b, 3, 14, 4107603335) /*■■■■ 27 ■■■■*/ + b = .part2( b, c, d, a, 8, 20, 1163531501) /*■■■■ 28 ■■■■*/ + a = .part2( a, b, c, d, 13, 5, 2850285829) /*■■■■ 29 ■■■■*/ + d = .part2( d, a, b, c, 2, 9, 4243563512) /*■■■■ 30 ■■■■*/ + c = .part2( c, d, a, b, 7, 14, 1735328473) /*■■■■ 31 ■■■■*/ + b = .part2( b, c, d, a, 12, 20, 2368359562) /*■■■■ 32 ■■■■*/ + a = .part3( a, b, c, d, 5, 4, 4294588738) /*■■■■ 33 ■■■■*/ + d = .part3( d, a, b, c, 8, 11, 2272392833) /*■■■■ 34 ■■■■*/ + c = .part3( c, d, a, b, 11, 16, 1839030562) /*■■■■ 35 ■■■■*/ + b = .part3( b, c, d, a, 14, 23, 4259657740) /*■■■■ 36 ■■■■*/ + a = .part3( a, b, c, d, 1, 4, 2763975236) /*■■■■ 37 ■■■■*/ + d = .part3( d, a, b, c, 4, 11, 1272893353) /*■■■■ 38 ■■■■*/ + c = .part3( c, d, a, b, 7, 16, 4139469664) /*■■■■ 39 ■■■■*/ + b = .part3( b, c, d, a, 10, 23, 3200236656) /*■■■■ 40 ■■■■*/ + a = .part3( a, b, c, d, 13, 4, 681279174) /*■■■■ 41 ■■■■*/ + d = .part3( d, a, b, c, 0, 11, 3936430074) /*■■■■ 42 ■■■■*/ + c = .part3( c, d, a, b, 3, 16, 3572445317) /*■■■■ 43 ■■■■*/ + b = .part3( b, c, d, a, 6, 23, 76029189) /*■■■■ 44 ■■■■*/ + a = .part3( a, b, c, d, 9, 4, 3654602809) /*■■■■ 45 ■■■■*/ + d = .part3( d, a, b, c, 12, 11, 3873151461) /*■■■■ 46 ■■■■*/ + c = .part3( c, d, a, b, 15, 16, 530742520) /*■■■■ 47 ■■■■*/ + b = .part3( b, c, d, a, 2, 23, 3299628645) /*■■■■ 48 ■■■■*/ + a = .part4( a, b, c, d, 0, 6, 4096336452) /*■■■■ 49 ■■■■*/ + d = .part4( d, a, b, c, 7, 10, 1126891415) /*■■■■ 50 ■■■■*/ + c = .part4( c, d, a, b, 14, 15, 2878612391) /*■■■■ 51 ■■■■*/ + b = .part4( b, c, d, a, 5, 21, 4237533241) /*■■■■ 52 ■■■■*/ + a = .part4( a, b, c, d, 12, 6, 1700485571) /*■■■■ 53 ■■■■*/ + d = .part4( d, a, b, c, 3, 10, 2399980690) /*■■■■ 54 ■■■■*/ + c = .part4( c, d, a, b, 10, 15, 4293915773) /*■■■■ 55 ■■■■*/ + b = .part4( b, c, d, a, 1, 21, 2240044497) /*■■■■ 56 ■■■■*/ + a = .part4( a, b, c, d, 8, 6, 1873313359) /*■■■■ 57 ■■■■*/ + d = .part4( d, a, b, c, 15, 10, 4264355552) /*■■■■ 58 ■■■■*/ + c = .part4( c, d, a, b, 6, 15, 2734768916) /*■■■■ 59 ■■■■*/ + b = .part4( b, c, d, a, 13, 21, 1309151649) /*■■■■ 60 ■■■■*/ + a = .part4( a, b, c, d, 4, 6, 4149444226) /*■■■■ 61 ■■■■*/ + d = .part4( d, a, b, c, 11, 10, 3174756917) /*■■■■ 62 ■■■■*/ + c = .part4( c, d, a, b, 2, 15, 718787259) /*■■■■ 63 ■■■■*/ + b = .part4( b, c, d, a, 9, 21, 3951481745) /*■■■■ 64 ■■■■*/ + a = .a(a_,a); b=.a(b_,b); c=.a(c_,c); d=.a(d_,d) + end /*j*/ -$=!||'80'x||copies('0'x,plus%8-1)reverse(right(d2c(8*#),4,'0'x))||'00000000'x - - do j=0 to length($)%64-1 /*process message (lots of steps)*/ - a_=a; b_=b; c_=c; d_=d - chunk=j*64 - do k=1 for 16 /*process the message in chunks. */ - !.k=reverse(substr($,chunk+1+4*(k-1),4)) - end /*k*/ - - a=.part1(a,b,c,d, 0, 7,3614090360) /* 1*/ - d=.part1(d,a,b,c, 1,12,3905402710) /* 2*/ - c=.part1(c,d,a,b, 2,17, 606105819) /* 3*/ - b=.part1(b,c,d,a, 3,22,3250441966) /* 4*/ - a=.part1(a,b,c,d, 4, 7,4118548399) /* 5*/ - d=.part1(d,a,b,c, 5,12,1200080426) /* 6*/ - c=.part1(c,d,a,b, 6,17,2821735955) /* 7*/ - b=.part1(b,c,d,a, 7,22,4249261313) /* 8*/ - a=.part1(a,b,c,d, 8, 7,1770035416) /* 9*/ - d=.part1(d,a,b,c, 9,12,2336552879) /*10*/ - c=.part1(c,d,a,b,10,17,4294925233) /*11*/ - b=.part1(b,c,d,a,11,22,2304563134) /*12*/ - a=.part1(a,b,c,d,12, 7,1804603682) /*13*/ - d=.part1(d,a,b,c,13,12,4254626195) /*14*/ - c=.part1(c,d,a,b,14,17,2792965006) /*15*/ - b=.part1(b,c,d,a,15,22,1236535329) /*16*/ - a=.part2(a,b,c,d, 1, 5,4129170786) /*17*/ - d=.part2(d,a,b,c, 6, 9,3225465664) /*18*/ - c=.part2(c,d,a,b,11,14, 643717713) /*19*/ - b=.part2(b,c,d,a, 0,20,3921069994) /*20*/ - a=.part2(a,b,c,d, 5, 5,3593408605) /*21*/ - d=.part2(d,a,b,c,10, 9, 38016083) /*22*/ - c=.part2(c,d,a,b,15,14,3634488961) /*23*/ - b=.part2(b,c,d,a, 4,20,3889429448) /*24*/ - a=.part2(a,b,c,d, 9, 5, 568446438) /*25*/ - d=.part2(d,a,b,c,14, 9,3275163606) /*26*/ - c=.part2(c,d,a,b, 3,14,4107603335) /*27*/ - b=.part2(b,c,d,a, 8,20,1163531501) /*28*/ - a=.part2(a,b,c,d,13, 5,2850285829) /*29*/ - d=.part2(d,a,b,c, 2, 9,4243563512) /*30*/ - c=.part2(c,d,a,b, 7,14,1735328473) /*31*/ - b=.part2(b,c,d,a,12,20,2368359562) /*32*/ - a=.part3(a,b,c,d, 5, 4,4294588738) /*33*/ - d=.part3(d,a,b,c, 8,11,2272392833) /*34*/ - c=.part3(c,d,a,b,11,16,1839030562) /*35*/ - b=.part3(b,c,d,a,14,23,4259657740) /*36*/ - a=.part3(a,b,c,d, 1, 4,2763975236) /*37*/ - d=.part3(d,a,b,c, 4,11,1272893353) /*38*/ - c=.part3(c,d,a,b, 7,16,4139469664) /*39*/ - b=.part3(b,c,d,a,10,23,3200236656) /*40*/ - a=.part3(a,b,c,d,13, 4, 681279174) /*41*/ - d=.part3(d,a,b,c, 0,11,3936430074) /*42*/ - c=.part3(c,d,a,b, 3,16,3572445317) /*43*/ - b=.part3(b,c,d,a, 6,23, 76029189) /*44*/ - a=.part3(a,b,c,d, 9, 4,3654602809) /*45*/ - d=.part3(d,a,b,c,12,11,3873151461) /*46*/ - c=.part3(c,d,a,b,15,16, 530742520) /*47*/ - b=.part3(b,c,d,a, 2,23,3299628645) /*48*/ - a=.part4(a,b,c,d, 0, 6,4096336452) /*49*/ - d=.part4(d,a,b,c, 7,10,1126891415) /*50*/ - c=.part4(c,d,a,b,14,15,2878612391) /*51*/ - b=.part4(b,c,d,a, 5,21,4237533241) /*52*/ - a=.part4(a,b,c,d,12, 6,1700485571) /*53*/ - d=.part4(d,a,b,c, 3,10,2399980690) /*54*/ - c=.part4(c,d,a,b,10,15,4293915773) /*55*/ - b=.part4(b,c,d,a, 1,21,2240044497) /*56*/ - a=.part4(a,b,c,d, 8, 6,1873313359) /*57*/ - d=.part4(d,a,b,c,15,10,4264355552) /*58*/ - c=.part4(c,d,a,b, 6,15,2734768916) /*59*/ - b=.part4(b,c,d,a,13,21,1309151649) /*60*/ - a=.part4(a,b,c,d, 4, 6,4149444226) /*61*/ - d=.part4(d,a,b,c,11,10,3174756917) /*62*/ - c=.part4(c,d,a,b, 2,15, 718787259) /*63*/ - b=.part4(b,c,d,a, 9,21,3951481745) /*64*/ - a=.a(a_,a); b=.a(b_,b); c=.a(c_,c); d=.a(d_,d) - end /*j*/ - -return c2x(reverse(a))c2x(reverse(b))c2x(reverse(c))c2x(reverse(d)) -/*─────────────────────────────────────subroutines──────────────────────*/ -.part1: procedure expose !.; parse arg w,x,y,z,n,m,_; n=n+1 - return .a(.lR(right(d2c(_+c2d(w)+c2d(.f(x,y,z))+c2d(!.n)),4,'0'x),m),x) -.part2: procedure expose !.; parse arg w,x,y,z,n,m,_; n=n+1 - return .a(.lR(right(d2c(_+c2d(w)+c2d(.g(x,y,z))+c2d(!.n)),4,'0'x),m),x) -.part3: procedure expose !.; parse arg w,x,y,z,n,m,_; n=n+1 - return .a(.lR(right(d2c(_+c2d(w)+c2d(.h(x,y,z))+c2d(!.n)),4,'0'x),m),x) -.part4: procedure expose !.; parse arg w,x,y,z,n,m; n=n+1 - return .a(.lR(right(d2c(c2d(w)+c2d(.i(x,y,z))+c2d(!.n)+arg(7)),4,'0'x),m),x) -.h: procedure; parse arg x,y,z; return bitxor(bitxor(x,y),z) -.i: return bitxor(arg(2),bitor(arg(1),bitxor(arg(3),'ffffffff'x))) -.a: return right(d2c(c2d(arg(1))+c2d(arg(2))),4,'0'x) -.f: procedure; parse arg x,y,z - return bitor(bitand(x,y),bitand(bitxor(x,'ffffffff'x),z)) -.g: procedure; parse arg x,y,z - return bitor(bitand(x,z),bitand(y,bitxor(z,'ffffffff'x))) -.lR: procedure; parse arg _,#; if #==0 then return _ /*left rotate.*/ - ?=x2b(c2x(_)); return x2c(b2x(right(?||left(?,#),length(?)))) + return c2x( reverse(a) )c2x( reverse(b) )c2x( reverse(c) )c2x( reverse(d) ) +/*──────────────────────────────────────────────────────────────────────────────────────*/ +.a: return right(d2c(c2d(arg(1)) + c2d(arg(2))), 4, '0'x) +.h: return bitxor(bitxor(arg(1), arg(2)), arg(3)) +.i: return bitxor(arg(2), bitor(arg(1), bitxor(arg(3), 'ffffffff'x))) +.f: return bitor(bitand(arg(1),arg(2)), bitand(bitxor(arg(1), 'ffffffff'x), arg(3))) +.g: return bitor(bitand(arg(1),arg(3)), bitand(arg(2), bitxor(arg(3), 'ffffffff'x))) +.Lr: procedure; parse arg _,#; if #==0 then return _ /*left rotate.*/ + ?=x2b(c2x(_)); return x2c(b2x(right(? || left(?, #), length(?)))) +.part1: procedure expose !.; parse arg w,x,y,z,n,m,_; n=n+1 + return .a(.Lr(right(d2c(_+c2d(w)+c2d(.f(x,y,z))+c2d(!.n)),4,'0'x),m),x) +.part2: procedure expose !.; parse arg w,x,y,z,n,m,_; n=n+1 + return .a(.Lr(right(d2c(_+c2d(w)+c2d(.g(x,y,z))+c2d(!.n)),4,'0'x),m),x) +.part3: procedure expose !.; parse arg w,x,y,z,n,m,_; n=n+1 + return .a(.Lr(right(d2c(_+c2d(w)+c2d(.h(x,y,z))+c2d(!.n)),4,'0'x),m),x) +.part4: procedure expose !.; parse arg w,x,y,z,n,m,_; n=n+1 + return .a(.Lr(right(d2c(c2d(w)+c2d(.i(x,y,z))+c2d(!.n)+_),4,'0'x),m),x) diff --git a/Task/MD5-Implementation/RPG/md5-implementation.rpg b/Task/MD5-Implementation/RPG/md5-implementation.rpg new file mode 100644 index 0000000000..601db3f882 --- /dev/null +++ b/Task/MD5-Implementation/RPG/md5-implementation.rpg @@ -0,0 +1,243 @@ +**FREE +Ctl-opt MAIN(Main); +Ctl-opt DFTACTGRP(*NO) ACTGRP(*NEW); + +dcl-pr QDCXLATE EXTPGM('QDCXLATE'); + dataLen packed(5 : 0) CONST; + data char(32767) options(*VARSIZE); + conversionTable char(10) CONST; +end-pr; + +dcl-c MASK32 CONST(4294967295); +dcl-s SHIFT_AMTS int(3) dim(16) CTDATA PERRCD(16); +dcl-s MD5_TABLE_T int(20) dim(64) CTDATA PERRCD(4); + +dcl-proc Main; + dcl-s inputData char(45); + dcl-s inputDataLen int(10) INZ(0); + dcl-s outputHash char(16); + dcl-s outputHashHex char(32); + + DSPLY 'Input: ' '' inputData; + inputData = %trim(inputData); + inputDataLen = %len(%trim(inputData)); + DSPLY ('Input=' + inputData); + DSPLY ('InputLen=' + %char(inputDataLen)); + + // Convert from EBCDIC to ASCII + if inputDataLen > 0; + QDCXLATE(inputDataLen : inputData : 'QTCPASC'); + endif; + CalculateMD5(inputData : inputDataLen : outputHash); + // Convert to hex + ConvertToHex(outputHash : 16 : outputHashHex); + DSPLY ('MD5: ' + outputHashHex); + return; +end-proc; + +dcl-proc CalculateMD5; + dcl-pi *N; + message char(65535) options(*VARSIZE) CONST; + messageLen int(10) value; + outputHash char(16); + end-pi; + dcl-s numBlocks int(10); + dcl-s padding char(72); + dcl-s a int(20) INZ(1732584193); + dcl-s b int(20) INZ(4023233417); + dcl-s c int(20) INZ(2562383102); + dcl-s d int(20) INZ(271733878); + dcl-s buffer int(20) dim(16) INZ(0); + dcl-s i int(10); + dcl-s j int(10); + dcl-s k int(10); + dcl-s multiplier int(20); + dcl-s index int(10); + dcl-s originalA int(20); + dcl-s originalB int(20); + dcl-s originalC int(20); + dcl-s originalD int(20); + dcl-s div16 int(10); + dcl-s f int(20); + dcl-s tempInt int(20); + dcl-s bufferIndex int(10); + dcl-ds byteToInt QUALIFIED; + n int(5) INZ(0); + c char(1) OVERLAY(n : 2); + end-ds; + + numBlocks = (messageLen + 8) / 64 + 1; + MD5_FillPadding(messageLen : numBlocks : padding); + for i = 0 to numBlocks - 1; + index = i * 64; + + // Read message as little-endian 32-bit words + for j = 1 to 16; + multiplier = 1; + for k = 1 to 4; + index += 1; + if index <= messageLen; + byteToInt.c = %subst(message : index : 1); + else; + byteToInt.c = %subst(padding : index - messageLen : 1); + endif; + buffer(j) += multiplier * byteToInt.n; + multiplier *= 256; + endfor; + endfor; + + originalA = a; + originalB = b; + originalC = c; + originalD = d; + + for j = 0 to 63; + div16 = j / 16; + select; + when div16 = 0; + f = %bitor(%bitand(b : c) : %bitand(%bitnot(b) : d)); + bufferIndex = j; + + when div16 = 1; + f = %bitor(%bitand(b : d) : %bitand(c : %bitnot(d))); + bufferIndex = %bitand(j * 5 + 1 : 15); + + when div16 = 2; + f = %bitxor(b : %bitxor(c : d)); + bufferIndex = %bitand(j * 3 + 5 : 15); + + when div16 = 3; + f = %bitxor(c : %bitor(b : Mask32Bit(%bitnot(d)))); + bufferIndex = %bitand(j * 7 : 15); + endsl; + tempInt = Mask32Bit(b + RotateLeft32Bit(a + f + buffer(bufferIndex + 1) + MD5_TABLE_T(j + 1) : + SHIFT_AMTS(div16 * 4 + %bitand(j : 3) + 1))); + a = d; + d = c; + c = b; + b = tempInt; + endfor; + a = Mask32Bit(a + originalA); + b = Mask32Bit(b + originalB); + c = Mask32Bit(c + originalC); + d = Mask32Bit(d + originalD); + endfor; + + for i = 0 to 3; + if i = 0; + tempInt = a; + elseif i = 1; + tempInt = b; + elseif i = 2; + tempInt = c; + else; + tempInt = d; + endif; + + for j = 0 to 3; + byteToInt.n = %bitand(tempInt : 255); + %subst(outputHash : i * 4 + j + 1 : 1) = byteToInt.c; + tempInt /= 256; + endfor; + endfor; + return; +end-proc; + +dcl-proc MD5_FillPadding; + dcl-pi *N; + messageLen int(10); + numBlocks int(10); + padding char(72); + end-pi; + dcl-s totalLen int(10); + dcl-s paddingSize int(10); + dcl-ds *N; + messageLenBits int(20); + mlb_bytes char(8) OVERLAY(messageLenBits); + end-ds; + dcl-s i int(10); + + %subst(padding : 1 : 1) = X'80'; + totalLen = numBlocks * 64; + paddingSize = totalLen - messageLen; // 9 to 72 + messageLenBits = messageLen; + messageLenBits *= 8; + for i = 1 to 8; + %subst(padding : paddingSize - i + 1 : 1) = %subst(mlb_bytes : i : 1); + endfor; + for i = 2 to paddingSize - 8; + %subst(padding : i : 1) = X'00'; + endfor; + return; +end-proc; + +dcl-proc RotateLeft32Bit; + dcl-pi *N int(20); + n int(20) value; + amount int(3) value; + end-pi; + dcl-s i int(3); + + n = Mask32Bit(n); + for i = 1 to amount; + n *= 2; + if n >= 4294967296; + n -= MASK32; + endif; + endfor; + return n; +end-proc; + +dcl-proc Mask32Bit; + dcl-pi *N int(20); + n int(20) value; + end-pi; + return %bitand(n : MASK32); +end-proc; + +dcl-proc ConvertToHex; + dcl-pi *N; + inputData char(32767) options(*VARSIZE) CONST; + inputDataLen int(10) value; + outputData char(65534) options(*VARSIZE); + end-pi; + dcl-c HEX_CHARS CONST('0123456789ABCDEF'); + dcl-s i int(10); + dcl-s outputOffset int(10) INZ(1); + dcl-ds dataStruct QUALIFIED; + numField int(5) INZ(0); + // IBM i is big-endian + charField char(1) OVERLAY(numField : 2); + end-ds; + + for i = 1 to inputDataLen; + dataStruct.charField = %BitAnd(%subst(inputData : i : 1) : X'F0'); + dataStruct.numField /= 16; + %subst(outputData : outputOffset : 1) = %subst(HEX_CHARS : dataStruct.numField + 1 : 1); + outputOffset += 1; + dataStruct.charField = %BitAnd(%subst(inputData : i : 1) : X'0F'); + %subst(outputData : outputOffset : 1) = %subst(HEX_CHARS : dataStruct.numField + 1 : 1); + outputOffset += 1; + endfor; + return; +end-proc; + +**CTDATA SHIFT_AMTS + 7 12 17 22 5 9 14 20 4 11 16 23 6 10 15 21 +**CTDATA MD5_TABLE_T + 3614090360 3905402710 606105819 3250441966 + 4118548399 1200080426 2821735955 4249261313 + 1770035416 2336552879 4294925233 2304563134 + 1804603682 4254626195 2792965006 1236535329 + 4129170786 3225465664 643717713 3921069994 + 3593408605 38016083 3634488961 3889429448 + 568446438 3275163606 4107603335 1163531501 + 2850285829 4243563512 1735328473 2368359562 + 4294588738 2272392833 1839030562 4259657740 + 2763975236 1272893353 4139469664 3200236656 + 681279174 3936430074 3572445317 76029189 + 3654602809 3873151461 530742520 3299628645 + 4096336452 1126891415 2878612391 4237533241 + 1700485571 2399980690 4293915773 2240044497 + 1873313359 4264355552 2734768916 1309151649 + 4149444226 3174756917 718787259 3951481745 diff --git a/Task/MD5/00DESCRIPTION b/Task/MD5/00DESCRIPTION index 7668436829..420436d40c 100644 --- a/Task/MD5/00DESCRIPTION +++ b/Task/MD5/00DESCRIPTION @@ -1,7 +1,12 @@ -Encode a string using an MD5 algorithm. The algorithm can be found on [[wp:Md5#Algorithm|wikipedia]]. +;Task: +Encode a string using an MD5 algorithm.   The algorithm can be found on   [[wp:Md5#Algorithm|Wikipedia]]. -Optionally, validate your implementation by running all of the test values in [http://tools.ietf.org/html/rfc1321 IETF RFC (1321) for MD5]. Additional the RFC provides more precise information on the algorithm than the Wikipedia article. -{{alertbox|lightgray|'''Warning:''' MD5 has [http://tools.ietf.org/html/rfc6151 known weaknesses], including '''collisions''' and [http://www.win.tue.nl/hashclash/rogue-ca/ forged signatures]. Users may consider a stronger alternative when doing production-grade cryptography, such as SHA-256 (from the SHA-2 family) or the upcoming SHA-3.}} +Optionally, validate your implementation by running all of the test values in   [http://tools.ietf.org/html/rfc1321 IETF RFC (1321)   for MD5]. -If the solution on this page is a library solution, see [[MD5/Implementation]] for an implementation from scratch. +Additionally,   RFC 1321   provides more precise information on the algorithm than the Wikipedia article. + +{{alertbox|lightgray|'''Warning:'''   MD5 has [http://tools.ietf.org/html/rfc6151 known weaknesses], including '''collisions''' and [http://www.win.tue.nl/hashclash/rogue-ca/ forged signatures].   Users may consider a stronger alternative when doing production-grade cryptography, such as SHA-256 (from the SHA-2 family), or the upcoming SHA-3.}} + +If the solution on this page is a library solution, see   [[MD5/Implementation]]   for an implementation from scratch. +

    diff --git a/Task/MD5/Fortran/md5.f b/Task/MD5/Fortran/md5.f new file mode 100644 index 0000000000..8618ebdf9e --- /dev/null +++ b/Task/MD5/Fortran/md5.f @@ -0,0 +1,94 @@ +module md5_m + use kernel32 + use advapi32 + implicit none + integer, parameter :: MD5LEN = 16 +contains + subroutine md5hash(name, hash, dwStatus, filesize) + implicit none + character(*) :: name + integer, parameter :: BUFLEN = 32768 + integer(HANDLE) :: hFile, hProv, hHash + integer(DWORD) :: dwStatus, nRead + integer(BOOL) :: status + integer(BYTE) :: buffer(BUFLEN) + integer(BYTE) :: hash(MD5LEN) + integer(UINT64) :: filesize + + dwStatus = 0 + filesize = 0 + hFile = CreateFile(trim(name) // char(0), GENERIC_READ, FILE_SHARE_READ, NULL, & + OPEN_EXISTING, FILE_FLAG_SEQUENTIAL_SCAN, NULL) + + if (hFile == INVALID_HANDLE_VALUE) then + dwStatus = GetLastError() + print *, "CreateFile failed." + return + end if + + if (CryptAcquireContext(hProv, NULL, NULL, PROV_RSA_FULL, & + CRYPT_VERIFYCONTEXT) == FALSE) then + dwStatus = GetLastError() + print *, "CryptAcquireContext failed." + goto 3 + end if + + if (CryptCreateHash(hProv, CALG_MD5, 0_ULONG_PTR, 0_DWORD, hHash) == FALSE) then + dwStatus = GetLastError() + print *, "CryptCreateHash failed." + go to 2 + end if + + do + status = ReadFile(hFile, loc(buffer), BUFLEN, loc(nRead), NULL) + if (status == FALSE .or. nRead == 0) exit + filesize = filesize + nRead + if (CryptHashData(hHash, buffer, nRead, 0) == FALSE) then + dwStatus = GetLastError() + print *, "CryptHashData failed." + go to 1 + end if + end do + + if (status == FALSE) then + dwStatus = GetLastError() + print *, "ReadFile failed." + go to 1 + end if + + nRead = MD5LEN + if (CryptGetHashParam(hHash, HP_HASHVAL, hash, nRead, 0) == FALSE) then + dwStatus = GetLastError() + print *, "CryptGetHashParam failed.", status, nRead, dwStatus + end if + + 1 status = CryptDestroyHash(hHash) + 2 status = CryptReleaseContext(hProv, 0) + 3 status = CloseHandle(hFile) + end subroutine +end module + +program md5 + use md5_m + implicit none + integer :: n, m, i, j + character(:), allocatable :: name + integer(DWORD) :: dwStatus + integer(BYTE) :: hash(MD5LEN) + integer(UINT64) :: filesize + + n = command_argument_count() + do i = 1, n + call get_command_argument(i, length=m) + allocate(character(m) :: name) + call get_command_argument(i, name) + call md5hash(name, hash, dwStatus, filesize) + if (dwStatus*0 == 0) then + do j = 1, MD5LEN + write(*, "(Z2.2)", advance="NO") hash(j) + end do + write(*, "(' ',A,' (',G0,' bytes)')") name, filesize + end if + deallocate(name) + end do +end program diff --git a/Task/MD5/J/md5.j b/Task/MD5/J/md5-1.j similarity index 100% rename from Task/MD5/J/md5.j rename to Task/MD5/J/md5-1.j diff --git a/Task/MD5/J/md5-2.j b/Task/MD5/J/md5-2.j new file mode 100644 index 0000000000..299febc7d9 --- /dev/null +++ b/Task/MD5/J/md5-2.j @@ -0,0 +1,4 @@ + require '~addons/ide/qt/qt.ijs' + getmd5=: 'md5'&gethash_jqtide_ + getmd5 'The quick brown fox jumped over the lazy dog''s back' +e38ca1d920c4b8b8d3946b2c72f01680 diff --git a/Task/MD5/PARI-GP/md5-1.pari b/Task/MD5/PARI-GP/md5-1.pari new file mode 100644 index 0000000000..45f6ee23f6 --- /dev/null +++ b/Task/MD5/PARI-GP/md5-1.pari @@ -0,0 +1,27 @@ +#include +#include + +#define HEX(x) (((x) < 10)? (x)+'0': (x)-10+'a') + +/* + * PARI/GP func: MD5 hash + * + * gp code: install("plug_md5", "s", "MD5", ""); + */ +GEN plug_md5(char *text) +{ + char md[MD5_DIGEST_LENGTH]; + char hash[sizeof(md) * 2 + 1]; + int i; + + MD5((unsigned char*)text, strlen(text), (unsigned char*)md); + + for (i = 0; i < sizeof(md); i++) { + hash[i+i] = HEX((md[i] >> 4) & 0x0f); + hash[i+i+1] = HEX(md[i] & 0x0f); + } + + hash[sizeof(md) * 2] = 0; + + return strtoGENstr(hash); +} diff --git a/Task/MD5/PARI-GP/md5-2.pari b/Task/MD5/PARI-GP/md5-2.pari new file mode 100644 index 0000000000..09a14b3faf --- /dev/null +++ b/Task/MD5/PARI-GP/md5-2.pari @@ -0,0 +1,3 @@ +install("plug_md5", "s", "MD5", "~/libmd5.so"); + +MD5("The quick brown fox jumped over the lazy dog's back") diff --git a/Task/MD5/REXX/md5.rexx b/Task/MD5/REXX/md5.rexx index 15ea1d9611..8a7d3e9c05 100644 --- a/Task/MD5/REXX/md5.rexx +++ b/Task/MD5/REXX/md5.rexx @@ -1,117 +1,114 @@ -/*REXX program tests the MD5 procedure as per the test suite in the */ -/*────── IETF RFC (1321) ────── The MD5 Message─Digest Algorithm. April 1992.*/ -msg.1 = /*─────MD5 test suite [from above doc].*/ +/*REXX program tests the MD5 procedure (below) as per a test suite the IETF RFC (1321).*/ +msg.1 = /*─────MD5 test suite [from above doc].*/ msg.2 = 'a' msg.3 = 'abc' msg.4 = 'message digest' msg.5 = 'abcdefghijklmnopqrstuvwxyz' msg.6 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789' msg.7 = 12345678901234567890123456789012345678901234567890123456789012345678901234567890 -msg.0 = 7 /* [↑] last value doesn't need quotes.*/ - do m=1 for msg.0 /*process each of the seven messages. */ - say ' in =' msg.m /*display the in message. */ - say 'out =' MD5(msg.m) /* " " out " */ - say /* " a blank like for a separator.*/ - end /*m*/ -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────MD5 subroutine────────────────────────────*/ -MD5: procedure; parse arg !; numeric digits 20 /*insure enough decimal digs.*/ -parse value '67452301'x 'efcdab89'x '98badcfe'x '10325476'x with a b c d -#=length(!) /*length of the input message*/ -L=#*8 // 512; if L<448 then plus=448-L - if L>448 then plus=960-L - if L=448 then plus=512 - /* [↓] a little of this, ··· */ -$=!'80'x || copies("0"x,plus%8-1)reverse(right(d2c(8*#),4,'0'x)) || "00000000"x - /* [↑] ··· and a little of that.*/ - do j=0 to length($)%64-1 /*process the message (lots of steps).*/ - a_=a; b_=b; c_=c; d_=d /*save the original values for later.*/ - chunk=j*64 /*calculate the size of the chunks. */ - do k=1 for 16 /*process the message in chunks. */ - !.k=reverse(substr($,chunk+1+4*(k-1),4)) /*magic stuff.*/ - end /*k*/ +msg.0 = 7 /* [↑] last value doesn't need quotes.*/ + do m=1 for msg.0; say /*process each of the seven messages. */ + say ' in =' msg.m /*display the in message. */ + say 'out =' MD5(msg.m) /* " " out " */ + end /*m*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +MD5: procedure; parse arg !; numeric digits 20 /*insure there's enough decimal digits.*/ + a='67452301'x; b="efcdab89"x; c='98badcfe'x; d="10325476"x; x00='0'x; x80="80"x + #=length(!) /*length in bytes of the input message.*/ + L=#*8//512; if L<448 then plus=448 - L /*is the length less than 448 ? */ + if L>448 then plus=960 - L /* " " " greater " " */ + if L=448 then plus=512 /* " " " equal to " */ + /* [↓] a little of this, ··· */ + $=! || x80 || copies(x00, plus%8 -1)reverse(right(d2c(8 * #), 4, x00)) || '00000000'x + /* [↑] ··· and a little of that.*/ + do j=0 to length($) % 64 - 1 /*process the message (lots of steps).*/ + a_=a; b_=b; c_=c; d_=d /*save the original values for later.*/ + chunk=j*64 /*calculate the size of the chunks. */ + do k=1 for 16 /*process the message in chunks. */ + !.k=reverse( substr($, chunk + 1 + 4*(k-1), 4) ) /*magic stuff.*/ + end /*k*/ /*────step────*/ + a = .part1( a, b, c, d, 0, 7, 3614090360) /*■■■■ 1 ■■■■*/ + d = .part1( d, a, b, c, 1, 12, 3905402710) /*■■■■ 2 ■■■■*/ + c = .part1( c, d, a, b, 2, 17, 606105819) /*■■■■ 3 ■■■■*/ + b = .part1( b, c, d, a, 3, 22, 3250441966) /*■■■■ 4 ■■■■*/ + a = .part1( a, b, c, d, 4, 7, 4118548399) /*■■■■ 5 ■■■■*/ + d = .part1( d, a, b, c, 5, 12, 1200080426) /*■■■■ 6 ■■■■*/ + c = .part1( c, d, a, b, 6, 17, 2821735955) /*■■■■ 7 ■■■■*/ + b = .part1( b, c, d, a, 7, 22, 4249261313) /*■■■■ 8 ■■■■*/ + a = .part1( a, b, c, d, 8, 7, 1770035416) /*■■■■ 9 ■■■■*/ + d = .part1( d, a, b, c, 9, 12, 2336552879) /*■■■■ 10 ■■■■*/ + c = .part1( c, d, a, b, 10, 17, 4294925233) /*■■■■ 11 ■■■■*/ + b = .part1( b, c, d, a, 11, 22, 2304563134) /*■■■■ 12 ■■■■*/ + a = .part1( a, b, c, d, 12, 7, 1804603682) /*■■■■ 13 ■■■■*/ + d = .part1( d, a, b, c, 13, 12, 4254626195) /*■■■■ 14 ■■■■*/ + c = .part1( c, d, a, b, 14, 17, 2792965006) /*■■■■ 15 ■■■■*/ + b = .part1( b, c, d, a, 15, 22, 1236535329) /*■■■■ 16 ■■■■*/ + a = .part2( a, b, c, d, 1, 5, 4129170786) /*■■■■ 17 ■■■■*/ + d = .part2( d, a, b, c, 6, 9, 3225465664) /*■■■■ 18 ■■■■*/ + c = .part2( c, d, a, b, 11, 14, 643717713) /*■■■■ 19 ■■■■*/ + b = .part2( b, c, d, a, 0, 20, 3921069994) /*■■■■ 20 ■■■■*/ + a = .part2( a, b, c, d, 5, 5, 3593408605) /*■■■■ 21 ■■■■*/ + d = .part2( d, a, b, c, 10, 9, 38016083) /*■■■■ 22 ■■■■*/ + c = .part2( c, d, a, b, 15, 14, 3634488961) /*■■■■ 23 ■■■■*/ + b = .part2( b, c, d, a, 4, 20, 3889429448) /*■■■■ 24 ■■■■*/ + a = .part2( a, b, c, d, 9, 5, 568446438) /*■■■■ 25 ■■■■*/ + d = .part2( d, a, b, c, 14, 9, 3275163606) /*■■■■ 26 ■■■■*/ + c = .part2( c, d, a, b, 3, 14, 4107603335) /*■■■■ 27 ■■■■*/ + b = .part2( b, c, d, a, 8, 20, 1163531501) /*■■■■ 28 ■■■■*/ + a = .part2( a, b, c, d, 13, 5, 2850285829) /*■■■■ 29 ■■■■*/ + d = .part2( d, a, b, c, 2, 9, 4243563512) /*■■■■ 30 ■■■■*/ + c = .part2( c, d, a, b, 7, 14, 1735328473) /*■■■■ 31 ■■■■*/ + b = .part2( b, c, d, a, 12, 20, 2368359562) /*■■■■ 32 ■■■■*/ + a = .part3( a, b, c, d, 5, 4, 4294588738) /*■■■■ 33 ■■■■*/ + d = .part3( d, a, b, c, 8, 11, 2272392833) /*■■■■ 34 ■■■■*/ + c = .part3( c, d, a, b, 11, 16, 1839030562) /*■■■■ 35 ■■■■*/ + b = .part3( b, c, d, a, 14, 23, 4259657740) /*■■■■ 36 ■■■■*/ + a = .part3( a, b, c, d, 1, 4, 2763975236) /*■■■■ 37 ■■■■*/ + d = .part3( d, a, b, c, 4, 11, 1272893353) /*■■■■ 38 ■■■■*/ + c = .part3( c, d, a, b, 7, 16, 4139469664) /*■■■■ 39 ■■■■*/ + b = .part3( b, c, d, a, 10, 23, 3200236656) /*■■■■ 40 ■■■■*/ + a = .part3( a, b, c, d, 13, 4, 681279174) /*■■■■ 41 ■■■■*/ + d = .part3( d, a, b, c, 0, 11, 3936430074) /*■■■■ 42 ■■■■*/ + c = .part3( c, d, a, b, 3, 16, 3572445317) /*■■■■ 43 ■■■■*/ + b = .part3( b, c, d, a, 6, 23, 76029189) /*■■■■ 44 ■■■■*/ + a = .part3( a, b, c, d, 9, 4, 3654602809) /*■■■■ 45 ■■■■*/ + d = .part3( d, a, b, c, 12, 11, 3873151461) /*■■■■ 46 ■■■■*/ + c = .part3( c, d, a, b, 15, 16, 530742520) /*■■■■ 47 ■■■■*/ + b = .part3( b, c, d, a, 2, 23, 3299628645) /*■■■■ 48 ■■■■*/ + a = .part4( a, b, c, d, 0, 6, 4096336452) /*■■■■ 49 ■■■■*/ + d = .part4( d, a, b, c, 7, 10, 1126891415) /*■■■■ 50 ■■■■*/ + c = .part4( c, d, a, b, 14, 15, 2878612391) /*■■■■ 51 ■■■■*/ + b = .part4( b, c, d, a, 5, 21, 4237533241) /*■■■■ 52 ■■■■*/ + a = .part4( a, b, c, d, 12, 6, 1700485571) /*■■■■ 53 ■■■■*/ + d = .part4( d, a, b, c, 3, 10, 2399980690) /*■■■■ 54 ■■■■*/ + c = .part4( c, d, a, b, 10, 15, 4293915773) /*■■■■ 55 ■■■■*/ + b = .part4( b, c, d, a, 1, 21, 2240044497) /*■■■■ 56 ■■■■*/ + a = .part4( a, b, c, d, 8, 6, 1873313359) /*■■■■ 57 ■■■■*/ + d = .part4( d, a, b, c, 15, 10, 4264355552) /*■■■■ 58 ■■■■*/ + c = .part4( c, d, a, b, 6, 15, 2734768916) /*■■■■ 59 ■■■■*/ + b = .part4( b, c, d, a, 13, 21, 1309151649) /*■■■■ 60 ■■■■*/ + a = .part4( a, b, c, d, 4, 6, 4149444226) /*■■■■ 61 ■■■■*/ + d = .part4( d, a, b, c, 11, 10, 3174756917) /*■■■■ 62 ■■■■*/ + c = .part4( c, d, a, b, 2, 15, 718787259) /*■■■■ 63 ■■■■*/ + b = .part4( b, c, d, a, 9, 21, 3951481745) /*■■■■ 64 ■■■■*/ + a = .a(a_, a); b=.a(b_, b); c=.a(c_, c); d=.a(d_, d) + end /*j*/ - a = .part1( a, b, c, d, 0, 7, 3614090360) /*■■■■1■■■*/ - d = .part1( d, a, b, c, 1, 12, 3905402710) /*■■■■2■■■*/ - c = .part1( c, d, a, b, 2, 17, 606105819) /*■■■■3■■■*/ - b = .part1( b, c, d, a, 3, 22, 3250441966) /*■■■■4■■■*/ - a = .part1( a, b, c, d, 4, 7, 4118548399) /*■■■■5■■■*/ - d = .part1( d, a, b, c, 5, 12, 1200080426) /*■■■■6■■■*/ - c = .part1( c, d, a, b, 6, 17, 2821735955) /*■■■■7■■■*/ - b = .part1( b, c, d, a, 7, 22, 4249261313) /*■■■■8■■■*/ - a = .part1( a, b, c, d, 8, 7, 1770035416) /*■■■■9■■■*/ - d = .part1( d, a, b, c, 9, 12, 2336552879) /*■■■10■■■*/ - c = .part1( c, d, a, b, 10, 17, 4294925233) /*■■■11■■■*/ - b = .part1( b, c, d, a, 11, 22, 2304563134) /*■■■12■■■*/ - a = .part1( a, b, c, d, 12, 7, 1804603682) /*■■■13■■■*/ - d = .part1( d, a, b, c, 13, 12, 4254626195) /*■■■14■■■*/ - c = .part1( c, d, a, b, 14, 17, 2792965006) /*■■■15■■■*/ - b = .part1( b, c, d, a, 15, 22, 1236535329) /*■■■16■■■*/ - a = .part2( a, b, c, d, 1, 5, 4129170786) /*■■■17■■■*/ - d = .part2( d, a, b, c, 6, 9, 3225465664) /*■■■18■■■*/ - c = .part2( c, d, a, b, 11, 14, 643717713) /*■■■19■■■*/ - b = .part2( b, c, d, a, 0, 20, 3921069994) /*■■■20■■■*/ - a = .part2( a, b, c, d, 5, 5, 3593408605) /*■■■21■■■*/ - d = .part2( d, a, b, c, 10, 9, 38016083) /*■■■22■■■*/ - c = .part2( c, d, a, b, 15, 14, 3634488961) /*■■■23■■■*/ - b = .part2( b, c, d, a, 4, 20, 3889429448) /*■■■24■■■*/ - a = .part2( a, b, c, d, 9, 5, 568446438) /*■■■25■■■*/ - d = .part2( d, a, b, c, 14, 9, 3275163606) /*■■■26■■■*/ - c = .part2( c, d, a, b, 3, 14, 4107603335) /*■■■27■■■*/ - b = .part2( b, c, d, a, 8, 20, 1163531501) /*■■■28■■■*/ - a = .part2( a, b, c, d, 13, 5, 2850285829) /*■■■29■■■*/ - d = .part2( d, a, b, c, 2, 9, 4243563512) /*■■■30■■■*/ - c = .part2( c, d, a, b, 7, 14, 1735328473) /*■■■31■■■*/ - b = .part2( b, c, d, a, 12, 20, 2368359562) /*■■■32■■■*/ - a = .part3( a, b, c, d, 5, 4, 4294588738) /*■■■33■■■*/ - d = .part3( d, a, b, c, 8, 11, 2272392833) /*■■■34■■■*/ - c = .part3( c, d, a, b, 11, 16, 1839030562) /*■■■35■■■*/ - b = .part3( b, c, d, a, 14, 23, 4259657740) /*■■■36■■■*/ - a = .part3( a, b, c, d, 1, 4, 2763975236) /*■■■37■■■*/ - d = .part3( d, a, b, c, 4, 11, 1272893353) /*■■■38■■■*/ - c = .part3( c, d, a, b, 7, 16, 4139469664) /*■■■39■■■*/ - b = .part3( b, c, d, a, 10, 23, 3200236656) /*■■■40■■■*/ - a = .part3( a, b, c, d, 13, 4, 681279174) /*■■■41■■■*/ - d = .part3( d, a, b, c, 0, 11, 3936430074) /*■■■42■■■*/ - c = .part3( c, d, a, b, 3, 16, 3572445317) /*■■■43■■■*/ - b = .part3( b, c, d, a, 6, 23, 76029189) /*■■■44■■■*/ - a = .part3( a, b, c, d, 9, 4, 3654602809) /*■■■45■■■*/ - d = .part3( d, a, b, c, 12, 11, 3873151461) /*■■■46■■■*/ - c = .part3( c, d, a, b, 15, 16, 530742520) /*■■■47■■■*/ - b = .part3( b, c, d, a, 2, 23, 3299628645) /*■■■48■■■*/ - a = .part4( a, b, c, d, 0, 6, 4096336452) /*■■■49■■■*/ - d = .part4( d, a, b, c, 7, 10, 1126891415) /*■■■50■■■*/ - c = .part4( c, d, a, b, 14, 15, 2878612391) /*■■■51■■■*/ - b = .part4( b, c, d, a, 5, 21, 4237533241) /*■■■52■■■*/ - a = .part4( a, b, c, d, 12, 6, 1700485571) /*■■■53■■■*/ - d = .part4( d, a, b, c, 3, 10, 2399980690) /*■■■54■■■*/ - c = .part4( c, d, a, b, 10, 15, 4293915773) /*■■■55■■■*/ - b = .part4( b, c, d, a, 1, 21, 2240044497) /*■■■56■■■*/ - a = .part4( a, b, c, d, 8, 6, 1873313359) /*■■■57■■■*/ - d = .part4( d, a, b, c, 15, 10, 4264355552) /*■■■58■■■*/ - c = .part4( c, d, a, b, 6, 15, 2734768916) /*■■■59■■■*/ - b = .part4( b, c, d, a, 13, 21, 1309151649) /*■■■60■■■*/ - a = .part4( a, b, c, d, 4, 6, 4149444226) /*■■■61■■■*/ - d = .part4( d, a, b, c, 11, 10, 3174756917) /*■■■62■■■*/ - c = .part4( c, d, a, b, 2, 15, 718787259) /*■■■63■■■*/ - b = .part4( b, c, d, a, 9, 21, 3951481745) /*■■■64■■■*/ - a = .a(a_,a); b=.a(b_,b); c=.a(c_,c); d=.a(d_,d) - end /*j*/ - -return c2x(reverse(a))c2x(reverse(b))c2x(reverse(c))c2x(reverse(d)) -/*─────────────────────────────────────subroutines─────────────────────────────────────*/ -.a: return right(d2c(c2d(arg(1)) + c2d(arg(2))), 4, '0'x) -.h: return bitxor(bitxor(arg(1), arg(2)), arg(3)) -.i: return bitxor(arg(2), bitor(arg(1), bitxor(arg(3), 'ffffffff'x))) -.f: return bitor(bitand(arg(1),arg(2)), bitand(bitxor(arg(1), 'ffffffff'x), arg(3))) -.g: return bitor(bitand(arg(1),arg(3)), bitand(arg(2), bitxor(arg(3), 'ffffffff'x))) -.Lr: procedure; parse arg _,#; if #==0 then return _ /*left rotate.*/ - ?=x2b(c2x(_)); return x2c(b2x(right(? || left(?, #), length(?)))) + return c2x( reverse(a) )c2x( reverse(b) )c2x( reverse(c) )c2x( reverse(d) ) +/*──────────────────────────────────────────────────────────────────────────────────────*/ +.a: return right( d2c( c2d( arg(1) ) + c2d( arg(2) ) ), 4, '0'x) +.h: return bitxor( bitxor( arg(1), arg(2) ), arg(3) ) +.i: return bitxor( arg(2), bitor(arg(1), bitxor(arg(3), 'ffffffff'x))) +.f: return bitor( bitand(arg(1),arg(2)), bitand(bitxor(arg(1), 'ffffffff'x), arg(3))) +.g: return bitor( bitand(arg(1),arg(3)), bitand(arg(2), bitxor(arg(3), 'ffffffff'x))) +.Lr: procedure; parse arg _,#; if #==0 then return _ /*left rotate.*/ + ?=x2b(c2x(_)); return x2c( b2x( right(? || left(?, #), length(?) ))) .part1: procedure expose !.; parse arg w,x,y,z,n,m,_; n=n+1 - return .a(.Lr(right(d2c(_+c2d(w)+c2d(.f(x,y,z))+c2d(!.n)),4,'0'x),m),x) + return .a(.Lr(right(d2c(_+c2d(w) +c2d(.f(x,y,z))+c2d(!.n)),4,'0'x),m),x) .part2: procedure expose !.; parse arg w,x,y,z,n,m,_; n=n+1 - return .a(.Lr(right(d2c(_+c2d(w)+c2d(.g(x,y,z))+c2d(!.n)),4,'0'x),m),x) + return .a(.Lr(right(d2c(_+c2d(w) +c2d(.g(x,y,z))+c2d(!.n)),4,'0'x),m),x) .part3: procedure expose !.; parse arg w,x,y,z,n,m,_; n=n+1 - return .a(.Lr(right(d2c(_+c2d(w)+c2d(.h(x,y,z))+c2d(!.n)),4,'0'x),m),x) + return .a(.Lr(right(d2c(_+c2d(w) +c2d(.h(x,y,z))+c2d(!.n)),4,'0'x),m),x) .part4: procedure expose !.; parse arg w,x,y,z,n,m,_; n=n+1 - return .a(.Lr(right(d2c(c2d(w)+c2d(.i(x,y,z))+c2d(!.n)+_),4,'0'x),m),x) + return .a(.Lr(right(d2c(c2d(w) +c2d(.i(x,y,z))+c2d(!.n)+_),4,'0'x),m),x) diff --git a/Task/MD5/RPG/md5.rpg b/Task/MD5/RPG/md5.rpg new file mode 100644 index 0000000000..e506c35a26 --- /dev/null +++ b/Task/MD5/RPG/md5.rpg @@ -0,0 +1,89 @@ +**FREE +Ctl-opt MAIN(Main); +Ctl-opt DFTACTGRP(*NO) ACTGRP(*NEW); + +dcl-pr QDCXLATE EXTPGM('QDCXLATE'); + dataLen packed(5 : 0) CONST; + data char(32767) options(*VARSIZE); + conversionTable char(10) CONST; +end-pr; + +dcl-pr Qc3CalculateHash EXTPROC('Qc3CalculateHash'); + inputData pointer value; + inputDataLen int(10) const; + inputDataFormat char(8) const; + algorithmDscr char(16) const; + algorithmFormat char(8) const; + cryptoServiceProvider char(1) const; + cryptoDeviceName char(1) const options(*OMIT); + hash char(64) options(*VARSIZE : *OMIT); + errorCode char(32767) options(*VARSIZE); +end-pr; + +dcl-c HEX_CHARS CONST('0123456789ABCDEF'); + +dcl-proc Main; + dcl-s inputData char(45); + dcl-s inputDataLen int(10) INZ(0); + dcl-s outputHash char(16); + dcl-s outputHashHex char(32); + dcl-ds algorithmDscr QUALIFIED; + hashAlgorithm int(10) INZ(0); + end-ds; + dcl-ds ERRC0100_NULL QUALIFIED; + bytesProvided int(10) INZ(0); // Leave at zero + bytesAvailable int(10); + end-ds; + + dow inputDataLen = 0; + DSPLY 'Input: ' '' inputData; + inputData = %trim(inputData); + inputDataLen = %len(%trim(inputData)); + DSPLY ('Input=' + inputData); + DSPLY ('InputLen=' + %char(inputDataLen)); + if inputDataLen = 0; + DSPLY 'Input must not be blank'; + endif; + enddo; + + // Convert from EBCDIC to ASCII + QDCXLATE(inputDataLen : inputData : 'QTCPASC'); + algorithmDscr.hashAlgorithm = 1; // MD5 + // Calculate hash + Qc3CalculateHash(%addr(inputData) : inputDataLen : 'DATA0100' : algorithmDscr + : 'ALGD0500' : '0' : *OMIT : outputHash : ERRC0100_NULL); + // Convert to hex + CVTHC(outputHashHex : outputHash : 32); + DSPLY ('MD5: ' + outputHashHex); + return; +end-proc; + +// This procedure is actually a MI, but I couldn't get it to bind so I wrote my own version +dcl-proc CVTHC; + dcl-pi *N; + target char(65534) options(*VARSIZE); + srcBits char(32767) options(*VARSIZE) CONST; + targetLen int(10) value; + end-pi; + dcl-s i int(10); + dcl-s lowNibble ind INZ(*OFF); + dcl-s inputOffset int(10) INZ(1); + dcl-ds dataStruct QUALIFIED; + numField int(5) INZ(0); + // IBM i is big-endian + charField char(1) OVERLAY(numField : 2); + end-ds; + + for i = 1 to targetLen; + if lowNibble; + dataStruct.charField = %BitAnd(%subst(srcBits : inputOffset : 1) : X'0F'); + inputOffset += 1; + else; + dataStruct.charField = %BitAnd(%subst(srcBits : inputOffset : 1) : X'F0'); + dataStruct.numField /= 16; + endif; + %subst(target : i : 1) = %subst(HEX_CHARS : dataStruct.numField + 1 : 1); + lowNibble = NOT lowNibble; + endfor; + return; +end-proc; diff --git a/Task/MD5/S-lang/md5.slang b/Task/MD5/S-lang/md5.slang new file mode 100644 index 0000000000..0e3d99febe --- /dev/null +++ b/Task/MD5/S-lang/md5.slang @@ -0,0 +1,2 @@ +require("chksum"); +print(md5sum("The quick brown fox jumped over the lazy dog's back")); diff --git a/Task/Machine-code/PicoLisp/machine-code.l b/Task/Machine-code/PicoLisp/machine-code.l new file mode 100644 index 0000000000..5e56b9b555 --- /dev/null +++ b/Task/Machine-code/PicoLisp/machine-code.l @@ -0,0 +1,33 @@ +(setq P + (struct (native "@" "malloc" 'N 39) 'N + # Align + 144 # nop + 144 # nop + + # Prepare stack + 106 12 # pushq $12 + 184 7 0 0 0 # mov $7, %eax + 72 193 224 32 # shl $32, %rax + 80 # pushq %rax + + # Rosetta task code + 139 68 36 4 3 68 36 8 + + # Get result + 76 137 227 # mov %r12, %rbx + 137 195 # mov %eax, %ebx + 72 193 227 4 # shl $4, %rbx + 128 203 2 # orb $2, %bl + + # Clean up stack + 72 131 196 16 # add $16, %rsp + + # Return + 195 ) # ret + foo (>> 4 P) ) + +# Execute +(println (foo)) + +# Free memory +(native "@" "free" NIL P) diff --git a/Task/Machine-code/PureBasic/machine-code.purebasic b/Task/Machine-code/PureBasic/machine-code.purebasic index 3bc5a08ef1..560c88cb60 100644 --- a/Task/Machine-code/PureBasic/machine-code.purebasic +++ b/Task/Machine-code/PureBasic/machine-code.purebasic @@ -1,22 +1,29 @@ +CompilerIf #PB_Compiler_Processor <> #PB_Processor_x86 + CompilerError "Code requires a 32-bit processor." +CompilerEndIf + + +; Machine code using the Windows API + Procedure MachineCodeVirtualAlloc(a,b) *vm = VirtualAlloc_(#Null,?ecode-?scode,#MEM_COMMIT,#PAGE_EXECUTE_READWRITE) If(*vm) - CopyMemory_(*vm,?scode,?ecode-?scode) + CopyMemory(?scode, *vm, ?ecode-?scode) eax_result=CallFunctionFast(*vm,a,b) VirtualFree_(*vm,0,#MEM_RELEASE) ProcedureReturn eax_result EndIf EndProcedure -rv=MachineCodeVirtualAlloc(7,12) -MessageRequester("MachineCodeVirtualAlloc",str(rv)+space(50),#PB_MessageRequester_Ok) +rv=MachineCodeVirtualAlloc( 7, 12) +MessageRequester("MachineCodeVirtualAlloc",Str(rv)+Space(50),#PB_MessageRequester_Ok) #HEAP_CREATE_ENABLE_EXECUTE=$00040000 Procedure MachineCodeHeapCreate(a,b) hHeap=HeapCreate_(#HEAP_CREATE_ENABLE_EXECUTE,?ecode-?scode,?ecode-?scode) If(hHeap) - CopyMemory_(hHeap,?scode,?ecode-?scode) + CopyMemory(?scode, hHeap, ?ecode-?scode) eax_result=CallFunctionFast(hHeap,a,b) HeapDestroy_(hHeap) ProcedureReturn eax_result @@ -24,7 +31,7 @@ hHeap=HeapCreate_(#HEAP_CREATE_ENABLE_EXECUTE,?ecode-?scode,?ecode-?scode) EndProcedure rv=MachineCodeHeapCreate(7,12) -MessageRequester("MachineCodeHeapCreate",str(rv)+space(50),#PB_MessageRequester_Ok) +MessageRequester("MachineCodeHeapCreate",Str(rv)+Space(50),#PB_MessageRequester_Ok) End ; 8B442404 mov eax,[esp+4] @@ -33,6 +40,6 @@ End DataSection scode: -Data.c $8B,$44,$24,$04,$03,$44,$24,$08,$C2,$08,$00 +Data.a $8B,$44,$24,$04,$03,$44,$24,$08,$C2,$08,$00 ecode: EndDataSection diff --git a/Task/Mad-Libs/00DESCRIPTION b/Task/Mad-Libs/00DESCRIPTION index e09cde5dbf..6e74702f2a 100644 --- a/Task/Mad-Libs/00DESCRIPTION +++ b/Task/Mad-Libs/00DESCRIPTION @@ -1,17 +1,29 @@ +{{wikipedia}} + +
    [[wp:Mad Libs|Mad Libs]] is a phrasal template word game where one player prompts another for a list of words to substitute for blanks in a story, usually with funny results. -Write a program to create a Mad Libs like story. -The program should read a multiline story from the input. The story will be terminated with a blank line. -Then, find each replacement to be made within the story, ask the user for a word to replace it with, and make all the replacements. Stop when there are none left and print the final story. -The input should be in the form: +;Task; +Write a program to create a Mad Libs like story. + +The program should read an arbitrary multiline story from input. + +The story will be terminated with a blank line. + +Then, find each replacement to be made within the story, ask the user for a word to replace it with, and make all the replacements. + +Stop when there are none left and print the final story. + + +The input should be an arbitrary story in the form:
      went for a walk in the park. 
     found a .  decided to take it home.
    -
     
    -It should then ask for a name, a he or she and a noun ( gets replaced both times with the same value.) -{{wikipedia}} +Given this example, it should then ask for a name, a he or she and a noun ( gets replaced both times with the same value). +

    + == {{header|Ada}} == The fun of Mad Libs is not knowing the story ahead of time, so the program reads the story template from a text file. The name of the text file is given as a command line argument. diff --git a/Task/Mad-Libs/AWK/mad-libs-2.awk b/Task/Mad-Libs/AWK/mad-libs-2.awk index f70982a677..4daf2f84d6 100644 --- a/Task/Mad-Libs/AWK/mad-libs-2.awk +++ b/Task/Mad-Libs/AWK/mad-libs-2.awk @@ -1,48 +1,145 @@ -#include -#include -using namespace std; +#include +#include +#include -int main() +#define err(...) fprintf(stderr, ## __VA_ARGS__), exit(1) + +/* We create a dynamic string with a few functions which make modifying + * the string and growing a bit easier */ +typedef struct { + char *data; + size_t alloc; + size_t length; +} dstr; + +inline int dstr_space(dstr *s, size_t grow_amount) { - string story, input; - - //Loop - while(true) - { - //Get a line from the user - getline(cin, input); - - //If it's blank, break this loop - if(input == "\r") - break; - - //Add the line to the story - story += input; - } - - //While there is a '<' in the story - int begin; - while((begin = story.find("<")) != string::npos) - { - //Get the category from between '<' and '>' - int end = story.find(">"); - string cat = story.substr(begin + 1, end - begin - 1); - - //Ask the user for a replacement - cout << "Give me a " << cat << ": "; - cin >> input; - - //While there's a matching category - //in the story - while((begin = story.find("<" + cat + ">")) != string::npos) - { - //Replace it with the user's replacement - story.replace(begin, cat.length()+2, input); - } - } - - //Output the final story - cout << endl << story; - - return 0; + return s->length + grow_amount < s->alloc; +} + +int dstr_grow(dstr *s) +{ + s->alloc *= 2; + char *attempt = realloc(s->data, s->alloc); + + if (!attempt) return 0; + else s->data = attempt; + + return 1; +} + +dstr* dstr_init(const size_t to_allocate) +{ + dstr *s = malloc(sizeof(dstr)); + if (!s) goto failure; + + s->length = 0; + s->alloc = to_allocate; + s->data = malloc(s->alloc); + + if (!s->data) goto failure; + + return s; + +failure: + if (s->data) free(s->data); + if (s) free(s); + return NULL; +} + +void dstr_delete(dstr *s) +{ + if (s->data) free(s->data); + if (s) free(s); +} + +dstr* readinput(FILE *fd) +{ + static const size_t buffer_size = 4096; + char buffer[buffer_size]; + + dstr *s = dstr_init(buffer_size); + if (!s) goto failure; + + while (fgets(buffer, buffer_size, fd)) { + while (!dstr_space(s, buffer_size)) + if (!dstr_grow(s)) goto failure; + + strncpy(s->data + s->length, buffer, buffer_size); + s->length += strlen(buffer); + } + + return s; + +failure: + dstr_delete(s); + return NULL; +} + +void dstr_replace_all(dstr *story, const char *replace, const char *insert) +{ + const size_t replace_l = strlen(replace); + const size_t insert_l = strlen(insert); + char *start = story->data; + + while ((start = strstr(start, replace))) { + if (!dstr_space(story, insert_l - replace_l)) + if (!dstr_grow(story)) err("Failed to allocate memory"); + + if (insert_l != replace_l) { + memmove(start + insert_l, start + replace_l, story->length - + (start + replace_l - story->data)); + + /* Remember to null terminate the data so we can utilize it + * as we normally would */ + story->length += insert_l - replace_l; + story->data[story->length] = 0; + } + + memmove(start, insert, insert_l); + } +} + +void madlibs(dstr *story) +{ + static const size_t buffer_size = 128; + char insert[buffer_size]; + char replace[buffer_size]; + + char *start, + *end = story->data; + + while (start = strchr(end, '<')) { + if (!(end = strchr(start, '>'))) err("Malformed brackets in input"); + + /* One extra for current char and another for nul byte */ + strncpy(replace, start, end - start + 1); + replace[end - start + 1] = '\0'; + + printf("Enter value for field %s: ", replace); + + fgets(insert, buffer_size, stdin); + const size_t il = strlen(insert) - 1; + if (insert[il] == '\n') + insert[il] = '\0'; + + dstr_replace_all(story, replace, insert); + } + printf("\n"); +} + +int main(int argc, char *argv[]) +{ + if (argc < 2) return 0; + + FILE *fd = fopen(argv[1], "r"); + if (!fd) err("Could not open file: '%s\n", argv[1]); + + dstr *story = readinput(fd); fclose(fd); + if (!story) err("Failed to allocate memory"); + + madlibs(story); + printf("%s\n", story->data); + dstr_delete(story); + return 0; } diff --git a/Task/Mad-Libs/AWK/mad-libs-3.awk b/Task/Mad-Libs/AWK/mad-libs-3.awk new file mode 100644 index 0000000000..f70982a677 --- /dev/null +++ b/Task/Mad-Libs/AWK/mad-libs-3.awk @@ -0,0 +1,48 @@ +#include +#include +using namespace std; + +int main() +{ + string story, input; + + //Loop + while(true) + { + //Get a line from the user + getline(cin, input); + + //If it's blank, break this loop + if(input == "\r") + break; + + //Add the line to the story + story += input; + } + + //While there is a '<' in the story + int begin; + while((begin = story.find("<")) != string::npos) + { + //Get the category from between '<' and '>' + int end = story.find(">"); + string cat = story.substr(begin + 1, end - begin - 1); + + //Ask the user for a replacement + cout << "Give me a " << cat << ": "; + cin >> input; + + //While there's a matching category + //in the story + while((begin = story.find("<" + cat + ">")) != string::npos) + { + //Replace it with the user's replacement + story.replace(begin, cat.length()+2, input); + } + } + + //Output the final story + cout << endl << story; + + return 0; +} diff --git a/Task/Mad-Libs/AWK/mad-libs.awk b/Task/Mad-Libs/AWK/mad-libs.awk deleted file mode 100644 index ea8fb07835..0000000000 --- a/Task/Mad-Libs/AWK/mad-libs.awk +++ /dev/null @@ -1,34 +0,0 @@ -# syntax: GAWK -f MAD_LIBS.AWK -BEGIN { - print("enter story:") -} -{ story_arr[++nr] = $0 - if ($0 ~ /^ *$/) { - exit - } - while ($0 ~ /[<>]/) { - L = index($0,"<") - R = index($0,">") - changes_arr[substr($0,L,R-L+1)] = "" - sub(//,"",$0) - } -} -END { - PROCINFO["sorted_in"] = "@ind_str_asc" - print("enter values for:") - for (i in changes_arr) { # prompt for replacement values - printf("%s ",i) - getline rec - sub(/ +$/,"",rec) - changes_arr[i] = rec - } - printf("\nrevised story:\n") - for (i=1; i<=nr; i++) { # print the story - for (j in changes_arr) { - gsub(j,changes_arr[j],story_arr[i]) - } - printf("%s\n",story_arr[i]) - } - exit(0) -} diff --git a/Task/Mad-Libs/C-sharp/mad-libs.cs b/Task/Mad-Libs/C-sharp/mad-libs.cs index 1054694ac7..7e90ea968a 100644 --- a/Task/Mad-Libs/C-sharp/mad-libs.cs +++ b/Task/Mad-Libs/C-sharp/mad-libs.cs @@ -1,25 +1,70 @@ using System; -using System.Collections.Generic; +using System.Linq; using System.Text; -using System.Threading.Tasks; -namespace madLibs { - class Program { - static void Main(string[] args) { - string name, sex, addThis, thing; - bool isMale = false; - Console.Write("Enter a name: "); - name = Console.ReadLine(); - while(isMale == false) { - Console.Write("Is that a male or female name? [m/f] "); - sex = Console.ReadLine().ToLower().ToCharArray()[0].ToString(); - if(sex == "m") { isMale = true; } else if(sex == "f") { break; } - } - if (isMale){ addThis = "He "; }else{ addThis = "She "; } - Console.Write("Enter a thing: "); - thing = Console.ReadLine(); - Console.WriteLine(Environment.NewLine + String.Format(("{0} went for a walk in the park. " + addThis + - "found a {1}. {0} decided to take it home."), name, thing)); - Console.ReadKey(); - } - } +using System.Text.RegularExpressions; + +namespace MadLibs_RosettaCode +{ + class Program + { + static void Main(string[] args) + { + string madLibs = +@"Write a program to create a Mad Libs like story. +The program should read an arbitrary multiline story from input. +The story will be terminated with a blank line. +Then, find each replacement to be made within the story, +ask the user for a word to replace it with, and make all the replacements. +Stop when there are none left and print the final story. +The input should be an arbitrary story in the form: + went for a walk in the park. +found a . decided to take it home. +Given this example, it should then ask for a name, +a he or she and a noun ( gets replaced both times with the same value)."; + + StringBuilder sb = new StringBuilder(); + Regex pattern = new Regex(@"\<(.*?)\>"); + string storyLine; + string replacement; + + Console.WriteLine(madLibs + Environment.NewLine + Environment.NewLine); + Console.WriteLine("Enter a story: "); + + // Continue to get input while empty line hasn't been entered. + do + { + storyLine = Console.ReadLine(); + sb.Append(storyLine + Environment.NewLine); + } while (!string.IsNullOrEmpty(storyLine) && !string.IsNullOrWhiteSpace(storyLine)); + + // Retrieve only the unique regex matches from the user entered story. + Match nameMatch = pattern.Matches(sb.ToString()).OfType().Where(x => x.Value.Equals("")).Select(x => x.Value).Distinct() as Match; + if(nameMatch != null) + { + do + { + Console.WriteLine("Enter value for: " + nameMatch.Value); + replacement = Console.ReadLine(); + } while (string.IsNullOrEmpty(replacement) || string.IsNullOrWhiteSpace(replacement)); + sb.Replace(nameMatch.Value, replacement); + } + + foreach (Match match in pattern.Matches(sb.ToString())) + { + replacement = string.Empty; + // Guarantee we get a non-whitespace value for the replacement + do + { + Console.WriteLine("Enter value for: " + match.Value); + replacement = Console.ReadLine(); + } while (string.IsNullOrEmpty(replacement) || string.IsNullOrWhiteSpace(replacement)); + + int location = sb.ToString().IndexOf(match.Value); + sb.Remove(location, match.Value.Length).Insert(location, replacement); + } + + Console.WriteLine(Environment.NewLine + Environment.NewLine + "--[ Here's your story! ]--"); + Console.WriteLine(sb.ToString()); + } + } } diff --git a/Task/Mad-Libs/Clojure/mad-libs.clj b/Task/Mad-Libs/Clojure/mad-libs.clj new file mode 100644 index 0000000000..23c1411b25 --- /dev/null +++ b/Task/Mad-Libs/Clojure/mad-libs.clj @@ -0,0 +1,59 @@ +(ns magic.rosetta + (:require [clojure.string :as str])) + +(defn mad-libs + "Write a program to create a Mad Libs like story. + The program should read an arbitrary multiline story from input. + The story will be terminated with a blank line. + Then, find each replacement to be made within the story, + ask the user for a word to replace it with, and make all the replacements. + Stop when there are none left and print the final story. + The input should be an arbitrary story in the form: + went for a walk in the park. + found a . decided to take it home. + Given this example, it should then ask for a name, + a he or she and a noun ( gets replaced both times with the same value). " + [] + (let + [story (do + (println "Please enter story:") + (loop [story []] + (let [line (read-line)] + (if (empty? line) + (str/join "\n" story) + (recur (conj story line)))))) + tokens (set (re-seq #"<[^<>]+>" story)) + story-completed (reduce + (fn [s t] + (str/replace s t (do + (println (str "Substitute " t ":")) + (read-line)))) + story + tokens)] + (println (str + "Here is your story:\n" + "------------------------------------\n" + story-completed)))) +; Sample run at REPL: +; +; user=> (magic.rosetta/mad-libs) +; Please enter story: +; One day wake up at . +; decided to . +; While , strange man +; appears and gave a . + +; Substitute : +; Sweden +; Substitute : +; Nobel prize +; Substitute : +; Bob Dylan +; Substitute : +; walk +; Here is your story: +; ------------------------------------ +; One day Bob Dylan wake up at Sweden. +; Bob Dylan decided to walk. +; While Bob Dylan walk, strange man +; appears and gave Bob Dylan a Nobel prize. diff --git a/Task/Mad-Libs/PowerShell/mad-libs-1.psh b/Task/Mad-Libs/PowerShell/mad-libs-1.psh new file mode 100644 index 0000000000..2ab657542d --- /dev/null +++ b/Task/Mad-Libs/PowerShell/mad-libs-1.psh @@ -0,0 +1,65 @@ +function New-MadLibs +{ + [CmdletBinding(DefaultParameterSetName='None')] + [OutputType([string])] + Param + ( + [Parameter(Mandatory=$false)] + [AllowEmptyString()] + [string] + $Name = "", + + [Parameter(Mandatory=$false, ParameterSetName='Male')] + [switch] + $Male, + + [Parameter(Mandatory=$false, ParameterSetName='Female')] + [switch] + $Female, + + [Parameter(Mandatory=$false)] + [AllowEmptyString()] + [string] + $Item = "" + ) + + if (-not $Name) + { + $Name = (Get-Culture).TextInfo.ToTitleCase((Read-Host -Prompt "`nEnter a name").ToLower()) + } + else + { + $Name = (Get-Culture).TextInfo.ToTitleCase(($Name).ToLower()) + } + + if ($Male) + { + $pronoun = "He" + } + elseif ($Female) + { + $pronoun = "She" + } + else + { + $title = "Gender" + $message = "Select $Name's Gender" + $_male = New-Object System.Management.Automation.Host.ChoiceDescription "&Male", "Selects male gender." + $_female = New-Object System.Management.Automation.Host.ChoiceDescription "&Female", "Selects female gender." + $options = [System.Management.Automation.Host.ChoiceDescription[]]($_male, $_female) + $result = $host.UI.PromptForChoice($title, $message, $options, 0) + + switch ($result) + { + 0 {$pronoun = "He"} + 1 {$pronoun = "She"} + } + } + + if (-not $Item) + { + $Item = Read-Host -Prompt "`nEnter an item" + } + + "`n{0} went for a walk in the park. {1} found a {2}. {0} decided to take it home.`n" -f $Name, $pronoun, $Item +} diff --git a/Task/Mad-Libs/PowerShell/mad-libs-2.psh b/Task/Mad-Libs/PowerShell/mad-libs-2.psh new file mode 100644 index 0000000000..b0d5f70a2e --- /dev/null +++ b/Task/Mad-Libs/PowerShell/mad-libs-2.psh @@ -0,0 +1 @@ +New-MadLibs -Name hank -Male -Item shank diff --git a/Task/Mad-Libs/PowerShell/mad-libs-3.psh b/Task/Mad-Libs/PowerShell/mad-libs-3.psh new file mode 100644 index 0000000000..4434816722 --- /dev/null +++ b/Task/Mad-Libs/PowerShell/mad-libs-3.psh @@ -0,0 +1 @@ +New-MadLibs diff --git a/Task/Mad-Libs/PowerShell/mad-libs-4.psh b/Task/Mad-Libs/PowerShell/mad-libs-4.psh new file mode 100644 index 0000000000..fd183821ca --- /dev/null +++ b/Task/Mad-Libs/PowerShell/mad-libs-4.psh @@ -0,0 +1,8 @@ +$paramLists = @(@{Name='mary'; Female=$true; Item="little lamb"}, + @{Name='hank'; Male=$true; Item="shank"}, + @{Name='foo'; Male=$true; Item="bar"}) + +foreach ($paramList in $paramLists) +{ + New-MadLibs @paramList +} diff --git a/Task/Mad-Libs/REXX/mad-libs.rexx b/Task/Mad-Libs/REXX/mad-libs.rexx index 9cb3573d63..c453c30332 100644 --- a/Task/Mad-Libs/REXX/mad-libs.rexx +++ b/Task/Mad-Libs/REXX/mad-libs.rexx @@ -1,36 +1,35 @@ -/*REXX program prompts user for a template substitutions within a story.*/ -@.=; !.=0; #=0; @= /*assign some defaults. */ -parse arg iFID . /*allow use to specify input file*/ -if iFID=='' then iFID="MAD_LIBS.TXT" /*Not specified? Use a default.*/ +/*REXX program prompts the user for a template substitutions within a story (MAD LIBS).*/ +parse arg iFID . /*allow user to specify the input file.*/ +if iFID=='' | iFID=="," then iFID="MAD_LIBS.TXT" /*Not specified? Then use the default.*/ +@.= /*assign defaults to some variables. */ +$=; do recs=1 while lines(iFID)\==0 /*read the input file until it's done. */ + @.recs=linein(iFID); $=$ @.recs /*read a record; and append it to @ */ + if @.recs='' then leave /*Read a blank line? Then we're done.*/ + end /*recs*/ +recs=recs-1 /*adjust for a E─O─F or a blank line.*/ +pm= 'please enter a word or phrase to replace: ' /*this is part of the Prompt Message. */ +!.=0 /*placeholder for phrases in MAD LIBS.*/ +#=0; do forever /*look for templates within the text. */ + parse var $ '<' ? ">" $ /*scan for <ααα> stuff in the text.*/ + if ?='' then leave /*No ααα ? Then we're all finished.*/ + if !.? then iterate /*Already asked? Then keep scanning. */ + !.?=1 /*mark this ααα as being "found". */ + do until ans\='' /*prompt user for a replacement. */ + say '───────────' pm ? /*prompt the user with a prompt message*/ + parse pull ans /*PULL obtains the text from console. */ + end /*forever*/ + #=#+1 /*bump the template counter. */ + old.# = '<'?">"; new.# = ans /*assign the "old" name and "new" name.*/ + end /*forever*/ +say /*display a blank line for a separator.*/ +say; say copies('═', 79) /*display a blank line and a fence. */ - do recs=1 while lines(iFID)\==0 /*read the input file 'til done. */ - @.recs=linein(iFID); @=@ @.recs /*read a record, append it to @ */ - if @.recs='' then leave /*Read a blank line? We're done.*/ - end /*recs*/ + do m=1 for recs /*display the text, line for line. */ + do n=1 for # /*perform substitutions in the text. */ + @.m=changestr(old.n, @.m, new.n) /*maybe replace text in @.m haystack.*/ + end /*n*/ + say @.m /*display the (new) substituted text. */ + end /*m*/ -recs=recs-1 /*adjust for E─O─F or blank line.*/ - - do forever /*look for templates in the text.*/ - parse var @ '<' ? '>' @ /*scan for <ααα> stuff in text.*/ - if ?='' then leave /*if no ααα, then we're done. */ - if !.? then iterate /*already asked? Keep scanning.*/ - !.?=1 /*mark this ααα as "found". */ - do forever /*prompt user for a replacement. */ - say '─────────── please enter a word or phrase to replace: ' ? - parse pull ans; if ans\='' then leave - end /*forever*/ - #=#+1 /*bump the template counter. */ - old.# = '<'?">"; new.# = ans /*assign "old" name & "new" name.*/ - end /*forever*/ - -say; say copies('═',79) /*display a blank and a fence. */ - - do m=1 for recs /*display the text, line for line*/ - do n=1 for # /*perform substitutions in text. */ - @.m = changestr(old.n, @.m, new.n) - end /*n*/ - say @.m /*display (new) substituted text.*/ - end /*m*/ - -say copies('═',79) /*display a final (output) fence.*/ - /*stick a fork in it, we're done.*/ +say copies('═', 79) /*display a final (output) fence. */ +say /*stick a fork in it, we're all done. */ diff --git a/Task/Magic-squares-of-odd-order/00DESCRIPTION b/Task/Magic-squares-of-odd-order/00DESCRIPTION index 67bfedf1c7..743acdbd7a 100644 --- a/Task/Magic-squares-of-odd-order/00DESCRIPTION +++ b/Task/Magic-squares-of-odd-order/00DESCRIPTION @@ -13,6 +13,7 @@ A magic square whose rows and columns add up to a magic number but whose main di | '''4''' || '''9''' || '''2''' |} + ;Task For any odd   '''N''',   [[wp:Magic square#Method_for_constructing_a_magic_square_of_odd_order|generate a magic square]] with the integers   ''' 1''' ──► '''N''',   and show the results here. @@ -21,5 +22,12 @@ Optionally, show the ''magic number''. You should demonstrate the generator by showing at least a magic square for   '''N''' = '''5'''. -;Also see: + +; Related tasks +* [[Magic squares of singly even order]] +* [[Magic squares of doubly even order]]

    + + +; See also: * MathWorld™ entry: [http://mathworld.wolfram.com/MagicSquare.html Magic_square] +* [http://www.1728.org/magicsq1.htm Odd Magic Squares (1728.org)]

    diff --git a/Task/Magic-squares-of-odd-order/ALGOL-68/magic-squares-of-odd-order.alg b/Task/Magic-squares-of-odd-order/ALGOL-68/magic-squares-of-odd-order.alg new file mode 100644 index 0000000000..fa933ec544 --- /dev/null +++ b/Task/Magic-squares-of-odd-order/ALGOL-68/magic-squares-of-odd-order.alg @@ -0,0 +1,59 @@ +# construct a magic square of odd order # +PROC magic square = ( INT order ) [,]INT: + IF NOT ODD order OR order < 1 + THEN + # can't make a magic square of the specified order # + LOC [ 1 : 0, 1 : 0 ]INT + ELSE + # order is OK - construct the square using de la Loubère's # + # algorithm as in the wikipedia page # + + [ 1 : order, 1 : order ]INT square; + FOR i TO order DO FOR j TO order DO square[ i, j ] := 0 OD OD; + + # as square [ 1, 1 ] if the top-left, moving "up" reduces the row # + # operator to advance "up" the square # + OP PREV = ( INT pos )INT: IF pos = 1 THEN order ELSE pos - 1 FI; + # operator to advance "across right" or "down" the square # + OP NEXT = ( INT pos )INT: ( pos MOD order ) + 1; + + # fill in the square, starting from the middle of the top row # + INT col := ( order + 1 ) OVER 2; + INT row := 1; + FOR i TO order * order DO + square[ row, col ] := i; + IF square[ PREV row, NEXT col ] /= 0 + THEN + # the up/right position is already taken, move down # + row := NEXT row + ELSE + # can move up and right # + row := PREV row; + col := NEXT col + FI + OD; + + square + FI # magic square # ; + +# prints the magic square # +PROC print square = ( [,]INT square )VOID: + BEGIN + INT order = 1 UPB square; + # calculate print width: negative so a leading "+" is not printed # + INT width := -1; + INT mag := order * order; + WHILE mag >= 10 DO mag OVERAB 10; width MINUSAB 1 OD; + # calculate the "magic sum" # + INT sum := 0; + FOR i TO order DO sum +:= square[ 1, i ] OD; + # print the square # + print( ( "maqic square of order ", whole( order, 0 ), ": sum: ", whole( sum, 0 ), newline ) ); + FOR i TO order DO + FOR j TO order DO write( ( " ", whole( square[ i, j ], width ) ) ) OD; + write( ( newline ) ) + OD + END # print square # ; + +# test the magic square generation # +FOR order BY 2 TO 7 DO print square( magic square( order ) ) OD diff --git a/Task/Magic-squares-of-odd-order/AppleScript/magic-squares-of-odd-order.applescript b/Task/Magic-squares-of-odd-order/AppleScript/magic-squares-of-odd-order.applescript new file mode 100644 index 0000000000..8e563093d5 --- /dev/null +++ b/Task/Magic-squares-of-odd-order/AppleScript/magic-squares-of-odd-order.applescript @@ -0,0 +1,171 @@ +-- oddMagicSquare :: Int -> [[Int]] +on oddMagicSquare(n) + cond((n mod 2) > 0, ¬ + rotate(transpose(rotate(table(n)))), ¬ + missing value) +end oddMagicSquare + + +-- TEST +on run + -- Orders 3, 5, 11 + + -- wikiTableMagic :: Int -> String + script wikiTableMagic + on lambda(n) + formattedTable(oddMagicSquare(n)) + end lambda + end script + + intercalate(linefeed & linefeed, map(wikiTableMagic, {3, 5, 11})) +end run + +-- table :: Int -> [[Int]] +on table(n) + set lstTop to range(1, n) + + script cols + on lambda(row) + script rows + on lambda(x) + (row * n) + x + end lambda + end script + + map(rows, lstTop) + end lambda + end script + + map(cols, range(0, n - 1)) +end table + +-- rotation :: [[a]] -> [[a]] +on rotate(lst) + script rotationRow + -- rotatedList :: [a] -> Int -> [a] + on rotatedList(lst, n) + if n = 0 then return lst + + set lng to length of lst + set m to (n + lng) mod lng + items -m thru -1 of lst & items 1 thru (lng - m) of lst + end rotatedList + + on lambda(row, i) + rotatedList(row, (((length of row) + 1) div 2) - (i)) + end lambda + end script + + map(rotationRow, lst) +end rotate + + +-- GENERIC FUNCTIONS + +-- intercalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate + +-- 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 + +-- 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 + +-- range :: Int -> Int -> [Int] +on range(m, n) + if n < m then + set d to -1 + else + set d to 1 + end if + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range + +-- splitOn :: Text -> Text -> [Text] +on splitOn(strDelim, strMain) + set {dlm, my text item delimiters} to {my text item delimiters, strDelim} + set xs to text items of strMain + set my text item delimiters to dlm + return xs +end splitOn + +-- transpose :: [[a]] -> [[a]] +on transpose(xss) + script column + on lambda(_, iCol) + script row + on lambda(xs) + item iCol of xs + end lambda + end script + + map(row, xss) + end lambda + end script + + map(column, item 1 of xss) +end transpose + +-- WIKI DISPLAY + +-- formattedTable :: [[Int]] -> String +on formattedTable(lstTable) + set n to length of lstTable + set w to 2.5 * n + "magic(" & n & ")" & linefeed & linefeed & wikiTable(lstTable, ¬ + false, "text-align:center;width:" & ¬ + w & "em;height:" & w & "em;table-layout:fixed;") +end formattedTable + +-- wikiTable :: [Text] -> Bool -> Text -> Text +on wikiTable(lstRows, blnHdr, strStyle) + script fWikiRows + on lambda(lstRow, iRow) + set strDelim to cond(blnHdr and (iRow = 0), "!", "|") + set strDbl to strDelim & strDelim + linefeed & "|-" & linefeed & strDelim & space & ¬ + intercalate(space & strDbl & space, lstRow) + end lambda + end script + + linefeed & "{| class=\"wikitable\" " & ¬ + cond(strStyle ≠ "", "style=\"" & strStyle & "\"", "") & ¬ + intercalate("", ¬ + map(fWikiRows, lstRows)) & linefeed & "|}" & linefeed +end wikiTable + +-- cond :: Bool -> a -> a -> a +on cond(bool, f, g) + if bool then + f + else + g + end if +end cond diff --git a/Task/Magic-squares-of-odd-order/C++/magic-squares-of-odd-order.cpp b/Task/Magic-squares-of-odd-order/C++/magic-squares-of-odd-order.cpp index f5a6ab496c..1495a423a4 100644 --- a/Task/Magic-squares-of-odd-order/C++/magic-squares-of-odd-order.cpp +++ b/Task/Magic-squares-of-odd-order/C++/magic-squares-of-odd-order.cpp @@ -56,7 +56,7 @@ private: } int magicNumber() - { return ( ( ( sz * sz + 1 ) / 2 ) * sz ); } // as written, this will only work for odd order, because the truncating division precedes the multiplication. (sz * (1 + Square(sz)) / 2 would usually be better + { return sz * ( ( sz * sz ) + 1 ) / 2; } void inc( int& a ) { if( ++a == sz ) a = 0; } @@ -79,5 +79,5 @@ int main( int argc, char* argv[] ) magicSqr s; s.create( 5 ); s.display(); - return system( "pause" ); + return 0; } diff --git a/Task/Magic-squares-of-odd-order/Elixir/magic-squares-of-odd-order.elixir b/Task/Magic-squares-of-odd-order/Elixir/magic-squares-of-odd-order.elixir index 2f3cd14324..736687d605 100644 --- a/Task/Magic-squares-of-odd-order/Elixir/magic-squares-of-odd-order.elixir +++ b/Task/Magic-squares-of-odd-order/Elixir/magic-squares-of-odd-order.elixir @@ -1,15 +1,18 @@ defmodule RC do - require Integer - def odd_magic_square(n) when Integer.is_odd(n) do + def odd_magic_square(n) when rem(n,2)==1 do for i <- 0..n-1 do - for j <- 0..n-1 do - n * rem(i+j+1+div(n,2),n) + rem(i+2*j+2*n-5,n) + 1 - end + for j <- 0..n-1, do: n * rem(i+j+1+div(n,2),n) + rem(i+2*j+2*n-5,n) + 1 end end + + def print_square(sq) do + width = List.flatten(sq) |> Enum.max |> to_char_list |> length + fmt = String.duplicate(" ~#{width}w", length(sq)) <> "~n" + Enum.each(sq, fn row -> :io.format fmt, row end) + end end -Enum.each([3,5,9], fn n -> +Enum.each([3,5,11], fn n -> IO.puts "\nSize #{n}, magic sum #{div(n*n+1,2)*n}" - Enum.each(RC.odd_magic_square(n), fn x -> IO.inspect x end) + RC.odd_magic_square(n) |> RC.print_square end) diff --git a/Task/Magic-squares-of-odd-order/Haskell/magic-squares-of-odd-order-2.hs b/Task/Magic-squares-of-odd-order/Haskell/magic-squares-of-odd-order-2.hs index 01c88203f6..a18c661b9a 100644 --- a/Task/Magic-squares-of-odd-order/Haskell/magic-squares-of-odd-order-2.hs +++ b/Task/Magic-squares-of-odd-order/Haskell/magic-squares-of-odd-order-2.hs @@ -1,25 +1,37 @@ -procedure main(A) - n := integer(!A) | 3 - write("Magic number: ",n*(n*n+1)/2) - sq := buildSquare(n) - showSquare(sq) -end +import Data.List (transpose, intercalate) -procedure buildSquare(n) - sq := [: |list(n)\n :] - r := 0 - c := n/2 - every i := !(n*n) do { - /sq[r+1,c+1] := i - nr := (n+r-1)%n - nc := (c+1)%n - if /sq[nr+1,nc+1] then (r := nr,c := nc) else r := (r+1)%n - } - return sq -end +magicSquare :: Int -> [[Int]] +magicSquare n = rowCycles . transpose . rowCycles $ rangeSquare n + where -procedure showSquare(sq) - n := *sq - s := *(n*n)+2 - every r := !sq do every writes(right(!r,s)|"\n") -end + -- N * N square with cells numbered sequentially + -- left right, top down + + rangeSquare :: Int -> [[Int]] + rangeSquare n = rowsOf n [1..(n^2)] + where + rowsOf _ [] = [] + rowsOf m xs = row : rowsOf n rest + where + (row, rest) = splitAt n xs + + + -- Numbers in each row cycled to the right + -- The first row by (N div 2) cells, and each subsequent row + -- by one less, down to minus (N div 2) in the last row + + rowCycles :: [[Int]] -> [[Int]] + rowCycles rows = + uncurry listCycle <$> zip [d, d-1 .. -d] rows + where + d = quot (length rows) 2 + listCycle _ [] = [] + listCycle n xs = + zipWith const (drop (length xs - n) (cycle xs)) xs + +-- TEST +-- Magic squares of dimension 3, 5 and 7 + +main :: IO () +main = putStr $ intercalate "\n\n" $ + (\n -> (intercalate "\n" $ show <$> magicSquare n)) <$> [3, 5, 7] diff --git a/Task/Magic-squares-of-odd-order/Haskell/magic-squares-of-odd-order-3.hs b/Task/Magic-squares-of-odd-order/Haskell/magic-squares-of-odd-order-3.hs new file mode 100644 index 0000000000..01c88203f6 --- /dev/null +++ b/Task/Magic-squares-of-odd-order/Haskell/magic-squares-of-odd-order-3.hs @@ -0,0 +1,25 @@ +procedure main(A) + n := integer(!A) | 3 + write("Magic number: ",n*(n*n+1)/2) + sq := buildSquare(n) + showSquare(sq) +end + +procedure buildSquare(n) + sq := [: |list(n)\n :] + r := 0 + c := n/2 + every i := !(n*n) do { + /sq[r+1,c+1] := i + nr := (n+r-1)%n + nc := (c+1)%n + if /sq[nr+1,nc+1] then (r := nr,c := nc) else r := (r+1)%n + } + return sq +end + +procedure showSquare(sq) + n := *sq + s := *(n*n)+2 + every r := !sq do every writes(right(!r,s)|"\n") +end diff --git a/Task/Magic-squares-of-odd-order/PARI-GP/magic-squares-of-odd-order.pari b/Task/Magic-squares-of-odd-order/PARI-GP/magic-squares-of-odd-order.pari new file mode 100644 index 0000000000..36de2c99c6 --- /dev/null +++ b/Task/Magic-squares-of-odd-order/PARI-GP/magic-squares-of-odd-order.pari @@ -0,0 +1,14 @@ +magicSquare(n)={ + my(M=matrix(n,n),j=n\2+1,i=1); + for(l=1,n^2, + M[i,j]=l; + if(M[(i-2)%n+1,j%n+1], + i=i%n+1 + , + i=(i-2)%n+1; + j=j%n+1 + ) + ); + M; +} +magicSquare(7) diff --git a/Task/Magic-squares-of-odd-order/Pascal/magic-squares-of-odd-order.pascal b/Task/Magic-squares-of-odd-order/Pascal/magic-squares-of-odd-order-1.pascal similarity index 100% rename from Task/Magic-squares-of-odd-order/Pascal/magic-squares-of-odd-order.pascal rename to Task/Magic-squares-of-odd-order/Pascal/magic-squares-of-odd-order-1.pascal diff --git a/Task/Magic-squares-of-odd-order/Pascal/magic-squares-of-odd-order-2.pascal b/Task/Magic-squares-of-odd-order/Pascal/magic-squares-of-odd-order-2.pascal new file mode 100644 index 0000000000..e95b1340cc --- /dev/null +++ b/Task/Magic-squares-of-odd-order/Pascal/magic-squares-of-odd-order-2.pascal @@ -0,0 +1,98 @@ +PROGRAM magic; +{$IFDEF FPC }{$MODE DELPHI}{$ELSE}{$APPTYPE CONSOLE}{$ENDIF} +uses + sysutils; +(* Magic squares of odd order *) +type + tsquare = array of array of LongInt; + trowcol = array of NativeInt; + +function GenShuffleRowCol(n: nativeInt):trowcol; +var + i,j,tmp: NativeInt; +begin + setlength(result,0); + IF n > 0 then + Begin + setlength(result,n); + For i := 0 to n-1 do + result[i] := i; + //shuffle + For i := n-1 downto 1 do + Begin + j := random(i+1);//j == [0..i] + tmp := result[i];result[i]:= result[j];result[j]:= tmp; + end; + end; +end; + +function MagicSqrOdd(n:nativeInt;SwapColRoW:boolean):tsquare; +VAR + rowIdx,colIdx,row,col,num :NativeInt; + cols,rows :trowcol; +BEGIN + rows:= GenShuffleRowCol(n); + cols:= GenShuffleRowCol(n); + setlength(result,n,n); + FOR rowIdx:= 0 TO n-1 DO + BEGIN + row := rows[rowIdx]; + FOR colIdx:=0 TO n-1 DO + Begin + col := cols[colIdx]; + //corrected formula cause row :0..n*1-> corrected to 1..n + num := (row*2-col+n+2) MOD n*n + (row*2+col+1) MOD n+1; + IF SwapColRoW then + result[colIdx,rowIdx] := num + else + result[rowIdx,colIdx] := num; + end; + END; +END; + +function MagicSqrCheck(const Mq:tsquare):boolean; +var + row,col,rowsum,mn,n,itm: NativeInt; + colSum:trowcol; +begin + n := length(Mq[0]); + mn := n*(n*n+1) DIV 2; + setlength(colsum,n);//automatic initialised to zero + For row := n-1 downto 0 do + Begin + //check one row + rowsum := 0; + For col := n-1 downto 0 do + Begin + itm := Mq[row,col]; + write(itm:4); + inc(rowsum,itm); + //sum up the columns too, for I'm just here + inc(colSum[col],itm); + end; + writeln; + result := (rowsum=mn); + IF Not(result) then begin writeln(row:4,col:4,rowsum:10);EXIT;end; + end; + //check columns + For col := n-1 downto 0 do + Begin + result := (colSum[col]=mn); + IF Not(result) then begin writeln(col:4,colSum[col]:10);EXIT;end; + end; + writeln; +end; + + +var + n,mn : nativeInt; + Mq : tsquare; +Begin + randomize; + n := 9; + mn := n*(n*n+1) DIV 2; + WRITELN('The square order is: ',n); + WRITELN('The magic number is: ',mn); + Mq := MagicSqrOdd(n,random(2)=0); + writeln(MagicSqrCheck(Mq)); +end. diff --git a/Task/Magic-squares-of-odd-order/PureBasic/magic-squares-of-odd-order.purebasic b/Task/Magic-squares-of-odd-order/PureBasic/magic-squares-of-odd-order.purebasic new file mode 100644 index 0000000000..50484a5d3b --- /dev/null +++ b/Task/Magic-squares-of-odd-order/PureBasic/magic-squares-of-odd-order.purebasic @@ -0,0 +1,14 @@ +#N=9 +Define.i i,j + +If OpenConsole("Magic squares") + PrintN("The square order is: "+Str(#N)) + For i=1 To #N + For j=1 To #N + Print(RSet(Str((i*2-j+#N-1) % #N*#N + (i*2+j-2) % #N+1),5)) + Next + PrintN("") + Next + PrintN("The magic number is: "+Str(#N*(#N*#N+1)/2)) +EndIf +Input() diff --git a/Task/Magic-squares-of-odd-order/REXX/magic-squares-of-odd-order.rexx b/Task/Magic-squares-of-odd-order/REXX/magic-squares-of-odd-order.rexx index d065a8a711..91cd37e072 100644 --- a/Task/Magic-squares-of-odd-order/REXX/magic-squares-of-odd-order.rexx +++ b/Task/Magic-squares-of-odd-order/REXX/magic-squares-of-odd-order.rexx @@ -1,22 +1,23 @@ -/*REXX pgm generates & displays magic squares (odd N will be a true magic sq.)*/ -parse arg N . /*obtain the optional argument from CL.*/ -if N=='' | N==',' then N=5 /*Not specified? Then use the default.*/ -NN=N*N; w=length(NN) /*W: width of largest number (output).*/ -r=1; c=(n+1) % 2 /*define the initial row and column.*/ -@.=. /*assign a default value for entire @.*/ - do j=1 for N*N /* [↓] filling uses the Siamese method*/ - if r<1 & c>N then do; r=r+2; c=c-1; end /*row is under, col is over ···*/ - if r<1 then r=N /*row is under, make row=last. */ - if r>N then r=1 /*row is over, make row=first.*/ - if c>N then c=1 /*col is over, make col=first.*/ - if @.r.c\==. then do; r=min(N,r+2); c=max(1,c-1); end /*at previous cell?*/ - @.r.c=j; r=r-1; c=c+1 /*assign # ───► cell; next row and col.*/ +/*REXX program generates and displays magic squares (odd N will be a true magic square).*/ +parse arg N . /*obtain the optional argument from CL.*/ +if N=='' | N=="," then N=5 /*Not specified? Then use the default.*/ +NN=N*N; w=length(NN) /*W: width of largest number (output).*/ +r=1; c=(n+1) % 2 /*define the initial row and column.*/ +@.=. /*assign a default value for entire @.*/ + do j=1 for NN /* [↓] filling uses the Siamese method*/ + if r<1 & c>N then do; r=r+2; c=c-1; end /*the row is under, column is over.*/ + if r<1 then r=N /* " " " " make row=last. */ + if r>N then r=1 /* " " " over, " " first.*/ + if c>N then c=1 /* " column " over, " col=first.*/ + if @.r.c\==. then do; r=min(N,r+2); c=max(1,c-1); end /*at the previous cell? */ + @.r.c=j; r=r-1; c=c+1 /*assign # ───► cell; next row & column*/ end /*j*/ - /* [↓] display square with aligned #'s*/ - do r=1 for N; _= /*display one matrix row at a time. */ - do c=1 for N; _=_ right(@.r.c, w); end /*c*/ /*build a row. */ - say substr(_,2) /*display a row.*/ - end /*c*/ -say /* [↑] If an odd square, show magic #.*/ -if N//2 then say 'The magic number (or magic constant is): ' N * (NN+1) % 2 - /*stick a fork in it, we're all done. */ + /* [↓] display square with aligned #'s*/ + do r=1 for N; _= /*display one matrix row at a time. */ + do c=1 for N; _=_ right(@.r.c, w) /*construct a row of the magic square. */ + end /*c*/ + say substr(_, 2) /*display a row of the magic square. */ + end /*c*/ +say /* [↓] If an odd square, show magic #.*/ +if N//2 then say 'The magic number (or magic constant is): ' N * (NN+1) % 2 + /*stick a fork in it, we're all done. */ diff --git a/Task/Make-directory-path/00DESCRIPTION b/Task/Make-directory-path/00DESCRIPTION index f86919663c..acc863f185 100644 --- a/Task/Make-directory-path/00DESCRIPTION +++ b/Task/Make-directory-path/00DESCRIPTION @@ -1,3 +1,4 @@ +;Task: Create a directory and any missing parents. This task is named after the posix [http://www.unix.com/man-page/POSIX/0/mkdir/ mkdir -p] command, and several libraries which implement the same behavior. @@ -7,3 +8,4 @@ If the directory already exists, return successfully. Ideally implementations will work equally well cross-platform (on windows, linux, and OS X). It's likely that your language implements such a function as part of its standard library. If so, please also show how such a function would be implemented. +

    diff --git a/Task/Make-directory-path/AWK/make-directory-path.awk b/Task/Make-directory-path/AWK/make-directory-path.awk new file mode 100644 index 0000000000..d50f5cdf57 --- /dev/null +++ b/Task/Make-directory-path/AWK/make-directory-path.awk @@ -0,0 +1,14 @@ +# syntax: GAWK -f MAKE_DIRECTORY_PATH.AWK path ... +BEGIN { + for (i=1; i<=ARGC-1; i++) { + path = ARGV[i] + msg = (make_dir_path(path) == 0) ? "created" : "exists" + printf("'%s' %s\n",path,msg) + } + exit(0) +} +function make_dir_path(path, cmd) { +# cmd = sprintf("mkdir -p '%s'",path) # Unix + cmd = sprintf("MKDIR \"%s\" 2>NUL",path) # MS-Windows + return system(cmd) +} diff --git a/Task/Make-directory-path/C/make-directory-path.c b/Task/Make-directory-path/C/make-directory-path.c new file mode 100644 index 0000000000..a08dc3a226 --- /dev/null +++ b/Task/Make-directory-path/C/make-directory-path.c @@ -0,0 +1,32 @@ +#include +#include +#include +#include +#include +#include + +int main (int argc, char **argv) { + char *str, *s; + struct stat statBuf; + + if (argc != 2) { + fprintf (stderr, "usage: %s \n", basename (argv[0])); + exit (1); + } + s = argv[1]; + while ((str = strtok (s, "/")) != NULL) { + if (str != s) { + str[-1] = '/'; + } + if (stat (argv[1], &statBuf) == -1) { + mkdir (argv[1], 0); + } else { + if (! S_ISDIR (statBuf.st_mode)) { + fprintf (stderr, "couldn't create directory %s\n", argv[1]); + exit (1); + } + } + s = NULL; + } + return 0; +} diff --git a/Task/Make-directory-path/NewLISP/make-directory-path.newlisp b/Task/Make-directory-path/NewLISP/make-directory-path.newlisp new file mode 100644 index 0000000000..494057432e --- /dev/null +++ b/Task/Make-directory-path/NewLISP/make-directory-path.newlisp @@ -0,0 +1,18 @@ +(define (mkdir-p mypath) + (if (= "/" (mypath 0)) ;; Abs or relative path? + (setf /? "/") + (setf /? "") + ) + (setf path-components (clean empty? (parse mypath "/"))) ;; Split path and remove empty elements + (for (x 0 (length path-components)) + (setf walking-path (string /? (join (slice path-components 0 (+ 1 x)) "/"))) + (make-dir walking-path) + ) +) + +;; Using user-made function... +(mkdir-p "/tmp/rosetta/test1") + +;; ... or calling OS command directly. +(! "mkdir -p /tmp/rosetta/test2") +(exit) diff --git a/Task/Make-directory-path/Perl-6/make-directory-path-1.pl6 b/Task/Make-directory-path/Perl-6/make-directory-path-1.pl6 new file mode 100644 index 0000000000..4fdb0d544b --- /dev/null +++ b/Task/Make-directory-path/Perl-6/make-directory-path-1.pl6 @@ -0,0 +1 @@ +mkdir 'path/to/dir' diff --git a/Task/Make-directory-path/Perl-6/make-directory-path-2.pl6 b/Task/Make-directory-path/Perl-6/make-directory-path-2.pl6 new file mode 100644 index 0000000000..9dd87a2f3f --- /dev/null +++ b/Task/Make-directory-path/Perl-6/make-directory-path-2.pl6 @@ -0,0 +1,3 @@ +for [\,] $*SPEC.splitdir("../path/to/dir") -> @path { + mkdir $_ unless .e given $*SPEC.catdir(@path).IO; +} diff --git a/Task/Make-directory-path/Perl-6/make-directory-path.pl6 b/Task/Make-directory-path/Perl-6/make-directory-path.pl6 deleted file mode 100644 index b47cefce55..0000000000 --- a/Task/Make-directory-path/Perl-6/make-directory-path.pl6 +++ /dev/null @@ -1 +0,0 @@ -mkpath 'path/to/dir' diff --git a/Task/Make-directory-path/PicoLisp/make-directory-path.l b/Task/Make-directory-path/PicoLisp/make-directory-path.l new file mode 100644 index 0000000000..40f459c572 --- /dev/null +++ b/Task/Make-directory-path/PicoLisp/make-directory-path.l @@ -0,0 +1 @@ +(call "mkdir" "-p" "path/to/dir") diff --git a/Task/Make-directory-path/PowerShell/make-directory-path.psh b/Task/Make-directory-path/PowerShell/make-directory-path.psh new file mode 100644 index 0000000000..1565f24f31 --- /dev/null +++ b/Task/Make-directory-path/PowerShell/make-directory-path.psh @@ -0,0 +1 @@ +New-Item -Path ".\path\to\dir" -ItemType Directory -ErrorAction SilentlyContinue diff --git a/Task/Make-directory-path/REXX/make-directory-path.rexx b/Task/Make-directory-path/REXX/make-directory-path.rexx index b78ad4ce49..3413989330 100644 --- a/Task/Make-directory-path/REXX/make-directory-path.rexx +++ b/Task/Make-directory-path/REXX/make-directory-path.rexx @@ -1,5 +1,7 @@ -/*REXX program creates a directory and all its parent paths as necessary*/ -trace off /*suppress possible warning msgs.*/ -dPath = 'path\to\dir' -'MKDIR' dPath "2>nul" /*alias could be used: MD Dpath */ - /*stick a fork in it, we're done.*/ +/*REXX program creates a directory (folder) and all its parent paths as necessary. */ +trace off /*suppress possible warning msgs.*/ + +dPath = 'path\to\dir' /*define directory (folder) path.*/ + +'MKDIR' dPath "2>nul" /*alias could be used: MD dPath */ + /*stick a fork in it, we're done.*/ diff --git a/Task/Make-directory-path/Run-BASIC/make-directory-path.run b/Task/Make-directory-path/Run-BASIC/make-directory-path.run new file mode 100644 index 0000000000..c13f915a81 --- /dev/null +++ b/Task/Make-directory-path/Run-BASIC/make-directory-path.run @@ -0,0 +1,10 @@ +files #f, "c:\myDocs" ' check for directory +if #f hasanswer() then + if #f isDir() then ' is it a file or a directory + print "A directory exist" + else + print "A file exist" + end if + else + shell$("mkdir c:\myDocs" ' if not exist make a directory +end if diff --git a/Task/Man-or-boy-test/00DESCRIPTION b/Task/Man-or-boy-test/00DESCRIPTION index 9029ac7ca5..65b56fe36d 100644 --- a/Task/Man-or-boy-test/00DESCRIPTION +++ b/Task/Man-or-boy-test/00DESCRIPTION @@ -1,3 +1,4 @@ +
    '''Background''': The '''man or boy test''' was proposed by computer scientist [[wp:Donald_Knuth|Donald Knuth]] as a means of evaluating implementations of the [[:Category:ALGOL 60|ALGOL 60]] programming language. The aim of the test was to distinguish compilers that correctly implemented "recursion and non-local references" from those that did not.
    @@ -217,3 +218,4 @@ The table below shows the result, call depths, and total calls for a range of '' |  |  |} +

    diff --git a/Task/Man-or-boy-test/Ada/man-or-boy-test-3.ada b/Task/Man-or-boy-test/Ada/man-or-boy-test-3.ada new file mode 100644 index 0000000000..ddeb20d9e6 --- /dev/null +++ b/Task/Man-or-boy-test/Ada/man-or-boy-test-3.ada @@ -0,0 +1,41 @@ +with Ada.Text_IO; +use Ada.Text_IO; + +procedure Man_Or_Boy is + + function Zero return Integer is ( 0); + function One return Integer is ( 1); + function Neg return Integer is (-1); + + function A (K: Integer; + X1, X2, X3, X4, X5: access function return Integer) return Integer is + M : Integer := K; -- K is read-only in Ada. Here is a mutable copy of K + Res_A: Integer; + function B return Integer is + begin + M := M - 1; + Res_A := A (M, B'Access, X1, X2, X3, X4); -- set result of A + return Res_A; + end B; + begin + if M <= 0 then + return X4.all + X5.all; + else + declare + Dummy: constant Integer := B; -- throw away + begin + return Res_A; + end; + end if; + end A; + +begin + + Put_Line (Integer'Image (A (K => 10, + X1 => One 'Access, + X2 => Neg 'Access, + X3 => Neg 'Access, + X4 => One 'Access, + X5 => Zero'Access))); + +end Man_Or_Boy; diff --git a/Task/Man-or-boy-test/Elena/man-or-boy-test.elena b/Task/Man-or-boy-test/Elena/man-or-boy-test.elena new file mode 100644 index 0000000000..0fc403e1ec --- /dev/null +++ b/Task/Man-or-boy-test/Elena/man-or-boy-test.elena @@ -0,0 +1,20 @@ +#import system. +#import extensions. + +#symbol A = (:k:x1:x2:x3:x4:x5) +[ + #var m := Integer new:k. + #var b := ()[ m -= 1. ^ A eval:m:this:x1:x2:x3:x4. ]. + + (m <= 0) + ? [ ^ x4 eval + x5 eval. ] + ! [ ^ b eval. ]. +]. + +#symbol program = +[ + 0 to:13 &doEach:n + [ + console writeLine:(A eval:n:()[1]:()[-1]:()[-1]:()[1]:()[0]). + ]. +]. diff --git a/Task/Man-or-boy-test/Go/man-or-boy-test-2.go b/Task/Man-or-boy-test/Go/man-or-boy-test-2.go index bc74507423..d1ab3f98ac 100644 --- a/Task/Man-or-boy-test/Go/man-or-boy-test-2.go +++ b/Task/Man-or-boy-test/Go/man-or-boy-test-2.go @@ -3,22 +3,22 @@ package main import "fmt" func A(k int, x1, x2, x3, x4, x5 func() int) (a int) { - var B func() int - B = func() (b int) { - k-- - a = A(k, B, x1, x2, x3, x4) - b = a - return - } - if k <= 0 { - a = x4() + x5() - } else { - B() - } - return + var B func() int + B = func() (b int) { + k-- + a = A(k, B, x1, x2, x3, x4) + b = a + return + } + if k <= 0 { + a = x4() + x5() + } else { + _ = B() + } + return } func main() { - K := func(x int) func() int { return func() int { return x } } - fmt.Println(A(10, K(1), K(-1), K(-1), K(1), K(0))) + K := func(x int) func() int { return func() int { return x } } + fmt.Println(A(10, K(1), K(-1), K(-1), K(1), K(0))) } diff --git a/Task/Man-or-boy-test/Go/man-or-boy-test-3.go b/Task/Man-or-boy-test/Go/man-or-boy-test-3.go new file mode 100644 index 0000000000..63c40166fb --- /dev/null +++ b/Task/Man-or-boy-test/Go/man-or-boy-test-3.go @@ -0,0 +1,34 @@ +package main + +import "fmt" + +func eval(v interface{}) int { + switch v := v.(type) { + case int: + return v + case func() int: + return v() + } + panic("bad type") + return 0 +} + +func A(k int, x1, x2, x3, x4, x5 interface{}) (a int) { + var B func() int + B = func() (b int) { + k-- + a = A(k, B, x1, x2, x3, x4) + b = a + return + } + if k <= 0 { + a = eval(x4) + eval(x5) + } else { + _ = B() + } + return +} + +func main() { + fmt.Println(A(10, 1, -1, -1, 1, 0)) +} diff --git a/Task/Man-or-boy-test/Go/man-or-boy-test-4.go b/Task/Man-or-boy-test/Go/man-or-boy-test-4.go new file mode 100644 index 0000000000..686831fdba --- /dev/null +++ b/Task/Man-or-boy-test/Go/man-or-boy-test-4.go @@ -0,0 +1,39 @@ +package main + +import ( + "fmt" + "math/big" +) + +func A(k int) *big.Int { + one := big.NewInt(1) + c0 := big.NewInt(3) + c1 := big.NewInt(2) + c2 := big.NewInt(1) + c3 := big.NewInt(0) + for j := 5; j < k; j++ { + c3.Sub(c3.Add(c3, c0), one) + c0.Add(c0, c1) + c1.Add(c1, c2) + c2.Add(c2, c3) + } + return c0.Add(c0.Sub(c0.Sub(c0, c1), c2), c3) +} + +func p(k int) { + fmt.Printf("A(%d) = ", k) + if s := A(k).String(); len(s) < 60 { + fmt.Println(s) + } else { + fmt.Printf("%s...%s (%d digits)\n", + s[:6], s[len(s)-5:], len(s)-1) + } +} + +func main() { + p(10) + p(30) + p(500) + p(10000) + p(1e6) +} diff --git a/Task/Man-or-boy-test/REXX/man-or-boy-test.rexx b/Task/Man-or-boy-test/REXX/man-or-boy-test.rexx index 5664c15964..36bfb55f9f 100644 --- a/Task/Man-or-boy-test/REXX/man-or-boy-test.rexx +++ b/Task/Man-or-boy-test/REXX/man-or-boy-test.rexx @@ -1,16 +1,17 @@ -/*REXX program performs the "man or boy" test as far as possible for N. */ - do n=0 /*increment N from 0 forever.*/ - say 'n='n a(N,x1,x2,x3,x4,x5) /*display the result to the term.*/ - end /*n*/ /* [↑] do until something breaks*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────A subroutine────────────────────────*/ -a: procedure; parse arg k,x1,x2,x3,x4,x5 - if k<=0 then return f(x4)+f(x5) +/*REXX program performs the "man or boy" test as far as possible for N. */ + do n=0 /*increment N from zero forever. */ + say 'n='n a(N,x1,x2,x3,x4,x5) /*display the result to the terminal. */ + end /*n*/ /* [↑] do until something breaks. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +a: procedure; parse arg k, x1, x2, x3, x4, x5 + if k<=0 then return f(x4) + f(x5) else return f(b) -/*──────────────────────────────────one─liner subroutines───────────────*/ -b: k=k-1; return a(k,b,x1,x2,x3,x4) -f: interpret 'v=' arg(1)"()"; return v -x1: procedure; return 1 -x2: procedure; return -1 -x3: procedure; return -1 -x4: procedure; return 1 +/*──────────────────────────────────────────────────────────────────────────────────────*/ +b: k=k-1; return a(k, b, x1, x2, x3, x4) +f: interpret 'v=' arg(1)"()"; return v +x1: procedure; return 1 +x2: procedure; return -1 +x3: procedure; return -1 +x4: procedure; return 1 +x5: procedure; return 0 diff --git a/Task/Man-or-boy-test/TXR/man-or-boy-test-1.txr b/Task/Man-or-boy-test/TXR/man-or-boy-test-1.txr new file mode 100644 index 0000000000..addbcc03e7 --- /dev/null +++ b/Task/Man-or-boy-test/TXR/man-or-boy-test-1.txr @@ -0,0 +1,7 @@ +(defun A (k x1 x2 x3 x4 x5) + (labels ((B () + (dec k) + [A k B x1 x2 x3 x4])) + (if (<= k 0) (+ [x4] [x5]) (B)))) + +(prinl (A 10 (ret 1) (ret -1) (ret -1) (ret 1) (ret 0))) diff --git a/Task/Man-or-boy-test/TXR/man-or-boy-test-2.txr b/Task/Man-or-boy-test/TXR/man-or-boy-test-2.txr new file mode 100644 index 0000000000..c47ea65f92 --- /dev/null +++ b/Task/Man-or-boy-test/TXR/man-or-boy-test-2.txr @@ -0,0 +1,10 @@ +(defun-cbn A (k x1 x2 x3 x4 x5) + (let ((k k)) + (labels-cbn (B () + (dec k) + (set B (set A (A k (B) x1 x2 x3 x4)))) + (if (<= k 0) + (set A (+ x4 x5)) + (B))))) ;; value of (B) correctly discarded here! + +(prinl (A 10 1 -1 -1 1 0)) diff --git a/Task/Man-or-boy-test/TXR/man-or-boy-test-3.txr b/Task/Man-or-boy-test/TXR/man-or-boy-test-3.txr new file mode 100644 index 0000000000..9c29e45588 --- /dev/null +++ b/Task/Man-or-boy-test/TXR/man-or-boy-test-3.txr @@ -0,0 +1,68 @@ +(defstruct (cbn-thunk get set) nil get set) + +(defmacro make-cbn-val (place) + (with-gensyms (nv tmp) + (cond + ((constantp place) + ^(let ((,tmp ,place)) + (new cbn-thunk + get (lambda () ,tmp) + set (lambda (,nv) (set ,tmp ,nv))))) + ((bindable place) + ^(new cbn-thunk + get (lambda () ,place) + set (lambda (,nv) (set ,place ,nv)))) + (t + ^(new cbn-thunk + get (lambda () ,place) + set (lambda (ign) (error "cannot set ~s" ',place))))))) + +(defun cbn-val (cbs) + (call cbs.get)) + +(defun set-cbn-val (cbs nv) + (call cbs.set nv)) + +(defplace (cbn-val thunk) body + (getter setter + (with-gensyms (thunk-tmp) + ^(rlet ((,thunk-tmp ,thunk)) + (macrolet ((,getter () ^(cbn-val ,',thunk-tmp)) + (,setter (val) ^(set-cbn-val ,',thunk-tmp ,val))) + ,body))))) + +(defun make-cbn-fun (sym args . body) + (let ((gens (mapcar (ret (gensym)) args))) + ^(,sym ,gens + (symacrolet ,[mapcar (ret ^(,@1 (cbn-val ,@2))) args gens] + ,*body)))) + +(defmacro cbn (fun . args) + ^(call (fun ,fun) ,*[mapcar (ret ^(make-cbn-val ,@1)) args])) + +(defmacro defun-cbn (name (. args) . body) + (with-gensyms (hidden-fun) + ^(progn + (defun ,hidden-fun ()) + (defmacro ,name (. args) ^(cbn ,',hidden-fun ,*args)) + (set (symbol-function ',hidden-fun) + ,(make-cbn-fun 'lambda args + ^(block ,name (let ((,name)) ,*body ,name))))))) + +(defmacro labels-cbn ((name (. args) . lbody) . body) + (with-gensyms (hidden-fun) + ^(macrolet ((,name (. args) ^(cbn ,',hidden-fun ,*args))) + (labels (,(make-cbn-fun hidden-fun args + ^(block ,name (let ((,name)) ,*lbody ,name)))) + ,*body)))) + +(defun-cbn A (k x1 x2 x3 x4 x5) + (let ((k k)) + (labels-cbn (B () + (dec k) + (set B (set A (A k (B) x1 x2 x3 x4)))) + (if (<= k 0) + (set A (+ x4 x5)) + (B))))) ;; value of (B) correctly discarded here! + +(prinl (A 10 1 -1 -1 1 0)) diff --git a/Task/Mandelbrot-set/00DESCRIPTION b/Task/Mandelbrot-set/00DESCRIPTION index 6ff0ec5889..39759e92f6 100644 --- a/Task/Mandelbrot-set/00DESCRIPTION +++ b/Task/Mandelbrot-set/00DESCRIPTION @@ -1,3 +1,6 @@ +;Task: Generate and draw the [[wp:Mandelbrot set|Mandelbrot set]]. + Note that there are [http://en.wikibooks.org/wiki/Fractals/Iterations_in_the_complex_plane/Mandelbrot_set many algorithms] to draw Mandelbrot set and there are [http://en.wikibooks.org/wiki/Pictures_of_Julia_and_Mandelbrot_sets many functions] which generate it . +

    diff --git a/Task/Mandelbrot-set/BASIC/mandelbrot-set-8.basic b/Task/Mandelbrot-set/BASIC/mandelbrot-set-8.basic new file mode 100644 index 0000000000..168460a577 --- /dev/null +++ b/Task/Mandelbrot-set/BASIC/mandelbrot-set-8.basic @@ -0,0 +1,15 @@ +Function mandel(xi As Double, yi As Double) + +maxiter = 256 +x = 0 +y = 0 + +For i = 1 To maxiter + If ((x * x) + (y * y)) > 4 Then Exit For + xt = xi + ((x * x) - (y * y)) + y = yi + (2 * x * y) + x = xt + Next + +mandel = i +End Function diff --git a/Task/Mandelbrot-set/Brainf---/mandelbrot-set.bf b/Task/Mandelbrot-set/Brainf---/mandelbrot-set.bf new file mode 100644 index 0000000000..068b7154f0 --- /dev/null +++ b/Task/Mandelbrot-set/Brainf---/mandelbrot-set.bf @@ -0,0 +1,145 @@ + A mandelbrot set fractal viewer in brainf*ck written by Erik Bosman ++++++++++++++[->++>>>+++++>++>+<<<<<<]>>>>>++++++>--->>>>>>>>>>+++++++++++++++[[ +>>>>>>>>>]+[<<<<<<<<<]>>>>>>>>>-]+[>>>>>>>>[-]>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>[-]+ +<<<<<<<+++++[-[->>>>>>>>>+<<<<<<<<<]>>>>>>>>>]>>>>>>>+>>>>>>>>>>>>>>>>>>>>>>>>>> +>+<<<<<<<<<<<<<<<<<[<<<<<<<<<]>>>[-]+[>>>>>>[>>>>>>>[-]>>]<<<<<<<<<[<<<<<<<<<]>> +>>>>>[-]+<<<<<<++++[-[->>>>>>>>>+<<<<<<<<<]>>>>>>>>>]>>>>>>+<<<<<<+++++++[-[->>> +>>>>>>+<<<<<<<<<]>>>>>>>>>]>>>>>>+<<<<<<<<<<<<<<<<[<<<<<<<<<]>>>[[-]>>>>>>[>>>>> +>>[-<<<<<<+>>>>>>]<<<<<<[->>>>>>+<<+<<<+<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>> +[>>>>>>>>[-<<<<<<<+>>>>>>>]<<<<<<<[->>>>>>>+<<+<<<+<<]>>>>>>>>]<<<<<<<<<[<<<<<<< +<<]>>>>>>>[-<<<<<<<+>>>>>>>]<<<<<<<[->>>>>>>+<<+<<<<<]>>>>>>>>>+++++++++++++++[[ +>>>>>>>>>]+>[-]>[-]>[-]>[-]>[-]>[-]>[-]>[-]>[-]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>-]+[ +>+>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>->>>>[-<<<<+>>>>]<<<<[->>>>+<<<<<[->>[ +-<<+>>]<<[->>+>>+<<<<]+>>>>>>>>>]<<<<<<<<[<<<<<<<<<]]>>>>>>>>>[>>>>>>>>>]<<<<<<< +<<[>[->>>>>>>>>+<<<<<<<<<]<<<<<<<<<<]>[->>>>>>>>>+<<<<<<<<<]<+>>>>>>>>]<<<<<<<<< +[>[-]<->>>>[-<<<<+>[<->-<<<<<<+>>>>>>]<[->+<]>>>>]<<<[->>>+<<<]<+<<<<<<<<<]>>>>> +>>>>[>+>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>->>>>>[-<<<<<+>>>>>]<<<<<[->>>>>+ +<<<<<<[->>>[-<<<+>>>]<<<[->>>+>+<<<<]+>>>>>>>>>]<<<<<<<<[<<<<<<<<<]]>>>>>>>>>[>> +>>>>>>>]<<<<<<<<<[>>[->>>>>>>>>+<<<<<<<<<]<<<<<<<<<<<]>>[->>>>>>>>>+<<<<<<<<<]<< ++>>>>>>>>]<<<<<<<<<[>[-]<->>>>[-<<<<+>[<->-<<<<<<+>>>>>>]<[->+<]>>>>]<<<[->>>+<< +<]<+<<<<<<<<<]>>>>>>>>>[>>>>[-<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>>>>>]>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>+++++++++++++++[[>>>> +>>>>>]<<<<<<<<<-<<<<<<<<<[<<<<<<<<<]>>>>>>>>>-]+>>>>>>>>>>>>>>>>>>>>>+<<<[<<<<<< +<<<]>>>>>>>>>[>>>[-<<<->>>]+<<<[->>>->[-<<<<+>>>>]<<<<[->>>>+<<<<<<<<<<<<<[<<<<< +<<<<]>>>>[-]+>>>>>[>>>>>>>>>]>+<]]+>>>>[-<<<<->>>>]+<<<<[->>>>-<[-<<<+>>>]<<<[-> +>>+<<<<<<<<<<<<[<<<<<<<<<]>>>[-]+>>>>>>[>>>>>>>>>]>[-]+<]]+>[-<[>>>>>>>>>]<<<<<< +<<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]<<<<<<<[->+>>>-<<<<]>>>>>>>>>+++++++++++++++++++ ++++++++>>[-<<<<+>>>>]<<<<[->>>>+<<[-]<<]>>[<<<<<<<+<[-<+>>>>+<<[-]]>[-<<[->+>>>- +<<<<]>>>]>>>>>>>>>>>>>[>>[-]>[-]>[-]>>>>>]<<<<<<<<<[<<<<<<<<<]>>>[-]>>>>>>[>>>>> +[-<<<<+>>>>]<<<<[->>>>+<<<+<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>>[-<<<<<<<< +<+>>>>>>>>>]>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>+++++++++++++++[[>>>>>>>>>]+>[- +]>[-]>[-]>[-]>[-]>[-]>[-]>[-]>[-]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>-]+[>+>>>>>>>>]<<< +<<<<<<[<<<<<<<<<]>>>>>>>>>[>->>>>>[-<<<<<+>>>>>]<<<<<[->>>>>+<<<<<<[->>[-<<+>>]< +<[->>+>+<<<]+>>>>>>>>>]<<<<<<<<[<<<<<<<<<]]>>>>>>>>>[>>>>>>>>>]<<<<<<<<<[>[->>>> +>>>>>+<<<<<<<<<]<<<<<<<<<<]>[->>>>>>>>>+<<<<<<<<<]<+>>>>>>>>]<<<<<<<<<[>[-]<->>> +[-<<<+>[<->-<<<<<<<+>>>>>>>]<[->+<]>>>]<<[->>+<<]<+<<<<<<<<<]>>>>>>>>>[>>>>>>[-< +<<<<+>>>>>]<<<<<[->>>>>+<<<<+<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>+>>>>>>>> +]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>->>>>>[-<<<<<+>>>>>]<<<<<[->>>>>+<<<<<<[->>[-<<+ +>>]<<[->>+>>+<<<<]+>>>>>>>>>]<<<<<<<<[<<<<<<<<<]]>>>>>>>>>[>>>>>>>>>]<<<<<<<<<[> +[->>>>>>>>>+<<<<<<<<<]<<<<<<<<<<]>[->>>>>>>>>+<<<<<<<<<]<+>>>>>>>>]<<<<<<<<<[>[- +]<->>>>[-<<<<+>[<->-<<<<<<+>>>>>>]<[->+<]>>>>]<<<[->>>+<<<]<+<<<<<<<<<]>>>>>>>>> +[>>>>[-<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> +]>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>>>[-<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+> +>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>]>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>++++++++ ++++++++[[>>>>>>>>>]<<<<<<<<<-<<<<<<<<<[<<<<<<<<<]>>>>>>>>>-]+[>>>>>>>>[-<<<<<<<+ +>>>>>>>]<<<<<<<[->>>>>>>+<<<<<<+<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>>>>>>[ +-]>>>]<<<<<<<<<[<<<<<<<<<]>>>>+>[-<-<<<<+>>>>>]>[-<<<<<<[->>>>>+<++<<<<]>>>>>[-< +<<<<+>>>>>]<->+>]<[->+<]<<<<<[->>>>>+<<<<<]>>>>>>[-]<<<<<<+>>>>[-<<<<->>>>]+<<<< +[->>>>->>>>>[>>[-<<->>]+<<[->>->[-<<<+>>>]<<<[->>>+<<<<<<<<<<<<[<<<<<<<<<]>>>[-] ++>>>>>>[>>>>>>>>>]>+<]]+>>>[-<<<->>>]+<<<[->>>-<[-<<+>>]<<[->>+<<<<<<<<<<<[<<<<< +<<<<]>>>>[-]+>>>>>[>>>>>>>>>]>[-]+<]]+>[-<[>>>>>>>>>]<<<<<<<<]>>>>>>>>]<<<<<<<<< +[<<<<<<<<<]>>>>[-<<<<+>>>>]<<<<[->>>>+>>>>>[>+>>[-<<->>]<<[->>+<<]>>>>>>>>]<<<<< +<<<+<[>[->>>>>+<<<<[->>>>-<<<<<<<<<<<<<<+>>>>>>>>>>>[->>>+<<<]<]>[->>>-<<<<<<<<< +<<<<<+>>>>>>>>>>>]<<]>[->>>>+<<<[->>>-<<<<<<<<<<<<<<+>>>>>>>>>>>]<]>[->>>+<<<]<< +<<<<<<<<<<]>>>>[-]<<<<]>>>[-<<<+>>>]<<<[->>>+>>>>>>[>+>[-<->]<[->+<]>>>>>>>>]<<< +<<<<<+<[>[->>>>>+<<<[->>>-<<<<<<<<<<<<<<+>>>>>>>>>>[->>>>+<<<<]>]<[->>>>-<<<<<<< +<<<<<<<+>>>>>>>>>>]<]>>[->>>+<<<<[->>>>-<<<<<<<<<<<<<<+>>>>>>>>>>]>]<[->>>>+<<<< +]<<<<<<<<<<<]>>>>>>+<<<<<<]]>>>>[-<<<<+>>>>]<<<<[->>>>+>>>>>[>>>>>>>>>]<<<<<<<<< +[>[->>>>>+<<<<[->>>>-<<<<<<<<<<<<<<+>>>>>>>>>>>[->>>+<<<]<]>[->>>-<<<<<<<<<<<<<< ++>>>>>>>>>>>]<<]>[->>>>+<<<[->>>-<<<<<<<<<<<<<<+>>>>>>>>>>>]<]>[->>>+<<<]<<<<<<< +<<<<<]]>[-]>>[-]>[-]>>>>>[>>[-]>[-]>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>>>>>[-< +<<<+>>>>]<<<<[->>>>+<<<+<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>+++++++++++++++[ +[>>>>>>>>>]+>[-]>[-]>[-]>[-]>[-]>[-]>[-]>[-]>[-]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>-]+ +[>+>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>->>>>[-<<<<+>>>>]<<<<[->>>>+<<<<<[->> +[-<<+>>]<<[->>+>+<<<]+>>>>>>>>>]<<<<<<<<[<<<<<<<<<]]>>>>>>>>>[>>>>>>>>>]<<<<<<<< +<[>[->>>>>>>>>+<<<<<<<<<]<<<<<<<<<<]>[->>>>>>>>>+<<<<<<<<<]<+>>>>>>>>]<<<<<<<<<[ +>[-]<->>>[-<<<+>[<->-<<<<<<<+>>>>>>>]<[->+<]>>>]<<[->>+<<]<+<<<<<<<<<]>>>>>>>>>[ +>>>[-<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>]> +>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>[-]>>>>+++++++++++++++[[>>>>>>>>>]<<<<<<<<<-<<<<< +<<<<[<<<<<<<<<]>>>>>>>>>-]+[>>>[-<<<->>>]+<<<[->>>->[-<<<<+>>>>]<<<<[->>>>+<<<<< +<<<<<<<<[<<<<<<<<<]>>>>[-]+>>>>>[>>>>>>>>>]>+<]]+>>>>[-<<<<->>>>]+<<<<[->>>>-<[- +<<<+>>>]<<<[->>>+<<<<<<<<<<<<[<<<<<<<<<]>>>[-]+>>>>>>[>>>>>>>>>]>[-]+<]]+>[-<[>> +>>>>>>>]<<<<<<<<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>[-<<<+>>>]<<<[->>>+>>>>>>[>+>>> +[-<<<->>>]<<<[->>>+<<<]>>>>>>>>]<<<<<<<<+<[>[->+>[-<-<<<<<<<<<<+>>>>>>>>>>>>[-<< ++>>]<]>[-<<-<<<<<<<<<<+>>>>>>>>>>>>]<<<]>>[-<+>>[-<<-<<<<<<<<<<+>>>>>>>>>>>>]<]> +[-<<+>>]<<<<<<<<<<<<<]]>>>>[-<<<<+>>>>]<<<<[->>>>+>>>>>[>+>>[-<<->>]<<[->>+<<]>> +>>>>>>]<<<<<<<<+<[>[->+>>[-<<-<<<<<<<<<<+>>>>>>>>>>>[-<+>]>]<[-<-<<<<<<<<<<+>>>> +>>>>>>>]<<]>>>[-<<+>[-<-<<<<<<<<<<+>>>>>>>>>>>]>]<[-<+>]<<<<<<<<<<<<]>>>>>+<<<<< +]>>>>>>>>>[>>>[-]>[-]>[-]>>>>]<<<<<<<<<[<<<<<<<<<]>>>[-]>[-]>>>>>[>>>>>>>[-<<<<< +<+>>>>>>]<<<<<<[->>>>>>+<<<<+<<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>+>[-<-<<<<+>>>> +>]>>[-<<<<<<<[->>>>>+<++<<<<]>>>>>[-<<<<<+>>>>>]<->+>>]<<[->>+<<]<<<<<[->>>>>+<< +<<<]+>>>>[-<<<<->>>>]+<<<<[->>>>->>>>>[>>>[-<<<->>>]+<<<[->>>-<[-<<+>>]<<[->>+<< +<<<<<<<<<[<<<<<<<<<]>>>>[-]+>>>>>[>>>>>>>>>]>+<]]+>>[-<<->>]+<<[->>->[-<<<+>>>]< +<<[->>>+<<<<<<<<<<<<[<<<<<<<<<]>>>[-]+>>>>>>[>>>>>>>>>]>[-]+<]]+>[-<[>>>>>>>>>]< +<<<<<<<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>[-<<<+>>>]<<<[->>>+>>>>>>[>+>[-<->]<[->+ +<]>>>>>>>>]<<<<<<<<+<[>[->>>>+<<[->>-<<<<<<<<<<<<<+>>>>>>>>>>[->>>+<<<]>]<[->>>- +<<<<<<<<<<<<<+>>>>>>>>>>]<]>>[->>+<<<[->>>-<<<<<<<<<<<<<+>>>>>>>>>>]>]<[->>>+<<< +]<<<<<<<<<<<]>>>>>[-]>>[-<<<<<<<+>>>>>>>]<<<<<<<[->>>>>>>+<<+<<<<<]]>>>>[-<<<<+> +>>>]<<<<[->>>>+>>>>>[>+>>[-<<->>]<<[->>+<<]>>>>>>>>]<<<<<<<<+<[>[->>>>+<<<[->>>- +<<<<<<<<<<<<<+>>>>>>>>>>>[->>+<<]<]>[->>-<<<<<<<<<<<<<+>>>>>>>>>>>]<<]>[->>>+<<[ +->>-<<<<<<<<<<<<<+>>>>>>>>>>>]<]>[->>+<<]<<<<<<<<<<<<]]>>>>[-]<<<<]>>>>[-<<<<+>> +>>]<<<<[->>>>+>[-]>>[-<<<<<<<+>>>>>>>]<<<<<<<[->>>>>>>+<<+<<<<<]>>>>>>>>>[>>>>>> +>>>]<<<<<<<<<[>[->>>>+<<<[->>>-<<<<<<<<<<<<<+>>>>>>>>>>>[->>+<<]<]>[->>-<<<<<<<< +<<<<<+>>>>>>>>>>>]<<]>[->>>+<<[->>-<<<<<<<<<<<<<+>>>>>>>>>>>]<]>[->>+<<]<<<<<<<< +<<<<]]>>>>>>>>>[>>[-]>[-]>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>[-]>[-]>>>>>[>>>>>[-<<<<+ +>>>>]<<<<[->>>>+<<<+<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>>>>>>[-<<<<<+>>>>> +]<<<<<[->>>>>+<<<+<<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>+++++++++++++++[[>>>> +>>>>>]+>[-]>[-]>[-]>[-]>[-]>[-]>[-]>[-]>[-]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>-]+[>+>> +>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>->>>>[-<<<<+>>>>]<<<<[->>>>+<<<<<[->>[-<<+ +>>]<<[->>+>>+<<<<]+>>>>>>>>>]<<<<<<<<[<<<<<<<<<]]>>>>>>>>>[>>>>>>>>>]<<<<<<<<<[> +[->>>>>>>>>+<<<<<<<<<]<<<<<<<<<<]>[->>>>>>>>>+<<<<<<<<<]<+>>>>>>>>]<<<<<<<<<[>[- +]<->>>>[-<<<<+>[<->-<<<<<<+>>>>>>]<[->+<]>>>>]<<<[->>>+<<<]<+<<<<<<<<<]>>>>>>>>> +[>+>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>->>>>>[-<<<<<+>>>>>]<<<<<[->>>>>+<<<< +<<[->>>[-<<<+>>>]<<<[->>>+>+<<<<]+>>>>>>>>>]<<<<<<<<[<<<<<<<<<]]>>>>>>>>>[>>>>>> +>>>]<<<<<<<<<[>>[->>>>>>>>>+<<<<<<<<<]<<<<<<<<<<<]>>[->>>>>>>>>+<<<<<<<<<]<<+>>> +>>>>>]<<<<<<<<<[>[-]<->>>>[-<<<<+>[<->-<<<<<<+>>>>>>]<[->+<]>>>>]<<<[->>>+<<<]<+ +<<<<<<<<<]>>>>>>>>>[>>>>[-<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<+>>>>>>>>>>>>>>>>> +>>>>>>>>>>>>>>>>>>>]>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>+++++++++++++++[[>>>>>>>> +>]<<<<<<<<<-<<<<<<<<<[<<<<<<<<<]>>>>>>>>>-]+>>>>>>>>>>>>>>>>>>>>>+<<<[<<<<<<<<<] +>>>>>>>>>[>>>[-<<<->>>]+<<<[->>>->[-<<<<+>>>>]<<<<[->>>>+<<<<<<<<<<<<<[<<<<<<<<< +]>>>>[-]+>>>>>[>>>>>>>>>]>+<]]+>>>>[-<<<<->>>>]+<<<<[->>>>-<[-<<<+>>>]<<<[->>>+< +<<<<<<<<<<<[<<<<<<<<<]>>>[-]+>>>>>>[>>>>>>>>>]>[-]+<]]+>[-<[>>>>>>>>>]<<<<<<<<]> +>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>->>[-<<<<+>>>>]<<<<[->>>>+<<[-]<<]>>]<<+>>>>[-<<<< +->>>>]+<<<<[->>>>-<<<<<<.>>]>>>>[-<<<<<<<.>>>>>>>]<<<[-]>[-]>[-]>[-]>[-]>[-]>>>[ +>[-]>[-]>[-]>[-]>[-]>[-]>>>]<<<<<<<<<[<<<<<<<<<]>>>>>>>>>[>>>>>[-]>>>>]<<<<<<<<< +[<<<<<<<<<]>+++++++++++[-[->>>>>>>>>+<<<<<<<<<]>>>>>>>>>]>>>>+>>>>>>>>>+<<<<<<<< +<<<<<<[<<<<<<<<<]>>>>>>>[-<<<<<<<+>>>>>>>]<<<<<<<[->>>>>>>+[-]>>[>>>>>>>>>]<<<<< +<<<<[>>>>>>>[-<<<<<<+>>>>>>]<<<<<<[->>>>>>+<<<<<<<[<<<<<<<<<]>>>>>>>[-]+>>>]<<<< +<<<<<<]]>>>>>>>[-<<<<<<<+>>>>>>>]<<<<<<<[->>>>>>>+>>[>+>>>>[-<<<<->>>>]<<<<[->>> +>+<<<<]>>>>>>>>]<<+<<<<<<<[>>>>>[->>+<<]<<<<<<<<<<<<<<]>>>>>>>>>[>>>>>>>>>]<<<<< +<<<<[>[-]<->>>>>>>[-<<<<<<<+>[<->-<<<+>>>]<[->+<]>>>>>>>]<<<<<<[->>>>>>+<<<<<<]< ++<<<<<<<<<]>>>>>>>-<<<<[-]+<<<]+>>>>>>>[-<<<<<<<->>>>>>>]+<<<<<<<[->>>>>>>->>[>> +>>>[->>+<<]>>>>]<<<<<<<<<[>[-]<->>>>>>>[-<<<<<<<+>[<->-<<<+>>>]<[->+<]>>>>>>>]<< +<<<<[->>>>>>+<<<<<<]<+<<<<<<<<<]>+++++[-[->>>>>>>>>+<<<<<<<<<]>>>>>>>>>]>>>>+<<< +<<[<<<<<<<<<]>>>>>>>>>[>>>>>[-<<<<<->>>>>]+<<<<<[->>>>>->>[-<<<<<<<+>>>>>>>]<<<< +<<<[->>>>>>>+<<<<<<<<<<<<<<<<[<<<<<<<<<]>>>>[-]+>>>>>[>>>>>>>>>]>+<]]+>>>>>>>[-< +<<<<<<->>>>>>>]+<<<<<<<[->>>>>>>-<<[-<<<<<+>>>>>]<<<<<[->>>>>+<<<<<<<<<<<<<<[<<< +<<<<<<]>>>[-]+>>>>>>[>>>>>>>>>]>[-]+<]]+>[-<[>>>>>>>>>]<<<<<<<<]>>>>>>>>]<<<<<<< +<<[<<<<<<<<<]>>>>[-]<<<+++++[-[->>>>>>>>>+<<<<<<<<<]>>>>>>>>>]>>>>-<<<<<[<<<<<<< +<<]]>>>]<<<<.>>>>>>>>>>[>>>>>>[-]>>>]<<<<<<<<<[<<<<<<<<<]>++++++++++[-[->>>>>>>> +>+<<<<<<<<<]>>>>>>>>>]>>>>>+>>>>>>>>>+<<<<<<<<<<<<<<<[<<<<<<<<<]>>>>>>>>[-<<<<<< +<<+>>>>>>>>]<<<<<<<<[->>>>>>>>+[-]>[>>>>>>>>>]<<<<<<<<<[>>>>>>>>[-<<<<<<<+>>>>>> +>]<<<<<<<[->>>>>>>+<<<<<<<<[<<<<<<<<<]>>>>>>>>[-]+>>]<<<<<<<<<<]]>>>>>>>>[-<<<<< +<<<+>>>>>>>>]<<<<<<<<[->>>>>>>>+>[>+>>>>>[-<<<<<->>>>>]<<<<<[->>>>>+<<<<<]>>>>>> +>>]<+<<<<<<<<[>>>>>>[->>+<<]<<<<<<<<<<<<<<<]>>>>>>>>>[>>>>>>>>>]<<<<<<<<<[>[-]<- +>>>>>>>>[-<<<<<<<<+>[<->-<<+>>]<[->+<]>>>>>>>>]<<<<<<<[->>>>>>>+<<<<<<<]<+<<<<<< +<<<]>>>>>>>>-<<<<<[-]+<<<]+>>>>>>>>[-<<<<<<<<->>>>>>>>]+<<<<<<<<[->>>>>>>>->[>>> +>>>[->>+<<]>>>]<<<<<<<<<[>[-]<->>>>>>>>[-<<<<<<<<+>[<->-<<+>>]<[->+<]>>>>>>>>]<< +<<<<<[->>>>>>>+<<<<<<<]<+<<<<<<<<<]>+++++[-[->>>>>>>>>+<<<<<<<<<]>>>>>>>>>]>>>>> ++>>>>>>>>>>>>>>>>>>>>>>>>>>>+<<<<<<[<<<<<<<<<]>>>>>>>>>[>>>>>>[-<<<<<<->>>>>>]+< +<<<<<[->>>>>>->>[-<<<<<<<<+>>>>>>>>]<<<<<<<<[->>>>>>>>+<<<<<<<<<<<<<<<<<[<<<<<<< +<<]>>>>[-]+>>>>>[>>>>>>>>>]>+<]]+>>>>>>>>[-<<<<<<<<->>>>>>>>]+<<<<<<<<[->>>>>>>> +-<<[-<<<<<<+>>>>>>]<<<<<<[->>>>>>+<<<<<<<<<<<<<<<[<<<<<<<<<]>>>[-]+>>>>>>[>>>>>> +>>>]>[-]+<]]+>[-<[>>>>>>>>>]<<<<<<<<]>>>>>>>>]<<<<<<<<<[<<<<<<<<<]>>>>[-]<<<++++ ++[-[->>>>>>>>>+<<<<<<<<<]>>>>>>>>>]>>>>>->>>>>>>>>>>>>>>>>>>>>>>>>>>-<<<<<<[<<<< +<<<<<]]>>>] diff --git a/Task/Mandelbrot-set/COBOL/mandelbrot-set.cobol b/Task/Mandelbrot-set/COBOL/mandelbrot-set.cobol new file mode 100644 index 0000000000..5ec202576e --- /dev/null +++ b/Task/Mandelbrot-set/COBOL/mandelbrot-set.cobol @@ -0,0 +1,51 @@ +IDENTIFICATION DIVISION. +PROGRAM-ID. MANDELBROT-SET-PROGRAM. +DATA DIVISION. +WORKING-STORAGE SECTION. +01 COMPLEX-ARITHMETIC. + 05 X PIC S9V9(9). + 05 Y PIC S9V9(9). + 05 X-A PIC S9V9(6). + 05 X-B PIC S9V9(6). + 05 Y-A PIC S9V9(6). + 05 X-A-SQUARED PIC S9V9(6). + 05 Y-A-SQUARED PIC S9V9(6). + 05 SUM-OF-SQUARES PIC S9V9(6). + 05 ROOT PIC S9V9(6). +01 LOOP-COUNTERS. + 05 I PIC 99. + 05 J PIC 99. + 05 K PIC 999. +77 PLOT-CHARACTER PIC X. +PROCEDURE DIVISION. +CONTROL-PARAGRAPH. + PERFORM OUTER-LOOP-PARAGRAPH + VARYING I FROM 1 BY 1 UNTIL I IS GREATER THAN 24. + STOP RUN. +OUTER-LOOP-PARAGRAPH. + PERFORM INNER-LOOP-PARAGRAPH + VARYING J FROM 1 BY 1 UNTIL J IS GREATER THAN 64. + DISPLAY ''. +INNER-LOOP-PARAGRAPH. + MOVE SPACE TO PLOT-CHARACTER. + MOVE ZERO TO X-A. + MOVE ZERO TO Y-A. + MULTIPLY J BY 0.0390625 GIVING X. + SUBTRACT 1.5 FROM X. + MULTIPLY I BY 0.083333333 GIVING Y. + SUBTRACT 1 FROM Y. + PERFORM ITERATION-PARAGRAPH VARYING K FROM 1 BY 1 + UNTIL K IS GREATER THAN 100 OR PLOT-CHARACTER IS EQUAL TO '#'. + DISPLAY PLOT-CHARACTER WITH NO ADVANCING. +ITERATION-PARAGRAPH. + MULTIPLY X-A BY X-A GIVING X-A-SQUARED. + MULTIPLY Y-A BY Y-A GIVING Y-A-SQUARED. + SUBTRACT Y-A-SQUARED FROM X-A-SQUARED GIVING X-B. + ADD X TO X-B. + MULTIPLY X-A BY Y-A GIVING Y-A. + MULTIPLY Y-A BY 2 GIVING Y-A. + SUBTRACT Y FROM Y-A. + MOVE X-B TO X-A. + ADD X-A-SQUARED TO Y-A-SQUARED GIVING SUM-OF-SQUARES. + MOVE FUNCTION SQRT (SUM-OF-SQUARES) TO ROOT. + IF ROOT IS GREATER THAN 2 THEN MOVE '#' TO PLOT-CHARACTER. diff --git a/Task/Mandelbrot-set/Elixir/mandelbrot-set.elixir b/Task/Mandelbrot-set/Elixir/mandelbrot-set.elixir new file mode 100644 index 0000000000..68605dc4af --- /dev/null +++ b/Task/Mandelbrot-set/Elixir/mandelbrot-set.elixir @@ -0,0 +1,29 @@ +defmodule Mandelbrot do + def set do + xsize = 59 + ysize = 21 + minIm = -1.0 + maxIm = 1.0 + minRe = -2.0 + maxRe = 1.0 + stepX = (maxRe - minRe) / xsize + stepY = (maxIm - minIm) / ysize + Enum.each(0..ysize, fn y -> + im = minIm + stepY * y + Enum.map(0..xsize, fn x -> + re = minRe + stepX * x + 62 - loop(0, re, im, re, im, re*re+im*im) + end) |> IO.puts + end) + end + + defp loop(n, _, _, _, _, _) when n>=30, do: n + defp loop(n, _, _, _, _, v) when v>4.0, do: n-1 + defp loop(n, re, im, zr, zi, _) do + a = zr * zr + b = zi * zi + loop(n+1, re, im, a-b+re, 2*zr*zi+im, a+b) + end +end + +Mandelbrot.set diff --git a/Task/Mandelbrot-set/OpenEdge-Progress/mandelbrot-set.openedge b/Task/Mandelbrot-set/OpenEdge-Progress/mandelbrot-set.openedge new file mode 100644 index 0000000000..4556e782d0 --- /dev/null +++ b/Task/Mandelbrot-set/OpenEdge-Progress/mandelbrot-set.openedge @@ -0,0 +1,44 @@ +DEFINE VARIABLE print_str AS CHAR NO-UNDO INIT ''. +DEFINE VARIABLE X1 AS DECIMAL NO-UNDO INIT 50. +DEFINE VARIABLE Y1 AS DECIMAL NO-UNDO INIT 21. +DEFINE VARIABLE X AS DECIMAL NO-UNDO. +DEFINE VARIABLE Y AS DECIMAL NO-UNDO. +DEFINE VARIABLE N AS DECIMAL NO-UNDO. +DEFINE VARIABLE I3 AS DECIMAL NO-UNDO. +DEFINE VARIABLE R3 AS DECIMAL NO-UNDO. +DEFINE VARIABLE Z1 AS DECIMAL NO-UNDO. +DEFINE VARIABLE Z2 AS DECIMAL NO-UNDO. +DEFINE VARIABLE A AS DECIMAL NO-UNDO. +DEFINE VARIABLE B AS DECIMAL NO-UNDO. +DEFINE VARIABLE I1 AS DECIMAL NO-UNDO INIT -1.0. +DEFINE VARIABLE I2 AS DECIMAL NO-UNDO INIT 1.0. +DEFINE VARIABLE R1 AS DECIMAL NO-UNDO INIT -2.0. +DEFINE VARIABLE R2 AS DECIMAL NO-UNDO INIT 1.0. +DEFINE VARIABLE S1 AS DECIMAL NO-UNDO. +DEFINE VARIABLE S2 AS DECIMAL NO-UNDO. + + +S1 = (R2 - R1) / X1. +S2 = (I2 - I1) / Y1. +DO Y = 0 TO Y1 - 1: + I3 = I1 + S2 * Y. + DO X = 0 TO X1 - 1: + R3 = R1 + S1 * X. + Z1 = R3. + Z2 = I3. + DO N = 0 TO 29: + A = Z1 * Z1. + B = Z2 * Z2. + IF A + B > 4.0 THEN + LEAVE. + Z2 = 2 * Z1 * Z2 + I3. + Z1 = A - B + R3. + END. + print_str = print_str + CHR(62 - N). + END. + print_str = print_str + '~n'. +END. + +OUTPUT TO "C:\Temp\out.txt". +MESSAGE print_str. +OUTPUT CLOSE. diff --git a/Task/Mandelbrot-set/Perl-6/mandelbrot-set.pl6 b/Task/Mandelbrot-set/Perl-6/mandelbrot-set.pl6 index e46b25e5cf..e855c8d0ce 100644 --- a/Task/Mandelbrot-set/Perl-6/mandelbrot-set.pl6 +++ b/Task/Mandelbrot-set/Perl-6/mandelbrot-set.pl6 @@ -1,13 +1,3 @@ -constant MAX_ITERATIONS = 50; -my $width = my $height = +(@*ARGS[0] // 30); - -sub cut(Range $r, Int $n where $n > 1) { - $r.min, * + ($r.max - $r.min) / ($n - 1) ... $r.max -} - -my @re = cut(-2 .. 1/2, $height); -my $im = [ cut( 0 .. 5/4, $width div 2 + 1) X* 1i ]; - constant @color_map = map ~*.comb(/../).map({:16($_)}), < 000000 0000fc 4000fc 7c00fc bc00fc fc00fc fc00bc fc007c fc0040 fc0000 fc4000 fc7c00 fcbc00 fcfc00 bcfc00 7cfc00 40fc00 00fc00 00fc40 00fc7c 00fcbc 00fcfc @@ -31,27 +21,29 @@ b4fcc4 b4fcd8 b4fce8 b4fcfc b4e8fc b4d8fc b4c4fc 000070 1c0070 380070 540070 2c402c 2c4030 2c4034 2c403c 2c4040 2c3c40 2c3440 2c3040 >; -sub mandelbrot( Complex $c ) { - my $im2 = $c.im**2; - return 0 if ($c.re + 1)**2 + $im2 < 1/16; - my $q = ($c.re - 1/4)**2 + $im2; - return 0 if $q*($q + ($c.re - 1/4)) < $im2/4; - my $z = 0i; - for ^MAX_ITERATIONS -> $i { - return $i + 1 if $z.re**2 + $z.im**2 > 4; - $z = $z * $z + $c; +constant MAX_ITERATIONS = 50; +my $width = my $height = +(@*ARGS[0] // 31); + +sub cut(Range $r, UInt $n where $n > 1) { + $r.min, * + ($r.max - $r.min) / ($n - 1) ... $r.max +} + +my @re = cut(-2 .. 1/2, $height); +my @im = cut( 0 .. 5/4, $width div 2 + 1) X* 1i; + +sub mandelbrot(Complex $z is copy, Complex $c) { + for 1 .. MAX_ITERATIONS { + $z = $z*$z + $c; + return $_ if $z.abs > 2; } return 0; } -my @promises = map -> $re { - start { [ mandelbrot($re + $_) for @$im ] } -}, @re; - say "P3"; say "$width $height"; say "255"; -for @promises».result { - say @color_map[(flat .reverse, .[1..*])[^$width]]; +for @re -> $re { + put @color_map[|.reverse, |.[1..*]][^$width] given + my @ = map &mandelbrot.assuming(0i, *), $re «+« @im; } diff --git a/Task/Mandelbrot-set/PowerShell/mandelbrot-set.psh b/Task/Mandelbrot-set/PowerShell/mandelbrot-set.psh new file mode 100644 index 0000000000..ec33673e72 --- /dev/null +++ b/Task/Mandelbrot-set/PowerShell/mandelbrot-set.psh @@ -0,0 +1,20 @@ +$x = $y = $i = $j = $r = -16 +$colors = [Enum]::GetValues([System.ConsoleColor]) + +while(($y++) -lt 15) +{ + for($x=0; ($x++) -lt 84; Write-Host " " -BackgroundColor ($colors[$k -band 15]) -NoNewline) + { + $i = $k = $r = 0 + + do + { + $j = $r * $r - $i * $i -2 + $x / 25 + $i = 2 * $r * $i + $y / 10 + $r = $j + } + while (($j * $j + $i * $i) -lt 11 -band ($k++) -lt 111) + } + + Write-Host +} diff --git a/Task/Mandelbrot-set/REXX/mandelbrot-set-1.rexx b/Task/Mandelbrot-set/REXX/mandelbrot-set-1.rexx index 88d83e4d71..2b82e50ad4 100644 --- a/Task/Mandelbrot-set/REXX/mandelbrot-set-1.rexx +++ b/Task/Mandelbrot-set/REXX/mandelbrot-set-1.rexx @@ -1,5 +1,5 @@ -/*REXX program generates and displays a Mandelbrot set as a character image.*/ -@ = '>=<;:9876543210/.-,+*)(''&%$#"!' /*characters used in display.*/ +/*REXX program generates and displays a Mandelbrot set as an ASCII art character image.*/ +@ = '>=<;:9876543210/.-,+*)(''&%$#"!' /*the characters used in the display. */ Xsize = 59; minRE = -2; maxRE = +1; stepX = (maxRE-minRE) / Xsize Ysize = 21; minIM = -1; maxIM = +1; stepY = (maxIM-minIM) / Ysize @@ -11,7 +11,7 @@ Ysize = 21; minIM = -1; maxIM = +1; stepY = (maxIM-minIM) / Ysize zi=zr*zi*2 + im; zr=a-b+re end /*n*/ - $=$ || substr(@, n+1, 1) /*append number (as a char) to $ string*/ + $=$ || substr(@, n+1, 1) /*append number (as a char) to $ string*/ end /*x*/ - say $ /*display a line of character output.*/ - end /*y*/ /*stick a fork in it, we're all done. */ + say $ /*display a line of character output.*/ + end /*y*/ /*stick a fork in it, we're all done. */ diff --git a/Task/Mandelbrot-set/REXX/mandelbrot-set-2.rexx b/Task/Mandelbrot-set/REXX/mandelbrot-set-2.rexx index 73d99ca55a..0ba24a272d 100644 --- a/Task/Mandelbrot-set/REXX/mandelbrot-set-2.rexx +++ b/Task/Mandelbrot-set/REXX/mandelbrot-set-2.rexx @@ -1,5 +1,5 @@ -/*REXX program generates and displays a Mandelbrot set as a character image.*/ -@ = '█▓▒░@9876543210=.-,+*)(·&%$#"!' /*characters used in display.*/ +/*REXX program generates and displays a Mandelbrot set as an ASCII art character image.*/ +@ = '█▓▒░@9876543210=.-,+*)(·&%$#"!' /*the characters used in the display. */ Xsize = 59; minRE = -2; maxRE = +1; stepX = (maxRE-minRE) / Xsize Ysize = 21; minIM = -1; maxIM = +1; stepY = (maxIM-minIM) / Ysize @@ -11,7 +11,7 @@ Ysize = 21; minIM = -1; maxIM = +1; stepY = (maxIM-minIM) / Ysize zi=zr*zi*2 + im; zr=a-b+re end /*n*/ - $=$ || substr(@, n+1, 1) /*append number (as a char) to $ string*/ + $=$ || substr(@, n+1, 1) /*append number (as a char) to $ string*/ end /*x*/ - say $ /*display a line of character output.*/ - end /*y*/ /*stick a fork in it, we're all done. */ + say $ /*display a line of character output.*/ + end /*y*/ /*stick a fork in it, we're all done. */ diff --git a/Task/Mandelbrot-set/REXX/mandelbrot-set-3.rexx b/Task/Mandelbrot-set/REXX/mandelbrot-set-3.rexx index 825c363698..8b59f9de90 100644 --- a/Task/Mandelbrot-set/REXX/mandelbrot-set-3.rexx +++ b/Task/Mandelbrot-set/REXX/mandelbrot-set-3.rexx @@ -1,8 +1,8 @@ -/*REXX program generates and displays a Mandelbrot set as a character image.*/ -@ = '█▓▒░@9876543210=.-,+*)(·&%$#"!' /*characters used in display.*/ -parse arg Xsize Ysize . /*get optional args from C.L.*/ -if Xsize=='' then Xsize=linesize()-1 /*X: the linesize (less 1).*/ -if Ysize=='' then Ysize=Xsize%2 + (Xsize//2==1) /*Y: ½linesize (make it even)*/ +/*REXX program generates and displays a Mandelbrot set as an ASCII art character image.*/ +@ = '█▓▒░@9876543210=.-,+*)(·&%$#"!' /*the characters used in the display. */ +parse arg Xsize Ysize . /*obtain optional arguments from the CL*/ +if Xsize=='' then Xsize=linesize() - 1 /*X: the (usable) linesize (minus 1).*/ +if Ysize=='' then Ysize=Xsize%2 + (Xsize//2==1) /*Y: half the linesize (make it even).*/ minRE = -2; maxRE = +1; stepX = (maxRE-minRE) / Xsize minIM = -1; maxIM = +1; stepY = (maxIM-minIM) / Ysize @@ -14,7 +14,7 @@ minIM = -1; maxIM = +1; stepY = (maxIM-minIM) / Ysize zi=zr*zi*2 + im; zr=a-b+re end /*n*/ - $=$ || substr(@, n+1, 1) /*append number (as a char) to $ string*/ + $=$ || substr(@, n+1, 1) /*append number (as a char) to $ string*/ end /*x*/ - say $ /*display a line of character output.*/ - end /*y*/ /*stick a fork in it, we're all done. */ + say $ /*display a line of character output.*/ + end /*y*/ /*stick a fork in it, we're all done. */ diff --git a/Task/Map-range/00DESCRIPTION b/Task/Map-range/00DESCRIPTION index 0028f374be..2241412e1f 100644 --- a/Task/Map-range/00DESCRIPTION +++ b/Task/Map-range/00DESCRIPTION @@ -1,6 +1,20 @@ -Given two [[wp:Interval (mathematics)|ranges]], [a_1,a_2] and [b_1,b_2]; then a value s in range [a_1,a_2] is linearly mapped to a value t in range [b_1,b_2] when: -:t = b_1 + {(s - a_1)(b_2 - b_1) \over (a_2 - a_1)} +Given two [[wp:Interval (mathematics)|ranges]]: +:::*   [a_1,a_2]   and +:::*   [b_1,b_2]; +:::*   then a value   s   in range   [a_1,a_2] +:::*   is linearly mapped to a value   t   in range   [b_1,b_2] +   where: +
    -The task is to write a function/subroutine/... that takes two ranges and a real number, and returns the mapping of the real number from the first to the second range. Use this function to map values from the range [0, 10] to the range [-1, 0]. +:::*   t = b_1 + {(s - a_1)(b_2 - b_1) \over (a_2 - a_1)} -'''Extra credit:''' Show additional idiomatic ways of performing the mapping, using tools available to the language. + +;Task: +Write a function/subroutine/... that takes two ranges and a real number, and returns the mapping of the real number from the first to the second range. + +Use this function to map values from the range   [0, 10]   to the range   [-1, 0]. + + +;Extra credit: +Show additional idiomatic ways of performing the mapping, using tools available to the language. +

    diff --git a/Task/Map-range/ALGOL-68/map-range.alg b/Task/Map-range/ALGOL-68/map-range.alg new file mode 100644 index 0000000000..c7c27393f3 --- /dev/null +++ b/Task/Map-range/ALGOL-68/map-range.alg @@ -0,0 +1,9 @@ +# maps a real s in the range [ a1, a2 ] to the range [ b1, b2 ] # +# there are no checks that s is in the range or that the ranges are valid # +PROC map range = ( REAL s, a1, a2, b1, b2 )REAL: + b1 + ( ( s - a1 ) * ( b2 - b1 ) ) / ( a2 - a1 ); + +# test the mapping # +FOR i FROM 0 TO 10 DO + print( ( whole( i, -2 ), " maps to ", fixed( map range( i, 0, 10, -1, 0 ), -8, 2 ), newline ) ) +OD diff --git a/Task/Map-range/C-sharp/map-range.cs b/Task/Map-range/C-sharp/map-range.cs new file mode 100644 index 0000000000..163ce571b5 --- /dev/null +++ b/Task/Map-range/C-sharp/map-range.cs @@ -0,0 +1,12 @@ +using System; +using System.Linq; + +public class MapRange +{ + public static void Main() { + foreach (int i in Enumerable.Range(0, 11)) + Console.WriteLine($"{i} maps to {Map(0, 10, -1, 0, i)}"); + } + + static double Map(double a1, double a2, double b1, double b2, double s) => b1 + (s - a1) * (b2 - b1) / (a2 - a1); +} diff --git a/Task/Map-range/C/map-range.c b/Task/Map-range/C/map-range.c new file mode 100644 index 0000000000..70d23f80cf --- /dev/null +++ b/Task/Map-range/C/map-range.c @@ -0,0 +1,19 @@ +#include + +double mapRange(double a1,double a2,double b1,double b2,double s) +{ + return b1 + (s-a1)*(b2-b1)/(a2-a1); +} + +int main() +{ + int i; + puts("Mapping [0,10] to [-1,0] at intervals of 1:"); + + for(i=0;i<=10;i++) + { + printf("f(%d) = %g\n",i,mapRange(0,10,-1,0,i)); + } + + return 0; +} diff --git a/Task/Map-range/REXX/map-range-1.rexx b/Task/Map-range/REXX/map-range-1.rexx index bd66eca1ba..a30668c427 100644 --- a/Task/Map-range/REXX/map-range-1.rexx +++ b/Task/Map-range/REXX/map-range-1.rexx @@ -1,11 +1,11 @@ -/*REXX program maps a range of numbers from one range to another range. */ -rangeA = 0 10 /*or: rangeA = ' 0 10 ' */ -rangeB = -1 0 /*or: rangeB = " -1 0 " */ +/*REXX program maps and displays a range of numbers from one range to another range.*/ +rangeA = 0 10 /*or: rangeA = ' 0 10 ' */ +rangeB = -1 0 /*or: rangeB = " -1 0 " */ parse var RangeA L H inc=1 - do j=L to H by inc*(1-2*sign(H f64 { + to_range.0 + (s - from_range.0) * (to_range.1 - to_range.0) / (from_range.1 - from_range.0) +} + +fn main() { + let input: Vec = vec![0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0, 9.0, 10.0]; + let result = input.into_iter() + .map(|x| map_range((0.0, 10.0), (-1.0, 0.0), x)) + .collect::>(); + print!("{:?}", result); +} diff --git a/Task/Matrix-arithmetic/00DESCRIPTION b/Task/Matrix-arithmetic/00DESCRIPTION index 22dda9650f..f9e65c2b76 100644 --- a/Task/Matrix-arithmetic/00DESCRIPTION +++ b/Task/Matrix-arithmetic/00DESCRIPTION @@ -1,12 +1,13 @@ For a given matrix, return the [[wp:Determinant|determinant]] and the [[wp:Permanent|permanent]] of the matrix. The determinant is given by -:\det(A) = \sum_\sigma\sgn(\sigma)\prod_{i=1}^n M_{i,\sigma_i} +:: \det(A) = \sum_\sigma\sgn(\sigma)\prod_{i=1}^n M_{i,\sigma_i} while the permanent is given by -: \operatorname{perm}(A)=\sum_\sigma\prod_{i=1}^n M_{i,\sigma_i} +:: \operatorname{perm}(A)=\sum_\sigma\prod_{i=1}^n M_{i,\sigma_i} In both cases the sum is over the permutations \sigma of the permutations of 1, 2, ..., ''n''. (A permutation's sign is 1 if there are an even number of inversions and -1 otherwise; see [[wp:Parity of a permutation|parity of a permutation]].) More efficient algorithms for the determinant are known: [[LU decomposition]], see for example [[wp:LU decomposition#Computing the determinant]]. Efficient methods for calculating the permanent are not known. ;Cf.: * [[Permutations by swapping]] +

    diff --git a/Task/Matrix-arithmetic/360-Assembly/matrix-arithmetic.360 b/Task/Matrix-arithmetic/360-Assembly/matrix-arithmetic.360 new file mode 100644 index 0000000000..1f5cf8f606 --- /dev/null +++ b/Task/Matrix-arithmetic/360-Assembly/matrix-arithmetic.360 @@ -0,0 +1,152 @@ +* Matrix arithmetic 13/05/2016 +MATARI START + STM R14,R12,12(R13) save caller's registers + LR R12,R15 set R12 as base register + USING MATARI,R12 notify assembler + LA R11,SAVEAREA get the address of my savearea + ST R13,4(R11) save caller's savearea pointer + ST R11,8(R13) save my savearea pointer + LR R13,R11 set R13 to point to my savearea + LA R1,TT @tt + BAL R14,DETER call deter(tt) + LR R2,R0 R2=deter(tt) + LR R3,R1 R3=perm(tt) + XDECO R2,PG1+12 edit determinant + XPRNT PG1,80 print determinant + XDECO R3,PG2+12 edit permanent + XPRNT PG2,80 print permanent +EXITALL L R13,SAVEAREA+4 restore caller's savearea address + LM R14,R12,12(R13) restore caller's registers + XR R15,R15 set return code to 0 + BR R14 return to caller +SAVEAREA DS 18F main savearea +TT DC F'3' matrix size + DC F'2',F'9',F'4',F'7',F'5',F'3',F'6',F'1',F'8' <==input +PG1 DC CL80'determinant=' +PG2 DC CL80'permanent=' +XDEC DS CL12 +* recursive function (R0,R1)=deter(t) (python style) +DETER CNOP 0,4 returns determinant and permanent + STM R14,R12,12(R13) save all registers + LR R9,R1 save R1 + L R2,0(R1) n + BCTR R2,0 n-1 + LR R11,R2 n-1 + MR R10,R2 (n-1)*(n-1) + SLA R11,2 (n-1)*(n-1)*4 + LA R11,1(R11) size of q array + A R11,=A(STACKLEN) R11 storage amount required + GETMAIN RU,LV=(R11) allocate storage for stack + USING STACK,R10 make storage addressable + LR R10,R1 establish stack addressability + LA R1,SAVEAREB get the address of my savearea + ST R13,4(R1) save caller's savearea pointer + ST R1,8(R13) save my savearea pointer + LR R13,R1 set R13 to point to my savearea + LR R1,R9 restore R1 + LR R9,R1 @t + L R4,0(R9) t(0) + ST R4,N n=t(0) +IF1 CH R4,=H'1' if n=1 + BNE SIF1 then + L R2,4(R9) t(1) + ST R2,R r=t(1) + ST R2,S s=t(1) + B EIF1 else +SIF1 L R2,N n + BCTR R2,0 n-1 + ST R2,Q q(0)=n-1 + ST R2,NM1 nm1=n-1 + LA R0,1 1 + ST R0,SGN sgn=1 + SR R0,R0 0 + ST R0,R r=0 + ST R0,S s=0 + LA R6,1 k=1 +LOOPK C R6,N do k=1 to n + BH ELOOPK leave k + SR R0,R0 0 + ST R0,JQ jq=0 + ST R0,KTI kti=0 + LA R7,1 iq=1 +LOOPIQ C R7,NM1 do iq=1 to n-1 + BH ELOOPIQ leave iq + LR R2,R7 iq + LA R2,1(R2) iq+1 + ST R2,IT it=iq+1 + L R2,KTI kti + A R2,N kti+n + ST R2,KTI kti=kti+n + ST R2,KT kt=kti + LA R8,1 jt=1 +LOOPJT C R8,N do jt=1 to n + BH ELOOPJT leave jt + L R2,KT kt + LA R2,1(R2) kt+1 + ST R2,KT kt=kt+1 +IF2 CR R8,R6 if jt<>k + BE EIF2 then + L R2,JQ jq + LA R2,1(R2) jq+1 + ST R2,JQ jq=jq+1 + L R1,KT kt + SLA R1,2 *4 + L R2,0(R1,R9) t(kt) + L R1,JQ jq + SLA R1,2 *4 + ST R2,Q(R1) q(jq)=t(kt) +EIF2 EQU * end if + LA R8,1(R8) jt=jt+1 + B LOOPJT next jt +ELOOPJT LA R7,1(R7) iq=iq+1 + B LOOPIQ next iq +ELOOPIQ LR R1,R6 k + SLA R1,2 *4 + L R5,0(R1,R9) t(k) + LR R2,R5 R2,R5=t(k) + LA R1,Q @q + BAL R14,DETER call deter(q) + LR R3,R0 R3=deter(q) + ST R1,P p=perm(q) + MR R4,R3 R5=t(k)*deter(q) + M R4,SGN R5=sgn*t(k)*deter(q) + A R5,R +r + ST R5,R r=r+sgn*t(k)*deter(q) + LR R5,R2 t(k) + M R4,P R5=t(k)*perm(q) + A R5,S +s + ST R5,S s=s+t(k)*perm(q) + L R2,SGN sgn + LCR R2,R2 -sgn + ST R2,SGN sgn=-sgn + LA R6,1(R6) k=k+1 + B LOOPK next k +ELOOPK EQU * end do +EIF1 EQU * end if +EXIT L R13,SAVEAREB+4 restore caller's savearea address + L R2,R return value (determinant) + L R3,S return value (permanent) + XR R15,R15 set return code to 0 + FREEMAIN A=(R10),LV=(R11) free allocated storage + LR R0,R2 first return value + LR R1,R3 second return value + L R14,12(R13) restore caller's return address + LM R2,R12,28(R13) restore registers R2 to R12 + BR R14 return to caller +IT DS F static area (out of stack) +KT DS F " +JQ DS F " +KTI DS F " +P DS F " + DROP R12 base no longer needed +STACK DSECT dynamic area (stack) +SAVEAREB DS 18F function savearea +N DS F n +NM1 DS F n-1 +R DS F determinant accu +S DS F permanent accu +SGN DS F sign +STACKLEN EQU *-STACK +Q DS F sub matrix q((n-1)*(n-1)+1) + YREGS + END MATARI diff --git a/Task/Matrix-arithmetic/Haskell/matrix-arithmetic.hs b/Task/Matrix-arithmetic/Haskell/matrix-arithmetic.hs new file mode 100644 index 0000000000..d6141874f8 --- /dev/null +++ b/Task/Matrix-arithmetic/Haskell/matrix-arithmetic.hs @@ -0,0 +1,39 @@ +s_permutations :: [a] -> [([a], Int)] +s_permutations = flip zip (cycle [1, -1]) . (foldl aux [[]]) + where aux items x = do + (f,item) <- zip (cycle [reverse,id]) items + f (insertEv x item) + insertEv x [] = [[x]] + insertEv x l@(y:ys) = (x:l) : map (y:) (insertEv x ys) + +elemPos::[[a]] -> Int -> Int -> a +elemPos ms i j = (ms !! i) !! j + +prod:: Num a => ([[a]] -> Int -> Int -> a) -> [[a]] -> [Int] -> a +prod f ms = product.zipWith (f ms) [0..] + +s_determinant:: Num a => ([[a]] -> Int -> Int -> a) -> [[a]] -> [([Int],Int)] -> a +s_determinant f ms = sum.map (\(is,s) -> fromIntegral s * prod f ms is) + +determinant:: Num a => [[a]] -> a +determinant ms = s_determinant elemPos ms.s_permutations $ [0..pred.length $ ms] + +permanent:: Num a => [[a]] -> a +permanent ms = sum.map (prod elemPos ms.fst).s_permutations $ [0..pred.length $ ms] + +result ms = do + putStrLn "Matrice:" + mapM_ print ms + putStrLn "Determinant:" + print $ determinant ms + putStrLn "Permanent:" + print $ permanent ms + +main = do + let m1 = [[5]] + let m2 = [[1,0,0],[0,1,0],[0,0,1]] + let m3 = [[0,0,1],[0,1,0],[1,0,0]] + let m4 = [[4,3],[2,5]] + let m5 = [[2,5],[4,3]] + let m6 = [[4,4],[2,2]] + mapM_ result [m1,m2,m3,m4,m5,m6] diff --git a/Task/Matrix-arithmetic/Java/matrix-arithmetic-1.java b/Task/Matrix-arithmetic/Java/matrix-arithmetic-1.java new file mode 100644 index 0000000000..3ebd3caa8f --- /dev/null +++ b/Task/Matrix-arithmetic/Java/matrix-arithmetic-1.java @@ -0,0 +1,55 @@ +import java.util.Scanner; + +public class MatrixArithmetic { + public static double[][] minor(double[][] a, int x, int y){ + int length = a.length-1; + double[][] result = new double[length][length]; + for(int i=0;i=x && j=y){ + result[i][j] = a[i][j+1]; + }else{ //i>x && j>y + result[i][j] = a[i+1][j+1]; + } + } + return result; + } + public static double det(double[][] a){ + if(a.length == 1){ + return a[0][0]; + }else{ + int sign = 1; + double sum = 0; + for(int i=0;i= 1 and loc <= #self.values and self.values[loc] < i then + return i + end + end + return 0 +end + +function _JT:next() + local r=self:largestMobile() + if r==0 then return false end + local rloc=self.positions[r] + local lloc=rloc+self.directions[r] + local l=self.values[lloc] + self.values[lloc],self.values[rloc] = self.values[rloc],self.values[lloc] + self.positions[l],self.positions[r] = self.positions[r],self.positions[l] + self.sign=-self.sign + for i=r+1,#self.directions do self.directions[i]=-self.directions[i] end + return true +end + +-- matrix class + +_MTX={} +function MTX(matrix) + setmetatable(matrix,{__index=_MTX}) + matrix.rows=#matrix + matrix.cols=#matrix[1] + return matrix +end + +function _MTX:dump() + for _,r in ipairs(self) do + print(unpack(r)) + end +end + +function _MTX:perm() return self:det(1) end +function _MTX:det(perm) + local det=0 + local jt=JT(self.cols) + repeat + local pi=perm or jt.sign + for i,v in ipairs(jt.values) do + pi=pi*self[i][v] + end + det=det+pi + until not jt:next() + return det +end + +-- test + +matrix=MTX +{ + { 7, 2, -2, 4}, + { 4, 4, 1, 7}, + {11, -8, 9, 10}, + {10, 5, 12, 13} +} +matrix:dump(); +print("det:",matrix:det(), "permanent:",matrix:perm(),"\n") + +matrix2=MTX +{ + {-2, 2,-3}, + {-1, 1, 3}, + { 2, 0,-1} +} +matrix2:dump(); +print("det:",matrix2:det(), "permanent:",matrix2:perm()) diff --git a/Task/Matrix-arithmetic/PARI-GP/matrix-arithmetic-3.pari b/Task/Matrix-arithmetic/PARI-GP/matrix-arithmetic-3.pari new file mode 100644 index 0000000000..3865a2c60a --- /dev/null +++ b/Task/Matrix-arithmetic/PARI-GP/matrix-arithmetic-3.pari @@ -0,0 +1,14 @@ +matperm(M)= +{ + my(n=matsize(M)[1],innerSums=vectorv(n)); + if(n==0, return(1)); + sum(x=1,2^n-1, + my(k=valuation(x,2),s=M[,k+1],gray=bitxor(x, x>>1)); + if(bittest(gray,k), + innerSums += s; + , + innerSums -= s; + ); + (-1)^hammingweight(gray)*factorback(innerSums) + )*(-1)^n; +} diff --git a/Task/Matrix-arithmetic/Perl-6/matrix-arithmetic.pl6 b/Task/Matrix-arithmetic/Perl-6/matrix-arithmetic.pl6 index 39c51af598..b5f40560a0 100644 --- a/Task/Matrix-arithmetic/Perl-6/matrix-arithmetic.pl6 +++ b/Task/Matrix-arithmetic/Perl-6/matrix-arithmetic.pl6 @@ -1,10 +1,10 @@ -sub insert( $x, @xs) { [@xs[0..$_-1], $x, @xs[$_..*]] for 0..@xs } +sub insert ($x, @xs) { ([flat @xs[0 ..^ $_], $x, @xs[$_ .. *]] for 0 .. @xs) } sub order ($sg, @xs) { $sg > 0 ?? @xs !! @xs.reverse } multi σ_permutations ([]) { [] => 1 } multi σ_permutations ([$x, *@xs]) { - σ_permutations(@xs).map({ order($_.value, insert($x, $_.key)) }) Z=> (1,-1) xx * + σ_permutations(@xs).map({ |order($_.value, insert($x, $_.key)) }) Z=> |(1,-1) xx * } sub m_arith ( @a, $op ) { @@ -41,7 +41,8 @@ my @tests = ( ); sub dump (@matrix) { - say $_».fmt: "%3s" for @matrix, ''; + say $_».fmt: "%3s" for @matrix; + say ''; } for @tests -> @matrix { diff --git a/Task/Matrix-exponentiation-operator/Perl-6/matrix-exponentiation-operator.pl6 b/Task/Matrix-exponentiation-operator/Perl-6/matrix-exponentiation-operator.pl6 index d98cf104b6..07ff211f0e 100644 --- a/Task/Matrix-exponentiation-operator/Perl-6/matrix-exponentiation-operator.pl6 +++ b/Task/Matrix-exponentiation-operator/Perl-6/matrix-exponentiation-operator.pl6 @@ -23,7 +23,7 @@ multi infix:<**> (SqMat $m, Int $n is copy where { $_ >= 0 }) { multi show (SqMat $m) { my $size = 1; for ^$m X ^$m -> ($i, $j) { $size max= $m[$i][$j].Str.chars; } - say join "\n", $m».fmt("%{$size}s"); + .put for @$m».fmt("%{$size}s"); } my @m = [1, 2, 0], diff --git a/Task/Matrix-multiplication/00DESCRIPTION b/Task/Matrix-multiplication/00DESCRIPTION index efce834784..525d5fc7eb 100644 --- a/Task/Matrix-multiplication/00DESCRIPTION +++ b/Task/Matrix-multiplication/00DESCRIPTION @@ -1 +1,5 @@ -Multiply two matrices together. They can be of any dimensions, so long as the number of columns of the first matrix is equal to the number of rows of the second matrix. +;Task: +Multiply two matrices together. + +They can be of any dimensions, so long as the number of columns of the first matrix is equal to the number of rows of the second matrix. +

    diff --git a/Task/Matrix-multiplication/AppleScript/matrix-multiplication-1.applescript b/Task/Matrix-multiplication/AppleScript/matrix-multiplication-1.applescript new file mode 100644 index 0000000000..8618ce1afe --- /dev/null +++ b/Task/Matrix-multiplication/AppleScript/matrix-multiplication-1.applescript @@ -0,0 +1,136 @@ +-- matrixMultiply :: [[n]] -> [[n]] -> [[n]] +to matrixMultiply(a, b) + script rows + property xs : transpose(b) + + on lambda(row) + script columns + on lambda(col) + dotProduct(row, col) + end lambda + end script + + map(columns, xs) + end lambda + end script + + map(rows, a) +end matrixMultiply + + + +-- TEST + +on run + matrixMultiply({¬ + {-1, 1, 4}, ¬ + {6, -4, 2}, ¬ + {-3, 5, 0}, ¬ + {3, 7, -2} ¬ + }, {¬ + {-1, 1, 4, 8}, ¬ + {6, 9, 10, 2}, ¬ + {11, -4, 5, -3}}) + + --> {{51, -8, 26, -18}, {-8, -38, -6, 34}, + -- {33, 42, 38, -14}, {17, 74, 72, 44}} +end run + + +-- dotProduct :: [n] -> [n] -> Maybe n +on dotProduct(xs, ys) + script product + on lambda(a, b) + a * b + end lambda + end script + + if length of xs is not length of ys then + missing value + else + sum(zipWith(product, xs, ys)) + end if +end dotProduct + +-- transpose :: [[a]] -> [[a]] +on transpose(xss) + script column + on lambda(_, iCol) + script row + on lambda(xs) + item iCol of xs + end lambda + end script + + map(row, xss) + end lambda + end script + + map(column, item 1 of xss) +end transpose + +-- sum :: [n] -> n +on sum(xs) + script add + on lambda(a, b) + a + b + end lambda + end script + + foldl(add, 0, xs) +end sum + + + +-- GENERIC LIBRARY FUNCTIONS + +-- 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 + +-- 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 + +-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] +on zipWith(f, xs, ys) + set lng to length of xs + if lng is not length of ys then + missing value + else + tell mReturn(f) + set lst to {} + 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 + +-- Script | Handler -> Script +on mReturn(f) + if class of f is script then + f + else + script + property lambda : f + end script + end if +end mReturn diff --git a/Task/Matrix-multiplication/AppleScript/matrix-multiplication-2.applescript b/Task/Matrix-multiplication/AppleScript/matrix-multiplication-2.applescript new file mode 100644 index 0000000000..561425b537 --- /dev/null +++ b/Task/Matrix-multiplication/AppleScript/matrix-multiplication-2.applescript @@ -0,0 +1 @@ +{{51, -8, 26, -18}, {-8, -38, -6, 34}, {33, 42, 38, -14}, {17, 74, 72, 44}} diff --git a/Task/Matrix-multiplication/Ela/matrix-multiplication.ela b/Task/Matrix-multiplication/Ela/matrix-multiplication.ela new file mode 100644 index 0000000000..0eb248de00 --- /dev/null +++ b/Task/Matrix-multiplication/Ela/matrix-multiplication.ela @@ -0,0 +1,7 @@ +open list + +mmult a b = [ [ sum $ zipWith (*) ar bc \\ bc <- (transpose b) ] \\ ar <- a ] + +[[1, 2], + [3, 4]] `mmult` [[-3, -8, 3], + [-2, 1, 4]] diff --git a/Task/Matrix-multiplication/Elixir/matrix-multiplication.elixir b/Task/Matrix-multiplication/Elixir/matrix-multiplication.elixir new file mode 100644 index 0000000000..f0d302385a --- /dev/null +++ b/Task/Matrix-multiplication/Elixir/matrix-multiplication.elixir @@ -0,0 +1,11 @@ + def mult(m1, m2) do + Enum.map m1, fn (x) -> Enum.map t(m2), fn (y) -> Enum.zip(x, y) + |> Enum.map(fn {x, y} -> x * y end) + |> Enum.sum + end + end + end + + def t(m) do # transpose + List.zip(m) |> Enum.map(&Tuple.to_list(&1)) + end diff --git a/Task/Matrix-multiplication/Haskell/matrix-multiplication-3.hs b/Task/Matrix-multiplication/Haskell/matrix-multiplication-3.hs new file mode 100644 index 0000000000..8cd2dbeb8d --- /dev/null +++ b/Task/Matrix-multiplication/Haskell/matrix-multiplication-3.hs @@ -0,0 +1,26 @@ +foldlZipWith::(a -> b -> c) -> (d -> c -> d) -> d -> [a] -> [b] -> d +foldlZipWith _ _ u [] _ = u +foldlZipWith _ _ u _ [] = u +foldlZipWith f g u (x:xs) (y:ys) = foldlZipWith f g (g u (f x y)) xs ys + +foldl1ZipWith::(a -> b -> c) -> (c -> c -> c) -> [a] -> [b] -> c +foldl1ZipWith _ _ [] _ = error "First list is empty" +foldl1ZipWith _ _ _ [] = error "Second list is empty" +foldl1ZipWith f g (x:xs) (y:ys) = foldlZipWith f g (f x y) xs ys + +multAdd::(a -> b -> c) -> (c -> c -> c) -> [[a]] -> [[b]] -> [[c]] +multAdd f g xs ys = map (\us -> foldl1ZipWith (\u vs -> map (f u) vs) (zipWith g) us ys) xs + +mult:: Num a => [[a]] -> [[a]] -> [[a]] +mult xs ys = multAdd (*) (+) xs ys + +test a b = do + let c = mult a b + putStrLn "a =" + mapM_ print a + putStrLn "b =" + mapM_ print b + putStrLn "c = a * b = mult a b =" + mapM_ print c + +main = test [[1, 2],[3, 4]] [[-3, -8, 3],[-2, 1, 4]] diff --git a/Task/Matrix-multiplication/JavaScript/matrix-multiplication.js b/Task/Matrix-multiplication/JavaScript/matrix-multiplication-1.js similarity index 100% rename from Task/Matrix-multiplication/JavaScript/matrix-multiplication.js rename to Task/Matrix-multiplication/JavaScript/matrix-multiplication-1.js diff --git a/Task/Matrix-multiplication/JavaScript/matrix-multiplication-2.js b/Task/Matrix-multiplication/JavaScript/matrix-multiplication-2.js new file mode 100644 index 0000000000..af8327f90a --- /dev/null +++ b/Task/Matrix-multiplication/JavaScript/matrix-multiplication-2.js @@ -0,0 +1,67 @@ +(function () { + 'use strict'; + + // matrixMultiply:: [[n]] -> [[n]] -> [[n]] + function matrixMultiply(a, b) { + var bCols = transpose(b); + + return a.map(function (aRow) { + return bCols.map(function (bCol) { + return dotProduct(aRow, bCol); + }); + }); + } + + // [[n]] -> [[n]] -> [[n]] + function dotProduct(xs, ys) { + return sum(zipWith(product, xs, ys)); + } + + return matrixMultiply( + [[-1, 1, 4], + [ 6, -4, 2], + [-3, 5, 0], + [ 3, 7, -2]], + + [[-1, 1, 4, 8], + [ 6, 9, 10, 2], + [11, -4, 5, -3]] + ); + + // --> [[51, -8, 26, -18], [-8, -38, -6, 34], + // [33, 42, 38, -14], [17, 74, 72, 44]] + + + // GENERIC LIBRARY FUNCTIONS + + // (a -> b -> c) -> [a] -> [b] -> [c] + function zipWith(f, xs, ys) { + return xs.length === ys.length ? ( + xs.map(function (x, i) { + return f(x, ys[i]); + }) + ) : undefined; + } + + // [[a]] -> [[a]] + function transpose(lst) { + return lst[0].map(function (_, iCol) { + return lst.map(function (row) { + return row[iCol]; + }); + }); + } + + // sum :: (Num a) => [a] -> a + function sum(xs) { + return xs.reduce(function (a, x) { + return a + x; + }, 0); + } + + // product :: n -> n -> n + function product(a, b) { + return a * b; + } + +})(); diff --git a/Task/Matrix-multiplication/Lua/matrix-multiplication.lua b/Task/Matrix-multiplication/Lua/matrix-multiplication-1.lua similarity index 100% rename from Task/Matrix-multiplication/Lua/matrix-multiplication.lua rename to Task/Matrix-multiplication/Lua/matrix-multiplication-1.lua diff --git a/Task/Matrix-multiplication/Lua/matrix-multiplication-2.lua b/Task/Matrix-multiplication/Lua/matrix-multiplication-2.lua new file mode 100644 index 0000000000..7043e85cfc --- /dev/null +++ b/Task/Matrix-multiplication/Lua/matrix-multiplication-2.lua @@ -0,0 +1,5 @@ +local alg = require("sci.alg") +mat1 = alg.tomat{{1, 2, 3}, {4, 5, 6}} +mat2 = alg.tomat{{1, 2}, {3, 4}, {5, 6}} +mat3 = mat1[] ** mat2[] +print(mat3) diff --git a/Task/Matrix-multiplication/PowerShell/matrix-multiplication.psh b/Task/Matrix-multiplication/PowerShell/matrix-multiplication.psh index 49ab23d852..d3cb489728 100644 --- a/Task/Matrix-multiplication/PowerShell/matrix-multiplication.psh +++ b/Task/Matrix-multiplication/PowerShell/matrix-multiplication.psh @@ -1,31 +1,38 @@ -function array-mult($A, $B) { - $C = @() - if($n -gt 0) { - $C = 0..($n-1)| foreach{@(0)} - 0..($n-1)| foreach{ - $i = $_ - $C[$i] = 0..($n-1)| foreach{ - $j = $_ - $((0..($n-1) | foreach{ - $k = $_ - $A[$i][$k]*$B[$k][$j] - } | measure -Sum).Sum) +function multarrays($a, $b) { + $c = @() + if($a -and $b) { + $n = $a.count - 1 + $m = $b[0].count - 1 + $c = @(0)*($n+1) + foreach ($i in 0..$n) { + $c[$i] = foreach ($j in 0..$m) { + $sum = 0 + foreach ($k in 0..$n){$sum += $a[$i][$k]*$b[$k][$j]} + $sum } } } - $C + $c } function show($a) { - if($a.Count -gt 0) { - $n = $a.Count - 1 - 0..$n | foreach{ "$($a[$_][0..$n])" } + if($a) { + 0..($a.count - 1) | foreach{ if($a[$_]){"$($a[$_])"}else{""} } } } -$A = @(@(1,2),@(3,4)) -$B = @(@(5,6),@(7,8)) -$I = @(@(1,0),@(0,1)) -$C = array-mult $A $B -$D = array-mult $A $I -show $C +$a = @(@(1,2),@(3,4)) +$b = @(@(5,6),@(7,8)) +$c = @(5,6) +"`$a =" +show $a +"" +"`$b =" +show $b +"" +"`$c =" +$c +"" +"`$a * `$b =" +show (multarrays $a $b) " " -show $D +"`$a * `$c =" +show (multarrays $a $c) diff --git a/Task/Matrix-multiplication/REXX/matrix-multiplication.rexx b/Task/Matrix-multiplication/REXX/matrix-multiplication.rexx index 0da25b7ab9..e7ea58b14f 100644 --- a/Task/Matrix-multiplication/REXX/matrix-multiplication.rexx +++ b/Task/Matrix-multiplication/REXX/matrix-multiplication.rexx @@ -1,37 +1,36 @@ -/*REXX program multiplies two matrices together, displays matrices and result.*/ -x.=; x.1=1 2 /*╔═══════════════════════════════════╗*/ - x.2=3 4 /*║ As none of the matrix values have ║*/ - x.3=5 6 /*║ a sign, quotes aren't needed. ║*/ - x.4=7 8 /*╚═══════════════════════════════════╝*/ - do r=1 while x.r\=='' /*build the "A" matrix from X. numbers.*/ - do c=1 while x.r\==''; parse var x.r a.r.c x.r; end - end /*r*/ -Arows=r-1 /*adjust the number of rows (DO loop).*/ -Acols=c-1 /* " " " " cols " " .*/ -y.=; y.1=1 2 3 - y.2=4 5 6 - do r=1 while y.r\=='' /*build the "B" matrix from Y. numbers.*/ - do c=1 while y.r\==''; parse var y.r b.r.c y.r; end - end /*r*/ -Brows=r-1 /*adjust the number of rows (DO loop).*/ -Bcols=c-1 /* " " " " cols " " */ -c.=0; w=0 /*W is max width of an matrix element.*/ - do i=1 for Arows /*multiply matrix A and B ───► C */ - do j=1 for Bcols - do k=1 for Acols - c.i.j = c.i.j + a.i.k * b.k.j; w=max(w, length(c.i.j)) - end /*k*/ - end /*j*/ - end /*i*/ +/*REXX program multiplies two matrices together, displays the matrices and the results. */ +x.=; x.1=1 2 /*╔═══════════════════════════════════╗*/ + x.2=3 4 /*║ As none of the matrix values have ║*/ + x.3=5 6 /*║ a sign, quotes aren't needed. ║*/ + x.4=7 8 /*╚═══════════════════════════════════╝*/ + do r=1 while x.r\=='' /*build the "A" matrix from X. numbers.*/ + do c=1 while x.r\==''; parse var x.r a.r.c x.r; end /*c*/ + end /*r*/ +Arows=r-1 /*adjust the number of rows (DO loop).*/ +Acols=c-1 /* " " " " cols " " .*/ +y.=; y.1=1 2 3 + y.2=4 5 6 + do r=1 while y.r\=='' /*build the "B" matrix from Y. numbers.*/ + do c=1 while y.r\==''; parse var y.r b.r.c y.r; end /*c*/ + end /*r*/ +Brows=r-1 /*adjust the number of rows (DO loop).*/ +Bcols=c-1 /* " " " " cols " " */ +c.=0; w=0 /*W is max width of an matrix element.*/ + do i=1 for Arows /*multiply matrix A and B ───► C */ + do j=1 for Bcols + do k=1 for Acols; c.i.j=c.i.j + a.i.k * b.k.j + w=max(w, length(c.i.j)) + end /*k*/ /* ↑ */ + end /*j*/ /* └──◄─── maximum width of elements. */ + end /*i*/ -call showMatrix 'A', Arows, Acols /*display matrix A ───► the terminal.*/ -call showMatrix 'B', Brows, Bcols /* " " B ───► " " */ -call showMatrix 'C', Arows, Bcols /* " " C ───► " " */ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -showMatrix: parse arg mat,rows,cols; say -say center(mat 'matrix', cols*(w+1)+4, "─") - do r =1 for rows; _= - do c=1 for cols; _=_ right(value(mat'.'r'.'c), w); end; say _ - end /*r*/ -return +call showMatrix 'A', Arows, Acols /*display matrix A ───► the terminal.*/ +call showMatrix 'B', Brows, Bcols /* " " B ───► " " */ +call showMatrix 'C', Arows, Bcols /* " " C ───► " " */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +showMatrix: parse arg mat,rows,cols; say; say center(mat 'matrix', cols*(w+1) +4, "─") + do r=1 for rows; _= + do c=1 for cols; _=_ right(value(mat'.'r"."c), w); end; say _ + end /*r*/ + return diff --git a/Task/Matrix-transposition/00DESCRIPTION b/Task/Matrix-transposition/00DESCRIPTION index a0f6e4aa8f..5043e6e1ee 100644 --- a/Task/Matrix-transposition/00DESCRIPTION +++ b/Task/Matrix-transposition/00DESCRIPTION @@ -1 +1,2 @@ [[wp:Transpose|Transpose]] an arbitrarily sized rectangular [[wp:Matrix (mathematics)|Matrix]]. +

    diff --git a/Task/Matrix-transposition/360-Assembly/matrix-transposition.360 b/Task/Matrix-transposition/360-Assembly/matrix-transposition.360 new file mode 100644 index 0000000000..436cd34cd6 --- /dev/null +++ b/Task/Matrix-transposition/360-Assembly/matrix-transposition.360 @@ -0,0 +1,39 @@ +... +KN EQU 3 +KM EQU 5 +N DC AL2(KN) +M DC AL2(KM) +A DS (KN*KM)F matrix a(n,m) +B DS (KM*KN)F matrix b(m,n) +... +* b(j,i)=a(i,j) +* transposition using Horner's formula + LA R4,0 i,from 1 + LA R7,KN to n + LA R6,1 step 1 +LOOPI BXH R4,R6,ELOOPI do i=1 to n + LA R5,0 j,from 1 + LA R9,KM to m + LA R8,1 step 1 +LOOPJ BXH R5,R8,ELOOPJ do j=1 to m + LR R1,R4 i + BCTR R1,0 i-1 + MH R1,M (i-1)*m + LR R2,R5 j + BCTR R2,0 j-1 + AR R1,R2 r1=(i-1)*m+(j-1) + SLA R1,2 r1=((i-1)*m+(j-1))*itemlen + L R0,A(R1) r0=a(i,j) + LR R1,R5 j + BCTR R1,0 j-1 + MH R1,N (j-1)*n + LR R2,R4 i + BCTR R2,0 i-1 + AR R1,R2 r1=(j-1)*n+(i-1) + SLA R1,2 r1=((j-1)*n+(i-1))*itemlen + ST R0,B(R1) b(j,i)=r0 + B LOOPJ next j +ELOOPJ EQU * out of loop j + B LOOPI next i +ELOOPI EQU * out of loop i +... diff --git a/Task/Matrix-transposition/AppleScript/matrix-transposition-1.applescript b/Task/Matrix-transposition/AppleScript/matrix-transposition-1.applescript new file mode 100644 index 0000000000..d64511b35a --- /dev/null +++ b/Task/Matrix-transposition/AppleScript/matrix-transposition-1.applescript @@ -0,0 +1,21 @@ +on run + transpose([[1, 2, 3], [4, 5, 6], [7, 8, 9], [10, 11, 12]]) + + --> {{1, 4, 7, 10}, {2, 5, 8, 11}, {3, 6, 9, 12}} +end run + +on transpose(xss) + set lstTrans to {} + + repeat with iCol from 1 to length of item 1 of xss + set lstCol to {} + + repeat with iRow from 1 to length of xss + set end of lstCol to item iCol of item iRow of xss + end repeat + + set end of lstTrans to lstCol + end repeat + + return lstTrans +end transpose diff --git a/Task/Matrix-transposition/AppleScript/matrix-transposition-2.applescript b/Task/Matrix-transposition/AppleScript/matrix-transposition-2.applescript new file mode 100644 index 0000000000..f0463970c5 --- /dev/null +++ b/Task/Matrix-transposition/AppleScript/matrix-transposition-2.applescript @@ -0,0 +1,52 @@ +-- transpose :: [[a]] -> [[a]] +on transpose(xss) + script column + on lambda(_, iCol) + script row + on lambda(xs) + item iCol of xs + end lambda + end script + + map(row, xss) + end lambda + end script + + map(column, item 1 of xss) +end transpose + + +-- TEST +on run + + transpose([[1, 2, 3], [4, 5, 6], [7, 8, 9], [10, 11, 12]]) + + --> {{1, 4, 7, 10}, {2, 5, 8, 11}, {3, 6, 9, 12}} +end run + + +-- GENERIC LIBRARY FUNCTIONS + +-- 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 + +-- 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 diff --git a/Task/Matrix-transposition/AppleScript/matrix-transposition-3.applescript b/Task/Matrix-transposition/AppleScript/matrix-transposition-3.applescript new file mode 100644 index 0000000000..fdc05f11e6 --- /dev/null +++ b/Task/Matrix-transposition/AppleScript/matrix-transposition-3.applescript @@ -0,0 +1 @@ +{{1, 4, 7, 10}, {2, 5, 8, 11}, {3, 6, 9, 12}} diff --git a/Task/Matrix-transposition/Clojure/matrix-transposition.clj b/Task/Matrix-transposition/Clojure/matrix-transposition.clj index 0859f4342b..a8aff61371 100644 --- a/Task/Matrix-transposition/Clojure/matrix-transposition.clj +++ b/Task/Matrix-transposition/Clojure/matrix-transposition.clj @@ -8,4 +8,4 @@ (defmethod matrix-transpose clojure.lang.PersistentVector [mtx] - (vec (apply map vector mtx))) + (apply mapv vector mtx)) diff --git a/Task/Matrix-transposition/Haxe/matrix-transposition.haxe b/Task/Matrix-transposition/Haxe/matrix-transposition.haxe new file mode 100644 index 0000000000..6c46f07a13 --- /dev/null +++ b/Task/Matrix-transposition/Haxe/matrix-transposition.haxe @@ -0,0 +1,17 @@ +class Matrix { + static function main() { + var m = [ [1, 1, 1, 1], + [2, 4, 8, 16], + [3, 9, 27, 81], + [4, 16, 64, 256], + [5, 25, 125, 625] ]; + var t = [ for (i in 0...m[0].length) + [ for (j in 0...m.length) 0 ] ]; + for(i in 0...m.length) + for(j in 0...m[0].length) + t[j][i] = m[i][j]; + + for(aa in [m, t]) + for(a in aa) Sys.println(a); + } +} diff --git a/Task/Matrix-transposition/JavaScript/matrix-transposition-2.js b/Task/Matrix-transposition/JavaScript/matrix-transposition-2.js index d4b4a8f800..5968620d91 100644 --- a/Task/Matrix-transposition/JavaScript/matrix-transposition-2.js +++ b/Task/Matrix-transposition/JavaScript/matrix-transposition-2.js @@ -1,12 +1,16 @@ -transpose = function(a) { - return a[0].map(function(x,i) { - return a.map(function(y,k) { - return y[i]; - }); - }); -} +(function () { + 'use strict'; -A = [[1,2,3],[4,5,6],[7,8,9],[10,11,12]]; + function transpose(lst) { + return lst[0].map(function (_, iCol) { + return lst.map(function (row) { + return row[iCol]; + }) + }); + } -JSON.stringify(transpose(A)); -"[[1,4,7,10],[2,5,8,11],[3,6,9,12]]" + return transpose( + [[1, 2, 3], [4, 5, 6], [7, 8, 9], [10, 11, 12]] + ); + +})(); diff --git a/Task/Matrix-transposition/JavaScript/matrix-transposition-3.js b/Task/Matrix-transposition/JavaScript/matrix-transposition-3.js new file mode 100644 index 0000000000..11d3cd289c --- /dev/null +++ b/Task/Matrix-transposition/JavaScript/matrix-transposition-3.js @@ -0,0 +1,16 @@ +(() => { + 'use strict'; + + // transpose :: [[a]] -> [[a]] + let transpose = xs => + xs[0].map((_, iCol) => xs.map((row) => row[iCol])); + + + + // TEST + return transpose([ + [1, 2], + [3, 4], + [5, 6] + ]); +})(); diff --git a/Task/Matrix-transposition/JavaScript/matrix-transposition-4.js b/Task/Matrix-transposition/JavaScript/matrix-transposition-4.js new file mode 100644 index 0000000000..a94db6dc69 --- /dev/null +++ b/Task/Matrix-transposition/JavaScript/matrix-transposition-4.js @@ -0,0 +1 @@ +[[1, 3, 5], [2, 4, 6]] diff --git a/Task/Matrix-transposition/Perl-6/matrix-transposition-1.pl6 b/Task/Matrix-transposition/Perl-6/matrix-transposition-1.pl6 index e89a2f2d09..63d0661a8d 100644 --- a/Task/Matrix-transposition/Perl-6/matrix-transposition-1.pl6 +++ b/Task/Matrix-transposition/Perl-6/matrix-transposition-1.pl6 @@ -7,12 +7,10 @@ sub transpose(@m) # creates a random matrix my @a; -for (^10).pick X (^10).pick -> ($x, $y) { @a[$x][$y] = (^100).pick; } - -say "original: "; -.perl.say for @a; +for ^5 X ^5 -> ($x, $y) { @a[$x][$y] = ('a'..'z').pick; } +say "original:"; +.gist.say for @a; my @b = transpose(@a); - -say "transposed: "; -.perl.say for @b; +say "transposed:"; +.gist.say for @b; diff --git a/Task/Matrix-transposition/PowerShell/matrix-transposition-1.psh b/Task/Matrix-transposition/PowerShell/matrix-transposition-1.psh new file mode 100644 index 0000000000..f6431a9cd4 --- /dev/null +++ b/Task/Matrix-transposition/PowerShell/matrix-transposition-1.psh @@ -0,0 +1,58 @@ +function transpose($a) { + $arr = @() + if($a) { + $n = $a.count - 1 + if(0 -lt $n) { + $m = ($a | foreach {$_.count} | measure-object -Minimum).Minimum - 1 + if( 0 -le $m) { + if (0 -lt $m) { + $arr =@(0)*($m+1) + foreach($i in 0..$m) { + $arr[$i] = foreach($j in 0..$n) {@($a[$j][$i])} + } + } else {$arr = foreach($row in $a) {$row[0]}} + } + } else {$arr = $a} + } + $arr +} +function show($a) { + if($a) { + 0..($a.Count - 1) | foreach{ if($a[$_]){"$($a[$_])"}else{""} } + } +} + +$a = @(@(2, 0, 7, 8),@(3, 5, 9, 1),@(4, 1, 6, 3)) +"`$a =" +show $a +"" +"transpose `$a =" +show (transpose $a) +"" +$a = @(1) +"`$a =" +show $a +"" +"transpose `$a =" +show (transpose $a) +"" +"`$a =" +$a = @(1,2,3) +show $a +"" +"transpose `$a =" +"$(transpose $a)" +"" +"`$a =" +$a = @(@(4,7,8),@(1),@(2,3)) +show $a +"" +"transpose `$a =" +"$(transpose $a)" +"" +"`$a =" +$a = @(@(4,7,8),@(1,5,9,0),@(2,3)) +show $a +"" +"transpose `$a =" +show (transpose $a) diff --git a/Task/Matrix-transposition/PowerShell/matrix-transposition.psh b/Task/Matrix-transposition/PowerShell/matrix-transposition-2.psh similarity index 74% rename from Task/Matrix-transposition/PowerShell/matrix-transposition.psh rename to Task/Matrix-transposition/PowerShell/matrix-transposition-2.psh index 39b37e13c3..7897907cb7 100644 --- a/Task/Matrix-transposition/PowerShell/matrix-transposition.psh +++ b/Task/Matrix-transposition/PowerShell/matrix-transposition-2.psh @@ -1,5 +1,5 @@ function transpose($a) { - if($a.Count -gt 0) { + if($a) { $n = $a.Count - 1 foreach($i in 0..$n) { $j = 0 @@ -12,9 +12,8 @@ function transpose($a) { $a } function show($a) { - if($a.Count -gt 0) { - $n = $a.Count - 1 - 0..$n | foreach{ "$($a[$_][0..$n])" } + if($a) { + 0..($a.Count - 1) | foreach{ if($a[$_]){"$($a[$_])"}else{""} } } } $a = @(@(2, 4, 7),@(3, 5, 9),@(4, 1, 6)) diff --git a/Task/Matrix-transposition/REXX/matrix-transposition.rexx b/Task/Matrix-transposition/REXX/matrix-transposition.rexx index aee419116c..0e30d79773 100644 --- a/Task/Matrix-transposition/REXX/matrix-transposition.rexx +++ b/Task/Matrix-transposition/REXX/matrix-transposition.rexx @@ -1,32 +1,28 @@ -/*REXX program transposes a matrix, shows before and after matrixes. */ -x. = -x.1 = 1.02 2.03 3.04 4.05 5.06 6.07 7.07 -x.2 = 111 2222 33333 444444 5555555 66666666 777777777 +/*REXX program transposes a matrix, and displays the before and after matrices. */ +x.=; x.1 = 1.02 2.03 3.04 4.05 5.06 6.07 7.07 + x.2 = 111 2222 33333 444444 5555555 66666666 777777777 - do r=1 while x.r\=='' /*build the "A" matric from X. numbers */ - do c=1 while x.r\=='' - parse var x.r a.r.c x.r - end /*c*/ - end /*r*/ - -rows = r-1; cols = c-1 -L=0 /*L is the maximum width element value.*/ - do i=1 for rows - do j=1 for cols - b.j.i = a.i.j; L=max(L,length(b.j.i)) - end /*j*/ - end /*i*/ + do r=1 while x.r\=='' /*build matrix A from matrix X.*/ + do c=1 while x.r\=='' + parse var x.r a.r.c x.r + end /*c*/ + end /*r*/ +rows=r-1; cols=c-1 /*adjust for DO loop indices. */ +L=0 /*L is max width element value. */ + do i=1 for rows + do j=1 for cols + b.j.i=a.i.j; L=max( L, length(b.j.i) ) + end /*j*/ + end /*i*/ call showMat 'A', rows, cols call showMat 'B', cols, rows -exit /*stick a fork in it, we're done.*/ -/*─────────────────────────────────────SHOWMAT subroutine───────────────*/ -showMat: parse arg mat,rows,cols; say -say center(mat 'matrix', cols*(L+1) +4, "─") - - do r=1 for rows; _= - do c=1 for cols; _ = _ right(value(mat'.'r'.'c), L) - end /*c*/ - say _ - end /*r*/ -return +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +showMat: parse arg mat,rows,cols; say; say center(mat 'matrix', cols*(L+1)+4, "─") + do r=1 for rows; _= + do c=1 for cols; _=_ right(value(mat'.'r"."c), L) + end /*c*/ + say _ + end /*r*/ + return diff --git a/Task/Maximum-triangle-path-sum/00DESCRIPTION b/Task/Maximum-triangle-path-sum/00DESCRIPTION index 790127cb21..307dce62cb 100644 --- a/Task/Maximum-triangle-path-sum/00DESCRIPTION +++ b/Task/Maximum-triangle-path-sum/00DESCRIPTION @@ -3,7 +3,8 @@ Starting from the top of a pyramid of numbers like this, you can walk down going 55 94 48 95 30 96 - 77 71 26 67
    + 77 71 26 67 + One of such walks is 55 - 94 - 30 - 26. You can compute the total of the numbers you have seen in such walk, @@ -11,7 +12,9 @@ in this case it's 205. Your problem is to find the maximum total among all possible paths from the top to the bottom row of the triangle. In the little example above it's 321. -'''Task:''' find the maximum total in the triangle below: + +;Task: +Find the maximum total in the triangle below:
                               55
                             94 48
    @@ -30,8 +33,10 @@ Your problem is to find the maximum total among all possible paths from the top
          44 25 67 84 71 67 11 61 40 57 58 89 40 56 36
        85 32 25 85 57 48 84 35 47 62 17 01 01 99 89 52
       06 71 28 75 94 48 37 10 23 51 06 48 53 18 74 98 15
    -27 02 92 23 08 71 76 84 15 52 92 63 81 10 44 10 69 93
    +27 02 92 23 08 71 76 84 15 52 92 63 81 10 44 10 69 93 + Such numbers can be included in the solution code, or read from a "triangle.txt" file. This task is derived from the [http://projecteuler.net/problem=18 Euler Problem #18]. +

    diff --git a/Task/Maximum-triangle-path-sum/REXX/maximum-triangle-path-sum.rexx b/Task/Maximum-triangle-path-sum/REXX/maximum-triangle-path-sum.rexx index 7ffce4a3f2..0222ea1431 100644 --- a/Task/Maximum-triangle-path-sum/REXX/maximum-triangle-path-sum.rexx +++ b/Task/Maximum-triangle-path-sum/REXX/maximum-triangle-path-sum.rexx @@ -1,34 +1,32 @@ -/*REXX program finds the max sum of a "column" of numbers in a triangle.*/ -@. = -@.1 = 55 -@.2 = 94 48 -@.3 = 95 30 96 -@.4 = 77 71 26 67 -@.5 = 97 13 76 38 45 -@.6 = 07 36 79 16 37 68 -@.7 = 48 07 09 18 70 26 06 -@.8 = 18 72 79 46 59 79 29 90 -@.9 = 20 76 87 11 32 07 07 49 18 -@.10 = 27 83 58 35 71 11 25 57 29 85 -@.11 = 14 64 36 96 27 11 58 56 92 18 55 -@.12 = 02 90 03 60 48 49 41 46 33 36 47 23 -@.13 = 92 50 48 02 36 59 42 79 72 20 82 77 42 -@.14 = 56 78 38 80 39 75 02 71 66 66 01 03 55 72 -@.15 = 44 25 67 84 71 67 11 61 40 57 58 89 40 56 36 -@.16 = 85 32 25 85 57 48 84 35 47 62 17 01 01 99 89 52 -@.17 = 06 71 28 75 94 48 37 10 23 51 06 48 53 18 74 98 15 -@.18 = 27 02 92 23 08 71 76 84 15 52 92 63 81 10 44 10 69 93 +/*REXX program finds the maximum sum of a path of numbers in a pyramid of numbers. */ +@.=.; @.1 = 55 + @.2 = 94 48 + @.3 = 95 30 96 + @.4 = 77 71 26 67 + @.5 = 97 13 76 38 45 + @.6 = 07 36 79 16 37 68 + @.7 = 48 07 09 18 70 26 06 + @.8 = 18 72 79 46 59 79 29 90 + @.9 = 20 76 87 11 32 07 07 49 18 + @.10 = 27 83 58 35 71 11 25 57 29 85 + @.11 = 14 64 36 96 27 11 58 56 92 18 55 + @.12 = 02 90 03 60 48 49 41 46 33 36 47 23 + @.13 = 92 50 48 02 36 59 42 79 72 20 82 77 42 + @.14 = 56 78 38 80 39 75 02 71 66 66 01 03 55 72 + @.15 = 44 25 67 84 71 67 11 61 40 57 58 89 40 56 36 + @.16 = 85 32 25 85 57 48 84 35 47 62 17 01 01 99 89 52 + @.17 = 06 71 28 75 94 48 37 10 23 51 06 48 53 18 74 98 15 + @.18 = 27 02 92 23 08 71 76 84 15 52 92 63 81 10 44 10 69 93 +#.=0 + do r=1 while @.r\==. /*build another version of the pyramid.*/ + do k=1 for r; #.r.k=word(@.r, k) /*assign a number to an array number. */ + end /*k*/ + end /*r*/ - do r=1 while @.r\=='' /*build a version of the triangle*/ - do k=1 for words(@.r) /*build a row, number by number. */ - #.r.k=word(@.r,k) /*assign a number to an array num*/ - end /*k*/ - end /*r*/ -rows=r-1 /*compute the number of rows. */ - do r=rows by -1 to 2; p=r-1 /*traipse through triangle rows. */ - do k=1 for p; kn=k+1 /*re-calculate the previous row. */ - #.p.k=max(#.r.k, #.r.kn) + #.p.k /*replace previous #. */ - end /*k*/ - end /*r*/ -say 'maximum path sum:' #.1.1 /*display the top (row 1) number.*/ - /*stick a fork in it, we're done.*/ + do r=r-1 by -1 to 2; p=r-1 /*traipse through the pyramid rows. */ + do k=1 for p; _=k+1 /*re─calculate the previous pyramid row*/ + #.p.k=max(#.r.k, #.r._) + #.p.k /*replace the previous number. */ + end /*k*/ + end /*r*/ + /*stick a fork in it, we're all done. */ +say 'maximum path sum: ' #.1.1 /*show the top (row 1) pyramid number. */ diff --git a/Task/Maze-generation/00DESCRIPTION b/Task/Maze-generation/00DESCRIPTION index 4613bb20c8..a0d273bd44 100644 --- a/Task/Maze-generation/00DESCRIPTION +++ b/Task/Maze-generation/00DESCRIPTION @@ -1,4 +1,8 @@ {{wikipedia|Maze generation algorithm}} +[[File:a maze.png|300px||right|a maze]] + +
    +;Task: Generate and show a maze, using the simple [[wp:Maze_generation_algorithm#Depth-first_search|Depth-first search]] algorithm. @@ -6,5 +10,8 @@ Generate and show a maze, using the simple [[wp:Maze_generation_algorithm#Depth- #Mark the current cell as visited, and get a list of its neighbors. For each neighbor, starting with a randomly selected neighbor: #:If that neighbor hasn't been visited, remove the wall between this cell and that neighbor, and then recurse with that neighbor as the current cell. +

    -See also [[Maze solving]]. +; Related tasks +* [[Maze solving]]. +

    diff --git a/Task/Maze-generation/Elixir/maze-generation.elixir b/Task/Maze-generation/Elixir/maze-generation.elixir index aeb3e04db8..4577d6e065 100644 --- a/Task/Maze-generation/Elixir/maze-generation.elixir +++ b/Task/Maze-generation/Elixir/maze-generation.elixir @@ -1,27 +1,28 @@ defmodule Maze do def generate(w, h) do - :random.seed(:os.timestamp) - (for i <- 1..w, j <- 1..h, do: {i,j}) |> - Enum.each(fn{i,j} -> Process.put({:vis, i, j}, true) end) - walk(:random.uniform(w), :random.uniform(h)) - print(w, h) + maze = (for i <- 1..w, j <- 1..h, into: Map.new, do: {{:vis, i, j}, true}) + |> walk(:rand.uniform(w), :rand.uniform(h)) + print(maze, w, h) + maze end - defp walk(x, y) do - Process.put({:vis, x, y}, false) - Enum.each(Enum.shuffle([[x-1,y], [x,y+1], [x+1,y], [x,y-1]]), fn [i,j] -> - if Process.get({:vis, i, j}) do - if i == x, do: Process.put({:hor, x, max(y, j)}, "+ "), - else: Process.put({:ver, max(x, i), y}, " ") - walk(i, j) + defp walk(map, x, y) do + Enum.shuffle( [[x-1,y], [x,y+1], [x+1,y], [x,y-1]] ) + |> Enum.reduce(Map.put(map, {:vis, x, y}, false), fn [i,j],acc -> + if acc[{:vis, i, j}] do + {k, v} = if i == x, do: {{:hor, x, max(y, j)}, "+ "}, + else: {{:ver, max(x, i), y}, " "} + walk(Map.put(acc, k, v), i, j) + else + acc end end) end - defp print(w, h) do + defp print(map, w, h) do Enum.each(1..h, fn j -> - IO.puts (Enum.map(1..w, fn i -> Process.get({:hor, i, j}, "+---") end) |> Enum.join) <> "+" - IO.puts (Enum.map(1..w, fn i -> Process.get({:ver, i, j}, "| ") end) |> Enum.join) <> "|" + IO.puts Enum.map_join(1..w, fn i -> Map.get(map, {:hor, i, j}, "+---") end) <> "+" + IO.puts Enum.map_join(1..w, fn i -> Map.get(map, {:ver, i, j}, "| ") end) <> "|" end) IO.puts String.duplicate("+---", w) <> "+" end diff --git a/Task/Maze-generation/Erlang/maze-generation.erl b/Task/Maze-generation/Erlang/maze-generation-1.erl similarity index 100% rename from Task/Maze-generation/Erlang/maze-generation.erl rename to Task/Maze-generation/Erlang/maze-generation-1.erl diff --git a/Task/Maze-generation/Erlang/maze-generation-2.erl b/Task/Maze-generation/Erlang/maze-generation-2.erl new file mode 100644 index 0000000000..805f8df248 --- /dev/null +++ b/Task/Maze-generation/Erlang/maze-generation-2.erl @@ -0,0 +1,114 @@ +-module(maze). +-record(maze, {g, m, n}). +-export([generate_default/0, generate_MxN/2]). + +make_maze(M, N) -> + Maze = #maze{g = digraph:new(), m = M, n = N}, + lists:foreach(fun(X) -> digraph:add_vertex(Maze#maze.g, X) end, lists:seq(0, M * N - 1)), + Maze. + +row_at(V, Maze) -> trunc(V / Maze#maze.n). +col_at(V, Maze) -> V - row_at(V, Maze) * Maze#maze.n. +vertex_at(Row, Col, Maze) -> Cell_Exists = cell_exists(Row, Col, Maze), if Cell_Exists -> Row * Maze#maze.n + Col; true -> -1 end. +cell_exists(Row, Col, Maze) -> (Row >= 0) and (Row < Maze#maze.m) and (Col >= 0) and (Col < Maze#maze.n). + +adjacent_cells(V, Maze) -> % ordered: left, up, right, down + adjacent_cell(cell_left, V, Maze)++adjacent_cell(cell_up, V, Maze)++adjacent_cell(cell_right, V, Maze)++adjacent_cell(cell_down, V, Maze). + +adjacent_cell(cell_left, V, Maze) -> case (col_at(V, Maze) == 0) of true -> []; _Else -> [V - 1] end; +adjacent_cell(cell_up, V, Maze) -> case (row_at(V, Maze) == 0) of true -> []; _Else -> [V - Maze#maze.n] end; +adjacent_cell(cell_right, V, Maze) -> case (col_at(V, Maze) == Maze#maze.n - 1) of true -> []; _Else -> [V + 1] end; +adjacent_cell(cell_down, V, Maze) -> case (row_at(V, Maze) == Maze#maze.m - 1) of true -> []; _Else -> [V + Maze#maze.n] end. + +connect_all(V, Maze) -> + lists:foreach(fun(X) -> digraph:add_edge(Maze#maze.g, V, X) end, adjacent_cells(V, Maze)). + +make_maze(M, N, all_connected) -> + Maze = make_maze(M, N), + lists:foreach(fun(X) -> connect_all(X, Maze) end, lists:seq(0, M * N - 1)), + Maze. + +maze_parts(Maze) -> + SPR = Maze#maze.n + 1, % slots per row is #columns + 1 + NPR = (Maze#maze.m * 2) + 1, % # part rows is #(rows * 2) + 1 + [make_part(Maze, trunc(Index/SPR), Index - trunc(Index/SPR) * SPR) || Index <- lists:seq(0, (SPR * NPR) - 1)]. + +draw_part(Part) -> + case Part of + {pwall, pclosed} -> io:format("+---"); + {pwall, popen} -> io:format("+ "); + {pwall, pend} -> io:format("+~n"); + {phall, pclosed} -> io:format("| "); + {phall, popen} -> io:format(" "); + {phall, pend} -> io:format("|~n") + end. + +has_neighbour(Maze, Row, Col, Direction) -> + V = vertex_at(Row, Col, Maze), + if + V >= 0 -> + Adjacent = adjacent_cell(Direction, V, Maze), + if + length(Adjacent) > 0 -> + Neighbours = digraph:out_neighbours(Maze#maze.g, lists:nth(1, Adjacent)), + lists:member(V, Neighbours); + true -> false + end; + true -> false + end. + +make_part(Maze, DoubledRow, Col) -> + if + trunc(DoubledRow/2) * 2 == DoubledRow -> % --- (even row) making a wall above the cell + make_part(Maze, trunc(DoubledRow/2), Col, cell_up, pwall); + true -> % ---otherwise (odd row) making a hall through the cell + make_part(Maze, trunc(DoubledRow/2), Col, cell_left, phall) + end. + +make_part(Maze, _, Col, _, Part_Type) when Col == Maze#maze.n -> {Part_Type, pend}; +make_part(Maze, Row, Col, Direction, Part_Type) -> + Has_Neighbour = has_neighbour(Maze, Row, Col, Direction), + if + Has_Neighbour -> {Part_Type, popen}; + true -> {Part_Type, pclosed} + end. + +shuffle([], Acc) -> Acc; +shuffle(List, Acc) -> + Elem = lists:nth(random:uniform(length(List)), List), + shuffle(lists:delete(Elem, List), Acc++[Elem]). + +processDepthFirst(Maze) -> + if + Maze#maze.m * Maze#maze.n == 0 -> [{pwall, pend}]; + true -> + Visited = array:new([{size, Maze#maze.m * Maze#maze.n},{fixed,true},{default,false}]), + {_, Path} = processDepthFirst(Maze, -1, random:uniform(Maze#maze.m * Maze#maze.n) - 1, {Visited, []}), + Path + end. + +processDepthFirst(Maze, Vfrom, V, VandP) -> + {Visited, Path} = VandP, + Was_Visited = array:get(V, Visited), + if + not Was_Visited -> + Walker = fun(X, Acc) -> processDepthFirst(Maze, V, X, Acc) end, + Random_Neighbours = shuffle(digraph:out_neighbours(Maze#maze.g, V), []), + lists:foldl(Walker, {array:set(V, true, Visited), Path++[{Vfrom, V}]}, Random_Neighbours); + true -> VandP + end. + +open_wall(_, {-1, _}) -> ok; +open_wall(Maze, {V, V2}) -> + case (V2 > V) of true -> digraph:add_edge(Maze#maze.g, V, V2); _Else -> digraph:add_edge(Maze#maze.g, V2, V) end. + +generate_MxN(M, N) -> + Maze = make_maze(M, N), + Matrix = make_maze(M, N, all_connected), + Trail = processDepthFirst(Matrix), + lists:foreach(fun(X) -> open_wall(Maze, X) end, Trail), + Parts = maze_parts(Maze), + lists:foreach(fun(X) -> draw_part(X) end, Parts). + +generate_default() -> + generate_MxN(9, 9). diff --git a/Task/Maze-generation/Haskell/maze-generation.hs b/Task/Maze-generation/Haskell/maze-generation.hs index 29e5429e17..56cee53ed7 100644 --- a/Task/Maze-generation/Haskell/maze-generation.hs +++ b/Task/Maze-generation/Haskell/maze-generation.hs @@ -1,3 +1,6 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} + import Control.Monad import Control.Monad.ST import Data.Array diff --git a/Task/Maze-generation/Kotlin/maze-generation.kotlin b/Task/Maze-generation/Kotlin/maze-generation.kotlin new file mode 100644 index 0000000000..3ee17bbf75 --- /dev/null +++ b/Task/Maze-generation/Kotlin/maze-generation.kotlin @@ -0,0 +1,61 @@ +import shuffle.shuffle + +class Maze_generator(val x: Int, val y: Int) { + fun generate(cx: Int, cy: Int) { + arrayOf(*DIR.values()).shuffle().forEach { + val nx = cx + it.dx + val ny = cy + it.dy + if (between(nx, x) && between(ny, y) && maze[nx][ny] == 0) { + maze[cx][cy] = maze[cx][cy] or it.bit + maze[nx][ny] = maze[nx][ny] or it.opposite!!.bit + generate(nx, ny) + } + } + } + + fun display() { + for (i in 0..y - 1) { + // draw the north edge + for (j in 0..x - 1) + print(if (maze[j][i] and 1 == 0) "+---" else "+ ") + println('+') + + // draw the west edge + for (j in 0..x - 1) + print(if (maze[j][i] and 8 == 0) "| " else " ") + println('|') + } + + // draw the bottom line + for (j in 0..x - 1) print("+---") + println('+') + } + + private enum class DIR(val bit: Int, val dx: Int, val dy: Int) { + N(1, 0, -1), S(2, 0, 1), E(4, 1, 0),W(8, -1, 0); + + var opposite: DIR? = null + + companion object { + init { + N.opposite = S + S.opposite = N + E.opposite = W + W.opposite = E + } + } + } + + private fun between(v: Int, upper: Int) = v >= 0 && v < upper + + private val maze = Array(x) { IntArray(y) } +} + +fun main(args: Array) { + val x = if (args.size >= 1) args[0].toInt() else 8 + val y = if (args.size == 2) args[1].toInt() else 8 + with(Maze_generator(x, y)) { + generate(0, 0) + display() + } +} diff --git a/Task/Maze-generation/Lua/maze-generation.lua b/Task/Maze-generation/Lua/maze-generation.lua new file mode 100644 index 0000000000..ee1fc378f4 --- /dev/null +++ b/Task/Maze-generation/Lua/maze-generation.lua @@ -0,0 +1,73 @@ +math.randomseed( os.time() ) + +-- Fisher-Yates shuffle from http://santos.nfshost.com/shuffling.html +function shuffle(t) + for i = 1, #t - 1 do + local r = math.random(i, #t) + t[i], t[r] = t[r], t[i] + end +end + +-- builds a width-by-height grid of trues +function initialize_grid(w, h) + local a = {} + for i = 1, h do + table.insert(a, {}) + for j = 1, w do + table.insert(a[i], true) + end + end + return a +end + +-- average of a and b +function avg(a, b) + return (a + b) / 2 +end + + +dirs = { + {x = 0, y = -2}, -- north + {x = 2, y = 0}, -- east + {x = -2, y = 0}, -- west + {x = 0, y = 2}, -- south +} + +function make_maze(w, h) + w = w or 16 + h = h or 8 + + local map = initialize_grid(w*2+1, h*2+1) + + function walk(x, y) + map[y][x] = false + + local d = { 1, 2, 3, 4 } + shuffle(d) + for i, dirnum in ipairs(d) do + local xx = x + dirs[dirnum].x + local yy = y + dirs[dirnum].y + if map[yy] and map[yy][xx] then + map[avg(y, yy)][avg(x, xx)] = false + walk(xx, yy) + end + end + end + + walk(math.random(1, w)*2, math.random(1, h)*2) + + local s = {} + for i = 1, h*2+1 do + for j = 1, w*2+1 do + if map[i][j] then + table.insert(s, '#') + else + table.insert(s, ' ') + end + end + table.insert(s, '\n') + end + return table.concat(s) +end + +print(make_maze()) diff --git a/Task/Maze-generation/REXX/maze-generation-1.rexx b/Task/Maze-generation/REXX/maze-generation-1.rexx index 2e475e2f62..af1889da35 100644 --- a/Task/Maze-generation/REXX/maze-generation-1.rexx +++ b/Task/Maze-generation/REXX/maze-generation-1.rexx @@ -1,103 +1,103 @@ -/*REXX program generates and displays a rectangular solvable maze (any size).*/ -height=0; @.=0 /*default for all cells visited. */ -parse arg rows cols seed . /*allow user to specify the maze size. */ -if rows='' | rows==',' then rows=19 /*No rows given? Then use the default.*/ -if cols='' | cols==',' then cols=19 /* " cols " ? " " " " */ -if seed\=='' then call random ,,seed /*use a random seed for repeatability.*/ -call buildRow '┌'copies('~┬',cols-1)'~┐' /*construct top edge of the maze. */ - /* [↓] construct the maze's grid. */ - do r=1 for rows; _=; __=; hp= '|'; hj='├' - do c=1 for cols; _= _||hp'1'; __=__||hj'~'; hj='┼'; hp='│' +/*REXX program generates and displays a rectangular solvable maze (of any size).*/ +height=0; @.=0 /*default for all cells visited. */ +parse arg rows cols seed . /*allow user to specify the maze size. */ +if rows='' | rows=="," then rows=19 /*No rows given? Then use the default.*/ +if cols='' | cols=="," then cols=19 /* " cols " ? " " " " */ +if seed\=='' then call random ,,seed /*use a random seed for repeatability.*/ +call buildRow '┌'copies("~┬",cols-1)'~┐' /*construct the top edge of the maze. */ + /* [↓] construct the maze's grid. */ + do r=1 for rows; _=; __=; hp= "|"; hj='├' + do c=1 for cols; _= _||hp'1'; __=__||hj"~"; hj='┼'; hp="│" end /*c*/ - call buildRow _'│' /*construct the right edge of cells.*/ - if r\==rows then call buildRow __'┤' /* " " " " " maze. */ + call buildRow _'│' /*construct the right edge of the cells*/ + if r\==rows then call buildRow __'┤' /* " " " " " " maze.*/ end /*r*/ -call buildRow '└'copies('~┴',cols-1)'~┘' /*construct the bottom maze edge.*/ -r!=random(1,rows)*2; c!=random(1,cols)*2; @.r!.c!=0 /*choose the 1st cell.*/ - /* [↓] traipse through the maze. */ - do forever; n=hood(r!,c!); if n==0 then if \fCell() then leave - call ?; @._r._c=0 /*get the (next) maze direction to go. */ - ro=r!; co=c!; r!=_r; c!=_c /*save original maze cell coordinates. */ - ?.zr=?.zr%2; ?.zc=?.zc%2 /*get the maze row and cell directions.*/ - rw=ro+?.zr; cw=co+?.zc /*calculate the next row and column. */ - @.rw.cw=. /*mark the maze cell as being visited. */ +call buildRow '└'copies("~┴", cols-1)'~┘' /*construct the bottom edge of the maze*/ +r!=random(1,rows)*2; c!=random(1,cols)*2; @.r!.c!=0 /*choose the first cell in maze*/ + /* [↓] traipse through the maze. */ + do forever; n=hood(r!,c!) + if n==0 then if \fCell() then leave + call ?; @._r._c=0 /*get the (next) maze direction to go. */ + ro=r!; co=c!; r!=_r; c!=_c /*save original maze cell coordinates. */ + ?.zr=?.zr%2; ?.zc=?.zc%2 /*get the maze row and cell directions.*/ + rw=ro+?.zr; cw=co+?.zc /*calculate the next row and column. */ + @.rw.cw=. /*mark the maze cell as being visited. */ end /*forever*/ - do r=1 for height; _= /*display the maze. */ + do r=1 for height; _= /*display the maze. */ do c=1 for cols*2 + 1; _=_ || @.r.c; end /*c*/ - if \(r//2) then _=translate(_, '\', .) /*trans to backslash*/ - @.r=_ /*save the row in @.*/ + if \(r//2) then _=translate(_, '\', .) /*trans to backslash*/ + @.r=_ /*save the row in @.*/ end /*r*/ - do #=1 for height; _=@.# /*display maze to the terminal. */ - call makeNice /*make some cell corners prettier*/ + do #=1 for height; _=@.# /*display the maze to the terminal. */ + call makeNice /*make some cell corners look prettier.*/ - _=changestr(1,_,111) /*──────these four ────────────────────*/ - _=changestr(0,_,000) /*───────── statements are ────────────*/ - _=changestr( . ,_," ") /*────────────── used for preserving ──*/ - _=changestr('~',_,"───") /*────────────────── the aspect ratio. */ - say translate(_, '─│', "═|\10") /*make it presentable for the screen. */ + _=changestr(1 , _, 111) /*──────these four ────────────────────*/ + _=changestr(0 , _, 000) /*───────── statements are ────────────*/ + _=changestr(. , _, " ") /*────────────── used for preserving ──*/ + _=changestr('~' , _, "───") /*────────────────── the aspect ratio. */ + say translate(_ , '─│', "═|\10") /*make it presentable for the screen. */ end /*#*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -@: parse arg _r,_c; return @._r._c /*a fast way to reference a maze cell. */ -/*────────────────────────────────────────────────────────────────────────────*/ -?: do forever; ?.=0; ?=random(1,4); if ?==1 then ?.zc=-2 /*north*/ - if ?==2 then ?.zr= 2 /* east*/ - if ?==3 then ?.zc= 2 /*south*/ - if ?==4 then ?.zr=-2 /* west*/ - _r=r!+?.zr; _c=c!+?.zc; if @._r._c==1 then return - end /*forever*/ -/*────────────────────────────────────────────────────────────────────────────*/ -buildRow: parse arg z; height=height+1; width=length(z) - do c=1 for width; @.height.c=substr(z,c,1); end; return -/*────────────────────────────────────────────────────────────────────────────*/ -fCell: do r=1 for rows; rr=r+r - do c=1 for cols; cc=c+c - if hood(rr,cc)==1 then do; r!=rr; c!=cc; @.r!.c!=0; return 1; end - end /*c*/ - end /*r*/ /* [↑] r! & c! are used by invoker.*/ -return 0 -/*────────────────────────────────────────────────────────────────────────────*/ -hood: parse arg rh,ch; return @(rh+2,ch) + @(rh-2,ch) + @(rh,ch-2) + @(rh,ch+2) -/*────────────────────────────────────────────────────────────────────────────*/ -makeNice: width=length(_); old=#-1; new=#+1; old_=@.old; new_=@.new - if left(_,2) =='├.' then _=translate(_, '|', "├") - if right(_,2)=='.┤' then _=translate(_, '|', "┤") - /* [↓] handle the top grid row.*/ - do k=1 for width while #==1; z=substr(_,k,1) /*maze top row.*/ - if z\=='┬' then iterate - if substr(new_,k,1)=='\' then _=overlay('═',_,k) - end /*k*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +@: parse arg _r,_c; return @._r._c /*a fast way to reference a maze cell. */ +hood: parse arg rh,ch; return @(rh+2,ch) + @(rh-2,ch) + @(rh,ch-2) + @(rh,ch+2) +/*──────────────────────────────────────────────────────────────────────────────────────*/ +?: do forever; ?.=0; ?=random(1,4); if ?==1 then ?.zc=-2 /*north*/ + if ?==2 then ?.zr= 2 /* east*/ + if ?==3 then ?.zc= 2 /*south*/ + if ?==4 then ?.zr=-2 /* west*/ + _r=r!+?.zr; _c=c!+?.zc; if @._r._c==1 then return + end /*forever*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +buildRow: parse arg z; height=height+1; width=length(z) + do c=1 for width; @.height.c=substr(z,c,1); end; return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +fCell: do r=1 for rows; rr=r+r + do c=1 for cols; cc=c+c + if hood(rr, cc)==1 then do; r!=rr; c!=cc; @.r!.c!=0; return 1; end + end /*c*/ + end /*r*/ /* [↑] r! and c! are used by invoker.*/ + return 0 +/*──────────────────────────────────────────────────────────────────────────────────────*/ +makeNice: width=length(_); old=#-1; new=#+1; old_=@.old; new_=@.new + if left(_,2) =='├.' then _=translate(_, "|", '├') + if right(_,2)=='.┤' then _=translate(_, "|", '┤') + /* [↓] handle the top row of the grid.*/ + do k=1 for width while #==1; z=substr(_,k,1) /*maze top row.*/ + if z\=='┬' then iterate + if substr(new_,k,1)=='\' then _=overlay("═",_,k) + end /*k*/ - do k=1 for width while #==height; z=substr(_,k,1) /*maze bot row.*/ - if z\=='┴' then iterate - if substr(old_,k,1)=='\' then _=overlay('═',_,k) - end /*k*/ - /* [↓] handle the mid grid rows*/ - do k=3 to width-2 by 2 while #//2; z=substr(_,k,1) /*maze mid rows*/ - if z\=='┼' then iterate - le=substr(_,k-1,1) - ri=substr(_,k+1,1) - up=substr(old_,k,1) - dw=substr(new_,k,1) - select - when le== . & ri== . & up=='│' & dw=='│' then _=overlay('|',_,k) - when le=='~' & ri=='~' & up=='\' & dw=='\' then _=overlay('═',_,k) - when le=='~' & ri=='~' & up=='\' & dw=='│' then _=overlay('┬',_,k) - when le=='~' & ri=='~' & up=='│' & dw=='\' then _=overlay('┴',_,k) - when le=='~' & ri== . & up=='\' & dw=='\' then _=overlay('═',_,k) - when le== . & ri=='~' & up=='\' & dw=='\' then _=overlay('═',_,k) - when le== . & ri== . & up=='│' & dw=='\' then _=overlay('|',_,k) - when le== . & ri== . & up=='\' & dw=='│' then _=overlay('|',_,k) - when le== . & ri=='~' & up=='\' & dw=='│' then _=overlay('┌',_,k) - when le== . & ri=='~' & up=='│' & dw=='\' then _=overlay('└',_,k) - when le=='~' & ri== . & up=='\' & dw=='│' then _=overlay('┐',_,k) - when le=='~' & ri== . & up=='│' & dw=='\' then _=overlay('┘',_,k) - when le=='~' & ri== . & up=='│' & dw=='│' then _=overlay('┤',_,k) - when le== . & ri=='~' & up=='│' & dw=='│' then _=overlay('├',_,k) - otherwise nop - end /*select*/ - end /*k*/ - return + do k=1 for width while #==height; z=substr(_,k,1) /*maze bot row.*/ + if z\=='┴' then iterate + if substr(old_, k, 1)=='\' then _=overlay("═", _, k) + end /*k*/ + /* [↓] handle the mid rows of the grid*/ + do k=3 to width-2 by 2 while #//2; z=substr(_,k,1) /*maze mid rows*/ + if z\=='┼' then iterate + le=substr(_,k-1,1) + ri=substr(_,k+1,1) + up=substr(old_,k,1) + dw=substr(new_,k,1) + select + when le== . & ri== . & up=='│' & dw=="│" then _=overlay('|',_,k) + when le=='~' & ri=="~" & up=='\' & dw=="\" then _=overlay('═',_,k) + when le=='~' & ri=="~" & up=='\' & dw=="│" then _=overlay('┬',_,k) + when le=='~' & ri=="~" & up=='│' & dw=="\" then _=overlay('┴',_,k) + when le=='~' & ri== . & up=='\' & dw=="\" then _=overlay('═',_,k) + when le== . & ri=="~" & up=='\' & dw=="\" then _=overlay('═',_,k) + when le== . & ri== . & up=='│' & dw=="\" then _=overlay('|',_,k) + when le== . & ri== . & up=='\' & dw=="│" then _=overlay('|',_,k) + when le== . & ri=="~" & up=='\' & dw=="│" then _=overlay('┌',_,k) + when le== . & ri=="~" & up=='│' & dw=="\" then _=overlay('└',_,k) + when le=='~' & ri== . & up=='\' & dw=="│" then _=overlay('┐',_,k) + when le=='~' & ri== . & up=='│' & dw=="\" then _=overlay('┘',_,k) + when le=='~' & ri== . & up=='│' & dw=="│" then _=overlay('┤',_,k) + when le== . & ri=="~" & up=='│' & dw=="│" then _=overlay('├',_,k) + otherwise nop + end /*select*/ + end /*k*/ + return diff --git a/Task/Maze-generation/REXX/maze-generation-2.rexx b/Task/Maze-generation/REXX/maze-generation-2.rexx index cccaeb1be9..db424eacbe 100644 --- a/Task/Maze-generation/REXX/maze-generation-2.rexx +++ b/Task/Maze-generation/REXX/maze-generation-2.rexx @@ -1,57 +1,58 @@ -/*REXX program generates and displays a rectangular solvable maze (any size).*/ -height=0; @.=0 /*default for all cells visited. */ -parse arg rows cols seed . /*allow user to specify the maze size. */ -if rows='' | rows==',' then rows=19 /*No rows given? Then use the default.*/ -if cols='' | cols==',' then cols=19 /* " cols " ? " " " " */ -if seed\=='' then call random ,,seed /*use a random seed for repeatability.*/ -call buildRow '┌'copies('─┬',cols-1)'─┐' /*build the top edge of the maze. */ - /* [↓] construct the maze's grid. */ - do r=1 for rows; _=; __=; hp= '|'; hj='├' - do c=1 for cols; _= _||hp'1'; __=__||hj'─'; hj='┼'; hp='│' +/*REXX program generates and displays a rectangular solvable maze (of any size). */ +height=0; @.=0 /*default for all cells visited. */ +parse arg rows cols seed . /*allow user to specify the maze size. */ +if rows='' | rows=="," then rows=19 /*No rows given? Then use the default.*/ +if cols='' | cols=="," then cols=19 /* " cols " ? " " " " */ +if seed\=='' then call random ,,seed /*use a random seed for repeatability.*/ +call buildRow '┌'copies("─┬", cols-1)'─┐' /*construct the top edge of the maze.*/ + /* [↓] construct the maze's grid. */ + do r=1 for rows; _=; __=; hp= "|"; hj='├' + do c=1 for cols; _= _||hp'1'; __=__||hj"─"; hj='┼'; hp="│" end /*c*/ - call buildRow _'│' /*build the right edge of cells. */ - if r\==rows then call buildRow __'┤' /* " " " " " maze. */ + call buildRow _'│' /*construct the right edge of the cells*/ + if r\==rows then call buildRow __'┤' /* " " " " " " maze.*/ end /*r*/ -call buildRow '└'copies('─┴',cols-1)'─┘' /*construct the bottom maze edge. */ -r!=random(1,rows)*2; c!=random(1,cols)*2; @.r!.c!=0 /*choose the 1st cell.*/ - /* [↓] traipse through the maze. */ - do forever; n=hood(r!,c!); if n==0 then if \fCell() then leave - call ?; @._r._c=0 /*get the (next) maze direction to go. */ - ro=r!; co=c!; r!=_r; c!=_c /*save the original cell coordinates. */ - ?.zr=?.zr%2; ?.zc=?.zc%2 /*get the maze row and cell directions.*/ - rw=ro+?.zr; cw=co+?.zc /*calculate the next maze row and col. */ - @.rw.cw=. /*mark the maze cell as being visited. */ +call buildRow '└'copies("─┴", cols-1)'─┘' /*construct the bottom edge of the maze*/ +r!=random(1,rows)*2; c!=random(1,cols)*2; @.r!.c!=0 /*choose the first cell.*/ + /* [↓] traipse through the maze. */ + do forever; n=hood(r!, c!) /*number of free maze cells. */ + if n==0 then if \fCell() then leave /*if no free maze cells left, then done*/ + call ?; @._r._c=0 /*get the (next) maze direction to go. */ + ro=r!; co=c!; r!=_r; c!=_c /*save the original cell coordinates. */ + ?.zr=?.zr%2; ?.zc=?.zc%2 /*get the maze row and cell directions.*/ + rw=ro+?.zr; cw=co+?.zc /*calculate the next maze row and col. */ + @.rw.cw=. /*mark the maze cell as being visited. */ end /*forever*/ - do r=1 for height; _= /*display the maze. */ + do r=1 for height; _= /*display the maze. */ do c=1 for cols*2 + 1; _=_ || @.r.c; end /*c*/ - if \(r//2) then _=translate(_, '\', .) /*trans to backslash*/ - _=changestr(1,_,111) /*──────these four ────────────────────*/ - _=changestr(0,_,000) /*───────── statements are ────────────*/ - _=changestr( . ,_," ") /*────────────── used for preserving ──*/ - _=changestr('─',_,"───") /*────────────────── the aspect ratio. */ - say translate(_,'│',"|\10") /*make it presentable for the screen. */ + if \(r//2) then _=translate(_, '\', .) /*trans to backslash*/ + _=changestr(1 , _, 111) /*──────these four ────────────────────*/ + _=changestr(0 , _, 000) /*───────── statements are ────────────*/ + _=changestr(. , _, " ") /*────────────── used for preserving ──*/ + _=changestr('─', _, "───") /*────────────────── the aspect ratio. */ + say translate(_, '│', "|\10") /*make it presentable for the screen. */ end /*r*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -@: parse arg _r,_c; return @._r._c /*a fast way to reference a maze cell. */ -/*────────────────────────────────────────────────────────────────────────────*/ -?: do forever; ?.=0; ?=random(1,4); if ?==1 then ?.zc=-2 /*north*/ - if ?==2 then ?.zr= 2 /* east*/ - if ?==3 then ?.zc= 2 /*south*/ - if ?==4 then ?.zr=-2 /* west*/ - _r=r!+?.zr; _c=c!+?.zc; if @._r._c==1 then return - end /*forever*/ -/*────────────────────────────────────────────────────────────────────────────*/ -buildRow: parse arg z; height=height+1; width=length(z) - do c=1 for width; @.height.c=substr(z,c,1); end; return -/*────────────────────────────────────────────────────────────────────────────*/ -fCell: do r=1 for rows; rr=r+r - do c=1 for cols; cc=c+c - if hood(rr,cc)==1 then do; r!=rr; c!=cc; @.r!.c!=0; return 1; end - end /*c*/ - end /*r*/ /* [↑] r! & c! are used by invoker.*/ -return 0 -/*────────────────────────────────────────────────────────────────────────────*/ -hood: parse arg rh,ch; return @(rh+2,ch) + @(rh-2,ch) + @(rh,ch-2) + @(rh,ch+2) +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +@: parse arg _r,_c; return @._r._c /*a fast way to reference a maze cell. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +?: do forever; ?.=0; ?=random(1,4); if ?==1 then ?.zc=-2 /*north*/ + if ?==2 then ?.zr= 2 /* east*/ + if ?==3 then ?.zc= 2 /*south*/ + if ?==4 then ?.zr=-2 /* west*/ + _r=r!+?.zr; _c=c!+?.zc; if @._r._c==1 then return + end /*forever*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +buildRow: parse arg z; height=height+1; width=length(z) + do c=1 for width; @.height.c=substr(z,c,1); end; return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +fCell: do r=1 for rows; rr=r+r + do c=1 for cols; cc=c+c + if hood(rr,cc)==1 then do; r!=rr; c!=cc; @.r!.c!=0; return 1; end + end /*c*/ + end /*r*/ /* [↑] r! and c! are used by invoker.*/ + return 0 +/*──────────────────────────────────────────────────────────────────────────────────────*/ +hood: parse arg rh,ch; return @(rh+2,ch) + @(rh-2,ch) + @(rh,ch-2) + @(rh,ch+2) diff --git a/Task/Maze-generation/SuperCollider/maze-generation.supercollider b/Task/Maze-generation/SuperCollider/maze-generation.supercollider new file mode 100644 index 0000000000..ff87b490d6 --- /dev/null +++ b/Task/Maze-generation/SuperCollider/maze-generation.supercollider @@ -0,0 +1,56 @@ +// some useful functions +( +~grid = { 0 ! 60 } ! 60; + +~at = { |coord| + var col = ~grid.at(coord[0]); + if(col.notNil) { col.at(coord[1]) } +}; +~put = { |coord, value| + var col = ~grid.at(coord[0]); + if(col.notNil) { col.put(coord[1], value) } +}; + +~coord = ~grid.shape.rand; +~next = { |p| + var possible = [p] + [[0, 1], [1, 0], [-1, 0], [0, -1]]; + possible = possible.select { |x| + var c = ~at.(x); + c.notNil and: { c == 0 } + }; + possible.choose +}; +~walkN = { |p, scale| + var next = ~next.(p); + if(next.notNil) { + ~put.(next, 1); + Pen.lineTo(~topoint.(next, scale)); + ~walkN.(next, scale); + ~walkN.(next, scale); + Pen.moveTo(~topoint.(p, scale)); + }; +}; + +~topoint = { |c, scale| (c + [1, 1] * scale).asPoint }; + +) + +// do the drawing +( +var b, w; + +b = Rect(100, 100, 700, 700); +w = Window("so-a-mazing", b); +w.view.background_(Color.black); + +w.drawFunc = { + var p = ~grid.shape.rand; + var scale = b.width / ~grid.size * 0.98; + Pen.moveTo(~topoint.(p, scale)); + ~walkN.(p, scale); + Pen.width = scale / 4; + Pen.color = Color.white; + Pen.stroke; +}; +w.front.refresh; +) diff --git a/Task/Maze-generation/TXR/maze-generation-2.txr b/Task/Maze-generation/TXR/maze-generation-2.txr index 419a622c27..b9737e148a 100644 --- a/Task/Maze-generation/TXR/maze-generation-2.txr +++ b/Task/Maze-generation/TXR/maze-generation-2.txr @@ -1,94 +1,90 @@ -@(do - (defvar vi) ;; visited hash - (defvar pa) ;; path connectivity hash - (defvar sc) ;; count, derived from straightness fator +(defvar vi) ;; visited hash +(defvar pa) ;; path connectivity hash +(defvar sc) ;; count, derived from straightness fator - (defun scramble (list) - (let ((out ())) - (each ((item list)) - (let ((r (rand (+ 1 (length out))))) - (set [out r..r] (list item)))) - out)) +(defun scramble (list) + (let ((out ())) + (each ((item list)) + (let ((r (rand (+ 1 (length out))))) + (set [out r..r] (list item)))) + out)) - (defun rnd-pick (list) - (if list [list (rand (length list))])) +(defun rnd-pick (list) + (if list [list (rand (length list))])) - (defmacro while (expr . body) - ^(for () (,expr) () ,*body)) +(defun neigh (loc) + (let ((x (from loc)) + (y (to loc))) + (list (- x 1)..y (+ x 1)..y + x..(- y 1) x..(+ y 1)))) - (defun neigh (loc) - (let ((x (from loc)) - (y (to loc))) - (list (- x 1)..y (+ x 1)..y - x..(- y 1) x..(+ y 1)))) +(defun make-maze-impl (cu) + (let ((fr (hash :equal-based)) + (q (list cu)) + (c sc)) + (set [fr cu] t) + (while q + (let* ((cu (first q)) + (ne (rnd-pick (remove-if (orf vi fr) (neigh cu))))) + (cond (ne (set [fr ne] t) + (push ne [pa cu]) + (push cu [pa ne]) + (push ne q) + (cond ((<= (dec c) 0) + (set q (scramble q)) + (set c sc)))) + (t (set [vi cu] t) + (del [fr cu]) + (pop q))))))) - (defun make-maze-impl (cu) - (let ((fr (hash :equal-based)) - (q (list cu)) - (c sc)) - (set [fr cu] t) - (while q - (let* ((cu (first q)) - (ne (rnd-pick (remove-if (orf vi fr) (neigh cu))))) - (cond (ne (set [fr ne] t) - (push ne [pa cu]) - (push cu [pa ne]) - (push ne q) - (cond ((<= (dec c) 0) - (set q (scramble q)) - (set c sc)))) - (t (set [vi cu] t) - (del [fr cu]) - (pop q))))))) +(defun make-maze (w h sf) + (let ((vi (hash :equal-based)) + (pa (hash :equal-based)) + (sc (max 1 (trunc (* sf w h) 100)))) + (each ((x (range -1 w))) + (set [vi x..-1] t) + (set [vi x..h] t)) + (each ((y (range* 0 h))) + (set [vi -1..y] t) + (set [vi w..y] t)) + (make-maze-impl 0..0) + pa)) - (defun make-maze (w h sf) - (let ((vi (hash :equal-based)) - (pa (hash :equal-based)) - (sc (max 1 (trunc (* sf w h) 100)))) - (each ((x (range -1 w))) - (set [vi x..-1] t) - (set [vi x..h] t)) - (each ((y (range* 0 h))) - (set [vi -1..y] t) - (set [vi w..y] t)) - (make-maze-impl 0..0) - pa)) +(defun print-tops (pa w j) + (each ((i (range* 0 w))) + (if (memqual i..(- j 1) [pa i..j]) + (put-string "+ ") + (put-string "+----"))) + (put-line "+")) - (defun print-tops (pa w j) - (each ((i (range* 0 w))) - (if (memqual i..(- j 1) [pa i..j]) - (put-string "+ ") - (put-string "+----"))) - (put-line "+")) +(defun print-sides (pa w j) + (let ((str "")) + (each ((i (range* 0 w))) + (if (memqual (- i 1)..j [pa i..j]) + (set str `@str `) + (set str `@str| `))) + (put-line `@str|\n@str|`))) - (defun print-sides (pa w j) - (let ((str "")) - (each ((i (range* 0 w))) - (if (memqual (- i 1)..j [pa i..j]) - (set str `@str `) - (set str `@str| `))) - (put-line `@str|\n@str|`))) +(defun print-maze (pa w h) + (each ((j (range* 0 h))) + (print-tops pa w j) + (print-sides pa w j)) + (print-tops pa w h)) - (defun print-maze (pa w h) - (each ((j (range* 0 h))) - (print-tops pa w j) - (print-sides pa w j)) - (print-tops pa w h)) +(defun usage () + (let ((invocation (ldiff *full-args* *args*))) + (put-line "usage: ") + (put-line `@invocation []`) + (put-line "straightness-factor is a percentage, defaulting to 15") + (exit 1))) - (defun usage () - (let ((invocation (ldiff *full-args* *args*))) - (put-line "usage: ") - (put-line `@invocation []`) - (put-line "straightness-factor is a percentage, defaulting to 15") - (exit 1))) - - (let ((args [mapcar int-str *args*]) - (*random-state* (make-random-state nil))) - (if (memq nil args) - (usage)) - (tree-case args - ((w h s ju . nk) (usage)) - ((w h : (s 15)) (set w (max 1 w)) - (set h (max 1 h)) - (print-maze (make-maze w h s) w h)) - (else (usage))))) +(let ((args [mapcar int-str *args*]) + (*random-state* (make-random-state nil))) + (if (memq nil args) + (usage)) + (tree-case args + ((w h s ju . nk) (usage)) + ((w h : (s 15)) (set w (max 1 w)) + (set h (max 1 h)) + (print-maze (make-maze w h s) w h)) + (else (usage)))) diff --git a/Task/Maze-solving/Java/maze-solving.java b/Task/Maze-solving/Java/maze-solving-1.java similarity index 100% rename from Task/Maze-solving/Java/maze-solving.java rename to Task/Maze-solving/Java/maze-solving-1.java diff --git a/Task/Maze-solving/Java/maze-solving-2.java b/Task/Maze-solving/Java/maze-solving-2.java new file mode 100644 index 0000000000..657f3b49f2 --- /dev/null +++ b/Task/Maze-solving/Java/maze-solving-2.java @@ -0,0 +1,182 @@ +import java.awt.*; +import java.awt.event.*; +import java.awt.geom.Path2D; +import java.util.*; +import javax.swing.*; + +public class MazeGenerator extends JPanel { + enum Dir { + N(1, 0, -1), S(2, 0, 1), E(4, 1, 0), W(8, -1, 0); + final int bit; + final int dx; + final int dy; + Dir opposite; + + // use the static initializer to resolve forward references + static { + N.opposite = S; + S.opposite = N; + E.opposite = W; + W.opposite = E; + } + + Dir(int bit, int dx, int dy) { + this.bit = bit; + this.dx = dx; + this.dy = dy; + } + }; + final int nCols; + final int nRows; + final int cellSize = 25; + final int margin = 25; + final int[][] maze; + LinkedList solution; + + public MazeGenerator(int size) { + setPreferredSize(new Dimension(650, 650)); + setBackground(Color.white); + nCols = size; + nRows = size; + maze = new int[nRows][nCols]; + solution = new LinkedList<>(); + generateMaze(0, 0); + + addMouseListener(new MouseAdapter() { + @Override + public void mousePressed(MouseEvent e) { + new Thread(() -> { + solve(0); + }).start(); + } + }); + } + + @Override + public void paintComponent(Graphics gg) { + super.paintComponent(gg); + Graphics2D g = (Graphics2D) gg; + g.setRenderingHint(RenderingHints.KEY_ANTIALIASING, + RenderingHints.VALUE_ANTIALIAS_ON); + + g.setStroke(new BasicStroke(5)); + g.setColor(Color.black); + + // draw maze + for (int r = 0; r < nRows; r++) { + for (int c = 0; c < nCols; c++) { + + int x = margin + c * cellSize; + int y = margin + r * cellSize; + + if ((maze[r][c] & 1) == 0) // N + g.drawLine(x, y, x + cellSize, y); + + if ((maze[r][c] & 2) == 0) // S + g.drawLine(x, y + cellSize, x + cellSize, y + cellSize); + + if ((maze[r][c] & 4) == 0) // E + g.drawLine(x + cellSize, y, x + cellSize, y + cellSize); + + if ((maze[r][c] & 8) == 0) // W + g.drawLine(x, y, x, y + cellSize); + } + } + + // draw pathfinding animation + int offset = margin + cellSize / 2; + + Path2D path = new Path2D.Float(); + path.moveTo(offset, offset); + + for (int pos : solution) { + int x = pos % nCols * cellSize + offset; + int y = pos / nCols * cellSize + offset; + path.lineTo(x, y); + } + + g.setColor(Color.orange); + g.draw(path); + + g.setColor(Color.blue); + g.fillOval(offset - 5, offset - 5, 10, 10); + + g.setColor(Color.green); + int x = offset + (nCols - 1) * cellSize; + int y = offset + (nRows - 1) * cellSize; + g.fillOval(x - 5, y - 5, 10, 10); + + } + + void generateMaze(int r, int c) { + Dir[] dirs = Dir.values(); + Collections.shuffle(Arrays.asList(dirs)); + for (Dir dir : dirs) { + int nc = c + dir.dx; + int nr = r + dir.dy; + if (withinBounds(nr, nc) && maze[nr][nc] == 0) { + maze[r][c] |= dir.bit; + maze[nr][nc] |= dir.opposite.bit; + generateMaze(nr, nc); + } + } + } + + boolean withinBounds(int r, int c) { + return c >= 0 && c < nCols && r >= 0 && r < nRows; + } + + boolean solve(int pos) { + if (pos == nCols * nRows - 1) + return true; + + int c = pos % nCols; + int r = pos / nCols; + + for (Dir dir : Dir.values()) { + int nc = c + dir.dx; + int nr = r + dir.dy; + if (withinBounds(nr, nc) && (maze[r][c] & dir.bit) != 0 + && (maze[nr][nc] & 16) == 0) { + + int newPos = nr * nCols + nc; + + solution.add(newPos); + maze[nr][nc] |= 16; + + animate(); + + if (solve(newPos)) + return true; + + animate(); + + solution.removeLast(); + maze[nr][nc] &= ~16; + } + } + + return false; + } + + void animate() { + try { + Thread.sleep(50L); + } catch (InterruptedException ignored) { + } + repaint(); + } + + public static void main(String[] args) { + SwingUtilities.invokeLater(() -> { + JFrame f = new JFrame(); + f.setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE); + f.setTitle("Maze Generator"); + f.setResizable(false); + f.add(new MazeGenerator(24), BorderLayout.CENTER); + f.pack(); + f.setLocationRelativeTo(null); + f.setVisible(true); + }); + } +} diff --git a/Task/Memory-allocation/00DESCRIPTION b/Task/Memory-allocation/00DESCRIPTION index 74de687f3f..65e9542636 100644 --- a/Task/Memory-allocation/00DESCRIPTION +++ b/Task/Memory-allocation/00DESCRIPTION @@ -1 +1,5 @@ -Show how to explicitly allocate and deallocate blocks of memory in your language. Show access to different types of memory (i.e., [[heap]], [[system stack|stack]], shared, foreign) if applicable. +;Task: +Show how to explicitly allocate and deallocate blocks of memory in your language. + +Show access to different types of memory (i.e., [[heap]], [[system stack|stack]], shared, foreign) if applicable. +

    diff --git a/Task/Memory-allocation/Fortran/memory-allocation.f b/Task/Memory-allocation/Fortran/memory-allocation.f index 35708507df..3a07b80b8d 100644 --- a/Task/Memory-allocation/Fortran/memory-allocation.f +++ b/Task/Memory-allocation/Fortran/memory-allocation.f @@ -1,15 +1,15 @@ program allocation_test + implicit none + real, dimension(:), allocatable :: vector + real, dimension(:, :), allocatable :: matrix + real, pointer :: ptr + integer, parameter :: n = 100 ! Size to allocate - implicit none - - real,dimension(:),allocatable :: vector - real,dimension(:,:),allocatable :: matrix - - integer,parameter :: n = 100 !size to allocate - - allocate(vector(n)) !allocate a vector - allocate(matrix(n,n)) !allocate a matrix - deallocate(vector) !deallocate a vector - deallocate(matrix) !deallocate a matrix + allocate(vector(n)) ! Allocate a vector + allocate(matrix(n, n)) ! Allocate a matrix + allocate(ptr) ! Allocate a pointer + deallocate(vector) ! Deallocate a vector + deallocate(matrix) ! Deallocate a matrix + deallocate(ptr) ! Deallocate a pointer end program allocation_test diff --git a/Task/Memory-layout-of-a-data-structure/00DESCRIPTION b/Task/Memory-layout-of-a-data-structure/00DESCRIPTION index d492c239b6..8d4c973d93 100644 --- a/Task/Memory-layout-of-a-data-structure/00DESCRIPTION +++ b/Task/Memory-layout-of-a-data-structure/00DESCRIPTION @@ -4,7 +4,7 @@ It is often useful to control the memory layout of fields in a data structure to (Reverse order for socket.) __________________________________________ 1 2 3 4 5 6 7 8 9 10 11 12 13 - 14 15 16 17 18 19 20 21 22 23 24 25 + 14 15 16 17 18 19 20 21 22 23 24 25 _________________ 1 2 3 4 5 6 7 8 9 diff --git a/Task/Memory-layout-of-a-data-structure/Fortran/memory-layout-of-a-data-structure.f b/Task/Memory-layout-of-a-data-structure/Fortran/memory-layout-of-a-data-structure.f new file mode 100644 index 0000000000..3ac3fba621 --- /dev/null +++ b/Task/Memory-layout-of-a-data-structure/Fortran/memory-layout-of-a-data-structure.f @@ -0,0 +1,11 @@ + TYPE RS232PIN9 + LOGICAL CARRIER_DETECT !1 + LOGICAL RECEIVED_DATA !2 + LOGICAL TRANSMITTED_DATA !3 + LOGICAL DATA_TERMINAL_READY !4 + LOGICAL SIGNAL_GROUND !5 + LOGICAL DATA_SET_READY !6 + LOGICAL REQUEST_TO_SEND !7 + LOGICAL CLEAR_TO_SEND !8 + LOGICAL RING_INDICATOR !9 + END TYPE RS232PIN9 diff --git a/Task/Memory-layout-of-a-data-structure/REXX/memory-layout-of-a-data-structure-2.rexx b/Task/Memory-layout-of-a-data-structure/REXX/memory-layout-of-a-data-structure-2.rexx index cf864871f2..03bd385bb0 100644 --- a/Task/Memory-layout-of-a-data-structure/REXX/memory-layout-of-a-data-structure-2.rexx +++ b/Task/Memory-layout-of-a-data-structure/REXX/memory-layout-of-a-data-structure-2.rexx @@ -1,42 +1,44 @@ -/*REXX pgm displays which pins are active of a 9 or 24 pin RS-232 plug. */ -call rs_232 24, 127 /*value for an RS-232 24 pin plug*/ -call rs_232 24, '020304x' /*value for an RS-232 24 pin plug*/ -call rs_232 9, '10100000b' /*value for an RS-232 9 pin plug*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────RS_232 subroutine───────────────────*/ -rs_232: arg pins,x; parse arg ,ox /*x is uppercased when using ARG.*/ -@. = '??? unassigned bit' /*assigned default for all bits. */ -@.24.1 = 'PG protective ground' -@.24.2 = 'TD transmitted data' ; @.9.3 = @.24.2 -@.24.3 = 'RD received data' ; @.9.2 = @.24.3 -@.24.4 = 'RTS request to send' ; @.9.7 = @.24.4 -@.24.5 = 'CTS clear to send' ; @.9.8 = @.24.5 -@.24.6 = 'DSR data set ready' ; @.9.6 = @.24.6 -@.24.7 = 'SG signal ground' ; @.9.5 = @.24.7 -@.24.8 = 'CD carrier detect' ; @.9.1 = @.24.8 -@.24.9 = '+ positive voltage' -@.24.10 = '- negative voltage' -@.24.12 = 'SCD secondary CD' -@.24.13 = 'SCS secondary CTS' -@.24.14 = 'STD secondary td' -@.24.15 = 'TC transmit clock' -@.24.16 = 'SRD secondary RD' -@.24.17 = 'RC receiver clock' -@.24.19 = 'SRS secondary RTS' -@.24.20 = 'DTR data terminal ready' ; @.9.4 = @.24.20 -@.24.21 = 'SQD signal quality detector' -@.24.22 = 'RI ring indicator' ; @.9.9 = @.24.22 -@.24.23 = 'DRS data rate select' -@.24.24 = 'XTC external clock' - select - when right(x,1)=='B' then bits= strip(x,'T',"B") - when right(x,1)=='X' then bits=x2b(strip(x,'T',"X")) - otherwise bits=x2b( d2x(x)) - end /*select*/ -bits=right(bits,pins,0) /*right justify the pin readings.*/ -say; say '───────── For a' pins "pin RS─232 plug, with a reading of: " ox -say - do j=1 for pins; z=substr(bits,j,1); if z==0 then iterate - say right(j,5) 'pin is "on": ' @.pins.j - end /*j*/ -return +/*REXX program displays which pins are active of a 9 or 24 pin RS-232 plug. */ +call rs_232 24, 127 /*the value for an RS-232 24 pin plug.*/ +call rs_232 24, '020304x' /* " " " " " " " " */ +call rs_232 9, '10100000b' /* " " " " " 9 " " */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +rs_232: arg ,x; parse arg pins,ox /*X is uppercased when using ARG. */ + @. = '??? unassigned pin' /*assign a default for all the pins. */ + @.24.1 = 'PG protective ground' + @.24.2 = 'TD transmitted data' ; @.9.3 = @.24.2 + @.24.3 = 'RD received data' ; @.9.2 = @.24.3 + @.24.4 = 'RTS request to send' ; @.9.7 = @.24.4 + @.24.5 = 'CTS clear to send' ; @.9.8 = @.24.5 + @.24.6 = 'DSR data set ready' ; @.9.6 = @.24.6 + @.24.7 = 'SG signal ground' ; @.9.5 = @.24.7 + @.24.8 = 'CD carrier detect' ; @.9.1 = @.24.8 + @.24.9 = '+ positive voltage' + @.24.10 = '- negative voltage' + @.24.12 = 'SCD secondary CD' + @.24.13 = 'SCS secondary CTS' + @.24.14 = 'STD secondary td' + @.24.15 = 'TC transmit clock' + @.24.16 = 'SRD secondary RD' + @.24.17 = 'RC receiver clock' + @.24.19 = 'SRS secondary RTS' + @.24.20 = 'DTR data terminal ready' ; @.9.4 = @.24.20 + @.24.21 = 'SQD signal quality detector' + @.24.22 = 'RI ring indicator' ; @.9.9 = @.24.22 + @.24.23 = 'DRS data rate select' + @.24.24 = 'XTC external clock' + + select + when right(x, 1)=='B' then bits= strip(x, 'T', "B") + when right(x, 1)=='X' then bits=x2b(strip(x, 'T', "X")) + otherwise bits=x2b( d2x(x) ) + end /*select*/ + say + bits=right(bits, pins, 0) /*right justify pin readings (values). */ + say '───────── For a' pins "pin RS─232 plug, with a reading of: " ox + say + do j=1 for pins; z=substr(bits, j, 1); if z==0 then iterate + say right(j, 5) 'pin is "on": ' @.pins.j + end /*j*/ + return diff --git a/Task/Menu/00DESCRIPTION b/Task/Menu/00DESCRIPTION index 57c6f6e097..c3bb84415d 100644 --- a/Task/Menu/00DESCRIPTION +++ b/Task/Menu/00DESCRIPTION @@ -1,11 +1,19 @@ +;Task: Given a prompt and a list containing a number of strings of which one is to be selected, create a function that: * prints a textual menu formatted as an index value followed by its corresponding string for each item in the list; * prompts the user to enter a number; * returns the string corresponding to the selected index number. +
    The function should reject input that is not an integer or is out of range by redisplaying the whole menu before asking again for a number. The function should return an empty string if called with an empty list. -For test purposes use the four phrases: “fee fie”, “huff and puff”, “mirror mirror” and “tick tock” in a list. +For test purposes use the following four phrases in a list: + fee fie + huff and puff + mirror mirror + tick tock -Note: This task is fashioned after the action of the [http://www.softpanorama.org/Scripting/Shellorama/Control_structures/select_statements.shtml Bash select statement]. +;Note: +This task is fashioned after the action of the [http://www.softpanorama.org/Scripting/Shellorama/Control_structures/select_statements.shtml Bash select statement]. +

    diff --git a/Task/Menu/C++/menu.cpp b/Task/Menu/C++/menu.cpp index 29a540e083..663763e945 100644 --- a/Task/Menu/C++/menu.cpp +++ b/Task/Menu/C++/menu.cpp @@ -1,50 +1,49 @@ #include -#include -#include #include -using namespace std; +#include -void printMenu(const string *, int); -//checks whether entered data is in required range -bool checkEntry(string, const string *, int); - -string dataEntry(string prompt, const string *terms, int size) { - if (size == 0) { //we return an empty string when we call the function with an empty list - return ""; - } - - string entry; - do { - printMenu(terms, size); - cout << prompt; - - cin >> entry; - } - while( !checkEntry(entry, terms, size) ); - - int number = atoi(entry.c_str()); - return terms[number - 1]; +void print_menu(const std::vector& terms) +{ + for (size_t i = 0; i < terms.size(); i++) { + std::cout << i + 1 << ") " << terms[i] << '\n'; + } } -void printMenu(const string *terms, int num) { - for (int i = 1 ; i < num + 1 ; i++) { - cout << i << ')' << terms[ i - 1 ] << '\n'; - } +int parse_entry(const std::string& entry, int max_number) +{ + int number = std::stoi(entry); + if (number < 1 || number > max_number) { + throw std::invalid_argument(""); + } + + return number; } -bool checkEntry(string myEntry, const string *terms, int num) { - boost::regex e("^\\d+$"); - if (!boost::regex_match(myEntry, e)) - return false; - int number = atoi(myEntry.c_str()); - if (number < 1 || number > num) - return false; - return true; +std::string data_entry(const std::string& prompt, const std::vector& terms) +{ + if (terms.empty()) { + return ""; + } + + int choice; + while (true) { + print_menu(terms); + std::cout << prompt; + + std::string entry; + std::cin >> entry; + + try { + choice = parse_entry(entry, terms.size()); + return terms[choice - 1]; + } catch (std::invalid_argument&) { + // std::cout << "Not a valid menu entry!" << std::endl; + } + } } -int main( ) { - const string terms[ ] = { "fee fie" , "huff and puff" , "mirror mirror" , "tick tock" }; - int size = sizeof terms / sizeof *terms; - cout << "You chose: " << dataEntry("Which is from the three pigs: ", terms, size); - return 0; +int main() +{ + std::vector terms = {"fee fie", "huff and puff", "mirror mirror", "tick tock"}; + std::cout << "You chose: " << data_entry("> ", terms) << std::endl; } diff --git a/Task/Menu/C-sharp/menu.cs b/Task/Menu/C-sharp/menu.cs index 191eec6ad5..d414920ca3 100644 --- a/Task/Menu/C-sharp/menu.cs +++ b/Task/Menu/C-sharp/menu.cs @@ -1,3 +1,8 @@ +using System; +using System.Collections.Generic; + +public class Menu +{ static void Main(string[] args) { List menu_items = new List() { "fee fie", "huff and puff", "mirror mirror", "tick tock" }; @@ -23,3 +28,4 @@ } while (!int.TryParse(input, out i) || i >= items.Count || i < 0); return items[i]; } +} diff --git a/Task/Menu/Elixir/menu.elixir b/Task/Menu/Elixir/menu.elixir new file mode 100644 index 0000000000..549a4dfd63 --- /dev/null +++ b/Task/Menu/Elixir/menu.elixir @@ -0,0 +1,21 @@ +defmodule Menu do + def select(_, []), do: "" + def select(prompt, items) do + IO.puts "" + Enum.with_index(items) |> Enum.each(fn {item,i} -> IO.puts " #{i}. #{item}" end) + answer = IO.gets("#{prompt}: ") |> String.strip + case Integer.parse(answer) do + {num, ""} when num in 0..length(items)-1 -> Enum.at(items, num) + _ -> select(prompt, items) + end + end +end + +# test empty list +response = Menu.select("Which is empty", []) +IO.puts "empty list returns: #{inspect response}" + +# "real" test +items = ["fee fie", "huff and puff", "mirror mirror", "tick tock"] +response = Menu.select("Which is from the three pigs", items) +IO.puts "you chose: #{inspect response}" diff --git a/Task/Menu/PowerShell/menu.psh b/Task/Menu/PowerShell/menu.psh new file mode 100644 index 0000000000..91ad206780 --- /dev/null +++ b/Task/Menu/PowerShell/menu.psh @@ -0,0 +1,73 @@ +function Select-TextItem +{ + <# + .SYNOPSIS + Prints a textual menu formatted as an index value followed by its corresponding string for each object in the list. + .DESCRIPTION + Prints a textual menu formatted as an index value followed by its corresponding string for each object in the list; + Prompts the user to enter a number; + Returns an object corresponding to the selected index number. + .PARAMETER InputObject + An array of objects. + .PARAMETER Prompt + The menu prompt string. + .EXAMPLE + “fee fie”, “huff and puff”, “mirror mirror”, “tick tock” | Select-TextItem + .EXAMPLE + “huff and puff”, “fee fie”, “tick tock”, “mirror mirror” | Sort-Object | Select-TextItem -Prompt "Select a string" + .EXAMPLE + Select-TextItem -InputObject (Get-Process) + .EXAMPLE + (Get-Process | Where-Object {$_.Name -match "notepad"}) | Select-TextItem -Prompt "Select a Process" | Stop-Process -ErrorAction SilentlyContinue + #> + [CmdletBinding()] + Param + ( + [Parameter(Mandatory=$true, + ValueFromPipeline=$true)] + $InputObject, + + [Parameter(Mandatory=$false)] + [string] + $Prompt = "Enter Selection" + ) + + Begin + { + $menuOptions = @() + } + Process + { + $menuOptions += $InputObject + } + End + { + do + { + [int]$optionNumber = 1 + + foreach ($option in $menuOptions) + { + Write-Host ("{0,3}: {1}" -f $optionNumber,$option) + + $optionNumber++ + } + + Write-Host ("{0,3}: {1}" -f 0,"To cancel") + + [int]$choice = Read-Host $Prompt + + $selectedValue = "" + + if ($choice -gt 0 -and $choice -le $menuOptions.Count) + { + $selectedValue = $menuOptions[$choice - 1] + } + } + until ($choice -eq 0 -or $choice -le $menuOptions.Count) + + return $selectedValue + } +} + +“fee fie”, “huff and puff”, “mirror mirror”, “tick tock” | Select-TextItem -Prompt "Select a string" diff --git a/Task/Menu/REXX/menu.rexx b/Task/Menu/REXX/menu.rexx index f3248a02e4..b68bf4a009 100644 --- a/Task/Menu/REXX/menu.rexx +++ b/Task/Menu/REXX/menu.rexx @@ -1,38 +1,37 @@ -/*REXX program shows a list, asks user for a selection number (integer).*/ +/*REXX program displays a list, then prompts the user for a selection number (integer).*/ + do forever /*keep prompting until response is OK. */ + call list_create /*create the list from scratch. */ + call list_show /*display (show) the list to the user.*/ + if #==0 then return '' /*if list is empty, then return null.*/ + say right(' choose an item by entering a number from 1 ───►' #, 70, '═') + parse pull x /*get the user's choice (if any). */ - do forever /*keep asking until response OK. */ - call list_create /*create the list from scratch. */ - call list_show /*display (show) the list to user*/ - if #==0 then return '' /*if empty list, then return null*/ - say right(' choose an item by entering a number from 1 ───►' #, 70, '═') - parse pull x /*get the user's choice (if any).*/ - - select - when x='' then call sayErr "a choice wasn't entered" - when words(x)\==1 then call sayErr 'too many choices entered:' - when \datatype(x,'N') then call sayErr "the choice isn't numeric:" - when \datatype(x,'W') then call sayErr "the choice isn't an integer:" - when x<1 | x># then call sayErr "the choice isn't within range:" - otherwise leave /*this leaves the DO FOREVER loop*/ - end /*select*/ - end /*forever*/ - /*user might've entered 2. or 003*/ -x=x/1 /*normalize the number (maybe). */ + select + when x='' then call sayErr "a choice wasn't entered" + when words(x)\==1 then call sayErr 'too many choices entered:' + when \datatype(x,'N') then call sayErr "the choice isn't numeric:" + when \datatype(x,'W') then call sayErr "the choice isn't an integer:" + when x<1 | x># then call sayErr "the choice isn't within range:" + otherwise leave /*this leaves the DO FOREVER loop.*/ + end /*select*/ + end /*forever*/ + /*user might've entered 2. or 003 */ +x=x/1 /*normalize the number (maybe). */ say; say 'you chose item' x": " #.x -return #.x /*stick a fork in it, we're done.*/ -/*──────────────────────────────────LIST_CREATE─────────────────────────*/ -list_create: #.1='fee fie' /*one method for list-building. */ - #.2='huff and puff' - #.3='mirror mirror' - #.4='tick tock' -#=4 /*store number of choices in #. */ -return /*(above) is just one convention.*/ -/*──────────────────────────────────LIST_SHOW───────────────────────────*/ -list_show: say /*display a blank line. */ - do j=1 for # /*display the list of choices. */ - say '[item' j"] " #.j /*display item # with its choice.*/ - end /*j*/ -say /*display another blank line. */ -return -/*──────────────────────────────────SAYERR──────────────────────────────*/ -sayErr: say; say '***error!***' arg(1) x; say; return +return #.x /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +list_create: #.1= 'fee fie' /*this is one method for list-building.*/ + #.2= 'huff and puff' + #.3= 'mirror mirror' + #.4= 'tick tock' + #=4 /*store the number of choices in # */ + return /*(above) is just one convention. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +list_show: say /*display a blank line. */ + do j=1 for # /*display the list of choices. */ + say '[item' j"] " #.j /*display item number with its choice. */ + end /*j*/ + say /*display another blank line. */ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sayErr: say; say '***error***' arg(1) x; say; return diff --git a/Task/Metaprogramming/ALGOL-68/metaprogramming.alg b/Task/Metaprogramming/ALGOL-68/metaprogramming.alg index 915306eaf2..a2dc39d932 100644 --- a/Task/Metaprogramming/ALGOL-68/metaprogramming.alg +++ b/Task/Metaprogramming/ALGOL-68/metaprogramming.alg @@ -78,7 +78,7 @@ OP WITH = ( INSPECTTOREPLACE inspected, STRING replace with )REF STRING: FI DO result +:= replace with; - rest := rest[ UPB to replace : ] + rest := rest[ 1 + UPB to replace : ] OD ELIF option OF inspected = replace first diff --git a/Task/Metaprogramming/Rust/metaprogramming.rust b/Task/Metaprogramming/Rust/metaprogramming.rust new file mode 100644 index 0000000000..be6335fdac --- /dev/null +++ b/Task/Metaprogramming/Rust/metaprogramming.rust @@ -0,0 +1,58 @@ +// dry.rs +use std::ops::{Add, Mul, Sub}; + +macro_rules! assert_equal_len { + // The `tt` (token tree) designator is used for + // operators and tokens. + ($a:ident, $b: ident, $func:ident, $op:tt) => ( + assert!($a.len() == $b.len(), + "{:?}: dimension mismatch: {:?} {:?} {:?}", + stringify!($func), + ($a.len(),), + stringify!($op), + ($b.len(),)); + ) +} + +macro_rules! op { + ($func:ident, $bound:ident, $op:tt, $method:ident) => ( + fn $func + Copy>(xs: &mut Vec, ys: &Vec) { + assert_equal_len!(xs, ys, $func, $op); + + for (x, y) in xs.iter_mut().zip(ys.iter()) { + *x = $bound::$method(*x, *y); + // *x = x.$method(*y); + } + } + ) +} + +// Implement `add_assign`, `mul_assign`, and `sub_assign` functions. +op!(add_assign, Add, +=, add); +op!(mul_assign, Mul, *=, mul); +op!(sub_assign, Sub, -=, sub); + +mod test { + use std::iter; + macro_rules! test { + ($func: ident, $x:expr, $y:expr, $z:expr) => { + #[test] + fn $func() { + for size in 0usize..10 { + let mut x: Vec<_> = iter::repeat($x).take(size).collect(); + let y: Vec<_> = iter::repeat($y).take(size).collect(); + let z: Vec<_> = iter::repeat($z).take(size).collect(); + + super::$func(&mut x, &y); + + assert_eq!(x, z); + } + } + } + } + + // Test `add_assign`, `mul_assign` and `sub_assign` + test!(add_assign, 1u32, 2u32, 3u32); + test!(mul_assign, 2u32, 3u32, 6u32); + test!(sub_assign, 3u32, 2u32, 1u32); +} diff --git a/Task/Metaprogramming/TXR/metaprogramming.txr b/Task/Metaprogramming/TXR/metaprogramming.txr index be385c6f73..6b76d8147e 100644 --- a/Task/Metaprogramming/TXR/metaprogramming.txr +++ b/Task/Metaprogramming/TXR/metaprogramming.txr @@ -1,27 +1,26 @@ -@(do - (defmacro while ((condition : result) . body) - (let ((cblk (gensym "cnt-blk-")) - (bblk (gensym "brk-blk-"))) - ^(macrolet ((break (value) ^(return-from ,',bblk ,value))) - (symacrolet ((break (return-from ,bblk)) - (continue (return-from ,cblk))) - (block ,bblk - (for () (,condition ,result) () - (block ,cblk ,*body))))))) +(defmacro whil ((condition : result) . body) + (let ((cblk (gensym "cnt-blk-")) + (bblk (gensym "brk-blk-"))) + ^(macrolet ((break (value) ^(return-from ,',bblk ,value))) + (symacrolet ((break (return-from ,bblk)) + (continue (return-from ,cblk))) + (block ,bblk + (for () (,condition ,result) () + (block ,cblk ,*body))))))) - (let ((i 0)) - (while ((< i 100)) +(let ((i 0)) + (whil ((< i 100)) + (if (< (inc i) 20) + continue) + (if (> i 30) + break) + (prinl i))) + +(prinl + (sys:expand + '(whil ((< i 100)) (if (< (inc i) 20) continue) (if (> i 30) break) - (prinl i))) - - (prinl - (sys:expand - '(while ((< i 100)) - (if (< (inc i) 20) - continue) - (if (> i 30) - break) - (prinl i))))) + (prinl i)))) diff --git a/Task/Metered-concurrency/Go/metered-concurrency-1.go b/Task/Metered-concurrency/Go/metered-concurrency-1.go index eefbef919c..3f5d2eecff 100644 --- a/Task/Metered-concurrency/Go/metered-concurrency-1.go +++ b/Task/Metered-concurrency/Go/metered-concurrency-1.go @@ -7,6 +7,13 @@ import ( "time" ) +// counting semaphore implemented with a buffered channel +type sem chan struct{} + +func (s sem) acquire() { s <- struct{}{} } +func (s sem) release() { <-s } +func (s sem) count() int { return cap(s) - len(s) } + // log package serializes output var fmt = log.New(os.Stdout, "", 0) @@ -15,11 +22,7 @@ const nRooms = 10 const nStudents = 20 func main() { - // buffered channel used as a counting semaphore - rooms := make(chan int, nRooms) - for i := 0; i < nRooms; i++ { - rooms <- 1 - } + rooms := make(sem, nRooms) // WaitGroup used to wait for all students to have studied // before terminating program var studied sync.WaitGroup @@ -31,12 +34,12 @@ func main() { studied.Wait() } -func student(rooms chan int, studied *sync.WaitGroup) { - <-rooms // acquire operation +func student(rooms sem, studied *sync.WaitGroup) { + rooms.acquire() // report per task descrption. also exercise count operation fmt.Printf("Room entered. Count is %d. Studying...\n", - len(rooms)) // len function provides count operation + rooms.count()) time.Sleep(2 * time.Second) // sleep per task description - rooms <- 1 // release operation - studied.Done() // signal that student is done + rooms.release() + studied.Done() // signal that student is done } diff --git a/Task/Metered-concurrency/Go/metered-concurrency-2.go b/Task/Metered-concurrency/Go/metered-concurrency-2.go index 3eea970448..4642e5cd48 100644 --- a/Task/Metered-concurrency/Go/metered-concurrency-2.go +++ b/Task/Metered-concurrency/Go/metered-concurrency-2.go @@ -4,40 +4,41 @@ import ( "log" "os" "sync" - "sync/atomic" "time" ) var fmt = log.New(os.Stdout, "", 0) type countSem struct { - c int32 - cond *sync.Cond + int + sync.Cond } func newCount(n int) *countSem { - return &countSem{int32(n), sync.NewCond(new(sync.Mutex))} + return &countSem{n, sync.Cond{L: &sync.Mutex{}}} } func (cs *countSem) count() int { - return int(atomic.LoadInt32(&cs.c)) + cs.L.Lock() + c := cs.int + cs.L.Unlock() + return c } func (cs *countSem) acquire() { - if atomic.AddInt32(&cs.c, -1) < 0 { - atomic.AddInt32(&cs.c, 1) - cs.cond.L.Lock() - for atomic.AddInt32(&cs.c, -1) < 0 { - atomic.AddInt32(&cs.c, 1) - cs.cond.Wait() - } - cs.cond.L.Unlock() + cs.L.Lock() + cs.int-- + for cs.int < 0 { + cs.Wait() } + cs.L.Unlock() } func (cs *countSem) release() { - atomic.AddInt32(&cs.c, 1) - cs.cond.Signal() + cs.L.Lock() + cs.int++ + cs.L.Unlock() + cs.Broadcast() } func main() { diff --git a/Task/Metronome/00DESCRIPTION b/Task/Metronome/00DESCRIPTION index 0ee444e117..21b5b89526 100644 --- a/Task/Metronome/00DESCRIPTION +++ b/Task/Metronome/00DESCRIPTION @@ -1,6 +1,15 @@ -The task is to implement a metronome. The metronome should be capable of producing high and low audio beats, accompanied by a visual beat indicator, and the beat pattern and tempo should be configurable. +[[File:Metronome.jpg|420px||right]] -For the purpose of this task, it is acceptable to play sound files for production of the beat notes, and an external player may be used. However, the playing of the sounds should not interfere with the timing of the metronome. +The task is to implement a   [https://en.wikipedia.org/wiki/Metronomemetronome metronome]. -The visual indicator can simply be a blinking red or green area of the screen (depending on whether a high or low beat is being produced), and the metronome can be implemented using a terminal display, or optionally, a graphical display, depending on the language capabilities. If the language has no facility to output sound, then it is permissible for this to implemented using just the visual indicator. +The metronome should be capable of producing high and low audio beats, accompanied by a visual beat indicator, and the beat pattern and tempo should be configurable. + +For the purpose of this task, it is acceptable to play sound files for production of the beat notes, and an external player may be used. + +However, the playing of the sounds should not interfere with the timing of the metronome. + +The visual indicator can simply be a blinking red or green area of the screen (depending on whether a high or low beat is being produced), and the metronome can be implemented using a terminal display, or optionally, a graphical display, depending on the language capabilities. + +If the language has no facility to output sound, then it is permissible for this to implemented using just the visual indicator. +

    diff --git a/Task/Metronome/J/metronome.j b/Task/Metronome/J/metronome.j new file mode 100644 index 0000000000..64667e76f3 --- /dev/null +++ b/Task/Metronome/J/metronome.j @@ -0,0 +1,40 @@ +MET=: _ _&$: :(4 : 0) + + 'BEL BS LF CR'=. 7 8 10 13 { a. + '`print stime delay'=. 1!:2&4`(6!:1)`(6!:3) + ticker=. 2 2$'\ /' + 'small large'=. (BEL,2#BS) ; 5#BS + clrln=. CR,(79#' '),CR + + x=. 2 ({.,) x + y=. _1 |.&.> 2 ({.,) y + 'i j'=. 0 + print 'bpb \ bpm \ ' , 2#BS + delay 1 + + x=. ({. , ('ti t'=. stime'') + {:) x + while. x *./@:> i,t do. + + 'bpb bpm'=. {.@> y=. 1 |.&.> y + dl=. 60 % bpm + + print clrln,(":bpb),' ',(ticker {~ 2 | i=. >: i),' ',(":bpm),' ' + + for. i. bpb do. + print small ,~ ticker {~ 2 | j=. >: j + delay 0 >. (t=. t + dl) - stime '' + end. + + end. + + print clrln + i , j , t - ti + +) + + +NB. Basic tacit version; this is probably considered bad coding style. At least I removed the "magic constants". Sort of. +NB. The above version is by far superior. +'BEL BS LF'=: 7 8 10 { a. +'`print delay'=: 1!:2&4`(6!:3) +met=: _&$: :((] ({:@] [ LF print@[ (-.@{.@] [ delay@[ print@] (BEL,2#BS) , (2 2$'\ /') {~ {.@])^:({:@])) 1 , <.@%) 60&% [ print@('\ '"_)) diff --git a/Task/Metronome/Java/metronome.java b/Task/Metronome/Java/metronome.java new file mode 100644 index 0000000000..c92376c2ce --- /dev/null +++ b/Task/Metronome/Java/metronome.java @@ -0,0 +1,29 @@ +class Metronome{ + double bpm; + int measure, counter; + public Metronome(double bpm, int measure){ + this.bpm = bpm; + this.measure = measure; + } + public void start(){ + while(true){ + try { + Thread.sleep((long)(1000*(60/bpm))); + }catch(InterruptedException e) { + e.printStackTrace(); + } + counter++; + if (counter%measure==0){ + System.out.println("TICK"); + }else{ + System.out.println("TOCK"); + } + } + } +} +public class test { + public static void main(String[] args) { + Metronome metronome1 = new Metronome(120,4); + metronome1.start(); + } +} diff --git a/Task/Metronome/PureBasic/metronome.purebasic b/Task/Metronome/PureBasic/metronome.purebasic index af415958f6..6f48d6f151 100644 --- a/Task/Metronome/PureBasic/metronome.purebasic +++ b/Task/Metronome/PureBasic/metronome.purebasic @@ -1,390 +1,320 @@ Structure METRONOMEs -string_mil.i -string_err.i -string_bmp.i -volumn.i -image_metronome.i + msPerBeat.i + BeatsPerMinute.i + BeatsPerCycle.i + volume.i + canvasGadget.i + w.i + h.i + originX.i + originY.i + radius.i + activityStatus.i EndStructure -Enumeration -#STRING_MIL -#STRING_ERR -#STRING_BMP -#BUTTON_ERRM -#BUTTON_ERRP -#BUTTON_VOLM -#BUTTON_VOLP -#TEXT_TUNE -#TEXT_MIL -#TEXT_BMP -#BUTTON_START -#BUTTON_STOP -#WINDOW -#IMAGE_METRONOME +Enumeration ;gadgets + #TEXT_MSPB ;milliseconds per beat + #STRING_MSPB ;milliseconds per beat + #TEXT_BPM ;beats per minute + #STRING_BPM ;beats per minute + #TEXT_BPC ;beats per cycle + #STRING_BPC ;beats per cycle + #BUTTON_VOLM ;volume - + #BUTTON_VOLP ;volume + + #BUTTON_START ;start + #SPIN_BPM + #CANVAS_METRONOME EndEnumeration +Enumeration ;sounds + #SOUND_LOW + #SOUND_HIGH +EndEnumeration -If Not InitSound() -MessageRequester("Error", "Sound system is not available", 0) -End -EndIf +#WINDOW = 0 ;window -; the wav file saved as raw data -; sClick: [?sClick < address of label sClick:] -; Data.a $52,$49,$46,... [?eClick-?sClick the # of bytes] -; eClick: [?eClick < address of label eClick:] -If Not CatchSound(0,?sClick,?eClick-?sClick) -MessageRequester("Error", "Could not CatchSound", 0) -End -EndIf - -If LoadFont(0,"tahoma",9,#PB_Font_HighQuality|#PB_Font_Bold) -SetGadgetFont(#PB_Default, FontID(0)) -EndIf - -Procedure.i Metronome(*m.METRONOMEs) -Protected j -Protected iw =360 -Protected ih =360 -Protected radius =100 -Protected originX =iw/2 -Protected originY =ih/2 -Protected BeatsPerMinute=*m\string_bmp.i -Protected msError.i =*m\string_err.i -Protected Milliseconds =int((60*1000)/BeatsPerMinute) -Protected msDword.i =Milliseconds*2/12 - -If CreateImage(*m\image_metronome.i,iw,ih) - -Repeat - -; [sAngleA: < prepare to read starting at address of label] -Restore sAngleA - -st1=ElapsedMilliseconds() -; 1 | 90 - ; 2 6 | 75 75 - ; 3 5 | 60 60 - ; 4 | 45 -; 90, 75, 60, 45, 60, 75 ; click -For j=1 to 6 -st2=ElapsedMilliseconds() -Read.f Angle.f -If StartDrawing(ImageOutput(*m\image_metronome.i)) - StartTime = ElapsedMilliseconds() - Box(0,0,iw,ih,RGB(0,0,0)) - CircleX=int(radius*cos(Radian(Angle))) - CircleY=int(radius*sin(Radian(Angle))) - LineXY(originX,originY, originX+CircleX,originY-CircleY,RGB(255,255,0)) - Circle(originX+CircleX,originY-CircleY,10,RGB(255,0,0)) - StopDrawing() ; don't forget to: StopDrawing() ! - SetGadgetState(*m\image_metronome.i,ImageID(*m\image_metronome.i)) - Endif -Delay(msDword-msError) -Next -While ElapsedMilliseconds()-st1= 0 + Delay(frameEndTime - ElapsedMilliseconds() - delayError) ;wait the remainder of frame + ElseIf delayTime < 0 + delayError = - delayTime + EndIf + frameEndTime + msPerFrame + Next + + ;check for thread exit + If *m\activityStatus < 0 + *m\activityStatus = 0 + ProcedureReturn + EndIf + + While (ElapsedMilliseconds() - startTime) < milliseconds: Wend + + SetGadgetText(*m\msPerBeat, Str(ElapsedMilliseconds() - startTime)) + cycleCount + 1: cycleCount % *m\BeatsPerCycle + If cycleCount = 0 + PlaySound(#SOUND_HIGH) + Else + PlaySound(#SOUND_LOW) + EndIf + startTime + milliseconds + Next + ForEver +EndProcedure + +Procedure startMetronome(*m.METRONOMEs, MetronomeThread) ;start up the thread with new values + *m\BeatsPerMinute = Val(GetGadgetText(#STRING_BPM)) + *m\BeatsPerCycle = Val(GetGadgetText(#STRING_BPC)) + *m\activityStatus = 1 + + If *m\BeatsPerMinute + MetronomeThread = CreateThread(@Metronome(), *m) + EndIf + ProcedureReturn MetronomeThread +EndProcedure + +Procedure stopMetronome(*m.METRONOMEs, MetronomeThread) ;if the thread is running: stop it + If IsThread(MetronomeThread) + *m\activityStatus = -1 ;signal thread to stop + EndIf + drawMetronome(*m, 90) +EndProcedure + + +Define w = 360, h = 360, ourMetronome.METRONOMEs + +;initialize the metronome +With ourMetronome + \msPerBeat = #STRING_MSPB + \canvasGadget = #CANVAS_METRONOME + \volume = 10 + \w = w + \h = h + \originX = w / 2 + \originY = h / 2 + \radius = 100 +EndWith + +ourMetronome\canvasGadget = #CANVAS_METRONOME + +;initialize sounds +handleError(InitSound(), "Sound system is Not available") +handleError(CatchSound(#SOUND_LOW, ?sClick, ?eClick - ?sClick), "Could Not CatchSound") +handleError(CatchSound(#SOUND_HIGH, ?sClick, ?eClick - ?sClick), "Could Not CatchSound") +SetSoundFrequency(#SOUND_HIGH, 50000) +SoundVolume(#SOUND_LOW, ourMetronome\volume) +SoundVolume(#SOUND_HIGH, ourMetronome\volume) + +;setup window & GUI +Define Style, i, wp, gh + +Style = #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget +handleError(OpenWindow(#WINDOW, 0, 0, w + 200 + 12, h + 4, "Metronome", Style), "Not OpenWindow") +SetWindowColor(#WINDOW, $505050) + +If LoadFont(0, "tahoma", 9, #PB_Font_HighQuality | #PB_Font_Bold) + SetGadgetFont(#PB_Default, FontID(0)) EndIf -SetWindowColor(#Window,$505050) -TEXT_STYLE=#PB_Text_Center|#PB_Text_Border +i = 3: wp = 10: gh = 22 +TextGadget(#TEXT_MSPB, w + wp, gh * i, 100, gh, "MilliSecs/Beat ", #PB_Text_Center) +StringGadget(#STRING_MSPB, w + wp + 108, gh * i, 90, gh, "0", #PB_String_ReadOnly): i + 2 +TextGadget(#TEXT_BPM, w + wp, gh * i, 100, gh,"Beats/Min ", #PB_Text_Center) +StringGadget(#STRING_BPM, w + wp + 108, gh * i, 90, gh, "120", #PB_String_Numeric): i + 2 +GadgetToolTip(#STRING_BPM, "Valid range is 20 -> 240") +TextGadget(#TEXT_BPC, w + wp, gh * i, 100, gh,"Beats/Cycle ", #PB_Text_Center) +StringGadget(#STRING_BPC, w + wp + 108, gh * i, 90, gh, "4", #PB_String_Numeric): i + 2 +GadgetToolTip(#STRING_BPC, "Valid range is 1 -> BPM") +ButtonGadget(#BUTTON_START, w + wp, gh * i, 200, gh, "Start", #PB_Button_Toggle): i + 2 +ButtonGadget(#BUTTON_VOLM, w + wp, gh * i, 100, gh, "-Volume") +ButtonGadget(#BUTTON_VOLP, w + wp + 100, gh * i, 100, gh, "+Volume") +CanvasGadget(ourMetronome\canvasGadget, 0, 0, ourMetronome\w, ourMetronome\h, #PB_Image_Border) +drawMetronome(ourMetronome, 90) -; data strings -i=2:wp=18:gh=24 -i+1:TextGadget(#TEXT_TUNE ,w+wp-10 ,gh*(i-1),200,gh,"Fine tuning",TEXT_STYLE) -i+1 -i+1:StringGadget(#STRING_ERR,w+wp+100,gh*(i-1),90,gh,"-5",#PB_String_ReadOnly) -i+1 -i+1:StringGadget(#STRING_MIL,w+wp+100,gh*(i-1),90,gh,"0",#PB_String_ReadOnly) -i+1 -i+1:StringGadget(#STRING_BMP,w+wp+100,gh*(i-1),90,gh,"120",#PB_String_Numeric) +Define msg, GID, MetronomeThread, Value +Repeat ;the control loop for our application + msg = WaitWindowEvent(1) + GID = EventGadget() + etp = EventType() -; control buttons -i=2:wp=10:gh=24 -i+1 -i+1 -i+1:ButtonGadget(#BUTTON_ERRM ,w+wp,gh*(i-1),50,gh,"-") -i+0:ButtonGadget(#BUTTON_ERRP ,w+wp+50,gh*(i-1),50,gh,"+") -i+1 -i+1:TextGadget(#TEXT_MIL ,w+wp,gh*(i-1),100,gh,"MilliSeconds ",TEXT_STYLE) -i+1 -i+1:TextGadget(#TEXT_BMP ,w+wp,gh*(i-1),100,gh,"BeatsPerMin " ,TEXT_STYLE) -i+1 -i+1:ButtonGadget(#BUTTON_START,w+wp,gh*(i-1),200,gh,"Start",#PB_Button_Toggle) -i+1 -i+1:ButtonGadget(#BUTTON_VOLM ,w+wp ,gh*(i-1),100,gh,"-Volumn") -i+0:ButtonGadget(#BUTTON_VOLP ,w+wp+100,gh*(i-1),100,gh,"+Volumn") + If GetAsyncKeyState_(#VK_ESCAPE): End: EndIf ;remove when app is o.k. -; the metronome image -IMG_STYLE=#PB_Image_Border -ImageGadget(#IMAGE_METRONOME,0,0,360,360,ImageID(#IMAGE_METRONOME),IMG_STYLE) -SetGadgetState(#IMAGE_METRONOME,ImageID(#IMAGE_METRONOME)) + Select msg -Repeat + Case #PB_Event_CloseWindow + End -; the control loop for our application [not all the values are used -; but this makes it easy to add further controls and functionality] -msg= WaitWindowEvent () -wid= EventWindow () -mid= EventMenu () -gid= EventGadget () -etp= EventType () -ewp= EventwParam () -elp= EventlParam () :If msg=#PB_Event_CloseWindow : End : EndIf + Case #PB_Event_Gadget + Select GID -; Esc kills application regardless of window focus -If GetAsyncKeyState_(#VK_ESCAPE) : End : EndIf + Case #STRING_BPM + If etp = #PB_EventType_LostFocus + Value = Val(GetGadgetText(#STRING_BPM)) + If Value > 390 + Value = 390 + ElseIf Value < 20 + Value = 20 + EndIf + SetGadgetText(#STRING_BPM, Str(Value)) + EndIf -Select msg + Case #STRING_BPC + If etp = #PB_EventType_LostFocus + Value = Val(GetGadgetText(#STRING_BPC)) + If Value > Val(GetGadgetText(#STRING_BPM)) + Value = Val(GetGadgetText(#STRING_BPM)) + ElseIf Value < 1 + Value = 1 + EndIf + SetGadgetText(#STRING_BPC, Str(Value)) + EndIf -case #PB_Event_Gadget + Case #BUTTON_VOLP, #BUTTON_VOLM ;change volume + If GID = #BUTTON_VOLP And ourMetronome\volume < 100 + ourMetronome\volume + 10 + ElseIf GID = #BUTTON_VOLM And ourMetronome\volume > 0 + ourMetronome\volume - 10 + EndIf + SoundVolume(#SOUND_LOW, ourMetronome\volume) + SoundVolume(#SOUND_HIGH, ourMetronome\volume) -Select gid + Case #BUTTON_START ;the toggle button for start/stop + Select GetGadgetState(#BUTTON_START) + Case 1 + stopMetronome(ourMetronome, MetronomeThread) + MetronomeThread = startMetronome(ourMetronome, MetronomeThread) + SetGadgetText(#BUTTON_START,"Stop") + Case 0 + stopMetronome(ourMetronome, MetronomeThread) + SetGadgetText(#BUTTON_START,"Start") + EndSelect - Case #BUTTON_VOLP ; +volumn - If *m\volumn.i<100:*m\volumn.i+10 - SoundVolume(0,*m\volumn.i) - EndIf - -Case #BUTTON_VOLM ; -volumn - If *m\volumn.i>0 :*m\volumn.i-10 - SoundVolume(0,*m\volumn.i) - EndIf - -Case #BUTTON_ERRP ; time accuracy adjustment [faster] - DelayVal-1 - *m\string_err.i =DelayVal - SetGadgetText(#STRING_ERR,str(0-DelayVal)) - If GetGadgetState(#BUTTON_START)=1 - GoSub Stop - GoSub Start - EndIf - -Case #BUTTON_ERRM ; time accuracy adjustment [slower] - DelayVal+1 - *m\string_err.i =DelayVal - SetGadgetText(#STRING_ERR,str(0-DelayVal)) - If GetGadgetState(#BUTTON_START)=1 - GoSub Stop - GoSub Start - EndIf - -Case #BUTTON_START ; the toggle button for start/stop - Select GetGadgetState(#BUTTON_START) - Case 1 :GoSub Stop : GoSub Start :SetGadgetText(#BUTTON_START,"Stop") - Case 0 :GoSub Stop :SetGadgetText(#BUTTON_START,"Start") + EndSelect EndSelect - -EndSelect -EndSelect ForEver End -Start: ; start up the thread with new values -*m\string_err.i =DelayVal -*m\string_bmp.i =Val(GetGadgetText(#STRING_BMP)) - -If *m\string_bmp.i - MetronomeThread=CreateThread(@Metronome(),*m) - EndIf -Return - -Stop: ; if the thread is running: stop it -If IsThread(MetronomeThread) - KillThread(MetronomeThread) - EndIf -Return - -DataSection ; an array of angles to be read by: MetronomeThread -sAngleA: -Data.f 90, 75, 60, 45, 60, 75 ; click -Data.f 90,105,120,135,120,105 ; click -eAngleA: -EndDataSection - -DataSection ; a small wav file saved as raw data -sClick: -Data.a $52,$49,$46,$46,$2E,$08,$00,$00,$57,$41,$56,$45,$66,$6D,$74,$20 -Data.a $10,$00,$00,$00,$01,$00,$01,$00,$44,$AC,$00,$00,$44,$AC,$00,$00 -Data.a $01,$00,$08,$00,$64,$61,$74,$61,$02,$06,$00,$00,$83,$84,$84,$84 -Data.a $85,$85,$86,$86,$88,$89,$8A,$8B,$8E,$91,$95,$9C,$A2,$A9,$B3,$C0 -Data.a $CF,$CF,$D0,$CE,$D3,$9B,$47,$31,$31,$33,$32,$32,$32,$32,$33,$32 -Data.a $33,$31,$42,$A1,$C9,$C4,$AE,$BD,$D4,$CD,$D1,$CF,$D0,$CF,$CF,$D0 -Data.a $CB,$A9,$70,$37,$33,$32,$32,$32,$32,$32,$33,$32,$33,$31,$34,$2E -Data.a $53,$AF,$CF,$CF,$CA,$CF,$D0,$CF,$D0,$CF,$D0,$CE,$D3,$AA,$83,$97 -Data.a $A1,$8A,$44,$32,$33,$31,$33,$32,$33,$32,$32,$33,$32,$33,$30,$44 -Data.a $83,$94,$7E,$7D,$AE,$CF,$D0,$CF,$D0,$CE,$D1,$BF,$B8,$C3,$B9,$B7 -Data.a $98,$68,$47,$37,$30,$31,$33,$32,$33,$32,$33,$32,$3D,$49,$48,$3E -Data.a $38,$43,$5C,$77,$87,$91,$95,$85,$78,$79,$7A,$80,$8D,$8F,$8A,$89 -Data.a $8D,$8D,$88,$81,$83,$89,$7F,$73,$77,$7A,$71,$64,$55,$43,$31,$31 -Data.a $34,$32,$34,$3A,$41,$36,$2F,$33,$37,$4D,$5C,$69,$73,$78,$7B,$82 -Data.a $8A,$8F,$90,$91,$91,$94,$9B,$9C,$94,$86,$75,$67,$5A,$51,$50,$4D -Data.a $45,$42,$41,$41,$43,$48,$51,$54,$59,$65,$75,$82,$87,$86,$83,$7B -Data.a $6E,$67,$65,$63,$61,$5F,$5D,$56,$4E,$4B,$50,$57,$5F,$67,$71,$78 -Data.a $7B,$7C,$7E,$82,$83,$80,$7C,$79,$76,$71,$6D,$6C,$68,$5E,$52,$4D -Data.a $4A,$46,$43,$43,$47,$4B,$4B,$4D,$53,$59,$5D,$65,$6F,$79,$82,$8B -Data.a $92,$93,$90,$8B,$88,$83,$7C,$7B,$7B,$76,$6F,$66,$5E,$59,$53,$51 -Data.a $53,$55,$57,$59,$5B,$5B,$5A,$5A,$5B,$5E,$61,$67,$6D,$6E,$6C,$69 -Data.a $6B,$6F,$72,$73,$75,$77,$79,$78,$79,$7B,$7C,$79,$76,$73,$72,$71 -Data.a $6C,$64,$59,$51,$50,$52,$53,$50,$4A,$41,$3B,$3C,$46,$53,$61,$6B -Data.a $6E,$6D,$70,$79,$83,$90,$9B,$A0,$9C,$94,$8C,$85,$7E,$7A,$76,$6F -Data.a $62,$56,$4E,$48,$45,$48,$4D,$4D,$4C,$4E,$54,$5B,$64,$6F,$79,$80 -Data.a $83,$82,$82,$85,$88,$88,$87,$84,$7D,$73,$69,$63,$60,$5D,$5A,$55 -Data.a $51,$4E,$4E,$52,$58,$5F,$66,$6A,$6D,$73,$7D,$86,$8B,$8F,$8E,$87 -Data.a $81,$80,$7F,$79,$72,$6B,$60,$54,$4D,$4C,$4E,$4E,$4F,$50,$52,$58 -Data.a $5F,$67,$6F,$75,$79,$7A,$7B,$7E,$82,$81,$7F,$7C,$75,$6F,$6C,$6B -Data.a $6C,$6E,$6F,$6C,$67,$65,$68,$6D,$73,$77,$77,$74,$70,$6C,$6B,$6E -Data.a $72,$73,$6F,$67,$60,$5D,$5E,$61,$63,$64,$63,$61,$60,$63,$69,$70 -Data.a $76,$79,$79,$7A,$7C,$7F,$81,$81,$80,$7E,$79,$72,$6E,$6B,$67,$65 -Data.a $62,$5F,$5D,$5D,$5E,$5F,$62,$65,$6A,$6E,$71,$75,$78,$7B,$7C,$7D -Data.a $7E,$7F,$7F,$7E,$7B,$77,$74,$6F,$6A,$67,$63,$5D,$56,$50,$49,$45 -Data.a $43,$43,$46,$4B,$50,$55,$5A,$60,$69,$74,$81,$8E,$97,$9D,$9F,$9E -Data.a $9C,$9B,$9A,$98,$93,$8A,$7D,$6E,$61,$58,$50,$4C,$49,$46,$45,$44 -Data.a $46,$4C,$53,$5C,$66,$6F,$75,$7B,$80,$85,$88,$88,$87,$85,$82,$7E -Data.a $7A,$75,$70,$6B,$66,$61,$5D,$5C,$5E,$61,$65,$69,$6B,$6B,$6B,$6A -Data.a $6B,$6F,$73,$76,$76,$71,$6B,$64,$61,$62,$67,$6D,$71,$72,$72,$72 -Data.a $74,$7A,$81,$85,$88,$87,$85,$82,$80,$7D,$79,$72,$6A,$63,$5F,$5F -Data.a $60,$60,$5E,$5A,$58,$58,$5D,$64,$6D,$74,$77,$78,$77,$79,$7D,$82 -Data.a $85,$86,$84,$80,$7C,$79,$78,$78,$75,$70,$6B,$66,$64,$66,$68,$6A -Data.a $6B,$68,$64,$63,$66,$6C,$72,$76,$78,$78,$78,$78,$78,$7B,$7E,$80 -Data.a $7F,$7D,$7B,$79,$74,$6F,$6A,$65,$63,$61,$5F,$5D,$5C,$5A,$58,$59 -Data.a $5E,$66,$6D,$74,$79,$7C,$80,$84,$89,$8B,$8C,$8B,$87,$81,$7C,$77 -Data.a $72,$6B,$63,$5B,$55,$52,$53,$55,$57,$59,$59,$5C,$62,$6B,$77,$82 -Data.a $8B,$91,$93,$94,$97,$9A,$9B,$98,$92,$8A,$81,$77,$72,$6E,$6A,$65 -Data.a $5E,$58,$56,$56,$57,$57,$54,$53,$53,$57,$5E,$67,$6D,$6F,$6E,$6E -Data.a $74,$7F,$8D,$96,$98,$93,$8C,$89,$8B,$91,$97,$96,$8C,$7E,$71,$69 -Data.a $67,$67,$65,$5D,$4F,$41,$39,$3B,$45,$51,$59,$5A,$56,$56,$5B,$69 -Data.a $7B,$89,$90,$8F,$8A,$87,$86,$89,$8C,$8A,$84,$7B,$75,$75,$78,$7A -Data.a $76,$6D,$63,$5E,$60,$68,$71,$74,$6F,$63,$57,$52,$58,$65,$73,$7B -Data.a $7C,$77,$72,$72,$77,$81,$89,$8C,$88,$81,$7A,$76,$76,$76,$75,$70 -Data.a $69,$62,$5F,$62,$68,$6D,$6D,$6A,$68,$68,$6C,$74,$7D,$84,$87,$86 -Data.a $84,$84,$86,$89,$8A,$88,$85,$84,$83,$80,$7B,$74,$6B,$61,$5A,$58 -Data.a $5A,$5C,$5C,$59,$55,$53,$55,$5B,$65,$72,$7D,$84,$86,$87,$89,$8C -Data.a $92,$98,$9A,$99,$96,$90,$8C,$88,$83,$7F,$79,$72,$6C,$66,$63,$61 -Data.a $5E,$59,$52,$4C,$4B,$4E,$55,$5E,$63,$66,$67,$69,$71,$7C,$88,$91 -Data.a $93,$91,$8C,$88,$88,$8A,$8E,$8E,$88,$7E,$73,$6A,$67,$66,$66,$65 -Data.a $62,$5B,$55,$52,$53,$58,$5F,$65,$69,$6B,$6F,$75,$7C,$83,$88,$8B -Data.a $8B,$89,$8B,$8E,$8E,$8B,$85,$7E,$74,$6E,$6C,$6D,$6D,$6B,$67,$62 -Data.a $5F,$60,$64,$67,$6A,$6B,$6C,$6C,$6F,$73,$75,$77,$78,$78,$79,$7C -Data.a $82,$89,$8D,$8D,$8C,$8C,$8C,$8E,$91,$90,$8C,$85,$7C,$74,$6D,$68 -Data.a $65,$62,$5E,$5B,$58,$58,$5C,$62,$68,$6C,$70,$75,$7C,$83,$8A,$90 -Data.a $96,$98,$98,$96,$93,$8E,$8A,$84,$7F,$7A,$75,$6E,$67,$60,$59,$54 -Data.a $52,$53,$57,$5B,$5D,$5E,$60,$65,$6C,$74,$7C,$87,$90,$98,$9D,$A1 -Data.a $A2,$A1,$9F,$9C,$9A,$97,$92,$89,$7E,$70,$64,$5C,$57,$55,$53,$52 -Data.a $50,$4F,$51,$56,$5D,$66,$6D,$73,$79,$7E,$82,$86,$89,$8B,$8D,$8D -Data.a $8C,$89,$84,$7F,$7B,$79,$77,$77,$76,$73,$6E,$6A,$6A,$6F,$74,$78 -Data.a $79,$78,$74,$72,$73,$76,$79,$7B,$7A,$75,$6F,$6A,$68,$69,$6B,$6C -Data.a $6D,$6C,$6C,$6D,$6F,$74,$78,$7C,$80,$82,$85,$88,$8B,$8C,$8B,$88 -Data.a $84,$81,$7F,$7D,$7B,$79,$75,$6F,$6A,$67,$65,$65,$68,$6B,$6D,$6F -Data.a $70,$72,$74,$79,$7D,$81,$85,$87,$88,$89,$8A,$8C,$8D,$8D,$8B,$86 -Data.a $82,$7F,$7D,$7C,$7A,$77,$73,$6F,$6A,$66,$65,$64,$65,$68,$6B,$6F -Data.a $72,$74,$75,$76,$79,$7D,$83,$8A,$8D,$8C,$88,$82,$7D,$7A,$78,$76 -Data.a $73,$6F,$69,$64,$60,$60,$62,$65,$68,$6B,$6F,$75,$7C,$84,$8A,$8E -Data.a $90,$91,$92,$94,$94,$93,$90,$8D,$88,$80,$78,$6F,$68,$64,$62,$60 -Data.a $5F,$5D,$5A,$58,$58,$5D,$68,$73,$7D,$83,$87,$89,$8C,$91,$96,$9B -Data.a $9D,$9B,$95,$8C,$83,$7B,$76,$71,$6D,$68,$63,$5D,$58,$56,$57,$5B -Data.a $62,$69,$6F,$75,$7B,$81,$86,$8C,$91,$95,$97,$97,$95,$93,$8F,$88 -Data.a $80,$77,$6F,$69,$66,$63,$60,$5C,$58,$54,$53,$59,$62,$6D,$75,$7A -Data.a $7C,$7E,$83,$8D,$98,$A0,$A2,$9E,$97,$90,$8E,$8F,$8F,$8D,$85,$79 -Data.a $6E,$66,$65,$68,$6D,$6E,$6B,$65,$60,$60,$65,$6C,$74,$79,$7A,$79 -Data.a $78,$79,$7C,$7E,$7F,$7F,$7F,$7F,$80,$82,$84,$84,$83,$82,$81,$83 -Data.a $88,$8D,$91,$92,$8E,$88,$82,$7F,$7F,$7F,$7F,$7C,$75,$6A,$60,$59 -Data.a $56,$56,$58,$59,$5A,$5A,$5E,$65,$6E,$79,$82,$8A,$91,$97,$9F,$A5 -Data.a $AA,$AB,$A6,$9C,$93,$8A,$84,$7E,$76,$6B,$5E,$51,$48,$45,$45,$48 -Data.a $4B,$4E,$51,$57,$60,$6E,$7C,$8A,$94,$9B,$A0,$A4,$A8,$AB,$AC,$A9 -Data.a $A3,$98,$8C,$7F,$73,$6A,$62,$5A,$54,$4E,$4A,$48,$49,$4D,$55,$60 -Data.a $6B,$77,$81,$8A,$92,$9A,$A1,$A9,$AD,$AF,$AD,$A7,$9F,$96,$8C,$84 -Data.a $7B,$71,$67,$5C,$52,$4C,$49,$4B,$4F,$54,$5A,$60,$67,$71,$7D,$8A -Data.a $96,$9F,$A4,$A6,$A6,$A5,$A4,$A2,$9C,$94,$89,$7F,$77,$70,$69,$62 -Data.a $5A,$54,$4F,$50,$56,$5E,$65,$6B,$6E,$73,$79,$83,$8F,$98,$9F,$A1 -Data.a $9F,$9C,$9A,$98,$96,$92,$8C,$84,$7A,$71,$6B,$67,$65,$64,$62,$61 -Data.a $61,$62,$67,$6D,$73,$79,$7E,$80,$83,$85,$88,$8A,$8C,$8B,$89,$86 -Data.a $84,$84,$84,$84,$82,$7E,$7A,$79,$7A,$7C,$7E,$7E,$7C,$7A,$77,$77 -Data.a $79,$7C,$7E,$7D,$7B,$79,$79,$79,$7A,$7B,$7C,$7C,$7B,$7B,$7C,$7D -Data.a $7D,$7C,$7B,$7A,$7B,$7C,$7D,$7D,$7B,$79,$77,$76,$77,$78,$79,$79 -Data.a $78,$76,$75,$76,$79,$7A,$7A,$78,$76,$75,$77,$7C,$81,$80,$53,$41 -Data.a $55,$52,$00,$02,$00,$00,$31,$2C,$20,$30,$2C,$20,$36,$2C,$20,$30 -eClick: +DataSection + ;a small wav file saved as raw data + sClick: + Data.q $0000082E46464952,$20746D6645564157,$0001000100000010,$0000AC440000AC44 + Data.q $6174616400080001,$8484848300000602,$8B8A898886868585,$C0B3A9A29C95918E + Data.q $31479BD3CED0CFCF,$3233323232323331,$BDAEC4C9A1423133,$D0CFCFD0CFD1CDD4 + Data.q $323232333770A9CB,$2E34313332333232,$CFD0CFCACFCFAF53,$9783AAD3CED0CFD0 + Data.q $3233313332448AA1,$4430333233323233,$CFD0CFAE7D7E9483,$B7B9C3B8BFD1CED0 + Data.q $3233313037476898,$3E48493D32333233,$85959187775C4338,$898A8F8D807A7978 + Data.q $737F898381888D8D,$3131435564717A77,$332F36413A343234,$827B7873695C4D37 + Data.q $9C9B949191908F8A,$4D50515A67758694,$5451484341414245,$7B83868782756559 + Data.q $565D5F616365676E,$7871675F57504B4E,$797C8083827E7C7B,$4D525E686C6D7176 + Data.q $4D4B4B474343464A,$8B82796F655D5953,$7B7C83888B909392,$5153595E666F767B + Data.q $5A5A5B5B59575553,$696C6E6D67615E5B,$7879777573726F6B,$71727376797C7B79 + Data.q $505352505159646C,$6B6153463C3B414A,$A09B908379706D6E,$6F767A7E858C949C + Data.q $4D4D4845484E5662,$80796F645B544E4C,$8487888885828283,$555A5D606369737D + Data.q $6A665F58524E4E51,$878E8F8B867D736D,$54606B72797F8081,$5852504F4E4E4C4D + Data.q $7E7B7A79756F675F,$6B6C6F757C7F8182,$6D6865676C6F6E6C,$6E6B6C7074777773 + Data.q $615E5D60676F7372,$7069636061636463,$81817F7C7A797976,$65676B6E72797E80 + Data.q $65625F5E5D5D5F62,$7D7C7B7875716E6A,$6F74777B7E7F7F7E,$454950565D63676A + Data.q $605A55504B464343,$9E9F9D978E817469,$6E7D8A93989A9B9C,$444546494C505861 + Data.q $7B756F665C534C46,$7E82858788888580,$5C5D61666B70757A,$6A6B6B6B6965615E + Data.q $646B717676736F6B,$727272716D676261,$8285878885817A74,$5F5F636A72797D80 + Data.q $645D58585A5E6060,$827D79777877746D,$7878797C80848685,$6A686664666B7075 + Data.q $76726C666364686B,$807E7B7878787878,$656A6F74797B7D7F,$59585A5C5D5F6163 + Data.q $84807C79746D665E,$777C81878B8C8B89,$555352555B636B72,$82776B625C595957 + Data.q $989B9A979493918B,$656A6E7277818A92,$535457575656585E,$6E6E6F6D675E5753 + Data.q $898C9398968D7F74,$69717E8C9697918B,$3B39414F5D656767,$695B56565A595145 + Data.q $8986878A8F90897B,$7A7875757B848A8C,$747168605E636D76,$7B7365585257636F + Data.q $8C8981777272777C,$70757676767A8188,$6A6D6D68625F6269,$8687847D746C6868 + Data.q $8485888A89868484,$585A616B747B8083,$5B555355595C5C5A,$8C898786847D7265 + Data.q $888C9096999A9892,$6163666C72797F83,$5E554E4B4C52595E,$91887C7169676663 + Data.q $8E8E8A88888C9193,$656666676A737E88,$655F585352555B62,$8B88837C756F6B69 + Data.q $7E858B8E8E8B898B,$62676B6D6D6C6E74,$6C6C6B6A6764605F,$7C7978787775736F + Data.q $8E8C8C8C8D8D8982,$686D747C858C9091,$625C58585B5E6265,$908A837C75706C68 + Data.q $848A8E9396989896,$545960676E757A7F,$65605E5D5B575352,$A19D9890877C746C + Data.q $8992979A9C9FA1A2,$525355575C64707E,$736D665D56514F50,$8D8D8B8986827E79 + Data.q $7777797B7F84898C,$78746F6A6A6E7376,$7B79767372747879,$6C6B69686A6F757A + Data.q $7C78746F6D6C6C6D,$888B8C8B88858280,$6F75797B7D7F8184,$6F6D6B686565676A + Data.q $8785817D79747270,$868B8D8D8C8A8988,$6F73777A7C7D7F82,$6F6B68656465666A + Data.q $8A837D7976757472,$76787A7D82888C8D,$6562606064696F73,$8E8A847C756F6B68 + Data.q $8D90939494929190,$606264686F788088,$73685D58585A5D5F,$9B96918C8987837D + Data.q $71767B838C959B9D,$5B5756585D63686D,$8C86817B756F6962,$888F939597979591 + Data.q $5C606366696F7780,$7A756D6259535458,$9EA2A0988D837E7C,$79858D8F8F8E9097 + Data.q $656B6E6D6865666E,$797A79746C656060,$7F7F7F7F7E7C7978,$8381828384848280 + Data.q $7F82888E92918D88,$59606A757C7F7F7F,$655E5A5A59585656,$A59F97918A82796E + Data.q $7E848A939CA6ABAA,$48454548515E6B76,$8A7C6E6057514E4B,$A9ACABA8A4A09B94 + Data.q $5A626A737F8C98A3,$60554D49484A4E54,$A9A19A928A81776B,$848C969FA7ADAFAD + Data.q $4B494C525C67717B,$8A7D7167605A544F,$A2A4A5A6A6A49F96,$626970777F89949C + Data.q $6B655E56504F545A,$A19F988F8379736E,$848C9296989A9C9F,$61626465676B717A + Data.q $807E79736D676261,$86898B8C8A888583,$797A7E8284848484,$77777A7C7E7E7C7A + Data.q $7979797B7D7E7C79,$7D7C7B7B7C7C7B7A,$7D7D7C7B7A7B7C7D,$797978777677797B + Data.q $787A7A7976757678,$415380817C777576,$2C31000002005255,$30202C36202C3020 + eClick: EndDataSection diff --git a/Task/Metronome/REXX/metronome-1.rexx b/Task/Metronome/REXX/metronome-1.rexx index 933930e27f..addd598449 100644 --- a/Task/Metronome/REXX/metronome-1.rexx +++ b/Task/Metronome/REXX/metronome-1.rexx @@ -1,18 +1,19 @@ -/*REXX program simulates a visual (textual) metronome (with no sound).*/ -parse arg bpm bpb dur . -if bpm=='' | bpm==',' then bpm=72 /*number of beats per minute. */ -if bpb=='' | bpb==',' then bpb= 4 /*number of beats per bar. */ -if dur=='' | dur==',' then dur= 5 /*duration of run in seconds. */ -call time 'R' /*reset the REXX elapsed timer. */ -bt=1/bpb /*calculate a tock-time interval.*/ +/*REXX program simulates a visual (textual) metronome (with no sound). */ +parse arg bpm bpb dur . /*obtain optional arguments from the CL*/ +if bpm=='' | bpm=="," then bpm=72 /*the number of beats per minute. */ +if bpb=='' | bpb=="," then bpb= 4 /* " " " " " bar. */ +if dur=='' | dur=="," then dur= 5 /*duration of the run in seconds. */ +call time 'Reset' /*reset the REXX elapsed timer. */ +bt=1/bpb /*calculate a tock-time interval. */ - do until et>=dur; et=time('E') /*process tick-tocks for duration*/ - say; call charout ,'TICK' /*show the first tick for period.*/ - es=et+1 /*bump the elapsed time limiter. */ - ee=et+bt - do until time('E')>=es; e=time('E') - if e=dur; et=time('Elasped') /*process tick-tocks for the duration*/ + say; call charout ,'TICK' /*show the first tick for the period. */ + es=et+1 /*bump the elapsed time "limiter". */ + $t=et+bt + do until e>=es; e=time('Elapsed') + if e<$t then iterate /*time for tock? */ + call charout , ' tock' /*show a "tock". */ + $t=$t+bt /*bump the TOCK time.*/ + end /*until e≥es*/ end /*until et≥dur*/ + /*stick a fork in it, we're all done. */ diff --git a/Task/Metronome/REXX/metronome-2.rexx b/Task/Metronome/REXX/metronome-2.rexx index c8175c1d2e..31474dbc63 100644 --- a/Task/Metronome/REXX/metronome-2.rexx +++ b/Task/Metronome/REXX/metronome-2.rexx @@ -1,22 +1,23 @@ -/*REXX program simulates a metronome (with sound), Regina REXX only. */ -parse arg bpm bpb dur tockf tockd tickf tickd . -if bpm=='' | bpm==',' then bpm=72 /*number of beats per minute. */ -if bpb=='' | bpb==',' then bpb= 4 /*number of beats per bar. */ -if dur=='' | dur==',' then dur= 5 /*duration of run in seconds. */ -if tockf==''|tockf==',' then tockf=400 /*frequency of tock sound in HZ. */ -if tockd==''|tockd==',' then tockd= 20 /*duration of tock sound in msec*/ -if tickf==''|tickf==',' then tickf=600 /*frequency of tick sound in HZ. */ -if tickd==''|tickd==',' then tickd= 10 /*duration of tick sound in msec*/ -call time 'R' /*reset the REXX elapsed timer. */ -bt=1/bpb /*calculate a tock-time interval.*/ +/*REXX program simulates a metronome (with sound). Regina REXX only. */ +parse arg bpm bpb dur tockf tockd tickf tickd . /*obtain optional arguments from the CL*/ +if bpm=='' | bpm=="," then bpm= 72 /*the number of beats per minute. */ +if bpb=='' | bpb=="," then bpb= 4 /* " " " " " bar. */ +if dur=='' | dur=="," then dur= 5 /*duration of the run in secs*/ +if tockf=='' | tockf=="," then tockf=400 /*frequency " " tock sound " HZ. */ +if tockd=='' | tockd=="," then tockd= 20 /*duration " " " " " msec*/ +if tickf=='' | tickf=="," then tickf=600 /*frequency " " tick " " HZ. */ +if tickd=='' | tickd=="," then tickd= 10 /*duration " " " " " msec*/ +call time 'Reset' /*reset the REXX elapsed timer. */ +bt=1/bpb /*calculate a tock─time interval. */ - do until et>=dur; et=time('E') /*process tick-tocks for duration*/ - call beep tockf,tockd /*sound a beep for the "TOCK". */ - es=et+1 /*bump the elapsed time limiter. */ - ee=et+bt - do until time('E')>=es; e=time('E') - if e=dur; et=time('Elasped') /*process tick-tocks for the duration*/ + call beep tockf, tockd /*sound a beep for the "TOCK". */ + es=et+1 /*bump the elapsed time "limiter". */ + $t=et+bt + do until e>=es; e=time('Elapsed') + if e<$t then iterate /*time for tock? */ + call beep tickf, tickd /*sound a "tick". */ + $t=$t+bt /*bump the TOCK time.*/ + end /*until e≥es*/ end /*until et≥dur*/ + /*stick a fork in it, we're all done. */ diff --git a/Task/Metronome/REXX/metronome-3.rexx b/Task/Metronome/REXX/metronome-3.rexx index 8ba8890c07..12bdcd24c7 100644 --- a/Task/Metronome/REXX/metronome-3.rexx +++ b/Task/Metronome/REXX/metronome-3.rexx @@ -1,22 +1,23 @@ -/*REXX program simulates a metronome (with sound), PC/REXX only. */ -parse arg bpm bpb dur tockf tockd tickf tickd . -if bpm=='' | bpm==',' then bpm=72 /*number of beats per minute. */ -if bpb=='' | bpb==',' then bpb= 4 /*number of beats per bar. */ -if dur=='' | dur==',' then dur= 5 /*duration of run in seconds. */ -if tockf==''|tockf==',' then tockf=400 /*frequency of tock sound in HZ. */ -if tockd==''|tockd==',' then tockd=.02 /*duration of tock sound in secs*/ -if tickf==''|tickf==',' then tickf=600 /*frequency of tick sound in HZ. */ -if tickd==''|tickd==',' then tickd=.01 /*duration of tick sound in secs*/ -call time 'R' /*reset the REXX elapsed timer. */ -bt=1/bpb /*calculate a tock-time interval.*/ +/*REXX program simulates a metronome (with sound). PC/REXX or Personal REXX only.*/ +parse arg bpm bpb dur tockf tockd tickf tickd . /*obtain optional arguments from the CL*/ +if bpm=='' | bpm=="," then bpm= 72 /*the number of beats per minute. */ +if bpb=='' | bpb=="," then bpb= 4 /* " " " " " bar. */ +if dur=='' | dur=="," then dur= 5 /*duration of the run in secs*/ +if tockf=='' | tockf=="," then tockf=400 /*frequency " " tock sound " HZ. */ +if tockd=='' | tockd=="," then tockd= .02 /*duration " " " " " sec.*/ +if tickf=='' | tickf=="," then tickf=600 /*frequency " " tick " " HZ. */ +if tickd=='' | tickd=="," then tickd= .01 /*duration " " " " " sec.*/ +call time 'Reset' /*reset the REXX elapsed timer. */ +bt=1/bpb /*calculate a tock─time interval. */ - do until et>=dur; et=time('E') /*process tick-tocks for duration*/ - call sound tockf,tockd /*sound a beep for the "TOCK". */ - es=et+1 /*bump the elapsed time limiter. */ - ee=et+bt - do until time('E')>=es; e=time('E') - if e=dur; et=time('Elasped') /*process tick-tocks for the duration*/ + call sound tockf, tockd /*sound a beep for the "TOCK". */ + es=et+1 /*bump the elapsed time "limiter". */ + $t=et+bt + do until e>=es; e=time('Elapsed') + if e<$t then iterate /*time for tock? */ + call sound tickf, tickd /*sound a tick. */ + $t=$t+bt /*bump the TOCK time.*/ + end /*until e≥es*/ end /*until et≥dur*/ + /*stick a fork in it, we're all done. */ diff --git a/Task/Middle-three-digits/00DESCRIPTION b/Task/Middle-three-digits/00DESCRIPTION index 7a7700ed9f..18126a1141 100644 --- a/Task/Middle-three-digits/00DESCRIPTION +++ b/Task/Middle-three-digits/00DESCRIPTION @@ -1,7 +1,12 @@ -The task is to: -:“''Write a function/procedure/subroutine that is called with an integer value and returns the middle three digits of the integer if possible or a clear indication of an error if this is not possible.''” -:''Note: The order of the middle digits should be preserved''. +;Task: +Write a function/procedure/subroutine that is called with an integer value and returns the middle three digits of the integer if possible or a clear indication of an error if this is not possible. + +Note: The order of the middle digits should be preserved. + Your function should be tested with the following values; the first line should return valid answers, those of the second line should return clear indications of an error: -
    123, 12345, 1234567, 987654321, 10001, -10001, -123, -100, 100, -12345
    -1, 2, -1, -10, 2002, -2002, 0
    +
    +123, 12345, 1234567, 987654321, 10001, -10001, -123, -100, 100, -12345
    +1, 2, -1, -10, 2002, -2002, 0
    +
    Show your output on this page. +

    diff --git a/Task/Middle-three-digits/BASIC/middle-three-digits-2.basic b/Task/Middle-three-digits/BASIC/middle-three-digits-2.basic index 46990d4d99..9172f69618 100644 --- a/Task/Middle-three-digits/BASIC/middle-three-digits-2.basic +++ b/Task/Middle-three-digits/BASIC/middle-three-digits-2.basic @@ -1,45 +1,21 @@ -#APPTYPE CONSOLE - -DIM numbers AS STRING = "123,12345,1234567,987654321,10001,-10001,-123,-100,100,-12345,1,2,-1,-10,2002,-2002,0" -DIM dict[] = Split(numbers, ",") -DIM num AS INTEGER -DIM num2 AS INTEGER -DIM powered AS INTEGER - -FOR DIM i = 0 TO COUNT(dict) - 1 - num2 = dict[i] - num = ABS(num2) - IF num < 100 THEN - display(num2, "is too small") - ELSE - FOR DIM j = 9 DOWNTO 1 - powered = 10 ^ j - IF num >= powered THEN - IF j MOD 2 = 1 THEN - display(num2, "has even number of digits") - ELSE - display(num2, middle3(num, j)) - END IF - EXIT FOR - END IF - NEXT - END IF +REM >midthree +FOR i% = 1 TO 17 + READ test% + PRINT test%; " -> "; FN_middle_three(test%) NEXT - -PAUSE - -FUNCTION display(num, msg) - PRINT LPAD(num, 11, " "), " --> ", msg -END FUNCTION - -FUNCTION middle3(n, pwr) - DIM power AS INTEGER = (pwr \ 2) - 1 - DIM m AS INTEGER = n - m = m \ (10 ^ power) - m = m MOD 1000 - IF m = 0 THEN - RETURN "000" - ELSE - RETURN m - END IF -END FUNCTION +END +: +DATA 123, 12345, 1234567, 987654321, 10001, -10001, -123, -100, 100, -12345 +DATA 1, 2, -1, -10, 2002, -2002, 0 +: +DEF FN_middle_three(n%) +LOCAL n$ +n$ = STR$ ABS n% +CASE TRUE OF +WHEN LEN n$ < 3 + = "Not enough digits" +WHEN LEN n$ MOD 2 = 0 + = "Even number of digits" +OTHERWISE + = MID$(n$, LEN n$ / 2, 3) +ENDCASE diff --git a/Task/Middle-three-digits/BASIC/middle-three-digits-3.basic b/Task/Middle-three-digits/BASIC/middle-three-digits-3.basic index e35d5c73d7..46990d4d99 100644 --- a/Task/Middle-three-digits/BASIC/middle-three-digits-3.basic +++ b/Task/Middle-three-digits/BASIC/middle-three-digits-3.basic @@ -1,28 +1,45 @@ -Procedure.s middleThreeDigits(x.q) - Protected x$, digitCount +#APPTYPE CONSOLE - If x < 0: x = -x: EndIf +DIM numbers AS STRING = "123,12345,1234567,987654321,10001,-10001,-123,-100,100,-12345,1,2,-1,-10,2002,-2002,0" +DIM dict[] = Split(numbers, ",") +DIM num AS INTEGER +DIM num2 AS INTEGER +DIM powered AS INTEGER - x$ = Str(x) - digitCount = Len(x$) - If digitCount < 3 - ProcedureReturn "invalid input: too few digits" - ElseIf digitCount % 2 = 0 - ProcedureReturn "invalid input: even number of digits" - EndIf +FOR DIM i = 0 TO COUNT(dict) - 1 + num2 = dict[i] + num = ABS(num2) + IF num < 100 THEN + display(num2, "is too small") + ELSE + FOR DIM j = 9 DOWNTO 1 + powered = 10 ^ j + IF num >= powered THEN + IF j MOD 2 = 1 THEN + display(num2, "has even number of digits") + ELSE + display(num2, middle3(num, j)) + END IF + EXIT FOR + END IF + NEXT + END IF +NEXT - ProcedureReturn Mid(x$,digitCount / 2, 3) -EndProcedure +PAUSE -If OpenConsole() - Define testValues$ = "123 12345 1234567 987654321 10001 -10001 -123 -100 100 -12345 1 2 -1 -10 2002 -2002 0" +FUNCTION display(num, msg) + PRINT LPAD(num, 11, " "), " --> ", msg +END FUNCTION - Define i, value.q, numTests = CountString(testValues$, " ") + 1 - For i = 1 To numTests - value = Val(StringField(testValues$, i, " ")) - PrintN(RSet(Str(value), 12, " ") + " : " + middleThreeDigits(value)) - Next - - Print(#crlf$ + #crlf$ + "Press ENTER to exit"): Input() - CloseConsole() -EndIf +FUNCTION middle3(n, pwr) + DIM power AS INTEGER = (pwr \ 2) - 1 + DIM m AS INTEGER = n + m = m \ (10 ^ power) + m = m MOD 1000 + IF m = 0 THEN + RETURN "000" + ELSE + RETURN m + END IF +END FUNCTION diff --git a/Task/Middle-three-digits/BASIC/middle-three-digits-4.basic b/Task/Middle-three-digits/BASIC/middle-three-digits-4.basic index 7a77efa890..e35d5c73d7 100644 --- a/Task/Middle-three-digits/BASIC/middle-three-digits-4.basic +++ b/Task/Middle-three-digits/BASIC/middle-three-digits-4.basic @@ -1,13 +1,28 @@ -x$ = "123, 12345, 1234567, 987654321, 10001, -10001, -123, -100, 100, -12345, 1, 2, -1, -10, 2002, -2002, 0" +Procedure.s middleThreeDigits(x.q) + Protected x$, digitCount -while word$(x$,i+1,",") <> "" - i = i + 1 - a1$ = trim$(word$(x$,i,",")) - if left$(a1$,1) = "-" then a$ = mid$(a1$,2) else a$ = a1$ - if (len(a$) and 1) = 0 or len(a$) < 3 then - print a1$;chr$(9);" length < 3 or is even" - else - print mid$(a$,((len(a$)-3)/2)+1,3);" ";a1$ - end if -wend -end + If x < 0: x = -x: EndIf + + x$ = Str(x) + digitCount = Len(x$) + If digitCount < 3 + ProcedureReturn "invalid input: too few digits" + ElseIf digitCount % 2 = 0 + ProcedureReturn "invalid input: even number of digits" + EndIf + + ProcedureReturn Mid(x$,digitCount / 2, 3) +EndProcedure + +If OpenConsole() + Define testValues$ = "123 12345 1234567 987654321 10001 -10001 -123 -100 100 -12345 1 2 -1 -10 2002 -2002 0" + + Define i, value.q, numTests = CountString(testValues$, " ") + 1 + For i = 1 To numTests + value = Val(StringField(testValues$, i, " ")) + PrintN(RSet(Str(value), 12, " ") + " : " + middleThreeDigits(value)) + Next + + Print(#crlf$ + #crlf$ + "Press ENTER to exit"): Input() + CloseConsole() +EndIf diff --git a/Task/Middle-three-digits/BASIC/middle-three-digits-5.basic b/Task/Middle-three-digits/BASIC/middle-three-digits-5.basic new file mode 100644 index 0000000000..7a77efa890 --- /dev/null +++ b/Task/Middle-three-digits/BASIC/middle-three-digits-5.basic @@ -0,0 +1,13 @@ +x$ = "123, 12345, 1234567, 987654321, 10001, -10001, -123, -100, 100, -12345, 1, 2, -1, -10, 2002, -2002, 0" + +while word$(x$,i+1,",") <> "" + i = i + 1 + a1$ = trim$(word$(x$,i,",")) + if left$(a1$,1) = "-" then a$ = mid$(a1$,2) else a$ = a1$ + if (len(a$) and 1) = 0 or len(a$) < 3 then + print a1$;chr$(9);" length < 3 or is even" + else + print mid$(a$,((len(a$)-3)/2)+1,3);" ";a1$ + end if +wend +end diff --git a/Task/Middle-three-digits/Kotlin/middle-three-digits.kotlin b/Task/Middle-three-digits/Kotlin/middle-three-digits.kotlin new file mode 100644 index 0000000000..51f712ca77 --- /dev/null +++ b/Task/Middle-three-digits/Kotlin/middle-three-digits.kotlin @@ -0,0 +1,14 @@ +fun middleThree(x: Int): Int? { + val s = Math.abs(x).toString() + when { + s.length < 3 -> return null // throw Exception("too short!") + s.length % 2 == 0 -> return null // throw Exception("even number of digits") + else -> return ((s.length / 2) - 1).let { s.substring(it, it + 3) }.toInt() + } +} + +println(middleThree(12345)) // 234 +println(middleThree(1234)) // null +println(middleThree(1234567)) // 345 +println(middleThree(123))// 123 +println(middleThree(123555)) //null diff --git a/Task/Middle-three-digits/MUMPS/middle-three-digits.mumps b/Task/Middle-three-digits/MUMPS/middle-three-digits.mumps new file mode 100644 index 0000000000..9f1e1f2e94 --- /dev/null +++ b/Task/Middle-three-digits/MUMPS/middle-three-digits.mumps @@ -0,0 +1,10 @@ +/* MUMPS */ +MID3(N) ; + N LEN,N2 + S N2=$S(N<0:-N,1:N) + I N2<100 Q "NUMBER TOO SMALL" + S LEN=$L(N2) + I LEN#2=0 Q "EVEN NUMBER OF DIGITS" + Q $E(N2,LEN\2,LEN\2+2) + +F I=123,12345,1234567,987654321,10001,-10001,-123,-100,100,-12345,1,2,-1,-10,2002,-2002,0 W !,$J(I,10),": ",$$MID3^MID3(I) diff --git a/Task/Middle-three-digits/Maple/middle-three-digits.maple b/Task/Middle-three-digits/Maple/middle-three-digits.maple new file mode 100644 index 0000000000..5c6b2ba21f --- /dev/null +++ b/Task/Middle-three-digits/Maple/middle-three-digits.maple @@ -0,0 +1,19 @@ +middleDigits := proc(n) + local nList, start; + nList := [seq(parse(i), i in convert (abs(n), string))]; + if numelems(nList) < 3 then + printf ("%9a: Error: Not enough digits.", n); + elif numelems(nList) mod 2 = 0 then + printf ("%9a: Error: Even number of digits.", n); + else + start := (numelems(nList)-1)/2; + printf("%9a: %a%a%a", n, op(nList[start..start+2])); + end if; +end proc: + +a := [123, 12345, 1234567, 987654321, 10001, -10001, -123, -100, 100, -12345, + 1, 2, -1, -10, 2002, -2002, 0]: +for i in a do + middleDigits(i); + printf("\n"); +end do; diff --git a/Task/Middle-three-digits/Pascal/middle-three-digits.pascal b/Task/Middle-three-digits/Pascal/middle-three-digits.pascal new file mode 100644 index 0000000000..cf40b7529c --- /dev/null +++ b/Task/Middle-three-digits/Pascal/middle-three-digits.pascal @@ -0,0 +1,37 @@ +program Midl3dig; +{$IFDEF FPC} + {$MODE Delphi} //result /integer => Int32 aka longInt etc.. +{$ELSE} + {$APPTYPE console} // Delphi +{$ENDIF} +uses + sysutils; //IntToStr +function GetMid3dig(i:NativeInt):Ansistring; +var + n,l: NativeInt; +Begin + setlength(result,0); + //n = |i| jumpless abs + n := i-((ORD(i>0)-1)AND (2*i)); + //calculate digitcount + IF n > 0 then + l := trunc(ln(n)/ln(10))+1 + else + l := 1; + if l<3 then Begin write('got too few digits'); EXIT; end; + If Not(ODD(l)) then Begin write('got even number of digits'); EXIT; end; + result:= copy(IntToStr(n),l DIV 2,3); +end; +const + Test : array [0..16] of NativeInt = + ( 123,12345,1234567,987654321,10001,-10001, + -123,-100,100,-12345,1,2,-1,-10,2002,-2002,0); +var + i,n : NativeInt; +Begin + For i := low(Test) to High(Test) do + Begin + n := Test[i]; + writeln(n:9,': ',GetMid3dig(Test[i])); + end; +end. diff --git a/Task/Middle-three-digits/Perl-6/middle-three-digits.pl6 b/Task/Middle-three-digits/Perl-6/middle-three-digits-1.pl6 similarity index 100% rename from Task/Middle-three-digits/Perl-6/middle-three-digits.pl6 rename to Task/Middle-three-digits/Perl-6/middle-three-digits-1.pl6 diff --git a/Task/Middle-three-digits/Perl-6/middle-three-digits-2.pl6 b/Task/Middle-three-digits/Perl-6/middle-three-digits-2.pl6 new file mode 100644 index 0000000000..e718a69176 --- /dev/null +++ b/Task/Middle-three-digits/Perl-6/middle-three-digits-2.pl6 @@ -0,0 +1 @@ +for [\~] ^10 { say "$_ => $()" if m/^^(\d+) <(\d**3)> (\d+) $$ / } diff --git a/Task/Middle-three-digits/REXX/middle-three-digits-2.rexx b/Task/Middle-three-digits/REXX/middle-three-digits-2.rexx index e991938bba..1da85cbf1a 100644 --- a/Task/Middle-three-digits/REXX/middle-three-digits-2.rexx +++ b/Task/Middle-three-digits/REXX/middle-three-digits-2.rexx @@ -1,17 +1,16 @@ -/*REXX program returns the three middle digits of a number (or an error msg).*/ -n= '123 12345 1234567 987654321 10001 -10001 -123 -100 100 -12345', - '2 -1 -10 2002 -2002 0 abc 1e3 -17e-3 1234567. 1237654.00', - '1234567890123456789012345678901234567890123456789012345678901234567' +/*REXX program returns the three middle digits of a decimal number (or an error msg).*/ +n= '123 12345 1234567 987654321 10001 -10001 -123 -100 100 -12345', + '+123 0123 2 -1 -10 2002 -2002 0 abc 1e3 -17e-3 1234567.', + 1237654.00 1234567890123456789012345678901234567890123456789012345678901234567 - do j=1 for words(n); #=word(n,j) /* [↓] format the output number nicely*/ - say 'middle 3 digits of' right(z, max(15, length(#))) '──►' middle3(#) - end /*j*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -middle3: procedure; parse arg x; numeric digits 1e6; er=' ***error!*** ' -if pos(.,x)\==0 then x=x/1 /*normalize it, contains decimal point.*/ -if datatype(x,'N') then x=abs(x); L=length(x) -if \datatype(x,'W') then return er "argument isn't an integer." -if L<3 then return er "argument is less than three digits." -if L//2==0 then return er "argument isn't an odd number of digits." - return substr(x, (L-3)%2+1, 3) + do j=1 for words(n); #=word(n,j) /* [↓] format number for pretty output*/ + say 'middle 3 digits of' right(#, max(15, length(#) ) ) "──►" middle3(#) + end /*j*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +middle3: procedure; parse arg x; numeric digits 1e6; er=' ***error*** ' + if datatype(x,'N') then x=abs(x)/1; L=length(x) /*use abs value; get length*/ + if \datatype(x,'W') then return er "argument isn't an integer." + if L<3 then return er "argument is less than three digits." + if L//2==0 then return er "argument isn't an odd number of digits." + return substr(x, (L-3)%2+1, 3) diff --git a/Task/Minesweeper-game/00DESCRIPTION b/Task/Minesweeper-game/00DESCRIPTION index 8269177909..fdb755c3da 100644 --- a/Task/Minesweeper-game/00DESCRIPTION +++ b/Task/Minesweeper-game/00DESCRIPTION @@ -10,8 +10,8 @@ Positions in the grid are modified by entering their coordinates where the first * You can mark what you think is free space by entering its coordinates. :* If the point is free space then it is cleared, as are any adjacent points that are also free space- this is repeated recursively for subsequent adjacent free points unless that point is marked as a mine or is a mine. ::* Points marked as a mine show as a '?'. -::* Other free points show as an integer count of the number of adjacent true mines in its immediate neighbourhood, or as a single space ' ' if the free point is not adjacent to any true mines. -* Of course you lose if you try to cjhlear space that has a hidden mine. +::* Other free points show as an integer count of the number of adjacent true mines in its immediate neighborhood, or as a single space ' ' if the free point is not adjacent to any true mines. +* Of course you lose if you try to clear space that has a hidden mine. * You win when you have correctly identified all mines. The Task is to '''create a program that allows you to play minesweeper on a 6 by 4 grid, and that assumes all user input is formatted correctly''' and so checking inputs for correct form may be omitted. diff --git a/Task/Modular-exponentiation/00DESCRIPTION b/Task/Modular-exponentiation/00DESCRIPTION index 4f4d3941a8..3fbe45fa49 100644 --- a/Task/Modular-exponentiation/00DESCRIPTION +++ b/Task/Modular-exponentiation/00DESCRIPTION @@ -3,6 +3,10 @@ Find the last 40 decimal digits of a^b, where * a = 2988348162058574136915891421498819466320163312926952423791023078876139 * b = 2351399303373464486466122544523690094744975233415544072992656881240319 -A computer is too slow to find the entire value of a^b. Instead, the program must use a fast algorithm for [[wp:Modular exponentiation|modular exponentiation]]: a^b \mod m. +
    +A computer is too slow to find the entire value of a^b. -The algorithm must work for any integers a, b, m where b \ge 0 and m > 0. +Instead, the program must use a fast algorithm for [[wp:Modular exponentiation|modular exponentiation]]: a^b \mod m. + +The algorithm must work for any integers a, b, m
    where b \ge 0 and m > 0. +

    diff --git a/Task/Modular-exponentiation/REXX/modular-exponentiation-1.rexx b/Task/Modular-exponentiation/REXX/modular-exponentiation-1.rexx index 8b05ceab08..0046162d10 100644 --- a/Task/Modular-exponentiation/REXX/modular-exponentiation-1.rexx +++ b/Task/Modular-exponentiation/REXX/modular-exponentiation-1.rexx @@ -1,25 +1,26 @@ -/*REXX program displays modular exponentation: a**b mod M */ -parse arg a b mm /*get optional args from CL.*/ -if a=='' | a==',' then a=2988348162058574136915891421498819466320163312926952423791023078876139 -if b=='' | b==',' then b=2351399303373464486466122544523690094744975233415544072992656881240319 -if mm='' | mm=',' then mm=40 /*MM specified? Use default.*/ -say 'a=' a; say ' ('length(a) "digits)" /*show value of A.*/ -say 'b=' b; say ' ('length(b) "digits)" /* " " " B.*/ +/*REXX program displays modular exponentiation of: a**b mod M */ +parse arg a b mm /*obtain optional args from the CL*/ +if a=='' | a=="," then a=2988348162058574136915891421498819466320163312926952423791023078876139 +if b=='' | b=="," then b=2351399303373464486466122544523690094744975233415544072992656881240319 +if mm='' | mm="," then mm=40 /*MM not specified? Use default.*/ +say 'a=' a; say " ("length(a) 'digits)' /*display the value of A. */ +say 'b=' b; say " ("length(b) 'digits)' /* " " " " B. */ - do j=1 for words(mm); m=word(mm,j) /*use one of the MM powers.*/ - say copies('─',linesize()-1) /*show a nice separator line*/ - say 'a**b (mod 10**'m")=" powerModulated(a,b,10**m) /*show ans*/ + do j=1 for words(mm); m=word(mm,j) /*use one of the MM powers (list).*/ + say copies('─', linesize()-1) /*show a nice separator fence line*/ + say 'a**b (mod 10**'m")=" powerMod(a,b,10**m) /*display the answer ───► console.*/ end /*j*/ -exit /*stick a fork in it; done.*/ -/*──────────────────────────────────────POWERMODULATED subroutine───────*/ -powerModulated: procedure; parse arg x,p,n /*fast modular exponentation*/ -if p==0 then return 1 /*special case of P = zero. */ -if p==1 then return x /* " " " " = unity.*/ -if p<0 then do; say '***error!*** power is negative:' p; exit 13; end -parse value max(x**2,p,n)'E0' with "E" e /*pick biggest of the three.*/ -numeric digits max(20,e*2) /*big enough to handle A² */ -_=1 /*use this for the 1st value*/ - do while p\==0; if p//2==1 then _=_*x//n /*is P odd? */ - p=p%2; x=x*x//n /*halve P; calc x² mod n */ - end /*while*/ /* [↑] keep moding 'til =0.*/ -return _ +exit /*stick a fork in it, we're done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +powerMod: procedure; parse arg x,p,n /*fast modular exponentiation code*/ + if p==0 then return 1 /*special case of P being zero. */ + if p==1 then return x /* " " " " " unity.*/ + if p<0 then do; say '***error*** power is negative:' p; exit 13; end + parse value max(x**2,p,n)'E0' with "E" e /*obtain the biggest of the three.*/ + numeric digits max(20, e*2) /*big enough to handle A². */ + _=1 /*use this for the first value. */ + do while p\==0 /*perform while P isn't zero.*/ + if p//2 then _=_*x//n /*is P odd? (is ÷ remainder≡1).*/ + p=p%2; x=x*x//n /*halve P; calculate x² mod n */ + end /*while*/ /* [↑] keep mod'ing 'til equal 0.*/ + return _ diff --git a/Task/Modular-inverse/00DESCRIPTION b/Task/Modular-inverse/00DESCRIPTION index fb8f974728..81c6a2d8f2 100644 --- a/Task/Modular-inverse/00DESCRIPTION +++ b/Task/Modular-inverse/00DESCRIPTION @@ -1,14 +1,16 @@ From [http://en.wikipedia.org/wiki/Modular_multiplicative_inverse Wikipedia]: -:In [[wp:modular arithmetic|modular arithmetic]], the '''modular multiplicative inverse''' of an [[integer]] ''a'' [[wp:modular arithmetic|modulo]] ''m'' is an integer ''x'' such that +In [[wp:modular arithmetic|modular arithmetic]],   the '''modular multiplicative inverse''' of an [[integer]]   ''a''   [[wp:modular arithmetic|modulo]]   ''m''   is an integer   ''x''   such that ::a\,x \equiv 1 \pmod{m}. Or in other words, such that: -:\exists k \in\Z,\qquad a\, x = 1 + k\,m -It can be shown that such an inverse exists if and only if a and m are [[wp:coprime|coprime]], but we will ignore this for this task. +::\exists k \in\Z,\qquad a\, x = 1 + k\,m -Either by implementing the algorithm, by using a dedicated library -or by using a builtin function in your language, -compute the modular inverse of 42 modulo 2017. +It can be shown that such an inverse exists   if and only if   ''a''   and   ''m''   are [[wp:coprime|coprime]],   but we will ignore this for this task. + + +;Task: +Either by implementing the algorithm, by using a dedicated library or by using a built-in function in +your language,   compute the modular inverse of   42 modulo 2017. diff --git a/Task/Modular-inverse/C++/modular-inverse.cpp b/Task/Modular-inverse/C++/modular-inverse-1.cpp similarity index 100% rename from Task/Modular-inverse/C++/modular-inverse.cpp rename to Task/Modular-inverse/C++/modular-inverse-1.cpp diff --git a/Task/Modular-inverse/C++/modular-inverse-2.cpp b/Task/Modular-inverse/C++/modular-inverse-2.cpp new file mode 100644 index 0000000000..5c3fc78d4d --- /dev/null +++ b/Task/Modular-inverse/C++/modular-inverse-2.cpp @@ -0,0 +1,12 @@ +#include + +short ObtainMultiplicativeInverse(int a, int b, int s0 = 1, int s1 = 0) +{ + return b==0? s0: ObtainMultiplicativeInverse(b, a%b, s1, s0 - s1*(a/b)); +} + +int main(int argc, char* argv[]) +{ + std::cout << ObtainMultiplicativeInverse(42, 2017) << std::endl; + return 0; +} diff --git a/Task/Modular-inverse/Clojure/modular-inverse.clj b/Task/Modular-inverse/Clojure/modular-inverse.clj new file mode 100644 index 0000000000..55cf1fe674 --- /dev/null +++ b/Task/Modular-inverse/Clojure/modular-inverse.clj @@ -0,0 +1,43 @@ +(ns test-p.core + (:require [clojure.math.numeric-tower :as math])) + +(defn extended-gcd + "The extended Euclidean algorithm--using Clojure code from RosettaCode for Extended Eucliean + (see http://en.wikipedia.orwiki/Extended_Euclidean_algorithm) + Returns a list containing the GCD and the Bézout coefficients + corresponding to the inputs with the result: gcd followed by bezout coefficients " + [a b] + (cond (zero? a) [(math/abs b) 0 1] + (zero? b) [(math/abs a) 1 0] + :else (loop [s 0 + s0 1 + t 1 + t0 0 + r (math/abs b) + r0 (math/abs a)] + (if (zero? r) + [r0 s0 t0] + (let [q (quot r0 r)] + (recur (- s0 (* q s)) s + (- t0 (* q t)) t + (- r0 (* q r)) r)))))) + +(defn mul_inv + " Get inverse using extended gcd. Extended GCD returns + gcd followed by bezout coefficients. We want the 1st coefficients + (i.e. second of extend-gcd result). We compute mod base so result + is between 0..(base-1) " + [a b] + (let [b (if (neg? b) (- b) b) + a (if (neg? a) (- b (mod (- a) b)) a) + egcd (extended-gcd a b)] + (if (= (first egcd) 1) + (mod (second egcd) b) + (str "No inverse since gcd is: " (first egcd))))) + + +(println (mul_inv 42 2017)) +(println (mul_inv 40 1)) +(println (mul_inv 52 -217)) +(println (mul_inv -486 217)) +(println (mul_inv 40 2018)) diff --git a/Task/Modular-inverse/Elixir/modular-inverse.elixir b/Task/Modular-inverse/Elixir/modular-inverse.elixir new file mode 100644 index 0000000000..0ec0444da3 --- /dev/null +++ b/Task/Modular-inverse/Elixir/modular-inverse.elixir @@ -0,0 +1,21 @@ +defmodule Modular do + def extended_gcd(a, b) do + {last_remainder, last_x} = extended_gcd(abs(a), abs(b), 1, 0, 0, 1) + {last_remainder, last_x * (if a < 0, do: -1, else: 1)} + end + + defp extended_gcd(last_remainder, 0, last_x, _, _, _), do: {last_remainder, last_x} + defp extended_gcd(last_remainder, remainder, last_x, x, last_y, y) do + quotient = div(last_remainder, remainder) + remainder2 = rem(last_remainder, remainder) + extended_gcd(remainder, remainder2, x, last_x - quotient*x, y, last_y - quotient*y) + end + + def inverse(e, et) do + {g, x} = extended_gcd(e, et) + if g != 1, do: raise "The maths are broken!" + rem(x+et, et) + end + end + +IO.puts Modular.inverse(42,2017) diff --git a/Task/Modular-inverse/JavaScript/modular-inverse.js b/Task/Modular-inverse/JavaScript/modular-inverse.js new file mode 100644 index 0000000000..a6a4770c79 --- /dev/null +++ b/Task/Modular-inverse/JavaScript/modular-inverse.js @@ -0,0 +1,8 @@ +var modInverse = function(a, b) { + a %= b; + for (var x = 1; x < b; x++) { + if ((a*x)%b == 1) { + return x; + } + } +} diff --git a/Task/Modular-inverse/REXX/modular-inverse.rexx b/Task/Modular-inverse/REXX/modular-inverse.rexx index bae72c476c..8e14f53a72 100644 --- a/Task/Modular-inverse/REXX/modular-inverse.rexx +++ b/Task/Modular-inverse/REXX/modular-inverse.rexx @@ -1,13 +1,15 @@ -/*REXX program calculates the modular inverse of an integer X modulo Y. */ -parse arg x y . /*obtain two integers from the C.L. */ -say 'modular inverse of ' x " by " y ' ───► ' modInv(x,y) -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -modInv: parse arg a,b 1 ob; ox=0 +/*REXX program calculates and displays the modular inverse of an integer X modulo Y.*/ +parse arg x y . /*obtain two integers from the C.L. */ +if x=='' | x=="," then x= 42 /*Not specified? Then use the default.*/ +if y=='' | y=="," then y= 2017 /* " " " " " " */ +say 'modular inverse of ' x " by " y ' ───► ' modInv(x,y) +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +modInv: parse arg a,b 1 ob; z=0 /*B & OB are obtained from the 2nd arg.*/ $=1 - if b \= 1 then do while a>1 - parse value a/b a//b b ox with q b a t - ox=$-q*ox; $=trunc(t) - end /*while a>1*/ + if b\=1 then do while a>1 + parse value a/b a//b b z with q b a t + z=$ - q*z; $=trunc(t) + end /*while*/ if $<0 then $=$+ob return $ diff --git a/Task/Modular-inverse/Ruby/modular-inverse.rb b/Task/Modular-inverse/Ruby/modular-inverse.rb index 7a1b19608b..c7d66510dc 100644 --- a/Task/Modular-inverse/Ruby/modular-inverse.rb +++ b/Task/Modular-inverse/Ruby/modular-inverse.rb @@ -14,7 +14,7 @@ end def invmod(e, et) g, x = extended_gcd(e, et) if g != 1 - raise 'Teh maths are broken!' + raise 'The maths are broken!' end x % et end diff --git a/Task/Modular-inverse/Rust/modular-inverse.rust b/Task/Modular-inverse/Rust/modular-inverse.rust new file mode 100644 index 0000000000..41e4de44ed --- /dev/null +++ b/Task/Modular-inverse/Rust/modular-inverse.rust @@ -0,0 +1,18 @@ +fn mod_inv(a: isize, module: isize) -> isize { + let mut mn = (module, a); + let mut xy = (0, 1); + + while mn.1 != 0 { + xy = (xy.1, xy.0 - (mn.0 / mn.1) * xy.1); + mn = (mn.1, mn.0 % mn.1); + } + + while xy.0 < 0 { + xy.0 += module; + } + xy.0 +} + +fn main() { + println!("{}", mod_inv(42, 2017)) +} diff --git a/Task/Modular-inverse/Scala/modular-inverse.scala b/Task/Modular-inverse/Scala/modular-inverse-1.scala similarity index 100% rename from Task/Modular-inverse/Scala/modular-inverse.scala rename to Task/Modular-inverse/Scala/modular-inverse-1.scala diff --git a/Task/Modular-inverse/Scala/modular-inverse-2.scala b/Task/Modular-inverse/Scala/modular-inverse-2.scala new file mode 100644 index 0000000000..a05fa6f239 --- /dev/null +++ b/Task/Modular-inverse/Scala/modular-inverse-2.scala @@ -0,0 +1 @@ +def modInv(a: Int, m: Int, x:Int = 1, y:Int = 0) : Int = if (m == 0) x else modInv(m, a%m, y, x - y*(a/m)) diff --git a/Task/Monte-Carlo-methods/00DESCRIPTION b/Task/Monte-Carlo-methods/00DESCRIPTION index 1b0e87e385..6e42289f0c 100644 --- a/Task/Monte-Carlo-methods/00DESCRIPTION +++ b/Task/Monte-Carlo-methods/00DESCRIPTION @@ -3,20 +3,24 @@ where calculating the actual value is difficult or impossible.
    It uses random sampling to define constraints on the value and then makes a sort of "best guess." -A simple Monte Carlo Simulation can be used to calculate the value for π. +A simple Monte Carlo Simulation can be used to calculate the value for \pi. + If you had a circle and a square where the length of a side of the square was the same as the diameter of the circle, the ratio of the area of the circle -to the area of the square would be π/4. +to the area of the square would be \pi/4. So, if you put this circle inside the square and select many random points inside the square, the number of points inside the circle divided by the number of points inside the square and the circle -would be approximately π/4. +would be approximately \pi/4. + + +;Task: +Write a function to run a simulation like this, with a variable number of random points to select. -Write a function to run a simulation like this, with a variable number -of random points to select.
    Also, show the results of a few different sample sizes. -For software where the number π is not built-in, -we give π to a couple of digits: -3.141592653589793238462643383280 +For software where the number \pi is not built-in, +we give \pi as a number of digits: + 3.141592653589793238462643383280 +

    diff --git a/Task/Monte-Carlo-methods/Elixir/monte-carlo-methods.elixir b/Task/Monte-Carlo-methods/Elixir/monte-carlo-methods.elixir index 66a761ee57..46d4f93cbe 100644 --- a/Task/Monte-Carlo-methods/Elixir/monte-carlo-methods.elixir +++ b/Task/Monte-Carlo-methods/Elixir/monte-carlo-methods.elixir @@ -1,9 +1,8 @@ defmodule MonteCarlo do def pi(n) do - :random.seed(:os.timestamp) count = Enum.count(1..n, fn _ -> - x = :random.uniform - y = :random.uniform + x = :rand.uniform + y = :rand.uniform :math.sqrt(x*x + y*y) <= 1 end) 4 * count / n diff --git a/Task/Monte-Carlo-methods/Fortran/monte-carlo-methods.f b/Task/Monte-Carlo-methods/Fortran/monte-carlo-methods-1.f similarity index 100% rename from Task/Monte-Carlo-methods/Fortran/monte-carlo-methods.f rename to Task/Monte-Carlo-methods/Fortran/monte-carlo-methods-1.f diff --git a/Task/Monte-Carlo-methods/Fortran/monte-carlo-methods-2.f b/Task/Monte-Carlo-methods/Fortran/monte-carlo-methods-2.f new file mode 100644 index 0000000000..b7c374abbf --- /dev/null +++ b/Task/Monte-Carlo-methods/Fortran/monte-carlo-methods-2.f @@ -0,0 +1,16 @@ + program mc + integer :: n,i + real(8) :: pi + n=10000 + do i=1,5 + print*,n,pi(n) + n = n * 10 + end do + end program + + function pi(n) + integer :: n + real(8) :: x(2,n),pi + call random_number(x) + pi = 4.d0 * dble( count( hypot(x(1,:),x(2,:)) <= 1.d0 ) ) / n + end function diff --git a/Task/Monte-Carlo-methods/REXX/monte-carlo-methods.rexx b/Task/Monte-Carlo-methods/REXX/monte-carlo-methods.rexx index 7287daebeb..a404e550f2 100644 --- a/Task/Monte-Carlo-methods/REXX/monte-carlo-methods.rexx +++ b/Task/Monte-Carlo-methods/REXX/monte-carlo-methods.rexx @@ -1,32 +1,30 @@ -/*REXX program computes pi ÷ 4 using the Monte Carlo algorithm. */ -parse arg times chunks . /*does user want a specific number? */ -if times=='' then times=1000000000 /*one billion should do it, me thinks. */ -if chunks=='' then chunks=10000 /*do Monte Carlo in 10,000 chunks. */ -limit=10000-1 /*REXX random generates only integers. */ -limitSq=limit**2 /*··· so, instead of one, use limit**2.*/ -!=0 /*the number of "pi hits" (so far). */ -accur=0 /*accuracy of Monte Carlo pi (so far). */ -if 1=='f1'x then piChar='pi' /*if EBCDIC, then use literal. */ - else piChar='e3'x /* " ASCII, " " pi glyph, */ - -pi=3.14159265358979323846264338327950288419716939937511 /*this, da real McCoy*/ -numeric digits length(pi) /*this program uses these decimal digs.*/ -say 'real pi='pi"+" /*we might as well brag about it. */ -say /*a blank line, just for the eyeballs. */ - do j=1 for times%chunks - do chunks /*do Monte Carlo, one chunk-at-a-time.*/ - if random(0,limit)**2 + random(0,limit)**2 <=limitSq then !=!+1 - end /*chunks*/ - reps=chunks*j /*compute the number of repetitions. */ - piX=4*!/reps /*let's see how this puppy does so far.*/ - _=compare(piX,pi) /*compare apples and ··· crabapples. */ - if _<=accur then iterate /*if not better accuracy, keep going. */ - say right(commas(reps),20) 'repetitions: Monte Carlo' piChar, - "is accurate to" _-1 'places.' /*subtract one for decimal point.*/ - accur=_ /*use this accuracy for the baseline. */ - end /*j*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -commas: procedure; parse arg _; n=_'.9'; #=123456789; b=verify(n,#,"M") - e=verify(n,#'0',,verify(n,#"0.",'M'))-4 - do j=e to b by -3; _=insert(',',_,j); end /*j*/; return _ +/*REXX program computes and displays the value of pi÷4 using the Monte Carlo algorithm*/ +pi=3.141592653589793238462643383279502884197169399375105820974944592307816406 /*true pi.*/ +say ' 1 2 3 4 5 6 7 ' +say 'scale: 1·234567890123456789012345678901234567890123456789012345678901234567890123' +say /* [↑] a two-line scale for showing pi*/ +say 'true pi='pi"+" /*we might as well brag about true pi.*/ +numeric digits length(pi) - 1 /*this program uses these decimal digs.*/ +parse arg times chunk . /*does user want a specific number? */ +if times=='' | times=="," then times=1000000000 /*one billion should do it, hopefully. */ +if chunk=='' | chunk=="." then chunk= 10000 /*perform Monte Carlo in 10k chunks.*/ +limit=10000-1 /*REXX random generates only integers. */ +limitSq=limit**2 /*··· so, instead of one, use limit**2.*/ +accur=0 /*accuracy of Monte Carlo pi (so far). */ +!=0; @reps='repetitions: Monte Carlo pi is' /*pi decimal digit accuracy (so far).*/ +say /*a blank line, just for the eyeballs.*/ + do j=1 for times%chunk + do chunk /*do Monte Carlo, one chunk at-a-time.*/ + if random(0,limit)**2 + random(0,limit)**2 <=limitSq then !=!+1 + end /*chunk*/ + reps=chunk*j /*calculate the number of repetitions. */ + _=compare(4*! / reps, pi) /*compare apples and ··· crabapples. */ + if _<=accur then iterate /*if not better accuracy, keep trukin'.*/ + say right(commas(reps),20) @reps 'accurate to' _-1 "places." /*-1 for dec. pt.*/ + accur=_ /*use this accuracy for next baseline. */ + end /*j*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +commas: procedure; parse arg _; n=_'.9'; #=123456789; b=verify(n,#,"M") + e=verify(n, #'0', , verify(n, #"0.", 'M') ) - 4 + do j=e to b by -3; _=insert(',',_,j); end /*j*/; return _ diff --git a/Task/Monty-Hall-problem/00DESCRIPTION b/Task/Monty-Hall-problem/00DESCRIPTION index 5a2035377e..62760984ea 100644 --- a/Task/Monty-Hall-problem/00DESCRIPTION +++ b/Task/Monty-Hall-problem/00DESCRIPTION @@ -1,10 +1,16 @@ +[[File:Monte_Hall_problem.jpg|500px||right]] + Run random simulations of the [[wp:Monty_Hall_problem|Monty Hall]] game. Show the effects of a strategy of the contestant always keeping his first guess so it can be contrasted with the strategy of the contestant always switching his guess. :Suppose you're on a game show and you're given the choice of three doors. Behind one door is a car; behind the others, goats. The car and the goats were placed randomly behind the doors before the show. The rules of the game show are as follows: After you have chosen a door, the door remains closed for the time being. The game show host, Monty Hall, who knows what is behind the doors, now has to open one of the two remaining doors, and the door he opens must have a goat behind it. If both remaining doors have goats behind them, he chooses one randomly. After Monty Hall opens a door with a goat, he will ask you to decide whether you want to stay with your first choice or to switch to the last remaining door. Imagine that you chose Door 1 and the host opens Door 3, which has a goat. He then asks you "Do you want to switch to Door Number 2?" Is it to your advantage to change your choice? ([http://www.usd.edu/~xtwang/Papers/MontyHallPaper.pdf Krauss and Wang 2003:10]) Note that the player may initially choose any of the three doors (not just Door 1), that the host opens a different door revealing a goat (not necessarily Door 3), and that he gives the player a second choice between the two remaining unopened doors. + +;Task: Simulate at least a thousand games using three doors for each strategy and show the results in such a way as to make it easy to compare the effects of each strategy. + ;Reference: * [https://www.youtube.com/watch?v=4Lb-6rxZxx0 Monty Hall Problem - Numberphile]. (Video). +

    diff --git a/Task/Monty-Hall-problem/Elixir/monty-hall-problem.elixir b/Task/Monty-Hall-problem/Elixir/monty-hall-problem.elixir index 7dbfe16b39..3f60e56316 100644 --- a/Task/Monty-Hall-problem/Elixir/monty-hall-problem.elixir +++ b/Task/Monty-Hall-problem/Elixir/monty-hall-problem.elixir @@ -1,6 +1,5 @@ defmodule MontyHall do def simulate(n) do - :random.seed(:os.timestamp) {stay, switch} = simulate(n, 0, 0) :io.format "Staying wins ~w times (~.3f%)~n", [stay, 100 * stay / n] :io.format "Switching wins ~w times (~.3f%)~n", [switch, 100 * switch / n] @@ -9,7 +8,7 @@ defmodule MontyHall do defp simulate(0, stay, switch), do: {stay, switch} defp simulate(n, stay, switch) do doors = Enum.shuffle([:goat, :goat, :car]) - guess = :random.uniform(3) - 1 + guess = :rand.uniform(3) - 1 [choice] = [0,1,2] -- [guess, shown(doors, guess)] if Enum.at(doors, choice) == :car, do: simulate(n-1, stay, switch+1), else: simulate(n-1, stay+1, switch) diff --git a/Task/Monty-Hall-problem/J/monty-hall-problem-7.j b/Task/Monty-Hall-problem/J/monty-hall-problem-7.j index a7f4536adc..3d42561efb 100644 --- a/Task/Monty-Hall-problem/J/monty-hall-problem-7.j +++ b/Task/Monty-Hall-problem/J/monty-hall-problem-7.j @@ -5,7 +5,7 @@ simulate=:3 :0 scenario=. ((pick@-.,])pick,pick) bind x stayWin=. =/@}. switchWin=. pick@(x -. }:) = {: - r=.(stayWin,switchWin)@scenario"0 i.1000 + r=.(stayWin,switchWin)@scenario"0 i.y labels=. ];.2 'limit stay switch ' smoutput labels,.":"0 y,+/r ) diff --git a/Task/Monty-Hall-problem/Pascal/monty-hall-problem.pascal b/Task/Monty-Hall-problem/Pascal/monty-hall-problem.pascal new file mode 100644 index 0000000000..bf3c9fa425 --- /dev/null +++ b/Task/Monty-Hall-problem/Pascal/monty-hall-problem.pascal @@ -0,0 +1,50 @@ +program MontyHall; + +uses + sysutils; + +const + NumGames = 1000; + + +{Randomly pick a door(a number between 0 and 2} +function PickDoor(): Integer; +begin + Exit(Trunc(Random * 3)); +end; + +var + i: Integer; + PrizeDoor: Integer; + ChosenDoor: Integer; + WinsChangingDoors: Integer = 0; + WinsNotChangingDoors: Integer = 0; +begin + Randomize; + for i := 0 to NumGames - 1 do + begin + //randomly picks the prize door + PrizeDoor := PickDoor; + //randomly chooses a door + ChosenDoor := PickDoor; + + //if the strategy is not changing doors the only way to win is if the chosen + //door is the one with the prize + if ChosenDoor = PrizeDoor then + Inc(WinsNotChangingDoors); + + //if the strategy is changing doors the only way to win is if we choose one + //of the two doors that hasn't the prize, because when we change we change to the prize door. + //The opened door doesn't have a prize + if ChosenDoor <> PrizeDoor then + Inc(WinsChangingDoors); + end; + + Writeln('Num of games:' + IntToStr(NumGames)); + Writeln('Wins not changing doors:' + IntToStr(WinsNotChangingDoors) + ', ' + + FloatToStr((WinsNotChangingDoors / NumGames) * 100) + '% of total.'); + + Writeln('Wins changing doors:' + IntToStr(WinsChangingDoors) + ', ' + + FloatToStr((WinsChangingDoors / NumGames) * 100) + '% of total.'); + +end. diff --git a/Task/Monty-Hall-problem/REXX/monty-hall-problem-2.rexx b/Task/Monty-Hall-problem/REXX/monty-hall-problem-2.rexx index ccd41f694d..5df6b0026d 100644 --- a/Task/Monty-Hall-problem/REXX/monty-hall-problem-2.rexx +++ b/Task/Monty-Hall-problem/REXX/monty-hall-problem-2.rexx @@ -1,14 +1,14 @@ -/*REXX program simulates a # of trials of the classic Monty Hall problem*/ -parse arg t .; if t=='' then t=1000000 /*Not specified? Then use default*/ -wins.=0 /*wins.0=stay; wins.1=switching.*/ - /*door values: 0=goat 1=car */ - do t /*perform this loop T times. */ - door.=0 /*set all doors to zero. */ - car=random(1,3); door.car=1 /*TV show hides a car randomly. */ - ?=random(1,3) ; _=door.? /*contestant picks a random door.*/ - wins._=wins._+1 /*bump the type of win strategy. */ - end /*DO t*/ - -say 'switching wins ' format(wins.0/t*100,,1)"% of the time." -say ' staying wins ' format(wins.1/t*100,,1)"% of the time."; say -say 'performed' t "times." /*stick a fork in it, we're done.* +/*REXX program simulates a number of trials of the classic Monty Hall problem. */ +parse arg # d . /*obtain the optional args from the CL.*/ +if #=='' | #=="," then #=1000000 /*Not specified? Then use 1 million. */ +if d=='' | d=="," then d= 3 /* " " " " three doors.*/ +wins.=0 /*wins.0 ≡ stay, wins.1 ≡ switching.*/ + do #; door. =0 /*initialize all doors to a value of 0.*/ + car=random(1, d); door.car=1 /*the TV show hides a car randomly. */ + ?=random(1, d); _=door.? /*the contestant picks a random door. */ + wins._ = wins._ + 1 /*bump the type of win strategy. */ + end /*#*/ /* [↑] perform the loop # times. */ + /* [↑] door values: 0≡goat 1≡car */ +say 'switching wins ' format(wins.0 / # * 100, , 1)"% of the time." +say ' staying wins ' format(wins.1 / # * 100, , 1)"% of the time." ; say +say 'performed ' # " times with " d ' doors.' /*stick a fork in it, we're all done. */ diff --git a/Task/Morse-code/00DESCRIPTION b/Task/Morse-code/00DESCRIPTION index 0bf9cf96d2..9277802c47 100644 --- a/Task/Morse-code/00DESCRIPTION +++ b/Task/Morse-code/00DESCRIPTION @@ -3,9 +3,12 @@ [[wp:Morse_code|Morse code]] is one of the simplest and most versatile methods of telecommunication in existence. It has been in use for more than 160 years — longer than any other electronic encoding system. -The task: Send a string as audible morse code to an audio device -(e.g., the PC speaker). + +;Task: +Send a string as audible Morse code to an audio device   (e.g., the PC speaker). + As the standard Morse code does not contain all possible characters, you may either ignore unknown characters in the file, -or indicate them somehow (e.g. with a different pitch). +or indicate them somehow   (e.g. with a different pitch). +

    diff --git a/Task/Morse-code/C++/morse-code.cpp b/Task/Morse-code/C++/morse-code.cpp new file mode 100644 index 0000000000..d26ccf7917 --- /dev/null +++ b/Task/Morse-code/C++/morse-code.cpp @@ -0,0 +1,68 @@ +/* +Michal Sikorski +06/07/2016 +*/ +#include +#include +#include +#include +using namespace std; +int main(int argc, char *argv[]) +{ + string inpt; + char ascii[28] = " ABCDEFGHIJKLMNOPQRSTUVWXYZ", lwcAscii[28] = " abcdefghijklmnopqrstuvwxyz"; + string morse[27] = {" ", ".- ", "-... ", "-.-. ", "-.. ", ". ", "..-. ", "--. ", ".... ", ".. ", ".--- ", "-.- ", ".-.. ", "-- ", "-. ", "--- ", ".--.", "--.- ", ".-. ", "... ", "- ", "..- ", "...- ", ".-- ", "-..- ", "-.-- ", "--.. "}; + string outpt; + getline(cin,inpt); + int xx=0; + int size = inpt.length(); + cout<<"Length:"<; + +procedure InitCodes; +var + i: Integer; +begin + for i := 0 to High(Codes) do + Dictionary.Add(Codes[i, 0], Codes[i, 1]); +end; + +procedure SayMorse(const Word: String); +var + s: String; +begin + for s in Word do + if s = '.' then + Windows.Beep(1000, 250) + else if s = '-' then + Windows.Beep(1000, 750) + else + Windows.Beep(1000, 1000); +end; + +procedure ParseMorse(const Word: String); +var + s, Value: String; +begin + for s in word do + if Dictionary.TryGetValue(s, Value) then + begin + Write(Value + ' '); + SayMorse(Value); + end; +end; + +begin + Dictionary := TDictionary.Create; + try + InitCodes; + if ParamCount = 0 then + ParseMorse('sos') + else if ParamCount = 1 then + ParseMorse(LowerCase(ParamStr(1))) + else + Writeln('Usage: Morse.exe anyword'); + + Readln; + finally + Dictionary.Free; + end; +end. diff --git a/Task/Morse-code/Elixir/morse-code.elixir b/Task/Morse-code/Elixir/morse-code.elixir index b4846280bf..b45750a42b 100644 --- a/Task/Morse-code/Elixir/morse-code.elixir +++ b/Task/Morse-code/Elixir/morse-code.elixir @@ -18,8 +18,7 @@ defmodule Morse do def code(text) do String.upcase(text) |> String.codepoints - |> Enum.map(fn c -> Dict.get(@morse, c, " ") end) - |> Enum.join(" ") + |> Enum.map_join(" ", fn c -> Map.get(@morse, c, " ") end) end end diff --git a/Task/Morse-code/Forth/morse-code.fth b/Task/Morse-code/Forth/morse-code.fth new file mode 100644 index 0000000000..29bc851eef --- /dev/null +++ b/Task/Morse-code/Forth/morse-code.fth @@ -0,0 +1,85 @@ +HEX +\ PC speaker hardware control (requires GIVEIO or DOSBOX for windows operation) + 042 constant fctrl + 043 constant tctrl + 061 constant sctrl + 0FC constant smask + +\ PC@ is Port char fetch (Intel IN instruction). PC! is port char store (Intel OUT instruction) +: speak ( -- ) sctrl pc@ 03 or sctrl pc! ; +: silence ( -- ) sctrl pc@ smask and 01 or sctrl pc! ; + +: tone ( freq -- ) \ freq is actually just a divisor value + ?dup \ check for non-zero input + if 0B6 tctrl pc! \ enable PC speaker + dup fctrl pc! \ set freq + 8 rshift fctrl pc! + speak + else + silence + then ; + +\ morse demonstration begins here +DECIMAL +1000 value freq \ arbitrary value that sounded ok + 90 value adit \ 1 dit will be 90 ms + +: dit_dur adit ms ; +: dah_dur adit 3 * ms ; +: wordgap adit 5 * ms ; +: off_dur adit 2/ ms ; +: lettergap dah_dur ; + +: sound ( -- ) freq tone ; + +: MORSE-EMIT ( char -- ) + dup bl = \ check for space character + if + wordgap drop \ and delay if detected + else + pad C! \ write char to buffer + pad 1 evaluate \ evaluate 1 character + lettergap \ pause for correct sounding morse code + then ; + +: TRANSMIT ( ADDR LEN -- ) + cr \ newline, + bounds \ convert loop indices to address ranges + do + I C@ dup emit \ dup and send char to console + morse-emit \ send the morse code + loop ; + +NAMESPACE MORSE \ prevent name conflicts with letters and numbers + +MORSE DEFINITIONS \ the following definitions go into MORSE namespace + +: . ( -- ) sound dit_dur silence off_dur ; +: - ( -- ) sound dah_dur silence off_dur ; + +\ define morse letters as Forth words. They transmit when executed + +: A . - ; : B - . . . ; : C - . - . ; : D - . . ; +: E . ; : F . . - . ; : G - - . ; : H . . . . ; +: I . . ; : J . - - - ; : K - . - ; : L . - . . ; +: M - - ; : N - . ; : O - - - ; : P . - - . ; +: Q - - . - ; : R . - . ; : S . . . ; : T - ; +: U . . - ; : V . . . - ; : W . - - ; : X - . . - ; +: Y - . - - ; : Z - - . . ; + +: 0 - - - - - ; : 1 . - - - - ; +: 2 . . - - - ; : 3 . . . - - ; +: 4 . . . . - ; : 5 . . . . . ; +: 6 - . . . . ; : 7 - - . . . ; +: 8 - - - . . ; : 9 - - - - . ; + +: ' - . . - . ; +: \ . - - - . ; +: ! . - . - . ; +: ? . . - - . . ; +: , - - . . - - ; +: / _ . . - . ; +: . . - . - . - ; + + PREVIOUS DEFINITIONS \ go back to previous namespace +: TRANSMIT MORSE TRANSMIT PREVIOUS ; diff --git a/Task/Morse-code/Java/morse-code.java b/Task/Morse-code/Java/morse-code.java new file mode 100644 index 0000000000..a2931c47e4 --- /dev/null +++ b/Task/Morse-code/Java/morse-code.java @@ -0,0 +1,44 @@ +import java.util.*; + +public class MorseCode { + + final static String[][] code = { + {"A", ".- "}, {"B", "-... "}, {"C", "-.-. "}, {"D", "-.. "}, + {"E", ". "}, {"F", "..-. "}, {"G", "--. "}, {"H", ".... "}, + {"I", ".. "}, {"J", ".--- "}, {"K", "-.- "}, {"L", ".-.. "}, + {"M", "-- "}, {"N", "-. "}, {"O", "--- "}, {"P", ".--. "}, + {"Q", "--.- "}, {"R", ".-. "}, {"S", "... "}, {"T", "- "}, + {"U", "..- "}, {"V", "...- "}, {"W", ".- - "}, {"X", "-..- "}, + {"Y", "-.-- "}, {"Z", "--.. "}, {"0", "----- "}, {"1", ".---- "}, + {"2", "..--- "}, {"3", "...-- "}, {"4", "....- "}, {"5", "..... "}, + {"6", "-.... "}, {"7", "--... "}, {"8", "---.. "}, {"9", "----. "}, + {"'", ".----. "}, {":", "---... "}, {",", "--..-- "}, {"-", "-....- "}, + {"(", "-.--.- "}, {".", ".-.-.- "}, {"?", "..--.. "}, {";", "-.-.-. "}, + {"/", "-..-. "}, {"-", "..--.- "}, {")", "---.. "}, {"=", "-...- "}, + {"@", ".--.-. "}, {"\"", ".-..-."}, {"+", ".-.-. "}, {" ", "/"}}; // cheat a little + + final static Map map = new HashMap<>(); + + static { + for (String[] pair : code) + map.put(pair[0].charAt(0), pair[1].trim()); + } + + public static void main(String[] args) { + printMorse("sos"); + printMorse(" Hello World!"); + printMorse("Rosetta Code"); + } + + static void printMorse(String input) { + System.out.printf("%s %n", input); + + input = input.trim().replaceAll("[ ]+", " ").toUpperCase(); + for (char c : input.toCharArray()) { + String s = map.get(c); + if (s != null) + System.out.printf("%s ", s); + } + System.out.println("\n"); + } +} diff --git a/Task/Morse-code/PowerShell/morse-code-1.psh b/Task/Morse-code/PowerShell/morse-code-1.psh new file mode 100644 index 0000000000..bf6eb75bbe --- /dev/null +++ b/Task/Morse-code/PowerShell/morse-code-1.psh @@ -0,0 +1,59 @@ +function Send-MorseCode +{ + [CmdletBinding()] + [OutputType([string])] + Param + ( + [Parameter(Mandatory=$true, + ValueFromPipeline=$true, + Position=0)] + [string] + $Message, + + [switch] + $ShowCode + ) + + Begin + { + $morseCode = @{ + a = ".-" ; b = "-..." ; c = "-.-." ; d = "-.." + e = "." ; f = "..-." ; g = "--." ; h = "...." + i = ".." ; j = ".---" ; k = "-.-" ; l = ".-.." + m = "--" ; n = "-." ; o = "---" ; p = ".--." + q = "--.-" ; r = ".-." ; s = "..." ; t = "-" + u = "..-" ; v = "...-" ; w = ".--" ; x = "-..-" + y = "-.--" ; z = "--.." ; 0 = "-----"; 1 = ".----" + 2 = "..---"; 3 = "...--"; 4 = "....-"; 5 = "....." + 6 = "-...."; 7 = "--..."; 8 = "---.."; 9 = "----." + } + } + Process + { + foreach ($word in $Message) + { + $word.Split(" ",[StringSplitOptions]::RemoveEmptyEntries) | ForEach-Object { + + foreach ($char in $_.ToCharArray()) + { + if ($char -in $morseCode.Keys) + { + foreach ($code in ($morseCode."$char").ToCharArray()) + { + if ($code -eq ".") {$duration = 250} else {$duration = 750} + + [System.Console]::Beep(1000, $duration) + Start-Sleep -Milliseconds 50 + } + + if ($ShowCode) {Write-Host ("{0,-6}" -f ("{0,6}" -f $morseCode."$char")) -NoNewLine} + } + } + + if ($ShowCode) {Write-Host} + } + + if ($ShowCode) {Write-Host} + } + } +} diff --git a/Task/Morse-code/PowerShell/morse-code-2.psh b/Task/Morse-code/PowerShell/morse-code-2.psh new file mode 100644 index 0000000000..84f7a3655e --- /dev/null +++ b/Task/Morse-code/PowerShell/morse-code-2.psh @@ -0,0 +1 @@ +Send-MorseCode -Message "S.O.S" diff --git a/Task/Morse-code/PowerShell/morse-code-3.psh b/Task/Morse-code/PowerShell/morse-code-3.psh new file mode 100644 index 0000000000..f29c479b82 --- /dev/null +++ b/Task/Morse-code/PowerShell/morse-code-3.psh @@ -0,0 +1 @@ +"S.O.S", "Goodbye, cruel world!" | Send-MorseCode -ShowCode diff --git a/Task/Move-to-front-algorithm/00DESCRIPTION b/Task/Move-to-front-algorithm/00DESCRIPTION index bae2743cfc..a2440a3def 100644 --- a/Task/Move-to-front-algorithm/00DESCRIPTION +++ b/Task/Move-to-front-algorithm/00DESCRIPTION @@ -91,4 +91,12 @@ Decoding the indices back to the original symbol order: * Show the strings and their encoding here. * Add a check to ensure that the decoded string is the same as the original. -The strings are: 'broood', 'bananaaa', and 'hiphophiphop'. (Note the spellings). +
    +The strings are: + + broood + bananaaa + hiphophiphop + +(Note the spellings.) +

    diff --git a/Task/Move-to-front-algorithm/Go/move-to-front-algorithm.go b/Task/Move-to-front-algorithm/Go/move-to-front-algorithm.go index 5f45f5ca11..38ed986b0b 100644 --- a/Task/Move-to-front-algorithm/Go/move-to-front-algorithm.go +++ b/Task/Move-to-front-algorithm/Go/move-to-front-algorithm.go @@ -1,46 +1,47 @@ package main import ( - "bytes" - "fmt" + "bytes" + "fmt" ) -type moveToFront string +type symbolTable string -func (symbols moveToFront) encode(s string) []int { - seq := make([]int, len(s)) - pad := []byte(symbols) - c1 := []byte{0} - for i := 0; i < len(s); i++ { - c := s[i] - c1[0] = c - x := bytes.Index(pad, c1) - seq[i] = x - copy(pad[1:], pad[:x]) - pad[0] = c - } - return seq +func (symbols symbolTable) encode(s string) []byte { + seq := make([]byte, len(s)) + pad := []byte(symbols) + c1 := []byte{0} + for i := 0; i < len(s); i++ { + c := s[i] + c1[0] = c + x := byte(bytes.Index(pad, c1)) + seq[i] = x + copy(pad[1:], pad[:x]) + pad[0] = c + } + return seq } -func (symbols moveToFront) decode(seq []int) string { - chars := make([]byte, len(seq)) - pad := []byte(symbols) - for i, x := range seq { - c := pad[x] - chars[i] = c - copy(pad[1:], pad[:x]) - pad[0] = c - } - return string(chars) + +func (symbols symbolTable) decode(seq []byte) string { + chars := make([]byte, len(seq)) + pad := []byte(symbols) + for i, x := range seq { + c := pad[x] + chars[i] = c + copy(pad[1:], pad[:x]) + pad[0] = c + } + return string(chars) } func main() { - m := moveToFront("abcdefghijklmnopqrstuvwxyz") - for _, s := range []string{"broood", "bananaaa", "hiphophiphop"} { - enc := m.encode(s) - dec := m.decode(enc) - fmt.Println(s, enc, dec) - if dec != s { - panic("Whoops!") - } - } + m := symbolTable("abcdefghijklmnopqrstuvwxyz") + for _, s := range []string{"broood", "bananaaa", "hiphophiphop"} { + enc := m.encode(s) + dec := m.decode(enc) + fmt.Println(s, enc, dec) + if dec != s { + panic("Whoops!") + } + } } diff --git a/Task/Move-to-front-algorithm/Lua/move-to-front-algorithm.lua b/Task/Move-to-front-algorithm/Lua/move-to-front-algorithm.lua new file mode 100644 index 0000000000..a34ea1e328 --- /dev/null +++ b/Task/Move-to-front-algorithm/Lua/move-to-front-algorithm.lua @@ -0,0 +1,46 @@ +-- Return table of the alphabet in lower case +function getAlphabet () + local letters = {} + for ascii = 97, 122 do table.insert(letters, string.char(ascii)) end + return letters +end + +-- Move the table value at ind to the front of tab +function moveToFront (tab, ind) + local toMove = tab[ind] + for i = ind - 1, 1, -1 do tab[i + 1] = tab[i] end + tab[1] = toMove +end + +-- Perform move-to-front encoding on input +function encode (input) + local symbolTable, output, index = getAlphabet(), {} + for pos = 1, #input do + for k, v in pairs(symbolTable) do + if v == input:sub(pos, pos) then index = k end + end + moveToFront(symbolTable, index) + table.insert(output, index - 1) + end + return table.concat(output, " ") +end + +-- Perform move-to-front decoding on input +function decode (input) + local symbolTable, output = getAlphabet(), "" + for num in input:gmatch("%d+") do + output = output .. symbolTable[num + 1] + moveToFront(symbolTable, num + 1) + end + return output +end + +-- Main procedure +local testCases, output = {"broood", "bananaaa", "hiphophiphop"} +for _, case in pairs(testCases) do + output = encode(case) + print("Original string: " .. case) + print("Encoded: " .. output) + print("Decoded: " .. decode(output)) + print() +end diff --git a/Task/Move-to-front-algorithm/PicoLisp/move-to-front-algorithm-1.l b/Task/Move-to-front-algorithm/PicoLisp/move-to-front-algorithm-1.l new file mode 100644 index 0000000000..9148a47e25 --- /dev/null +++ b/Task/Move-to-front-algorithm/PicoLisp/move-to-front-algorithm-1.l @@ -0,0 +1,19 @@ +(de encode (Str) + (let Table (chop "abcdefghijklmnopqrstuvwxyz") + (mapcar + '((C) + (dec + (prog1 + (index C Table) + (rot Table @) ) ) ) + (chop Str) ) ) ) + +(de decode (Lst) + (let Table (chop "abcdefghijklmnopqrstuvwxyz") + (pack + (mapcar + '((N) + (prog1 + (get Table (inc 'N)) + (rot Table N) ) ) + Lst ) ) ) ) diff --git a/Task/Move-to-front-algorithm/PicoLisp/move-to-front-algorithm-2.l b/Task/Move-to-front-algorithm/PicoLisp/move-to-front-algorithm-2.l new file mode 100644 index 0000000000..28809f7acd --- /dev/null +++ b/Task/Move-to-front-algorithm/PicoLisp/move-to-front-algorithm-2.l @@ -0,0 +1,14 @@ +(test (1 17 15 0 0 5) + (encode "broood") ) +(test "broood" + (decode (1 17 15 0 0 5)) ) + +(test (1 1 13 1 1 1 0 0) + (encode "bananaaa") ) +(test "bananaaa" + (decode (1 1 13 1 1 1 0 0)) ) + +(test (7 8 15 2 15 2 2 3 2 2 3 2) + (encode "hiphophiphop") ) +(test "hiphophiphop" + (decode (7 8 15 2 15 2 2 3 2 2 3 2)) ) diff --git a/Task/Move-to-front-algorithm/REXX/move-to-front-algorithm-2.rexx b/Task/Move-to-front-algorithm/REXX/move-to-front-algorithm-2.rexx index ba2fc87b03..5f9182cfab 100644 --- a/Task/Move-to-front-algorithm/REXX/move-to-front-algorithm-2.rexx +++ b/Task/Move-to-front-algorithm/REXX/move-to-front-algorithm-2.rexx @@ -1,21 +1,18 @@ -/*REXX program demonstrates move─to─front algorithm encode/decode symbol table*/ -parse arg xxx; if xxx='' then xxx='broood bananaaa hiphophiphop' /*default*/ - one=1 /*(offset) for task's requirement.*/ - do j=1 for words(xxx); x=word(xxx,j) /*process one word at a time. */ - @='abcdefghijklmnopqrstuvwxyz'; @@=@ /*symbol table: lowercase alphabet*/ - $= /*set the decode string to a null.*/ - do k=1 for length(x); z=substr(x,k,1) /*encrypt a symbol in the word. */ - _=pos(z,@); if _==0 then iterate /*symbol position in symbol table.*/ - $=$ _-one; @=z || delstr(@,_,1) /*adjust the symbol table string. */ - end /*k*/ /* [↑] move─to─front encoding. */ +/*REXX program demonstrates the move─to─front algorithm encode/decode symbol table. */ +parse arg xxx; if xxx='' then xxx= 'broood bananaaa hiphophiphop' /*use the default?*/ + one=1 /*(offset) for this task's requirement.*/ + do j=1 for words(xxx); x=word(xxx, j) /*process a single word at a time. */ + @= 'abcdefghijklmnopqrstuvwxyz'; @@=@ /*symbol table: the lowercase alphabet */ + $= /*set the decode string to a null. */ + do k=1 for length(x); z=substr(x, k, 1) /*encrypt a symbol in the word. */ + _=pos(z, @); if _==0 then iterate /*the symbol position in symbol table. */ + $=$ _ - one; @=z || delstr(@, _, 1) /*adjust the symbol table string. */ + end /*k*/ /* [↑] the move─to─front encoding. */ + != /*set the encode string to a null. */ + do m=1 for words($); n=word($, m) +one /*decode the sequence table string. */ + y=substr(@@, n, 1); !=! || y /*the decode symbol for the word. */ + @@=y || delstr(@@, n, 1) /*rebuild the symbol table string. */ + end /*m*/ /* [↑] the move─to─front decoding. */ - @=@@ /*symbol table: lowercase alphabet*/ - != /*set the encode string to a null.*/ - do m=1 for words($); n=word($,m)+one /*decode the sequence table string*/ - y=substr(@,n,1); !=! || y /*the decode symbol of the word. */ - @=y || delstr(@,n,1) /*rebuild the symbol table string.*/ - end /*m*/ /* [↑] move─to─front decoding. */ - - say 'word: ' left(x,20) "encoding:" left($,35) word('wrong OK',1+(!==x)) - end /*j*/ /*all done encoding/decoding the words.*/ - /*stick a fork in it, we're all done. */ + say ' word: ' left(x, 20) "encoding:" left($, 35) word('wrong OK', 1+(!==x) ) + end /*j*/ /*stick a fork in it, we're all done. */ diff --git a/Task/Move-to-front-algorithm/Scala/move-to-front-algorithm.scala b/Task/Move-to-front-algorithm/Scala/move-to-front-algorithm.scala new file mode 100644 index 0000000000..ce7059c2e2 --- /dev/null +++ b/Task/Move-to-front-algorithm/Scala/move-to-front-algorithm.scala @@ -0,0 +1,97 @@ +package rosetta + +import scala.annotation.tailrec + +object MoveToFront { + /** + * Default radix + */ + private val R = 256 + + /** + * Default symbol table + */ + private def symbolTable = (0 until R).map(_.toChar).mkString + + /** + * Apply move-to-front encoding using default symbol table. + */ + def encode(s: String): List[Int] = { + encode(s, symbolTable) + } + + /** + * Apply move-to-front encoding using symbol table symTable. + */ + def encode(s: String, symTable: String): List[Int] = { + val table = symTable.toCharArray + + @inline @tailrec def moveToFront(ch: Char, index: Int, tmpout: Char): Int = { + val tmpin = table(index) + table(index) = tmpout + if (ch != tmpin) + moveToFront(ch, index + 1, tmpin) + else { + table(0) = ch + index + } + } + + @tailrec def encodeString(output: List[Int], s: List[Char]): List[Int] = s match { + case Nil => output + case x :: xs => { + encodeString(moveToFront(x, 0, table(0)) :: output, s.tail) + } + } + encodeString(Nil, s.toList).reverse + } + + /** + * Apply move-to-front decoding using default symbol table. + */ + def decode(ints: List[Int]): String = { + decode(ints, symbolTable) + } + + /** + * Apply move-to-front decoding using symbol table symTable. + */ + def decode(lst: List[Int], symTable: String): String = { + val table = symTable.toCharArray + + @inline def moveToFront(c: Char, index: Int) { + for (i <- index-1 to 0 by -1) + table(i+1) = table(i) + table(0) = c + } + + @tailrec def decodeList(output: List[Char], lst: List[Int]): List[Char] = lst match { + case Nil => output + case x :: xs => { + val c = table(x) + moveToFront(c, x) + decodeList(c :: output, xs) + } + } + decodeList(Nil, lst).reverse.mkString + } + + def test(toEncode: String, symTable: String) { + val encoded = encode(toEncode, symTable) + println(toEncode + ": " + encoded) + val decoded = decode(encoded, symTable) + if (toEncode != decoded) + print("in") + println("correctly decoded to " + decoded) + } +} + +/** + * Unit tests the MoveToFront data type. + */ +object RosettaCodeMTF extends App { + val symTable = "abcdefghijklmnopqrstuvwxyz" + MoveToFront.test("broood", symTable) + MoveToFront.test("bananaaa", symTable) + MoveToFront.test("hiphophiphop", symTable) +} diff --git a/Task/Multifactorial/00DESCRIPTION b/Task/Multifactorial/00DESCRIPTION index 3ed32b6cea..0d37c705b8 100644 --- a/Task/Multifactorial/00DESCRIPTION +++ b/Task/Multifactorial/00DESCRIPTION @@ -13,4 +13,5 @@ If we define the degree of the multifactorial as the difference in successive te # Write a function that given n and the degree, calculates the multifactorial. # Use the function to generate and display here a table of the first ten members (1 to 10) of the first five degrees of multifactorial. -'''Note:''' The [[wp:Factorial#Multifactorials|wikipedia entry on multifactorials]] gives a different formula. This task uses the [http://mathworld.wolfram.com/Multifactorial.html Wolfram mathworld definition]. + +'''Note:''' The [[wp:Factorial#Multifactorials|wikipedia entry on multifactorials]] gives a different formula. This task uses the [http://mathworld.wolfram.com/Multifactorial.html Wolfram mathworld definition]. diff --git a/Task/Multifactorial/360-Assembly/multifactorial.360 b/Task/Multifactorial/360-Assembly/multifactorial.360 new file mode 100644 index 0000000000..80b3f8fbdc --- /dev/null +++ b/Task/Multifactorial/360-Assembly/multifactorial.360 @@ -0,0 +1,51 @@ +* Multifactorial 09/05/2016 +MULFACR CSECT + USING MULFACR,13 +SAVEAR B STM-SAVEAR(15) + DC 17F'0' +STM STM 14,12,12(13) prolog + ST 13,4(15) " + ST 15,8(13) " + LR 13,15 " + LA I,1 i=1 +LOOPI C I,D do i=1 to deg + BH ELOOPI leave i + LA L,W+4 l=@p + LA J,1 j=1 +LOOPJ C J,N do j=1 to num + BH ELOOPJ leave j + LA R,1 r=1 + LCR S,I s=-i + LR K,J k=j +LOOPK C K,=F'2' do k=j to 2 by s + BL ELOOPK leave k + MR RR,K r=r*k + AR K,S k=k+s + B LOOPK next k +ELOOPK CVD R,Y pack r + MVC X,=XL12'402020202020202020202120' ed mask + ED X,Y+2 edit r + MVC 0(8,L),X+4 output r + LA L,8(L) l=l+8 + LA J,1(J) j=j+1 + B LOOPJ next j +ELOOPJ WTO MF=(E,W) + LA I,1(I) i=i+1 + B LOOPI next i +ELOOPI L 13,4(0,13) epilog + LM 14,12,12(13) " + XR 15,15 " + BR 14 " +N DC F'10' number +D DC F'5' degree +W DC 0F,H'84',H'0',CL80' ' length,zero,text +X DS CL12 temp +Y DS D packed PL8 +I EQU 6 +J EQU 7 +K EQU 8 +S EQU 9 +RR EQU 10 even reg of R for MR opcode +R EQU 11 +L EQU 12 + END MULFACR diff --git a/Task/Multifactorial/Elixir/multifactorial.elixir b/Task/Multifactorial/Elixir/multifactorial.elixir index e86697c99d..2f083e97e8 100644 --- a/Task/Multifactorial/Elixir/multifactorial.elixir +++ b/Task/Multifactorial/Elixir/multifactorial.elixir @@ -1,10 +1,10 @@ defmodule RC do def multifactorial(n,d) do - List.foldl(:lists.seq(n,1,-d), 1, fn x,p -> x*p end) + Enum.take_every(n..1, d) |> Enum.reduce(1, fn x,p -> x*p end) end end Enum.each(1..5, fn d -> - multifac = Enum.map(1..10, fn n -> RC.multifactorial(n,d) end) + multifac = for n <- 1..10, do: RC.multifactorial(n,d) IO.puts "Degree #{d}: #{inspect multifac}" end) diff --git a/Task/Multifactorial/Forth/multifactorial.fth b/Task/Multifactorial/Forth/multifactorial.fth new file mode 100644 index 0000000000..edb85dbec4 --- /dev/null +++ b/Task/Multifactorial/Forth/multifactorial.fth @@ -0,0 +1,2 @@ +: !n negate swap 1 dup rot do i * over +loop nip ; +: test cr 6 1 ?do 11 1 ?do i j !n . loop cr loop ; diff --git a/Task/Multifactorial/Fortran/multifactorial.f b/Task/Multifactorial/Fortran/multifactorial.f new file mode 100644 index 0000000000..bd06f8f068 --- /dev/null +++ b/Task/Multifactorial/Fortran/multifactorial.f @@ -0,0 +1,23 @@ +program test + implicit none + integer :: i, j, n + + do i = 1, 5 + write(*, "(a, i0, a)", advance = "no") "Degree ", i, ": " + do j = 1, 10 + n = multifactorial(j, i) + write(*, "(i0, 1x)", advance = "no") n + end do + write(*,*) + end do + +contains + +function multifactorial (range, degree) + integer :: multifactorial, range, degree + integer :: k + + multifactorial = product((/(k, k=range, 1, -degree)/)) + +end function multifactorial +end program test diff --git a/Task/Multifactorial/Kotlin/multifactorial.kotlin b/Task/Multifactorial/Kotlin/multifactorial.kotlin new file mode 100644 index 0000000000..84044b95a7 --- /dev/null +++ b/Task/Multifactorial/Kotlin/multifactorial.kotlin @@ -0,0 +1,14 @@ +fun multifactorial(n: Long, d: Int) : Long { + val r = n % d + return (1..n).filter { it % d == r } .reduce { i, p -> i * p } +} + +fun main(args: Array) { + val m = 5 + val r = 1..10L + for (d in 1..m) { + print("%${m}s:".format( "!".repeat(d))) + r.forEach { print(" " + multifactorial(it, d)) } + println() + } +} diff --git a/Task/Multifactorial/Lua/multifactorial.lua b/Task/Multifactorial/Lua/multifactorial.lua new file mode 100644 index 0000000000..afef8e7cd9 --- /dev/null +++ b/Task/Multifactorial/Lua/multifactorial.lua @@ -0,0 +1,17 @@ +function multiFact (n, degree) + local fact = 1 + for i = n, 2, -degree do + fact = fact * i + end + return fact +end + +print("Degree\t|\tMultifactorials 1 to 10") +print(string.rep("-", 52)) +for d = 1, 5 do + io.write(" " .. d, "\t| ") + for n = 1, 10 do + io.write(multiFact(n, d) .. " ") + end + print() +end diff --git a/Task/Multifactorial/Perl/multifactorial-1.pl b/Task/Multifactorial/Perl/multifactorial-1.pl index 0f683da4ba..d44b3e3ca3 100644 --- a/Task/Multifactorial/Perl/multifactorial-1.pl +++ b/Task/Multifactorial/Perl/multifactorial-1.pl @@ -1,8 +1,14 @@ -use 5.10.0; - -sub ng { - state %g; - my ($n, $d, $key) = ( @_[0], @_[1], $n.'ng'.$d); - if (!$g{$key}) {$g[$key] = ($n <= $d+1)? $n : ng($n-$d,$d)*$n} - return $g[$key]; +{ # <-- scoping the cache and bigint clause + my @cache; + use bigint; + sub mfact { + my ($s, $n) = @_; + return 1 if $n <= 0; + $cache[$s][$n] //= $n * mfact($s, $n - $s); + } +} + +for my $s (1 .. 10) { + print "step=$s: "; + print join(" ", map(mfact($s, $_), 1 .. 10)), "\n"; } diff --git a/Task/Multifactorial/Perl/multifactorial-2.pl b/Task/Multifactorial/Perl/multifactorial-2.pl index 2b8949585e..6d13991b0f 100644 --- a/Task/Multifactorial/Perl/multifactorial-2.pl +++ b/Task/Multifactorial/Perl/multifactorial-2.pl @@ -1,9 +1,10 @@ -printf "%s %s %s %s %s %s %s %s %s %s\n", ng(1,1), ng(2,1), ng(3,1), ng(4,1), ng(5,1), ng(6,1), ng(7,1), ng(8,1), ng(9,1), ng(10,1) ; -printf "%s %s %s %s %s %s %s %s %s %s\n", ng(1,2), ng(2,2), ng(3,2), ng(4,2), ng(5,2), ng(6,2), ng(7,2), ng(8,2), ng(9,2), ng(10,2) ; -printf "%s %s %s %s %s %s %s %s %s %s\n", ng(1,3), ng(2,3), ng(3,3), ng(4,3), ng(5,3), ng(6,3), ng(7,3), ng(8,3), ng(9,3), ng(10,3) ; -printf "%s %s %s %s %s %s %s %s %s %s\n", ng(1,4), ng(2,4), ng(3,4), ng(4,4), ng(5,4), ng(6,4), ng(7,4), ng(8,4), ng(9,4), ng(10,4) ; -printf "%s %s %s %s %s %s %s %s %s %s\n", ng(1,5), ng(2,5), ng(3,5), ng(4,5), ng(5,5), ng(6,5), ng(7,5), ng(8,5), ng(9,5), ng(10,5) ; -printf "%s %s %s %s %s %s %s %s %s %s\n", ng(1,6), ng(2,6), ng(3,6), ng(4,6), ng(5,6), ng(6,6), ng(7,6), ng(8,6), ng(9,6), ng(10,6) ; -printf "%s %s %s %s %s %s %s %s %s %s\n", ng(1,7), ng(2,7), ng(3,7), ng(4,7), ng(5,7), ng(6,7), ng(7,7), ng(8,7), ng(9,7), ng(10,7) ; -printf "%s %s %s %s %s %s %s %s %s %s\n", ng(1,8), ng(2,8), ng(3,8), ng(4,8), ng(5,8), ng(6,8), ng(7,8), ng(8,8), ng(9,8), ng(10,8) ; -printf "%s %s %s %s %s %s %s %s %s %s\n", ng(1,9), ng(2,9), ng(3,9), ng(4,9), ng(5,9), ng(6,9), ng(7,9), ng(8,9), ng(9,9), ng(10,9) ; +use ntheory qw/vecprod/; + +sub mfac { + my($n,$d) = @_; + vecprod(map { $n - $_*$d } 0 .. int(($n-1)/$d)); +} + +for my $degree (1..5) { + say "$degree: ",join(" ",map{mfac($_,$degree)} 1..10); +} diff --git a/Task/Multifactorial/Perl/multifactorial.pl b/Task/Multifactorial/Perl/multifactorial.pl deleted file mode 100644 index d44b3e3ca3..0000000000 --- a/Task/Multifactorial/Perl/multifactorial.pl +++ /dev/null @@ -1,14 +0,0 @@ -{ # <-- scoping the cache and bigint clause - my @cache; - use bigint; - sub mfact { - my ($s, $n) = @_; - return 1 if $n <= 0; - $cache[$s][$n] //= $n * mfact($s, $n - $s); - } -} - -for my $s (1 .. 10) { - print "step=$s: "; - print join(" ", map(mfact($s, $_), 1 .. 10)), "\n"; -} diff --git a/Task/Multifactorial/PicoLisp/multifactorial.l b/Task/Multifactorial/PicoLisp/multifactorial.l new file mode 100644 index 0000000000..e3589c7dac --- /dev/null +++ b/Task/Multifactorial/PicoLisp/multifactorial.l @@ -0,0 +1,11 @@ +(de multifact (N Deg) + (let Res N + (while (> N Deg) + (setq Res (* Res (dec 'N Deg))) ) + Res ) ) + +(for I 5 + (prin "Degree " I ":") + (for J 10 + (prin " " (multifact J I)) ) + (prinl) ) diff --git a/Task/Multifactorial/R/multifactorial.r b/Task/Multifactorial/R/multifactorial.r new file mode 100644 index 0000000000..7c545bff63 --- /dev/null +++ b/Task/Multifactorial/R/multifactorial.r @@ -0,0 +1,9 @@ +#x is Input +#n is Factorial Number +multifactorial=function(x,n){ + if(x<=n+1){ + return(x) + }else{ + return(x*multifactorial(x-n,n)) + } +} diff --git a/Task/Multifactorial/REXX/multifactorial.rexx b/Task/Multifactorial/REXX/multifactorial.rexx index 01dfe9f0c9..2067415d44 100644 --- a/Task/Multifactorial/REXX/multifactorial.rexx +++ b/Task/Multifactorial/REXX/multifactorial.rexx @@ -1,21 +1,18 @@ -/*REXX program calculates K-fact (multifactorial) of non-negative integers. */ -numeric digits 1000 /*get ka-razy with the decimal digits. */ -parse arg num deg . /*get optional arguments from the C.L. */ -if num=='' | num==',' then num=15 /*Not specified? Then use the default.*/ -if deg=='' | deg==',' then deg=10 /* " " " " " " */ -say '═══showing multiple factorials (1 ──►' deg") for numbers 1 ──►" num +/*REXX program calculates and displays K-fact (multifactorial) of non-negative integers.*/ +numeric digits 1000 /*get ka-razy with the decimal digits. */ +parse arg num deg . /*get optional arguments from the C.L. */ +if num=='' | num=="," then num=15 /*Not specified? Then use the default.*/ +if deg=='' | deg=="," then deg=10 /* " " " " " " */ +say '═══showing multiple factorials (1 ──►' deg") for numbers 1 ──►" num say - do d=1 for deg /*the factorializing (degree) of !'s.*/ - _= /*the list of factorials (so far). */ - do f=1 for num /* ◄── perform a ! from 1 ───► number.*/ - _=_ Kfact(f, d) /*build a list of factorial products. */ - end /*f*/ /*(above) D can default to unity. */ + do d=1 for deg /*the factorializing (degree) of !'s.*/ + _= /*the list of factorials (so far). */ + do f=1 for num /* ◄── perform a ! from 1 ───► number.*/ + _=_ Kfact(f, d) /*build a list of factorial products.*/ + end /*f*/ /* [↑] D can default to unity. */ - say right('n'copies("!", d),1+deg) right('['d"]", 2+length(num))':' _ + say right('n'copies("!", d), 1+deg) right('['d"]", 2+length(num) )':' _ end /*d*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -Kfact: procedure; !=1; do j=arg(1) to 2 by -word(arg(2) 1, 1) - !=!*j - end /*j*/ - return ! +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +Kfact: procedure; !=1; do j=arg(1) to 2 by -word(arg(2) 1,1); !=!*j; end; return ! diff --git a/Task/Multifactorial/Ruby/multifactorial.rb b/Task/Multifactorial/Ruby/multifactorial-1.rb similarity index 100% rename from Task/Multifactorial/Ruby/multifactorial.rb rename to Task/Multifactorial/Ruby/multifactorial-1.rb diff --git a/Task/Multifactorial/Ruby/multifactorial-2.rb b/Task/Multifactorial/Ruby/multifactorial-2.rb new file mode 100644 index 0000000000..7b1c44120e --- /dev/null +++ b/Task/Multifactorial/Ruby/multifactorial-2.rb @@ -0,0 +1,17 @@ +print "Degree " + "|" + " Multifactorials 1 to 10" + nl +print copy("-", 52) + nl +for d = 1 to 5 + print "" + d + " " + "| " + for n = 1 to 10 + print "" + multiFact(n, d) + " "; + next + print +next + +function multiFact(n,degree) + fact = 1 + for i = n to 2 step -degree + fact = fact * i + next + multiFact = fact + end function diff --git a/Task/Multifactorial/Scala/multifactorial.scala b/Task/Multifactorial/Scala/multifactorial.scala new file mode 100644 index 0000000000..a63e6aea28 --- /dev/null +++ b/Task/Multifactorial/Scala/multifactorial.scala @@ -0,0 +1,6 @@ +def multiFact(n : BigInt, degree : BigInt) = (n to 1 by -degree).product + +for{ + degree <- 1 to 5 + str = (1 to 10).map(n => multiFact(n, degree)).mkString(" ") +} println(s"Degree $degree: $str") diff --git a/Task/Multiple-distinct-objects/00DESCRIPTION b/Task/Multiple-distinct-objects/00DESCRIPTION index dd8a4fa8b3..9fff69e5d1 100644 --- a/Task/Multiple-distinct-objects/00DESCRIPTION +++ b/Task/Multiple-distinct-objects/00DESCRIPTION @@ -7,3 +7,5 @@ By ''initialized'' we mean that each item must be in a well-defined state approp This task was inspired by the common error of intending to do this, but instead creating a sequence of n references to the ''same'' mutable object; it might be informative to show the way to do that as well, both as a negative example and as how to do it when that's all that's actually necessary. This task is most relevant to languages operating in the pass-references-by-value style (most object-oriented, garbage-collected, and/or 'dynamic' languages). + +See also: [[Closures/Value capture]] diff --git a/Task/Multiple-distinct-objects/AppleScript/multiple-distinct-objects-1.applescript b/Task/Multiple-distinct-objects/AppleScript/multiple-distinct-objects-1.applescript new file mode 100644 index 0000000000..9ac8d0e864 --- /dev/null +++ b/Task/Multiple-distinct-objects/AppleScript/multiple-distinct-objects-1.applescript @@ -0,0 +1,62 @@ +-- nObjects Constructor -> Int -> [Object] +on nObjects(f, n) + map(f, range(1, n)) +end nObjects + + +-- TEST +on run + + -- someConstructor :: a -> Int -> b + script someConstructor + on lambda(_, i) + {index:i} + end lambda + end script + + nObjects(someConstructor, 6) + + --> {{index:1}, {index:2}, {index:3}, {index:4}, {index:5}, {index:6}} +end run + + + +-- GENERIC FUNCTIONS ----------------------------------------------------------- + +-- 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 + +-- 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 + +-- range :: Int -> Int -> [Int] +on range(m, n) + if n < m then + set d to -1 + else + set d to 1 + end if + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range diff --git a/Task/Multiple-distinct-objects/AppleScript/multiple-distinct-objects-2.applescript b/Task/Multiple-distinct-objects/AppleScript/multiple-distinct-objects-2.applescript new file mode 100644 index 0000000000..182f42212d --- /dev/null +++ b/Task/Multiple-distinct-objects/AppleScript/multiple-distinct-objects-2.applescript @@ -0,0 +1 @@ +{{index:1}, {index:2}, {index:3}, {index:4}, {index:5}, {index:6}} diff --git a/Task/Multiple-distinct-objects/Elixir/multiple-distinct-objects.elixir b/Task/Multiple-distinct-objects/Elixir/multiple-distinct-objects.elixir index 00666e38ca..42de7c9351 100644 --- a/Task/Multiple-distinct-objects/Elixir/multiple-distinct-objects.elixir +++ b/Task/Multiple-distinct-objects/Elixir/multiple-distinct-objects.elixir @@ -1 +1 @@ -randoms = for _ <- 1..10, do: :random.uniform(1000) +randoms = for _ <- 1..10, do: :rand.uniform(1000) diff --git a/Task/Multiple-distinct-objects/JavaScript/multiple-distinct-objects.js b/Task/Multiple-distinct-objects/JavaScript/multiple-distinct-objects-1.js similarity index 100% rename from Task/Multiple-distinct-objects/JavaScript/multiple-distinct-objects.js rename to Task/Multiple-distinct-objects/JavaScript/multiple-distinct-objects-1.js diff --git a/Task/Multiple-distinct-objects/JavaScript/multiple-distinct-objects-2.js b/Task/Multiple-distinct-objects/JavaScript/multiple-distinct-objects-2.js new file mode 100644 index 0000000000..4393ef5002 --- /dev/null +++ b/Task/Multiple-distinct-objects/JavaScript/multiple-distinct-objects-2.js @@ -0,0 +1,14 @@ +(n => { + + let nObjects = n => Array.from({ + length: n + 1 + }, (_, i) => { + // optionally indexed object constructor + return { + index: i + }; + }); + + return nObjects(6); + +})(6); diff --git a/Task/Multiple-distinct-objects/JavaScript/multiple-distinct-objects-3.js b/Task/Multiple-distinct-objects/JavaScript/multiple-distinct-objects-3.js new file mode 100644 index 0000000000..b733ef89e3 --- /dev/null +++ b/Task/Multiple-distinct-objects/JavaScript/multiple-distinct-objects-3.js @@ -0,0 +1,2 @@ +[{"index":0}, {"index":1}, {"index":2}, {"index":3}, +{"index":4}, {"index":5}, {"index":6}] diff --git a/Task/Multiple-distinct-objects/Lua/multiple-distinct-objects.lua b/Task/Multiple-distinct-objects/Lua/multiple-distinct-objects.lua new file mode 100644 index 0000000000..1026882ab6 --- /dev/null +++ b/Task/Multiple-distinct-objects/Lua/multiple-distinct-objects.lua @@ -0,0 +1,17 @@ +-- This concept is relevant to tables in Lua +local table1 = {1,2,3} + +-- The following will create a table of references to table1 +local refTab = {} +for i = 1, 10 do refTab[i] = table1 end + +-- Instead, tables should be copied using a function like this +function copy (t) + local new = {} + for k, v in pairs(t) do new[k] = v end + return new +end + +-- Now we can create a table of independent copies of table1 +local copyTab = {} +for i = 1, 10 do copyTab[i] = copy(table1) end diff --git a/Task/Multiple-distinct-objects/PowerShell/multiple-distinct-objects-1.psh b/Task/Multiple-distinct-objects/PowerShell/multiple-distinct-objects-1.psh new file mode 100644 index 0000000000..f99bd0ca21 --- /dev/null +++ b/Task/Multiple-distinct-objects/PowerShell/multiple-distinct-objects-1.psh @@ -0,0 +1,3 @@ +1..3 | ForEach-Object {((Get-Date -Hour ($_ + (1..4 | Get-Random))).AddDays($_ + (1..4 | Get-Random)))} | + Select-Object -Unique | + ForEach-Object {$_.ToString()} diff --git a/Task/Multiple-distinct-objects/PowerShell/multiple-distinct-objects-2.psh b/Task/Multiple-distinct-objects/PowerShell/multiple-distinct-objects-2.psh new file mode 100644 index 0000000000..f99bd0ca21 --- /dev/null +++ b/Task/Multiple-distinct-objects/PowerShell/multiple-distinct-objects-2.psh @@ -0,0 +1,3 @@ +1..3 | ForEach-Object {((Get-Date -Hour ($_ + (1..4 | Get-Random))).AddDays($_ + (1..4 | Get-Random)))} | + Select-Object -Unique | + ForEach-Object {$_.ToString()} diff --git a/Task/Multiple-regression/00DESCRIPTION b/Task/Multiple-regression/00DESCRIPTION index ab28c8a349..2624e193bb 100644 --- a/Task/Multiple-regression/00DESCRIPTION +++ b/Task/Multiple-regression/00DESCRIPTION @@ -1,13 +1,13 @@ +;Task: Given a set of data vectors in the following format: -y = \{ y_1, y_2, ..., y_n \}\, + y = \{ y_1, y_2, ..., y_n \}\, -X_i = \{ x_{i1}, x_{i2}, ..., x_{in} \}, i \in 1..k\, + X_i = \{ x_{i1}, x_{i2}, ..., x_{in} \}, i \in 1..k\, -Compute the vector \beta = \{ \beta_1, \beta_2, ..., \beta_k \} using -[[wp:Ordinary least squares|ordinary least squares]] regression using the following equation: +Compute the vector \beta = \{ \beta_1, \beta_2, ..., \beta_k \} using [[wp:Ordinary least squares|ordinary least squares]] regression using the following equation: -y_j = \Sigma_i \beta_i \cdot x_{ij} , j \in 1..n + y_j = \Sigma_i \beta_i \cdot x_{ij} , j \in 1..n -You can assume y is given to you as a vector (a one-dimensional array), -and X is given to you as a two-dimensional array (i.e. matrix). +You can assume y is given to you as a vector (a one-dimensional array), and X is given to you as a two-dimensional array (i.e. matrix). +

    diff --git a/Task/Multiple-regression/Perl-6/multiple-regression.pl6 b/Task/Multiple-regression/Perl-6/multiple-regression.pl6 new file mode 100644 index 0000000000..b8a426784c --- /dev/null +++ b/Task/Multiple-regression/Perl-6/multiple-regression.pl6 @@ -0,0 +1,16 @@ +use Clifford; +my @height = <1.47 1.50 1.52 1.55 1.57 1.60 1.63 1.65 1.68 1.70 1.73 1.75 1.78 1.80 1.83>; +my @weight = <52.21 53.12 54.48 55.84 57.20 58.57 59.93 61.29 63.11 64.47 66.28 68.10 69.92 72.19 74.46>; + +my $w = [+] @weight Z* @e; + +my $h0 = [+] @e[^@weight]; +my $h1 = [+] @height Z* @e; +my $h2 = [+] (@height X** 2) Z* @e; + +my $I = $h0∧$h1∧$h2; +my $I2 = ($I·$I.reversion).Real; + +say "α = ", ($w∧$h1∧$h2)·$I.reversion/$I2; +say "β = ", ($w∧$h2∧$h0)·$I.reversion/$I2; +say "γ = ", ($w∧$h0∧$h1)·$I.reversion/$I2; diff --git a/Task/Multiplication-tables/00DESCRIPTION b/Task/Multiplication-tables/00DESCRIPTION index 75d653800e..d2313ff2b1 100644 --- a/Task/Multiplication-tables/00DESCRIPTION +++ b/Task/Multiplication-tables/00DESCRIPTION @@ -1,3 +1,6 @@ -Produce a formatted 12×12 multiplication table of the kind memorised by rote when in primary school. +;Task: +Produce a formatted   12×12   multiplication table of the kind memorized by rote when in primary (or elementary) school. + Only print the top half triangle of products. +

    diff --git a/Task/Multiplication-tables/AppleScript/multiplication-tables.applescript b/Task/Multiplication-tables/AppleScript/multiplication-tables-1.applescript similarity index 100% rename from Task/Multiplication-tables/AppleScript/multiplication-tables.applescript rename to Task/Multiplication-tables/AppleScript/multiplication-tables-1.applescript diff --git a/Task/Multiplication-tables/AppleScript/multiplication-tables-2.applescript b/Task/Multiplication-tables/AppleScript/multiplication-tables-2.applescript new file mode 100644 index 0000000000..98b3c97038 --- /dev/null +++ b/Task/Multiplication-tables/AppleScript/multiplication-tables-2.applescript @@ -0,0 +1,124 @@ +-- MULTIPLICATION TABLE FOR INTEGERS M TO N + +-- table :: Int -> Int -> [[String]] +on table(m, n) + + set axis to range(m, n) + + script column + on lambda(x) + script row + on lambda(y) + if y < x then + {""} + else + {(x * y) as text} + end if + end lambda + end script + + {x & map(row, axis)} + end lambda + end script + + {{"x"} & axis} & concatMap(column, axis) +end table + + +on run + + tableText(table(1, 12)) + +end run + + +-- TABLE DISPLAY + +-- tableText :: [[String]] -> String +on tableText(lstTable) + script tableLine + on lambda(lstLine) + script tableCell + on lambda(cell) + (characters -4 thru -1 of (" " & cell)) as string + end lambda + end script + + intercalate(" ", map(tableCell, lstLine)) + end lambda + end script + + intercalate(linefeed, map(tableLine, lstTable)) +end tableText + + +-- GENERIC LIBRARY FUNCTIONS + +-- concatMap :: (a -> [b]) -> [a] -> [b] +on concatMap(f, xs) + script append + on lambda(a, b) + a & b + end lambda + end script + + foldl(append, {}, map(f, xs)) +end concatMap + +-- 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 + +-- 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 + +-- 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 + +-- range :: Int -> Int -> [Int] +on range(m, n) + if n < m then + set d to -1 + else + set d to 1 + end if + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range + +-- intercalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate diff --git a/Task/Multiplication-tables/C/multiplication-tables.c b/Task/Multiplication-tables/C/multiplication-tables.c index ae132d1d00..914ac4e10c 100644 --- a/Task/Multiplication-tables/C/multiplication-tables.c +++ b/Task/Multiplication-tables/C/multiplication-tables.c @@ -1,13 +1,17 @@ -int main() +#include + +int main(void) { int i, j, n = 12; - for (j = 1; j <= n; j++) printf("%3d%c", j, j - n ? ' ':'\n'); - for (j = 0; j <= n; j++) printf(j - n ? "----" : "+\n"); + for (j = 1; j <= n; j++) printf("%3d%c", j, j != n ? ' ' : '\n'); + for (j = 0; j <= n; j++) printf(j != n ? "----" : "+\n"); - for (i = 1; i <= n; printf("| %d\n", i++)) + for (i = 1; i <= n; i++) { for (j = 1; j <= n; j++) printf(j < i ? " " : "%3d ", i * j); + printf("| %d\n", i); + } return 0; } diff --git a/Task/Multiplication-tables/COBOL/multiplication-tables.cobol b/Task/Multiplication-tables/COBOL/multiplication-tables.cobol new file mode 100644 index 0000000000..e353bf3474 --- /dev/null +++ b/Task/Multiplication-tables/COBOL/multiplication-tables.cobol @@ -0,0 +1,46 @@ + identification division. + program-id. multiplication-table. + + environment division. + configuration section. + repository. + function all intrinsic. + + data division. + working-storage section. + 01 multiplication. + 05 rows occurs 12 times. + 10 colm occurs 12 times. + 15 num pic 999. + 77 cand pic 99. + 77 ier pic 99. + 77 ind pic z9. + 77 show pic zz9. + + procedure division. + sample-main. + perform varying cand from 1 by 1 until cand greater than 12 + after ier from 1 by 1 until ier greater than 12 + multiply cand by ier giving num(cand, ier) + end-perform + + perform varying cand from 1 by 1 until cand greater than 12 + move cand to ind + display "x " ind "| " with no advancing + perform varying ier from 1 by 1 until ier greater than 12 + if ier greater than or equal to cand then + move num(cand, ier) to show + display show with no advancing + if ier equal to 12 then + display "|" + else + display space with no advancing + end-if + else + display " " with no advancing + end-if + end-perform + end-perform + + goback. + end program multiplication-table. diff --git a/Task/Multiplication-tables/Fortran/multiplication-tables-4.f b/Task/Multiplication-tables/Fortran/multiplication-tables-4.f new file mode 100644 index 0000000000..7008a2dc22 --- /dev/null +++ b/Task/Multiplication-tables/Fortran/multiplication-tables-4.f @@ -0,0 +1,24 @@ + PROGRAM TABLES + IMPLICIT NONE +C +C Produce a formatted multiplication table of the kind memorised by rote +C when in primary school. Only print the top half triangle of products. +C +C 23 Nov 15 - 0.1 - Adapted from original for VAX FORTRAN - MEJT +C + INTEGER I,J,K ! Counters. + CHARACTER*32 S ! Buffer for format specifier. +C + K=12 +C + WRITE(S,1) K,K + 1 FORMAT(8H(4H0 |,,I2.2,11HI4,/,4H --+,I2.2,9H(4H----))) + WRITE(6,S) (I,I = 1,K) ! Print heading. +C + DO 3 I=1,K ! Step down the lines. + WRITE(S,2) (I-1)*4+1,K ! Update format string. + 2 FORMAT(12H(1H ,I2,1H|,,I2.2,5HX,I3,,I2.2,3HI4),8X) ! Format string includes an explicit carridge control character. + WRITE(6,S) I,(I*J, J = I,K) ! Use format to print row with leading blanks, unused fields are ignored. + 3 CONTINUE +C + END diff --git a/Task/Multiplication-tables/Fortran/multiplication-tables-5.f b/Task/Multiplication-tables/Fortran/multiplication-tables-5.f new file mode 100644 index 0000000000..91e5ceace3 --- /dev/null +++ b/Task/Multiplication-tables/Fortran/multiplication-tables-5.f @@ -0,0 +1,35 @@ + PROGRAM TABLES +C +C Produce a formatted multiplication table of the kind memorised by rote +C when in primary school. Only print the top half triangle of products. +C +C 23 Nov 15 - 0.1 - Adapted from original for VAX FORTRAN - MEJT +C 24 Nov 15 - 0.2 - FORTRAN IV version adapted from VAX FORTRAN and +C compiled using Microsoft FORTRAN-80 - MEJT +C + DIMENSION K(12) + DIMENSION A(6) + DIMENSION L(12) +C + COMMON //A + EQUIVALENCE (A(1),L(1)) +C + DATA A/'(1H ',',I2,','1H|,','01X,','I3,1','2I4)'/ +C + WRITE(1,1) (I,I=1,12) + 1 FORMAT(4H0 |,12I4,/,4H --+12(4H----)) +C +C Overlaying the format specifier with an integer array makes it possibe +C to modify the number of blank spaces. The number of blank spaces is +C stored as two consecuitive ASCII characters that overlay on the +C integer value in L(7) in the ordr low byte, high byte. +C + DO 3 I=1,12 + L(7)=(48+(I*4-3)-((I*4-3)/10)*10)*256+48+((I*4-3)/10) + DO 2 J=1,12 + K(J)=I*J + 2 CONTINUE + WRITE(1,A)I,(K(J), J = I,12) + 3 CONTINUE +C + END diff --git a/Task/Multiplication-tables/Fortran/multiplication-tables-6.f b/Task/Multiplication-tables/Fortran/multiplication-tables-6.f new file mode 100644 index 0000000000..8ad8d70bbc --- /dev/null +++ b/Task/Multiplication-tables/Fortran/multiplication-tables-6.f @@ -0,0 +1,33 @@ + PROGRAM TABLES +C +C Produce a formatted multiplication table of the kind memorised by rote +C when in primary school. Only print the top half triangle of products. +C +C 23 Nov 15 - 0.1 - Adapted from original for VAX FORTRAN - MEJT +C 24 Nov 15 - 0.2 - FORTRAN IV version adapted from VAX FORTRAN and +C compiled using Microsoft FORTRAN-80 - MEJT +C 25 Nov 15 - 0.3 - Microsoft FORTRAN-80 version using a BYTE array +C which makes it easier to understand what is going +C on. - MEJT +C + BYTE A + DIMENSION A(24) + DIMENSION K(12) +C + DATA A/'(','1','H',' ',',','I','2',',','1','H','|',',', + + '0','1','X',',','I','3',',','1','1','I','4',')'/ +C +C Print a heading and (try to) underline it. +C + WRITE(1,1) (I,I=1,12) + 1 FORMAT(4H |,12I4,/,4H --+12(4H----)) + DO 3 I=1,12 + A(13)=48+((I*4-3)/10) + A(14)=48+(I*4-3)-((I*4-3)/10)*10 + DO 2 J=1,12 + K(J)=I*J + 2 CONTINUE + WRITE(1,A)I,(K(J), J = I,12) + 3 CONTINUE +C + END diff --git a/Task/Multiplication-tables/Fortran/multiplication-tables-7.f b/Task/Multiplication-tables/Fortran/multiplication-tables-7.f new file mode 100644 index 0000000000..dd0e2d5eae --- /dev/null +++ b/Task/Multiplication-tables/Fortran/multiplication-tables-7.f @@ -0,0 +1,2 @@ + WRITE(1,4) (A(J), J = 1,24) + 4 FORMAT(1x,24A1) diff --git a/Task/Multiplication-tables/Fortran/multiplication-tables-8.f b/Task/Multiplication-tables/Fortran/multiplication-tables-8.f new file mode 100644 index 0000000000..17dd41e405 --- /dev/null +++ b/Task/Multiplication-tables/Fortran/multiplication-tables-8.f @@ -0,0 +1,14 @@ + | 1 2 3 4 5 6 7 8 9 10 11 12 +--+------------------------------------------------ + 1| 1 2 3 4 5 6 7 8 9 10 11 12 + 2| 4 6 8 10 12 14 16 18 20 22 24 + 3| 9 12 15 18 21 24 27 30 33 36 + 4| 16 20 24 28 32 36 40 44 48 + 5| 25 30 35 40 45 50 55 60 + 6| 36 42 48 54 60 66 72 + 7| 49 56 63 70 77 84 + 8| 64 72 80 88 96 + 9| 81 90 99 108 +10| 100 110 120 +11| 121 132 +12| 144 diff --git a/Task/Multiplication-tables/Java/multiplication-tables.java b/Task/Multiplication-tables/Java/multiplication-tables.java index 7490f0e700..fd3bbef1d2 100644 --- a/Task/Multiplication-tables/Java/multiplication-tables.java +++ b/Task/Multiplication-tables/Java/multiplication-tables.java @@ -1,24 +1,20 @@ -public class MulTable{ - public static void main(String args[]){ - int i,j; - for(i=1;i<=12;i++) - { - System.out.print("\t"+i); - } +public class MultiplicationTable { + public static void main(String[] args) { + for (int i = 1; i <= 12; i++) + System.out.print("\t" + i); - System.out.println(""); - for(i=0;i<100;i++) + System.out.println(); + for (int i = 0; i < 100; i++) System.out.print("-"); - System.out.println(""); - for(i=1;i<=12;i++){ - System.out.print(""+i+"|"); - for(j=1;j<=12;j++){ - if(j= i) + System.out.print("\t" + i * j); } - System.out.println(""); + System.out.println(); } } } diff --git a/Task/Multiplication-tables/JavaScript/multiplication-tables-2.js b/Task/Multiplication-tables/JavaScript/multiplication-tables-2.js index 222b8b53f4..c07c758edb 100644 --- a/Task/Multiplication-tables/JavaScript/multiplication-tables-2.js +++ b/Task/Multiplication-tables/JavaScript/multiplication-tables-2.js @@ -8,22 +8,19 @@ } // Monadic bind (chain) for lists - function chain(xs, f) { + function mb(xs, f) { return [].concat.apply([], xs.map(f)); } - var lstRange = range(m, n), + var rng = range(m, n), - lstTable = [['x'].concat(lstRange)].concat( - chain(lstRange, function (y) { - return [[y].concat( - chain(lstRange, function (x) { - return x < y ? [''] : [x * y]; // triangle only - }) - )] - }) - ); + lstTable = [['x'].concat( rng )] + .concat(mb(rng, function (x) { + return [[x].concat(mb(rng, function (y) { + return y < x ? [''] : [x * y]; // triangle only + + }))]})); /* FORMATTING OUTPUT */ diff --git a/Task/Multiplication-tables/Maple/multiplication-tables.maple b/Task/Multiplication-tables/Maple/multiplication-tables.maple new file mode 100644 index 0000000000..c801f6b58b --- /dev/null +++ b/Task/Multiplication-tables/Maple/multiplication-tables.maple @@ -0,0 +1,18 @@ +printf(" "); +for i to 12 do + printf("%-3d ", i); +end do; +printf("\n"); +for i to 75 do + printf("-"); +end do; +for i to 12 do + printf("\n%2d| ", i); + for j to 12 do + if j123456789101112" +For i = 1 To 12 + html "";i;"" + For ii = 1 To 12 + html "" + If ii >= i Then html i * ii + html "" + Next ii +next i +html "" diff --git a/Task/Multiplication-tables/Rust/multiplication-tables.rust b/Task/Multiplication-tables/Rust/multiplication-tables.rust new file mode 100644 index 0000000000..04dc6055ed --- /dev/null +++ b/Task/Multiplication-tables/Rust/multiplication-tables.rust @@ -0,0 +1,23 @@ +const LIMIT: i32 = 12; + +fn main() { + for i in 1..LIMIT+1 { + print!("{:3}{}", i, if LIMIT - i == 0 {'\n'} else {' '}) + } + for i in 0..LIMIT+1 { + print!("{}", if LIMIT - i == 0 {"+\n"} else {"----"}); + } + + for i in 1..LIMIT+1 { + for j in 1..LIMIT+1 { + if j < i { + print!(" ") + } else { + print!("{:3} ", j * i) + } + } + println!("| {}", i); + } + + +} diff --git a/Task/Multiplication-tables/Simula/multiplication-tables.simula b/Task/Multiplication-tables/Simula/multiplication-tables.simula new file mode 100644 index 0000000000..43b193b3d6 --- /dev/null +++ b/Task/Multiplication-tables/Simula/multiplication-tables.simula @@ -0,0 +1,17 @@ +begin + integer i, j; + outtext( " " ); + for i := 1 step 1 until 12 do outint( i, 4 ); + outimage; + outtext( " +" ); + for i := 1 step 1 until 12 do outtext( "----" ); + outimage; + for i := 1 step 1 until 12 do + begin + outint( i, 3 ); + outtext( "|" ); + for j := 1 step 1 until i - 1 do outtext( " " ); + for j := i step 1 until 12 do outint( i * j, 4 ); + outimage + end; +end diff --git a/Task/Multiplicative-order/00DESCRIPTION b/Task/Multiplicative-order/00DESCRIPTION index b1face1def..6434328adb 100644 --- a/Task/Multiplicative-order/00DESCRIPTION +++ b/Task/Multiplicative-order/00DESCRIPTION @@ -1,10 +1,17 @@ The '''multiplicative order''' of ''a'' relative to ''m'' is the least positive integer ''n'' such that ''a^n'' is 1 (modulo ''m''). -For example, the multiplicative order of 37 relative to 1000 is 100 because 37^100 is 1 (modulo 1000), and no number smaller than 100 would do. + + +;Example: +The multiplicative order of 37 relative to 1000 is 100 because 37^100 is 1 (modulo 1000), and no number smaller than 100 would do. + One possible algorithm that is efficient also for large numbers is the following: By the [[wp:Chinese_Remainder_Theorem|Chinese Remainder Theorem]], it's enough to calculate the multiplicative order for each prime exponent ''p^k'' of ''m'', and combine the results with the ''[[least common multiple]]'' operation. -Now the order of ''a'' wrt. to ''p^k'' must divide ''Φ(p^k)''. Call this number ''t'', and determine it's factors ''q^e''. Since each multiple of the order will also yield 1 when used as exponent for ''a'', it's enough to find the least d such that ''(q^d)*(t/(q^e))'' yields 1 when used as exponent. +Now the order of ''a'' with regard to ''p^k'' must divide ''Φ(p^k)''. Call this number ''t'', and determine it's factors ''q^e''. Since each multiple of the order will also yield 1 when used as exponent for ''a'', it's enough to find the least d such that ''(q^d)*(t/(q^e))'' yields 1 when used as exponent. + + +;Task: Implement a routine to calculate the multiplicative order along these lines. You may assume that routines to determine the factorization into prime powers are available in some library. ---- @@ -14,7 +21,7 @@ An algorithm for the multiplicative order can be found in Bach & Shallit, Alg

    Exercise 5.8, page 115:

    Suppose you are given a prime p and a complete factorization -of p-1 . Show how to compute the order of an +of p-1.   Show how to compute the order of an element a in (Z/(p))* using O((lg p)4/(lg lg p)) bit operations.

    @@ -22,8 +29,7 @@ operations.

    Let the prime factorization of p-1 be q1e1q2e2...qkek . We use the following observation: if x^((p-1)/qifi) = 1 (mod p) , -and fi=ei or x^((p-1)/qifi+1) != 1 (mod p) , then qiei-fi||ordp x . -(This follows by combining Exercises 5.1 and 2.10.) +and fi=ei or x^((p-1)/qifi+1) != 1 (mod p) , then qiei-fi||ordp x.   (This follows by combining Exercises 5.1 and 2.10.) Hence it suffices to find, for each i , the exponent fi such that the condition above holds.

    @@ -34,4 +40,5 @@ compute x1=ay1(mod p), ... , xk=ayk(mod p) . This can be done using O(k(lg p)3) bit operations, and k=O((lg p)/(lg lg p)) by Theorem 8.8.10. Finally, for each i , repeatedly raise xi to the qi-th power (mod p) (as many as ei-1 times), checking to see when 1 is obtained. This can be done using O((lg p)3) steps. -The total cost is dominated by O(k(lg p)3) , which is O((lg p)4/(lg lg p)) . +The total cost is dominated by O(k(lg p)3) , which is O((lg p)4/(lg lg p)). +

    diff --git a/Task/Multiplicative-order/Ruby/multiplicative-order.rb b/Task/Multiplicative-order/Ruby/multiplicative-order.rb index 65b0656e90..bbd8dba8cb 100644 --- a/Task/Multiplicative-order/Ruby/multiplicative-order.rb +++ b/Task/Multiplicative-order/Ruby/multiplicative-order.rb @@ -1,16 +1,10 @@ -require 'rational' # for lcm -require 'mathn' # for prime_division +require 'prime' def powerMod(b, p, m) - result = 1 - bits = p.to_s(2) - for bit in bits.split('') + p.to_s(2).each_char.inject(1) do |result, bit| result = (result * result) % m - if bit == '1' - result = (result * b) % m - end + bit=='1' ? (result * b) % m : result end - result end def multOrder_(a, p, k) @@ -18,7 +12,7 @@ def multOrder_(a, p, k) t = (p - 1) * p ** (k - 1) r = 1 for q, e in t.prime_division - x = powerMod(a, t / q ** e, pk) + x = powerMod(a, t / q**e, pk) while x != 1 r *= q x = powerMod(x, q, pk) @@ -28,15 +22,15 @@ def multOrder_(a, p, k) end def multOrder(a, m) - m.prime_division.inject(1) {|result, f| + m.prime_division.inject(1) do |result, f| result.lcm(multOrder_(a, *f)) - } + end end -puts multOrder(37, 1000) # 100 +puts multOrder(37, 1000) b = 10**20-1 -puts multOrder(2, b) # 3748806900 -puts multOrder(17,b) # 1499522760 +puts multOrder(2, b) +puts multOrder(17,b) b = 100001 puts multOrder(54,b) puts powerMod(54, multOrder(54,b), b) diff --git a/Task/Multisplit/Lua/multisplit.lua b/Task/Multisplit/Lua/multisplit.lua new file mode 100644 index 0000000000..89b33421b6 --- /dev/null +++ b/Task/Multisplit/Lua/multisplit.lua @@ -0,0 +1,53 @@ +--[[ +Returns a table of substrings by splitting the given string on +occurrences of the given character delimiters, which may be specified +as a single- or multi-character string or a table of such strings. +If chars is omitted, it defaults to the set of all space characters, +and keep is taken to be false. The limit and keep arguments are +optional: they are a maximum size for the result and a flag +determining whether empty fields should be kept in the result. +]] +function split (str, chars, limit, keep) + local limit, splitTable, entry, pos, match = limit or 0, {}, "", 1 + if keep == nil then keep = true end + if not chars then + for e in string.gmatch(str, "%S+") do + table.insert(splitTable, e) + end + return splitTable + end + while pos <= str:len() do + match = nil + if type(chars) == "table" then + for _, delim in pairs(chars) do + if str:sub(pos, pos + delim:len() - 1) == delim then + match = string.len(delim) - 1 + break + end + end + elseif str:sub(pos, pos + chars:len() - 1) == chars then + match = string.len(chars) - 1 + end + if match then + if not (keep == false and entry == "") then + table.insert(splitTable, entry) + if #splitTable == limit then return splitTable end + entry = "" + end + else + entry = entry .. str:sub(pos, pos) + end + pos = pos + 1 + (match or 0) + end + if entry ~= "" then table.insert(splitTable, entry) end + return splitTable +end + +local multisplit = split("a!===b=!=c", {"==", "!=", "="}) + +-- Returned result is a table (key/value pairs) - display all entries +print("Key\tValue") +print("---\t-----") +for k, v in pairs(multisplit) do + print(k, v) +end diff --git a/Task/Multisplit/Perl-6/multisplit.pl6 b/Task/Multisplit/Perl-6/multisplit.pl6 index c0d2708e4d..be9165bdad 100644 --- a/Task/Multisplit/Perl-6/multisplit.pl6 +++ b/Task/Multisplit/Perl-6/multisplit.pl6 @@ -1,4 +1,4 @@ -sub multisplit($str, @seps) { $str.split(/ ||@seps /, :all) } +sub multisplit($str, @seps) { $str.split(/ ||@seps /, :v) } my @chunks = multisplit( 'a!===b=!=c==d', < == != = > ); diff --git a/Task/Multisplit/PowerShell/multisplit.psh b/Task/Multisplit/PowerShell/multisplit.psh new file mode 100644 index 0000000000..daf4833212 --- /dev/null +++ b/Task/Multisplit/PowerShell/multisplit.psh @@ -0,0 +1,11 @@ +$string = "a!===b=!=c" +$separators = [regex]"(==|!=|=)" + +$matchInfo = $separators.Matches($string) | + Select-Object -Property Index, Value | + Group-Object -Property Value | + Select-Object -Property @{Name="Separator"; Expression={$_.Name}}, + Count, + @{Name="Position" ; Expression={$_.Group.Index}} + +$matchInfo diff --git a/Task/Multisplit/REXX/multisplit.rexx b/Task/Multisplit/REXX/multisplit.rexx index 65f26a3bd1..48feede850 100644 --- a/Task/Multisplit/REXX/multisplit.rexx +++ b/Task/Multisplit/REXX/multisplit.rexx @@ -1,26 +1,26 @@ -/*REXX program splits a string based on different separator strings.*/ -parse arg ? /*get string from command line. */ -if ?=='' then ? = "a!===b=!=c" /*None specified? Use default.*/ -say 'old string='? /*echo the old string to screen. */ -zz = '0'x /*null char, can be most anything*/ -seps = '== != =' /*a list of seperators to be used*/ - /* [↓] process tokens in SEPS.*/ - do j=1 for words(seps) /*parse string with all the seps.*/ - sep=word(seps,j) /*pick a separator to use now. */ - /* [↓] process chars in the sep*/ - do k=1 for length(sep) /*parse for various sep versions.*/ - sep=strip(insert(zz,sep,k),,zz) /*allow imbedded "nulls" in sep. */ - ?=changestr(sep,?,zz) /* ··· but not trailing "nulls". */ - /* [↓] process strings in input*/ - do until ?==??; ??=? /*keep changing until no more chg*/ - ?=changestr(zz || zz, ?, zz) /*reduce replicated "nulls". */ - end /*until···*/ - /* [↓] use BIF or external prog.*/ - sep=changestr(zz, sep, '') /*remove true nulls from the sep.*/ - end /*k*/ - end /*j*/ +/*REXX program splits a (character) string based on different separator delimiters.*/ +parse arg $ /*obtain optional string from the C.L. */ +if $='' then $= "a!===b=!=c" /*None specified? Then use the default*/ +say 'old string:' $ /*display the old string to the screen.*/ +null= '0'x /*null char. It can be most anything.*/ +seps= '== != =' /*list of separator strings to be used.*/ + /* [↓] process the tokens in SEPS. */ + do j=1 for words(seps) /*parse the string with all the seps. */ + sep=word(seps,j) /*pick a separator to use in below code*/ + /* [↓] process characters in the sep.*/ + do k=1 for length(sep) /*parse for various separator versions.*/ + sep=strip(insert(null, sep, k), , null) /*allow imbedded "nulls" in separator, */ + $=changestr(sep, $, null) /* ··· but not trailing "nulls". */ + /* [↓] process strings in the input. */ + do until $==old; old=$ /*keep changing until no more changes. */ + $=changestr(null || null, $, null) /*reduce replicated "nulls" in string. */ + end /*until*/ + /* [↓] use BIF or external program.*/ + sep=changestr(null, sep, '') /*remove true nulls from the separator.*/ + end /*k*/ + end /*j*/ -showNull = ' {} ' /*one more thing, display the ···*/ -?=changestr(zz,?,showNull) /* ··· showing of "null" chars. */ -say 'new string='? /*now, display the new string. */ - /*stick a fork in it, we're done.*/ +showNull= ' {} ' /*just one more thing, display the ··· */ +$=changestr(null, $, showNull) /* ··· showing of "null" chars. */ +say 'new string:' $ /*now, display the new string to term. */ + /*stick a fork in it, we're all done. */ diff --git a/Task/Munching-squares/BBC-BASIC/munching-squares.bbc b/Task/Munching-squares/BBC-BASIC/munching-squares.bbc new file mode 100644 index 0000000000..860278c75f --- /dev/null +++ b/Task/Munching-squares/BBC-BASIC/munching-squares.bbc @@ -0,0 +1,20 @@ + size% = 256 + + VDU 23,22,size%;size%;8,8,16,0 + OFF + + DIM coltab%(size%-1) + FOR I% = 0 TO size%-1 + coltab%(I%) = ((I% AND &FF) * &010101) EOR &FF0000 + NEXT + + GCOL 1 + FOR I% = 0 TO size%-1 + FOR J% = 0 TO size%-1 + C% = coltab%(I% EOR J%) + COLOUR 1, C%, C%>>8, C%>>16 + PLOT I%*2, J%*2 + NEXT + NEXT I% + + REPEAT WAIT 1 : UNTIL FALSE diff --git a/Task/Munching-squares/Perl-6/munching-squares-2.pl6 b/Task/Munching-squares/Perl-6/munching-squares-2.pl6 index 91ffa56cde..36f7da2256 100644 --- a/Task/Munching-squares/Perl-6/munching-squares-2.pl6 +++ b/Task/Munching-squares/Perl-6/munching-squares-2.pl6 @@ -1,8 +1,8 @@ my @colors = map -> $r, $g, $b { Buf.new: $r, $g, $b }, map -> $x { floor ($x/256) ** 3 * 256 }, - ((0...255) Z + (flat (0...255) Z (255...0) Z - (0,2...254),(254,252...0)); + flat (0,2...254),(254,252...0)); my $PPM = open "munching.ppm", :w, :bin or die "Can't create munching.ppm: $!"; diff --git a/Task/Mutual-recursion/00DESCRIPTION b/Task/Mutual-recursion/00DESCRIPTION index 139500c563..4d032d161a 100644 --- a/Task/Mutual-recursion/00DESCRIPTION +++ b/Task/Mutual-recursion/00DESCRIPTION @@ -2,6 +2,7 @@ Two functions are said to be mutually recursive if the first calls the second, and in turn the second calls the first. Write two mutually recursive functions that compute members of the [[wp:Hofstadter sequence#Hofstadter Female and Male sequences|Hofstadter Female and Male sequences]] defined as: + : \begin{align} F(0)&=1\ ;\ M(0)=0 \\ @@ -9,6 +10,8 @@ F(n)&=n-M(F(n-1)), \quad n>0 \\ M(n)&=n-F(M(n-1)), \quad n>0. \end{align} +
    (If a language does not allow for a solution using mutually recursive functions then state this rather than give a solution by other means). +

    diff --git a/Task/Mutual-recursion/AWK/mutual-recursion.awk b/Task/Mutual-recursion/AWK/mutual-recursion.awk index fa5549b7ff..fc7c53c313 100644 --- a/Task/Mutual-recursion/AWK/mutual-recursion.awk +++ b/Task/Mutual-recursion/AWK/mutual-recursion.awk @@ -1,21 +1,19 @@ +cat mutual_recursion.awk: +#!/usr/local/bin/gawk -f + +# User defined functions function F(n) -{ - if ( n == 0 ) return 1; - return n - M(F(n-1)) -} +{ return n == 0 ? 1 : n - M(F(n-1)) } function M(n) -{ - if ( n == 0 ) return 0; - return n - F(M(n-1)) -} +{ return n == 0 ? 0 : n - F(M(n-1)) } BEGIN { - for(i=0; i < 20; i++) { + for(i=0; i <= 20; i++) { printf "%3d ", F(i) } print "" - for(i=0; i < 20; i++) { + for(i=0; i <= 20; i++) { printf "%3d ", M(i) } print "" diff --git a/Task/Mutual-recursion/AppleScript/mutual-recursion-1.applescript b/Task/Mutual-recursion/AppleScript/mutual-recursion-1.applescript new file mode 100644 index 0000000000..81761e0a51 --- /dev/null +++ b/Task/Mutual-recursion/AppleScript/mutual-recursion-1.applescript @@ -0,0 +1,66 @@ +-- f :: Int -> Int +on f(x) + if x = 0 then + 1 + else + x - m(f(x - 1)) + end if +end f + +-- m :: Int -> Int +on m(x) + if x = 0 then + 0 + else + x - f(m(x - 1)) + end if +end m + + +-- TEST +on run + set xs to range(0, 19) + + {map(f, xs), map(m, xs)} +end run + + +-- GENERIC FUNCTIONS + +-- 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 + +-- 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 + +-- range :: Int -> Int -> [Int] +on range(m, n) + if n < m then + set d to -1 + else + set d to 1 + end if + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range diff --git a/Task/Mutual-recursion/AppleScript/mutual-recursion-2.applescript b/Task/Mutual-recursion/AppleScript/mutual-recursion-2.applescript new file mode 100644 index 0000000000..5b14ba308c --- /dev/null +++ b/Task/Mutual-recursion/AppleScript/mutual-recursion-2.applescript @@ -0,0 +1,2 @@ +{{1, 1, 2, 2, 3, 3, 4, 5, 5, 6, 6, 7, 8, 8, 9, 9, 10, 11, 11, 12}, + {0, 0, 1, 2, 2, 3, 4, 4, 5, 6, 6, 7, 7, 8, 9, 9, 10, 11, 11, 12}} diff --git a/Task/Mutual-recursion/Bc/mutual-recursion-1.bc b/Task/Mutual-recursion/Bc/mutual-recursion-1.bc index a94d0ada0c..a3fa33f0fb 100644 --- a/Task/Mutual-recursion/Bc/mutual-recursion-1.bc +++ b/Task/Mutual-recursion/Bc/mutual-recursion-1.bc @@ -1,3 +1,4 @@ +cat mutual_recursion.bc: define f(n) { if ( n == 0 ) return(1); return(n - m(f(n-1))); diff --git a/Task/Mutual-recursion/Bc/mutual-recursion-2.bc b/Task/Mutual-recursion/Bc/mutual-recursion-2.bc index e318ce06a7..7ae51148fb 100644 --- a/Task/Mutual-recursion/Bc/mutual-recursion-2.bc +++ b/Task/Mutual-recursion/Bc/mutual-recursion-2.bc @@ -7,3 +7,4 @@ for(i=0; i < 19; i++) { print m(i); print " "; } print "\n"; +quit diff --git a/Task/Mutual-recursion/JavaScript/mutual-recursion-3.js b/Task/Mutual-recursion/JavaScript/mutual-recursion-3.js new file mode 100644 index 0000000000..2d1a3c7591 --- /dev/null +++ b/Task/Mutual-recursion/JavaScript/mutual-recursion-3.js @@ -0,0 +1 @@ +var range = (m, n) => Array(... Array(n - m + 1)).map((x, i) => m + i) diff --git a/Task/Mutual-recursion/REXX/mutual-recursion-1.rexx b/Task/Mutual-recursion/REXX/mutual-recursion-1.rexx index 8183e751e8..66401e53ed 100644 --- a/Task/Mutual-recursion/REXX/mutual-recursion-1.rexx +++ b/Task/Mutual-recursion/REXX/mutual-recursion-1.rexx @@ -1,10 +1,10 @@ -/*REXX program shows mutual recursion (via Hofstadter Male & Female sequence).*/ -parse arg lim .; if lim='' then lim=40; w=length(lim); pad=left('',20) +/*REXX program shows mutual recursion (via the Hofstadter Male and Female sequences). */ +parse arg lim .; if lim='' then lim=40; w=length(lim); pad=left('', 20) - do j=0 to lim; jj=right(j,w); ff=right(F(j),w); mm=right(M(j),w) - say pad 'F('jj") =" ff pad 'M('jj") =" mm + do j=0 to lim; jj=right(j, w); ff=right(F(j), w); mm=right(M(j), w) + say pad 'F('jj") =" ff pad 'M('jj") =" mm end /*j*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -F: procedure; parse arg n; if n==0 then return 1; return n - M(F(n-1)) -M: procedure; parse arg n; if n==0 then return 0; return n - F(M(n-1)) +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +F: procedure; parse arg n; if n==0 then return 1; return n - M( F(n-1) ) +M: procedure; parse arg n; if n==0 then return 0; return n - F( M(n-1) ) diff --git a/Task/Mutual-recursion/REXX/mutual-recursion-2.rexx b/Task/Mutual-recursion/REXX/mutual-recursion-2.rexx index e7f40750b9..74cbafd0b3 100644 --- a/Task/Mutual-recursion/REXX/mutual-recursion-2.rexx +++ b/Task/Mutual-recursion/REXX/mutual-recursion-2.rexx @@ -1,14 +1,14 @@ -/*REXX program shows mutual recursion (via Hofstadter Male & Female sequence).*/ -parse arg lim .; if lim=='' then lim=40 /*assume the default for LIM? */ -w=length(lim); $m.=.; $m.0=0; $f.=.; $f.0=1; Js=; Fs=; Ms= +/*REXX program shows mutual recursion (via the Hofstadter Male and Female sequences). */ +parse arg lim .; if lim=='' then lim=40 /*assume the default for LIM? */ +w=length(lim); $m.=.; $m.0=0; $f.=.; $f.0=1; Js=; Fs=; Ms= do j=0 to lim - Js=Js right(j,w); Fs=Fs right(F(j),w); Ms=Ms right(M(j),w) + Js=Js right(j, w); Fs=Fs right(F(j), w); Ms=Ms right(M(j), w) end /*j*/ -say 'Js=' Js /*display the list of Js to the term.*/ -say 'Fs=' Fs /* " " " " Fs " " " */ -say 'Ms=' Ms /* " " " " Ms " " " */ -exit /*stick a fork in it, we're all done. */ -/*───────────────────────────────────────────────────────────────────────────────────*/ -F: procedure expose $m. $f.; parse arg n; if $f.n==. then $f.n=n-M(F(n-1)); return $f.n -M: procedure expose $m. $f.; parse arg n; if $m.n==. then $m.n=n-F(M(n-1)); return $m.n +say 'Js=' Js /*display the list of Js to the term.*/ +say 'Fs=' Fs /* " " " " Fs " " " */ +say 'Ms=' Ms /* " " " " Ms " " " */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +F: procedure expose $m. $f.; parse arg n; if $f.n==. then $f.n=n-M(F(n-1)); return $f.n +M: procedure expose $m. $f.; parse arg n; if $m.n==. then $m.n=n-F(M(n-1)); return $m.n diff --git a/Task/Mutual-recursion/REXX/mutual-recursion-3.rexx b/Task/Mutual-recursion/REXX/mutual-recursion-3.rexx index cba268c1a7..7b0b40cb8b 100644 --- a/Task/Mutual-recursion/REXX/mutual-recursion-3.rexx +++ b/Task/Mutual-recursion/REXX/mutual-recursion-3.rexx @@ -1,17 +1,17 @@ -/*REXX program shows mutual recursion (via Hofstadter Male & Female sequence).*/ -/*────────If LIM is negative, a single result is shown for the abs(lim) entry.*/ +/*REXX program shows mutual recursion (via the Hofstadter Male and Female sequences). */ +/*───────────────── If LIM is negative, a single result is shown for the abs(lim) entry.*/ -parse arg lim .; if lim=='' then lim=99; aLim=abs(lim) -w=length(aLim); $m.=.; $m.0=0; $f.=.; $f.0=1; Js=; Fs=; Ms= +parse arg lim .; if lim=='' then lim=99; aLim=abs(lim) +w=length(aLim); $m.=.; $m.0=0; $f.=.; $f.0=1; Js=; Fs=; Ms= do j=0 to Alim - Js=Js right(j,w); Fs=Fs right(F(j),w); Ms=Ms right(M(j),w) + Js=Js right(j, w); Fs=Fs right(F(j), w); Ms=Ms right(M(j), w) end /*j*/ -if lim>0 then say 'Js=' Js; else say 'J('aLim")=" word(Js,aLim+1) -if lim>0 then say 'Fs=' Fs; else say 'F('aLim")=" word(Fs,aLim+1) -if lim>0 then say 'Ms=' Ms; else say 'M('aLim")=" word(Ms,aLim+1) -exit /*stick a fork in it, we're all done. */ -/*───────────────────────────────────────────────────────────────────────────────────*/ -F: procedure expose $m. $f.; parse arg n; if $f.n==. then $f.n=n-M(F(n-1)); return $f.n -M: procedure expose $m. $f.; parse arg n; if $m.n==. then $m.n=n-F(M(n-1)); return $m.n +if lim>0 then say 'Js=' Js; else say 'J('aLim")=" word(Js, aLim+1) +if lim>0 then say 'Fs=' Fs; else say 'F('aLim")=" word(Fs, aLim+1) +if lim>0 then say 'Ms=' Ms; else say 'M('aLim")=" word(Ms, aLim+1) +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +F: procedure expose $m. $f.; parse arg n; if $f.n==. then $f.n=n-M(F(n-1)); return $f.n +M: procedure expose $m. $f.; parse arg n; if $m.n==. then $m.n=n-F(M(n-1)); return $m.n diff --git a/Task/Mutual-recursion/S-lang/mutual-recursion.slang b/Task/Mutual-recursion/S-lang/mutual-recursion.slang new file mode 100644 index 0000000000..1067f5697e --- /dev/null +++ b/Task/Mutual-recursion/S-lang/mutual-recursion.slang @@ -0,0 +1,22 @@ +% Forward definitions: [also deletes any existing definition] +define f(); +define m(); + +define f(n) { + if (n == 0) return 1; + else if (n < 0) error("oops"); + return n - m(f(n - 1)); +} + +define m(n) { + if (n == 0) return 0; + else if (n < 0) error("oops"); + return n - f(m(n - 1)); +} + +foreach $1 ([0:19]) + () = printf("%d ", f($1)); +() = printf("\n"); +foreach $1 ([0:19]) + () = printf("%d ", m($1)); +() = printf("\n"); diff --git a/Task/Mutual-recursion/TXR/mutual-recursion.txr b/Task/Mutual-recursion/TXR/mutual-recursion.txr index 9c11e45acb..9f6508772a 100644 --- a/Task/Mutual-recursion/TXR/mutual-recursion.txr +++ b/Task/Mutual-recursion/TXR/mutual-recursion.txr @@ -1,13 +1,12 @@ -@(do - (defun f (n) - (if (>= 0 n) - 1 - (- n (m (f (- n 1)))))) +(defun f (n) + (if (>= 0 n) + 1 + (- n (m (f (- n 1)))))) - (defun m (n) - (if (>= 0 n) - 0 - (- n (f (m (- n 1)))))) +(defun m (n) + (if (>= 0 n) + 0 + (- n (f (m (- n 1)))))) - (each ((n (range 0 15))) - (format t "f(~s) = ~s; m(~s) = ~s\n" n (f n) n (m n)))) +(each ((n (range 0 15))) + (format t "f(~s) = ~s; m(~s) = ~s\n" n (f n) n (m n))) diff --git a/Task/N-queens-problem/00DESCRIPTION b/Task/N-queens-problem/00DESCRIPTION index 7cd15eefb4..c34ec41525 100644 --- a/Task/N-queens-problem/00DESCRIPTION +++ b/Task/N-queens-problem/00DESCRIPTION @@ -1,7 +1,19 @@ +[[File:chess_queen.jpg|400px||right]] + +[[File:N_queens_problem.png|400px||right]] + Solve the [[WP:Eight_queens_puzzle|eight queens puzzle]]. -You can extend the problem to solve the puzzle with a board of side NxN. -For the number of solutions for small values of N, see [http://oeis.org/A000170 oeis.org]. -;Cf. -* [[Knight's tour]] +You can extend the problem to solve the puzzle with a board of size   '''N'''x'''N'''. + +For the number of solutions for small values of   '''N''',   see   [http://oeis.org/A000170 oeis.org sequence A170]. + + +;See also: +*   [[Knight's tour]] +*   [[Solve a Hidato puzzle]] +*   [[Solve a Holy Knight's tour]] +*   [[Solve a Numbrix puzzle]] +*   [[Solve a Hopido puzzle]] +

    diff --git a/Task/N-queens-problem/360-Assembly/n-queens-problem.360 b/Task/N-queens-problem/360-Assembly/n-queens-problem.360 index ee4c98c659..f4518766f2 100644 --- a/Task/N-queens-problem/360-Assembly/n-queens-problem.360 +++ b/Task/N-queens-problem/360-Assembly/n-queens-problem.360 @@ -1,6 +1,29 @@ -* N-queens problem 04/09/2015 -NQUEENS PROLOG - LA R9,1 n=1 +* N-QUEENS PROBLEM 04/09/2015 + PRINT NOGEN + MACRO +&LAB XDECO ®,&TARGET +&LAB B I&SYSNDX branch around work area +P&SYSNDX DS 0D,PL8 packed +W&SYSNDX DS CL13 char +I&SYSNDX CVD ®,P&SYSNDX convert to decimal + MVC W&SYSNDX,=X'40202020202020202020212060' nice mask + EDMK W&SYSNDX,P&SYSNDX+2 edit and mark + BCTR R1,0 locate the right place + MVC 0(1,R1),W&SYSNDX+12 move the sign + MVC &TARGET.(12),W&SYSNDX move to target + MEND + PRINT NOGEN +NQUEENS CSECT + SAVE (14,12) save registers on entry + PRINT NOGEN + BALR R12,0 establish addressability + USING *,R12 set base register + ST R13,SAVEA+4 link mySA->prevSA + LA R11,SAVEA mySA + ST R11,8(R13) link prevSA->mySA + LR R13,R11 set mySA pointer +OPENEM OPEN (OUTDCB,OUTPUT) open the printer file + LA R9,1 n=1 start of loop LOOPN CH R9,L do n=1 to l BH ELOOPN if n>l then exit loop SR R8,R8 m=0 @@ -92,13 +115,18 @@ E90 BCTR R10,0 i=i-1 SLA R1,1 (q+r)*2 STH R0,U-2(R1) u(q+r)=0 B E60 goto e60 -ZERO XDECO R9,PG+0 edit n - XDECO R8,PG+12 edit m - XPRNT PG,24 print buffer +ZERO XDECO R9,PG+0 edit N + XDECO R8,PG+12 edit M + PUT OUTDCB,PG print buffer LA R9,1(R9) n=n+1 B LOOPN loop do n -ELOOPN EPILOG -L DC H'12' input value +ELOOPN CLOSE (OUTDCB) close output + L R13,SAVEA+4 previous save area addrs + RETURN (14,12),RC=0 return to caller with rc=0 + LTORG +SAVEA DS 18F save area for chaining +OUTDCB DCB DSORG=PS,MACRF=PM,DDNAME=OUTDD use OUTDD in jcl +L DC H'13' input value A DC H'01',H'02',H'03',H'04',H'05',H'06' DC H'07',H'08',H'09',H'10',H'11',H'12' U DC 46H'0' @@ -106,5 +134,5 @@ S DS 12H Z DS H Y DS H PG DS CL24 buffer - YREGS + REGS make sure to incld copybook jcl END NQUEENS diff --git a/Task/N-queens-problem/AppleScript/n-queens-problem.applescript b/Task/N-queens-problem/AppleScript/n-queens-problem.applescript new file mode 100644 index 0000000000..d314720587 --- /dev/null +++ b/Task/N-queens-problem/AppleScript/n-queens-problem.applescript @@ -0,0 +1,154 @@ +-- Finds all possible solutions and the unique patterns. + +property Grid_Size : 8 + +property Patterns : {} +property Solutions : {} +property Test_Count : 0 + +property Rotated : {} + +on run + local diff + local endTime + local msg + local rows + local startTime + + set Patterns to {} + set Solutions to {} + set Rotated to {} + + set Test_Count to 0 + + set rows to Make_Empty_List(Grid_Size) + + set startTime to current date + Solve(1, rows) + set endTime to current date + set diff to endTime - startTime + + set msg to ("Found " & (count Solutions) & " solutions with " & (count Patterns) & " patterns in " & diff & " seconds.") as text + display alert msg +end run + +on Solve(row as integer, rows as list) + if row is greater than (count rows) then + Append_Solution(rows) + return + end if + + repeat with column from 1 to Grid_Size + set Test_Count to Test_Count + 1 + if Place_Queen(column, row, rows) then + Solve(row + 1, rows) + end if + end repeat +end Solve + +on Place_Queen(column as integer, row as integer, rows as list) + local colDiff + local previousRow + local rowDiff + local testColumn + + repeat with previousRow from 1 to (row - 1) + set testColumn to item previousRow of rows + + if testColumn is equal to column then + return false + end if + + set colDiff to abs (testColumn - column) as integer + set rowDiff to row - previousRow + if colDiff is equal to rowDiff then + return false + end if + end repeat + + set item row of rows to column + return true +end Place_Queen + +on Append_Solution(rows as list) + local column + local rowsCopy + local testReflection + local testReflectionText + local testRotation + local testRotationText + local testRotations + + copy rows to rowsCopy + set end of Solutions to rowsCopy + local rowsCopy + + copy rows to testRotation + set testRotations to {} + repeat 3 times + set testRotation to Rotate(testRotation) + set testRotationText to testRotation as text + if Rotated contains testRotationText then + return + end if + set end of testRotations to testRotationText + + set testReflection to Reflect(testRotation) + set testReflectionText to testReflection as text + if Rotated contains testReflectionText then + return + end if + set end of testRotations to testReflectionText + end repeat + + repeat with testRotationText in testRotations + set end of Rotated to (contents of testRotationText) + end repeat + set end of Rotated to (rowsCopy as text) + set end of Rotated to (Reflect(rowsCopy) as text) + + set end of Patterns to rowsCopy +end Append_Solution + +on Make_Empty_List(depth as integer) + local i + local emptyList + + set emptyList to {} + repeat with i from 1 to depth + set end of emptyList to missing value + end repeat + return emptyList +end Make_Empty_List + +on Rotate(rows as list) + local column + local newColumn + local newRow + local newRows + local row + local rowCount + + set rowCount to (count rows) + set newRows to Make_Empty_List(rowCount) + repeat with row from 1 to rowCount + set column to (contents of item row of rows) + set newRow to column + set newColumn to rowCount - row + 1 + set item newRow of newRows to newColumn + end repeat + + return newRows +end Rotate + +on Reflect(rows as list) + local column + local newRows + + set newRows to {} + repeat with column in rows + set end of newRows to (count rows) - column + 1 + end repeat + + return newRows +end Reflect diff --git a/Task/N-queens-problem/Elixir/n-queens-problem.elixir b/Task/N-queens-problem/Elixir/n-queens-problem.elixir index 1258e998db..70d294c5da 100644 --- a/Task/N-queens-problem/Elixir/n-queens-problem.elixir +++ b/Task/N-queens-problem/Elixir/n-queens-problem.elixir @@ -1,28 +1,26 @@ defmodule RC do - def queen(n) do - add = Tuple.duplicate(true, 2*n-1) - sub = Tuple.duplicate(true, 2*n-1) - solve(n, [], add, sub) + def queen(n, display \\ true) do + solve(n, [], [], [], display) end - def solve(n, row, _, _) when n <= length(row) do - print(n,row) + defp solve(n, row, _, _, display) when n==length(row) do + if display, do: print(n,row) 1 end - def solve(n, row, add, sub) do + defp solve(n, row, add_list, sub_list, display) do Enum.map(Enum.to_list(0..n-1) -- row, fn x -> - iadd = x + (len = length(row)) - isub = if (y = x-len) < 0, do: y + 2*n - 1, else: y - if elem(add, iadd) and elem(sub, isub) do - solve(n, [x|row], put_elem(add,iadd,false), put_elem(sub,isub,false)) - else + add = x + length(row) # \ diagonal check + sub = x - length(row) # / diagonal check + if (add in add_list) or (sub in sub_list) do 0 + else + solve(n, [x|row], [add | add_list], [sub | sub_list], display) end - end) |> Enum.sum + end) |> Enum.sum # total of the solution end - def print(n, row) do - IO.puts frame = "+-" <> String.duplicate("--", n) <> "+" + defp print(n, row) do + IO.puts frame = "+" <> String.duplicate("-", 2*n+1) <> "+" Enum.each(row, fn x -> line = Enum.map_join(0..n-1, fn i -> if x==i, do: "Q ", else: ". " end) IO.puts "| #{line}|" @@ -34,3 +32,7 @@ end Enum.each(1..6, fn n -> IO.puts " #{n} Queen : #{RC.queen(n)}" end) + +Enum.each(7..12, fn n -> + IO.puts " #{n} Queen : #{RC.queen(n, false)}" # no display +end) diff --git a/Task/N-queens-problem/Julia/n-queens-problem-1.julia b/Task/N-queens-problem/Julia/n-queens-problem-1.julia new file mode 100644 index 0000000000..507e085a80 --- /dev/null +++ b/Task/N-queens-problem/Julia/n-queens-problem-1.julia @@ -0,0 +1,77 @@ +#!/usr/bin/env julia + +__precompile__(true) + +""" +# EightQueensPuzzle + +Ported to **Julia** from examples in several languages from +here: https://hbfs.wordpress.com/2009/11/10/is-python-slow +""" +module EightQueensPuzzle + +export main + +type Board + cols::Int + nodes::Int + diag45::Int + diag135::Int + solutions::Int + + Board() = new(0, 0, 0, 0, 0) +end + +"Marks occupancy." +function mark!(b::Board, k::Int, j::Int) + b.cols $= (1 << j) + b.diag135 $= (1 << (j+k)) + b.diag45 $= (1 << (32+j-k)) +end + +"Tests if a square is menaced." +function test(b::Board, k::Int, j::Int) + b.cols & (1 << j) + + b.diag135 & (1 << (j+k)) + + b.diag45 & (1 << (32+j-k)) == 0 +end + +"Backtracking solver." +function solve!(b::Board, niv::Int, dx::Int) + if niv > 0 + for i in 0:dx-1 + if test(b, niv, i) == true + mark!(b, niv, i) + solve!(b, niv-1, dx) + mark!(b, niv, i) + end + end + else + for i in 0:dx-1 + if test(b, 0, i) == true + b.solutions += 1 + end + end + end + b.nodes += 1 + b.solutions +end + +"C/C++-style `main` function." +function main() + for n = 1:17 + gc() + b = Board() + @show n + print("elapsed:") + solutions = @time solve!(b, n-1, n) + @show solutions + println() + end +end + +end + +using EightQueensPuzzle + +main() diff --git a/Task/N-queens-problem/Julia/n-queens-problem-2.julia b/Task/N-queens-problem/Julia/n-queens-problem-2.julia new file mode 100644 index 0000000000..a543be0633 --- /dev/null +++ b/Task/N-queens-problem/Julia/n-queens-problem-2.julia @@ -0,0 +1,68 @@ +juser@juliabox:~$ /opt/julia-0.5/bin/julia eight_queen_puzzle.jl +n = 1 +elapsed: 0.000001 seconds +solutions = 1 + +n = 2 +elapsed: 0.000001 seconds +solutions = 0 + +n = 3 +elapsed: 0.000001 seconds +solutions = 0 + +n = 4 +elapsed: 0.000001 seconds +solutions = 2 + +n = 5 +elapsed: 0.000003 seconds +solutions = 10 + +n = 6 +elapsed: 0.000008 seconds +solutions = 4 + +n = 7 +elapsed: 0.000028 seconds +solutions = 40 + +n = 8 +elapsed: 0.000108 seconds +solutions = 92 + +n = 9 +elapsed: 0.000463 seconds +solutions = 352 + +n = 10 +elapsed: 0.002146 seconds +solutions = 724 + +n = 11 +elapsed: 0.010646 seconds +solutions = 2680 + +n = 12 +elapsed: 0.057603 seconds +solutions = 14200 + +n = 13 +elapsed: 0.334600 seconds +solutions = 73712 + +n = 14 +elapsed: 2.055078 seconds +solutions = 365596 + +n = 15 +elapsed: 13.480449 seconds +solutions = 2279184 + +n = 16 +elapsed: 97.192552 seconds +solutions = 14772512 + +n = 17 +elapsed:720.314676 seconds +solutions = 95815104 diff --git a/Task/N-queens-problem/Lua/n-queens-problem.lua b/Task/N-queens-problem/Lua/n-queens-problem.lua index 80ce581a1f..36a5785433 100644 --- a/Task/N-queens-problem/Lua/n-queens-problem.lua +++ b/Task/N-queens-problem/Lua/n-queens-problem.lua @@ -1,46 +1,35 @@ N = 8 -board = {} -for i = 1, N do - board[i] = {} - for j = 1, N do - board[i][j] = false - end +-- We'll use nil to indicate no queen is present. +grid = {} +for i = 0, N do + grid[i] = {} end -function Allowed( x, y ) - for i = 1, x-1 do - if ( board[i][y] ) or ( i <= y and board[x-i][y-i] ) or ( y+i <= N and board[x-i][y+i] ) then - return false - end - end - return true +function can_find_solution(x0, y0) + local x0, y0 = x0 or 0, y0 or 1 -- Set default vals (0, 1). + for x = 1, x0 - 1 do + if grid[x][y0] or grid[x][y0 - x0 + x] or grid[x][y0 + x0 - x] then + return false + end + end + grid[x0][y0] = true + if x0 == N then return true end + for y0 = 1, N do + if can_find_solution(x0 + 1, y0) then return true end + end + grid[x0][y0] = nil + return false end -function Find_Solution( x ) - for y = 1, N do - if Allowed( x, y ) then - board[x][y] = true - if x == N or Find_Solution( x+1 ) then - return true - end - board[x][y] = false - end - end - return false -end - -if Find_Solution( 1 ) then - for i = 1, N do - for j = 1, N do - if board[i][j] then - io.write( "|Q" ) - else - io.write( "| " ) - end - end - print( "|" ) +if can_find_solution() then + for y = 1, N do + for x = 1, N do + -- Print "|Q" if grid[x][y] is true; "|_" otherwise. + io.write(grid[x][y] and "|Q" or "|_") end + print("|") + end else - print( string.format( "No solution for %d queens.\n", N ) ) + print(string.format("No solution for %d queens.\n", N)) end diff --git a/Task/N-queens-problem/PL-I/n-queens-problem.pli b/Task/N-queens-problem/PL-I/n-queens-problem.pli new file mode 100644 index 0000000000..4df92c5fdc --- /dev/null +++ b/Task/N-queens-problem/PL-I/n-queens-problem.pli @@ -0,0 +1,78 @@ +NQUEENS: PROC OPTIONS (MAIN); + DCL A(35) BIN FIXED(31) EXTERNAL; + DCL COUNT BIN FIXED(31) EXTERNAL; + COUNT = 0; + DECLARE SYSIN FILE; + DCL ABS BUILTIN; + DECLARE SYSPRINT FILE; + DECLARE N BINARY FIXED (31); /* COUNTER */ + /* MAIN LOOP STARTS HERE */ + GET LIST (N) FILE(SYSIN); /* N QUEENS, N X N BOARD */ + PUT SKIP (1) FILE(SYSPRINT); + PUT SKIP LIST('BEGIN N QUEENS PROCESSING *****') FILE(SYSPRINT); + PUT SKIP LIST('SOLUTIONS FOR N: ',N) FILE(SYSPRINT); + PUT SKIP (1) FILE(SYSPRINT); + IF N < 4 THEN DO; + /* LESS THAN 4 MAKES NO SENSE */ + PUT SKIP (2) FILE(SYSPRINT); + PUT SKIP LIST (N,' N TOO LOW') FILE (SYSPRINT); + PUT SKIP (2) FILE(SYSPRINT); + RETURN (1); + END; + IF N > 35 THEN DO; + /* WOULD TAKE WEEKS */ + PUT SKIP (2) FILE(SYSPRINT); + PUT SKIP LIST (N,' N TOO HIGH') FILE (SYSPRINT); + PUT SKIP (2) FILE(SYSPRINT); + RETURN (1); + END; + + CALL QUEEN(N); + + PUT SKIP (2) FILE(SYSPRINT); + PUT SKIP LIST (COUNT,' SOLUTIONS FOUND') FILE(SYSPRINT); + PUT SKIP (1) FILE(SYSPRINT); + PUT SKIP LIST ('END OF PROCESSING ****') FILE(SYSPRINT); + RETURN(0); + /* MAIN LOOP ENDS ABOVE */ + + PLACE: PROCEDURE (PS); + DCL PS BIN FIXED(31); + DCL I BIN FIXED(31) INIT(0); + DCL A(50) BIN FIXED(31) EXTERNAL; + + DO I=1 TO PS-1; + IF A(I) = A(PS) THEN RETURN(0); + IF ABS ( A(I) - A(PS) ) = (PS-I) THEN RETURN(0); + END; + RETURN (1); + END PLACE; + + QUEEN: PROCEDURE (N); + DCL N BIN FIXED (31); + DCL K BIN FIXED (31); + DCL A(50) BIN FIXED(31) EXTERNAL; + DCL COUNT BIN FIXED(31) EXTERNAL; + K = 1; + A(K) = 0; + DO WHILE (K > 0); + A(K) = A(K) + 1; + DO WHILE ( ( A(K)<= N) & (PLACE(K) =0) ); + A(K) = A(K) +1; + END; + IF (A(K) <= N) THEN DO; + IF (K = N ) THEN DO; + COUNT = COUNT + 1; + END; + ELSE DO; + K= K +1; + A(K) = 0; + END; /* OF INSIDE ELSE */ + END; /* OF FIRST IF */ + ELSE DO; + K = K -1; + END; + END; /* OF EXTERNAL WHILE LOOP */ + END QUEEN; + + END NQUEENS; diff --git a/Task/N-queens-problem/Perl-6/n-queens-problem.pl6 b/Task/N-queens-problem/Perl-6/n-queens-problem.pl6 index 5ac790e3f3..cc7cf977c7 100644 --- a/Task/N-queens-problem/Perl-6/n-queens-problem.pl6 +++ b/Task/N-queens-problem/Perl-6/n-queens-problem.pl6 @@ -6,7 +6,7 @@ sub MAIN(\N = 8) { } False; } - sub search(@field is rw, $row) { + sub search(@field, $row) { return @field if $row == N; for ^N -> $i { @field[$row] = $i; diff --git a/Task/N-queens-problem/PowerShell/n-queens-problem-1.psh b/Task/N-queens-problem/PowerShell/n-queens-problem-1.psh new file mode 100644 index 0000000000..d30eace610 --- /dev/null +++ b/Task/N-queens-problem/PowerShell/n-queens-problem-1.psh @@ -0,0 +1,59 @@ +function PlaceQueen ( [ref]$Board, $Row, $N ) + { + # For the current row, start with the first column + $Board.Value[$Row] = 0 + + # While haven't exhausted all columns in the current row... + While ( $Board.Value[$Row] -lt $N ) + { + # If not the first row, check for conflicts + $Conflict = $Row -and + ( (0..($Row-1)).Where{ $Board.Value[$_] -eq $Board.Value[$Row] }.Count -or + (0..($Row-1)).Where{ $Board.Value[$_] -eq $Board.Value[$Row] - $Row + $_ }.Count -or + (0..($Row-1)).Where{ $Board.Value[$_] -eq $Board.Value[$Row] + $Row - $_ }.Count ) + + # If no conflicts and the current column is a valid column... + If ( -not $Conflict -and $Board.Value[$Row] -lt $N ) + { + + # If this is the last row + # Board completed successfully + If ( $Row -eq ( $N - 1 ) ) + { + return $True + } + + # Recurse + # If all nested recursions were successful + # Board completed successfully + If ( PlaceQueen $Board ( $Row + 1 ) $N ) + { + return $True + } + } + + # Try the next column + $Board.Value[$Row]++ + } + + # Everything was tried, nothing worked + Return $False + } + +function Get-NQueensBoard ( $N ) + { + # Start with a default board (array of column positions for each row) + $Board = @( 0 ) * $N + + # Place queens on board + # If successful... + If ( PlaceQueen -Board ([ref]$Board) -Row 0 -N $N ) + { + # Convert board to strings for display + $Board | ForEach { ( @( "" ) + @(" ") * $_ + "Q" + @(" ") * ( $N - $_ ) ) -join "|" } + } + Else + { + "There is no solution for N = $N" + } + } diff --git a/Task/N-queens-problem/PowerShell/n-queens-problem-2.psh b/Task/N-queens-problem/PowerShell/n-queens-problem-2.psh new file mode 100644 index 0000000000..1d441b07f3 --- /dev/null +++ b/Task/N-queens-problem/PowerShell/n-queens-problem-2.psh @@ -0,0 +1,7 @@ +Get-NQueensBoard 8 +'' +Get-NQueensBoard 3 +'' +Get-NQueensBoard 4 +'' +Get-NQueensBoard 14 diff --git a/Task/N-queens-problem/R/n-queens-problem.r b/Task/N-queens-problem/R/n-queens-problem.r index 5d8d5b3923..bd253fe492 100644 --- a/Task/N-queens-problem/R/n-queens-problem.r +++ b/Task/N-queens-problem/R/n-queens-problem.r @@ -1,25 +1,25 @@ # Brute force, see the "Permutations" page for the next.perm function safe <- function(p) { - n <- length(p) - for(i in 1:(n-1)) { - for(j in (i+1):n) { - if(abs(p[j] - p[i]) == abs(j - i)) return(FALSE) - } - } - return(TRUE) + n <- length(p) + for (i in seq(1, n - 1)) { + for (j in seq(i + 1, n)) { + if (abs(p[j] - p[i]) == abs(j - i)) return(F) + } + } + return(T) } queens <- function(n) { - p <- 1:n - k <- 0 - while(!is.null(p)) { - if(safe(p)) { - cat(p,"\n") - k <- k + 1 - } - p <- next.perm(p) - } - return(k) + p <- 1:n + k <- 0 + while (!is.null(p)) { + if(safe(p)) { + cat(p, "\n") + k <- k + 1 + } + p <- next.perm(p) + } + return(k) } queens(8) diff --git a/Task/N-queens-problem/REXX/n-queens-problem.rexx b/Task/N-queens-problem/REXX/n-queens-problem.rexx index cd221cbd0e..a02b260e12 100644 --- a/Task/N-queens-problem/REXX/n-queens-problem.rexx +++ b/Task/N-queens-problem/REXX/n-queens-problem.rexx @@ -1,51 +1,49 @@ -/*REXX program places N queens on a NxN chessboard; the 8 queens problem*/ -parse arg N . /*get board size arg (if any). */ -if N=='' then N=8; if N<1 then call noSol /*No arg? Use the default.*/ -rank=1; file=1; q=0 /*starting rank & file; # queens.*/ -@.=0; !=left('', 9* (N<18)) /*define empty board, indentation*/ -/*═════════════════════════════════════find solution: N queens problem.*/ - do while qN; rank=rank-1; if rank==0 then call noSol - do j=1 for N; if \@.j.rank then iterate /*occupied?*/ - file=j; @.file.rank=0; q=q-1; file=j+1; leave /*j*/ +/*REXX program places N queens on an NxN chessboard (the eight queens problem). */ +parse arg N . /*obtain optional argument from the CL.*/ +if N=='' | N=="," then N=8 /*Not specified: Then use the default.*/ +if N<1 then call noSol /*display a message, the board is bad. */ +rank=1; file=1; #=0 /*starting rank&file; #≡number queens.*/ +@.=0; pad=left('', 9* (N<18)) /*define empty board; set indentation.*/ + + do while #N; rank=rank-1; if rank==0 then call noSol + do j=1 for N; if \@.j.rank then iterate /*occupied?*/ + file=j; @.file.rank=0; #=#-1; file=j+1; leave /*j*/ end /*j*/ end /*while file>N*/ - end /*while q(collection: I) -> Box> + 'a> + where I: 'a + IntoIterator + Clone, + T: 'a + PartialEq + Copy + Clone { + if collection.clone().into_iter().count() == 0 { + Box::new(vec![LinkedList::new()].into_iter()) + } + else { + Box::new( + collection.clone().into_iter().flat_map(move |i| { + permutations(collection.clone().into_iter() + .filter(move |&i0| i != i0) + .collect::>()) + .map(move |mut l| {l.push_front(i); l}) + }) + ) + } +} + +pub struct NQueens { + iterator: Box> +} + +impl NQueens { + pub fn new(n: u32) -> NQueens { + NQueens { + iterator: Box::new(permutations(0..n) + .filter(|vec| { + let iter = vec.iter().enumerate(); + iter.clone().all(|(col, &row)| { + iter.clone().filter(|&(c,_)| c != col) + .all(|(ocol, &orow)| { + col as i32 - row as i32 != + ocol as i32 - orow as i32 && + col as u32 + row != ocol as u32 + orow + }) + }) + }) + .map(|vec| NQueensSolution(vec)) + ) + } + } +} + +impl Iterator for NQueens { + type Item = NQueensSolution; + fn next(&mut self) -> Option { + self.iterator.next() + } +} + +pub struct NQueensSolution(LinkedList); + +impl ToString for NQueensSolution { + fn to_string(&self) -> String { + let mut str = String::new(); + for &row in self.0.iter() { + for r in 0..self.0.len() as u32 { + if r == row { + str.push_str("Q "); + } else { + str.push_str("- "); + } + } + str.push('\n'); + } + str + } +} diff --git a/Task/N-queens-problem/Scala/n-queens-problem.scala b/Task/N-queens-problem/Scala/n-queens-problem-1.scala similarity index 80% rename from Task/N-queens-problem/Scala/n-queens-problem.scala rename to Task/N-queens-problem/Scala/n-queens-problem-1.scala index 3052880f2e..f04a803b43 100644 --- a/Task/N-queens-problem/Scala/n-queens-problem.scala +++ b/Task/N-queens-problem/Scala/n-queens-problem-1.scala @@ -14,7 +14,3 @@ def expand(solutions: Iterator[List[Pos]], size: Int, row: Int) = pos <- rowSet(size, row) if solution forall (_ legal pos) } yield pos :: solution - -def seed(size: Int) = rowSet(size, 0) map (sol => List(sol)) - -def solve(size: Int) = (1 until size).foldLeft(seed(size)) (expand(_, size, _)) diff --git a/Task/N-queens-problem/Scala/n-queens-problem-2.scala b/Task/N-queens-problem/Scala/n-queens-problem-2.scala new file mode 100644 index 0000000000..9290d1de35 --- /dev/null +++ b/Task/N-queens-problem/Scala/n-queens-problem-2.scala @@ -0,0 +1,18 @@ +def vecOk(v: IndexedSeq[Int])(f: (Int,Int) => Int): Boolean = { + def vecOkIter(level: Int)(lst: List[Int]): Boolean = { + if (level > -1) { + val d = f(v(level),level) + if (lst.contains(d)) false + else vecOkIter(level-1)(d :: lst) + } + else true + } + vecOkIter(v.length-1)(List[Int]()) +} + +def nQueen(n: Int) = for ( + v <- (1 to n).permutations + if vecOk(v)(_+_) && vecOk(v)(_-_) +) yield v + +nQueen(8) diff --git a/Task/Named-parameters/00DESCRIPTION b/Task/Named-parameters/00DESCRIPTION index c9a4d7105b..20fd629bea 100644 --- a/Task/Named-parameters/00DESCRIPTION +++ b/Task/Named-parameters/00DESCRIPTION @@ -10,3 +10,4 @@ Create a function which takes in a number of arguments which are specified by na * [[Varargs]] * [[Optional parameters]] * [[wp:Named parameter|Wikipedia: Named parameter]] +

    diff --git a/Task/Named-parameters/Elixir/named-parameters.elixir b/Task/Named-parameters/Elixir/named-parameters.elixir new file mode 100644 index 0000000000..eaa6eec7a7 --- /dev/null +++ b/Task/Named-parameters/Elixir/named-parameters.elixir @@ -0,0 +1,3 @@ +def fun(bar: bar, baz: baz), do: IO.puts "#{bar}, #{baz}." + +fun(bar: "bar", baz: "baz") diff --git a/Task/Named-parameters/Maple/named-parameters.maple b/Task/Named-parameters/Maple/named-parameters.maple new file mode 100644 index 0000000000..7a19d532e3 --- /dev/null +++ b/Task/Named-parameters/Maple/named-parameters.maple @@ -0,0 +1,10 @@ +f := proc(a, {b:= 1, c:= 1}) + print (a*(c+b)); +end proc: +#a is a mandatory positional parameter, b and c are optional named parameters +f(1);#you must have a value for a for the procedure to work + 2 +f(1, c = 1, b = 2); + 3 +f(2, b = 5, c = 3);#b and c can be put in any order + 16 diff --git a/Task/Named-parameters/Perl-6/named-parameters-2.pl6 b/Task/Named-parameters/Perl-6/named-parameters-2.pl6 index 2725ecea6c..f31e5a460c 100644 --- a/Task/Named-parameters/Perl-6/named-parameters-2.pl6 +++ b/Task/Named-parameters/Perl-6/named-parameters-2.pl6 @@ -1,4 +1,4 @@ -sub funkshun ($a, $b?, $c = 15, :$d, *@e, *%f) { +sub funkshun ($a, $b?, :$c = 15, :$d, *@e, *%f) { say "$a $b $c $d"; say join ' ', @e; say join ' ', keys %f; diff --git a/Task/Named-parameters/Standard-ML/named-parameters-1.ml b/Task/Named-parameters/Standard-ML/named-parameters-1.ml new file mode 100644 index 0000000000..902264bb16 --- /dev/null +++ b/Task/Named-parameters/Standard-ML/named-parameters-1.ml @@ -0,0 +1,3 @@ +fun dosomething (a, b, c) = print ("a = " ^ a ^ "\nb = " ^ Real.toString b ^ "\nc = " ^ Int.toString c ^ "\n") + +fun example {a, b, c} = dosomething (a, b, c) diff --git a/Task/Named-parameters/Standard-ML/named-parameters-2.ml b/Task/Named-parameters/Standard-ML/named-parameters-2.ml new file mode 100644 index 0000000000..fab1787099 --- /dev/null +++ b/Task/Named-parameters/Standard-ML/named-parameters-2.ml @@ -0,0 +1 @@ +example {a="Hello World!", b=3.14, c=42} diff --git a/Task/Named-parameters/Standard-ML/named-parameters-3.ml b/Task/Named-parameters/Standard-ML/named-parameters-3.ml new file mode 100644 index 0000000000..d55b0c2333 --- /dev/null +++ b/Task/Named-parameters/Standard-ML/named-parameters-3.ml @@ -0,0 +1,12 @@ +datatype param = A of string | B of real | C of int + +fun args xs = + let + (* Default values *) + val a = ref "hello world" + val b = ref 3.14 + val c = ref 42 + in + map (fn (A x) => a := x | (B x) => b := x | (C x) => c := x) xs; + (!a, !b, !c) + end diff --git a/Task/Named-parameters/Standard-ML/named-parameters-4.ml b/Task/Named-parameters/Standard-ML/named-parameters-4.ml new file mode 100644 index 0000000000..283c723ea7 --- /dev/null +++ b/Task/Named-parameters/Standard-ML/named-parameters-4.ml @@ -0,0 +1 @@ +dosomething (args [A "tam", B 42.0]); diff --git a/Task/Narcissist/00DESCRIPTION b/Task/Narcissist/00DESCRIPTION index 433655a0e9..87c541fb47 100644 --- a/Task/Narcissist/00DESCRIPTION +++ b/Task/Narcissist/00DESCRIPTION @@ -6,4 +6,9 @@ A '''narcissist''' (or '''Narcissus program''') is the decision-problem version A quine, when run, takes no input, but produces a copy of its own source code at its output. In contrast, a narcissist reads a string of symbols from its input, and produces no output except a "1" or "accept" if that string matches its own source code, or a "0" or "reject" if it does not. -For concreteness, in this task we shall assume that symbol = character. The narcissist should be able to cope with any finite input, whatever its length. Any form of output is allowed, as long as the program always halts, and "accept", "reject" and "not yet finished" are distinguishable. +For concreteness, in this task we shall assume that symbol = character. + +The narcissist should be able to cope with any finite input, whatever its length. + +Any form of output is allowed, as long as the program always halts, and "accept", "reject" and "not yet finished" are distinguishable. +

    diff --git a/Task/Narcissist/PARI-GP/narcissist.pari b/Task/Narcissist/PARI-GP/narcissist.pari new file mode 100644 index 0000000000..f0c2ab10eb --- /dev/null +++ b/Task/Narcissist/PARI-GP/narcissist.pari @@ -0,0 +1 @@ +narcissist()=input()==narcissist diff --git a/Task/Narcissist/PowerShell/narcissist-1.psh b/Task/Narcissist/PowerShell/narcissist-1.psh new file mode 100644 index 0000000000..3d73b9edb5 --- /dev/null +++ b/Task/Narcissist/PowerShell/narcissist-1.psh @@ -0,0 +1,6 @@ +function Narcissist +{ +Param ( [string]$String ) +If ( $String -eq $MyInvocation.MyCommand.Definition ) { 'Accept' } +Else { 'Reject' } +} diff --git a/Task/Narcissist/PowerShell/narcissist-2.psh b/Task/Narcissist/PowerShell/narcissist-2.psh new file mode 100644 index 0000000000..63a8e6f863 --- /dev/null +++ b/Task/Narcissist/PowerShell/narcissist-2.psh @@ -0,0 +1,9 @@ +Narcissist 'Banana' + +Narcissist @' + +Param ( [string]$String ) +If ( $String -eq $MyInvocation.MyCommand.Definition ) { 'Accept' } +Else { 'Reject' } + +'@ diff --git a/Task/Narcissist/Python/narcissist.py b/Task/Narcissist/Python/narcissist-1.py similarity index 100% rename from Task/Narcissist/Python/narcissist.py rename to Task/Narcissist/Python/narcissist-1.py diff --git a/Task/Narcissist/Python/narcissist-2.py b/Task/Narcissist/Python/narcissist-2.py new file mode 100644 index 0000000000..102ddccc3c --- /dev/null +++ b/Task/Narcissist/Python/narcissist-2.py @@ -0,0 +1 @@ +_='_=%r;print (_%%_==input())';print (_%_==input()) diff --git a/Task/Narcissist/TXR/narcissist.txr b/Task/Narcissist/TXR/narcissist.txr index 1558bb21a8..a9560e91dc 100644 --- a/Task/Narcissist/TXR/narcissist.txr +++ b/Task/Narcissist/TXR/narcissist.txr @@ -1,13 +1,13 @@ -@(bind my64 "QChuZXh0IDphcmdzKQpAZmlsZW5hbWUKQChuZXh0IGAhc2VkIC1uIC1lICcyLCRwJyBAZmlsZW5hbWUgfCBiYXNlNjRgKQpAKGZyZWVmb3JtICIiKQpAaW42NApAKG5leHQgYEBmaWxlbmFtZWApCkBmaXJzdGxpbmUKQChjYXNlcykKQCAgKGJpbmQgZmlyc3RsaW5lIGBAQChiaW5kIG15NjQgIkBteTY0IilgKQpAICAoYmluZCBpbjY0IG15NjQpCkAgIChiaW5kIHJlc3VsdCAiMSIpCkAob3IpCkAgIChiaW5kIHJlc3VsdCAiMCIpCkAoZW5kKQpAKG91dHB1dCkKQHJlc3VsdApAKGVuZCkK") +@(bind my64 "QChuZXh0IDphcmdzKUBmaWxlbmFtZUAobmV4dCBmaWxlbmFtZSlAZmlyc3RsaW5lQChmcmVlZm9ybSAiIilAcmVzdEAoYmluZCBpbjY0IEAoYmFzZTY0LWVuY29kZSByZXN0KSlAKGNhc2VzKUAgIChiaW5kIGZpcnN0bGluZSBgXEAoYmluZCBteTY0ICJAbXk2NCIpYClAICAoYmluZCBpbjY0IG15NjQpQCAgKGJpbmQgcmVzdWx0ICIxIilAKG9yKUAgIChiaW5kIHJlc3VsdCAiMCIpQChlbmQpQChvdXRwdXQpQHJlc3VsdEAoZW5kKQ==") @(next :args) @filename -@(next `!sed -n -e '2,$p' @filename | base64`) -@(freeform "") -@in64 -@(next `@filename`) +@(next filename) @firstline +@(freeform "") +@rest +@(bind in64 @(base64-encode rest)) @(cases) -@ (bind firstline `@@(bind my64 "@my64")`) +@ (bind firstline `\@(bind my64 "@my64")`) @ (bind in64 my64) @ (bind result "1") @(or) diff --git a/Task/Narcissist/UNIX-Shell/narcissist.sh b/Task/Narcissist/UNIX-Shell/narcissist.sh new file mode 100644 index 0000000000..e06219f8a2 --- /dev/null +++ b/Task/Narcissist/UNIX-Shell/narcissist.sh @@ -0,0 +1 @@ +cmp "$0" >/dev/null && echo accept || echo reject diff --git a/Task/Narcissistic-decimal-number/00DESCRIPTION b/Task/Narcissistic-decimal-number/00DESCRIPTION index 5b7842826c..a3d53ad966 100644 --- a/Task/Narcissistic-decimal-number/00DESCRIPTION +++ b/Task/Narcissistic-decimal-number/00DESCRIPTION @@ -1,9 +1,19 @@ -A [http://mathworld.wolfram.com/NarcissisticNumber.html Narcissistic decimal number] is a non-negative integer, n, that is equal to the sum of the m-th powers of each of the digits in the decimal representation of n, where m is the number of digits in the decimal representation of n. +A   [http://mathworld.wolfram.com/NarcissisticNumber.html Narcissistic decimal number]   is a non-negative integer,   n,   that is equal to the sum of the   m-th   powers of each of the digits in the decimal representation of   n,   where   m   is the number of digits in the decimal representation of   n. Narcissistic (decimal) numbers are sometimes called   '''Armstrong'''   numbers, named after Michael F. Armstrong. -For example, if n is 153 then m, the number of digits, is 3 and we have 1^3+5^3+3^3 = 1+125+27 = 153 and so 153 is a narcissistic decimal number. -The task is to generate and show here the first 25 narcissistic decimal numbers. +;An example: +::::*   if   n   is   '''153''' +::::*   then   m,   (the number of decimal digits)   is   '''3''' +::::*   we have   13 + 53 + 33   =   1 + 125 + 27   =   '''153''' +::::*   and so   '''153'''   is a narcissistic decimal number -Note: 0^1 = 0, the first in the series. + +;Task: +Generate and show here the first   '''25'''   narcissistic decimal numbers. + + + +Note:   0^1 = 0,   the first in the series. +

    diff --git a/Task/Narcissistic-decimal-number/ALGOL-68/narcissistic-decimal-number.alg b/Task/Narcissistic-decimal-number/ALGOL-68/narcissistic-decimal-number.alg new file mode 100644 index 0000000000..5ec6c51a24 --- /dev/null +++ b/Task/Narcissistic-decimal-number/ALGOL-68/narcissistic-decimal-number.alg @@ -0,0 +1,33 @@ +# find some narcissistic decimal numbers # + +# returns TRUE if n is narcissitic, FALSE otherwise; n should be >= 0 # +PROC is narcissistic = ( INT n )BOOL: + BEGIN + # count the number of digits in n # + INT digits := 0; + INT number := n; + WHILE digits +:= 1; + number OVERAB 10; + number > 0 + DO SKIP OD; + # sum the digits'th powers of the digits of n # + INT sum := 0; + number := n; + TO digits DO + sum +:= ( number MOD 10 ) ^ digits; + number OVERAB 10 + OD; + # n is narcissistic if n = sum # + n = sum + END # is narcissistic # ; + +# print the first 25 narcissistic numbers # +INT count := 0; +FOR n FROM 0 WHILE count < 25 DO + IF is narcissistic( n ) THEN + # found another narcissistic number # + print( ( " ", whole( n, 0 ) ) ); + count +:= 1 + FI +OD; +print( ( newline ) ) diff --git a/Task/Narcissistic-decimal-number/Lua/narcissistic-decimal-number.lua b/Task/Narcissistic-decimal-number/Lua/narcissistic-decimal-number.lua new file mode 100644 index 0000000000..7244795549 --- /dev/null +++ b/Task/Narcissistic-decimal-number/Lua/narcissistic-decimal-number.lua @@ -0,0 +1,17 @@ +function isNarc (n) + local m, sum, digit = string.len(n), 0 + for pos = 1, m do + digit = tonumber(string.sub(n, pos, pos)) + sum = sum + digit^m + end + return sum == n +end + +local n, count = 0, 0 +repeat + if isNarc(n) then + io.write(n .. " ") + count = count + 1 + end + n = n + 1 +until count == 25 diff --git a/Task/Narcissistic-decimal-number/PARI-GP/narcissistic-decimal-number.pari b/Task/Narcissistic-decimal-number/PARI-GP/narcissistic-decimal-number.pari new file mode 100644 index 0000000000..a1469eacbe --- /dev/null +++ b/Task/Narcissistic-decimal-number/PARI-GP/narcissistic-decimal-number.pari @@ -0,0 +1,2 @@ +isNarcissistic(n)=my(v=digits(n)); sum(i=1, #v, v[i]^#v)==n +v=List();for(n=1,1e9,if(isNarcissistic(n),listput(v,n);if(#v>24, return(Vec(v))))) diff --git a/Task/Narcissistic-decimal-number/PowerShell/narcissistic-decimal-number.psh b/Task/Narcissistic-decimal-number/PowerShell/narcissistic-decimal-number.psh new file mode 100644 index 0000000000..4b56f971a9 --- /dev/null +++ b/Task/Narcissistic-decimal-number/PowerShell/narcissistic-decimal-number.psh @@ -0,0 +1,30 @@ +function Test-Narcissistic ([int]$Number) +{ + if ($Number -lt 0) {return $false} + + $total = 0 + $digits = $Number.ToString().ToCharArray() + + foreach ($digit in $digits) + { + $total += [Math]::Pow([Char]::GetNumericValue($digit), $digits.Count) + } + + $total -eq $Number +} + + +[int[]]$narcissisticNumbers = @() +[int]$i = 0 + +while ($narcissisticNumbers.Count -lt 25) +{ + if (Test-Narcissistic -Number $i) + { + $narcissisticNumbers += $i + } + + $i++ +} + +$narcissisticNumbers | Format-Wide {"{0,7}" -f $_} -Column 5 -Force diff --git a/Task/Narcissistic-decimal-number/REXX/narcissistic-decimal-number-1.rexx b/Task/Narcissistic-decimal-number/REXX/narcissistic-decimal-number-1.rexx index bcc854f385..84348d7bbf 100644 --- a/Task/Narcissistic-decimal-number/REXX/narcissistic-decimal-number-1.rexx +++ b/Task/Narcissistic-decimal-number/REXX/narcissistic-decimal-number-1.rexx @@ -1,17 +1,17 @@ -/*REXX pgm generates and displays a number of narcissistic (Armstrong) numbers*/ -numeric digits 39 /*be able to handle largest Armstrong #*/ -parse arg N .; if N=='' then N=25 /*obtain the number of narcissistic #'s*/ -N=min(N,89) /*there are only 89 narcissistic #s. */ -#=0 /*number of narcissistic numbers so far*/ - do j=0 until #==N; L=length(j) /*get length of the J decimal number.*/ - $=left(j,1)**L /*1st digit in J raised to the L pow.*/ +/*REXX program generates and displays a number of narcissistic (Armstrong) numbers. */ +numeric digits 39 /*be able to handle largest Armstrong #*/ +parse arg N .; if N=='' | N=="," then N=25 /*obtain the number of narcissistic #'s*/ +N=min(N, 89) /*there are only 89 narcissistic #s. */ +#=0 /*number of narcissistic numbers so far*/ + do j=0 until #==N; L=length(j) /*get length of the J decimal number.*/ + $=left(j,1)**L /*1st digit in J raised to the L pow.*/ - do k=2 for L-1 until $>j /*perform for each decimal digit in J.*/ - $=$ + substr(j,k,1)**L /*add digit raised to power to the sum.*/ - end /*k*/ /* [↑] calculate the rest of the sum. */ + do k=2 for L-1 until $>j /*perform for each decimal digit in J.*/ + $=$ + substr(j, k, 1) ** L /*add digit raised to power to the sum.*/ + end /*k*/ /* [↑] calculate the rest of the sum. */ - if $\==j then iterate /*does the sum equal to J? No, skip it*/ - #=#+1 /*bump count of narcissistic numbers. */ - say right(#,9) ' narcissistic:' j /*display index and narcissistic number*/ - end /*j*/ /* [↑] this list starts at 0 (zero).*/ - /*stick a fork in it, we're all done. */ + if $\==j then iterate /*does the sum equal to J? No, skip it*/ + #=#+1 /*bump count of narcissistic numbers. */ + say right(#, 9) ' narcissistic:' j /*display index and narcissistic number*/ + end /*j*/ /* [↑] this list starts at 0 (zero).*/ + /*stick a fork in it, we're all done. */ diff --git a/Task/Narcissistic-decimal-number/REXX/narcissistic-decimal-number-2.rexx b/Task/Narcissistic-decimal-number/REXX/narcissistic-decimal-number-2.rexx index 082ab32d02..33e58a8379 100644 --- a/Task/Narcissistic-decimal-number/REXX/narcissistic-decimal-number-2.rexx +++ b/Task/Narcissistic-decimal-number/REXX/narcissistic-decimal-number-2.rexx @@ -1,22 +1,23 @@ -/*REXX pgm generates and displays a number of narcissistic (Armstrong) numbers*/ -numeric digits 39 /*be able to handle largest Armstrong #*/ -parse arg N .; if N=='' then N=25 /*obtain the number of narcissistic #'s*/ -N=min(N,89) /*there are only 89 narcissistic #s. */ - do w=1 for 39 /*generate tables: digits ^ L power. */ - do i=0 for 10; @.w.i=i**w; end /*build table of ten digits ^ L power. */ - end /*w*/ /* [↑] table is a fixed (limited) size*/ -#=0 /*number of narcissistic numbers so far*/ - do j=0 until #==N; L=length(j) /*get length of the J decimal number.*/ - _=left(j,1) /*select the first decimal digit to sum*/ - $=@.L._ /*sum of the J dec. digits ^ L (so far)*/ +/*REXX program generates and displays a number of narcissistic (Armstrong) numbers. */ +numeric digits 39 /*be able to handle largest Armstrong #*/ +parse arg N .; if N=='' | N=="," then N=25 /*obtain the number of narcissistic #'s*/ +N=min(N, 89) /*there are only 89 narcissistic #s. */ - do k=2 for L-1 until $>j /*perform for each decimal digit in J.*/ - _=substr(j,k,1) /*select the next decimal digit to sum.*/ - $=$+@.L._ /*add dec. digit raised to power to sum*/ - end /*k*/ /* [↑] calculate the rest of the sum. */ + do w=1 for 39 /*generate tables: digits ^ L power. */ + do i=0 for 10; @.w.i=i**w /*build table of ten digits ^ L power. */ + end /*i*/ + end /*w*/ /* [↑] table is a fixed (limited) size*/ +#=0 /*number of narcissistic numbers so far*/ + do j=0 until #==N; L=length(j) /*get length of the J decimal number.*/ + _=left(j, 1) /*select the first decimal digit to sum*/ + $=@.L._ /*sum of the J dec. digits ^ L (so far)*/ + do k=2 for L-1 until $>j /*perform for each decimal digit in J.*/ + _=substr(j, k, 1) /*select the next decimal digit to sum.*/ + $=$ + @.L._ /*add dec. digit raised to power to sum*/ + end /*k*/ /* [↑] calculate the rest of the sum. */ - if $\==j then iterate /*does the sum equal to J? No, skip it*/ - #=#+1 /*bump count of narcissistic numbers. */ - say right(#,9) ' narcissistic:' j /*display index and narcissistic number*/ - end /*j*/ /* [↑] this list starts at 0 (zero).*/ - /*stick a fork in it, we're all done. */ + if $\==j then iterate /*does the sum equal to J? No, skip it*/ + #=#+1 /*bump count of narcissistic numbers. */ + say right(#, 9) ' narcissistic:' j /*display index and narcissistic number*/ + end /*j*/ /* [↑] this list starts at 0 (zero).*/ + /*stick a fork in it, we're all done. */ diff --git a/Task/Narcissistic-decimal-number/REXX/narcissistic-decimal-number-3.rexx b/Task/Narcissistic-decimal-number/REXX/narcissistic-decimal-number-3.rexx index 5bcf2bb4c5..6e4631bd02 100644 --- a/Task/Narcissistic-decimal-number/REXX/narcissistic-decimal-number-3.rexx +++ b/Task/Narcissistic-decimal-number/REXX/narcissistic-decimal-number-3.rexx @@ -1,28 +1,28 @@ -/*REXX pgm generates and displays a number of narcissistic (Armstrong) numbers*/ -numeric digits 39 /*be able to handle largest Armstrong #*/ -parse arg N .; if N=='' then N=25 /*obtain the number of narcissistic #'s*/ -N=min(N,89) /*there are only 89 narcissistic #s. */ -@.=0 /*set default for the @ stemmed array. */ -#=0 /*number of narcissistic numbers so far*/ - do w=0 for 39+1 /*generate tables: digits ^ L power. */ - if w<10 then call tell w /*display the 1st 1─digit dec. numbers.*/ - do i=1 for 9; @.w.i=i**w; end /*build table of ten digits ^ L power. */ - end /*w*/ /* [↑] table is a fixed (limited) size*/ - /* [↓] skip the 2─digit dec. numbers. */ - do j=100; L=length(j) /*get length of the J decimal number.*/ - parse var j _1 2 _2 3 m '' -1 _R /*get 1st, 2nd, middle, last dec. digit*/ - $=@.L._1 + @.L._2 + @.L._R /*sum of the J decimal digs^L (so far).*/ +/*REXX program generates and displays a number of narcissistic (Armstrong) numbers. */ +numeric digits 39 /*be able to handle largest Armstrong #*/ +parse arg N .; if N=='' | N=="," then N=25 /*obtain the number of narcissistic #'s*/ +N=min(N, 89) /*there are only 89 narcissistic #s. */ +@.=0 /*set default for the @ stemmed array. */ +#=0 /*number of narcissistic numbers so far*/ + do w=0 for 39+1; if w<10 then call tell w /*display the 1st 1─digit dec. numbers.*/ + do i=1 for 9; @.w.i=i**w /*build table of ten digits ^ L power. */ + end /*i*/ + end /*w*/ /* [↑] table is a fixed (limited) size*/ + /* [↓] skip the 2─digit dec. numbers. */ + do j=100; L=length(j) /*get length of the J decimal number.*/ + parse var j _1 2 _2 3 m '' -1 _R /*get 1st, 2nd, middle, last dec. digit*/ + $=@.L._1 + @.L._2 + @.L._R /*sum of the J decimal digs^L (so far).*/ - do k=3 for L-3 until $>j /*perform for other decimal digits in J*/ - parse var m _ +1 m /*get next dec. dig in J, start at 3rd.*/ - $=$ + @.L._ /*add dec. digit raised to pow to sum. */ - end /*k*/ /* [↑] calculate the rest of the sum. */ + do k=3 for L-3 until $>j /*perform for other decimal digits in J*/ + parse var m _ +1 m /*get next dec. dig in J, start at 3rd.*/ + $=$ + @.L._ /*add dec. digit raised to pow to sum. */ + end /*k*/ /* [↑] calculate the rest of the sum. */ - if $==j then call tell j /*does the sum equal to J? Show the #*/ - end /*j*/ /* [↑] the J loop list starts at 100*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -tell: #=#+1 /*bump the counter for narcissistic #s.*/ -say right(#,9) ' narcissistic:' arg(1) /*display index and narcissistic number*/ -if #==N then exit /*stick a fork in it, we're all done. */ -return /*return to invoker & keep on truckin'.*/ + if $==j then call tell j /*does the sum equal to J? Show the #*/ + end /*j*/ /* [↑] the J loop list starts at 100*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +tell: #=#+1 /*bump the counter for narcissistic #s.*/ + say right(#,9) ' narcissistic:' arg(1) /*display index and narcissistic number*/ + if #==N then exit /*stick a fork in it, we're all done. */ + return /*return to invoker & keep on truckin'.*/ diff --git a/Task/Natural-sorting/Elixir/natural-sorting.elixir b/Task/Natural-sorting/Elixir/natural-sorting.elixir new file mode 100644 index 0000000000..3f3698c4f2 --- /dev/null +++ b/Task/Natural-sorting/Elixir/natural-sorting.elixir @@ -0,0 +1,56 @@ +defmodule Natural do + def sorting(texts) do + Enum.sort_by(texts, fn text -> compare_value(text) end) + end + + defp compare_value(text) do + text + |> String.downcase + |> String.replace(~r/\A(a |an |the )/, "") + |> String.split + |> Enum.map(fn word -> + Regex.scan(~r/\d+|\D+/, word) + |> Enum.map(fn [part] -> + case Integer.parse(part) do + {num, ""} -> num + _ -> part + end + end) + end) + end + + def task(title, input) do + IO.puts "\n#{title}:" + IO.puts "< input >" + Enum.each(input, &IO.inspect &1) + IO.puts "< normal sort >" + Enum.sort(input) |> Enum.each(&IO.inspect &1) + IO.puts "< natural sort >" + Enum.sort_by(input, &compare_value &1) |> Enum.each(&IO.inspect &1) + end +end + +[{"Ignoring leading spaces", + ["ignore leading spaces: 2-2", " ignore leading spaces: 2-1", + " ignore leading spaces: 2+0", " ignore leading spaces: 2+1"]}, + + {"Ignoring multiple adjacent spaces (m.a.s)", + ["ignore m.a.s spaces: 2-2", "ignore m.a.s spaces: 2-1", + "ignore m.a.s spaces: 2+0", "ignore m.a.s spaces: 2+1"]}, + + {"Equivalent whitespace characters", + ["Equiv. spaces: 3-3", "Equiv.\rspaces: 3-2", "Equiv.\x0cspaces: 3-1", + "Equiv.\x0bspaces: 3+0", "Equiv.\nspaces: 3+1", "Equiv.\tspaces: 3+2"]}, + + {"Case Indepenent sort", + ["cASE INDEPENENT: 3-2", "caSE INDEPENENT: 3-1", + "casE INDEPENENT: 3+0", "case INDEPENENT: 3+1"]}, + + {"Numeric fields as numerics", + ["foo100bar99baz0.txt", "foo100bar10baz0.txt", + "foo1000bar99baz10.txt", "foo1000bar99baz9.txt"]}, + + {"Title sorts", + ["The Wind in the Willows", "The 40th step more", "The 39 steps", "Wanda"]} +] +|> Enum.each(fn {title, input} -> Natural.task(title, input) end) diff --git a/Task/Nautical-bell/00DESCRIPTION b/Task/Nautical-bell/00DESCRIPTION index 01ffa892de..351be9884a 100644 --- a/Task/Nautical-bell/00DESCRIPTION +++ b/Task/Nautical-bell/00DESCRIPTION @@ -1,7 +1,15 @@ -The task is to write a small program that emulates a [[wp:Ship's bell#Timing_of_duty_periods|nautical bell]] producing a ringing bell pattern at certain times throughout the day. +[[File:ship'sBell.jpg|650px||right]] +[[Category: Date and time]] + +;Task + +Write a small program that emulates a [[wp:Ship's bell#Timing_of_duty_periods|nautical bell]] producing a ringing bell pattern at certain times throughout the day. + The bell timing should be in accordance with [[wp:GMT|Greenwich Mean Time]], unless locale dictates otherwise. It is permissible for the program to [[Run as a daemon or service|daemonize]], or to slave off a scheduler, and it is permissible to use alternative notification methods (such as producing a written notice "Two Bells Gone"), if these are more usual for the system type. + ;Cf.: * [[Sleep]] +

    diff --git a/Task/Nautical-bell/AWK/nautical-bell.awk b/Task/Nautical-bell/AWK/nautical-bell.awk new file mode 100644 index 0000000000..d9712e2e09 --- /dev/null +++ b/Task/Nautical-bell/AWK/nautical-bell.awk @@ -0,0 +1,51 @@ +# syntax: GAWK -f NAUTICAL_BELL.AWK +BEGIN { +# sleep_cmd = "sleep 55s" # Unix + sleep_cmd = "TIMEOUT /T 55 >NUL" # MS-Windows + split("Middle,Morning,Forenoon,Afternoon,Dog,First",watch_arr,",") + split("One,Two,Three,Four,Five,Six,Seven,Eight",bells_arr,",") + simulate1day() + while (1) { + t = systime() + h = strftime("%H",t) + 0 + m = strftime("%M",t) + 0 + if (m == 0 || m == 30) { + nb(h,m) + while (systime() < t + 5) {} + } + system(sleep_cmd) + } + exit(0) +} +function nb(h,m, bells,hhmm,plural,sounds,watch) { +# hhmm = sprintf("%02d:%02d",h,m) +# if (hhmm == "00:00") { watch = 6 } +# else if (hhmm <= "04:00") { watch = 1 } +# else if (hhmm <= "08:00") { watch = 2 } +# else if (hhmm <= "12:00") { watch = 3 } +# else if (hhmm <= "16:00") { watch = 4 } +# else if (hhmm <= "20:00") { watch = 5 } +# else { watch = 6} +# determining watch: verbose & readable (above) vs. terse & cryptic (below) + watch = 60 * h + m + watch = (watch < 1 ) ? 6 : int((watch - 1) / 240 + 1) + bells = (h % 4) * 2 + int(m / 30) + if (bells == 0) { bells = 8 } + plural = (bells == 1) ? " " : "s" + sounds = strdup("\x07",bells) + printf("%02d:%02d %9s watch %5s bell%s %s\n",h,m,watch_arr[watch],bells_arr[bells],plural,sounds) +} +function simulate1day( h,m) { + for (h=0; h<=23; h++) { + for (m=0; m<=59; m+=30) { + nb(h,m) + } + } +} +function strdup(str,n, i,new_str) { + for (i=1; i<=n; i++) { + new_str = new_str str + } + gsub(str str,"& ",new_str) + return(new_str) +} diff --git a/Task/Nautical-bell/AppleScript/nautical-bell.applescript b/Task/Nautical-bell/AppleScript/nautical-bell.applescript new file mode 100644 index 0000000000..7f584e3f96 --- /dev/null +++ b/Task/Nautical-bell/AppleScript/nautical-bell.applescript @@ -0,0 +1,15 @@ +repeat + set {hours:h, minutes:m} to (current date) + if {0, 30} contains m then + set bells to (h mod 4) * 2 + (m div 30) + if bells is 0 then set bells to 4 + set pairs to bells div 2 + repeat pairs times + say "ding dong" using "Bells" + end repeat + if (bells mod 2) is 1 then + say "dong" using "Bells" + end if + end if + delay 60 +end repeat diff --git a/Task/Nautical-bell/Java/nautical-bell.java b/Task/Nautical-bell/Java/nautical-bell.java index a42edb783c..24dd7eac20 100644 --- a/Task/Nautical-bell/Java/nautical-bell.java +++ b/Task/Nautical-bell/Java/nautical-bell.java @@ -43,7 +43,7 @@ public class NauticalBell extends Thread { try { Thread.sleep(wait); } catch (InterruptedException e) { - System.out.println(e); + return; } } } diff --git a/Task/Nautical-bell/OoRexx/nautical-bell.rexx b/Task/Nautical-bell/OoRexx/nautical-bell.rexx new file mode 100644 index 0000000000..f73ea3a55f --- /dev/null +++ b/Task/Nautical-bell/OoRexx/nautical-bell.rexx @@ -0,0 +1,46 @@ +/*REXX pgm beep's "bells" (using PC speaker) when running (perpetually).*/ + Parse Arg msg + If msg='?' Then Do + Say 'Ring a nautical bell' + Exit + End + Signal on Halt /* allow a clean way to stop prog.*/ + Do Forever + Parse Value time() With hh ':' mn ':' ss + ct=time('C') + hhmmc=left(right(ct,7,0),5) /* HH:MM (leading zero). */ + If msg>'' Then + Say center(arg(1) ct time(),79) /* echo arg1 with time ? */ + If ss==00 & ( mn==00 | mn==30 ) Then Do /*It's time to ring bell */ + dd=dd(hhmmc) /* compute number of times */ + If msg>'' Then + Say center(dd "bells",79) /* echo bells? */ + Do k=1 For dd + Call beep 650,500 + Call syssleep 1+(k//2==0) + End + Call syssleep 60 /* ensure don't re-peel. */ + End + Else + Call syssleep (60-ss) + End +/* test +time: +If arg(1)='C' Then + res='8:30am' +Else + res='08:30:00' +Return res +*/ + +dd: Parse Arg hhmmc +Parse Var hhmmc hh +2 ':' mm . +h=hh//4 +If h=0 Then + If mm=00 Then res=8 + Else res=1 +Else + res=2*h+(mm=30) +Return res + +halt: diff --git a/Task/Nautical-bell/PowerShell/nautical-bell.psh b/Task/Nautical-bell/PowerShell/nautical-bell.psh new file mode 100644 index 0000000000..651f94329e --- /dev/null +++ b/Task/Nautical-bell/PowerShell/nautical-bell.psh @@ -0,0 +1,79 @@ +function Get-Bell +{ + [CmdletBinding()] + Param + ( + [Parameter(Mandatory=$true, + Position=0)] + [ValidateRange(1,12)] + [int] + $Hour, + + [Parameter(Mandatory=$true, + Position=1)] + [ValidateSet(0,30)] + [int] + $Minute + ) + + $bells = @{ + OneBell = 1 + TwoBells = 2 + ThreeBells = 2, 1 + FourBells = 2, 2 + FiveBells = 2, 2, 1 + SixBells = 2, 2, 2 + SevenBells = 2, 2, 2, 1 + EightBells = 2, 2, 2, 2 + } + + filter Invoke-Bell + { + if ($_ -eq 1) + { + [System.Media.SystemSounds]::Asterisk.Play() + Write-Host -NoNewline "♪" + } + else + { + [System.Media.SystemSounds]::Exclamation.Play() + Write-Host -NoNewline "♪♪ " + } + + Start-Sleep -Milliseconds 500 + } + + + $time = New-TimeSpan -Hours $Hour -Minutes $Minute + + switch ($time.Hours) + { + 1 {if ($time.Minutes -eq 0) {$bells.TwoBells | Invoke-Bell} else {$bells.ThreeBells | Invoke-Bell}; break} + 2 {if ($time.Minutes -eq 0) {$bells.FourBells | Invoke-Bell} else {$bells.FiveBells | Invoke-Bell}; break} + 3 {if ($time.Minutes -eq 0) {$bells.SixBells | Invoke-Bell} else {$bells.SevenBells | Invoke-Bell}; break} + 4 {if ($time.Minutes -eq 0) {$bells.EightBells | Invoke-Bell} else {$bells.OneBell | Invoke-Bell}; break} + 5 {if ($time.Minutes -eq 0) {$bells.TwoBells | Invoke-Bell} else {$bells.ThreeBells | Invoke-Bell}; break} + 6 {if ($time.Minutes -eq 0) {$bells.FourBells | Invoke-Bell} else {$bells.FiveBells | Invoke-Bell}; break} + 7 {if ($time.Minutes -eq 0) {$bells.SixBells | Invoke-Bell} else {$bells.SevenBells | Invoke-Bell}; break} + 8 {if ($time.Minutes -eq 0) {$bells.EightBells | Invoke-Bell} else {$bells.OneBell | Invoke-Bell}; break} + 9 {if ($time.Minutes -eq 0) {$bells.TwoBells | Invoke-Bell} else {$bells.ThreeBells | Invoke-Bell}; break} + 10 {if ($time.Minutes -eq 0) {$bells.FourBells | Invoke-Bell} else {$bells.FiveBells | Invoke-Bell}; break} + 11 {if ($time.Minutes -eq 0) {$bells.SixBells | Invoke-Bell} else {$bells.SevenBells | Invoke-Bell}; break} + 12 {if ($time.Minutes -eq 0) {$bells.EightBells | Invoke-Bell} else {$bells.OneBell | Invoke-Bell}} + } + + Write-Host +} + +Write-Host "Time Bells`n---- -----`n" + +1..12 | ForEach-Object { + + $date = Get-Date -Hour $_ -Minute 0 + Write-Host -NoNewline "$($date.ToString("hh:mm")) " + Get-Bell -Hour $_ -Minute 0 + + $date = $date.AddMinutes(30) + Write-Host -NoNewline "$($date.ToString("hh:mm")) " + Get-Bell -Hour $_ -Minute 30 +} diff --git a/Task/Nautical-bell/REXX/nautical-bell.rexx b/Task/Nautical-bell/REXX/nautical-bell.rexx index 587d97fc64..f5aa285b38 100644 --- a/Task/Nautical-bell/REXX/nautical-bell.rexx +++ b/Task/Nautical-bell/REXX/nautical-bell.rexx @@ -1,24 +1,25 @@ -/*REXX pgm sounds "bells" (using PC speaker) when running (perpetually).*/ -echo= arg()\==0 /*echo time & bells if any args. */ -signal on halt /*allow a clean way to stop prog.*/ -t.1 = '00:30 01:00 01:30 02:00 02:30 03:00 03:30 04:00' -t.2 = '04:30 05:00 05:30 06:00 06:30 07:00 07:30 08:00' -t.3 = '08:30 09:00 09:30 10:00 10:30 11:00 11:30 12:00' +/*REXX program sounds "ship's bells" (using PC speaker) when executing (perpetually).*/ +echo= (arg()\==0) /*echo time and bells if any arguments.*/ +signal on halt /*allow a clean way to stop the program*/ + t.1= '00:30 01:00 01:30 02:00 02:30 03:00 03:30 04:00' + t.2= '04:30 05:00 05:30 06:00 06:30 07:00 07:30 08:00' + t.3= '08:30 09:00 09:30 10:00 10:30 11:00 11:30 12:00' - do forever; t=time(); ss=right(t,2); mn=right(t,2) /*times.*/ - ct=time('C') /*[↓] add leading zero.*/ - hhmmc=left( right( ct, 7, 0), 5) /*HH:MM (leading zero).*/ - if echo then say center(arg(1) ct, 79) /*echo arg1 with time ?*/ - if ss\==00 & mn\==00 & mn\==30 then /*wait for next min ? */ - do; call delay 60-ss; iterate; end /*delay fraction of min*/ + do forever; t=time(); ss=right(t,2); mn=substr(t,4,2) /*the current time. */ + ct=time('C') /*[↓] maybe add leading zero*/ + hhmmc=left( right( ct, 7, 0), 5) /*HH:MM (with leading zero).*/ + if echo then say center(arg(1) ct, 79) /*echo 1st arg with the time?*/ + if ss\==00 & mn\==00 & mn\==30 then do /*wait for the next minute ? */ + call delay 60-ss; iterate + end /* [↑] delay minute fraction*/ + /* [↓] number bells to peel.*/ + do j=1 for 3 until $\==0; $=wordpos(hhmmc,t.j) + end /*j*/ - /*[↓] # bells to peel.*/ - do j=1 for 3 until $\==0; $=wordpos(hhmmc,t.j); end /*j*/ + if $\==0 & echo then say center($ "bells", 79) /*echo the bells ? */ - if $\==0 & echo then say center($ "bells", 79) /*echo bells? */ - - do k=1 for $; call sound 650,1; call delay 1+(k//2==0); end /*k*/ - /*[↑] peel and pause.*/ - call delay 60 /*ensure don't re-peel.*/ - end /*forever*/ -halt: /*stick a fork in it, we're done.*/ + do k=1 for $; call sound 650,1; call delay 1 +(k//2==0) + end /*k*/ /*[↑] peel and then pause. */ + call delay 60 /*ensure we don't re-peel. */ + end /*forever*/ +halt: /*stick a fork in it, we're all done. */ diff --git a/Task/Non-continuous-subsequences/00DESCRIPTION b/Task/Non-continuous-subsequences/00DESCRIPTION index 0a7ec01075..cab2b63ad2 100644 --- a/Task/Non-continuous-subsequences/00DESCRIPTION +++ b/Task/Non-continuous-subsequences/00DESCRIPTION @@ -7,6 +7,13 @@ A ''continuous'' subsequence is one in which no elements are missing between the Note: Subsequences are defined ''structurally'', not by their contents. So a sequence ''a,b,c,d'' will always have the same subsequences and continuous subsequences, no matter which values are substituted; it may even be the same value. -'''Task''': Find all non-continuous subsequences for a given sequence. Example: For the sequence ''1,2,3,4'', there are five non-continuous subsequences, namely ''1,3''; ''1,4''; ''2,4''; ''1,3,4'' and ''1,2,4''. +'''Task''': Find all non-continuous subsequences for a given sequence. + +Example: For the sequence   ''1,2,3,4'',   there are five non-continuous subsequences, namely: +::::*   ''1,3'' +::::*   ''1,4'' +::::*   ''2,4'' +::::*   ''1,3,4'' +::::*   ''1,2,4'' '''Goal''': There are different ways to calculate those subsequences. Demonstrate algorithm(s) that are natural for the language. diff --git a/Task/Non-continuous-subsequences/Elixir/non-continuous-subsequences.elixir b/Task/Non-continuous-subsequences/Elixir/non-continuous-subsequences.elixir new file mode 100644 index 0000000000..8d69840d9d --- /dev/null +++ b/Task/Non-continuous-subsequences/Elixir/non-continuous-subsequences.elixir @@ -0,0 +1,24 @@ +defmodule RC do + defp masks(n) do + maxmask = trunc(:math.pow(2, n)) - 1 + Enum.map(3..maxmask, &Integer.to_string(&1, 2)) + |> Enum.filter_map(&contains_noncont(&1), &String.rjust(&1, n, ?0)) # padding + end + + defp contains_noncont(n) do + Regex.match?(~r/10+1/, n) + end + + defp apply_mask_to_list(mask, list) do + Enum.zip(to_char_list(mask), list) + |> Enum.filter_map(fn {include, _} -> include > ?0 end, fn {_, value} -> value end) + end + + def ncs(list) do + Enum.map(masks(length(list)), fn mask -> apply_mask_to_list(mask, list) end) + end +end + +IO.inspect RC.ncs([1,2,3]) +IO.inspect RC.ncs([1,2,3,4]) +IO.inspect RC.ncs('abcd') diff --git a/Task/Non-continuous-subsequences/REXX/non-continuous-subsequences.rexx b/Task/Non-continuous-subsequences/REXX/non-continuous-subsequences.rexx index c7162987ee..1530f4ed8e 100644 --- a/Task/Non-continuous-subsequences/REXX/non-continuous-subsequences.rexx +++ b/Task/Non-continuous-subsequences/REXX/non-continuous-subsequences.rexx @@ -1,33 +1,32 @@ -/*REXX program lists non-continuous subsequences (NCS), given a sequence. */ -parse arg list /*obtain the list from the C.L. */ -if list='' then list=1 2 3 4 5 /*Not specified? Use the default*/ -say 'list=' space(list); say /*display the list to terminal. */ -w=words(list) ; #=0 /*W: words in list; # of NCS. */ -$=left(123456789,w) /*build a string of decimal digs.*/ -tail=right($,max(0,w-2)) /*construct a "fast" tail. */ +/*REXX program lists all the non─continuous subsequences (NCS), given a sequence. */ +parse arg list /*obtain the arguments from the C. L. */ +if list='' | list==',' then list=1 2 3 4 5 /*Not specified? Then use the default.*/ +say 'list=' space(list); say /*display the list to the terminal. */ +w=words(list) /*W: is the number of items in list. */ +$=left(123456789, w) /*build a string of decimal digits. */ +tail=right($, max(0, w-2)) /*construct a fast tail for comparisons*/ +#=0 /* [↓] L: length of Jth item. */ + do j=13 to left($,1) || tail; L=length(j) /*step through list (using smart start)*/ + if verify(j, $)\==0 then iterate /*Not one of the chosen (sequences) ? */ + f=left(j,1) /*use the fist decimal digit of J. */ + NCS=0 /*there isn't a non─continuous subseq. */ + do k=2 to L; _=substr(j, k, 1) /*extract a single decimal digit of J.*/ + if _ <= f then iterate j /*if next digit ≤, then skip this digit*/ + if _ \== f+1 then NCS=1 /*it's OK as of now (that is, so far).*/ + f=_ /*now have a new next decimal digit. */ + end /*k*/ - do j=13 to left($,1) || tail /*step through the list. */ - if verify(j,$)\==0 then iterate /*Not one of the chosen? */ - f=left(j,1) /*use the 1st decimal digit of J.*/ - NCS=0 /*not non-continuous subsequence.*/ - do k=2 to length(j); _=substr(j,k,1) /*pick off a single decimal digit*/ - if _ <= f then iterate j /*if next digit ≤, then skip it.*/ - if _ \== f+1 then NCS=1 /*it's OK as of now. */ - f=_ /*now have a new next decimal dig*/ - end /*k*/ + if \NCS then iterate /*not OK? Then skip this number (item)*/ + #=#+1 /*Eureka! We found a number (or item).*/ + @=; do m=1 for L /*build a sequence string to display. */ + @=@ word(list, substr(j, m, 1)) /*pick off a number (item) to display. */ + end /*m*/ - if \NCS then iterate /*not OK? Then skip this number.*/ - #=#+1 /*Eureka! We found onea digit.*/ - x= /*the beginning of the NCS. */ - do m=1 for length(j) /*build a sequence string to show*/ - x=x word(list,substr(j,m,1)) /*pick off a number to display. */ - end /*m*/ - - say 'a non-continuous subsequence: ' x /*show non─continous subsequence.*/ - end /*j*/ - -if #==0 then #='no' /*make it more gooder Anglesh. */ -say; say # "non-continuous subsequence"s(#) 'were found.' -exit /*stick a fork in it, we're done.*/ -/*────────────────────────────────────────────────────────────────────────────*/ -s: if arg(1)==1 then return ''; return word(arg(2) 's',1) /*plurals.*/ + say 'a non─continuous subsequence: ' @ /*show the non─continuous subsequence. */ + end /*j*/ +say +if #==0 then #='no' /*make it look more gooder Angleshy. */ +say # "non─continuous subsequence"s(#) 'were found.' +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +s: if arg(1)==1 then return ''; return word(arg(2) 's', 1) /*pluralizer.*/ diff --git a/Task/Non-decimal-radices-Convert/00DESCRIPTION b/Task/Non-decimal-radices-Convert/00DESCRIPTION index cb36e813b8..6a1e0979e4 100644 --- a/Task/Non-decimal-radices-Convert/00DESCRIPTION +++ b/Task/Non-decimal-radices-Convert/00DESCRIPTION @@ -1,7 +1,16 @@ Number base conversion is when you express a stored integer in an integer base, such as in octal (base 8) or binary (base 2). It also is involved when you take a string representing a number in a given base and convert it to the stored integer form. Normally, a stored integer is in binary, but that's typically invisible to the user, who normally enters or sees stored integers as decimal. -Write a function (or identify the built-in function) which is passed a non-negative integer to convert, and another integer representing the base. It should return a string containing the digits of the resulting number, without leading zeros except for the number 0 itself. For the digits beyond 9, one should use the lowercase English alphabet, where the digit a = 9+1, b = a+1, etc. The decimal number 26 expressed in base 16 would be 1a, for example. + +;Task: +Write a function (or identify the built-in function) which is passed a non-negative integer to convert, and another integer representing the base. + +It should return a string containing the digits of the resulting number, without leading zeros except for the number   '''0'''   itself. + +For the digits beyond 9, one should use the lowercase English alphabet, where the digit   '''a''' = 9+1,   '''b''' = a+1,   etc. + +For example:   the decimal number   '''26'''   expressed in base   '''16'''   would be   '''1a'''. Write a second function which is passed a string and an integer base, and it returns an integer representing that string interpreted in that base. The programs may be limited by the word size or other such constraint of a given language. There is no need to do error checking for negatives, bases less than 2, or inappropriate digits. +

    diff --git a/Task/Non-decimal-radices-Convert/JavaScript/non-decimal-radices-convert.js b/Task/Non-decimal-radices-Convert/JavaScript/non-decimal-radices-convert-1.js similarity index 100% rename from Task/Non-decimal-radices-Convert/JavaScript/non-decimal-radices-convert.js rename to Task/Non-decimal-radices-Convert/JavaScript/non-decimal-radices-convert-1.js diff --git a/Task/Non-decimal-radices-Convert/JavaScript/non-decimal-radices-convert-2.js b/Task/Non-decimal-radices-Convert/JavaScript/non-decimal-radices-convert-2.js new file mode 100644 index 0000000000..ba4f543a92 --- /dev/null +++ b/Task/Non-decimal-radices-Convert/JavaScript/non-decimal-radices-convert-2.js @@ -0,0 +1,19 @@ +var baselist = "0123456789abcdefghijklmnopqrstuvwxyz", listbase = []; +for(var i = 0; i < baselist.length; i++) listbase[baselist[i]] = i; // Generate baselist reverse +function basechange(snumber, frombase, tobase) +{ + var i, t, to = new Array(Math.ceil(snumber.length * Math.log(frombase) / Math.log(tobase))), accumulator; + if(1 < frombase < baselist.length || 1 < tobase < baselist.length) console.error("Invalid or unsupported base!"); + while(snumber[0] == baselist[0] && snumber.length > 1) snumber = snumber.substr(1); // Remove leading zeros character + console.log("Number is", snumber, "in base", frombase, "to base", tobase, "result should be", + parseInt(snumber, frombase).toString(tobase)); + for(i = snumber.length - 1, inexp = 1; i > -1; i--, inexp *= frombase) + for(accumulator = listbase[snumber[i]] * inexp, t = to.length - 1; accumulator > 0 || t >= 0; t--) + { + accumulator += listbase[to[t] || 0]; + to[t] = baselist[(accumulator % tobase) || 0]; + accumulator = Math.floor(accumulator / tobase); + } + return to.join(''); +} +console.log("Result:", basechange("zzzzzzzzzz", 36, 10)); diff --git a/Task/Non-decimal-radices-Convert/JavaScript/non-decimal-radices-convert-3.js b/Task/Non-decimal-radices-Convert/JavaScript/non-decimal-radices-convert-3.js new file mode 100644 index 0000000000..0d4c618a6c --- /dev/null +++ b/Task/Non-decimal-radices-Convert/JavaScript/non-decimal-radices-convert-3.js @@ -0,0 +1,28 @@ +// Tom Wu jsbn.js http://www-cs-students.stanford.edu/~tjw/jsbn/ +var baselist = "0123456789abcdefghijklmnopqrstuvwxyz", listbase = []; +for(var i = 0; i < baselist.length; i++) listbase[baselist[i]] = i; // Generate baselist reverse +function baseconvert(snumber, frombase, tobase) // String number in base X to string number in base Y, arbitrary length, base +{ + var i, t, to, accum = new BigInteger(), inexp = new BigInteger('1', 10), tb = new BigInteger(), + fb = new BigInteger(), tmp = new BigInteger(); + console.log("Number is", snumber, "in base", frombase, "to base", tobase, "result should be", + frombase < 37 && tobase < 37 ? parseInt(snumber, frombase).toString(tobase) : 'too large'); + while(snumber[0] == baselist[0] && snumber.length > 1) snumber = snumber.substr(1); // Remove leading zeros + tb.fromInt(tobase); + fb.fromInt(frombase); + for(i = snumber.length - 1, to = new Array(Math.ceil(snumber.length * Math.log(frombase) / Math.log(tobase))); i > -1; i--) + { + accum = inexp.clone(); + accum.dMultiply(listbase[snumber[i]]); + for(t = to.length - 1; accum.compareTo(BigInteger.ZERO) > 0 || t >= 0; t--) + { + tmp.fromInt(listbase[to[t]] || 0); + accum = accum.add(tmp); + to[t] = baselist[accum.mod(tb).intValue()]; + accum = accum.divide(tb); + } + inexp = inexp.multiply(fb); + } + while(to[0] == baselist[0] && to.length > 1) to = to.slice(1); // Remove leading zeros + return to.join(''); +} diff --git a/Task/Non-decimal-radices-Convert/Lua/non-decimal-radices-convert.lua b/Task/Non-decimal-radices-Convert/Lua/non-decimal-radices-convert.lua new file mode 100644 index 0000000000..311255a3af --- /dev/null +++ b/Task/Non-decimal-radices-Convert/Lua/non-decimal-radices-convert.lua @@ -0,0 +1,14 @@ +function dec2base (base, n) + local result, digit = "" + while n > 0 do + digit = n % base + if digit > 9 then digit = string.char(digit + 87) end + n = math.floor(n / base) + result = digit .. result + end + return result +end + +local x = dec2base(16, 26) +print(x) --> 1a +print(tonumber(x, 16)) --> 26 diff --git a/Task/Non-decimal-radices-Convert/PARI-GP/non-decimal-radices-convert.pari b/Task/Non-decimal-radices-Convert/PARI-GP/non-decimal-radices-convert.pari index eb2ae42f4d..2934ee0ff0 100644 --- a/Task/Non-decimal-radices-Convert/PARI-GP/non-decimal-radices-convert.pari +++ b/Task/Non-decimal-radices-Convert/PARI-GP/non-decimal-radices-convert.pari @@ -10,7 +10,7 @@ toBase(n,b)={ fromBase(s,b)={ my(t=0); s=Vecsmall(s); - forstep(i=#s,1,-1, + for(i=1,#s,1, t=b*t+s[i]-if(s[i]<58,48,87) ); t diff --git a/Task/Non-decimal-radices-Convert/Perl/non-decimal-radices-convert-1.pl b/Task/Non-decimal-radices-Convert/Perl/non-decimal-radices-convert-1.pl index 15198adbac..96ebb24bf0 100644 --- a/Task/Non-decimal-radices-Convert/Perl/non-decimal-radices-convert-1.pl +++ b/Task/Non-decimal-radices-Convert/Perl/non-decimal-radices-convert-1.pl @@ -1,5 +1,4 @@ -use POSIX; - -my ($num, $n_unparsed) = strtol('1a', 16); -$n_unparsed == 0 or die "invalid characters found"; -print "$num\n"; # prints "26" +sub to2 { sprintf "%b", shift; } +sub to16 { sprintf "%x", shift; } +sub from2 { unpack("N", pack("B32", substr("0" x 32 . shift, -32))); } +sub from16 { hex(shift); } diff --git a/Task/Non-decimal-radices-Convert/Perl/non-decimal-radices-convert-2.pl b/Task/Non-decimal-radices-Convert/Perl/non-decimal-radices-convert-2.pl index 6897c94388..c25ba44c10 100644 --- a/Task/Non-decimal-radices-Convert/Perl/non-decimal-radices-convert-2.pl +++ b/Task/Non-decimal-radices-Convert/Perl/non-decimal-radices-convert-2.pl @@ -1,14 +1,17 @@ -sub digitize -# Converts an integer to a single digit. - {my $i = shift; - $i < 10 - ? $i - : ('a' .. 'z')[$i - 10];} - -sub to_base - {my ($int, $radix) = @_; - my $numeral = ''; - do { - $numeral .= digitize($int % $radix); - } while $int = int($int / $radix); - scalar reverse $numeral;} +sub base_to { + my($n,$b) = @_; + my $s = ""; + while ($n) { + $s .= ('0'..'9','a'..'z')[$n % $b]; + $n = int($n/$b); + } + scalar(reverse($s)); +} +sub base_from { + my($n,$b) = @_; + my $t = 0; + for my $c (split(//, lc($n))) { + $t = $b * $t + index("0123456789abcdefghijklmnopqrstuvwxyz", $c); + } + $t; +} diff --git a/Task/Non-decimal-radices-Convert/Perl/non-decimal-radices-convert-3.pl b/Task/Non-decimal-radices-Convert/Perl/non-decimal-radices-convert-3.pl index ffa6da015a..021ed110f8 100644 --- a/Task/Non-decimal-radices-Convert/Perl/non-decimal-radices-convert-3.pl +++ b/Task/Non-decimal-radices-Convert/Perl/non-decimal-radices-convert-3.pl @@ -1,3 +1,4 @@ -use Math::BaseCnv 'cnv'; -print cnv("1a", 16, 10),"\n"; # "1a" from hex to decimal prints 26 -print lc(cnv(26, 10, 16)),"\n"; # 26 from decimal to hex prints "1a" +use POSIX; +my ($num, $n_unparsed) = strtol('1a', 16); +$n_unparsed == 0 or die "invalid characters found"; +print "$num\n"; # prints "26" diff --git a/Task/Non-decimal-radices-Convert/Perl/non-decimal-radices-convert-4.pl b/Task/Non-decimal-radices-Convert/Perl/non-decimal-radices-convert-4.pl new file mode 100644 index 0000000000..591499ea60 --- /dev/null +++ b/Task/Non-decimal-radices-Convert/Perl/non-decimal-radices-convert-4.pl @@ -0,0 +1,5 @@ +use ntheory qw/fromdigits todigitstring/; +my $n = 65261; +my $n16 = todigitstring($n, 16) || 0; +my $n10 = fromdigits($n16, 16); +say "$n $n16 $n10"; # prints "65261 feed 65261" diff --git a/Task/Non-decimal-radices-Convert/REXX/non-decimal-radices-convert.rexx b/Task/Non-decimal-radices-Convert/REXX/non-decimal-radices-convert.rexx index bc81c530d7..6927169164 100644 --- a/Task/Non-decimal-radices-Convert/REXX/non-decimal-radices-convert.rexx +++ b/Task/Non-decimal-radices-Convert/REXX/non-decimal-radices-convert.rexx @@ -1,37 +1,37 @@ -/*REXX pgm converts integers from one base to another (base 2 ──► 90). */ -@abc = 'abcdefghijklmnopqrstuvwxyz' /*the lowercase (Latin) alphabet.*/ -parse upper var @abc @abcU /*uppercase a version of @abc. */ -@@ = 0123456789 || @abc || @abcU /*prefix 'em with numeric digits.*/ -@@ = @@'<>[]{}()?~!@#$%^&*_=|\/;:¢¬≈' /*add some special chars as well.*/ - /* [↑] all chars must be viewable*/ -numeric digits 3000 /*what da hey, support gihugeics.*/ -maxB=length(@@) /*max base (radix) supported here*/ -parse arg x toB inB 1 ox . 1 sigX 2 x2 . /*get: 3 args, origX, sign···*/ -if pos(sigX,"+-")\==0 then x=x2 /*Does X have a leading sign? */ - else sigX= /*Nope. No leading sign for X. */ -if x=='' then call erm /*if no X number, issue error.*/ -if toB=='' | toB=="," then toB=10 /*if skipped, assume default (10)*/ -if inB=='' | inB=="," then inB=10 /* " " " " " */ -if inB<2 | inb>maxB | \datatype(inB,'W') then call erb 'inBase ' inB -if toB<2 | toB>maxB | \datatype(toB,'W') then call erb 'toBase ' toB -#=0 /*result of converted X (base 10)*/ - do j=1 for length(x) /*convert X, base inB ──► base 10*/ - ?=substr(x,j,1) /*pick off a numeral/digit from X*/ - _=pos(?, @@) /*calculate this numeral's value.*/ - if _==0 | _>inB then call erd x /*_ character an illegal numeral?*/ - #=#*inB+_-1 /*build a new number, dig by dig.*/ - end /*j*/ /* [↑] this also verifies digits*/ -y= /*the value of X in base B. */ - do while # >= toB /*convert #, base 10 ──► base toB*/ - y=substr(@@, (#//toB)+1, 1)y /*construct the output number. */ - #=#%toB /*··· and whittle # down also. */ - end /*while*/ /* [↑] process leaves a residual*/ - /* [↓] Y is the residual*/ -y=sigX || substr(@@, #+1, 1)y /*prepend the sign if it existed.*/ -say ox "(base" inB')' center('is',20) y "(base" toB')' -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────one─liner subroutines───────────────*/ -erb: call ser 'illegal' arg(1)", it must be in the range: 2──►"maxB -erd: call ser 'illegal digit/numeral ['?"] in: " x -erm: call ser 'no argument specified.' -ser: say; say '***error!***'; say arg(1); exit 13 +/*REXX program converts integers from one base to another (using bases 2 ──► 90). */ +@abc = 'abcdefghijklmnopqrstuvwxyz' /*lowercase (Latin or English) alphabet*/ +parse upper var @abc @abcU /*uppercase a version of @abc. */ +@@ = 0123456789 || @abc || @abcU /*prefix them with all numeric digits. */ +@@ = @@'<>[]{}()?~!@#$%^&*_=|\/;:¢¬≈' /*add some special characters as well. */ + /* [↑] all characters must be viewable*/ +numeric digits 3000 /*what da hey, support gihugeic numbers*/ +maxB=length(@@) /*max base/radix supported in this code*/ +parse arg x toB inB 1 ox . 1 sigX 2 x2 . /*obtain: three args, origX, sign ··· */ +if pos(sigX, "+-")\==0 then x=x2 /*does X have a leading sign (+ or -) ?*/ + else sigX= /*Nope. No leading sign for the X value*/ +if x=='' then call erm /*if no X number, issue an error msg.*/ +if toB=='' | toB=="," then toB=10 /*if skipped, assume the default (10). */ +if inB=='' | inB=="," then inB=10 /* " " " " " " */ +if inB<2 | inB>maxB | \datatype(inB,'W') then call erb "inBase " inB +if toB<2 | toB>maxB | \datatype(toB,'W') then call erb "toBase " toB +#=0 /*result of converted X (in base 10).*/ + do j=1 for length(x) /*convert X: base inB ──► base 10. */ + ?=substr(x,j,1) /*pick off a numeral/digit from X. */ + _=pos(?, @@) /*calculate the value of this numeral. */ + if _==0 | _>inB then call erd x /*is _ character an illegal numeral? */ + #=#*inB+_-1 /*build a new number, digit by digit. */ + end /*j*/ /* [↑] this also verifies digits. */ +y= /*the value of X in base B. */ + do while # >= toB /*convert #: base 10 ──► base toB.*/ + y=substr(@@, (#//toB)+1, 1)y /*construct the output number. */ + #=#%toB /* ··· and whittle # down also. */ + end /*while*/ /* [↑] algorithm may leave a residual.*/ + /* [↓] Y is the residual. */ +y=sigX || substr(@@, #+1, 1)y /*prepend the sign if it existed. */ +say ox "(base" inB')' center("is",20) y '(base' toB")" +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +erb: call ser 'illegal' arg(1)", it must be in the range: 2──►"maxB +erd: call ser 'illegal digit/numeral ['?"] in: " x +erm: call ser 'no argument specified.' +ser: say; say '***error!***'; say arg(1); exit 13 diff --git a/Task/Non-decimal-radices-Input/PARI-GP/non-decimal-radices-input.pari b/Task/Non-decimal-radices-Input/PARI-GP/non-decimal-radices-input-1.pari similarity index 100% rename from Task/Non-decimal-radices-Input/PARI-GP/non-decimal-radices-input.pari rename to Task/Non-decimal-radices-Input/PARI-GP/non-decimal-radices-input-1.pari diff --git a/Task/Non-decimal-radices-Input/PARI-GP/non-decimal-radices-input-2.pari b/Task/Non-decimal-radices-Input/PARI-GP/non-decimal-radices-input-2.pari new file mode 100644 index 0000000000..921c767bad --- /dev/null +++ b/Task/Non-decimal-radices-Input/PARI-GP/non-decimal-radices-input-2.pari @@ -0,0 +1 @@ +fromdigits([1,15,15],16) diff --git a/Task/Non-decimal-radices-Output/00DESCRIPTION b/Task/Non-decimal-radices-Output/00DESCRIPTION index 7be9e4200e..a653b2058d 100644 --- a/Task/Non-decimal-radices-Output/00DESCRIPTION +++ b/Task/Non-decimal-radices-Output/00DESCRIPTION @@ -1,5 +1,12 @@ Programming languages often have built-in routines to convert a non-negative integer for printing in different number bases. Such common number bases might include binary, [[Octal]] and [[Hexadecimal]]. -Show how to print a small range of integers in some different bases, as supported by standard routines of your programming language. (Note: this is distinct from [[Number base conversion]] as a user-defined conversion function is '''not''' asked for.) + +;Task: +Print a small range of integers in some different bases, as supported by standard routines of your programming language. + + +;Note: +This is distinct from [[Number base conversion]] as a user-defined conversion function is '''not''' asked for.) The reverse operation is [[Common number base parsing]]. +

    diff --git a/Task/Non-decimal-radices-Output/Perl-6/non-decimal-radices-output-1.pl6 b/Task/Non-decimal-radices-Output/Perl-6/non-decimal-radices-output-1.pl6 new file mode 100644 index 0000000000..85caedb6bb --- /dev/null +++ b/Task/Non-decimal-radices-Output/Perl-6/non-decimal-radices-output-1.pl6 @@ -0,0 +1,5 @@ +say 30.base(2); # "11110" +say 30.base(8); # "36" +say 30.base(10); # "30" +say 30.base(16); # "1E" +say 30.base(30); # "10" diff --git a/Task/Non-decimal-radices-Output/Perl-6/non-decimal-radices-output.pl6 b/Task/Non-decimal-radices-Output/Perl-6/non-decimal-radices-output-2.pl6 similarity index 100% rename from Task/Non-decimal-radices-Output/Perl-6/non-decimal-radices-output.pl6 rename to Task/Non-decimal-radices-Output/Perl-6/non-decimal-radices-output-2.pl6 diff --git a/Task/Non-decimal-radices-Output/Run-BASIC/non-decimal-radices-output.run b/Task/Non-decimal-radices-Output/Run-BASIC/non-decimal-radices-output.run new file mode 100644 index 0000000000..480e6b1de4 --- /dev/null +++ b/Task/Non-decimal-radices-Output/Run-BASIC/non-decimal-radices-output.run @@ -0,0 +1,6 @@ +print asc("X") ' convert to ascii +print chr$(169) ' ascii to character +print dechex$(255) ' decimal to hex +print hexdec("FF") ' hex to decimal +print str$(467) ' decimal to string +print val("27") ' string to decimal diff --git a/Task/Nth-root/00DESCRIPTION b/Task/Nth-root/00DESCRIPTION index 6a170b0cb0..af11f8ee43 100644 --- a/Task/Nth-root/00DESCRIPTION +++ b/Task/Nth-root/00DESCRIPTION @@ -1 +1,3 @@ -Implement the algorithm to compute the principal [[wp:Nth root|''n''th root]] \sqrt[n]A of a positive real number ''A'', as explained at the [[wp:Nth root algorithm|Wikipedia page]]. +;Task: + +Implement the algorithm to compute the principal [[wp:Nth root|''n''th root]] \sqrt[n]A of a positive real number ''A'', as explained at the [[wp:Nth root algorithm|Wikipedia page]]. diff --git a/Task/Nth-root/00META.yaml b/Task/Nth-root/00META.yaml index f407ff9d83..733f71ecf3 100644 --- a/Task/Nth-root/00META.yaml +++ b/Task/Nth-root/00META.yaml @@ -1,2 +1,4 @@ --- +category: +- Simple note: Classic CS problems and programs diff --git a/Task/Nth-root/C/nth-root.c b/Task/Nth-root/C/nth-root.c index f5fb6613d3..e54e04d3ab 100644 --- a/Task/Nth-root/C/nth-root.c +++ b/Task/Nth-root/C/nth-root.c @@ -1,31 +1,34 @@ #include #include -inline double abs_(double x) { return x >= 0 ? x : -x; } -double pow_(double x, int e) -{ - double ret = 1; - for (ret = 1; e; x *= x, e >>= 1) - if ((e & 1)) ret *= x; - return ret; +double pow_ (double x, int e) { + int i; + double r = 1; + for (i = 0; i < e; i++) { + r *= x; + } + return r; } -double root(double a, int n) -{ - double d, x = 1; - if (!a) return 0; - if (n < 1 || (a < 0 && !(n&1))) return 0./0.; /* NaN */ - - do { d = (a / pow_(x, n - 1) - x) / n; - x+= d; - } while (abs_(d) >= abs_(x) * (DBL_EPSILON * 10)); - - return x; +double root (int n, double x) { + double d, r = 1; + if (!x) { + return 0; + } + if (n < 1 || (x < 0 && !(n&1))) { + return 0.0 / 0.0; /* NaN */ + } + do { + d = (x / pow_(r, n - 1) - r) / n; + r += d; + } + while (d >= DBL_EPSILON * 10 || d <= -DBL_EPSILON * 10); + return r; } -int main() -{ - double x = pow_(-3.14159, 15); - printf("root(%g, 15) = %g\n", x, root(x, 15)); - return 0; +int main () { + int n = 15; + double x = pow_(-3.14159, 15); + printf("root(%d, %g) = %g\n", n, x, root(n, x)); + return 0; } diff --git a/Task/Nth-root/Clojure/nth-root.clj b/Task/Nth-root/Clojure/nth-root.clj new file mode 100644 index 0000000000..4323df3bee --- /dev/null +++ b/Task/Nth-root/Clojure/nth-root.clj @@ -0,0 +1,23 @@ +(ns test-project-intellij.core + (:gen-class)) + +;; define abs & power to avoid needing to bring in the clojure Math library +(defn abs [x] + " Absolute value" + (if (< x 0) (- x) x)) + +(defn power [x n] + " x to power n, where n = 0, 1, 2, ... " + (apply * (repeat n x))) + +(defn calc-delta [A x n] + " nth rooth algorithm delta calculation " + (/ (- (/ A (power x (- n 1))) x) n)) + +(defn nth-root + " nth root of algorithm: A = numer, n = root" + ([A n] (nth-root A n 0.5 1.0)) ; Takes only two arguments A, n and calls version which takes A, n, guess-prev, guess-current + ([A n guess-prev guess-current] ; version take takes in four arguments (A, n, guess-prev, guess-current) + (if (< (abs (- guess-prev guess-current)) 1e-6) + guess-current + (recur A n guess-current (+ guess-current (calc-delta A guess-current n)))))) ; iterate answer using tail recursion diff --git a/Task/Nth-root/REXX/nth-root.rexx b/Task/Nth-root/REXX/nth-root.rexx index 84a0bc87e0..0cb70d985e 100644 --- a/Task/Nth-root/REXX/nth-root.rexx +++ b/Task/Nth-root/REXX/nth-root.rexx @@ -1,39 +1,38 @@ -/*REXX program calculates the Nth root of X, with DIGS accuracy. */ -parse arg x root digs . /*get specified args from the CL.*/ -if x=='' then x=2 /*Not specified? Then use default*/ -if root=='' then root=2 /* " " " " " */ -if digs=='' then digs=65 /* " " " " " */ -numeric digits digs /*set the precision to DIGS. */ -say ' x = ' x /*echo the value of X. */ -say ' root = ' root /*echo the value of ROOT. */ -say ' digits = ' digs /*echo the value of DIGS. */ -say ' answer = ' root(x,root) /*show the value of ANSWER. */ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────ROOT subroutine─────────────────────*/ -root: procedure; parse arg x 1 Ox,r . 1 Or /*1st arg──►x&Ox, 2nd──►r&Or*/ -if r=='' then r=2 /*Was root specified? Assume √.*/ -if r=0 then return '[n/a]' /*oops-ay! Can't do zeroth root.*/ -complex= x<0 & R//2==0 /*will the result be complex? */ -oDigs=digits() /*get the current number of digs.*/ -if x=0 | r=1 then return x/1 /*handle couple of special cases.*/ -dm=oDigs+5 /*we need a little guard room. */ -r=abs(r); x=abs(x) /*the absolute values of R and X.*/ -rm=r-1 /*just a fast version of ROOT -1*/ -numeric form /*take a good guess at the root─┐*/ -parse value format(x,2,1,,0) 'E0' with ? 'E' _ . /* ◄───────────┘*/ -g= (? / r'E'_ % r) + (x>1) /*kinda uses a crude "logarithm".*/ -numeric fuzz 3 /*fuzz digits for higher roots. */ -d=5 /*start with only five digits. */ - do until d==dm; d=min(d+d,dm) /*each interation doubles prec. */ - numeric digits d /*tell REXX to use D digits. */ - old=-1 /*assume some kind of old guess. */ - do until old=g; old=g /*where da rubber meets da road─┐*/ - g=(rm*g**r+x) / r / g**rm /*nitty-gritty root computation◄┘*/ - end /*until old=g*/ /*maybe until the cows come home.*/ - end /*until d==dm*/ /*and wait for more cows to come.*/ +/*REXX program calculates the Nth root of X, with DIGS (decimal digits) accuracy. */ +parse arg x root digs . /*obtain optional arguments from the CL*/ +if x=='' | x=="," then x= 2 /*Not specified? Then use the default.*/ +if root=='' | root=="," then root= 2 /* " " " " " " */ +if digs=='' | digs=="," then digs=65 /* " " " " " " */ +numeric digits digs /*set the decimal digits to DIGS. */ +say ' x = ' x /*echo the value of X. */ +say ' root = ' root /* " " " " ROOT. */ +say ' digits = ' digs /* " " " " DIGS. */ +say ' answer = ' root(x, root) /*show the value of ANSWER. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +root: procedure; parse arg x 1 Ox, r 1 Or /*arg1 ──► x & Ox, 2nd ──► r & Or*/ + if r=='' then r=2 /*Was root specified? Assume √. */ + if r=0 then return '[n/a]' /*oops-ay! Can't do zeroth root.*/ + complex= x<0 & R//2==0 /*will the result be complex? */ + oDigs=digits() /*get the current number of digs.*/ + if x=0 | r=1 then return x/1 /*handle couple of special cases.*/ + dm=oDigs+5 /*we need a little guard room. */ + r=abs(r); x=abs(x) /*the absolute values of R and X.*/ + rm=r-1 /*just a fast version of ROOT -1*/ + numeric form /*take a good guess at the root─┐*/ + parse value format(x,2,1,,0) 'E0' with ? 'E' _ . /* ◄────────────────────────────┘*/ + g= (? / r'E'_ % r) + (x>1) /*kinda uses a crude "logarithm".*/ + d=5 /*start with five decimal digits.*/ + do until d==dm; d=min(d+d,dm) /*each time, precision doubles. */ + numeric digits d /*tell REXX to use D digits. */ + old=-1 /*assume some kind of old guess. */ + do until old=g; old=g /*where da rubber meets da road─┐*/ + g=format((rm*g**r+x)/r/g**rm,, d-2) /* ◄────── the root computation─┘*/ + end /*until old=g*/ /*maybe until the cows come home.*/ + end /*until d==dm*/ /*and wait for more cows to come.*/ -if g=0 then return 0 /*in case the jillionth root = 0.*/ -if Or<0 then g=1/g /*root < 0 ? Reciprocal it is!*/ -if \complex then g=g*sign(Ox) /*adjust the sign (maybe). */ -numeric digits oDigs /*reinstate the original digits. */ -return g/1 || left('j',complex) /*normalize # to digs, append j ?*/ + if g=0 then return 0 /*in case the jillionth root = 0.*/ + if Or<0 then g=1/g /*root < 0 ? Reciprocal it is! */ + if \complex then g=g*sign(Ox) /*adjust the sign (maybe). */ + numeric digits oDigs /*reinstate the original digits. */ + return (g/1) || left('j', complex) /*normalize # to digs, append j ?*/ diff --git a/Task/Nth/AppleScript/nth.applescript b/Task/Nth/AppleScript/nth.applescript new file mode 100644 index 0000000000..c1b8708a16 --- /dev/null +++ b/Task/Nth/AppleScript/nth.applescript @@ -0,0 +1,84 @@ +-- ORDINAL STRINGS + +-- ordinalString :: Int -> String +on ordinalString(n) + (n as string) & ordinalSuffix(n) +end ordinalString + +-- ordinalSuffix :: Int -> String +on ordinalSuffix(n) + set modHundred to n mod 100 + if (11 ≤ modHundred) and (13 ≥ modHundred) then + "th" + else + item ((n mod 10) + 1) of ¬ + {"th", "st", "nd", "rd", "th", "th", "th", "th", "th", "th"} + end if +end ordinalSuffix + + + +-- TEST +on run + + -- showOrdinals :: [Int] -> [String] + script showOrdinals + on lambda(lstInt) + map(ordinalString, lstInt) + end lambda + end script + + map(showOrdinals, ¬ + map(tupleRange, ¬ + [[0, 25], [250, 265], [1000, 1025]])) + +end run + + + +-- GENERIC FUNCTIONS + +-- 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 + +-- tupleRange :: (Int, Int) -> [Int] +on tupleRange(lstPair) + set {m, n} to lstPair + + range(m, n) +end tupleRange + +-- range :: Int -> Int -> [Int] +on range(m, n) + if n < m then + set d to -1 + else + set d to 1 + end if + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range + +-- 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 diff --git a/Task/Nth/COBOL/nth.cobol b/Task/Nth/COBOL/nth.cobol new file mode 100644 index 0000000000..36766ca757 --- /dev/null +++ b/Task/Nth/COBOL/nth.cobol @@ -0,0 +1,31 @@ +IDENTIFICATION DIVISION. +PROGRAM-ID. NTH-PROGRAM. +DATA DIVISION. +WORKING-STORAGE SECTION. +01 WS-NUMBER. + 05 N PIC 9(8). + 05 LAST-TWO-DIGITS PIC 99. + 05 LAST-DIGIT PIC 9. + 05 N-TO-OUTPUT PIC Z(7)9. + 05 SUFFIX PIC AA. +PROCEDURE DIVISION. +TEST-PARAGRAPH. + PERFORM NTH-PARAGRAPH VARYING N FROM 0 BY 1 UNTIL N IS GREATER THAN 25. + PERFORM NTH-PARAGRAPH VARYING N FROM 250 BY 1 UNTIL N IS GREATER THAN 265. + PERFORM NTH-PARAGRAPH VARYING N FROM 1000 BY 1 UNTIL N IS GREATER THAN 1025. + STOP RUN. +NTH-PARAGRAPH. + MOVE 'TH' TO SUFFIX. + MOVE N (7:2) TO LAST-TWO-DIGITS. + IF LAST-TWO-DIGITS IS LESS THAN 4, + OR LAST-TWO-DIGITS IS GREATER THAN 20, + THEN PERFORM DECISION-PARAGRAPH. + MOVE N TO N-TO-OUTPUT. + DISPLAY N-TO-OUTPUT WITH NO ADVANCING. + DISPLAY SUFFIX WITH NO ADVANCING. + DISPLAY SPACE WITH NO ADVANCING. +DECISION-PARAGRAPH. + MOVE N (8:1) TO LAST-DIGIT. + IF LAST-DIGIT IS EQUAL TO 1 THEN MOVE 'ST' TO SUFFIX. + IF LAST-DIGIT IS EQUAL TO 2 THEN MOVE 'ND' TO SUFFIX. + IF LAST-DIGIT IS EQUAL TO 3 THEN MOVE 'RD' TO SUFFIX. diff --git a/Task/Nth/Common-Lisp/nth-1.lisp b/Task/Nth/Common-Lisp/nth-1.lisp new file mode 100644 index 0000000000..6f6bf47d24 --- /dev/null +++ b/Task/Nth/Common-Lisp/nth-1.lisp @@ -0,0 +1,8 @@ +(defun add-suffix (number) + (let* ((suffixes #10("th" "st" "nd" "rd" "th")) + (last2 (mod number 100)) + (last-digit (mod number 10)) + (suffix (if (< 10 last2 20) + "th" + (svref suffixes last-digit)))) + (format nil "~a~a" number suffix))) diff --git a/Task/Nth/Common-Lisp/nth-2.lisp b/Task/Nth/Common-Lisp/nth-2.lisp new file mode 100644 index 0000000000..b058dfe23b --- /dev/null +++ b/Task/Nth/Common-Lisp/nth-2.lisp @@ -0,0 +1,2 @@ +(defun add-suffix (n) + (format nil "~d'~:[~[th~;st~;nd~;rd~:;th~]~;th~]" n (< (mod (- n 10) 100) 10) (mod n 10))) diff --git a/Task/Nth/Common-Lisp/nth-3.lisp b/Task/Nth/Common-Lisp/nth-3.lisp new file mode 100644 index 0000000000..ce6828be01 --- /dev/null +++ b/Task/Nth/Common-Lisp/nth-3.lisp @@ -0,0 +1,6 @@ +(loop for (low high) in '((0 25) (250 265) (1000 1025)) + do (progn + (format t "~a to ~a: " low high) + (loop for n from low to high + do (format t "~a " (add-suffix n)) + finally (terpri)))) diff --git a/Task/Nth/Common-Lisp/nth.lisp b/Task/Nth/Common-Lisp/nth.lisp deleted file mode 100644 index bf66a27ee9..0000000000 --- a/Task/Nth/Common-Lisp/nth.lisp +++ /dev/null @@ -1,21 +0,0 @@ -(defun add-suffix (number) - (let* ((suffixes #10("th" "st" "nd" "rd" "th")) - (last2 (mod number 100)) - (last-digit (mod number 10)) - (suffix (if (< 10 last2 20) - "th" - (svref suffixes last-digit)))) - (format nil "~a~a" number suffix))) - - -(defun add-suffix (n) - "A more concise, albeit less readable version" - (format nil "~d'~:[~[th~;st~;nd~;rd~:;th~]~;th~]" n (< (mod (- n 10) 100) 10) (mod n 10))) - - -(loop for (low high) in '((0 25) (250 265) (1000 1025)) - do (progn - (format t "~a to ~a: " low high) - (loop for n from low to high - do (format t "~a " (add-suffix n)) - finally (terpri)))) diff --git a/Task/Nth/Factor/nth.factor b/Task/Nth/Factor/nth.factor new file mode 100644 index 0000000000..4432de203c --- /dev/null +++ b/Task/Nth/Factor/nth.factor @@ -0,0 +1,28 @@ +USING: math kernel combinators math.ranges math.parser + sequences io ; +IN: nth + +: tens-digit ( n -- n ) 10 [ /i ] [ mod ] bi ; + +: teens? ( n -- ? ) tens-digit 1 = ; + +: non-teen-suffix ( n -- str ) + 10 mod { + { 1 [ "st" ] } + { 2 [ "nd" ] } + { 3 [ "rd" ] } + [ drop "th" ] + } case ; + +: ordinal-suffix ( n -- str ) + dup teens? [ drop 0 ] when non-teen-suffix ; + +: join-suffix ( n -- str ) dup ordinal-suffix + [ number>string ] dip append ; + +: main ( -- ) + 0 25 250 265 1000 1025 [ [a,b] ] 2tri@ + [ [ join-suffix ] map ] tri@ + [ [ bl ] [ write ] interleave nl ] tri@ ; + +MAIN: main diff --git a/Task/Nth/JavaScript/nth-3.js b/Task/Nth/JavaScript/nth-3.js new file mode 100644 index 0000000000..5add914c78 --- /dev/null +++ b/Task/Nth/JavaScript/nth-3.js @@ -0,0 +1,26 @@ +(function (lstTestRanges) { + 'use strict' + + let lstSuffix = 'th st nd rd th th th th th th'.split(' '), + + // ordinalString :: Int -> String + ordinalString = n => + n.toString() + ( + 11 <= n % 100 && 13 >= n % 100 ? + "th" : lstSuffix[n % 10] + ), + + // range :: Int -> Int -> [Int] + range = (m, n) => + Array.from({ + length: (n - m) + 1 + }, (_, i) => m + i); + + + return lstTestRanges + .map(tpl => range + .apply(null, tpl) + .map(ordinalString) + ); + +})([[0, 25], [250, 265], [1000, 1025]]); diff --git a/Task/Nth/Kotlin/nth.kotlin b/Task/Nth/Kotlin/nth.kotlin new file mode 100644 index 0000000000..2d92635d0b --- /dev/null +++ b/Task/Nth/Kotlin/nth.kotlin @@ -0,0 +1,9 @@ +fun Int.ordinalAbbrev() = + if (this % 100 / 10 == 1) "th" + else when (this % 10) { 1 -> "st" 2 -> "nd" 3 -> "rd" else -> "th" } + +fun IntRange.ordinalAbbrev() = map { "$it" + it.ordinalAbbrev() }.joinToString(" ") + +fun main(args: Array) { + listOf((0..25), (250..265), (1000..1025)).forEach { println(it.ordinalAbbrev()) } +} diff --git a/Task/Nth/Lua/nth.lua b/Task/Nth/Lua/nth.lua index 15d546d08e..b51134c913 100644 --- a/Task/Nth/Lua/nth.lua +++ b/Task/Nth/Lua/nth.lua @@ -1,16 +1,12 @@ function getSuffix (n) - local lastTwo, lastOne = n % 100, n % 10 - if lastTwo > 3 and lastTwo < 21 then return "th" end - if lastOne == 1 then return "st" end - if lastOne == 2 then return "nd" end - if lastOne == 3 then return "rd" end - return "th" + local lastTwo, lastOne = n % 100, n % 10 + if lastTwo > 3 and lastTwo < 21 then return "th" end + if lastOne == 1 then return "st" end + if lastOne == 2 then return "nd" end + if lastOne == 3 then return "rd" end + return "th" end -function Nth (n) - return n .. "'" .. getSuffix(n) -end +function Nth (n) return n .. "'" .. getSuffix(n) end -for n = 0, 25 do - print(Nth(n), Nth(n + 250), Nth(n + 1000)) -end +for i = 0, 25 do print(Nth(i), Nth(i + 250), Nth(i + 1000)) end diff --git a/Task/Nth/Maple/nth.maple b/Task/Nth/Maple/nth.maple new file mode 100644 index 0000000000..45a0785388 --- /dev/null +++ b/Task/Nth/Maple/nth.maple @@ -0,0 +1,25 @@ +toOrdinal := proc(n:: nonnegint) + if 1 <= n and n <= 10 then + if n >= 4 then + printf("%ath", n); + elif n = 3 then + printf("%ard", n); + elif n = 2 then + printf("%and", n); + else + printf("%ast", n); + end if: + else + printf(convert(n, 'ordinal')); + end if: + return NULL; +end proc: + +a := [[0, 25], [250, 265], [1000, 1025]]: +for i in a do + for j from i[1] to i[2] do + toOrdinal(j); + printf(" "); + end do; + printf("\n\n"); +end do; diff --git a/Task/Nth/Pascal/nth.pascal b/Task/Nth/Pascal/nth.pascal new file mode 100644 index 0000000000..285749b408 --- /dev/null +++ b/Task/Nth/Pascal/nth.pascal @@ -0,0 +1,33 @@ +Program n_th; + +function Suffix(N: NativeInt):AnsiString; +var + res: AnsiString; +begin + res:= 'th'; + case N mod 10 of + 1:IF N mod 100 <> 11 then + res:= 'st'; + 2:IF N mod 100 <> 12 then + res:= 'nd'; + 3:IF N mod 100 <> 13 then + res:= 'rd'; + else + end; + Suffix := res; +end; + +procedure Print_Images(loLim, HiLim: NativeInt); +var + i : NativeUint; +begin + for I := LoLim to HiLim do + write(i,Suffix(i),' '); + writeln; +end; + +begin + Print_Images( 0, 25); + Print_Images( 250, 265); + Print_Images(1000, 1025); +end. diff --git a/Task/Nth/PowerShell/nth.psh b/Task/Nth/PowerShell/nth-1.psh similarity index 100% rename from Task/Nth/PowerShell/nth.psh rename to Task/Nth/PowerShell/nth-1.psh diff --git a/Task/Nth/PowerShell/nth-2.psh b/Task/Nth/PowerShell/nth-2.psh new file mode 100644 index 0000000000..0eee4b3361 --- /dev/null +++ b/Task/Nth/PowerShell/nth-2.psh @@ -0,0 +1,17 @@ +function Get-Nth ([int]$Number) +{ + $suffix = "th" + + switch ($Number % 10) + { + 1 {$suffix = "st"} + 2 {$suffix = "nd"} + 3 {$suffix = "rd"} + } + + "$Number$suffix" +} + +1..25 | ForEach-Object {Get-Nth $_} | Format-Wide {$_} -Column 5 -Force +251..265 | ForEach-Object {Get-Nth $_} | Format-Wide {$_} -Column 5 -Force +1001..1025 | ForEach-Object {Get-Nth $_} | Format-Wide {$_} -Column 5 -Force diff --git a/Task/Nth/SQL/nth.sql b/Task/Nth/SQL/nth.sql new file mode 100644 index 0000000000..f07f907ddb --- /dev/null +++ b/Task/Nth/SQL/nth.sql @@ -0,0 +1,7 @@ +select level card, + to_char(to_date(level,'j'),'fmjth') ord +from dual +connect by level <= 15; + +select to_char(to_date(5373485,'j'),'fmjth') +from dual; diff --git a/Task/Null-object/00DESCRIPTION b/Task/Null-object/00DESCRIPTION index aee9a0dda6..f38ebfa4d1 100644 --- a/Task/Null-object/00DESCRIPTION +++ b/Task/Null-object/00DESCRIPTION @@ -1,5 +1,11 @@ -'''Null''' (or '''nil''') is the computer science concept of an undefined or unbound object. Some languages have an explicit way to access the null object, and some don't. Some languages distinguish the null object from [[undefined values]], and some don't. +'''Null''' (or '''nil''') is the computer science concept of an undefined or unbound object. +Some languages have an explicit way to access the null object, and some don't. +Some languages distinguish the null object from [[undefined values]], and some don't. + +;Task: Show how to access null in your language by checking to see if an object is equivalent to the null object. + ''This task is not about whether a variable is defined. The task is about "null"-like values in various languages, which may or may not be related to the defined-ness of variables in your language.'' +

    diff --git a/Task/Null-object/00META.yaml b/Task/Null-object/00META.yaml index 659c8686af..3548159ac8 100644 --- a/Task/Null-object/00META.yaml +++ b/Task/Null-object/00META.yaml @@ -1,2 +1,4 @@ --- +category: +- Simple note: Basic language learning diff --git a/Task/Null-object/COBOL/null-object.cobol b/Task/Null-object/COBOL/null-object.cobol new file mode 100644 index 0000000000..f6b6adc4a5 --- /dev/null +++ b/Task/Null-object/COBOL/null-object.cobol @@ -0,0 +1,43 @@ + identification division. + program-id. null-objects. + remarks. test with cobc -x -j null-objects.cob + + data division. + working-storage section. + 01 thing-not-thing usage pointer. + + *> call a subprogram + *> with one null pointer + *> an omitted parameter + *> and expect void return (callee returning omitted) + *> and do not touch default return-code (returning nothing) + procedure division. + call "test-null" using thing-not-thing omitted returning nothing + goback. + end program null-objects. + + *> Test for pointer to null (still a real thing that takes space) + *> and an omitted parameter, (call frame has placeholder) + *> and finally, return void, (omitted) + identification division. + program-id. test-null. + + data division. + linkage section. + 01 thing-one usage pointer. + 01 thing-two pic x. + + procedure division using + thing-one + optional thing-two + returning omitted. + + if thing-one equal null then + display "thing-one pointer to null" upon syserr + end-if + + if thing-two omitted then + display "no thing-two was passed" upon syserr + end-if + goback. + end program test-null. diff --git a/Task/Null-object/J/null-object-3.j b/Task/Null-object/J/null-object-3.j index a883108b4f..bc072cf12e 100644 --- a/Task/Null-object/J/null-object-3.j +++ b/Task/Null-object/J/null-object-3.j @@ -1,10 +1,12 @@ - 1 1 0 1#3 4 _ 5 + 1 1 0 1#3 4 _ 5 NB. use bitmask to select numbers 3 4 5 - I.1 1 0 1 + I.1 1 0 1 NB. get indices for bitmask 0 1 3 - 0 1 3 { 3 4 _ 5 + 0 1 3 { 3 4 _ 5 NB. use indices to select numbers 3 4 5 - 1 1 0 1 #inv 3 4 5 + 1 1 0 1 #inv 3 4 5 NB. use bitmask to restore original positions 3 4 0 5 - 1 1 0 1 #!._ inv 3 4 5 + 1 1 0 1 #!._ inv 3 4 5 NB. specify different fill element +3 4 _ 5 + 3 4 5 (0 1 3}) _ _ _ _ NB. use indices to restore original positions 3 4 _ 5 diff --git a/Task/Null-object/Maple/null-object-1.maple b/Task/Null-object/Maple/null-object-1.maple new file mode 100644 index 0000000000..d6a2356978 --- /dev/null +++ b/Task/Null-object/Maple/null-object-1.maple @@ -0,0 +1,7 @@ +a := NULL; + a := +is (NULL = ()); + true +if a = NULL then + print (NULL); +end if; diff --git a/Task/Null-object/Maple/null-object-2.maple b/Task/Null-object/Maple/null-object-2.maple new file mode 100644 index 0000000000..9ae1dee9cc --- /dev/null +++ b/Task/Null-object/Maple/null-object-2.maple @@ -0,0 +1,12 @@ +b := Array([1, 2, 3, Integer(undefined), 5]); + b := [ 1 2 3 undefined 5 ] +numelems(b); + 5 +b := Array([1, 2, 3, Float(undefined), 5]); + b := [ 1 2 3 Float(undefined) 5 ] +numelems(b); + 5 +b := Array([1, 2, 3, NULL, 5]); + b := [ 1 2 3 5 ] +numelems(b); + 4 diff --git a/Task/Null-object/Oberon-2/null-object.oberon-2 b/Task/Null-object/Oberon-2/null-object.oberon-2 new file mode 100644 index 0000000000..8afd515c5b --- /dev/null +++ b/Task/Null-object/Oberon-2/null-object.oberon-2 @@ -0,0 +1,14 @@ +MODULE Null; +IMPORT + Out; +TYPE + Object = POINTER TO ObjectDesc; + ObjectDesc = RECORD + END; + +VAR + o: Object; (* default initialization to NIL *) + +BEGIN + IF o = NIL THEN Out.String("o is NIL"); Out.Ln END +END Null. diff --git a/Task/Null-object/REBOL/null-object.rebol b/Task/Null-object/REBOL/null-object-1.rebol similarity index 100% rename from Task/Null-object/REBOL/null-object.rebol rename to Task/Null-object/REBOL/null-object-1.rebol diff --git a/Task/Null-object/REBOL/null-object-2.rebol b/Task/Null-object/REBOL/null-object-2.rebol new file mode 100644 index 0000000000..84bd53b5d7 --- /dev/null +++ b/Task/Null-object/REBOL/null-object-2.rebol @@ -0,0 +1,2 @@ +unset? get/any 'some-var +unset? get 'some-var diff --git a/Task/Number-names/00DESCRIPTION b/Task/Number-names/00DESCRIPTION index a1740465bb..b59b6902f8 100644 --- a/Task/Number-names/00DESCRIPTION +++ b/Task/Number-names/00DESCRIPTION @@ -1,3 +1,7 @@ -Show how to spell out a number in English.
    -You can use a preexisting implementation or roll your own, but you should support inputs up to at least one million (or the maximum value of your language's default bounded integer type, if that's less).
    +;Task: +Show how to spell out a number in English. + +You can use a preexisting implementation or roll your own, but you should support inputs up to at least one million (or the maximum value of your language's default bounded integer type, if that's less). + Support for inputs other than positive integers (like zero, negative integers, and floating-point numbers) is optional. +

    diff --git a/Task/Number-names/PowerShell/number-names.psh b/Task/Number-names/PowerShell/number-names.psh new file mode 100644 index 0000000000..5159471d25 --- /dev/null +++ b/Task/Number-names/PowerShell/number-names.psh @@ -0,0 +1,131 @@ +function Get-NumberName +{ + <# + .SYNOPSIS + Spells out a number in English. + .DESCRIPTION + Spells out a number in English in the range of 0 to 999,999,999. + .NOTES + The code for this function was copied (almost word for word) from the C# + example on this page to show how similar Powershell is to C#. + .PARAMETER Number + One or more integers in the range of 0 to 999,999,999. + .EXAMPLE + Get-NumberName -Number 666 + .EXAMPLE + Get-NumberName 1, 234, 31337, 987654321 + .EXAMPLE + 1, 234, 31337, 987654321 | Get-NumberName + #> + [CmdletBinding()] + [OutputType([string])] + Param + ( + [Parameter(Mandatory=$true, ValueFromPipeline=$true)] + [ValidateRange(0,999999999)] + [int[]] + $Number + ) + + Begin + { + [string[]]$incrementsOfOne = "zero", "one", "two", "three", "four", + "five", "six", "seven", "eight", "nine", + "ten", "eleven", "twelve", "thirteen", "fourteen", + "fifteen", "sixteen", "seventeen", "eighteen", "nineteen" + + [string[]]$incrementsOfTen = "", "", "twenty", "thirty", "fourty", + "fifty", "sixty", "seventy", "eighty", "ninety" + + [string]$millionName = "million" + [string]$thousandName = "thousand" + [string]$hundredName = "hundred" + [string]$andName = "and" + + function GetName([int]$i) + { + [string]$output = "" + + if ($i -ge 1000000) + { + $remainder = $null + $output += (ParseTriplet ([Math]::DivRem($i,1000000,[ref]$remainder))) + " " + $millionName + $i = $remainder + + if ($i -eq 0) { return $output } + } + + if ($i -ge 1000) + { + if ($output.Length -gt 0) + { + $output += ", " + } + + $remainder = $null + $output += (ParseTriplet ([Math]::DivRem($i,1000,[ref]$remainder))) + " " + $thousandName + $i = $remainder + + if ($i -eq 0) { return $output } + } + + if ($output.Length -gt 0) + { + $output += ", " + } + + $output += (ParseTriplet $i) + + return $output + } + + function ParseTriplet([int]$i) + { + [string]$output = "" + + if ($i -ge 100) + { + $remainder = $null + $output += $incrementsOfOne[([Math]::DivRem($i,100,[ref]$remainder))] + " " + $hundredName + $i = $remainder + + if ($i -eq 0) { return $output } + } + + if ($output.Length -gt 0) + { + $output += " " + $andName + " " + } + + if ($i -ge 20) + { + $remainder = $null + $output += $incrementsOfTen[([Math]::DivRem($i,10,[ref]$remainder))] + $i = $remainder + + if ($i -eq 0) { return $output } + } + + if ($output.Length -gt 0) + { + $output += " " + } + + $output += $incrementsOfOne[$i] + + return $output + } + } + Process + { + foreach ($n in $Number) + { + [PSCustomObject]@{ + Number = $n + Name = GetName $n + } + } + } +} + +1, 234, 31337, 987654321 | Get-NumberName diff --git a/Task/Number-names/SQL/number-names.sql b/Task/Number-names/SQL/number-names.sql new file mode 100644 index 0000000000..69da254658 --- /dev/null +++ b/Task/Number-names/SQL/number-names.sql @@ -0,0 +1,10 @@ +select val, to_char(to_date(val,'j'),'jsp') name +from +( +select +round( dbms_random.value(1, 5373484)) val +from dual +connect by level <= 5 +); + +select to_char(to_date(5373485,'j'),'jsp') from dual; diff --git a/Task/Number-reversal-game/00DESCRIPTION b/Task/Number-reversal-game/00DESCRIPTION index 0d576be042..2672761b7c 100644 --- a/Task/Number-reversal-game/00DESCRIPTION +++ b/Task/Number-reversal-game/00DESCRIPTION @@ -1,12 +1,21 @@ -Given a jumbled list of the numbers 1 to 9 that are definitely ''not'' in ascending order, show the list then -ask the player how many digits from the left to reverse. -Reverse those digits, then ask again, until all the -digits end up in ascending order. +;Task: +Given a jumbled list of the numbers '''1''' to '''9''' that are definitely ''not'' in +ascending order. + +Show the list,   and then ask the player how many digits from the +left to reverse. + +Reverse those digits,   then ask again,   until all the digits end up in ascending order. + The score is the count of the reversals needed to attain the ascending order. + Note: Assume the player's input does not need extra validation. -;Cf. -* [[Sorting algorithms/Pancake sort]], [[wp:Pancake sorting|Pancake sorting]]. -* [[Topswops]] + +;Related tasks: +*   [[Sorting algorithms/Pancake sort]] +*   [[wp:Pancake sorting|Pancake sorting]]. +*   [[Topswops]] +

    diff --git a/Task/Number-reversal-game/Elena/number-reversal-game.elena b/Task/Number-reversal-game/Elena/number-reversal-game.elena new file mode 100644 index 0000000000..e145eb0082 --- /dev/null +++ b/Task/Number-reversal-game/Elena/number-reversal-game.elena @@ -0,0 +1,21 @@ +#import system. +#import system'routines. +#import extensions. + +#symbol program = +[ + #var sorted := Array new:9 set &every: (&index:n) [ n + 1 ]. + #var values := sorted clone randomize:9. + + #var tries := Integer new. + #loop (sorted sequenceEqual:values)! + [ + tries += 1. + + console writeLiteral:"# ":tries:" : LIST : ":values:" - Flip how many?". + + values reverse:(console readLine toInt) &at:0. + ]. + + console writeLine:"You took ":tries:" attempts to put the digits in order!" readChar. +]. diff --git a/Task/Number-reversal-game/Elixir/number-reversal-game.elixir b/Task/Number-reversal-game/Elixir/number-reversal-game.elixir new file mode 100644 index 0000000000..0aeb71f80f --- /dev/null +++ b/Task/Number-reversal-game/Elixir/number-reversal-game.elixir @@ -0,0 +1,20 @@ +defmodule Number_reversal_game do + def start( n ) when n > 1 do + IO.puts "Usage: #{usage(n)}" + targets = Enum.to_list( 1..n ) + jumbleds = Enum.shuffle(targets) + attempt = loop( targets, jumbleds, 0 ) + IO.puts "Numbers sorted in #{attempt} atttempts" + end + + defp loop( targets, targets, attempt ), do: attempt + defp loop( targets, jumbleds, attempt ) do + IO.inspect jumbleds + {n,_} = IO.gets("How many digits from the left to reverse? ") |> Integer.parse + loop( targets, Enum.reverse_slice(jumbleds, 0, n), attempt+1 ) + end + + defp usage(n), do: "Given a jumbled list of the numbers 1 to #{n} that are definitely not in ascending order, show the list then ask the player how many digits from the left to reverse. Reverse those digits, then ask again, until all the digits end up in ascending order." +end + +Number_reversal_game.start( 9 ) diff --git a/Task/Numeric-error-propagation/00DESCRIPTION b/Task/Numeric-error-propagation/00DESCRIPTION index e9fa06b75a..1439fc83fb 100644 --- a/Task/Numeric-error-propagation/00DESCRIPTION +++ b/Task/Numeric-error-propagation/00DESCRIPTION @@ -1,27 +1,39 @@ -If f, a, and b are values with uncertainties σf, σa, and σb. and c is a constant; then if f is derived from a, b, and c in the following ways, then σf can be calculated as follows: +If   '''f''',   '''a''',   and   '''b'''   are values with uncertainties   σf,   σa,   and   σb,   and   '''c'''   is a constant; +
    then if   '''f'''   is derived from   '''a''',   '''b''',   and   '''c'''   in the following ways, +
    then   σf   can be calculated as follows: :;Addition/Subtraction -:* If f = a ± c, or f = c ± a then '''σf = σa''' -:* If f = a ± b then '''σf2 = σa2 + σb2''' +:* If   f = a ± c,   or   f = c ± a   then   '''σf = σa''' +:* If   f = a ± b   then   '''σf2 = σa2 + σb2''' :;Multiplication/Division -:* If f = ca or f = ac then '''σf = |cσa|''' -:* If f = ab or f = a / b then '''σf2 = f2( (σa / a)2 + (σb / b)2)''' +:* If   f = ca   or   f = ac       then   '''σf = |cσa|''' +:* If   f = ab   or   f = a / b   then   '''σf2 = f2( (σa / a)2 + (σb / b)2)''' :;Exponentiation -:* If f = ac then '''σf = |fc(σa / a)|''' +:* If   f = ac   then   '''σf = |fc(σa / a)|''' + + +Caution: +::This implementation of error propagation does not address issues of dependent and independent values.   It is assumed that   '''a'''   and   '''b'''   are independent and so the formula for multiplication should not be applied to   '''a*a'''   for example.   See   [[Talk:Numeric_error_propagation|the talk page]]   for some of the implications of this issue. -:Caution: -::This implementation of error propagation does not address issues of dependent and independent values. It is assumed that a and b are independent and so the formula for multiplication should not be applied to a*a for example. See [[Talk:Numeric_error_propagation|the talk page]] for some of the implications of this issue. ;Task details: # Add an uncertain number type to your language that can support addition, subtraction, multiplication, division, and exponentiation between numbers with an associated error term together with 'normal' floating point numbers without an associated error term.
    Implement enough functionality to perform the following calculations. -# Given coordinates and their errors:
    x1 = 100 ± 1.1
    y1 = 50 ± 1.2
    x2 = 200 ± 2.2
    y2 = 100 ± 2.3
    if point p1 is located at (x1, y1) and p2 is at (x2, y2); calculate the distance between the two points using the classic pythagorean formula:
    '''d = √((x1 - x2)2 + (y1 - y2)2)''' -# Print and display both '''d''' and its error. +# Given coordinates and their errors:
    x1 = 100 ± 1.1
    y1 = 50 ± 1.2
    x2 = 200 ± 2.2
    y2 = 100 ± 2.3
    if point p1 is located at (x1, y1) and p2 is at (x2, y2); calculate the distance between the two points using the classic Pythagorean formula:
    d = √   (x1 - x2)²   +   (y1 - y2)²   +# Print and display both   '''d'''   and its error. + + ;References: * [http://casa.colorado.edu/~benderan/teaching/astr3510/stats.pdf A Guide to Error Propagation] B. Keeney, 2005. * [[wp:Propagation of uncertainty|Propagation of uncertainty]] Wikipedia. -;Cf.: -* [[Quaternion type]] + +;Related task: +*   [[Quaternion type]] +

    diff --git a/Task/Numeric-error-propagation/ALGOL-68/numeric-error-propagation.alg b/Task/Numeric-error-propagation/ALGOL-68/numeric-error-propagation.alg new file mode 100644 index 0000000000..4c094fc4d8 --- /dev/null +++ b/Task/Numeric-error-propagation/ALGOL-68/numeric-error-propagation.alg @@ -0,0 +1,73 @@ +# MODE representing a uncertain number # +MODE UNCERTAIN = STRUCT( REAL v, uncertainty ); + +# add a costant and an uncertain value # +OP + = ( INT c, UNCERTAIN u )UNCERTAIN: UNCERTAIN( v OF u + c, uncertainty OF u ); +OP + = ( UNCERTAIN u, INT c )UNCERTAIN: c + u; +OP + = ( REAL c, UNCERTAIN u )UNCERTAIN: UNCERTAIN( v OF u + c, uncertainty OF u ); +OP + = ( UNCERTAIN u, REAL c )UNCERTAIN: c + u; +# add two uncertain values # +OP + = ( UNCERTAIN a, b )UNCERTAIN: UNCERTAIN( v OF a + v OF b + , sqrt( ( uncertainty OF a * uncertainty OF a ) + + ( uncertainty OF b * uncertainty OF b ) + ) + ); + +# negate an uncertain value # +OP - = ( UNCERTAIN a )UNCERTAIN: ( - v OF a, uncertainty OF a ); + +# subtract an uncertain value from a constant # +OP - = ( INT c, UNCERTAIN u )UNCERTAIN: c + - u; +OP - = ( REAL c, UNCERTAIN u )UNCERTAIN: c + - u; +# subtract a constant from an uncertain value # +OP - = ( UNCERTAIN u, INT c )UNCERTAIN: u + - c; +OP - = ( UNCERTAIN u, REAL c )UNCERTAIN: u + - c; +# subtract two uncertain values # +OP - = ( UNCERTAIN a, b )UNCERTAIN: a + - b; + +# multiply a constant by an uncertain value # +OP * = ( INT c, UNCERTAIN u )UNCERTAIN: UNCERTAIN( v OF u + c, ABS( c * uncertainty OF u ) ); +OP * = ( UNCERTAIN u, INT c )UNCERTAIN: c * u; +OP * = ( REAL c, UNCERTAIN u )UNCERTAIN: UNCERTAIN( v OF u + c, ABS( c * uncertainty OF u ) ); +OP * = ( UNCERTAIN u, REAL c )UNCERTAIN: c * u; +# multiply two uncertain values # +OP * = ( UNCERTAIN a, b )UNCERTAIN: + BEGIN + REAL av = v OF a; + REAL bv = v OF b; + REAL f = av * bv; + UNCERTAIN( f, f * sqrt( ( uncertainty OF a / av ) + ( uncertainty OF b / bv ) ) ) + END # * # ; + +# construct the reciprocol of an uncertain value # +OP ONEOVER = ( UNCERTAIN u )UNCERTAIN: ( 1 / v OF u, uncertainty OF u ); +# divide a constant by an uncertain value # +OP / = ( INT c, UNCERTAIN u )UNCERTAIN: c * ONEOVER u; +OP / = ( REAL c, UNCERTAIN u )UNCERTAIN: c * ONEOVER u; +# divide an uncertain value by a constant # +OP / = ( UNCERTAIN u, INT c )UNCERTAIN: u * ( 1 / c ); +OP / = ( UNCERTAIN u, REAL c )UNCERTAIN: u * ( 1 / c ); +# divide two uncertain values # +OP / = ( UNCERTAIN a, b )UNCERTAIN: a * ONEOVER b; + +# exponentiation # +OP ^ = ( UNCERTAIN u, INT c )UNCERTAIN: + BEGIN + REAL f = v OF u ^ c; + UNCERTAIN( f, ABS ( ( f * c * uncertainty OF u ) / v OF u ) ) + END # ^ # ; +OP ^ = ( UNCERTAIN u, REAL c )UNCERTAIN: + BEGIN + REAL f = v OF u ^ c; + UNCERTAIN( f, ABS ( ( f * c * uncertainty OF u ) / v OF u ) ) + END # ^ # ; + +# test the above operatrs by using them to find the pythagorean distance between the two sample points # +UNCERTAIN x1 = UNCERTAIN( 100, 1.1 ); +UNCERTAIN y1 = UNCERTAIN( 50, 1.2 ); +UNCERTAIN x2 = UNCERTAIN( 200, 2.2 ); +UNCERTAIN y2 = UNCERTAIN( 100, 2.3 ); + +UNCERTAIN d = ( ( ( x1 - x2 ) ^ 2 ) + ( y1 - y2 ) ^ 2 ) ^ 0.5; + +print( ( "distance: ", fixed( v OF d, 0, 2 ), " +/- ", fixed( uncertainty OF d, 0, 2 ), newline ) ) diff --git a/Task/Numeric-error-propagation/C++/numeric-error-propagation-1.cpp b/Task/Numeric-error-propagation/C++/numeric-error-propagation-1.cpp new file mode 100644 index 0000000000..b0109a2be6 --- /dev/null +++ b/Task/Numeric-error-propagation/C++/numeric-error-propagation-1.cpp @@ -0,0 +1,44 @@ +#pragma once + +#include +#include +#include +#include + +class Approx { +public: + Approx(double _v, double _s = 0.0) : v(_v), s(_s) {} + + operator std::string() const { + std::ostringstream os(""); + os << std::setprecision(15) << v << " ±" << std::setprecision(15) << s << std::ends; + return os.str(); + } + + Approx operator +(const Approx& a) const { return Approx(v + a.v, sqrt(s * s + a.s * a.s)); } + Approx operator +(double d) const { return Approx(v + d, s); } + Approx operator -(const Approx& a) const { return Approx(v - a.v, sqrt(s * s + a.s * a.s)); } + Approx operator -(double d) const { return Approx(v - d, s); } + + Approx operator *(const Approx& a) const { + const double t = v * a.v; + return Approx(v, sqrt(t * t * s * s / (v * v) + a.s * a.s / (a.v * a.v))); + } + + Approx operator *(double d) const { return Approx(v * d, fabs(d * s)); } + + Approx operator /(const Approx& a) const { + const double t = v / a.v; + return Approx(t, sqrt(t * t * s * s / (v * v) + a.s * a.s / (a.v * a.v))); + } + + Approx operator /(double d) const { return Approx(v / d, fabs(d * s)); } + + Approx pow(double d) const { + const double t = ::pow(v, d); + return Approx(t, fabs(t * d * s / v)); + } + +private: + double v, s; +}; diff --git a/Task/Numeric-error-propagation/C++/numeric-error-propagation-2.cpp b/Task/Numeric-error-propagation/C++/numeric-error-propagation-2.cpp new file mode 100644 index 0000000000..bed7f40b9c --- /dev/null +++ b/Task/Numeric-error-propagation/C++/numeric-error-propagation-2.cpp @@ -0,0 +1,13 @@ +#include +#include +#include "numeric_error.hpp" + +int main(const int argc, const char* argv[]) { + const Approx x1(100, 1.1); + const Approx x2(50, 1.2); + const Approx y1(200, 2.2); + const Approx y2(100, 2.3); + std::cout << std::string(((x1 - x2).pow(2.) + (y1 - y2).pow(2.)).pow(0.5)) << std::endl; // => 111.803398874989 ±2.938366893361 + + return EXIT_SUCCESS; +} diff --git a/Task/Numeric-error-propagation/Fortran/numeric-error-propagation-1.f b/Task/Numeric-error-propagation/Fortran/numeric-error-propagation-1.f new file mode 100644 index 0000000000..93e3444499 --- /dev/null +++ b/Task/Numeric-error-propagation/Fortran/numeric-error-propagation-1.f @@ -0,0 +1,27 @@ + PROGRAM CALCULATE !A distance, with error propagation. + REAL X1, Y1, X2, Y2 !The co-ordinates. + REAL X1E,Y1E,X2E,Y2E !Their standard deviation. + DATA X1, Y1 ,X2, Y2 /100., 50., 200.,100./ !Specified + DATA X1E,Y1E,X2E,Y2E/ 1.1, 1.2, 2.2, 2.3/ !Values. + REAL DX,DY,D2,D,DXE,DYE,E !Assistants. + CHARACTER*1 C !I'm stuck with code page 437 instead of 850. + PARAMETER (C = CHAR(241)) !Thus ± does not yield this glyph on a "console" screen. CHAR(241) does. + REAL SD !This is an arithmetic statement function. + SD(X,P,S) = P*ABS(X)**(P - 1)*S !SD for X**P where SD of X is S + WRITE (6,1) X1,C,X1E,Y1,C,Y1E, !Reveal the points + 1 X2,C,X2E,Y2,C,Y2E !Though one could have used an array... + 1 FORMAT ("Euclidean distance between two points:"/ !A heading. + 1 ("(",F5.1,A1,F3.1,",",F5.1,A1,F3.1,")")) !Thus, One point per line. + DX = (X1 - X2) !X difference. + DXE = SQRT(X1E**2 + X2E**2) !SD for DX, a simple difference. + DY = (Y1 - Y2) !Y difference. + DYE = SQRT(Y1E**2 + Y2E**2) !SD for DY, (Y1 - Y2) + D2 = DX**2 + DY**2 !The distance, squared. + DXE = SD(DX,2,DXE) !SD for DX**2 + DYE = SD(DY,2,DYE) !SD for DY**2 + E = SQRT(DXE**2 + DYE**2) !SD for their sum + D = SQRT(D2) !The distance! + E = SD(D2,0.5,E) !SD after the SQRT. + WRITE (6,2) D,C,E !Ahh, the relief. + 2 FORMAT ("Distance",F6.1,A1,F4.2) !Sizes to fit the example. + END !Enough. diff --git a/Task/Numeric-error-propagation/Fortran/numeric-error-propagation-2.f b/Task/Numeric-error-propagation/Fortran/numeric-error-propagation-2.f new file mode 100644 index 0000000000..c2ca0d2292 --- /dev/null +++ b/Task/Numeric-error-propagation/Fortran/numeric-error-propagation-2.f @@ -0,0 +1,122 @@ + MODULE ERRORFLOW !Calculate with an error estimate tagging along. + INTEGER VSP,VMAX !Do so with an arithmetic stack. + PARAMETER (VMAX = 28) !Surely sufficient. + REAL STACKV(VMAX) !Holds the values. + REAL STACKE(VMAX) !And the corresponding error estimate. + INTEGER VOUT !Output file. + LOGICAL VTRACE !Perhaps progress is to be followed in detail. + DATA VSP,VOUT,VTRACE/0,0,.FALSE./ !Start with nothing. + CHARACTER*1 PM !I'm stuck with code page 437 instead of 850. + PARAMETER (PM = CHAR(241)) !Thus ± does not yield this glyph on a "console" screen. CHAR(241) does. + CONTAINS !The servants. + SUBROUTINE VINIT(OUT) !Get ready. + INTEGER OUT !Unit number for output. + VSP = 0 !My stack is empty. + VOUT = OUT !Save this rather than have extra parameters. + VTRACE = VOUT .GT. 0 !By implication. + END SUBROUTINE VINIT !Ready. + SUBROUTINE VSHOW(WOT) !Show the topmost element. + CHARACTER*(*) WOT !The caller identifies itself. + IF (VSP.LE.0) THEN !Just in case + WRITE (VOUT,1) "Empty",VSP !My stack may be empty. + ELSE !But normally, it is not. + WRITE (VOUT,1) WOT,VSP,STACKV(VSP),PM,STACKE(VSP) !Topmost. + 1 FORMAT (A8,": Vstack(",I2,") =",F8.1,A1,F6.2) !Suits the example. + END IF !So much for protection. + END SUBROUTINE VSHOW !Could reveal all the stack... + + SUBROUTINE VLOAD(V,E) !Load the stack. + REAL V,E !The value and its error. + IF (VSP.GE.VMAX) STOP "VLOAD: overflow!" !Oh dear. + VSP = VSP + 1 !Up one. + STACKV(VSP) = V !Place the value. + STACKE(VSP) = E !And the error. + IF (VTRACE) CALL VSHOW("vLoad") + END SUBROUTINE VLOAD !That was easy! + + SUBROUTINE VADD !Add the top two elements. + IF (VSP.LE.1) STOP "VADD: underflow!" !Maybe not. + STACKV(VSP - 1) = STACKV(VSP - 1) + STACKV(VSP) !Do the deed. + STACKE(VSP - 1) = SQRT(STACKE(VSP - 1)**2 + STACKE(VSP)**2) !The errors follow. + VSP = VSP - 1 !Two values have become one. + IF (VTRACE) CALL VSHOW("vAdd")!The result. + END SUBROUTINE VADD !The variance of the sum is the sum of the variances. + + SUBROUTINE VSUB !Subtract the topmost element from the one below. + IF (VSP.LE.1) STOP "VSUB: underflow!" !Perhaps not. + STACKV(VSP - 1) = STACKV(VSP - 1) - STACKV(VSP) !The topmost was the second loaded. + STACKE(VSP - 1) = SQRT(STACKE(VSP - 1)**2 + STACKE(VSP)**2) !Add the variances also. + VSP = VSP - 1 !Two values have become one. + IF (VTRACE) CALL VSHOW("vSub")!The result. + END SUBROUTINE VSUB !Could alternatively play with the signs and add... + + SUBROUTINE VMUL !Multiply the top two elements. + REAL R1,R2 !Use relative errors in place of plain SD. + IF (VSP.LE.1) STOP "VMUL: underflow!" !Perhaps not. + R1 = STACKE(VSP - 1)/STACKV(VSP - 1) !The relative errors for multiply + R2 = STACKE(VSP) /STACKV(VSP) !Are treated as are variances in addition. + STACKV(VSP - 1) = STACKV(VSP - 1)*STACKV(VSP) !Perform the multiply. + VSP = VSP - 1 !Unstack, but not quite finished. + STACKE(VSP) = SQRT((R1**2 + R2**2)*STACKV(VSP)**2) ![SD/xy]² = [SD/x]² + [SD/y]² + IF (VTRACE) CALL VSHOW("vMul") !Thus SD² = [[SD/x]² + [SD/y]²]xy² + END SUBROUTINE VMUL !The square means that the error's sign is not altered. + + SUBROUTINE VDIV !Divide the penultimate element by the top elements. + REAL R1,R2 !Use relative errors in place of plain SD. + IF (VSP.LE.1) STOP "VDIV: underflow!" !Perhaps not. + R1 = STACKE(VSP - 1)/STACKV(VSP - 1) !The relative errors for divide + R2 = STACKE(VSP) /STACKV(VSP) !Are treated as are variances in subtraction. + STACKV(VSP - 1) = STACKV(VSP - 1)/STACKV(VSP) !Perform the divide. + VSP = VSP - 1 !X/Y is Load X, Load Y, Divide; Y is topmost. + STACKE(VSP) = SQRT((R1**2 + R2**2)*STACKV(VSP)**2) ![SD/(x/y)]² = [SD/x]² + [SD/y]² + IF (VTRACE) CALL VSHOW("vDiv") !Thus SD² = [[SD/x]² + [SD/y]²](x/y)² + END SUBROUTINE VDIV !Worry over y ± SD spanning zero... + + SUBROUTINE VSQRT !Now for some fun with the topmost element. + IF (VSP.LE.0) STOP "VSQRT: underflow!" !Maybe not. + STACKV(VSP) = SQRT(STACKV(VSP)) !Negative? Let the system complain. + STACKE(VSP) = 0.5/STACKV(VSP)*STACKE(VSP) !F(x ± s) = F(x) ± F'(x).s + IF (VTRACE) CALL VSHOW("vSqrt") !Here, F' can't be negative. + END SUBROUTINE VSQRT !No change to the pointer. + SUBROUTINE VSQUARE !Another raise-to-a-power. + STACKE(VSP) = 2*ABS(STACKV(VSP))*STACKE(VSP) !The error's sign is not to be messed with. + STACKV(VSP) = STACKV(VSP)**2 !This will never be negative. + IF (VTRACE) CALL VSHOW("vSquare") !Keep away from zero though. + END SUBROUTINE VSQUARE !Same formula as VSQRT, just a different power. + SUBROUTINE VPOW(P) !Now for the more general. + INTEGER P !Though only integer powers for this routine, so no EXP(P*LN(x)). + IF (VSP.LE.0) STOP "VPOW: underflow!" !Perhaps not. + IF (P.EQ.0) STOP "VPOW: zero power!" !No sense in this power! + STACKE(VSP) = P*ABS(STACKV(VSP))**(P - 1)*STACKE(VSP) !Negative values a worry. + STACKV(VSP) = ABS(STACKV(VSP))**P !I only want the magnitude. + IF (VTRACE) CALL VSHOW("vPower") !So, what happened? + END SUBROUTINE VPOW !Powers with fractional parts are troublesome. + END MODULE ERRORFLOW !That will do for the test problem. + + PROGRAM CALCULATE !A distance, with error propagation. + USE ERRORFLOW !For the details. + REAL X1, Y1, X2, Y2 !The co-ordinates. + REAL X1E,Y1E,X2E,Y2E !Their standard deviation. + DATA X1, Y1 ,X2, Y2 /100., 50., 200.,100./ !Specified + DATA X1E,Y1E,X2E,Y2E/ 1.1, 1.2, 2.2, 2.3/ !Values. + + WRITE (6,1) X1,PM,X1E,Y1,PM,Y1E, !Reveal the points + 1 X2,PM,X2E,Y2,PM,Y2E !Though one could have used an array... + 1 FORMAT ("Euclidean distance between two points:"/ !A heading. + 1 ("(",F5.1,A1,F3.1,",",F5.1,A1,F3.1,")")) !Thus, One point per line. + +Calculate SQRT[(X2 - X1)**2 + (Y2 - Y1)**2] + CALL VINIT(6) !Start my arithmetic. + CALL VLOAD(X2,X2E) + CALL VLOAD(X1,X1E) + CALL VSUB !(X2 - X1) + CALL VSQUARE !(X2 - X1)**2 + CALL VLOAD(Y2,Y2E) + CALL VLOAD(Y1,Y1E) + CALL VSUB !Y2 - Y1) + CALL VSQUARE !Y2 - Y1)**2 + CALL VADD !(X2 - X1)**2 + (Y2 - Y1)**2 + CALL VSQRT !SQRT((X2 - X1)**2 + (Y2 - Y1)**2) + WRITE (6,2) STACKV(1),PM,STACKE(1) !Ahh, the relief. + 2 FORMAT ("Distance",F6.1,A1,F4.2) !Sizes to fit the example. + END !Enough. diff --git a/Task/Numeric-error-propagation/Fortran/numeric-error-propagation-3.f b/Task/Numeric-error-propagation/Fortran/numeric-error-propagation-3.f new file mode 100644 index 0000000000..93893bbb05 --- /dev/null +++ b/Task/Numeric-error-propagation/Fortran/numeric-error-propagation-3.f @@ -0,0 +1,9 @@ + TYPE DATUM + REAL VALUE + REAL SD + END TYPE DATUM + TYPE POINT + TYPE(DATUM) X + TYPE(DATUM) Y + END TYPE POINT + TYPE(POINT) P1,P2 diff --git a/Task/Numeric-error-propagation/Java/numeric-error-propagation.java b/Task/Numeric-error-propagation/Java/numeric-error-propagation.java index b0e05376fd..b8f017fe9d 100644 --- a/Task/Numeric-error-propagation/Java/numeric-error-propagation.java +++ b/Task/Numeric-error-propagation/Java/numeric-error-propagation.java @@ -76,8 +76,8 @@ public class Approx { public static void main(String[] args){ Approx x1 = new Approx(100, 1.1); - Approx x2 = new Approx(50, 1.2); - Approx y1 = new Approx(200, 2.2); + Approx y1 = new Approx(50, 1.2); + Approx x2 = new Approx(200, 2.2); Approx y2 = new Approx(100, 2.3); x1.sub(x2).pow(2).add(y1.sub(y2).pow(2)).pow(0.5); diff --git a/Task/Numeric-error-propagation/Kotlin/numeric-error-propagation.kotlin b/Task/Numeric-error-propagation/Kotlin/numeric-error-propagation.kotlin new file mode 100644 index 0000000000..69562ae8c3 --- /dev/null +++ b/Task/Numeric-error-propagation/Kotlin/numeric-error-propagation.kotlin @@ -0,0 +1,40 @@ +import java.lang.Math.* + +data class Approx(val ν: Double, val σ: Double = 0.0) { + constructor(a: Approx) : this(a.ν, a.σ) + constructor(n: Number) : this(n.toDouble(), 0.0) + + override fun toString() = "$ν ±$σ" + + operator infix fun plus(a: Approx) = Approx(ν + a.ν, sqrt(σ * σ + a.σ * a.σ)) + operator infix fun plus(d: Double) = Approx(ν + d, σ) + operator infix fun minus(a: Approx) = Approx(ν - a.ν, sqrt(σ * σ + a.σ * a.σ)) + operator infix fun minus(d: Double) = Approx(ν - d, σ) + + operator infix fun times(a: Approx): Approx { + val v = ν * a.ν + return Approx(v, sqrt(v * v * σ * σ / (ν * ν) + a.σ * a.σ / (a.ν * a.ν))) + } + + operator infix fun times(d: Double) = Approx(ν * d, abs(d * σ)) + + operator infix fun div(a: Approx): Approx { + val v = ν / a.ν + return Approx(v, sqrt(v * v * σ * σ / (ν * ν) + a.σ * a.σ / (a.ν * a.ν))) + } + + operator infix fun div(d: Double) = Approx(ν / d, abs(d * σ)) + + fun pow(d: Double): Approx { + val v = pow(ν, d) + return Approx(v, abs(v * d * σ / ν)) + } +} + +fun main(args: Array) { + val x1 = Approx(100.0, 1.1) + val y1 = Approx(50.0, 1.2) + val x2 = Approx(200.0, 2.2) + val y2 = Approx(100.0, 2.3) + println(((x1 - x2).pow(2.0) + (y1 - y2).pow(2.0)).pow(0.5)) +} diff --git a/Task/Numeric-error-propagation/REXX/numeric-error-propagation.rexx b/Task/Numeric-error-propagation/REXX/numeric-error-propagation.rexx new file mode 100644 index 0000000000..feef5f7ee4 --- /dev/null +++ b/Task/Numeric-error-propagation/REXX/numeric-error-propagation.rexx @@ -0,0 +1,25 @@ +/*REXX program calculates the distance between two points (2D) with error propagation. */ +parse arg a b . /*obtain arguments from the CL*/ +if a=='' | a=="," then a= '100±1.1, 50±1.2' /*Not given? Then use default.*/ +if b=='' | b=="," then b= '200±2.2, 100±2.3' /* " " " " " */ +parse var a ax ',' ay; parse var b bx ',' by /*obtain X,Y from A & B point.*/ +parse var ax ax '±' axe; parse var bx bx '±' bxE /* " err " Ax and Bx.*/ +parse var ay ay '±' aye; parse var by by '±' byE /* " " " Ay " By.*/ +if axE=='' then axE=0; if bxE=="" then bxE=0; /*No error? Then use default.*/ +if ayE=='' then ayE=0; if byE=="" then byE=0; /* " " " " " */ + say ' A point (x,y)= ' ax "±" axE', ' ay "±" ayE /*display A point (with err)*/ + say ' B point (x.y)= ' bx "±" bxE', ' by "±" byE /* " B " " " */ + say /*blank line for the eyeballs.*/ +dx=ax-bx; dxE=sqrt(axE**2 + bxE**2); xe=#(dx, 2, dxE) /*compute X distances (& err)*/ +dy=ay-by; dyE=sqrt(ayE**2 + byE**2); ye=#(dy, 2, dyE) /* " Y " " " */ +D=sqrt(dx**2 + dy**2) /*compute the 2D distance. */ + say 'distance=' D "±" #(D**2, .5, sqrt(xE**2 + yE**2)) /*display " " " */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +#: procedure; arg x,p,e; if p=.5 then z=1/sqrt(abs(x)); else z=abs(x)**(p-1); return p*e*z +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); numeric digits; h=d+6 + numeric form; parse value format(x,2,1,,0) 'E0' with g "E" _ .; g=g * .5'e'_ % 2 + m.=9; do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ + do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ + numeric digits d; return g/1 diff --git a/Task/Numeric-error-propagation/Scala/numeric-error-propagation.scala b/Task/Numeric-error-propagation/Scala/numeric-error-propagation.scala new file mode 100644 index 0000000000..ee7603fa27 --- /dev/null +++ b/Task/Numeric-error-propagation/Scala/numeric-error-propagation.scala @@ -0,0 +1,43 @@ +import java.lang.Math._ + +class Approx(val ν: Double, val σ: Double = 0.0) { + def this(a: Approx) = this(a.ν, a.σ) + def this(n: Number) = this(n.doubleValue(), 0.0) + + override def toString = s"$ν ±$σ" + + def +(a: Approx) = Approx(ν + a.ν, sqrt(σ * σ + a.σ * a.σ)) + def +(d: Double) = Approx(ν + d, σ) + def -(a: Approx) = Approx(ν - a.ν, sqrt(σ * σ + a.σ * a.σ)) + def -(d: Double) = Approx(ν - d, σ) + + def *(a: Approx) = { + val v = ν * a.ν + Approx(v, sqrt(v * v * σ * σ / (ν * ν) + a.σ * a.σ / (a.ν * a.ν))) + } + + def *(d: Double) = Approx(ν * d, abs(d * σ)) + + def /(a: Approx) = { + val t = ν / a.ν + Approx(t, sqrt(t * t * σ * σ / (ν * ν) + a.σ * a.σ / (a.ν * a.ν))) + } + + def /(d: Double) = Approx(ν / d, abs(d * σ)) + + def ^(d: Double) = { + val t = pow(ν, d) + Approx(t, abs(t * d * σ / ν)) + } +} + +object Approx { def apply(ν: Double, σ: Double = 0.0) = new Approx(ν, σ) } + +object NumericError extends App { + def √(a: Approx) = a^0.5 + val x1 = Approx(100.0, 1.1) + val x2 = Approx(50.0, 1.2) + val y1 = Approx(200.0, 2.2) + val y2 = Approx(100.0, 2.3) + println(√(((x1 - x2)^2.0) + ((y1 - y2)^2.0))) // => 111.80339887498948 ±2.938366893361004 +} diff --git a/Task/Numerical-integration-Gauss-Legendre-Quadrature/00DESCRIPTION b/Task/Numerical-integration-Gauss-Legendre-Quadrature/00DESCRIPTION index 0fe8843f6b..a208f2b29d 100644 --- a/Task/Numerical-integration-Gauss-Legendre-Quadrature/00DESCRIPTION +++ b/Task/Numerical-integration-Gauss-Legendre-Quadrature/00DESCRIPTION @@ -9,6 +9,7 @@ |\int_{-1}^1 f(x)\,dx \approx \sum_{i=1}^n w_i f(x_i) |} + For this, we first need to calculate the nodes and the weights, but after we have them, we can reuse them for numerious integral evaluations, which greatly speeds up the calculation compared to more [[Numerical Integration|simple numerical integration methods]]. {|border=1 cellspacing=0 cellpadding=3 @@ -33,10 +34,11 @@ For this, we first need to calculate the nodes and the weights, but after we hav |\int_a^b f(x)\,dx \approx \frac{b-a}{2} \sum_{i=1}^n w_i f\left(\frac{b-a}{2}x_i + \frac{a+b}{2}\right) |} + '''Task description''' Similar to the task [[Numerical Integration]], the task here is to calculate the definite integral of a function f(x), but by applying an n-point Gauss-Legendre quadrature rule, as described [[wp:Gaussian Quadrature|here]], for example. The input values should be an function f to integrate, the bounds of the integration interval a and b, and the number of gaussian evaluation points n. An reference implementation in Common Lisp is provided for comparison. -To demonstrate the calculation, compute the weights and nodes for an 5-point quadrature rule and then use them to compute - -::\int_{-3}^{3} \exp(x) \, dx \approx \sum_{i=1}^5 w_i \; \exp(x_i) \approx 20.036 +To demonstrate the calculation, compute the weights and nodes for an 5-point quadrature rule and then use them to compute: + \int_{-3}^{3} \exp(x) \, dx \approx \sum_{i=1}^5 w_i \; \exp(x_i) \approx 20.036 +

    diff --git a/Task/Numerical-integration-Gauss-Legendre-Quadrature/C++/numerical-integration-gauss-legendre-quadrature.cpp b/Task/Numerical-integration-Gauss-Legendre-Quadrature/C++/numerical-integration-gauss-legendre-quadrature.cpp new file mode 100644 index 0000000000..2a8fe08eef --- /dev/null +++ b/Task/Numerical-integration-Gauss-Legendre-Quadrature/C++/numerical-integration-gauss-legendre-quadrature.cpp @@ -0,0 +1,136 @@ +namespace Rosetta { + + /*! Implementation of Gauss-Legendre quadrature + * http://en.wikipedia.org/wiki/Gaussian_quadrature + * http://rosettacode.org/wiki/Numerical_integration/Gauss-Legendre_Quadrature + * + */ + template + class GaussLegendreQuadrature { + public: + enum {eDEGREE = N}; + + /*! Compute the integral of a functor + * + * @param a lower limit of integration + * @param b upper limit of integration + * @param f the function to integrate + * @param err callback in case of problems + */ + template + double integrate(double a, double b, Function f) { + double p = (b - a) / 2; + double q = (b + a) / 2; + const LegendrePolynomial& legpoly = s_LegendrePolynomial; + + double sum = 0; + for (int i = 1; i <= eDEGREE; ++i) { + sum += legpoly.weight(i) * f(p * legpoly.root(i) + q); + } + + return p * sum; + } + + /*! Print out roots and weights for information + */ + void print_roots_and_weights(std::ostream& out) const { + const LegendrePolynomial& legpoly = s_LegendrePolynomial; + out << "Roots: "; + for (int i = 0; i <= eDEGREE; ++i) { + out << ' ' << legpoly.root(i); + } + out << '\n'; + out << "Weights:"; + for (int i = 0; i <= eDEGREE; ++i) { + out << ' ' << legpoly.weight(i); + } + out << '\n'; + } + private: + /*! Implementation of the Legendre polynomials that form + * the basis of this quadrature + */ + class LegendrePolynomial { + public: + LegendrePolynomial () { + // Solve roots and weights + for (int i = 0; i <= eDEGREE; ++i) { + double dr = 1; + + // Find zero + Evaluation eval(cos(M_PI * (i - 0.25) / (eDEGREE + 0.5))); + do { + dr = eval.v() / eval.d(); + eval.evaluate(eval.x() - dr); + } while (fabs (dr) > 2e-16); + + this->_r[i] = eval.x(); + this->_w[i] = 2 / ((1 - eval.x() * eval.x()) * eval.d() * eval.d()); + } + } + + double root(int i) const { return this->_r[i]; } + double weight(int i) const { return this->_w[i]; } + private: + double _r[eDEGREE + 1]; + double _w[eDEGREE + 1]; + + /*! Evaluate the value *and* derivative of the + * Legendre polynomial + */ + class Evaluation { + public: + explicit Evaluation (double x) : _x(x), _v(1), _d(0) { + this->evaluate(x); + } + + void evaluate(double x) { + this->_x = x; + + double vsub1 = x; + double vsub2 = 1; + double f = 1 / (x * x - 1); + + for (int i = 2; i <= eDEGREE; ++i) { + this->_v = ((2 * i - 1) * x * vsub1 - (i - 1) * vsub2) / i; + this->_d = i * f * (x * this->_v - vsub1); + + vsub2 = vsub1; + vsub1 = this->_v; + } + } + + double v() const { return this->_v; } + double d() const { return this->_d; } + double x() const { return this->_x; } + + private: + double _x; + double _v; + double _d; + }; + }; + + /*! Pre-compute the weights and abscissae of the Legendre polynomials + */ + static LegendrePolynomial s_LegendrePolynomial; + }; + + template + typename GaussLegendreQuadrature::LegendrePolynomial GaussLegendreQuadrature::s_LegendrePolynomial; +} + +// This to avoid issues with exp being a templated function +double RosettaExp(double x) { + return exp(x); +} + +int main() { + Rosetta::GaussLegendreQuadrature<5> gl5; + + std::cout << std::setprecision(10); + + gl5.print_roots_and_weights(std::cout); + std::cout << "Integrating Exp(X) over [-3, 3]: " << gl5.integrate(-3., 3., RosettaExp) << '\n'; + std::cout << "Actual value: " << RosettaExp(3) - RosettaExp(-3) << '\n'; +} diff --git a/Task/Numerical-integration-Gauss-Legendre-Quadrature/Haskell/numerical-integration-gauss-legendre-quadrature-1.hs b/Task/Numerical-integration-Gauss-Legendre-Quadrature/Haskell/numerical-integration-gauss-legendre-quadrature-1.hs new file mode 100644 index 0000000000..5e74104cfa --- /dev/null +++ b/Task/Numerical-integration-Gauss-Legendre-Quadrature/Haskell/numerical-integration-gauss-legendre-quadrature-1.hs @@ -0,0 +1,6 @@ +gaussLegendre n f a b = d*sum [ w x*f(m + d*x) | x <- roots ] + where d = (b - a)/2 + m = (b + a)/2 + w x = 2/(1-x^2)/(legendreP' n x)^2 + roots = map (findRoot (legendreP n) (legendreP' n) . x0) [1..n] + x0 i = cos (pi*(i-1/4)/(n+1/2)) diff --git a/Task/Numerical-integration-Gauss-Legendre-Quadrature/Haskell/numerical-integration-gauss-legendre-quadrature-2.hs b/Task/Numerical-integration-Gauss-Legendre-Quadrature/Haskell/numerical-integration-gauss-legendre-quadrature-2.hs new file mode 100644 index 0000000000..bd2f1863cc --- /dev/null +++ b/Task/Numerical-integration-Gauss-Legendre-Quadrature/Haskell/numerical-integration-gauss-legendre-quadrature-2.hs @@ -0,0 +1,6 @@ +legendreP n x = go n 1 x + where go 0 p2 _ = p2 + go 1 _ p1 = p1 + go n p2 p1 = go (n-1) p1 $ ((2*n-1)*x*p1 - (n-1)*p2)/n + +legendreP' n x = n/(x^2-1)*(x*legendreP n x - legendreP (n-1) x) diff --git a/Task/Numerical-integration-Gauss-Legendre-Quadrature/Haskell/numerical-integration-gauss-legendre-quadrature-3.hs b/Task/Numerical-integration-Gauss-Legendre-Quadrature/Haskell/numerical-integration-gauss-legendre-quadrature-3.hs new file mode 100644 index 0000000000..32cd1409e3 --- /dev/null +++ b/Task/Numerical-integration-Gauss-Legendre-Quadrature/Haskell/numerical-integration-gauss-legendre-quadrature-3.hs @@ -0,0 +1,5 @@ +findRoot f df = fixedPoint (\x -> x - f x / df x) + +fixedPoint f x | abs (fx - x) < 1e-15 = x + | otherwise = fixedPoint f fx + where fx = f x diff --git a/Task/Numerical-integration-Gauss-Legendre-Quadrature/Haskell/numerical-integration-gauss-legendre-quadrature-4.hs b/Task/Numerical-integration-Gauss-Legendre-Quadrature/Haskell/numerical-integration-gauss-legendre-quadrature-4.hs new file mode 100644 index 0000000000..9feae863f0 --- /dev/null +++ b/Task/Numerical-integration-Gauss-Legendre-Quadrature/Haskell/numerical-integration-gauss-legendre-quadrature-4.hs @@ -0,0 +1,2 @@ +integrate _ [] = 0 +integrate f (m:ms) = sum $ zipWith (gaussLegendre 5 f) (m:ms) ms diff --git a/Task/Numerical-integration-Gauss-Legendre-Quadrature/Java/numerical-integration-gauss-legendre-quadrature.java b/Task/Numerical-integration-Gauss-Legendre-Quadrature/Java/numerical-integration-gauss-legendre-quadrature.java new file mode 100644 index 0000000000..293539b7c8 --- /dev/null +++ b/Task/Numerical-integration-Gauss-Legendre-Quadrature/Java/numerical-integration-gauss-legendre-quadrature.java @@ -0,0 +1,75 @@ +import static java.lang.Math.*; +import java.util.function.Function; + +public class Test { + final static int N = 5; + + static double[] lroots = new double[N]; + static double[] weight = new double[N]; + static double[][] lcoef = new double[N + 1][N + 1]; + + static void legeCoef() { + lcoef[0][0] = lcoef[1][1] = 1; + + for (int n = 2; n <= N; n++) { + + lcoef[n][0] = -(n - 1) * lcoef[n - 2][0] / n; + + for (int i = 1; i <= n; i++) { + lcoef[n][i] = ((2 * n - 1) * lcoef[n - 1][i - 1] + - (n - 1) * lcoef[n - 2][i]) / n; + } + } + } + + static double legeEval(int n, double x) { + double s = lcoef[n][n]; + for (int i = n; i > 0; i--) + s = s * x + lcoef[n][i - 1]; + return s; + } + + static double legeDiff(int n, double x) { + return n * (x * legeEval(n, x) - legeEval(n - 1, x)) / (x * x - 1); + } + + static void legeRoots() { + double x, x1; + for (int i = 1; i <= N; i++) { + x = cos(PI * (i - 0.25) / (N + 0.5)); + do { + x1 = x; + x -= legeEval(N, x) / legeDiff(N, x); + } while (x != x1); + + lroots[i - 1] = x; + + x1 = legeDiff(N, x); + weight[i - 1] = 2 / ((1 - x * x) * x1 * x1); + } + } + + static double legeInte(Function f, double a, double b) { + double c1 = (b - a) / 2, c2 = (b + a) / 2, sum = 0; + for (int i = 0; i < N; i++) + sum += weight[i] * f.apply(c1 * lroots[i] + c2); + return c1 * sum; + } + + public static void main(String[] args) { + legeCoef(); + legeRoots(); + + System.out.print("Roots: "); + for (int i = 0; i < N; i++) + System.out.printf(" %f", lroots[i]); + + System.out.print("\nWeight:"); + for (int i = 0; i < N; i++) + System.out.printf(" %f", weight[i]); + + System.out.printf("%nintegrating Exp(x) over [-3, 3]:%n\t%10.8f,%n" + + "compared to actual%n\t%10.8f%n", + legeInte(x -> exp(x), -3, 3), exp(3) - exp(-3)); + } +} diff --git a/Task/Numerical-integration-Gauss-Legendre-Quadrature/Kotlin/numerical-integration-gauss-legendre-quadrature.kotlin b/Task/Numerical-integration-Gauss-Legendre-Quadrature/Kotlin/numerical-integration-gauss-legendre-quadrature.kotlin new file mode 100644 index 0000000000..763ec2119c --- /dev/null +++ b/Task/Numerical-integration-Gauss-Legendre-Quadrature/Kotlin/numerical-integration-gauss-legendre-quadrature.kotlin @@ -0,0 +1,58 @@ +import java.lang.Math.* + +class Legendre(val N: Int) { + fun evaluate(n: Int, x: Double) = (n downTo 1).fold(c[n][n]) { s, i -> s * x + c[n][i - 1] } + + fun diff(n: Int, x: Double) = n * (x * evaluate(n, x) - evaluate(n - 1, x)) / (x * x - 1) + + fun integrate(f: (Double) -> Double, a: Double, b: Double): Double { + val c1 = (b - a) / 2 + val c2 = (b + a) / 2 + return c1 * (0 until N).fold(0.0) { s, i -> s + weights[i] * f(c1 * roots[i] + c2) } + } + + private val roots = DoubleArray(N) + private val weights = DoubleArray(N) + private val c = Array(N + 1) { DoubleArray(N + 1) } // coefficients + + init { + // coefficients: + c[0][0] = 1.0 + c[1][1] = 1.0 + for (n in 2..N) { + c[n][0] = (1 - n) * c[n - 2][0] / n + for (i in 1..n) + c[n][i] = ((2 * n - 1) * c[n - 1][i - 1] - (n - 1) * c[n - 2][i]) / n + } + + // roots: + var x: Double + var x1: Double + for (i in 1..N) { + x = cos(PI * (i - 0.25) / (N + 0.5)) + do { + x1 = x + x -= evaluate(N, x) / diff(N, x) + } while (x != x1) + + x1 = diff(N, x) + roots[i - 1] = x + weights[i - 1] = 2 / ((1 - x * x) * x1 * x1) + } + + print("Roots:") + roots.forEach { print(" %f".format(it)) } + println() + print("Weights:") + weights.forEach { print(" %f".format(it)) } + println() + } +} + +fun main(args: Array) { + val legendre = Legendre(5) + println("integrating Exp(x) over [-3, 3]:") + println("\t%10.8f".format(legendre.integrate(Math::exp, -3.0, 3.0))) + println("compared to actual:") + println("\t%10.8f".format(exp(3.0) - exp(-3.0))) +} diff --git a/Task/Numerical-integration-Gauss-Legendre-Quadrature/PARI-GP/numerical-integration-gauss-legendre-quadrature.pari b/Task/Numerical-integration-Gauss-Legendre-Quadrature/PARI-GP/numerical-integration-gauss-legendre-quadrature-1.pari similarity index 100% rename from Task/Numerical-integration-Gauss-Legendre-Quadrature/PARI-GP/numerical-integration-gauss-legendre-quadrature.pari rename to Task/Numerical-integration-Gauss-Legendre-Quadrature/PARI-GP/numerical-integration-gauss-legendre-quadrature-1.pari diff --git a/Task/Numerical-integration-Gauss-Legendre-Quadrature/PARI-GP/numerical-integration-gauss-legendre-quadrature-2.pari b/Task/Numerical-integration-Gauss-Legendre-Quadrature/PARI-GP/numerical-integration-gauss-legendre-quadrature-2.pari new file mode 100644 index 0000000000..e9fdd4e488 --- /dev/null +++ b/Task/Numerical-integration-Gauss-Legendre-Quadrature/PARI-GP/numerical-integration-gauss-legendre-quadrature-2.pari @@ -0,0 +1,2 @@ +intnumgauss(x=-3, 3, exp(x), intnumgaussinit(5)) +intnumgauss(x=-3, 3, exp(x)) \\ determine number of points automatically; all digits shown should be accurate diff --git a/Task/Numerical-integration-Gauss-Legendre-Quadrature/REXX/numerical-integration-gauss-legendre-quadrature-2.rexx b/Task/Numerical-integration-Gauss-Legendre-Quadrature/REXX/numerical-integration-gauss-legendre-quadrature-2.rexx index 104650614f..7478cffe68 100644 --- a/Task/Numerical-integration-Gauss-Legendre-Quadrature/REXX/numerical-integration-gauss-legendre-quadrature-2.rexx +++ b/Task/Numerical-integration-Gauss-Legendre-Quadrature/REXX/numerical-integration-gauss-legendre-quadrature-2.rexx @@ -1,49 +1,52 @@ -/*REXX pgm does numerical integration using Gauss─Legendre Quadrature (GLQ).*/ -pi=pi(); digs=length(pi); numeric digits digs; reps=digs%2 -!.=.; b=3; a=-b; bma=b-a; bmaH=bma/2; tiny='1E-' || digs -trueV=exp(b)-exp(a); bpa=b+a; bpaH=bpa/2 -say ' step ' center("iterative value",digs+3) ' difference' /*show hdr*/ -sep='──────' copies('─' ,digs+3) '─────────────'; say sep +/*REXX program does numerical integration using an N-point Gauss─Legendre quadrature rule. */ +pi=pi(); digs=length(pi)-1; numeric digits digs; reps=digs%2 +!.=.; b=3; a=-b; bma=b-a; bmaH=bma/2; tiny='1e-'digs +trueV=exp(b)-exp(a); bpa=b+a; bpaH=bpa/2 +say ' step ' center("iterative value",digs+3) ' difference' /*show hdr*/ +sep='──────' copies("─" ,digs+3) '─────────────'; say sep /* " sep*/ - do #=1 until dif>0; p0z=1; p0.1=1; p1z=2; p1.1=1; p1.2=0; ##=#+.5; r.=0 - if #\==1 then say center(#, 6) z' ' Ndif /*don't display if not computed.*/ + do #=1 until dif>0; p0z=1; p0.1=1; p1z=2; p1.1=1; p1.2=0; ##=#+.5; r.=0 -/*█*/ do k=2 to #; km=k-1; do y=1 for p1z; T.y=p1.y; end /*y*/ -/*█*/ T.y=0; TT.=0; do L=1 for p0z; _=L+2; TT._=p0.L; end /*L*/ -/*█*/ -/*█*/ kkm=k+km; do j=1 for p1z+1; T.j=(kkm*T.j-km*TT.j)/k ; end /*j*/ -/*█*/ p0z=p1z; do n=1 for p0z; p0.n=p1.n ; end /*n*/ -/*█*/ p1z=p1z+1; do p=1 for p1z; p1.p= T.p ; end /*p*/ -/*█*/ end /*k*/ + /*█*/ do k=2 to #; km=k-1; do y=1 for p1z; T.y=p1.y; end /*y*/ + /*█*/ T.y=0; TT.=0; do L=1 for p0z; _=L+2; TT._=p0.L; end /*L*/ + /*█*/ + /*█*/ kkm=k+km; do j=1 for p1z+1; T.j=(kkm*T.j-km*TT.j)/k ; end /*j*/ + /*█*/ p0z=p1z; do n=1 for p0z; p0.n=p1.n ; end /*n*/ + /*█*/ p1z=p1z+1; do p=1 for p1z; p1.p= T.p ; end /*p*/ + /*█*/ end /*k*/ - /*▓*/ do !=1 for #; x=cos( pi * (! - .25) / ## ) - /*▓*/ - /*▓*/ /*░*/ do reps until abs(dx) <= tiny - /*▓*/ /*░*/ f=p1.1; df=0; do u=2 to p1z - /*▓*/ /*░*/ df=f + x*df - /*▓*/ /*░*/ f=p1.u + x*f - /*▓*/ /*░*/ end /*u*/ - /*▓*/ /*░*/ dx=f/df; x=x-dx - /*▓*/ /*░*/ end /*reps ···*/ - /*▓*/ r.1.!=x - /*▓*/ r.2.!=2 / ((1 - x**2) * df**2) - /*▓*/ end /*!*/ + /*▓*/ do !=1 for #; x=cos( pi * (! - .25) / ## ) + /*▓*/ + /*▓*/ /*░*/ do reps until abs(dx) <= tiny + /*▓*/ /*░*/ f=p1.1; df=0; do u=2 to p1z + /*▓*/ /*░*/ df=f + x*df + /*▓*/ /*░*/ f=p1.u + x*f + /*▓*/ /*░*/ end /*u*/ + /*▓*/ /*░*/ dx=f/df; x=x-dx + /*▓*/ /*░*/ end /*reps ···*/ + /*▓*/ r.1.!=x + /*▓*/ r.2.!=2 / ((1 - x**2) * df**2) + /*▓*/ end /*!*/ $=0 - /*▒*/ do m=1 for #; $=$+r.2.m*exp(bpaH+r.1.m*bmaH); end /*m*/ - z=bmaH*$ /*calculate the target value (Z)*/ - dif=z-trueV; z=format(z,3,digs-2) /* " " difference. */ - Ndif=translate( format(dif,3,4,2,0), 'e', "E") + /*▒*/ do m=1 for #; $=$ + r.2.m * exp(bpaH + r.1.m*bmaH); end /*m*/ + z=bmaH*$ /*calculate target value (Z)*/ + dif=z-trueV; z=format(z, 3, digs-2) /* " difference. */ + Ndif=translate( format(dif, 3, 4, 2, 0), 'e', "E") + if #\==1 then say center(#, 6) z' ' Ndif /*don't display if not computed.*/ end /*#*/ -say sep; say left('',6+1) trueV " {exact value}" -exit /*stick a fork in it, we're all done. */ -/*─────────────────────────────────────────────────────────────────────────────────────*/ -e: return 2.7182818284590452353602874713526624977572470936999595749669676277240766303535 -pi: return 3.1415926535897932384626433832795028841971693993751058209749445923078164062862 -/*──────────────────────────────────────────────────────────────────────────────────*/ -cos: procedure expose !.; parse arg x; if !.x\==. then return !.x; _=1; z=1; y=x*x - do k=2 by 2 until p==z; p=z; _=-_*y/(k*(k-1)); z=z+_; end; !.x=z; return z -/*────────────────────────────────────────────────────────────────────────────*/ -exp: procedure; parse arg x; ix=trunc(x); if abs(x-ix)>.5 then ix=ix+sign(x) - x=x-ix; z=1; _=1; do j=1 until p==z; p=z; _=_*x/j; z=z+_; end - if z\==0 then z=z*e()**ix; return z +say sep; xdif=compare(strip(z), trueV); say right("↑", 6+1+xdif) +say left('', 6+1) trueV " {exact value}"; say +say 'Using ' digs " digit precision, the" , + 'N-point Gauss─Legendre quadrature (GLQ) had an accuracy of ' xdif-2 " digits." +exit /*stick a fork in it, we're all done. */ +/*───────────────────────────────────────────────────────────────────────────────────────────*/ +e: return 2.718281828459045235360287471352662497757247093699959574966967627724076630353547595 +pi: return 3.141592653589793238462643383279502884197169399375105820974944592307816406286286209 +/*───────────────────────────────────────────────────────────────────────────────────────────*/ +cos: procedure expose !.; parse arg x; if !.x\==. then return !.x; _=1; z=1; y=x*x + do k=2 by 2 until p==z; p=z; _=-_*y/(k*(k-1)); z=z+_; end; !.x=z; return z +/*───────────────────────────────────────────────────────────────────────────────────────────*/ +exp: procedure; parse arg x; ix=x % 1; if abs(x-ix) > .5 then ix=ix + sign(x) + x=x-ix; z=1; _=1; do j=1 until p==z; p=z; _=_*x/j; z=z+_; end + if z\==0 then z=z * e()**ix; return z diff --git a/Task/Numerical-integration/00DESCRIPTION b/Task/Numerical-integration/00DESCRIPTION index 6b1f454070..dc5985dbc3 100644 --- a/Task/Numerical-integration/00DESCRIPTION +++ b/Task/Numerical-integration/00DESCRIPTION @@ -1,6 +1,17 @@ -Write functions to calculate the definite integral of a function (''f(x)'') using [[wp:Rectangle_method|rectangular]] (left, right, and midpoint), [[wp:Trapezoidal_rule|trapezium]], and [[wp:Simpson%27s_rule|Simpson's]] methods. Your functions should take in the upper and lower bounds (''a'' and ''b'') and the number of approximations to make in that range (''n''). Assume that your example already has a function that gives values for ''f(x)''. +Write functions to calculate the definite integral of a function     ''ƒ(x)''     using   ''all''   five of the following methods: +::*   [[wp:Rectangle_method|rectangular]] +::::*   left +::::*   right +::::*   midpoint +::*   [[wp:Trapezoidal_rule|trapezium]] +::*   [[wp:Simpson%27s_rule|Simpson's]] -Simpson's method is defined by the following pseudocode: +
    +Your functions should take in the upper and lower bounds   (''a''   and   ''b''),   and the number of approximations to make in that range   (''n''). + +Assume that your example already has a function that gives values for     ''ƒ(x)''. + +Simpson's method is defined by the following pseudo-code:
     h := (b - a) / n
     sum1 := f(a + h/2)
    @@ -14,11 +25,14 @@ answer := (h / 6) * (f(a) + f(b) + 4*sum1 + 2*sum2)
     
    Demonstrate your function by showing the results for: -* f(x) = x^3, where x is [0,1], with 100 approximations. The exact result is 1/4, or 0.25. -* f(x) = 1/x, where x is [1,100], with 1,000 approximations. The exact result is the natural log of 100, or about 4.605170 -* f(x) = x, where x is [0,5000], with 5,000,000 approximations. The exact result is 12,500,000. -* f(x) = x, where x is [0,6000], with 6,000,000 approximations. The exact result is 18,000,000. +* ƒ(x) = x3,   where     '''x'''     is   [0,1],   with 100 approximations.   The exact result is   1/4,   or   0.25. +* ƒ(x) = 1/x,   where   '''x'''   is   [1,100],   with 1,000 approximations.   The exact result is the natural log of 100,   or about   4.605170 +* ƒ(x) = x,     where   '''x'''   is   [0,5000],   with 5,000,000 approximations.   The exact result is   12,500,000. +* ƒ(x) = x,     where   '''x'''   is   [0,6000],   with 6,000,000 approximations.   The exact result is   18,000,000. + +
    '''See also''' * [[Active object]] for integrating a function of real time. * [[Numerical integration/Gauss-Legendre Quadrature]] for another integration method. +

    diff --git a/Task/Numerical-integration/ALGOL-68/numerical-integration.alg b/Task/Numerical-integration/ALGOL-68/numerical-integration.alg index dfe4e3a434..0aea988d79 100644 --- a/Task/Numerical-integration/ALGOL-68/numerical-integration.alg +++ b/Task/Numerical-integration/ALGOL-68/numerical-integration.alg @@ -82,4 +82,37 @@ BEGIN OD; h / 6 * (f(a) + f(b) + 4 * sum1 + 2 * sum2) END # simpson #; + +# test the above procedures # +PROC test integrators = ( STRING legend + , F function + , LONG REAL lower limit + , LONG REAL upper limit + , INT iterations + ) VOID: +BEGIN + print( ( legend + , fixed( left rect( function, lower limit, upper limit, iterations ), -20, 6 ) + , fixed( right rect( function, lower limit, upper limit, iterations ), -20, 6 ) + , fixed( mid rect( function, lower limit, upper limit, iterations ), -20, 6 ) + , fixed( trapezium( function, lower limit, upper limit, iterations ), -20, 6 ) + , fixed( simpson( function, lower limit, upper limit, iterations ), -20, 6 ) + , newline + ) + ) +END; # test integrators # +print( ( " " + , " left rect" + , " right rect" + , " mid rect" + , " trapezium" + , " simpson" + , newline + ) + ); +test integrators( "x^3", ( LONG REAL x )LONG REAL: x * x * x, 0, 1, 100 ); +test integrators( "1/x", ( LONG REAL x )LONG REAL: 1 / x, 1, 100, 1 000 ); +test integrators( "x ", ( LONG REAL x )LONG REAL: x, 0, 5 000, 5 000 000 ); +test integrators( "x ", ( LONG REAL x )LONG REAL: x, 0, 6 000, 6 000 000 ); + SKIP diff --git a/Task/Numerical-integration/Perl-6/numerical-integration-1.pl6 b/Task/Numerical-integration/Perl-6/numerical-integration-1.pl6 index eeb58ba3a2..51b2a87428 100644 --- a/Task/Numerical-integration/Perl-6/numerical-integration-1.pl6 +++ b/Task/Numerical-integration/Perl-6/numerical-integration-1.pl6 @@ -1,3 +1,5 @@ +use MONKEY-SEE-NO-EVAL; + sub leftrect(&f, $a, $b, $n) { my $h = ($b - $a) / $n; $h * [+] do f($_) for $a, $a+$h ... $b-$h; @@ -15,7 +17,8 @@ sub midrect(&f, $a, $b, $n) { sub trapez(&f, $a, $b, $n) { my $h = ($b - $a) / $n; - $h / 2 * [+] f($a), f($b), |do f($_) * 2 for $a+$h, $a+$h+$h ... $b-$h; + my $partial-sum += f($_) * 2 for $a+$h, $a+$h+$h ... $b-$h; + $h / 2 * [+] f($a), f($b), $partial-sum; } sub simpsons(&f, $a, $b, $n) { diff --git a/Task/Numerical-integration/Python/numerical-integration-3.py b/Task/Numerical-integration/Python/numerical-integration-3.py index 45983eb2ee..8b9d2d617d 100644 --- a/Task/Numerical-integration/Python/numerical-integration-3.py +++ b/Task/Numerical-integration/Python/numerical-integration-3.py @@ -1,5 +1,5 @@ def faster_simpson(f, a, b, steps): - h = (b-a)/steps + h = (b-a)/float(steps) a1 = a+h/2 s1 = sum( f(a1+i*h) for i in range(0,steps)) s2 = sum( f(a+i*h) for i in range(1,steps)) diff --git a/Task/Numerical-integration/REXX/numerical-integration.rexx b/Task/Numerical-integration/REXX/numerical-integration.rexx index d335c8ce13..501fb77d98 100644 --- a/Task/Numerical-integration/REXX/numerical-integration.rexx +++ b/Task/Numerical-integration/REXX/numerical-integration.rexx @@ -1,47 +1,47 @@ -/*REXX program does numerical integration using five different algorithms.*/ -numeric digits 20 /*use twenty decimal digits precision. */ +/*REXX pgm performs numerical integration using 5 different algorithms and show results.*/ +numeric digits 20 /*use twenty decimal digits precision. */ - do test=1 for 4 /*perform the 4 different test suites. */ - if test==1 then do; L=0; H= 1; i= 100; end - if test==2 then do; L=1; H= 100; i= 1000; end - if test==3 then do; L=0; H=5000; i=5000000; end - if test==4 then do; L=0; H=6000; i=5000000; end + do test=1 for 4 /*perform the 4 different test suites. */ + if test==1 then do; L=0; H= 1; i= 100; end + if test==2 then do; L=1; H= 100; i= 1000; end + if test==3 then do; L=0; H=5000; i=5000000; end + if test==4 then do; L=0; H=6000; i=5000000; end say - say center('test' test,65,'─') /*display a header for the test suite. */ + say center('test' test,65,'─') /*display a header for the test suite. */ say ' left rectangular('L", "H', 'i") ──► " left_rect(L, H, i) say ' midpoint rectangular('L", "H', 'i") ──► " midpoint_rect(L, H, i) say ' right rectangular('L", "H', 'i") ──► " right_rect(L, H, i) say ' Simpson('L", "H', 'i") ──► " Simpson(L, H, i) say ' trapezium('L", "H', 'i") ──► " trapezium(L, H, i) end /*test*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -f: if test==1 then return arg(1)**3 - if test==2 then return 1/arg(1) - return arg(1) -/*────────────────────────────────────────────────────────────────────────────*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +f: if test==1 then return arg(1)**3 /*choose the cube function. */ + if test==2 then return 1/arg(1) /* " " reciprocal " */ + return arg(1) /* " " "as-is" " */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ left_rect: procedure expose test; parse arg a,b,n; h=(b-a)/n -$=0 - do x=a by h for n; $=$+f(x); end /*x*/ -return $*h/1 /*return the number with no trailing 0s*/ -/*────────────────────────────────────────────────────────────────────────────*/ + $=0 + do x=a by h for n; $=$+f(x); end /*x*/ + return $*h/1 +/*──────────────────────────────────────────────────────────────────────────────────────*/ midpoint_rect: procedure expose test; parse arg a,b,n; h=(b-a)/n -$=0 - do x=a+h/2 by h for n; $=$+f(x); end /*x*/ -return $*h/1 /*return the number with no trailing 0s*/ -/*────────────────────────────────────────────────────────────────────────────*/ + $=0 + do x=a+h/2 by h for n; $=$+f(x); end /*x*/ + return $*h/1 +/*──────────────────────────────────────────────────────────────────────────────────────*/ right_rect: procedure expose test; parse arg a,b,n; h=(b-a)/n -$=0 - do x=a+h by h for n; $=$+f(x); end /*x*/ -return $*h/1 /*return the number with no trailing 0s*/ -/*────────────────────────────────────────────────────────────────────────────*/ + $=0 + do x=a+h by h for n; $=$+f(x); end /*x*/ + return $*h/1 +/*──────────────────────────────────────────────────────────────────────────────────────*/ Simpson: procedure expose test; parse arg a,b,n; h=(b-a)/n -$=f(a+h/2) -@=0; do x=1 for n-1; $=$+f(a+h*x+h*.5); @=@+f(a+x*h); end /*x*/ + $=f(a+h/2) + @=0; do x=1 for n-1; $=$+f(a+h*x+h*.5); @=@+f(a+x*h); end /*x*/ -return h*(f(a) + f(b) + 4*$ + 2*@)/6 /*return the number with no trailing 0s*/ -/*────────────────────────────────────────────────────────────────────────────*/ -trapezium: procedure expose test; parse arg a,b,n; h=(b-a)/n -$=0 - do x=a by h for n; $=$+(f(x)+f(x+h)); end /*x*/ -return $*h/2 /*return the number with no trailing 0s*/ + return h*(f(a) + f(b) + 4*$ + 2*@) / 6 +/*──────────────────────────────────────────────────────────────────────────────────────*/ +trapezium: procedure expose test; parse arg a,b,n; h=(b-a)/n + $=0 + do x=a by h for n; $=$+(f(x)+f(x+h)); end /*x*/ + return $*h/2 diff --git a/Task/Numerical-integration/VBA/numerical-integration.vba b/Task/Numerical-integration/VBA/numerical-integration.vba new file mode 100644 index 0000000000..55d40b33eb --- /dev/null +++ b/Task/Numerical-integration/VBA/numerical-integration.vba @@ -0,0 +1,56 @@ +Option Explicit +Option Base 1 + +Function Quad(ByVal f As String, ByVal a As Double, _ + ByVal b As Double, ByVal n As Long, _ + ByVal u As Variant, ByVal v As Variant) As Double + Dim m As Long, h As Double, x As Double, s As Double, i As Long, j As Long + m = UBound(u) + h = (b - a) / n + s = 0# + For i = 1 To n + x = a + (i - 1) * h + For j = 1 To m + s = s + v(j) * Application.Run(f, x + h * u(j)) + Next + Next + Quad = s * h +End Function + +Function f1fun(x As Double) As Double + f1fun = x ^ 3 +End Function + +Function f2fun(x As Double) As Double + f2fun = 1 / x +End Function + +Function f3fun(x As Double) As Double + f3fun = x +End Function + +Sub Test() + Dim fun, f, coef, c + Dim i As Long, j As Long, s As Double + + fun = Array(Array("f1fun", 0, 1, 100, 1 / 4), _ + Array("f2fun", 1, 100, 1000, Log(100)), _ + Array("f3fun", 0, 5000, 50000, 5000 ^ 2 / 2), _ + Array("f3fun", 0, 6000, 60000, 6000 ^ 2 / 2)) + + coef = Array(Array("Left rect. ", Array(0, 1), Array(1, 0)), _ + Array("Right rect. ", Array(0, 1), Array(0, 1)), _ + Array("Midpoint ", Array(0.5), Array(1)), _ + Array("Trapez. ", Array(0, 1), Array(0.5, 0.5)), _ + Array("Simpson ", Array(0, 0.5, 1), Array(1 / 6, 4 / 6, 1 / 6))) + + For i = 1 To UBound(fun) + f = fun(i) + Debug.Print f(1) + For j = 1 To UBound(coef) + c = coef(j) + s = Quad(f(1), f(2), f(3), f(4), c(2), c(3)) + Debug.Print " " + c(1) + ": ", s, (s - f(5)) / f(5) + Next j + Next i +End Sub diff --git a/Task/Odd-word-problem/00DESCRIPTION b/Task/Odd-word-problem/00DESCRIPTION index 4ae9f0f876..4b1ca3be30 100644 --- a/Task/Odd-word-problem/00DESCRIPTION +++ b/Task/Odd-word-problem/00DESCRIPTION @@ -1,14 +1,31 @@ +;Task: Write a program that solves the [http://c2.com/cgi/wiki?OddWordProblem odd word problem] with the restrictions given below. -'''Description''': You are promised an input stream consisting of English letters and punctuations. It is guaranteed that -* the words (sequence of consecutive letters) are delimited by one and only one punctuation; that -* the stream will begin with a word; that -* the words will be at least one letter long; and that -* a full stop (.) appears after, and only after, the last word. -For example, what,is,the;meaning,of:life. is such a stream with six words. Your task is to reverse the letters in every other word while leaving punctuations intact, producing e.g. "what,si,the;gninaem,of:efil.", while observing the following restrictions: +;Description: +You are promised an input stream consisting of English letters and punctuations. + +It is guaranteed that: +* the words (sequence of consecutive letters) are delimited by one and only one punctuation, +* the stream will begin with a word, +* the words will be at least one letter long,   and +* a full stop (a period, [.]) appears after, and only after, the last word. + + +;Example: +A stream with six words: +:: what,is,the;meaning,of:life. + + +The task is to reverse the letters in every other word while leaving punctuations intact, producing: +:: what,si,the;gninaem,of:efil. +while observing the following restrictions: # Only I/O allowed is reading or writing one character at a time, which means: no reading in a string, no peeking ahead, no pushing characters back into the stream, and no storing characters in a global variable for later use; # You '''are not''' to explicitly save characters in a collection data structure, such as arrays, strings, hash tables, etc, for later reversal; -# You '''are''' allowed to use recursions, closures, continuations, threads, coroutines, etc., even if their use implies the storage of multiple characters. +# You '''are''' allowed to use recursions, closures, continuations, threads, co-routines, etc., even if their use implies the storage of multiple characters. -'''Test case''': work on both the "life" example given above, and the text we,are;not,in,kansas;any,more. + +;Test cases: +Work on both the   "life"   example given above, and also the text: +:: we,are;not,in,kansas;any,more. +

    diff --git a/Task/Odd-word-problem/Elixir/odd-word-problem.elixir b/Task/Odd-word-problem/Elixir/odd-word-problem.elixir new file mode 100644 index 0000000000..45daf2dd25 --- /dev/null +++ b/Task/Odd-word-problem/Elixir/odd-word-problem.elixir @@ -0,0 +1,26 @@ +defmodule Odd_word do + def handle(s, false, i, o) when ((s >= "a" and s <= "z") or (s >= "A" and s <= "Z")) do + o.(s) + handle(i.(), false, i, o) + end + def handle(s, t, i, o) when ((s >= "a" and s <= "z") or (s >= "A" and s <= "Z")) do + d = handle(i.(), :rec, i, o) + o.(s) + if t == true, do: handle(d, t, i, o), else: d + end + def handle(s, :rec, _, _), do: s + def handle(?., _, _, o), do: o.(?.); :done + def handle(:eof, _, _, _), do: :done + def handle(s, t, i, o) do + o.(s) + handle(i.(), not t, i, o) + end + + def main do + i = fn() -> IO.getn("") end + o = fn(s) -> IO.write(s) end + handle(i.(), false, i, o) + end +end + +Odd_word.main diff --git a/Task/Odd-word-problem/Fortran/odd-word-problem.f b/Task/Odd-word-problem/Fortran/odd-word-problem.f new file mode 100644 index 0000000000..e5f7e29d6b --- /dev/null +++ b/Task/Odd-word-problem/Fortran/odd-word-problem.f @@ -0,0 +1,41 @@ + MODULE ELUDOM !Uses the call stack for auxiliary storage. + INTEGER MSG,INF !I/O unit numbers. + LOGICAL DEFER !To stumble, or not to stumble. + CONTAINS + CHARACTER*1 RECURSIVE FUNCTION GET(IN) !Returns one character, going forwards. + INTEGER IN !The input file. + CHARACTER*1 C !The single character to be read therefrom. + READ (IN,1,ADVANCE="NO",EOR=3,END=4) C !Thus. Not advancing to the next record. + 1 FORMAT (A1,$) !For output, no advance to the next line either. + 2 IF (("A"<=C .AND. C<="Z").OR.("a"<=C .AND. C<="z")) THEN !Unsafe for EBCDIC. + IF (DEFER) THEN !Are we to reverse the current text? + GET = GET(IN) !Yes. Go for the next letter. + WRITE (MSG,1) C !And now, backing out, reveal the letter at this level. + RETURN !Retreat another level. + END IF !Thus passing back the ending non-letter that was encountered. + ELSE !And if we've encountered a non-letter, + DEFER = .NOT. DEFER !Then our backwardness flips. + END IF !Enough inspection of C. + 3 GET = C !Pass it back. + RETURN !And we're done. + 4 GET = CHAR(0) !Reserving this for end-of-file. + END FUNCTION GET!That was strange. + END MODULE ELUDOM !But as per the specification. + + PROGRAM CONFUSED !Just so. + USE ELUDOM !Forwards? Backwards? + CHARACTER*1 C !A scratchpad for multiple inspections. + MSG = 6 !Standard output. + INF = 10 !This will do. + OPEN (INF,NAME = "Confused.txt",STATUS="OLD",ACTION="READ") !Go for the file. + +Chew through the input. A full stop marks the end. + 10 DEFER = .FALSE. !Start off going forwards. + 11 C = GET(INF) !Get some character from file INF. + IF (ICHAR(C).LE.0) STOP !Perhaps end-of-file is reported. + IF (C.NE." ") WRITE (MSG,12) C !Otherwise, write it. A blank for end-of-record. + 12 FORMAT (A1,$) !Obviously, not finishing the line each time. + IF (C.NE.".") GO TO 11 !And if not a full stop, do it again. + WRITE (MSG,"('')") !End the line of output. + GO TO 10 !And have another go. + END !That was confusing. diff --git a/Task/Odd-word-problem/REXX/odd-word-problem.rexx b/Task/Odd-word-problem/REXX/odd-word-problem.rexx index 8be165ac48..f918cd1887 100644 --- a/Task/Odd-word-problem/REXX/odd-word-problem.rexx +++ b/Task/Odd-word-problem/REXX/odd-word-problem.rexx @@ -1,28 +1,30 @@ -/*REXX program solves the odd word problem by only using byte input/output.*/ -iFID_ = 'ODDWORD.IN' /*Note: numeric suffix is added later.*/ -oFID_ = 'ODDWORD.' /* " " " " " " */ +/*REXX program solves the odd word problem by only using byte input/output. */ +iFID_ = 'ODDWORD.IN' /*Note: numeric suffix is added later.*/ +oFID_ = 'ODDWORD.' /* " " " " " " */ - do case=1 for 2; #=0 /*#: is the number of characters read.*/ - iFID=iFID_ || case /*read ODDWORD.IN1 or ODDWORD.IN2 */ - oFID=oFID_ || case /*write ODDWORD.1 o r ODDWORD.2 */ - say; say; say '════════ reading file: ' iFID "════════" + do case=1 for 2; #=0 /*#: is the number of characters read.*/ + iFID=iFID_ || case /*read ODDWORD.IN1 or ODDWORD.IN2 */ + oFID=oFID_ || case /*write ODDWORD.1 o r ODDWORD.2 */ + say; say; say '════════ reading file: ' iFID "════════" /* ◄■■■■■■■■■ optional. */ - do until x==. /* [↓] perform DO loop for odd words.*/ - do until \isMix(x); call readChar; call writeChar; end - if x==. then leave /*is this end─of─sentence? (full stop)*/ - call readLetters; punctuation_location=# - do j=#-1 by -1; call readChar j - if \isMix(x) then leave; call writeChar - end /*j*/ /* [↑] perform for the "even" words.*/ - call readLetters; call writeChar; #=punctuation_location - end /*until x ···*/ - end /*case*/ /* [↑] process both of the input files*/ -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────one─liner subroutines─────────────────────*/ -isMix: return datatype(arg(1),'M') /*return 1 if arg is a letter.*/ -readLetters: do until \isMix(x); call readChar; end; return -writeChar: call charout ,x; call charout oFID,x; return -/*──────────────────────────────────readChar subroutine───────────────────────*/ -readChar: if arg(1)=='' then do; x=charin(iFID); #=#+1; end /*read next char*/ - else x=charin(iFID, arg(1)) /* " specific "*/ - return + do until x==. /* [↓] perform for "odd" words.*/ + do until \isMix(x); /* [↓] perform until punct found.*/ + call readChar; call writeChar /*read and write a letter. */ + end /*until ¬isMix(x)*/ /* [↑] keep reading " " */ + if x==. then leave /*is this the end─of─sentence ? */ + call readLetters; punct=# /*save the location of punctuation*/ + do j=#-1 by -1; call readChar j /*read previous word (backwards). */ + if \isMix(x) then leave; call writeChar /*Found punctuation? Then leave. */ + end /*j*/ /* [↑] perform for "even" words.*/ + call readLetters; call writeChar; #=punct /*read/write letters; new location*/ + end /*until x==.*/ + end /*case*/ /* [↑] process both input files. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +isMix: return datatype( arg(1), 'M') /*return 1 if argument is a letter.*/ +readLetters: do until \isMix(x); call readChar; end; return +writeChar: call charout , x; call charout oFID, x; return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +readChar: if arg(1)=='' then do; x=charin(iFID); #=#+1; end /*read the next char*/ + else x=charin(iFID, arg(1)) /* " specific " */ + return diff --git a/Task/Old-lady-swallowed-a-fly/00DESCRIPTION b/Task/Old-lady-swallowed-a-fly/00DESCRIPTION index 2f64895dff..3408644954 100644 --- a/Task/Old-lady-swallowed-a-fly/00DESCRIPTION +++ b/Task/Old-lady-swallowed-a-fly/00DESCRIPTION @@ -1,3 +1,9 @@ -Present a program which emits the lyrics to the song ''[[wp:There Was an Old Lady Who Swallowed a Fly|I Knew an Old Lady Who Swallowed a Fly]]'', taking advantage of the repetitive structure of the song's lyrics. This song has multiple versions with slightly different lyrics, so all these programs might not emit identical output. +;Task: +Present a program which emits the lyrics to the song   ''[[wp:There Was an Old Lady Who Swallowed a Fly|I Knew an Old Lady Who Swallowed a Fly]]'',   taking advantage of the repetitive structure of the song's lyrics. -See also: [[99 Bottles of Beer]] +This song has multiple versions with slightly different lyrics, so all these programs might not emit identical output. + + +;Related task: +*   [[99 Bottles of Beer]] +

    diff --git a/Task/Old-lady-swallowed-a-fly/BBC-BASIC/old-lady-swallowed-a-fly.bbc b/Task/Old-lady-swallowed-a-fly/BBC-BASIC/old-lady-swallowed-a-fly.bbc new file mode 100644 index 0000000000..636a017207 --- /dev/null +++ b/Task/Old-lady-swallowed-a-fly/BBC-BASIC/old-lady-swallowed-a-fly.bbc @@ -0,0 +1,28 @@ +REM >oldlady +DIM swallowings$(6, 1) +swallowings$() = "fly", "+why", "spider", "That wriggled and wiggled and tickled inside her", "bird", ":How absurd", "cat", ":Fancy that", "dog", ":What a hog", "cow", "+how", "horse", "She's dead, of course" +FOR i% = 0 TO 6 + PRINT "There was an old lady who swallowed a "; swallowings$(i%, 0); "..." + PROC_comment_on_swallowing(swallowings$(i%, 0), swallowings$(i%, 1)) + IF i% > 0 AND i% < 6 THEN + FOR j% = i% TO 1 STEP -1 + PRINT "She swallowed the "; swallowings$(j%, 0); " to catch the "; swallowings$(j% - 1, 0); "," + NEXT + PROC_comment_on_swallowing(swallowings$(0, 0), swallowings$(0, 1)) + ENDIF + PRINT +NEXT +END +: +DEF PROC_comment_on_swallowing(animal$, observation$) +CASE LEFT$(observation$, 1) OF +WHEN "+": + PRINT "I don't know "; MID$(observation$, 2); " she swallowed a "; animal$; + IF animal$ = "fly" THEN PRINT " -- perhaps she'll die"; + PRINT "!" +WHEN ":" + PRINT MID$(observation$, 2); ", to swallow a "; animal$; "!" +OTHERWISE + PRINT observation$; "!" +ENDCASE +ENDPROC diff --git a/Task/Old-lady-swallowed-a-fly/COBOL/old-lady-swallowed-a-fly.cobol b/Task/Old-lady-swallowed-a-fly/COBOL/old-lady-swallowed-a-fly.cobol new file mode 100644 index 0000000000..d11c265b88 --- /dev/null +++ b/Task/Old-lady-swallowed-a-fly/COBOL/old-lady-swallowed-a-fly.cobol @@ -0,0 +1,89 @@ + IDENTIFICATION DIVISION. + PROGRAM-ID. OLD-LADY. + + DATA DIVISION. + WORKING-STORAGE SECTION. + + 01 LYRICS. + 03 THERE-WAS PIC X(38) VALUE + "There was an old lady who swallowed a ". + 03 SHE-SWALLOWED PIC X(18) VALUE "She swallowed the ". + 03 TO-CATCH PIC X(14) VALUE " to catch the ". + 01 ANIMALS. + 03 FLY. + 05 NAME PIC X(6) VALUE "fly". + 05 VERSE PIC X(60) VALUE + "I don't know why she swallowed a fly. Perhaps she'll die.". + 03 SPIDER. + 05 NAME PIC X(6) VALUE "spider". + 05 VERSE PIC X(60) VALUE + "That wiggled and jiggled and tickled inside her.". + 03 BIRD. + 05 NAME PIC X(6) VALUE "bird". + 05 VERSE PIC X(60) VALUE + "How absurd, to swallow a bird.". + 03 CAT. + 05 NAME PIC X(6) VALUE "cat". + 05 VERSE PIC X(60) VALUE + "Imagine that, she swallowed a cat.". + 03 DOG. + 05 NAME PIC X(6) VALUE "dog". + 05 VERSE PIC X(60) VALUE + "What a hog, to swallow a dog.". + 03 GOAT. + 05 NAME PIC X(6) VALUE "goat". + 05 VERSE PIC X(60) VALUE + "She just opened her throat and swallowed that goat.". + 03 COW. + 05 NAME PIC X(6) VALUE "cow". + 05 VERSE PIC X(60) VALUE + "I don't know how she swallowed that cow.". + 03 HORSE. + 05 NAME PIC X(6) VALUE "horse". + 05 VERSE PIC X(60) VALUE + "She's dead, of course.". + 01 ANIMAL-ARRAY REDEFINES ANIMALS. + 03 ANIMAL OCCURS 8 TIMES. + 05 NAME PIC X(6). + 05 VERSE PIC X(60). + 01 MISC. + 03 LINE-OUT PIC X(80). + 03 A-IDX PIC 9(2). + 03 S-IDX PIC 9(2). + + PROCEDURE DIVISION. + MAIN SECTION. + PERFORM DO-ANIMAL + VARYING A-IDX FROM 1 BY 1 UNTIL A-IDX > 8. + STOP RUN. + + DO-ANIMAL SECTION. + MOVE SPACES TO LINE-OUT. + STRING + THERE-WAS DELIMITED BY SIZE, + NAME OF ANIMAL(A-IDX) DELIMITED BY SPACE, + "," + INTO LINE-OUT + END-STRING. + DISPLAY LINE-OUT. + IF A-IDX > 1 THEN + DISPLAY VERSE OF ANIMAL(A-IDX) + END-IF. + IF A-IDX = 8 THEN + EXIT SECTION + END-IF. + PERFORM DO-SWALLOW + VARYING S-IDX FROM A-IDX BY -1 UNTIL S-IDX = 1. + DISPLAY VERSE OF ANIMAL(1). + DISPLAY SPACES. + + DO-SWALLOW SECTION. + MOVE SPACES TO LINE-OUT. + STRING + SHE-SWALLOWED DELIMITED BY SIZE, + NAME OF ANIMAL(S-IDX) DELIMITED BY SPACE, + TO-CATCH DELIMITED BY SIZE, + NAME OF ANIMAL(S-IDX - 1) DELIMITED BY SPACE + INTO LINE-OUT + END-STRING. + DISPLAY LINE-OUT. diff --git a/Task/Old-lady-swallowed-a-fly/Common-Lisp/old-lady-swallowed-a-fly.lisp b/Task/Old-lady-swallowed-a-fly/Common-Lisp/old-lady-swallowed-a-fly.lisp new file mode 100644 index 0000000000..8dbf0f4db8 --- /dev/null +++ b/Task/Old-lady-swallowed-a-fly/Common-Lisp/old-lady-swallowed-a-fly.lisp @@ -0,0 +1,37 @@ +(defun verse (what remark &optional always die) (list what remark always die)) +(defun what (verse) (first verse)) +(defun remark (verse) (second verse)) +(defun always (verse) (third verse)) +(defun die (verse) (fourth verse)) + +(defun ssa (what remark &optional always die ) + (verse what (format nil "~a she swallowed a ~a!" remark what always die))) +(defun tsa (what remark &optional always die) + (verse what (format nil "~a, to swallow a ~a!" remark what))) +(defun asa (what remark &optional always die) + (verse what (format nil "~a, and swallowed a ~a!" remark what))) + + +(let ((verses (list + (verse "fly" "I don't know why she swallowed the fly" T) + (verse "spider" "That wriggled and jiggled and tickled inside her" T) + (tsa "bird" "Now how absurd") + (tsa "cat" "Now fancy that") + (tsa "dog" "what a hog") + (asa "goat" "She just opened her throat") + (ssa "cow" "I don't know how") + (verse "horse" "She's dead, of course!" T T)))) + + (loop for verse in verses for i from 0 doing + (let ((it (what verse))) + (format t "I know an old lady who swallowed a ~a~%" it) + (format t "~a~%" (remark verse)) + (if (not (die verse)) (progn + (if (> i 0) + (loop for j from (1- i) downto 0 doing + (let* ((v (nth j verses))) + (format t "She swallowed the ~a to catch the ~a~%" it (what v)) + (setf it (what v)) + (if (always v) + (format t "~a~a~%" (if (= j 0) "But " "") (remark v)))))) + (format t "Perhaps she'll die. ~%~%")))))) diff --git a/Task/Old-lady-swallowed-a-fly/Elena/old-lady-swallowed-a-fly.elena b/Task/Old-lady-swallowed-a-fly/Elena/old-lady-swallowed-a-fly.elena new file mode 100644 index 0000000000..96783962bc --- /dev/null +++ b/Task/Old-lady-swallowed-a-fly/Elena/old-lady-swallowed-a-fly.elena @@ -0,0 +1,37 @@ +#import system. +#import extensions. + +#symbol Creatures = ("fly", "spider", "bird", "cat", "dog", "goat", "cow", "horse"). +#symbol Comments = +( + "I don't know why she swallowed that fly"#10"Perhaps she'll die", + "That wiggled and jiggled and tickled inside her", + "How absurd, to swallow a bird", + "Imagine that. She swallowed a cat", + "What a hog to swallow a dog", + "She just opened her throat and swallowed that goat", + "I don't know how she swallowed that cow", + "She's dead of course" +). + +#symbol program = +[ + 0 till:(Creatures length) &doEach: i + [ + console + writeLine:"There was an old lady who swallowed a {0}" &args:(Creatures@i) + writeLine:(Comments@i). + + ((i != 0)&&(i != Creatures length - 1))? + [ + i till:0 &by:1 &doEach:j + [ + console writeLine:"She swallowed the {0} to catch the {1}" &args:(Creatures@j):(Creatures@(j - 1)). + ]. + + console writeLine:(Comments@0). + ]. + + console writeLine. + ]. +]. diff --git a/Task/Old-lady-swallowed-a-fly/Elixir/old-lady-swallowed-a-fly.elixir b/Task/Old-lady-swallowed-a-fly/Elixir/old-lady-swallowed-a-fly.elixir new file mode 100644 index 0000000000..1b960aa99e --- /dev/null +++ b/Task/Old-lady-swallowed-a-fly/Elixir/old-lady-swallowed-a-fly.elixir @@ -0,0 +1,48 @@ +defmodule Old_lady do + @descriptions [ + fly: "I don't know why S", + spider: "That wriggled and jiggled and tickled inside her.", + bird: "Quite absurd T", + cat: "Fancy that, S", + dog: "What a hog, S", + goat: "She opened her throat T", + cow: "I don't know how S", + horse: "She's dead, of course.", + ] + + def swallowed do + {descriptions, animals} = setup(@descriptions) + Enum.each(Enum.with_index(animals), fn {animal, idx} -> + IO.puts "There was an old lady who swallowed a #{animal}." + IO.puts descriptions[animal] + if animal == :horse, do: exit(:normal) + if idx > 0 do + Enum.each(idx..1, fn i -> + IO.puts "She swallowed the #{Enum.at(animals,i)} to catch the #{Enum.at(animals,i-1)}." + case Enum.at(animals,i-1) do + :spider -> IO.puts descriptions[:spider] + :fly -> IO.puts descriptions[:fly] + _ -> :ok + end + end) + end + IO.puts "Perhaps she'll die.\n" + end) + end + + def setup(descriptions) do + animals = Keyword.keys(descriptions) + descs = Enum.reduce(animals, descriptions, fn animal, acc -> + Keyword.update!(acc, animal, fn d -> + case String.last(d) do + "S" -> String.replace(d, ~r/S$/, "she swallowed a #{animal}.") + "T" -> String.replace(d, ~r/T$/, "to swallow a #{animal}.") + _ -> d + end + end) + end) + {descs, animals} + end +end + +Old_lady.swallowed diff --git a/Task/Old-lady-swallowed-a-fly/Frege/old-lady-swallowed-a-fly.frege b/Task/Old-lady-swallowed-a-fly/Frege/old-lady-swallowed-a-fly.frege index 9f0d8e10ae..b367fc2ed3 100644 --- a/Task/Old-lady-swallowed-a-fly/Frege/old-lady-swallowed-a-fly.frege +++ b/Task/Old-lady-swallowed-a-fly/Frege/old-lady-swallowed-a-fly.frege @@ -36,6 +36,6 @@ verse' ((anim, act, phrase):restAnims) prevAnim = in lns ++ verse' restAnims anim song :: [String] -song = intercalate [""] $ map verse $ tail $ reverse $ tails animals +song = concatMap verse $ tail $ reverse $ tails animals -main _ = printStr $ unlines song +main = putStr $ unlines song diff --git a/Task/Old-lady-swallowed-a-fly/Haskell/old-lady-swallowed-a-fly.hs b/Task/Old-lady-swallowed-a-fly/Haskell/old-lady-swallowed-a-fly.hs index 277f54a613..c0b828aa7c 100644 --- a/Task/Old-lady-swallowed-a-fly/Haskell/old-lady-swallowed-a-fly.hs +++ b/Task/Old-lady-swallowed-a-fly/Haskell/old-lady-swallowed-a-fly.hs @@ -1,4 +1,4 @@ -#!/usr/bin/runhaskell +#!/usr/bin/env runhaskell import Data.List @@ -36,6 +36,6 @@ verse' ((anim, act, phrase):restAnims) prevAnim = in lns ++ verse' restAnims anim song :: [String] -song = intercalate [""] $ map verse $ tail $ reverse $ tails animals +song = concatMap verse $ tail $ reverse $ tails animals main = putStr $ unlines song diff --git a/Task/Old-lady-swallowed-a-fly/Maple/old-lady-swallowed-a-fly.maple b/Task/Old-lady-swallowed-a-fly/Maple/old-lady-swallowed-a-fly.maple new file mode 100644 index 0000000000..332ae67647 --- /dev/null +++ b/Task/Old-lady-swallowed-a-fly/Maple/old-lady-swallowed-a-fly.maple @@ -0,0 +1,19 @@ +swallowed := ["fly", "spider", "bird", "cat", "dog", "cow", "horse"]: +phrases := ["I don't know why she swallowed a fly, perhaps she'll die!", + "That wriggled and wiggled and tiggled inside her.", + "How absurd to swallow a bird.", + "Fancy that to swallow a cat!", + "What a hog, to swallow a dog.", + "I don't know how she swallowed a cow.", + "She's dead, of course."]: +for i to numelems(swallowed) do + printf("There was an old lady who swallowed a %s.\n%s\n", swallowed[i], phrases[i]); + if i > 1 and i < 7 then + for j from i by -1 to 2 do + printf("\tShe swallowed the %s to catch the %s.\n", swallowed[j], swallowed[j-1]); + end do; + printf("%s\n\n", phrases[1]); + elif i = 1 then + printf("\n"); + end if; +end do; diff --git a/Task/Old-lady-swallowed-a-fly/Perl-6/old-lady-swallowed-a-fly.pl6 b/Task/Old-lady-swallowed-a-fly/Perl-6/old-lady-swallowed-a-fly.pl6 index d967810325..b6226284bb 100644 --- a/Task/Old-lady-swallowed-a-fly/Perl-6/old-lady-swallowed-a-fly.pl6 +++ b/Task/Old-lady-swallowed-a-fly/Perl-6/old-lady-swallowed-a-fly.pl6 @@ -10,7 +10,7 @@ my @victims = my @history = "I guess she'll die...\n"; -for @victims».kv -> $victim, $_ is copy { +for (flat @victims».kv) -> $victim, $_ is copy { say "There was an old lady who swallowed a $victim..."; s/ «S» /she swallowed the $victim/; diff --git a/Task/One-dimensional-cellular-automata/AWK/one-dimensional-cellular-automata.awk b/Task/One-dimensional-cellular-automata/AWK/one-dimensional-cellular-automata-1.awk similarity index 100% rename from Task/One-dimensional-cellular-automata/AWK/one-dimensional-cellular-automata.awk rename to Task/One-dimensional-cellular-automata/AWK/one-dimensional-cellular-automata-1.awk diff --git a/Task/One-dimensional-cellular-automata/AWK/one-dimensional-cellular-automata-2.awk b/Task/One-dimensional-cellular-automata/AWK/one-dimensional-cellular-automata-2.awk new file mode 100644 index 0000000000..0b7dfe72de --- /dev/null +++ b/Task/One-dimensional-cellular-automata/AWK/one-dimensional-cellular-automata-2.awk @@ -0,0 +1,43 @@ +Another new solution (twice size as previous solution) : +cat automata.awk : + +#!/usr/local/bin/gawk -f + +# User defined functions +function ASCII_to_Binary(str_) { + gsub("_","0",str_); gsub("@","1",str_) + return str_ +} + +function Binary_to_ASCII(bit_) { + gsub("0","_",bit_); gsub("1","@",bit_) + return bit_ +} + +function automate(b1,b2,b3) { + a = and(b1,b2,b3) + b = or(b1,b2,b3) + c = xor(b1,b2,b3) + d = a + b + c + return d == 1 ? 1 : 0 +} + +# For each line in input do +{ +str_ = $0 +gen = 0 +taille = length(str_) +print "0: " str_ +do { + gen ? str_previous = str_ : str_previous = "" + gen += 1 + str_ = ASCII_to_Binary(str_) + split(str_,tab,"") + str_ = and(tab[1],tab[2]) + for (i=1; i<=taille-2; i++) { + str_ = str_ automate(tab[i],tab[i+1],tab[i+2]) + } + str_ = str_ and(tab[taille-1],tab[taille]) + print gen ": " Binary_to_ASCII(str_) + } while (str_ != str_previous) +} diff --git a/Task/One-dimensional-cellular-automata/Perl-6/one-dimensional-cellular-automata-1.pl6 b/Task/One-dimensional-cellular-automata/Perl-6/one-dimensional-cellular-automata-1.pl6 index 76e167eb4d..d7dcca5e87 100644 --- a/Task/One-dimensional-cellular-automata/Perl-6/one-dimensional-cellular-automata-1.pl6 +++ b/Task/One-dimensional-cellular-automata/Perl-6/one-dimensional-cellular-automata-1.pl6 @@ -1,14 +1,17 @@ -class Automata { - has ($.rule, @.cells); - method gist { <| |>.join: @!cells.map({$_ ?? '#' !! ' '}).join } - method code { $.rule.fmt("%08b").comb.reverse } +class Automaton { + has $.rule; + has @.cells; + has @.code = $!rule.fmt('%08b').flip.comb».Int; + + method gist { "|{ @!cells.map({+$_ ?? '#' !! ' '}).join }|" } + method succ { - self.new: :$.rule, :cells( - self.code[ - [Z+] 4 «*« @.cells.rotate(-1), - 2 «*« @.cells, - @.cells.rotate(1) - ] - ) + self.new: :$!rule, :@!code, :cells( + @!code[ + 4 «*« @!cells.rotate(-1) + »+« 2 «*« @!cells + »+« @!cells.rotate(1) + ] + ) } } diff --git a/Task/One-dimensional-cellular-automata/Perl-6/one-dimensional-cellular-automata-2.pl6 b/Task/One-dimensional-cellular-automata/Perl-6/one-dimensional-cellular-automata-2.pl6 index 0eecb411bc..fbe6700ffa 100644 --- a/Task/One-dimensional-cellular-automata/Perl-6/one-dimensional-cellular-automata-2.pl6 +++ b/Task/One-dimensional-cellular-automata/Perl-6/one-dimensional-cellular-automata-2.pl6 @@ -1,5 +1,6 @@ -my $size = 10; -my Automata $a .= new: - :rule(104), - :cells( 0 xx $size div 2, '111011010101'.comb, 0 xx $size div 2 ); +my @padding = 0 xx 5; +my Automaton $a .= new: + rule => 104, + cells => flat @padding, '111011010101'.comb, @padding +; say $a++ for ^10; diff --git a/Task/One-dimensional-cellular-automata/Perl-6/one-dimensional-cellular-automata-3.pl6 b/Task/One-dimensional-cellular-automata/Perl-6/one-dimensional-cellular-automata-3.pl6 index 40de91d1b0..ed7219580a 100644 --- a/Task/One-dimensional-cellular-automata/Perl-6/one-dimensional-cellular-automata-3.pl6 +++ b/Task/One-dimensional-cellular-automata/Perl-6/one-dimensional-cellular-automata-3.pl6 @@ -1,4 +1,4 @@ -my $size = 50; -my Automata $a .= new: :rule(90), :cells( 0 xx $size div 2, 1, 0 xx $size div 2 ); +my @padding = 0 xx 25; +my Automaton $a .= new: :rule(90), :cells(flat @padding, 1, @padding); say $a++ for ^20; diff --git a/Task/One-dimensional-cellular-automata/PureBasic/one-dimensional-cellular-automata.purebasic b/Task/One-dimensional-cellular-automata/PureBasic/one-dimensional-cellular-automata.purebasic index 3d79f77f06..8210ffe5cf 100644 --- a/Task/One-dimensional-cellular-automata/PureBasic/one-dimensional-cellular-automata.purebasic +++ b/Task/One-dimensional-cellular-automata/PureBasic/one-dimensional-cellular-automata.purebasic @@ -25,7 +25,7 @@ Repeat nG(n)=0 EndIf Next - Swap cG() , nG() + CopyArray(nG(), cG()) Until Gen > 9 PrintN("Press any key to exit"): Repeat: Until Inkey() <> "" diff --git a/Task/One-dimensional-cellular-automata/REXX/one-dimensional-cellular-automata.rexx b/Task/One-dimensional-cellular-automata/REXX/one-dimensional-cellular-automata.rexx index 80864463d9..60b5d1c8d7 100644 --- a/Task/One-dimensional-cellular-automata/REXX/one-dimensional-cellular-automata.rexx +++ b/Task/One-dimensional-cellular-automata/REXX/one-dimensional-cellular-automata.rexx @@ -1,15 +1,16 @@ -/*REXX program displays N generations of one-dimensional cellular automata.*/ -parse arg $ gens .; if $=='' | $==',' then $=001110110101010 /*use default?*/ - if gens=='' then gens=40 /* " " */ - L=length($)-1 /*adjusted len*/ - do #=0 for gens /*process gens*/ - say " generation" right(#,length(gens)) ' ' translate($,"#·",10) - @=0 /*+ generation*/ - do j=2 for L; x=substr($,j-1,3) /*obtain cell.*/ - if x==011 | x==101 | x==110 then @=overlay(1,@,j) /*cell lives. */ - else @=overlay(0,@,j) /*cell death. */ - end /*j*/ - if $==@ then do; say right('repeats',40); leave; end /*it repeats? */ - $=@ /*now use the next generation of cells.*/ - end /*#*/ - /*stick a fork in it, we're all done. */ +/*REXX program generates & displays N generations of one─dimensional cellular automata. */ +parse arg $ gens . /*obtain optional arguments from the CL*/ +if $=='' | $=="," then $=001110110101010 /*Not specified? Then use the default.*/ +if gens=='' | gens=="," then gens=40 /* " " " " " " */ + + do #=0 for gens /* process the one-dimensional cells.*/ + say " generation" right(#,length(gens)) ' ' translate($, "#·", 10) + @=0 /* [↓] generation.*/ + do j=2 for length($) - 1; x=substr($, j-1, 3) /*obtain the cell.*/ + if x==011 | x==101 | x==110 then @=overlay(1, @, j) /*the cell lives. */ + else @=overlay(0, @, j) /* " " dies. */ + end /*j*/ + + if $==@ then do; say right('repeats', 40); leave; end /*does it repeat? */ + $=@ /*now use the next generation of cells.*/ + end /*#*/ /*stick a fork in it, we're all done. */ diff --git a/Task/One-of-n-lines-in-a-file/Elixir/one-of-n-lines-in-a-file.elixir b/Task/One-of-n-lines-in-a-file/Elixir/one-of-n-lines-in-a-file.elixir new file mode 100644 index 0000000000..fd172c2423 --- /dev/null +++ b/Task/One-of-n-lines-in-a-file/Elixir/one-of-n-lines-in-a-file.elixir @@ -0,0 +1,18 @@ +defmodule One_of_n_lines_in_file do + def task do + dict = Enum.reduce(1..1000000, %{}, fn _,acc -> + Map.update( acc, one_of_n(10), 1, &(&1+1) ) + end) + Enum.each(Enum.sort(Map.keys(dict)), fn x -> + :io.format "Line ~2w selected: ~6w~n", [x, dict[x]] + end) + end + + def one_of_n( n ), do: loop( n, 2, :rand.uniform, 1 ) + + def loop( max, n, _random, acc ) when n == max + 1, do: acc + def loop( max, n, random, _acc ) when random < (1/n), do: loop( max, n + 1, :rand.uniform, n ) + def loop( max, n, _random, acc ), do: loop( max, n + 1, :rand.uniform, acc ) +end + +One_of_n_lines_in_file.task diff --git a/Task/One-of-n-lines-in-a-file/PARI-GP/one-of-n-lines-in-a-file.pari b/Task/One-of-n-lines-in-a-file/PARI-GP/one-of-n-lines-in-a-file.pari new file mode 100644 index 0000000000..cca9c9ae62 --- /dev/null +++ b/Task/One-of-n-lines-in-a-file/PARI-GP/one-of-n-lines-in-a-file.pari @@ -0,0 +1,8 @@ +one_of_n(n)={ + my(chosen=1); + for(k=2,n, + if(random(k)==0, chosen=k) + ); + chosen; +} +v=vector(10); for(i=1,1e6, v[one_of_n(10)]++); v diff --git a/Task/One-of-n-lines-in-a-file/PowerShell/one-of-n-lines-in-a-file.psh b/Task/One-of-n-lines-in-a-file/PowerShell/one-of-n-lines-in-a-file.psh new file mode 100644 index 0000000000..6280c3c37e --- /dev/null +++ b/Task/One-of-n-lines-in-a-file/PowerShell/one-of-n-lines-in-a-file.psh @@ -0,0 +1,32 @@ +function Get-OneOfN ([int]$Number) +{ + $current = 1 + + for ($i = 2; $i -le $Number; $i++) + { + $limit = 1 / $i + + if ((Get-Random -Minimum 0.0 -Maximum 1.0) -lt $limit) + { + $current = $i + } + } + + $current +} + + +$table = [ordered]@{} + +for ($i = 1; $i -lt 11; $i++) +{ + $table.Add(("Line {0,2}" -f $i), 0) +} + +for ($i = 0; $i -lt 1000000; $i++) +{ + $index = (Get-OneOfN -Number 10) - 1 + $table[$index] = $table[$index] + 1 +} + +[PSCustomObject]$table diff --git a/Task/One-of-n-lines-in-a-file/Rust/one-of-n-lines-in-a-file.rust b/Task/One-of-n-lines-in-a-file/Rust/one-of-n-lines-in-a-file.rust new file mode 100644 index 0000000000..d778b94048 --- /dev/null +++ b/Task/One-of-n-lines-in-a-file/Rust/one-of-n-lines-in-a-file.rust @@ -0,0 +1,23 @@ +extern crate rand; + +use rand::Rng; + +fn one_of_n(rng: &mut rand::ThreadRng, n: usize) -> usize { + (1..n).fold(0, |keep, cand| + match rng.next_f64() { + y if y < (1.0 / (cand + 1) as f64) => cand, + _ => keep + } + ) +} + +fn main() { + let mut dist = [0usize; 10]; + let mut rng = rand::thread_rng(); + + for _ in 0..1_000_000 { + dist[one_of_n(&mut rng, 10)] += 1; + } + + println!("{:?}", dist); +} diff --git a/Task/Operator-precedence/00DESCRIPTION b/Task/Operator-precedence/00DESCRIPTION index 7af115e570..76b9b10db4 100644 --- a/Task/Operator-precedence/00DESCRIPTION +++ b/Task/Operator-precedence/00DESCRIPTION @@ -1,4 +1,10 @@ {{wikipedia|Operators in C and C++}} -Provide a list of [[wp:order of operations|precedence]] and [[wp:operator associativity|associativity]] of all the operators and constructs that the language utilizes in descending order of precedence such that an operator which is listed on some row will be evaluated prior to any operator that is listed on a row further below it. Operators that are in the same cell (there may be several rows of operators listed in a cell) are evaluated with the same level of precedence, in the given direction. -Stating whether arguments are passed by value or by reference + +;Task: +Provide a list of   [[wp:order of operations|precedence]]   and   [[wp:operator associativity|associativity]]   of all the operators and constructs that the language utilizes in descending order of precedence such that an operator which is listed on some row will be evaluated prior to any operator that is listed on a row further below it. + +Operators that are in the same cell (there may be several rows of operators listed in a cell) are evaluated with the same level of precedence, in the given direction. + +State whether arguments are passed by value or by reference. +

    diff --git a/Task/Operator-precedence/00META.yaml b/Task/Operator-precedence/00META.yaml new file mode 100644 index 0000000000..df58a6932c --- /dev/null +++ b/Task/Operator-precedence/00META.yaml @@ -0,0 +1,3 @@ +--- +category: +- Simple diff --git a/Task/Optional-parameters/00DESCRIPTION b/Task/Optional-parameters/00DESCRIPTION index 70534fd7d2..b6acbd7409 100644 --- a/Task/Optional-parameters/00DESCRIPTION +++ b/Task/Optional-parameters/00DESCRIPTION @@ -1,3 +1,4 @@ +;Task: Define a function/method/subroutine which sorts a sequence ("table") of sequences ("rows") of strings ("cells"), by one of the strings. Besides the input to be sorted, it shall have the following optional parameters: :{| | @@ -17,3 +18,4 @@ Do not implement a sorting algorithm; this task is about the interface. If you c See also: * [[Named Arguments]] +

    diff --git a/Task/Optional-parameters/ALGOL-68/optional-parameters.alg b/Task/Optional-parameters/ALGOL-68/optional-parameters.alg new file mode 100644 index 0000000000..516994e614 --- /dev/null +++ b/Task/Optional-parameters/ALGOL-68/optional-parameters.alg @@ -0,0 +1,35 @@ +# as the options have distinct types (INT, BOOL and PROC( STRING, STRING )INT) the # +# easiest way to support these optional parameters in Algol 68 would be to have an array # +# with elements of these types # +# See the Named Arguments sample for cases where the option types are not distinct # + +# default comparison function # +PROC default compare = ( STRING a, b )INT: IF a < b THEN -1 ELIF a = b THEN 0 ELSE 1 FI; + +# sorting procedure # +PROC configurable sort = ( [,]STRING data, []UNION( INT, BOOL, PROC( STRING, STRING )INT ) options )VOID: +BEGIN + # set initial values for the options # + INT sort column := 2 LWB data; + BOOL reverse sort := FALSE; + PROC( STRING, STRING )INT comparator := default compare; + # overide from the supplied options # + FOR opt pos FROM LWB options TO UPB options DO + CASE options[ opt pos ] + IN ( PROC( STRING, STRING )INT p ): comparator := p + , ( INT c ): sort column := c + , ( BOOL r ): reverse sort := r + ESAC + OD + # do the sort .... # +END # configurable sort # ; + +# example calls # +[ 1 : 2, 1 : 3 ]STRING data := ( ( "a", "bb", "cde" ), ( "x", "abcdef", "Q" ) ); + +# sort data, default comparison, first column, reverse order # +configurable sort( data, ( TRUE ) ); +# sort data, second column, ignore first chaacter when sorting, normal order # +configurable sort( data, ( 2, ( STRING a, STRING b )INT: default compare( a[ LWB a + 1 : ], b[ LWB b + 1 : ] ) ) ); +# default sort # +configurable sort( data, () ) diff --git a/Task/Optional-parameters/Elixir/optional-parameters.elixir b/Task/Optional-parameters/Elixir/optional-parameters.elixir new file mode 100644 index 0000000000..f794dda463 --- /dev/null +++ b/Task/Optional-parameters/Elixir/optional-parameters.elixir @@ -0,0 +1,31 @@ +defmodule Optional_parameters do + def sort( table, options\\[] ) do + options = options ++ [ ordering: :lexicographic, column: 0, reverse: false ] + ordering = options[ :ordering ] + column = options[ :column ] + reverse = options[ :reverse ] + sorted = sort( table, ordering, column ) + if reverse, do: Enum.reverse( sorted ), else: sorted + end + + defp sort( table, :lexicographic, column ) do + Enum.sort_by( table, &elem( &1, column ) ) + end + defp sort( table, :numeric, column ) do + Enum.sort_by( table, &elem( &1, column ) |> String.to_integer ) + end + + def task do + table = [ { "123", "456", "0789" }, + { "456", "0789", "123" }, + { "0789", "123", "456" } ] + IO.write "sort defaults "; IO.inspect sort( table ) + IO.write " & reverse "; IO.inspect sort( table, reverse: true ) + IO.write "sort column 2 "; IO.inspect sort( table, column: 2) + IO.write " & reverse "; IO.inspect sort( table, column: 2, reverse: true) + IO.write "sort numeric "; IO.inspect sort( table, ordering: :numeric) + IO.write " & reverse "; IO.inspect sort( table, ordering: :numeric, reverse: true) + end +end + +Optional_parameters.task diff --git a/Task/Optional-parameters/Lua/optional-parameters.lua b/Task/Optional-parameters/Lua/optional-parameters.lua new file mode 100644 index 0000000000..577cf0328a --- /dev/null +++ b/Task/Optional-parameters/Lua/optional-parameters.lua @@ -0,0 +1,43 @@ +function showTable(tbl) + if type(tbl)=='table' then + local result = {} + for _, val in pairs(tbl) do + table.insert(result, showTable(val)) + end + return '{' .. table.concat(result, ', ') .. '}' + else + return (tostring(tbl)) + end +end + +function sortTable(op) + local tbl = op.table or {} + local column = op.column or 1 + local reverse = op.reverse or false + local cmp = op.cmp or (function (a, b) return a < b end) + local compareTables = function (a, b) + local result = cmp(a[column], b[column]) + if reverse then return not result else return result end + end + table.sort(tbl, compareTables) +end + +A = {{"quail", "deer", "snake"}, + {"dalmation", "bear", "fox"}, + {"ant", "cougar", "coyote"}} +print('original', showTable(A)) + +sortTable{table=A} +print('defaults', showTable(A)) + +sortTable{table=A, column=2} +print('col 2 ', showTable(A)) + +sortTable{table=A, column=3} +print('col 3 ', showTable(A)) + +sortTable{table=A, column=3, reverse=true} +print('col 3 rev', showTable(A)) + +sortTable{table=A, cmp=(function (a, b) return #a < #b end)} +print('by length', showTable(A)) diff --git a/Task/Order-disjoint-list-items/00DESCRIPTION b/Task/Order-disjoint-list-items/00DESCRIPTION index c6f61b3b6a..424c842cd0 100644 --- a/Task/Order-disjoint-list-items/00DESCRIPTION +++ b/Task/Order-disjoint-list-items/00DESCRIPTION @@ -1,27 +1,39 @@ -Given M as a list of items and another list N of items chosen from M, create M' as a list with the ''first'' occurrences of items from N sorted to be in one of the set of indices of their original occurrence in M but in the order given by their order in N. That is, items in N are taken from M without replacement, then the corresponding positions in M' are filled by successive items from N. +Given   M   as a list of items and another list   N   of items chosen from   M,   create   M'   as a list with the ''first'' occurrences of items from   N   sorted to be in one of the set of indices of their original occurrence in   M   but in the order given by their order in   N. -For example: -:if M is 'the cat sat on the mat' -:And N is 'mat cat' -:Then the result M' is 'the mat sat on the cat'. -The words not in N are left in their original positions. +That is, items in   N   are taken from   M   without replacement, then the corresponding positions in   M'   are filled by successive items from   N. -If there are duplications then only the first instances in M up to as many as are mentioned in N are potentially re-ordered. -For example: -:M = 'A B C A B C A B C' -:N = 'C A C A' +;For example: +:if   M   is   'the cat sat on the mat' +:And   N   is   'mat cat' +:Then the result   M'   is   'the mat sat on the cat'. + +The words not in   N   are left in their original positions. + + +If there are duplications then only the first instances in   M   up to as many as are mentioned in   N   are potentially re-ordered. + + +;For example: +: M = 'A B C A B C A B C' +: N = 'C A C A' + Is ordered as: -:M' = 'C B A C B A A B C' +: M' = 'C B A C B A A B C' +
    Show the output, here, for at least the following inputs: -
    Data M: 'the cat sat on the mat' Order N: 'mat cat'
    +
    +Data M: 'the cat sat on the mat' Order N: 'mat cat'
     Data M: 'the cat sat on the mat' Order N: 'cat mat'
     Data M: 'A B C A B C A B C'      Order N: 'C A C A'
     Data M: 'A B C A B D A B E'      Order N: 'E A D A'
     Data M: 'A B'                    Order N: 'B'
     Data M: 'A B'                    Order N: 'B A'
    -Data M: 'A B B A'                Order N: 'B A'
    +Data M: 'A B B A' Order N: 'B A' +
    + ;Cf: * [[Sort disjoint sublist]] +

    diff --git a/Task/Order-disjoint-list-items/AppleScript/order-disjoint-list-items.applescript b/Task/Order-disjoint-list-items/AppleScript/order-disjoint-list-items.applescript new file mode 100644 index 0000000000..7b64ff17e6 --- /dev/null +++ b/Task/Order-disjoint-list-items/AppleScript/order-disjoint-list-items.applescript @@ -0,0 +1,290 @@ +-- disjointOrder :: String -> String -> String +on disjointOrder(m, n) + set {ms, ns} to map(my |words|, {m, n}) + + unwords(flatten(zip(segments(ms, ns), ns & ""))) +end disjointOrder + +-- segments :: [String] -> [String] -> [String] +on segments(ms, ns) + script segmentation + on lambda(a, x) + set wds to |words| of a + + if wds contains x then + {parts:(parts of a) & [current of a], current:[], |words|:deleteFirst(x, wds)} + else + {parts:(parts of a), current:(current of a) & x, |words|:wds} + end if + end lambda + end script + + tell foldl(segmentation, {|words|:ns, parts:[], current:[]}, ms) + (parts of it) & [current of it] + end tell +end segments + + +-- TEST -------------------------------------------------------------------------------------- +on run + script order + on lambda(rec) + tell rec + [its m, its n, my disjointOrder(its m, its n)] + end tell + end lambda + end script + + arrowTable(map(order, [¬ + {m:"the cat sat on the mat", n:"mat cat"}, ¬ + {m:"the cat sat on the mat", n:"cat mat"}, ¬ + {m:"A B C A B C A B C", n:"C A C A"}, ¬ + {m:"A B C A B D A B E", n:"E A D A"}, ¬ + {m:"A B", n:"B"}, {m:"A B", n:"B A"}, ¬ + {m:"A B B A", n:"B A"}])) + +-- the cat sat on the mat -> mat cat -> the mat sat on the cat +-- the cat sat on the mat -> cat mat -> the cat sat on the mat +-- A B C A B C A B C -> C A C A -> C B A C B A A B C +-- A B C A B D A B E -> E A D A -> E B C A B D A B A +-- A B -> B -> A B +-- A B -> B A -> B A +-- A B B A -> B A -> B A B A + +end run + + +-- GENERIC FUNCTIONS ---------------------------------------------------------------------- + +-- Formatting test results + +-- arrowTable :: [[String]] -> String +on arrowTable(rows) + + script leftAligned + script width + on lambda(a, b) + (length of a) - (length of b) + end lambda + end script + + on lambda(col) + set widest to length of maximumBy(width, col) + + script padding + on lambda(s) + justifyLeft(widest, space, s) + end lambda + end script + + map(padding, col) + end lambda + end script + + script arrows + on lambda(row) + intercalate(" -> ", row) + end lambda + end script + + intercalate(linefeed, ¬ + map(arrows, ¬ + transpose(map(leftAligned, transpose(rows))))) + +end arrowTable + +-- transpose :: [[a]] -> [[a]] +on transpose(xss) + script column + on lambda(_, iCol) + script row + on lambda(xs) + item iCol of xs + end lambda + end script + + map(row, xss) + end lambda + end script + + map(column, item 1 of xss) +end transpose + +-- justifyLeft :: Int -> Char -> Text -> Text +on justifyLeft(n, cFiller, strText) + if n > length of strText then + text 1 thru n of (strText & replicate(n, cFiller)) + else + strText + end if +end justifyLeft + +-- maximumBy :: (a -> a -> Ordering) -> [a] -> a +on maximumBy(f, xs) + set cmp to mReturn(f) + script max + on lambda(a, b) + if a is missing value or cmp's lambda(a, b) < 0 then + b + else + a + end if + end lambda + end script + + foldl(max, missing value, xs) +end maximumBy + +-- Egyptian multiplication - progressively doubling a list, appending +-- stages of doubling to an accumulator where needed for binary +-- assembly of a target length + +-- replicate :: Int -> a -> [a] +on replicate(n, a) + set out to {} + if n < 1 then return out + set dbl to {a} + + repeat while (n > 1) + if (n mod 2) > 0 then set out to out & dbl + set n to (n div 2) + set dbl to (dbl & dbl) + end repeat + return out & dbl +end replicate + +-- List functions + +-- 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 + +-- 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 + +-- zip :: [a] -> [b] -> [(a, b)] +on zip(xs, ys) + script pair + on lambda(x, i) + [x, item i of ys] + end lambda + end script + + map(pair, items 1 thru minimum([length of xs, length of ys]) of xs) +end zip + +-- flatten :: Tree a -> [a] +on flatten(t) + if class of t is list then + concatMap(my flatten, t) + else + t + end if +end flatten + +-- concatMap :: (a -> [b]) -> [a] -> [b] +on concatMap(f, xs) + script append + on lambda(a, b) + a & b + end lambda + end script + + foldl(append, {}, map(f, xs)) +end concatMap + +-- 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 + +-- deleteFirst :: a -> [a] -> [a] +on deleteFirst(x, xs) + script Eq + on lambda(a, b) + a = b + end lambda + end script + + deleteBy(Eq, x, xs) +end deleteFirst + +-- minimum :: [a] -> a +on minimum(xs) + script min + on lambda(a, x) + if x < a or a is missing value then + x + else + a + end if + end lambda + end script + + foldl(min, missing value, xs) +end minimum + +-- deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a] +on deleteBy(fnEq, x, xs) + if length of xs > 0 then + set {h, t} to uncons(xs) + if lambda(x, h) of mReturn(fnEq) then + t + else + {h} & deleteBy(fnEq, x, t) + end if + else + {} + end if +end deleteBy + +-- uncons :: [a] -> Maybe (a, [a]) +on uncons(xs) + if length of xs > 0 then + {item 1 of xs, rest of xs} + else + missing value + end if +end uncons + +-- unwords :: [String] -> String +on unwords(xs) + intercalate(space, xs) +end unwords + +-- intercalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate + +-- words :: String -> [String] +on |words|(s) + words of s +end |words| diff --git a/Task/Order-disjoint-list-items/Elixir/order-disjoint-list-items.elixir b/Task/Order-disjoint-list-items/Elixir/order-disjoint-list-items.elixir new file mode 100644 index 0000000000..e6c845cd37 --- /dev/null +++ b/Task/Order-disjoint-list-items/Elixir/order-disjoint-list-items.elixir @@ -0,0 +1,39 @@ +defmodule Order do + def disjoint(m,n) do + IO.write "#{Enum.join(m," ")} | #{Enum.join(n," ")} -> " + Enum.chunk(n,2) + |> Enum.reduce({m,0}, fn [x,y],{m,from} -> + md = Enum.drop(m, from) + if x > y and x in md and y in md do + if Enum.find_index(md,&(&1==x)) > Enum.find_index(md,&(&1==y)) do + new_from = max(Enum.find_index(m,&(&1==x)), Enum.find_index(m,&(&1==y))) + 1 + m = swap(m,from,x,y) + from = new_from + end + end + {m,from} + end) + |> elem(0) + |> Enum.join(" ") + |> IO.puts + end + + defp swap(m,from,x,y) do + ix = Enum.find_index(m,&(&1==x)) + from + iy = Enum.find_index(m,&(&1==y)) + from + vx = Enum.at(m,ix) + vy = Enum.at(m,iy) + m |> List.replace_at(ix,vy) |> List.replace_at(iy,vx) + end +end + +[ {"the cat sat on the mat", "mat cat"}, + {"the cat sat on the mat", "cat mat"}, + {"A B C A B C A B C" , "C A C A"}, + {"A B C A B D A B E" , "E A D A"}, + {"A B" , "B"}, + {"A B" , "B A"}, + {"A B B A" , "B A"} ] +|> Enum.each(fn {m,n} -> + Order.disjoint(String.split(m),String.split(n)) + end) diff --git a/Task/Order-disjoint-list-items/Haskell/order-disjoint-list-items-1.hs b/Task/Order-disjoint-list-items/Haskell/order-disjoint-list-items-1.hs new file mode 100644 index 0000000000..540670cd69 --- /dev/null +++ b/Task/Order-disjoint-list-items/Haskell/order-disjoint-list-items-1.hs @@ -0,0 +1,16 @@ +import Data.List + +order::Ord a => [[a]] -> [a] +order [ms,ns] = snd.mapAccumL yu ls $ ks + where + ks = zip ms [(0::Int)..] + ls = zip ns.sort.snd.foldl go (sort ns,[]).sort $ ks + yu ((u,v):us) (_,y) | v == y = (us,u) + yu ys (x,_) = (ys,x) + go ((u:us),ys) (x,y) | u == x = (us,y:ys) + go ts _ = ts + +task ls@[ms,ns] = do + putStrLn $ "M: " ++ ms ++ " | N: " ++ ns ++ " |> " ++ (unwords.order.map words $ ls) + +main = mapM_ task [["the cat sat on the mat","mat cat"],["the cat sat on the mat","cat mat"],["A B C A B C A B C","C A C A"],["A B C A B D A B E","E A D A"],["A B","B"],["A B","B A"],["A B B A","B A"]] diff --git a/Task/Order-disjoint-list-items/Haskell/order-disjoint-list-items-2.hs b/Task/Order-disjoint-list-items/Haskell/order-disjoint-list-items-2.hs new file mode 100644 index 0000000000..91414608c1 --- /dev/null +++ b/Task/Order-disjoint-list-items/Haskell/order-disjoint-list-items-2.hs @@ -0,0 +1,44 @@ +import Prelude hiding (unlines, unwords, words, length) +import Data.List (delete, transpose) +import Data.Text hiding (concat, zipWith, foldl, transpose, maximum) + + +disjointOrder :: Eq a => [a] -> [a] -> [a] +disjointOrder m n = concat $ zipWith (++) ms ns + where + ms = segments m n + ns = ((:[]) <$> n) ++ [[]] -- as list of lists, lengthened by 1 + + segments :: Eq a => [a] -> [a] -> [[a]] + segments m n = _m ++ [_acc] + where + (_m, _, _acc) = foldl split ([], n, []) m + + split :: Eq a => ([[a]],[a],[a]) -> a -> ([[a]],[a],[a]) + split (ms, ns, acc) x + | elem x ns = (ms ++ [acc], delete x ns, []) + | otherwise = (ms, ns, acc ++ [x]) + + +-- TEST ----------------------------------------------------------- + +tests :: [(Text, Text)] +tests = (\(a, b) -> (pack a, pack b)) <$> + [("the cat sat on the mat","mat cat"), + ("the cat sat on the mat","cat mat"), + ("A B C A B C A B C","C A C A"), + ("A B C A B D A B E","E A D A"), + ("A B","B"), + ("A B","B A"), + ("A B B A","B A")] + +table :: Text -> [[Text]] -> Text +table delim rows = unlines $ (\r -> (intercalate delim r)) + <$> (transpose $ (\col -> + let width = (length $ maximum col) + in (justifyLeft width ' ') <$> col) <$> transpose rows) + +main :: IO () +main = putStr $ unpack $ table (pack " -> ") $ + (\(m, n) -> [m, n, unwords (disjointOrder (words m) (words n))]) + <$> tests diff --git a/Task/Order-disjoint-list-items/JavaScript/order-disjoint-list-items.js b/Task/Order-disjoint-list-items/JavaScript/order-disjoint-list-items.js new file mode 100644 index 0000000000..d8ba07595a --- /dev/null +++ b/Task/Order-disjoint-list-items/JavaScript/order-disjoint-list-items.js @@ -0,0 +1,150 @@ +(() => { + 'use strict'; + + // GENERIC FUNCTIONS + + // concatMap :: (a -> [b]) -> [a] -> [b] + const concatMap = (f, xs) => [].concat.apply([], xs.map(f)); + + // deleteFirst :: a -> [a] -> [a] + const deleteFirst = (x, xs) => + xs.length > 0 ? ( + x === xs[0] ? ( + xs.slice(1) + ) : [xs[0]].concat(deleteFirst(x, xs.slice(1))) + ) : []; + + // flatten :: Tree a -> [a] + const flatten = t => (t instanceof Array ? concatMap(flatten, t) : [t]); + + // unwords :: [String] -> String + const unwords = xs => xs.join(' '); + + // words :: String -> [String] + const words = s => s.split(/\s+/); + + // 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])); + }; + + //------------------------------------------------------------------------ + + // ORDER DISJOINT LIST ITEMS + + // disjointOrder :: [String] -> [String] -> [String] + const disjointOrder = (ms, ns) => + flatten( + zipWith( + (a, b) => a.concat(b), + segments(ms, ns), + ns.concat('') + ) + ); + + // segments :: [String] -> [String] -> [String] + const segments = (ms, ns) => { + const dct = ms.reduce((a, x) => { + const wds = a.words, + blnFound = wds.indexOf(x) !== -1; + + return { + parts: a.parts.concat(blnFound ? [a.current] : []), + current: blnFound ? [] : a.current.concat(x), + words: blnFound ? deleteFirst(x, wds) : wds, + }; + }, { + words: ns, + parts: [], + current: [] + }); + + return dct.parts.concat([dct.current]); + }; + + // ----------------------------------------------------------------------- + // FORMATTING TEST OUTPUT + + // transpose :: [[a]] -> [[a]] + const transpose = xs => + xs[0].map((_, iCol) => xs.map((row) => row[iCol])); + + // maximumBy :: (a -> a -> Ordering) -> [a] -> a + const maximumBy = (f, xs) => + xs.reduce((a, x) => a === undefined ? x : ( + f(x, a) > 0 ? x : a + ), undefined); + + // 2 or more arguments + // curry :: Function -> Function + const curry = (f, ...args) => { + const intArgs = f.length, + go = xs => + xs.length >= intArgs ? ( + f.apply(null, xs) + ) : function () { + return go(xs.concat([].slice.apply(arguments))); + }; + return go([].slice.call(args, 1)); + }; + + // justifyLeft :: Int -> Char -> Text -> Text + const justifyLeft = (n, cFiller, strText) => + n > strText.length ? ( + (strText + replicateS(n, cFiller)) + .substr(0, n) + ) : strText; + + // replicateS :: Int -> String -> String + const replicateS = (n, s) => { + let v = s, + o = ''; + if (n < 1) return o; + while (n > 1) { + if (n & 1) o = o.concat(v); + n >>= 1; + v = v.concat(v); + } + return o.concat(v); + }; + + // ----------------------------------------------------------------------- + + // TEST + return transpose(transpose([{ + M: 'the cat sat on the mat', + N: 'mat cat' + }, { + M: 'the cat sat on the mat', + N: 'cat mat' + }, { + M: 'A B C A B C A B C', + N: 'C A C A' + }, { + M: 'A B C A B D A B E', + N: 'E A D A' + }, { + M: 'A B', + N: 'B' + }, { + M: 'A B', + N: 'B A' + }, { + M: 'A B B A', + N: 'B A' + }].map(dct => [ + dct.M, dct.N, + unwords(disjointOrder(words(dct.M), words(dct.N))) + ])) + .map(col => { + const width = maximumBy((a, b) => a.length > b.length, col) + .length; + return col.map(curry(justifyLeft)(width, ' ')); + })) + .map( + ([a, b, c]) => a + ' -> ' + b + ' -> ' + c + ) + .join('\n'); +})(); diff --git a/Task/Order-disjoint-list-items/Lua/order-disjoint-list-items.lua b/Task/Order-disjoint-list-items/Lua/order-disjoint-list-items.lua new file mode 100644 index 0000000000..b4db79d145 --- /dev/null +++ b/Task/Order-disjoint-list-items/Lua/order-disjoint-list-items.lua @@ -0,0 +1,42 @@ +-- Split str on any space characters and return as a table +function split (str) + local t = {} + for word in str:gmatch("%S+") do table.insert(t, word) end + return t +end + +-- Order disjoint list items +function orderList (dataStr, orderStr) + local data, order = split(dataStr), split(orderStr) + for orderPos, orderWord in pairs(order) do + for dataPos, dataWord in pairs(data) do + if dataWord == orderWord then + data[dataPos] = false + break + end + end + end + local orderPos = 1 + for dataPos, dataWord in pairs(data) do + if not dataWord then + data[dataPos] = order[orderPos] + orderPos = orderPos + 1 + if orderPos > #order then return data end + end + end + return data +end + +-- Main procedure +local testCases = { + {'the cat sat on the mat', 'mat cat'}, + {'the cat sat on the mat', 'cat mat'}, + {'A B C A B C A B C' , 'C A C A'}, + {'A B C A B D A B E' , 'E A D A'}, + {'A B' , 'B'}, + {'A B' , 'B A'}, + {'A B B A' , 'B A'} +} +for _, example in pairs(testCases) do + print(table.concat(orderList(unpack(example)), " ")) +end diff --git a/Task/Order-disjoint-list-items/PicoLisp/order-disjoint-list-items-1.l b/Task/Order-disjoint-list-items/PicoLisp/order-disjoint-list-items-1.l new file mode 100644 index 0000000000..27376cee13 --- /dev/null +++ b/Task/Order-disjoint-list-items/PicoLisp/order-disjoint-list-items-1.l @@ -0,0 +1,6 @@ +(de orderDisjoint (M N) + (for S N + (and (memq S M) (set @ NIL)) ) + (mapcar + '((S) (or S (pop 'N))) + M ) ) diff --git a/Task/Order-disjoint-list-items/PicoLisp/order-disjoint-list-items-2.l b/Task/Order-disjoint-list-items/PicoLisp/order-disjoint-list-items-2.l new file mode 100644 index 0000000000..c16b224cf5 --- /dev/null +++ b/Task/Order-disjoint-list-items/PicoLisp/order-disjoint-list-items-2.l @@ -0,0 +1,20 @@ +: (orderDisjoint '(the cat sat on the mat) '(mat cat)) +-> (the mat sat on the cat) + +: (orderDisjoint '(the cat sat on the mat) '(cat mat)) +-> (the cat sat on the mat) + +: (orderDisjoint '(A B C A B C A B C) '(C A C A)) +-> (C B A C B A A B C) + +: (orderDisjoint '(A B C A B D A B E) '(E A D A)) +-> (E B C A B D A B A) + +: (orderDisjoint '(A B) '(B)) +-> (A B) + +: (orderDisjoint '(A B) '(B A)) +-> (B A) + +: (orderDisjoint '(A B B A) '(B A)) +-> (B A B A) diff --git a/Task/Order-disjoint-list-items/REXX/order-disjoint-list-items.rexx b/Task/Order-disjoint-list-items/REXX/order-disjoint-list-items.rexx index 437e3b13ad..a4769d2252 100644 --- a/Task/Order-disjoint-list-items/REXX/order-disjoint-list-items.rexx +++ b/Task/Order-disjoint-list-items/REXX/order-disjoint-list-items.rexx @@ -1,49 +1,45 @@ -/*REXX program orders a disjoint list of M items with a list of N items.*/ -used = '0'x /*indicates that a word has been parsed*/ -@. = /*placeholder indicates end─of─array, */ -@.1 = " the cat sat on the mat | mat cat " /*a string. */ -@.2 = " the cat sat on the mat | cat mat " /*" " */ -@.3 = " A B C A B C A B C | C A C A " /*" " */ -@.4 = " A B C A B D A B E | E A D A " /*" " */ -@.5 = " A B | B " /*" " */ -@.6 = " A B | B A " /*" " */ -@.7 = " A B B A | B A " /*" " */ -@.8 = " | " /*" " */ -@.9 = " A | A " /*" " */ -@.10 = " A B | " /*" " */ -@.11 = " A B B A | A B " /*" " */ -@.12 = " A B A B | A B " /*" " */ -@.13 = " A B A B | B A B A " /*" " */ -@.14 = " A B C C B A | A C A C " /*" " */ -@.15 = " A B C C B A | C A C A " /*" " */ - /* ════════════M═══════════ ════N════ */ - /* [↓] process each input strings. */ - do j=1 while @.j\==''; r.= /*nullify the replacement string [R.] */ - parse var @.j m '|' n /*parse input string into M and N. */ - #=words(m) /*#: number of words in the M list.*/ - do i=# for # by -1 /*process list items in reverse order. */ - _=word(m,i) /*obtain a soecific word from the list.*/ - !.i=_; $._=i /*construct the !. and $. arrays.*/ +/*REXX program orders a disjoint list of M items with a list of N items. */ +used = '0'x /*indicates that a word has been parsed*/ +@. = /*placeholder indicates end─of─array, */ +@.1 = " the cat sat on the mat | mat cat " /*a string. */ +@.2 = " the cat sat on the mat | cat mat " /*" " */ +@.3 = " A B C A B C A B C | C A C A " /*" " */ +@.4 = " A B C A B D A B E | E A D A " /*" " */ +@.5 = " A B | B " /*" " */ +@.6 = " A B | B A " /*" " */ +@.7 = " A B B A | B A " /*" " */ +@.8 = " | " /*" " */ +@.9 = " A | A " /*" " */ +@.10 = " A B | " /*" " */ +@.11 = " A B B A | A B " /*" " */ +@.12 = " A B A B | A B " /*" " */ +@.13 = " A B A B | B A B A " /*" " */ +@.14 = " A B C C B A | A C A C " /*" " */ +@.15 = " A B C C B A | C A C A " /*" " */ + /* ════════════M═══════════ ════N════ */ + /* [↓] process each input strings. */ + do j=1 while @.j\==''; r.= /*nullify the replacement string [R.] */ + parse var @.j m '|' n /*parse input string into M and N. */ + #=words(m) /*#: number of words in the M list.*/ + do i=# for # by -1 /*process list items in reverse order. */ + _=word(m,i); !.i=_; $._=i /*construct the !. and $. arrays.*/ end /*i*/ - do k=1 for words(n)%2 by 2 /* [↓] process the N array. */ - _=word(n,k); v=word(n,k+1) /*get an order word and the replacement*/ - p1=wordpos(_,m); p2=wordpos(v,m) /*positions of " " " " */ - if p1==0 | p2==0 then iterate /*if either not found, then skip them. */ + do k=1 for words(n)%2 by 2 /* [↓] process the N array. */ + _=word(n,k); v=word(n,k+1) /*get an order word and the replacement*/ + p1=wordpos(_,m); p2=wordpos(v,m) /*positions of " " " " */ + if p1==0 | p2==0 then iterate /*if either not found, then skip them. */ + if $._>>$.v then do; r.p2=!.p1; r.p1=!.p2; end /*switch the words.*/ + else do; r.p1=!.p1; r.p2=!.p2; end /*don't switch. */ + !.p1=used; !.p2=used /*mark 'em as used.*/ + m= + do i=1 for #; m=m !.i; _=word(m,i); !.i=_; $._=i; end /*i*/ + end /*k*/ /* [↑] rebuild the !. and $. arrays.*/ + mp= /*the MP (aka M') string (so far). */ + do q=1 for #; if !.q==used then mp=mp r.q /*use the original.*/ + else mp=mp !.q /*use substitute. */ + end /*q*/ /* [↑] re─build the (output) string. */ - if $._>>$.v then do; r.p2=!.p1; r.p1=!.p2; end /*switch the words.*/ - else do; r.p1=!.p1; r.p2=!.p2; end /*don't switch. */ - - !.p1=used; !.p2=used /*mark 'em as used.*/ - m= - do i=1 for #; m=m !.i; _=word(m,i); !.i=_; $._=i; end - end /*k*/ /* [↑] rebuild the !. and $. arrays.*/ - - mp= /*the MP (aka M') string (so far). */ - do q=1 for #; if !.q==used then mp=mp r.q /*use the original.*/ - else mp=mp !.q /*use substitute. */ - end /*q*/ /* [↑] re─build the (output) string. */ - - say @.j '───►' space(mp) /*display new re─ordered text ──► term.*/ - end /*j*/ /* [↑] end of processing for N words*/ - /*stick a fork in it, we're all done. */ + say @.j '───►' space(mp) /*display new re─ordered text ──► term.*/ + end /*j*/ /* [↑] end of processing for N words*/ + /*stick a fork in it, we're all done. */ diff --git a/Task/Order-disjoint-list-items/Ruby/order-disjoint-list-items.rb b/Task/Order-disjoint-list-items/Ruby/order-disjoint-list-items.rb index 1b5434597a..952e659c93 100644 --- a/Task/Order-disjoint-list-items/Ruby/order-disjoint-list-items.rb +++ b/Task/Order-disjoint-list-items/Ruby/order-disjoint-list-items.rb @@ -1,24 +1,25 @@ -[ -'the cat sat on the mat', 'mat cat', -'the cat sat on the mat', 'cat mat', -'A B C A B C A B C' , 'C A C A', -'A B C A B D A B E' , 'E A D A', -'A B' , 'B', -'A B' , 'B A', -'A B B A' , 'B A' -].each_slice(2) do |s, o| - s, o = s.split, o.split - print [s, '|' , o, ' -> '].join(' ') +def order_disjoint(m,n) + print "#{m} | #{n} -> " + m, n = m.split, n.split from = 0 - o.each_slice(2) do |x, y| + n.each_slice(2) do |x,y| next unless y - if x > y && (s[from..-1].include? x) && (s[from..-1].include? y) - new_from = [s.index(x), s.index(y)].max+1 - if s[from..-1].index(x) > s[from..-1].index(y) - s[s.index(x)+from], s[s.index(y)+from] = s[s.index(y)+from], s[s.index(x)+from] - from = new_from - end + sd = m[from..-1] + if x > y && (sd.include? x) && (sd.include? y) && (sd.index(x) > sd.index(y)) + new_from = m.index(x)+1 + m[m.index(x)+from], m[m.index(y)+from] = m[m.index(y)+from], m[m.index(x)+from] + from = new_from end end - puts s.join(' ') + puts m.join(' ') end + +[ + ['the cat sat on the mat', 'mat cat'], + ['the cat sat on the mat', 'cat mat'], + ['A B C A B C A B C' , 'C A C A'], + ['A B C A B D A B E' , 'E A D A'], + ['A B' , 'B' ], + ['A B' , 'B A' ], + ['A B B A' , 'B A' ] +].each {|m,n| order_disjoint(m,n)} diff --git a/Task/Order-two-numerical-lists/AppleScript/order-two-numerical-lists-1.applescript b/Task/Order-two-numerical-lists/AppleScript/order-two-numerical-lists-1.applescript new file mode 100644 index 0000000000..55da79c93d --- /dev/null +++ b/Task/Order-two-numerical-lists/AppleScript/order-two-numerical-lists-1.applescript @@ -0,0 +1,44 @@ +-- <= for lists +-- compare :: [a] -> [a] -> Bool +on compare(xs, ys) + if length of xs = 0 then + true + else + if length of ys = 0 then + false + else + set {hx, txs} to uncons(xs) + set {hy, tys} to uncons(ys) + + if hx = hy then + compare(txs, tys) + else + hx < hy + end if + end if + end if +end compare + + + +-- TEST +on run + + {compare([1, 2, 1, 3, 2], [1, 2, 0, 4, 4, 0, 0, 0]), ¬ + compare([1, 2, 0, 4, 4, 0, 0, 0], [1, 2, 1, 3, 2])} + +end run + + +--------------------------------------------------------------------------- + +-- GENERIC FUNCTION + +-- uncons :: [a] -> Maybe (a, [a]) +on uncons(xs) + if length of xs > 0 then + {item 1 of xs, rest of xs} + else + missing value + end if +end uncons diff --git a/Task/Order-two-numerical-lists/AppleScript/order-two-numerical-lists-2.applescript b/Task/Order-two-numerical-lists/AppleScript/order-two-numerical-lists-2.applescript new file mode 100644 index 0000000000..49b4696be3 --- /dev/null +++ b/Task/Order-two-numerical-lists/AppleScript/order-two-numerical-lists-2.applescript @@ -0,0 +1 @@ +{false, true} diff --git a/Task/Order-two-numerical-lists/Elixir/order-two-numerical-lists.elixir b/Task/Order-two-numerical-lists/Elixir/order-two-numerical-lists.elixir new file mode 100644 index 0000000000..ff69f86c51 --- /dev/null +++ b/Task/Order-two-numerical-lists/Elixir/order-two-numerical-lists.elixir @@ -0,0 +1,4 @@ +iex(1)> [1,2,3] < [1,2,3,4] +true +iex(2)> [1,2,3] < [1,2,4] +true diff --git a/Task/Order-two-numerical-lists/JavaScript/order-two-numerical-lists-1.js b/Task/Order-two-numerical-lists/JavaScript/order-two-numerical-lists-1.js new file mode 100644 index 0000000000..ff942271cc --- /dev/null +++ b/Task/Order-two-numerical-lists/JavaScript/order-two-numerical-lists-1.js @@ -0,0 +1,17 @@ +(() => { + 'use strict'; + + // <= is already defined for lists in JS + + // compare :: [a] -> [a] -> Bool + const compare = (xs, ys) => xs <= ys; + + + // TEST + return [ + compare([1, 2, 1, 3, 2], [1, 2, 0, 4, 4, 0, 0, 0]), + compare([1, 2, 0, 4, 4, 0, 0, 0], [1, 2, 1, 3, 2]) + ]; + + // --> [false, true] +})() diff --git a/Task/Order-two-numerical-lists/JavaScript/order-two-numerical-lists-2.js b/Task/Order-two-numerical-lists/JavaScript/order-two-numerical-lists-2.js new file mode 100644 index 0000000000..cb579368cf --- /dev/null +++ b/Task/Order-two-numerical-lists/JavaScript/order-two-numerical-lists-2.js @@ -0,0 +1 @@ +[false, true] diff --git a/Task/Order-two-numerical-lists/Perl-6/order-two-numerical-lists.pl6 b/Task/Order-two-numerical-lists/Perl-6/order-two-numerical-lists.pl6 index 8789069768..226694a186 100644 --- a/Task/Order-two-numerical-lists/Perl-6/order-two-numerical-lists.pl6 +++ b/Task/Order-two-numerical-lists/Perl-6/order-two-numerical-lists.pl6 @@ -11,7 +11,7 @@ say @a," before ",@b," = ", @a before @b; say @a," before ",@b," = ", @a before @b; for 1..10 { - my @a = (^100).roll((2..3).pick); - my @b = @a.map: { Bool.pick ?? $_ !! (^100).roll((0..2).pick) } + my @a = flat (^100).roll((2..3).pick); + my @b = flat @a.map: { Bool.pick ?? $_ !! (^100).roll((0..2).pick) } say @a," before ",@b," = ", @a before @b; } diff --git a/Task/Order-two-numerical-lists/Perl/order-two-numerical-lists.pl b/Task/Order-two-numerical-lists/Perl/order-two-numerical-lists.pl index eb5ece4143..2de1a362c0 100644 --- a/Task/Order-two-numerical-lists/Perl/order-two-numerical-lists.pl +++ b/Task/Order-two-numerical-lists/Perl/order-two-numerical-lists.pl @@ -1,36 +1,38 @@ -#!/usr/bin/perl -w -use strict ; +use strict; +use warnings; sub orderlists { - my $firstlist = shift ; - my $secondlist = shift ; - my $first = shift @{$firstlist } if @{$firstlist} ; - my $second ; -#keep stripping elements from the first list as long as there are any -#or until the second list is used up! - while ( @{$firstlist} ) { - if ( @{$secondlist} ) { #second list is not used up yet! - $second = shift @{$secondlist} ; - if ( $first < $second ) { - return 1 ; - } - if ( $first > $second ) { - return 0 ; - } - } - else { #second list used up, defined to return false - return 0 ; - } - $first = shift @{$firstlist} ; - } - return 0 ; #in all remaining cases return false + my ($firstlist, $secondlist) = @_; + + my ($first, $second); + while (@{$firstlist}) { + $first = shift @{$firstlist}; + if (@{$secondlist}) { + $second = shift @{$secondlist}; + if ($first < $second) { + return 1; + } + if ($first > $second) { + return 0; + } + } + else { + return 0; + } + } + + @{$secondlist} ? 1 : 0; } -my @firstnumbers = ( 43 , 33 , 2 ) ; -my @secondnumbers = ( 45 ) ; -if ( orderlists( \@firstnumbers , \@secondnumbers ) ) { - print "The first list comes before the second list!\n" ; -} -else { - print "The first list does not come before the second list!\n" ; +foreach my $pair ( + [[1, 2, 4], [1, 2, 4]], + [[1, 2, 4], [1, 2, ]], + [[1, 2, ], [1, 2, 4]], + [[55,53,1], [55,62,83]], + [[20,40,51],[20,17,78,34]], +) { + my $first = $pair->[0]; + my $second = $pair->[1]; + my $before = orderlists([@$first], [@$second]) ? 'true' : 'false'; + print "(@$first) comes before (@$second) : $before\n"; } diff --git a/Task/Order-two-numerical-lists/PowerShell/order-two-numerical-lists-1.psh b/Task/Order-two-numerical-lists/PowerShell/order-two-numerical-lists-1.psh new file mode 100644 index 0000000000..1a04ed4774 --- /dev/null +++ b/Task/Order-two-numerical-lists/PowerShell/order-two-numerical-lists-1.psh @@ -0,0 +1,9 @@ +function order($as,$bs) { + if($as -and $bs) { + $a, $as = $as + $b, $bs = $bs + if($a -eq $b) {order $as $bs} + else{$a -lt $b} + } elseif ($bs) {$true} else {$false} +} +"$(order @(1,2,1,3,2) @(1,2,0,4,4,0,0,0))" diff --git a/Task/Order-two-numerical-lists/PowerShell/order-two-numerical-lists-2.psh b/Task/Order-two-numerical-lists/PowerShell/order-two-numerical-lists-2.psh new file mode 100644 index 0000000000..57d68bb0b4 --- /dev/null +++ b/Task/Order-two-numerical-lists/PowerShell/order-two-numerical-lists-2.psh @@ -0,0 +1,16 @@ +function Test-Order ([int[]]$ReferenceArray, [int[]]$DifferenceArray) +{ + for ($i = 0; $i -lt $ReferenceArray.Count; $i++) + { + if ($ReferenceArray[$i] -lt $DifferenceArray[$i]) + { + return $true + } + elseif ($ReferenceArray[$i] -gt $DifferenceArray[$i]) + { + return $false + } + } + + return ($ReferenceArray.Count -lt $DifferenceArray.Count) -or (Compare-Object $ReferenceArray $DifferenceArray) -eq $null +} diff --git a/Task/Order-two-numerical-lists/PowerShell/order-two-numerical-lists-3.psh b/Task/Order-two-numerical-lists/PowerShell/order-two-numerical-lists-3.psh new file mode 100644 index 0000000000..1d74bcd01d --- /dev/null +++ b/Task/Order-two-numerical-lists/PowerShell/order-two-numerical-lists-3.psh @@ -0,0 +1,5 @@ +Test-Order -ReferenceArray 1, 2, 1, 3, 2 -DifferenceArray 1, 2, 0, 4, 4, 0, 0, 0 +Test-Order -ReferenceArray 1, 2, 1, 3, 2 -DifferenceArray 1, 2, 2, 4, 4, 0, 0, 0 +Test-Order -ReferenceArray 1, 2, 3 -DifferenceArray 1, 2 +Test-Order -ReferenceArray 1, 2 -DifferenceArray 1, 2, 3 +Test-Order -ReferenceArray 1, 2 -DifferenceArray 1, 2 diff --git a/Task/Ordered-Partitions/Elixir/ordered-partitions.elixir b/Task/Ordered-Partitions/Elixir/ordered-partitions.elixir new file mode 100644 index 0000000000..b5465d2b4a --- /dev/null +++ b/Task/Ordered-Partitions/Elixir/ordered-partitions.elixir @@ -0,0 +1,30 @@ +defmodule Ordered do + def partition([]), do: [[]] + def partition(mask) do + sum = Enum.sum(mask) + if sum == 0 do + [Enum.map(mask, fn _ -> [] end)] + else + Enum.to_list(1..sum) + |> permute + |> Enum.reduce([], fn perm,acc -> + {_, part} = Enum.reduce(mask, {perm,[]}, fn num,{pm,a} -> + {p, rest} = Enum.split(pm, num) + {rest, [Enum.sort(p) | a]} + end) + [Enum.reverse(part) | acc] + end) + |> Enum.uniq + end + end + + defp permute([]), do: [[]] + defp permute(list), do: for x <- list, y <- permute(list -- [x]), do: [x|y] +end + +Enum.each([[],[0,0,0],[1,1,1],[2,0,2]], fn test_case -> + IO.puts "\npartitions #{inspect test_case}:" + Enum.each(Ordered.partition(test_case), fn part -> + IO.inspect part + end) +end) diff --git a/Task/Ordered-Partitions/J/ordered-partitions-3.j b/Task/Ordered-Partitions/J/ordered-partitions-3.j new file mode 100644 index 0000000000..32a5922d8d --- /dev/null +++ b/Task/Ordered-Partitions/J/ordered-partitions-3.j @@ -0,0 +1,22 @@ + +/\. 2 0 2 +4 2 2 + ({@comb&.> +/\.) 2 0 2 +┌─────────────────────────┬──┬─────┐ +│┌───┬───┬───┬───┬───┬───┐│┌┐│┌───┐│ +││0 1│0 2│0 3│1 2│1 3│2 3││││││0 1││ +│└───┴───┴───┴───┴───┴───┘│└┘│└───┘│ +└─────────────────────────┴──┴─────┘ + >@,@{@({@comb&.> +/\.) 2 0 2 +┌───┬┬───┐ +│0 1││0 1│ +├───┼┼───┤ +│0 2││0 1│ +├───┼┼───┤ +│0 3││0 1│ +├───┼┼───┤ +│1 2││0 1│ +├───┼┼───┤ +│1 3││0 1│ +├───┼┼───┤ +│2 3││0 1│ +└───┴┴───┘ diff --git a/Task/Ordered-Partitions/J/ordered-partitions-4.j b/Task/Ordered-Partitions/J/ordered-partitions-4.j new file mode 100644 index 0000000000..93bc1fa0d1 --- /dev/null +++ b/Task/Ordered-Partitions/J/ordered-partitions-4.j @@ -0,0 +1,12 @@ + ([,] {L:0 (i.@#@, -. [)&;)/0 1;0 1 +┌───┬───┐ +│0 1│2 3│ +└───┴───┘ + ([,] {L:0 (i.@#@, -. [)&;)/0 1;0 1;0 1 +┌───┬───┬───┐ +│0 1│2 3│4 5│ +└───┴───┴───┘ + ([,] {L:0 (i.@#@, -. [)&;)/0 1;0 1;0 1;0 1 +┌───┬───┬───┬───┐ +│0 1│2 3│4 5│6 7│ +└───┴───┴───┴───┘ diff --git a/Task/Ordered-Partitions/J/ordered-partitions-5.j b/Task/Ordered-Partitions/J/ordered-partitions-5.j new file mode 100644 index 0000000000..fa34084f10 --- /dev/null +++ b/Task/Ordered-Partitions/J/ordered-partitions-5.j @@ -0,0 +1,4 @@ + (<0 1) ([,] {L:0 (i.@#@, -. [)&;)0 1;2 3;4 5 +┌───┬───┬───┬───┐ +│0 1│2 3│4 5│6 7│ +└───┴───┴───┴───┘ diff --git a/Task/Ordered-Partitions/JavaScript/ordered-partitions-1.js b/Task/Ordered-Partitions/JavaScript/ordered-partitions-1.js new file mode 100644 index 0000000000..a379c82f34 --- /dev/null +++ b/Task/Ordered-Partitions/JavaScript/ordered-partitions-1.js @@ -0,0 +1,61 @@ +(function () { + 'use strict'; + + // [n] -> [[[n]]] + function partitions(a1, a2, a3) { + var n = a1 + a2 + a3; + + return combos(range(1, n), n, [a1, a2, a3]); + } + + function combos(s, n, xxs) { + if (!xxs.length) return [[]]; + + var x = xxs[0], + xs = xxs.slice(1); + + return mb( choose(s, n, x), function (l_rest) { + return mb( combos(l_rest[1], (n - x), xs), function (r) { + // monadic return/injection requires 1 additional + // layer of list nesting: + return [ [l_rest[0]].concat(r) ]; + + })}); + } + + function choose(aa, n, m) { + if (!m) return [[[], aa]]; + + var a = aa[0], + as = aa.slice(1); + + return n === m ? ( + [[aa, []]] + ) : ( + choose(as, n - 1, m - 1).map(function (xy) { + return [[a].concat(xy[0]), xy[1]]; + }).concat(choose(as, n - 1, m).map(function (xy) { + return [xy[0], [a].concat(xy[1])]; + })) + ); + } + + // GENERIC + + // Monadic bind (chain) for lists + function mb(xs, f) { + return [].concat.apply([], xs.map(f)); + } + + // [m..n] + function range(m, n) { + return Array.apply(null, Array(n - m + 1)).map(function (x, i) { + return m + i; + }); + } + + // EXAMPLE + + return partitions(2, 0, 2); + +})(); diff --git a/Task/Ordered-Partitions/JavaScript/ordered-partitions-2.js b/Task/Ordered-Partitions/JavaScript/ordered-partitions-2.js new file mode 100644 index 0000000000..5589352ea0 --- /dev/null +++ b/Task/Ordered-Partitions/JavaScript/ordered-partitions-2.js @@ -0,0 +1,6 @@ +[[[1, 2], [], [3, 4]], + [[1, 3], [], [2, 4]], + [[1, 4], [], [2, 3]], + [[2, 3], [], [1, 4]], + [[2, 4], [], [1, 3]], + [[3, 4], [], [1, 2]]] diff --git a/Task/Ordered-words/00DESCRIPTION b/Task/Ordered-words/00DESCRIPTION index 47f3b6df13..40db134ac4 100644 --- a/Task/Ordered-words/00DESCRIPTION +++ b/Task/Ordered-words/00DESCRIPTION @@ -1,3 +1,17 @@ -Define an ordered word as a word in which the letters of the word appear in alphabetic order. Examples include 'abbey' and 'dirt'. +An   ''ordered word''   is a word in which the letters appear in alphabetic order. -The task is to find ''and display'' all the ordered words in this [http://www.puzzlers.org/pub/wordlists/unixdict.txt dictionary] that have the longest word length. (Examples that access the dictionary file locally assume that you have downloaded this file yourself.) The display needs to be shown on this page. +Examples include   '''abbey'''   and   '''dirt'''. + +{{task heading}} + +Find ''and display'' all the ordered words in the dictionary   [http://www.puzzlers.org/pub/wordlists/unixdict.txt unixdict.txt]   that have the longest word length. + +(Examples that access the dictionary file locally assume that you have downloaded this file yourself.) + +The display needs to be shown on this page. + +{{task heading|Related tasks}} + +{{Related tasks/Word plays}} + +
    diff --git a/Task/Ordered-words/ALGOL-68/ordered-words.alg b/Task/Ordered-words/ALGOL-68/ordered-words.alg new file mode 100644 index 0000000000..842c41a063 --- /dev/null +++ b/Task/Ordered-words/ALGOL-68/ordered-words.alg @@ -0,0 +1,83 @@ +# find the longrst words in a list that have all letters in order # +# use the associative array in the Associate array/iteration task # +PR read "aArray.a68" PR + +# returns the length of word # +PROC length = ( STRING word )INT: 1 + ( UPB word - LWB word ); + +# returns text with the characters sorted into ascending order # +PROC char sort = ( STRING text )STRING: + BEGIN + STRING sorted := text; + FOR end pos FROM UPB sorted - 1 BY -1 TO LWB sorted + WHILE + BOOL swapped := FALSE; + FOR pos FROM LWB sorted TO end pos DO + IF sorted[ pos ] > sorted[ pos + 1 ] + THEN + CHAR t := sorted[ pos ]; + sorted[ pos ] := sorted[ pos + 1 ]; + sorted[ pos + 1 ] := t; + swapped := TRUE + FI + OD; + swapped + DO SKIP OD; + sorted + END # char sort # ; + +# read the list of words and store the ordered ones in an associative array # + +IF FILE input file; + STRING file name = "unixdict.txt"; + open( input file, file name, stand in channel ) /= 0 +THEN + # failed to open the file # + print( ( "Unable to open """ + file name + """", newline ) ) +ELSE + # file opened OK # + BOOL at eof := FALSE; + # set the EOF handler for the file # + on logical file end( input file, ( REF FILE f )BOOL: + BEGIN + # note that we reached EOF on the # + # latest read # + at eof := TRUE; + # return TRUE so processing can continue # + TRUE + END + ); + # store the ordered words and find the longest # + INT max length := 0; + REF AARRAY words := INIT LOC AARRAY; + STRING word; + WHILE NOT at eof + DO + STRING word; + get( input file, ( word, newline ) ); + IF char sort( word ) = word + THEN + # have an ordered word # + IF INT word length := length( word ); + word length > max length + THEN + max length := word length + FI; + # store the word # + words // word := "" + FI + OD; + # close the file # + close( input file ); + + print( ( "Maximum length of ordered words: ", whole( max length, -4 ), newline ) ); + # show the ordered words with the maximum length # + REF AAELEMENT e := FIRST words; + WHILE e ISNT nil element DO + IF max length = length( key OF e ) + THEN + print( ( key OF e, newline ) ) + FI; + e := NEXT words + OD +FI diff --git a/Task/Ordered-words/Io/ordered-words.io b/Task/Ordered-words/Io/ordered-words.io new file mode 100644 index 0000000000..bc33bbce6d --- /dev/null +++ b/Task/Ordered-words/Io/ordered-words.io @@ -0,0 +1,17 @@ +file := File clone openForReading("./unixdict.txt") +words := file readLines +file close + +maxLen := 0 +orderedWords := list() +words foreach(word, + if( (word size >= maxLen) and (word == (word asMutable sort)), + if( word size > maxLen, + maxLen = word size + orderedWords empty + ) + orderedWords append(word) + ) +) + +orderedWords join(" ") println diff --git a/Task/Ordered-words/Kotlin/ordered-words.kotlin b/Task/Ordered-words/Kotlin/ordered-words.kotlin new file mode 100644 index 0000000000..c062fcf096 --- /dev/null +++ b/Task/Ordered-words/Kotlin/ordered-words.kotlin @@ -0,0 +1,21 @@ +import java.io.File + +fun main(args: Array) { + val file = File("unixdict.txt") + val result = mutableListOf() + + file.forEachLine { + if (it.toCharArray().sorted().joinToString(separator = "") == it) { + result += it + } + } + + result.sortByDescending { it.length } + val max = result[0].length + + for (word in result) { + if (word.length == max) { + println(word) + } + } +} diff --git a/Task/Ordered-words/PARI-GP/ordered-words.pari b/Task/Ordered-words/PARI-GP/ordered-words.pari new file mode 100644 index 0000000000..9da0c84d4a --- /dev/null +++ b/Task/Ordered-words/PARI-GP/ordered-words.pari @@ -0,0 +1,4 @@ +ordered(s)=my(v=Vecsmall(s),t=97);for(i=1,#v,if(v[i]>64&&v[i]<91,v[i]+=32);if(v[i]<97||v[i]>122||v[i]#s==N, v) diff --git a/Task/Ordered-words/Perl-6/ordered-words.pl6 b/Task/Ordered-words/Perl-6/ordered-words.pl6 index 3813d048ca..3475fedd11 100644 --- a/Task/Ordered-words/Perl-6/ordered-words.pl6 +++ b/Task/Ordered-words/Perl-6/ordered-words.pl6 @@ -1 +1 @@ -say .value given max :by(*.key), classify *.chars, grep { [le] .comb }, lines; +say lines.grep({ [le] .comb }).classify(*.chars).max(*.key).value diff --git a/Task/Ordered-words/PowerShell/ordered-words.psh b/Task/Ordered-words/PowerShell/ordered-words.psh new file mode 100644 index 0000000000..35e0d6b768 --- /dev/null +++ b/Task/Ordered-words/PowerShell/ordered-words.psh @@ -0,0 +1,16 @@ +$url = 'http://www.puzzlers.org/pub/wordlists/unixdict.txt' + +(New-Object System.Net.WebClient).DownloadFile($url, "$env:TEMP\unixdict.txt") + +$ordered = Get-Content -Path "$env:TEMP\unixdict.txt" | + ForEach-Object {if (($_.ToCharArray() | Sort-Object) -join '' -eq $_) {$_}} | + Group-Object -Property Length | + Sort-Object -Property Name | + Select-Object -Property @{Name="WordCount" ; Expression={$_.Count}}, + @{Name="WordLength"; Expression={[int]$_.Name}}, + @{Name="Words" ; Expression={$_.Group}} -Last 1 + +"There are {0} ordered words of the longest word length ({1} characters):`n`n{2}" -f $ordered.WordCount, + $ordered.WordLength, + ($ordered.Words -join ", ") +Remove-Item -Path "$env:TEMP\unixdict.txt" -Force -ErrorAction SilentlyContinue diff --git a/Task/Ordered-words/PureBasic/ordered-words.purebasic b/Task/Ordered-words/PureBasic/ordered-words.purebasic index 52f37ad50f..a80a3b6e25 100644 --- a/Task/Ordered-words/PureBasic/ordered-words.purebasic +++ b/Task/Ordered-words/PureBasic/ordered-words.purebasic @@ -25,10 +25,13 @@ If OpenConsole() orderedWords()\length = Len(word) EndIf Wend + Else + MessageRequester("Error", "Unable to find dictionary '" + filename + "'") + End EndIf - SortStructuredList(orderedWords(), #PB_Sort_Ascending, OffsetOf(orderedWord\word), #PB_Sort_String) - SortStructuredList(orderedWords(), #PB_Sort_Descending, OffsetOf(orderedWord\length), #PB_Sort_integer) + SortStructuredList(orderedWords(), #PB_Sort_Ascending, OffsetOf(orderedWord\word), #PB_String) + SortStructuredList(orderedWords(), #PB_Sort_Descending, OffsetOf(orderedWord\length), #PB_Integer) Define maxLength FirstElement(orderedWords()) maxLength = orderedWords()\length diff --git a/Task/Ordered-words/REXX/ordered-words.rexx b/Task/Ordered-words/REXX/ordered-words.rexx index 528ccaefe1..874e4d332f 100644 --- a/Task/Ordered-words/REXX/ordered-words.rexx +++ b/Task/Ordered-words/REXX/ordered-words.rexx @@ -1,27 +1,24 @@ -/*REXX program lists (the longest) ordered word(s) from a supplied dictionary.*/ -iFID = 'UNIXDICT.TXT' /*the filename of the word dictionary. */ -@.= /*placeholder array for list of words. */ -mL=0 /*maximum length of the ordered words. */ -call linein iFID, 1, 0 /*point to the first word in dictionary*/ - /* [↑] just in case the file is open. */ - do j=1 while lines(iFID)\==0 /*keep reading until file is exhausted.*/ - x=linein(iFID); w=length(x) /*obtain a word and also its length. */ - if w bool { let mut prev = '\x00'; - for c in s.chars() { + for c in s.to_lowercase().chars() { if c < prev { return false; } @@ -13,7 +12,7 @@ fn is_ordered(s: &str) -> bool { return true; } -fn find_longest_ordered_words(dict: Vec) -> Vec { +fn find_longest_ordered_words(dict: Vec<&str>) -> Vec<&str> { let mut result = Vec::new(); let mut longest_length = 0; @@ -25,7 +24,7 @@ fn find_longest_ordered_words(dict: Vec) -> Vec { result.truncate(0); } if n == longest_length { - result.push(s.to_owned()); + result.push(s); } } } @@ -34,7 +33,7 @@ fn find_longest_ordered_words(dict: Vec) -> Vec { } fn main() { - let lines = BufReader::new(File::open("unixdict.txt").unwrap()).lines().map(|l|l.unwrap()).collect(); + let lines = FILE.lines().collect(); let longest_ordered = find_longest_ordered_words(lines); diff --git a/Task/Palindrome-detection/00DESCRIPTION b/Task/Palindrome-detection/00DESCRIPTION index df4713fc61..d3589457cf 100644 --- a/Task/Palindrome-detection/00DESCRIPTION +++ b/Task/Palindrome-detection/00DESCRIPTION @@ -1,37 +1,20 @@ -Write at least one function/method (or whatever it is called in your -preferred language) to check if a sequence of characters (or bytes) -is a [[wp:Palindrome|palindrome]] or not. -The ''function'' must return a boolean value -(or something that can be used as boolean value, like an integer). +A [[wp:Palindrome|palindrome]] is a phrase which reads the same backward and forward. -It is not mandatory to write also an example code that uses -the ''function'', unless its usage could be not clear -(e.g. the provided recursive C solution -needs explanation on how to call the function). +{{task heading}} -It is not mandatory to handle properly encodings (see [[String length]]), -i.e. it is admissible that the function does not recognize 'salàlas' -as palindrome. +Write a function or program that checks whether a given sequence of characters (or, if you prefer, bytes) +is a palindrome. -The function must not ignore spaces and punctuations. -The compliance to the aforementioned, strict or not, -requirements completes the task. +'''''For extra credit:''''' +* Support Unicode characters. +* Write a second function (possibly as a wrapper to the first) which detects ''inexact'' palindromes, i.e. phrases that are palindromes if white-space and punctuation is ignored and case-insensitive comparison is used. -'''Example'''
    -An example of a Latin palindrome is the sentence -"''In girum imus nocte et consumimur igni''", -roughly translated as: we walk around in the night and we are burnt by the fire (of love). -To do your test with it, you must make it all the same case and strip spaces. - -'''Clarification'''
    -To remove some confusion expressed in the discussion tab: - -* To satisfy this task, the function should only identify exact palindromes; it should *not* strip spaces or punctuation or convert case. -* You may additionally write a wrapper function to detect inexact palindromes, such as the Latin example in the task description, or simply do the conversion in the calling function of your test code. - -'''Notes'''
    +{{task heading|Hints}} * It might be useful for this task to know how to [[Reversing a string|reverse a string]]. * This task's entries might also form the subjects of the task [[Test a function]]. -;Cf. -* [[Semordnilap]] +{{task heading|Related tasks}} + +{{Related tasks/Word plays}} + +
    diff --git a/Task/Palindrome-detection/AppleScript/palindrome-detection.applescript b/Task/Palindrome-detection/AppleScript/palindrome-detection.applescript new file mode 100644 index 0000000000..7626ae96c7 --- /dev/null +++ b/Task/Palindrome-detection/AppleScript/palindrome-detection.applescript @@ -0,0 +1,73 @@ +use framework "Foundation" + + +-- isPalindrome :: String -> Bool +on isPalindrome(s) + s = intercalate("", reverse of characters of s) +end isPalindrome + + + +-- TEST + +on run + + isPalindrome(lowerCaseNoSpace("In girum imus nocte et consumimur igni")) + + --> true + +end run + +-- lowerCaseNoSpace :: String -> String +on lowerCaseNoSpace(s) + script notSpace + on lambda(s) + s is not space + end lambda + end script + + intercalate("", filter(notSpace, characters of toLowerCase(s))) +end lowerCaseNoSpace + + +-- GENERIC LIBRARY FUNCTIONS + +-- toLowerCase :: String -> String +on toLowerCase(str) + set ca to current application + ((ca's NSString's stringWithString:(str))'s ¬ + lowercaseStringWithLocale:(ca's NSLocale's currentLocale())) as text +end toLowerCase + +-- intercalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate + +-- 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 + +-- 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 diff --git a/Task/Palindrome-detection/BASIC/palindrome-detection.basic b/Task/Palindrome-detection/BASIC/palindrome-detection.basic index 146ec8b885..e14e4f498a 100644 --- a/Task/Palindrome-detection/BASIC/palindrome-detection.basic +++ b/Task/Palindrome-detection/BASIC/palindrome-detection.basic @@ -1,32 +1,80 @@ -DECLARE FUNCTION isPalindrome% (what AS STRING) +' OPTION _EXPLICIT ' For QB64. In VB-DOS remove the underscore. -DATA "My dog has fleas", "Madam, I'm Adam.", "1 on 1", "In girum imus nocte et consumimur igni" +DIM txt$ -DIM L1 AS INTEGER, w AS STRING -FOR L1 = 1 TO 4 - READ w - IF isPalindrome(w) THEN - PRINT CHR$(34); w; CHR$(34); " is a palindrome" - ELSE - PRINT CHR$(34); w; CHR$(34); " is not a palindrome" - END IF -NEXT +' Palindrome +CLS +PRINT "This is a palindrome detector program." +PRINT +INPUT "Please, type a word or phrase: ", txt$ -FUNCTION isPalindrome% (what AS STRING) - DIM whatcopy AS STRING, chk AS STRING, tmp AS STRING * 1, L0 AS INTEGER +IF IsPalindrome(txt$) THEN + PRINT "Is a palindrome." +ELSE + PRINT "Is Not a palindrome." +END IF - FOR L0 = 1 TO LEN(what) - tmp = UCASE$(MID$(what, L0, 1)) - SELECT CASE tmp - CASE "A" TO "Z" - whatcopy = whatcopy + tmp - chk = tmp + chk - CASE "0" TO "9" - PRINT "Numbers are cheating! ("; CHR$(34); what; CHR$(34); ")" - isPalindrome = 0 - EXIT FUNCTION - END SELECT - NEXT +END + + +FUNCTION IsPalindrome (AText$) + ' Var + DIM CleanTXT$, RvrsTXT$ + + CleanTXT$ = CleanText$(AText$) + RvrsTXT$ = RvrsText$(CleanTXT$) + + IsPalindrome = (CleanTXT$ = RvrsTXT$) + +END FUNCTION + +FUNCTION CleanText$ (WhichText$) + ' Var + DIM i%, j%, c$, NewText$, CpyTxt$, AddIt%, SubsTXT$ + CONST False = 0, True = NOT False + + SubsTXT$ = "AIOUE" + CpyTxt$ = UCASE$(WhichText$) + j% = LEN(CpyTxt$) + + FOR i% = 1 TO j% + c$ = MID$(CpyTxt$, i%, 1) + + ' See if it is a letter. Includes Spanish letters. + SELECT CASE c$ + CASE "A" TO "Z" + AddIt% = True + CASE " ", "¡", "¢", "£" + c$ = MID$(SubsTXT$, ASC(c$) - 159, 1) + AddIt% = True + CASE "‚" + c$ = "E" + AddIt% = True + CASE "¤" + c$ = "¥" + AddIt% = True + CASE ELSE + AddIt% = False + END SELECT + + IF AddIt% THEN + NewText$ = NewText$ + c$ + END IF + NEXT i% + + CleanText$ = NewText$ + +END FUNCTION + +FUNCTION RvrsText$ (WhichText$) + ' Var + DIM i%, c$, NewText$, j% + + j% = LEN(WhichText$) + FOR i% = 1 TO j% + NewText$ = MID$(WhichText$, i%, 1) + NewText$ + NEXT i% + + RvrsText$ = NewText$ - isPalindrome = ((whatcopy) = chk) END FUNCTION diff --git a/Task/Palindrome-detection/COBOL/palindrome-detection.cobol b/Task/Palindrome-detection/COBOL/palindrome-detection.cobol new file mode 100644 index 0000000000..e1e80e5d2a --- /dev/null +++ b/Task/Palindrome-detection/COBOL/palindrome-detection.cobol @@ -0,0 +1,19 @@ + identification division. + function-id. palindromic-test. + + data division. + linkage section. + 01 test-text pic x any length. + 01 result pic x. + 88 palindromic value high-value + when set to false low-value. + + procedure division using test-text returning result. + + set palindromic to false + if test-text equal function reverse(test-text) then + set palindromic to true + end-if + + goback. + end function palindromic-test. diff --git a/Task/Palindrome-detection/Dart/palindrome-detection.dart b/Task/Palindrome-detection/Dart/palindrome-detection.dart index 4a7c1e7509..2562fc3c92 100644 --- a/Task/Palindrome-detection/Dart/palindrome-detection.dart +++ b/Task/Palindrome-detection/Dart/palindrome-detection.dart @@ -1,4 +1,4 @@ -bool isPolindrome(String s){ +bool isPalindrome(String s){ for(int i = 0; i < s.length/2;i++){ if(s[i] != s[(s.length-1) -i]) return false; diff --git a/Task/Palindrome-detection/Go/palindrome-detection.go b/Task/Palindrome-detection/Go/palindrome-detection-1.go similarity index 100% rename from Task/Palindrome-detection/Go/palindrome-detection.go rename to Task/Palindrome-detection/Go/palindrome-detection-1.go diff --git a/Task/Palindrome-detection/Go/palindrome-detection-2.go b/Task/Palindrome-detection/Go/palindrome-detection-2.go new file mode 100644 index 0000000000..2a9f472b95 --- /dev/null +++ b/Task/Palindrome-detection/Go/palindrome-detection-2.go @@ -0,0 +1,10 @@ +func isPalindrome(s string) bool { + runes := []rune(s) + numRunes := len(runes) - 1 + for i := 0; i < len(runes)/2; i++ { + if runes[i] != runes[numRunes-i] { + return false + } + } + return true +} diff --git a/Task/Palindrome-detection/Go/palindrome-detection-3.go b/Task/Palindrome-detection/Go/palindrome-detection-3.go new file mode 100644 index 0000000000..692eb19cba --- /dev/null +++ b/Task/Palindrome-detection/Go/palindrome-detection-3.go @@ -0,0 +1,10 @@ +func isPalindrome(s string) bool { + runes := []rune(s) + for len(runes) > 1 { + if runes[0] != runes[len(runes)-1] { + return false + } + runes = runes[1 : len(runes)-1] + } + return true +} diff --git a/Task/Palindrome-detection/JavaScript/palindrome-detection-3.js b/Task/Palindrome-detection/JavaScript/palindrome-detection-3.js new file mode 100644 index 0000000000..107639d5e9 --- /dev/null +++ b/Task/Palindrome-detection/JavaScript/palindrome-detection-3.js @@ -0,0 +1,28 @@ +(function (strSample) { + + // isPalindrome :: String -> Bool + let isPalindrome = s => + s.split('') + .reverse() + .join('') === s; + + + + // TESTING + + // lowerCaseNoSpace :: String -> String + let lowerCaseNoSpace = s => + concatMap(c => c !== ' ' ? [c.toLowerCase()] : [], + s.split('')) + .join(''), + + // concatMap :: (a -> [b]) -> [a] -> [b] + concatMap = (f, xs) => [].concat.apply([], xs.map(f)); + + + return isPalindrome( + lowerCaseNoSpace(strSample) + ); + + +})("In girum imus nocte et consumimur igni"); diff --git a/Task/Palindrome-detection/NewLISP/palindrome-detection.newlisp b/Task/Palindrome-detection/NewLISP/palindrome-detection.newlisp index 2ea9a6d630..4b6afe4557 100644 --- a/Task/Palindrome-detection/NewLISP/palindrome-detection.newlisp +++ b/Task/Palindrome-detection/NewLISP/palindrome-detection.newlisp @@ -1,4 +1,8 @@ (define (palindrome? s) - (setq r s) - (reverse r) ; Reverse is destructive. - (= s r)) + (setq r s) + (reverse r) ; Reverse is destructive. + (= s r)) + +;; Make ‘reverse’ non-destructive and avoid a global variable +(define (palindrome? s) + (= s (reverse (copy s)))) diff --git a/Task/Palindrome-detection/PowerShell/palindrome-detection.psh b/Task/Palindrome-detection/PowerShell/palindrome-detection-1.psh similarity index 100% rename from Task/Palindrome-detection/PowerShell/palindrome-detection.psh rename to Task/Palindrome-detection/PowerShell/palindrome-detection-1.psh diff --git a/Task/Palindrome-detection/PowerShell/palindrome-detection-2.psh b/Task/Palindrome-detection/PowerShell/palindrome-detection-2.psh new file mode 100644 index 0000000000..7584106792 --- /dev/null +++ b/Task/Palindrome-detection/PowerShell/palindrome-detection-2.psh @@ -0,0 +1,34 @@ +function Test-Palindrome +{ + <# + .SYNOPSIS + Tests if a string is a palindrome. + .DESCRIPTION + Tests if a string is a true palindrome or, optionally, an inexact palindrome. + .EXAMPLE + Test-Palindrome -Text "racecar" + .EXAMPLE + Test-Palindrome -Text '"Deliver desserts," demanded Nemesis, "emended, named, stressed, reviled."' -Inexact + #> + [CmdletBinding()] + [OutputType([bool])] + Param + ( + # The string to test for palindrominity. + [Parameter(Mandatory=$true)] + [string] + $Text, + + # When specified, detects an inexact palindrome. + [switch] + $Inexact + ) + + if ($Inexact) + { + # Strip all punctuation and spaces + $Text = [Regex]::Replace("$Text($7&","[^1-9a-zA-Z]","") + } + + $Text -match "^(?'char'[a-z])+[a-z]?(?:\k'char'(?'-char'))+(?(char)(?!))$" +} diff --git a/Task/Palindrome-detection/PowerShell/palindrome-detection-3.psh b/Task/Palindrome-detection/PowerShell/palindrome-detection-3.psh new file mode 100644 index 0000000000..d3ff46e171 --- /dev/null +++ b/Task/Palindrome-detection/PowerShell/palindrome-detection-3.psh @@ -0,0 +1 @@ +Test-Palindrome -Text 'radar' diff --git a/Task/Palindrome-detection/PowerShell/palindrome-detection-4.psh b/Task/Palindrome-detection/PowerShell/palindrome-detection-4.psh new file mode 100644 index 0000000000..47fa420f4f --- /dev/null +++ b/Task/Palindrome-detection/PowerShell/palindrome-detection-4.psh @@ -0,0 +1 @@ +Test-Palindrome -Text "In girum imus nocte et consumimur igni." diff --git a/Task/Palindrome-detection/PowerShell/palindrome-detection-5.psh b/Task/Palindrome-detection/PowerShell/palindrome-detection-5.psh new file mode 100644 index 0000000000..e2bf7e9045 --- /dev/null +++ b/Task/Palindrome-detection/PowerShell/palindrome-detection-5.psh @@ -0,0 +1 @@ +Test-Palindrome -Text "In girum imus nocte et consumimur igni." -Inexact diff --git a/Task/Palindrome-detection/Python/palindrome-detection-5.py b/Task/Palindrome-detection/Python/palindrome-detection-5.py new file mode 100644 index 0000000000..d9766d2f7c --- /dev/null +++ b/Task/Palindrome-detection/Python/palindrome-detection-5.py @@ -0,0 +1,28 @@ +def p_loop(): + import re, string + re1="" # Beginning of Regex + re2="" # End of Regex + pal=raw_input("Please Enter a word or phrase: ") + pd = pal.replace(' ','') + for c in string.punctuation: + pd = pd.replace(c,"") + if pal == "" : + return -1 + c=len(pd) # Count of chars. + loops = (c+1)/2 + for x in range(loops): + re1 = re1 + "(\w)" + if (c%2 == 1 and x == 0): + continue + p = loops - x + re2 = re2 + "\\" + str(p) + regex= re1+re2+"$" # regex is like "(\w)(\w)(\w)\2\1$" + #print(regex) # To test regex before re.search + m = re.search(r'^'+regex,pd,re.IGNORECASE) + if (m): + print("\n "+'"'+pal+'"') + print(" is a Palindrome\n") + return 1 + else: + print("Nope!") + return 0 diff --git a/Task/Palindrome-detection/Rust/palindrome-detection.rust b/Task/Palindrome-detection/Rust/palindrome-detection.rust new file mode 100644 index 0000000000..a483e1dccb --- /dev/null +++ b/Task/Palindrome-detection/Rust/palindrome-detection.rust @@ -0,0 +1,19 @@ +fn is_palindrome(string: &str) -> bool { + string.chars().zip(string.chars().rev()).all(|(x, y)| x == y) +} + +macro_rules! test { + ( $( $x:tt ),* ) => { $( println!("'{}': {}", $x, is_palindrome($x)); )* }; +} + +fn main() { + test!("", + "a", + "ada", + "adad", + "ingirumimusnocteetconsumimurigni", + "人人為我,我為人人", + "Я иду с мечем, судия", + "아들딸들아", + "The quick brown fox"); +} diff --git a/Task/Palindrome-detection/Vala/palindrome-detection.vala b/Task/Palindrome-detection/Vala/palindrome-detection.vala new file mode 100644 index 0000000000..51ad64b240 --- /dev/null +++ b/Task/Palindrome-detection/Vala/palindrome-detection.vala @@ -0,0 +1,9 @@ +bool is_palindrome (string str) { + var tmp = str.casefold ().replace (" ", ""); + return tmp == tmp.reverse (); +} + +int main (string[] args) { + print (is_palindrome (args[1]).to_string () + "\n"); + return 0; +} diff --git a/Task/Pangram-checker/00DESCRIPTION b/Task/Pangram-checker/00DESCRIPTION index b2a0a6a302..ce41980f15 100644 --- a/Task/Pangram-checker/00DESCRIPTION +++ b/Task/Pangram-checker/00DESCRIPTION @@ -1,6 +1,10 @@ {{omit from|Lilypond}} -Write a function or method to check a sentence -to see if it is a [[wp:Pangram|pangram]] or not and show its use. -A pangram is a sentence that contains all the letters of the English alphabet -at least once, for example: ''The quick brown fox jumps over the lazy dog''. +A pangram is a sentence that contains all the letters of the English alphabet at least once. + +For example:   ''The quick brown fox jumps over the lazy dog''. + + +;Task: +Write a function or method to check a sentence to see if it is a   [[wp:Pangram|pangram]]   (or not)   and show its use. +

    diff --git a/Task/Pangram-checker/AppleScript/pangram-checker-1.applescript b/Task/Pangram-checker/AppleScript/pangram-checker-1.applescript new file mode 100644 index 0000000000..ff29991f66 --- /dev/null +++ b/Task/Pangram-checker/AppleScript/pangram-checker-1.applescript @@ -0,0 +1,91 @@ +use framework "Foundation" -- ( for case conversion function ) + + +-- isPangram :: String -> Bool +on isPangram(s) + script charUnUsed + property lowerCaseString : my toLowerCase(s) + + on lambda(c) + lowerCaseString does not contain c + end lambda + end script + + length of filter(charUnUsed, "abcdefghijklmnopqrstuvwxyz") = 0 +end isPangram + + +-- TEST + +on run + map(isPangram, {¬ + "is this a pangram", ¬ + "The quick brown fox jumps over the lazy dog"}) + + --> {false, true} +end run + + +-- GENERIC HIGHER ORDER FUNCTIONS (FILTER AND 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 + +-- 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 + +-- 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 + +-- OBJC function: lowercaseStringWithLocale + +-- toLowerCase :: String -> String +on toLowerCase(str) + set ca to current application + unwrap(wrap(str)'s ¬ + lowercaseStringWithLocale:(ca's NSLocale's currentLocale)) +end toLowerCase + +-- wrap :: AS value -> NSObject +on wrap(v) + set ca to current application + ca's (NSArray's arrayWithObject:v)'s objectAtIndex:0 +end wrap + +-- unwrap :: NSObject -> AS value +on unwrap(objCValue) + if objCValue is missing value then + return missing value + else + set ca to current application + item 1 of ((ca's NSArray's arrayWithObject:objCValue) as list) + end if +end unwrap diff --git a/Task/Pangram-checker/AppleScript/pangram-checker-2.applescript b/Task/Pangram-checker/AppleScript/pangram-checker-2.applescript new file mode 100644 index 0000000000..49b4696be3 --- /dev/null +++ b/Task/Pangram-checker/AppleScript/pangram-checker-2.applescript @@ -0,0 +1 @@ +{false, true} diff --git a/Task/Pangram-checker/C++/pangram-checker.cpp b/Task/Pangram-checker/C++/pangram-checker.cpp index ccec311543..fce16774a4 100644 --- a/Task/Pangram-checker/C++/pangram-checker.cpp +++ b/Task/Pangram-checker/C++/pangram-checker.cpp @@ -1,16 +1,24 @@ #include #include #include -using namespace std; +#include -const string alphabet("abcdefghijklmnopqrstuvwxyz"); // sorted, no duplicates +const std::string alphabet("abcdefghijklmnopqrstuvwxyz"); -bool is_pangram(string s) { - // Convert to lower case. - transform(s.begin(), s.end(), s.begin(), ::tolower); - // Convert to a sorted sequence of (not necessarily unique) characters. - sort(s.begin(), s.end()); - // Is the second sequence a subset of the first sequence? - // Repeated letters in "s" are okay, since it still "includes" the single letter - return includes(s.begin(), s.end(), alphabet.begin(), alphabet.end()); +bool is_pangram(std::string s) +{ + std::transform(s.begin(), s.end(), s.begin(), ::tolower); + std::sort(s.begin(), s.end()); + return std::includes(s.begin(), s.end(), alphabet.begin(), alphabet.end()); +} + +int main() +{ + const auto examples = {"The quick brown fox jumps over the lazy dog", + "The quick white cat jumps over the lazy dog"}; + + std::cout.setf(std::ios::boolalpha); + for (auto& text : examples) { + std::cout << "Is \"" << text << "\" a pangram? - " << is_pangram(text) << std::endl; + } } diff --git a/Task/Pangram-checker/C/pangram-checker-1.c b/Task/Pangram-checker/C/pangram-checker-1.c index 8ceb662607..be0e900574 100644 --- a/Task/Pangram-checker/C/pangram-checker-1.c +++ b/Task/Pangram-checker/C/pangram-checker-1.c @@ -1,27 +1,32 @@ #include -int isPangram(const char *string) +int is_pangram(const char *s) { + const char *alpha = "" + "abcdefghjiklmnopqrstuvwxyz" + "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; + char ch, wasused[26] = {0}; int total = 0; - while ((ch = *string++)) { - int index; + while ((ch = *s++) != '\0') { + const char *p; + int idx; - if('A'<=ch&&ch<='Z') - index = ch-'A'; - else if('a'<=ch&&ch<='z') - index = ch-'a'; - else + if ((p = strchr(alpha, ch)) == NULL) continue; - total += !wasused[index]; - wasused[index] = 1; + idx = (p - alpha) % 26; + + total += !wasused[idx]; + wasused[idx] = 1; + if (total == 26) + return 1; } - return (total==26); + return 0; } -int main() +int main(void) { int i; const char *tests[] = { @@ -31,6 +36,6 @@ int main() for (i = 0; i < 2; i++) printf("\"%s\" is %sa pangram\n", - tests[i], isPangram(tests[i])?"":"not "); + tests[i], is_pangram(tests[i])?"":"not "); return 0; } diff --git a/Task/Pangram-checker/COBOL/pangram-checker.cobol b/Task/Pangram-checker/COBOL/pangram-checker.cobol new file mode 100644 index 0000000000..302c22767f --- /dev/null +++ b/Task/Pangram-checker/COBOL/pangram-checker.cobol @@ -0,0 +1,51 @@ + identification division. + program-id. pan-test. + data division. + working-storage section. + 1 text-string pic x(80). + 1 len binary pic 9(4). + 1 trailing-spaces binary pic 9(4). + 1 pangram-flag pic x value "n". + 88 is-not-pangram value "n". + 88 is-pangram value "y". + procedure division. + begin. + display "Enter text string:" + accept text-string + set is-not-pangram to true + initialize trailing-spaces len + inspect function reverse (text-string) + tallying trailing-spaces for leading space + len for characters after space + call "pangram" using pangram-flag len text-string + cancel "pangram" + if is-pangram + display "is a pangram" + else + display "is not a pangram" + end-if + stop run + . + end program pan-test. + + identification division. + program-id. pangram. + data division. + 1 lc-alphabet pic x(26) value "abcdefghijklmnopqrstuvwxyz". + linkage section. + 1 pangram-flag pic x. + 88 is-not-pangram value "n". + 88 is-pangram value "y". + 1 len binary pic 9(4). + 1 text-string pic x(80). + procedure division using pangram-flag len text-string. + begin. + inspect lc-alphabet converting + function lower-case (text-string (1:len)) + to space + if lc-alphabet = space + set is-pangram to true + end-if + exit program + . + end program pangram. diff --git a/Task/Pangram-checker/Go/pangram-checker.go b/Task/Pangram-checker/Go/pangram-checker.go index a3447fdc3c..d7502e9dda 100644 --- a/Task/Pangram-checker/Go/pangram-checker.go +++ b/Task/Pangram-checker/Go/pangram-checker.go @@ -17,27 +17,21 @@ func main() { } func pangram(s string) bool { - var rep [26]bool - var count int - for _, c := range s { - if c >= 'a' { - if c > 'z' { - continue - } - c -= 'a' - } else { - if c < 'A' || c > 'Z' { - continue - } - c -= 'A' - } - if !rep[c] { - if count == 25 { - return true - } - rep[c] = true - count++ - } - } - return false + var missing uint32 = (1 << 26) - 1 + for _, c := range s { + var index uint32 + if 'a' <= c && c <= 'z' { + index = uint32(c - 'a') + } else if 'A' <= c && c <= 'Z' { + index = uint32(c - 'A') + } else { + continue + } + + missing &^= 1 << index + if missing == 0 { + return true + } + } + return false } diff --git a/Task/Pangram-checker/Io/pangram-checker.io b/Task/Pangram-checker/Io/pangram-checker.io new file mode 100644 index 0000000000..257c6dfbab --- /dev/null +++ b/Task/Pangram-checker/Io/pangram-checker.io @@ -0,0 +1,14 @@ +Sequence isPangram := method( + letters := " " repeated(26) + ia := "a" at(0) + foreach(ichar, + if(ichar isLetter, + letters atPut((ichar asLowercase) - ia, ichar) + ) + ) + letters contains(" " at(0)) not // true only if no " " in letters +) + +"The quick brown fox jumps over the lazy dog." isPangram println // --> true +"The quick brown fox jumped over the lazy dog." isPangram println // --> false +"ABC.D.E.FGHI*J/KL-M+NO*PQ R\nSTUVWXYZ" isPangram println // --> true diff --git a/Task/Pangram-checker/JavaScript/pangram-checker-1.js b/Task/Pangram-checker/JavaScript/pangram-checker-1.js index 433e331cce..87f80cd42b 100644 --- a/Task/Pangram-checker/JavaScript/pangram-checker-1.js +++ b/Task/Pangram-checker/JavaScript/pangram-checker-1.js @@ -1,12 +1,11 @@ -function is_pangram(str) { - var s = str.toLowerCase(); +function isPangram(s) { + var letters = "zqxjkvbpygfwmucldrhsnioate" // sorted by frequency ascending (http://en.wikipedia.org/wiki/Letter_frequency) - var letters = "zqxjkvbpygfwmucldrhsnioate"; + s = s.toLowerCase().replace(/[^a-z]/g,'') for (var i = 0; i < 26; i++) - if (s.indexOf(letters.charAt(i)) == -1) - return false; - return true; + if (s.indexOf(letters[i]) < 0) return false + return true } -print(is_pangram("is this a pangram")); // false -print(is_pangram("The quick brown fox jumps over the lazy dog")); // true +console.log(isPangram("is this a pangram")) // false +console.log(isPangram("The quick brown fox jumps over the lazy dog")) // true diff --git a/Task/Pangram-checker/JavaScript/pangram-checker-2.js b/Task/Pangram-checker/JavaScript/pangram-checker-2.js index cbc94e2fae..f1b4120389 100644 --- a/Task/Pangram-checker/JavaScript/pangram-checker-2.js +++ b/Task/Pangram-checker/JavaScript/pangram-checker-2.js @@ -1,36 +1,20 @@ -var _ = require("underscore"); +(() => { + 'use strict'; -// Curried mixin function -// Utility Methods -_.mixin({ - checkAToZ: function(s) { - return function(letter) { - if (s.indexOf(letter) != -1) { return true}; - } - } -}); + // isPangram :: String -> Bool + let isPangram = s => { + let lc = s.toLowerCase(); -_.mixin({ - toLower: function(str) { - return str.toLowerCase(); - } -}); + return 'abcdefghijklmnopqrstuvwxyz' + .split('') + .filter(c => lc.indexOf(c) === -1) + .length === 0; + }; -_.mixin({ - isPangram: function(lstr) { - var letters = "zqxjkvbpygfwmucldrhsnioate".split(''); - return _.every(letters, _.checkAToZ(lstr)); - } -}); + // TEST + return [ + 'is this a pangram', + 'The quick brown fox jumps over the lazy dog' + ].map(isPangram); - -var panGramStr = "The quick brown fox jumps over the lazy dog"; -var IsPanGram = function(panGramStr) { - return _.chain(panGramStr).toLower().isPangram().value(); -}; - -console.log("Result IsPanGram - \"", panGramStr,"\" - " , IsPanGram.call(this,panGramStr)); -console.log("Result IsPanGram - \"", "the World","\" - ", IsPanGram.call(this, "the World")); - -// Result IsPanGram - " The quick brown fox jumps over the lazy dog " - true -// Result IsPanGram - " the World " - false +})(); diff --git a/Task/Pangram-checker/NewLISP/pangram-checker.newlisp b/Task/Pangram-checker/NewLISP/pangram-checker.newlisp new file mode 100644 index 0000000000..d6c76daf2e --- /dev/null +++ b/Task/Pangram-checker/NewLISP/pangram-checker.newlisp @@ -0,0 +1,18 @@ +(context 'PGR) ;; Switch to context (say namespace) PGR +(define (is-pangram? str) + (setf chars (explode (upper-case str))) ;; Uppercase + convert string into a list of chars + (setf is-pangram-status true) ;; Default return value of function + (for (c (char "A") (char "Z") 1 (nil? is-pangram-status)) ;; For loop with break condition + (if (not (find (char c) chars)) ;; If char not found in list, "is-pangram-status" becomes "nil" + (setf is-pangram-status nil) + ) + ) + is-pangram-status ;; Return current value of symbol "is-pangram-status" +) +(context 'MAIN) ;; Back to MAIN context + +;; - - - - - - - - - - + +(println (PGR:is-pangram? "abcdefghijklmnopqrstuvwxyz")) ;; Print true +(println (PGR:is-pangram? "abcdef")) ;; Print nil +(exit) diff --git a/Task/Pangram-checker/PowerShell/pangram-checker-1.psh b/Task/Pangram-checker/PowerShell/pangram-checker-1.psh new file mode 100644 index 0000000000..3bcaf16c54 --- /dev/null +++ b/Task/Pangram-checker/PowerShell/pangram-checker-1.psh @@ -0,0 +1,13 @@ +function Test-Pangram ( [string]$Text, [string]$Alphabet = 'abcdefghijklmnopqrstuvwxyz' ) + { + $Text = $Text.ToLower() + $Alphabet = $Alphabet.ToLower() + + $IsPangram = $Alphabet.ToCharArray().Where{ $Text.Contains( $_ ) }.Count -eq $Alphabet.Length + + return $IsPangram + } + +Test-Pangram 'The quick brown fox jumped over the lazy dog.' +Test-Pangram 'The quick brown fox jumps over the lazy dog.' +Test-Pangram 'Съешь же ещё этих мягких французских булок, да выпей чаю' 'абвгдежзийклмнопрстуфхцчшщъыьэюяё' diff --git a/Task/Pangram-checker/PowerShell/pangram-checker-2.psh b/Task/Pangram-checker/PowerShell/pangram-checker-2.psh new file mode 100644 index 0000000000..3f13b4f7fc --- /dev/null +++ b/Task/Pangram-checker/PowerShell/pangram-checker-2.psh @@ -0,0 +1,13 @@ +function Test-Pangram ( [string]$Text, [string]$Alphabet = 'abcdefghijklmnopqrstuvwxyz' ) + { + $Text = $Text.ToLower() + $Alphabet = $Alphabet.ToLower() + + $IsPangram = ( $Alphabet.ToCharArray() | Where { $Text.Contains( $_ ) } ).Count -eq $Alphabet.Length + + return $IsPangram + } + +Test-Pangram 'The quick brown fox jumped over the lazy dog.' +Test-Pangram 'The quick brown fox jumps over the lazy dog.' +Test-Pangram 'Съешь же ещё этих мягких французских булок, да выпей чаю' 'абвгдежзийклмнопрстуфхцчшщъыьэюяё' diff --git a/Task/Pangram-checker/REXX/pangram-checker.rexx b/Task/Pangram-checker/REXX/pangram-checker.rexx index ba981090bf..621df2257c 100644 --- a/Task/Pangram-checker/REXX/pangram-checker.rexx +++ b/Task/Pangram-checker/REXX/pangram-checker.rexx @@ -1,16 +1,14 @@ -/*REXX program checks to see if an entered string (sentence) is a pangram. */ -@abc = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' /*a list of all (Latin) capital letters*/ +/*REXX program verifies if an entered/supplied string (sentence) is a pangram. */ +@abc= 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' /*a list of all (Latin) capital letters*/ - do forever; say /*keep promoting 'til null (or blanks).*/ - say '───── Please enter a pangramic sentence:'; say - pull y /*this also uppercases the Y variable.*/ - if y='' then leave /*if nothing entered, then we're done.*/ - ?=verify(@abc,y) /*Are all the (Latin) letters present? */ + do forever; say /*keep promoting 'til null (or blanks).*/ + say '──────── Please enter a pangramic sentence (or a blank to quit):'; say + pull y /*this also uppercases the Y variable.*/ + if y='' then leave /*if nothing entered, then we're done.*/ + ?=verify(@abc, y) /*Are all the (Latin) letters present? */ + if ?==0 then say '──────── Sentence is a pangram.' + else say "──────── Sentence isn't a pangram, missing:" substr(@abc, ?, 1) + say + end /*forever*/ - if ?==0 then say 'Sentence is a pangram.' - else say "Sentence isn't a pangram, missing:" substr(@abc,?,1) - say - end /*forever*/ - -say '───── PANGRAM program ended. ─────' - /*stick a fork in it, we're all done. */ +say '──────── PANGRAM program ended. ────────' /*stick a fork in it, we're all done. */ diff --git a/Task/Pangram-checker/Rust/pangram-checker.rust b/Task/Pangram-checker/Rust/pangram-checker.rust new file mode 100644 index 0000000000..6f9fbb6382 --- /dev/null +++ b/Task/Pangram-checker/Rust/pangram-checker.rust @@ -0,0 +1,69 @@ +#![feature(test)] + +extern crate test; + +use std::collections::HashSet; + +pub fn is_pangram_via_bitmask(s: &str) -> bool { + + // Create a mask of set bits and convert to false as we find characters. + let mut mask = (1 << 26) - 1; + + for chr in s.chars() { + let val = chr as u32 & !0x20; /* 0x20 converts lowercase to upper */ + if val <= 'Z' as u32 && val >= 'A' as u32 { + mask = mask & !(1 << (val - 'A' as u32)); + } + } + + mask == 0 +} + +pub fn is_pangram_via_hashset(s: &str) -> bool { + + // Insert lowercase letters into a HashSet, then check if we have at least 26. + let letters = s.chars() + .flat_map(|chr| chr.to_lowercase()) + .filter(|&chr| chr >= 'a' && chr <= 'z') + .fold(HashSet::new(), |mut letters, chr| { + letters.insert(chr); + letters + }); + + letters.len() == 26 +} + +pub fn is_pangram_via_sort(s: &str) -> bool { + + // Copy chars into a vector, convert to lowercase, sort, and remove duplicates. + let mut chars: Vec = s.chars() + .flat_map(|chr| chr.to_lowercase()) + .filter(|&chr| chr >= 'a' && chr <= 'z') + .collect(); + + chars.sort(); + chars.dedup(); + + chars.len() == 26 +} + +fn main() { + + let examples = ["The quick brown fox jumps over the lazy dog", + "The quick white cat jumps over the lazy dog"]; + + for &text in examples.iter() { + let is_pangram_sort = is_pangram_via_sort(text); + println!("Is \"{}\" a pangram via sort? - {}", text, is_pangram_sort); + + let is_pangram_bitmask = is_pangram_via_bitmask(text); + println!("Is \"{}\" a pangram via bitmask? - {}", + text, + is_pangram_bitmask); + + let is_pangram_hashset = is_pangram_via_hashset(text); + println!("Is \"{}\" a pangram via bitmask? - {}", + text, + is_pangram_hashset); + } +} diff --git a/Task/Paraffins/00DESCRIPTION b/Task/Paraffins/00DESCRIPTION index 433ef805a9..3b30715070 100644 --- a/Task/Paraffins/00DESCRIPTION +++ b/Task/Paraffins/00DESCRIPTION @@ -1,23 +1,49 @@ +[[File:Paraffins.isopentane.png|450px||right]] + This organic chemistry task is essentially to implement a tree enumeration algorithm. -The problem is to enumerate, without repetitions and in order of increasing size, all possible paraffin molecules (or [[wp:alkane|alkane]]s). Paraffins are built up using only carbon, which has 4 bonds and hydrogen, which has 1. All bonds for each atom must be used, so it is easiest to think of an alkane as linked carbon atoms forming the "backbone" structure, with adding hydrogens linking the remaining unused bonds. -In a paraffin one is allowed neither double bonds (two bonds between the same pair of atoms) nor cycles of linked carbons, so all paraffins with n carbon atoms share the empirical formula CnH2n+2 but for all n >= 4 there are several distinct molecules ("isomers") with the same formula but different structures. The number of isomers rises rather rapidly with n. In counting isomers it should be borne in mind that the four bond positions on a given carbon atom can be freely interchanged and bonds rotated (including 3-D "out of the paper" rotations when you are looking at a flat diagram), so rotations or reorientations of parts of the molecule (without breaking bonds) do not give different isomers. So what seem at first to be different molecules may in fact turn out to be different orientations of the same molecule. +;Task: +Enumerate, without repetitions and in order of increasing size, all possible paraffin molecules (also known as [[wp:alkane|alkane]]s). -For example with n = 3 there is only 1 way of linking the carbons despite the different orientations you can draw the molecule in; and with n = 4 there are 2 configurations, a straight chain: (CH3)(CH2)(CH2)(CH3) and a branched chain: (CH3)(CH(CH3))(CH3). Due to bond rotations it doesn't matter which direction the branch points in. The phenomenon of "stereo-isomerism" (a molecule being different from its mirror image due to the actual 3-D arrangement of bonds) is ignored for the purpose of this task. -The input is just the number 'n' of carbon atoms of a molecule, like 17. The output is how many different different paraffins there are with 'n' carbon atoms (like 24_894 if n = 17). +Paraffins are built up using only carbon atoms, which has four bonds, and hydrogen, which has one bond. All bonds for each atom must be used, so it is easiest to think of an alkane as linked carbon atoms forming the "backbone" structure, with adding hydrogen atoms linking the remaining unused bonds. -The sequence of those results is visible in the [[oeis:A000602|Sloane encyclopedia]]. The sequence is (the index starts from 0, and represents the number of carbon atoms): +In a paraffin, one is allowed neither double bonds (two bonds between the same pair of atoms), nor cycles of linked carbons. So all paraffins with   '''n'''   carbon atoms share the empirical formula   CnH2n+2 + +But for all   '''n''' ≥ 4   there are several distinct molecules ("isomers") with the same formula but different structures. + +The number of isomers rises rather rapidly when   '''n'''   increases. + +In counting isomers it should be borne in mind that the four bond positions on a given carbon atom can be freely interchanged and bonds rotated (including 3-D "out of the paper" rotations when it's being observed on a flat diagram), so rotations or re-orientations of parts of the molecule (without breaking bonds) do not give different isomers. So what seem at first to be different molecules may in fact turn out to be different orientations of the same molecule. + + +;Example: +With   '''n''' = 3   there is only one way of linking the carbons despite the different orientations the molecule can be drawn;   and with   '''n''' = 4   there are two configurations: +:::* a   straight chain:     (CH3)(CH2)(CH2)(CH3) +:::* a branched chain:     (CH3)(CH(CH3))(CH3) + +
    +Due to bond rotations, it doesn't matter which direction the branch points in. + +The phenomenon of "stereo-isomerism" (a molecule being different from its mirror image due to the actual 3-D arrangement of bonds) is ignored for the purpose of this task. + +The input is the number   '''n'''   of carbon atoms of a molecule (for instance '''17'''). + +The output is how many different different paraffins there are with   '''n'''   carbon atoms (for instance   24,894   if   '''n''' = 17). + +The sequence of those results is visible in the [[oeis:A000602|Sloane encyclopedia]]. The sequence is (the index starts from zero, and represents the number of carbon atoms): 1, 1, 1, 1, 2, 3, 5, 9, 18, 35, 75, 159, 355, 802, 1858, 4347, 10359, 24894, 60523, 148284, 366319, 910726, 2278658, 5731580, 14490245, 36797588, 93839412, 240215803, 617105614, 1590507121, 4111846763, 10660307791, 27711253769, ... -'''Extra credit''' -Show the paraffins in some way. A flat 1D representation, with arrays or lists is enough, like: +;Extra credit: +Show the paraffins in some way. + +A flat 1D representation, with arrays or lists is enough, for instance: *Main> all_paraffins 1 [CCP H H H H] @@ -39,8 +65,8 @@ Show the paraffins in some way. A flat 1D representation, with arrays or lists i (C H H (C H H H)) (C H H (C H H H)),CCP (C H H H) (C H H H) (C H H H) (C H H (C H H H))] -Showing a basic 2D ASCII-art representation of the paraffines is better, like (molecule names aren't necessary): -
     Methane         Ethane              Propane              Iso-butane
    +Showing a basic 2D ASCII-art representation of the paraffins is better; for instance (molecule names aren't necessary):
    +
     Methane         Ethane              Propane              Isobutane
     
         H             H   H             H   H   H             H   H   H
         |             |   |             |   |   |             |   |   |
    @@ -52,16 +78,17 @@ H - C - H     H - C - C - H     H - C - C - C - H     H - C - C - C - H
                                                                   |
                                                                   H
    -'''Links''' -A paper that explains the problem and its solution in a functional language: +;Links: +* A paper that explains the problem and its solution in a functional language: http://www.cs.wright.edu/~tkprasad/courses/cs776/paraffins-turner.pdf -A Haskell implementation: -http://darcs.brianweb.net/nofib/imaginary/paraffins/Main.hs   ◄── dead link. +* A Haskell implementation: +https://github.com/ghc/nofib/blob/master/imaginary/paraffins/Main.hs -A Scheme implementation: +* A Scheme implementation: http://www.ccs.neu.edu/home/will/Twobit/src/paraffins.scm -A Fortress implementation: +* A Fortress implementation: http://java.net/projects/projectfortress/sources/sources/content/ProjectFortress/demos/turnersParaffins0.fss?rev=3005 +

    diff --git a/Task/Paraffins/Java/paraffins.java b/Task/Paraffins/Java/paraffins.java new file mode 100644 index 0000000000..ac1cd93ccd --- /dev/null +++ b/Task/Paraffins/Java/paraffins.java @@ -0,0 +1,59 @@ +import java.math.BigInteger; +import java.util.Arrays; + +class Test { + final static int nMax = 250; + final static int nBranches = 4; + + static BigInteger[] rooted = new BigInteger[nMax + 1]; + static BigInteger[] unrooted = new BigInteger[nMax + 1]; + static BigInteger[] c = new BigInteger[nBranches]; + + static void tree(int br, int n, int l, int inSum, BigInteger cnt) { + int sum = inSum; + for (int b = br + 1; b <= nBranches; b++) { + sum += n; + + if (sum > nMax || (l * 2 >= sum && b >= nBranches)) + return; + + BigInteger tmp = rooted[n]; + if (b == br + 1) { + c[br] = tmp.multiply(cnt); + } else { + c[br] = c[br].multiply(tmp.add(BigInteger.valueOf(b - br - 1))); + c[br] = c[br].divide(BigInteger.valueOf(b - br)); + } + + if (l * 2 < sum) + unrooted[sum] = unrooted[sum].add(c[br]); + + if (b < nBranches) + rooted[sum] = rooted[sum].add(c[br]); + + for (int m = n - 1; m > 0; m--) + tree(b, m, l, sum, c[br]); + } + } + + static void bicenter(int s) { + if ((s & 1) == 0) { + BigInteger tmp = rooted[s / 2]; + tmp = tmp.add(BigInteger.ONE).multiply(rooted[s / 2]); + unrooted[s] = unrooted[s].add(tmp.shiftRight(1)); + } + } + + public static void main(String[] args) { + Arrays.fill(rooted, BigInteger.ZERO); + Arrays.fill(unrooted, BigInteger.ZERO); + rooted[0] = rooted[1] = BigInteger.ONE; + unrooted[0] = unrooted[1] = BigInteger.ONE; + + for (int n = 1; n <= nMax; n++) { + tree(0, n, n, 1, BigInteger.ONE); + bicenter(n); + System.out.printf("%d: %s%n", n, unrooted[n]); + } + } +} diff --git a/Task/Paraffins/Perl-6/paraffins.pl6 b/Task/Paraffins/Perl-6/paraffins.pl6 index 6dba8d9030..4381d42a6a 100644 --- a/Task/Paraffins/Perl-6/paraffins.pl6 +++ b/Task/Paraffins/Perl-6/paraffins.pl6 @@ -1,6 +1,6 @@ sub count-unrooted-trees(Int $max-branches, Int $max-weight) { - my @rooted = 1,1,0 xx $max-weight - 1; - my @unrooted = 1,1,0 xx $max-weight - 1; + my @rooted = flat 1,1,0 xx $max-weight - 1; + my @unrooted = flat 1,1,0 xx $max-weight - 1; sub count-trees-with-centroid(Int $radius) { sub add-branches( @@ -41,5 +41,5 @@ sub count-unrooted-trees(Int $max-branches, Int $max-weight) { } my constant N = 100; -my @paraffins := count-unrooted-trees(4, N); -say .fmt('%3d'), ': ', @paraffins[$_] for 1 .. 30, N; +my @paraffins = count-unrooted-trees(4, N); +say .fmt('%3d'), ': ', @paraffins[$_] for flat 1 .. 30, N; diff --git a/Task/Paraffins/REXX/paraffins.rexx b/Task/Paraffins/REXX/paraffins.rexx index 65063a0917..6314834ce7 100644 --- a/Task/Paraffins/REXX/paraffins.rexx +++ b/Task/Paraffins/REXX/paraffins.rexx @@ -1,27 +1,27 @@ -/*REXX program to enumerate number # paraffins for N atoms of carbon.*/ -parse arg nodes .; if nodes=='' then nodes=100 /*Not given? Use default*/ - rooted. = 0; rooted.0=1; rooted.1=1 /*define base rooted #s.*/ -unrooted. = 0; unrooted.0=1; unrooted.1=1 /* " " unrooted " */ -numeric digits max(9,nodes%2) /*may use gi-hugeic nums*/ -w=length(nodes) /*for formatted display.*/ -say right(0,w) unrooted.0 /*··· zero carbon atoms.*/ - /* [↓] process nodes. */ - do C=1 for nodes; h=C%2 /*C: # of carbon atoms.*/ - call tree 0, C, C, 1, 1 /* [↓] if C is even. */ - if C//2==0 then unrooted.C=unrooted.C + rooted.h*(rooted.h+1)%2 - say right(C,w) unrooted.C /*display formatted #'s.*/ +/*REXX program enumerates (without repetition) the # of paraffins with N atoms of carbon*/ +parse arg nodes . /*obtain optional argument from the CL.*/ +if nodes=='' | nodes=="," then nodes=100 /*Not specified? Then use the default.*/ + rooted. = 0; rooted.0=1; rooted.1=1 /*define the base rooted numbers.*/ +unrooted. = 0; unrooted.0=1; unrooted.1=1 /* " " " unrooted " */ +numeric digits max(9,nodes%2) /*this program may use gihugeic numbers*/ +w=length(nodes) /*W: used for aligning formatted nodes.*/ +say right(0,w) unrooted.0 /*show enumerations of 0 carbon atoms*/ + /* [↓] process all nodes (up to NODES)*/ + do C=1 for nodes; h=C%2 /*C: is the number of carbon atoms. */ + call tree 0, C, C, 1, 1 /* [↓] if # of carbon atoms is even···*/ + if C//2==0 then unrooted.C=unrooted.C + rooted.h * (rooted.h + 1) % 2 + say right(C,w) unrooted.C /*display an aligned formatted number. */ end /*C*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────TREE subroutine─────────────────────*/ -tree: procedure expose rooted. unrooted. nodes #. /*recursive.*/ -parse arg br,n,L,sum,cnt; nm=n-1; LL=L+L; brp=br+1 - do b=brp to 4; sum=sum+n; if sum>nodes then leave - if b==4 then if LL>=sum then leave - if b==brp then #.br=rooted.n*cnt - else #.br=#.br*(rooted.n+b-brp)%(b-br) - if LLnodes then leave + if b==4 then if LL>=sum then leave + if b==brp then #.br=rooted.n * cnt + else #.br=#.br * (rooted.n + b - brp) % (b - br) + if LL (print-max-factor (max-minimum-factor '(12757923 12878611 12878893 12757923 15808973 15780709 197622519))) -12878893 has the largest miniumum factor 47 +12878893 has the largest minimum factor 47 diff --git a/Task/Parametrized-SQL-statement/PureBasic/parametrized-sql-statement.purebasic b/Task/Parametrized-SQL-statement/PureBasic/parametrized-sql-statement.purebasic index 3b311732ce..1640f87986 100644 --- a/Task/Parametrized-SQL-statement/PureBasic/parametrized-sql-statement.purebasic +++ b/Task/Parametrized-SQL-statement/PureBasic/parametrized-sql-statement.purebasic @@ -1,19 +1,53 @@ UseSQLiteDatabase() -DatabaseFile$ = GetTemporaryDirectory()+"/Batadase.sqt" -; all kind of variables for the given case - table$ = "players" - name$ = "Smith, Steve" - score.w = 42 - active$ ="TRUE" - jerseynum.w =99 +Procedure CheckDatabaseUpdate(database, query$) + result = DatabaseUpdate(database, query$) + If result = 0 + PrintN(DatabaseError()) + EndIf + + ProcedureReturn result +EndProcedure + + +If OpenConsole() + If OpenDatabase(0, ":memory:", "", "") + ;create players table with sample data + CheckDatabaseUpdate(0, "CREATE table players (name, score, active, jerseyNum)") + CheckDatabaseUpdate(0, "INSERT INTO players VALUES ('Jones, Bob',0,'N',99)") + CheckDatabaseUpdate(0, "INSERT INTO players VALUES ('Jesten, Jim',0,'N',100)") + CheckDatabaseUpdate(0, "INSERT INTO players VALUES ('Jello, Frank',0,'N',101)") + + Define name$, score, active$, jerseynum + name$ = "Smith, Steve" + score = 42 + active$ ="TRUE" + jerseynum = 99 + SetDatabaseString(0, 0, name$) + SetDatabaseLong(0, 1, score) + SetDatabaseString(0, 2, active$) + SetDatabaseLong(0, 3, jerseynum) + CheckDatabaseUpdate(0, "UPDATE players SET name = ?, score = ?, active = ? WHERE jerseyNum = ?") + + ;display database contents + If DatabaseQuery(0, "Select * from players") + While NextDatabaseRow(0) + name$ = GetDatabaseString(0, 0) + score = GetDatabaseLong(0, 1) + active$ = GetDatabaseString(0, 2) + jerseynum = GetDatabaseLong(0, 3) + row$ = "['" + name$ + "', " + score + ", '" + active$ + "', " + jerseynum + "]" + PrintN(row$) + Wend + + FinishDatabaseQuery(0) + EndIf - If OpenDatabase(0, DatabaseFile$, "", "") - Result = DatabaseUpdate((0, "UPDATE "+table$+" SET name = '"+name$+"', score = '"+Str(score)+"', active = '"+active$+"' WHERE jerseyNum = "+Str(num)+";") - If Result = 0 - Debug DatabaseError() - EndIf CloseDatabase(0) - Else - Debug "Can't open database !" - EndIf + Else + PrintN("Can't open database !") + EndIf + + Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input() + CloseConsole() +EndIf diff --git a/Task/Parse-an-IP-Address/PowerShell/parse-an-ip-address-1.psh b/Task/Parse-an-IP-Address/PowerShell/parse-an-ip-address-1.psh new file mode 100644 index 0000000000..7ed850f0ac --- /dev/null +++ b/Task/Parse-an-IP-Address/PowerShell/parse-an-ip-address-1.psh @@ -0,0 +1,62 @@ +function Get-IpAddress +{ + [CmdletBinding()] + [OutputType([PSCustomObject])] + Param + ( + [Parameter(Mandatory=$true, + ValueFromPipeline=$true, + ValueFromPipelineByPropertyName=$true, + Position=0)] + $InputObject + ) + + Begin + { + function Get-Address ([string]$Address) + { + if ($Address.IndexOf(".") -ne -1) + { + $Address, $port = $Address.Split(":") + + [PSCustomObject]@{ + IPAddress = [System.Net.IPAddress]$Address + Port = $port + } + } + else + { + if ($Address.IndexOf("[") -ne -1) + { + [PSCustomObject]@{ + IPAddress = [System.Net.IPAddress]$Address + Port = ($Address.Split("]")[-1]).TrimStart(":") + } + } + else + { + [PSCustomObject]@{ + IPAddress = [System.Net.IPAddress]$Address + Port = $null + } + } + } + } + } + Process + { + $InputObject | ForEach-Object { + $address = Get-Address $_ + $bytes = ([System.Net.IPAddress]$address.IPAddress).GetAddressBytes() + [Array]::Reverse($bytes) + $i = 0 + $bytes | ForEach-Object -Begin {[bigint]$decimalIP = 0} ` + -Process {$decimalIP += [bigint]$_ * [bigint]::Pow(256, $i); $i++} ` + -End {[PSCustomObject]@{ + Address = $address.IPAddress + Port = $address.Port + Hex = "0x$($decimalIP.ToString('x'))"} + } + } + } +} diff --git a/Task/Parse-an-IP-Address/PowerShell/parse-an-ip-address-2.psh b/Task/Parse-an-IP-Address/PowerShell/parse-an-ip-address-2.psh new file mode 100644 index 0000000000..5b3efd8324 --- /dev/null +++ b/Task/Parse-an-IP-Address/PowerShell/parse-an-ip-address-2.psh @@ -0,0 +1,2 @@ +$ipAddresses = "127.0.0.1","127.0.0.1:80","::1","[::1]:80","2605:2700:0:3::4713:93e3","[2605:2700:0:3::4713:93e3]:80" | Get-IpAddress +$ipAddresses diff --git a/Task/Parse-an-IP-Address/PowerShell/parse-an-ip-address-3.psh b/Task/Parse-an-IP-Address/PowerShell/parse-an-ip-address-3.psh new file mode 100644 index 0000000000..1b11c51f60 --- /dev/null +++ b/Task/Parse-an-IP-Address/PowerShell/parse-an-ip-address-3.psh @@ -0,0 +1 @@ +$ipAddresses[5].Address diff --git a/Task/Parse-an-IP-Address/PowerShell/parse-an-ip-address-4.psh b/Task/Parse-an-IP-Address/PowerShell/parse-an-ip-address-4.psh new file mode 100644 index 0000000000..c216c1e4e7 --- /dev/null +++ b/Task/Parse-an-IP-Address/PowerShell/parse-an-ip-address-4.psh @@ -0,0 +1 @@ +$ipAddresses | where {$_.Address.AddressFamily -eq "InterNetworkV6" -and $_.Port -ne $null} diff --git a/Task/Parse-an-IP-Address/Ruby/parse-an-ip-address.rb b/Task/Parse-an-IP-Address/Ruby/parse-an-ip-address.rb index b9858c841f..26cb8a4dae 100644 --- a/Task/Parse-an-IP-Address/Ruby/parse-an-ip-address.rb +++ b/Task/Parse-an-IP-Address/Ruby/parse-an-ip-address.rb @@ -1,35 +1,12 @@ -require 'socket' require 'ipaddr' -IP_ADDRESSES = ["127.0.0.1", "127.0.0.1:80", + +TESTCASES = ["127.0.0.1", "127.0.0.1:80", "::1", "[::1]:80", - "2605:2700:0:3::4713:93e3", "[2605:2700:0:3::4713:93e3]:80", - "fe80::1%lo0", "1600 Pennsylvania Avenue NW"] -output = [] -output << %w(String Address Port Family Hex Scope?) -output << %w(------ ------- ---- ------ --- ------) + "2605:2700:0:3::4713:93e3", "[2605:2700:0:3::4713:93e3]:80"] -# Parse _string_ for an IP address and optional port number. Returns -# them in an Addrinfo object. -def parse_addr(string) - # Split host and port number from string. - case string - when /\A\[(?
    .* )\]:(? \d+ )\z/x # string like "[::1]:80" - address, port = $~[:address], $~[:port] - when /\A(?
    [^:]+ ):(? \d+ )\z/x # string like "127.0.0.1:80" - address, port = $~[:address], $~[:port] - else # string with no port number - address, port = string, nil - end - - # Pass address, port to Addrinfo.getaddrinfo. It will raise SocketError if address or port is not valid. - # IPAddr currently cannot handle ::1 notation, use Addrinfo instead - ary = Addrinfo.getaddrinfo(address, port) - - # An IP address is exactly one address. - ary.size == 1 or raise SocketError, "expected 1 address, found #{ary.size}" - ary.first -end +output = [%w(String Address Port Family Hex), + %w(------ ------- ---- ------ ---)] def output_table(rows) widths = [] @@ -38,27 +15,21 @@ def output_table(rows) rows.each {|row| puts format % row} end -family_hash = {Socket::AF_INET => "ipv4", Socket::AF_INET6 => "ipv6"} - -IP_ADDRESSES.each do |string| - begin - addr = parse_addr(string) - rescue SocketError - output << [string, "illegal address", '','','',''] - else - (cur_string ||= []) << string << addr.ip_address << addr.ip_port.to_s << family_hash[addr.afamily] # for output - - # Show address in hexadecimal. We must unpack it from sockaddr string. - if addr.ipv4? - # network byte order "N" - cur_string << "0x%08x" % IPAddr.new(addr.ip_address).hton.unpack('N') << "" - elsif addr.ipv6? - # 32 bytes for address, network byte order "N4" - cur_string << "0x%032x" % IPAddr.new(addr.ip_address).to_i - cur_string << (addr.ipv6_linklocal? ? ary[4] : "") # for Scope - end - output << cur_string +TESTCASES.each do |str| + case str # handle port; IPAddr does not. + when /\A\[(?
    .* )\]:(? \d+ )\z/x # string like "[::1]:80" + address, port = $~[:address], $~[:port] + when /\A(?
    [^:]+ ):(? \d+ )\z/x # string like "127.0.0.1:80" + address, port = $~[:address], $~[:port] + else # string with no port number + address, port = str, nil end + + ip_addr = IPAddr.new(address) + family = "IPv4" if ip_addr.ipv4? + family = "IPv6" if ip_addr.ipv6? + + output << [str, ip_addr.to_s, port.to_s, family, ip_addr.to_i.to_s(16)] end -output_table output +output_table(output) diff --git a/Task/Parsing-RPN-calculator-algorithm/00DESCRIPTION b/Task/Parsing-RPN-calculator-algorithm/00DESCRIPTION index 2c785bb46a..7d91cc6a52 100644 --- a/Task/Parsing-RPN-calculator-algorithm/00DESCRIPTION +++ b/Task/Parsing-RPN-calculator-algorithm/00DESCRIPTION @@ -1,14 +1,21 @@ -Create a stack-based evaluator for an expression in [[wp:Reverse Polish notation|reverse Polish notation]] that also shows the changes in the stack -as each individual token is processed ''as a table''. +;Task: +Create a stack-based evaluator for an expression in   [[wp:Reverse Polish notation|reverse Polish notation (RPN)]]   that also shows the changes in the stack as each individual token is processed ''as a table''. + * Assume an input of a correct, space separated, string of tokens of an RPN expression -* Test with the RPN expression generated from the [[Parsing/Shunting-yard algorithm]] task '3 4 2 * 1 5 - 2 3 ^ ^ / +' then print and display the output here. +* Test with the RPN expression generated from the   [[Parsing/Shunting-yard algorithm]]   task:
    +        3 4 2 * 1 5 - 2 3 ^ ^ / + +* Print or display the output here + + +;Notes: +*   '''^'''   means exponentiation in the expression above. +*   '''/'''   means division. -;Note: -* '^' means exponentiation in the expression above. ;See also: -* [[Parsing/Shunting-yard algorithm]] for a method of generating an RPN from an infix expression. -* Several solutions to [[24 game/Solve]] make use of RPN evaluators (although tracing how they work is not a part of that task). -* [[Parsing/RPN to infix conversion]]. -* [[Arithmetic evaluation]]. +*   [[Parsing/Shunting-yard algorithm]] for a method of generating an RPN from an infix expression. +*   Several solutions to [[24 game/Solve]] make use of RPN evaluators (although tracing how they work is not a part of that task). +*   [[Parsing/RPN to infix conversion]]. +*   [[Arithmetic evaluation]]. +

    diff --git a/Task/Parsing-RPN-calculator-algorithm/Ela/parsing-rpn-calculator-algorithm.ela b/Task/Parsing-RPN-calculator-algorithm/Ela/parsing-rpn-calculator-algorithm.ela index 8a0bba2342..f12bc7a473 100644 --- a/Task/Parsing-RPN-calculator-algorithm/Ela/parsing-rpn-calculator-algorithm.ela +++ b/Task/Parsing-RPN-calculator-algorithm/Ela/parsing-rpn-calculator-algorithm.ela @@ -1,21 +1,42 @@ -open string console list format read +open string generic monad io -eval str = writen "Input\tOperation\tStack after" $ - eval' (split " " str) [] - where eval' [] (s::_) = printfn "Result: {0}" s - eval' (x::xs) sta | "+"? = eval' xs <| op (+) - | "-"? = eval' xs <| op (-) - | "^"? = eval' xs <| op (**) - | "/"? = eval' xs <| op (/) - | "*"? = eval' xs <| op (*) - | else = eval' xs <| conv x - where c? = x == c - op (^) = out "Operate" st' $ st' - where st' = (head ss ^ s) :: tail ss - conv x = out "Push" st' $ st' - where st' = readStr x :: sta - (s,ss) | sta == [] = ((),[]) - | else = (head sta,tail sta) - out op st' = printfn "{0}\t{1}\t\t{2}" x op st' +type OpType = Push | Operate + deriving Show -eval "3 4 2 * 1 5 - 2 3 ^ ^ / +" +type Op = Op (OpType typ) input stack + deriving Show + +parse str = split " " str + +eval stack [] = [] +eval stack (x::xs) = op :: eval nst xs + where (op, nst) = conv x stack + conv "+"@x = operate x (+) + conv "-"@x = operate x (-) + conv "*"@x = operate x (*) + conv "/"@x = operate x (/) + conv "^"@x = operate x (**) + conv x = \stack -> + let n = gread x::stack in + (Op Push x n, n) + operate input fn (x::y::ys) = + let n = (y `fn` x) :: ys in + (Op Operate input n, n) + +print_line (Op typ input stack) = do + putStr input + putStr "\t" + put typ + putStr "\t\t" + putLn stack + +print ((Op typ input stack)@x::xs) lv = print_line x `seq` print xs (head stack) +print [] lv = lv + +print_result xs = do + putStrLn "Input\tOperation\tStack after" + res <- return $ print xs 0 + putStrLn ("Result: " ++ show res) + +res = parse "3 4 2 * 1 5 - 2 3 ^ ^ / +" |> eval [] +print_result res ::: IO diff --git a/Task/Parsing-RPN-calculator-algorithm/Fortran/parsing-rpn-calculator-algorithm.f b/Task/Parsing-RPN-calculator-algorithm/Fortran/parsing-rpn-calculator-algorithm.f new file mode 100644 index 0000000000..08ff74fc33 --- /dev/null +++ b/Task/Parsing-RPN-calculator-algorithm/Fortran/parsing-rpn-calculator-algorithm.f @@ -0,0 +1,48 @@ + REAL FUNCTION EVALRP(TEXT) !Evaluates a Reverse Polish string. +Caution: deals with single digits only. + CHARACTER*(*) TEXT !The RPN string. + INTEGER SP,STACKLIMIT !Needed for the evaluation. + PARAMETER (STACKLIMIT = 6) !This should do. + REAL*8 STACK(STACKLIMIT) !Though with ^ there's no upper limit. + INTEGER L,D !Assistants for the scan. + CHARACTER*4 DEED !A scratchpad for the annotation. + CHARACTER*1 C !The character of the moment. + WRITE (6,1) TEXT !A function that writes messages... Improper. + 1 FORMAT ("Evaluation of the Reverse Polish string ",A,// !Still, it's good to see stuff. + 1 "Char Token Action SP:Stack...") !Such as a heading for the trace. + SP = 0 !Commence with the stack empty. + STACK = -666 !This value should cause trouble. + DO L = 1,LEN(TEXT) !Step through the text. + C = TEXT(L:L) !Grab a character. + IF (C.LE." ") CYCLE !Boring. + D = ICHAR(C) - ICHAR("0") !Uncouth test to check for a digit. + IF (D.GE.0 .AND. D.LE.9) THEN !Is it one? + DEED = "Load" !Yes. So, load its value. + SP = SP + 1 !By going up one. + IF (SP.GT.STACKLIMIT) STOP "Stack overflow!" !Or, maybe not. + STACK(SP) = D !And stashing the value. + ELSE !Otherwise, it must be an operator. + IF (SP.LT.2) STOP "Stack underflow!" !They all require two operands. + DEED = "XEQ" !So, I'm about to do so. + SELECT CASE(C) !Which one this time? + CASE("+"); STACK(SP - 1) = STACK(SP - 1) + STACK(SP) !A + B = B + A, so it is easy. + CASE("-"); STACK(SP - 1) = STACK(SP - 1) - STACK(SP) !A is in STACK(SP - 1), B in STACK(SP) + CASE("*"); STACK(SP - 1) = STACK(SP - 1)*STACK(SP) !Again, order doesn't count. + CASE("/"); STACK(SP - 1) = STACK(SP - 1)/STACK(SP) !But for division, A/B becomes A B / + CASE("^"); STACK(SP - 1) = STACK(SP - 1)**STACK(SP) !So, this way around. + CASE DEFAULT !This should never happen! + STOP "Unknown operator!" !If the RPN script is indeed correct. + END SELECT !So much for that operator. + SP = SP - 1 !All of them take two operands and make one. + END IF !So much for that item. + WRITE (6,2) L,C,DEED,SP,STACK(1:SP) !Reveal the state now. + 2 FORMAT (I4,A6,A7,I4,":",66F14.6) !Aligned with the heading of FORMAT 1. + END DO !On to the next symbol. + EVALRP = STACK(1) !The RPN string being correct, this is the result. + END !Simple enough! + + PROGRAM HSILOP + REAL V + V = EVALRP("3 4 2 * 1 5 - 2 3 ^ ^ / +") !The specified example. + WRITE (6,*) "Result is...",V + END diff --git a/Task/Parsing-RPN-calculator-algorithm/Haskell/parsing-rpn-calculator-algorithm-1.hs b/Task/Parsing-RPN-calculator-algorithm/Haskell/parsing-rpn-calculator-algorithm-1.hs new file mode 100644 index 0000000000..a0797fa345 --- /dev/null +++ b/Task/Parsing-RPN-calculator-algorithm/Haskell/parsing-rpn-calculator-algorithm-1.hs @@ -0,0 +1,13 @@ +calcRPN :: String -> [Double] +calcRPN = foldl interprete [] . words + +interprete s x + | x `elem` ["+","-","*","/","^"] = operate x s + | otherwise = read x:s + where + operate op (x:y:s) = case op of + "+" -> x + y:s + "-" -> y - x:s + "*" -> x * y:s + "/" -> y / x:s + "^" -> y ** x:s diff --git a/Task/Parsing-RPN-calculator-algorithm/Haskell/parsing-rpn-calculator-algorithm-2.hs b/Task/Parsing-RPN-calculator-algorithm/Haskell/parsing-rpn-calculator-algorithm-2.hs new file mode 100644 index 0000000000..c72979c014 --- /dev/null +++ b/Task/Parsing-RPN-calculator-algorithm/Haskell/parsing-rpn-calculator-algorithm-2.hs @@ -0,0 +1,6 @@ +calcRPNLog :: String -> ([Double],[(String, [Double])]) +calcRPNLog input = mkLog $ zip commands $ tail result + where result = scanl interprete [] commands + commands = words input + mkLog [] = ([], []) + mkLog res = (snd $ last res, res) diff --git a/Task/Parsing-RPN-calculator-algorithm/Haskell/parsing-rpn-calculator-algorithm-3.hs b/Task/Parsing-RPN-calculator-algorithm/Haskell/parsing-rpn-calculator-algorithm-3.hs new file mode 100644 index 0000000000..b6f5af76e7 --- /dev/null +++ b/Task/Parsing-RPN-calculator-algorithm/Haskell/parsing-rpn-calculator-algorithm-3.hs @@ -0,0 +1,7 @@ +import Control.Monad (foldM) + +calcRPNIO :: String -> IO [Double] +calcRPNIO = foldM (verbose interprete) [] . words + +verbose f s x = write (x ++ "\t" ++ show res ++ "\n") >> return res + where res = f s x diff --git a/Task/Parsing-RPN-calculator-algorithm/Haskell/parsing-rpn-calculator-algorithm-4.hs b/Task/Parsing-RPN-calculator-algorithm/Haskell/parsing-rpn-calculator-algorithm-4.hs new file mode 100644 index 0000000000..acbc1d4f2c --- /dev/null +++ b/Task/Parsing-RPN-calculator-algorithm/Haskell/parsing-rpn-calculator-algorithm-4.hs @@ -0,0 +1,10 @@ +class Monad m => Logger m where + write :: String -> m () + +instance Logger IO where write = putStr +instance a ~ String => Logger (Writer a) where write = tell + +verbose2 f x y = write (show x ++ " " ++ + show y ++ " ==> " ++ + show res ++ "\n") >> return res + where res = f x y diff --git a/Task/Parsing-RPN-calculator-algorithm/Haskell/parsing-rpn-calculator-algorithm-5.hs b/Task/Parsing-RPN-calculator-algorithm/Haskell/parsing-rpn-calculator-algorithm-5.hs new file mode 100644 index 0000000000..dee30e7697 --- /dev/null +++ b/Task/Parsing-RPN-calculator-algorithm/Haskell/parsing-rpn-calculator-algorithm-5.hs @@ -0,0 +1,2 @@ +calcRPNM :: Logger m => String -> m [Double] +calcRPNM = foldM (verbose interprete) [] . words diff --git a/Task/Parsing-RPN-calculator-algorithm/Haskell/parsing-rpn-calculator-algorithm.hs b/Task/Parsing-RPN-calculator-algorithm/Haskell/parsing-rpn-calculator-algorithm.hs deleted file mode 100644 index 5e1b6759a4..0000000000 --- a/Task/Parsing-RPN-calculator-algorithm/Haskell/parsing-rpn-calculator-algorithm.hs +++ /dev/null @@ -1,15 +0,0 @@ -import Data.List (elemIndex) - --- Show results -main = mapM_ (\(x, y) -> putStrLn $ x ++ " ==> " ++ show y) $ reverse $ zip b (a:c) - where (a, b, c) = solve "3 4 2 * 1 5 - 2 3 ^ ^ / +" - --- Solve and report RPN -solve = foldl reduce ([], [], []) . words -reduce (xs, ps, st) w = - if i == Nothing - then (read w:xs, ("Pushing " ++ w):ps, xs:st) - else (([(*),(+),(-),(/),(**)]!!o) a b:zs, ("Performing " ++ w):ps, xs:st) - where i = elemIndex (head w) "*+-/^" - Just o = i - (b:a:zs) = xs diff --git a/Task/Parsing-RPN-calculator-algorithm/Mathematica/parsing-rpn-calculator-algorithm.math b/Task/Parsing-RPN-calculator-algorithm/Mathematica/parsing-rpn-calculator-algorithm.math index 98d847d280..e3f6a41fd1 100644 --- a/Task/Parsing-RPN-calculator-algorithm/Mathematica/parsing-rpn-calculator-algorithm.math +++ b/Task/Parsing-RPN-calculator-algorithm/Mathematica/parsing-rpn-calculator-algorithm.math @@ -1,12 +1,9 @@ calc[rpn_] := - Module[{tokens = StringSplit[rpn], steps}, - steps = FoldList[ - Switch[#2, _?DigitQ, Append[#, FromDigits[#2]], "^", - Append[#[[;; -3]], #[[-2]]^#[[-1]]], "*", - Append[#[[;; -3]], #[[-2]] #[[-1]]], "/", - Append[#[[;; -3]], #[[-2]]/#[[-1]]], "+", - Append[#[[;; -3]], #[[-2]] + #[[-1]]], "-", - Append[#[[;; -3]], #[[-2]] - #[[-1]]]] &, {}, tokens][[2 ;;]]; - Grid[Transpose[{# <> ":" & /@ tokens, + Module[{tokens = StringSplit[rpn], s = "(" <> ToString@InputForm@# <> ")" &, op, steps}, + op[o_, x_, y_] := ToExpression[s@x <> o <> s@y]; + steps = FoldList[Switch[#2, _?DigitQ, Append[#, FromDigits[#2]], + _, Append[#[[;; -3]], op[#2, #[[-2]], #[[-1]]]] + ] &, {}, tokens][[2 ;;]]; + Grid[Transpose[{# <> ":" & /@ tokens, StringRiffle[ToString[#, InputForm] & /@ #] & /@ steps}]]]; Print[calc["3 4 2 * 1 5 - 2 3 ^ ^ / +"]]; diff --git a/Task/Parsing-RPN-calculator-algorithm/PowerShell/parsing-rpn-calculator-algorithm.psh b/Task/Parsing-RPN-calculator-algorithm/PowerShell/parsing-rpn-calculator-algorithm.psh new file mode 100644 index 0000000000..7d518c79a4 --- /dev/null +++ b/Task/Parsing-RPN-calculator-algorithm/PowerShell/parsing-rpn-calculator-algorithm.psh @@ -0,0 +1,132 @@ +function Invoke-Rpn +{ + <# + .SYNOPSIS + A stack-based evaluator for an expression in reverse Polish notation. + .DESCRIPTION + A stack-based evaluator for an expression in reverse Polish notation. + + All methods in the Math and Decimal classes are available. + .PARAMETER Expression + A space separated, string of tokens. + .PARAMETER DisplayState + This switch shows the changes in the stack as each individual token is processed as a table. + .EXAMPLE + Invoke-Rpn -Expression "3 4 Max" + .EXAMPLE + Invoke-Rpn -Expression "3 4 Log2" + .EXAMPLE + Invoke-Rpn -Expression "3 4 2 * 1 5 - 2 3 ^ ^ / +" + .EXAMPLE + Invoke-Rpn -Expression "3 4 2 * 1 5 - 2 3 ^ ^ / +" -DisplayState +#> + [CmdletBinding()] + Param + ( + [Parameter(Mandatory=$true)] + [AllowEmptyString()] + [string] + $Expression, + + [Parameter(Mandatory=$false)] + [switch] + $DisplayState + ) + Begin + { + function Out-State ([System.Collections.Stack]$Stack) + { + $array = $Stack.ToArray() + [Array]::Reverse($array) + $array | ForEach-Object -Process { Write-Host ("{0,-8:F3}" -f $_) -NoNewline } -End { Write-Host } + } + + function New-RpnEvaluation + { + $stack = New-Object -Type System.Collections.Stack + + $shortcuts = @{ + "+" = "Add"; "-" = "Subtract"; "/" = "Divide"; "*" = "Multiply"; "%" = "Remainder"; "^" = "Pow" + } + + :ARGUMENT_LOOP foreach ($argument in $args) + { + if ($DisplayState -and $stack.Count) + { + Out-State $stack + } + + if ($shortcuts[$argument]) + { + $argument = $shortcuts[$argument] + } + + try + { + $stack.Push([decimal]$argument) + continue + } + catch + { + } + + $argCountList = $argument -replace "(\D+)(\d*)",‘$2’ + $operation = $argument.Substring(0, $argument.Length – $argCountList.Length) + + foreach($type in [Decimal],[Math]) + { + if ($definition = $type::$operation) + { + if (-not $argCountList) + { + $argCountList = $definition.OverloadDefinitions | + Foreach-Object { ($_ -split ", ").Count } | + Sort-Object -Unique + } + + foreach ($argCount in $argCountList) + { + try + { + $methodArguments = $stack.ToArray()[($argCount–1)..0] + $result = $type::$operation.Invoke($methodArguments) + + $null = 1..$argCount | Foreach-Object { $stack.Pop() } + + $stack.Push($result) + + continue ARGUMENT_LOOP + } + catch + { + ## If error, try with the next number of arguments + } + } + } + } + } + + if ($DisplayState -and $stack.Count) + { + Out-State $stack + if ($stack.Count) + { + Write-Host "`nResult = $($stack.Peek())" + } + } + else + { + $stack + } + } + } + Process + { + Invoke-Expression -Command "New-RpnEvaluation $Expression" + } + End + { + } +} + +Invoke-Rpn -Expression "3 4 2 * 1 5 - 2 3 ^ ^ / +" -DisplayState diff --git a/Task/Parsing-RPN-calculator-algorithm/Python/parsing-rpn-calculator-algorithm.py b/Task/Parsing-RPN-calculator-algorithm/Python/parsing-rpn-calculator-algorithm-1.py similarity index 100% rename from Task/Parsing-RPN-calculator-algorithm/Python/parsing-rpn-calculator-algorithm.py rename to Task/Parsing-RPN-calculator-algorithm/Python/parsing-rpn-calculator-algorithm-1.py diff --git a/Task/Parsing-RPN-calculator-algorithm/Python/parsing-rpn-calculator-algorithm-2.py b/Task/Parsing-RPN-calculator-algorithm/Python/parsing-rpn-calculator-algorithm-2.py new file mode 100644 index 0000000000..5ca0ea38de --- /dev/null +++ b/Task/Parsing-RPN-calculator-algorithm/Python/parsing-rpn-calculator-algorithm-2.py @@ -0,0 +1,6 @@ +a=[] +b={'+': lambda x,y: y+x, '-': lambda x,y: y-x, '*': lambda x,y: y*x,'/': lambda x,y:y/x,'^': lambda x,y:y**x} +for c in '3 4 2 * 1 5 - 2 3 ^ ^ / +'.split(): + if c in b: a.append(b[c](a.pop(),a.pop())) + else: a.append(float(c)) + print c, a diff --git a/Task/Parsing-RPN-calculator-algorithm/REXX/parsing-rpn-calculator-algorithm-2.rexx b/Task/Parsing-RPN-calculator-algorithm/REXX/parsing-rpn-calculator-algorithm-2.rexx index 17482cd7fc..6bb3077d76 100644 --- a/Task/Parsing-RPN-calculator-algorithm/REXX/parsing-rpn-calculator-algorithm-2.rexx +++ b/Task/Parsing-RPN-calculator-algorithm/REXX/parsing-rpn-calculator-algorithm-2.rexx @@ -1,27 +1,29 @@ -/*REXX program evaluates a Reverse Polish notation (RPN) expression.*/ -parse arg x; if x='' then x = '3 4 2 * 1 5 - 2 3 ^ ^ / +'; ox=x -showSteps=1 /*set to 0 (zero) if working steps not wanted.*/ -x=space(x); tokens=words(x) - do i=1 for tokens; @.i=word(x,i); end /*i*/ /*assign input tokens*/ -L=max(20,length(x)) /*use 20 for the min show width. */ -numeric digits L /*ensure enough digits for answer*/ -say center('operand',L,'─') center('stack',L*2,'─'); e='***error!***' -op='- + / * ^'; add2s='add to───►stack'; z=; stack= - - do #=1 for tokens; ?=@.#; ??=? /*process each token from @. list*/ - w=words(stack) /*stack count (# entries).*/ - if datatype(?,'N') then do; stack=stack ?; call show add2s; iterate; end - if ?=='^' then ??="**" /*REXXify ^ ──► ** (make legal)*/ - interpret 'y=' word(stack,w-1) ?? word(stack,w) /*compute.*/ - if datatype(y,'W') then y=y/1 /*normalize the number with ÷ */ - _=subword(stack,1,w-2); stack=_ y /*rebuild the stack with answer. */ - call show ? - end /*#*/ - -z=space(z stack) /*append any residual entries. */ -say; say ' RPN input:' ox; say ' answer──►' z /*show input & ans.*/ -parse source upper . y . /*invoked via C.L. or REXX pgm?*/ -if y=='COMMAND' | \datatype(z,'W') then exit /*stick a fork in it, done.*/ - else return z /*RESULT ──► invoker.*/ -/*──────────────────────────────────SHOW subroutine─────────────────────*/ -show: if showSteps then say center(arg(1),L) left(space(stack),L); return +/*REXX program evaluates a ═════ Reverse Polish notation (RPN) ═════ expression. */ +parse arg x /*obtain optional arguments from the CL*/ +if x='' then x= "3 4 2 * 1 5 - 2 3 ^ ^ / +" /*Not specified? Then use the default.*/ +tokens=words(x) /*save the number of tokens " ". */ +showSteps=1 /*set to 0 if working steps not wanted.*/ +ox=x /*save the original value of X. */ + do i=1 for tokens; @.i=word(x,i) /*assign the input tokens to an array. */ + end /*i*/ +x=space(x) /*remove any superfluous blanks in X. */ +L=max(20, length(x)) /*use 20 for the minimum display width.*/ +numeric digits L /*ensure enough decimal digits for ans.*/ +say center('operand', L, "─") center('stack', L+L, "─") /*display title*/ +$= /*nullify the stack (completely empty).*/ + do k=1 for tokens; ?=@.k; ??=? /*process each token from the @. list.*/ + #=words($) /*stack the count (the number entries).*/ + if datatype(?,'N') then do; $=$ ?; call show "add to───►stack"; iterate; end + if ?=='^' then ??= "**" /*REXXify ^ ───► ** (make legal).*/ + interpret 'y='word($,#-1) ?? word($,#) /*compute via the famous REXX INTERPRET*/ + if datatype(y,'N') then y=y/1 /*normalize the number with ÷ by unity.*/ + $=subword($, 1, #-2) y /*rebuild the stack with the answer. */ + call show ? /*display steps (tracing into), maybe.*/ + end /*k*/ +say /*display a blank line, better perusing*/ +say ' RPN input:' ox; say " answer──►"$ /*display original input; display ans.*/ +parse source upper . y . /*invoked via C.L. or via a REXX pgm?*/ +if y=='COMMAND' | \datatype($,"W") then exit /*stick a fork in it, we're all done. */ + else exit $ /*return the answer ───► the invoker.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +show: if showSteps then say center(arg(1), L) left(space($), L); return diff --git a/Task/Parsing-RPN-calculator-algorithm/REXX/parsing-rpn-calculator-algorithm-3.rexx b/Task/Parsing-RPN-calculator-algorithm/REXX/parsing-rpn-calculator-algorithm-3.rexx index aa7ba69871..ff056ad95c 100644 --- a/Task/Parsing-RPN-calculator-algorithm/REXX/parsing-rpn-calculator-algorithm-3.rexx +++ b/Task/Parsing-RPN-calculator-algorithm/REXX/parsing-rpn-calculator-algorithm-3.rexx @@ -1,42 +1,43 @@ -/*REXX program evaluates a Reverse Polish notation (RPN) expression.*/ -parse arg x; if x='' then x = '3 4 2 * 1 5 - 2 3 ^ ^ / +'; ox=x -showSteps=1 /*set to 0 (zero) if working steps not wanted.*/ -x=space(x); tokens=words(x) /*elide extra blanks;count tokens*/ - do i=1 for tokens; @.i=word(x,i); end /*i*/ /*assign input tokens*/ -L=max(20,length(x)) /*use 20 for the min show width. */ -numeric digits L /*ensure enough digits for answer*/ -say center('operand',L,'─') center('stack',L*2,'─'); e='***error!***' -add2s='add to───►stack'; z=; stack= -dop='/ // % ÷'; bop='& | &&' /*division ops; binary operands*/ -aop='- + * ^ **' dop bop; lop=aop '||' /*arithmetic ops; legal operands*/ - - do #=1 for tokens; ?=@.#; ??=? /*process each token from @. list*/ - w=words(stack); b=word(stack,max(1,w)) /*stack count; last entry.*/ - a=word(stack,max(1,w-1)) /*stack's "first" operand.*/ - division =wordpos(?,dop)\==0 /*flag: doing a division.*/ - arith =wordpos(?,aop)\==0 /*flag: doing arithmetic.*/ - bitOp =wordpos(?,bop)\==0 /*flag: doing binary math*/ - if datatype(?,'N') then do; stack=stack ?; call show add2s; iterate; end - if wordpos(?,lop)==0 then do; z=e 'illegal operator:' ?; leave; end - if w<2 then do; z=e 'illegal RPN expression.'; leave; end - if ?=='^' then ??="**" /*REXXify ^ ──► ** (make legal)*/ - if ?=='÷' then ??="/" /*REXXify ÷ ──► / (make legal)*/ - if division & b=0 then do; z=e 'division by zero: ' b; leave; end - if bitOp & \isBit(a) then do; z=e "token isn't logical: " a; leave; end - if bitOp & \isBit(b) then do; z=e "token isn't logical: " b; leave; end - interpret 'y=' a ?? b /*compute with two stack operands*/ - if datatype(y,'W') then y=y/1 /*normalize number with ÷ by 1.*/ - _=subword(stack,1,w-2); stack=_ y /*rebuild the stack with answer. */ - call show ? - end /*#*/ - -if word(z,1)==e then stack= /*handle special case of errors. */ -z=space(z stack) /*append any residual entries. */ -say; say ' RPN input:' ox; say ' answer──►' z /*show input & ans.*/ -parse source upper . how . /*invoked via C.L. or REXX pgm?*/ -if how=='COMMAND' | , - \datatype(z,'W') then exit /*stick a fork in it, we're done.*/ -return z /*return Z ──► invoker (RESULT).*/ -/*──────────────────────────────────subroutines─────────────────────────*/ -isBit: return arg(1)==0 | arg(1)==1 /*returns 1 if arg1 is bin bit.*/ -show: if showSteps then say center(arg(1),L) left(space(stack),L); return +/*REXX program evaluates a ═════ Reverse Polish notation (RPN) ═════ expression. */ +parse arg x /*obtain optional arguments from the CL*/ +if x='' then x= "3 4 2 * 1 5 - 2 3 ^ ^ / +" /*Not specified? Then use the default.*/ +tokens=words(x) /*save the number of tokens " ". */ +showSteps=1 /*set to 0 if working steps not wanted.*/ +ox=x /*save the original value of X. */ + do i=1 for tokens; @.i=word(x,i) /*assign the input tokens to an array. */ + end /*i*/ +x=space(x) /*remove any superfluous blanks in X. */ +L=max(20, length(x)) /*use 20 for the minimum display width.*/ +numeric digits L /*ensure enough decimal digits for ans.*/ +say center('operand', L, "─") center('stack', L+L, "─") /*display title*/ +Dop= '/ // % ÷'; Bop='& | &&' /*division operators; binary operands.*/ +Aop= '- + * ^ **' Dop Bop; Lop=Aop "||" /*arithmetic operators; legal operands.*/ +$= /*nullify the stack (completely empty).*/ + do k=1 for tokens; ?=@.k; ??=? /*process each token from the @. list.*/ + #=words($); b=word($, max(1, #) ) /*the stack count; the last entry. */ + a=word($, max(1, #-1) ) /*stack's "first" operand. */ + division =wordpos(?, Dop)\==0 /*flag: doing a some kind of division.*/ + arith =wordpos(?, Aop)\==0 /*flag: doing arithmetic. */ + bitOp =wordpos(?, Bop)\==0 /*flag: doing some kind of binary oper*/ + if datatype(?, 'N') then do; $=$ ?; call show "add to───►stack"; iterate; end + if wordpos(?, Lop)==0 then do; $=e 'illegal operator:' ?; leave; end + if w<2 then do; $=e 'illegal RPN expression.'; leave; end + if ?=='^' then ??= "**" /*REXXify ^ ──► ** (make it legal). */ + if ?=='÷' then ??= "/" /*REXXify ÷ ──► / (make it legal). */ + if division & b=0 then do; $=e 'division by zero.' ; leave; end + if bitOp & \isBit(a) then do; $=e "token isn't logical: " a; leave; end + if bitOp & \isBit(b) then do; $=e "token isn't logical: " b; leave; end + interpret 'y=' a ?? b /*compute with two stack operands*/ + if datatype(y, 'W') then y=y/1 /*normalize the number with ÷ by unity.*/ + _=subword($, 1, #-2); $=_ y /*rebuild the stack with the answer. */ + call show ? /*display (possibly) a working step. */ + end /*k*/ +say /*display a blank line, better perusing*/ +if word($,1)==e then $= /*handle the special case of errors. */ +say ' RPN input:' ox; say " answer───►"$ /*display original input; display ans.*/ +parse source upper . y . /*invoked via C.L. or via a REXX pgm?*/ +if y=='COMMAND' | \datatype($,"W") then exit /*stick a fork in it, we're all done. */ + else exit $ /*return the answer ───► the invoker.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +isBit: return arg(1)==0 | arg(1)==1 /*returns 1 if arg1 is a binary bit*/ +show: if showSteps then say center(arg(1), L) left(space($), L); return diff --git a/Task/Parsing-RPN-to-infix-conversion/00DESCRIPTION b/Task/Parsing-RPN-to-infix-conversion/00DESCRIPTION index 8cc2375406..44a320c32e 100644 --- a/Task/Parsing-RPN-to-infix-conversion/00DESCRIPTION +++ b/Task/Parsing-RPN-to-infix-conversion/00DESCRIPTION @@ -1,3 +1,4 @@ +;Task: Create a program that takes an [[wp:Reverse Polish notation|RPN]] representation of an expression formatted as a space separated sequence of tokens and generates the equivalent expression in [[wp:Infix notation|infix notation]]. * Assume an input of a correct, space separated, string of tokens @@ -12,26 +13,25 @@ Create a program that takes an [[wp:Reverse Polish notation|RPN]] representation | 1 2 + 3 4 + ^ 5 6 + ^|| ( ( 1 + 2 ) ^ ( 3 + 4 ) ) ^ ( 5 + 6 ) |} -* Operator precedence is given in this table: +* Operator precedence and operator associativity is given in this table: :{| class="wikitable" -! operator !! [[wp:Order_of_operations|precedence]] !! [[wp:Operator_associativity|associativity]] +! operator !! [[wp:Order_of_operations|precedence]] !! [[wp:Operator_associativity|associativity]] !! operation |- || align="center" -| ^ || 4 || Right +| ^ || 4 || right || exponentiation |- || align="center" -| * || 3 || Left +| * || 3 || left || multiplication |- || align="center" -| / || 3 || Left +| / || 3 || left || division |- || align="center" -| + || 2 || Left +| + || 2 || left || addition |- || align="center" -| - || 2 || Left +| - || 2 || left || subtraction |} -;Note: -* '^' means exponentiation. ;See also: -* [[Parsing/Shunting-yard algorithm]] for a method of generating an RPN from an infix expression. -* [[Parsing/RPN calculator algorithm]] for a method of calculating a final value from this output RPN expression. -* [http://www.rubyquiz.com/quiz148.html Postfix to infix] from the RubyQuiz site. +*   [[Parsing/Shunting-yard algorithm]]   for a method of generating an RPN from an infix expression. +*   [[Parsing/RPN calculator algorithm]]   for a method of calculating a final value from this output RPN expression. +*   [http://www.rubyquiz.com/quiz148.html Postfix to infix]   from the RubyQuiz site. +

    diff --git a/Task/Parsing-RPN-to-infix-conversion/Common-Lisp/parsing-rpn-to-infix-conversion.lisp b/Task/Parsing-RPN-to-infix-conversion/Common-Lisp/parsing-rpn-to-infix-conversion.lisp new file mode 100644 index 0000000000..a09f593c22 --- /dev/null +++ b/Task/Parsing-RPN-to-infix-conversion/Common-Lisp/parsing-rpn-to-infix-conversion.lisp @@ -0,0 +1,59 @@ +;;;; Parsing/RPN to infix conversion +(defstruct (node (:print-function print-node)) opr infix) +(defun print-node (node stream depth) + (format stream "opr:=~A infix:=\"~A\"" (node-opr node) (node-infix node))) + +(defconstant OPERATORS '((#\^ . 4) (#\* . 3) (#\/ . 3) (#\+ . 2) (#\- . 2))) + +;;; (char,char[,boolean])->boolean +(defun higher-p (opp opc &optional (left-node-p nil)) + (or (> (cdr (assoc opp OPERATORS)) (cdr (assoc opc OPERATORS))) + (and left-node-p (char= opp #\^) (char= opc #\^)))) + +;;; string->list +(defun string-split (expr) + (let ((p (position #\Space expr))) + (if (null p) (list expr) + (append (list (subseq expr 0 p)) + (string-split (subseq expr (1+ p))))))) + +;;; string->string +(defun parse (expr) + (let ((stack '())) + (format t "TOKEN STACK~%") + (dolist (tok (string-split expr)) + (if (assoc (char tok 0) OPERATORS) ; operator? + (push (make-node :opr (char tok 0) :infix (infix (char tok 0) (pop stack) (pop stack))) stack) + (push tok stack)) + + ;; print stack at each token + (format t "~3,A" tok) + (dotimes (i (length stack)) (format t "~8,T[~D] ~A~%" i (nth i stack)))) + + ;; print final infix expression + (if (= (length stack) 1) + (format nil "~A" (node-infix (first stack))) + (format nil "syntax error in ~A" expr)))) + +;;; (char,node,node)->string +(defun infix (operator rightn leftn) + + ;; (char,node[,boolean]->string + (defun string-node (operator anode &optional (left-node-p nil)) + (if (stringp anode) anode + (if (higher-p operator (node-opr anode) left-node-p) + (format nil "( ~A )" (node-infix anode)) (node-infix anode)))) + + (concatenate 'string + (string-node operator leftn t) + (format nil " ~A " operator) + (string-node operator rightn))) + +;;; nil->[printed infix expressions] +(defun main () + (let ((expressions '("3 4 2 * 1 5 - 2 3 ^ ^ / +" + "1 2 + 3 4 + ^ 5 6 + ^" + "3 4 ^ 2 9 ^ ^ 2 5 ^ ^"))) + (dolist (expr expressions) + (format t "~%Parsing:\"~A\"~%" expr) + (format t "RPN:\"~A\" INFIX:\"~A\"~%" expr (parse expr))))) diff --git a/Task/Parsing-RPN-to-infix-conversion/JavaScript/parsing-rpn-to-infix-conversion.js b/Task/Parsing-RPN-to-infix-conversion/JavaScript/parsing-rpn-to-infix-conversion.js new file mode 100644 index 0000000000..7ac4a72f1c --- /dev/null +++ b/Task/Parsing-RPN-to-infix-conversion/JavaScript/parsing-rpn-to-infix-conversion.js @@ -0,0 +1,59 @@ +const Associativity = { + /** a / b / c = (a / b) / c */ + left: 0, + /** a ^ b ^ c = a ^ (b ^ c) */ + right: 1, + /** a + b + c = (a + b) + c = a + (b + c) */ + both: 2, +}; +const operators = { + '+': { precedence: 2, associativity: Associativity.both }, + '-': { precedence: 2, associativity: Associativity.left }, + '*': { precedence: 3, associativity: Associativity.both }, + '/': { precedence: 3, associativity: Associativity.left }, + '^': { precedence: 4, associativity: Associativity.right }, +}; +class NumberNode { + constructor(text) { this.text = text; } + toString() { return this.text; } +} +class InfixNode { + constructor(fnname, operands) { + this.fnname = fnname; + this.operands = operands; + } + toString(parentPrecedence = 0) { + const op = operators[this.fnname]; + const leftAdd = op.associativity === Associativity.right ? 0.01 : 0; + const rightAdd = op.associativity === Associativity.left ? 0.01 : 0; + if (this.operands.length !== 2) throw Error("invalid operand count"); + const result = this.operands[0].toString(op.precedence + leftAdd) + +` ${this.fnname} ${this.operands[1].toString(op.precedence + rightAdd)}`; + if (parentPrecedence > op.precedence) return `( ${result} )`; + else return result; + } +} +function rpnToTree(tokens) { + const stack = []; + console.log(`input = ${tokens}`); + for (const token of tokens.split(" ")) { + if (token in operators) { + const op = operators[token], arity = 2; // all of these operators take 2 arguments + if (stack.length < arity) throw Error("stack error"); + stack.push(new InfixNode(token, stack.splice(stack.length - arity))); + } + else stack.push(new NumberNode(token)); + console.log(`read ${token}, stack = [${stack.join(", ")}]`); + } + if (stack.length !== 1) throw Error("stack error " + stack); + return stack[0]; +} +const tests = [ + ["3 4 2 * 1 5 - 2 3 ^ ^ / +", "3 + 4 * 2 / ( 1 - 5 ) ^ 2 ^ 3"], + ["1 2 + 3 4 + ^ 5 6 + ^", "( ( 1 + 2 ) ^ ( 3 + 4 ) ) ^ ( 5 + 6 )"], + ["1 2 3 + +", "1 + 2 + 3"] // test associativity (1+(2+3)) == (1+2+3) +]; +for (const [inp, oup] of tests) { + const realOup = rpnToTree(inp).toString(); + console.log(realOup === oup ? "Correct!" : "Incorrect!"); +} diff --git a/Task/Parsing-RPN-to-infix-conversion/Perl-6/parsing-rpn-to-infix-conversion.pl6 b/Task/Parsing-RPN-to-infix-conversion/Perl-6/parsing-rpn-to-infix-conversion.pl6 index 7e1dd6d3c6..4ec8d5698f 100644 --- a/Task/Parsing-RPN-to-infix-conversion/Perl-6/parsing-rpn-to-infix-conversion.pl6 +++ b/Task/Parsing-RPN-to-infix-conversion/Perl-6/parsing-rpn-to-infix-conversion.pl6 @@ -16,7 +16,7 @@ sub rpm-to-infix($string) { when '^' { @stack.push: 4 => ~(p($x,5), $_, p($y,4)) } when '*' | '/' { @stack.push: 3 => ~(p($x,3), $_, p($y,3)) } when '+' | '-' { @stack.push: 2 => ~(p($x,2), $_, p($y,2)) } - LEAVE { say @stack } + # LEAVE { say @stack } # phaser not yet implemented in this context } say "-----------------"; @stack».value; diff --git a/Task/Parsing-RPN-to-infix-conversion/TXR/parsing-rpn-to-infix-conversion.txr b/Task/Parsing-RPN-to-infix-conversion/TXR/parsing-rpn-to-infix-conversion.txr index 7fec316924..e40c5efb99 100644 --- a/Task/Parsing-RPN-to-infix-conversion/TXR/parsing-rpn-to-infix-conversion.txr +++ b/Task/Parsing-RPN-to-infix-conversion/TXR/parsing-rpn-to-infix-conversion.txr @@ -1,64 +1,63 @@ -@(do - ;; alias for circumflex, which is reserved syntax - (defvar exp (intern "^")) +;; alias for circumflex, which is reserved syntax +(defvar exp (intern "^")) - (defvar *prec* ^((,exp . 4) (* . 3) (/ . 3) (+ . 2) (- . 2))) +(defvar *prec* ^((,exp . 4) (* . 3) (/ . 3) (+ . 2) (- . 2))) - (defvar *asso* ^((,exp . :right) (* . nil) - (/ . :left) (+ . nil) (- . :left))) +(defvar *asso* ^((,exp . :right) (* . nil) + (/ . :left) (+ . nil) (- . :left))) - (defun debug-print (label val) - (format t "~a: ~a\n" label val) - val) +(defun debug-print (label val) + (format t "~a: ~a\n" label val) + val) - (defun rpn-to-lisp (rpn) - (let (stack) - (each ((term rpn)) - (if (symbolp (debug-print "rpn term" term)) - (let ((right (pop stack)) - (left (pop stack))) - (push ^(,term ,left ,right) stack)) - (push term stack)) - (debug-print "stack" stack)) - (if (rest stack) - (return-from error "*excess stack elements*")) - (debug-print "lisp" (pop stack)))) +(defun rpn-to-lisp (rpn) + (let (stack) + (each ((term rpn)) + (if (symbolp (debug-print "rpn term" term)) + (let ((right (pop stack)) + (left (pop stack))) + (push ^(,term ,left ,right) stack)) + (push term stack)) + (debug-print "stack" stack)) + (if (rest stack) + (return-from error "*excess stack elements*")) + (debug-print "lisp" (pop stack)))) - (defun prec (term) - (or (cdr (assoc term *prec*)) 99)) +(defun prec (term) + (or (cdr (assoc term *prec*)) 99)) - (defun asso (term dfl) - (or (cdr (assoc term *asso*)) dfl)) +(defun asso (term dfl) + (or (cdr (assoc term *asso*)) dfl)) - (defun inf-term (op term left-or-right) - (if (atom term) - `@term` - (let ((pt (prec (car term))) - (po (prec op)) - (at (asso (car term) left-or-right)) - (ao (asso op left-or-right))) - (cond - ((< pt po) `(@(lisp-to-infix term))`) - ((> pt po) `@(lisp-to-infix term)`) - ((and (eq at ao) (eq left-or-right ao)) `@(lisp-to-infix term)`) - (t `(@(lisp-to-infix term))`))))) +(defun inf-term (op term left-or-right) + (if (atom term) + `@term` + (let ((pt (prec (car term))) + (po (prec op)) + (at (asso (car term) left-or-right)) + (ao (asso op left-or-right))) + (cond + ((< pt po) `(@(lisp-to-infix term))`) + ((> pt po) `@(lisp-to-infix term)`) + ((and (eq at ao) (eq left-or-right ao)) `@(lisp-to-infix term)`) + (t `(@(lisp-to-infix term))`))))) - (defun lisp-to-infix (lisp) - (tree-case lisp - ((op left right) (let ((left-inf (inf-term op left :left)) - (right-inf (inf-term op right :right))) - `@{left-inf} @op @{right-inf}`)) - (() (return-from error "*stack underflow*")) - (else `@lisp`))) +(defun lisp-to-infix (lisp) + (tree-case lisp + ((op left right) (let ((left-inf (inf-term op left :left)) + (right-inf (inf-term op right :right))) + `@{left-inf} @op @{right-inf}`)) + (() (return-from error "*stack underflow*")) + (else `@lisp`))) - (defun string-to-rpn (str) - (debug-print "rpn" - (mapcar (do if (int-str @1) (int-str @1) (intern @1)) - (tok-str str #/[^ \t]+/)))) +(defun string-to-rpn (str) + (debug-print "rpn" + (mapcar (do if (int-str @1) (int-str @1) (intern @1)) + (tok-str str #/[^ \t]+/)))) - (debug-print "infix" - (block error - (tree-case *args* - ((a b . c) "*excess args*") - ((a) (lisp-to-infix (rpn-to-lisp (string-to-rpn a)))) - (else "*arg needed*"))))) +(debug-print "infix" + (block error + (tree-case *args* + ((a b . c) "*excess args*") + ((a) (lisp-to-infix (rpn-to-lisp (string-to-rpn a)))) + (else "*arg needed*")))) diff --git a/Task/Parsing-Shunting-yard-algorithm/00DESCRIPTION b/Task/Parsing-Shunting-yard-algorithm/00DESCRIPTION index 994acfc880..e22893c5c5 100644 --- a/Task/Parsing-Shunting-yard-algorithm/00DESCRIPTION +++ b/Task/Parsing-Shunting-yard-algorithm/00DESCRIPTION @@ -1,32 +1,38 @@ -Given the operator characteristics and input from the [[wp:Shunting-yard_algorithm|Shunting-yard algorithm]] page and tables -Use the algorithm to show the changes in the operator stack and RPN output +;Task: +Given the operator characteristics and input from the [[wp:Shunting-yard_algorithm|Shunting-yard algorithm]] page and tables, use the algorithm to show the changes in the operator stack and RPN output as each individual token is processed. * Assume an input of a correct, space separated, string of tokens representing an infix expression * Generate a space separated output string representing the RPN -* Test with the input string '3 + 4 * 2 / ( 1 - 5 ) ^ 2 ^ 3' then print and display the output here. +* Test with the input string: +:::: 3 + 4 * 2 / ( 1 - 5 ) ^ 2 ^ 3 +* print and display the output here. * Operator precedence is given in this table: :{| class="wikitable" -! operator !! precedence !! associativity +! operator !! [[wp:Order_of_operations|precedence]] !! [[wp:Operator_associativity|associativity]] !! operation |- || align="center" -| ^ || 4 || Right +| ^ || 4 || right || exponentiation |- || align="center" -| * || 3 || Left +| * || 3 || left || multiplication |- || align="center" -| / || 3 || Left +| / || 3 || left || division |- || align="center" -| + || 2 || Left +| + || 2 || left || addition |- || align="center" -| - || 2 || Left +| - || 2 || left || subtraction |} -;Extra credit: -* Add extra text explaining the actions and an optional comment for the action on receipt of each token. +
    +;Extra credit +Add extra text explaining the actions and an optional comment for the action on receipt of each token. + + +;Note +The handling of functions and arguments is not required. -;Note: -* the handling of functions and arguments is not required. ;See also: * [[Parsing/RPN calculator algorithm]] for a method of calculating a final value from this output RPN expression. * [[Parsing/RPN to infix conversion]]. +

    diff --git a/Task/Parsing-Shunting-yard-algorithm/Common-Lisp/parsing-shunting-yard-algorithm.lisp b/Task/Parsing-Shunting-yard-algorithm/Common-Lisp/parsing-shunting-yard-algorithm.lisp new file mode 100644 index 0000000000..642377161d --- /dev/null +++ b/Task/Parsing-Shunting-yard-algorithm/Common-Lisp/parsing-shunting-yard-algorithm.lisp @@ -0,0 +1,89 @@ +;;;; Parsing/infix to RPN conversion +(defconstant operators "^*/+-") +(defconstant precedence '(-4 3 3 2 2)) + +(defun operator-p (op) + "string->integer|nil: Returns operator precedence index or nil if not operator." + (and (= (length op) 1) (position (char op 0) operators))) + +(defun has-priority (op2 op1) + "(string,string)->boolean: True if op2 has output priority over op1." + (defun prec (op) (nth (operator-p op) precedence)) + (or (and (plusp (prec op1)) (<= (prec op1) (abs (prec op2)))) + (and (minusp (prec op1)) (< (- (prec op1)) (abs (prec op2)))))) + +(defun string-split (expr) + "string->list: Tokenize a space separated string." + (let* ((p (position #\Space expr)) + (tok (if p (subseq expr 0 p) expr))) + (if p (append (list tok) (string-split (subseq expr (1+ p)))) (list tok)))) + +(defun classify (tok) + "nil|string->symbol: Classify a token." + (cond + ((null tok) 'NOL) + ((operator-p tok) 'OPR) + ((string= tok "(") 'LPR) + ((string= tok ")") 'RPR) + (t 'LIT))) + +;;; transitions when op2 is dont care +(defconstant trans1D '((LIT GO) (LPR ENTER))) +;;; transitions when we check op2 also +(defconstant trans2D + '((OPR ((NOL ENTER) + (LPR ENTER) + (OPR (lambda (op1 op2) (if (has-priority op2 op1) 'LEAVE 'ENTER))))) + (RPR ((NOL "mismatched parentheses") + (LPR CLEAR) + (OPR LEAVE))) + (NOL ((NOL nil) + (LPR "mismatched parentheses") + (OPR LEAVE))))) + +(defun do-signal (op1 op2) + "(nil|string,nil|string)->symbol|string|nil: Emit a signal based on state of inputq and opstack. + A nil return is a successful lookup (on nil,nil) because all input combinations are specified." + (let ((sig (or (cadr (assoc (classify op1) trans1D)) + (cadr (assoc (classify op2) (cadr (assoc (classify op1) trans2D))))))) + (if (or (null sig) (symbolp sig) (stringp sig)) sig + (funcall (coerce sig 'function) op1 op2)))) + +(defun rpn (expr) + "string->string: Parse infix expression into rpn." + (format t "TOKEN TOS SIGNAL OPSTACK OUTPUTQ~%") + + ;; iterate until both stacks empty + (do* ((input (string-split expr)) (opstack nil) (outputq "") + (sig (do-signal (first input) (first opstack)) (do-signal (first input) (first opstack)))) + ((null sig) ; until + ;; print last closing frame + (format t "~A~7,T~A~14,T~A~25,T~A~38,T~A~%" nil nil nil opstack outputq) + (subseq outputq 1)) ; return final infix expression + + ;; print opening frame + (format t "~A~7,T~A~14,T" (first input) (first opstack)) + (format t (if (stringp sig) "\"~A\"" "~A") sig) + + ;; switch state + (let ((output (case sig + (GO (pop input)) + (ENTER (push (pop input) opstack) nil) + (LEAVE (pop opstack)) + (CLEAR (pop input) (pop opstack) nil) + (otherwise (pop input) (pop opstack) + (if (stringp sig) sig "unknown signal"))))) + (when output (setf outputq (concatenate 'string outputq " " output)))) + + ;; print closing frame + (format t "~25,T~A~38,T~A~%" opstack outputq))) ; end-do + +(defun main (&optional (xtra nil)) + "nil->[printed rpn expressions]: Main function." + (let ((expressions '("3 + 4 * 2 / ( 1 - 5 ) ^ 2 ^ 3" + "( ( 1 + 2 ) ^ ( 3 + 4 ) ) ^ ( 5 + 6 )" + "( ( 3 ^ 4 ) ^ 2 ^ 9 ) ^ 2 ^ 5" + "3 + 4 * ( 5 - 6 ) ) 4 * 9"))) + (dolist (expr (if xtra expressions (list (car expressions)))) + (format t "~%INFIX:\"~A\"~%" expr) + (format t "RPN:\"~A\"~%" (rpn expr))))) diff --git a/Task/Parsing-Shunting-yard-algorithm/Fortran/parsing-shunting-yard-algorithm-1.f b/Task/Parsing-Shunting-yard-algorithm/Fortran/parsing-shunting-yard-algorithm-1.f new file mode 100644 index 0000000000..058763b10d --- /dev/null +++ b/Task/Parsing-Shunting-yard-algorithm/Fortran/parsing-shunting-yard-algorithm-1.f @@ -0,0 +1,234 @@ + MODULE COMPILER !At least of arithmetic expressions. + INTEGER KBD,MSG !I/O units. + + INTEGER ENUFF !How long s a piece of string? + PARAMETER (ENUFF = 66) !This long. + CHARACTER*(ENUFF) RP !Holds the Reverse Polish Notation. + INTEGER LR !And this is its length. + + INTEGER OPSYMBOLS !Recognised operator symbols. + PARAMETER (OPSYMBOLS = 11) !There are also some associates. + TYPE SYMB !To recognise symbols and carry associated information. + CHARACTER*1 IS !Its text. Careful with the trailing space and comparisons. + INTEGER*1 PRECEDENCE !Controls the order of evaluation. + CHARACTER*48 USAGE !Description. + END TYPE SYMB !The cross-linkage of precedences is tricky. + TYPE(SYMB) SYMBOL(0:OPSYMBOLS) !Righto, I'll have some. + PARAMETER (SYMBOL =(/ !Note that "*" is not to be seen as a match to "**". + o SYMB(" ", 0,"Not recognised as an operator's symbol."), + 1 SYMB(" ", 1,"separates symbols and aids legibility."), + 2 SYMB(")", 4,"opened with ( to bracket a sub-expression."), + 3 SYMB("]", 4,"opened with [ to bracket a sub-expression."), + 4 SYMB("}", 4,"opened with { to bracket a sub-expression."), + 5 SYMB("+",11,"addition, and unary + to no effect."), + 6 SYMB("-",11,"subtraction, and unary - for neg. numbers."), + 7 SYMB("*",12,"multiplication."), + 8 SYMB("×",12,"multiplication, if you can find this."), + 9 SYMB("/",12,"division."), + o SYMB("÷",12,"division for those with a fancy keyboard."), +C 13 is used so that stacked ^ will have lower priority than incoming ^, thus delivering right-to-left evaluation. + 1 SYMB("^",14,"raise to power. Not recognised is **.")/)) + CHARACTER*3 BRAOPEN,BRACLOSE !Three types are allowed. + PARAMETER (BRAOPEN = "([{", BRACLOSE = ")]}") !These. + INTEGER BRALEVEL !In and out, in and out. That's the game. + INTEGER PRBRA,PRPOW !Special double values. + PARAMETER (PRBRA = SYMBOL( 3).PRECEDENCE) !Bracketing + PARAMETER (PRPOW = SYMBOL(11).PRECEDENCE) !And powers refer leftwards. + + CHARACTER*10 DIGIT !Numberish is a bit more complex. + PARAMETER (DIGIT = "0123456789") !But this will do for integers. + + INTEGER STACKLIMIT !How high is a stack? + PARAMETER (STACKLIMIT = 66) !This should suffice. + TYPE DEFERRED !I need a siding for lower-precedence operations. + CHARACTER*1 OPC !The operation code. + INTEGER*1 PRECEDENCE !Its precedence in the siding may differ. + END TYPE DEFERRED !Anyway, that's enough. + TYPE(DEFERRED) OPSTACK(0:STACKLIMIT) !One siding, please. + INTEGER OSP !The operation stack pointer. + + INTEGER INCOMING,TOKENTYPE,NOTHING,ANUMBER,OPENBRA,HUH !Some mnemonics. + PARAMETER (NOTHING = 0, ANUMBER = -1, OPENBRA = -2, HUH = -3) !The ordering is not arbitrary. + CONTAINS !Now to mess about. + SUBROUTINE EMIT(STUFF) !The objective is to produce some RPN text. + CHARACTER*(*) STUFF !The term of the moment. + INTEGER L !A length. + WRITE (MSG,1) STUFF !Announce. + 1 FORMAT ("Emit ",A) !Whatever it is. + IF (STUFF.EQ."") RETURN !Ha ha. + L = LEN(STUFF) !So, how much is there to append? + IF (LR + L.GE.ENUFF) STOP "Too much RPN for RP!" !Perhaps too much. + IF (LR.GT.0) THEN !Is there existing stuff? + LR = LR + 1 !Yes. Advance one, + RP(LR:LR) = " " !And place a space. + END IF !So much for separators. + RP(LR + 1:LR + L) = STUFF !Place the stuff. + LR = LR + L !Count it in. + END SUBROUTINE EMIT !Simple enough, if a bit finicky. + + SUBROUTINE STACKOP(C,P) !Push an item into the siding. + CHARACTER*1 C !The operation code. + INTEGER P !Its precedence. + OSP = OSP + 1 !Stacking up... + IF (OSP.GT.STACKLIMIT) STOP "OSP overtopped!" !Perhaps not. + OPSTACK(OSP).OPC = C !Righto, + OPSTACK(OSP).PRECEDENCE = P !The deed is simple. + WRITE (MSG,1) C,OPSTACK(1:OSP) !Announce. + 1 FORMAT ("Stack ",A1,9X,",OpStk=",33(A1,I2:",")) + END SUBROUTINE STACKOP !So this is more for mnemonic ease. + + LOGICAL FUNCTION COMPILE(TEXT) !A compiler confronts a compiler! + CHARACTER*(*) TEXT !To be inspected. + INTEGER L1,L2 !Fingers for the scan. + CHARACTER*1 C !Character of the moment. + INTEGER HAPPY !Ah, shades of mood. + LR = 0 !No output yet. + OSP = 0 !Nothing stacked. + OPSTACK(0).OPC = "" !Prepare a bouncer. + OPSTACK(0).PRECEDENCE = 0 !So that loops won't go past. + BRALEVEL = 0 !None seen. + HAPPY = +1 !Nor any problems. + L2 = 1 !Syncopation: one past the end of the previous token. +Chew into an operand, possibly obstructed by an open bracket. + 100 CALL FORASIGN !Find something to inspect. + IF (TOKENTYPE.EQ.NOTHING) THEN !Run off the end? + IF (OSP.GT.0) CALL GRUMP("Another operand or one of " !E.g. "1 +". + 1 //BRAOPEN//" is expected.") !Give a hint, because stacked stuff awaits. + ELSE IF (TOKENTYPE.EQ.ANUMBER) THEN !If a number, + CALL EMIT(TEXT(L1:L2 - 1)) !Roll all its digits. + ELSE IF (TOKENTYPE.EQ.OPENBRA) THEN !Starting a sub-expression? + CALL STACKOP(C,PRBRA - 1) !Thus ( has less precedence than ). + GO TO 100 !And I still want an operand. +C ELSE IF (TOKENTYPE.EQ.ANAME) THEN !Name of something? +C CALL EMIT(TEXT(L1:L2 - 1)) !Roll it. + ELSE !No further options. + CALL GRUMP("Huh? Unexpected "//C) !Probably something like "1 + +" + END IF !Righto, finished with operands. +Chase after an operator, possibly interrupted by a close bracket,. + 200 CALL FORASIGN !Find something to inspect. + IF (TOKENTYPE.LT.0) THEN !But, have I an operand-like token instead? + CALL GRUMP("Operator expected, not "//C) !It seems so. + ELSE !Normally, an operator is to hand. Possibly a NOTHING, though. + WRITE (MSG,201) C,INCOMING,OPSTACK(1:OSP) !Document it. + 201 FORMAT ("Oprn=>",A1,"< Prec=",I2, !Try to align with other output. + 1 ",OpStk=",33(A1,I2:",")) !So as not to clutter the display. + DO WHILE(OPSTACK(OSP).PRECEDENCE .GE. INCOMING) !Shunt higher-precedence stuff out. + IF (OPSTACK(OSP).PRECEDENCE .EQ. PRBRA - 1) !Only opening brackets have this precedence. + 1 CALL GRUMP("Unbalanced "//OPSTACK(OSP).OPC) !And they vanish only when meeting their closing bracket. + CALL EMIT(OPSTACK(OSP).OPC) !Otherwise we have an operator. + OSP = OSP - 1 !It has gone forth. + END DO !On to the next. + IF (TOKENTYPE.GT.NOTHING) THEN !Now, only lower-precedence items are still in the stack. + IF (INCOMING.EQ.PRBRA) THEN !And this is a special arrival. + CALL BALANCEBRA(C) !It should match an earlier entry. + BRALEVEL = BRALEVEL - 1 !Count it out. + GO TO 200 !And I still haven't got an operator. + ELSE !All others are normal operators. + IF (C.EQ."^") INCOMING = PRPOW - 1 !Special trick to cause leftwards association of x^2^3. + CALL STACKOP(C,INCOMING) !Shunt aside, to await the next arrival. + END IF !So much for that operator. + END IF !Providing it was not just an end-of-input flusher. + END IF !And not a misplaced operand. +Carry on? + IF (HAPPY .GT. 0) GO TO 100 !No problems, and not a nothing from the end of the text. +Completed. + COMPILE = HAPPY.GE.0 !One hopes so. + CONTAINS !Now for some assistants. + SUBROUTINE GRUMP(GROWL) !There might be a problem. + CHARACTER*(*) GROWL !The fault. + WRITE (MSG,1) GROWL !Say it. + IF (L1.GT. 1) WRITE (MSG,1) "Tasty:",TEXT( 1:L1 - 1) !Now explain the context. + IF (L2.GT.L1) WRITE (MSG,1) "Nasty:",TEXT(L1:L2 - 1) !This is the token when trouble was found. + IF (L2.LE.LEN(TEXT)) WRITE (MSG,1) "Misty:",TEXT(L2:) !And this remains to be seen. + 1 FORMAT (4X,A,1X,A) !A simple layout works nicely for reasonable-length texts. + HAPPY = -1 . !Just so. + END SUBROUTINE GRUMP !Enuogh said. + + SUBROUTINE BALANCEBRA(B) !Perhaps a happy meeting. + CHARACTER*1 B !The closer. + CHARACTER*1 O !The putative opener. + INTEGER IT,L !Fingers. + CHARACTER*88 GROWL !A scratchpad. + O = OPSTACK(OSP).OPC !This should match B. + WRITE (MSG,1) O,B !Perhaps. + 1 FORMAT ("Match ",2A) !Show what I've got, anyway. + IT = INDEX(BRAOPEN,O) !So, what sort did I save? + IF (IT .EQ. INDEX(BRACLOSE,B)) THEN !A friend? + OSP = OSP - 1 !Yes. They vanish together. + ELSE !Otherwise, something is out of place. + GROWL = "Unbalanced {[(...)]} bracketing! The closing " !Alas. + 1 //B//" is unmatched." !So, a mess. + IF (IT.GT.0) GROWL(62:) = "A "//BRACLOSE(IT:IT) !Perhaps there had been no opening bracket. + 1 //" would be better." !But if there had, this would be its friend. + CALL GRUMP(GROWL) !Take that! + END IF !So much for discrepancies. + END SUBROUTINE BALANCEBRA !But, hopefully, amity prevails. + + SUBROUTINE FORASIGN !See what comes next. + INTEGER I !A stepper. + L1 = L2 !Pick up where the previous scan left off. + 10 IF (L1.GT.LEN(TEXT)) THEN !Are we off the end yet? + C = "" !Yes. Scrub the marker. + L2 = L1 !TEXT(L1:L2 - 1) will be null. + TOKENTYPE = NOTHING !But this is to be checked first. + INCOMING = SYMBOL(1).PRECEDENCE !For flushing sidetracked operators. + HAPPY = 0 !Fading away. + ELSE !Otherwise, there is grist. +Check for spaces and move past them. + C = TEXT(L1:L1) !Grab the first character of the prospective token. + IF (C.LE." ") THEN !Boring? + L1 = L1 + 1 !Yes. Step past it. + GO TO 10 !And look afresh. + END IF !Otherwise, L1 now fingers the start. +Caught something to inspect. + L2 = L1 + 1 !This is one beyond. Just for digit strings. + IF (INDEX(DIGIT,C).GT.0) THEN !So, has one started? + TOKENTYPE = ANUMBER !Yep. + 20 IF (L2.LE.LEN(TEXT)) THEN !Probe ahead. + IF (INDEX(DIGIT,TEXT(L2:L2)).GT.0) THEN !Another digit? + L2 = L2 + 1 !Yes. Leaving L1 fingering its start, + GO TO 20 !Chase its end. + END IF !So much for another digit. + END IF !And checking against the end. +C ELSE IF (INDEX(LETTERS,C).GT.0) THEN !Some sort of name? +C advance L2 while in NAMEISH. + ELSE IF (INDEX(BRAOPEN,C).GT.0) THEN !An open bracket? + TOKENTYPE = OPENBRA !Yep. + ELSE !Otherwise, anything else. + DO I = OPSYMBOLS,1,-1 !Scan backwards, to find ** before *, if present. + IF (SYMBOL(I).IS .EQ. C) EXIT !Found? + END DO !On to the next. A linear search will do. + IF (I.LE.0) THEN !Is it identified? + TOKENTYPE = HUH !No. + INCOMING = SYMBOL(0).PRECEDENCE !And this might provoke a flush. + ELSE !If it is identified, + TOKENTYPE = I !Then this is a positive number. + INCOMING = SYMBOL(I).PRECEDENCE !And this is of interest. + END IF !Righto, anything has been identified, possibly as HUH. + END IF !So much for classification. + END IF !If there is something to see. + WRITE (MSG,30) C,INCOMING,TOKENTYPE !Announce. + 30 FORMAT ("Next=>",A1,"< Prec=",I2,",Ttype=",I2) !C might be blank. + END SUBROUTINE FORASIGN !I call for a sign, and I see what? + END FUNCTION COMPILE !That's the main activity. + END MODULE COMPILER !So, enough of this. + + PROGRAM POKE + USE COMPILER + CHARACTER*66 TEXT + LOGICAL HIC + MSG = 6 + KBD = 5 + WRITE (MSG,1) + 1 FORMAT ("Produce RPN from infix...",/) + + 10 WRITE (MSG,11) + 11 FORMAT("Infix: ",$) + READ(KBD,12) TEXT + 12 FORMAT (A) + IF (TEXT.EQ."") STOP "Enough." + HIC = COMPILE(TEXT) + WRITE (MSG,13) HIC,RP(1:LR) + 13 FORMAT (L6," RPN: >",A,"<") + GO TO 10 + END diff --git a/Task/Parsing-Shunting-yard-algorithm/Fortran/parsing-shunting-yard-algorithm-2.f b/Task/Parsing-Shunting-yard-algorithm/Fortran/parsing-shunting-yard-algorithm-2.f new file mode 100644 index 0000000000..9cbfb4b8be --- /dev/null +++ b/Task/Parsing-Shunting-yard-algorithm/Fortran/parsing-shunting-yard-algorithm-2.f @@ -0,0 +1,48 @@ +Caution! The apparent gaps in the sequence of precedence values in this table are *not* unused! +Cunning ploys with precedence allow parameter evaluation, and right-to-left order as in x**y**z. + INTEGER OPSYMBOLS !Recognised operator symbols. + PARAMETER (OPSYMBOLS = 25) !There are also some associates. + TYPE SYMB !To recognise symbols and carry associated information. + CHARACTER*2 IS !Its text. Careful with the trailing space and comparisons. + INTEGER*1 PRECEDENCE !Controls the order of evaluation. + INTEGER*1 POPCOUNT !Stack activity: a+b means + requires two in. + CHARACTER*48 USAGE !Description. + END TYPE SYMB !The cross-linkage of precedences is tricky. + CHARACTER*5 IFPARTS(0:4) !These appear when an operator would otherwise be expected. + PARAMETER (IFPARTS = (/"IF","THEN","ELSE","OWISE","FI"/)) !So, bend the usage of "operator". + TYPE(SYMB) SYMBOL(-4:OPSYMBOLS) !Righto, I'll have some. + PARAMETER (SYMBOL =(/ !Note that "*" is not to be seen as a match to "**". + 4 SYMB("FI", 2,0,"the FI that ends an IF-statement."), !These negative entries are not for name matching + 3 SYMB("Ow", 3,0,"the OWISE part of an IF-statement."), !Which is instead done via IFPARTS + 2 SYMB("El", 3,0,"the ELSE part of an IF-statement."), !But are here to take advantage of the structure in place. + 1 SYMB("Th", 3,0,"the THEN part of an IF-statement."), !The IF is recognised separately, when expecting an operand. + o SYMB(" ", 0,0,"Not recognised as an operator's symbol."), + 1 SYMB(" ", 1,0,"separates symbols and aids legibility."), +C 2 and 3 are used for the parts of an IF-statement. See PRIF. +C 3 These precedences ensure the desired order of evaluation. + 2 SYMB(") ", 4,0,"opened with ( to bracket a sub-expression."), + 3 SYMB("] ", 4,0,"opened with [ to bracket a sub-expression."), + 4 SYMB("} ", 4,0,"opened with { to bracket a sub-expression."), + 5 SYMB(", ", 5,0,"continues a list of parameters to a function."), +C SYMB(":=", 6,0,"marks an on-the-fly assignment of a result"), Identified differently... see PRREF. + 6 SYMB("| ", 7,2,"logical OR, similar to addition."), + 7 SYMB("& ", 8,2,"logical AND, similar to multiplication."), + 8 SYMB("¬ ", 9,0,"logical NOT, similar to negation."), + 9 SYMB("= ",10,2,"tests for equality (beware decimal fractions)"), + o SYMB("< ",10,2,"tests strictly less than."), + 1 SYMB("> ",10,2,"tests strictly greater than."), + 2 SYMB("<>",10,2,"tests not equal (there is no 'not' key!)"), + 3 SYMB("¬=",10,2,"tests not equal if you can find a ¬ !"), + 4 SYMB("<=",10,2,"tests less than or equal."), + 5 SYMB(">=",10,2,"tests greater than or equal."), + 6 SYMB("+ ",11,2,"addition, and unary + to no effect."), + 7 SYMB("- ",11,2,"subtraction, and unary - for neg. numbers."), + 8 SYMB("* ",12,2,"multiplication."), + 9 SYMB("× ",12,2,"multiplication, if you can find this."), + o SYMB("/ ",12,2,"division."), + 1 SYMB("÷ ",12,2,"division for those with a fancy keyboard."), + 2 SYMB("\ ",12,2,"remainder a\b = a - truncate(a/b)*b; 11\3 = 2"), +C 13 is used so that stacked ** will have lower priority than incoming **, thus delivering right-to-left evaluation. + 3 SYMB("^ ",14,2,"raise to power: also recognised is **."), !Uses the previous precedence level also! + 4 SYMB("**",14,2,"raise to power: also recognised is ^."), + 5 SYMB("! ",15,1,"factorial, sortof, just for fun.")/)) diff --git a/Task/Parsing-Shunting-yard-algorithm/JavaScript/parsing-shunting-yard-algorithm.js b/Task/Parsing-Shunting-yard-algorithm/JavaScript/parsing-shunting-yard-algorithm.js index 70dab5c0c5..e55864c6ea 100644 --- a/Task/Parsing-Shunting-yard-algorithm/JavaScript/parsing-shunting-yard-algorithm.js +++ b/Task/Parsing-Shunting-yard-algorithm/JavaScript/parsing-shunting-yard-algorithm.js @@ -36,7 +36,7 @@ var o1, o2; for (var i = 0; i < infix.length; i++) { token = infix[i]; - if (token > "0" && token < "9") { // if token is operand (here limited to 0 <= x <= 9) + if (token >= "0" && token <= "9") { // if token is operand (here limited to 0 <= x <= 9) postfix += token + " "; } else if (ops.indexOf(token) != -1) { // if token is an operator diff --git a/Task/Parsing-Shunting-yard-algorithm/REXX/parsing-shunting-yard-algorithm-1.rexx b/Task/Parsing-Shunting-yard-algorithm/REXX/parsing-shunting-yard-algorithm-1.rexx index 9265dac551..9421d6b8ec 100644 --- a/Task/Parsing-Shunting-yard-algorithm/REXX/parsing-shunting-yard-algorithm-1.rexx +++ b/Task/Parsing-Shunting-yard-algorithm/REXX/parsing-shunting-yard-algorithm-1.rexx @@ -1,48 +1,52 @@ -/*REXX pgm converts infix arith. expressions to Reverse Polish notation.*/ -parse arg x; if x='' then x = '3 + 4 * 2 / ( 1 - 5 ) ^ 2 ^ 3'; ox=x -showSteps=1 /*set to 0 (zero) if working steps not wanted.*/ -x='(' space(x) ') '; tokens=words(x) /*force stacking for expression. */ - do i=1 for tokens; @.i=word(x,i); end /*i*/ /*assign input tokens*/ -L=max(20,length(x)) /*use 20 for the min show width. */ -say 'token' center('input',L,'─') center('stack',L%2,'─') center('output',L,'─') center('action',L,'─') -pad=left('',5); op=')(-+/*^'; rOp=substr(op,3); p.=; s.=; n=length(op); RPN=; stack= +/*REXX pgm converts infix arith. expressions to Reverse Polish notation (shunting─yard).*/ +parse arg x /*obtain optional argument from the CL.*/ +if x='' then x= '3 + 4 * 2 / ( 1 - 5 ) ^ 2 ^ 3' /*Not specified? Then use the default.*/ +ox=x +x='(' space(x) ") " /*force stacking for the expression. */ +#=words(x) /*get number of tokens in expression. */ + do i=1 for #; @.i=word(x, i) /*assign the input tokens to an array. */ + end /*i*/ +tell=1 /*set to 0 if working steps not wanted.*/ +L=max( 20, length(x) ) /*use twenty for the minimum show width*/ - do i=1 for n; _=substr(op,i,1); s._=(i+1)%2; p._=s._+(i==n); end /*i*/ - /*[↑] assign operator priorities.*/ - do #=1 for tokens; ?=@.# /*process each token from @. list*/ - select /*@.# is: (, operator, ), operand*/ - when ?=='(' then do; stack='(' stack; call show 'moving' ? "──► stack"; end - when isOp(?) then do /*is token an operator?*/ - !=word(stack,1) /*get token from stack.*/ - do while !\==')' & s.!>=p.?; RPN=RPN ! /*add*/ - stack=subword(stack,2); /*del token from stack.*/ - call show 'unstacking:' ! - !=word(stack,1) /*get token from stack.*/ - end /*while ···)*/ - stack=? stack /*add token to stack.*/ - call show 'moving' ? "──► stack" - end - when ?==')' then do; !=word(stack,1) /*get token from stack.*/ - do while !\=='('; RPN=RPN ! /*add to RPN.*/ - stack=subword(stack,2) /*del token from stack.*/ - !=word(stack,1) /*get token from stack.*/ - call show 'moving stack' ! '──► RPN' - end /*while ···( */ - stack=subword(stack,2) /*del token from stack.*/ - call show 'deleting ( from the stack' - end - otherwise RPN=RPN ? /*add operand to RPN. */ - call show 'moving' ? '──► RPN' +say 'token' center("input" , L, '─') center("stack" , L%2, '─'), + center("output", L, '─') center("action", L, '─') +op= ")(-+/*^"; Rop=substr(op,3); p.=; n=length(op); RPN= /*some handy-dandy vars.*/ +s.= + do i=1 for n; _=substr(op,i,1); s._=(i+1)%2; p._=s._+(i==n); end /*i*/ +$= /* [↑] assign the operator priorities.*/ + do k=1 for #; ?=@.k /*process each token from the @. list.*/ + select /*@.k is: (, operator, ), operand*/ + when ?=='(' then do; $="(" $; call show 'moving' ? "──► stack"; end + when isOp(?) then do; !=word($, 1) /*get token from stack*/ + do while ! \==')' & s.!>=p.? + RPN=RPN ! /*add token to RPN.*/ + $=subword($, 2) /*del token from stack*/ + call show 'unstacking:' ! + !=word($, 1) /*get token from stack*/ + end /*while*/ + $=? $ /*add token to stack*/ + call show 'moving' ? "──► stack" + end + when ?==')' then do; !=word($, 1) /*get token from stack*/ + do while !\=='('; RPN=RPN ! /*add token to RPN. */ + $=subword($, 2) /*del token from stack*/ + != word($, 1) /*get token from stack*/ + call show 'moving stack' ! "──► RPN" + end /*while*/ + $=subword($, 2) /*del token from stack*/ + call show 'deleting ( from the stack' + end + otherwise RPN=RPN ? /*add operand to RPN. */ + call show 'moving' ? "──► RPN" end /*select*/ - end /*#*/ - -RPN=space(RPN stack) -say; say 'input:' ox; say 'RPN──►' RPN /*show input and the RPN.*/ -parse source upper . y . /*invoked via C.L. or REXX pgm?*/ -if y=='COMMAND' then exit /*stick a fork in it, we're done.*/ - else return RPN /*return RPN to invoker (RESULT).*/ -/*──────────────────────────────────ISOP subroutine─────────────────────*/ -isOp: return pos(arg(1),rOp)\==0 /*is argument1 a "real" operator?*/ -/*──────────────────────────────────SHOW subroutine─────────────────────*/ -show: if showSteps then say center(?,length(pad)) left(subword(x,#),L), - left(stack,L%2) left(space(RPN),L) arg(1); return + end /*k*/ +say +RPN=space(RPN $) /*elide any superfluous blanks in RPN. */ +say ' input:' ox; say " RPN──►" RPN /*display the input and the RPN. */ +parse source upper . y . /*invoked via the C.L. or REXX pgm? */ +if y=='COMMAND' then exit /*stick a fork in it, we're all done. */ + else return RPN /*return RPN to invoker (the RESULT). */ +/*──────────────────────────────────────────────────────────────────────────────────────────*/ +isOp: return pos(arg(1),rOp) \== 0 /*is the first argument a "real" operator? */ +show: if tell then say center(?,5) left(subword(x,k),L) left($,L%2) left(RPN,L) arg(1); return diff --git a/Task/Parsing-Shunting-yard-algorithm/REXX/parsing-shunting-yard-algorithm-2.rexx b/Task/Parsing-Shunting-yard-algorithm/REXX/parsing-shunting-yard-algorithm-2.rexx index fdcee619df..717d553d24 100644 --- a/Task/Parsing-Shunting-yard-algorithm/REXX/parsing-shunting-yard-algorithm-2.rexx +++ b/Task/Parsing-Shunting-yard-algorithm/REXX/parsing-shunting-yard-algorithm-2.rexx @@ -1,57 +1,57 @@ -/*REXX pgm converts infix arith. expressions to Reverse Polish notation.*/ -parse arg x; if x='' then x = '3 + 4 * 2 / ( ( 1 - 5 ) ) ^ 2 ^ 3'; ox=x -g=0 /* G is a counter of ( and ) */ - do p=1 for words(x); _=word(x,p) /*catches unbalanced () and )( */ - if _=='(' then g=g+1 - else if _==')' then do; g=g-1; if g<0 then g=-1e9; end - end /*p*/ -good=(g==0) /*indicate expression is good | ¬*/ -showSteps=1 /* 0: action steps not wanted.*/ -x='(' space(x) ') '; tokens=words(x) /*force stacking for expression. */ - do i=1 for tokens; @.i=word(x,i); end /*i*/ /*assign input tokens*/ -L=max(20,length(x)) /*use 20 for the min show width. */ -if good then say 'token' center('input' ,L,'─') center('stack' ,L%2,'─'), - center('output',L,'─') center('action',L ,'─') -pad=left('',5); op=')(-+/*^'; rOp=substr(op,3); stack= - p.=; n=length(op); s.=; RPN= - - do i=1 for n; _=substr(op,i,1); s._=(i+1)%2; p._=s._+(i==n); end /*i*/ - /*[↑] assign operator priorities.*/ - do #=1 for tokens*good; ?=@.# /*process each token from @. list*/ - select /*@.# is: (, operator, ), operand*/ - when ?=='(' then do; stack='(' stack; call show 'moving' ? "──► stack"; end - when isOp(?) then do /*is token an operator?*/ - !=word(stack,1) /*get token from stack.*/ - do while !\==')' & s.!>=p.?; RPN=RPN ! /*add*/ - stack=subword(stack,2); /*del token from stack.*/ - call show 'unstacking:' ! - !=word(stack,1) /*get token from stack.*/ - end /*while ···)*/ - stack=? stack /*add token to stack.*/ - call show 'moving' ? "──► stack" - end - when ?==')' then do; !=word(stack,1) /*get token from stack.*/ - do while !\=='('; RPN=RPN ! /*add to RPN.*/ - stack=subword(stack,2) /*del token from stack.*/ - !=word(stack,1) /*get token from stack.*/ - call show 'moving stack' ! '──► RPN' - end /*while ···( */ - stack=subword(stack,2) /*del token from stack.*/ - call show 'deleting ( from the stack' - end - otherwise RPN=RPN ? /*add operand to RPN. */ - call show 'moving' ? '──► RPN' - end /*select*/ - end /*#*/ - -RPN=space(RPN stack) -if \good then RPN = '─────── error in expression ───────' -say; say ' input:' ox; say ' RPN──►' RPN /*show input and the RPN.*/ -parse source upper . y . /*invoked via C.L. or REXX pgm?*/ -if y=='COMMAND' then exit /*stick a fork in it, we're done.*/ - else return RPN /*return RPN to invoker (RESULT).*/ -/*──────────────────────────────────ISOP subroutine─────────────────────*/ -isOp: return pos(arg(1),rOp)\==0 /*is argument1 a "real" operator?*/ -/*──────────────────────────────────SHOW subroutine─────────────────────*/ -show: if showSteps then say center(?,length(pad)) left(subword(x,#),L), - left(stack,L%2) left(space(RPN),L) arg(1); return +/*REXX pgm converts infix arith. expressions to Reverse Polish notation (shunting─yard).*/ +parse arg x /*obtain optional argument from the CL.*/ +if x='' then x= '3 + 4 * 2 / ( 1 - 5 ) ^ 2 ^ 3' /*Not specified? Then use the default.*/ +g=0 /* G is a counter of ( and ) */ + do p=1 for words(x); _=word(x,p) /*catches unbalanced ( ) and ) ( */ + if _=='(' then g=g+1 + else if _==')' then do; g=g-1; if g<0 then g=-1e8; end + end /*p*/ +ox=x +x='(' space(x) ") " /*force stacking for the expression. */ +#=words(x) /*get number of tokens in expression. */ +good= (g==0) /*indicate expression is good or bad.*/ + do i=1 for #; @.i=word(x, i) /*assign the input tokens to an array. */ + end /*i*/ +tell=1 /*set to 0 if working steps not wanted.*/ +L=max( 20, length(x) ) /*use twenty for the minimum show width*/ +if good then say 'token' center("input" , L, '─') center("stack" , L%2, '─'), + center("output", L, '─') center("action", L, '─') +op= ")(-+/*^"; Rop=substr(op,3); p.=; n=length(op); RPN= /*some handy-dandy vars.*/ +s.= + do i=1 for n; _=substr(op,i,1); s._=(i+1)%2; p._=s._+(i==n); end /*i*/ +$= /* [↑] assign the operator priorities.*/ + do k=1 for #*good; ?=@.k /*process each token from the @. list.*/ + select /*@.k is: ( operator ) operand.*/ + when ?=='(' then do; $="(" $; call show 'moving' ? "──► stack"; end + when isOp(?) then do; !=word($, 1) /*get token from stack*/ + do while ! \==')' & s.!>=p.? + RPN=RPN ! /*add token to RPN.*/ + $=subword($, 2) /*del token from stack*/ + call show 'unstacking:' ! + !=word($, 1) /*get token from stack*/ + end /*while*/ + $=? $ /*add token to stack*/ + call show 'moving' ? "──► stack" + end + when ?==')' then do; !=word($, 1) /*get token from stack*/ + do while !\=='('; RPN=RPN ! /*add token to RPN.*/ + $=subword($, 2) /*del token from stack*/ + != word($, 1) /*get token from stack*/ + call show 'moving stack' ! "──► RPN" + end /*while*/ + $=subword($, 2) /*del token from stack*/ + call show 'deleting ( from the stack' + end + otherwise RPN=RPN ? /*add operand to RPN.*/ + call show 'moving' ? "──► RPN" + end /*select*/ + end /*k*/ +say +RPN=space(RPN $); if \good then RPN= '─────── error in expression ───────' /*error? */ +say ' input:' ox; say " RPN──►" RPN /*display the input and the RPN. */ +parse source upper . y . /*invoked via the C.L. or REXX pgm? */ +if y=='COMMAND' then exit /*stick a fork in it, we're all done. */ + else return RPN /*return RPN to invoker (the RESULT). */ +/*──────────────────────────────────────────────────────────────────────────────────────────*/ +isOp: return pos(arg(1), Rop) \== 0 /*is the first argument a "real" operator? */ +show: if tell then say center(?,5) left(subword(x,k),L) left($,L%2) left(RPN,L) arg(1); return diff --git a/Task/Parsing-Shunting-yard-algorithm/Standard-ML/parsing-shunting-yard-algorithm.ml b/Task/Parsing-Shunting-yard-algorithm/Standard-ML/parsing-shunting-yard-algorithm.ml new file mode 100644 index 0000000000..9cfd297870 --- /dev/null +++ b/Task/Parsing-Shunting-yard-algorithm/Standard-ML/parsing-shunting-yard-algorithm.ml @@ -0,0 +1,110 @@ +structure Operator = struct + datatype associativity = LEFT | RIGHT + type operator = { symbol : char, assoc : associativity, precedence : int } + + val operators : operator list = [ + { symbol = #"^", precedence = 4, assoc = RIGHT }, + { symbol = #"*", precedence = 3, assoc = LEFT }, + { symbol = #"/", precedence = 3, assoc = LEFT }, + { symbol = #"+", precedence = 2, assoc = LEFT }, + { symbol = #"-", precedence = 2, assoc = LEFT } + ] + + fun find (c : char) : operator option = List.find (fn ({symbol, ...} : operator) => symbol = c) operators + + infix cmp + fun ({precedence=p1, assoc=a1, ...} : operator) cmp ({precedence=p2, ...} : operator) = + case a1 of + LEFT => p1 <= p2 + | RIGHT => p1 < p2 +end + +signature SHUNTING_YARD = sig + type 'a tree + type content + + val parse : string -> content tree +end + +structure ShuntingYard : SHUNTING_YARD = struct + structure O = Operator + val cmp = O.cmp + (* did you know infixity doesn't "carry out" of a structure unless you open it? TIL *) + infix cmp + fun pop2 (b::a::rest) = ((a, b), rest) + | pop2 _ = raise Fail "bad input" + + datatype content = Op of char + | Int of int + datatype 'a tree = Leaf + | Node of 'a tree * 'a * 'a tree + + fun parse_int' tokens curr = case tokens of + [] => (List.rev curr, []) + | t::ts => if Char.isDigit t then parse_int' ts (t::curr) + else (List.rev curr, t::ts) + + fun parse_int tokens = let + val (int_chars, rest) = parse_int' tokens [] + in + ((Option.valOf o Int.fromString o String.implode) int_chars, rest) + end + + fun parse (s : string) : content tree = let + val tokens = String.explode s + (* parse': tokens operator_stack trees *) + fun parse' [] [] [result] = result + | parse' [] (opr::os) trees = + if opr = #"(" orelse opr = #")" then raise Fail "bad input" + else let + val ((a,b), trees') = pop2 trees + val trees'' = (Node (a, Op opr, b)) :: trees' + in + parse' [] os trees'' + end + | parse' (t::ts) operators trees = + if Char.isSpace t then parse' ts operators trees else + if t = #"(" then parse' ts (t::operators) (trees : content tree list) else + if t = #")" then let + (* process_operators : operators trees *) + fun process_operators [] _ = raise Fail "bad input" + | process_operators (opr::os) trees = + if opr = #"(" then (os, trees) + else let + val ((a, b), trees') = pop2 trees + val trees'' = (Node (a, Op opr, b)) :: trees' + in + process_operators os trees'' + end + val (operators', trees') = process_operators (operators : char list) (trees : content tree list) + in + parse' ts operators' trees' + end else + (case O.find (t : char) of + SOME o1 => let + (* process_operators : operators trees *) + fun process_operators [] trees = ([], trees) + | process_operators (o2::os) trees = (case O.find o2 of + SOME o2 => + if o1 cmp o2 then let + val ((a, b), trees') = pop2 trees + val trees'' = (Node (a, Op (#symbol o2), b)) :: trees' + in + process_operators os trees'' + end + else ((#symbol o2)::os, trees) + | NONE => (o2::os, trees)) + val (operators', trees') = process_operators operators trees + in + parse' ts ((#symbol o1)::operators') trees' + end + | NONE => let + val (n, tokens') = parse_int (t::ts) + in + parse' tokens' operators ((Node (Leaf, Int n, Leaf)) :: trees) + end) + | parse' _ _ _ = raise Fail "bad input" + in + parse' tokens [] [] + end +end diff --git a/Task/Partial-function-application/00DESCRIPTION b/Task/Partial-function-application/00DESCRIPTION index 802d176e06..77d4b63469 100644 --- a/Task/Partial-function-application/00DESCRIPTION +++ b/Task/Partial-function-application/00DESCRIPTION @@ -1,4 +1,4 @@ -[[wp:Partial application|Partial function application]] is the ability to take a function of many +[[wp:Partial application|Partial function application]]   is the ability to take a function of many parameters and apply arguments to some of the parameters to create a new function that needs only the application of the remaining arguments to produce the equivalent of applying all arguments to the original function. @@ -9,8 +9,10 @@ E.g: : Then partial(f, param1=v1) returns f'(param2) : And f(param1=v1, param2=v2) == f'(param2=v2) (for any value v2) + Note that in the partial application of a parameter, (in the above case param1), other parameters are not explicitly mentioned. This is a recurring feature of partial function application. + ;Task * Create a function fs( f, s ) that takes a function, f( n ), of one value and a sequence of values s.
    Function fs should return an ordered sequence of the result of applying function f to every value of s in turn. @@ -22,6 +24,8 @@ Note that in the partial application of a parameter, (in the above case param1), * Test fsf1 and fsf2 by evaluating them with s being the sequence of integers from 0 to 3 inclusive and then the sequence of even integers from 2 to 8 inclusive. + ;Notes * In partially applying the functions f1 or f2 to fs, there should be no ''explicit'' mention of any other parameters to fs, although introspection of fs within the partial applicator to find its parameters ''is'' allowed. * This task is more about ''how'' results are generated rather than just getting results. +

    diff --git a/Task/Partial-function-application/Lua/partial-function-application.lua b/Task/Partial-function-application/Lua/partial-function-application.lua index 8ab0834f7f..35a49f7a54 100644 --- a/Task/Partial-function-application/Lua/partial-function-application.lua +++ b/Task/Partial-function-application/Lua/partial-function-application.lua @@ -14,10 +14,9 @@ function squared(n) return n ^ 2 end -function partial(f, ...) - local args = ... +function partial(f, arg) return function(...) - return f(args, ...) + return f(arg, ...) end end diff --git a/Task/Pascals-triangle-Puzzle/00DESCRIPTION b/Task/Pascals-triangle-Puzzle/00DESCRIPTION index e8ade29ece..90ba88e9d3 100644 --- a/Task/Pascals-triangle-Puzzle/00DESCRIPTION +++ b/Task/Pascals-triangle-Puzzle/00DESCRIPTION @@ -10,4 +10,7 @@ Each brick of the pyramid is the sum of the two bricks situated below it.
    Of the three missing numbers at the base of the pyramid, the middle one is the sum of the other two (that is, Y = X + Z). + +;Task: Write a program to find a solution to this puzzle. +

    diff --git a/Task/Pascals-triangle-Puzzle/Mathematica/pascals-triangle-puzzle-6.math b/Task/Pascals-triangle-Puzzle/Mathematica/pascals-triangle-puzzle-6.math new file mode 100644 index 0000000000..5d161fcf3b --- /dev/null +++ b/Task/Pascals-triangle-Puzzle/Mathematica/pascals-triangle-puzzle-6.math @@ -0,0 +1,2 @@ +triangle[n_, m_] := Nest[MovingMap[Total, #, 1] &, {x, 11, y, 4, z}, n - 1][[m]] +Solve[{triangle[3, 1] == 40, triangle[5, 1] == 151, y == x + z}, {x, y, z}] diff --git a/Task/Pascals-triangle-Puzzle/Mathematica/pascals-triangle-puzzle-7.math b/Task/Pascals-triangle-Puzzle/Mathematica/pascals-triangle-puzzle-7.math new file mode 100644 index 0000000000..8a2f836af9 --- /dev/null +++ b/Task/Pascals-triangle-Puzzle/Mathematica/pascals-triangle-puzzle-7.math @@ -0,0 +1 @@ +{{x -> 5, y -> 13, z -> 8}} diff --git a/Task/Pascals-triangle/00DESCRIPTION b/Task/Pascals-triangle/00DESCRIPTION index c36db2c9ce..b82e9f9d80 100644 --- a/Task/Pascals-triangle/00DESCRIPTION +++ b/Task/Pascals-triangle/00DESCRIPTION @@ -1,12 +1,37 @@ -[[wp:Pascal's triangle|Pascal's triangle]] is an arithmetic and geometric figure first imagined by [[wp:Blaise Pascal|Blaise Pascal]]. +[[wp:Pascal's triangle|Pascal's triangle]]   is an arithmetic and geometric figure first imagined by   [[wp:Blaise Pascal|Blaise Pascal]]. + Its first few rows look like this: - 1 - 1 1 - 1 2 1 - 1 3 3 1 -where each element of each row is either 1 or the sum of the two elements right above it. For example, the next row would be 1 (since the first element of each row doesn't have two elements above it), 4 (1 + 3), 6 (3 + 3), 4 (3 + 1), and 1 (since the last element of each row doesn't have two elements above it). Each row n (starting with row 0 at the top) shows the coefficients of the binomial expansion of (x + y)n. + 1 + 1 1 + 1 2 1 + 1 3 3 1 +where each element of each row is either 1 or the sum of the two elements right above it. -Write a function that prints out the first n rows of the triangle (with f(1) yielding the row consisting of only the element 1). This can be done either by summing elements from the previous rows or using a binary coefficient or combination function. Behavior for n <= 0 does not need to be uniform, but should be noted. +For example, the next row of the triangle would be: +:::   '''1'''   (since the first element of each row doesn't have two elements above it) +:::   '''4'''   (1 + 3) +:::   '''6'''   (3 + 3) +:::   '''4'''   (3 + 1) +:::   '''1'''   (since the last element of each row doesn't have two elements above it) -'''See also:''' +So the triangle now looks like this: + 1 + 1 1 + 1 2 1 + 1 3 3 1 + 1 4 6 4 1 + +Each row   n   (starting with row   0   at the top) shows the coefficients of the binomial expansion of   (x + y)n. + + +;Task: +Write a function that prints out the first   n   rows of the triangle   (with   f(1)   yielding the row consisting of only the element '''1'''). + +This can be done either by summing elements from the previous rows or using a binary coefficient or combination function. + +Behavior for   n ≤ 0   does not need to be uniform, but should be noted. + + +;See also: * [[Evaluate binomial coefficients]] +

    diff --git a/Task/Pascals-triangle/AppleScript/pascals-triangle.applescript b/Task/Pascals-triangle/AppleScript/pascals-triangle.applescript new file mode 100644 index 0000000000..5705744436 --- /dev/null +++ b/Task/Pascals-triangle/AppleScript/pascals-triangle.applescript @@ -0,0 +1,136 @@ +-- pascal :: Int -> [[Int]] +on pascal(intRows) + + script addRow + on nextRow(row) + script add + on lambda(a, b) + a + b + end lambda + end script + + zipWith(add, [0] & row, row & [0]) + end nextRow + + on lambda(xs) + xs & {nextRow(item -1 of xs)} + end lambda + end script + + foldr(addRow, {{1}}, range(1, intRows - 1)) +end pascal + + +-- TEST + +on run + set lstTriangle to pascal(7) + + script spaced + on lambda(xs) + script rightAlign + on lambda(x) + text -4 thru -1 of (" " & x) + end lambda + end script + + intercalate("", map(rightAlign, xs)) + end lambda + end script + + script indented + on lambda(a, x) + set strIndent to leftSpace of a + + {rows:strIndent & x & linefeed & rows of a, leftSpace:leftSpace of a & " "} + end lambda + end script + + rows of foldr(indented, {rows:"", leftSpace:""}, map(spaced, lstTriangle)) +end run + + + +-- GENERIC LIBRARY FUNCTIONS + +-- foldr :: (a -> b -> a) -> a -> [b] -> a +on foldr(f, startValue, xs) + tell mReturn(f) + set v to startValue + set lng to length of xs + repeat with i from lng to 1 by -1 + set v to lambda(v, item i of xs, i, xs) + end repeat + return v + end tell +end foldr + +-- 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 + +-- 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 + +-- cond :: Bool -> (a -> b) -> (a -> b) -> (a -> b) +on cond(bool, f, g) + if bool then + f + else + g + end if +end cond + +-- intercalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate + +-- range :: Int -> Int -> [Int] +on range(m, n) + set lng to (n - m) + 1 + set base to m - 1 + set lst to {} + repeat with i from 1 to lng + set end of lst to i + base + end repeat + return lst +end range + +-- 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 diff --git a/Task/Pascals-triangle/Common-Lisp/pascals-triangle.lisp b/Task/Pascals-triangle/Common-Lisp/pascals-triangle-1.lisp similarity index 100% rename from Task/Pascals-triangle/Common-Lisp/pascals-triangle.lisp rename to Task/Pascals-triangle/Common-Lisp/pascals-triangle-1.lisp diff --git a/Task/Pascals-triangle/Common-Lisp/pascals-triangle-2.lisp b/Task/Pascals-triangle/Common-Lisp/pascals-triangle-2.lisp new file mode 100644 index 0000000000..e9053d7938 --- /dev/null +++ b/Task/Pascals-triangle/Common-Lisp/pascals-triangle-2.lisp @@ -0,0 +1,12 @@ +(defun pascal-next-row (a) + (loop :for q :in a + :and p = 0 :then q + :as s = (list (+ p q)) + :nconc s :into a + :finally (rplacd s (list 1)) + (return a))) + +(defun pascal (n) + (loop :for a = (list 1) :then (pascal-next-row a) + :repeat n + :collect a)) diff --git a/Task/Pascals-triangle/Groovy/pascals-triangle-1.groovy b/Task/Pascals-triangle/Groovy/pascals-triangle-1.groovy index 761b3f9fd3..25a0a836d0 100644 --- a/Task/Pascals-triangle/Groovy/pascals-triangle-1.groovy +++ b/Task/Pascals-triangle/Groovy/pascals-triangle-1.groovy @@ -1 +1,2 @@ -def pascal = { n -> (n <= 1) ? [1] : GroovyCollections.transpose([[0] + pascal(n - 1), pascal(n - 1) + [0]]).collect { it.sum() } } +def pascal +pascal = { n -> (n <= 1) ? [1] : [[0] + pascal(n - 1), pascal(n - 1) + [0]].transpose().collect { it.sum() } } diff --git a/Task/Pascals-triangle/JavaScript/pascals-triangle-2.js b/Task/Pascals-triangle/JavaScript/pascals-triangle-2.js index de68a2707b..0197cf10f4 100644 --- a/Task/Pascals-triangle/JavaScript/pascals-triangle-2.js +++ b/Task/Pascals-triangle/JavaScript/pascals-triangle-2.js @@ -1,70 +1,92 @@ (function (n) { + 'use strict'; - // A Pascal triangle of n rows - // n --> [[n]] - function pascalTriangle(n) { + // A Pascal triangle of n rows - // Sums of each consecutive pair of numbers - // [n] --> [n] - function pairSums(lst) { - return lst.reduce(function (acc, n, i, l) { - var iPrev = i ? i - 1 : 0; - return i ? acc.concat(l[iPrev] + l[i]) : acc - }, []); + // pascal :: Int -> [[Int]] + function pascal(n) { + return range(1, n - 1) + .reduce(function (a) { + var lstPreviousRow = a.slice(-1)[0]; + + return a + .concat( + [zipWith( + function (a, b) { + return a + b + }, + [0].concat(lstPreviousRow), + lstPreviousRow.concat(0) + )] + ); + }, [[1]]); } - // Next line in a Pascal triangle series - // [n] --> [n] - function nextPascal(lst) { - return lst.length ? [1].concat( - pairSums(lst) - ).concat(1) : [1]; + + + // GENERIC FUNCTIONS + + // zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] + function zipWith(f, xs, ys) { + return xs.length === ys.length ? ( + xs.map(function (x, i) { + return f(x, ys[i]); + }) + ) : undefined; } - // Each row is a function of the preceding row - return n ? Array.apply(null, Array(n - 1)).reduce( - function (a, _, i) { - return a.concat([nextPascal(a[i])]); - }, [[1]]) : []; - } + // range :: Int -> Int -> [Int] + function range(m, n) { + return Array.apply(null, Array(n - m + 1)) + .map(function (x, i) { + return m + i; + }); + } - // TEST - var lstTriangle = pascalTriangle(n); + // TEST + var lstTriangle = pascal(n); - // FORMAT OUTPUT AS WIKI TABLE + // FORMAT OUTPUT AS WIKI TABLE - // [[a]] -> bool -> s -> s - function wikiTable(lstRows, blnHeaderRow, strStyle) { - return '{| class="wikitable" ' + ( - strStyle ? 'style="' + strStyle + '"' : '' - ) + lstRows.map(function (lstRow, iRow) { - var strDelim = ((blnHeaderRow && !iRow) ? '!' : '|'); + // [[a]] -> bool -> s -> s + function wikiTable(lstRows, blnHeaderRow, strStyle) { + return '{| class="wikitable" ' + ( + strStyle ? 'style="' + strStyle + '"' : '' + ) + lstRows.map(function (lstRow, iRow) { + var strDelim = ((blnHeaderRow && !iRow) ? '!' : '|'); - return '\n|-\n' + strDelim + ' ' + lstRow.map(function (v) { - return typeof v === 'undefined' ? ' ' : v; - }).join(' ' + strDelim + strDelim + ' '); - }).join('') + '\n|}'; - } + return '\n|-\n' + strDelim + ' ' + lstRow.map(function ( + v) { + return typeof v === 'undefined' ? ' ' : v; + }) + .join(' ' + strDelim + strDelim + ' '); + }) + .join('') + '\n|}'; + } - var lstLastLine = lstTriangle.slice(-1)[0], - lngBase = (lstLastLine.length * 2) - 1, - nWidth = lstLastLine.reduce(function (a, x) { - var d = x.toString().length; - return d > a ? d : a; - }, 1) * lngBase; + var lstLastLine = lstTriangle.slice(-1)[0], + lngBase = (lstLastLine.length * 2) - 1, + nWidth = lstLastLine.reduce(function (a, x) { + var d = x.toString() + .length; + return d > a ? d : a; + }, 1) * lngBase; - return [ + return [ wikiTable( - lstTriangle.map(function (lst) { - return lst.join(';;').split(';'); - }).map(function (line, i) { - var lstPad = Array((lngBase - line.length) / 2); - return lstPad.concat(line).concat(lstPad); - }), - false, - 'text-align:center;width:' + nWidth + 'em;height:' + nWidth + - 'em;table-layout:fixed;' + lstTriangle.map(function (lst) { + return lst.join(';;') + .split(';'); + }) + .map(function (line, i) { + var lstPad = Array((lngBase - line.length) / 2); + return lstPad.concat(line) + .concat(lstPad); + }), + false, + 'text-align:center;width:' + nWidth + 'em;height:' + nWidth + + 'em;table-layout:fixed;' ), JSON.stringify(lstTriangle) diff --git a/Task/Pascals-triangle/JavaScript/pascals-triangle-4.js b/Task/Pascals-triangle/JavaScript/pascals-triangle-4.js new file mode 100644 index 0000000000..4e1e8b3378 --- /dev/null +++ b/Task/Pascals-triangle/JavaScript/pascals-triangle-4.js @@ -0,0 +1,50 @@ +(() => { + 'use strict'; + + // pascal :: Int -> [[Int]] + let pascal = n => + range(1, n - 1) + .reduce(a => { + let lstPreviousRow = a.slice(-1)[0]; + + return a + .concat([zipWith((a, b) => a + b, + [0].concat(lstPreviousRow), + lstPreviousRow.concat(0) + )]); + }, [ + [1] + ]); + + // GENERIC FUNCTIONS + + // Int -> Int -> Maybe Int -> [Int] + let range = (m, n, step) => { + let d = (step || 1) * (n >= m ? 1 : -1); + return Array.from({ + length: Math.floor((n - m) / d) + 1 + }, (_, i) => m + (i * d)); + }, + + // zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] + zipWith = (f, xs, ys) => + xs.length === ys.length ? ( + xs.map((x, i) => f(x, ys[i])) + ) : undefined; + + // TEST + return pascal(7) + .reduceRight((a, x) => { + let strIndent = a.indent; + + return { + rows: strIndent + x + .map(n => (' ' + n).slice(-4)) + .join('') + '\n' + a.rows, + indent: strIndent + ' ' + }; + }, { + rows: '', + indent: '' + }).rows; +})(); diff --git a/Task/Pascals-triangle/Maple/pascals-triangle.maple b/Task/Pascals-triangle/Maple/pascals-triangle.maple new file mode 100644 index 0000000000..649b8d3b37 --- /dev/null +++ b/Task/Pascals-triangle/Maple/pascals-triangle.maple @@ -0,0 +1,3 @@ +f:=n->seq(print(seq(binomial(i,k),k=0..i)),i=0..n-1); + +f(3); diff --git a/Task/Pascals-triangle/Perl-6/pascals-triangle-1.pl6 b/Task/Pascals-triangle/Perl-6/pascals-triangle-1.pl6 index 9acb990be6..ae223b731b 100644 --- a/Task/Pascals-triangle/Perl-6/pascals-triangle-1.pl6 +++ b/Task/Pascals-triangle/Perl-6/pascals-triangle-1.pl6 @@ -1,3 +1,5 @@ -sub pascal { [1], -> $prev { [0, |$prev Z+ |$prev, 0] } ... * } +sub pascal { + [1], { [0, |$_ Z+ |$_, 0] } ... * +} .say for pascal[^10]; diff --git a/Task/Pascals-triangle/REXX/pascals-triangle.rexx b/Task/Pascals-triangle/REXX/pascals-triangle.rexx index e9329f0d12..cb54507c7c 100644 --- a/Task/Pascals-triangle/REXX/pascals-triangle.rexx +++ b/Task/Pascals-triangle/REXX/pascals-triangle.rexx @@ -1,25 +1,25 @@ -/*REXX program displays Pascal's triangle (centered/formatted); also known as:*/ -/*────────── Yang Hui's, Khayyam─Pascal, Kyayyam, and/or Tartaglia's triangle.*/ -numeric digits 3000 /*be able to handle gihugeic triangles.*/ -parse arg nn .; if nn=='' then nn=10 /*use default if NN wasn't specified.*/ -N=abs(nn) /*N is the number of rows in triangle.*/ -@.=1; $.=@. /*default value for rows and for lines.*/ -w=length(!(N-1) / !(N%2) / !(N-1-N%2)) /*W is the width of the biggest number*/ - /* [↓] build rows of Pascals' triangle*/ - do r=1 for N; rm=r-1 /*Note: the first column is always 1.*/ - do c=2 to rm; cm=c-1 /*build the rest of the columns in row.*/ - @.r.c= @.rm.cm + @.rm.c /*assign value to a specific row & col.*/ - $.r = $.r right(@.r.c, w) /*and construct a line for output (row)*/ - end /*c*/ /* [↑] C is the column being built.*/ - if r\==1 then $.r=$.r right(1, w) /*for most rows, append a trailing "1".*/ - end /*r*/ /* [↑] R is the row being built.*/ - /* [↑] WIDTH: for nicely looking line.*/ -width=length($.N) /*width of the last (output) line (row)*/ - /*if NN<0, output is written to a file.*/ - do r=1 for N /*show│write lines (rows) of triangle. */ - if nn>0 then say center($.r, width) /*SAY, or*/ - else call lineout 'PASCALS.'n, center($.r, width) /*write. */ - end /*r*/ -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────! subroutine (factorial)─────────────────*/ -!: procedure; parse arg x; !=1; do j=2 to x; !=!*j; end; return ! +/*REXX program displays (or writes to a file) Pascal's triangle (centered/formatted).*/ +numeric digits 3000 /*be able to handle gihugeic triangles.*/ +parse arg nn . /*obtain the optional argument from CL.*/ +if nn=='' | nn=="," then nn=10 /*Not specified? Then use the default.*/ +N=abs(nn) /*N is the number of rows in triangle.*/ +w=length( !(N-1) / !(N%2) / !(N-1-N%2) ) /*W: the width of the biggest integer.*/ +@.=1; $.=@.; unity=right(1, w) /*defaults rows & lines; aligned unity.*/ + /* [↓] build rows of Pascals' triangle*/ + do r=1 for N; rm=r-1 /*Note: the first column is always 1.*/ + do c=2 to rm; cm=c-1 /*build the rest of the columns in row.*/ + @.r.c= @.rm.cm + @.rm.c /*assign value to a specific row & col.*/ + $.r = $.r right(@.r.c, w) /*and construct a line for output (row)*/ + end /*c*/ /* [↑] C is the column being built.*/ + if r\==1 then $.r=$.r unity /*for rows≥2, append a trailing "1".*/ + end /*r*/ /* [↑] R is the row being built.*/ + /* [↑] WIDTH: for nicely looking line.*/ +width=length($.N) /*width of the last (output) line (row)*/ + /*if NN<0, output is written to a file.*/ + do r=1 for N; $$=center($.r, width) /*center this particular Pascals' row. */ + if nn>0 then say $$ /*SAY if NN is positive, else */ + else call lineout 'PASCALS.'n, $$ /*write this Pascal's row ───► a file.*/ + end /*r*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +!: procedure; !=1; do j=2 to arg(1); !=!*j; end /*j*/; return ! /*compute factorial*/ diff --git a/Task/Pattern-matching/Elixir/pattern-matching.elixir b/Task/Pattern-matching/Elixir/pattern-matching.elixir new file mode 100644 index 0000000000..51a6ba6ee4 --- /dev/null +++ b/Task/Pattern-matching/Elixir/pattern-matching.elixir @@ -0,0 +1,43 @@ +defmodule RBtree do + def find(nil, _), do: :not_found + def find({ key, value, _, _, _ }, key), do: { :found, { key, value } } + def find({ key1, _, _, left, _ }, key) when key < key1, do: find(left, key) + def find({ key1, _, _, _, right }, key) when key > key1, do: find(right, key) + + def new(key, value), do: ins(nil, key, value) |> make_black + + def insert(tree, key, value), do: ins(tree, key, value) |> make_black + + defp ins(nil, key, value), + do: { key, value, :r, nil, nil } + defp ins({ key, _, color, left, right }, key, value), + do: { key, value, color, left, right } + defp ins({ ky, vy, cy, ly, ry }, key, value) when key < ky, + do: balance({ ky, vy, cy, ins(ly, key, value), ry }) + defp ins({ ky, vy, cy, ly, ry }, key, value) when key > ky, + do: balance({ ky, vy, cy, ly, ins(ry, key, value) }) + + defp make_black({ key, value, _, left, right }), + do: { key, value, :b, left, right } + + defp balance({ kx, vx, :b, lx, { ky, vy, :r, ly, { kz, vz, :r, lz, rz } } }), + do: { ky, vy, :r, { kx, vx, :b, lx, ly }, { kz, vz, :b, lz, rz } } + defp balance({ kx, vx, :b, lx, { ky, vy, :r, { kz, vz, :r, lz, rz }, ry } }), + do: { kz, vz, :r, { kx, vx, :b, lx, lz }, { ky, vy, :b, rz, ry } } + defp balance({ kx, vx, :b, { ky, vy, :r, { kz, vz, :r, lz, rz }, ry }, rx }), + do: { ky, vy, :r, { kz, vz, :b, lz, rz }, { kx, vx, :b, ry, rx } } + defp balance({ kx, vx, :b, { ky, vy, :r, ly, { kz, vz, :r, lz, rz } }, rx }), + do: { kz, vz, :r, { ky, vy, :b, ly, lz }, { kx, vx, :b, rz, rx } } + defp balance(t), + do: t +end + +RBtree.new(0,3) |> IO.inspect +|> RBtree.insert(1,5) |> IO.inspect +|> RBtree.insert(2,-1) |> IO.inspect +|> RBtree.insert(3,7) |> IO.inspect +|> RBtree.insert(4,-3) |> IO.inspect +|> RBtree.insert(5,0) |> IO.inspect +|> RBtree.insert(6,-1) |> IO.inspect +|> RBtree.insert(7,0) |> IO.inspect +|> RBtree.find(4) |> IO.inspect diff --git a/Task/Penneys-game/00DESCRIPTION b/Task/Penneys-game/00DESCRIPTION index 867435e43d..f785d1cdd4 100644 --- a/Task/Penneys-game/00DESCRIPTION +++ b/Task/Penneys-game/00DESCRIPTION @@ -1,18 +1,31 @@ -[[wp:Penney's_game|Penneys game]] is a game where two players bet on being the first to see a particular sequence of Heads and Tails in consecutive tosses of a fair coin. +[[wp:Penney's_game|Penney's game]]   is a game where two players bet on being the first to see a particular sequence of   [[wp:Coin_flipping|heads or tails]]   in consecutive tosses of a   [[wp:Fair_coin|fair coin]]. -It is common to agree on a sequence length of three then one player will openly choose a sequence, for example Heads, Tails, Heads, or HTH for short; then the other player on seeing the first players choice will choose his sequence. The coin is tossed and the first player to see his sequence in the sequence of coin tosses wins. +It is common to agree on a sequence length of three then one player will openly choose a sequence, for example: + Heads, Tails, Heads, or + '''HTH''' for short. +The other player on seeing the first players choice will choose his sequence. -For example: One player might choose the sequence HHT and the other THT. Successive coin tosses of HTTHT gives the win to the second player as the last three coin tosses are his sequence. +The coin is tossed and the first player to see his sequence in the sequence of coin tosses wins. -;The Task: + +;Example: +One player might choose the sequence   '''HHT'''   and the other   '''THT'''.   + +Successive coin tosses of   '''HTTHT'''   gives the win to the second player as the last three coin tosses are his sequence. + + +;Task: Create a program that tosses the coin, keeps score and plays Penney's game against a human opponent. -* Who chooses and shows their sequence of three should be chosen randomly. -* If going first, the computer should choose its sequence of three randomly. -* If going second, the computer should automatically play [[wp:Penney's_game#Analysis_of_the_three-bit_game|the optimum sequence]]. -* Successive coin tosses should be shown. +:*   Who chooses and shows their sequence of three should be chosen randomly. +:*   If going first, the computer should randomly choose its sequence of three. +:*   If going second, the computer should automatically play [[wp:Penney's_game#Analysis_of_the_three-bit_game|the optimum sequence]]. +:*   Successive coin tosses should be shown. -Show output of a game where the computer choses first and a game where the user goes first here on this page. +
    +Show output of a game where the computer chooses first and a game where the user goes first here on this page. -;Refs: -* [https://www.youtube.com/watch?v=OcYnlSenF04 The Penney Ante Part 1] (Video). -* [https://www.youtube.com/watch?v=U9wak7g5yQA The Penney Ante Part 2] (Video). + +;See also: +*   [https://www.youtube.com/watch?v=OcYnlSenF04 The Penney Ante Part 1] (Video). +*   [https://www.youtube.com/watch?v=U9wak7g5yQA The Penney Ante Part 2] (Video). +

    diff --git a/Task/Penneys-game/BBC-BASIC/penneys-game.bbc b/Task/Penneys-game/BBC-BASIC/penneys-game.bbc new file mode 100644 index 0000000000..2b7f591437 --- /dev/null +++ b/Task/Penneys-game/BBC-BASIC/penneys-game.bbc @@ -0,0 +1,81 @@ +REM >penney +PRINT "*** Penney's Game ***" +REPEAT + PRINT ' "Heads you pick first, tails I pick first." + PRINT "And it is... "; + WAIT 100 + ht% = RND(0 - TIME) AND 1 + IF ht% THEN + PRINT "heads!" + PROC_player_chooses(player$) + computer$ = FN_optimal(player$) + PRINT "I choose "; computer$; "." + ELSE + PRINT "tails!" + computer$ = FN_random + PRINT "I choose "; computer$; "." + PROC_player_chooses(player$) + ENDIF + PRINT "Starting the game..." ' SPC 5; + sequence$ = "" + winner% = FALSE + REPEAT + WAIT 100 + roll% = RND AND 1 + IF roll% THEN + sequence$ += "H" + PRINT "H "; + ELSE + PRINT "T "; + sequence$ += "T" + ENDIF + IF RIGHT$(sequence$, 3) = computer$ THEN + PRINT ' "I won!" + winner% = TRUE + ELSE + IF RIGHT$(sequence$, 3) = player$ THEN + PRINT ' "Congratulations! You won." + winner% = TRUE + ENDIF + ENDIF + UNTIL winner% + REPEAT + valid% = FALSE + INPUT "Another game? (Y/N) " another$ + IF INSTR("YN", another$) THEN valid% = TRUE + UNTIL valid% +UNTIL another$ = "N" +PRINT "Thank you for playing!" +END +: +DEF PROC_player_chooses(RETURN sequence$) +LOCAL choice$, valid%, i% +REPEAT + valid% = TRUE + PRINT "Enter a sequence of three choices, each of them either H or T:" + INPUT "> " sequence$ + IF LEN sequence$ <> 3 THEN valid% = FALSE + IF valid% THEN + FOR i% = 1 TO 3 + choice$ = MID$(sequence$, i%, 1) + IF choice$ <> "H" AND choice$ <> "T" THEN valid% = FALSE + NEXT + ENDIF +UNTIL valid% +ENDPROC +: +DEF FN_random +LOCAL sequence$, choice%, i% +sequence$ = "" +FOR i% = 1 TO 3 + choice% = RND AND 1 + IF choice% THEN sequence$ += "H" ELSE sequence$ += "T" +NEXT += sequence$ +: +DEF FN_optimal(sequence$) +IF MID$(sequence$, 2, 1) = "H" THEN + = "T" + LEFT$(sequence$, 2) +ELSE + = "H" + LEFT$(sequence$, 2) +ENDIF diff --git a/Task/Penneys-game/Elixir/penneys-game.elixir b/Task/Penneys-game/Elixir/penneys-game.elixir new file mode 100644 index 0000000000..824113f883 --- /dev/null +++ b/Task/Penneys-game/Elixir/penneys-game.elixir @@ -0,0 +1,57 @@ +defmodule Penney do + @toss [:Heads, :Tails] + + def game(score \\ {0,0}) + def game({iwin, ywin}=score) do + IO.puts "Penney game score I : #{iwin}, You : #{ywin}" + [i, you] = @toss + coin = Enum.random(@toss) + IO.puts "#{i} I start, #{you} you start ..... #{coin}" + {myC, yC} = setup(coin) + seq = for _ <- 1..3, do: Enum.random(@toss) + IO.write Enum.join(seq, " ") + {winner, score} = loop(seq, myC, yC, score) + IO.puts "\n #{winner} win!\n" + game(score) + end + + defp setup(:Heads) do + myC = Enum.shuffle(@toss) ++ [Enum.random(@toss)] + joined = Enum.join(myC, " ") + IO.puts "I chose : #{joined}" + {myC, yourChoice} + end + defp setup(:Tails) do + yC = yourChoice + myC = (@toss -- [Enum.at(yC,1)]) ++ Enum.take(yC,2) + joined = Enum.join(myC, " ") + IO.puts "I chose : #{joined}" + {myC, yC} + end + + defp yourChoice do + IO.write "Enter your choice (H/T) " + choice = read([]) + IO.puts "You chose: #{Enum.join(choice, " ")}" + choice + end + + defp read([_,_,_]=choice), do: choice + defp read(choice) do + case IO.getn("") |> String.upcase do + "H" -> read(choice ++ [:Heads]) + "T" -> read(choice ++ [:Tails]) + _ -> read(choice) + end + end + + defp loop(myC, myC, _, {iwin, ywin}), do: {"I", {iwin+1, ywin}} + defp loop(yC, _, yC, {iwin, ywin}), do: {"You", {iwin, ywin+1}} + defp loop(seq, myC, yC, score) do + append = Enum.random(@toss) + IO.write " #{append}" + loop(tl(seq)++[append], myC, yC, score) + end +end + +Penney.game diff --git a/Task/Penneys-game/R/penneys-game.r b/Task/Penneys-game/R/penneys-game.r new file mode 100644 index 0000000000..c013312fe5 --- /dev/null +++ b/Task/Penneys-game/R/penneys-game.r @@ -0,0 +1,63 @@ +#=============================================================== +# Penney's Game Task from Rosetta Code Wiki +# R implementation +#=============================================================== + +penneysgame <- function() { + + #--------------------------------------------------------------- + # Who goes first? + #--------------------------------------------------------------- + + first <- sample(c("PC", "Human"), 1) + + #--------------------------------------------------------------- + # Determine the sequences + #--------------------------------------------------------------- + + if (first == "PC") { # PC goes first + + pc.seq <- sample(c("H", "T"), 3, replace = TRUE) + cat(paste("\nI choose first and will win on first seeing", paste(pc.seq, collapse = ""), "in the list of tosses.\n\n")) + human.seq <- readline("What sequence of three Heads/Tails will you win with: ") + human.seq <- unlist(strsplit(human.seq, "")) + + } else if (first == "Human") { # Player goest first + + cat(paste("\nYou can choose your winning sequence first.\n\n")) + human.seq <- readline("What sequence of three Heads/Tails will you win with: ") + human.seq <- unlist(strsplit(human.seq, "")) # Split the string into characters + pc.seq <- c(human.seq[2], human.seq[1:2]) # Append second element at the start + pc.seq[1] <- ifelse(pc.seq[1] == "H", "T", "H") # Switch first element to get the optimal guess + cat(paste("\nI win on first seeing", paste(pc.seq, collapse = ""), "in the list of tosses.\n")) + + } + + #--------------------------------------------------------------- + # Start throwing the coin + #--------------------------------------------------------------- + + cat("\nThrowing:\n") + + ran.seq <- NULL + + while(TRUE) { + + ran.seq <- c(ran.seq, sample(c("H", "T"), 1)) # Add a new coin throw to the vector of throws + + cat("\n", paste(ran.seq, sep = "", collapse = "")) # Print the sequence thrown so far + + if (length(ran.seq) >= 3 && all(tail(ran.seq, 3) == pc.seq)) { + cat("\n\nI win!\n") + break + } + + if (length(ran.seq) >= 3 && all(tail(ran.seq, 3) == human.seq)) { + cat("\n\nYou win!\n") + break + } + + Sys.sleep(0.5) # Pause for 0.5 seconds + + } +} diff --git a/Task/Penneys-game/REXX/penneys-game.rexx b/Task/Penneys-game/REXX/penneys-game.rexx index c88e228eb4..aac837f58b 100644 --- a/Task/Penneys-game/REXX/penneys-game.rexx +++ b/Task/Penneys-game/REXX/penneys-game.rexx @@ -1,67 +1,67 @@ -/*REXX program plays Penney's Game, a 2-player coin toss sequence game.*/ -__=copies('─',9) /*literal for eyecatching fence. */ -signal on halt /*a clean way out if CLBF quits. */ -parse arg # ? . /*get optional args from the C.L.*/ -if #=='' | #=="," then #=3 /*default coin sequence length. */ -if ?\=='' & ?\==',' then call random ,,? /*use seed for RANDOM #s ?*/ -wins=0; do games=1 /*play a number of Penney's games*/ - call game /*play a single inning of a game.*/ - end /*games*/ /*keep at it 'til QUIT or halt.*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────one-line subroutines────────────────*/ -halt: say; say __ "Penney's Game was halted."; say; exit 13 -r: arg ,$; do arg(1); $=$||random(0,1); end; return $ -s: if arg(1)==1 then return arg(3); return word(arg(2) 's',1) /*plural*/ -/*──────────────────────────────────GAME subroutine─────────────────────*/ -game: @.=; tosses=@. /*the coin toss sequence so far. */ -toss1=r(1) /*result: 0=computer, 1=CBLF.*/ -if \toss1 then call randComp /*maybe let the computer go first*/ -if toss1 then say __ "You win the first toss, so you pick your sequence first." - else say __ "The computer won first toss, the pick was: " @.comp - call prompter /*get the human's guess from C.L.*/ - call randComp /*get computer's guess if needed.*/ - /*CBLF: carbon-based life form. */ -say __ " your pick:" @.CBLF /*echo human's pick to terminal. */ -say __ "computer's pick:" @.comp /* " comp.'s " " " */ -say /* [↓] flip the coin 'til a win.*/ - do flips=1 until pos(@.CBLF,tosses)\==0 | pos(@.comp,tosses)\==0 - tosses=tosses || translate(r(1),'HT',10) - end /*flips*/ /* [↑] this is a flipping coin,*/ - /* [↓] series of tosses*/ -say __ "The tossed coin series was: " tosses /*show the coin tosses.*/ -say -@@@="won this toss with " flips ' coin tosses.' /*handy literal.*/ -if pos(@.CBLF,tosses)\==0 then do; say __ "You" @@@; wins=wins+1; end - else say __ "The computer" @@@ -_=wins; if _==0 then _='no' /*use gooder English.*/ -say __ "You've won" _ "game"s(wins) 'out of ' games"." -say; say copies('╩╦',79%2)'╩'; say /*show eyeball fence.*/ -return -/*──────────────────────────────────PROMPTER subroutine─────────────────*/ -prompter: oops=__ 'Oops! '; a= /*define some handy REXX literals*/ -@a_z='ABCDEFG-IJKLMNOPQRS+UVWXYZ' /*the extraneous alphabetic chars*/ -p=__ 'Pick a sequence of' # "coin tosses of H or T (Heads or Tails) or Quit:" - do until ok; say; say p; pull a /*uppercase the answer.*/ - if abbrev('QUIT',a,1) then exit 1 /*human wants to quit. */ - a=space(translate(a,,@a_z',./\;:_'),0) /*elide extraneous chrs*/ - b=translate(a,10,'HT'); L=length(a) /*tran───►bin; get len.*/ - ok=0 /*response is OK so far*/ - select /*verify user response.*/ - when \datatype(b,'B') then say oops "Illegal response." - when \datatype(a,'M') then say oops "Illegal characters in response." - when L==0 then say oops "No choice was given." - when L<# then say oops "Not enough coin choices." - when L># then say oops "Too many coin choices." - when a==@.comp then say oops "You can't choose the computer's choice: " @.comp - otherwise ok=1 - end /*select*/ - end /*until ok*/ -@.CBLF=a; @.CBLF!=b /*we have the human's guess now. */ -return -/*──────────────────────────────────RANDCOMP subroutine─────────────────*/ -randComp: if @.comp\=='' then return /*the computer already has a pick*/ -_=@.CBLF! /* [↓] use best-choice algorithm.*/ -if _\=='' then g=left((\substr(_,min(2,#),1))left(_,1)substr(_,3),#) - do until g\==@.CBLF!; g=r(#); end /*otherwise, generate a choice. */ -@.comp=translate(g,'HT',10) -return +/*REXX program plays/simulates Penney's Game, a two-player coin toss sequence game. */ +__=copies('─',9) /*literal for eyecatching fence. */ +signal on halt /*a clean way out if CLBF quits. */ +parse arg # seed . /*obtain optional arguments from the CL*/ +if #=='' | #=="," then #=3 /*Not specified? Then use the default.*/ +if datatype(seed,'W') then call random ,,seed /*use seed for RANDOM #s repeatability.*/ +wins=0; do games=1 /*simulate a number of Penney's games. */ + call game /*simulate a single inning of a game. */ + end /*games*/ /*keep at it until QUIT or halt. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +halt: say; say __ "Penney's Game was halted."; say; exit 13 +r: arg ,$; do arg(1); $=$ || random(0,1); end; return $ +s: if arg(1)==1 then return arg(3); return word(arg(2) 's',1) /*pluralizer.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +game: @.=; tosses=@. /*the coin toss sequence so far. */ + toss1=r(1) /*result: 0=computer, 1=CBLF.*/ + if \toss1 then call randComp /*maybe let the computer go first*/ + if toss1 then say __ "You win the first toss, so you pick your sequence first." + else say __ "The computer won first toss, the pick was: " @.comp + call prompter /*get the human's guess from C.L.*/ + call randComp /*get computer's guess if needed.*/ + /*CBLF: carbon-based life form. */ + say __ " your pick:" @.CBLF /*echo human's pick to terminal. */ + say __ "computer's pick:" @.comp /* " comp.'s " " " */ + say /* [↓] flip the coin 'til a win.*/ + do flips=1 until pos(@.CBLF,tosses)\==0 | pos(@.comp,tosses)\==0 + tosses=tosses || translate(r(1),'HT',10) + end /*flips*/ /* [↑] this is a flipping coin,*/ + /* [↓] series of tosses*/ + say __ "The tossed coin series was: " tosses + say + @@@="won this toss with " flips ' coin tosses.' + if pos(@.CBLF,tosses)\==0 then do; say __ "You" @@@; wins=wins+1; end + else say __ "The computer" @@@ + _=wins; if _==0 then _='no' + say __ "You've won" _ "game"s(wins) 'out of ' games"." + say; say copies('╩╦',79%2)'╩'; say + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +prompter: oops=__ 'Oops! '; a= /*define some handy REXX literals*/ + @a_z='ABCDEFG-IJKLMNOPQRS+UVWXYZ' /*the extraneous alphabetic chars*/ + p=__ 'Pick a sequence of' # "coin tosses of H or T (Heads or Tails) or Quit:" + do until ok; say; say p; pull a /*uppercase the answer. */ + if abbrev('QUIT',a,1) then exit 1 /*the human wants to quit. */ + a=space(translate(a,,@a_z',./\;:_'),0) /*elide extraneous characters. */ + b=translate(a,10,'HT'); L=length(a) /*translate ───► bin; get length.*/ + ok=0 /*the response is OK (so far). */ + select /*verify the user response. */ + when \datatype(b,'B') then say oops "Illegal response." + when \datatype(a,'M') then say oops "Illegal characters in response." + when L==0 then say oops "No choice was given." + when L<# then say oops "Not enough coin choices." + when L># then say oops "Too many coin choices." + when a==@.comp then say oops "You can't choose the computer's choice: " @.comp + otherwise ok=1 + end /*select*/ + end /*until ok*/ + @.CBLF=a; @.CBLF!=b /*we have the human's guess now. */ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +randComp: if @.comp\=='' then return /*the computer already has a pick*/ + _=@.CBLF! /* [↓] use best-choice algorithm.*/ + if _\=='' then g=left((\substr(_, min(2, #), 1))left(_, 1)substr(_, 3), #) + do until g\==@.CBLF!; g=r(#); end /*otherwise, generate a choice. */ + @.comp=translate(g, 'HT', 10) + return diff --git a/Task/Penneys-game/Ruby/penneys-game.rb b/Task/Penneys-game/Ruby/penneys-game.rb index fa38533884..c8d870f1f9 100644 --- a/Task/Penneys-game/Ruby/penneys-game.rb +++ b/Task/Penneys-game/Ruby/penneys-game.rb @@ -1,5 +1,3 @@ -# Penney's Game - Toss = [:Heads, :Tails] def yourChoice @@ -14,22 +12,24 @@ def yourChoice choice end -puts "%s I start, %s you start ..... #{coin = Toss.sample}" % Toss -if coin == Toss[0] - myC = Array.new(3){Toss.sample} - puts "I chose #{myC.join(' ')}" - yC = yourChoice -else - yC = yourChoice - myC = Toss - [yC[1]] + yC.first(2) - puts "I chose #{myC.join(' ')}" -end - -seq = Array.new(3){Toss.sample} -print seq.join(' ') loop do - puts "\n I win!" or break if seq == myC - puts "\n You win!" or break if seq == yC - seq.push(Toss.sample).shift - print " #{seq[-1]}" + puts "\n%s I start, %s you start ..... %s" % [*Toss, coin = Toss.sample] + if coin == Toss[0] + myC = Toss.shuffle << Toss.sample + puts "I chose #{myC.join(' ')}" + yC = yourChoice + else + yC = yourChoice + myC = Toss - [yC[1]] + yC.first(2) + puts "I chose #{myC.join(' ')}" + end + + seq = Array.new(3){Toss.sample} + print seq.join(' ') + loop do + puts "\n I win!" or break if seq == myC + puts "\n You win!" or break if seq == yC + seq.push(Toss.sample).shift + print " #{seq[-1]}" + end end diff --git a/Task/Percentage-difference-between-images/Frink/percentage-difference-between-images.frink b/Task/Percentage-difference-between-images/Frink/percentage-difference-between-images.frink new file mode 100644 index 0000000000..2bccf1c4c2 --- /dev/null +++ b/Task/Percentage-difference-between-images/Frink/percentage-difference-between-images.frink @@ -0,0 +1,17 @@ +img1 = new image["file:Lenna50.jpg"] +img2 = new image["file:Lenna100.jpg"] + +[w1, h1] = img1.getSize[] +[w2, h2] = img2.getSize[] + +sum = 0 +for x=0 to w1-1 + for y=0 to h1-1 + { + [r1,g1,b1] = img1.getPixel[x,y] + [r2,g2,b2] = img2.getPixel[x,y] + sum = sum + abs[r1-r2] + abs[g1-g2] + abs[b1-b2] + } + +errors = sum / (w1 * h1 * 3) +println["Error is " + (errors->"percent")] diff --git a/Task/Percolation-Bond-percolation/00DESCRIPTION b/Task/Percolation-Bond-percolation/00DESCRIPTION index 62a37092d2..ab5c8c3aa1 100644 --- a/Task/Percolation-Bond-percolation/00DESCRIPTION +++ b/Task/Percolation-Bond-percolation/00DESCRIPTION @@ -1,5 +1,5 @@ {{Percolation Simulation}} -Given an M \times N rectangular array of cells numbered \mathrm{cell}[0..M-1, 0..N-1]assume M is horizontal and N is downwards. Each \mathrm{cell}[m, n] is bounded by (horizontal) walls \mathrm{hwall}[m, n] and \mathrm{hwall}[m+1, n]; (vertical) walls \mathrm{vwall}[m, n] and \mathrm{vwall}[m, n+1] +Given an M \times N rectangular array of cells numbered \mathrm{cell}[0..M-1, 0..N-1], assume M is horizontal and N is downwards. Each \mathrm{cell}[m, n] is bounded by (horizontal) walls \mathrm{hwall}[m, n] and \mathrm{hwall}[m+1, n]; (vertical) walls \mathrm{vwall}[m, n] and \mathrm{vwall}[m, n+1] Assume that the probability of any wall being present is a constant p where : 0.0 \le p \le 1.0 @@ -21,3 +21,4 @@ Use an M=10, N=10 grid of cells for all cases. Optionally depict fluid successfully percolating through a grid graphically. Show all output on this page. +

    diff --git a/Task/Percolation-Bond-percolation/C++/percolation-bond-percolation.cpp b/Task/Percolation-Bond-percolation/C++/percolation-bond-percolation.cpp new file mode 100644 index 0000000000..be75edba9a --- /dev/null +++ b/Task/Percolation-Bond-percolation/C++/percolation-bond-percolation.cpp @@ -0,0 +1,103 @@ +#include +#include +#include +#include + +using namespace std; + +class Grid { +public: + Grid(const double p, const int x, const int y) : m(x), n(y) { + const int thresh = static_cast(RAND_MAX * p); + + // Allocate two addition rows to avoid checking bounds. + // Bottom row is also required by drippage + start = new cell[m * (n + 2)]; + cells = start + m; + for (auto i = 0; i < m; i++) start[i] = RBWALL; + end = cells; + for (auto i = 0; i < y; i++) { + for (auto j = x; --j;) + *end++ = (rand() < thresh ? BWALL : 0) | (rand() < thresh ? RWALL : 0); + *end++ = RWALL | (rand() < thresh ? BWALL : 0); + } + memset(end, 0u, sizeof(cell) * m); + } + + ~Grid() { + delete[] start; + cells = 0; + start = 0; + end = 0; + } + + int percolate() const { + auto i = 0; + for (; i < m && !fill(cells + i); i++); + return i < m; + } + + void show() const { + for (auto j = 0; j < m; j++) + cout << ("+-"); + cout << '+' << endl; + + for (auto i = 0; i <= n; i++) { + cout << (i == n ? ' ' : '|'); + for (auto j = 0; j < m; j++) { + cout << ((cells[i * m + j] & FILL) ? "#" : " "); + cout << ((cells[i * m + j] & RWALL) ? '|' : ' '); + } + cout << endl; + + if (i == n) return; + + for (auto j = 0; j < m; j++) + cout << ((cells[i * m + j] & BWALL) ? "+-" : "+ "); + cout << '+' << endl; + } + } + +private: + enum cell_state { + FILL = 1 << 0, + RWALL = 1 << 1, // right wall + BWALL = 1 << 2, // bottom wall + RBWALL = RWALL | BWALL // right/bottom wall + }; + + typedef unsigned int cell; + + bool fill(cell* p) const { + if ((*p & FILL)) return false; + *p |= FILL; + if (p >= end) return true; // success: reached bottom row + + return (!(p[0] & BWALL) && fill(p + m)) || (!(p[0] & RWALL) && fill(p + 1)) + ||(!(p[-1] & RWALL) && fill(p - 1)) || (!(p[-m] & BWALL) && fill(p - m)); + } + + cell* cells; + cell* start; + cell* end; + const int m; + const int n; +}; + +int main() { + const auto M = 10, N = 10; + const Grid grid(.5, M, N); + grid.percolate(); + grid.show(); + + const auto C = 10000; + cout << endl << "running " << M << "x" << N << " grids " << C << " times for each p:" << endl; + for (auto p = 1; p < M; p++) { + auto cnt = 0, i = 0; + for (; i < C; i++) + cnt += Grid(p / static_cast(M), M, N).percolate(); + cout << "p = " << p / static_cast(M) << ": " << static_cast(cnt) / i << endl; + } + + return EXIT_SUCCESS; +} diff --git a/Task/Percolation-Mean-cluster-density/Go/percolation-mean-cluster-density.go b/Task/Percolation-Mean-cluster-density/Go/percolation-mean-cluster-density.go new file mode 100644 index 0000000000..ac51f08c32 --- /dev/null +++ b/Task/Percolation-Mean-cluster-density/Go/percolation-mean-cluster-density.go @@ -0,0 +1,98 @@ +package main + +import ( + "fmt" + "math/rand" + "time" +) + +var ( + n_range = []int{4, 64, 256, 1024, 4096} + M = 15 + N = 15 +) + +const ( + p = .5 + t = 5 + NOT_CLUSTERED = 1 + cell2char = " #abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" +) + +func newgrid(n int, p float64) [][]int { + g := make([][]int, n) + for y := range g { + gy := make([]int, n) + for x := range gy { + if rand.Float64() < p { + gy[x] = 1 + } + } + g[y] = gy + } + return g +} + +func pgrid(cell [][]int) { + for n := 0; n < N; n++ { + fmt.Print(n%10, ") ") + for m := 0; m < M; m++ { + fmt.Printf(" %c", cell2char[cell[n][m]]) + } + fmt.Println() + } +} + +func cluster_density(n int, p float64) float64 { + cc := clustercount(newgrid(n, p)) + return float64(cc) / float64(n) / float64(n) +} + +func clustercount(cell [][]int) int { + walk_index := 1 + for n := 0; n < N; n++ { + for m := 0; m < M; m++ { + if cell[n][m] == NOT_CLUSTERED { + walk_index++ + walk_maze(m, n, cell, walk_index) + } + } + } + return walk_index - 1 +} + +func walk_maze(m, n int, cell [][]int, indx int) { + cell[n][m] = indx + if n < N-1 && cell[n+1][m] == NOT_CLUSTERED { + walk_maze(m, n+1, cell, indx) + } + if m < M-1 && cell[n][m+1] == NOT_CLUSTERED { + walk_maze(m+1, n, cell, indx) + } + if m > 0 && cell[n][m-1] == NOT_CLUSTERED { + walk_maze(m-1, n, cell, indx) + } + if n > 0 && cell[n-1][m] == NOT_CLUSTERED { + walk_maze(m, n-1, cell, indx) + } +} + +func main() { + rand.Seed(time.Now().Unix()) + cell := newgrid(N, .5) + fmt.Printf("Found %d clusters in this %d by %d grid\n\n", + clustercount(cell), N, N) + pgrid(cell) + fmt.Println() + + for _, n := range n_range { + M = n + N = n + sum := 0. + for i := 0; i < t; i++ { + sum += cluster_density(n, p) + } + sim := sum / float64(t) + fmt.Printf("t=%3d p=%4.2f n=%5d sim=%7.5f\n", t, p, n, sim) + } +} diff --git a/Task/Percolation-Mean-cluster-density/J/percolation-mean-cluster-density-15.j b/Task/Percolation-Mean-cluster-density/J/percolation-mean-cluster-density-15.j new file mode 100644 index 0000000000..c5b77f57bf --- /dev/null +++ b/Task/Percolation-Mean-cluster-density/J/percolation-mean-cluster-density-15.j @@ -0,0 +1,49 @@ + M=: (* 1+i.@$)?15 15$2 + M + 0 2 3 4 0 6 0 8 0 10 11 12 0 0 15 + 0 0 18 19 20 0 22 0 0 0 0 0 28 29 0 + 31 32 0 34 35 36 37 38 0 0 0 42 0 0 45 + 0 0 48 49 0 51 0 0 54 55 0 57 58 0 0 + 61 62 63 64 0 0 67 0 69 0 71 72 0 74 0 + 0 0 78 79 0 0 82 0 84 85 86 87 88 0 0 + 0 92 0 94 0 0 0 0 99 100 101 0 103 0 105 +106 107 108 0 0 111 0 0 114 115 116 0 0 0 0 + 0 0 0 124 125 126 127 0 0 0 0 0 133 134 135 + 0 0 138 0 0 141 0 143 144 145 0 0 0 0 150 + 0 152 153 154 0 0 0 158 0 160 0 162 163 164 165 + 0 167 168 169 170 0 172 173 0 175 176 177 0 0 180 +181 182 183 0 0 186 0 188 189 190 191 192 0 194 195 +196 197 198 0 200 201 202 0 0 205 0 207 0 0 0 +211 212 213 0 0 0 217 218 0 220 221 0 0 224 0 + congeal M + 0 94 94 94 0 6 0 8 0 12 12 12 0 0 15 + 0 0 94 94 94 0 94 0 0 0 0 0 29 29 0 + 32 32 0 94 94 94 94 94 0 0 0 116 0 0 45 + 0 0 94 94 0 94 0 0 116 116 0 116 116 0 0 + 94 94 94 94 0 0 82 0 116 0 116 116 0 74 0 + 0 0 94 94 0 0 82 0 116 116 116 116 116 0 0 + 0 108 0 94 0 0 0 0 116 116 116 0 116 0 105 +108 108 108 0 0 141 0 0 116 116 116 0 0 0 0 + 0 0 0 141 141 141 141 0 0 0 0 0 221 221 221 + 0 0 213 0 0 141 0 221 221 221 0 0 0 0 221 + 0 213 213 213 0 0 0 221 0 221 0 221 221 221 221 + 0 213 213 213 213 0 221 221 0 221 221 221 0 0 221 +213 213 213 0 0 218 0 221 221 221 221 221 0 221 221 +213 213 213 0 218 218 218 0 0 221 0 221 0 0 0 +213 213 213 0 0 0 218 218 0 221 221 0 0 224 0 + (~.@, i. ])congeal M + 0 1 1 1 0 2 0 3 0 4 4 4 0 0 5 + 0 0 1 1 1 0 1 0 0 0 0 0 6 6 0 + 7 7 0 1 1 1 1 1 0 0 0 8 0 0 9 + 0 0 1 1 0 1 0 0 8 8 0 8 8 0 0 + 1 1 1 1 0 0 10 0 8 0 8 8 0 11 0 + 0 0 1 1 0 0 10 0 8 8 8 8 8 0 0 + 0 12 0 1 0 0 0 0 8 8 8 0 8 0 13 +12 12 12 0 0 14 0 0 8 8 8 0 0 0 0 + 0 0 0 14 14 14 14 0 0 0 0 0 15 15 15 + 0 0 16 0 0 14 0 15 15 15 0 0 0 0 15 + 0 16 16 16 0 0 0 15 0 15 0 15 15 15 15 + 0 16 16 16 16 0 15 15 0 15 15 15 0 0 15 +16 16 16 0 0 17 0 15 15 15 15 15 0 15 15 +16 16 16 0 17 17 17 0 0 15 0 15 0 0 0 +16 16 16 0 0 0 17 17 0 15 15 0 0 18 0 diff --git a/Task/Percolation-Mean-run-density/Go/percolation-mean-run-density.go b/Task/Percolation-Mean-run-density/Go/percolation-mean-run-density.go new file mode 100644 index 0000000000..915b275eef --- /dev/null +++ b/Task/Percolation-Mean-run-density/Go/percolation-mean-run-density.go @@ -0,0 +1,35 @@ +package main + +import ( + "fmt" + "math/rand" +) + +var ( + pList = []float64{.1, .3, .5, .7, .9} + nList = []int{1e2, 1e3, 1e4, 1e5} + t = 100 +) + +func main() { + for _, p := range pList { + theory := p * (1 - p) + fmt.Printf("\np: %.4f theory: %.4f t: %d\n", p, theory, t) + fmt.Println(" n sim sim-theory") + for _, n := range nList { + sum := 0 + for i := 0; i < t; i++ { + run := false + for j := 0; j < n; j++ { + one := rand.Float64() < p + if one && !run { + sum++ + } + run = one + } + } + K := float64(sum) / float64(t) / float64(n) + fmt.Printf("%9d %15.4f %9.6f\n", n, K, K-theory) + } + } +} diff --git a/Task/Percolation-Mean-run-density/J/percolation-mean-run-density.j b/Task/Percolation-Mean-run-density/J/percolation-mean-run-density.j index d362d23d9e..e0026c2e28 100644 --- a/Task/Percolation-Mean-run-density/J/percolation-mean-run-density.j +++ b/Task/Percolation-Mean-run-density/J/percolation-mean-run-density.j @@ -1,6 +1,6 @@ NB. translation of python -NB. 'N P T' =: 100 0.5 500 NB. silliness +NB. 'N P T' =: 100 0.5 500 NB. hypothetical example values, to aid comprehension... newv =: (> ?@(#&0))~ NB. generate a random binary vector. Use: N newv P runs =: {: + [: +/ 1 0&E. NB. add the tail to the sum of 1 0 occurrences Use: runs V diff --git a/Task/Percolation-Mean-run-density/Mathematica/percolation-mean-run-density.math b/Task/Percolation-Mean-run-density/Mathematica/percolation-mean-run-density.math new file mode 100644 index 0000000000..3ffcf6192b --- /dev/null +++ b/Task/Percolation-Mean-run-density/Mathematica/percolation-mean-run-density.math @@ -0,0 +1,9 @@ +meanRunDensity[p_, len_, trials_] := + Mean[Length[Cases[Split@#, {1, ___}]] & /@ + Unitize[Chop[RandomReal[1, {trials, len}], 1 - p]]]/len + +Column@Table[ + Grid[Join[{{p, n, K, diff}}, + Table[{q, n, x = meanRunDensity[q, n, 100] // N, + q (1 - q) - x}, {n, {100, 1000, 10000, 100000}}], {}], + Alignment -> Left], {q, {.1, .3, .5, .7, .9}}] diff --git a/Task/Percolation-Mean-run-density/Pascal/percolation-mean-run-density.pascal b/Task/Percolation-Mean-run-density/Pascal/percolation-mean-run-density.pascal new file mode 100644 index 0000000000..34d0487484 --- /dev/null +++ b/Task/Percolation-Mean-run-density/Pascal/percolation-mean-run-density.pascal @@ -0,0 +1,52 @@ +{$MODE objFPC}//for using result,parameter runs becomes for variable.. +uses + sysutils;//Format +const + MaxN = 100*1000; + +function run_test(p:double;len,runs: NativeInt):double; +var + x, y, i,cnt : NativeInt; +Begin + result := 1/ (runs * len); + cnt := 0; + for runs := runs-1 downto 0 do + Begin + x := 0; + y := 0; + for i := len-1 downto 0 do + begin + x := y; + y := Ord(Random() < p); + cnt := cnt+ord(x < y); + end; + end; + result := result *cnt; +end; + +//main +var + p, p1p, K : double; + ip, n : nativeInt; +Begin + randomize; + writeln( 'running 1000 tests each:'#13#10, + ' p n K p(1-p) diff'#13#10, + '-----------------------------------------------'); + ip:= 1; + while ip < 10 do + Begin + p := ip / 10; + p1p := p * (1 - p); + n := 100; + While n <= MaxN do + Begin + K := run_test(p, n, 1000); + writeln(Format('%4.1f %6d %6.4f %6.4f %7.4f (%5.2f %%)', + [p, n, K, p1p, K - p1p, (K - p1p) / p1p * 100])); + n := n*10; + end; + writeln; + ip := ip+2; + end; +end. diff --git a/Task/Perfect-numbers/00DESCRIPTION b/Task/Perfect-numbers/00DESCRIPTION index 95d3e11c75..f6f15a834a 100644 --- a/Task/Perfect-numbers/00DESCRIPTION +++ b/Task/Perfect-numbers/00DESCRIPTION @@ -1,15 +1,19 @@ Write a function which says whether a number is perfect. -[[wp:Perfect_numbers|A perfect number]] is a positive integer that is -the sum of its proper positive divisors excluding the number itself. -Equivalently, a perfect number is a number that is half the sum -of all of its positive divisors (including itself). +
    +[[wp:Perfect_numbers|A perfect number]] is a positive integer that is the sum of its proper positive divisors excluding the number itself. -Note: The faster [[Lucas-Lehmer test]] is used to find primes of the form 2''n''-1, all ''known'' perfect numbers can be derived from these primes -using the formula (2''n'' - 1) × 2''n'' - 1. -It is not known if there are any odd perfect numbers (any that exist are larger than 102000). +Equivalently, a perfect number is a number that is half the sum of all of its positive divisors (including itself). -'''See also''' + +Note:   The faster   [[Lucas-Lehmer test]]   is used to find primes of the form   2''n''-1,   all ''known'' perfect numbers can be derived from these primes +using the formula   (2''n'' - 1) × 2''n'' - 1. + +It is not known if there are any odd perfect numbers (any that exist are larger than 102000). + + +;See also: * [[Rational Arithmetic]] * [[oeis:A000396|Perfect numbers on OEIS]] * [http://www.oddperfect.org/ Odd Perfect] showing the current status of bounds on odd perfect numbers. +

    diff --git a/Task/Perfect-numbers/360-Assembly/perfect-numbers-1.360 b/Task/Perfect-numbers/360-Assembly/perfect-numbers-1.360 new file mode 100644 index 0000000000..19fe563c44 --- /dev/null +++ b/Task/Perfect-numbers/360-Assembly/perfect-numbers-1.360 @@ -0,0 +1,47 @@ +* Perfect numbers 15/05/2016 +PERFECTN CSECT + USING PERFECTN,R13 prolog +SAVEAREA B STM-SAVEAREA(R15) " + DC 17F'0' " +STM STM R14,R12,12(R13) " + ST R13,4(R15) " + ST R15,8(R13) " + LR R13,R15 " + LA R6,2 i=2 +LOOPI C R6,NN do i=2 to nn + BH ELOOPI + LR R1,R6 i + BAL R14,PERFECT + LTR R0,R0 if perfect(i) + BZ NOTPERF + XDECO R6,PG edit i + XPRNT PG,L'PG print i +NOTPERF LA R6,1(R6) i=i+1 + B LOOPI +ELOOPI L R13,4(0,R13) epilog + LM R14,R12,12(R13) " + XR R15,R15 " + BR R14 exit +PERFECT SR R9,R9 function perfect(n); sum=0 + LA R7,1 j + LR R8,R1 n + SRA R8,1 n/2 +LOOPJ CR R7,R8 do j=1 to n/2 + BH ELOOPJ + LR R4,R1 n + SRDA R4,32 + DR R4,R7 n/j + LTR R4,R4 if mod(n,j)=0 + BNZ NOTMOD + AR R9,R7 sum=sum+j +NOTMOD LA R7,1(R7) j=j+1 + B LOOPJ +ELOOPJ SR R0,R0 r0=false + CR R9,R1 if sum=n + BNE NOTEQ + BCTR R0,0 r0=true +NOTEQ BR R14 return(r0); end perfect +NN DC F'10000' +PG DC CL12' ' buffer + YREGS + END PERFECTN diff --git a/Task/Perfect-numbers/360-Assembly/perfect-numbers-2.360 b/Task/Perfect-numbers/360-Assembly/perfect-numbers-2.360 new file mode 100644 index 0000000000..9038328d5c --- /dev/null +++ b/Task/Perfect-numbers/360-Assembly/perfect-numbers-2.360 @@ -0,0 +1,76 @@ +* Perfect numbers 15/05/2016 +PERFECPO CSECT + USING PERFECPO,R13 prolog +SAVEAREA B STM-SAVEAREA(R15) " + DC 17F'0' " +STM STM R14,R12,12(R13) " + ST R13,4(R15) " + ST R15,8(R13) " + LR R13,R15 " + ZAP I,I1 i=i1 +LOOPI CP I,I2 do i=i1 to i2 + BH ELOOPI + LA R1,I r1=@i + BAL R14,PERFECT perfect(i) + LTR R0,R0 if perfect(i) + BZ NOTPERF + UNPK PG(16),I unpack i + OI PG+15,X'F0' + XPRNT PG,16 print i +NOTPERF AP I,=P'1' i=i+1 + B LOOPI +ELOOPI L R13,4(0,R13) epilog + LM R14,R12,12(R13) " + XR R15,R15 " + BR R14 exit +PERFECT EQU * function perfect(n); + ZAP N,0(8,R1) n=%r1 + CP N,=P'6' if n=6 + BNE NOT6 + L R0,=F'-1' r0=true + B RETURN return(true) +NOT6 ZAP PW,N n + SP PW,=P'1' n-1 + ZAP PW2,PW n-1 + DP PW2,=PL8'9' (n-1)/9 + ZAP R,PW2+8(8) if mod((n-1),9)<>0 + BZ ZERO + SR R0,R0 r0=false + B RETURN return(false) +ZERO ZAP PW2,N n + DP PW2,=PL8'2' n/2 + ZAP SUM,PW2(8) sum=n/2 + AP SUM,=P'3' sum=n/2+3 + ZAP J,=P'3' j=3 +LOOPJ ZAP PW,J do loop on j + MP PW,J j*j + CP PW,N while j*j<=n + BH ELOOPJ + ZAP PW2,N n + DP PW2,J n/j + CP PW2+8(8),=P'0' if mod(n,j)<>0 + BNE NEXTJ + AP SUM,J sum=sum+j + ZAP PW2,N n + DP PW2,J n/j + AP SUM,PW2(8) sum=sum+j+n/j +NEXTJ AP J,=P'1' j=j+1 + B LOOPJ next j +ELOOPJ SR R0,R0 r0=false + CP SUM,N if sum=n + BNE RETURN + BCTR R0,0 r0=true +RETURN BR R14 return(r0); end perfect +I1 DC PL8'1' +I2 DC PL8'200000000000' +I DS PL8 +PG DC CL16' ' buffer +N DS PL8 +SUM DS PL8 +J DS PL8 +R DS PL8 +C DS CL16 +PW DS PL8 +PW2 DS PL16 + YREGS + END PERFECPO diff --git a/Task/Perfect-numbers/AppleScript/perfect-numbers-1.applescript b/Task/Perfect-numbers/AppleScript/perfect-numbers-1.applescript new file mode 100644 index 0000000000..994d4af193 --- /dev/null +++ b/Task/Perfect-numbers/AppleScript/perfect-numbers-1.applescript @@ -0,0 +1,108 @@ +-- perfect :: integer -> bool +on perfect(n) + + -- isFactor :: integer -> bool + script isFactor + on lambda(x) + n mod x = 0 + end lambda + end script + + -- quotient :: number -> number + script quotient + on lambda(x) + n / x + end lambda + end script + + -- sum :: number -> number -> number + script sum + on lambda(a, b) + a + b + end lambda + end script + + -- Integer factors of n below the square root + set lows to filter(isFactor, range(1, (n ^ (1 / 2)) as integer)) + + -- low and high factors (quotients of low factors) tested for perfection + (n > 1) and (foldl(sum, 0, (lows & map(quotient, lows))) / 2 = n) +end perfect + + +-- TEST + +on run + + filter(perfect, range(1, 10000)) + + --> {6, 28, 496, 8128} + +end run + + + +-- GENERIC LIBRARY FUNCTIONS + +-- 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 + +-- 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 + +-- 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 + +-- range :: Int -> Int -> [Int] +on range(m, n) + if n < m then + set d to -1 + else + set d to 1 + end if + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range + +-- 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 diff --git a/Task/Perfect-numbers/AppleScript/perfect-numbers-2.applescript b/Task/Perfect-numbers/AppleScript/perfect-numbers-2.applescript new file mode 100644 index 0000000000..2f9fe8b648 --- /dev/null +++ b/Task/Perfect-numbers/AppleScript/perfect-numbers-2.applescript @@ -0,0 +1 @@ +{6, 28, 496, 8128} diff --git a/Task/Perfect-numbers/Clojure/perfect-numbers-3.clj b/Task/Perfect-numbers/Clojure/perfect-numbers-3.clj new file mode 100644 index 0000000000..2a4b62137a --- /dev/null +++ b/Task/Perfect-numbers/Clojure/perfect-numbers-3.clj @@ -0,0 +1,2 @@ +(defn perfect? [n] + (= (reduce + (filter #(zero? (rem n %)) (range 1 n))) n)) diff --git a/Task/Perfect-numbers/Elena/perfect-numbers.elena b/Task/Perfect-numbers/Elena/perfect-numbers.elena new file mode 100644 index 0000000000..e1e69bc556 --- /dev/null +++ b/Task/Perfect-numbers/Elena/perfect-numbers.elena @@ -0,0 +1,21 @@ +#import system. +#import system'routines. +#import system'math. +#import extensions. + +#class(extension)extension +{ + #method is &perfect + = 1 repeat &till:self &each: n [ (self mod:n == 0) iif:n:0 ] summarize:(Integer new) == self. +} + +#symbol program = +[ + 1 till:10000 &doEach: n + [ + (n is &perfect) + ? [ console writeLine:n:" is perfect". ]. + ]. + + console readChar. +]. diff --git a/Task/Perfect-numbers/Elixir/perfect-numbers.elixir b/Task/Perfect-numbers/Elixir/perfect-numbers.elixir index 0bdab4aa5c..f498ed6512 100644 --- a/Task/Perfect-numbers/Elixir/perfect-numbers.elixir +++ b/Task/Perfect-numbers/Elixir/perfect-numbers.elixir @@ -1,8 +1,13 @@ defmodule RC do def is_perfect(1), do: false def is_perfect(n) when n > 1 do - (for i <- 1..div(n,2), rem(n,i)==0, do: i) |> Enum.sum == n + Enum.sum(factor(n, 2, [1])) == n end + + defp factor(n, i, factors) when n < i*i , do: factors + defp factor(n, i, factors) when n == i*i , do: [i | factors] + defp factor(n, i, factors) when rem(n,i)==0, do: factor(n, i+1, [i, div(n,i) | factors]) + defp factor(n, i, factors) , do: factor(n, i+1, factors) end IO.inspect (for i <- 1..10000, RC.is_perfect(i), do: i) diff --git a/Task/Perfect-numbers/Go/perfect-numbers.go b/Task/Perfect-numbers/Go/perfect-numbers.go index 6b733b04b7..651db46c55 100644 --- a/Task/Perfect-numbers/Go/perfect-numbers.go +++ b/Task/Perfect-numbers/Go/perfect-numbers.go @@ -2,6 +2,16 @@ package main import "fmt" +func computePerfect(n int64) bool { + var sum int64 + for i := int64(1); i < n; i++ { + if n%i == 0 { + sum += i + } + } + return sum == n +} + // following function satisfies the task, returning true for all // perfect numbers representable in the argument type func isPerfect(n int64) bool { @@ -24,13 +34,3 @@ func main() { } } } - -func computePerfect(n int64) bool { - var sum int64 - for i := int64(1); i < n; i++ { - if n%i == 0 { - sum += i - } - } - return sum == n -} diff --git a/Task/Perfect-numbers/JavaScript/perfect-numbers-8.js b/Task/Perfect-numbers/JavaScript/perfect-numbers-8.js new file mode 100644 index 0000000000..4fcd91edf5 --- /dev/null +++ b/Task/Perfect-numbers/JavaScript/perfect-numbers-8.js @@ -0,0 +1,24 @@ +((nFrom, nTo) => { + + // perfect :: Int -> Bool + let perfect = n => { + let lows = range(1, Math.floor(Math.sqrt(n))) + .filter(x => (n % x) === 0); + + return n > 1 && lows.concat(lows.map(x => n / x)) + .reduce((a, x) => (a + x), 0) / 2 === n; + }, + + // range :: Int -> Int -> Maybe Int -> [Int] + range = (m, n, step) => { + let d = (step || 1) * (n >= m ? 1 : -1); + + return Array.from({ + length: Math.floor((n - m) / d) + 1 + }, (_, i) => m + (i * d)); + }; + + return range(nFrom, nTo) + .filter(perfect); + +})(1, 10000); diff --git a/Task/Perfect-numbers/JavaScript/perfect-numbers-9.js b/Task/Perfect-numbers/JavaScript/perfect-numbers-9.js new file mode 100644 index 0000000000..e15308fdaa --- /dev/null +++ b/Task/Perfect-numbers/JavaScript/perfect-numbers-9.js @@ -0,0 +1 @@ +[6, 28, 496, 8128] diff --git a/Task/Perfect-numbers/Perl/perfect-numbers-7.pl b/Task/Perfect-numbers/Perl/perfect-numbers-7.pl new file mode 100644 index 0000000000..0f6893d989 --- /dev/null +++ b/Task/Perfect-numbers/Perl/perfect-numbers-7.pl @@ -0,0 +1,13 @@ +use ntheory qw(is_mersenne_prime valuation hammingweight is_power sqrtint); + +sub is_even_perfect { + my ($n) = @_; + + $n % 2 == 0 || return; + + my $square = 8 * $n + 1; + is_power($square, 2) || return; + + my $k = (sqrtint($square) + 1) / 2; + hammingweight($k) == 1 && is_mersenne_prime(valuation($k, 2)); +} diff --git a/Task/Perfect-numbers/REXX/perfect-numbers-1.rexx b/Task/Perfect-numbers/REXX/perfect-numbers-1.rexx index d3938f435f..f726911248 100644 --- a/Task/Perfect-numbers/REXX/perfect-numbers-1.rexx +++ b/Task/Perfect-numbers/REXX/perfect-numbers-1.rexx @@ -1,12 +1,12 @@ -/*REXX version of the ooRexx pgm (code was modified for Classic REXX).*/ - do i=1 to 10000 /*statement changed: LOOP ──► DO*/ +/*REXX version of the ooRexx program (the code was modified to run with Classic REXX).*/ + do i=1 to 10000 /*statement changed: LOOP ──► DO*/ if perfectNumber(i) then say i "is a perfect number" end exit -perfectNumber: procedure; parse arg n /*statements changed: ROUTINE,USE*/ +perfectNumber: procedure; parse arg n /*statements changed: ROUTINE,USE*/ sum=0 - do i=1 to n%2 /*statement changed: LOOP ──► DO*/ - if n//i==0 then sum=sum+i /*statement changed: sum += i */ + do i=1 to n%2 /*statement changed: LOOP ──► DO*/ + if n//i==0 then sum=sum+i /*statement changed: sum += i */ end return sum=n diff --git a/Task/Perfect-numbers/REXX/perfect-numbers-2.rexx b/Task/Perfect-numbers/REXX/perfect-numbers-2.rexx index 665fefe500..d4bd1a89bf 100644 --- a/Task/Perfect-numbers/REXX/perfect-numbers-2.rexx +++ b/Task/Perfect-numbers/REXX/perfect-numbers-2.rexx @@ -1,17 +1,17 @@ -/*REXX version of the PL/I program (code was modified for Classic REXX).*/ -parse arg low high . /*obtain the specified number(s).*/ -if high=='' & low=='' then high=34000000 /*if no args, use a range.*/ -if low=='' then low=1 /*if no LOW, then assume unity.*/ -if high=='' then high=low /*if no HIGH, then assume LOW. */ +/*REXX version of the PL/I program (code was modified to run with Classic REXX). */ +parse arg low high . /*obtain the specified number(s).*/ +if high=='' & low=='' then high=34000000 /*if no arguments, use a range. */ +if low=='' then low=1 /*if no LOW, then assume unity.*/ +if high=='' then high=low /*if no HIGH, then assume LOW. */ - do i=low to high /*process the single # or range. */ + do i=low to high /*process the single # or range. */ if perfect(i) then say i 'is a perfect number.' end /*i*/ exit -perfect: procedure; parse arg n /*get the number to be tested. */ -sum=0 /*the sum of the factors so far. */ - do i=1 for n-1 /*starting at 1, find all factors*/ - if n//i==0 then sum=sum+i /*I is a factor of N, so add it.*/ +perfect: procedure; parse arg n /*get the number to be tested. */ +sum=0 /*the sum of the factors so far. */ + do i=1 for n-1 /*starting at 1, find all factors*/ + if n//i==0 then sum=sum+i /*I is a factor of N, so add it.*/ end /*i*/ -return sum=n /*if the sum matches N, perfect! */ +return sum=n /*if the sum matches N, perfect! */ diff --git a/Task/Perfect-numbers/REXX/perfect-numbers-3.rexx b/Task/Perfect-numbers/REXX/perfect-numbers-3.rexx index c7d01d47b7..981fd22097 100644 --- a/Task/Perfect-numbers/REXX/perfect-numbers-3.rexx +++ b/Task/Perfect-numbers/REXX/perfect-numbers-3.rexx @@ -1,22 +1,21 @@ -/*REXX program tests if a number (or a range of numbers) is/are perfect.*/ -parse arg low high . /*obtain the specified number(s).*/ -if high=='' & low=='' then high=34000000 /*if no args, use a range.*/ -if low=='' then low=1 /*if no LOW, then assume unity.*/ -if high=='' then high=low /*if no HIGH, then assume LOW. */ -w=length(high) /*use W for formatting output. */ -numeric digits max(9,w+2) /*ensure enough digits to handle#*/ +/*REXX program tests if a number (or a range of numbers) is/are perfect. */ +parse arg low high . /*obtain optional arguments from the CL*/ +if high=='' & low=="" then high=34000000 /*if no arguments, then use a range. */ +if low=='' then low=1 /*if no LOW, then assume unity. */ +if high=='' then high=low /*if no HIGH, then assume LOW. */ +w=length(high) /*use W for formatting the output. */ +numeric digits max(9,w+2) /*ensure enough digits to handle number*/ - do i=low to high /*process the single # or range. */ - if isPerfect(i) then say right(i,w) 'is a perfect number.' - end /*i*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────ISPERFECT subroutine────────────────*/ -isPerfect: procedure; parse arg x /*get the number to be tested. */ -if x<6 then return 0 /*perfect numbers can't be < six.*/ -s=1 /*the first factor of X. _*/ - do j=2 while j*j<=x /*starting at 2, find factors ≤√X*/ - if x//j\==0 then iterate /*J isn't a factor of X, so skip.*/ - s = s + j + x%j /*··· add it and the other factor*/ - if s>x then return 0 /*Sum too big? It ain't perfect.*/ - end /*j*/ /*(above) is marginally faster. */ -return s==x /*if the sum matches X, perfect! */ + do i=low to high /*process the single number or a range.*/ + if isPerfect(i) then say right(i,w) 'is a perfect number.' + end /*i*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +isPerfect: procedure; parse arg x /*obtain the number to be tested. */ + if x<6 then return 0 /*perfect numbers can't be < six. */ + s=1 /*the first factor of X. ___*/ + do j=2 while j*j<=x /*starting at 2, find the factors ≤√ X */ + if x//j\==0 then iterate /*J isn't a factor of X, so skip it.*/ + s = s + j + x%j /* ··· add it and the other factor. */ + end /*j*/ /*(above) is marginally faster. */ + return s==x /*if the sum matches X, it's perfect! */ diff --git a/Task/Perfect-numbers/REXX/perfect-numbers-4.rexx b/Task/Perfect-numbers/REXX/perfect-numbers-4.rexx index 3bc5111b0b..5f6b191337 100644 --- a/Task/Perfect-numbers/REXX/perfect-numbers-4.rexx +++ b/Task/Perfect-numbers/REXX/perfect-numbers-4.rexx @@ -1,29 +1,28 @@ -/*REXX program tests if a number (or a range of numbers) is/are perfect.*/ -parse arg low high . /*obtain the specified number(s).*/ -if high=='' & low=='' then high=34000000 /*if no args, use a range.*/ -if low=='' then low=1 /*if no LOW, then assume unity.*/ -if high=='' then high=low /*if no HIGH, then assume LOW. */ -w=length(high) /*use W for formatting output. */ -numeric digits max(9,w+2) /*ensure enough digits to handle#*/ +/*REXX program tests if a number (or a range of numbers) is/are perfect. */ +parse arg low high . /*obtain the specified number(s). */ +if high=='' & low=="" then high=34000000 /*if no arguments, then use a range. */ +if low=='' then low=1 /*if no LOW, then assume unity. */ +if high=='' then high=low /*if no HIGH, then assume LOW. */ +w=length(high) /*use W for formatting the output. */ +numeric digits max(9,w+2) /*ensure enough digits to handle number*/ - do i=low to high /*process the single # or range. */ - if isPerfect(i) then say right(i,w) 'is a perfect number.' - end /*i*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────ISPERFECT subroutine────────────────*/ -isPerfect: procedure; parse arg x 1 y /*get the number to be tested. */ -if x==6 then return 1 /*handle special case of six. */ - /*[↓] perfect #s digitalRoot = 1.*/ - do until y<10 /*find the digital root of Y. */ - parse var y r 2; do k=2 for length(y)-1; r=r+substr(y,k,1); end - y=r /*find digital root of dig root. */ - end /*DO until*/ /*wash, rinse, repeat ··· */ + do i=low to high /*process the single number or a range.*/ + if isPerfect(i) then say right(i,w) 'is a perfect number.' + end /*i*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +isPerfect: procedure; parse arg x 1 y /*obtain the number to be tested. */ + if x==6 then return 1 /*handle the special case of six. */ + /*[↓] perfect number's digitalRoot = 1*/ + do until y<10 /*find the digital root of Y. */ + parse var y r 2; do k=2 for length(y)-1; r=r+substr(y,k,1); end /*k*/ + y=r /*find digital root of the digit root. */ + end /*until*/ /*wash, rinse, repeat ··· */ -if r\==1 then return 0 /*Digital root ¬1? Then ¬perfect.*/ -s=1 /*the first factor of X. _*/ - do j=2 while j*j<=x /*starting at 2, find factors ≤√X*/ - if x//j\==0 then iterate /*J isn't a factor of X, so skip.*/ - s = s + j + x%j /*··· add it and the other factor*/ - if s>x then return 0 /*Sum too big? It ain't perfect.*/ - end /*j*/ /*(above) is marginally faster. */ -return s==x /*if the sum matches X, perfect! */ + if r\==1 then return 0 /*Digital root ¬ 1? Then ¬ perfect. */ + s=1 /*the first factor of X. ___*/ + do j=2 while j*j<=x /*starting at 2, find the factors ≤√ X */ + if x//j\==0 then iterate /*J isn't a factor of X, so skip it. */ + s = s + j + x%j /*··· add it and the other factor. */ + end /*j*/ /*(above) is marginally faster. */ + return s==x /*if the sum matches X, it's perfect! */ diff --git a/Task/Perfect-numbers/REXX/perfect-numbers-5.rexx b/Task/Perfect-numbers/REXX/perfect-numbers-5.rexx index 47b81074dc..966599a864 100644 --- a/Task/Perfect-numbers/REXX/perfect-numbers-5.rexx +++ b/Task/Perfect-numbers/REXX/perfect-numbers-5.rexx @@ -1,31 +1,29 @@ -/*REXX program tests if a number (or a range of numbers) is/are perfect.*/ -parse arg low high . /*obtain the specified number(s).*/ -if high=='' & low=='' then high=34000000 /*if no args, use a range.*/ -if low=='' then low=1 /*if no LOW, then assume unity.*/ -if low//2 then low=low+1 /*if LOW is odd, bump it by one.*/ -if high=='' then high=low /*if no HIGH, then assume LOW. */ -w=length(high) /*use W for formatting output. */ -numeric digits max(9,w+2) /*ensure enough digits to handle#*/ +/*REXX program tests if a number (or a range of numbers) is/are perfect. */ +parse arg low high . /*obtain optional arguments from the CL*/ +if high=='' & low=="" then high=34000000 /*if no arguments, then use a range. */ +if low=='' then low=1 /*if no LOW, then assume unity. */ +low=low+low//2 /*if LOW is odd, bump it by one. */ +if high=='' then high=low /*if no HIGH, then assume LOW. */ +w=length(high) /*use W for formatting the output. */ +numeric digits max(9,w+2) /*ensure enough digits to handle number*/ - do i=low to high by 2 /*process the single # or range. */ - if isPerfect(i) then say right(i,w) 'is a perfect number.' - end /*i*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────ISPERFECT subroutine────────────────*/ -isPerfect: procedure; parse arg x 1 y /*get the number to be tested. */ -if x==6 then return 1 /*handle special case of six. */ + do i=low to high by 2 /*process the single number or a range.*/ + if isPerfect(i) then say right(i,w) 'is a perfect number.' + end /*i*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +isPerfect: procedure; parse arg x 1 y /*obtain the number to be tested. */ + if x==6 then return 1 /*handle the special case of six. */ - do until y<10 /*find the digital root of Y. */ - parse var y r 2; do k=2 for length(y)-1; r=r+substr(y,k,1); end - y=r /*find digital root of dig root. */ - end /*DO until*/ /*wash, rinse, repeat ··· */ + do until y<10 /*find the digital root of Y. */ + parse var y 1 r 2; do k=2 for length(y)-1; r=r+substr(y,k,1); end /*k*/ + y=r /*find digital root of the digital root*/ + end /*until*/ /*wash, rinse, repeat ··· */ -if r\==1 then return 0 /*is dig root ¬1? Then ¬perfect.*/ - -s = 3 + x%2 /*the first 3 factors of X. _*/ - do j=3 while j*j<=x /*starting at 3, find factors ≤√X*/ - if x//j\==0 then iterate /*J isn't a factor of X, so skip.*/ - s = s + j + x%j /*··· add it and the other factor*/ - if s>x then return 0 /*Sum too big? It ain't perfect.*/ - end /*j*/ /*(above) is marginally faster. */ -return s==x /*if the sum matches X, perfect! */ + if r\==1 then return 0 /*Digital root ¬ 1 ? Then ¬ perfect.*/ + s=3 + x%2 /*the first 3 factors of X. ___*/ + do j=3 while j*j<=x /*starting at 3, find the factors ≤√ X */ + if x//j\==0 then iterate /*J isn't a factor o f X, so skip it.*/ + s = s + j + x%j /* ··· add it and the other factor. */ + end /*j*/ /*(above) is marginally faster. */ + return s==x /*if sum matches X, then it's perfect!*/ diff --git a/Task/Perfect-numbers/REXX/perfect-numbers-6.rexx b/Task/Perfect-numbers/REXX/perfect-numbers-6.rexx index 3f795ea23d..6b00ec353c 100644 --- a/Task/Perfect-numbers/REXX/perfect-numbers-6.rexx +++ b/Task/Perfect-numbers/REXX/perfect-numbers-6.rexx @@ -1,33 +1,33 @@ -/*REXX program tests if a number (or a range of numbers) is/are perfect.*/ -parse arg low high . /*obtain the specified number(s).*/ -if high=='' & low=='' then high=34000000 /*if no args, use a range.*/ -if low=='' then low=1 /*if no LOW, then assume unity.*/ -if low//2 then low=low+1 /*if LOW is odd, bump it by one.*/ -if high=='' then high=low /*if no HIGH, then assume LOW. */ -w=length(high) /*use W for formatting output. */ -numeric digits max(9,w+2) /*ensure enough digits to handle#*/ -@.=0; @.1=2 /*highest magic # and its index.*/ - do i=low to high by 2 /*process the single # or range. */ - if isPerfect(i) then say right(i,w) 'is a perfect number.' - end /*i*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────ISPERFECT subroutine────────────────*/ -isPerfect: procedure expose @.; parse arg x /*get the # to be tested.*/ - /*Lucas-Lehmer know that perfect */ - /* numbers can be expressed as: */ - /* [2**n - 1] * [2** (n-1) ] */ +/*REXX program tests if a number (or a range of numbers) is/are perfect. */ +parse arg low high . /*obtain the optional arguments from CL*/ +if high=='' & low=="" then high=34000000 /*if no arguments, then use a range. */ +if low=='' then low=1 /*if no LOW, then assume unity. */ +low=low+low//2 /*if LOW is odd, bump it by one. */ +if high=='' then high=low /*if no HIGH, then assume LOW. */ +w=length(high) /*use W for formatting the output. */ +numeric digits max(9,w+2) /*ensure enough digits to handle number*/ +@.=0; @.1=2 /*highest magic number and its index. */ -if @.0x then return 0 /*Sum too big? It ain't perfect.*/ - end /*j*/ /*(above) is marginally faster. */ -return s==x /*if the sum matches X, perfect! */ + if @.01; q=q%4; _=z-r-q; r=r%2; if _>=0 then do; z=_; r=r+q; end - end /*while ···*/ /* [↑] compute the integer SQRT of X.*/ - /* ___ */ - do j=3 to r until s>x /*starting at 3, find factors ≤ √ X */ - if x//j==0 then s=s+j+x%j /*J divisible by X? Then add J and X÷J*/ - end /*j*/ -return s==x /*if the sum matches X, then perfect! */ + if d\==1 then return 0 /*Is digital root ¬ 1? Then ¬ perfect.*/ + s=3 + x%2 /*we know the following factors: unity,*/ + z=x /*2, and x÷2 (x is even). */ + q=1; do while q<=z; q=q*4 ; end /*while q≤z*/ /* _____*/ + r=0 /* [↓] R will be the integer √ X */ + do while q>1; q=q%4; _=z-r-q; r=r%2; if _>=0 then do; z=_; r=r+q; end + end /*while q>1*/ /* [↑] compute the integer SQRT of X.*/ + /* _____*/ + do j=3 to r /*starting at 3, find factors ≤ √ X */ + if x//j==0 then s=s+j+x%j /*J divisible by X? Then add J and X÷J*/ + end /*j*/ + return s==x /*if the sum matches X, then perfect! */ diff --git a/Task/Perfect-numbers/Racket/perfect-numbers.rkt b/Task/Perfect-numbers/Racket/perfect-numbers.rkt index 65cfc2a025..7639110733 100644 --- a/Task/Perfect-numbers/Racket/perfect-numbers.rkt +++ b/Task/Perfect-numbers/Racket/perfect-numbers.rkt @@ -1,12 +1,11 @@ #lang racket +(require math) + (define (perfect? n) - (= n - (for/fold ((sum 0)) - ((i (in-range 1 (add1 (floor (/ n 2)))))) - (if (= (remainder n i) 0) - (+ sum i) - sum)))) + (= + (* n 2) + (sum (divisors n)))) - -(filter perfect? (build-list 1000 values)) -;-> '(0 6 28 496) +; filtering to only even numbers for better performance +(filter perfect? (filter even? (range 1e5))) +;-> '(0 6 28 496 8128) diff --git a/Task/Permutation-test/C++/permutation-test-1.cpp b/Task/Permutation-test/C++/permutation-test-1.cpp new file mode 100644 index 0000000000..698ee8e648 --- /dev/null +++ b/Task/Permutation-test/C++/permutation-test-1.cpp @@ -0,0 +1,39 @@ +#include +#include +#include +#include + +class +{ +public: + int64_t operator()(int n, int k){ return partial_factorial(n, k) / factorial(n - k);} +private: + int64_t partial_factorial(int from, int to) { return from == to ? 1 : from * partial_factorial(from - 1, to); } + int64_t factorial(int n) { return n == 0 ? 1 : n * factorial(n - 1);} +}combinations; + +int main() +{ + static constexpr int treatment = 9; + const std::vector data{ 85, 88, 75, 66, 25, 29, 83, 39, 97, + 68, 41, 10, 49, 16, 65, 32, 92, 28, 98 }; + + int treated = std::accumulate(data.begin(), data.begin() + treatment, 0); + + std::function pick; + pick = [&](int n, int from, int accumulated) + { + if(n == 0) + return accumulated > treated ? 1 : 0; + else + return pick(n - 1, from - 1, accumulated + data[from - 1]) + + (from > n ? pick(n, from - 1, accumulated) : 0); + }; + + int total = combinations(data.size(), treatment); + int greater = pick(treatment, data.size(), 0); + int lesser = total - greater; + + std::cout << "<= : " << 100.0 * lesser / total << "% " << lesser << std::endl + << " > : " << 100.0 * greater / total << "% " << greater << std::endl; +} diff --git a/Task/Permutation-test/C++/permutation-test-2.cpp b/Task/Permutation-test/C++/permutation-test-2.cpp new file mode 100644 index 0000000000..75ef1d984f --- /dev/null +++ b/Task/Permutation-test/C++/permutation-test-2.cpp @@ -0,0 +1,2 @@ +<= : 87.197168% 80551 + > : 12.802832% 11827 diff --git a/Task/Permutations-Derangements/00DESCRIPTION b/Task/Permutations-Derangements/00DESCRIPTION index 0f6d0b3b09..fd5e30b5e9 100644 --- a/Task/Permutations-Derangements/00DESCRIPTION +++ b/Task/Permutations-Derangements/00DESCRIPTION @@ -5,17 +5,20 @@ For example, the only two derangements of the three items (0, 1, 2) are (1, 2, 0 The number of derangements of ''n'' distinct items is known as the subfactorial of ''n'', sometimes written as !''n''. There are various ways to [[wp:Derangement#Counting_derangements|calculate]] !''n''. -;Task -The task is to: + +;Task: # Create a named function/method/subroutine/... to generate derangements of the integers ''0..n-1'', (or ''1..n'' if you prefer). # Generate ''and show'' all the derangements of 4 integers using the above routine. # Create a function that calculates the subfactorial of ''n'', !''n''. # Print and show a table of the ''counted'' number of derangements of ''n'' vs. the calculated !''n'' for n from 0..9 inclusive. -As an optional stretch goal: -:* Calculate !''20''. -;Cf. -* [[Anagrams/Deranged anagrams]] -* [[Best shuffle]] -* [[Left_factorials]] +;Optional stretch goal: +*   Calculate   !''20'' + + +;Related tasks: +*   [[Anagrams/Deranged anagrams]] +*   [[Best shuffle]] +*   [[Left_factorials]] +

    diff --git a/Task/Permutations-Derangements/Haskell/permutations-derangements-1.hs b/Task/Permutations-Derangements/Haskell/permutations-derangements-1.hs index 7938bbc119..de84bec584 100644 --- a/Task/Permutations-Derangements/Haskell/permutations-derangements-1.hs +++ b/Task/Permutations-Derangements/Haskell/permutations-derangements-1.hs @@ -5,9 +5,8 @@ import Data.List derangements xs = filter (and . zipWith (/=) xs) $ permutations xs -- Compute the number of derangements of n elements -subfactorial 0 = 0 +subfactorial 0 = 1 subfactorial 1 = 0 -subfactorial 2 = 1 subfactorial n = (n-1) * (subfactorial (n-1) + subfactorial (n-2)) main = do diff --git a/Task/Permutations-Derangements/Lua/permutations-derangements.lua b/Task/Permutations-Derangements/Lua/permutations-derangements.lua new file mode 100644 index 0000000000..471398ebcb --- /dev/null +++ b/Task/Permutations-Derangements/Lua/permutations-derangements.lua @@ -0,0 +1,69 @@ +-- Return an iterator to produce every permutation of list +function permute (list) + local function perm (list, n) + if n == 0 then coroutine.yield(list) end + for i = 1, n do + list[i], list[n] = list[n], list[i] + perm(list, n - 1) + list[i], list[n] = list[n], list[i] + end + end + return coroutine.wrap(function() perm(list, #list) end) +end + +-- Return a copy of table t (wouldn't work for a table of tables) +function copy (t) + if not t then return nil end + local new = {} + for k, v in pairs(t) do new[k] = v end + return new +end + +-- Return true if no value in t1 can be found at the same index of t2 +function noMatches (t1, t2) + for k, v in pairs(t1) do + if t2[k] == v then return false end + end + return true +end + +-- Return a table of all derangements of table t +function derangements (t) + local orig = copy(t) + local nextPerm, deranged = permute(t), {} + local numList, keep = copy(nextPerm()) + while numList do + if noMatches(numList, orig) then table.insert(deranged, numList) end + numList = copy(nextPerm()) + end + return deranged +end + +-- Return the subfactorial of n +function subFact (n) + if n < 2 then + return 1 - n + else + return (subFact(n - 1) + subFact(n - 2)) * (n - 1) + end +end + +-- Return a table of the numbers 1 to n +function listOneTo (n) + local t = {} + for i = 1, n do t[i] = i end + return t +end + +-- Main procedure +print("Derangements of [1,2,3,4]") +for k, v in pairs(derangements(listOneTo(4))) do print("", unpack(v)) end +print("\n\nSubfactorial vs counted derangements\n") +print("\tn\t| subFact(n)\t| Derangements") +print(" " .. string.rep("-", 42)) +for i = 0, 9 do + io.write("\t" .. i .. "\t| " .. subFact(i)) + if string.len(subFact(i)) < 5 then io.write("\t") end + print("\t| " .. #derangements(listOneTo(i))) +end +print("\n\nThe subfactorial of 20 is " .. subFact(20)) diff --git a/Task/Permutations-Derangements/Perl-6/permutations-derangements.pl6 b/Task/Permutations-Derangements/Perl-6/permutations-derangements.pl6 index 2d7b9145c2..eb2c0d7a36 100644 --- a/Task/Permutations-Derangements/Perl-6/permutations-derangements.pl6 +++ b/Task/Permutations-Derangements/Perl-6/permutations-derangements.pl6 @@ -1,32 +1,24 @@ -sub derange (@result, @avail) { - if not @avail { @result.item } - else { - map { - derange([ @result, @avail[$_] ], - @avail[0 .. $_-1, $_+1 ..^ @avail ]) - }, grep { @avail[$_] != @result }, 0 .. @avail-1; - } +sub is-derangement(List $l) { + return not grep { $l[$_] == $_ }, 0..($l.elems - 1); } -constant factorial = 1, [\*] 1...*; - -# choose k among n, i.e. n! / k! (n-k)! -sub choose ($n, $k) { factorial[$n] div factorial[$k] div factorial[$n - $k] } - -sub sub-factorial ($n) { - (state @)[$n] //= - factorial[$n] - [+] gather for 1 .. $n -> $k { - take choose($n, $k) * sub-factorial($n - $k); - } +# task 1 +sub derangements(Range $x) { + $x.permutations.grep( *.&is-derangement ) } -say "Derangements for 4 elements:"; -for derange([], 0 .. 3).kv -> $i, @d { - say $i+1, ': ', @d; +# task 2 +.say for (0..4).&derangements; + +# task 3 +sub prefix:(Int $x) { + return +derangements(^$x); } -say "\nCompare list length and calculated table"; -say "$_\t{+derange([], ^$_)}\t{sub-factorial($_)}" for 0 .. 9; - -say "\nNumber of derangements:"; -say "$_:\t{sub-factorial($_)}" for 1 .. 20; +# task 4 +for ^9 -> $n { + say "number: " ~ $n; + say "count: " ~ !$n; + say "derangements: "; + .say for (0..$n-1).&derangements; +} diff --git a/Task/Permutations-Derangements/SuperCollider/permutations-derangements-1.supercollider b/Task/Permutations-Derangements/SuperCollider/permutations-derangements-1.supercollider new file mode 100644 index 0000000000..b738e4e7f7 --- /dev/null +++ b/Task/Permutations-Derangements/SuperCollider/permutations-derangements-1.supercollider @@ -0,0 +1,16 @@ +( +d = { |array, n| + Routine { + n = n ?? { array.size.factorial }; + n.do { |i| + var permuted = array.permute(i); + if(array.every { |each, i| permuted[i] != each }) { + permuted.yield + }; + } + }; +}; +f = { |n| d.((0..n-1)) }; +x = f.(4); +x.all.do(_.postln); ""; +) diff --git a/Task/Permutations-Derangements/SuperCollider/permutations-derangements-2.supercollider b/Task/Permutations-Derangements/SuperCollider/permutations-derangements-2.supercollider new file mode 100644 index 0000000000..b0ba13b4e4 --- /dev/null +++ b/Task/Permutations-Derangements/SuperCollider/permutations-derangements-2.supercollider @@ -0,0 +1,9 @@ +[ 3, 2, 1, 0 ] +[ 2, 3, 0, 1 ] +[ 1, 0, 3, 2 ] +[ 1, 2, 3, 0 ] +[ 2, 0, 3, 1 ] +[ 3, 2, 0, 1 ] +[ 1, 3, 0, 2 ] +[ 2, 3, 1, 0 ] +[ 3, 0, 1, 2 ] diff --git a/Task/Permutations-Derangements/SuperCollider/permutations-derangements-3.supercollider b/Task/Permutations-Derangements/SuperCollider/permutations-derangements-3.supercollider new file mode 100644 index 0000000000..3ee326538e --- /dev/null +++ b/Task/Permutations-Derangements/SuperCollider/permutations-derangements-3.supercollider @@ -0,0 +1,15 @@ +( +z = { |n| + case + { n <= 0 } { 1 } + { n == 1 } { 0 } + { (n - 1) * (z.(n - 1) + z.(n - 2)) } +}; +p = { |i| i.asPaddedString(10, " ") }; +"n derangements subfactorial".postln; +(0..9).do { |i| + var derangements = f.(i).all; + var subfactorial = z.(i); + "% % %\n".postf(i, p.(derangements.size), p.(subfactorial)); +}; +) diff --git a/Task/Permutations-Derangements/SuperCollider/permutations-derangements-4.supercollider b/Task/Permutations-Derangements/SuperCollider/permutations-derangements-4.supercollider new file mode 100644 index 0000000000..8502d19689 --- /dev/null +++ b/Task/Permutations-Derangements/SuperCollider/permutations-derangements-4.supercollider @@ -0,0 +1,11 @@ +n derangements subfactorial +0 1 1 +1 0 0 +2 1 1 +3 2 2 +4 9 9 +5 44 44 +6 265 265 +7 1854 1854 +8 14833 14833 +9 133496 133496 diff --git a/Task/Permutations-Rank-of-a-permutation/00DESCRIPTION b/Task/Permutations-Rank-of-a-permutation/00DESCRIPTION index c39a7b1647..5a18fa369c 100644 --- a/Task/Permutations-Rank-of-a-permutation/00DESCRIPTION +++ b/Task/Permutations-Rank-of-a-permutation/00DESCRIPTION @@ -34,15 +34,21 @@ Algorithms exist that can generate a rank from a permutation for some particular One use of such algorithms could be in generating a small, random, sample of permutations of n items without duplicates when the total number of permutations is large. Remember that the total number of permutations of n items is given by n! which grows large very quickly: A 32 bit integer can only hold 12!, a 64 bit integer only 20!. It becomes difficult to take the straight-forward approach of generating all permutations then taking a random sample of them. A [http://stackoverflow.com/questions/12884428/generate-sample-of-1-000-000-random-permutations question on the Stack Overflow site] asked how to generate one million random and indivudual permutations of 144 items. -;This task is to: + + +;Task: # Create a function to generate a permutation from a rank. # Create the inverse function that given the permutation generates its rank. # Show that for n=3 the two functions are indeed inverses of each other. # Compute and show here 4 random, individual, samples of permutations of 12 objects. + + ;Stretch goal: * State how reasonable it would be to use your program to address the limits of the Stack Overflow question. + ;References: # [http://webhome.cs.uvic.ca/~ruskey/Publications/RankPerm/RankPerm.html Ranking and Unranking Permutations in Linear Time] by Myrvold & Ruskey. (Also available via Google [https://docs.google.com/viewer?a=v&q=cache:t8G2xQ3-wlkJ:citeseerx.ist.psu.edu/viewdoc/download%3Fdoi%3D10.1.1.43.4521%26rep%3Drep1%26type%3Dpdf+&hl=en&gl=uk&pid=bl&srcid=ADGEESgDcCc4JVd_57ziRRFlhDFxpPxoy88eABf9UG_TLXMzfxiC8D__qx4xfY3JAhw_nuPDrZ9gSInX0MbpYjgh807ZfoNtLrl40wdNElw2JMdi94Znv1diM-XYo53D8uelCXnK053L&sig=AHIEtbQtx-sxcVzaZgy9uhniOmETuW4xKg here]). # [http://www.davdata.nl/math/ranks.html Ranks] on the DevData site. # [http://stackoverflow.com/a/1506337/10562 Another answer] on Stack Overflow to a different question that explains its algorithm in detail. +

    diff --git a/Task/Permutations-Rank-of-a-permutation/Perl-6/permutations-rank-of-a-permutation.pl6 b/Task/Permutations-Rank-of-a-permutation/Perl-6/permutations-rank-of-a-permutation.pl6 new file mode 100644 index 0000000000..1b582e1546 --- /dev/null +++ b/Task/Permutations-Rank-of-a-permutation/Perl-6/permutations-rank-of-a-permutation.pl6 @@ -0,0 +1,49 @@ +use v6; + +sub rank2inv ( $rank, $n = * ) { + $rank.polymod( 1 ..^ $n ); +} + +sub inv2rank ( @inv ) { + [+] @inv Z* [\*] 1, 1, * + 1 ... * +} + +sub inv2perm ( @inv, @items is copy = ^@inv.elems ) { + my @perm; + for @inv.reverse -> $i { + @perm.append: @items.splice: $i, 1; + } + @perm; +} + +sub perm2inv ( @perm ) { #not in linear time + ( + { @perm[++$ .. *].grep( * < $^cur ).elems } for @perm; + ).reverse; +} + +for ^6 { + my @row.push: $^rank; + for ( *.&rank2inv(3) , &inv2perm, &perm2inv, &inv2rank ) -> &code { + @row.push: code( @row[*-1] ); + } + say @row; +} + +my $perms = 4; #100; +my $n = 12; #144; + +say 'Via BigInt rank'; +for ( ( ^([*] 1 .. $n) ).pick($perms) ) { + say $^rank.&rank2inv($n).&inv2perm; +}; + +say 'Via inversion vectors'; +for ( { my $i=0; inv2perm (^++$i).roll xx $n } ... * ).unique( with => &[eqv] ).[^$perms] { + .say; +}; + +say 'Via Perl 6 method pick'; +for ( { [(^$n).pick(*)] } ... * ).unique( with => &[eqv] ).head($perms) { + .say +}; diff --git a/Task/Permutations-Rank-of-a-permutation/REXX/permutations-rank-of-a-permutation.rexx b/Task/Permutations-Rank-of-a-permutation/REXX/permutations-rank-of-a-permutation.rexx index 484d0a178c..b4b5ac5fa8 100644 --- a/Task/Permutations-Rank-of-a-permutation/REXX/permutations-rank-of-a-permutation.rexx +++ b/Task/Permutations-Rank-of-a-permutation/REXX/permutations-rank-of-a-permutation.rexx @@ -1,33 +1,40 @@ -/*REXX program shows permutations of N number of objects (1,2,3, ...).*/ -parse arg N seed .; if N=='' then N=3 /*Not specified? Assume default*/ -permutes=permsets(N) /*returns N! (# of permutations)*/ -w=length(permutes) /*used for aligning the SAY stuff*/ +/*REXX program displays permutations of N number of objects (1, 2, 3, ···). */ +parse arg N seed . /*obtain optional arguments from the CL*/ +if N=='' | N=="," then N=4 /*Not specified? Then use the default.*/ +if datatype(seed,'W') then call random ,,seed /*can make RANDOM numbers repeatable. */ +permutes=permSets(N) /*returns N! (number of permutations).*/ +w=length(permutes) /*used for aligning the SAY output. */ - do what=0 to permutes-1 /*traipse through each permute. */ - z=permsets(N, what) /*get the "what" permuation. */ - say N 'items, permute' right(what,w) "=" z ' rank=' permsets(N,,z) - end /*what*/ - -say; if seed\=='' then call random ,,seed /*seed ≡ repeatability.*/ + do what=0 to permutes-1 /*traipse through each of the permutes.*/ + z=permSets(N, what) /*get which of the permutation it is.*/ + say N 'items, permute' right(what,w) "=" z ' rank=' permSets(N,,z) + end /*what*/ +say N=12 - do 4; ?=random(0, N**4) /*REXX has a 100k RANDOM range.*/ - say N 'items, permute' right(?,6) " is " permsets(N,?) + do 4; ?=random(0, N**4) /*REXX has a 100k RANDOM range. */ + say N 'items, permute' right(?,6) " is " permSets(N,?) end /*rand*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────PERMSETS subroutine─────────────────*/ -permsets: procedure expose @. #; #=0; parse arg x,r,c; c=space(c); xm=x-1 +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +permSets: procedure expose @. #; #=0; parse arg x,r,c; c=space(c); xm=x-1 - do j=1 for x; @.j=j-1; end /*j*/; _=0; do u=2 for xm; _=_ @.u; end /*u*/ - if r==# then return _; if c==_ then return # + do j=1 for x; @.j=j-1; end /*j*/ + _=0; do u=2 for xm; _=_ @.u; end /*u*/ + if r==# then return _; if c==_ then return # - do while .permsets(x,0); #=#+1; _=@.1; do u=2 for xm; _=_ @.u; end /*u*/ - if r==# then return _; if c==_ then return # - end /*while···*/ -return #+1 + do while .permSets(x,0); #=#+1; _=@.1 + do v=2 for xm; _=_ @.v; end /*v*/ + if r==# then return _; if c==_ then return # + end /*while···*/ + return #+1 +/*──────────────────────────────────────────────────────────────────────────────────────*/ +.permSets: procedure expose @.; parse arg p,q; pm=p-1 + do k=pm by -1 for pm; kp=k+1; if @.k<@.kp then do; q=k; leave; end + end /*k*/ -.permsets: procedure expose @.; parse arg p,q; pm=p-1 - do k=pm by -1 for pm; kp=k+1; if @.k<@.kp then do; q=k; leave; end; end - do j=q+1 while j
    diff --git a/Task/Permutations-by-swapping/Clojure/permutations-by-swapping.clj b/Task/Permutations-by-swapping/Clojure/permutations-by-swapping-1.clj similarity index 100% rename from Task/Permutations-by-swapping/Clojure/permutations-by-swapping.clj rename to Task/Permutations-by-swapping/Clojure/permutations-by-swapping-1.clj diff --git a/Task/Permutations-by-swapping/Clojure/permutations-by-swapping-2.clj b/Task/Permutations-by-swapping/Clojure/permutations-by-swapping-2.clj new file mode 100644 index 0000000000..decf8c3d0b --- /dev/null +++ b/Task/Permutations-by-swapping/Clojure/permutations-by-swapping-2.clj @@ -0,0 +1,62 @@ +(ns test-p.core) + +(defn numbers-only [x] + " Just shows the numbers only for the pairs (i.e. drops the direction --used for display purposes when printing the result" + (mapv first x)) + +(defn next-permutation + " Generates next permutation from the current (p) using the Johnson-Trotter technique + The code below translates the Python version which has the following steps: + p of form [...[n dir]...] such as [[0 1] [1 1] [2 -1]], where n is a number and dir = direction (=1=right, -1=left, 0=don't move) + Step: 1 finds the pair [n dir] with the largest value of n (where dir is not equal to 0 (done if none) + Step: 2: swap the max pair found with its neighbor in the direction of the pair (i.e. +1 means swap to right, -1 means swap left + Step 3: if swapping places the pair a the beginning or end of the list, set the direction = 0 (i.e. becomes non-mobile) + Step 4: Set the directions of all pairs whose numbers are greater to the right of where the pair was moved to -1 and to the left to +1 " + [p] + (if (every? zero? (map second p)) + nil ; no mobile elements (all directions are zero) + (let [n (count p) + ; Step 1 + fn-find-max (fn [m] + (first (apply max-key ; find the max mobile elment + (fn [[i x]] + (if (zero? (second x)) + -1 + (first x))) + (map-indexed vector p)))) + i1 (fn-find-max p) ; index of max + [n1 d1] (p i1) ; value and direction of max + i2 (+ d1 i1) + fn-swap (fn [m] (assoc m i2 (m i1) i1 (m i2))) ; function to swap with neighbor in our step direction + fn-update-max (fn [m] (if (or (contains? #{0 (dec n)} i2) ; update direction of max (where max went) + (> ((m (+ i2 d1)) 0) n1)) + (assoc-in m [i2 1] 0) + m)) + fn-update-others (fn [[i3 [n3 d3]]] ; Updates directions of pairs to the left and right of max + (cond ; direction reset to -1 if to right, +1 if to left + (<= n3 n1) [n3 d3] + (< i3 i2) [n3 1] + :else [n3 -1]))] + ; apply steps 2, 3, 4(using functions that where created for these steps) + (mapv fn-update-others (map-indexed vector (fn-update-max (fn-swap p))))))) + +(defn spermutations + " Lazy sequence of permutations of n digits" + ; Each element is two element vector (number direction) + ; Startup case - generates sequence 0...(n-1) with move direction (1 = move right, -1 = move left, 0 = don't move) + ([n] (spermutations 1 + (into [] (for [i (range n)] (if (zero? i) + [i 0] ; 0th element is not mobile yet + [i -1]))))) ; all others move left + ([sign p] + (when-let [s (seq p)] + (cons [(numbers-only p) sign] + (spermutations (- sign) (next-permutation p)))))) ; recursively tag onto sequence + + +;; Print results for 2, 3, and 4 items +(doseq [n (range 2 5)] + (do + (println) + (println (format "Permutations and sign of %d items " n)) + (doseq [q (spermutations n)] (println (format "Perm: %s Sign: %2d" (first q) (second q)))))) diff --git a/Task/Permutations-by-swapping/Haskell/permutations-by-swapping.hs b/Task/Permutations-by-swapping/Haskell/permutations-by-swapping.hs index b41b838184..811aac66a5 100644 --- a/Task/Permutations-by-swapping/Haskell/permutations-by-swapping.hs +++ b/Task/Permutations-by-swapping/Haskell/permutations-by-swapping.hs @@ -4,7 +4,7 @@ s_permutations = flip zip (cycle [1, -1]) . (foldl aux [[]]) (f,item) <- zip (cycle [reverse,id]) items f (insertEv x item) insertEv x [] = [[x]] - insertEv x l@(y:ys) = (x:l) : map (y:) $ insertEv x ys + insertEv x l@(y:ys) = (x:l) : map (y:) (insertEv x ys) main :: IO () main = do diff --git a/Task/Permutations-by-swapping/Lua/permutations-by-swapping.lua b/Task/Permutations-by-swapping/Lua/permutations-by-swapping.lua new file mode 100644 index 0000000000..61276ad6a8 --- /dev/null +++ b/Task/Permutations-by-swapping/Lua/permutations-by-swapping.lua @@ -0,0 +1,41 @@ +_JT={} +function JT(dim) + local n={ values={}, positions={}, directions={}, sign=1 } + setmetatable(n,{__index=_JT}) + for i=1,dim do + n.values[i]=i + n.positions[i]=i + n.directions[i]=-1 + end + return n +end + +function _JT:largestMobile() + for i=#self.values,1,-1 do + local loc=self.positions[i]+self.directions[i] + if loc >= 1 and loc <= #self.values and self.values[loc] < i then + return i + end + end + return 0 +end + +function _JT:next() + local r=self:largestMobile() + if r==0 then return false end + local rloc=self.positions[r] + local lloc=rloc+self.directions[r] + local l=self.values[lloc] + self.values[lloc],self.values[rloc] = self.values[rloc],self.values[lloc] + self.positions[l],self.positions[r] = self.positions[r],self.positions[l] + self.sign=-self.sign + for i=r+1,#self.directions do self.directions[i]=-self.directions[i] end + return true +end + +-- test + +perm=JT(4) +repeat + print(unpack(perm.values)) +until not perm:next() diff --git a/Task/Permutations-by-swapping/REXX/permutations-by-swapping.rexx b/Task/Permutations-by-swapping/REXX/permutations-by-swapping.rexx index 340c8ae4fd..a8792aa6f7 100644 --- a/Task/Permutations-by-swapping/REXX/permutations-by-swapping.rexx +++ b/Task/Permutations-by-swapping/REXX/permutations-by-swapping.rexx @@ -1,53 +1,52 @@ -/*REXX program generates all permutations of N different objects by swapping. */ -parse arg things bunch . /*get optional arguments from the C.L. */ -things = p(things 4) /*should use the default for THINGS ? */ -bunch = p(bunch things) /* " " " " " BUNCH ? */ -call permSets things, bunch /*invoke permutations by swapping sub. */ -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────one─liner subroutines─────────────────────*/ -!: procedure; !=1; do j=2 to arg(1); !=!*j; end; return ! -c: return substr(arg(1),arg(2),1) /*pick a single character from a string*/ -p: return word(arg(1), 1) /*pick 1st word (or number) from a list*/ -/*──────────────────────────────────PERMSETS subroutine───────────────────────*/ -permSets: procedure; parse arg x,y /*take X things Y at a time. */ -!.=0; pad=left('',x*y) /*Note: X can't be > length(@0abcs). */ -@abc ='abcdefghijklmnopqrstuvwxyz'; @abcU=@abc; upper @abcU /*build syms.*/ -@abcS=@abcU || @abc; @0abcS=123456789 || @abcS /*···and more*/ -z= /*define Z to be a null value for start*/ - do i=1 for x /*build list of (permutation) symbols. */ - z=z || c(@0abcS,i) /*append the char to the symbol list. */ - end /*i*/ -#=1 /*the number of permutations (so far).*/ -!.z=1; q=z; s=1; times=!(x)% !(x-y) /*calculate (#) TIMES using factorial.*/ -w=max(length(z), length('permute')) /*maximum width of Z and also PERMUTE.*/ -say center('permutations for ' x ' things taken ' y " at a time",60,'═') -say -say pad 'permutation' center("permute",w,'─') 'sign' -say pad '───────────' center("───────",w,'─') '────' -say pad center(#,11) center(z ,w) right(s, 4-1) +/*REXX program generates all permutations of N different objects by swapping. */ +parse arg things bunch . /*get optional arguments from the C.L. */ +things = p(things 4) /*should use the default for THINGS ? */ +bunch = p(bunch things) /* " " " " " BUNCH ? */ +call permSets things, bunch /*invoke permutations by swapping sub. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +!: procedure; !=1; do j=2 to arg(1); !=!*j; end /*j*/; return ! +c: return substr(arg(1), arg(2), 1) /*pick a single character from a string*/ +p: return word(arg(1), 1) /*pick 1st word (or number) from a list*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +permSets: procedure; parse arg x,y /*take X things Y at a time. */ + !.=0; pad=left('',x*y) /*Note: X can't be > length(@0abcs). */ + @abc = 'abcdefghijklmnopqrstuvwxyz'; @abcU=@abc; upper @abcU /*build symbols*/ + @abcS= @abcU || @abc; @0abcS=123456789 || @abcS /* ··· and more*/ + z= /*define Z to be a null value for start*/ + do i=1 for x /*build list of (permutation) symbols. */ + z=z || c(@0abcS, i) /*append the char to the symbol list. */ + end /*i*/ + #=1 /*the number of permutations (so far).*/ + !.z=1; q=z; s=1; times=!(x)% !(x-y) /*calculate (#) TIMES using factorial.*/ + w=max(length(z), length('permute')) /*maximum width of Z and also PERMUTE.*/ + say center('permutations for ' x ' things taken ' y " at a time",60,'═') + say + say pad 'permutation' center("permute", w, '─') "sign" + say pad '───────────' center("───────", w, '─') "────" + say pad center(#, 11) center(z , w) right(s, 4-1) - do $=1 until #==times /*perform permutation until # of times.*/ - do k=1 for x-1 /*step thru things for things-1 times.*/ - do m=k+1 to x /*this method doesn't use adjacency. */ - ?= /*begin this with a blank (null) slate.*/ - do n=1 for x /*build the new permutation by swapping*/ - if n\==k & n\==m then ? = ? || c(z, n) - else if n==k then ? = ? || c(z, m) - else ? = ? || c(z, k) - end /*n*/ - z=? /*save this permutation for next swap. */ - if !.? then iterate m /*if defined before, then try next 'un.*/ - _=0 /* [↓] count number of swapped symbols*/ - do d=1 for x while $\==1; _=_+(c(?,d)\==c(prev,d)); end /*d*/ - if _>2 then do; _=z - a=$//x+1; q=q+_ /* [← ↓] this swapping tries adjacency*/ - b=q//x+1; if b==a then b=a+1; if b>x then b=a-1 - z=overlay(c(z,b), overlay(c(z,a), _, b), a) - iterate $ /*now, try this particular permutation.*/ - end - #=#+1; s=-s; say pad center(#,11) center(?,w) right(s,4-1) - !.?=1; prev=?; iterate $ /*now, try another swapped permutation.*/ - end /*m*/ - end /*k*/ - end /*$*/ -return /*we're all finished with permutating. */ + do $=1 until #==times /*perform permutation until # of times.*/ + do k=1 for x-1 /*step thru things for things-1 times.*/ + do m=k+1 to x; ?= /*this method doesn't use adjacency. */ + do n=1 for x /*build the new permutation by swapping*/ + if n\==k & n\==m then ? = ? || c(z, n) + else if n==k then ? = ? || c(z, m) + else ? = ? || c(z, k) + end /*n*/ + z=? /*save this permutation for next swap. */ + if !.? then iterate m /*if defined before, then try next one.*/ + _=0 /* [↓] count number of swapped symbols*/ + do d=1 for x while $\==1; _=_+(c(?,d)\==c(prev,d)); end /*d*/ + if _>2 then do; _=z + a=$//x+1; q=q+_ /* [← ↓] this swapping tries adjacency*/ + b=q//x+1; if b==a then b=a+1; if b>x then b=a-1 + z=overlay(c(z, b), overlay(c(z, a), _, b), a) + iterate $ /*now, try this particular permutation.*/ + end + #=#+1; s=-s; say pad center(#,11) center(?,w) right(s,4-1) + !.?=1; prev=?; iterate $ /*now, try another swapped permutation.*/ + end /*m*/ + end /*k*/ + end /*$*/ + return /*we're all finished with permutating. */ diff --git a/Task/Permutations/00DESCRIPTION b/Task/Permutations/00DESCRIPTION index fa72acb084..6837402a77 100644 --- a/Task/Permutations/00DESCRIPTION +++ b/Task/Permutations/00DESCRIPTION @@ -1,7 +1,11 @@ -Write a program that generates all [[wp:Permutation|permutations]] of '''n''' different objects. (Practically numerals!) -;Cf. -* [[Find the missing permutation]] -* [[Permutations/Derangements]] +;Task: +Write a program that generates all   [[wp:Permutation|permutations]]   of   '''n'''   different objects.   (Practically numerals!) + + +;Related tasks: +*   [[Find the missing permutation]] +*   [[Permutations/Derangements]] + -'''See Also:''' {{Template:Combinations and permutations}} +

    diff --git a/Task/Permutations/AppleScript/permutations.applescript b/Task/Permutations/AppleScript/permutations.applescript new file mode 100644 index 0000000000..55160d0128 --- /dev/null +++ b/Task/Permutations/AppleScript/permutations.applescript @@ -0,0 +1,114 @@ +-- permutations :: [a] -> [[a]] +on permutations(xs) + script firstElement + on lambda(x) + script tailElements + on lambda(ys) + {x & ys} + end lambda + end script + + concatMap(tailElements, permutations(|delete|(x, xs))) + end lambda + end script + + if length of xs > 0 then + concatMap(firstElement, xs) + else + {{}} + end if +end permutations + + +-- TEST +on run + + return permutations({1, 2, 3}) + permutations({"aardvarks", "eat", "ants"}) + +end run + + + +-- GENERIC LIBRARY FUNCTIONS + +-- concatMap :: (a -> [b]) -> [a] -> [b] +on concatMap(f, xs) + script append + on lambda(a, b) + a & b + end lambda + end script + + foldl(append, {}, map(f, xs)) +end concatMap + +-- 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 + +-- 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 + +-- delete :: a -> [a] -> [a] +on |delete|(x, xs) + script Eq + on lambda(a, b) + a = b + end lambda + end script + + deleteBy(Eq, x, xs) +end |delete| + +-- deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a] +on deleteBy(fnEq, x, xs) + if length of xs > 0 then + set {h, t} to uncons(xs) + if lambda(x, h) of mReturn(fnEq) then + t + else + {h} & deleteBy(fnEq, x, t) + end if + else + {} + end if +end deleteBy + +-- uncons :: [a] -> Maybe (a, [a]) +on uncons(xs) + if length of xs > 0 then + {item 1 of xs, rest of xs} + else + missing value + end if +end uncons + +-- 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 diff --git a/Task/Permutations/Batch-File/permutations.bat b/Task/Permutations/Batch-File/permutations.bat new file mode 100644 index 0000000000..44429e5440 --- /dev/null +++ b/Task/Permutations/Batch-File/permutations.bat @@ -0,0 +1,33 @@ +@echo off +setlocal enabledelayedexpansion +set arr=ABCD +set /a n=4 +:: echo !arr! +call :permu %n% arr +goto:eof + +:permu num &arr +setlocal +if %1 equ 1 call echo(!%2! & exit /b +set /a "num=%1-1,n2=num-1" +set arr=!%2! +for /L %%c in (0,1,!n2!) do ( + call:permu !num! arr + set /a n1="num&1" + if !n1! equ 0 (call:swapit !num! 0 arr) else (call:swapit !num! %%c arr) + ) + call:permu !num! arr +endlocal & set %2=%arr% +exit /b + +:swapit from to &arr +setlocal +set arr=!%3! +set temp1=!arr:~%~1,1! +set temp2=!arr:~%~2,1! +set arr=!arr:%temp1%=@! +set arr=!arr:%temp2%=%temp1%! +set arr=!arr:@=%temp2%! +:: echo %1 %2 !%~3! !arr! +endlocal & set %3=%arr% +exit /b diff --git a/Task/Permutations/JavaScript/permutations-1.js b/Task/Permutations/JavaScript/permutations-1.js index 30c6578a01..874ce8673e 100644 --- a/Task/Permutations/JavaScript/permutations-1.js +++ b/Task/Permutations/JavaScript/permutations-1.js @@ -5,18 +5,18 @@ var d = document.getElementById('result'); function perm(list, ret) { - if (list.length == 0) { - var row = document.createTextNode(ret.join(' ') + '\n'); - d.appendChild(row); - return; - } - for (var i = 0; i < list.length; i++) { - var x = list.splice(i, 1); - ret.push(x); - perm(list, ret); - ret.pop(); - list.splice(i, 0, x); - } + if (list.length == 0) { + var row = document.createTextNode(ret.join(' ') + '\n'); + d.appendChild(row); + return; + } + for (var i = 0; i < list.length; i++) { + var x = list.splice(i, 1); + ret.push(x); + perm(list, ret); + ret.pop(); + list.splice(i, 0, x); + } } perm([1, 2, 'A', 4], []); diff --git a/Task/Permutations/JavaScript/permutations-2.js b/Task/Permutations/JavaScript/permutations-2.js index 22887ee077..c9e572cefa 100644 --- a/Task/Permutations/JavaScript/permutations-2.js +++ b/Task/Permutations/JavaScript/permutations-2.js @@ -1,30 +1,12 @@ -(function () { +function perm(a) { + if (a.length < 2) return [a]; + var c, d, b = []; + for (c = 0; c < a.length; c++) { + var e = a.splice(c, 1), + f = perm(a); + for (d = 0; d < f.length; d++) b.push([e].concat(f[d])); + a.splice(c, 0, e[0]) + } return b +} - // [a] -> [[a]] - function permutations(xs) { - return xs.length ? ( - chain( xs, function (x) { - return chain( permutations(deleted(x, xs)), function (ys) { - - return ( [[x].concat(ys)] ); - - })})) : [[]] - } - - // monadic bind/chain for lists - function chain(xs, f) { - return [].concat.apply([], xs.map(f)); - } - - // drops first instance found - function deleted(x, xs) { - return xs.length ? ( - x === xs[0] ? xs.slice(1) : [xs[0]].concat( - deleted(x, xs.slice(1)) - ) - ) : []; - } - - return permutations(['Aardvarks', 'eat', 'ants']) - -})(); +console.log(perm(['Aardvarks', 'eat', 'ants']).join("\n")); diff --git a/Task/Permutations/JavaScript/permutations-3.js b/Task/Permutations/JavaScript/permutations-3.js index 9ec16abe7d..d708ebc7a3 100644 --- a/Task/Permutations/JavaScript/permutations-3.js +++ b/Task/Permutations/JavaScript/permutations-3.js @@ -1 +1,6 @@ -[["Aardvarks", "eat", "ants"], ["Aardvarks", "ants", "eat"], ["eat", "Aardvarks", "ants"], ["eat", "ants", "Aardvarks"], ["ants", "Aardvarks", "eat"], ["ants", "eat", "Aardvarks"]] +Aardvarks,eat,ants +Aardvarks,ants,eat +eat,Aardvarks,ants +eat,ants,Aardvarks +ants,Aardvarks,eat +ants,eat,Aardvarks diff --git a/Task/Permutations/JavaScript/permutations-4.js b/Task/Permutations/JavaScript/permutations-4.js new file mode 100644 index 0000000000..7c49b8445f --- /dev/null +++ b/Task/Permutations/JavaScript/permutations-4.js @@ -0,0 +1,39 @@ +(function () { + + // permutations :: [a] -> [[a]] + function permutations(xs) { + return xs.length ? (concatMap( + function (x) { + return concatMap( + function (ys) { + return ([[x].concat(ys)]); + }, permutations(delete1(x, xs))) + }, xs)) : [[]] + } + + + // GENERIC LIBRARY FUNCTIONS + + // concatMap :: (a -> [b]) -> [a] -> [b] + function concatMap(f, xs) { + return [].concat.apply([], xs.map(f)); + } + + // delete first instance of a in [a] + // delete1 :: a -> [a] -> [a] + function delete1(x, xs) { + return deleteBy(function (a, b) { + return a === b; + }, x, xs); + } + + // deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a] + function deleteBy(fnEq, x, xs) { + return xs.length ? fnEq(x, xs[0]) ? xs.slice(1) : [xs[0]] + .concat(deleteBy(fnEq, x, xs.slice(1))) : []; + } + + + return permutations(['Aardvarks', 'eat', 'ants']) + +})(); diff --git a/Task/Permutations/JavaScript/permutations-5.js b/Task/Permutations/JavaScript/permutations-5.js new file mode 100644 index 0000000000..4b9fbe8242 --- /dev/null +++ b/Task/Permutations/JavaScript/permutations-5.js @@ -0,0 +1,3 @@ +[["Aardvarks", "eat", "ants"], ["Aardvarks", "ants", "eat"], + ["eat", "Aardvarks", "ants"], ["eat", "ants", "Aardvarks"], +["ants", "Aardvarks", "eat"], ["ants", "eat", "Aardvarks"]] diff --git a/Task/Permutations/JavaScript/permutations-6.js b/Task/Permutations/JavaScript/permutations-6.js new file mode 100644 index 0000000000..5052af34c7 --- /dev/null +++ b/Task/Permutations/JavaScript/permutations-6.js @@ -0,0 +1,19 @@ +(function (lst) { + 'use strict'; + + const permutations = (xs) => xs.length ? ( + flatMap((x) => flatMap((xs) => [[x].concat(xs)], + permutations(del(x, xs))), xs) + ) : [[]], + + flatMap = (f, xs) => [].concat.apply([], xs.map(f)), + + del = (x, xs) => xs.length ? x === xs[0] ? ( + xs.slice(1) + ) : [xs[0]].concat(del(x, xs.slice(1)) + ) : []; + + + return permutations(lst); + +})(["Aardvarks", "eat", "ants"]); diff --git a/Task/Permutations/JavaScript/permutations-7.js b/Task/Permutations/JavaScript/permutations-7.js new file mode 100644 index 0000000000..4b9fbe8242 --- /dev/null +++ b/Task/Permutations/JavaScript/permutations-7.js @@ -0,0 +1,3 @@ +[["Aardvarks", "eat", "ants"], ["Aardvarks", "ants", "eat"], + ["eat", "Aardvarks", "ants"], ["eat", "ants", "Aardvarks"], +["ants", "Aardvarks", "eat"], ["ants", "eat", "Aardvarks"]] diff --git a/Task/Permutations/K/permutations.k b/Task/Permutations/K/permutations-1.k similarity index 100% rename from Task/Permutations/K/permutations.k rename to Task/Permutations/K/permutations-1.k diff --git a/Task/Permutations/K/permutations-2.k b/Task/Permutations/K/permutations-2.k new file mode 100644 index 0000000000..bb0185b0b4 --- /dev/null +++ b/Task/Permutations/K/permutations-2.k @@ -0,0 +1,25 @@ + perm:{x@m@&n=(#?:)'m:!n#n:#x} + + perm[!3] +(0 1 2 + 0 2 1 + 1 0 2 + 1 2 0 + 2 0 1 + 2 1 0) + + perm "abc" +("abc" + "acb" + "bac" + "bca" + "cab" + "cba") + + `0:{1_,/" ",/: $x}' perm `$" "\"some random text" +some random text +some text random +random some text +random text some +text some random +text random some diff --git a/Task/Permutations/Modula-2/permutations.mod2 b/Task/Permutations/Modula-2/permutations.mod2 new file mode 100644 index 0000000000..5660483c64 --- /dev/null +++ b/Task/Permutations/Modula-2/permutations.mod2 @@ -0,0 +1,60 @@ +MODULE Permute; + +FROM Terminal +IMPORT Read, Write, WriteLn; + +FROM Terminal2 +IMPORT WriteString; + +CONST MAXIDX = 6; + MINIDX = 1; + +TYPE TInpCh = ['a'..'z']; + TChr = SET OF TInpCh; + +VAR n, + nl: INTEGER; + ch: CHAR; + a: ARRAY[MINIDX..MAXIDX] OF CHAR; + kt: TChr = TChr{'a'..'f'}; + +PROCEDURE output; +VAR i: INTEGER; +BEGIN + FOR i := MINIDX TO n DO Write(a[i]) END; + WriteString(" | "); +END output; + +PROCEDURE exchange(VAR x, y : CHAR); +VAR z: CHAR; +BEGIN z := x; x := y; y := z +END exchange; + +PROCEDURE permute(k: INTEGER); +VAR i: INTEGER; +BEGIN + IF k = 1 THEN + output; + INC(nl); + IF (nl MOD 8 = 1) THEN WriteLn END; + ELSE + permute(k-1); + FOR i := MINIDX TO k-1 DO + exchange(a[i], a[k]); + permute(k-1); + exchange(a[i], a[k]); + END + END +END permute; + +BEGIN + n := 0; nl := 1; WriteString("Input {a,b,c,d,e,f} >"); + REPEAT + Read(ch); + IF ch IN kt THEN INC(n); a[n] := ch; Write(ch) END + UNTIL (ch <= " ") OR (n > MAXIDX); + + WriteLn; + IF n > 0 THEN permute(n) END; + (*Wait*) +END Permute. diff --git a/Task/Permutations/PHP/permutations.php b/Task/Permutations/PHP/permutations.php new file mode 100644 index 0000000000..919cf79e82 --- /dev/null +++ b/Task/Permutations/PHP/permutations.php @@ -0,0 +1,23 @@ +//Author Gavryushin Ivan @dcc0 + $a[$i-1]) { + $i++; +} +$j=0; + while($a[$j] < $a[$i]) { + +$j++; +} + $c=$a[$j]; + $a[$j]=$a[$i]; + $a[$i]=$c; + $a=strrev(substr($a, 0, $i)).substr($a, $i); + print $a. "\n"; + +} +?> diff --git a/Task/Permutations/Pascal/permutations.pascal b/Task/Permutations/Pascal/permutations-1.pascal similarity index 100% rename from Task/Permutations/Pascal/permutations.pascal rename to Task/Permutations/Pascal/permutations-1.pascal diff --git a/Task/Permutations/Pascal/permutations-2.pascal b/Task/Permutations/Pascal/permutations-2.pascal new file mode 100644 index 0000000000..84cd0a1ba6 --- /dev/null +++ b/Task/Permutations/Pascal/permutations-2.pascal @@ -0,0 +1,71 @@ +{$IFDEF FPC} + {$MODE DELPHI} +{$ELSE} + {$APPTYPE CONSOLE} +{$ENDIF} +uses + sysutils; +type + tPermfield = array[0..15] of Nativeint; +var + permcnt: NativeUint; + +procedure DoSomething(k: NativeInt;var x:tPermfield); +var + i:integer; + kk:string; +begin + kk:=''; + for i:=1 to k do kk:=kk+inttostr(x[i])+' '; + writeln(kk); +end; + +procedure PermKoutOfN(k,n: nativeInt); +var + x,y:tPermfield; + i,yi,tmp:NativeInt; +begin + //initialise + permcnt:= 1; + if k>n then + k:=n; + if k=n then + k:=k-1; + for i:=1 to n do x[i]:=i; + for i:=1 to k do y[i]:=i; + +// DoSomething(k,x); + i := k; + repeat + yi:=y[i]; + if yi $n is copy { my @order; @@ -7,7 +7,7 @@ sub permute(@items) { $n div= $_; } my @i-copy = @items; - take [ map { @i-copy.splice($_, 1) }, @order ]; + take map { |@i-copy.splice($_, 1) }, @order; } } .say for permute( 'a'..'c' ) diff --git a/Task/Permutations/R/permutations.r b/Task/Permutations/R/permutations.r index 52b6245e00..768b299254 100644 --- a/Task/Permutations/R/permutations.r +++ b/Task/Permutations/R/permutations.r @@ -1,42 +1,42 @@ next.perm <- function(p) { - n <- length(p) - i <- n - 1 - r = TRUE - for(i in (n-1):1) { - if(p[i] < p[i+1]) { - r = FALSE - break - } - } - - j <- i + 1 - k <- n - while(j < k) { - x <- p[j] - p[j] <- p[k] - p[k] <- x - j <- j + 1 - k <- k - 1 - } - - if(r) return(NULL) - - j <- n - while(p[j] > p[i]) j <- j - 1 - j <- j + 1 - - x <- p[i] - p[i] <- p[j] - p[j] <- x - return(p) + n <- length(p) + i <- n - 1 + r = T + for (i in seq(n - 1, 1)) { + if (p[i] < p[i + 1]) { + r = F + break + } + } + + j <- i + 1 + k <- n + while (j < k) { + x <- p[j] + p[j] <- p[k] + p[k] <- x + j <- j + 1 + k <- k - 1 + } + + if(r) return(NULL) + + j <- n + while (p[j] > p[i]) j <- j - 1 + j <- j + 1 + + x <- p[i] + p[i] <- p[j] + p[j] <- x + return(p) } print.perms <- function(n) { - p <- 1:n - while(!is.null(p)) { - cat(p,"\n") - p <- next.perm(p) - } + p <- 1:n + while (!is.null(p)) { + cat(p, "\n") + p <- next.perm(p) + } } print.perms(3) diff --git a/Task/Permutations/REXX/permutations-1.rexx b/Task/Permutations/REXX/permutations-1.rexx index 22429954f1..569720f5dc 100644 --- a/Task/Permutations/REXX/permutations-1.rexx +++ b/Task/Permutations/REXX/permutations-1.rexx @@ -1,33 +1,32 @@ -/*REXX program generates all permutations of N different objects. */ +/*REXX program generates and displays all permutations of N different objects. */ parse arg things bunch inbetweenChars names - /* inbetweenChars (optional) defaults to a [null]. */ - /* names (optional) defaults to digits (and letters). */ + /* inbetweenChars (optional) defaults to a [null]. */ + /* names (optional) defaults to digits (and letters).*/ call permSets things, bunch, inbetweenChars, names -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────P subroutine (Pick one)─────────────*/ -p: return word(arg(1),1) -/*──────────────────────────────────PERMSETS subroutine─────────────────*/ -permSets: procedure; parse arg x,y,between,uSyms /*X things Y at a time.*/ -@.=; sep= /*X can't be > length(@0abcs). */ -@abc = 'abcdefghijklmnopqrstuvwxyz'; @abcU=@abc; upper @abcU -@abcS = @abcU || @abc; @0abcS=123456789 || @abcS +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +p: return word(arg(1),1) /*P function (Pick first arg of many).*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +permSets: procedure; parse arg x,y,between,uSyms /*X things taken Y at a time. */ + @.=; sep= /*X can't be > length(@0abcs). */ + @abc = 'abcdefghijklmnopqrstuvwxyz'; @abcU=@abc; upper @abcU + @abcS = @abcU || @abc; @0abcS=123456789 || @abcS - do k=1 for x /*build a list of (perm) symbols.*/ - _=p(word(uSyms,k) p(substr(@0abcS,k,1) k)) /*get|generate a symbol.*/ - if length(_)\==1 then sep='_' /*if not 1st char, then use sep.*/ - $.k=_ /*append it to the symbol list. */ - end /*k*/ + do k=1 for x /*build a list of permutation symbols. */ + _=p(word(uSyms,k) p(substr(@0abcS,k,1) k)) /*get or generate a symbol.*/ + if length(_)\==1 then sep='_' /*if not 1st character, then use sep. */ + $.k=_ /*append the character to symbol list. */ + end /*k*/ -if between=='' then between=sep /*use the appropriate separator. */ -call .permset 1 /*start with the first permuation*/ -return -/*──────────────────────────────────.PERMSET subroutine─────────────────*/ -.permset: procedure expose $. @. between x y; parse arg ? -if ?>y then do; _=@.1; do j=2 to y; _=_||between||@.j; end; say _; end - else do q=1 for x /*build permutation recursively. */ - do k=1 for ?-1; if @.k==$.q then iterate q; end /*k*/ - @.?=$.q; call .permset ?+1 - end /*q*/ -return + if between=='' then between=sep /*use the appropriate separator chars. */ + call .permset 1 /*start with the first permuation. */ + return +.permset: procedure expose $. @. between x y; parse arg ? + if ?>y then do; _=@.1; do j=2 to y; _=_ || between || @.j; end; say _; end + else do q=1 for x /*build the permutation recursively. */ + do k=1 for ?-1; if @.k==$.q then iterate q; end /*k*/ + @.?=$.q; call .permset ?+1 + end /*q*/ + return diff --git a/Task/Permutations/REXX/permutations-2.rexx b/Task/Permutations/REXX/permutations-2.rexx index a59791998a..a1d6459d9a 100644 --- a/Task/Permutations/REXX/permutations-2.rexx +++ b/Task/Permutations/REXX/permutations-2.rexx @@ -1,22 +1,16 @@ -/*REXX program shows permutations of N number of objects (1,2,3, ...).*/ -parse arg n .; if n=='' then n=3 /*Not specified? Assume default.*/ - /*populate the first permutation.*/ - do pop=1 for n; @.pop=pop ; end; call tell n - - do while nextperm(n,0); call tell n; end -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────NEXTPERM subroutine─────────────────*/ -nextperm: procedure expose @.; parse arg n,i; nm=n-1 - - do k=nm by -1 for nm; kp=k+1 - if @.k<@.kp then do; i=k; leave; end - end /*k*/ - - do j=i+1 while j Traversable[List[T]] = { + case Nil => List(Nil) + case xs => { + for { + (x, i) <- xs.zipWithIndex + ys <- permutations(xs.take(i) ++ xs.drop(1 + i)) + } yield { + x :: ys + } + } + } diff --git a/Task/Permutations/Scala/permutations.scala b/Task/Permutations/Scala/permutations.scala deleted file mode 100644 index 5cd28d26a9..0000000000 --- a/Task/Permutations/Scala/permutations.scala +++ /dev/null @@ -1 +0,0 @@ -List('a, 'b, 'c).permutations foreach println diff --git a/Task/Permutations/VBA/permutations.vba b/Task/Permutations/VBA/permutations.vba index 3c50f54c3f..9f453e4cf7 100644 --- a/Task/Permutations/VBA/permutations.vba +++ b/Task/Permutations/VBA/permutations.vba @@ -1,63 +1,81 @@ Public Sub Permute(n As Integer, Optional printem As Boolean = True) -'generate, count and print (if printem is not false) all permutations of first n integers +'Generate, count and print (if printem is not false) all permutations of first n integers Dim P() As Integer +Dim t As Integer, i As Integer, j As Integer, k As Integer Dim count As Long -dim Last as boolean -Dim t, i, j, k As Integer +Dim Last As Boolean If n <= 1 Then - Debug.Print "give a number greater than 1!" + + Debug.Print "Please give a number greater than 1" Exit Sub + End If -'initialize +'Initialize ReDim P(n) -For i = 1 To n: P(i) = i: Next + +For i = 1 To n + P(i) = i +Next + count = 0 Last = False Do While Not Last - 'print? - If printem Then - For t = 1 To n: Debug.Print P(t);: Next - Debug.Print - End If - count = count + 1 + 'print? + If printem Then + + For t = 1 To n + Debug.Print P(t); + Next + + Debug.Print - Last = True - i = n - 1 - Do While i > 0 - If P(i) < P(i + 1) Then - Last = False - Exit Do End If - i = i - 1 - Loop - If Not Last Then - j = i + 1 - k = n - While j < k - ' swap p(j) and p(k) - t = P(j) - P(j) = P(k) - P(k) = t - j = j + 1 - k = k - 1 - Wend - j = n - While P(j) > P(i) - j = j - 1 - Wend - j = j + 1 - 'swap p(i) and p(j) - t = P(i) - P(i) = P(j) - P(j) = t - End If 'not last +count = count + 1 -Loop 'while not last +Last = True +i = n - 1 + + Do While i > 0 + + If P(i) < P(i + 1) Then + + Last = False + Exit Do + + End If + + i = i - 1 + Loop + + j = i + 1 + k = n + + While j < k + ' Swap p(j) and p(k) + t = P(j) + P(j) = P(k) + P(k) = t + j = j + 1 + k = k - 1 + Wend + + j = n + + While P(j) > P(i) + j = j - 1 + Wend + + j = j + 1 + 'Swap p(i) and p(j) + t = P(i) + P(i) = P(j) + P(j) = t +Loop 'While not last Debug.Print "Number of permutations: "; count diff --git a/Task/Pernicious-numbers/00DESCRIPTION b/Task/Pernicious-numbers/00DESCRIPTION index acb086296a..36a04510dd 100644 --- a/Task/Pernicious-numbers/00DESCRIPTION +++ b/Task/Pernicious-numbers/00DESCRIPTION @@ -2,13 +2,19 @@ A   ''[[wp:Pernicious number|pernicious number]]''   is a positive int The   ''population count''   (also known as ''pop count'')   is the number of 1's  (ones) in the binary representation of a non-negative integer. -For example:     22   (which is   10110   in binary)   has a population count of   3   (which is prime), and therefore   22   is a pernicious number. + +;Example: +'''22'''   (which is   '''10110'''   in binary)   has a population count of   '''3'''   (which is prime),   and therefore +
    '''22'''   is a pernicious number. + '''Task requirements''' :* display the first   25   pernicious numbers. :* display all pernicious numbers between   888,888,877   and   888,888,888   (inclusive). :* display each list of integers on one line (which may or may not include a title).
    + ;See also * Sequence   [[oeis:A052294|A052294 pernicious numbers]] on The On-Line Encyclopedia of Integer Sequences. * Rosetta Code entry   [[Population_count|population count, evil numbers, odious numbers]]. +

    diff --git a/Task/Pernicious-numbers/360-Assembly/pernicious-numbers.360 b/Task/Pernicious-numbers/360-Assembly/pernicious-numbers.360 new file mode 100644 index 0000000000..392dd7735c --- /dev/null +++ b/Task/Pernicious-numbers/360-Assembly/pernicious-numbers.360 @@ -0,0 +1,126 @@ +* Pernicious numbers 04/05/2016 +PERNIC CSECT + USING PERNIC,R13 base register and savearea pointer +SAVEAREA B STM-SAVEAREA(R15) + DC 17F'0' +STM STM R14,R12,12(R13) save registers + ST R13,4(R15) link backward SA + ST R15,8(R13) link forward SA + LR R13,R15 establish addressability + SR R7,R7 n=0 + MVC PG,=CL80' ' clear buffer + LA R10,PG pgi + LA R6,1 i=1 +LOOPI1 C R7,=F'25' do i=1 while(n<25) + BNL ELOOPI1 + LR R1,R6 i + BAL R14,POPCOUNT + LR R1,R0 popcount(i) + BAL R14,ISPRIME + C R0,=F'1' if isprime(popcount(i))=1 + BNE NOTPRIM1 + XDECO R6,XDEC edit i + MVC 0(3,R10),XDEC+9 output i format I3 + LA R10,3(R10) pgi=pgi+3 + LA R7,1(R7) n=n+1 +NOTPRIM1 LA R6,1(R6) i=i+1 + B LOOPI1 +ELOOPI1 XPRNT PG,80 print buffer + MVC PG,=CL80' ' clear buffer + LA R10,PG pgi + L R6,=F'888888877' i=888888877 +LOOPI2 C R6,=F'888888888' do i to 888888888 + BH ELOOPI2 + LR R1,R6 i + BAL R14,POPCOUNT + LR R1,R0 popcount(i) + BAL R14,ISPRIME + C R0,=F'1' if isprime(popcount(i))=1 + BNE NOTPRIM2 + XDECO R6,XDEC edit i + MVC 0(10,R10),XDEC+2 output i format I10 + LA R10,10(R10) pgi=pgi+10 +NOTPRIM2 LA R6,1(R6) i=i+1 + B LOOPI2 +ELOOPI2 XPRNT PG,80 print buffer + L R13,4(0,R13) restore savearea pointer + LM R14,R12,12(R13) restore registers + XR R15,R15 return code = 0 + BR R14 -------------- end main +POPCOUNT CNOP 0,4 -------------- popcount(xx) [R8,R11] + ST R14,POPCOUSA save return address + ST R1,XX store argument + SR R11,R11 rr=0 + SR R8,R8 ii=0 +LOOPII C R8,=F'31' do ii=0 to 31 + BH ELOOPII + L R1,XX xx + LR R2,R8 ii + BAL R14,BTEST + C R0,=F'1' if btest(xx,ii)=1 + BNE NOTBTEST + LA R11,1(R11) rr=rr+1 +NOTBTEST LA R8,1(R8) ii=ii+1 + B LOOPII +ELOOPII LR R0,R11 return(rr) + L R14,POPCOUSA + BR R14 -------------- end popcount +ISPRIME CNOP 0,4 -------------- isprime(number) [R9] + ST R14,ISPRIMSA save return address + ST R1,NUMBER store argument + C R1,=F'2' if number=2 + BNE ELSE1 + MVC ISPRIMEX,=F'1' isprimex=1 + B ELOOPJJ +ELSE1 L R1,NUMBER + C R1,=F'2' if number<2 + BL EVEN + L R4,NUMBER + SRDA R4,32 + D R4,=F'2' mod(number,2) + C R4,=F'0' if mod(number,2)=0 + BNE ELSE2 +EVEN MVC ISPRIMEX,=F'0' isprimex=0 + B ELOOPJJ +ELSE2 MVC ISPRIMEX,=F'1' isprimex=1 + LA R9,3 jj=3 +LOOPJJ LR R5,R9 jj + MR R4,R9 jj*jj + C R5,NUMBER do jj=3 by 1 while jj*jj<=number + BH ELOOPJJ + L R4,NUMBER + SRDA R4,32 + DR R4,R9 mod(number,jj) + LTR R4,R4 if mod(number,jj)=0 + BNZ ITERJJ + MVC ISPRIMEX,=F'0' isprimex=0 + L R0,ISPRIMEX return(isprimex) + B ISPRIMRT +ITERJJ LA R9,1(R9) jj=jj+1 + B LOOPJJ +ELOOPJJ L R0,ISPRIMEX return(isprimex) +ISPRIMRT L R14,ISPRIMSA + BR R14 -------------- end isprime +BTEST CNOP 0,4 -------------- btest(word,n) [R0:R3] + LA R0,1 ok=1; return(1) if word(n)='1'b + LR R3,R2 i=n +LOOPB LTR R3,R3 if i=0 + BZ ELOOPB + SRL R1,1 Shift Right Logical + BCTR R3,0 i=i-1 + B LOOPB +ELOOPB STC R1,BTESTX x=word + TM BTESTX,B'00000001' if bit(word,n)='1'b + BO BTESTRET + LA R0,0 ok=0; return(0) if word(n)='0'b +BTESTRET BR R14 -------------- end btest +XX DS F paramter of popcount +NUMBER DS F paramter of isprime +ISPRIMEX DS F return value of isprime +BTESTX DS X byte to see in btest +POPCOUSA DS A return address of popcount +ISPRIMSA DS A return address of isprime +PG DS CL80 buffer +XDEC DS CL12 edit zone + YREGS + END PERNIC diff --git a/Task/Pernicious-numbers/ALGOL-68/pernicious-numbers.alg b/Task/Pernicious-numbers/ALGOL-68/pernicious-numbers.alg new file mode 100644 index 0000000000..cf232ec8c2 --- /dev/null +++ b/Task/Pernicious-numbers/ALGOL-68/pernicious-numbers.alg @@ -0,0 +1,47 @@ +# calculate various pernicious numbers # + +# returns the population (number of bits on) of the non-negative integer n # +PROC population = ( INT n )INT: + BEGIN + INT number := n; + INT result := 0; + WHILE number > 0 DO + IF ODD number THEN result +:= 1 FI; + number OVERAB 2 + OD; + result + END # population # ; + +# as we are dealing with 32 bit numbers, the maximum possible population is 32 # +# so we only need a table of whether the integers 0 : 32 are prime or not # +# we use the sieve of Eratosthenes... # +INT max number = 32; +[ 0 : max number ]BOOL is prime; +is prime[ 0 ] := FALSE; +is prime[ 1 ] := FALSE; +FOR i FROM 2 TO max number DO is prime[ i ] := TRUE OD; +FOR i FROM 2 TO ENTIER sqrt( max number ) DO + IF is prime[ i ] THEN FOR p FROM i * i BY i TO max number DO is prime[ p ] := FALSE OD FI +OD; + +# returns TRUE if n is pernicious, FALSE otherwise # +PROC is pernicious = ( INT n )BOOL: is prime[ population( n ) ]; + +# find the first 25 pernicious numbers, 0 and 1 are not pernicious # +INT pernicious count := 0; +FOR i FROM 2 WHILE pernicious count < 25 DO + IF is pernicious( i ) THEN + # found a pernicious number # + print( ( whole( i, 0 ), " " ) ); + pernicious count +:= 1 + FI +OD; +print( ( newline ) ); + +# find the pernicious numbers between 888 888 877 and 888 888 888 # +FOR i FROM 888 888 877 TO 888 888 888 DO + IF is pernicious( i ) THEN + print( ( whole( i, 0 ), " " ) ) + FI +OD; +print( ( newline ) ) diff --git a/Task/Pernicious-numbers/Clojure/pernicious-numbers.clj b/Task/Pernicious-numbers/Clojure/pernicious-numbers.clj new file mode 100644 index 0000000000..a0078a787e --- /dev/null +++ b/Task/Pernicious-numbers/Clojure/pernicious-numbers.clj @@ -0,0 +1,9 @@ +(defn counting-numbers + ([] (counting-numbers 1)) + ([n] (lazy-seq (cons n (counting-numbers (inc n)))))) +(defn divisors [n] (filter #(zero? (mod n %)) (range 1 (inc n)))) +(defn prime? [n] (= (divisors n) (list 1 n))) +(defn pernicious? [n] + (prime? (count (filter #(= % \1) (Integer/toString n 2))))) +(println (take 25 (filter pernicious? (counting-numbers)))) +(println (filter pernicious? (range 888888877 888888889))) diff --git a/Task/Pernicious-numbers/J/pernicious-numbers-1.j b/Task/Pernicious-numbers/J/pernicious-numbers-1.j index d58c5c2a2d..430b9e2a2b 100644 --- a/Task/Pernicious-numbers/J/pernicious-numbers-1.j +++ b/Task/Pernicious-numbers/J/pernicious-numbers-1.j @@ -1,3 +1 @@ ispernicious=: 1 p: +/"1@#: - -thru=: <./ + i.@(+*)@-~ diff --git a/Task/Pernicious-numbers/J/pernicious-numbers-2.j b/Task/Pernicious-numbers/J/pernicious-numbers-2.j index bfbba8a2fd..9c86c1f927 100644 --- a/Task/Pernicious-numbers/J/pernicious-numbers-2.j +++ b/Task/Pernicious-numbers/J/pernicious-numbers-2.j @@ -1,4 +1,6 @@ 25{.I.ispernicious i.100 3 5 6 7 9 10 11 12 13 14 17 18 19 20 21 22 24 25 26 28 31 33 34 35 36 + + thru=: <. + i.@(+*)@-~ 888888877 + I. ispernicious 888888877 thru 888888888 888888877 888888878 888888880 888888883 888888885 888888886 diff --git a/Task/Pernicious-numbers/Lua/pernicious-numbers.lua b/Task/Pernicious-numbers/Lua/pernicious-numbers.lua new file mode 100644 index 0000000000..a39bc8a613 --- /dev/null +++ b/Task/Pernicious-numbers/Lua/pernicious-numbers.lua @@ -0,0 +1,53 @@ +-- Test primality by trial division +function isPrime (x) + if x < 2 then return false end + if x < 4 then return true end + if x % 2 == 0 then return false end + for d = 3, math.sqrt(x), 2 do + if x % d == 0 then return false end + end + return true +end + +-- Take decimal number, return binary string +function dec2bin (n) + local bin, bit = "" + while n > 0 do + bit = n % 2 + n = math.floor(n / 2) + bin = bit .. bin + end + return bin +end + +-- Take decimal number, return population count as number +function popCount (n) + local bin, count = dec2bin(n), 0 + for pos = 1, bin:len() do + if bin:sub(pos, pos) == "1" then count = count + 1 end + end + return count +end + +-- Print pernicious numbers in range if two arguments provided, or +function pernicious (x, y) -- the first 'x' if only one argument. + if y then + for n = x, y do + if isPrime(popCount(n)) then io.write(n .. " ") end + end + else + local n, count = 0, 0 + while count < x do + if isPrime(popCount(n)) then + io.write(n .. " ") + count = count + 1 + end + n = n + 1 + end + end + print() +end + +-- Main procedure +pernicious(25) +pernicious(888888877, 888888888) diff --git a/Task/Pernicious-numbers/Pascal/pernicious-numbers.pascal b/Task/Pernicious-numbers/Pascal/pernicious-numbers.pascal index f29ee472d3..5fc7e5f9f4 100644 --- a/Task/Pernicious-numbers/Pascal/pernicious-numbers.pascal +++ b/Task/Pernicious-numbers/Pascal/pernicious-numbers.pascal @@ -19,6 +19,20 @@ const 1,0,0,0,0,0, 1,0,0,0,1,0,1,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,1,0, 1,0,0,0); +function n_beyond_k(n,k: NativeInt):Uint64; +var + i : NativeInt; +Begin + result := 1; + IF 2*k>= n then + k := n-k; + For i := 1 to k do + Begin + result := result *n DIV i; + dec(n); + end; +end; + function popcnt32(n:Uint32):NativeUint; //https://en.wikipedia.org/wiki/Hamming_weight#Efficient_implementation const @@ -35,31 +49,36 @@ begin end; var - t : TDAteTime; - i, + bit1cnt, k : LongWord; - + PernCnt : Uint64; Begin writeln('the 25 first pernicious numbers'); - I:=1;k:=0; + k:=1; + PernCnt:=0; repeat - IF PrimeTil64[popCnt32(i)] <> 0 then Begin - inc(k); write(i,' ');end; - inc(i); - until k >= 25; + IF PrimeTil64[popCnt32(k)] <> 0 then Begin + inc(PernCnt); write(k,' ');end; + inc(k); + until PernCnt >= 25; writeln; writeln('pernicious numbers in [888888877..888888888]'); - For i := 888888877 to 888888888 do - IF PrimeTil64[popCnt32(i)] <> 0 then - write(i,' '); - writeln; + For k := 888888877 to 888888888 do + IF PrimeTil64[popCnt32(k)] <> 0 then + write(k,' '); + writeln(#13#10); - //speedtest of popcount - t:= time; - k := 0; - For i := High(i) downto 0 do - k := k+PrimeTil64[popCnt32(i)]; - t := time-t; - writeln(k,' pernicious numbers in [0..2^32-1] takes ',t*86400:0:3,' seconds'); - end. + k := 8; + repeat + PernCnt := 0; + For bit1cnt := 0 to k do + Begin + //i == number of Bits set,n_beyond_k(k,i) == number of arrangements + IF PrimeTil64[bit1cnt] <> 0 then + inc(PernCnt,n_beyond_k(k,bit1cnt)); + end; + writeln(PernCnt,' pernicious numbers in [0..2^',k,'-1]'); + inc(k,k); + until k>64; +end. diff --git a/Task/Pernicious-numbers/PicoLisp/pernicious-numbers-1.l b/Task/Pernicious-numbers/PicoLisp/pernicious-numbers-1.l new file mode 100644 index 0000000000..d051381a1f --- /dev/null +++ b/Task/Pernicious-numbers/PicoLisp/pernicious-numbers-1.l @@ -0,0 +1,2 @@ +(de pernicious? (N) + (prime? (cnt = (chop (bin N)) '("1" .))) ) diff --git a/Task/Pernicious-numbers/PicoLisp/pernicious-numbers-2.l b/Task/Pernicious-numbers/PicoLisp/pernicious-numbers-2.l new file mode 100644 index 0000000000..b483e27244 --- /dev/null +++ b/Task/Pernicious-numbers/PicoLisp/pernicious-numbers-2.l @@ -0,0 +1,8 @@ +: (let N 0 + (do 25 + (until (pernicious? (inc 'N))) + (printsp N) ) ) +3 5 6 7 9 10 11 12 13 14 17 18 19 20 21 22 24 25 26 28 31 33 34 35 36 -> 36 + +: (filter pernicious? (range 888888877 888888888)) +-> (888888877 888888878 888888880 888888883 888888885 888888886) diff --git a/Task/Pernicious-numbers/PowerShell/pernicious-numbers.psh b/Task/Pernicious-numbers/PowerShell/pernicious-numbers.psh new file mode 100644 index 0000000000..422842c240 --- /dev/null +++ b/Task/Pernicious-numbers/PowerShell/pernicious-numbers.psh @@ -0,0 +1,28 @@ +function pop-count($n) { + (([Convert]::ToString($n, 2)).toCharArray() | where {$_ -eq '1'}).count +} + +function isPrime ($n) { + if ($n -eq 1) {$false} + elseif ($n -eq 2) {$true} + elseif ($n -eq 3) {$true} + else{ + $m = [Math]::Floor([Math]::Sqrt($n)) + (@(2..$m | where {($_ -lt $n) -and ($n % $_ -eq 0) }).Count -eq 0) + } +} + +$i = 0 +$num = 1 +$arr = while($i -lt 25) { + if((isPrime (pop-count $num))) { + $i++ + $num + } + $num++ +} +"first 25 pernicious numbers" +"$arr" +"" +"pernicious numbers between 888,888,877 and 888,888,888" +"$(888888877..888888888 | where{isprime(pop-count $_)})" diff --git a/Task/Pernicious-numbers/PureBasic/pernicious-numbers.purebasic b/Task/Pernicious-numbers/PureBasic/pernicious-numbers.purebasic new file mode 100644 index 0000000000..6c24c9c0e9 --- /dev/null +++ b/Task/Pernicious-numbers/PureBasic/pernicious-numbers.purebasic @@ -0,0 +1,61 @@ +EnableExplicit + +Procedure.i SumBinaryDigits(Number) + If Number < 0 : number = -number : EndIf; convert negative numbers to positive + Protected sum = 0 + While Number > 0 + sum + Number % 2 + Number / 2 + Wend + ProcedureReturn sum +EndProcedure + +Procedure.i IsPrime(Number) + If Number <= 1 + ProcedureReturn #False + ElseIf Number <= 3 + ProcedureReturn #True + ElseIf Number % 2 = 0 Or Number % 3 = 0 + ProcedureReturn #False + EndIf + Protected i = 5 + While i * i <= Number + If Number % i = 0 Or Number % (i + 2) = 0 + ProcedureReturn #False + EndIf + i + 6 + Wend + ProcedureReturn #True +EndProcedure + +Procedure.i IsPernicious(Number) + Protected popCount = SumBinaryDigits(Number) + ProcedureReturn Bool(IsPrime(popCount)) +EndProcedure + +Define n = 1, count = 0 +If OpenConsole() + PrintN("The following are the first 25 pernicious numbers :") + PrintN("") + Repeat + If IsPernicious(n) + Print(RSet(Str(n), 3)) + count + 1 + EndIf + n + 1 + Until count = 25 + PrintN("") + PrintN("") + PrintN("The pernicious numbers between 888,888,877 and 888,888,888 inclusive are : ") + PrintN("") + For n = 888888877 To 888888888 + If IsPernicious(n) + Print(RSet(Str(n), 10)) + EndIf + Next + PrintN("") + PrintN("") + PrintN("Press any key to close the console") + Repeat: Delay(10) : Until Inkey() <> "" + CloseConsole() +EndIf diff --git a/Task/Pernicious-numbers/REXX/pernicious-numbers.rexx b/Task/Pernicious-numbers/REXX/pernicious-numbers.rexx index ddd383d0f9..db31ab7b0b 100644 --- a/Task/Pernicious-numbers/REXX/pernicious-numbers.rexx +++ b/Task/Pernicious-numbers/REXX/pernicious-numbers.rexx @@ -1,31 +1,32 @@ -/*REXX program displays a number of pernicious numbers and also a range.*/ -numeric digits 30 /*be able to handle large numbers*/ -parse arg N L H . /*get optional arguments: N, L, H*/ -if N=='' | N==',' then N=25 /*N given? Then use the default.*/ -if L=='' | L==',' then L=888888877 /*L " ? " " " " */ -if H=='' | H==',' then H=888888888 /*H " ? " " " " */ -say 'The 1st ' N " pernicious numbers are:" /*display a nice title.*/ -say pernicious(1,,N) /*get all pernicious # from 1──►N*/ -say /*display a blank line for a sep.*/ -say 'Pernicious numbers between ' L " and " H ' (inclusive) are:' -say pernicious(L,H) /*get all pernicious # from L──►H*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────D2B subroutine──────────────────────*/ -d2b: return word(strip(x2b(d2x(arg(1))),'L',0) 0,1) /*convert dec──►bin*/ -/*──────────────────────────────────PERNICIOUS subroutine───────────────*/ -pernicious: procedure; parse arg bot,top,m /*get the bot & top #s, limit*/ -_ = 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 -!.=0; do k=1 until p=''; p=word(_,k); !.p=1; end /*gen low prime array*/ -if m=='' then m=999999999 /*assume an "infinite" limit. */ -if top=='' then top=999999999 /*assume an "infinite" top limit.*/ -#=0 /*number of pernicious #s so far.*/ -$=; do j=bot to top until #==m /*gen pernicious until satisfied.*/ - pc=popCount(j) /*obtain population count for J.*/ - if \!.pc then iterate /*if popCount ¬ in !.prime, skip.*/ - $=$ j /*append a pernicious # to list.*/ - #=#+1 /*bump the pernicious # count. */ - end /*j*/ /* [↑] append popCount to a list*/ -return substr($,2) /*return results, sans 1st blank.*/ -/*──────────────────────────────────POPCOUNT subroutine─────────────────*/ -popCount: procedure;_=d2b(abs(arg(1))) /*convert the # passed to binary.*/ -return length(_)-length(space(translate(_,,1),0)) /*count the one bits.*/ +/*REXX program computes and displays a number (and also a range) of pernicious numbers.*/ +numeric digits 100 /*be able to handle large numbers. */ +parse arg N L H . /*obtain optional arguments from the CL*/ +if N=='' | N==',' then N=25 /*N not given? Then use the default. */ +if L=='' | L==',' then L=888888877 /*L " " " " " " */ +if H=='' | H==',' then H=888888888 /*H " " " " " " */ +say 'The 1st ' N " pernicious numbers are:" /*display a nice title for the numbers.*/ +say pernicious(1,,N) /*get all pernicious # from 1 ─~─► N. */ +say /*display a blank line for a separator.*/ +say 'Pernicious numbers between ' L " and " H ' (inclusive) are:' +say pernicious(L,H) /*get all pernicious # from L ───► H. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +pernicious: procedure; parse arg bot,top,lim /*obtain the bot and top numbers, limit*/ + p='2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101' + @.=0 + do k=1 until _=='' /*examine the list of some low primes.*/ + _=word(p, k); @._=1 /*generate an array " " " " */ + end /*k*/ + $= /*list of pernicious numbers (so far). */ + if m=='' then m=999999999 /*Not given? Then use a gihugic limit.*/ + if top=='' then top=999999999 /* " " " " " " " */ + #=0 /*number of pernicious numbers (so far)*/ + do j=bot to top until #==lim /*generate pernicious #s 'til satisfied*/ + pc=popCount(j) /*obtain the population count for J. */ + if \@.pc then iterate /*if popCount not in @.prime, skip it.*/ + $=$ j /*append a pernicious number to list. */ + #=#+1 /*bump the pernicious number count. */ + end /*j*/ + return substr($, 2) /*return the results, sans 1st blank. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +popCount: return length( space( translate( x2b( d2x(arg(1))) +0,, 0), 0)) /*count 1's.*/ diff --git a/Task/Phrase-reversals/00DESCRIPTION b/Task/Phrase-reversals/00DESCRIPTION index 9edd77576a..4b4bd6bd1c 100644 --- a/Task/Phrase-reversals/00DESCRIPTION +++ b/Task/Phrase-reversals/00DESCRIPTION @@ -1,12 +1,15 @@ +;Task: Given a string of space separated words containing the following phrase: -:''"rosetta code phrase reversal"'' - -# Reverse the string. -# Reverse each individual word in the string, maintaining original string order. -# Reverse the order of each word of the phrase, maintaining the order of characters in each word. + rosetta code phrase reversal +:# Reverse the string. +:# Reverse each individual word in the string, maintaining original string order. +:# Reverse the order of each word of the phrase, maintaining the order of characters in each word. +
    Show your output here. + ;See also: * [[Reverse a string]] * [[Reverse words in a string]] +

    diff --git a/Task/Phrase-reversals/AppleScript/phrase-reversals.applescript b/Task/Phrase-reversals/AppleScript/phrase-reversals.applescript new file mode 100644 index 0000000000..8cf6c567bb --- /dev/null +++ b/Task/Phrase-reversals/AppleScript/phrase-reversals.applescript @@ -0,0 +1,71 @@ +-- _reverse :: [a] -> [a] +on _reverse(xs) + if class of xs is text then + (reverse of characters of xs) as text + else + reverse of xs + end if +end _reverse + + +-- TEST + +on run {} + set phrase to "rosetta code phrase reversal" + + unlines({¬ + _reverse(phrase), ¬ + unwords(map(_reverse, _words(phrase))), ¬ + unwords(_reverse(_words(phrase)))}) +end run + + + +-- GENERIC FUNCTIONS + +-- 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 + +-- intercalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate + +-- _words :: String -> [String] +on _words(str) + words of str +end _words + +-- unlines :: [String] -> String +on unlines(lstLines) + intercalate(linefeed, lstLines) +end unlines + +-- unwords :: [String] -> String +on unwords(lstWords) + intercalate(space, lstWords) +end unwords + +-- 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 diff --git a/Task/Phrase-reversals/C-sharp/phrase-reversals.cs b/Task/Phrase-reversals/C-sharp/phrase-reversals.cs new file mode 100644 index 0000000000..21f4f72c66 --- /dev/null +++ b/Task/Phrase-reversals/C-sharp/phrase-reversals.cs @@ -0,0 +1,22 @@ +using System; +using System.Linq; +namespace ConsoleApplication +{ + class Program + { + static void Main(string[] args) + { + //Reverse() is an extension method on IEnumerable. + //The constructor takes a char[], so we have to call ToArray() + Func reverse = s => new string(s.Reverse().ToArray()); + + string phrase = "rosetta code phrase reversal"; + //Reverse the string + Console.WriteLine(reverse(phrase)); + //Reverse each individual word in the string, maintaining original string order. + Console.WriteLine(string.Join(" ", phrase.Split(' ').Select(word => reverse(word)))); + //Reverse the order of each word of the phrase, maintaining the order of characters in each word. + Console.WriteLine(string.Join(" ", phrase.Split(' ').Reverse())); + } + } +} diff --git a/Task/Phrase-reversals/COBOL/phrase-reversals.cobol b/Task/Phrase-reversals/COBOL/phrase-reversals.cobol new file mode 100644 index 0000000000..b6755b6cf0 --- /dev/null +++ b/Task/Phrase-reversals/COBOL/phrase-reversals.cobol @@ -0,0 +1,35 @@ + program-id. phra-rev. + data division. + working-storage section. + 1 phrase pic x(28) value "rosetta code phrase reversal". + 1 wk-str pic x(16). + 1 binary. + 2 phrase-len pic 9(4). + 2 pos pic 9(4). + 2 cnt pic 9(4). + procedure division. + compute phrase-len = function length (phrase) + display phrase + display function reverse (phrase) + perform display-words + move function reverse (phrase) to phrase + perform display-words + stop run + . + + display-words. + move 1 to pos + perform until pos > phrase-len + unstring phrase delimited space + into wk-str count in cnt + with pointer pos + end-unstring + display function reverse (wk-str (1:cnt)) + with no advancing + if pos < phrase-len + display space with no advancing + end-if + end-perform + display space + . + end program phra-rev. diff --git a/Task/Phrase-reversals/Common-Lisp/phrase-reversals.lisp b/Task/Phrase-reversals/Common-Lisp/phrase-reversals.lisp new file mode 100644 index 0000000000..dbeced746b --- /dev/null +++ b/Task/Phrase-reversals/Common-Lisp/phrase-reversals.lisp @@ -0,0 +1,16 @@ +(defun split-string (str) + "Split a string into space separated words including spaces" + (do* ((lst nil) + (i (position-if #'alphanumericp str) (position-if #'alphanumericp str :start j)) + (j (when i (position #\Space str :start i)) (when i (position #\Space str :start i))) ) + ((null j) (nreverse (push (subseq str i nil) lst))) + (push (subseq str i j) lst) + (push " " lst) )) + + +(defun task (str) + (print (reverse str)) + (let ((lst (split-string str))) + (print (apply #'concatenate 'string (mapcar #'reverse lst))) + (print (apply #'concatenate 'string (reverse lst))) ) + nil ) diff --git a/Task/Phrase-reversals/Fortran/phrase-reversals-1.f b/Task/Phrase-reversals/Fortran/phrase-reversals-1.f new file mode 100644 index 0000000000..ee903ce178 --- /dev/null +++ b/Task/Phrase-reversals/Fortran/phrase-reversals-1.f @@ -0,0 +1,3 @@ + DO WHILE (L1.LE.L .AND. ATXT(L1).LE." ") + L1 = L1 + 1 + END DO diff --git a/Task/Phrase-reversals/Fortran/phrase-reversals-2.f b/Task/Phrase-reversals/Fortran/phrase-reversals-2.f new file mode 100644 index 0000000000..89be7894e3 --- /dev/null +++ b/Task/Phrase-reversals/Fortran/phrase-reversals-2.f @@ -0,0 +1,3 @@ + DO L1 = L1,L + IF (ATXT(L1).GT." ") EXIT + END DO diff --git a/Task/Phrase-reversals/Fortran/phrase-reversals-3.f b/Task/Phrase-reversals/Fortran/phrase-reversals-3.f new file mode 100644 index 0000000000..724a77f5c5 --- /dev/null +++ b/Task/Phrase-reversals/Fortran/phrase-reversals-3.f @@ -0,0 +1,41 @@ + PROGRAM REVERSER !Just fooling around. + CHARACTER*(66) TEXT !Holds the text. Easily long enough. + CHARACTER*1 ATXT(66) !But this is what I play with. + EQUIVALENCE (TEXT,ATXT) !Same storage, different access abilities.. + DATA TEXT/"Rosetta Code Phrase Reversal"/ !Easier to specify this for TEXT. + INTEGER IST(6),LST(6) !Start and stop positions. + INTEGER N,L,I !Counters. + INTEGER L1,L2 !Fingers for the scan. + CHARACTER*(*) AS,RW,FW,RO,FO !Now for some cramming. + PARAMETER (AS = "Words ordered as supplied") !So that some statements can fit on a line. + PARAMETER (RW = "Reversed words, ", FW = "Forward words, ") + PARAMETER (RO = "reverse order", FO = "forward order") + +Chop the text into words. + N = 0 !No words found. + L = LEN(TEXT) !Multiple trailing spaces - no worries. + L2 = 0 !Syncopation: where the previous chomp ended. + 10 L1 = L2 !Thus, where a fresh scan should follow. + 11 L1 = L1 + 1 !Advance one. + IF (L1.GT.L) GO TO 20 !Finished yet? + IF (ATXT(L1).LE." ") GO TO 11 !No. Skip leading spaces. + L2 = L1 !Righto, L1 is the first non-blank. + 12 L2 = L2 + 1 !Scan through the non-blanks. + IF (L2.GT.L) GO TO 13 !Is it safe to look? + IF (ATXT(L2).GT." ") GO TO 12 !Yes. Speed through non-blanks. + 13 N = N + 1 !Righto, a word is found in TEXT(L1:L2 - 1) + IST(N) = L1 !So, recall its first character. + LST(N) = L2 - 1 !And its last. + IF (L2.LT.L) GO TO 10 !Perhaps more text follows. + +Chuck the words around. + 20 WRITE (6,21) N,TEXT !First, say what has been discovered. + 21 FORMAT (I4," words have been isolated from the text ",A,/) + + WRITE (6,22) AS, (" ",ATXT(IST(I):LST(I):+1), I = 1,N,+1) + WRITE (6,22) RW//RO,(" ",ATXT(LST(I):IST(I):-1), I = N,1,-1) + WRITE (6,22) FW//RO,(" ",ATXT(IST(I):LST(I):+1), I = N,1,-1) + WRITE (6,22) RW//FO,(" ",ATXT(LST(I):IST(I):-1), I = 1,N,+1) + + 22 FORMAT (A36,":",66A1) + END diff --git a/Task/Phrase-reversals/Fortran/phrase-reversals-4.f b/Task/Phrase-reversals/Fortran/phrase-reversals-4.f new file mode 100644 index 0000000000..02237d83e2 --- /dev/null +++ b/Task/Phrase-reversals/Fortran/phrase-reversals-4.f @@ -0,0 +1 @@ + WRITE (6,22) RW//RO,(" ",(ATXT(J), J = LST(I),IST(I),-1), I = 1,N,+1) diff --git a/Task/Phrase-reversals/Lua/phrase-reversals.lua b/Task/Phrase-reversals/Lua/phrase-reversals.lua new file mode 100644 index 0000000000..0769acbf2b --- /dev/null +++ b/Task/Phrase-reversals/Lua/phrase-reversals.lua @@ -0,0 +1,27 @@ +-- Return a copy of table t in which each string is reversed +function reverseEach (t) + local rev = {} + for k, v in pairs(t) do rev[k] = v:reverse() end + return rev +end + +-- Return a reversed copy of table t +function tabReverse (t) + local revTab = {} + for i, v in ipairs(t) do revTab[#t - i + 1] = v end + return revTab +end + +-- Split string str into a table on space characters +function wordSplit (str) + local t = {} + for word in str:gmatch("%S+") do table.insert(t, word) end + return t +end + +-- Main procedure +local str = "rosetta code phrase reversal" +local tab = wordSplit(str) +print("1. " .. str:reverse()) +print("2. " .. table.concat(reverseEach(tab), " ")) +print("3. " .. table.concat(tabReverse(tab), " ")) diff --git a/Task/Phrase-reversals/PicoLisp/phrase-reversals.l b/Task/Phrase-reversals/PicoLisp/phrase-reversals.l new file mode 100644 index 0000000000..53b616edcf --- /dev/null +++ b/Task/Phrase-reversals/PicoLisp/phrase-reversals.l @@ -0,0 +1,4 @@ +(let (S (chop "rosetta code phrase reversal") L (split S " ")) + (prinl (reverse S)) + (prinl (glue " " (mapcar reverse L))) + (prinl (glue " " (reverse L))) ) diff --git a/Task/Phrase-reversals/REXX/phrase-reversals-2.rexx b/Task/Phrase-reversals/REXX/phrase-reversals-2.rexx index 8c1c87dbe6..caa43be103 100644 --- a/Task/Phrase-reversals/REXX/phrase-reversals-2.rexx +++ b/Task/Phrase-reversals/REXX/phrase-reversals-2.rexx @@ -1,9 +1,13 @@ -/*REXX pgm reverses words and/or letters in a string in various ways. */ -i=; p=; parse arg $; if $='' then $="rosetta code phrase reversal" - do j=1 for words($); _=word($,j) - i=i reverse(_) ; p=_ p - end /*j*/ -say ' the original phrase used: ' $ -say ' original phrase reversed: ' reverse($) -say 'reversed individual words: ' strip(i) -say 'reversed words in phrases: ' p /*stick a fork in it, we're done.*/ +/*REXX program reverses words and/or letters in a string in various (several) ways.*/ +parse arg $ /*obtain optional arguments from the CL*/ +if $='' then $= "rosetta code phrase reversal" /*Not specified? Then use the default.*/ +L=; W= /*initialize two REXX variables to null*/ + do j=1 for words($); _=word($, j) /*extract each word in the $ string. */ + L=L reverse(_) /*reverse the letters in a word. */ + W=_ W /*reverse the words in the string. */ + end /*j*/ + /*display some results to the terminal.*/ +say ' the original phrase used: ' $ +say ' original phrase reversed: ' reverse($) +say ' reversed individual words: ' strip(L) +say ' reversed words in phrases: ' W /*stick a fork in it, we're all done. */ diff --git a/Task/Pi/00DESCRIPTION b/Task/Pi/00DESCRIPTION index 0868eb8920..db0a127f15 100644 --- a/Task/Pi/00DESCRIPTION +++ b/Task/Pi/00DESCRIPTION @@ -1,6 +1,14 @@ -Create a program to continually calculate and output the next digit of \pi (pi). The program should continue forever (until it is aborted by the user) calculating and outputting each digit in succession. The output should be a decimal sequence beginning 3.14159265 ... +[[File:pi_symbol.jpg|500px||right]] + +Create a program to continually calculate and output the next decimal digit of   \pi   (pi). + +The program should continue forever (until it is aborted by the user) calculating and outputting each decimal digit in succession. + +The output should be a decimal sequence beginning   3.14159265 ... -Note: this task is about calculating pi. For information on built-in pi constants see [[Real constants and functions]]. +Note: this task is about   ''calculating''   pi.   For information on built-in pi constants see [[Real constants and functions]]. + Related Task [[Arithmetic-geometric mean/Calculate Pi]] +

    diff --git a/Task/Pi/360-Assembly/pi.360 b/Task/Pi/360-Assembly/pi.360 new file mode 100644 index 0000000000..ecd7e90386 --- /dev/null +++ b/Task/Pi/360-Assembly/pi.360 @@ -0,0 +1,104 @@ +* Spigot algorithm do the digits of PI 02/07/2016 +PISPIG CSECT + USING PISPIG,R13 base register + B 72(R15) skip savearea + DC 17F'0' savearea + STM R14,R12,12(R13) prolog + ST R13,4(R15) " + ST R15,8(R13) " + LR R13,R15 " + SR R0,R0 0 + ST R0,MORE more=0 + LA R6,1 i=1 +LOOPI1 C R6,=A(NBUF) do i=1 to hbound(buf) + BH ELOOPI1 " + SR R9,R9 karray=0 + L R7,=A(NVECT) j=hbound(vect) + LR R1,R7 j + SLA R1,2 . + LA R10,VECT-4(R1) r10=@vect(j) +LOOPJ EQU * do j=hbound(vect) to 1 by -1 + L R5,=F'100000' 100000 + M R4,0(R10) *vect(j) + LR R2,R5 r2=100000*vect(j) + LR R5,R9 karray + MR R4,R7 karray*j + AR R2,R5 r2+karray*j + LR R11,R2 n=100000*vect(j)+karray*j + LR R3,R7 j + SLA R3,1 2*j + BCTR R3,0 2*j-1) + LR R4,R11 n + SRDA R4,32 . + DR R4,R3 n/(2*j-1) + LR R9,R5 karray=n/(2*j-1) + LR R5,R9 karray + MR R4,R3 karray*(2*j-1) + LR R1,R11 n + SR R1,R5 n-karray*(2*j-1) + ST R1,0(R10) vect(j)=n-karray*(2*j-1) + SH R10,=H'4' r10=@vect(j) + BCT R7,LOOPJ end do j + LR R4,R9 karray + SRDA R4,32 . + D R4,=F'100000' karray/100000 + LR R11,R5 k=karray/100000 + L R2,MORE more + AR R2,R11 +k + LR R1,R6 i + SLA R1,2 . + ST R2,BUF-4(R1) buf(i)=more+k + LR R5,R11 k + M R4,=F'100000' *100000 + LR R1,R9 karray + SR R1,R5 -k*100000 + ST R1,MORE more=karray-k*100000 + LA R6,1(R6) i=i+1 + B LOOPI1 end do i +ELOOPI1 L R1,BUF buf(1) + CVD R1,PACKED convert buf(1) to packed decimal + OI PACKED+7,X'0F' prepare unpack + UNPK PG(1),PACKED packed decimal to zoned printable + MVI PG+1,C'.' output '.' + XPRNT PG,80 print buffer + MVC PG,=CL80' ' clear buffer + LA R3,PG pgi=0 + LA R6,2 i=2 +LOOPI2 C R6,=A(NBUF) do i=2 to hbound(buf) + BH ELOOPI2 " + MVC 0(1,R3),=C' ' output ' ' + LA R3,1(R3) pgi=pgi+1 + LR R1,R6 i + SLA R1,2 . + L R2,BUF-4(R1) buf(i) + CVD R2,PACKED convert v to packed decimal + OI PACKED+7,X'0F' prepare unpack + UNPK XDEC,PACKED packed decimal to zoned printable + MVC 0(5,R3),XDEC+7 output buf(i) with 5 decimals + LA R3,5(R3) pgi=pgi+5 + LR R4,R6 i + BCTR R4,0 i-1 + SRDA R4,32 . + D R4,=F'10' (i-1)/10 + LTR R4,R4 if (i-1)//10=0 + BNZ NOSKIP then + XPRNT PG,80 print buffer + LA R3,PG pgi=0 + MVC PG,=CL80' ' clear buffer +NOSKIP LA R6,1(R6) i=i+1 + B LOOPI2 end do i +ELOOPI2 L R13,4(0,R13) epilog + LM R14,R12,12(R13) " + XR R15,R15 " + BR R14 exit + LTORG +MORE DS F more +PACKED DS 0D,PL8 packed decimal +PG DC CL80' ' buffer +XDEC DS CL12 temp +BUF DC (NBUF)F'0' buf(nbuf) +VECT DC (NVECT)F'2' vect(nvect) init 2 + YREGS +NBUF EQU 201 number of 5 decimals +NVECT EQU 3350 nvect=ceil(nbuf*50/3) + END PISPIG diff --git a/Task/Pi/Clojure/pi.clj b/Task/Pi/Clojure/pi.clj new file mode 100644 index 0000000000..1634692cbf --- /dev/null +++ b/Task/Pi/Clojure/pi.clj @@ -0,0 +1,38 @@ +(ns pidigits + (:gen-class)) + +(def calc-pi + ; integer division rounding downwards to -infinity + (let [div (fn [x y] (long (Math/floor (/ x y)))) + + ; Computations performed after yield clause in Python code + update-after-yield (fn [[q r t k n l]] + (let [nr (* 10 (- r (* n t))) + nn (- (div (* 10 (+ (* 3 q) r)) t) (* 10 n)) + nq (* 10 q)] + [nq nr t k nn l])) + + ; Update of else clause in Python code: if (< (- (+ (* 4 q) r) t) (* n t)) + update-else (fn [[q r t k n l]] + (let [nr (* (+ (* 2 q) r) l) + nn (div (+ (* q 7 k) 2 (* r l)) (* t l)) + nq (* k q) + nt (* l t) + nl (+ 2 l) + nk (+ 1 k)] + [nq nr nt nk nn nl])) + + ; Compute the lazy sequence of pi digits translating the Python code + pi-from (fn pi-from [[q r t k n l]] + (if (< (- (+ (* 4 q) r) t) (* n t)) + (lazy-seq (cons n (pi-from (update-after-yield [q r t k n l])))) + (recur (update-else [q r t k n l]))))] + + ; Use Clojure big numbers to perform the math (avoid integer overflow) + (pi-from [1N 0N 1N 1N 3N 3N]))) + +;; Indefinitely Output digits of pi, with 40 characters per line +(doseq [[i q] (map-indexed vector calc-pi)] + (when (= (mod i 40) 0) + (println)) + (print q)) diff --git a/Task/Pi/Fortran/pi-1.f b/Task/Pi/Fortran/pi-1.f new file mode 100644 index 0000000000..c6c54d9fd0 --- /dev/null +++ b/Task/Pi/Fortran/pi-1.f @@ -0,0 +1,15 @@ +Coded by Stanley Rabinowitz, 12 Vine Brook Road, Westford MA, 01886-4212. + INTEGER VECT(3350),BUFFER(201) + DATA VECT/3350*2/,MORE/0/ + DO 2 N = 1,201 + KARRAY = 0 + DO 3 L = 3350,1,-1 + NUM = 100000*VECT(L) + KARRAY*L + KARRAY = NUM/(2*L - 1) + 3 VECT(L) = NUM - KARRAY*(2*L - 1) + K = KARRAY/100000 + BUFFER(N) = MORE + K + 2 MORE = KARRAY - K*100000 + WRITE (*,100) BUFFER + 100 FORMAT (I2,"."/(1X,10I5.5)) + END diff --git a/Task/Pi/Fortran/pi-2.f b/Task/Pi/Fortran/pi-2.f new file mode 100644 index 0000000000..a248c57e69 --- /dev/null +++ b/Task/Pi/Fortran/pi-2.f @@ -0,0 +1,48 @@ +!================================================ + program pi_spigot_unbounded +!================================================ + do + call print_next_pi_digit() + end do + + contains + +!------------------------------------------------ + subroutine print_next_pi_digit() +!------------------------------------------------ + use fmzm + type (im) :: q, r, t, k, n, l, nr + logical :: dot=.false., init=.false. + save :: q, r, t, k, n, l + if (.not.init) then + q=to_im(1) + r=to_im(0) + t=to_im(1) + k=to_im(1) + n=to_im(3) + l=to_im(3) + init=.true. + end if + if (4*q+r-t < n*t) then + write(6,fmt='(i1)',advance='no') to_int(n) + if (.not.dot) then + write(6,fmt='(a1)',advance='no') '.' + dot=.true. + end if + flush(6) + nr = 10 * ( r - n*t ) + n = 10 * ( (3*q + r) / t - n ) + q = 10 * q + r = nr + else + nr = (2*q + r) * l + n = ( (q * (7*k + 2) + r*l) / (t*l) ) + q = q * k + t = t * l + l = l + 2 + k = k + 1 + r = nr + end if + end subroutine + + end program diff --git a/Task/Pi/JavaScript/pi.js b/Task/Pi/JavaScript/pi.js new file mode 100644 index 0000000000..12c0e7cb3c --- /dev/null +++ b/Task/Pi/JavaScript/pi.js @@ -0,0 +1,14 @@ +var calcPi = function() { + var n = 20000; + var pi = 0; + for (var i = 0; i < n; i++) { + var temp = 4 / (i*2+1); + if (i % 2 == 0) { + pi += temp; + } + else { + pi -= temp; + } + } + return pi; +} diff --git a/Task/Pi/Perl/pi-3.pl b/Task/Pi/Perl/pi-3.pl index 57b9ddf467..10e6136a8b 100644 --- a/Task/Pi/Perl/pi-3.pl +++ b/Task/Pi/Perl/pi-3.pl @@ -1,4 +1,4 @@ -use bigint try=>"GMP" +use bigint try=>"GMP"; # Pi/4 = 4 arctan 1/5 - arctan 1/239 # expanding it with Taylor series with what's probably the dumbest method diff --git a/Task/Pi/REXX/pi.rexx b/Task/Pi/REXX/pi.rexx index b06c2c3401..bfd0a0e154 100644 --- a/Task/Pi/REXX/pi.rexx +++ b/Task/Pi/REXX/pi.rexx @@ -1,23 +1,23 @@ -/*REXX program spits out digits of π (pi) (one at a time) until Ctrl-Break.*/ -parse arg digs . /*obtain optional argument from the CL.*/ -if digs=='' | digs=="," then digs=1e6 /*Not specified? Then use one million.*/ -fn = 'PI_DIGITS.OUT' /*fileID used for output: the π digits.*/ -numeric digits digs /*with bigger digs, spitting is slower.*/ -call time 'Reset' /*reset the wall-clock (elapsed) timer.*/ -signal on halt /*───► HALT when Ctrl─Break is pressed.*/ -pi=0; s=16; r=4; v=5; vv=v*v; g=239; gg=g*g; spit=0; old= - - do n=1 by 2 /*calculate π with increasing accuracy */ - pi=pi + s/(n*v) - r/(n*g) /* ··· using John Machin's formula.*/ - if pi==old then leave /*have we exceeded the DIGITS accuracy?*/ - s=-s; r=-r; v=v*vv; g=g*gg /*compute some variables for shortcuts.*/ - do j=spit+1 to compare(pi,old) /*spit out some (new) digits of π (pi)*/ - parse var pi =(j) spit +1 /*equivalent to: spit=substr(pi,j,1) */ - call charout ,spit /*display one (new) decimal digit of π.*/ - call charout fn,spit /*··· and also write π digit to a file.*/ - end /*j*/ /* [↑] 0, 1, or 2 decimal dig are spit*/ - spit=j-1 /*adjust for DO loop index increment.*/ - old=pi /*use "OLD" value for the next COMPARE.*/ - end /*n*/ -say /*stick a fork in it, we're all done. */ -halt: say n%2+1 'iterations took' format(time("Elapsed"),,2) 'seconds.' +/*REXX program spits out decimal digits of pi (one digit at a time) until Ctrl-Break.*/ +parse arg digs oFID . /*obtain optional argument from the CL.*/ +if digs=='' | digs=="," then digs=1e6 /*Not specified? Then use the default.*/ +if oFID=='' | oFID=="," then oFID='PI_SPIT.OUT' /* " " " " " " */ +numeric digits digs /*with bigger digs, spitting is slower.*/ +call time 'Reset' /*reset the wall─clock (elapsed) timer.*/ +signal on halt /*───► HALT when Ctrl─Break is pressed.*/ +pi=0; v=5; vv=v*v; g=239; gg=g*g; spit=0 /*assign some values to some variables.*/ +s=16 /*calculate π with increasing accuracy */ +r=4; do n=1 by 2 until old=pi; old=pi /*just calculate pi with odd integers*/ + pi=pi + s/(n*v) - r/(n*g) /* ··· using John Machin's formula.*/ + if pi==old then leave /*have we exceeded the DIGITS accuracy?*/ + s=-s; r=-r; v=v*vv; g=g*gg /*compute some variables for shortcuts.*/ + do j=spit+1 to compare(pi,old) /*spit out some (new) digits of π (pi)*/ + parse var pi =(j) spit +1 /*equivalent to: spit=substr(pi,j,1) */ + call charout ,spit /*display one (new) decimal digit of π.*/ + call charout oFID,spit /*··· and also write π digit to a file.*/ + end /*j*/ /* [↑] 0, 1, or 2 decimal dig are spit*/ + spit=j-1 /*adjust for DO loop index increment.*/ + end /*n*/ +say /*stick a fork in it, we're all done. */ +exit: say; say n%2+1 'iterations took' format(time("Elapsed"),,2) 'seconds.'; exit +halt: say; say 'PI_SPIT halted via use of Ctrl-Break.'; signal exit /*show iterations.*/ diff --git a/Task/Pick-random-element/AWK/pick-random-element.awk b/Task/Pick-random-element/AWK/pick-random-element.awk new file mode 100644 index 0000000000..f6ab43af57 --- /dev/null +++ b/Task/Pick-random-element/AWK/pick-random-element.awk @@ -0,0 +1,8 @@ +# syntax: GAWK -f PICK_RANDOM_ELEMENT.AWK +BEGIN { + n = split("Monday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday",day_of_week,",") + srand() + x = int(n*rand()) + 1 + printf("%s\n",day_of_week[x]) + exit(0) +} diff --git a/Task/Pick-random-element/Elena/pick-random-element.elena b/Task/Pick-random-element/Elena/pick-random-element.elena new file mode 100644 index 0000000000..94068179ce --- /dev/null +++ b/Task/Pick-random-element/Elena/pick-random-element.elena @@ -0,0 +1,15 @@ +#import system. +#import extensions. + +#class(extension)listOp +{ + #method randomItem + = self @ (randomGenerator eval:(self length)). +} + +#symbol program = +[ + #var item := (0, 1, 2, 3, 4, 5, 6, 7, 8, 9). + + console writeLine:"I picked element ":(item randomItem). +]. diff --git a/Task/Pick-random-element/Elixir/pick-random-element.elixir b/Task/Pick-random-element/Elixir/pick-random-element.elixir index eca6382f5b..5dc3ce9cac 100644 --- a/Task/Pick-random-element/Elixir/pick-random-element.elixir +++ b/Task/Pick-random-element/Elixir/pick-random-element.elixir @@ -1,12 +1,6 @@ -defmodule Random do - def init do - :random.seed(:erlang.now) - end - def pick_element(list) do - Enum.at(list, :random.uniform(length(list)) - 1) - end -end - -Random.init -list = Enum.to_list(1..20) -IO.puts Random.pick_element(list) +iex(1)> list = Enum.to_list(1..20) +[1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20] +iex(2)> Enum.random(list) +19 +iex(3)> Enum.take_random(list,4) +[19, 20, 7, 15] diff --git a/Task/Pick-random-element/GAP/pick-random-element.gap b/Task/Pick-random-element/GAP/pick-random-element-1.gap similarity index 100% rename from Task/Pick-random-element/GAP/pick-random-element.gap rename to Task/Pick-random-element/GAP/pick-random-element-1.gap diff --git a/Task/Pick-random-element/GAP/pick-random-element-2.gap b/Task/Pick-random-element/GAP/pick-random-element-2.gap new file mode 100644 index 0000000000..b3195f38c6 --- /dev/null +++ b/Task/Pick-random-element/GAP/pick-random-element-2.gap @@ -0,0 +1,3 @@ +Random(SymmetricGroup(20)); + +(1,4,8,2)(3,12)(5,14,10,18,17,7,16)(9,13)(11,15,20,19) diff --git a/Task/Pick-random-element/Groovy/pick-random-element.groovy b/Task/Pick-random-element/Groovy/pick-random-element-1.groovy similarity index 100% rename from Task/Pick-random-element/Groovy/pick-random-element.groovy rename to Task/Pick-random-element/Groovy/pick-random-element-1.groovy diff --git a/Task/Pick-random-element/Groovy/pick-random-element-2.groovy b/Task/Pick-random-element/Groovy/pick-random-element-2.groovy new file mode 100644 index 0000000000..88f494dbf7 --- /dev/null +++ b/Task/Pick-random-element/Groovy/pick-random-element-2.groovy @@ -0,0 +1 @@ +[25, 30, 1, 450, 3, 78].sort{new Random()}?.take(1)[0] diff --git a/Task/Pick-random-element/Haskell/pick-random-element-1.hs b/Task/Pick-random-element/Haskell/pick-random-element-1.hs index 0e2f1337d7..8f5cd09c30 100644 --- a/Task/Pick-random-element/Haskell/pick-random-element-1.hs +++ b/Task/Pick-random-element/Haskell/pick-random-element-1.hs @@ -1,6 +1,6 @@ -import Random (randomRIO) +import System.Random (randomRIO) pick :: [a] -> IO a -pick xs = randomRIO (0, length xs - 1) >>= return . (xs !!) +pick xs = fmap (xs !!) $ randomRIO (0, length xs - 1) x <- pick [1 2 3] diff --git a/Task/Pick-random-element/Julia/pick-random-element.julia b/Task/Pick-random-element/Julia/pick-random-element.julia index 57cc330423..2f83ebe1f9 100644 --- a/Task/Pick-random-element/Julia/pick-random-element.julia +++ b/Task/Pick-random-element/Julia/pick-random-element.julia @@ -1,2 +1,2 @@ array = [1,2,3] -array[rand(1:length(array))] +rand(array) diff --git a/Task/Pick-random-element/Maple/pick-random-element.maple b/Task/Pick-random-element/Maple/pick-random-element.maple new file mode 100644 index 0000000000..53b6627a30 --- /dev/null +++ b/Task/Pick-random-element/Maple/pick-random-element.maple @@ -0,0 +1,3 @@ +a := [bear, giraffe, dog, rabbit, koala, lion, fox, deer, pony]: +randomNum := rand(1 ..numelems(a)): +a[randomNum()]; diff --git a/Task/Pick-random-element/Perl-6/pick-random-element-3.pl6 b/Task/Pick-random-element/Perl-6/pick-random-element-3.pl6 index ebdf90d652..99da7334f3 100644 --- a/Task/Pick-random-element/Perl-6/pick-random-element-3.pl6 +++ b/Task/Pick-random-element/Perl-6/pick-random-element-3.pl6 @@ -1,5 +1,5 @@ # define the deck -constant deck = 2..9, X~ <♠ ♣ ♥ ♦>; -deck.pick; # Pick a card -deck.pick(5); # Draw 5 -deck.pick(*); # Get a shuffled deck +my @deck = <2 3 4 5 6 7 8 9 J Q K A> X~ <♠ ♣ ♥ ♦>; +@deck.pick; # Pick a card +@deck.pick(5); # Draw 5 +@deck.pick(*); # Get a shuffled deck diff --git a/Task/Pig-the-dice-game-Player/00DESCRIPTION b/Task/Pig-the-dice-game-Player/00DESCRIPTION index c54b0904ba..1cd0c8536c 100644 --- a/Task/Pig-the-dice-game-Player/00DESCRIPTION +++ b/Task/Pig-the-dice-game-Player/00DESCRIPTION @@ -1,11 +1,13 @@ -__FORCETOC__ -The task is to create a dice simulator and scorer of [[Pig the dice game]] and add to it the ability to play the game to at least one strategy. +;Task: +Create a dice simulator and scorer of [[Pig the dice game]] and add to it the ability to play the game to at least one strategy. * State here the play strategies involved. * Show play during a game here. + As a stretch goal: * Simulate playing the game a number of times with two players of given strategies and report here summary statistics such as, but not restricted to, the influence of going first or which strategy seems stronger. + ;Game Rules: The game of Pig is a multiplayer game played with a single six-sided die. The object of the game is to reach 100 points or more. @@ -14,5 +16,7 @@ Play is taken in turns. On each person's turn that person has the option of eith # '''Rolling the dice''': where a roll of two to six is added to their score for that turn and the player's turn continues as the player is given the same choice again; or a roll of 1 loses the player's total points ''for that turn'' and their turn finishes with play passing to the next player. # '''Holding''': The player's score for that round is added to their total and becomes safe from the effects of throwing a one. The player's turn finishes with play passing to the next player. + ;Reference * [[wp:Pig (dice)|Pig (dice)]] +

    diff --git a/Task/Pig-the-dice-game-Player/Racket/pig-the-dice-game-player.rkt b/Task/Pig-the-dice-game-Player/Racket/pig-the-dice-game-player-1.rkt similarity index 100% rename from Task/Pig-the-dice-game-Player/Racket/pig-the-dice-game-player.rkt rename to Task/Pig-the-dice-game-Player/Racket/pig-the-dice-game-player-1.rkt diff --git a/Task/Pig-the-dice-game-Player/Racket/pig-the-dice-game-player-2.rkt b/Task/Pig-the-dice-game-Player/Racket/pig-the-dice-game-player-2.rkt new file mode 100644 index 0000000000..537306a410 --- /dev/null +++ b/Task/Pig-the-dice-game-Player/Racket/pig-the-dice-game-player-2.rkt @@ -0,0 +1 @@ +(pig-the-dice #:print? #t (n-points 12) (n-rounds 4)) diff --git a/Task/Pig-the-dice-game/00DESCRIPTION b/Task/Pig-the-dice-game/00DESCRIPTION index 95c70b39a4..14f718e567 100644 --- a/Task/Pig-the-dice-game/00DESCRIPTION +++ b/Task/Pig-the-dice-game/00DESCRIPTION @@ -1,12 +1,15 @@ -The [[wp:Pig (dice)|game of Pig]] is a multiplayer game played with a single six-sided die. The -object of the game is to reach 100 points or more. -Play is taken in turns. On each person's turn that person has the option of either +The   [[wp:Pig (dice)|game of Pig]]   is a multiplayer game played with a single six-sided die.   The +object of the game is to reach   '''100'''   points or more.   +Play is taken in turns.   On each person's turn that person has the option of either: -# '''Rolling the dice''': where a roll of two to six is added to their score for that turn and the player's turn continues as the player is given the same choice again; or a roll of 1 loses the player's total points ''for that turn'' and their turn finishes with play passing to the next player. -# '''Holding''': The player's score for that round is added to their total and becomes safe from the effects of throwing a one. The player's turn finishes with play passing to the next player. +:# '''Rolling the dice''':   where a roll of two to six is added to their score for that turn and the player's turn continues as the player is given the same choice again;   or a roll of   '''1'''   loses the player's total points   ''for that turn''   and their turn finishes with play passing to the next player. +:# '''Holding''':   the player's score for that round is added to their total and becomes safe from the effects of throwing a   '''1'''   (one).   The player's turn finishes with play passing to the next player. -;Task goal: -The goal of this task is to create a program to score for, and simulate dice throws for, a two-person game. -;Cf: -* [[Pig the dice game/Player]] +;Task: +Create a program to score for, and simulate dice throws for, a two-person game. + + +;Related task: +*   [[Pig the dice game/Player]] +

    diff --git a/Task/Pig-the-dice-game/Lua/pig-the-dice-game.lua b/Task/Pig-the-dice-game/Lua/pig-the-dice-game.lua new file mode 100644 index 0000000000..b5dfa06db3 --- /dev/null +++ b/Task/Pig-the-dice-game/Lua/pig-the-dice-game.lua @@ -0,0 +1,34 @@ +local numPlayers = 2 +local maxScore = 100 +local scores = { } +for i = 1, numPlayers do + scores[i] = 0 -- total safe score for each player +end +math.randomseed(os.time()) +print("Enter a letter: [h]old or [r]oll?") +local points = 0 -- points accumulated in current turn +local p = 1 -- start with first player +while true do + io.write("\nPlayer "..p..", your score is ".. scores[p]..", with ".. points.." temporary points. ") + local reply = string.sub(string.lower(io.read("*line")), 1, 1) + if reply == 'r' then + local roll = math.random(6) + io.write("You rolled a " .. roll) + if roll == 1 then + print(". Too bad. :(") + p = (p % numPlayers) + 1 + points = 0 + else + points = points + roll + end + elseif reply == 'h' then + scores[p] = scores[p] + points + if scores[p] >= maxScore then + print("Player "..p..", you win with a score of "..scores[p]) + break + end + print("Player "..p..", your new score is " .. scores[p]) + p = (p % numPlayers) + 1 + points = 0 + end +end diff --git a/Task/Pig-the-dice-game/Maple/pig-the-dice-game.maple b/Task/Pig-the-dice-game/Maple/pig-the-dice-game.maple new file mode 100644 index 0000000000..020d33416f --- /dev/null +++ b/Task/Pig-the-dice-game/Maple/pig-the-dice-game.maple @@ -0,0 +1,45 @@ +pig := proc() + local Points, pointsThisTurn, answer, rollNum, i, win; + randomize(); + Points := [0, 0]; + win := [false, 0]; + while not win[1] do + for i to 2 do + if not win[1] then + printf("Player %a's turn.\n", i); + answer := ""; + pointsThisTurn := 0; + while not answer = "HOLD" do + while not answer = "ROLL" and not answer = "HOLD" do + printf("Would you like to ROLL or HOLD?\n"); + answer := StringTools:-UpperCase(readline()); + if not answer = "ROLL" and not answer = "HOLD" then + printf("Invalid answer.\n\n"); + end if; + end do; + if answer = "ROLL" then + rollNum := rand(1..6)(); + printf("You rolled a %a!\n", rollNum); + if rollNum = 1 then + pointsThisTurn := 0; + answer := "HOLD"; + else + pointsThisTurn := pointsThisTurn + rollNum; + answer := ""; + printf("Your points so far this turn: %a.\n\n", pointsThisTurn); + end if; + end if; + end do; + printf("This turn is over! Player %a gained %a points this turn.\n\n", i, pointsThisTurn); + Points[i] := Points[i] + pointsThisTurn; + if Points[i] >= 100 then + win := [true, i]; + end if; + printf("Player 1 has %a points. Player 2 has %a points.\n\n", Points[1], Points[2]); + end if; + end do; + end do; + printf("Player %a won with %a points!\n", win[2], Points[win[2]]); +end proc; + +pig(); diff --git a/Task/Pinstripe-Display/Perl-6/pinstripe-display.pl6 b/Task/Pinstripe-Display/Perl-6/pinstripe-display.pl6 index 6304645aa6..673d394ffe 100644 --- a/Task/Pinstripe-Display/Perl-6/pinstripe-display.pl6 +++ b/Task/Pinstripe-Display/Perl-6/pinstripe-display.pl6 @@ -15,7 +15,7 @@ $PPM.print: qq:to/EOH/; my $vzones = $VERT div 4; for 1..4 -> $w { my $hzones = ceiling $HOR / $w / +@colors; - my $line = Buf.new: ((@colors Xxx $w) xx $hzones).splice(0,$HOR); + my $line = Buf.new: (flat((@colors Xxx $w) xx $hzones).Array).splice(0,$HOR); $PPM.write: $line for ^$vzones; } diff --git a/Task/Pinstripe-Display/Python/pinstripe-display.py b/Task/Pinstripe-Display/Python/pinstripe-display.py new file mode 100644 index 0000000000..84a349f798 --- /dev/null +++ b/Task/Pinstripe-Display/Python/pinstripe-display.py @@ -0,0 +1,55 @@ +#Python task for Pinstripe/Display +#Tested for Python2.7 by Benjamin Curutchet + +#Import PIL libraries +from PIL import Image +from PIL import ImageColor +from PIL import ImageDraw + +#Create the picture (size parameter 1660x1005 like the example) +x_size = 1650 +y_size = 1000 +im = Image.new('RGB',(x_size, y_size)) + +#Create a full black picture +draw = ImageDraw.Draw(im) + +#RGB code for the White Color +White = (255,255,255) + +#First loop in order to create four distinct lines +y_delimiter_list = [] +for y_delimiter in range(1,y_size,y_size/4): + y_delimiter_list.append(y_delimiter) + + +#Four different loops in order to draw columns in white depending on the +#number of the line + +for x in range(1,x_size,2): + for y in range(1,y_delimiter_list[1],1): + draw.point((x,y),White) + +for x in range(1,x_size-1,4): + for y in range(y_delimiter_list[1],y_delimiter_list[2],1): + draw.point((x,y),White) + draw.point((x+1,y),White) + +for x in range(1,x_size-2,6): + for y in range(y_delimiter_list[2],y_delimiter_list[3],1): + draw.point((x,y),White) + draw.point((x+1,y),White) + draw.point((x+2,y),White) + +for x in range(1,x_size-3,8): + for y in range(y_delimiter_list[3],y_size,1): + draw.point((x,y),White) + draw.point((x+1,y),White) + draw.point((x+2,y),White) + draw.point((x+3,y),White) + + + +#Save the picture under a name as a jpg file. +print "Your picture is saved" +im.save('PictureResult.jpg') diff --git a/Task/Playing-cards/00DESCRIPTION b/Task/Playing-cards/00DESCRIPTION index fff7a1bbe9..d25b8b6d02 100644 --- a/Task/Playing-cards/00DESCRIPTION +++ b/Task/Playing-cards/00DESCRIPTION @@ -1,7 +1,13 @@ -Create a data structure and the associated methods to define and manipulate a deck of [[wp:Playing-cards#Anglo-American-French|playing cards]]. +;Task: +Create a data structure and the associated methods to define and manipulate a deck of   [[wp:Playing-cards#Anglo-American-French|playing cards]]. The deck should contain 52 unique cards. -The methods must include the ability to make a new deck, shuffle (randomize) the deck, deal from the deck, and print the current contents of a deck. +The methods must include the ability to: +:::*   make a new deck +:::*   shuffle (randomize) the deck +:::*   deal from the deck +:::*   print the current contents of a deck Each card must have a pip value and a suit value which constitute the unique value of the card. +

    diff --git a/Task/Playing-cards/AutoHotkey/playing-cards.ahk b/Task/Playing-cards/AutoHotkey/playing-cards.ahk new file mode 100644 index 0000000000..be59869b0b --- /dev/null +++ b/Task/Playing-cards/AutoHotkey/playing-cards.ahk @@ -0,0 +1,84 @@ +suits := ["♠", "♦", "♥", "♣"] +values := [2,3,4,5,6,7,8,9,10,"J","Q","K","A"] +Gui, font, s14 +Gui, add, button, w190 gNewDeck, New Deck +Gui, add, button, x+10 wp gShuffle, Shuffle +Gui, add, button, x+10 wp gDeal, Deal +Gui, add, text, xs w600 , Current Deck: +Gui, add, Edit, xs wp r4 vDeck +Gui, add, text, xs , Hands: +Gui, add, Edit, x+10 w60 vHands gHands +Gui, add, UpDown,, 1 +Edits := 0 + +Hands: +Gui, Submit, NoHide +loop, % Edits + GuiControl,Hide, Hand%A_Index% + +loop, % Hands + GuiControl,Show, % "Hand" A_Index + +loop, % Hands - Edits +{ + Edits++ + Gui, add, ListBox, % "x" (Edits=1?"s":"+10") " w60 r13 vHand" Edits +} +Gui, show, AutoSize +return +;----------------------------------------------- +GuiClose: +ExitApp +return +;----------------------------------------------- +NewDeck: +cards := [], deck := Dealt:= "" + +loop, % Hands + GuiControl,, Hand%A_Index%, | + +for each, suit in suits + for each, value in values + cards.Insert(value suit) + +for each, card in cards + deck .= card (mod(A_Index, 13) ? " " : "`n") +GuiControl,, Deck, % deck +GuiControl,, Dealt +GuiControl, Enable, Button2 +GuiControl, Enable, Hands +return +;----------------------------------------------- +shuffle: +gosub, NewDeck +shuffled := [], deck := "" +loop, 52 { + Random, rnd, 1, % cards.MaxIndex() + shuffled[A_Index] := cards.RemoveAt(rnd) +} +for each, card in shuffled +{ + deck .= card (mod(A_Index, 13) ? " " : "`n") + cards.Insert(card) +} +GuiControl,, Deck, % deck +return +;----------------------------------------------- +Deal: +Gui, Submit, NoHide +if ( Hands > cards.MaxIndex()) + return + +deck := "" +loop, % Hands + GuiControl,, Hand%A_Index%, % cards.RemoveAt(1) + +GuiControl, Disable, Button2 +GuiControl, Disable, Hands +GuiControl,, Dealt, % Dealt + +for each, card in cards + deck .= card (mod(A_Index, 13) ? " " : "`n") +GuiControl,, Deck, % deck +return +;----------------------------------------------- diff --git a/Task/Playing-cards/AutoIt/playing-cards.autoit b/Task/Playing-cards/AutoIt/playing-cards.autoit new file mode 100644 index 0000000000..e0d122eceb --- /dev/null +++ b/Task/Playing-cards/AutoIt/playing-cards.autoit @@ -0,0 +1,51 @@ +#Region ;**** Directives created by AutoIt3Wrapper_GUI **** +#AutoIt3Wrapper_Change2CUI=y +#EndRegion ;**** Directives created by AutoIt3Wrapper_GUI **** +#include + +; ## GLOBALS ## +Global $SUIT = ["D", "H", "S", "C"] +Global $FACE = [2, 3, 4, 5, 6, 7, 8, 9, 10, "J", "Q", "K", "A"] +Global $DECK[52] + +; ## CREATES A NEW DECK +Func NewDeck() + + For $i = 0 To 3 + For $x = 0 To 12 + _ArrayPush($DECK, $FACE[$x] & $SUIT[$i]) + Next + Next + +EndFunc ;==>NewDeck + +; ## SHUFFLE DECK +Func Shuffle() + + _ArrayShuffle($DECK) + +EndFunc ;==>Shuffle + +; ## DEAL A CARD +Func Deal() + + Return _ArrayPop($DECK) + +EndFunc ;==>Deal + +; ## PRINT DECK +Func Print() + + ConsoleWrite(_ArrayToString($DECK) & @CRLF) + +EndFunc ;==>Print + + +#Region ;#### USAGE #### +NewDeck() +Print() +Shuffle() +Print() +ConsoleWrite("DEALT: " & Deal() & @CRLF) +Print() +#EndRegion ;#### USAGE #### diff --git a/Task/Playing-cards/Batch-File/playing-cards.bat b/Task/Playing-cards/Batch-File/playing-cards.bat new file mode 100644 index 0000000000..44a7619d94 --- /dev/null +++ b/Task/Playing-cards/Batch-File/playing-cards.bat @@ -0,0 +1,99 @@ +@echo off +setlocal enabledelayedexpansion + +call:newdeck deck +echo new deck: +echo. +call:showcards deck +echo. +echo shuffling: +echo. +call:shuffle deck +call:showcards deck +echo. +echo dealing 5 cards to 4 players +call:deal deck 5 hand1 hand2 hand3 hand4 +echo. +echo player 1 & call:showcards hand1 +echo. +echo player 2 & call:showcards hand2 +echo. +echo player 3 & call:showcards hand3 +echo. +echo player 4 & call:showcards hand4 +echo. +call:count %deck% cnt +echo %cnt% cards remaining in the deck +echo. + call:showcards deck +echo. + +exit /b + +:getcard deck hand :: deals 1 card to a player + set "loc1=!%~1!" + set "%~2=!%~2!!loc1:~0,3!" + set "%~1=!loc1:~3!" +exit /b + +:deal deck n player1 player2...up to 7 + set "loc=!%~1!" + set "cards=%~2" + set players=%3 %4 %5 %6 %7 %8 %9 + for /L %%j in (1,1,!cards!) do ( + for %%k in (!players!) do call:getcard loc %%k) + set "%~1=!loc!" + exit /b + +:newdeck [deck] ::creates a deck of cards + :: in the parentheses below there are ascii chars 3,4,5 and 6 representing the suits + for %%i in ( ♠ ♦ ♥ ♣ ) do ( + for %%j in (20 31 42 53 64 75 86 97 T8 J9 QA KB AC) do set loc=!loc!%%i%%j + ) + set "%~1=!loc!" +exit /b + +:showcards [deck] :: prints a deck or a hand + set "loc=!%~1!" + for /L %%j in (0,39,117) do ( + set s= + for /L %%i in (0,3,36) do ( + set /a n=%%i+%%j + call set s=%%s%% %%loc:~!n!,2%% + ) + if "!s: =!" neq "" echo(!s! + set /a n+=1 + if "%loc:~!n!,!%" equ "" goto endloop + ) + :endloop + exit /b + +:count deck count +set "loc1=%1" +set /a cnt1=0 +for %%i in (96 48 24 12 6 3 ) do if "!loc1:~%%i,1!" neq "" set /a cnt1+=%%i & set loc1=!loc1:~%%i! +set /a cnt1=cnt1/3+1 +set "%~2=!cnt1!" +exit /b + +:shuffle (deck) :: shuffles a deck + set "loc=!%~1!" + call:count %loc%, cnt + set /a cnt-=1 + for /L %%i in (%cnt%,-1,0) do ( + SET /A "from=%%i,to=(!RANDOM!*(%%i-1)/32768)" + call:swap loc from to + ) + set "%~1=!loc!" + exit /b + + :swap deck from to :: swaps two cards + set "arr=!%~1!" + set /a "from=!%~2!*3,to=!%~3!*3" + set temp1=!arr:~%from%,3! + set temp2=!arr:~%to%,3! + set arr=!arr:%temp1%=@@@! + set arr=!arr:%temp2%=%temp1%! + set arr=!arr:@@@=%temp2%! + set "%~1=!arr!" + exit /b diff --git a/Task/Playing-cards/C++/playing-cards.cpp b/Task/Playing-cards/C++/playing-cards.cpp index c107bc91a9..2f7276b458 100644 --- a/Task/Playing-cards/C++/playing-cards.cpp +++ b/Task/Playing-cards/C++/playing-cards.cpp @@ -1,6 +1,3 @@ -#ifndef CARDS_H_INC -#define CARDS_H_INC - #include #include #include @@ -8,86 +5,72 @@ namespace cards { - class card - { - public: +class card +{ +public: enum pip_type { two, three, four, five, six, seven, eight, nine, ten, - jack, queen, king, ace }; - enum suite_type { hearts, spades, diamonds, clubs }; + jack, queen, king, ace, pip_count }; + enum suite_type { hearts, spades, diamonds, clubs, suite_count }; + enum { unique_count = pip_count * suite_count }; - // construct a card of a given suite and pip - card(suite_type s, pip_type p): value(s + 4*p) {} + card(suite_type s, pip_type p): value(s + suite_count * p) {} - // construct a card directly from its value - card(unsigned char v = 0): value(v) {} + explicit card(unsigned char v = 0): value(v) {} - // return the pip of the card - pip_type pip() { return pip_type(value/4); } + pip_type pip() { return pip_type(value / suite_count); } - // return the suit of the card - suite_type suite() { return suite_type(value%4); } + suite_type suite() { return suite_type(value % suite_count); } - private: - // there are only 52 cards, therefore unsigned char suffices +private: unsigned char value; - }; +}; - char const* const pip_names[] = +const char* const pip_names[] = { "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten", "jack", "queen", "king", "ace" }; - // output a pip - std::ostream& operator<<(std::ostream& os, card::pip_type pip) - { +std::ostream& operator<<(std::ostream& os, card::pip_type pip) +{ return os << pip_names[pip]; - }; - - char const* const suite_names[] = - { "hearts", "spades", "diamonds", "clubs" }; - - // output a suite - std::ostream& operator<<(std::ostream& os, card::suite_type suite) - { - return os << suite_names[suite]; - } - - // output a card - std::ostream& operator<<(std::ostream& os, card c) - { - return os << c.pip() << " of " << c.suite(); - } - - class deck - { - public: - // default constructor: construct a default-ordered deck - deck() - { - for (int i = 0; i < 52; ++i) - cards.push_back(card(i)); - } - - // shuffle the deck - void shuffle() { std::random_shuffle(cards.begin(), cards.end()); } - - // deal a card from the top - card deal() { card c = cards.front(); cards.pop_front(); return c; } - - // iterators (only reading access is allowed) - typedef std::deque::const_iterator const_iterator; - const_iterator begin() const { return cards.begin(); } - const_iterator end() const { return cards.end(); } - private: - // the cards - std::deque cards; - }; - - // output the deck - inline std::ostream& operator<<(std::ostream& os, deck const& d) - { - std::copy(d.begin(), d.end(), std::ostream_iterator(os, "\n")); - return os; - } } -#endif +const char* const suite_names[] = + { "hearts", "spades", "diamonds", "clubs" }; + +std::ostream& operator<<(std::ostream& os, card::suite_type suite) +{ + return os << suite_names[suite]; +} + +std::ostream& operator<<(std::ostream& os, card c) +{ + return os << c.pip() << " of " << c.suite(); +} + +class deck +{ +public: + deck() + { + for (int i = 0; i < card::unique_count; ++i) { + cards.push_back(card(i)); + } + } + + void shuffle() { std::random_shuffle(cards.begin(), cards.end()); } + + card deal() { card c = cards.front(); cards.pop_front(); return c; } + + typedef std::deque::const_iterator const_iterator; + const_iterator begin() const { return cards.cbegin(); } + const_iterator end() const { return cards.cend(); } +private: + std::deque cards; +}; + +inline std::ostream& operator<<(std::ostream& os, const deck& d) +{ + std::copy(d.begin(), d.end(), std::ostream_iterator(os, "\n")); + return os; +} +} diff --git a/Task/Playing-cards/COBOL/playing-cards.cobol b/Task/Playing-cards/COBOL/playing-cards.cobol new file mode 100644 index 0000000000..6d04af9fd8 --- /dev/null +++ b/Task/Playing-cards/COBOL/playing-cards.cobol @@ -0,0 +1,177 @@ + identification division. + program-id. playing-cards. + + environment division. + configuration section. + repository. + function all intrinsic. + + data division. + working-storage section. + 77 card usage index. + 01 deck. + 05 cards occurs 52 times ascending key slot indexed by card. + 10 slot pic 99. + 10 hand pic 99. + 10 suit pic 9. + 10 symbol pic x(4). + 10 rank pic 99. + + 01 filler. + 05 suit-name pic x(8) occurs 4 times. + + *> Unicode U+1F0Ax, Bx, Cx, Dx "f09f82a0" "82b0" "8380" "8390" + 01 base-s constant as 4036985504. + 01 base-h constant as 4036985520. + 01 base-d constant as 4036985728. + 01 base-c constant as 4036985744. + + 01 sym pic x(4) comp-x. + 01 symx redefines sym pic x(4). + 77 s pic 9. + 77 r pic 99. + 77 c pic 99. + 77 hit pic 9. + 77 limiter pic 9(6). + + 01 spades constant as 1. + 01 hearts constant as 2. + 01 diamonds constant as 3. + 01 clubs constant as 4. + + 01 players constant as 3. + 01 cards-per constant as 5. + 01 deal pic 99. + 01 player pic 99. + + 01 show-tally pic zz. + 01 show-rank pic z(5). + 01 arg pic 9(10). + + procedure division. + cards-main. + perform seed + perform initialize-deck + perform shuffle-deck + perform deal-deck + perform display-hands + goback. + + *> ******** + seed. + accept arg from command-line + if arg not equal 0 then + move random(arg) to c + end-if + . + + initialize-deck. + move "spades" to suit-name(spades) + move "hearts" to suit-name(hearts) + move "diamonds" to suit-name(diamonds) + move "clubs" to suit-name(clubs) + + perform varying s from 1 by 1 until s > 4 + after r from 1 by 1 until r > 13 + compute c = (s - 1) * 13 + r + evaluate s + when spades compute sym = base-s + r + when hearts compute sym = base-h + r + when diamonds compute sym = base-d + r + when clubs compute sym = base-c + r + end-evaluate + if r > 11 then compute sym = sym + 1 end-if + move s to suit(c) + move r to rank(c) + move symx to symbol(c) + move zero to slot(c) + move zero to hand(c) + end-perform + . + + shuffle-deck. + move zero to limiter + perform until exit + compute c = random() * 52.0 + 1.0 + move zero to hit + perform varying tally from 1 by 1 until tally > 52 + if slot(tally) equal c then + move 1 to hit + exit perform + end-if + if slot(tally) equal 0 then + if tally < 52 then move 1 to hit end-if + move c to slot(tally) + exit perform + end-if + end-perform + if hit equal zero then exit perform end-if + if limiter > 999999 then + display "too many shuffles, deck invalid" upon syserr + exit perform + end-if + add 1 to limiter + end-perform + sort cards ascending key slot + . + + display-card. + >>IF ENGLISH IS DEFINED + move rank(tally) to show-rank + evaluate rank(tally) + when 1 display " ace" with no advancing + when 2 thru 10 display show-rank with no advancing + when 11 display " jack" with no advancing + when 12 display "queen" with no advancing + when 13 display " king" with no advancing + end-evaluate + display " of " suit-name(suit(tally)) with no advancing + >>ELSE + display symbol(tally) with no advancing + >>END-IF + . + + display-deck. + perform varying tally from 1 by 1 until tally > 52 + move tally to show-tally + display "Card: " show-tally + " currently in hand " hand(tally) + " is " with no advancing + perform display-card + display space + end-perform + . + + display-hands. + perform varying player from 1 by 1 until player > players + move player to tally + display "Player " player ": " with no advancing + perform varying deal from 1 by 1 until deal > cards-per + perform display-card + add players to tally + end-perform + display space + end-perform + display "Stock: " with no advancing + subtract players from tally + add 1 to tally + perform varying tally from tally by 1 until tally > 52 + perform display-card + >>IF ENGLISH IS DEFINED + display space + >>END-IF + end-perform + display space + . + + deal-deck. + display "Dealing " cards-per " cards to " players " players" + move 1 to tally + perform varying deal from 1 by 1 until deal > cards-per + after player from 1 by 1 until player > players + move player to hand(tally) + add 1 to tally + end-perform + . + + end program playing-cards. diff --git a/Task/Playing-cards/Clojure/playing-cards.clj b/Task/Playing-cards/Clojure/playing-cards.clj index 03ba736ced..91e94c93e4 100644 --- a/Task/Playing-cards/Clojure/playing-cards.clj +++ b/Task/Playing-cards/Clojure/playing-cards.clj @@ -1,21 +1,12 @@ -(defrecord Card [pip suit] - Object - (toString [this] (str pip " of " suit))) +(def suits [:club :diamond :heart :spade]) +(def pips [:ace 2 3 4 5 6 7 8 9 10 :jack :queen :king]) -(defprotocol pDeck - (deal [this n]) - (shuffle [this]) - (newDeck [this]) - (print [this])) +(defn deck [] (for [s suits p pips] [s p])) -(deftype Deck [cards] - pDeck - (deal [this n] [(take n cards) (Deck. (drop n cards))]) - (shuffle [this] (Deck. (shuffle cards))) - (newDeck [this] (Deck. (for [suit ["Clubs" "Hearts" "Spades" "Diamonds"] - pip ["2" "3" "4" "5" "6" "7" "8" "9" "10" "Jack" "Queen" "King" "Ace"]] - (Card. pip suit)))) - (print [this] (dorun (map (comp println str) cards)) this)) - -(defn new-deck [] - (.newDeck (Deck. nil))) +(def shuffle clojure.core/shuffle) +(def deal first) +(defn output [deck] + (doseq [[suit pip] deck] + (println (format "%s of %ss" + (if (keyword? pip) (name pip) pip) + (name suit))))) diff --git a/Task/Playing-cards/Elixir/playing-cards.elixir b/Task/Playing-cards/Elixir/playing-cards.elixir new file mode 100644 index 0000000000..19370f784e --- /dev/null +++ b/Task/Playing-cards/Elixir/playing-cards.elixir @@ -0,0 +1,41 @@ +defmodule Card do + defstruct pip: nil, suit: nil +end + +defmodule Playing_cards do + @pips ~w[2 3 4 5 6 7 8 9 10 Jack Queen King Ace]a + @suits ~w[Clubs Hearts Spades Diamonds]a + @pip_value Enum.with_index(@pips) + @suit_value Enum.with_index(@suits) + + def deal( n_cards, deck ), do: Enum.split( deck, n_cards ) + + def deal( n_hands, n_cards, deck ) do + Enum.reduce(1..n_hands, {[], deck}, fn _,{acc,d} -> + {hand, new_d} = deal(n_cards, d) + {[hand | acc], new_d} + end) + end + + def deck, do: (for x <- @suits, y <- @pips, do: %Card{suit: x, pip: y}) + + def print( cards ), do: IO.puts (for x <- cards, do: "\t#{inspect x}") + + def shuffle( deck ), do: Enum.shuffle( deck ) + + def sort_pips( cards ), do: Enum.sort_by( cards, &@pip_value[&1.pip] ) + + def sort_suits( cards ), do: Enum.sort_by( cards, &(@suit_value[&1.suit]) ) + + def task do + shuffled = shuffle( deck ) + {hand, new_deck} = deal( 3, shuffled ) + {hands, _deck} = deal( 2, 3, new_deck ) + IO.write "Hand:" + print( hand ) + IO.puts "Hands:" + for x <- hands, do: print(x) + end +end + +Playing_cards.task diff --git a/Task/Playing-cards/Perl-6/playing-cards.pl6 b/Task/Playing-cards/Perl-6/playing-cards.pl6 index ddf151e519..380929db30 100644 --- a/Task/Playing-cards/Perl-6/playing-cards.pl6 +++ b/Task/Playing-cards/Perl-6/playing-cards.pl6 @@ -10,7 +10,7 @@ class Card { class Deck { has Card @.cards = pick *, - map { Card.new(:$^pip, :$^suit) }, (Pip.pick(*) X Suit.pick(*)); + map { Card.new(:$^pip, :$^suit) }, flat (Pip.pick(*) X Suit.pick(*)); method shuffle { @!cards .= pick: * } diff --git a/Task/Playing-cards/REXX/playing-cards-2.rexx b/Task/Playing-cards/REXX/playing-cards-2.rexx index fe219d44c8..575323a69c 100644 --- a/Task/Playing-cards/REXX/playing-cards-2.rexx +++ b/Task/Playing-cards/REXX/playing-cards-2.rexx @@ -1,36 +1,36 @@ -/*REXX pgm shows a method to build/shuffle/deal a standard 52─card deck.*/ -box = build(); say ' box of cards:' box /*a new box of 52─cards.*/ -deck=shuffle(); say 'shuffled deck:' deck /*randomly shuffled deck*/ -call deal 5, 4 /* ◄═════════════════════════════════ 5 cards, 4 hands*/ +/*REXX program demonstrates a method to build/shuffle/deal a standard 52─card deck. */ +box = build(); say ' box of cards:' box /*a brand new standard box of 52 cards.*/ +deck=shuffle(); say 'shuffled deck:' deck /*obtain a randomly shuffled deck. */ +call deal 5, 4 /* ◄═════════════════════════════════════════════════ 5 cards, 4 hands*/ say; say; say right('[north]' hand.1,50) say; say '[west]' hand.4 right('[east]' hand.2,60) say; say right('[south]' hand.3,50) say; say; say; say 'remainder of deck: ' deck -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────BUILD subroutine────────────────────*/ -build: _=; ranks= "A 2 3 4 5 6 7 8 9 10 J Q K" /*ranks. */ -if 5=='f5'x then suits= "h d c s" /*EBCDIC? */ - else suits= "♥ ♦ ♣ ♠" /*ASCII. */ -#ranks=words(ranks); do s=1 for words(suits); @=word(suits,s) - do r=1 for #ranks - _=_ word(ranks,r)@ - end /*s*/ - end /*r*/ -return _ -/*──────────────────────────────────SHUFFLE subroutine──────────────────*/ -shuffle: y=; _=box; #cards=words(_) /*define REXX vars.*/ - do shuffler=1 for #cards /*shuffle all the cards in deck. */ - ?=random(1,#cards+1-shuffler) /*each shuffle, random# decreases*/ - y=y word(_, ?) /*shuffled deck, 1 card at─a─time*/ - _=delword(_, ?, 1) /*delete the just─chosen card. */ - end /*shuffler*/ -return y -/*──────────────────────────────────DEAL subroutine─────────────────────*/ -deal: parse arg #cards, hands; hand.= - do #cards /*deal the hand to the players. */ - do player=1 for hands /*deal some cards to the players.*/ - hand.player=hand.player word(deck, 1) /*deal top card.*/ - deck=subword(deck, 2) /*diminish deck, remove one card.*/ - end /*player*/ - end /*#cards*/ -return +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +build: _=; ranks= "A 2 3 4 5 6 7 8 9 10 J Q K" /*ranks. */ + if 5=='f5'x then suits= "h d c s" /*EBCDIC? */ + else suits= "♥ ♦ ♣ ♠" /*ASCII. */ + #ranks=words(ranks); do s=1 for words(suits); @= word(suits, s) + do r=1 for #ranks; _=_ word(ranks, r)@ + end /*s*/ + end /*r*/ + + return _ /*this build skips the jokers. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +shuffle: y=; _=box; #cards=words(_) /*define three REXX variables. */ + do shuffler=1 for #cards /*shuffle all the cards in deck. */ + ?=random(1, #cards + 1 - shuffler) /*each shuffle, random# decreases*/ + y=y word(_, ?) /*shuffled deck, 1 card at─a─time*/ + _=delword(_, ?, 1) /*delete the just─chosen card. */ + end /*shuffler*/ + return y +/*──────────────────────────────────────────────────────────────────────────────────────*/ +deal: parse arg #cards, hands; hand.= + do #cards /*deal the hand to the players. */ + do player=1 for hands /*deal some cards to the players.*/ + hand.player=hand.player word(deck, 1) /*deal the top card.*/ + deck=subword(deck, 2) /*diminish deck, remove one card.*/ + end /*player*/ + end /*#cards*/ + return diff --git a/Task/Playing-cards/Ruby/playing-cards.rb b/Task/Playing-cards/Ruby/playing-cards.rb index df555e34ba..a13a095cf7 100644 --- a/Task/Playing-cards/Ruby/playing-cards.rb +++ b/Task/Playing-cards/Ruby/playing-cards.rb @@ -31,7 +31,7 @@ class Deck end def to_s - "[#{@deck.join(", ")}]" + @deck.inspect end def shuffle! diff --git a/Task/Plot-coordinate-pairs/00DESCRIPTION b/Task/Plot-coordinate-pairs/00DESCRIPTION index 47c830ffc3..e321eeb13d 100644 --- a/Task/Plot-coordinate-pairs/00DESCRIPTION +++ b/Task/Plot-coordinate-pairs/00DESCRIPTION @@ -1,7 +1,9 @@ -Plot a function represented as `x', `y' numerical arrays. +;Task: +Plot a function represented as   `x',   `y'   numerical arrays. -Post link to your resulting image for input arrays (see [[Query Performance|'''Example''' section for Python language on ''Query Performance'' page]]): +Post the resulting image for the following input arrays (taken from [[Time_a_function#Python|Python's Example section on ''Time a function'']]): x = {0, 1, 2, 3, 4, 5, 6, 7, 8, 9}; y = {2.7, 2.8, 31.4, 38.1, 58.0, 76.2, 100.5, 130.0, 149.3, 180.0}; This task is intended as a subtask for [[Measure relative performance of sorting algorithms implementations]]. +

    diff --git a/Task/Plot-coordinate-pairs/Go/plot-coordinate-pairs.go b/Task/Plot-coordinate-pairs/Go/plot-coordinate-pairs-1.go similarity index 100% rename from Task/Plot-coordinate-pairs/Go/plot-coordinate-pairs.go rename to Task/Plot-coordinate-pairs/Go/plot-coordinate-pairs-1.go diff --git a/Task/Plot-coordinate-pairs/Go/plot-coordinate-pairs-2.go b/Task/Plot-coordinate-pairs/Go/plot-coordinate-pairs-2.go new file mode 100644 index 0000000000..598b0a94f0 --- /dev/null +++ b/Task/Plot-coordinate-pairs/Go/plot-coordinate-pairs-2.go @@ -0,0 +1,32 @@ +package main + +import ( + "log" + + "github.com/gonum/plot" + "github.com/gonum/plot/plotter" + "github.com/gonum/plot/plotutil" + "github.com/gonum/plot/vg" +) + +var ( + x = []int{0, 1, 2, 3, 4, 5, 6, 7, 8, 9} + y = []float64{2.7, 2.8, 31.4, 38.1, 58.0, 76.2, 100.5, 130.0, 149.3, 180.0} +) + +func main() { + pts := make(plotter.XYs, len(x)) + for i, xi := range x { + pts[i] = struct{ X, Y float64 }{float64(xi), y[i]} + } + p, err := plot.New() + if err != nil { + log.Fatal(err) + } + if err = plotutil.AddScatters(p, pts); err != nil { + log.Fatal(err) + } + if err := p.Save(3*vg.Inch, 3*vg.Inch, "points.svg"); err != nil { + log.Fatal(err) + } +} diff --git a/Task/Polymorphism/00DESCRIPTION b/Task/Polymorphism/00DESCRIPTION index fdd5887cff..e26bc42586 100644 --- a/Task/Polymorphism/00DESCRIPTION +++ b/Task/Polymorphism/00DESCRIPTION @@ -1 +1,3 @@ -Create two classes Point(x,y) and Circle(x,y,r) with a polymorphic function print, accessors for (x,y,r), copy constructor, assignment and destructor and every possible default constructors +;Task: +Create two classes   Point(x,y)   and   Circle(x,y,r)   with a polymorphic function print, accessors for (x,y,r), copy constructor, assignment and destructor and every possible default constructors +

    diff --git a/Task/Polymorphism/Ela/polymorphism-1.ela b/Task/Polymorphism/Ela/polymorphism-1.ela index ca2aa32630..2293aac03f 100644 --- a/Task/Polymorphism/Ela/polymorphism-1.ela +++ b/Task/Polymorphism/Ela/polymorphism-1.ela @@ -1,14 +1,14 @@ type Point = Point x y instance Show Point where - showf _ (Point x y) = "Point " ++ (show x) ++ " " ++ (show y) + show (Point x y) = "Point " ++ (show x) ++ " " ++ (show y) instance Name Point where getField nm (Point x y) | nm == "x" = x | nm == "y" = y | else = fail "Undefined name." - isField nm _ = nm == "x" or nm == "y" + isField nm _ = nm == "x" || nm == "y" pointX = flip Point 0 @@ -19,7 +19,7 @@ pointEmpty = Point 0 0 type Circle = Circle x y z instance Show Circle where - showf _ (Circle x y z) = + show (Circle x y z) = "Circle " ++ (show x) ++ " " ++ (show y) ++ " " ++ (show z) instance Name Circle where @@ -28,7 +28,7 @@ instance Name Circle where | nm == "y" = y | nm == "z" = z | else = fail "Undefined name." - isField nm _ = nm == "x" or nm == "y" or nm == "z" + isField nm _ = nm == "x" || nm == "y" || nm == "z" circleXZ = flip Circle 0 @@ -41,5 +41,3 @@ circleY y = Circle 0 y 0 circleZ = Circle 0 0 circleEmpty = Circle 0 0 0 - -circleX 1 2 diff --git a/Task/Polymorphism/Java/polymorphism.java b/Task/Polymorphism/Java/polymorphism.java index 6a4655dd7b..a72faa1178 100644 --- a/Task/Polymorphism/Java/polymorphism.java +++ b/Task/Polymorphism/Java/polymorphism.java @@ -1,33 +1,35 @@ class Point { protected int x, y; public Point() { this(0); } - public Point(int x0) { this(x0, 0); } - public Point(int x0, int y0) { x = x0; y = y0; } + public Point(int x) { this(x, 0); } + public Point(int x, int y) { this.x = x; this.y = y; } public Point(Point p) { this(p.x, p.y); } - public int getX() { return x; } - public int getY() { return y; } - public int setX(int x0) { x = x0; } - public int setY(int y0) { y = y0; } - public void print() { System.out.println("Point"); } + public int getX() { return this.x; } + public int getY() { return this.y; } + public void setX(int x) { this.x = x; } + public void setY(int y) { this.y = y; } + public void print() { System.out.println("Point x: " + this.x + " y: " + this.y); } } -public class Circle extends Point { +class Circle extends Point { private int r; public Circle(Point p) { this(p, 0); } - public Circle(Point p, int r0) { super(p); r = r0; } + public Circle(Point p, int r) { super(p); this.r = r; } public Circle() { this(0); } - public Circle(int x0) { this(x0, 0); } - public Circle(int x0, int y0) { this(x0, y0, 0); } - public Circle(int x0, int y0, int r0) { super(x0, y0); r = r0; } + public Circle(int x) { this(x, 0); } + public Circle(int x, int y) { this(x, y, 0); } + public Circle(int x, int y, int r) { super(x, y); this.r = r; } public Circle(Circle c) { this(c.x, c.y, c.r); } - public int getR() { return r; } - public int setR(int r0) { r = r0; } - public void print() { System.out.println("Circle"); } - - public static void main(String args[]) { - Point p = new Point(); - Point c = new Circle(); - p.print(); - c.print(); - } + public int getR() { return this.r; } + public void setR(int r) { this.r = r; } + public void print() { System.out.println("Circle x: " + this.x + " y: " + this.y + " r: " + this.r); } +} + +public class test { + public static void main(String args[]) { + Point p = new Point(); + Point c = new Circle(); + p.print(); + c.print(); + } } diff --git a/Task/Polymorphism/Perl-6/polymorphism-1.pl6 b/Task/Polymorphism/Perl-6/polymorphism-1.pl6 index 7b3cc3e189..fe5e69ec86 100644 --- a/Task/Polymorphism/Perl-6/polymorphism-1.pl6 +++ b/Task/Polymorphism/Perl-6/polymorphism-1.pl6 @@ -1,16 +1,16 @@ class Point { - has Num $.x is rw = 0; - has Num $.y is rw = 0; + has Real $.x is rw = 0; + has Real $.y is rw = 0; method Str { $.perl } } class Circle { has Point $.p is rw = Point.new; - has Num $.r is rw = 0; + has Real $.r is rw = 0; method Str { $.perl } } -my $c = Circle.new(Point.new(x => 1, y => 2), r => 3); +my $c = Circle.new(p => Point.new(x => 1, y => 2), r => 3); say $c; $c.p.x = (-10..10).pick; $c.p.y = (-10..10).pick; diff --git a/Task/Polynomial-long-division/00DESCRIPTION b/Task/Polynomial-long-division/00DESCRIPTION index 9e9313ea86..04026c07a1 100644 --- a/Task/Polynomial-long-division/00DESCRIPTION +++ b/Task/Polynomial-long-division/00DESCRIPTION @@ -12,20 +12,15 @@ Then a pseudocode for the polynomial long division using the conventions describ polynomial_long_division('''N''', '''D''') ''returns'' ('''q''', '''r'''): // '''N''', '''D''', '''q''', '''r''' are vectors '''if''' degree('''D''') < 0 '''then''' ''error'' - '''if''' degree('''N''') ≥ degree('''D''') '''then''' - '''q''' ← '''0''' - '''while''' degree('''N''') ≥ degree('''D''') - '''d''' ← '''D''' ''shifted right'' ''by'' (degree('''N''') - degree('''D''')) - '''q'''(degree('''N''') - degree('''D''')) ← '''N'''(degree('''N''')) / '''d'''(degree('''d''')) - // by construction, degree('''d''') = degree('''N''') of course - '''d''' ← '''d''' * '''q'''(degree('''N''') - degree('''D''')) - '''N''' ← '''N''' - '''d''' - '''endwhile''' - '''r''' ← '''N''' - '''else''' - '''q''' ← '''0''' - '''r''' ← '''N''' - '''endif''' + '''q''' ← '''0''' + '''while''' degree('''N''') ≥ degree('''D''') + '''d''' ← '''D''' ''shifted right'' ''by'' (degree('''N''') - degree('''D''')) + '''q'''(degree('''N''') - degree('''D''')) ← '''N'''(degree('''N''')) / '''d'''(degree('''d''')) + // by construction, degree('''d''') = degree('''N''') of course + '''d''' ← '''d''' * '''q'''(degree('''N''') - degree('''D''')) + '''N''' ← '''N''' - '''d''' + '''endwhile''' + '''r''' ← '''N''' '''return''' ('''q''', '''r''') '''Note''': vector * scalar multiplies each element of the vector by the scalar; vectorA - vectorB subtracts each element of the vectorB from the element of the vectorA with "the same index". The vectors in the pseudocode are zero-based. diff --git a/Task/Polynomial-long-division/Elixir/polynomial-long-division.elixir b/Task/Polynomial-long-division/Elixir/polynomial-long-division.elixir new file mode 100644 index 0000000000..ddf8520b8c --- /dev/null +++ b/Task/Polynomial-long-division/Elixir/polynomial-long-division.elixir @@ -0,0 +1,31 @@ +defmodule Polynomial do + def division(_, []), do: raise ArgumentError, "denominator is zero" + def division(_, [0]), do: raise ArgumentError, "denominator is zero" + def division(f, g) when length(f) < length(g), do: {[0], f} + def division(f, g) do + {q, r} = division(g, [], f) + if q==[], do: q = [0] + if r==[], do: r = [0] + {q, r} + end + + defp division(g, q, r) when length(r) < length(g), do: {q, r} + defp division(g, q, r) do + p = hd(r) / hd(g) + r2 = Enum.zip(r, g) + |> Enum.with_index + |> Enum.reduce(r, fn {{pn,pg},i},acc -> + List.replace_at(acc, i, pn - p * pg) + end) + division(g, q++[p], tl(r2)) + end +end + +[ { [1, -12, 0, -42], [1, -3] }, + { [1, -12, 0, -42], [1, 1, -3] }, + { [1, 3, 2], [1, 1] }, + { [1, -4, 6, 5, 3], [1, 2, 1] } ] +|> Enum.each(fn {f,g} -> + {q, r} = Polynomial.division(f, g) + IO.puts "#{inspect f} / #{inspect g} => #{inspect q} remainder #{inspect r}" + end) diff --git a/Task/Polynomial-long-division/Perl-6/polynomial-long-division.pl6 b/Task/Polynomial-long-division/Perl-6/polynomial-long-division.pl6 index 5c1a5432ab..67b2c31b6a 100644 --- a/Task/Polynomial-long-division/Perl-6/polynomial-long-division.pl6 +++ b/Task/Polynomial-long-division/Perl-6/polynomial-long-division.pl6 @@ -19,6 +19,6 @@ my @polys = [ [ 1, -12, 0, -42 ], [ 1, -3 ] ], say '\begin{array}{rr}'; for @polys -> [ @a, @b ] { - printf "%s , & %s \\\\\n", poly_long_div( @a, @b ).map: { poly_print($_) }; + printf Q"%s , & %s \\\\\n", poly_long_div( @a, @b ).map: { poly_print($_) }; } say '\end{array}'; diff --git a/Task/Polynomial-regression/00DESCRIPTION b/Task/Polynomial-regression/00DESCRIPTION index 626f2cc997..74eeae9c60 100644 --- a/Task/Polynomial-regression/00DESCRIPTION +++ b/Task/Polynomial-regression/00DESCRIPTION @@ -1,11 +1,11 @@ -Find an approximating polynom of known degree for a given data. +Find an approximating polynomial of known degree for a given data. Example: For input data: x = {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10}; y = {1, 6, 17, 34, 57, 86, 121, 162, 209, 262, 321}; -The approximating polynom is: +The approximating polynomial is: 3 x2 + 2 x + 1 -Here, the polynom's coefficients are (3, 2, 1). +Here, the polynomial's coefficients are (3, 2, 1). This task is intended as a subtask for [[Measure relative performance of sorting algorithms implementations]]. diff --git a/Task/Polynomial-regression/C/polynomial-regression-2.c b/Task/Polynomial-regression/C/polynomial-regression-2.c index b4cb56acb0..aedf8441dd 100644 --- a/Task/Polynomial-regression/C/polynomial-regression-2.c +++ b/Task/Polynomial-regression/C/polynomial-regression-2.c @@ -16,7 +16,6 @@ bool polynomialfit(int obs, int degree, cov = gsl_matrix_alloc(degree, degree); for(i=0; i < obs; i++) { - gsl_matrix_set(X, i, 0, 1.0); for(j=0; j < degree; j++) { gsl_matrix_set(X, i, j, pow(dx[i], j)); } diff --git a/Task/Polynomial-regression/J/polynomial-regression-1.j b/Task/Polynomial-regression/J/polynomial-regression-1.j index 0f965a09f8..75bba20d61 100644 --- a/Task/Polynomial-regression/J/polynomial-regression-1.j +++ b/Task/Polynomial-regression/J/polynomial-regression-1.j @@ -1,3 +1,3 @@ - X=:i.# Y=:1 6 17 34 57 86 121 162 209 262 321 - Y (%. (^/ x:@i.@#)) X + Y=:1 6 17 34 57 86 121 162 209 262 321 + (%. ^/~@x:@i.@#) Y 1 2 3 0 0 0 0 0 0 0 0 diff --git a/Task/Polynomial-regression/J/polynomial-regression-2.j b/Task/Polynomial-regression/J/polynomial-regression-2.j index ab3867b90d..cb4b5a33a1 100644 --- a/Task/Polynomial-regression/J/polynomial-regression-2.j +++ b/Task/Polynomial-regression/J/polynomial-regression-2.j @@ -1,2 +1,2 @@ - Y (%. (i.3) ^/~ ]) X + Y %. (i.3) ^/~ i.#Y 1 2 3 diff --git a/Task/Polynomial-regression/PARI-GP/polynomial-regression-3.pari b/Task/Polynomial-regression/PARI-GP/polynomial-regression-3.pari index 4a9293087c..15c8d681f3 100644 --- a/Task/Polynomial-regression/PARI-GP/polynomial-regression-3.pari +++ b/Task/Polynomial-regression/PARI-GP/polynomial-regression-3.pari @@ -1,2 +1,2 @@ -lsf(X,Y,n)=my(M=matrix(#X,n,i,j,X[i]^(j-1))); Polrev(matsolve(M~*M,M~*Y~) -lsf([0..10], [1,6,17,34,57,86,121,162,209,262,321], 3) +lsf(X,Y,n)=my(M=matrix(#X,n+1,i,j,X[i]^(j-1))); Polrev(matsolve(M~*M,M~*Y~)) +lsf([0..10], [1,6,17,34,57,86,121,162,209,262,321], 2) diff --git a/Task/Polynomial-regression/Perl-6/polynomial-regression.pl6 b/Task/Polynomial-regression/Perl-6/polynomial-regression.pl6 new file mode 100644 index 0000000000..f83b5e6ef8 --- /dev/null +++ b/Task/Polynomial-regression/Perl-6/polynomial-regression.pl6 @@ -0,0 +1,20 @@ +use Clifford; + +constant @x1 = <0 1 2 3 4 5 6 7 8 9 10>; +constant @y = <1 6 17 34 57 86 121 162 209 262 321>; + +constant $x0 = [+] @e[^@x1]; +constant $x1 = [+] @x1 Z* @e; +constant $x2 = [+] @x1 »**» 2 Z* @e; + +constant $y = [+] @y Z* @e; + +my $J = $x1 ∧ $x2; +my $I = $x0 ∧ $J; + +my $I2 = ($I·$I.reversion).Real; + +.say for +(($y ∧ $J)·$I.reversion)/$I2, +(($y ∧ ($x2 ∧ $x0))·$I.reversion)/$I2, +(($y ∧ ($x0 ∧ $x1))·$I.reversion)/$I2; diff --git a/Task/Power-set/00DESCRIPTION b/Task/Power-set/00DESCRIPTION index 484da56a4a..12b970fbcc 100644 --- a/Task/Power-set/00DESCRIPTION +++ b/Task/Power-set/00DESCRIPTION @@ -1,20 +1,31 @@ {{omit from|GUISS}} -A [[set]] is a collection (container) of certain values, + +A   [[set]]   is a collection (container) of certain values, without any particular order, and no repeated values. + It corresponds with a finite set in mathematics. + A set can be implemented as an associative array (partial mapping) in which the value of each key-value pair is ignored. -Given a set S, the [[wp:Power_set|power set]] (or powerset) of S, written P(S), or 2S, is the set of all subsets of S.
    -'''Task : ''' By using a library or built-in set type, or by defining a set type with necessary operations, write a function with a set S as input that yields the power set 2S of S. +Given a set S, the [[wp:Power_set|power set]] (or powerset) of S, written P(S), or 2S, is the set of all subsets of S. -For example, the power set of {1,2,3,4} is {{}, {1}, {2}, {1,2}, {3}, {1,3}, {2,3}, {1,2,3}, {4}, {1,4}, {2,4}, {1,2,4}, {3,4}, {1,3,4}, {2,3,4}, {1,2,3,4}}. + +;Task: +By using a library or built-in set type, or by defining a set type with necessary operations, write a function with a set S as input that yields the power set 2S of S. + + +For example, the power set of     {1,2,3,4}     is +::: {{}, {1}, {2}, {1,2}, {3}, {1,3}, {2,3}, {1,2,3}, {4}, {1,4}, {2,4}, {1,2,4}, {3,4}, {1,3,4}, {2,3,4}, {1,2,3,4}}. For a set which contains n elements, the corresponding power set has 2n elements, including the edge cases of [[wp:Empty_set|empty set]].
    The power set of the empty set is the set which contains itself (20 = 1):
    -\mathcal{P}(\varnothing) = { \varnothing }
    +::: \mathcal{P}(\varnothing) = { \varnothing }
    + And the power set of the set which contains only the empty set, has two subsets, the empty set and the set which contains the empty set (21 = 2):
    -\mathcal{P}({\varnothing}) = { \varnothing, { \varnothing } }
    +::: \mathcal{P}({\varnothing}) = { \varnothing, { \varnothing } }
    + '''Extra credit: ''' Demonstrate that your language supports these last two powersets. +

    diff --git a/Task/Power-set/ATS/power-set.ats b/Task/Power-set/ATS/power-set.ats new file mode 100644 index 0000000000..8b3106a980 --- /dev/null +++ b/Task/Power-set/ATS/power-set.ats @@ -0,0 +1,83 @@ +(* ****** ****** *) +// +#include +"share/atspre_define.hats" // defines some names +#include +"share/atspre_staload.hats" // for targeting C +#include +"share/HATS/atspre_staload_libats_ML.hats" // for ... +// +(* ****** ****** *) +// +extern +fun +Power_set(xs: list0(int)): void +// +(* ****** ****** *) + +// Helper: fast power function. +fun power(n: int, p: int): int = + if p = 1 then n + else if p = 0 then 1 + else if p % 2 = 0 then power(n*n, p/2) + else n * power(n, p-1) + +fun print_list(list: list0(int)): void = + case+ list of + | nil0() => println!(" ") + | cons0(car, crd) => + let + val () = begin print car; print ','; end + val () = print_list(crd) + in + end + +fun get_list_length(list: list0(int), length: int): int = + case+ list of + | nil0() => length + | cons0(car, crd) => get_list_length(crd, length+1) + + +fun get_list_from_bit_mask(mask: int, list: list0(int), result: list0(int)): list0(int) = + if mask = 0 then result + else + case+ list of + | nil0() => result + | cons0(car, crd) => + let + val current: int = mask % 2 + in + if current = 0 then + get_list_from_bit_mask(mask >> 1, crd, result) + else + get_list_from_bit_mask(mask >> 1, crd, list0_cons(car, result)) + end + + +implement +Power_set(xs) = let + val len: int = get_list_length(xs, 0) + val pow: int = power(2, len) + fun loop(mask: int, list: list0(int)): void = + if mask > 0 && mask >= pow then () + else + let + val () = print_list(get_list_from_bit_mask(mask, list, list0_nil())) + in + loop(mask+1, list) + end + in + loop(0, xs) + end + +(* ****** ****** *) + +implement +main0() = +let + val xs: list0(int) = cons0(1, list0_pair(2, 3)) +in + Power_set(xs) +end (* end of [main0] *) + +(* ****** ****** *) diff --git a/Task/Power-set/AWK/power-set.awk b/Task/Power-set/AWK/power-set.awk new file mode 100644 index 0000000000..4b00922d73 --- /dev/null +++ b/Task/Power-set/AWK/power-set.awk @@ -0,0 +1,10 @@ +cat power_set.awk +#!/usr/local/bin/gawk -f + +# User defined function +function tochar(l,n, r) { + while (l) { n--; if (l%2 != 0) r = r sprintf(" %c ",49+n); l = int(l/2) }; return r +} + +# For each input +{ for (i=0;i<=2^NF-1;i++) if (i == 0) printf("empty\n"); else printf("(%s)\n",tochar(i,NF)) } diff --git a/Task/Power-set/AppleScript/power-set-1.applescript b/Task/Power-set/AppleScript/power-set-1.applescript new file mode 100644 index 0000000000..1e83709750 --- /dev/null +++ b/Task/Power-set/AppleScript/power-set-1.applescript @@ -0,0 +1,77 @@ +-- powerset :: [a] -> [[a]] +on powerset(xs) + script subSet + on lambda(acc, x) + script consX + on lambda(y) + {x} & y + end lambda + end script + + acc & map(consX, acc) + end lambda + end script + + foldr(subSet, {{}}, xs) +end powerset + +-------------------------------------------------------------------------------------- + +-- TEST +on run + script test + on lambda(x) + set {setName, setMembers} to x + {setName, powerset(setMembers)} + end lambda + end script + + map(test, [¬ + ["Set [1,2,3]", {1, 2, 3}], ¬ + ["Empty set", {}], ¬ + ["Set containing only empty set", {{}}]]) + + --> {{"Set [1,2,3]", {{}, {3}, {2}, {2, 3}, {1}, {1, 3}, {1, 2}, {1, 2, 3}}}, + --> {"Empty set", {{}}}, + --> {"Set containing only empty set", {{}, {{}}}}} + +end run + + +-- GENERIC FUNCTIONS --------------------------------------------------------------- + +-- foldr :: (a -> b -> a) -> a -> [b] -> a +on foldr(f, startValue, xs) + tell mReturn(f) + set v to startValue + set lng to length of xs + repeat with i from lng to 1 by -1 + set v to lambda(v, item i of xs, i, xs) + end repeat + return v + end tell +end foldr + +-- 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 + +-- 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 diff --git a/Task/Power-set/AppleScript/power-set-2.applescript b/Task/Power-set/AppleScript/power-set-2.applescript new file mode 100644 index 0000000000..622f91d2f9 --- /dev/null +++ b/Task/Power-set/AppleScript/power-set-2.applescript @@ -0,0 +1,3 @@ +{{"Set [1,2,3]", {{}, {3}, {2}, {2, 3}, {1}, {1, 3}, {1, 2}, {1, 2, 3}}}, + {"Empty set", {{}}}, + {"Set containing only empty set", {{}, {{}}}}} diff --git a/Task/Power-set/Go/power-set.go b/Task/Power-set/Go/power-set.go index 6ee8e0fc46..25b6f6c094 100644 --- a/Task/Power-set/Go/power-set.go +++ b/Task/Power-set/Go/power-set.go @@ -1,9 +1,9 @@ package main import ( - "bytes" - "fmt" - "strconv" + "bytes" + "fmt" + "strconv" ) // types needed to implement general purpose sets are element and set @@ -11,25 +11,25 @@ import ( // element is an interface, allowing different kinds of elements to be // implemented and stored in sets. type elem interface { - // an element must be distinguishable from other elements to satisfy - // the mathematical definition of a set. a.eq(b) must give the same - // result as b.eq(a). - Eq(elem) bool - // String result is used only for printable output. Given a, b where - // a.eq(b), it is not required that a.String() == b.String(). - fmt.Stringer + // an element must be distinguishable from other elements to satisfy + // the mathematical definition of a set. a.eq(b) must give the same + // result as b.eq(a). + Eq(elem) bool + // String result is used only for printable output. Given a, b where + // a.eq(b), it is not required that a.String() == b.String(). + fmt.Stringer } // integer type satisfying element interface type Int int func (i Int) Eq(e elem) bool { - j, ok := e.(Int) - return ok && i == j + j, ok := e.(Int) + return ok && i == j } func (i Int) String() string { - return strconv.Itoa(int(i)) + return strconv.Itoa(int(i)) } // a set is a slice of elem's. methods are added to implement @@ -38,80 +38,104 @@ type set []elem // uniqueness of elements can be ensured by using add method func (s *set) add(e elem) { - if !s.has(e) { - *s = append(*s, e) - } + if !s.has(e) { + *s = append(*s, e) + } } func (s *set) has(e elem) bool { - for _, ex := range *s { - if e.Eq(ex) { - return true - } - } - return false + for _, ex := range *s { + if e.Eq(ex) { + return true + } + } + return false +} + +func (s set) ok() bool { + for i, e0 := range s { + for _, e1 := range s[i+1:] { + if e0.Eq(e1) { + return false + } + } + } + return true } // elem.Eq func (s set) Eq(e elem) bool { - t, ok := e.(set) - if !ok { - return false - } - if len(s) != len(t) { - return false - } - for _, se := range s { - if !t.has(se) { - return false - } - } - return true + t, ok := e.(set) + if !ok { + return false + } + if len(s) != len(t) { + return false + } + for _, se := range s { + if !t.has(se) { + return false + } + } + return true } // elem.String func (s set) String() string { - if len(s) == 0 { - return "∅" - } - var buf bytes.Buffer - buf.WriteRune('{') - for i, e := range s { - if i > 0 { - buf.WriteRune(',') - } - buf.WriteString(e.String()) - } - buf.WriteRune('}') - return buf.String() + if len(s) == 0 { + return "∅" + } + var buf bytes.Buffer + buf.WriteRune('{') + for i, e := range s { + if i > 0 { + buf.WriteRune(',') + } + buf.WriteString(e.String()) + } + buf.WriteRune('}') + return buf.String() } // method required for task func (s set) powerSet() set { - r := set{set{}} - for _, es := range s { - var u set - for _, er := range r { - u = append(u, append(er.(set), es)) - } - r = append(r, u...) - } - return r + r := set{set{}} + for _, es := range s { + var u set + for _, er := range r { + er := er.(set) + u = append(u, append(er[:len(er):len(er)], es)) + } + r = append(r, u...) + } + return r } func main() { - var s set - for _, i := range []Int{1, 2, 2, 3, 4, 4, 4} { - s.add(i) - } - fmt.Println(" s:", s, "length:", len(s)) - ps := s.powerSet() - fmt.Println(" 𝑷(s):", ps, "length:", len(ps)) + var s set + for _, i := range []Int{1, 2, 2, 3, 4, 4, 4} { + s.add(i) + } + fmt.Println(" s:", s, "length:", len(s)) + ps := s.powerSet() + fmt.Println(" 𝑷(s):", ps, "length:", len(ps)) - var empty set - fmt.Println(" empty:", empty, "len:", len(empty)) - ps = empty.powerSet() - fmt.Println(" 𝑷(∅):", ps, "len:", len(ps)) - ps = ps.powerSet() - fmt.Println("𝑷(𝑷(∅)):", ps, "len:", len(ps)) + fmt.Println("\n(extra credit)") + var empty set + fmt.Println(" empty:", empty, "len:", len(empty)) + ps = empty.powerSet() + fmt.Println(" 𝑷(∅):", ps, "len:", len(ps)) + ps = ps.powerSet() + fmt.Println("𝑷(𝑷(∅)):", ps, "len:", len(ps)) + + fmt.Println("\n(regression test for earlier bug)") + s = set{Int(1), Int(2), Int(3), Int(4), Int(5)} + fmt.Println(" s:", s, "length:", len(s), "ok:", s.ok()) + ps = s.powerSet() + fmt.Println(" 𝑷(s):", "length:", len(ps), "ok:", ps.ok()) + for _, e := range ps { + if !e.(set).ok() { + panic("invalid set in ps") + } + } } diff --git a/Task/Power-set/Haskell/power-set-3.hs b/Task/Power-set/Haskell/power-set-3.hs index 5e532572a9..4ed8ea3c0a 100644 --- a/Task/Power-set/Haskell/power-set-3.hs +++ b/Task/Power-set/Haskell/power-set-3.hs @@ -1 +1,2 @@ +powerSet :: [a] -> [[a]] powerset = foldr (\x acc -> acc ++ map (x:) acc) [[]] diff --git a/Task/Power-set/JavaScript/power-set.js b/Task/Power-set/JavaScript/power-set-1.js similarity index 100% rename from Task/Power-set/JavaScript/power-set.js rename to Task/Power-set/JavaScript/power-set-1.js diff --git a/Task/Power-set/JavaScript/power-set-2.js b/Task/Power-set/JavaScript/power-set-2.js new file mode 100644 index 0000000000..90290fdd38 --- /dev/null +++ b/Task/Power-set/JavaScript/power-set-2.js @@ -0,0 +1,21 @@ +(function () { + + // translating: powerset = foldr (\x acc -> acc ++ map (x:) acc) [[]] + + function powerset(xs) { + return xs.reduceRight(function (a, x) { + return a.concat(a.map(function (y) { + return [x].concat(y); + })); + }, [[]]); + } + + + // TEST + return { + '[1,2,3] ->': powerset([1, 2, 3]), + 'empty set ->': powerset([]), + 'set which contains only the empty set ->': powerset([[]]) + } + +})(); diff --git a/Task/Power-set/JavaScript/power-set-3.js b/Task/Power-set/JavaScript/power-set-3.js new file mode 100644 index 0000000000..b4b100cf51 --- /dev/null +++ b/Task/Power-set/JavaScript/power-set-3.js @@ -0,0 +1,5 @@ +{ + "[1,2,3] ->":[[], [3], [2], [2, 3], [1], [1, 3], [1, 2], [1, 2, 3]], + "empty set ->":[[]], + "set which contains only the empty set ->":[[], [[]]] +} diff --git a/Task/Power-set/JavaScript/power-set-4.js b/Task/Power-set/JavaScript/power-set-4.js new file mode 100644 index 0000000000..3d907d1558 --- /dev/null +++ b/Task/Power-set/JavaScript/power-set-4.js @@ -0,0 +1,19 @@ +(() => { + 'use strict'; + + // powerset :: [a] -> [[a]] + const powerset = xs => + xs.reduceRight((a, x) => a.concat(a.map(y => [x].concat(y))), [ + [] + ]); + + + // TEST + return { + '[1,2,3] ->': powerset([1, 2, 3]), + 'empty set ->': powerset([]), + 'set which contains only the empty set ->': powerset([ + [] + ]) + }; +})() diff --git a/Task/Power-set/JavaScript/power-set-5.js b/Task/Power-set/JavaScript/power-set-5.js new file mode 100644 index 0000000000..d3022dda0b --- /dev/null +++ b/Task/Power-set/JavaScript/power-set-5.js @@ -0,0 +1,3 @@ +{"[1,2,3] ->":[[], [3], [2], [2, 3], [1], [1, 3], [1, 2], [1, 2, 3]], +"empty set ->":[[]], +"set which contains only the empty set ->":[[], [[]]]} diff --git a/Task/Power-set/REXX/power-set.rexx b/Task/Power-set/REXX/power-set.rexx index 8635fb47c7..8341884f08 100644 --- a/Task/Power-set/REXX/power-set.rexx +++ b/Task/Power-set/REXX/power-set.rexx @@ -1,30 +1,29 @@ -/*REXX pgm displays a power set, items may be anything (but can't have blanks)*/ -parse arg S /*allow the user specify optional set. */ -if S='' then S='one two three four' /*None specified? Then use the default*/ -N=words(S) /*the number of items in the list (set)*/ -@='{}' /*start process with a null power set. */ - do chunk=1 for N /*traipse through the items in the set.*/ - @=@ combN(N,chunk) /*take N items, a CHUNK at a time. */ - end /*chunk*/ -w=length(2**N) /*the number of items in the power set.*/ - do k=1 for words(@) /* [↓] show combinations, one per line*/ - say right(k,w) word(@,k) /*display a single combination to term.*/ - end /*k*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -combN: procedure expose S; parse arg x,y; base=x+1; bbase=base-y; !.=0 - do p=1 for y; !.p=p; end /*p*/ -$= - do j=1; L= - do d=1 for y; L=L','word(S,!.d) - end /*d*/ - $=$ '{'strip(L,'L',",")'}' - !.y=!.y+1; if !.y==base then if .combU(y-1) then leave - end /*j*/ -return strip($) /*return with a partial powerset chunk.*/ -/*────────────────────────────────────────────────────────────────────────────*/ -.combU: procedure expose !. y bbase; parse arg d; if d==0 then return 1; p=!.d - do u=d to y; !.u=p+1; if !.u==bbase+u then return .combU(u-1) - p=!.u - end /*u*/ -return 0 +/*REXX program displays a power set; items may be anything (but can't have blanks).*/ +parse arg S /*allow the user specify optional set. */ +if S='' then S= 'one two three four' /*Not specified? Then use the default.*/ +@='{}' /*start process with a null power set. */ +N=words(S); do chunk=1 for N /*traipse through the items in the set.*/ + @=@ combN(N, chunk) /*take N items, a CHUNK at a time. */ + end /*chunk*/ +w=length(2**N) /*the number of items in the power set.*/ + do k=1 for words(@) /* [↓] show combinations, one per line*/ + say right(k, w) word(@, k) /*display a single combination to term.*/ + end /*k*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +combN: procedure expose S; parse arg x,y; base=x+1; bbase=base-y; !.=0 + do p=1 for y; !.p=p; end /*p*/ + $= + do j=1; L= + do d=1 for y; L=L','word(S, !.d) + end /*d*/ + $=$ '{'strip(L, "L", ',')"}" + !.y=!.y+1; if !.y==base then if .combU(y-1) then leave + end /*j*/ + return strip($) /*return with a partial powerset chunk.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +.combU: procedure expose !. y bbase; parse arg d; if d==0 then return 1; p=!.d + do u=d to y; !.u=p+1; if !.u==bbase+u then return .combU(u-1) + p=!.u + end /*u*/ + return 0 diff --git a/Task/Power-set/Scala/power-set-3.scala b/Task/Power-set/Scala/power-set-3.scala new file mode 100644 index 0000000000..470c8c5fd4 --- /dev/null +++ b/Task/Power-set/Scala/power-set-3.scala @@ -0,0 +1,7 @@ +def powerset[A](s: Set[A]) = { + def powerset_rec(acc: List[Set[A]], remaining: List[A]): List[Set[A]] = remaining match { + case Nil => acc + case head :: tail => powerset_rec(acc ++ acc.map(_ + head), tail) + } + powerset_rec(List(Set.empty[A]), s.toList) +} diff --git a/Task/Pragmatic-directives/00DESCRIPTION b/Task/Pragmatic-directives/00DESCRIPTION index b617089d19..0d2f07d80b 100644 --- a/Task/Pragmatic-directives/00DESCRIPTION +++ b/Task/Pragmatic-directives/00DESCRIPTION @@ -1,3 +1,6 @@ -Pragmatic directives cause the language to operate in a specific manner, allowing support for operational variances within the program code (possibly by the loading of specific or alternative modules). +Pragmatic directives cause the language to operate in a specific manner,   allowing support for operational variances within the program code   (possibly by the loading of specific or alternative modules). -The task is to list any pragmatic directives supported by the language, demonstrate how to activate and deactivate the pragmatic directives and to describe or demonstate the scope of effect that the pragmatic directives have within a program. + +;Task: +List any pragmatic directives supported by the language,   and demonstrate how to activate and deactivate the pragmatic directives and to describe or demonstrate the scope of effect that the pragmatic directives have within a program. +

    diff --git a/Task/Pragmatic-directives/PL-I/pragmatic-directives-1.pli b/Task/Pragmatic-directives/PL-I/pragmatic-directives-1.pli new file mode 100644 index 0000000000..b58b85fe78 --- /dev/null +++ b/Task/Pragmatic-directives/PL-I/pragmatic-directives-1.pli @@ -0,0 +1,3 @@ + declare (t(100),i) fixed binary; + i=101; + t(i)=0; diff --git a/Task/Pragmatic-directives/PL-I/pragmatic-directives-2.pli b/Task/Pragmatic-directives/PL-I/pragmatic-directives-2.pli new file mode 100644 index 0000000000..ad61f4ce81 --- /dev/null +++ b/Task/Pragmatic-directives/PL-I/pragmatic-directives-2.pli @@ -0,0 +1,5 @@ + (SubscriptRange): begin; + declare (t(100),i) fixed binary; + i=101; + t(i)=0; + end; diff --git a/Task/Pragmatic-directives/PL-I/pragmatic-directives-3.pli b/Task/Pragmatic-directives/PL-I/pragmatic-directives-3.pli new file mode 100644 index 0000000000..e691597a93 --- /dev/null +++ b/Task/Pragmatic-directives/PL-I/pragmatic-directives-3.pli @@ -0,0 +1,7 @@ + (SubscriptRange): begin; + declare (t(100),i) fixed binary; + i=101; + on SubscriptRange begin; put skip list('error on t(i)'); goto e; end; + t(i)=0; + e:on SubscriptRange system; /* default dehaviour */ + end; diff --git a/Task/Pragmatic-directives/PowerShell/pragmatic-directives-1.psh b/Task/Pragmatic-directives/PowerShell/pragmatic-directives-1.psh new file mode 100644 index 0000000000..f37c572c31 --- /dev/null +++ b/Task/Pragmatic-directives/PowerShell/pragmatic-directives-1.psh @@ -0,0 +1,5 @@ +#Requires -Version [.] +#Requires –PSSnapin [-Version [.]] +#Requires -Modules { | } +#Requires –ShellId +#Requires -RunAsAdministrator diff --git a/Task/Pragmatic-directives/PowerShell/pragmatic-directives-2.psh b/Task/Pragmatic-directives/PowerShell/pragmatic-directives-2.psh new file mode 100644 index 0000000000..60f71313d0 --- /dev/null +++ b/Task/Pragmatic-directives/PowerShell/pragmatic-directives-2.psh @@ -0,0 +1 @@ +Get-Help about_Requires diff --git a/Task/Price-fraction/00DESCRIPTION b/Task/Price-fraction/00DESCRIPTION index f003a333b2..da799db0b4 100644 --- a/Task/Price-fraction/00DESCRIPTION +++ b/Task/Price-fraction/00DESCRIPTION @@ -1,6 +1,8 @@ -A friend of mine runs a pharmacy. He has a specialised function in his Dispensary application which receives a decimal value of currency and replaces it to a standard value. This value is regulated by a government department. +A friend of mine runs a pharmacy.   He has a specialized function in his Dispensary application which receives a decimal value of currency and replaces it to a standard value.   This value is regulated by a government department. -Task: Given a floating point value between 0.00 and 1.00, rescale according to the following table: + +;Task: +Given a floating point value between   0.00   and   1.00,   rescale according to the following table: >= 0.00 < 0.06 := 0.10 >= 0.06 < 0.11 := 0.18 @@ -22,3 +24,4 @@ Task: Given a floating point value between 0.00 and 1.00, rescale according to t >= 0.86 < 0.91 := 0.94 >= 0.91 < 0.96 := 0.98 >= 0.96 < 1.01 := 1.00 +

    diff --git a/Task/Price-fraction/Lua/price-fraction.lua b/Task/Price-fraction/Lua/price-fraction.lua new file mode 100644 index 0000000000..bbede1ceac --- /dev/null +++ b/Task/Price-fraction/Lua/price-fraction.lua @@ -0,0 +1,22 @@ +scaleTable = { + {0.06, 0.10}, {0.11, 0.18}, {0.16, 0.26}, {0.21, 0.32}, + {0.26, 0.38}, {0.31, 0.44}, {0.36, 0.50}, {0.41, 0.54}, + {0.46, 0.58}, {0.51, 0.62}, {0.56, 0.66}, {0.61, 0.70}, + {0.66, 0.74}, {0.71, 0.78}, {0.76, 0.82}, {0.81, 0.86}, + {0.86, 0.90}, {0.91, 0.94}, {0.96, 0.98}, {1.01, 1.00} +} + +function rescale (price) + if price < 0 or price > 1 then return "Out of range!" end + for k, v in pairs(scaleTable) do + if price < v[1] then return v[2] end + end +end + +math.randomseed(os.time()) +for i = 1, 5 do + rnd = math.random() + print("Random value:", rnd) + print("Adjusted price:", rescale(rnd)) + print() +end diff --git a/Task/Price-fraction/Maple/price-fraction.maple b/Task/Price-fraction/Maple/price-fraction.maple new file mode 100644 index 0000000000..a700263dd5 --- /dev/null +++ b/Task/Price-fraction/Maple/price-fraction.maple @@ -0,0 +1,18 @@ +priceFraction := proc(price) + local values, standard, newPrice, i; + values := [0, 0.06, 0.11, 0.16, 0.21, 0.26, 0.31, 0.36, 0.41, 0.46, 0.51, 0.56, 0.61, + 0.66, 0.71, 0.76, 0.81, 0.86, 0.91, 0.96, 1.01]; + standard := [0.10, 0.18, 0.26, 0.32, 0.38, 0.44, 0.50, 0.54, 0.58, 0.62, 0.66, 0.70, + 0.74, 0.78, 0.82, 0.86, 0.90, 0.94, 0.98, 1.00]; + for i to numelems(standard) do + if price >= values[i] and price < values[i+1] then + newPrice := standard[i]; + end if; + end do; + printf("%f --> %.2f\n", price, newPrice); +end proc: + +randomize(): +for i to 5 do + priceFraction (rand(0.0..1.0)()); +end do; diff --git a/Task/Price-fraction/Perl-6/price-fraction-1.pl6 b/Task/Price-fraction/Perl-6/price-fraction-1.pl6 index 8bb1da2598..12f135981c 100644 --- a/Task/Price-fraction/Perl-6/price-fraction-1.pl6 +++ b/Task/Price-fraction/Perl-6/price-fraction-1.pl6 @@ -1,35 +1,26 @@ -my $table = q:to/END/; ->= 0.00 < 0.06 := 0.10 ->= 0.06 < 0.11 := 0.18 ->= 0.11 < 0.16 := 0.26 ->= 0.16 < 0.21 := 0.32 ->= 0.21 < 0.26 := 0.38 ->= 0.26 < 0.31 := 0.44 ->= 0.31 < 0.36 := 0.50 ->= 0.36 < 0.41 := 0.54 ->= 0.41 < 0.46 := 0.58 ->= 0.46 < 0.51 := 0.62 ->= 0.51 < 0.56 := 0.66 ->= 0.56 < 0.61 := 0.70 ->= 0.61 < 0.66 := 0.74 ->= 0.66 < 0.71 := 0.78 ->= 0.71 < 0.76 := 0.82 ->= 0.76 < 0.81 := 0.86 ->= 0.81 < 0.86 := 0.90 ->= 0.86 < 0.91 := 0.94 ->= 0.91 < 0.96 := 0.98 ->= 0.96 < 1.01 := 1.00 -END - -my $value = 0.44; - -say price($value); - -sub price($value) -{ - for $table.lines -> $line { - $line ~~ / '>=' \s+ (\S+) \s+ '<' \s+ (\S+) \s+ ':=' \s+ (\S+)/; - return $2 if $0 <= $value < $1; - } - fail "Out of range"; +sub price-fraction ($n where 0..1) { + when $n < 0.06 { 0.10 } + when $n < 0.11 { 0.18 } + when $n < 0.16 { 0.26 } + when $n < 0.21 { 0.32 } + when $n < 0.26 { 0.38 } + when $n < 0.31 { 0.44 } + when $n < 0.36 { 0.50 } + when $n < 0.41 { 0.54 } + when $n < 0.46 { 0.58 } + when $n < 0.51 { 0.62 } + when $n < 0.56 { 0.66 } + when $n < 0.61 { 0.70 } + when $n < 0.66 { 0.74 } + when $n < 0.71 { 0.78 } + when $n < 0.76 { 0.82 } + when $n < 0.81 { 0.86 } + when $n < 0.86 { 0.90 } + when $n < 0.91 { 0.94 } + when $n < 0.96 { 0.98 } + default { 1.00 } +} + +while prompt("value: ") -> $value { + say price-fraction(+$value); } diff --git a/Task/Price-fraction/Perl-6/price-fraction-2.pl6 b/Task/Price-fraction/Perl-6/price-fraction-2.pl6 index 0233fa9693..c6f79e6ae6 100644 --- a/Task/Price-fraction/Perl-6/price-fraction-2.pl6 +++ b/Task/Price-fraction/Perl-6/price-fraction-2.pl6 @@ -22,5 +22,5 @@ my @price = map *.value, flat ; while prompt("value: ") -> $value { - say @price[ $value * 100 ] // note "Out of range"; + say @price[$value * 100] // "Out of range"; } diff --git a/Task/Price-fraction/Perl-6/price-fraction-3.pl6 b/Task/Price-fraction/Perl-6/price-fraction-3.pl6 index 6188b12ea9..5ae78f18c4 100644 --- a/Task/Price-fraction/Perl-6/price-fraction-3.pl6 +++ b/Task/Price-fraction/Perl-6/price-fraction-3.pl6 @@ -1,28 +1,33 @@ -sub price_fraction ( Rat() $n where { $^n >= 0 and $^n <= 1 } ) { - ( $n < 0.06 ) ?? 0.10 - !! ( $n < 0.11 ) ?? 0.18 - !! ( $n < 0.16 ) ?? 0.26 - !! ( $n < 0.21 ) ?? 0.32 - !! ( $n < 0.26 ) ?? 0.38 - !! ( $n < 0.31 ) ?? 0.44 - !! ( $n < 0.36 ) ?? 0.50 - !! ( $n < 0.41 ) ?? 0.54 - !! ( $n < 0.46 ) ?? 0.58 - !! ( $n < 0.51 ) ?? 0.62 - !! ( $n < 0.56 ) ?? 0.66 - !! ( $n < 0.61 ) ?? 0.70 - !! ( $n < 0.66 ) ?? 0.74 - !! ( $n < 0.71 ) ?? 0.78 - !! ( $n < 0.76 ) ?? 0.82 - !! ( $n < 0.81 ) ?? 0.86 - !! ( $n < 0.86 ) ?? 0.90 - !! ( $n < 0.91 ) ?? 0.94 - !! ( $n < 0.96 ) ?? 0.98 - !! 1.00 - ; +my $table = q:to/END/; +>= 0.00 < 0.06 := 0.10 +>= 0.06 < 0.11 := 0.18 +>= 0.11 < 0.16 := 0.26 +>= 0.16 < 0.21 := 0.32 +>= 0.21 < 0.26 := 0.38 +>= 0.26 < 0.31 := 0.44 +>= 0.31 < 0.36 := 0.50 +>= 0.36 < 0.41 := 0.54 +>= 0.41 < 0.46 := 0.58 +>= 0.46 < 0.51 := 0.62 +>= 0.51 < 0.56 := 0.66 +>= 0.56 < 0.61 := 0.70 +>= 0.61 < 0.66 := 0.74 +>= 0.66 < 0.71 := 0.78 +>= 0.71 < 0.76 := 0.82 +>= 0.76 < 0.81 := 0.86 +>= 0.81 < 0.86 := 0.90 +>= 0.86 < 0.91 := 0.94 +>= 0.91 < 0.96 := 0.98 +>= 0.96 < 1.01 := 1.00 +END + +my @price; + +for $table.lines { + /:s '>=' (\S+) '<' (\S+) ':=' (\S+)/; + @price[$0*100 ..^ $1*100] »=» +$2; } while prompt("value: ") -> $value { - last if $value ~~ /exit|quit/; - say price_fraction(+$value); + say @price[$value * 100] // "Out of range"; } diff --git a/Task/Primality-by-trial-division/00DESCRIPTION b/Task/Primality-by-trial-division/00DESCRIPTION index f0af36a7ef..50e15b8acf 100644 --- a/Task/Primality-by-trial-division/00DESCRIPTION +++ b/Task/Primality-by-trial-division/00DESCRIPTION @@ -1,6 +1,19 @@ -Write a boolean function that tells whether a given integer is prime. Remember that 1 and all non-positive numbers are not prime. +;Task: +Write a boolean function that tells whether a given integer is prime. -Use trial division. Even numbers over two may be eliminated right away. -A loop from 3 to √n will suffice, but other loops are allowed. -* Related tasks: [[Sequence of primes by Trial Division]], [[Sieve of Eratosthenes]], [[Prime decomposition]], [[AKS test for primes]]. +Remember that   '''1'''   and all non-positive numbers are not prime. + +Use trial division. + +Even numbers over two may be eliminated right away. + +A loop from   '''3'''   to   '''√{{overline| n }}  ''' will suffice,   but other loops are allowed. + + +;Related tasks: +*   [[Sequence of primes by Trial Division]] +*   [[Sieve of Eratosthenes]] +*   [[Prime decomposition]] +*   [[AKS test for primes]]. +

    diff --git a/Task/Primality-by-trial-division/BASIC/primality-by-trial-division-2.basic b/Task/Primality-by-trial-division/BASIC/primality-by-trial-division-2.basic index 3726e7cc2e..26d11ae225 100644 --- a/Task/Primality-by-trial-division/BASIC/primality-by-trial-division-2.basic +++ b/Task/Primality-by-trial-division/BASIC/primality-by-trial-division-2.basic @@ -1,6 +1,6 @@ 10 LET n=0: LET p=0 20 INPUT "Enter number: ";n -30 GO SUB 1000 +30 IF n>1 THEN GO SUB 1000 40 IF p=0 THEN PRINT n;" is not prime!" 50 IF p<>0 THEN PRINT n;" is prime!" 60 GO TO 10 diff --git a/Task/Primality-by-trial-division/Go/primality-by-trial-division-1.go b/Task/Primality-by-trial-division/Go/primality-by-trial-division-1.go index a9033d098f..0094827767 100644 --- a/Task/Primality-by-trial-division/Go/primality-by-trial-division-1.go +++ b/Task/Primality-by-trial-division/Go/primality-by-trial-division-1.go @@ -1,12 +1,13 @@ func IsPrime(n int) bool { if n < 0 { n = -n } switch { + case n == 2: + return true case n < 2 || n % 2 == 0: return false - case n == 2: - return true + default: - for i = 3; i*i < n; i += 2 { + for i = 3; i*i <= n; i += 2 { if n % i == 0 { return false } } } diff --git a/Task/Primality-by-trial-division/Go/primality-by-trial-division-2.go b/Task/Primality-by-trial-division/Go/primality-by-trial-division-2.go index 93883d80d9..09a81691e2 100644 --- a/Task/Primality-by-trial-division/Go/primality-by-trial-division-2.go +++ b/Task/Primality-by-trial-division/Go/primality-by-trial-division-2.go @@ -7,7 +7,7 @@ func IsPrime(n int) bool { } func isPrime_r(n, i int) bool { - if i*i < n { + if i*i <= n { return n % i != 0 && isPrime_r(n, i+2) } return true diff --git a/Task/Primality-by-trial-division/Haskell/primality-by-trial-division-1.hs b/Task/Primality-by-trial-division/Haskell/primality-by-trial-division-1.hs index f8507c2768..e85dde5e68 100644 --- a/Task/Primality-by-trial-division/Haskell/primality-by-trial-division-1.hs +++ b/Task/Primality-by-trial-division/Haskell/primality-by-trial-division-1.hs @@ -1 +1 @@ -isPrime n = n==2 || n>2 && all ((> 0).rem n) (2:[3,5..floor.sqrt(fromIntegral n+1)]) +isPrime n = n==2 || n>2 && all ((> 0).rem n) (2:[3,5..floor.sqrt.fromIntegral $ n+1]) diff --git a/Task/Primality-by-trial-division/Haskell/primality-by-trial-division-2.hs b/Task/Primality-by-trial-division/Haskell/primality-by-trial-division-2.hs index a30a416982..e25319b8b5 100644 --- a/Task/Primality-by-trial-division/Haskell/primality-by-trial-division-2.hs +++ b/Task/Primality-by-trial-division/Haskell/primality-by-trial-division-2.hs @@ -1,6 +1,7 @@ noDivsBy factors n = foldr (\f r-> f*f>n || ((rem n f /= 0) && r)) True factors -- primeNums = filter (noDivsBy [2..]) [2..] +-- = 2 : filter (noDivsBy [3,5..]) [3,5..] primeNums = 2 : 3 : filter (noDivsBy $ tail primeNums) [5,7..] isPrime n = n > 1 && noDivsBy primeNums n diff --git a/Task/Primality-by-trial-division/Haskell/primality-by-trial-division-3.hs b/Task/Primality-by-trial-division/Haskell/primality-by-trial-division-3.hs index 698797d55c..1f6147b86d 100644 --- a/Task/Primality-by-trial-division/Haskell/primality-by-trial-division-3.hs +++ b/Task/Primality-by-trial-division/Haskell/primality-by-trial-division-3.hs @@ -1 +1 @@ -primesFromTo n m = filter isPrime [n..m] +isPrime n = n > 1 && []==[i | i <- [2..n-1], rem n i == 0] diff --git a/Task/Primality-by-trial-division/Haskell/primality-by-trial-division-4.hs b/Task/Primality-by-trial-division/Haskell/primality-by-trial-division-4.hs index 297b95fec7..3a88d9ade8 100644 --- a/Task/Primality-by-trial-division/Haskell/primality-by-trial-division-4.hs +++ b/Task/Primality-by-trial-division/Haskell/primality-by-trial-division-4.hs @@ -1,2 +1 @@ -primes = sieve [2..] where - sieve (p:xs) = p : sieve [x | x <- xs, x `mod` p /= 0] +isPrime n = n > 1 && []==[i | i <- [2..n-1], isPrime i && rem n i == 0] diff --git a/Task/Primality-by-trial-division/JavaScript/primality-by-trial-division.js b/Task/Primality-by-trial-division/JavaScript/primality-by-trial-division.js index 1ad82b968b..c0a279b141 100644 --- a/Task/Primality-by-trial-division/JavaScript/primality-by-trial-division.js +++ b/Task/Primality-by-trial-division/JavaScript/primality-by-trial-division.js @@ -1,5 +1,5 @@ function isPrime(n) { - if (n == 2) { + if (n == 2 || n == 3 || n == 5 || n == 7) { return true; } else if ((n < 2) || (n % 2 == 0)) { return false; diff --git a/Task/Primality-by-trial-division/Liberty-BASIC/primality-by-trial-division.liberty b/Task/Primality-by-trial-division/Liberty-BASIC/primality-by-trial-division.liberty index 5301d9c1cb..62cae99dfc 100644 --- a/Task/Primality-by-trial-division/Liberty-BASIC/primality-by-trial-division.liberty +++ b/Task/Primality-by-trial-division/Liberty-BASIC/primality-by-trial-division.liberty @@ -1,22 +1,17 @@ -for n =1 to 50 - if prime( n) = 1 then print n; " is prime." -next n +print "Rosetta Code - Primality by trial division" +print +[start] +input "Enter an integer: "; x +if x=0 then print "Program complete.": end +if isPrime(x) then print x; " is prime" else print x; " is not prime" +goto [start] -wait - -function prime( n) - if n =2 then - prime =1 - else - if ( n <=1) or ( n mod 2 =0) then - prime =0 - else - prime =1 - for i = 3 to int( sqr( n)) step 2 - if ( n MOD i) =0 then prime = 0: exit function - next i - end if - end if +function isPrime(p) + p=int(abs(p)) + if p=2 or then isPrime=1: exit function 'prime + if p=0 or p=1 or (p mod 2)=0 then exit function 'not prime + for i=3 to sqr(p) step 2 + if (p mod i)=0 then exit function 'not prime + next i + isPrime=1 end function - -end diff --git a/Task/Primality-by-trial-division/Perl-6/primality-by-trial-division-1.pl6 b/Task/Primality-by-trial-division/Perl-6/primality-by-trial-division-1.pl6 index e265878db9..6453ce17b2 100644 --- a/Task/Primality-by-trial-division/Perl-6/primality-by-trial-division-1.pl6 +++ b/Task/Primality-by-trial-division/Perl-6/primality-by-trial-division-1.pl6 @@ -1,3 +1,3 @@ sub prime (Int $i --> Bool) { - $i > 1 and $i %% none 2, 3, *+2 ...^ * >= sqrt $i; + $i > 1 and so $i %% none 2..$i.sqrt; } diff --git a/Task/Primality-by-trial-division/REXX/primality-by-trial-division-1.rexx b/Task/Primality-by-trial-division/REXX/primality-by-trial-division-1.rexx index 0b693ddaca..8341632309 100644 --- a/Task/Primality-by-trial-division/REXX/primality-by-trial-division-1.rexx +++ b/Task/Primality-by-trial-division/REXX/primality-by-trial-division-1.rexx @@ -1,22 +1,21 @@ -/*REXX program tests for primality using (kinda smartish) trial division*/ -parse arg n .; if n=='' then n=10000 /*let user choose the upper limit*/ -tell=(n>0); n=abs(n) /*display primes only if N > 0 */ -p=0 /*a count of primes (so far). */ - do j=-57 to n /*start in the cellar and work up*/ - if \isPrime(j) then iterate /*if not prime, keep looking. */ - p=p+1 /*bump the jelly bean counter. */ - if tell then say right(j,20) 'is prime.' /*maybe show the prime.*/ +/*REXX program tests for primality by using (kinda smartish) trial division. */ +parse arg n .; if n=='' then n=10000 /*let the user choose the upper limit. */ +tell=(n>0); n=abs(n) /*display the primes only if N > 0. */ +p=0 /*a count of the primes found (so far).*/ + do j=-57 to n /*start in the cellar and work up. */ + if \isPrime(j) then iterate /*if not prime, then keep looking. */ + p=p+1 /*bump the jelly bean counter. */ + if tell then say right(j,20) 'is prime.' /*maybe display prime to the terminal. */ end /*j*/ say -say "There are " p " primes up to " n ' (inclusive).' -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────ISPRIME subroutine──────────────────*/ -isPrime: procedure; parse arg x /*get the number in question*/ -if wordpos(x,'2 3 5 7')\==0 then return 1 /*is number a teacher's pet?*/ -if x<2 | x//2==0 | x//3==0 then return 0 /*weed out the riff-raff. */ - - do k=5 by 6 until k*k>x /*skips odd multiples of 3. */ - if x//k==0 | x//(k+2)==0 then return 0 /*a pair of divides. ___*/ - end /*k*/ /*divide up through the √ x.*/ - /*Note: // is remainder.*/ -return 1 /*done dividing, it's prime.*/ +say "There are " p " primes up to " n ' (inclusive).' +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +isPrime: procedure; parse arg x /*get the number to be tested. */ + if wordpos(x, '2 3 5 7')\==0 then return 1 /*is number a teacher's pet? */ + if x<2 | x//2==0 | x//3==0 then return 0 /*weed out the riff-raff. */ + do k=5 by 6 until k*k>x /*skips odd multiples of 3. */ + if x//k==0 | x//(k+2)==0 then return 0 /*a pair of divides. ___ */ + end /*k*/ /*divide up through the √ x */ + /*Note: // is ÷ remainder.*/ + return 1 /*done dividing, it's prime. */ diff --git a/Task/Primality-by-trial-division/REXX/primality-by-trial-division-2.rexx b/Task/Primality-by-trial-division/REXX/primality-by-trial-division-2.rexx index fae0b627cf..b8afb7f1e1 100644 --- a/Task/Primality-by-trial-division/REXX/primality-by-trial-division-2.rexx +++ b/Task/Primality-by-trial-division/REXX/primality-by-trial-division-2.rexx @@ -1,23 +1,22 @@ -/*REXX program tests for primality using (kinda smartish) trial division*/ -parse arg n .; if n=='' then n=10000 /*let user choose the upper limit*/ -tell=(n>0); n=abs(n) /*display primes only if N > 0 */ -p=0 /*a count of primes (so far). */ - do j=-57 to n /*start in the cellar and work up*/ - if \isPrime(j) then iterate /*if not prime, then keep looking*/ - p=p+1 /*bump the jelly bean counter. */ - if tell then say right(j,20) 'is prime.' /*maybe show the prime.*/ +/*REXX program tests for primality by using (kinda smartish) trial division. */ +parse arg n .; if n=='' then n=10000 /*let the user choose the upper limit. */ +tell=(n>0); n=abs(n) /*display the primes only if N > 0. */ +p=0 /*a count of the primes found (so far).*/ + do j=-57 to n /*start in the cellar and work up. */ + if \isPrime(j) then iterate /*if not prime, then keep looking. */ + p=p+1 /*bump the jelly bean counter. */ + if tell then say right(j,20) 'is prime.' /*maybe display prime to the terminal. */ end /*j*/ say -say "There are " p " primes up to " n ' (inclusive).' -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────ISPRIME subroutine──────────────────*/ -isPrime: procedure; parse arg x /*get integer to be investigated.*/ -if x<11 then return wordpos(x,'2 3 5 7')\==0 /*is it a wee prime?*/ -if x//2==0 then return 0 /*eliminate all the even numbers.*/ -if x//3==0 then return 0 /* ··· and eliminate the triples.*/ - - do k=5 by 6 until k*k>x /*this skips odd multiples of 3. */ - if x//k ==0 then return 0 /*perform a divide (modulus), */ - if x//(k+2)==0 then return 0 /* ··· and the next umpty one. */ - end /*k*/ /*Note: REXX // is remainder*/ -return 1 /*did all divisions, it's prime. */ +say "There are " p " primes up to " n ' (inclusive).' +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +isPrime: procedure; parse arg x /*get integer to be investigated.*/ + if x<11 then return wordpos(x, '2 3 5 7')\==0 /*is it a wee prime? */ + if x//2==0 then return 0 /*eliminate all the even numbers.*/ + if x//3==0 then return 0 /* ··· and eliminate the triples.*/ + do k=5 by 6 until k*k>x /*this skips odd multiples of 3. */ + if x//k ==0 then return 0 /*perform a divide (modulus), */ + if x//(k+2)==0 then return 0 /* ··· and the next umpty one. */ + end /*k*/ /*Note: REXX // is ÷ remainder.*/ + return 1 /*did all divisions, it's prime. */ diff --git a/Task/Primality-by-trial-division/REXX/primality-by-trial-division-3.rexx b/Task/Primality-by-trial-division/REXX/primality-by-trial-division-3.rexx index 55ba3e170c..bbc635e32f 100644 --- a/Task/Primality-by-trial-division/REXX/primality-by-trial-division-3.rexx +++ b/Task/Primality-by-trial-division/REXX/primality-by-trial-division-3.rexx @@ -1,51 +1,49 @@ -/*REXX program tests for primality using (kinda smartish) trial division*/ -parse arg n .; if n=='' then n=10000 /*let user choose the upper limit*/ -tell=(n>0); n=abs(n) /*display primes only if N > 0 */ -p=0 /*a count of primes (so far). */ - do j=-57 to n /*start in the cellar and work up*/ - if \isPrime(j) then iterate /*if not prime, then keep looking*/ - p=p+1 /*bump the jelly bean counter. */ - if tell then say right(j,20) 'is prime.' /*maybe show the prime.*/ +/*REXX program tests for primality by using (kinda smartish) trial division. */ +parse arg n .; if n=='' then n=10000 /*let the user choose the upper limit. */ +tell=(n>0); n=abs(n) /*display the primes only if N > 0. */ +p=0 /*a count of the primes found (so far).*/ + do j=-57 to n /*start in the cellar and work up. */ + if \isPrime(j) then iterate /*if not prime, then keep looking. */ + p=p+1 /*bump the jelly bean counter. */ + if tell then say right(j,20) 'is prime.' /*maybe display prime to the terminal. */ end /*j*/ say -say "There are " p " primes up to " n ' (inclusive).' -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────ISPRIME subroutine──────────────────*/ -isPrime: procedure; parse arg x /*get integer to be investigated.*/ -if x<107 then return wordpos(x, '2 3 5 7', /*test for some low primes*/ - '11 13 17 19 23 29 31 37 41 43 47 53', /*list of ··*/ - '59 61 67 71 73 79 83 89 97 101 103')\==0 /*loo primes*/ - -if x// 2 ==0 then return 0 /*eliminate all the even numbers.*/ -if x// 3 ==0 then return 0 /* ··· and eliminate the triples.*/ -if right(x,1) ==5 then return 0 /* ··· and eliminate the nickels.*/ -if x// 7 ==0 then return 0 /* ··· and eliminate the luckies.*/ -if x//11 ==0 then return 0 -if x//13 ==0 then return 0 -if x//17 ==0 then return 0 -if x//19 ==0 then return 0 -if x//23 ==0 then return 0 -if x//29 ==0 then return 0 -if x//31 ==0 then return 0 -if x//37 ==0 then return 0 -if x//41 ==0 then return 0 -if x//43 ==0 then return 0 -if x//47 ==0 then return 0 -if x//53 ==0 then return 0 -if x//59 ==0 then return 0 -if x//61 ==0 then return 0 -if x//67 ==0 then return 0 -if x//71 ==0 then return 0 -if x//73 ==0 then return 0 -if x//79 ==0 then return 0 -if x//83 ==0 then return 0 -if x//89 ==0 then return 0 -if x//97 ==0 then return 0 -if x//101==0 then return 0 -if x//103==0 then return 0 - /*Note: REXX // is remainder*/ - do k=107 by 6 while k*k<=x /*this skips odd multiples of 3. */ - if x//k ==0 then return 0 /*perform a divide (modulus), */ - if x//(k+2)==0 then return 0 /* ··· and the next also. ___ */ - end /*k*/ /*divide up through the √ x. */ -return 1 /*after all that, ··· it's prime.*/ +say "There are " p " primes up to " n ' (inclusive).' +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +isPrime: procedure; parse arg x /*get the integer to be investigated. */ + if x<107 then return wordpos(x, '2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53', + '59 61 67 71 73 79 83 89 97 101 103')\==0 /*some low primes.*/ + if x// 2 ==0 then return 0 /*eliminate all the even numbers. */ + if x// 3 ==0 then return 0 /* ··· and eliminate the triples. */ + parse var x '' -1 _ /* obtain the rightmost digit.*/ + if _ ==5 then return 0 /* ··· and eliminate the nickels. */ + if x// 7 ==0 then return 0 /* ··· and eliminate the luckies. */ + if x//11 ==0 then return 0 + if x//13 ==0 then return 0 + if x//17 ==0 then return 0 + if x//19 ==0 then return 0 + if x//23 ==0 then return 0 + if x//29 ==0 then return 0 + if x//31 ==0 then return 0 + if x//37 ==0 then return 0 + if x//41 ==0 then return 0 + if x//43 ==0 then return 0 + if x//47 ==0 then return 0 + if x//53 ==0 then return 0 + if x//59 ==0 then return 0 + if x//61 ==0 then return 0 + if x//67 ==0 then return 0 + if x//71 ==0 then return 0 + if x//73 ==0 then return 0 + if x//79 ==0 then return 0 + if x//83 ==0 then return 0 + if x//89 ==0 then return 0 + if x//97 ==0 then return 0 + if x//101==0 then return 0 + if x//103==0 then return 0 /*Note: REXX // is ÷ remainder. */ + do k=107 by 6 while k*k<=x /*this skips odd multiples of three. */ + if x//k ==0 then return 0 /*perform a divide (modulus), */ + if x//(k+2)==0 then return 0 /* ··· and the next also. ___ */ + end /*k*/ /*divide up through the √ x */ + return 1 /*after all that, ··· it's a prime. */ diff --git a/Task/Primality-by-trial-division/Seed7/primality-by-trial-division.seed7 b/Task/Primality-by-trial-division/Seed7/primality-by-trial-division.seed7 index 99397bf068..e0f5aa6352 100644 --- a/Task/Primality-by-trial-division/Seed7/primality-by-trial-division.seed7 +++ b/Task/Primality-by-trial-division/Seed7/primality-by-trial-division.seed7 @@ -1,4 +1,4 @@ -const func boolean: is_prime (in integer: number) is func +const func boolean: isPrime (in integer: number) is func result var boolean: prime is FALSE; local @@ -7,9 +7,7 @@ const func boolean: is_prime (in integer: number) is func begin if number = 2 then prime := TRUE; - elsif number rem 2 = 0 or number <= 1 then - prime := FALSE; - else + elsif odd(number) and number > 2 then upTo := sqrt(number); while number rem testNum <> 0 and testNum <= upTo do testNum +:= 2; diff --git a/Task/Prime-decomposition/00DESCRIPTION b/Task/Prime-decomposition/00DESCRIPTION index 9ce1a9b86a..aa4226b773 100644 --- a/Task/Prime-decomposition/00DESCRIPTION +++ b/Task/Prime-decomposition/00DESCRIPTION @@ -1,10 +1,16 @@ {{omit from|GUISS}} + The prime decomposition of a number is defined as a list of prime numbers which when all multiplied together, are equal to that number. -Example: 12 = 2 × 2 × 3, so its prime decomposition is {2, 2, 3} -Write a function which returns an [[Arrays|array]] or [[Collections|collection]] which contains the prime decomposition of a given number, n, greater than 1. +;Example: + 12 = 2 × 2 × 3, so its prime decomposition is {2, 2, 3} + + +;Task: +Write a function which returns an [[Arrays|array]] or [[Collections|collection]] which contains the prime decomposition of a given number   n   greater than   '''1'''. + If your language does not have an isPrime-like function available, you may assume that you have a function which determines whether a number is prime (note its name before your code). @@ -13,5 +19,9 @@ If you would like to test code from this task, you may use code from [[Primality Note: The program must not be limited by the word size of your computer or some other artificial limit; it should work for any number regardless of size (ignoring the physical limits of RAM etc). -See also: -* [[Factors of an integer]] + +;Related tasks: +*   [[Factors of an integer]] +*   [[Primality by trial division]] +*   [[Sieve of Eratosthenes]] +

    diff --git a/Task/Prime-decomposition/Ela/prime-decomposition.ela b/Task/Prime-decomposition/Ela/prime-decomposition.ela new file mode 100644 index 0000000000..74f7f9486e --- /dev/null +++ b/Task/Prime-decomposition/Ela/prime-decomposition.ela @@ -0,0 +1,9 @@ +open integer //arbitrary sized integers + +decompose_prime n = loop n 2I + where + loop c p | c < (p * p) = [c] + | c % p == 0I = p :: (loop (c / p) p) + | else = loop c (p + 1I) + +decompose_prime 600851475143I diff --git a/Task/Prime-decomposition/Haskell/prime-decomposition-1.hs b/Task/Prime-decomposition/Haskell/prime-decomposition-1.hs index 627b0ba6cd..f7c369892a 100644 --- a/Task/Prime-decomposition/Haskell/prime-decomposition-1.hs +++ b/Task/Prime-decomposition/Haskell/prime-decomposition-1.hs @@ -1,3 +1,5 @@ -factorize n = concat [divs n p | p <- [2..n], isPrime p] - where - divs n p = if rem n p==0 then p:divs (quot n p) p else [] +factorize n = [ d | p <- [2..n], isPrime p, d <- divs n p ] + -- [2..n] >>= (\p-> [p|isPrime p]) >>= divs n + where + divs n p | rem n p == 0 = p : divs (quot n p) p + | otherwise = [] diff --git a/Task/Prime-decomposition/Haskell/prime-decomposition-2.hs b/Task/Prime-decomposition/Haskell/prime-decomposition-2.hs index 239fcff53c..40d5f2c3bd 100644 --- a/Task/Prime-decomposition/Haskell/prime-decomposition-2.hs +++ b/Task/Prime-decomposition/Haskell/prime-decomposition-2.hs @@ -1,6 +1,11 @@ -factorize n = divs n primesList - where - divs n ds@(d:t) | d*d > n = [n | n > 1] - | r == 0 = d : divs q ds - | otherwise = divs n t - where (q,r) = quotRem n d +import Data.Maybe (listToMaybe) +import Data.List (unfoldr) + +factorize :: Integer -> [Integer] +factorize n + = unfoldr (\n -> listToMaybe [(x, div n x) | x <- [2..n], mod n x==0]) n + = unfoldr (\(d,n) -> listToMaybe [(x, (x, div n x)) | x <- [d..n], mod n x==0]) (2,n) + = unfoldr (\(d,n) -> listToMaybe [(x, (x, div n x)) | x <- + takeWhile ((<=n).(^2)) [d..] ++ [n|n>1], mod n x==0]) (2,n) + = unfoldr (\(ds,n) -> listToMaybe [(x, (dropWhile (< x) ds, div n x)) | n>1, x <- + takeWhile ((<=n).(^2)) ds ++ [n|n>1], mod n x==0]) (primesList,n) diff --git a/Task/Prime-decomposition/Haskell/prime-decomposition-3.hs b/Task/Prime-decomposition/Haskell/prime-decomposition-3.hs index 869419d4cc..7a016e1abf 100644 --- a/Task/Prime-decomposition/Haskell/prime-decomposition-3.hs +++ b/Task/Prime-decomposition/Haskell/prime-decomposition-3.hs @@ -1,22 +1,6 @@ -import Test.HUnit -import Data.List - -factor::Int->[Int] -factor 1 = [] -factor n - | product primeDivisor == n = primeDivisor - | otherwise = primeDivisor ++ factor (div n $ product primeDivisor) - where - primeDivisor = filter isPrime $ filter (isDivisor n) [2 .. n] - isDivisor n d = (==) 0 $ mod n d - isPrime n = not $ any (isDivisor n) [2 .. n-1] - -tests = TestList[TestCase $ assertEqual "1 has no prime factors" [] $ factor 1 - ,TestCase $ assertEqual "2 is 2" [2] $ factor 2 - ,TestCase $ assertEqual "3 is 3" [3] $ factor 3 - ,TestCase $ assertEqual "4 is 2*2" [2, 2] $ factor 4 - ,TestCase $ assertEqual "5 is 5" [5] $ factor 5 - ,TestCase $ assertEqual "6 is 2*3" [2, 3] $ factor 6 - ,TestCase $ assertEqual "7 is 7" [7] $ factor 7 - ,TestCase $ assertEqual "8 is 2*2*2" [2, 2, 2] $ factor 8 - ,TestCase $ assertEqual "large number" [2, 3, 3, 5, 7, 11, 13] $ sort $ factor (2*9*5*7*11*13)] +factorize n = divs n primesList + where + divs n ds@(d:t) | d*d > n = [n | n > 1] + | r == 0 = d : divs q ds + | otherwise = divs n t + where (q,r) = quotRem n d diff --git a/Task/Prime-decomposition/Perl-6/prime-decomposition-1.pl6 b/Task/Prime-decomposition/Perl-6/prime-decomposition-1.pl6 new file mode 100644 index 0000000000..04c519e268 --- /dev/null +++ b/Task/Prime-decomposition/Perl-6/prime-decomposition-1.pl6 @@ -0,0 +1,31 @@ +sub prime-factors ( Int $n where * > 0 ) { + return $n if $n.is-prime; + return [] if $n == 1; + my $factor = find-factor( $n ); + sort flat prime-factors( $factor ), prime-factors( $n div $factor ); +} + +sub find-factor ( Int $n, $constant = 1 ) { + my $x = 2; + my $rho = 1; + my $factor = 1; + while $factor == 1 { + $rho *= 2; + my $fixed = $x; + for ^$rho { + $x = ( $x * $x + $constant ) % $n; + $factor = ( $x - $fixed ) gcd $n; + last if 1 < $factor; + } + } + $factor = find-factor( $n, $constant + 1 ) if $n == $factor; + $factor; +} + +for 2²⁹-1, 2⁴¹-1, 2⁵⁹-1, 2⁷¹-1, 2⁷⁹-1, 2⁹⁷-1, 2¹¹⁷-1, +5465610891074107968111136514192945634873647594456118359804135903459867604844945580205745718497 + -> $n { + my $start = now; + say "factors of $n: ", + prime-factors($n).join(' × '), " \t in ", (now - $start).fmt("%0.3f"), " sec." +} diff --git a/Task/Prime-decomposition/Perl-6/prime-decomposition-2.pl6 b/Task/Prime-decomposition/Perl-6/prime-decomposition-2.pl6 new file mode 100644 index 0000000000..9a34928543 --- /dev/null +++ b/Task/Prime-decomposition/Perl-6/prime-decomposition-2.pl6 @@ -0,0 +1,16 @@ +use Inline::Perl5; +my $p5 = Inline::Perl5.new(); +$p5.use( 'ntheory' ); + +sub prime-factors ($i) { + my &primes = $p5.run('sub { map { ntheory::todigitstring $_ } sort {$a <=> $b} ntheory::factor $_[0] }'); + primes("$i"); +} + +for 2²⁹-1, 2⁴¹-1, 2⁵⁹-1, 2⁷¹-1, 2⁷⁹-1, 2⁹⁷-1, 2¹¹⁷-1, +5465610891074107968111136514192945634873647594456118359804135903459867604844945580205745718497 + -> $n { + my $start = now; + say "factors of $n: ", + prime-factors($n).join(' × '), " \t in ", (now - $start).fmt("%0.3f"), " sec." +} diff --git a/Task/Prime-decomposition/Perl-6/prime-decomposition.pl6 b/Task/Prime-decomposition/Perl-6/prime-decomposition.pl6 deleted file mode 100644 index a14292a7aa..0000000000 --- a/Task/Prime-decomposition/Perl-6/prime-decomposition.pl6 +++ /dev/null @@ -1,23 +0,0 @@ -constant @primes = 2, 3, 5, -> *@p { - my $n = @p[*-1]; - repeat { $n += 2 } while $n %% any @p.grep: * **2 <= $n; - $n; -} ... *; - -sub factors(Int $remainder is copy) { - return 1 if $remainder <= 1; - gather for @primes -> $factor { - if $factor * $factor > $remainder { - take $remainder if $remainder > 1; - last; - } - - # How many times can we divide by this prime? - while $remainder %% $factor { - take $factor; - last if ($remainder div= $factor) === 1; - } - } -} - -say factors 536870911; diff --git a/Task/Prime-decomposition/Prolog/prime-decomposition-3.pro b/Task/Prime-decomposition/Prolog/prime-decomposition-3.pro new file mode 100644 index 0000000000..7118541f74 --- /dev/null +++ b/Task/Prime-decomposition/Prolog/prime-decomposition-3.pro @@ -0,0 +1,16 @@ +factors( N, FS):- + factors2( N, FS). + +factors2( N, FS):- + ( N < 2 -> FS = [] + ; 4 > N -> FS = [N] + ; 0 is N rem 2 -> FS = [K|FS2], N2 is N div 2, factors2( N2, FS2) + ; factors( N, 3, FS) + ). + +factors( N, K, FS):- + ( N < 2 -> FS = [] + ; K*K > N -> FS = [N] + ; 0 is N rem K -> FS = [K|FS2], N2 is N div K, factors( N2, K, FS2) + ; K2 is K+2, factors( N, K2, FS) + ). diff --git a/Task/Prime-decomposition/R/prime-decomposition.r b/Task/Prime-decomposition/R/prime-decomposition.r index 60bafc131b..8bb21b347e 100644 --- a/Task/Prime-decomposition/R/prime-decomposition.r +++ b/Task/Prime-decomposition/R/prime-decomposition.r @@ -1,15 +1,15 @@ -findfactors <- function(n) { - d <- c() - div <- 2; nxt <- 3; rest <- n - while( rest != 1 ) { - while( rest%%div == 0 ) { - d <- c(d, div) - rest <- floor(rest / div) +findfactors <- function(num) { + x <- c() + 1stprime<- 2; 2ndprime <- 3; everyprime <- num + while( everyprime != 1 ) { + while( everyprime%%1stprime == 0 ) { + x <- c(x, 1stprime) + everyprime <- floor(everyprime/ 1stprime) } - div <- nxt - nxt <- nxt + 2 + 1stprime <- 2ndprime + 2ndprime <- 2ndprime + 2 } - d + x } -print(findfactors(1005025)) +print(findfactors(1027*4)) diff --git a/Task/Prime-decomposition/REXX/prime-decomposition-1.rexx b/Task/Prime-decomposition/REXX/prime-decomposition-1.rexx new file mode 100644 index 0000000000..a0f015fb8f --- /dev/null +++ b/Task/Prime-decomposition/REXX/prime-decomposition-1.rexx @@ -0,0 +1,43 @@ +/*REXX pgm does prime decomposition of a range of positive integers (with a prime count)*/ +numeric digits 1000 /*handle thousand digits for the powers*/ +parse arg bot top step base add /*get optional arguments from the C.L. */ +if bot=='' then do; bot=1; top=100; end /*no BOT given? Then use the default.*/ +if top=='' then top=bot /* " TOP? " " " " " */ +if step=='' then step= 1 /* " STEP? " " " " " */ +if add =='' then add= -1 /* " ADD? " " " " " */ +tell= top>0; top=abs(top) /*if TOP is negative, suppress displays*/ +w=length(top) /*get maximum width for aligned display*/ +if base\=='' then w=length(base**top) /*will be testing powers of two later? */ +@.=left('', 7); @.0="{unity}"; @.1='[prime]' /*some literals: pad; prime (or not).*/ +numeric digits max(9, w+1) /*maybe increase the digits precision. */ +#=0 /*#: is the number of primes found. */ + do n=bot to top by step /*process a single number or a range.*/ + ?=n; if base\=='' then ?=base**n + add /*should we perform a "Mercenne" test? */ + pf=factr(?); f=words(pf) /*get prime factors; number of factors.*/ + if f==1 then #=#+1 /*Is N prime? Then bump prime counter.*/ + if tell then say right(?,w) right('('f")",9) 'prime factors: ' @.f pf + end /*n*/ +say +ps= 'primes'; if p==1 then ps= "prime" /*setup for proper English in sentence.*/ +say right(#, w+9+1) ps 'found.' /*display the number of primes found. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +factr: procedure; parse arg x 1 d,$ /*set X, D to argument 1; $ to null.*/ +if x==1 then return '' /*handle the special case of X = 1. */ + do while x//2==0; $=$ 2; x=x%2; end /*append all the 2 factors of new X.*/ + do while x//3==0; $=$ 3; x=x%3; end /* " " " 3 " " " " */ + do while x//5==0; $=$ 5; x=x%5; end /* " " " 5 " " " " */ + do while x//7==0; $=$ 7; x=x%7; end /* " " " 7 " " " " */ + /* ___*/ +q=1; do while q<=x; q=q*4; end /*these two lines compute integer √ X */ +r=0; do while q>1; q=q%4; _=d-r-q; r=r%2; if _>=0 then do; d=_; r=r+q; end; end + + do j=11 by 6 to r /*insure that J isn't divisible by 3.*/ + parse var j '' -1 _ /*obtain the last decimal digit of J. */ + if _\==5 then do while x//j==0; $=$ j; x=x%j; end /*maybe reduce by J. */ + if _ ==3 then iterate /*Is next Y is divisible by 5? Skip.*/ + y=j+2; do while x//y==0; $=$ y; x=x%y; end /*maybe reduce by J. */ + end /*j*/ + /* [↓] The $ list has a leading blank.*/ +if x==1 then return $ /*Is residual=unity? Then don't append.*/ + return $ x /*return $ with appended residual. */ diff --git a/Task/Prime-decomposition/REXX/prime-decomposition-2.rexx b/Task/Prime-decomposition/REXX/prime-decomposition-2.rexx new file mode 100644 index 0000000000..e231bf982e --- /dev/null +++ b/Task/Prime-decomposition/REXX/prime-decomposition-2.rexx @@ -0,0 +1,48 @@ +/*REXX pgm does prime decomposition of a range of positive integers (with a prime count)*/ +numeric digits 1000 /*handle thousand digits for the powers*/ +parse arg bot top step base add /*get optional arguments from the C.L. */ +if bot=='' then do; bot=1; top=100; end /*no BOT given? Then use the default.*/ +if top=='' then top=bot /* " TOP? " " " " " */ +if step=='' then step= 1 /* " STEP? " " " " " */ +if add =='' then add= -1 /* " ADD? " " " " " */ +tell= top>0; top=abs(top) /*if TOP is negative, suppress displays*/ +w=length(top) /*get maximum width for aligned display*/ +if base\=='' then w=length(base**top) /*will be testing powers of two later? */ +@.=left('', 7); @.0="{unity}"; @.1='[prime]' /*some literals: pad; prime (or not).*/ +numeric digits max(9, w+1) /*maybe increase the digits precision. */ +#=0 /*#: is the number of primes found. */ + do n=bot to top by step /*process a single number or a range.*/ + ?=n; if base\=='' then ?=base**n + add /*should we perform a "Mercenne" test? */ + pf=factr(?); f=words(pf) /*get prime factors; number of factors.*/ + if f==1 then #=#+1 /*Is N prime? Then bump prime counter.*/ + if tell then say right(?,w) right('('f")",9) 'prime factors: ' @.f pf + end /*n*/ +say +ps= 'primes'; if p==1 then ps= "prime" /*setup for proper English in sentence.*/ +say right(#, w+9+1) ps 'found.' /*display the number of primes found. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +factr: procedure; parse arg x 1 d,$ /*set X, D to argument 1; $ to null.*/ +if x==1 then return '' /*handle the special case of X = 1. */ + do while x// 2==0; $=$ 2; x=x%2; end /*append all the 2 factors of new X.*/ + do while x// 3==0; $=$ 3; x=x%3; end /* " " " 3 " " " " */ + do while x// 5==0; $=$ 5; x=x%5; end /* " " " 5 " " " " */ + do while x// 7==0; $=$ 7; x=x%7; end /* " " " 7 " " " " */ + do while x//11==0; $=$ 11; x=x%11; end /* " " " 11 " " " " */ /* ◄■■■■ added.*/ + do while x//13==0; $=$ 13; x=x%13; end /* " " " 13 " " " " */ /* ◄■■■■ added.*/ + do while x//17==0; $=$ 17; x=x%17; end /* " " " 17 " " " " */ /* ◄■■■■ added.*/ + do while x//19==0; $=$ 19; x=x%19; end /* " " " 19 " " " " */ /* ◄■■■■ added.*/ + do while x//23==0; $=$ 23; x=x%23; end /* " " " 23 " " " " */ /* ◄■■■■ added.*/ + /* ___*/ +q=1; do while q<=x; q=q*4; end /*these two lines compute integer √ X */ +r=0; do while q>1; q=q%4; _=d-r-q; r=r%2; if _>=0 then do; d=_; r=r+q; end; end + + do j=29 by 6 to r /*insure that J isn't divisible by 3.*/ /* ◄■■■■ changed.*/ + parse var j '' -1 _ /*obtain the last decimal digit of J. */ + if _\==5 then do while x//j==0; $=$ j; x=x%j; end /*maybe reduce by J. */ + if _ ==3 then iterate /*Is next Y is divisible by 5? Skip.*/ + y=j+2; do while x//y==0; $=$ y; x=x%y; end /*maybe reduce by J. */ + end /*j*/ + /* [↓] The $ list has a leading blank.*/ +if x==1 then return $ /*Is residual=unity? Then don't append.*/ + return $ x /*return $ with appended residual. */ diff --git a/Task/Prime-decomposition/REXX/prime-decomposition.rexx b/Task/Prime-decomposition/REXX/prime-decomposition.rexx deleted file mode 100644 index cc1a6b2481..0000000000 --- a/Task/Prime-decomposition/REXX/prime-decomposition.rexx +++ /dev/null @@ -1,43 +0,0 @@ -/*REXX program performs prime decomposition for a range of positive integer(s)*/ -numeric digits 1000 /*handle thousand digits for the powers*/ -parse arg bot top step base add /*get optional arguments from the C.L. */ -if bot=='' then do;bot=1;top=100;end /*no BOT given? Then use the default.*/ -if top=='' then top=bot /* " TOP? " " " " " */ -if step=='' then step=1 /* " STEP? " " " " " */ -if add =='' then add=-1 /* " ADD? " " " " " */ -w=length(top) /*get maximum width for aligned display*/ -if base\=='' then w=length(base**top) /*will be testing powers of two later? */ -@.=left('',7); @.0='{unity}'; @.1='[prime]' /*literals: prime (or not)*/ -numeric digits max(9,w+1) /*maybe increase the digits precision. */ -#=0 /*P: is the number of primes found. */ - do n=bot to top by step /*process a single number or a range.*/ - ?=n; if base\=='' then ?=base**n+add /*do a "Mercenne" test? */ - pf=factr(?); f=words(pf) /*get prime factors; number of factors.*/ - if f==1 then #=#+1 /*Is N prime? Then bump prime counter.*/ - say right(?,w) right('('f")",9) 'prime factors: ' @.f pf -iterate - end /*n*/ -say -ps='primes'; if p==1 then ps='prime' /*setup for proper English in sentence.*/ -say right(#,w+9+1) ps 'found.' /*display the number of primes found. */ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -factr: procedure; parse arg x 1 z 1 d,$ /*set X and Z to argument; $ to null*/ -if x==1 then return '' /*handle the special case of X equal 1.*/ - do while z//2==0; $=$ 2; z=z%2; end /*append all the 2 factors.*/ - do while z//3==0; $=$ 3; z=z%3; end /* " " " 3 " */ - do while z//5==0; $=$ 5; z=z%5; end /* " " " 5 " */ - do while z//7==0; $=$ 7; z=z%7; end /* " " " 7 " */ - /* ___ */ -q=1; do while q<=x; q=q*4; end /*these 2 lines compute √ X */ -r=0; do while q>1; q=q%4; _=d-r-q; r=r%2; if _>=0 then do; d=_;r=r+q;end; end - - do j=11 by 6 to r /*insure that J isn't divisible by 3.*/ - parse var j '' -1 _ /*obtain the last decimal digit of J. */ - if _\==5 then do while z//j==0; $=$ j; z=z%j; end /*maybe reduce*/ - if _ ==3 then iterate /*if next Y is divisible by 5, skip.*/ - y=j+2; do while z//y==0; $=$ y; z=z%y; end /*maybe reduce*/ - end /*j*/ - /* [↓] The $ list has a leading blank.*/ -if z==1 then return $ /*if residual=unity, then don't append.*/ - return $ z /*return $ with appended residual. */ diff --git a/Task/Prime-decomposition/TXR/prime-decomposition.txr b/Task/Prime-decomposition/TXR/prime-decomposition.txr index 478b40d3b4..1f0cf2b007 100644 --- a/Task/Prime-decomposition/TXR/prime-decomposition.txr +++ b/Task/Prime-decomposition/TXR/prime-decomposition.txr @@ -2,10 +2,10 @@ @(do (defun factor (n) (if (> n 1) - (for ((max-d (sqrt n)) + (for ((max-d (isqrt n)) (d 2)) - (t) - ((set d (if (evenp d) (+ d 1) (+ d 2)))) + () + ((inc d (if (evenp d) 1 2))) (cond ((> d max-d) (return (list n))) ((zerop (mod n d)) (return (cons d (factor (trunc n d)))))))))) diff --git a/Task/Priority-queue/Batch-File/priority-queue.bat b/Task/Priority-queue/Batch-File/priority-queue.bat new file mode 100644 index 0000000000..e442c24f1e --- /dev/null +++ b/Task/Priority-queue/Batch-File/priority-queue.bat @@ -0,0 +1,29 @@ +@echo off +setlocal enabledelayedexpansion + +call :push 10 "item ten" +call :push 2 "item two" +call :push 100 "item one hundred" +call :push 5 "item five" + +call :pop & echo !order! !item! +call :pop & echo !order! !item! +call :pop & echo !order! !item! +call :pop & echo !order! !item! +call :pop & echo !order! !item! + +goto:eof + + +:push +set temp=000%1 +set queu%temp:~-3%=%2 +goto:eof + +:pop +set queu >nul 2>nul +if %errorlevel% equ 1 (set order=-1&set item=no more items & goto:eof) +for /f "tokens=1,2 delims==" %%a in ('set queu') do set %%a=& set order=%%a& set item=%%~b& goto:next +:next +set order= %order:~-3% +goto:eof diff --git a/Task/Priority-queue/C/priority-queue.c b/Task/Priority-queue/C/priority-queue.c new file mode 100644 index 0000000000..00a7acebad --- /dev/null +++ b/Task/Priority-queue/C/priority-queue.c @@ -0,0 +1,72 @@ +#include +#include + +typedef struct { + int priority; + char *data; +} node_t; + +typedef struct { + node_t *nodes; + int len; + int size; +} heap_t; + +void push (heap_t *h, int priority, char *data) { + if (h->len + 1 >= h->size) { + h->size = h->size ? h->size * 2 : 4; + h->nodes = (node_t *)realloc(h->nodes, h->size * sizeof (node_t)); + } + int i = h->len + 1; + int j = i / 2; + while (i > 1 && h->nodes[j].priority > priority) { + h->nodes[i] = h->nodes[j]; + i = j; + j = j / 2; + } + h->nodes[i].priority = priority; + h->nodes[i].data = data; + h->len++; +} + +char *pop (heap_t *h) { + int i, j, k; + if (!h->len) { + return NULL; + } + char *data = h->nodes[1].data; + h->nodes[1] = h->nodes[h->len]; + h->len--; + i = 1; + while (1) { + k = i; + j = 2 * i; + if (j <= h->len && h->nodes[j].priority < h->nodes[k].priority) { + k = j; + } + if (j + 1 <= h->len && h->nodes[j + 1].priority < h->nodes[k].priority) { + k = j + 1; + } + if (k == i) { + break; + } + h->nodes[i] = h->nodes[k]; + i = k; + } + h->nodes[i] = h->nodes[h->len + 1]; + return data; +} + +int main () { + heap_t *h = (heap_t *)calloc(1, sizeof (heap_t)); + push(h, 3, "Clear drains"); + push(h, 4, "Feed cat"); + push(h, 5, "Make tea"); + push(h, 1, "Solve RC tasks"); + push(h, 2, "Tax return"); + int i; + for (i = 0; i < 5; i++) { + printf("%s\n", pop(h)); + } + return 0; +} diff --git a/Task/Priority-queue/Elixir/priority-queue.elixir b/Task/Priority-queue/Elixir/priority-queue.elixir new file mode 100644 index 0000000000..94ec228878 --- /dev/null +++ b/Task/Priority-queue/Elixir/priority-queue.elixir @@ -0,0 +1,30 @@ +defmodule Priority do + def create, do: :gb_trees.empty + + def insert( element, priority, queue ), do: :gb_trees.enter( priority, element, queue ) + + def peek( queue ) do + {_priority, element, _new_queue} = :gb_trees.take_smallest( queue ) + element + end + + def task do + items = [{3, "Clear drains"}, {4, "Feed cat"}, {5, "Make tea"}, {1, "Solve RC tasks"}, {2, "Tax return"}] + queue = Enum.reduce(items, create, fn({priority, element}, acc) -> insert( element, priority, acc ) end) + IO.puts "peek priority: #{peek( queue )}" + Enum.reduce(1..length(items), queue, fn(_n, q) -> write_top( q ) end) + end + + def top( queue ) do + {_priority, element, new_queue} = :gb_trees.take_smallest( queue ) + {element, new_queue} + end + + defp write_top( q ) do + {element, new_queue} = top( q ) + IO.puts "top priority: #{element}" + new_queue + end +end + +Priority.task diff --git a/Task/Priority-queue/Java/priority-queue.java b/Task/Priority-queue/Java/priority-queue.java index 382ed6b144..f62fcc8a9f 100644 --- a/Task/Priority-queue/Java/priority-queue.java +++ b/Task/Priority-queue/Java/priority-queue.java @@ -17,7 +17,7 @@ class Task implements Comparable { return priority < other.priority ? -1 : priority > other.priority ? 1 : 0; } - public static final void main(String[] args) { + public static void main(String[] args) { PriorityQueue pq = new PriorityQueue(); pq.add(new Task(3, "Clear drains")); pq.add(new Task(4, "Feed cat")); diff --git a/Task/Priority-queue/Kotlin/priority-queue.kotlin b/Task/Priority-queue/Kotlin/priority-queue.kotlin new file mode 100644 index 0000000000..09e78d057c --- /dev/null +++ b/Task/Priority-queue/Kotlin/priority-queue.kotlin @@ -0,0 +1,20 @@ +import java.util.PriorityQueue + +internal data class Task(val priority: Int, val name: String) : Comparable { + override fun compareTo(other: Task) = when { + priority < other.priority -> -1 + priority > other.priority -> 1 + else -> 0 + } +} + +private infix fun String.priority(priority: Int) = Task(priority, this) + +fun main(args: Array) { + val q = PriorityQueue(listOf("Clear drains" priority 3, + "Feed cat" priority 4, + "Make tea" priority 5, + "Solve RC tasks" priority 1, + "Tax return" priority 2)) + while (q.any()) println(q.remove()) +} diff --git a/Task/Priority-queue/R/priority-queue-1.r b/Task/Priority-queue/R/priority-queue-1.r index dc8d056b25..cd4c4b6b0b 100644 --- a/Task/Priority-queue/R/priority-queue-1.r +++ b/Task/Priority-queue/R/priority-queue-1.r @@ -1,19 +1,18 @@ PriorityQueue <- function() { keys <- values <- NULL insert <- function(key, value) { - temp <- c(keys, key) - ord <- order(temp) - keys <<- temp[ord] - values <<- c(values, list(value))[ord] + ord <- findInterval(key, keys) + keys <<- append(keys, key, ord) + values <<- append(values, value, ord) } pop <- function() { - head <- values[[1]] + head <- list(key=keys[1],value=values[[1]]) values <<- values[-1] keys <<- keys[-1] return(head) } empty <- function() length(keys) == 0 - list(insert = insert, pop = pop, empty = empty) + environment() } pq <- PriorityQueue() @@ -23,5 +22,5 @@ pq$insert(5, "Make tea") pq$insert(1, "Solve RC tasks") pq$insert(2, "Tax return") while(!pq$empty()) { - print(pq$pop()) + with(pq$pop(), cat(key,":",value,"\n")) } diff --git a/Task/Priority-queue/R/priority-queue-2.r b/Task/Priority-queue/R/priority-queue-2.r index 4d5efd3d7d..dc441b6c89 100644 --- a/Task/Priority-queue/R/priority-queue-2.r +++ b/Task/Priority-queue/R/priority-queue-2.r @@ -1,5 +1,5 @@ -[1] "Solve RC tasks" -[1] "Tax return" -[1] "Clear drains" -[1] "Feed cat" -[1] "Make tea" +1 : Solve RC tasks +2 : Tax return +3 : Clear drains +4 : Feed cat +5 : Make tea diff --git a/Task/Priority-queue/R/priority-queue-3.r b/Task/Priority-queue/R/priority-queue-3.r index 9022992158..300b7eb6d4 100644 --- a/Task/Priority-queue/R/priority-queue-3.r +++ b/Task/Priority-queue/R/priority-queue-3.r @@ -1,18 +1,17 @@ PriorityQueue <- - setRefClass("PriorityQueue", - fields = list(keys = "numeric", values = "list"), - methods = list( - insert = function(key,value) { - temp <- c(keys,key) - ord <- order(temp) - keys <<- temp[ord] - values <<- c(values,list(value))[ord] - }, - pop = function() { - head <- values[[1]] - keys <<- keys[-1] - values <<- values[-1] - return(head) - }, - empty = function() length(keys) == 0 + setRefClass("PriorityQueue", + fields = list(keys = "numeric", values = "list"), + methods = list( + insert = function(key,value) { + insert.order <- findInterval(key, keys) + keys <<- append(keys, key, insert.order) + values <<- append(values, value, insert.order) + }, + pop = function() { + head <- list(key=keys[1],value=values[[1]]) + keys <<- keys[-1] + values <<- values[-1] + return(head) + }, + empty = function() length(keys) == 0 )) diff --git a/Task/Priority-queue/REXX/priority-queue-1.rexx b/Task/Priority-queue/REXX/priority-queue-1.rexx index 788e6a7737..5f7dcde330 100644 --- a/Task/Priority-queue/REXX/priority-queue-1.rexx +++ b/Task/Priority-queue/REXX/priority-queue-1.rexx @@ -1,31 +1,26 @@ -/*REXX pgm implements a priority queue; with insert/show/delete top task*/ -numeric digits 100; #=0; @.= /*big #, 0 tasks, null priority queue*/ -say '══════ inserting tasks.'; call .ins 3 'Clear drains' - call .ins 4 'Feed cat' - call .ins 5 'Make tea' - call .ins 1 'Solve RC tasks' - call .ins 2 'Tax return' - call .ins 6 'Relax' - call .ins 6 'Enjoy' +/*REXX program implements a priority queue; with insert/display/delete the top task. */ +#=0; @.= /*0 tasks; nullify the priority queue.*/ +say '══════ inserting tasks.'; call .ins 3 "Clear drains" + call .ins 4 "Feed cat" + call .ins 5 "Make tea" + call .ins 1 "Solve RC tasks" + call .ins 2 "Tax return" + call .ins 6 "Relax" + call .ins 6 "Enjoy" say '══════ showing tasks.'; call .show -say '══════ deletes top task.'; do # /*number of tasks. */ - say .del() /*delete top task. */ - end /* [↑] do top first.*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────.INS subroutine─────────────────────*/ -.ins: procedure expose @. #; #=#+1; @.#=arg(1); return # /*entry,P,task.*/ -/*──────────────────────────────────.DEL subroutine─────────────────────*/ -.del: procedure expose @. #; parse arg p; if p=='' then p=.top() -x=@.p; @.p= /*delete the top task entry. */ -return x /*return task that was deleted. */ -/*──────────────────────────────────.SHOW subroutine────────────────────*/ -.show: procedure expose @. # - do j=1 for #; _=@.j; if _=='' then iterate; say _ - end /*j*/ /* [↑] show whole list or just 1.*/ -return -/*──────────────────────────────────.TOP subroutine─────────────────────*/ -.top: procedure expose @. #; top=; top#= - do j=1 for #; _=word(@.j,1); if _=='' then iterate - if top=='' | _>top then do; top=_; top#=j; end - end /*j*/ -return top# +say '══════ deletes top task.'; say .del() /*delete the top task. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +.del: procedure expose @. #; parse arg p; if p=='' then p=.top(); x=@.p; @.p=; return x + /*delete the top task entry. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +.ins: procedure expose @. #; #=#+1; @.#=arg(1); return # /*entry, P, task.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +.show: procedure expose @. #; do j=1 for #; _=@.j; if _=='' then iterate; say _; end + return /* [↑] show whole list or just one. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +.top: procedure expose @. #; top=; top#= + do j=1 for #; _=word(@.j,1); if _=='' then iterate + if top=='' | _>top then do; top=_; top#=j; end + end /*j*/ + return top# diff --git a/Task/Priority-queue/Rust/priority-queue.rust b/Task/Priority-queue/Rust/priority-queue.rust new file mode 100644 index 0000000000..8f831b7a12 --- /dev/null +++ b/Task/Priority-queue/Rust/priority-queue.rust @@ -0,0 +1,48 @@ +use std::collections::BinaryHeap; +use std::cmp::Ordering; +use std::borrow::Cow; + +#[derive(Eq, PartialEq)] +struct Item<'a> { + priority: usize, + task: Cow<'a, str>, // Takes either borrowed or owned string +} + +impl<'a> Item<'a> { + fn new(p: usize, t: T) -> Self + where T: Into> + { + Item { + priority: p, + task: t.into(), + } + } +} + +// Manually implpement Ord so we have a min heap +impl<'a> Ord for Item<'a> { + fn cmp(&self, other: &Self) -> Ordering { + other.priority.cmp(&self.priority) + } +} + +// PartialOrd is required by Ord +impl<'a> PartialOrd for Item<'a> { + fn partial_cmp(&self, other: &Self) -> Option { + Some(self.cmp(other)) + } +} + + +fn main() { + let mut queue = BinaryHeap::with_capacity(5); + queue.push(Item::new(3, "Clear drains")); + queue.push(Item::new(4, "Feed cat")); + queue.push(Item::new(5, "Make tea")); + queue.push(Item::new(1, "Solve RC tasks")); + queue.push(Item::new(2, "Tax return")); + + for item in queue { + println!("{}", item.task); + } +} diff --git a/Task/Probabilistic-choice/Elixir/probabilistic-choice.elixir b/Task/Probabilistic-choice/Elixir/probabilistic-choice.elixir new file mode 100644 index 0000000000..295e629256 --- /dev/null +++ b/Task/Probabilistic-choice/Elixir/probabilistic-choice.elixir @@ -0,0 +1,27 @@ +defmodule Probabilistic do + @tries 1000000 + @probs [aleph: 1/5, + beth: 1/6, + gimel: 1/7, + daleth: 1/8, + he: 1/9, + waw: 1/10, + zayin: 1/11, + heth: 1759/27720] + + def test do + trials = for _ <- 1..@tries, do: get_choice(@probs, :rand.uniform) + IO.puts "Item Expected Actual" + fmt = " ~-8s ~.6f ~.6f~n" + Enum.each(@probs, fn {glyph,expected} -> + actual = length(for ^glyph <- trials, do: glyph) / @tries + :io.format fmt, [glyph, expected, actual] + end) + end + + defp get_choice([{glyph,_}], _), do: glyph + defp get_choice([{glyph,prob}|_], ran) when ran < prob, do: glyph + defp get_choice([{_,prob}|t], ran), do: get_choice(t, ran - prob) +end + +Probabilistic.test diff --git a/Task/Probabilistic-choice/REXX/probabilistic-choice.rexx b/Task/Probabilistic-choice/REXX/probabilistic-choice.rexx index fd4dbac1ab..fdcc53f1d0 100644 --- a/Task/Probabilistic-choice/REXX/probabilistic-choice.rexx +++ b/Task/Probabilistic-choice/REXX/probabilistic-choice.rexx @@ -1,32 +1,32 @@ -/*REXX program shows results of probabilistic choices, gen random #s per prob.*/ -parse arg trials digits seed . /*obtain the optional arguments from CL*/ -if trials=='' | trials==',' then trials=1000000 -if digits=='' | digits==',' then digits=15; digits=max(10,digits) -if seed\=='' then call random ,,seed /*for repeatability.*/ -names='aleph beth gimel daleth he waw zayin heth ──totals───►' -cells=words(names) - 1; high=100000; s=0; !.=0 +/*REXX program displays results of probabilistic choices, gen random #s per probability.*/ +parse arg trials digits seed . /*obtain the optional arguments from CL*/ +if trials=='' | trials=="," then trials=1000000 /*Not specified? Then use the default.*/ +if digits=='' | digits=="," then digits=15 /* " " " " " " */ +if datatype(seed,'W') then call random ,,seed /*allows repeatability for RANDOM nums.*/ +names= 'aleph beth gimel daleth he waw zayin heth ──totals───►' +cells=words(names) - 1; high=100000; s=0; !.=0 _=4 - do n=1 for 7; _=_+1; prob.n=1/_; Hprob.n=prob.n*high; s=s+prob.n - end /*n*/ /* [↑] determine the probabilities. */ + do n=1 for 7; _=_+1; prob.n=1/_; Hprob.n=prob.n*high; s=s+prob.n + end /*n*/ /* [↑] determine the probabilities. */ -prob.8=1759/27720; Hprob.8=prob.8*high; s=s+prob.8; prob.9=s; !.9=trials +prob.8=1759/27720; Hprob.8=prob.8*high; s=s+prob.8; prob.9=s; !.9=trials - do j=1 for trials; r=random(1,high) /*generate X number of random numbers.*/ - do k=1 for cells /*for each cell, compute percentages. */ - if r<=Hprob.k then !.k=!.k+1 /*for each range, bump the counter. */ + do j=1 for trials; r=random(1, high) /*generate X number of random numbers.*/ + do k=1 for cells /*for each cell, compute percentages. */ + if r<=Hprob.k then !.k=!.k+1 /*for each range, bump the counter. */ end /*k*/ end /*j*/ w=digits+6; d=max(length(trials), length('count')) + 4 say centr('name',15) centr('count',d) centr('target %') centr('actual %') - /* [↑] display a formatted header line*/ - do i=1 for cells+1 /*show for each of the cells and totals*/ + /* [↑] display a formatted header line*/ + do i=1 for cells+1 /*show for each of the cells and totals*/ say ' ' left(word(names,i) , 12), - right(!.i , d-2) ' ', + right(!.i , d-2) " ", left(format(prob.i *100, d), w-2), left(format(!.i/trials*100, d), w-2) if i==8 then say centr(,15) centr(,d) centr() centr() end /*i*/ -exit /*stick a fork in it, we are all done.*/ -/*────────────────────────────────────────────────────────────────────────────*/ -centr: return center(arg(1), word(arg(2) w,1), '─') +exit /*stick a fork in it, we are all done.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +centr: return center( arg(1), word(arg(2) w, 1), '─') diff --git a/Task/Problem-of-Apollonius/00DESCRIPTION b/Task/Problem-of-Apollonius/00DESCRIPTION index 2740259c4f..d4bc8016da 100644 --- a/Task/Problem-of-Apollonius/00DESCRIPTION +++ b/Task/Problem-of-Apollonius/00DESCRIPTION @@ -1,3 +1,7 @@ -Implement a solution to the Problem of Apollonius ([[wp:Problem_of_Apollonius|description on wikipedia]]) which is the problem of finding the circle that is tangent to three specified circles. There is an [[wp:Problem_of_Apollonius#Algebraic_solutions|algebraic solution]] which is pretty straightforward. The solutions to the example in the code are shown in the image (the red circle is "internally tangent" to all three black circles and the green circle is "externally tangent" to all three black circles). +[[File:Apollonius.png|400px|Two solutions to the problem of Apollonius|right]] -[[File:Apollonius.png|200px|Two solutions to the problem of apollonius]] +;Task: +Implement a solution to the Problem of Apollonius   ([[wp:Problem_of_Apollonius|description on Wikipedia]])   which is the problem of finding the circle that is tangent to three specified circles.   There is an [[wp:Problem_of_Apollonius#Algebraic_solutions|algebraic solution]] which is pretty straightforward. + +The solutions to the example in the code are shown in the image (below and right).   The red circle is "internally tangent" to all three black circles, and the green circle is "externally tangent" to all three black circles. +

    diff --git a/Task/Problem-of-Apollonius/PowerShell/problem-of-apollonius-1.psh b/Task/Problem-of-Apollonius/PowerShell/problem-of-apollonius-1.psh new file mode 100644 index 0000000000..4827d1bdc4 --- /dev/null +++ b/Task/Problem-of-Apollonius/PowerShell/problem-of-apollonius-1.psh @@ -0,0 +1,69 @@ +function Measure-Apollonius +{ + [CmdletBinding()] + [OutputType([PSCustomObject])] + Param + ( + [int]$Counter, + [double]$x1, + [double]$y1, + [double]$r1, + [double]$x2, + [double]$y2, + [double]$r2, + [double]$x3, + [double]$y3, + [double]$r3 + ) + + switch ($Counter) + { + {$_ -eq 2} {$s1 = -1; $s2 = -1; $s3 = -1; break} + {$_ -eq 3} {$s1 = 1; $s2 = -1; $s3 = -1; break} + {$_ -eq 4} {$s1 = -1; $s2 = 1; $s3 = -1; break} + {$_ -eq 5} {$s1 = -1; $s2 = -1; $s3 = 1; break} + {$_ -eq 6} {$s1 = 1; $s2 = 1; $s3 = -1; break} + {$_ -eq 7} {$s1 = -1; $s2 = 1; $s3 = 1; break} + {$_ -eq 8} {$s1 = 1; $s2 = -1; $s3 = 1; break} + Default {$s1 = 1; $s2 = 1; $s3 = 1; break} + } + + [double]$v11 = 2 * $x2 - 2 * $x1 + [double]$v12 = 2 * $y2 - 2 * $y1 + [double]$v13 = $x1 * $x1 - $x2 * $x2 + $y1 * $y1 - $y2 * $y2 - $r1 * $r1 + $r2 * $r2 + [double]$v14 = 2 * $s2 * $r2 - 2 * $s1 * $r1 + + [double]$v21 = 2 * $x3 - 2 * $x2 + [double]$v22 = 2 * $y3 - 2 * $y2 + [double]$v23 = $x2 * $x2 - $x3 * $x3 + $y2 * $y2 - $y3 * $y3 - $r2 * $r2 + $r3 * $r3 + [double]$v24 = 2 * $s3 * $r3 - 2 * $s2 * $r2 + + [double]$w12 = $v12 / $v11 + [double]$w13 = $v13 / $v11 + [double]$w14 = $v14 / $v11 + + [double]$w22 = $v22 / $v21 - $w12 + [double]$w23 = $v23 / $v21 - $w13 + [double]$w24 = $v24 / $v21 - $w14 + + [double]$P = -$w23 / $w22 + [double]$Q = $w24 / $w22 + [double]$M = -$w12 * $P - $w13 + [double]$N = $w14 - $w12 * $Q + + [double]$a = $N * $N + $Q * $Q - 1 + [double]$b = 2 * $M * $N - 2 * $N * $x1 + 2 * $P * $Q - 2 * $Q * $y1 + 2 * $s1 * $r1 + [double]$c = $x1 * $x1 + $M * $M - 2 * $M * $x1 + $P * $P + $y1 * $y1 - 2 * $P * $y1 - $r1 * $r1 + + [double]$D = $b * $b - 4 * $a * $c + + [double]$rs = (-$b - [Double]::Parse([Math]::Sqrt($D).ToString())) / (2 * [Double]::Parse($a.ToString())) + [double]$xs = $M + $N * $rs + [double]$ys = $P + $Q * $rs + + [PSCustomObject]@{ + X = $xs + Y = $ys + Radius = $rs + } +} diff --git a/Task/Problem-of-Apollonius/PowerShell/problem-of-apollonius-2.psh b/Task/Problem-of-Apollonius/PowerShell/problem-of-apollonius-2.psh new file mode 100644 index 0000000000..e54dfcbf34 --- /dev/null +++ b/Task/Problem-of-Apollonius/PowerShell/problem-of-apollonius-2.psh @@ -0,0 +1,4 @@ +for ($i = 1; $i -le 8; $i++) +{ + Measure-Apollonius -Counter $i -x1 0 -y1 0 -r1 1 -x2 4 -y2 0 -r2 1 -x3 2 -y3 4 -r3 2 +} diff --git a/Task/Program-name/Elena/program-name.elena b/Task/Program-name/Elena/program-name.elena new file mode 100644 index 0000000000..6e79418102 --- /dev/null +++ b/Task/Program-name/Elena/program-name.elena @@ -0,0 +1,8 @@ +#import system. + +#symbol program = +[ + console writeLine:system'commandLine. // the whole command line + + console writeLine:('program'arguments@0). // the program name +]. diff --git a/Task/Program-name/Python/program-name-1.py b/Task/Program-name/Python/program-name-1.py index e8bf0531d7..73135e5190 100644 --- a/Task/Program-name/Python/program-name-1.py +++ b/Task/Program-name/Python/program-name-1.py @@ -3,8 +3,8 @@ import sys def main(): - program = sys.argv[0] - print "Program: %s" % program + program = sys.argv[0] + print("Program: %s" % program) -if __name__=="__main__": - main() +if __name__ == "__main__": + main() diff --git a/Task/Program-name/Python/program-name-2.py b/Task/Program-name/Python/program-name-2.py index 5997f3e9d1..5eb12c753e 100644 --- a/Task/Program-name/Python/program-name-2.py +++ b/Task/Program-name/Python/program-name-2.py @@ -3,8 +3,8 @@ import inspect def main(): - program = inspect.getfile(inspect.currentframe()) - print "Program: %s" % program + program = inspect.getfile(inspect.currentframe()) + print("Program: %s" % program) -if __name__=="__main__": - main() +if __name__ == "__main__": + main() diff --git a/Task/Program-termination/00DESCRIPTION b/Task/Program-termination/00DESCRIPTION index 3689e92664..d3e9650e31 100644 --- a/Task/Program-termination/00DESCRIPTION +++ b/Task/Program-termination/00DESCRIPTION @@ -1,4 +1,9 @@ -Show the syntax for a complete stoppage of a program inside a [[Conditional Structures|conditional]]. +;Task: +Show the syntax for a complete stoppage of a program inside a   [[Conditional Structures|conditional]]. + This includes all [[threads]]/[[processes]] which are part of your program. -Explain the cleanup (or lack thereof) caused by the termination (allocated memory, database connections, open files, object finalizers/destructors, run-on-exit hooks, etc.). Unless otherwise described, no special cleanup outside that provided by the operating system is provided. +Explain the cleanup (or lack thereof) caused by the termination (allocated memory, database connections, open files, object finalizers/destructors, run-on-exit hooks, etc.). + +Unless otherwise described, no special cleanup outside that provided by the operating system is provided. +

    diff --git a/Task/Program-termination/Run-BASIC/program-termination.run b/Task/Program-termination/Run-BASIC/program-termination.run new file mode 100644 index 0000000000..d986de8b4f --- /dev/null +++ b/Task/Program-termination/Run-BASIC/program-termination.run @@ -0,0 +1 @@ +if whatever then end diff --git a/Task/Program-termination/Rust/program-termination-1.rust b/Task/Program-termination/Rust/program-termination-1.rust new file mode 100644 index 0000000000..ba35ff0ad1 --- /dev/null +++ b/Task/Program-termination/Rust/program-termination-1.rust @@ -0,0 +1,5 @@ +fn main() { + println!("The program is running"); + return; + println!("This line won't be printed"); +} diff --git a/Task/Program-termination/Rust/program-termination-2.rust b/Task/Program-termination/Rust/program-termination-2.rust new file mode 100644 index 0000000000..f047089321 --- /dev/null +++ b/Task/Program-termination/Rust/program-termination-2.rust @@ -0,0 +1,5 @@ +fn main() { + if problem { + std::process::exit(1); // 1 is the exit code + } +} diff --git a/Task/Program-termination/Rust/program-termination-3.rust b/Task/Program-termination/Rust/program-termination-3.rust new file mode 100644 index 0000000000..1bcae18a27 --- /dev/null +++ b/Task/Program-termination/Rust/program-termination-3.rust @@ -0,0 +1,5 @@ +fn main() { + println!("The program is running"); + panic!("A runtime panic occured"); + println!("This line won't be printed"); +} diff --git a/Task/Program-termination/Rust/program-termination-4.rust b/Task/Program-termination/Rust/program-termination-4.rust new file mode 100644 index 0000000000..7768322970 --- /dev/null +++ b/Task/Program-termination/Rust/program-termination-4.rust @@ -0,0 +1,12 @@ +use std::thread; + +fn main() { + println!("The program is running"); + + thread::spawn(move|| { + println!("This is the second thread"); + panic!("A runtime panic occured"); + }).join(); + + println!("This line should be printed"); +} diff --git a/Task/Pythagorean-triples/00DESCRIPTION b/Task/Pythagorean-triples/00DESCRIPTION index 7bee6004a2..86ac71e812 100644 --- a/Task/Pythagorean-triples/00DESCRIPTION +++ b/Task/Pythagorean-triples/00DESCRIPTION @@ -1,12 +1,22 @@ -A [[wp:Pythagorean_triple|Pythagorean triple]] is defined as three positive integers (a, b, c) where a < b < c, and a^2+b^2=c^2. They are called primitive triples if a, b, c are coprime, that is, if their pairwise greatest common divisors {\rm gcd}(a, b) = {\rm gcd}(a, c) = {\rm gcd}(b, c) = 1. Because of their relationship through the Pythagorean theorem, a, b, and c are coprime if a and b are coprime ({\rm gcd}(a, b) = 1). Each triple forms the length of the sides of a right triangle, whose perimeter is P=a+b+c. +A [[wp:Pythagorean_triple|Pythagorean triple]] is defined as three positive integers (a, b, c) where a < b < c, and a^2+b^2=c^2. -'''Task''' +They are called primitive triples if a, b, c are co-prime, that is, if their pairwise greatest common divisors {\rm gcd}(a, b) = {\rm gcd}(a, c) = {\rm gcd}(b, c) = 1. +Because of their relationship through the Pythagorean theorem, a, b, and c are co-prime if a and b are co-prime ({\rm gcd}(a, b) = 1).   + +Each triple forms the length of the sides of a right triangle, whose perimeter is P=a+b+c. + + +;Task: The task is to determine how many Pythagorean triples there are with a perimeter no larger than 100 and the number of these that are primitive. -'''Extra credit:''' Deal with large values. Can your program handle a max perimeter of 1,000,000? What about 10,000,000? 100,000,000? -Note: the extra credit is not for you to demonstrate how fast your language is compared to others; you need a proper algorithm to solve them in a timely manner. +;Extra credit: +Deal with large values.   Can your program handle a maximum perimeter of 1,000,000?   What about 10,000,000?   100,000,000? + +Note: the extra credit is not for you to demonstrate how fast your language is compared to others;   you need a proper algorithm to solve them in a timely manner. + ;Cf: * [[List comprehensions]] +

    diff --git a/Task/Pythagorean-triples/REXX/pythagorean-triples-1.rexx b/Task/Pythagorean-triples/REXX/pythagorean-triples-1.rexx index 081b0f2fe6..d6d45a5c03 100644 --- a/Task/Pythagorean-triples/REXX/pythagorean-triples-1.rexx +++ b/Task/Pythagorean-triples/REXX/pythagorean-triples-1.rexx @@ -1,28 +1,29 @@ -/*REXX program counts number of Pythagorean triples that exist given a max */ -/*────────── perimeter of N, and also counts how many of them are primitives.*/ -trips=0; prims=0 /*set the number of triples, primitives*/ -parse arg N .; if N=='' then n=100 /*N specified? No, then use default. */ +/*REXX program counts the number of Pythagorean triples that exist given a maximum */ +/*──────────────────── perimeter of N, and also counts how many of them are primitives.*/ +trips=0; prims=0 /*set the number of triples, primitives*/ +parse arg N . /*obtain optional argument from the CL.*/ +if N=='' | N=="," then n=100 /*Not specified? Then use the default.*/ - do a=3 to N%3; aa=a*a /*limit side to 1/3 of the perimeter.*/ + do a=3 to N%3; aa=a*a /*limit side to 1/3 of the perimeter.*/ - do b=a+1 /*the triangle can't be isosceles. */ - ab=a+b /*compute a partial perimeter (2 sides)*/ - if ab>=N then iterate a /*is a+b ≥ perimeter? Try different A*/ - aabb=aa+b*b /*compute the sum of a²+b² (shortcut)*/ + do b=a+1 /*the triangle can't be isosceles. */ + ab=a + b /*compute a partial perimeter (2 sides)*/ + if ab>=N then iterate a /*is a+b ≥ perimeter? Try different A*/ + aabb=aa + b*b /*compute the sum of a²+b² (shortcut)*/ - do c=b+1 /*compute the value of the third side. */ - if ab+c>N then iterate a /*is a+b+c > perimeter? Try diff. A.*/ - cc=c*c /*compute the value of C². */ - if cc > aabb then iterate b /*is c² > a²+b² ? Try a different B.*/ - if cc\==aabb then iterate /*is c² ¬= a²+b² ? Try a different C.*/ - trips=trips+1 /*eureka. We found a Pythagorean triple*/ - prims=prims+(gcd(a,b)==1) /*is this triple a primitive triple? */ + do c=b+1 /*compute the value of the third side. */ + if ab + c > N then iterate a /*is a+b+c > perimeter? Try diff. A.*/ + cc=c*c /*compute the value of C². */ + if cc > aabb then iterate b /*is c² > a²+b² ? Try a different B.*/ + if cc\==aabb then iterate /*is c² ¬= a²+b² ? Try a different C.*/ + trips=trips + 1 /*eureka. We found a Pythagorean triple*/ + prims=prims + (gcd(a,b)==1) /*is this triple a primitive triple? */ end /*c*/ end /*b*/ end /*a*/ -_=left('',7) /*for padding the output with 7 blanks.*/ -say 'max perimeter =' N _ "Pythagorean triples =" trips _ 'primitives =' prims -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────────────*/ -gcd: procedure; parse arg x,y; do until y==0; parse value x//y y with y x; end; return x +_=left('', 7) /*for padding the output with 7 blanks.*/ +say 'max perimeter =' N _ "Pythagorean triples =" trips _ 'primitives =' prims +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +gcd: procedure; parse arg x,y; do until y==0; parse value x//y y with y x; end; return x diff --git a/Task/Pythagorean-triples/REXX/pythagorean-triples-2.rexx b/Task/Pythagorean-triples/REXX/pythagorean-triples-2.rexx index febaf6e480..5da270027a 100644 --- a/Task/Pythagorean-triples/REXX/pythagorean-triples-2.rexx +++ b/Task/Pythagorean-triples/REXX/pythagorean-triples-2.rexx @@ -1,36 +1,36 @@ -/*REXX program counts number of Pythagorean triples that exist given a max */ -/*REXX program counts number of Pythagorean triples that exist given a max */ -/*────────── perimeter of N, and also counts how many of them are primitives.*/ -@.=0; trips=0; prims=0 /*define some REXX variables to zero. */ -parse arg N .; if N=='' then n=100 /*N specified? No, then use default. */ +/*REXX program counts the number of Pythagorean triples that exist given a maximum */ +/*──────────────────── perimeter of N, and also counts how many of them are primitives.*/ +@.=0; trips=0; prims=0 /*define some REXX variables to zero. */ +parse arg N . /*obtain optional argument from the CL.*/ +if N=='' | N=="," then n=100 /*Not specified? Then use the default.*/ - do a=3 to N%3; aa=a*a /*limit side to 1/3 of the perimeter.*/ - aEven= a//2==0 /*set variable to 1 if A is even. */ + do a=3 to N%3; aa=a*a /*limit side to 1/3 of the perimeter.*/ + aEven= a//2==0 /*set variable to 1 if A is even. */ - do b=a+1 by 1+aEven /*the triangle can't be isosceles. */ - ab=a+b /*compute a partial perimeter (2 sides)*/ - if ab>=N then iterate a /*is a+b ≥ perimeter? Try different A*/ - aabb=aa+b*b /*compute the sum of a²+b² (shortcut)*/ + do b=a+1 by 1+aEven /*the triangle can't be isosceles. */ + ab=a + b /*compute a partial perimeter (2 sides)*/ + if ab>=N then iterate a /*is a+b ≥ perimeter? Try different A*/ + aabb=aa + b*b /*compute the sum of a²+b² (shortcut)*/ - do c=b+1 /*compute the value of the third side. */ + do c=b + 1 /*compute the value of the third side. */ if aEven then if c//2==0 then iterate - if ab+c>n then iterate a /*a+b+c > perimeter? Try different A.*/ - cc=c*c /*compute the value of C². */ - if cc > aabb then iterate b /*is c² > a²+b² ? Try a different B.*/ - if cc\==aabb then iterate /*is c² ¬= a²+b² ? Try a different C.*/ - if @.a.b.c then iterate /*Is this a duplicate? Then try again.*/ - trips=trips+1 /*Eureka! We found a Pythagorean triple*/ - prims=prims+1 /*count this also as a primitive triple*/ + if ab+c>n then iterate a /*a+b+c > perimeter? Try different A.*/ + cc=c*c /*compute the value of C². */ + if cc > aabb then iterate b /*is c² > a²+b² ? Try a different B.*/ + if cc\==aabb then iterate /*is c² ¬= a²+b² ? Try a different C.*/ + if @.a.b.c then iterate /*Is this a duplicate? Then try again.*/ + trips=trips + 1 /*Eureka! We found a Pythagorean triple*/ + prims=prims + 1 /*count this also as a primitive triple*/ - do m=2; am=a*m; bm=b*m; cm=c*m /*generate non-primitives.*/ - if am+bm+cm>N then leave /*is this multiple Pythagorean triple? */ - trips=trips+1 /*Eureka! We found a Pythagorean triple*/ - @.am.bm.cm=1 /*mark Pythagorean triangle as a triple*/ + do m=2; am=a*m; bm=b*m; cm=c*m /*generate non-primitives Pythagoreans.*/ + if am+bm+cm>N then leave /*is this multiple Pythagorean triple? */ + trips=trips+1 /*Eureka! We found a Pythagorean triple*/ + @.am.bm.cm=1 /*mark Pythagorean triangle as a triple*/ end /*m*/ end /*c*/ end /*b*/ end /*a*/ -_=left('',7) /*for padding the output with 7 blanks.*/ -say 'max perimeter =' N _ "Pythagorean triples =" trips _ 'primitives =' prims - /*stick a fork in it, we're all done. */ +_=left('', 7) /*for padding the output with 7 blanks.*/ +say 'max perimeter =' N _ "Pythagorean triples =" trips _ 'primitives =' prims + /*stick a fork in it, we're all done. */ diff --git a/Task/Pythagorean-triples/ZX-Spectrum-Basic/pythagorean-triples.zx b/Task/Pythagorean-triples/ZX-Spectrum-Basic/pythagorean-triples.zx new file mode 100644 index 0000000000..385a5eb98d --- /dev/null +++ b/Task/Pythagorean-triples/ZX-Spectrum-Basic/pythagorean-triples.zx @@ -0,0 +1,11 @@ + 1 LET Y=0: LET X=0: LET Z=0: LET V=0: LET U=0: LET L=10: LET T=0: LET P=0: LET N=4: LET M=0: PRINT "limit trip. prim." + 2 FOR U=2 TO INT (SQR (L/2)): LET Y=U-INT (U/2)*2: LET N=N+4: LET M=U*U*2: IF Y=0 THEN LET M=M-U-U + 3 FOR V=1+Y TO U-1 STEP 2: LET M=M+N: LET X=U: LET Y=V + 4 LET Z=Y: LET Y=X-INT (X/Y)*Y: LET X=Z: IF Y<>0 THEN GO TO 4 + 5 IF X>1 THEN GO TO 8 + 6 IF M>L THEN GO TO 9 + 7 LET P=P+1: LET T=T+INT (L/M) + 8 NEXT V + 9 NEXT U + 10 PRINT L;TAB 8;T;TAB 16;P + 11 LET N=4: LET T=0: LET P=0: LET L=L*10: IF L<=100000 THEN GO TO 2 diff --git a/Task/Quaternion-type/00DESCRIPTION b/Task/Quaternion-type/00DESCRIPTION index 7bd61e5f08..d1dc577b74 100644 --- a/Task/Quaternion-type/00DESCRIPTION +++ b/Task/Quaternion-type/00DESCRIPTION @@ -1,30 +1,55 @@ -[[wp:Quaternion|Quaternions]] are an extension of the idea of [[Arithmetic/Complex|complex numbers]]. +[[wp:Quaternion|Quaternions]]   are an extension of the idea of   [[Arithmetic/Complex|complex numbers]]. -A complex number has a real and complex part written sometimes as a + bi, where a and b stand for real numbers and i stands for the square root of minus 1. An example of a complex number might be -3 + 2i, where the real part, a is -3.0 and the complex part, b is +2.0. +A complex number has a real and complex part,   sometimes written as   a + bi, +
    where   a   and   b   stand for real numbers, and   i   stands for the square root of minus 1. -A quaternion has one real part and ''three'' imaginary parts, i, j, and k. A quaternion might be written as a + bi + cj + dk. In this numbering system, ii = jj = kk = ijk = -1. The order of multiplication is important, as, in general, for two quaternions q1 and q2; q1q2 != q2q1. +An example of a complex number might be   -3 + 2i,   +
    where the real part,   a   is   '''-3.0'''   and the complex part,   b   is   '''+2.0'''. -An example of a quaternion might be 1 +2i +3j +4k
    -There is a list form of notation where just the numbers are shown and the imaginary multipliers i, j, and k are assumed by position. So the example above would be written as (1, 2, 3, 4) +A quaternion has one real part and ''three'' imaginary parts,   i,   j,   and   k. -'''Task Description'''
    -Given the three quaternions and their components: - q = (1, 2, 3, 4) = (a, b, c, d ) +A quaternion might be written as   a + bi + cj + dk. + +In the quaternion numbering system: +:::*   i∙i = j∙j = k∙k = i∙j∙k = -1,       or more simply, +:::*   ii  = jj  = kk  = ijk   = -1. + +The order of multiplication is important, as, in general, for two quaternions: +::::   q1   and   q2:     q1q2 ≠ q2q1. + +An example of a quaternion might be   1 +2i +3j +4k + +There is a list form of notation where just the numbers are shown and the imaginary multipliers   i,   j,   and   k   are assumed by position. + +So the example above would be written as   (1, 2, 3, 4) + + +;Task: +Given the three quaternions and their components: + q = (1, 2, 3, 4) = (a, b, c, d) q1 = (2, 3, 4, 5) = (a1, b1, c1, d1) - q2 = (3, 4, 5, 6) = (a2, b2, c2, d2) -And a wholly real number r = 7. + q2 = (3, 4, 5, 6) = (a2, b2, c2, d2) +And a wholly real number   r = 7. -Your task is to create functions or classes to perform simple maths with quaternions including computing: -# The norm of a quaternion:
    = \sqrt{a^2 + b^2 + c^2 + d^2} -# The negative of a quaternion:
    =(-a, -b, -c, -d) -# The conjugate of a quaternion:
    =( a, -b, -c, -d) -# Addition of a real number r and a quaternion q:
    r + q = q + r = (a+r, b, c, d) -# Addition of two quaternions:
    q1 + q2 = (a1+a2, b1+b2, c1+c2, d1+d2) -# Multiplication of a real number and a quaternion:
    qr = rq = (ar, br, cr, dr) -# Multiplication of two quaternions q1 and q2 is given by:
    ( a1a2 − b1b2 − c1c2 − d1d2,
      a1b2 + b1a2 + c1d2 − d1c2,
      a1c2 − b1d2 + c1a2 + d1b2,
      a1d2 + b1c2 − c1b2 + d1a2 ) -# Show that, for the two quaternions q1 and q2:
    q1q2 != q2q1 -If your language has built-in support for quaternions then use it. -C.f. -* [[Vector products]] -* [http://www.maths.tcd.ie/pub/HistMath/People/Hamilton/QLetter/QLetter.pdf On Quaternions]; or on a new System of Imaginaries in Algebra. By Sir William Rowan Hamilton LL.D, P.R.I.A., F.R.A.S., Hon. M. R. Soc. Ed. and Dub., Hon. or Corr. M. of the Royal or Imperial Academies of St. Petersburgh, Berlin, Turin and Paris, Member of the American Academy of Arts and Sciences, and of other Scientific Societies at Home and Abroad, Andrews' Prof. of Astronomy in the University of Dublin, and Royal Astronomer of Ireland. +'''Note:''' ''The first formula below is invisible to the majority of browsers, including Chrome, IE/Edge, Safari, Opera etc. It may, subject to the installation of requisite fonts, prove visible in Firefox.'' + + +Create functions   (or classes)   to perform simple maths with quaternions including computing: +# The norm of a quaternion:
    = \sqrt{ a^2 + b^2 + c^2 + d^2 } +# The negative of a quaternion:
    = (-a, -b, -c, -d) +# The conjugate of a quaternion:
    = ( a, -b, -c, -d) +# Addition of a real number   r   and   a   quaternion   q:
    r + q = q + r = (a+r, b, c, d) +# Addition of two quaternions:
    q1 + q2 = (a1+a2, b1+b2, c1+c2, d1+d2) +# Multiplication of a real number and a quaternion:
    qr = rq = (ar, br, cr, dr) +# Multiplication of two quaternions   q1   and   q2   is given by:
    ( a1a2 − b1b2 − c1c2 − d1d2,
      a1b2 + b1a2 + c1d2 − d1c2,
      a1c2 − b1d2 + c1a2 + d1b2,
      a1d2 + b1c2 − c1b2 + d1a2 )
    +# Show that, for the two quaternions   q1   and   q2:
    q1q2 ≠ q2q1
    + +
    +If a language has built-in support for quaternions, then use it. + + +;C.f.: +*   [[Vector products]] +*   [http://www.maths.tcd.ie/pub/HistMath/People/Hamilton/QLetter/QLetter.pdf On Quaternions];   or on a new System of Imaginaries in Algebra.   By Sir William Rowan Hamilton LL.D, P.R.I.A., F.R.A.S., Hon. M. R. Soc. Ed. and Dub., Hon. or Corr. M. of the Royal or Imperial Academies of St. Petersburgh, Berlin, Turin and Paris, Member of the American Academy of Arts and Sciences, and of other Scientific Societies at Home and Abroad, Andrews' Prof. of Astronomy in the University of Dublin, and Royal Astronomer of Ireland. +

    diff --git a/Task/Quaternion-type/PowerShell/quaternion-type-1.psh b/Task/Quaternion-type/PowerShell/quaternion-type-1.psh new file mode 100644 index 0000000000..be3f6c2e84 --- /dev/null +++ b/Task/Quaternion-type/PowerShell/quaternion-type-1.psh @@ -0,0 +1,58 @@ +class Quaternion { + [Double]$w + [Double]$x + [Double]$y + [Double]$z + Quaternion() { + $this.w = 0 + $this.x = 0 + $this.y = 0 + $this.z = 0 + } + Quaternion([Double]$a, [Double]$b, [Double]$c, [Double]$d) { + $this.w = $a + $this.x = $b + $this.y = $c + $this.z = $d + } + [Double]abs2() {return $this.w*$this.w + $this.x*$this.x + $this.y*$this.y + $this.z*$this.z} + [Double]abs() {return [math]::sqrt($this.wbs2())} + static [Quaternion]real([Double]$r) {return [Quaternion]::new($r, 0, 0, 0)} + static [Quaternion]add([Quaternion]$m,[Quaternion]$n) {return [Quaternion]::new($m.w+$n.w, $m.x+$n.x, $m.y+$n.y, $m.z+$n.z)} + [Quaternion]addreal([Double]$r) {return [Quaternion]::add($this,[Quaternion]::real($r))} + static [Quaternion]mul([Quaternion]$m,[Quaternion]$n) { + return [Quaternion]::new( + ($m.w*$n.w) - ($m.x*$n.x) - ($m.y*$n.y) - ($m.z*$n.z), + ($m.w*$n.x) + ($m.x*$n.w) + ($m.y*$n.z) - ($m.z*$n.y), + ($m.w*$n.y) - ($m.x*$n.z) + ($m.y*$n.w) + ($m.z*$n.x), + ($m.w*$n.z) + ($m.x*$n.y) - ($m.y*$n.x) + ($m.z*$n.w)) + } + + [Quaternion]mul([Double]$r) {return [Quaternion]::new($r*$this.w, $r*$this.x, $r*$this.y, $r*$this.z)} + [Quaternion]negate() {return $this.mul(-1)} + [Quaternion]conjugate() {return [Quaternion]::new($this.w, -$this.x, -$this.y, -$this.z)} + static [String]st([Double]$r) { + if(0 -le $r) {return "+$r"} else {return "$r"} + } + [String]show() {return "$($this.w)$([Quaternion]::st($this.x))i$([Quaternion]::st($this.y))j$([Quaternion]::st($this.z))k"} + static [String]show([Quaternion]$other) {return $other.show()} +} + + +$q = [Quaternion]::new(1, 2, 3, 4) +$q1 = [Quaternion]::new(2, 3, 4, 5) +$q2 = [Quaternion]::new(3, 4, 5, 6) +$r = 7 +"`$q: $($q.show())" +"`$q1: $($q1.show())" +"`$q2: $($q2.show())" +"`$r: $r" +"" +"norm `$q: $($q.wbs())" +"negate `$q: $($q.negate().show())" +"conjugate `$q: $($q.yonjugate().show())" +"`$q + `$r: $($q.wddreal($r).show())" +"`$q1 + `$q2: $([Quaternion]::show([Quaternion]::add($q1,$q2)))" +"`$q * `$r: $($q.mul($r).show())" +"`$q1 * `$q2: $([Quaternion]::show([Quaternion]::mul($q1,$q2)))" +"`$q2 * `$q1: $([Quaternion]::show([Quaternion]::mul($q2,$q1)))" diff --git a/Task/Quaternion-type/PowerShell/quaternion-type-2.psh b/Task/Quaternion-type/PowerShell/quaternion-type-2.psh new file mode 100644 index 0000000000..16452e9e7b --- /dev/null +++ b/Task/Quaternion-type/PowerShell/quaternion-type-2.psh @@ -0,0 +1,22 @@ +function show([System.Numerics.Quaternion]$c) { + function st([Double]$r) { + if(0 -le $r) {return "+$r"} else {return "$r"} + } + return "$($c.w)$(st $c.y)i$(st $c.y)j$(st $c.z)k" +} +$q = [System.Numerics.Quaternion]::new(1, 2, 3, 4) +$q1 = [System.Numerics.Quaternion]::new(2, 3, 4, 5) +$q2 = [System.Numerics.Quaternion]::new(3, 4, 5, 6) +$r = 7 +"`$q: $(show $q)" +"`$q1: $(show $q1)" +"`$q2: $(show $q2)" +"`$r: $r" +"norm `$q: $($q.Length())" +"negate `$q: $(show ([System.Numerics.Quaternion]::Negate($q)))" +"conjugate `$q: $(show ([System.Numerics.Quaternion]::Conjugate($q)))" +"`$q + `$r: $(show ([System.Numerics.Quaternion]::new($q.w + $r, $q.x, $q.y, $q.z)))" +"`$q1 + `$q2: $(show ([System.Numerics.Quaternion]::Add($q1,$q2)))" +"`$q * `$r: $(show ([System.Numerics.Quaternion]::new($q.w * $r, $q.x * $r, $q.y * $r, $q.z * $r)))" +"`$q1 * `$q2: $(show ([System.Numerics.Quaternion]::Multiply($q1,$q2)))" +"`$q2 * `$q1: $(show ([System.Numerics.Quaternion]::Multiply($q2,$q1)))" diff --git a/Task/Queue-Definition/00DESCRIPTION b/Task/Queue-Definition/00DESCRIPTION index f13d6e4adf..b3606f497f 100644 --- a/Task/Queue-Definition/00DESCRIPTION +++ b/Task/Queue-Definition/00DESCRIPTION @@ -1,16 +1,25 @@ {{Data structure}} [[File:Fifo.gif|frame|right|Illustration of FIFO behavior]] + +;Task: Implement a FIFO queue. + Elements are added at one side and popped from the other in the order of insertion. + Operations: -* push (aka ''enqueue'') - add element -* pop (aka ''dequeue'') - pop first element -* empty - return truth value when empty +*   push   (aka ''enqueue'')   - add element +*   pop     (aka ''dequeue'')   - pop first element +*   empty   - return truth value when empty + Errors: -* handle the error of trying to pop from an empty queue (behavior depends on the language and platform) +*   handle the error of trying to pop from an empty queue (behavior depends on the language and platform) + + +;See: +*   [[Queue/Usage]]   for the built-in FIFO or queue of your language or standard library. -See [[Queue/Usage]] for the built-in FIFO or queue of your language or standard library. {{Template:See also lists}} +

    diff --git a/Task/Queue-Definition/Forth/queue-definition.fth b/Task/Queue-Definition/Forth/queue-definition-1.fth similarity index 100% rename from Task/Queue-Definition/Forth/queue-definition.fth rename to Task/Queue-Definition/Forth/queue-definition-1.fth diff --git a/Task/Queue-Definition/Forth/queue-definition-2.fth b/Task/Queue-Definition/Forth/queue-definition-2.fth new file mode 100644 index 0000000000..d6bac99208 --- /dev/null +++ b/Task/Queue-Definition/Forth/queue-definition-2.fth @@ -0,0 +1,42 @@ +0 + field: list-next + field: list-val +constant list-struct + +: insert ( x list-addr -- ) + list-struct allocate throw >r + swap r@ list-val ! + dup @ r@ list-next ! + r> swap ! ; + +: remove ( list-addr -- x ) + >r r@ @ ( list-node ) + r@ @ dup list-val @ ( list-node x ) + swap list-next @ r> ! + swap free throw ; + +0 + field: queue-last \ points to the last entry (head of the list) + field: queue-nextaddr \ points to the pointer to the next-inserted entry +constant queue-struct + +: init-queue ( queue -- ) + >r 0 r@ queue-last ! + r@ queue-last r> queue-nextaddr ! ; + +: make-queue ( -- queue ) + queue-struct allocate throw dup init-queue ; + +: empty? ( queue -- f ) + queue-last @ 0= ; + +: enqueue ( x queue -- ) + dup >r queue-nextaddr @ insert + r@ queue-nextaddr @ @ list-next r> queue-nextaddr ! ; + +: dequeue ( queue -- x ) + dup empty? abort" dequeue applied to an empty queue" + dup queue-last remove ( queue x ) + over empty? if + over init-queue then + nip ; diff --git a/Task/Queue-Definition/GAP/queue-definition.gap b/Task/Queue-Definition/GAP/queue-definition.gap index 59c46b3fa4..dc4a982e94 100644 --- a/Task/Queue-Definition/GAP/queue-definition.gap +++ b/Task/Queue-Definition/GAP/queue-definition.gap @@ -1,21 +1,20 @@ Enqueue := function(v, x) - Add(v[1], x); + Add(v[1], x); end; Dequeue := function(v) - local n, x; - n := Size(v[2]); - if n = 0 then - v[2] := Reversed(v[1]); - v[1] := [ ]; - n := Size(v[2]); - if n = 0 then - return fail; - fi; - fi; - return Remove(v[2], n); + if IsEmpty(v[2]) then + if IsEmpty(v[1]) then + return fail; + else + v[2] := Reversed(v[1]); + v[1] := []; + fi; + fi; + return Remove(v[2]); end; + # a new queue v := [[], []]; diff --git a/Task/Queue-Definition/Perl-6/queue-definition-2.pl6 b/Task/Queue-Definition/Perl-6/queue-definition-2.pl6 index bd40506f0a..c0be6f5d84 100644 --- a/Task/Queue-Definition/Perl-6/queue-definition-2.pl6 +++ b/Task/Queue-Definition/Perl-6/queue-definition-2.pl6 @@ -1,15 +1,15 @@ my @queue does FIFO; -say @queue.is-empty; # -> Bool::True -say @queue.enqueue:
    ; # -> 3 -say @queue.enqueue: Any; # -> 1 -say @queue.enqueue: 7, 8; # -> 2 -say @queue.is-empty; # -> Bool::False -say @queue.dequeue; # -> A -say @queue.elems; # -> 5 -say @queue.dequeue; # -> B -say @queue.is-empty; # -> Bool::False -say @queue.enqueue('OHAI!'); # -> 1 -say @queue.dequeue until @queue.is-empty; # -> C \n Any() \n 7 \n 8 \n OHAI! -say @queue.is-empty; # -> Bool::True -say @queue.dequeue; # -> +say @queue.is-empty; # -> Bool::True +for -> $i { say @queue.enqueue: $i } # 1 \n 1 \n 1 +say @queue.enqueue: Any; # -> 1 +say @queue.enqueue: 7, 8; # -> 2 +say @queue.is-empty; # -> Bool::False +say @queue.dequeue; # -> A +say @queue.elems; # -> 4 +say @queue.dequeue; # -> B +say @queue.is-empty; # -> Bool::False +say @queue.enqueue('OHAI!'); # -> 1 +say @queue.dequeue until @queue.is-empty; # -> C \n Any() \n [7 8] \n OHAI! +say @queue.is-empty; # -> Bool::True +say @queue.dequeue; # -> diff --git a/Task/Queue-Definition/PowerShell/queue-definition.psh b/Task/Queue-Definition/PowerShell/queue-definition.psh new file mode 100644 index 0000000000..3c337a2c0b --- /dev/null +++ b/Task/Queue-Definition/PowerShell/queue-definition.psh @@ -0,0 +1,17 @@ +$Q = New-Object System.Collections.Queue + +$Q.Enqueue( 1 ) +$Q.Enqueue( 2 ) +$Q.Enqueue( 3 ) + +$Q.Dequeue() +$Q.Dequeue() + +$Q.Count -eq 0 +$Q.Dequeue() +$Q.Count -eq 0 + +try +{ $Q.Dequeue() } +catch [System.InvalidOperationException] +{ If ( $_.Exception.Message -eq 'Queue empty.' ) { 'Caught error' } } diff --git a/Task/Queue-Definition/Rust/queue-definition-1.rust b/Task/Queue-Definition/Rust/queue-definition-1.rust new file mode 100644 index 0000000000..bd2d4e5e9a --- /dev/null +++ b/Task/Queue-Definition/Rust/queue-definition-1.rust @@ -0,0 +1,13 @@ +use std::collections::VecDeque; +fn main() { + let mut stack = VecDeque::new(); + stack.push_back("Element1"); + stack.push_back("Element2"); + stack.push_back("Element3"); + + assert_eq!(Some(&"Element1"), stack.front()); + assert_eq!(Some("Element1"), stack.pop_front()); + assert_eq!(Some("Element2"), stack.pop_front()); + assert_eq!(Some("Element3"), stack.pop_front()); + assert_eq!(None, stack.pop_front()); +} diff --git a/Task/Queue-Definition/Rust/queue-definition-2.rust b/Task/Queue-Definition/Rust/queue-definition-2.rust new file mode 100644 index 0000000000..f779a7a184 --- /dev/null +++ b/Task/Queue-Definition/Rust/queue-definition-2.rust @@ -0,0 +1,124 @@ +use std::ptr; + +pub struct Queue { + head: Link, + tail: *mut Item, // Raw, C-like pointer. Cannot be guaranteed safe +} + +type Link = Option>>; + +struct Item { + elem: T, + next: Link, +} + +pub struct IntoIter(Queue); + +pub struct Iter<'a, T:'a> { + next: Option<&'a Item>, +} + +pub struct IterMut<'a, T: 'a> { + next: Option<&'a mut Item>, +} + + +impl Queue { + pub fn new() -> Self { + Queue { head: None, tail: ptr::null_mut() } + } + + pub fn enqueue(&mut self, elem: T) { + let mut new_tail = Box::new(Item { + elem: elem, + next: None, + }); + + let raw_tail: *mut _ = &mut *new_tail; + + if !self.tail.is_null() { + unsafe { + (*self.tail).next = Some(new_tail); + } + } else { + self.head = Some(new_tail); + } + + self.tail = raw_tail; + } + + pub fn dequeue(&mut self) -> Option { + self.head.take().map(|head| { + let head = *head; + self.head = head.next; + + if self.head.is_none() { + self.tail = ptr::null_mut(); + } + + head.elem + }) + } + + pub fn peek(&self) -> Option<&T> { + self.head.as_ref().map(|item| { + &item.elem + }) + } + + pub fn peek_mut(&mut self) -> Option<&mut T> { + self.head.as_mut().map(|item| { + &mut item.elem + }) + } + + pub fn into_iter(self) -> IntoIter { + IntoIter(self) + } + + pub fn iter(&self) -> Iter { + Iter { next: self.head.as_ref().map(|item| &**item) } + } + + pub fn iter_mut(&mut self) -> IterMut { + IterMut { next: self.head.as_mut().map(|item| &mut **item) } + } +} + +impl Drop for Queue { + fn drop(&mut self) { + let mut cur_link = self.head.take(); + while let Some(mut boxed_item) = cur_link { + cur_link = boxed_item.next.take(); + } + } +} + +impl Iterator for IntoIter { + type Item = T; + fn next(&mut self) -> Option { + self.0.dequeue() + } +} + +impl<'a, T> Iterator for Iter<'a, T> { + type Item = &'a T; + + fn next(&mut self) -> Option { + self.next.map(|item| { + self.next = item.next.as_ref().map(|item| &**item); + &item.elem + }) + } +} + +impl<'a, T> Iterator for IterMut<'a, T> { + type Item = &'a mut T; + + fn next(&mut self) -> Option { + self.next.take().map(|item| { + self.next = item.next.as_mut().map(|item| &mut **item); + &mut item.elem + }) + } +} diff --git a/Task/Queue-Usage/00DESCRIPTION b/Task/Queue-Usage/00DESCRIPTION index a2da12ed37..f84a1c9da8 100644 --- a/Task/Queue-Usage/00DESCRIPTION +++ b/Task/Queue-Usage/00DESCRIPTION @@ -1,10 +1,17 @@ {{Data structure}} [[File:Fifo.gif|frame|right|Illustration of FIFO behavior]] -Create a queue data structure and demonstrate its operations. (For implementations of queues, see the [[FIFO]] task.) + +;Task: +Create a queue data structure and demonstrate its operations. + +(For implementations of queues, see the [[FIFO]] task.) + Operations: -* push (aka ''enqueue'') - add element -* pop (aka ''dequeue'') - pop first element -* empty - return truth value when empty +::*   push       (aka ''enqueue'') - add element +::*   pop         (aka ''dequeue'') - pop first element +::*   empty     - return truth value when empty +
    {{Template:See also lists}} +

    diff --git a/Task/Queue-Usage/Elena/queue-usage.elena b/Task/Queue-Usage/Elena/queue-usage.elena new file mode 100644 index 0000000000..6d1985888d --- /dev/null +++ b/Task/Queue-Usage/Elena/queue-usage.elena @@ -0,0 +1,25 @@ +#import system. +#import system'collections. +#import extensions. + +#symbol program = +[ + // Create a queue and "push" items into it + #var queue := Queue new. + + queue push:1. + queue push:3. + queue push:5. + + // "Pop" items from the queue in FIFO order + console writeLine:(queue pop). // 1 + console writeLine:(queue pop). // 3 + console writeLine:(queue pop). // 5 + + // To tell if the queue is empty, we check the count + console writeLine:"queue is ":((queue length == 0) iif:"empty":"nonempty"). + + // If we try to pop from an empty queue, an exception + // is thrown. + queue pop | if &Error: e [ console writeLine:"Queue empty.". ]. +]. diff --git a/Task/Queue-Usage/Forth/queue-usage-1.fth b/Task/Queue-Usage/Forth/queue-usage-1.fth new file mode 100644 index 0000000000..a0816624ee --- /dev/null +++ b/Task/Queue-Usage/Forth/queue-usage-1.fth @@ -0,0 +1,45 @@ +: cqueue: ( n -- ) + create \ compile time: build the data structure in memory + dup + dup 1- and abort" queue size must be power of 2" + 0 , \ write pointer "HEAD" + 0 , \ read pointer "TAIL" + 0 , \ byte counter + dup 1- , \ mask value used for wrap around + allot ; \ run time: returns the address of this data structure + +\ calculate offsets into the queue data structure +: ->head ( q -- adr ) ; \ syntactic sugar +: ->tail ( q -- adr ) cell+ ; +: ->cnt ( q -- adr ) 2 cells + ; +: ->msk ( q -- adr ) 3 cells + ; +: ->data ( q -- adr ) 4 cells + ; + +: head++ ( q -- ) \ circular increment head pointer of a queue + dup >r ->head @ 1+ r@ ->msk @ and r> ->head ! ; + +: tail++ ( q -- ) \ circular increment tail pointer of a queue + dup >r ->tail @ 1+ r@ ->msk @ and r> ->tail ! ; + +: qempty ( q -- flag) + dup ->head off dup ->tail off dup ->cnt off \ reset all fields to "off" (zero) + ->cnt @ 0= ; \ per the spec qempty returns a flag + +: cnt=msk? ( q -- flag) dup >r ->cnt @ r> ->msk @ = ; +: ?empty ( q -- ) ->cnt @ 0= abort" queue is empty" ; +: ?full ( q -- ) cnt=msk? abort" queue is full" ; +: 1+! ( adr -- ) 1 swap +! ; \ increment contents of adr +: 1-! ( adr -- ) -1 swap +! ; \ decrement contents of adr + +: qc@ ( queue -- char ) \ fetch next char in queue + dup >r ?empty \ abort if empty + r@ ->cnt 1-! \ decr. the counter + r@ tail++ + r@ ->data r> ->tail @ + c@ ; \ calc. address and fetch the byte + + +: qc! ( char queue -- ) + dup >r ?full \ abort if q full + r@ ->cnt 1+! \ incr. the counter + r@ head++ + r@ ->data r> ->head @ + c! ; \ data+head = adr, and store the char diff --git a/Task/Queue-Usage/Forth/queue-usage-2.fth b/Task/Queue-Usage/Forth/queue-usage-2.fth new file mode 100644 index 0000000000..ff0589a8e8 --- /dev/null +++ b/Task/Queue-Usage/Forth/queue-usage-2.fth @@ -0,0 +1,16 @@ +make-queue constant q1 +make-queue constant q2 +q1 empty? . +5 q1 enqueue +q1 empty? . +7 q1 enqueue +9 q1 enqueue +q2 empty? . +3 q2 enqueue +q2 empty? . +q1 dequeue . +q1 dequeue . +q1 dequeue . +q1 empty? . +q2 dequeue . +q2 empty? . diff --git a/Task/Queue-Usage/PowerShell/queue-usage.psh b/Task/Queue-Usage/PowerShell/queue-usage-1.psh similarity index 100% rename from Task/Queue-Usage/PowerShell/queue-usage.psh rename to Task/Queue-Usage/PowerShell/queue-usage-1.psh diff --git a/Task/Queue-Usage/PowerShell/queue-usage-2.psh b/Task/Queue-Usage/PowerShell/queue-usage-2.psh new file mode 100644 index 0000000000..bcef8fed72 --- /dev/null +++ b/Task/Queue-Usage/PowerShell/queue-usage-2.psh @@ -0,0 +1,3 @@ +$queue = New-Object -TypeName System.Collections.Queue +#or +$queue = [System.Collections.Queue] @() diff --git a/Task/Queue-Usage/PowerShell/queue-usage-3.psh b/Task/Queue-Usage/PowerShell/queue-usage-3.psh new file mode 100644 index 0000000000..74630330e2 --- /dev/null +++ b/Task/Queue-Usage/PowerShell/queue-usage-3.psh @@ -0,0 +1 @@ +Get-Member -InputObject $queue diff --git a/Task/Queue-Usage/PowerShell/queue-usage-4.psh b/Task/Queue-Usage/PowerShell/queue-usage-4.psh new file mode 100644 index 0000000000..1bdf036c3d --- /dev/null +++ b/Task/Queue-Usage/PowerShell/queue-usage-4.psh @@ -0,0 +1 @@ +1,2,3 | ForEach-Object {$queue.Enqueue($_)} diff --git a/Task/Queue-Usage/PowerShell/queue-usage-5.psh b/Task/Queue-Usage/PowerShell/queue-usage-5.psh new file mode 100644 index 0000000000..8c5ccd2126 --- /dev/null +++ b/Task/Queue-Usage/PowerShell/queue-usage-5.psh @@ -0,0 +1 @@ +$queue.Peek() diff --git a/Task/Queue-Usage/PowerShell/queue-usage-6.psh b/Task/Queue-Usage/PowerShell/queue-usage-6.psh new file mode 100644 index 0000000000..229c5ad8ff --- /dev/null +++ b/Task/Queue-Usage/PowerShell/queue-usage-6.psh @@ -0,0 +1 @@ +$queue.Dequeue() diff --git a/Task/Queue-Usage/PowerShell/queue-usage-7.psh b/Task/Queue-Usage/PowerShell/queue-usage-7.psh new file mode 100644 index 0000000000..bbdb5589c0 --- /dev/null +++ b/Task/Queue-Usage/PowerShell/queue-usage-7.psh @@ -0,0 +1 @@ +$queue.Clear() diff --git a/Task/Queue-Usage/PowerShell/queue-usage-8.psh b/Task/Queue-Usage/PowerShell/queue-usage-8.psh new file mode 100644 index 0000000000..c0ac5cef05 --- /dev/null +++ b/Task/Queue-Usage/PowerShell/queue-usage-8.psh @@ -0,0 +1 @@ +if (-not $queue.Count) {"Queue is empty"} diff --git a/Task/Quickselect-algorithm/00DESCRIPTION b/Task/Quickselect-algorithm/00DESCRIPTION index ec98e0dedc..f35c268540 100644 --- a/Task/Quickselect-algorithm/00DESCRIPTION +++ b/Task/Quickselect-algorithm/00DESCRIPTION @@ -2,4 +2,4 @@ Use the [[wp:Quickselect|quickselect algorithm]] on the vector : [9, 8, 7, 6, 5, 0, 1, 2, 3, 4] To show the first, second, third, ... up to the tenth largest member of the vector, in order, here on this page. -* Note: Quick''sort'' has a separate [[Sorting algorithms/Quicksort|task]]. +* Note: Quick''sort'' has a separate [[Sorting algorithms/Quicksort|task]].

    diff --git a/Task/Quickselect-algorithm/Elixir/quickselect-algorithm.elixir b/Task/Quickselect-algorithm/Elixir/quickselect-algorithm.elixir new file mode 100644 index 0000000000..381f7402f0 --- /dev/null +++ b/Task/Quickselect-algorithm/Elixir/quickselect-algorithm.elixir @@ -0,0 +1,19 @@ +defmodule Quick do + def select(k, [x|xs]) do + {ys, zs} = Enum.partition(xs, fn e -> e < x end) + l = length(ys) + cond do + k < l -> select(k, ys) + k > l -> select(k - l - 1, zs) + true -> x + end + end + + def test do + v = [9, 8, 7, 6, 5, 0, 1, 2, 3, 4] + Enum.map(0..length(v)-1, fn i -> select(i,v) end) + |> IO.inspect + end +end + +Quick.test diff --git a/Task/Quickselect-algorithm/Fortran/quickselect-algorithm.f b/Task/Quickselect-algorithm/Fortran/quickselect-algorithm.f new file mode 100644 index 0000000000..826117113a --- /dev/null +++ b/Task/Quickselect-algorithm/Fortran/quickselect-algorithm.f @@ -0,0 +1,51 @@ + INTEGER FUNCTION FINDELEMENT(K,A,N) !I know I can. +Chase an order statistic: FindElement(N/2,A,N) leads to the median, with some odd/even caution. +Careful! The array is shuffled: for i < K, A(i) <= A(K); for i > K, A(i) >= A(K). +Charles Anthony Richard Hoare devised this method, as related to his famous QuickSort. + INTEGER K,N !Find the K'th element in order of an array of N elements, not necessarily in order. + INTEGER A(N),HOPE,PESTY !The array, and like associates. + INTEGER L,R,L2,R2 !Fingers. + L = 1 !Here we go. + R = N !The bounds of the work area within which the K'th element lurks. + DO WHILE (L .LT. R) !So, keep going until it is clamped. + HOPE = A(K) !If array A is sorted, this will be rewarded. + L2 = L !But it probably isn't sorted. + R2 = R !So prepare a scan. + DO WHILE (L2 .LE. R2) !Keep squeezing until the inner teeth meet. + DO WHILE (A(L2) .LT. HOPE) !Pass elements less than HOPE. + L2 = L2 + 1 !Note that at least element A(K) equals HOPE. + END DO !Raising the lower jaw. + DO WHILE (HOPE .LT. A(R2)) !Elements higher than HOPE + R2 = R2 - 1 !Are in the desired place. + END DO !And so we speed past them. + IF (L2 - R2) 1,2,3 !How have the teeth paused? + 1 PESTY = A(L2) !On grit. A(L2) > HOPE and A(R2) < HOPE. + A(L2) = A(R2) !So swap the two troublemakers. + A(R2) = PESTY !To be as if they had been in the desired order all along. + 2 L2 = L2 + 1 !Advance my teeth. + R2 = R2 - 1 !As if they hadn't paused on this pest. + 3 END DO !And resume the squeeze, hopefully closing in K. + IF (R2 .LT. K) L = L2 !The end point gives the order position of value HOPE. + IF (K .LT. L2) R = R2 !But we want the value of order position K. + END DO !Have my teeth met yet? + FINDELEMENT = A(K) !Yes. A(K) now has the K'th element in order. + END FUNCTION FINDELEMENT !Remember! Array A has likely had some elements moved! + + PROGRAM POKE + INTEGER FINDELEMENT !Not the default type for F. + INTEGER N !The number of elements. + PARAMETER (N = 10) !Fixed for the test problem. + INTEGER A(66) !An array of integers. + DATA A(1:N)/9, 8, 7, 6, 5, 0, 1, 2, 3, 4/ !The specified values. + + WRITE (6,1) A(1:N) !Announce, and add a heading. + 1 FORMAT ("Selection of the i'th element in order from an array.",/ + 1 "The array need not be in order, and may be reordered.",/ + 2 " i Val:Array elements...",/,8X,666I2) + + DO I = 1,N !One by one, + WRITE (6,2) I,FINDELEMENT(I,A,N),A(1:N) !Request the i'th element. + 2 FORMAT (I3,I4,":",666I2) !Match FORMAT 1. + END DO !On to the next trial. + + END !That was easy. diff --git a/Task/Quickselect-algorithm/Lua/quickselect-algorithm.lua b/Task/Quickselect-algorithm/Lua/quickselect-algorithm.lua new file mode 100644 index 0000000000..fab352f7b3 --- /dev/null +++ b/Task/Quickselect-algorithm/Lua/quickselect-algorithm.lua @@ -0,0 +1,33 @@ +function partition (list, left, right, pivotIndex) + local pivotValue = list[pivotIndex] + list[pivotIndex], list[right] = list[right], list[pivotIndex] + local storeIndex = left + for i = left, right do + if list[i] < pivotValue then + list[storeIndex], list[i] = list[i], list[storeIndex] + storeIndex = storeIndex + 1 + end + end + list[right], list[storeIndex] = list[storeIndex], list[right] + return storeIndex +end + +function quickSelect (list, left, right, n) + local pivotIndex + while 1 do + if left == right then return list[left] end + pivotIndex = math.random(left, right) + pivotIndex = partition(list, left, right, pivotIndex) + if n == pivotIndex then + return list[n] + elseif n < pivotIndex then + right = pivotIndex - 1 + else + left = pivotIndex + 1 + end + end +end + +math.randomseed(os.time()) +local vec = {9, 8, 7, 6, 5, 0, 1, 2, 3, 4} +for i = 1, 10 do print(i, quickSelect(vec, 1, #vec, i) .. " ") end diff --git a/Task/Quickselect-algorithm/PowerShell/quickselect-algorithm.psh b/Task/Quickselect-algorithm/PowerShell/quickselect-algorithm.psh new file mode 100644 index 0000000000..e71bcb3db2 --- /dev/null +++ b/Task/Quickselect-algorithm/PowerShell/quickselect-algorithm.psh @@ -0,0 +1,31 @@ + function partition($list, $left, $right, $pivotIndex) { + $pivotValue = $list[$pivotIndex] + $list[$pivotIndex], $list[$right] = $list[$right], $list[$pivotIndex] + $storeIndex = $left + foreach ($i in $left..($right-1)) { + if ($list[$i] -lt $pivotValue) { + $list[$storeIndex],$list[$i] = $list[$i], $list[$storeIndex] + $storeIndex += 1 + } + } + $list[$right],$list[$storeIndex] = $list[$storeIndex], $list[$right] + $storeIndex +} + +function rank($list, $left, $right, $n) { + if ($left -eq $right) {$list[$left]} + else { + $pivotIndex = Get-Random -Minimum $left -Maximum $right + $pivotIndex = partition $list $left $right $pivotIndex + if ($n -eq $pivotIndex) {$list[$n]} + elseif ($n -lt $pivotIndex) {(rank $list $left ($pivotIndex - 1) $n)} + else {(rank $list ($pivotIndex+1) $right $n)} + } +} + +function quickselect($list) { + $right = $list.count-1 + foreach($left in 0..$right) {rank $list $left $right $left} +} +$arr = @(9, 8, 7, 6, 5, 0, 1, 2, 3, 4) +"$(quickselect $arr)" diff --git a/Task/Quickselect-algorithm/REXX/quickselect-algorithm-1.rexx b/Task/Quickselect-algorithm/REXX/quickselect-algorithm-1.rexx index 08ac4a8dc7..9de21f9872 100644 --- a/Task/Quickselect-algorithm/REXX/quickselect-algorithm-1.rexx +++ b/Task/Quickselect-algorithm/REXX/quickselect-algorithm-1.rexx @@ -1,30 +1,32 @@ -/*REXX pgm sorts a list (which may be numbers) using quick select algorithm.*/ -parse arg list; if list='' then list=9 8 7 6 5 0 1 2 3 4 /*use the default?*/ - do #=1 for words(list); @.#=word(list,#) /*assign item──►@.*/ - end /*#*/ /* [↑] #: number of items in the list*/ -#=#-1 /*adjust number of items in the list. */ - do j=1 for # /*show 1 ──► # of items place and value*/ - say right('item',20) right(j,length(#))", value: " qSel(1,#,j) +/*REXX program sorts a list (which may be numbers) by using the quick select algorithm. */ +parse arg list; if list='' then list=9 8 7 6 5 0 1 2 3 4 /*Not given? Use default.*/ +say right('list: ', 22) list +say + do #=1 for words(list); @.#=word(list,#) /*assign all the items ──► @. (array). */ + end /*#*/ /* [↑] #: number of items in the list.*/ +#=#-1 /*adjust number of items in the list. */ + do j=1 for # /*show 1 ──► # items place and value.*/ + say right('item', 20) right(j, length(#))", value: " qSel(1, #, j) end /*j*/ -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────QPART subroutine──────────────────────────*/ -qPart: procedure expose @.; parse arg L 1 ?,R,X; xVal = @.X -parse value @.X @.R with @.R @.X /*swap the two names items (X and R). */ - do k=L to R-1 /*process the left side of the list. */ - if @.k>xVal then iterate /*when an item > item #X, then skip it.*/ - parse value @.? @.k with @.k @.? /*swap the two named items (? and K). */ - ?=?+1 /*bump the item number (point to next)*/ - end /*k*/ -parse value @.R @.? with @.? @.R /*swap the two named items (R and ?). */ -return ? /*return item num.*/ -/*──────────────────────────────────QSEL subroutine───────────────────────────*/ -qSel: procedure expose @.; parse arg L,R,z; if L==R then return @.L /*one?*/ - do forever /*keep searching until we're all done. */ - new=qPart(L, R, (L+R)%2) /*partition the list into roughly ½. */ - dist=new-L+1 /*calculate the pivot distance less L+1*/ - if dist==z then return @.new /*we're all done with this pivot part. */ - else if zxVal then iterate /*when an item > item #X, then skip it.*/ + parse value @.? @.k with @.k @.? /*swap the two named items (? and K). */ + ?=?+1 /*bump the item number (point to next).*/ + end /*k*/ + parse value @.R @.? with @.? @.R /*swap the two named items (R and ?). */ + return ? /*return the item number to invoker. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +qSel: procedure expose @.; parse arg L,R,z; if L==R then return @.L /*only one item?*/ + do forever /*keep searching until we're all done. */ + new=qPart(L, R, (L+R) % 2) /*partition the list into roughly ½. */ + $=new-L+1 /*calculate pivot distance less L+1. */ + if $==z then return @.new /*we're all done with this pivot part. */ + else if z<$ then R=new-1 /*decrease the right half of the array.*/ + else do; z=z-$ /*decrease the distance. */ + L=new+1 /*increase the left half *f the array.*/ + end + end /*forever*/ diff --git a/Task/Quickselect-algorithm/REXX/quickselect-algorithm-2.rexx b/Task/Quickselect-algorithm/REXX/quickselect-algorithm-2.rexx index e49e4135a9..3bbb74257d 100644 --- a/Task/Quickselect-algorithm/REXX/quickselect-algorithm-2.rexx +++ b/Task/Quickselect-algorithm/REXX/quickselect-algorithm-2.rexx @@ -1,32 +1,34 @@ -/*REXX pgm sorts a list (which may be numbers) using quick select algorithm.*/ -parse arg list; if list='' then list=9 8 7 6 5 0 1 2 3 4 /*use the default?*/ - do #=1 for words(list); @.#=word(list,#) /*assign item──►@.*/ - end /*#*/ /* [↑] #: number of items in the list*/ -#=#-1 /*adjust number of items in the list. */ - do j=1 for # /*show 1 ──► # of items place and value*/ - say right('item',20) right(j,length(#))", value: " qSel(1,#,j) +/*REXX program sorts a list (which may be numbers) by using the quick select algorithm. */ +parse arg list; if list='' then list=9 8 7 6 5 0 1 2 3 4 /*Not given? Use default.*/ +say right('list: ', 22) list +say + do #=1 for words(list); @.#=word(list,#) /*assign all the items ──► @. (array). */ + end /*#*/ /* [↑] #: number of items in the list.*/ +#=#-1 /*adjust number of items in the list. */ + do j=1 for # /*show 1 ──► # items place and value.*/ + say right('item', 20) right(j, length(#))", value: " qSel(1, #, j) end /*j*/ -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────QPART subroutine──────────────────────────*/ -qPart: procedure expose @.; parse arg L 1 ?,R,X; xVal = @.X -call swap X,R /*swap the two named items (X and R). */ - do k=L to R-1 /*process the left side of the list. */ - if @.k>xVal then iterate /*when an item > item #X, then skip it.*/ - call swap ?,k /*swap the two named items (? and K). */ - ?=?+1 /*bump item number we're working with. */ - end /*k*/ -call swap R,? /*swap the two named items (R and ?). */ -return ? /*return item num.*/ -/*──────────────────────────────────QSEL subroutine───────────────────────────*/ -qSel: procedure expose @.; parse arg L,R,z; if L==R then return @.L /*one?*/ - do forever /*keep searching until we're all done. */ - new=qPart(L, R, (L+R)%2) /*partition the list into roughly ½. */ - dist=new-L+1 /*calculate the pivot distance less L+1*/ - if dist==z then return @.new /*we're all done with this pivot part. */ - else if zxVal then iterate /*when an item > item #X, then skip it.*/ + call swap ?,k /*swap the two named items (? and K). */ + ?=?+1 /*bump the item number (point to next).*/ + end /*k*/ + call swap R,? /*swap the two named items (R and ?). */ + return ? /*return the item number to invoker. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +qSel: procedure expose @.; parse arg L,R,z; if L==R then return @.L /*only one item?*/ + do forever /*keep searching until we're all done. */ + new=qPart(L, R, (L+R)%2) /*partition the list into roughly ½. */ + $=new-L+1 /*calculate the pivot distance less L+1*/ + if $==z then return @.new /*we're all done with this pivot part. */ + else if z<$ then R=new-1 /*decrease the right half of the array.*/ + else do; z=z-$ /*decrease the distance. */ + L=new+1 /*increase the left half of the array.*/ + end + end /*forever*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +swap: parse arg _1,_2; parse value @._1 @._2 with @._2 @._1; return /*swap 2 items.*/ diff --git a/Task/Quine/00DESCRIPTION b/Task/Quine/00DESCRIPTION index a32201f813..8922e0ef77 100644 --- a/Task/Quine/00DESCRIPTION +++ b/Task/Quine/00DESCRIPTION @@ -1,5 +1,6 @@ A [[wp:Quine_%28computing%29|Quine]] is a self-referential program that can, without any external access, output its own source. + It is named after the [[wp:Willard_Van_Orman_Quine|philosopher and logician]] who studied self-reference and quoting in natural language, as for example in the paradox "'Yields falsehood when preceded by its quotation' yields falsehood when preceded by its quotation." @@ -9,6 +10,8 @@ For languages in which program source is represented as a data structure, "sourc The usual way to code a Quine works similarly to this paradox: The program consists of two identical parts, once as plain code and once ''quoted'' in some way (for example, as a character string, or a literal data structure). The plain code then accesses the quoted code and prints it out twice, once unquoted and once with the proper quotation marks added. Often, the plain code and the quoted code have to be nested. + +;Task: Write a program that outputs its own source code in this way. If the language allows it, you may add a variant that accesses the code directly. You are not allowed to read any external files with the source code. The program should also contain some sort of self-reference, so constant expressions which return their own value which some top-level interpreter will print out. Empty programs producing no output are not allowed. There are several difficulties that one runs into when writing a quine, mostly dealing with quoting: @@ -20,4 +23,6 @@ There are several difficulties that one runs into when writing a quine, mostly d ** Some languages allow you to have a string literal that spans multiple lines, which embeds the newlines into the string without escaping. ** Write the entire program on one line, for free-form languages (as you can see for some of the solutions here, they run off the edge of the screen), thus removing the need for newlines. However, this may be unacceptable as some languages require a newline at the end of the file; and otherwise it is still generally good style to have a newline at the end of a file. (The task is not clear on whether a newline is required at the end of the file.) Some languages have a print statement that appends a newline; which solves the newline-at-the-end issue; but others do not. +
    '''Next to the Quines presented here, many other versions can be found on the [http://www.nyx.net/~gthompso/quine.htm Quine] page.''' +

    diff --git a/Task/Quine/Babel/quine-1.pb b/Task/Quine/Babel/quine-1.pb new file mode 100644 index 0000000000..56e559a0df --- /dev/null +++ b/Task/Quine/Babel/quine-1.pb @@ -0,0 +1,6 @@ +% bin/babel quine.sp +{ "{ '{ ' << dup [val 0x22 0xffffff00 ] dup <- << << -> << ' ' << << ' }' << } !" { '{ ' << dup [val 0x22 0xffffff00 ] dup <- << << -> << ' ' << << '}' << } ! }% +% +% cat quine.sp +{ "{ '{ ' << dup [val 0x22 0xffffff00 ] dup <- << << -> << ' ' << << ' }' << } !" { '{ ' << dup [val 0x22 0xffffff00 ] dup <- << << -> << ' ' << << '}' << } ! }% +% diff --git a/Task/Quine/Babel/quine-2.pb b/Task/Quine/Babel/quine-2.pb new file mode 100644 index 0000000000..3b53265427 --- /dev/null +++ b/Task/Quine/Babel/quine-2.pb @@ -0,0 +1,6 @@ +% bin/babel +babel> { "{ '{ ' << dup [val 0x22 0xffffff00 ] dup <- << << -> << ' ' << << ' }' << } !" { '{ ' << dup [val 0x22 0xffffff00 ] dup <- << << -> << ' ' << << '}' << } ! } +babel> eval +{ "{ '{ ' << dup [val 0x22 0xffffff00 ] dup <- << << -> << ' ' << << ' }' << } !" { '{ ' << dup [val 0x22 0xffffff00 ] dup <- << << -> << ' ' << << ' +}' << } !}babel> +babel> diff --git a/Task/Quine/C/quine.c b/Task/Quine/C/quine-1.c similarity index 100% rename from Task/Quine/C/quine.c rename to Task/Quine/C/quine-1.c diff --git a/Task/Quine/C/quine-2.c b/Task/Quine/C/quine-2.c new file mode 100644 index 0000000000..191c005f40 --- /dev/null +++ b/Task/Quine/C/quine-2.c @@ -0,0 +1,2 @@ +#include +int main(){char*c="#include %cint main(){char*c=%c%s%c;printf(c,10,34,c,34,10);return 0;}%c";printf(c,10,34,c,34,10);return 0;} diff --git a/Task/Quine/COBOL/quine-1.cobol b/Task/Quine/COBOL/quine-1.cobol index d7d3ecf8c9..096e2ce35a 100644 --- a/Task/Quine/COBOL/quine-1.cobol +++ b/Task/Quine/COBOL/quine-1.cobol @@ -1,339 +1 @@ - IDENTIFICATION DIVISION. - PROGRAM-ID. GRICE. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - SYMBOLIC CHARACTERS FULL-STOP IS 76. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OUTPUT-FILE ASSIGN TO OUTPUT1. - DATA DIVISION. - FILE SECTION. - FD OUTPUT-FILE - RECORDING MODE F - LABEL RECORDS OMITTED. - 01 OUTPUT-RECORD PIC X(80). - WORKING-STORAGE SECTION. - 01 SUB-X PIC S9(4) COMP. - 01 SOURCE-FACSIMILE-AREA. - 02 SOURCE-FACSIMILE-DATA. - 03 FILLER PIC X(40) VALUE - " IDENTIFICATION DIVISION. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " PROGRAM-ID. GRICE. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " ENVIRONMENT DIVISION. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " CONFIGURATION SECTION. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " SPECIAL-NAMES. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " SYMBOLIC CHARACTERS FULL-STOP". - 03 FILLER PIC X(40) VALUE - " IS 76. ". - 03 FILLER PIC X(40) VALUE - " INPUT-OUTPUT SECTION. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " FILE-CONTROL. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " SELECT OUTPUT-FILE ASSIGN TO ". - 03 FILLER PIC X(40) VALUE - "OUTPUT1. ". - 03 FILLER PIC X(40) VALUE - " DATA DIVISION. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " FILE SECTION. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " FD OUTPUT-FILE ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " RECORDING MODE F ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " LABEL RECORDS OMITTED. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " 01 OUTPUT-RECORD ". - 03 FILLER PIC X(40) VALUE - " PIC X(80). ". - 03 FILLER PIC X(40) VALUE - " WORKING-STORAGE SECTION. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " 01 SUB-X ". - 03 FILLER PIC X(40) VALUE - " PIC S9(4) COMP. ". - 03 FILLER PIC X(40) VALUE - " 01 SOURCE-FACSIMILE-AREA. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " 02 SOURCE-FACSIMILE-DATA. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " 03 FILLER ". - 03 FILLER PIC X(40) VALUE - " PIC X(40) VALUE ". - 03 FILLER PIC X(40) VALUE - " 02 SOURCE-FACSIMILE-TABLE RE". - 03 FILLER PIC X(40) VALUE - "DEFINES ". - 03 FILLER PIC X(40) VALUE - " SOURCE-FACSIMILE-DATA". - 03 FILLER PIC X(40) VALUE - ". ". - 03 FILLER PIC X(40) VALUE - " 03 SOURCE-FACSIMILE OCCU". - 03 FILLER PIC X(40) VALUE - "RS 68. ". - 03 FILLER PIC X(40) VALUE - " 04 SOURCE-FACSIMILE-". - 03 FILLER PIC X(40) VALUE - "ONE PIC X(40). ". - 03 FILLER PIC X(40) VALUE - " 04 SOURCE-FACSIMILE-". - 03 FILLER PIC X(40) VALUE - "TWO PIC X(40). ". - 03 FILLER PIC X(40) VALUE - " 01 FILLER-IMAGE. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " 02 FILLER ". - 03 FILLER PIC X(40) VALUE - " PIC X(15) VALUE SPACES. ". - 03 FILLER PIC X(40) VALUE - " 02 FILLER ". - 03 FILLER PIC X(40) VALUE - " PIC X VALUE QUOTE. ". - 03 FILLER PIC X(40) VALUE - " 02 FILLER-DATA ". - 03 FILLER PIC X(40) VALUE - " PIC X(40). ". - 03 FILLER PIC X(40) VALUE - " 02 FILLER ". - 03 FILLER PIC X(40) VALUE - " PIC X VALUE QUOTE. ". - 03 FILLER PIC X(40) VALUE - " 02 FILLER ". - 03 FILLER PIC X(40) VALUE - " PIC X VALUE FULL-STOP. ". - 03 FILLER PIC X(40) VALUE - " 02 FILLER ". - 03 FILLER PIC X(40) VALUE - " PIC X(22) VALUE SPACES. ". - 03 FILLER PIC X(40) VALUE - " PROCEDURE DIVISION. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " MAIN-LINE SECTION. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " ML-1. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " OPEN OUTPUT OUTPUT-FILE. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " MOVE 1 TO SUB-X. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " ML-2. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " MOVE SOURCE-FACSIMILE (SUB-X)". - 03 FILLER PIC X(40) VALUE - " TO OUTPUT-RECORD. ". - 03 FILLER PIC X(40) VALUE - " WRITE OUTPUT-RECORD. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " IF SUB-X < 19 ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " ADD 1 TO SUB-X ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " GO TO ML-2. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " MOVE 1 TO SUB-X. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " ML-3. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " MOVE SOURCE-FACSIMILE (20) TO". - 03 FILLER PIC X(40) VALUE - " OUTPUT-RECORD. ". - 03 FILLER PIC X(40) VALUE - " WRITE OUTPUT-RECORD. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " MOVE SOURCE-FACSIMILE-ONE (SU". - 03 FILLER PIC X(40) VALUE - "B-X) TO FILLER-DATA. ". - 03 FILLER PIC X(40) VALUE - " MOVE FILLER-IMAGE TO OUTPUT-R". - 03 FILLER PIC X(40) VALUE - "ECORD. ". - 03 FILLER PIC X(40) VALUE - " WRITE OUTPUT-RECORD. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " MOVE SOURCE-FACSIMILE (20) TO". - 03 FILLER PIC X(40) VALUE - " OUTPUT-RECORD. ". - 03 FILLER PIC X(40) VALUE - " WRITE OUTPUT-RECORD. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " MOVE SOURCE-FACSIMILE-TWO (SU". - 03 FILLER PIC X(40) VALUE - "B-X) TO FILLER-DATA. ". - 03 FILLER PIC X(40) VALUE - " MOVE FILLER-IMAGE TO OUTPUT-R". - 03 FILLER PIC X(40) VALUE - "ECORD. ". - 03 FILLER PIC X(40) VALUE - " WRITE OUTPUT-RECORD. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " IF SUB-X < 68 ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " ADD 1 TO SUB-X ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " GO TO ML-3. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " MOVE 21 TO SUB-X. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " ML-4. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " MOVE SOURCE-FACSIMILE (SUB-X)". - 03 FILLER PIC X(40) VALUE - " TO OUTPUT-RECORD. ". - 03 FILLER PIC X(40) VALUE - " WRITE OUTPUT-RECORD. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " IF SUB-X < 68 ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " ADD 1 TO SUB-X ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " GO TO ML-4. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " ML-99. ". - 03 FILLER PIC X(40) VALUE - " ". - lang Ada>with Ada.Text_IO;procedure Self is Q:Character:='"';A:String:="with Ada.Text_IO;procedure Self is Q:Character:=' 03 FILLER PIC X(40) VALUE - " CLOSE OUTPUT-FILE. ". - 03 FILLER PIC X(40) VALUE - " ". - 03 FILLER PIC X(40) VALUE - " STOP RUN. ". - 03 FILLER PIC X(40) VALUE - " ". - 02 SOURCE-FACSIMILE-TABLE REDEFINES - SOURCE-FACSIMILE-DATA. - 03 SOURCE-FACSIMILE OCCURS 68. - 04 SOURCE-FACSIMILE-ONE PIC X(40). - 04 SOURCE-FACSIMILE-TWO PIC X(40). - 01 FILLER-IMAGE. - 02 FILLER PIC X(15) VALUE SPACES. - 02 FILLER PIC X VALUE QUOTE. - 02 FILLER-DATA PIC X(40). - 02 FILLER PIC X VALUE QUOTE. - 02 FILLER PIC X VALUE FULL-STOP. - 02 FILLER PIC X(22) VALUE SPACES. - PROCEDURE DIVISION. - MAIN-LINE SECTION. - ML-1. - OPEN OUTPUT OUTPUT-FILE. - MOVE 1 TO SUB-X. - ML-2. - MOVE SOURCE-FACSIMILE (SUB-X) TO OUTPUT-RECORD. - WRITE OUTPUT-RECORD. - IF SUB-X < 19 - ADD 1 TO SUB-X - GO TO ML-2. - MOVE 1 TO SUB-X. - ML-3. - MOVE SOURCE-FACSIMILE (20) TO OUTPUT-RECORD. - WRITE OUTPUT-RECORD. - MOVE SOURCE-FACSIMILE-ONE (SUB-X) TO FILLER-DATA. - MOVE FILLER-IMAGE TO OUTPUT-RECORD. - WRITE OUTPUT-RECORD. - MOVE SOURCE-FACSIMILE (20) TO OUTPUT-RECORD. - WRITE OUTPUT-RECORD. - MOVE SOURCE-FACSIMILE-TWO (SUB-X) TO FILLER-DATA. - MOVE FILLER-IMAGE TO OUTPUT-RECORD. - WRITE OUTPUT-RECORD. - IF SUB-X < 68 - ADD 1 TO SUB-X - GO TO ML-3. - MOVE 21 TO SUB-X. - ML-4. - MOVE SOURCE-FACSIMILE (SUB-X) TO OUTPUT-RECORD. - WRITE OUTPUT-RECORD. - IF SUB-X < 68 - ADD 1 TO SUB-X - GO TO ML-4. - ML-99. - CLOSE OUTPUT-FILE. - STOP RUN. +linkage section. 78 c value "display 'linkage section. 78 c value ' x'22' c x'222e20' c.". display 'linkage section. 78 c value ' x'22' c x'222e20' c. diff --git a/Task/Quine/COBOL/quine-2.cobol b/Task/Quine/COBOL/quine-2.cobol index 412e295df7..79c601ebf6 100644 --- a/Task/Quine/COBOL/quine-2.cobol +++ b/Task/Quine/COBOL/quine-2.cobol @@ -1,48 +1,339 @@ - ID DIVISION. - PROGRAM-ID. QUINE. + IDENTIFICATION DIVISION. + PROGRAM-ID. GRICE. + ENVIRONMENT DIVISION. + CONFIGURATION SECTION. + SPECIAL-NAMES. + SYMBOLIC CHARACTERS FULL-STOP IS 76. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT OUTPUT-FILE ASSIGN TO OUTPUT1. DATA DIVISION. + FILE SECTION. + FD OUTPUT-FILE + RECORDING MODE F + LABEL RECORDS OMITTED. + 01 OUTPUT-RECORD PIC X(80). WORKING-STORAGE SECTION. - 1 X PIC S9(4) COMP. - 1 A. 2 B. - 3 PIC X(40) VALUE " ID DIVISION. ". - 3 PIC X(40) VALUE " ". - 3 PIC X(40) VALUE " PROGRAM-ID. QUINE. ". - 3 PIC X(40) VALUE " ". - 3 PIC X(40) VALUE " DATA DIVISION. ". - 3 PIC X(40) VALUE " ". - 3 PIC X(40) VALUE " WORKING-STORAGE SECTION. ". - 3 PIC X(40) VALUE " ". - 3 PIC X(40) VALUE " 1 X PIC S9(4) COMP. ". - 3 PIC X(40) VALUE " ". - 3 PIC X(40) VALUE " 1 A. 2 B. ". - 3 PIC X(40) VALUE " ". - 3 PIC X(40) VALUE " 2 T REDEFINES B. 3 TE OCCURS 16. ". - 3 PIC X(40) VALUE "4 T1 PIC X(40). 4 T2 PIC X(40). ". - 3 PIC X(40) VALUE " 1 F. 2 PIC X(25) VALUE ". - 3 PIC X(40) VALUE "' 3 PIC X(40) VALUE '. ". - 3 PIC X(40) VALUE " 2 PIC X VALUE QUOTE. 2 FF PIC X(4". - 3 PIC X(40) VALUE "0). 2 PIC X VALUE QUOTE. ". - 3 PIC X(40) VALUE " 2 PIC X VALUE '.'. ". - 3 PIC X(40) VALUE " ". - 3 PIC X(40) VALUE " PROCEDURE DIVISION. ". - 3 PIC X(40) VALUE " ". - 3 PIC X(40) VALUE " PERFORM VARYING X FROM 1 BY 1". - 3 PIC X(40) VALUE " UNTIL X > 6 DISPLAY TE (X) ". - 3 PIC X(40) VALUE " END-PERFORM PERFORM VARYING X". - 3 PIC X(40) VALUE " FROM 1 BY 1 UNTIL X > 16 ". - 3 PIC X(40) VALUE " MOVE T1 (X) TO FF DISPLAY F M". - 3 PIC X(40) VALUE "OVE T2 (X) TO FF DISPLAY F ". - 3 PIC X(40) VALUE " END-PERFORM PERFORM VARYING X". - 3 PIC X(40) VALUE " FROM 7 BY 1 UNTIL X > 16 ". - 3 PIC X(40) VALUE " DISPLAY TE (X) END-PERFORM ST". - 3 PIC X(40) VALUE "OP RUN. ". - 2 T REDEFINES B. 3 TE OCCURS 16. 4 T1 PIC X(40). 4 T2 PIC X(40). - 1 F. 2 PIC X(25) VALUE ' 3 PIC X(40) VALUE '. - 2 PIC X VALUE QUOTE. 2 FF PIC X(40). 2 PIC X VALUE QUOTE. - 2 PIC X VALUE '.'. + 01 SUB-X PIC S9(4) COMP. + 01 SOURCE-FACSIMILE-AREA. + 02 SOURCE-FACSIMILE-DATA. + 03 FILLER PIC X(40) VALUE + " IDENTIFICATION DIVISION. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " PROGRAM-ID. GRICE. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " ENVIRONMENT DIVISION. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " CONFIGURATION SECTION. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " SPECIAL-NAMES. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " SYMBOLIC CHARACTERS FULL-STOP". + 03 FILLER PIC X(40) VALUE + " IS 76. ". + 03 FILLER PIC X(40) VALUE + " INPUT-OUTPUT SECTION. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " FILE-CONTROL. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " SELECT OUTPUT-FILE ASSIGN TO ". + 03 FILLER PIC X(40) VALUE + "OUTPUT1. ". + 03 FILLER PIC X(40) VALUE + " DATA DIVISION. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " FILE SECTION. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " FD OUTPUT-FILE ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " RECORDING MODE F ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " LABEL RECORDS OMITTED. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " 01 OUTPUT-RECORD ". + 03 FILLER PIC X(40) VALUE + " PIC X(80). ". + 03 FILLER PIC X(40) VALUE + " WORKING-STORAGE SECTION. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " 01 SUB-X ". + 03 FILLER PIC X(40) VALUE + " PIC S9(4) COMP. ". + 03 FILLER PIC X(40) VALUE + " 01 SOURCE-FACSIMILE-AREA. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " 02 SOURCE-FACSIMILE-DATA. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " 03 FILLER ". + 03 FILLER PIC X(40) VALUE + " PIC X(40) VALUE ". + 03 FILLER PIC X(40) VALUE + " 02 SOURCE-FACSIMILE-TABLE RE". + 03 FILLER PIC X(40) VALUE + "DEFINES ". + 03 FILLER PIC X(40) VALUE + " SOURCE-FACSIMILE-DATA". + 03 FILLER PIC X(40) VALUE + ". ". + 03 FILLER PIC X(40) VALUE + " 03 SOURCE-FACSIMILE OCCU". + 03 FILLER PIC X(40) VALUE + "RS 68. ". + 03 FILLER PIC X(40) VALUE + " 04 SOURCE-FACSIMILE-". + 03 FILLER PIC X(40) VALUE + "ONE PIC X(40). ". + 03 FILLER PIC X(40) VALUE + " 04 SOURCE-FACSIMILE-". + 03 FILLER PIC X(40) VALUE + "TWO PIC X(40). ". + 03 FILLER PIC X(40) VALUE + " 01 FILLER-IMAGE. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " 02 FILLER ". + 03 FILLER PIC X(40) VALUE + " PIC X(15) VALUE SPACES. ". + 03 FILLER PIC X(40) VALUE + " 02 FILLER ". + 03 FILLER PIC X(40) VALUE + " PIC X VALUE QUOTE. ". + 03 FILLER PIC X(40) VALUE + " 02 FILLER-DATA ". + 03 FILLER PIC X(40) VALUE + " PIC X(40). ". + 03 FILLER PIC X(40) VALUE + " 02 FILLER ". + 03 FILLER PIC X(40) VALUE + " PIC X VALUE QUOTE. ". + 03 FILLER PIC X(40) VALUE + " 02 FILLER ". + 03 FILLER PIC X(40) VALUE + " PIC X VALUE FULL-STOP. ". + 03 FILLER PIC X(40) VALUE + " 02 FILLER ". + 03 FILLER PIC X(40) VALUE + " PIC X(22) VALUE SPACES. ". + 03 FILLER PIC X(40) VALUE + " PROCEDURE DIVISION. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " MAIN-LINE SECTION. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " ML-1. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " OPEN OUTPUT OUTPUT-FILE. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " MOVE 1 TO SUB-X. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " ML-2. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " MOVE SOURCE-FACSIMILE (SUB-X)". + 03 FILLER PIC X(40) VALUE + " TO OUTPUT-RECORD. ". + 03 FILLER PIC X(40) VALUE + " WRITE OUTPUT-RECORD. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " IF SUB-X < 19 ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " ADD 1 TO SUB-X ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " GO TO ML-2. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " MOVE 1 TO SUB-X. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " ML-3. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " MOVE SOURCE-FACSIMILE (20) TO". + 03 FILLER PIC X(40) VALUE + " OUTPUT-RECORD. ". + 03 FILLER PIC X(40) VALUE + " WRITE OUTPUT-RECORD. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " MOVE SOURCE-FACSIMILE-ONE (SU". + 03 FILLER PIC X(40) VALUE + "B-X) TO FILLER-DATA. ". + 03 FILLER PIC X(40) VALUE + " MOVE FILLER-IMAGE TO OUTPUT-R". + 03 FILLER PIC X(40) VALUE + "ECORD. ". + 03 FILLER PIC X(40) VALUE + " WRITE OUTPUT-RECORD. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " MOVE SOURCE-FACSIMILE (20) TO". + 03 FILLER PIC X(40) VALUE + " OUTPUT-RECORD. ". + 03 FILLER PIC X(40) VALUE + " WRITE OUTPUT-RECORD. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " MOVE SOURCE-FACSIMILE-TWO (SU". + 03 FILLER PIC X(40) VALUE + "B-X) TO FILLER-DATA. ". + 03 FILLER PIC X(40) VALUE + " MOVE FILLER-IMAGE TO OUTPUT-R". + 03 FILLER PIC X(40) VALUE + "ECORD. ". + 03 FILLER PIC X(40) VALUE + " WRITE OUTPUT-RECORD. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " IF SUB-X < 68 ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " ADD 1 TO SUB-X ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " GO TO ML-3. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " MOVE 21 TO SUB-X. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " ML-4. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " MOVE SOURCE-FACSIMILE (SUB-X)". + 03 FILLER PIC X(40) VALUE + " TO OUTPUT-RECORD. ". + 03 FILLER PIC X(40) VALUE + " WRITE OUTPUT-RECORD. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " IF SUB-X < 68 ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " ADD 1 TO SUB-X ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " GO TO ML-4. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " ML-99. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " CLOSE OUTPUT-FILE. ". + 03 FILLER PIC X(40) VALUE + " ". + 03 FILLER PIC X(40) VALUE + " STOP RUN. ". + 03 FILLER PIC X(40) VALUE + " ". + 02 SOURCE-FACSIMILE-TABLE REDEFINES + SOURCE-FACSIMILE-DATA. + 03 SOURCE-FACSIMILE OCCURS 68. + 04 SOURCE-FACSIMILE-ONE PIC X(40). + 04 SOURCE-FACSIMILE-TWO PIC X(40). + 01 FILLER-IMAGE. + 02 FILLER PIC X(15) VALUE SPACES. + 02 FILLER PIC X VALUE QUOTE. + 02 FILLER-DATA PIC X(40). + 02 FILLER PIC X VALUE QUOTE. + 02 FILLER PIC X VALUE FULL-STOP. + 02 FILLER PIC X(22) VALUE SPACES. PROCEDURE DIVISION. - PERFORM VARYING X FROM 1 BY 1 UNTIL X > 6 DISPLAY TE (X) - END-PERFORM PERFORM VARYING X FROM 1 BY 1 UNTIL X > 16 - MOVE T1 (X) TO FF DISPLAY F MOVE T2 (X) TO FF DISPLAY F - END-PERFORM PERFORM VARYING X FROM 7 BY 1 UNTIL X > 16 - DISPLAY TE (X) END-PERFORM STOP RUN. + MAIN-LINE SECTION. + ML-1. + OPEN OUTPUT OUTPUT-FILE. + MOVE 1 TO SUB-X. + ML-2. + MOVE SOURCE-FACSIMILE (SUB-X) TO OUTPUT-RECORD. + WRITE OUTPUT-RECORD. + IF SUB-X < 19 + ADD 1 TO SUB-X + GO TO ML-2. + MOVE 1 TO SUB-X. + ML-3. + MOVE SOURCE-FACSIMILE (20) TO OUTPUT-RECORD. + WRITE OUTPUT-RECORD. + MOVE SOURCE-FACSIMILE-ONE (SUB-X) TO FILLER-DATA. + MOVE FILLER-IMAGE TO OUTPUT-RECORD. + WRITE OUTPUT-RECORD. + MOVE SOURCE-FACSIMILE (20) TO OUTPUT-RECORD. + WRITE OUTPUT-RECORD. + MOVE SOURCE-FACSIMILE-TWO (SUB-X) TO FILLER-DATA. + MOVE FILLER-IMAGE TO OUTPUT-RECORD. + WRITE OUTPUT-RECORD. + IF SUB-X < 68 + ADD 1 TO SUB-X + GO TO ML-3. + MOVE 21 TO SUB-X. + ML-4. + MOVE SOURCE-FACSIMILE (SUB-X) TO OUTPUT-RECORD. + WRITE OUTPUT-RECORD. + IF SUB-X < 68 + ADD 1 TO SUB-X + GO TO ML-4. + ML-99. + CLOSE OUTPUT-FILE. + STOP RUN. diff --git a/Task/Quine/COBOL/quine-3.cobol b/Task/Quine/COBOL/quine-3.cobol new file mode 100644 index 0000000000..412e295df7 --- /dev/null +++ b/Task/Quine/COBOL/quine-3.cobol @@ -0,0 +1,48 @@ + ID DIVISION. + PROGRAM-ID. QUINE. + DATA DIVISION. + WORKING-STORAGE SECTION. + 1 X PIC S9(4) COMP. + 1 A. 2 B. + 3 PIC X(40) VALUE " ID DIVISION. ". + 3 PIC X(40) VALUE " ". + 3 PIC X(40) VALUE " PROGRAM-ID. QUINE. ". + 3 PIC X(40) VALUE " ". + 3 PIC X(40) VALUE " DATA DIVISION. ". + 3 PIC X(40) VALUE " ". + 3 PIC X(40) VALUE " WORKING-STORAGE SECTION. ". + 3 PIC X(40) VALUE " ". + 3 PIC X(40) VALUE " 1 X PIC S9(4) COMP. ". + 3 PIC X(40) VALUE " ". + 3 PIC X(40) VALUE " 1 A. 2 B. ". + 3 PIC X(40) VALUE " ". + 3 PIC X(40) VALUE " 2 T REDEFINES B. 3 TE OCCURS 16. ". + 3 PIC X(40) VALUE "4 T1 PIC X(40). 4 T2 PIC X(40). ". + 3 PIC X(40) VALUE " 1 F. 2 PIC X(25) VALUE ". + 3 PIC X(40) VALUE "' 3 PIC X(40) VALUE '. ". + 3 PIC X(40) VALUE " 2 PIC X VALUE QUOTE. 2 FF PIC X(4". + 3 PIC X(40) VALUE "0). 2 PIC X VALUE QUOTE. ". + 3 PIC X(40) VALUE " 2 PIC X VALUE '.'. ". + 3 PIC X(40) VALUE " ". + 3 PIC X(40) VALUE " PROCEDURE DIVISION. ". + 3 PIC X(40) VALUE " ". + 3 PIC X(40) VALUE " PERFORM VARYING X FROM 1 BY 1". + 3 PIC X(40) VALUE " UNTIL X > 6 DISPLAY TE (X) ". + 3 PIC X(40) VALUE " END-PERFORM PERFORM VARYING X". + 3 PIC X(40) VALUE " FROM 1 BY 1 UNTIL X > 16 ". + 3 PIC X(40) VALUE " MOVE T1 (X) TO FF DISPLAY F M". + 3 PIC X(40) VALUE "OVE T2 (X) TO FF DISPLAY F ". + 3 PIC X(40) VALUE " END-PERFORM PERFORM VARYING X". + 3 PIC X(40) VALUE " FROM 7 BY 1 UNTIL X > 16 ". + 3 PIC X(40) VALUE " DISPLAY TE (X) END-PERFORM ST". + 3 PIC X(40) VALUE "OP RUN. ". + 2 T REDEFINES B. 3 TE OCCURS 16. 4 T1 PIC X(40). 4 T2 PIC X(40). + 1 F. 2 PIC X(25) VALUE ' 3 PIC X(40) VALUE '. + 2 PIC X VALUE QUOTE. 2 FF PIC X(40). 2 PIC X VALUE QUOTE. + 2 PIC X VALUE '.'. + PROCEDURE DIVISION. + PERFORM VARYING X FROM 1 BY 1 UNTIL X > 6 DISPLAY TE (X) + END-PERFORM PERFORM VARYING X FROM 1 BY 1 UNTIL X > 16 + MOVE T1 (X) TO FF DISPLAY F MOVE T2 (X) TO FF DISPLAY F + END-PERFORM PERFORM VARYING X FROM 7 BY 1 UNTIL X > 16 + DISPLAY TE (X) END-PERFORM STOP RUN. diff --git a/Task/Quine/Fortran/quine.f b/Task/Quine/Fortran/quine-1.f similarity index 100% rename from Task/Quine/Fortran/quine.f rename to Task/Quine/Fortran/quine-1.f diff --git a/Task/Quine/Fortran/quine-2.f b/Task/Quine/Fortran/quine-2.f new file mode 100644 index 0000000000..99932f5d40 --- /dev/null +++ b/Task/Quine/Fortran/quine-2.f @@ -0,0 +1,8 @@ + WRITE(6,100) + STOP + 100 FORMAT(6X,12HWRITE(6,100)/6X,4HSTOP/ + .42H 100 FORMAT(6X,12HWRITE(6,100)/6X,4HSTOP/ ,2(/5X,67H. + .42H 100 FORMAT(6X,12HWRITE(6,100)/6X,4HSTOP/ ,2(/5X,67H. + .)/T48,2H)/T1,5X2(21H.)/T48,2H)/T1,5X2(21H)/ + .T62,10H)/6X3HEND)T1,5X2(28H.T62,10H)/6X3HEND)T1,5X2(28H)/6X3HEND) + END diff --git a/Task/Quine/JavaScript/quine-5.js b/Task/Quine/JavaScript/quine-5.js new file mode 100644 index 0000000000..2890fb95bf --- /dev/null +++ b/Task/Quine/JavaScript/quine-5.js @@ -0,0 +1,5 @@ +(function f() { + + return '(' + f.toString() + ')();'; + +})(); diff --git a/Task/Quine/JavaScript/quine-6.js b/Task/Quine/JavaScript/quine-6.js new file mode 100644 index 0000000000..2890fb95bf --- /dev/null +++ b/Task/Quine/JavaScript/quine-6.js @@ -0,0 +1,5 @@ +(function f() { + + return '(' + f.toString() + ')();'; + +})(); diff --git a/Task/Quine/JavaScript/quine-7.js b/Task/Quine/JavaScript/quine-7.js new file mode 100644 index 0000000000..4291e29f30 --- /dev/null +++ b/Task/Quine/JavaScript/quine-7.js @@ -0,0 +1,5 @@ +(function f() { + + console.log('(' + f.toString() + ')();'); + +})(); diff --git a/Task/Quine/PARI-GP/quine-1.pari b/Task/Quine/PARI-GP/quine-1.pari new file mode 100644 index 0000000000..f4f4d6d282 --- /dev/null +++ b/Task/Quine/PARI-GP/quine-1.pari @@ -0,0 +1 @@ +()->quine diff --git a/Task/Quine/PARI-GP/quine-2.pari b/Task/Quine/PARI-GP/quine-2.pari new file mode 100644 index 0000000000..fd47ff5b74 --- /dev/null +++ b/Task/Quine/PARI-GP/quine-2.pari @@ -0,0 +1 @@ +quine=()->quine diff --git a/Task/Quine/PowerShell/quine-1.psh b/Task/Quine/PowerShell/quine-1.psh new file mode 100644 index 0000000000..14d9f4b050 --- /dev/null +++ b/Task/Quine/PowerShell/quine-1.psh @@ -0,0 +1,2 @@ +$S = '$S = $S.Substring(0,5) + [string][char]39 + $S + [string][char]39 + [string][char]10 + $S.Substring(5)' +$S.Substring(0,5) + [string][char]39 + $S + [string][char]39 + [string][char]10 + $S.Substring(5) diff --git a/Task/Quine/PowerShell/quine-2.psh b/Task/Quine/PowerShell/quine-2.psh new file mode 100644 index 0000000000..dc521ae0d7 --- /dev/null +++ b/Task/Quine/PowerShell/quine-2.psh @@ -0,0 +1 @@ +$MyInvocation.MyCommand.ScriptContents diff --git a/Task/Quine/PowerShell/quine-3.psh b/Task/Quine/PowerShell/quine-3.psh new file mode 100644 index 0000000000..6c8d83e603 --- /dev/null +++ b/Task/Quine/PowerShell/quine-3.psh @@ -0,0 +1 @@ +$MyInvocation.MyCommand.Definition diff --git a/Task/Quine/PowerShell/quine-4.psh b/Task/Quine/PowerShell/quine-4.psh new file mode 100644 index 0000000000..a7ba8eccec --- /dev/null +++ b/Task/Quine/PowerShell/quine-4.psh @@ -0,0 +1 @@ +function Quine { $MyInvocation.MyCommand.Definition } diff --git a/Task/Quine/PowerShell/quine.psh b/Task/Quine/PowerShell/quine.psh deleted file mode 100644 index 38bb2bf406..0000000000 --- a/Task/Quine/PowerShell/quine.psh +++ /dev/null @@ -1,2 +0,0 @@ -$d='$d={0}{1}{0}{2}Write-Host -NoNewLine ($d -f [char]39,$d,"`r`n")' -Write-Host -NoNewLine ($d -f [char]39,$d,"`r`n") diff --git a/Task/Quine/Python/quine-10.py b/Task/Quine/Python/quine-10.py new file mode 100644 index 0000000000..1215102f05 --- /dev/null +++ b/Task/Quine/Python/quine-10.py @@ -0,0 +1,3 @@ +a = 'YSA9ICcnCmIgPSBhLmRlY29kZSgnYmFzZTY0JykKcHJpbnQgYls6NV0rYStiWzU6XQ==' +b = a.decode('base64') +print b[:5]+a+b[5:] diff --git a/Task/Quine/Python/quine-11.py b/Task/Quine/Python/quine-11.py new file mode 100644 index 0000000000..3991ab85fb --- /dev/null +++ b/Task/Quine/Python/quine-11.py @@ -0,0 +1,7 @@ +data = ( + 'ZGF0YSA9ICgKCSc=', + 'JywKCSc=', + 'JwopCnByZWZpeCwgc2VwYXJhdG9yLCBzdWZmaXggPSAoZC5kZWNvZGUoJ2Jhc2U2NCcpIGZvciBkIGluIGRhdGEpCnByaW50IHByZWZpeCArIGRhdGFbMF0gKyBzZXBhcmF0b3IgKyBkYXRhWzFdICsgc2VwYXJhdG9yICsgZGF0YVsyXSArIHN1ZmZpeA==' +) +prefix, separator, suffix = (d.decode('base64') for d in data) +print prefix + data[0] + separator + data[1] + separator + data[2] + suffix diff --git a/Task/Quine/Python/quine-12.py b/Task/Quine/Python/quine-12.py new file mode 100644 index 0000000000..69bb8dff97 --- /dev/null +++ b/Task/Quine/Python/quine-12.py @@ -0,0 +1,5 @@ +def applyToOwnSourceCode(functionBody): + print "def applyToOwnSourceCode(functionBody):" + print functionBody + print "applyToOwnSourceCode(" + repr(functionBody) + ")" +applyToOwnSourceCode('\tprint "def applyToOwnSourceCode(functionBody):"\n\tprint functionBody\n\tprint "applyToOwnSourceCode(" + repr(functionBody) + ")"') diff --git a/Task/Quine/Python/quine-9.py b/Task/Quine/Python/quine-9.py new file mode 100644 index 0000000000..61605bae52 --- /dev/null +++ b/Task/Quine/Python/quine-9.py @@ -0,0 +1,3 @@ +x = """x = {0}{1}{0} +print x.format(chr(34)*3,x)""" +print x.format(chr(34)*3,x) diff --git a/Task/Quine/UNIX-Shell/quine-2.sh b/Task/Quine/UNIX-Shell/quine-2.sh index 4439a45bf6..79ee43386b 100644 --- a/Task/Quine/UNIX-Shell/quine-2.sh +++ b/Task/Quine/UNIX-Shell/quine-2.sh @@ -1,14 +1 @@ -{ - string=`cat` - printf "$string" "$string" - echo - echo END-FORMAT -} <<'END-FORMAT' -{ - string=`cat` - printf "$string" "$string" - echo - echo END-FORMAT -} <<'END-FORMAT' -%s -END-FORMAT +history | tail -n 1 | cut -c 8- diff --git a/Task/Quine/UNIX-Shell/quine-3.sh b/Task/Quine/UNIX-Shell/quine-3.sh new file mode 100644 index 0000000000..4439a45bf6 --- /dev/null +++ b/Task/Quine/UNIX-Shell/quine-3.sh @@ -0,0 +1,14 @@ +{ + string=`cat` + printf "$string" "$string" + echo + echo END-FORMAT +} <<'END-FORMAT' +{ + string=`cat` + printf "$string" "$string" + echo + echo END-FORMAT +} <<'END-FORMAT' +%s +END-FORMAT diff --git a/Task/RIPEMD-160/Kotlin/ripemd-160.kotlin b/Task/RIPEMD-160/Kotlin/ripemd-160.kotlin new file mode 100644 index 0000000000..23e9b9d9cc --- /dev/null +++ b/Task/RIPEMD-160/Kotlin/ripemd-160.kotlin @@ -0,0 +1,20 @@ +import org.bouncycastle.crypto.digests.RIPEMD160Digest +import org.bouncycastle.util.encoders.Hex +import kotlin.text.Charsets.US_ASCII + +fun RIPEMD160Digest.inOneGo(input : ByteArray) : ByteArray { + val output = ByteArray(digestSize) + + update(input, 0, input.size) + doFinal(output, 0) + + return output +} + +fun main(args: Array) { + val input = "Rosetta Code".toByteArray(US_ASCII) + val output = RIPEMD160Digest().inOneGo(input) + + Hex.encode(output, System.out) + System.out.flush() +} diff --git a/Task/RIPEMD-160/PARI-GP/ripemd-160-1.pari b/Task/RIPEMD-160/PARI-GP/ripemd-160-1.pari new file mode 100644 index 0000000000..39957f1b5e --- /dev/null +++ b/Task/RIPEMD-160/PARI-GP/ripemd-160-1.pari @@ -0,0 +1,22 @@ +#include +#include + +#define HEX(x) (((x) < 10)? (x)+'0': (x)-10+'a') + +GEN plug_ripemd160(char *text) +{ + char md[RIPEMD160_DIGEST_LENGTH]; + char hash[sizeof(md) * 2 + 1]; + int i; + + RIPEMD160((unsigned char*)text, strlen(text), (unsigned char*)md); + + for (i = 0; i < sizeof(md); i++) { + hash[i+i] = HEX((md[i] >> 4) & 0x0f); + hash[i+i+1] = HEX(md[i] & 0x0f); + } + + hash[sizeof(md) * 2] = 0; + + return strtoGENstr(hash); +} diff --git a/Task/RIPEMD-160/PARI-GP/ripemd-160-2.pari b/Task/RIPEMD-160/PARI-GP/ripemd-160-2.pari new file mode 100644 index 0000000000..3e7636d900 --- /dev/null +++ b/Task/RIPEMD-160/PARI-GP/ripemd-160-2.pari @@ -0,0 +1,3 @@ +install("plug_ripemd160", "s", "RIPEMD160", "~/libripemd160.so"); + +RIPEMD160("Rosetta Code") diff --git a/Task/RSA-code/PARI-GP/rsa-code-1.pari b/Task/RSA-code/PARI-GP/rsa-code-1.pari new file mode 100644 index 0000000000..a6bf14d0fd --- /dev/null +++ b/Task/RSA-code/PARI-GP/rsa-code-1.pari @@ -0,0 +1,12 @@ +stigid(V,b)=subst(Pol(V),'x,b); \\ inverse function digits(...) + +n = 9516311845790656153499716760847001433441357; +e = 65537; +d = 5617843187844953170308463622230283376298685; + +text = "Rosetta Code" + +inttext = stigid(Vecsmall(text),256) \\ message as an integer +encoded = lift(Mod(inttext, n) ^ e) \\ encrypted message +decoded = lift(Mod(encoded, n) ^ d) \\ decrypted message +message = Strchr(digits(decoded, 256)) \\ readable message diff --git a/Task/RSA-code/PARI-GP/rsa-code-2.pari b/Task/RSA-code/PARI-GP/rsa-code-2.pari new file mode 100644 index 0000000000..b1b0416ea6 --- /dev/null +++ b/Task/RSA-code/PARI-GP/rsa-code-2.pari @@ -0,0 +1,3 @@ +f = factor(n); \\ factorize public key 'n' + +crack = Strchr(digits(lift(Mod(encoded,n) ^ lift(Mod(1,(f[1,1]-1)*(f[2,1]-1)) / e)),256)) diff --git a/Task/RSA-code/Ruby/rsa-code.rb b/Task/RSA-code/Ruby/rsa-code.rb new file mode 100644 index 0000000000..9a14251919 --- /dev/null +++ b/Task/RSA-code/Ruby/rsa-code.rb @@ -0,0 +1,55 @@ +#!/usr/bin/ruby + +require 'openssl' # for mod_exp only +require 'prime' + +def rsa_encode blocks, e, n + blocks.map{|b| b.to_bn.mod_exp(e, n).to_i} +end + +def rsa_decode ciphers, d, n + rsa_encode ciphers, d, n +end + +# all numbers in blocks have to be < modulus, or information is lost +# for secure encryption only use big modulus and blocksizes +def text_to_blocks text, blocksize=64 # 1 hex = 4 bit => default is 256bit + text.each_byte.reduce(""){|acc,b| acc << b.to_s(16).rjust(2, "0")} # convert text to hex (preserving leading 0 chars) + .each_char.each_slice(blocksize).to_a # slice hexnumbers in pieces of blocksize + .map{|a| a.join("").to_i(16)} # convert each slice into internal number +end + +def blocks_to_text blocks + blocks.map{|d| d.to_s(16)}.join("") # join all blocks into one hex-string + .each_char.each_slice(2).to_a # group into pairs + .map{|s| s.join("").to_i(16)} # number from 2 hexdigits is byte + .flatten.pack("C*") # pack bytes into ruby-string + .force_encoding(Encoding::default_external) # reset encoding +end + +def generate_keys p1, p2 + n = p1 * p2 + t = (p1 - 1) * (p2 - 1) + e = 2.step.each do |i| + break i if i.gcd(t) == 1 + end + d = 1.step.each do |i| + break i if (i * e) % t == 1 + end + return e, d, n +end + +p1, p2 = Prime.take(100).last(2) +public_key, private_key, modulus = + generate_keys p1, p2 + +print "Message: " +message = gets +blocks = text_to_blocks message, 4 # very small primes +print "Numbers: "; p blocks +encoded = rsa_encode(blocks, public_key, modulus) +print "Encrypted as: "; p encoded +decoded = rsa_decode(encoded, private_key, modulus) +print "Decrypted to: "; p decoded +final = blocks_to_text(decoded) +print "Decrypted Message: "; puts final diff --git a/Task/Random-number-generator--device-/00DESCRIPTION b/Task/Random-number-generator--device-/00DESCRIPTION index afef50913c..c2233a8f5a 100644 --- a/Task/Random-number-generator--device-/00DESCRIPTION +++ b/Task/Random-number-generator--device-/00DESCRIPTION @@ -1 +1,5 @@ -If your system has a means to generate random numbers involving not only a software algorithm (like the [[wp:/dev/random|/dev/urandom]] devices in Unix), show how to obtain a random 32-bit number from that mechanism. +;Task: +If your system has a means to generate random numbers involving not only a software algorithm   (like the [[wp:/dev/random|/dev/urandom]] devices in Unix),   then: + +show how to obtain a random 32-bit number from that mechanism. +

    diff --git a/Task/Random-number-generator--device-/Perl-6/random-number-generator--device-.pl6 b/Task/Random-number-generator--device-/Perl-6/random-number-generator--device-.pl6 index 5c7e0cb46c..d142c81c70 100644 --- a/Task/Random-number-generator--device-/Perl-6/random-number-generator--device-.pl6 +++ b/Task/Random-number-generator--device-/Perl-6/random-number-generator--device-.pl6 @@ -1,4 +1,5 @@ +use experimental :pack; my $UR = open("/dev/urandom", :bin) or die "Can't open /dev/urandom: $!"; -my @random-spigot := gather loop { take $UR.read(1024).unpack("L*") } +my @random-spigot = $UR.read(1024).unpack("L*") ... *; .say for @random-spigot[^10]; diff --git a/Task/Random-number-generator--device-/Rust/random-number-generator--device-.rust b/Task/Random-number-generator--device-/Rust/random-number-generator--device-.rust new file mode 100644 index 0000000000..507a1263a9 --- /dev/null +++ b/Task/Random-number-generator--device-/Rust/random-number-generator--device-.rust @@ -0,0 +1,13 @@ +extern crate rand; + +use rand::{Rng, OsRng}; + +fn main() { + let mut rng = match OsRng::new() { + Ok(v) => v, + Err(e) => panic!("Failed to obtain OS RNG: {}", e) + }; + + let rand_num:u32 = rng.next_u32(); + println!("{}",rand_num); +} diff --git a/Task/Random-number-generator--included-/00DESCRIPTION b/Task/Random-number-generator--included-/00DESCRIPTION index ac5f03ed61..428cc1f926 100644 --- a/Task/Random-number-generator--included-/00DESCRIPTION +++ b/Task/Random-number-generator--included-/00DESCRIPTION @@ -1,9 +1,9 @@ The task is to: -: State the type of random number generator algorithm used in a languages built-in random number generator, or omit the language if no random number generator is given as part of the language or its immediate libraries.
    -: If possible, a link to a wider [[wp:List of random number generators|explanation]] of the algorithm used should be given. +: State the type of random number generator algorithm used in a language's built-in random number generator. If the language or its immediate libraries don't provide a random number generator, skip this task. +: If possible, give a link to a wider [[wp:List of random number generators|explanation]] of the algorithm used. Note: the task is ''not'' to create an RNG, but to report on the languages in-built RNG that would be the most likely RNG used. -The main types of pseudo-random number generator, ([[wp:PRNG|PRNG]]), that are in use are the [[linear congruential generator|Linear Congruential Generator]], ([[wp:Linear congruential generator|LCG]]), and the Generalized Feedback Shift Register, ([[wp:Generalised_feedback_shift_register#Non-binary_Galois_LFSR|GFSR]]), (of which the [[wp:Mersenne twister|Mersenne twister]] generator is a subclass). The last main type is where the output of one of the previous ones (typically a Mersenne twister) is fed through a [[cryptographic hash function]] to maximize unpredictability of individual bits. +The main types of pseudo-random number generator ([[wp:PRNG|PRNG]]) that are in use are the [[linear congruential generator|Linear Congruential Generator]] ([[wp:Linear congruential generator|LCG]]), and the Generalized Feedback Shift Register ([[wp:Generalised_feedback_shift_register#Non-binary_Galois_LFSR|GFSR]]), (of which the [[wp:Mersenne twister|Mersenne twister]] generator is a subclass). The last main type is where the output of one of the previous ones (typically a Mersenne twister) is fed through a [[cryptographic hash function]] to maximize unpredictability of individual bits. -Note that LCGs nor GFSRs should be used for the most demanding applications (cryptography) without additional steps. +Note that neither LCGs nor GFSRs should be used for the most demanding applications (cryptography) without additional steps. diff --git a/Task/Random-numbers/00DESCRIPTION b/Task/Random-numbers/00DESCRIPTION index 863b255f4d..6eaaf1c2b7 100644 --- a/Task/Random-numbers/00DESCRIPTION +++ b/Task/Random-numbers/00DESCRIPTION @@ -1,13 +1,16 @@ {{omit from|GUISS}} {{omit from|UNIX Shell|From the shell, we simply invoke the awk solution}} -The goal of this task is to generate a collection filled with -1000 normally distributed random (or pseudorandom) numbers -with a mean of 1.0 and a [[wp:Standard_deviation|standard deviation]] of 0.5 +;Task: +Generate a collection filled with   '''1000'''   normally distributed random (or pseudo-random) numbers +with a mean of   '''1.0'''   and a   [[wp:Standard_deviation|standard deviation]]   of   '''0.5''' + Many libraries only generate uniformly distributed random numbers. If so, use [[wp:Normal_distribution#Generating_values_from_normal_distribution|this formula]] to convert them to a normal distribution. -;See also: -* [[Standard deviation]] + +;Related task: +*   [[Standard deviation]] +

    diff --git a/Task/Random-numbers/Elixir/random-numbers-1.elixir b/Task/Random-numbers/Elixir/random-numbers-1.elixir new file mode 100644 index 0000000000..8aa9c33ad5 --- /dev/null +++ b/Task/Random-numbers/Elixir/random-numbers-1.elixir @@ -0,0 +1,16 @@ +defmodule Random do + def normal(mean, sd) do + {a, b} = {:rand.uniform, :rand.uniform} + mean + sd * (:math.sqrt(-2 * :math.log(a)) * :math.cos(2 * :math.pi * b)) + end +end + +std_dev = fn (list) -> + mean = Enum.sum(list) / length(list) + sd = Enum.reduce(list, 0, fn x,acc -> acc + (x-mean)*(x-mean) end) / length(list) + |> :math.sqrt + IO.puts "Mean: #{mean},\tStdDev: #{sd}" + end + +xs = for _ <- 1..1000, do: Random.normal(1.0, 0.5) +std_dev.(xs) diff --git a/Task/Random-numbers/Elixir/random-numbers-2.elixir b/Task/Random-numbers/Elixir/random-numbers-2.elixir new file mode 100644 index 0000000000..52f567fad0 --- /dev/null +++ b/Task/Random-numbers/Elixir/random-numbers-2.elixir @@ -0,0 +1,2 @@ +xs = for _ <- 1..1000, do: 1.0 + :rand.normal * 0.5 +std_dev.(xs) diff --git a/Task/Random-numbers/Elixir/random-numbers.elixir b/Task/Random-numbers/Elixir/random-numbers.elixir deleted file mode 100644 index 4dca28b7d3..0000000000 --- a/Task/Random-numbers/Elixir/random-numbers.elixir +++ /dev/null @@ -1,12 +0,0 @@ -defmodule Random do - def init() do - :random.seed(:erlang.now()) - end - def normal(mean, sd) do - {a, b} = {:random.uniform(), :random.uniform()} - mean + sd * (:math.sqrt(-2 * :math.log(a)) * :math.cos(2 * :math.pi * b)) - end -end - -Random.init() -xs = for _ <- 1..1000, do: Random.normal(1.0, 0.5) diff --git a/Task/Random-numbers/Maple/random-numbers.maple b/Task/Random-numbers/Maple/random-numbers.maple new file mode 100644 index 0000000000..4567164626 --- /dev/null +++ b/Task/Random-numbers/Maple/random-numbers.maple @@ -0,0 +1,2 @@ +with(Statistics): +Sample(Normal(1, 0.5), 1000); diff --git a/Task/Random-numbers/PowerShell/random-numbers.psh b/Task/Random-numbers/PowerShell/random-numbers.psh new file mode 100644 index 0000000000..62f209cb4c --- /dev/null +++ b/Task/Random-numbers/PowerShell/random-numbers.psh @@ -0,0 +1,35 @@ +function Get-RandomNormal + { + [CmdletBinding()] + Param ( [double]$Mean, [double]$StandardDeviation ) + + $RandomNormal = $Mean + $StandardDeviation * [math]::Sqrt( -2 * [math]::Log( ( Get-Random -Minimum 0.0 -Maximum 1.0 ) ) ) * [math]::Cos( 2 * [math]::PI * ( Get-Random -Minimum 0.0 -Maximum 1.0 ) ) + + return $RandomNormal + } + +# Standard deviation function for testing +function Get-StandardDeviation + { + [CmdletBinding()] + param ( [double[]]$Numbers ) + + $Measure = $Numbers | Measure-Object -Average + $PopulationDeviation = 0 + ForEach ($Number in $Numbers) { $PopulationDeviation += [math]::Pow( ( $Number - $Measure.Average ), 2 ) } + $StandardDeviation = [math]::Sqrt( $PopulationDeviation / ( $Measure.Count - 1 ) ) + return $StandardDeviation + } + +# Test +$RandomNormalNumbers = 1..1000 | ForEach { Get-RandomNormal -Mean 1 -StandardDeviation 0.5 } + +$Measure = $RandomNormalNumbers | Measure-Object -Average + +$Stats = [PSCustomObject]@{ + Count = $Measure.Count + Average = $Measure.Average + StandardDeviation = Get-StandardDeviation -Numbers $RandomNormalNumbers +} + +$Stats | Format-List diff --git a/Task/Random-numbers/REXX/random-numbers.rexx b/Task/Random-numbers/REXX/random-numbers.rexx index fa370e73ed..e36ea6b97b 100644 --- a/Task/Random-numbers/REXX/random-numbers.rexx +++ b/Task/Random-numbers/REXX/random-numbers.rexx @@ -1,45 +1,45 @@ -/*REXX pgm gens 1,000 normally distributed #s: mean=1, standard deviation.=½.*/ -numeric digits 20 /*the default decimal digit precision=9*/ -parse arg n seed . /*allow specification of N and the seed*/ -if n=='' | n==',' then n=1000 /*N: is the size of the array. */ -if seed\=='' then call random ,,seed /*SEED: for repeatable random numbers. */ -newMean=1 /*the desired new mean|arithmetic avg. */ -sd=1/2 /*the desired new standard deviation. */ - do g=1 for n /*generate N uniform random #'s (0,1].*/ - #.g = random(1,1e5) / 1e5 /*REXX's RANDOM BIF generates integers.*/ - end /*g*/ /* [↑] rand integers ──► fractions. */ -say ' old mean=' mean() -say 'old standard deviation=' stdDev() -call pi; pi2=pi+pi /*define pi and also 2 * pi. */ +/*REXX pgm generates 1,000 normally distributed numbers: mean=1, standard deviation=½.*/ +numeric digits 20 /*the default decimal digit precision=9*/ +parse arg n seed . /*allow specification of N and the seed*/ +if n=='' | n=="," then n=1000 /*N: is the size of the array. */ +if datatype(seed,'W') then call random ,,seed /*SEED: for repeatable random numbers. */ +newMean=1 /*the desired new mean (arithmetic avg)*/ +sd=1/2 /*the desired new standard deviation. */ + do g=1 for n /*generate N uniform random #'s (0,1].*/ + #.g = random(1, 1e5) / 1e5 /*REXX's RANDOM BIF generates integers.*/ + end /*g*/ /* [↑] random integers ──► fractions. */ +say ' old mean=' mean() +say 'old standard deviation=' stdDev() +call pi; pi2=pi * 2 /*define pi and also 2 * pi. */ say - do j=1 to n-1 by 2; m=j+1 /*step through the iterations by two. */ - _=sd * sqrt(ln(#.j) * -2) /*calculate the used-twice expression.*/ - #.j=_ * cos(pi2*#.m) + newMean /*utilize the Box─Muller method. */ - #.m=_ * sin(pi2*#.m) + newMean /*random number must be: (0,1] */ + do j=1 to n-1 by 2; m=j+1 /*step through the iterations by two. */ + _=sd * sqrt(ln(#.j) * -2) /*calculate the used-twice expression.*/ + #.j=_ * cos(pi2 * #.m) + newMean /*utilize the Box─Muller method. */ + #.m=_ * sin(pi2 * #.m) + newMean /*random number must be: (0,1] */ end /*j*/ -say ' new mean=' mean() -say 'new standard deviation=' stdDev() -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────subroutines──────────────────────────────────────────────────────────────────────*/ -mean: _=0; do k=1 for n; _=_+#.k; end; return _/n -stdDev: _avg=mean(); _=0; do k=1 for n; _=_+(#.k-_avg)**2; end; return sqrt(_/n) +say ' new mean=' mean() +say 'new standard deviation=' stdDev() +exit /*stick a fork in it, we're all done. */ +/*───────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/ +mean: _=0; do k=1 for n; _=_ + #.k; end; return _/n +stdDev: _avg=mean(); _=0; do k=1 for n; _=_ + (#.k - _avg)**2; end; return sqrt(_/n) e: e =2.7182818284590452353602874713526624977572470936999595749669676277240766303535; return e /*digs overkill*/ pi: pi=3.1415926535897932384626433832795028841971693993751058209749445923078164062862; return pi /* " " */ -r2r: return arg(1) // (2*pi()) /*normalize ang*/ +r2r: return arg(1) // (pi() * 2) /*normalize ang*/ sin: procedure; parse arg x;x=r2r(x);numeric fuzz min(5,digits()-3);if abs(x)=pi then return 0;return .sincos(x,x,1) .sincos:parse arg z,_,i; x=x*x; p=z; do k=2 by 2; _=-_*x/(k*(k+i)); z=z+_; if z=p then leave; p=z; end; return z -ln: procedure; parse arg x,f; call e; ig= x>1.5; is=1-2*(ig\==1); ii=0; xx=x; return .ln_comp() -.ln_comp: do while ig&xx>1.5|\ig&xx<.5;_=e;do k=-1;iz=xx*_**-is;if k>=0&(ig&iz<1|\ig&iz>.5) then leave;_=_*_;izz=iz;end +/*───────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/ +ln: procedure; parse arg x,f; call e; ig= x>1.5; is=1 - 2 * (ig\==1); ii=0; xx=x + do while ig&xx>1.5|\ig&xx<.5;_=e;do k=-1;iz=xx*_**-is;if k>=0&(ig&iz<1|\ig&iz>.5) then leave;_=_*_;izz=iz;end xx=izz;ii=ii+is*2**k;end;x=x*e**-ii-1;z=0;_=-1;p=z;do k=1;_=-_*x;z=z+_/k;if z=p then leave;p=z;end; return z+ii - -cos: procedure; parse arg x; x=r2r(x); a=abs(x); hpi=pi*.5 - numeric fuzz min(6,digits()-3); if a=pi() then return -1 - if a=hpi | a=hpi*3 then return 0; if a=pi()/3 then return .5 - if a=pi()*2/3 then return -.5; return .sinCos(1,1,-1) - -sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); i=; m.=9 - numeric digits 9; numeric form; h=d+6; if x<0 then do; x=-x; i='i'; end - parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_%2 - do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ - do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ - numeric digits d; return (g/1)i /*make complex if X < 0.*/ +/*───────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/ +cos: procedure; parse arg x; x=r2r(x); a=abs(x); hpi=pi * .5 + numeric fuzz min(6, digits() - 3); if a=pi then return -1 + if a=hpi | a=hpi*3 then return 0; if a=pi/3 then return .5 + if a=pi * 2/3 then return -.5; return .sinCos(1,1,-1) +/*───────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/ +sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); numeric digits; h=d+6 + numeric form; parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g * .5'e'_ %2 + m.=9; do j=0 while h>9; m.j=h; h=h%2 + 1; end /*j*/ + do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ + numeric digits d; return g/1 diff --git a/Task/Range-expansion/00DESCRIPTION b/Task/Range-expansion/00DESCRIPTION index c2d9489c32..b152ec109f 100644 --- a/Task/Range-expansion/00DESCRIPTION +++ b/Task/Range-expansion/00DESCRIPTION @@ -1,9 +1,14 @@ {{:Range extraction/Format}} -;The task -Expand the range description: -: -6,-3--1,3-5,7-11,14,15,17-20 -Note that the second element above, -is the '''range from minus 3 to ''minus'' 1'''. -C.f. [[Range extraction]] +;Task: +Expand the range description: + -6,-3--1,3-5,7-11,14,15,17-20 + +Note that the second element above, +is the '''range from minus 3 to ''minus'' 1'''. + + +;Related task: +*   [[Range extraction]] +

    diff --git a/Task/Range-expansion/ALGOL-68/range-expansion.alg b/Task/Range-expansion/ALGOL-68/range-expansion.alg index 64c01f2e61..efd4ad523f 100644 --- a/Task/Range-expansion/ALGOL-68/range-expansion.alg +++ b/Task/Range-expansion/ALGOL-68/range-expansion.alg @@ -150,31 +150,12 @@ END; # TORANGE # OP TOSTRING = ( []INT values )STRING: BEGIN - # converts an integer to a string # - OP TOSTRING = ( INT value )STRING: - BEGIN - STRING result := ""; - INT n := ABS value; - - WHILE - REPR ( ( n MOD 10 ) + ABS "0" ) PLUSTO result; - n OVERAB 10; - n > 0 - DO - SKIP - OD; - - # RESULT # - IF value < 0 THEN "-" ELSE "" FI + result - END; # TOSTRING # - - STRING result := ""; STRING separator := ""; FOR pos FROM LWB values TO UPB values DO - result +:= ( separator + TOSTRING values[ pos ] ); + result +:= ( separator + whole( values[ pos ], 0 ) ); separator := "," OD; @@ -183,7 +164,6 @@ BEGIN END; # TOSTRING # - test:( print( ( TOSTRING range expand( TORANGE "-6,-3--1,3-5,7-11,14,15,17-20" ), newline ) ) ) diff --git a/Task/Range-expansion/AppleScript/range-expansion-1.applescript b/Task/Range-expansion/AppleScript/range-expansion-1.applescript new file mode 100644 index 0000000000..6917602dac --- /dev/null +++ b/Task/Range-expansion/AppleScript/range-expansion-1.applescript @@ -0,0 +1,139 @@ +-- Each comma-delimited string is mapped to a list of integers, +-- and these integer lists are concatenated together into a single list + +-- expansion :: String -> [Int] +on expansion(strExpr) + -- The string (between commas) is split on hyphens, + -- and this segmentation is rewritten to ranges or minus signs + -- and evaluated to lists of integer values + + -- signedRange :: String -> [Int] + script signedRange + -- After the first character, numbers preceded by an + -- empty string (resulting from splitting on hyphens) + -- and interpreted as negative + + -- signedIntegerAppended:: [Int] -> String -> Int -> [Int] -> [Int] + on signedIntegerAppended(lstAccumulator, strNum, iPosn, lst) + if strNum ≠ "" then + if iPosn > 1 then + if length of (item (iPosn - 1) of lst) > 0 then + set strSign to "" + else + set strSign to "-" + end if + else + set strSign to "+" + end if + lstAccumulator & ((strSign & strNum) as integer) + else + lstAccumulator + end if + end signedIntegerAppended + + on lambda(strHyphenated) + tupleRange(foldl(signedIntegerAppended, {}, ¬ + splitOn("-", strHyphenated))) + end lambda + end script + + concatMap(signedRange, splitOn(",", strExpr)) +end expansion + + +-- TEST +on run + + expansion("-6,-3--1,3-5,7-11,14,15,17-20") + + --> {-6, -3, -2, -1, 3, 4, 5, 7, 8, 9, 10, 11, 14, 15, 17, 18, 19, 20} +end run + + + +-- GENERIC LIBRARY FUNCTIONS + +-- concatMap :: (a -> [b]) -> [a] -> [b] +on concatMap(f, xs) + script append + on lambda(a, b) + a & b + end lambda + end script + + foldl(append, {}, map(f, xs)) +end concatMap + +-- 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 + +-- 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 + +-- 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 + +-- range :: (Int, Int) -> [Int] +on tupleRange(tuple) + if tuple = {} then + {} + else if length of tuple > 1 then + range(item 1 of tuple, item 2 of tuple) + else + item 1 of tuple + end if +end tupleRange + +-- range :: Int -> Int -> [Int] +on range(m, n) + set d to cond(n < m, -1, 1) + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range + +-- cond :: Bool -> (a -> b) -> (a -> b) -> (a -> b) +on cond(bool, f, g) + if bool then + f + else + g + end if +end cond + +-- splitOn :: Text -> Text -> [Text] +on splitOn(strDelim, strMain) + set {dlm, my text item delimiters} to {my text item delimiters, strDelim} + set xs to text items of strMain + set my text item delimiters to dlm + return xs +end splitOn diff --git a/Task/Range-expansion/AppleScript/range-expansion-2.applescript b/Task/Range-expansion/AppleScript/range-expansion-2.applescript new file mode 100644 index 0000000000..dd76653e56 --- /dev/null +++ b/Task/Range-expansion/AppleScript/range-expansion-2.applescript @@ -0,0 +1 @@ +{-6, -3, -2, -1, 3, 4, 5, 7, 8, 9, 10, 11, 14, 15, 17, 18, 19, 20} diff --git a/Task/Range-expansion/DWScript/range-expansion.dw b/Task/Range-expansion/DWScript/range-expansion.dw new file mode 100644 index 0000000000..207a6f32f6 --- /dev/null +++ b/Task/Range-expansion/DWScript/range-expansion.dw @@ -0,0 +1,15 @@ +function ExpandRanges(ranges : String) : array of Integer; +begin + for var range in ranges.Split(',') do begin + var separator = range.IndexOf('-', 2); + if separator > 0 then begin + for var i := range.Left(separator-1).ToInteger to range.Copy(separator+1).ToInteger do + Result.Add(i); + end else begin + Result.Add(range.ToInteger) + end; + end; +end; + +var expanded := ExpandRanges('-6,-3--1,3-5,7-11,14,15,17-20'); +PrintLn(JSON.Stringify(expanded)); diff --git a/Task/Range-expansion/Fortran/range-expansion.f b/Task/Range-expansion/Fortran/range-expansion.f new file mode 100644 index 0000000000..a6992e7463 --- /dev/null +++ b/Task/Range-expansion/Fortran/range-expansion.f @@ -0,0 +1,100 @@ + MODULE HOMEONTHERANGE + CONTAINS !The key function. + CHARACTER*200 FUNCTION ERANGE(TEXT) !Expands integer ranges in a list. +Can't return a character value of variable size. + CHARACTER*(*) TEXT !The list on input. + CHARACTER*200 ALINE !Scratchpad for output. + INTEGER N,N1,N2 !Numbers in a range. + INTEGER I,I1 !Steppers. + ALINE = "" !Scrub the scratchpad. + L = 0 !No text has been placed. + I = 1 !Start at the start. + CALL FORASIGN !Find something to look at. +Chug through another number or number - number range. + R:DO WHILE(EATINT(N1)) !If I can grab a first number, a term has begun. + N2 = N1 !Make the far end the same. + IF (PASSBY("-")) CALL EATINT(N2) !A hyphen here is not a minus sign. + IF (L.GT.0) CALL EMIT(",") !Another, after what went before? + DO N = N1,N2,SIGN(+1,N2 - N1) !Step through the range, possibly backwards. + CALL SPLOT(N) !Roll a number. + IF (N.NE.N2) CALL EMIT(",") !Perhaps another follows. + END DO !On to the next number. + IF (.NOT.PASSBY(",")) EXIT R !More to come? + END DO R !So much for a range. +Completed the scan. Just return the result. + ERANGE = ALINE(1:L) !Present the result. Fiddling ERANGE is bungled by some compilers. + CONTAINS !Some assistants for the scan to save on repetition and show intent. + SUBROUTINE FORASIGN !Look for one. + 1 IF (I.LE.LEN(TEXT)) THEN !After a thingy, + IF (TEXT(I:I).LE." ") THEN !There may follow spaces. + I = I + 1 !So, + GO TO 1 !Speed past any. + END IF !So that the caller can see + END IF !Whatever substantive character follows. + END SUBROUTINE FORASIGN !Simple enough. + + LOGICAL FUNCTION PASSBY(C) !Advances the scan if a certain character is seen. +Could consider or ignore case for letters, but this is really for single symbols. + CHARACTER*1 C !The character. + PASSBY = .FALSE. !Pessimism. + IF (I.LE.LEN(TEXT)) THEN !Can't rely on I.LE.LEN(TEXT) .AND. TEXT(I:I)... + IF (TEXT(I:I).EQ.C) THEN !Curse possible full evaluation. + PASSBY = .TRUE. !Righto, C is seen. + I = I + 1 !So advance the scan. + CALL FORASIGN !And see what follows. + END IF !So much for a match. + END IF !If there is something to be uinspected. + END FUNCTION PASSBY !Can't rely on testing PASSBY within PASSBY either. + + LOGICAL FUNCTION EATINT(N) !Convert text into an integer. + INTEGER N !The value to be ascertained. + INTEGER D !A digit. + LOGICAL NEG !In case of a minus sign. + EATINT = .FALSE. !Pessimism. + IF (I.GT.LEN(TEXT)) RETURN !Anything to look at? + N = 0 !Scrub to start with. + IF (PASSBY("+")) THEN !A plus sign here can be ignored. + NEG = .FALSE. !So, there's no minus sign. + ELSE !And if there wasn't a plus, + NEG = PASSBY("-") !A hyphen here is a minus sign. + END IF !One way or another, NEG is initialised. + IF (I.GT.LEN(TEXT)) RETURN !Nothing further! We wuz misled! +Chug through digits. Can develop -2147483648, thanks to the workings of two's complement. + 10 D = ICHAR(TEXT(I:I)) - ICHAR("0") !Hope for a digit. + IF (0.LE.D .AND. D.LE.9) THEN !Is it one? + N = N*10 + D !Yes! Assimilate it, negatively. + I = I + 1 !Advance one. + IF (I.LE.LEN(TEXT)) GO TO 10 !And see what comes next. + END IF !So much for a sequence of digits. + IF (NEG) N = -N !Apply the minus sign. + EATINT = .TRUE. !Should really check for at least one digit. + CALL FORASIGN !Ram into whatever follows. + END FUNCTION EATINT !Integers are easy. Could check for no digits seen. + + SUBROUTINE EMIT(C) !Rolls forth one character. + CHARACTER*1 C !The character. + L = L + 1 !Advance the finger. + IF (L.GT.LEN(ALINE)) STOP "Ran out of ALINE!" !Maybe not. + ALINE(L:L) = C !And place the character. + END SUBROUTINE EMIT !That was simple. + + SUBROUTINE SPLOT(N) !Rolls forth a signed number. + INTEGER N !The number. + CHARACTER*12 FIELD !Sufficient for 32-bit integers. + INTEGER I !A stepper. + WRITE (FIELD,"(I0)") N !Roll the number, with trailing spaces. + DO I = 1,12 !Now transfer the ALINE of the number. + IF (FIELD(I:I).LE." ") EXIT !Up to the first space. + CALL EMIT(FIELD(I:I)) !One by one. + END DO !On to the end. + END SUBROUTINE SPLOT !Not so difficult either. + END FUNCTION ERANGE !A bit tricky. + END MODULE HOMEONTHERANGE + + PROGRAM POKE + USE HOMEONTHERANGE + CHARACTER*(200) SOME + SOME = "-6,-3--1,3-5,7-11,14,15,17-20" + SOME = ERANGE(SOME) + WRITE (6,*) SOME !If ERANGE(SOME) then the function usually can't write output also. + END diff --git a/Task/Range-expansion/J/range-expansion-1.j b/Task/Range-expansion/J/range-expansion-1.j index 1450fea10b..fae596a426 100644 --- a/Task/Range-expansion/J/range-expansion-1.j +++ b/Task/Range-expansion/J/range-expansion-1.j @@ -1,5 +1,5 @@ require'strings' -thru=: <./ + i.@(+*)@-~ +thru=: <. + i.@(+*)@-~ num=: _&". normaliz=: rplc&(',-';',_';'--';'-_')@,~&',' subranges=:<@(thru/)@(num;._2)@,&'-';._1 diff --git a/Task/Range-expansion/JavaScript/range-expansion.js b/Task/Range-expansion/JavaScript/range-expansion-1.js similarity index 100% rename from Task/Range-expansion/JavaScript/range-expansion.js rename to Task/Range-expansion/JavaScript/range-expansion-1.js diff --git a/Task/Range-expansion/JavaScript/range-expansion-2.js b/Task/Range-expansion/JavaScript/range-expansion-2.js new file mode 100644 index 0000000000..b57b4de5bf --- /dev/null +++ b/Task/Range-expansion/JavaScript/range-expansion-2.js @@ -0,0 +1,39 @@ +(function (strTest) { + 'use strict'; + + // s -> [n] + function expansion(strExpr) { + + // concat map yields flattened output list + return [].concat.apply([], strExpr.split(',') + .map(function (x) { + return x.split('-') + .reduce(function (a, s, i, l) { + + // negative (after item 0) if preceded by an empty string + // (i.e. a hyphen-split artefact, otherwise ignored) + return s.length ? i ? a.concat( + parseInt(l[i - 1].length ? s : + '-' + s, 10) + ) : [+s] : a; + }, []); + + // two-number lists are interpreted as ranges + }) + .map(function (r) { + return r.length > 1 ? range.apply(null, r) : r; + })); + } + + + // [m..n] + function range(m, n) { + return Array.apply(null, Array(n - m + 1)) + .map(function (x, i) { + return m + i; + }); + } + + return expansion(strTest); + +})('-6,-3--1,3-5,7-11,14,15,17-20'); diff --git a/Task/Range-expansion/JavaScript/range-expansion-3.js b/Task/Range-expansion/JavaScript/range-expansion-3.js new file mode 100644 index 0000000000..e1aa3cbe05 --- /dev/null +++ b/Task/Range-expansion/JavaScript/range-expansion-3.js @@ -0,0 +1 @@ +[-6, -3, -2, -1, 3, 4, 5, 7, 8, 9, 10, 11, 14, 15, 17, 18, 19, 20] diff --git a/Task/Range-expansion/JavaScript/range-expansion-4.js b/Task/Range-expansion/JavaScript/range-expansion-4.js new file mode 100644 index 0000000000..824ec7da69 --- /dev/null +++ b/Task/Range-expansion/JavaScript/range-expansion-4.js @@ -0,0 +1,37 @@ +(strTest => { + + // expansion :: String -> [Int] + let expansion = strExpr => + + // concat map yields flattened output list + [].concat.apply([], strExpr.split(',') + .map(x => x.split('-') + .reduce((a, s, i, l) => + + // negative (after item 0) if preceded by an empty string + // (i.e. a hyphen-split artefact, otherwise ignored) + s.length ? i ? a.concat( + parseInt(l[i - 1].length ? s : + '-' + s, 10) + ) : [+s] : a, []) + + // two-number lists are interpreted as ranges + ) + .map(r => r.length > 1 ? range.apply(null, r) : r)), + + + + // range :: Int -> Int -> Maybe Int -> [Int] + range = (m, n, step) => { + let d = (step || 1) * (n >= m ? 1 : -1); + + return Array.from({ + length: Math.floor((n - m) / d) + 1 + }, (_, i) => m + (i * d)); + }; + + + + return expansion(strTest); + +})('-6,-3--1,3-5,7-11,14,15,17-20'); diff --git a/Task/Range-expansion/JavaScript/range-expansion-5.js b/Task/Range-expansion/JavaScript/range-expansion-5.js new file mode 100644 index 0000000000..e1aa3cbe05 --- /dev/null +++ b/Task/Range-expansion/JavaScript/range-expansion-5.js @@ -0,0 +1 @@ +[-6, -3, -2, -1, 3, 4, 5, 7, 8, 9, 10, 11, 14, 15, 17, 18, 19, 20] diff --git a/Task/Range-expansion/Perl-6/range-expansion-1.pl6 b/Task/Range-expansion/Perl-6/range-expansion-1.pl6 new file mode 100644 index 0000000000..59c8f6beed --- /dev/null +++ b/Task/Range-expansion/Perl-6/range-expansion-1.pl6 @@ -0,0 +1,11 @@ +sub range-expand (Str $range-description) { + my token number { '-'? \d+ } + my token range { (<&number>) '-' (<&number>) } + + $range-description + .split(',') + .map({ .match(&range) ?? $0..$1 !! +$_ }) + .flat +} + +say range-expand('-6,-3--1,3-5,7-11,14,15,17-20').join(', '); diff --git a/Task/Range-expansion/Perl-6/range-expansion-2.pl6 b/Task/Range-expansion/Perl-6/range-expansion-2.pl6 new file mode 100644 index 0000000000..36bc76cb92 --- /dev/null +++ b/Task/Range-expansion/Perl-6/range-expansion-2.pl6 @@ -0,0 +1,8 @@ +grammar RangeList { + token TOP { * % ',' { make $.map(*.made) } } + token term { [|] { make ($ // $).made } } + token range { '-' { make +$[0] .. +$[1] } } + token num { '-'? \d+ { make +$/ } } +} + +say RangeList.parse('-6,-3--1,3-5,7-11,14,15,17-20').made.flat.join(', '); diff --git a/Task/Range-expansion/Perl-6/range-expansion.pl6 b/Task/Range-expansion/Perl-6/range-expansion.pl6 deleted file mode 100644 index a3c54846ba..0000000000 --- a/Task/Range-expansion/Perl-6/range-expansion.pl6 +++ /dev/null @@ -1,7 +0,0 @@ -sub range-expansion (Str $range-description) { - my $range-pattern = rx/ ( '-'? \d+ ) '-' ( '-'? \d+) /; - my &expand = -> $term { $term ~~ $range-pattern ?? +$0..+$1 !! $term }; - return $range-description.split(',').map(&expand) -} - -say range-expansion('-6,-3--1,3-5,7-11,14,15,17-20').join(', '); diff --git a/Task/Range-expansion/Python/range-expansion-3.py b/Task/Range-expansion/Python/range-expansion-3.py new file mode 100644 index 0000000000..bfd76ed9cc --- /dev/null +++ b/Task/Range-expansion/Python/range-expansion-3.py @@ -0,0 +1,6 @@ +from functools import reduce +from operator import add + +def rangeexpand(s): + return reduce(add, + map(lambda x: list(range(*map(int, x.split('-')))) if '-' in x else [int(x)], s.split(','))) diff --git a/Task/Range-expansion/REXX/range-expansion-1.rexx b/Task/Range-expansion/REXX/range-expansion-1.rexx index e2a0e79259..1df6709d2b 100644 --- a/Task/Range-expansion/REXX/range-expansion-1.rexx +++ b/Task/Range-expansion/REXX/range-expansion-1.rexx @@ -1,13 +1,13 @@ -/*REXX program expands an ordered list of integers into an expanded list*/ -old='-6,-3--1, 3-5, 7-11, 14,15,17-20'; a=translate(old,,',') -new= /*translate , ───► blanks [↑] */ - do until a==''; parse var a X a /*obtain next integer ─or─ range.*/ - p=pos('-',X,2) /*find location of a dash (maybe)*/ - if p==0 then new=new X /*append X to the new list.*/ - else do j=left(X,p-1) to substr(X,p+1); new=new j - end /*j*/ /*append single int at a time [↑]*/ - end /*until*/ - /*stick a fork in it, we're done.*/ -new=translate(strip(new), ',' ," ") /*remove first blank, add commas.*/ -say 'old list: ' old /*show old list of numbers/ranges*/ -say 'new list: ' new /*show the new list of numbers.*/ +/*REXX program expands an ordered list of integers into an expanded list. */ +old= '-6,-3--1, 3-5, 7-11, 14,15,17-20'; a=translate(old,,',') +new= /*translate [↑] commas (,) ───► blanks*/ + do until a==''; parse var a X a /*obtain the next integer ──or── range.*/ + p=pos('-', X, 2) /*find the location of a dash (maybe). */ + if p==0 then new=new X /*append integer X to the new list.*/ + else do j=left(X,p-1) to substr(X,p+1); new=new j + end /*j*/ /*append a single [↑] integer at a time*/ + end /*until*/ + /*stick a fork in it, we're all done. */ +new=translate( strip(new), ',', " ") /*remove the first blank, add commas. */ +say 'old list: ' old /*show the old list of numbers/ranges.*/ +say 'new list: ' new /* " " new " " numbers. */ diff --git a/Task/Range-expansion/S-lang/range-expansion.slang b/Task/Range-expansion/S-lang/range-expansion.slang new file mode 100644 index 0000000000..f90ace1abb --- /dev/null +++ b/Task/Range-expansion/S-lang/range-expansion.slang @@ -0,0 +1,19 @@ +variable r_expres = "-6,-3--1,3-5,7-11,14,15,17-20", s, r_expan = {}, dpos, i; + +foreach s (strchop(r_expres, ',', 0)) +{ + % S-Lang built-in RE's are fairly limited, and have a quirk: + % grouping is done with \\( and \\), not ( and ) + % [PCRE and Oniguruma RE's are available via standard libraries] + if (string_match(s, "-?[0-9]+\\(-\\)-?[0-9]+", 1)) { + + (dpos, ) = string_match_nth(1); + + % Create/loop-over a "range array": from num before - to num after it: + foreach i ( [integer(substr(s, 1, dpos)) : integer(substr(s, dpos+2, -1))] ) + list_append(r_expan, string(i)); + } + else + list_append(r_expan, s); +} +print(strjoin(list_to_array(r_expan), ", ")); diff --git a/Task/Range-expansion/TXR/range-expansion.txr b/Task/Range-expansion/TXR/range-expansion.txr index d18c3a7d9c..22368df593 100644 --- a/Task/Range-expansion/TXR/range-expansion.txr +++ b/Task/Range-expansion/TXR/range-expansion.txr @@ -31,12 +31,8 @@ (rangeexpand (rest list)))) (t (cons (first list) (rangeexpand (rest list)))))) - (defun sortdup (li) - (let ((h [group-by identity li])) - [sort (hash-keys h) <])) - (defun rangeexpand (list) - (sortdup (expand-helper list)))) + (uniq (expand-helper list)))) @(repeat) @(rangelist x)@{trailing-junk} @(output) diff --git a/Task/Range-extraction/00DESCRIPTION b/Task/Range-extraction/00DESCRIPTION index 2a84396dab..c1baf36d37 100644 --- a/Task/Range-extraction/00DESCRIPTION +++ b/Task/Range-extraction/00DESCRIPTION @@ -1,12 +1,16 @@ {{:Range extraction/Format}} -'''The task''' +;Task: * Create a function that takes a list of integers in increasing order and returns a correctly formatted string in the range format. * Use the function to compute and print the range formatted version of the following ordered list of integers. (The correct answer is: 0-2,4,6-8,11,12,14-25,27-33,35-39.) +
    0, 1, 2, 4, 6, 7, 8, 11, 12, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 27, 28, 29, 30, 31, 32, 33, 35, 36, 37, 38, 39 * Show the output of your program. -C.f. [[Range expansion]] + +;Related task: +*   [[Range expansion]] +

    diff --git a/Task/Range-extraction/AppleScript/range-extraction.applescript b/Task/Range-extraction/AppleScript/range-extraction.applescript new file mode 100644 index 0000000000..f147431cff --- /dev/null +++ b/Task/Range-extraction/AppleScript/range-extraction.applescript @@ -0,0 +1,120 @@ +on run + + rangeString([0, 1, 2, 4, 6, 7, 8, 11, 12, 14, 15, ¬ + 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 27, ¬ + 28, 29, 30, 31, 32, 33, 35, 36, 37, 38, 39]) + +end run + +-- rangeString :: [Int] -> String +on rangeString(xs) + script addNumberOrRange + property iLast : length of xs + + -- [[Int]] -> Int -> Int -> [Int] -> [[Int]] + on lambda(lstAccumulator, x, iPosn, xs) + if iPosn < iLast then + if ((item (iPosn + 1) of xs) - x) > 1 then -- rightward gap > 1 + [[x]] & lstAccumulator --> start of new series + else + -- Prepended to current series + -- (if a series-breaker, or start list, is at left) + if ((iPosn = 1) or (x - (item (iPosn - 1) of xs)) > 1) then + [[x] & (item 1 of lstAccumulator)] & tail(lstAccumulator) + else + lstAccumulator -- Stet - series continues + end if + end if + else + [[x]] + end if + end lambda + end script + + interCalate(",", ¬ + map(my delimitedString, ¬ + foldr(addNumberOrRange, [], xs))) +end rangeString + + +-- delimitedString :: [Int] -> String +on delimitedString(lstInt) + set intFirst to item 1 of lstInt + + if length of lstInt > 1 then + set intSecond to item 2 of lstInt + set delta to intSecond - intFirst + else + set delta to 0 + end if + + if delta > 0 then + (intFirst as string) & cond(delta > 1, "-", ",") & intSecond as string + else + intFirst as string + end if +end delimitedString + + +-- GENERIC LIBRARY FUNCTIONS + +-- intercalate :: Text -> [Text] -> Text +on interCalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end interCalate + +-- foldr :: (a -> b -> a) -> a -> [b] -> a +on foldr(f, startValue, xs) + set mf to mReturn(f) + + set v to startValue + set lng to length of xs + repeat with i from lng to 1 by -1 + set v to mf's lambda(v, item i of xs, i, xs) + end repeat + return v +end foldr + +-- map :: (a -> b) -> [a] -> [b] +on map(f, xs) + set mf to mReturn(f) + set lng to length of xs + set lst to {} + repeat with i from 1 to lng + set end of lst to mf's lambda(item i of xs, i, xs) + end repeat + return lst +end map + +-- cond :: Bool -> (a -> b) -> (a -> b) -> (a -> b) +on cond(bool, f, g) + if bool then + f + else + g + end if +end cond + +-- tail :: [a] -> [a] +on tail(xs) + if class of xs is list and length of xs > 1 then + items 2 thru -1 of xs + else + {} + end if +end tail + +-- 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 diff --git a/Task/Range-extraction/Elixir/range-extraction.elixir b/Task/Range-extraction/Elixir/range-extraction.elixir index c17041bc2c..6b1a50dc3f 100644 --- a/Task/Range-extraction/Elixir/range-extraction.elixir +++ b/Task/Range-extraction/Elixir/range-extraction.elixir @@ -2,21 +2,21 @@ defmodule RC do def range_extract(list) do max = Enum.max(list) + 2 sorted = Enum.sort([max|list]) - canidate_number = hd(sorted) + candidate_number = hd(sorted) current_number = hd(sorted) - extract(tl(sorted), canidate_number, current_number, []) + extract(tl(sorted), candidate_number, current_number, []) end defp extract([], _, _, range), do: Enum.reverse(range) |> Enum.join(",") - defp extract([next|rest], canidate, current, range) when current+1 >= next do - extract(rest, canidate, next, range) + defp extract([next|rest], candidate, current, range) when current+1 >= next do + extract(rest, candidate, next, range) end - defp extract([next|rest], canidate, current, range) when canidate == current do + defp extract([next|rest], candidate, current, range) when candidate == current do extract(rest, next, next, [to_string(current)|range]) end - defp extract([next|rest], canidate, current, range) do - seperator = if canidate+1 == current, do: ",", else: "-" - str = "#{canidate}#{seperator}#{current}" + defp extract([next|rest], candidate, current, range) do + separator = if candidate+1 == current, do: ",", else: "-" + str = "#{candidate}#{separator}#{current}" extract(rest, next, next, [str|range]) end end diff --git a/Task/Range-extraction/Fortran/range-extraction.f b/Task/Range-extraction/Fortran/range-extraction.f new file mode 100644 index 0000000000..e61118863a --- /dev/null +++ b/Task/Range-extraction/Fortran/range-extraction.f @@ -0,0 +1,59 @@ + SUBROUTINE IRANGE(TEXT) !Identifies integer ranges in a list of integers. +Could make this a function, but then a maximum text length returned would have to be specified. + CHARACTER*(*) TEXT !The list on input, the list with ranges on output. + INTEGER LOTS !Once again, how long is a piece of string? + PARAMETER (LOTS = 666) !This should do, at least for demonstrations. + INTEGER VAL(LOTS) !The integers of the list. + INTEGER N !Count of numbers. + INTEGER I,I1 !Steppers. + N = 1 !Presume there to be one number. + DO I = 1,LEN(TEXT) !Then by noticing commas, + IF (TEXT(I:I).EQ.",") N = N + 1 !Determine how many more there are. + END DO !Step alonmg the text. + IF (N.LE.2) RETURN !One comma = two values. Boring. + IF (N.GT.LOTS) STOP "Too many values!" + READ (TEXT,*) VAL(1:N) !Get the numbers, with free-format flexibility. + TEXT = "" !Scrub the parameter! + L = 0 !No text has been placed. + I1 = 1 !Start the scan. + 10 IF (L.GT.0) CALL EMIT(",") !A comma if there is prior text. + CALL SPLOT(VAL(I1)) !The first number always appears. + DO I = I1 + 1,N !Now probe ahead + IF (VAL(I - 1) + 1 .NE. VAL(I)) EXIT !While values are consecutive. + END DO !Up to the end of the remaining list. + IF (I - I1 .GT. 2) THEN !More than two consecutive values seen? + CALL EMIT("-") !Yes! + CALL SPLOT(VAL(I - 1)) !The ending number of a range. + I1 = I !Finger the first beyond the run. + ELSE !But if too few to be worth a span, + I1 = I1 + 1 !Just finger the next number. + END IF !So much for that starter. + IF (I.LE.N) GO TO 10 !Any more? + CONTAINS !Some assistants to save on repetition. + SUBROUTINE EMIT(C) !Rolls forth one character. + CHARACTER*1 C !The character. + L = L + 1 !Advance the finger. + IF (L.GT.LEN(TEXT)) STOP "Ran out of text!" !Maybe not. + TEXT(L:L) = C !And place the character. + END SUBROUTINE EMIT !That was simple. + SUBROUTINE SPLOT(N) !Rolls forth a signed number. + INTEGER N !The number. + CHARACTER*12 FIELD !Sufficient for 32-bit integers. + INTEGER I !A stepper. + WRITE (FIELD,"(I0)") N!Roll the number, with trailing spaces. + DO I = 1,12 !Now transfer the text of the number. + IF (FIELD(I:I).LE." ") EXIT !Up to the first space. + CALL EMIT(FIELD(I:I)) !One by one. + END DO !On to the end. + END SUBROUTINE SPLOT !Not so difficult either. + END !So much for IRANGE. + + PROGRAM POKE + CHARACTER*(200) SOME + SOME = " 0, 1, 2, 4, 6, 7, 8, 11, 12, 14, " + 1 //" 15, 16, 17, 18, 19, 20, 21, 22, 23, 24," + 2 //"25, 27, 28, 29, 30, 31, 32, 33, 35, 36, " + 3 //"37, 38, 39 " + CALL IRANGE(SOME) + WRITE (6,*) SOME + END diff --git a/Task/Range-extraction/Java/range-extraction.java b/Task/Range-extraction/Java/range-extraction.java index f4656bdfa6..c4204493ff 100644 --- a/Task/Range-extraction/Java/range-extraction.java +++ b/Task/Range-extraction/Java/range-extraction.java @@ -1,41 +1,22 @@ -public class Range{ - public static void main(String[] args){ - System.out.println(compress2Range("-6, -3, -2, -1, 0, 1, 3, 4, 5, 7," + - " 8, 9, 10, 11, 14, 15, 17, 18, 19, 20")); - System.out.println(compress2Range( - "0, 1, 2, 4, 6, 7, 8, 11, 12, 14, " + - "15, 16, 17, 18, 19, 20, 21, 22, 23, 24," + - "25, 27, 28, 29, 30, 31, 32, 33, 35, 36," + - "37, 38, 39")); - } +public class RangeExtraction { - private static String compress2Range(String expanded){ - StringBuilder result = new StringBuilder(); - String[] nums = expanded.replace(" ", "").split(","); - int firstNum = Integer.parseInt(nums[0]); - int rangeSize = 0; - for(int i = 1; i < nums.length; i++){ - int thisNum = Integer.parseInt(nums[i]); - if(thisNum - firstNum - rangeSize == 1){ - rangeSize++; - }else{ - if(rangeSize != 0){ - result.append(firstNum).append((rangeSize == 1) ? ",": "-") - .append(firstNum+rangeSize).append(","); - rangeSize = 0; - }else{ - result.append(firstNum).append(","); - } - firstNum = thisNum; + public static void main(String[] args) { + int[] arr = {0, 1, 2, 4, 6, 7, 8, 11, 12, 14, + 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, + 25, 27, 28, 29, 30, 31, 32, 33, 35, 36, + 37, 38, 39}; + + int len = arr.length; + int idx = 0, idx2 = 0; + while (idx < len) { + while (++idx2 < len && arr[idx2] - arr[idx2 - 1] == 1); + if (idx2 - idx > 2) { + System.out.printf("%s-%s,", arr[idx], arr[idx2 - 1]); + idx = idx2; + } else { + for (; idx < idx2; idx++) + System.out.printf("%s,", arr[idx]); } } - if(rangeSize != 0){ - result.append(firstNum).append((rangeSize == 1) ? "," : "-"). - append(firstNum + rangeSize); - rangeSize = 0; - } else { - result.append(firstNum); - } - return result.toString(); } } diff --git a/Task/Range-extraction/JavaScript/range-extraction.js b/Task/Range-extraction/JavaScript/range-extraction-1.js similarity index 100% rename from Task/Range-extraction/JavaScript/range-extraction.js rename to Task/Range-extraction/JavaScript/range-extraction-1.js diff --git a/Task/Range-extraction/JavaScript/range-extraction-2.js b/Task/Range-extraction/JavaScript/range-extraction-2.js new file mode 100644 index 0000000000..cd869a464a --- /dev/null +++ b/Task/Range-extraction/JavaScript/range-extraction-2.js @@ -0,0 +1,45 @@ +(function (lstTest) { + 'use strict'; + + function rangeString(xs) { + var iRightmost = xs.length - 1, + + // Using foldr/reduceRight proves simpler here than foldl/reduce + // (the left end of the list is easier to reach than the tip of the tail) + lstSeries = xs.reduceRight(function (a, x, i, l) { + + return i < iRightmost ? ( + + // new series if rightward gap > 1 + l[i + 1] - x > 1 ? ( + [[x]].concat(a) + ) : ( + + // This value prepended to current series (if a + // series-breaker, or the start of the list, is at left) + (i === 0 || (x - l[i - 1]) > 1) ? ( + [[x].concat(a[0])].concat(a.slice(1)) + + // or, if the series continues to the left, + // just an unmodified copy of the accumulator + ) : a + ) + ) : [[x]]; + + }, []); + + return lstSeries.map(function (r) { + var lng = r.length, + d = lng > 1 ? r[1] - r[0] : 0; + + return d ? r[0] + (d > 1 ? '-' : ',') + r[1] : r[0]; + + }).join(','); + } + + return rangeString(lstTest); + +})([0, 1, 2, 4, 6, 7, 8, 11, 12, 14, + 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, + 25, 27, 28, 29, 30, 31, 32, 33, 35, 36, + 37, 38, 39]); diff --git a/Task/Range-extraction/JavaScript/range-extraction-3.js b/Task/Range-extraction/JavaScript/range-extraction-3.js new file mode 100644 index 0000000000..844c5f34ca --- /dev/null +++ b/Task/Range-extraction/JavaScript/range-extraction-3.js @@ -0,0 +1 @@ +"0-2,4,6-8,11,12,14-25,27-33,35-39" diff --git a/Task/Range-extraction/Lua/range-extraction.lua b/Task/Range-extraction/Lua/range-extraction.lua new file mode 100644 index 0000000000..96510de6c1 --- /dev/null +++ b/Task/Range-extraction/Lua/range-extraction.lua @@ -0,0 +1,28 @@ +function extractRange (rList) + local rExpr, startVal = "" + for k, v in pairs(rList) do + if rList[k + 1] == v + 1 then + if not startVal then startVal = v end + else + if startVal then + if v == startVal + 1 then + rExpr = rExpr .. startVal .. "," .. v .. "," + else + rExpr = rExpr .. startVal .. "-" .. v .. "," + end + startVal = nil + else + rExpr = rExpr .. v .. "," + end + end + end + return rExpr:sub(1, -2) +end + +local intList = { + 0, 1, 2, 4, 6, 7, 8, 11, 12, 14, + 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, + 25, 27, 28, 29, 30, 31, 32, 33, 35, 36, + 37, 38, 39 +} +print(extractRange(intList)) diff --git a/Task/Range-extraction/REXX/range-extraction-1.rexx b/Task/Range-extraction/REXX/range-extraction-1.rexx index c7e64a2ab2..6923acf70e 100644 --- a/Task/Range-extraction/REXX/range-extraction-1.rexx +++ b/Task/Range-extraction/REXX/range-extraction-1.rexx @@ -1,19 +1,19 @@ -/*REXX program creates a range extraction from a list of numbers (can be neg.)*/ +/*REXX program creates a range extraction from a list of numbers (can be negative.) */ old=0 1 2 4 6 7 8 11 12 14 15 16 17 18 19 20 21 22 23 24 25 27 28 29 30 31 32 33 35 36 37 38 39 -#=words(old) /*number of integers in the number list*/ -new= /*the new list, possibly with ranges. */ - do j=1 to #; x=word(old,j) /*obtain Jth number in the old list. */ - new=new',' x /*append " " to " new " */ - inc=1 /*start with an increment of one (1). */ - do k=j+1 to #; y=word(old,k) /*get the Kth number in the number list*/ - if y\=x+inc then leave /*is this number not > previous by inc?*/ - inc=inc+1; g=y /*increase the range, assign G (good).*/ - end /*k*/ - if k-1=j | g=x+1 then iterate /*Is the range=0│1? Then keep truckin'*/ - new=new'-'g; j=k-1 /*indicate a range of #s; change index*/ - end /*j*/ +#=words(old) /*number of integers in the number list*/ +new= /*the new list, possibly with ranges. */ + do j=1 to #; x=word(old,j) /*obtain Jth number in the old list. */ + new=new',' x /*append " " to " new " */ + inc=1 /*start with an increment of one (1). */ + do k=j+1 to #; y=word(old,k) /*get the Kth number in the number list*/ + if y\==x+inc then leave /*is this number not > previous by inc?*/ + inc=inc+1; g=y /*increase the range, assign G (good).*/ + end /*k*/ + if k-1=j | g=x+1 then iterate /*Is the range=0│1? Then keep truckin'*/ + new=new'-'g; j=k-1 /*indicate a range of #s; change index*/ + end /*j*/ -new=space(substr(new, 2), 0) /*elide leading comma, also all blanks.*/ -say 'old:' old /*display the old range of numbers. */ -say 'new:' new /* " " new list " " */ - /*stick a fork in it, we're all done. */ +new=space(substr(new, 2), 0) /*elide leading comma, also all blanks.*/ +say 'old:' old /*display the old range of numbers. */ +say 'new:' new /* " " new list " " */ + /*stick a fork in it, we're all done. */ diff --git a/Task/Range-extraction/REXX/range-extraction-2.rexx b/Task/Range-extraction/REXX/range-extraction-2.rexx index 69162f64a0..49fa853387 100644 --- a/Task/Range-extraction/REXX/range-extraction-2.rexx +++ b/Task/Range-extraction/REXX/range-extraction-2.rexx @@ -1,19 +1,19 @@ -/*REXX program creates a range extraction from a list of numbers (can be neg.)*/ +/*REXX program creates a range extraction from a list of numbers (can be negative.) */ old=0 1 2 4 6 7 8 11 12 14 15 16 17 18 19 20 21 22 23 24 25 27 28 29 30 31 32 33 35 36 37 38 39 -#=words(old); j=0 /*number of integers in the number list*/ -new= /*the new list, possibly with ranges. */ - do while j<#; j=j+1; x=word(old,j) /*get the Jth number in the number list*/ - new=new',' x /*append " " to " new " */ - inc=1 /*start with an increment of one (1). */ - do k=j+1 to #; y=word(old,k) /*get the Kth number in the number list*/ - if y\=x+inc then leave /*is this number not > previous by inc?*/ - inc=inc+1; g=y /*increase the range, assign G (good).*/ - end /*k*/ - if k-1=j | g=x+1 then iterate /*Is the range=0│1? Then keep truckin'*/ - new=new'-'g; j=k-1 /*indicate a range of numbers; change J*/ - end /*while*/ +#=words(old); j=0 /*number of integers in the number list*/ +new= /*the new list, possibly with ranges. */ + do while j<#; j=j+1; x=word(old,j) /*get the Jth number in the number list*/ + new=new',' x /*append " " to " new " */ + inc=1 /*start with an increment of one (1). */ + do k=j+1 to #; y=word(old,k) /*get the Kth number in the number list*/ + if y\==x+inc then leave /*is this number not > previous by inc?*/ + inc=inc+1; g=y /*increase the range, assign G (good).*/ + end /*k*/ + if k-1=j | g=x+1 then iterate /*Is the range=0│1? Then keep truckin'*/ + new=new'-'g; j=k-1 /*indicate a range of numbers; change J*/ + end /*while*/ -new=space(substr(new, 2), 0) /*elide leading comma, also all blanks.*/ -say 'old:' old /*display the old range of numbers. */ -say 'new:' new /* " " new list " " */ - /*stick a fork in it, we're all done. */ +new=space(substr(new, 2), 0) /*elide leading comma, also all blanks.*/ +say 'old:' old /*display the old range of numbers. */ +say 'new:' new /* " " new list " " */ + /*stick a fork in it, we're all done. */ diff --git a/Task/Range-extraction/Ruby/range-extraction.rb b/Task/Range-extraction/Ruby/range-extraction-1.rb similarity index 100% rename from Task/Range-extraction/Ruby/range-extraction.rb rename to Task/Range-extraction/Ruby/range-extraction-1.rb diff --git a/Task/Range-extraction/Ruby/range-extraction-2.rb b/Task/Range-extraction/Ruby/range-extraction-2.rb new file mode 100644 index 0000000000..a16805f1a9 --- /dev/null +++ b/Task/Range-extraction/Ruby/range-extraction-2.rb @@ -0,0 +1,2 @@ +ary = [0,1,2,4,6,7,8,11,12,14,15,16,17,18,19,20,21,22,23,24,25,27,28,29,30,31,32,33,35,36,37,38,39] +puts ary.sort.slice_when{|i,j| i+1 != j}.map{|a| a.size<3 ? a : "#{a[0]}-#{a[-1]}"}.join(",") diff --git a/Task/Range-extraction/Rust/range-extraction-1.rust b/Task/Range-extraction/Rust/range-extraction-1.rust new file mode 100644 index 0000000000..621ebeeae3 --- /dev/null +++ b/Task/Range-extraction/Rust/range-extraction-1.rust @@ -0,0 +1,51 @@ +use std::ops::Add; + +struct RangeFinder<'a, T: 'a> { + index: usize, + length: usize, + arr: &'a [T], +} + +impl<'a, T> Iterator for RangeFinder<'a, T> where T: PartialEq + Add + Copy { + type Item = (T, Option); + fn next(&mut self) -> Option { + if self.index == self.length { + return None; + } + let lo = self.index; + while self.index < self.length - 1 && self.arr[self.index + 1] == self.arr[self.index] + 1 { + self.index += 1 + } + let hi = self.index; + self.index += 1; + if hi - lo > 1 { + Some((self.arr[lo], Some(self.arr[hi]))) + } else { + if hi - lo == 1 { + self.index -= 1 + } + Some((self.arr[lo], None)) + } + } +} + +impl<'a, T> RangeFinder<'a, T> { + fn new(a: &'a [T]) -> Self { + RangeFinder { + index: 0, + arr: a, + length: a.len(), + } + } +} + +fn main() { + let n = [0,1,2,3]; + + for (i, (lo, hi)) in RangeFinder::new(&n).enumerate() { + if i > 0 {print!(", ")} + print!("{}", lo); + if hi.is_some() {print!("-{}", hi.unwrap())} + } + println!(""); +} diff --git a/Task/Range-extraction/Rust/range-extraction-2.rust b/Task/Range-extraction/Rust/range-extraction-2.rust new file mode 100644 index 0000000000..bd2ceb5954 --- /dev/null +++ b/Task/Range-extraction/Rust/range-extraction-2.rust @@ -0,0 +1,2 @@ +#![feature(zero_one)] +use std::num::One; diff --git a/Task/Range-extraction/Rust/range-extraction-3.rust b/Task/Range-extraction/Rust/range-extraction-3.rust new file mode 100644 index 0000000000..00e96f973f --- /dev/null +++ b/Task/Range-extraction/Rust/range-extraction-3.rust @@ -0,0 +1 @@ + impl<'a, T> Iterator for RangeFinder<'a, T> where T: PartialEq + Add + Copy { diff --git a/Task/Range-extraction/Rust/range-extraction-4.rust b/Task/Range-extraction/Rust/range-extraction-4.rust new file mode 100644 index 0000000000..62724baeb9 --- /dev/null +++ b/Task/Range-extraction/Rust/range-extraction-4.rust @@ -0,0 +1 @@ +impl<'a, T> Iterator for RangeFinder<'a, T> where T: PartialEq + Add + Copy + One { diff --git a/Task/Range-extraction/Rust/range-extraction-5.rust b/Task/Range-extraction/Rust/range-extraction-5.rust new file mode 100644 index 0000000000..fa31a8ddfb --- /dev/null +++ b/Task/Range-extraction/Rust/range-extraction-5.rust @@ -0,0 +1 @@ + while self.index < self.length - 1 && self.arr[self.index + 1] == self.arr[self.index] + 1 { diff --git a/Task/Range-extraction/Rust/range-extraction-6.rust b/Task/Range-extraction/Rust/range-extraction-6.rust new file mode 100644 index 0000000000..8af49593f3 --- /dev/null +++ b/Task/Range-extraction/Rust/range-extraction-6.rust @@ -0,0 +1 @@ + while self.index < self.length - 1 && self.arr[self.index + 1] == self.arr[self.index] + T::one() { diff --git a/Task/Range-extraction/TXR/range-extraction.txr b/Task/Range-extraction/TXR/range-extraction.txr new file mode 100644 index 0000000000..0ec4c00aef --- /dev/null +++ b/Task/Range-extraction/TXR/range-extraction.txr @@ -0,0 +1,9 @@ +(defun range-extract (numbers) + `@{(mapcar [iff [callf > length (ret 2)] + (ret `@[@1 0]-@[@1 -1]`) + (ret `@{@1 ","}`)] + (mapcar (op mapcar car) + (split [window-map 1 :reflect + (op list @2 (- @2 @1)) + (sort (uniq numbers))] + (op where [chain second (op < 1)])))) ","}`) diff --git a/Task/Ranking-methods/00DESCRIPTION b/Task/Ranking-methods/00DESCRIPTION index 64f3cd95e6..5bc4a59981 100644 --- a/Task/Ranking-methods/00DESCRIPTION +++ b/Task/Ranking-methods/00DESCRIPTION @@ -2,6 +2,7 @@ The numerical rank of competitors in a competition shows if one is better than, The numerical rank of a competitor can be assigned in several [[wp:Ranking|different ways]]. + ;Task: The following scores are accrued for all competitors of a competition (in best-first order):
    44 Solomon
    @@ -18,6 +19,9 @@ For each of the following ranking methods, create a function/method/procedure/su
     # Dense. (Ties share the next available integer).
     # Ordinal. ((Competitors take the next available integer. Ties are not treated otherwise).
     # Fractional. (Ties share the mean of what would have been their ordinal numbers).
    +
    +
    See the [[wp:Ranking|wikipedia article]] for a fuller description. Show here, on this page, the ranking of the test scores under each of the numbered ranking methods. +

    diff --git a/Task/Ranking-methods/Elixir/ranking-methods.elixir b/Task/Ranking-methods/Elixir/ranking-methods.elixir new file mode 100644 index 0000000000..d69005940e --- /dev/null +++ b/Task/Ranking-methods/Elixir/ranking-methods.elixir @@ -0,0 +1,33 @@ +defmodule Ranking do + def methods(data) do + IO.puts "stand.\tmod.\tdense\tord.\tfract." + Enum.group_by(data, fn {score,_name} -> score end) + |> Enum.map(fn {score,pairs} -> + names = Enum.map(pairs, fn {_,name} -> name end) |> Enum.reverse + {score, names} + end) + |> Enum.sort_by(fn {score,_} -> -score end) + |> Enum.with_index + |> Enum.reduce({1,0,0}, fn {{score, names}, i}, {s_rnk, m_rnk, o_rnk} -> + d_rnk = i + 1 + m_rnk = m_rnk + length(names) + f_rnk = ((s_rnk + m_rnk) / 2) |> to_string |> String.replace(".0","") + o_rnk = Enum.reduce(names, o_rnk, fn name,acc -> + IO.puts "#{s_rnk}\t#{m_rnk}\t#{d_rnk}\t#{acc+1}\t#{f_rnk}\t#{score} #{name}" + acc + 1 + end) + {s_rnk+length(names), m_rnk, o_rnk} + end) + end +end + +~w"44 Solomon + 42 Jason + 42 Errol + 41 Garry + 41 Bernard + 41 Barry + 39 Stephen" +|> Enum.chunk(2) +|> Enum.map(fn [score,name] -> {String.to_integer(score),name} end) +|> Ranking.methods diff --git a/Task/Ranking-methods/JavaScript/ranking-methods.js b/Task/Ranking-methods/JavaScript/ranking-methods-1.js similarity index 100% rename from Task/Ranking-methods/JavaScript/ranking-methods.js rename to Task/Ranking-methods/JavaScript/ranking-methods-1.js diff --git a/Task/Ranking-methods/JavaScript/ranking-methods-2.js b/Task/Ranking-methods/JavaScript/ranking-methods-2.js new file mode 100644 index 0000000000..d3dfa4ed3a --- /dev/null +++ b/Task/Ranking-methods/JavaScript/ranking-methods-2.js @@ -0,0 +1,59 @@ +((() => { + const xs = 'Solomon Jason Errol Garry Bernard Barry Stephen'.split(' '), + ns = [44, 42, 42, 41, 41, 41, 39]; + + const sorted = xs.map((x, i) => ({ + name: x, + score: ns[i] + })) + .sort((a, b) => { + const c = b.score - a.score; + return c ? c : a.name < b.name ? -1 : a.name > b.name ? 1 : 0; + }); + + const names = sorted.map(x => x.name), + scores = sorted.map(x => x.score), + reversed = scores.slice(0) + .reverse(), + unique = scores.filter((x, i) => scores.indexOf(x) === i); + + // RANKINGS AS FUNCTIONS OF SCORES: SORTED, REVERSED AND UNIQUE + + // rankings :: Int -> Int -> Dictonary + const rankings = (score, index) => ({ + name: names[index], + score, + Ordinal: index + 1, + Standard: scores.indexOf(score) + 1, + Modified: reversed.length - reversed.indexOf(score), + Dense: unique.indexOf(score) + 1, + + Fractional: (n => ( + (scores.indexOf(n) + 1) + + (reversed.length - reversed.indexOf(n)) + ) / 2)(score) + }); + + // tbl :: [[[a]]] + const tbl = [ + 'Name Score Standard Modified Dense Ordinal Fractional'.split(' ') + ].concat(scores.map(rankings) + .reduce((a, x) => a.concat([ + [x.name, x.score, + x.Standard, x.Modified, x.Dense, x.Ordinal, x.Fractional + ] + ]), [])); + + // wikiTable :: [[[a]]] -> Bool -> String -> String + const wikiTable = (lstRows, blnHeaderRow, strStyle) => + `{| class="wikitable" ${strStyle ? 'style="' + strStyle + '"' : ''} + ${lstRows.map((lstRow, iRow) => { + const strDelim = ((blnHeaderRow && !iRow) ? '!' : '|'); + + return '\n|-\n' + strDelim + ' ' + lstRow + .map(v => typeof v === 'undefined' ? ' ' : v) + .join(' ' + strDelim + strDelim + ' '); + }).join('')}\n|}`; + + return wikiTable(tbl, true, 'text-align:center'); +}))(); diff --git a/Task/Ranking-methods/Mathematica/ranking-methods.math b/Task/Ranking-methods/Mathematica/ranking-methods.math new file mode 100644 index 0000000000..1f09077e17 --- /dev/null +++ b/Task/Ranking-methods/Mathematica/ranking-methods.math @@ -0,0 +1,19 @@ +data = Transpose@{{44, 42, 42, 41, 41, 41, 39}, {"Solomon", "Jason", + "Errol", "Garry", "Bernard", "Barry", "Stephen"}}; + +rank[data_, type_] := + Module[{t = Transpose@{Sort@data, Range[Length@data, 1, -1]}}, + Switch[type, + "standard", data/.Rule@@@First/@SplitBy[t, First], + "modified", data/.Rule@@@Last/@SplitBy[t, First], + "dense", data/.Thread[#->Range[Length@#]]&@SplitBy[t, First][[All, 1, 1]], + "ordinal", Reverse@Ordering[data], + "fractional", data/.Rule@@@(Mean[#]/.{a_Rational:>N[a]}&)/@ SplitBy[t, First]]] + +fmtRankedData[data_, type_] := + Labeled[Grid[ + SortBy[ArrayFlatten@{{Transpose@{rank[data[[All, 1]], type]}, + data}}, First], Alignment->Left], type<>" ranking:", Top] + +Grid@{fmtRankedData[data, #] & /@ {"standard", "modified", "dense", + "ordinal", "fractional"}} diff --git a/Task/Ranking-methods/PARI-GP/ranking-methods.pari b/Task/Ranking-methods/PARI-GP/ranking-methods.pari new file mode 100644 index 0000000000..f7a723f71b --- /dev/null +++ b/Task/Ranking-methods/PARI-GP/ranking-methods.pari @@ -0,0 +1,12 @@ +standard(v)=v=vecsort(v,1,4); my(last=v[1][1]+1); for(i=1,#v, v[i][1]=if(v[i][1]last,last=v[i][1]; i, v[i+1][1])); v; +dense(v)=v=vecsort(v,1,4); my(last=v[1][1]+1,rank); for(i=1,#v, v[i][1]=if(v[i][1]Be aware of the precision and accuracy limitations of your timing mechanisms, and document them if you can. '''See also:''' [[System time]], [[Time a function]] diff --git a/Task/Rate-counter/Java/rate-counter-1.java b/Task/Rate-counter/Java/rate-counter-1.java new file mode 100644 index 0000000000..f50de6180b --- /dev/null +++ b/Task/Rate-counter/Java/rate-counter-1.java @@ -0,0 +1,19 @@ +import java.util.function.Consumer; + +public class RateCounter { + + public static void main(String[] args) { + for (double d : benchmark(10, x -> System.out.print(""), 10)) + System.out.println(d); + } + + static double[] benchmark(int n, Consumer f, int arg) { + double[] timings = new double[n]; + for (int i = 0; i < n; i++) { + long time = System.nanoTime(); + f.accept(arg); + timings[i] = System.nanoTime() - time; + } + return timings; + } +} diff --git a/Task/Rate-counter/Java/rate-counter-2.java b/Task/Rate-counter/Java/rate-counter-2.java new file mode 100644 index 0000000000..3c775556a3 --- /dev/null +++ b/Task/Rate-counter/Java/rate-counter-2.java @@ -0,0 +1,33 @@ +import java.util.function.IntConsumer; +import java.util.stream.DoubleStream; + +import static java.lang.System.nanoTime; +import static java.util.stream.DoubleStream.generate; + +import static java.lang.System.out; + +public interface RateCounter { + public static void main(final String... arguments) { + benchmark( + 10, + x -> out.print(""), + 10 + ) + .forEach(out::println) + ; + } + + public static DoubleStream benchmark( + final int n, + final IntConsumer consumer, + final int argument + ) { + return generate(() -> { + final long time = nanoTime(); + consumer.accept(argument); + return nanoTime() - time; + }) + .limit(n) + ; + } +} diff --git a/Task/Rate-counter/PowerShell/rate-counter.psh b/Task/Rate-counter/PowerShell/rate-counter.psh new file mode 100644 index 0000000000..d1e35aa81f --- /dev/null +++ b/Task/Rate-counter/PowerShell/rate-counter.psh @@ -0,0 +1,20 @@ +[datetime]$start = Get-Date + +[int]$count = 3 + +[timespan[]]$times = for ($i = 0; $i -lt $count; $i++) +{ + Measure-Command {0..999999 | Out-Null} +} + +[datetime]$end = Get-Date + +$rate = [PSCustomObject]@{ + StartTime = $start + EndTime = $end + Duration = ($end - $start).TotalSeconds + TimesRun = $count + AverageRunTime = ($times.TotalSeconds | Measure-Object -Average).Average +} + +$rate | Format-List diff --git a/Task/Rate-counter/REXX/rate-counter.rexx b/Task/Rate-counter/REXX/rate-counter.rexx index 3a05a34899..d88c91d38b 100644 --- a/Task/Rate-counter/REXX/rate-counter.rexx +++ b/Task/Rate-counter/REXX/rate-counter.rexx @@ -1,36 +1,35 @@ -/*REXX program reports on the time 4 different tasks take (wall clock)*/ -time.= /*nullify times for all tasks. */ -/*──────────────────────────────────────────────────────────────────────*/ -call time 'Reset' /*reset the REXX (elapsed) timer.*/ - /*show π in hexadecimal to */ - /*2,000 decimal places. */ - task.1='base(pi,16)' - call '$CALC' task.1 /*perform task number one. */ -time.1=time('Elapsed') /*save the time used by task 1. */ -/*──────────────────────────────────────────────────────────────────────*/ -call time 'Reset' /*reset the REXX (elapsed) timer.*/ - /*get primes # 40000──►40800 and */ - /*show their differences. */ - task.2='diffs[prime(40k,40.8k)] ;;; group 20' - call '$CALC' task.2 /*perform task number two. */ -time.2=time('Elapsed') /*save the time used by task 2. */ -/*──────────────────────────────────────────────────────────────────────*/ -call time 'Reset' /*reset the REXX (elapsed) timer.*/ - /*show the Collatz sequence for */ - /*a stupidly big number. */ - task.3='collatz(38**8) ;;; Horizontal' - call '$CALC' task.3 /*perform task number three. */ -time.3=time('Elapsed') /*save the time used by task 3. */ -/*──────────────────────────────────────────────────────────────────────*/ -call time 'Reset' /*reset the REXX (elapsed) timer.*/ - /*plot SIN in ½ degree increments*/ - /*using 9 decimal digits (¬ 60).*/ - task.4='sind(-180,+180,0.5) ;;; Plot DIGits 9' - call '$CALC' task.4 /*perform task number four. */ -time.4=time('Elapsed') /*save the time used by task 4. */ -/*──────────────────────────────────────────────────────────────────────*/ +/*REXX program reports on the amount of elapsed time 4 different tasks use (wall clock).*/ +time.= /*nullify times for all the tasks below*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +call time 'Reset' /*reset the REXX (elapsed) clock timer.*/ + /*show pi in hex to 2,000 dec. digits.*/ + task.1= 'base(pi,16) ;;; lowercase digits 2k echoOptions' + call '$CALC' task.1 /*perform task number one (via $CALC).*/ +time.1=time('E') /*get and save the time used by task 1.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +call time 'Reset' /*reset the REXX (elapsed) clock timer.*/ + /*get primes 40000 ──► 40800 and */ + /*show their differences. */ + task.2= 'diffs[ prime(40k, 40.8k) ] ;;; GRoup 20' + call '$CALC' task.2 /*perform task number two (via $CALC).*/ +time.2=time('E') /*get and save the time used by task 2.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +call time 'Reset' /*reset the REXX (elapsed) clock timer.*/ + /*show the Collatz sequence for a */ + /*stupidly gihugeic number. */ + task.3= 'Collatz(38**8) ;;; Horizontal' + call '$CALC' task.3 /*perform task number three (via $CALC)*/ +time.3=time('E') /*get and save the time used by task 3.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +call time 'Reset' /*reset the REXX (elapsed) clock timer.*/ + /*plot SINE in ½ degree increments.*/ + /*using five decimal digits (¬ 60). */ + task.4= 'sinD(-180, +180, 0.5) ;;; Plot DIGits 5 echoOptions' + call '$CALC' task.4 /*perform task number four (via $CALC).*/ +time.4=time('E') /*get and save the time used by task 4.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ say - do j=1 while time.j\=='' - say 'time used for task' j "was" right(format(time.j,,0),4) 'seconds.' + do j=1 while time.j\=='' + say 'time used for task' j "was" right(format(time.j,,0),4) 'seconds.' end /*j*/ - /*stick a fork in it, we're done.*/ + /*stick a fork in it, we're all done. */ diff --git a/Task/Ray-casting-algorithm/00DESCRIPTION b/Task/Ray-casting-algorithm/00DESCRIPTION index ca25d0acdf..07d41afbd2 100644 --- a/Task/Ray-casting-algorithm/00DESCRIPTION +++ b/Task/Ray-casting-algorithm/00DESCRIPTION @@ -1,4 +1,6 @@ {{Wikipedia|Point_in_polygon}} + +
    Given a point and a polygon, check if the point is inside or outside the polygon using the [[wp:Point in polygon#Ray casting algorithm|ray-casting algorithm]]. A pseudocode can be simply: @@ -27,6 +29,7 @@ So the problematic points are those inside the white area (the box delimited by [[Image:posslope.png|128px|thumb|right]] [[Image:negslope.png|128px|thumb|right]] + Let us take into account a segment AB (the point A having y coordinate always smaller than B's y coordinate, i.e. point A is always below point B) and a point P. Let us use the cumbersome notation PAX to denote the angle between segment AP and AX, where X is always a point on the horizontal line passing by A with x coordinate bigger than the maximum between the x coordinate of A and the x coordinate of B. As explained graphically by the figures on the right, if PAX is greater than the angle BAX, then the ray starting from P intersects the segment AB. (In the images, the ray starting from PA does not intersect the segment, while the ray starting from PB in the second picture, intersects the segment). Points on the boundary or "on" a vertex are someway special and through this approach we do not obtain ''coherent'' results. They could be treated apart, but it is not necessary to do so. @@ -68,4 +71,5 @@ An algorithm for the previous speech could be (if P is a point, Px is its x coor '''end''' '''if''' '''end''' '''if''' -(To avoid the "ray on vertex" problem, the point is moved upward of a small quantity ε) +(To avoid the "ray on vertex" problem, the point is moved upward of a small quantity   ε.) +

    diff --git a/Task/Ray-casting-algorithm/C++/ray-casting-algorithm.cpp b/Task/Ray-casting-algorithm/C++/ray-casting-algorithm.cpp new file mode 100644 index 0000000000..e839e4e64c --- /dev/null +++ b/Task/Ray-casting-algorithm/C++/ray-casting-algorithm.cpp @@ -0,0 +1,81 @@ +#include +#include +#include +#include +#include + +using namespace std; + +const double epsilon = numeric_limits().epsilon(); +const numeric_limits DOUBLE; +const double MIN = DOUBLE.min(); +const double MAX = DOUBLE.max(); + +struct Point { const double x, y; }; + +struct Edge { + const Point a, b; + + bool operator()(const Point& p) const + { + if (a.y > b.y) return Edge{ b, a }(p); + if (p.y == a.y || p.y == b.y) return operator()({ p.x, p.y + epsilon }); + if (p.y > b.y || p.y < a.y || p.x > max(a.x, b.x)) return false; + if (p.x < min(a.x, b.x)) return true; + auto blue = abs(a.x - p.x) > MIN ? (p.y - a.y) / (p.x - a.x) : MAX; + auto red = abs(a.x - b.x) > MIN ? (b.y - a.y) / (b.x - a.x) : MAX; + return blue >= red; + } +}; + +struct Figure { + const string name; + const initializer_list edges; + + bool contains(const Point& p) const + { + auto c = 0; + for (auto e : edges) if (e(p)) c++; + return c % 2 != 0; + } + + template + void check(const initializer_list& points, ostream& os) const + { + os << "Is point inside figure " << name << '?' << endl; + for (auto p : points) + os << " (" << setw(W) << p.x << ',' << setw(W) << p.y << "): " << boolalpha << contains(p) << endl; + os << endl; + } +}; + +int main() +{ + const initializer_list points = { { 5.0, 5.0}, {5.0, 8.0}, {-10.0, 5.0}, {0.0, 5.0}, {10.0, 5.0}, {8.0, 5.0}, {10.0, 10.0} }; + const Figure square = { "Square", + { {{0.0, 0.0}, {10.0, 0.0}}, {{10.0, 0.0}, {10.0, 10.0}}, {{10.0, 10.0}, {0.0, 10.0}}, {{0.0, 10.0}, {0.0, 0.0}} } + }; + + const Figure square_hole = { "Square hole", + { {{0.0, 0.0}, {10.0, 0.0}}, {{10.0, 0.0}, {10.0, 10.0}}, {{10.0, 10.0}, {0.0, 10.0}}, {{0.0, 10.0}, {0.0, 0.0}}, + {{2.5, 2.5}, {7.5, 2.5}}, {{7.5, 2.5}, {7.5, 7.5}}, {{7.5, 7.5}, {2.5, 7.5}}, {{2.5, 7.5}, {2.5, 2.5}} + } + }; + + const Figure strange = { "Strange", + { {{0.0, 0.0}, {2.5, 2.5}}, {{2.5, 2.5}, {0.0, 10.0}}, {{0.0, 10.0}, {2.5, 7.5}}, {{2.5, 7.5}, {7.5, 7.5}}, + {{7.5, 7.5}, {10.0, 10.0}}, {{10.0, 10.0}, {10.0, 0.0}}, {{10.0, 0}, {2.5, 2.5}} + } + }; + + const Figure exagon = { "Exagon", + { {{3.0, 0.0}, {7.0, 0.0}}, {{7.0, 0.0}, {10.0, 5.0}}, {{10.0, 5.0}, {7.0, 10.0}}, {{7.0, 10.0}, {3.0, 10.0}}, + {{3.0, 10.0}, {0.0, 5.0}}, {{0.0, 5.0}, {3.0, 0.0}} + } + }; + + for(auto f : {square, square_hole, strange, exagon}) + f.check(points, cout); + + return EXIT_SUCCESS; +} diff --git a/Task/Ray-casting-algorithm/Go/ray-casting-algorithm-1.go b/Task/Ray-casting-algorithm/Go/ray-casting-algorithm-1.go index 97019c874b..aa6f42bfde 100644 --- a/Task/Ray-casting-algorithm/Go/ray-casting-algorithm-1.go +++ b/Task/Ray-casting-algorithm/Go/ray-casting-algorithm-1.go @@ -1,8 +1,8 @@ package main import ( - "math" "fmt" + "math" ) type xy struct { @@ -85,7 +85,12 @@ var tpg = []poly{ {p13, p14}, {p14, p9}, {p9, p11}}}, } -var tpt = []xy{{5, 5}, {5, 8}, {-10, 5}, {0, 5}, {10, 5}, {8, 5}, {10, 10}} +var tpt = []xy{ + // test points common in other solutions on this page + {5, 5}, {5, 8}, {-10, 5}, {0, 5}, {10, 5}, {8, 5}, {10, 10}, + // test points that show the problem with "strange" + {1, 2}, {2, 1}, +} func main() { for _, pg := range tpg { diff --git a/Task/Ray-casting-algorithm/Go/ray-casting-algorithm-3.go b/Task/Ray-casting-algorithm/Go/ray-casting-algorithm-3.go new file mode 100644 index 0000000000..379e87934a --- /dev/null +++ b/Task/Ray-casting-algorithm/Go/ray-casting-algorithm-3.go @@ -0,0 +1,50 @@ +package main + +import "fmt" + +type xy struct { + x, y float64 +} + +type closedPoly struct { + name string + vert []xy +} + +func inside(pt xy, pg closedPoly) bool { + if len(pg.vert) < 3 { + return false + } + in := rayIntersectsSegment(pt, pg.vert[len(pg.vert)-1], pg.vert[0]) + for i := 1; i < len(pg.vert); i++ { + if rayIntersectsSegment(pt, pg.vert[i-1], pg.vert[i]) { + in = !in + } + } + return in +} + +func rayIntersectsSegment(p, a, b xy) bool { + return (a.y > p.y) != (b.y > p.y) && + p.x < (b.x-a.x)*(p.y-a.y)/(b.y-a.y)+a.x +} + +var tpg = []closedPoly{ + {"square", []xy{{0, 0}, {10, 0}, {10, 10}, {0, 10}}}, + {"square hole", []xy{{0, 0}, {10, 0}, {10, 10}, {0, 10}, {0, 0}, + {2.5, 2.5}, {7.5, 2.5}, {7.5, 7.5}, {2.5, 7.5}, {2.5, 2.5}}}, + {"strange", []xy{{0, 0}, {2.5, 2.5}, {0, 10}, {2.5, 7.5}, {7.5, 7.5}, + {10, 10}, {10, 0}, {2.5, 2.5}}}, + {"exagon", []xy{{3, 0}, {7, 0}, {10, 5}, {7, 10}, {3, 10}, {0, 5}}}, +} + +var tpt = []xy{{1, 2}, {2, 1}} + +func main() { + for _, pg := range tpg { + fmt.Printf("%s:\n", pg.name) + for _, pt := range tpt { + fmt.Println(pt, inside(pt, pg)) + } + } +} diff --git a/Task/Ray-casting-algorithm/Java/ray-casting-algorithm.java b/Task/Ray-casting-algorithm/Java/ray-casting-algorithm.java new file mode 100644 index 0000000000..aa2e3185f8 --- /dev/null +++ b/Task/Ray-casting-algorithm/Java/ray-casting-algorithm.java @@ -0,0 +1,56 @@ +import static java.lang.Math.*; + +public class RayCasting { + + static boolean intersects(int[] A, int[] B, double[] P) { + if (A[1] > B[1]) + return intersects(B, A, P); + + if (P[1] == A[1] || P[1] == B[1]) + P[1] += 0.0001; + + if (P[1] > B[1] || P[1] < A[1] || P[0] > max(A[0], B[0])) + return false; + + if (P[0] < min(A[0], B[0])) + return true; + + double red = (P[1] - A[1]) / (double) (P[0] - A[0]); + double blue = (B[1] - A[1]) / (double) (B[0] - A[0]); + return red >= blue; + } + + static boolean contains(int[][] shape, double[] pnt) { + boolean inside = false; + int len = shape.length; + for (int i = 0; i < len; i++) { + if (intersects(shape[i], shape[(i + 1) % len], pnt)) + inside = !inside; + } + return inside; + } + + public static void main(String[] a) { + double[][] testPoints = {{10, 10}, {10, 16}, {-20, 10}, {0, 10}, + {20, 10}, {16, 10}, {20, 20}}; + + for (int[][] shape : shapes) { + for (double[] pnt : testPoints) + System.out.printf("%7s ", contains(shape, pnt)); + System.out.println(); + } + } + + final static int[][] square = {{0, 0}, {20, 0}, {20, 20}, {0, 20}}; + + final static int[][] squareHole = {{0, 0}, {20, 0}, {20, 20}, {0, 20}, + {5, 5}, {15, 5}, {15, 15}, {5, 15}}; + + final static int[][] strange = {{0, 0}, {5, 5}, {0, 20}, {5, 15}, {15, 15}, + {20, 20}, {20, 0}}; + + final static int[][] hexagon = {{6, 0}, {14, 0}, {20, 10}, {14, 20}, + {6, 20}, {0, 10}}; + + final static int[][][] shapes = {square, squareHole, strange, hexagon}; +} diff --git a/Task/Ray-casting-algorithm/Kotlin/ray-casting-algorithm-1.kotlin b/Task/Ray-casting-algorithm/Kotlin/ray-casting-algorithm-1.kotlin new file mode 100644 index 0000000000..4dbe9a1df0 --- /dev/null +++ b/Task/Ray-casting-algorithm/Kotlin/ray-casting-algorithm-1.kotlin @@ -0,0 +1,37 @@ +package ray_casting + +import java.lang.Double.* +import java.lang.Math.* + +data class Point(val x: Double, val y: Double) + +data class Edge(val s: Point, val e: Point) { + operator fun invoke(p: Point) : Boolean = when { + s.y > e.y -> Edge(e, s).invoke(p) + p.y == s.y || p.y == e.y -> invoke(Point(p.x, p.y + epsilon)) + p.y > e.y || p.y < s.y || p.x > max(s.x, e.x) -> false + p.x < min(s.x, e.x) -> true + else -> { + val blue = if (abs(s.x - p.x) > MIN_VALUE) (p.y - s.y) / (p.x - s.x) else MAX_VALUE + val red = if (abs(s.x - e.x) > MIN_VALUE) (e.y - s.y) / (e.x - s.x) else MAX_VALUE + blue >= red + } + } + + val epsilon = 0.00001 +} + +class Figure(val name: String, val edges: Array) { + operator fun contains(p: Point) = edges.count({ it(p) }) % 2 != 0 +} + +object Ray_casting { + fun check(figures : Array
    , points : List) { + println("points: " + points) + figures.forEach { f -> + println("figure: " + f.name) + f.edges.forEach { println(" " + it) } + println("result: " + (points.map { it in f })) + } + } +} diff --git a/Task/Ray-casting-algorithm/Kotlin/ray-casting-algorithm-2.kotlin b/Task/Ray-casting-algorithm/Kotlin/ray-casting-algorithm-2.kotlin new file mode 100644 index 0000000000..75d651645a --- /dev/null +++ b/Task/Ray-casting-algorithm/Kotlin/ray-casting-algorithm-2.kotlin @@ -0,0 +1,19 @@ +package ray_casting + +fun main(args: Array) { + val figures = arrayOf(Figure("Square", arrayOf(Edge(Point(0.0, 0.0), Point(10.0, 0.0)), Edge(Point(10.0, 0.0), Point(10.0, 10.0)), + Edge(Point(10.0, 10.0), Point(0.0, 10.0)),Edge(Point(0.0, 10.0), Point(0.0, 0.0)))), + Figure("Square hole", arrayOf(Edge(Point(0.0, 0.0), Point(10.0, 0.0)), Edge(Point(10.0, 0.0), Point(10.0, 10.0)), + Edge(Point(10.0, 10.0), Point(0.0, 10.0)), Edge(Point(0.0, 10.0), Point(0.0, 0.0)), Edge(Point(2.5, 2.5), Point(7.5, 2.5)), + Edge(Point(7.5, 2.5), Point(7.5, 7.5)),Edge(Point(7.5, 7.5), Point(2.5, 7.5)), Edge(Point(2.5, 7.5), Point(2.5, 2.5)))), + Figure("Strange", arrayOf(Edge(Point(0.0, 0.0), Point(2.5, 2.5)), Edge(Point(2.5, 2.5), Point(0.0, 10.0)), + Edge(Point(0.0, 10.0), Point(2.5, 7.5)), Edge(Point(2.5, 7.5), Point(7.5, 7.5)), Edge(Point(7.5, 7.5), Point(10.0, 10.0)), + Edge(Point(10.0, 10.0), Point(10.0, 0.0)), Edge(Point(10.0, 0.0), Point(2.5, 2.5)))), + Figure("Exagon", arrayOf(Edge(Point(3.0, 0.0), Point(7.0, 0.0)), Edge(Point(7.0, 0.0), Point(10.0, 5.0)), Edge(Point(10.0, 5.0), Point(7.0, 10.0)), + Edge(Point(7.0, 10.0), Point(3.0, 10.0)), Edge(Point(3.0, 10.0), Point(0.0, 5.0)), Edge(Point(0.0, 5.0), Point(3.0, 0.0))))) + + val points = listOf(Point(5.0, 5.0), Point(5.0, 8.0), Point(-10.0, 5.0), Point(0.0, 5.0), + Point(10.0, 5.0), Point(8.0, 5.0), Point(10.0, 10.0)) + + Ray_casting.check(figures, points) +} diff --git a/Task/Ray-casting-algorithm/REXX/ray-casting-algorithm.rexx b/Task/Ray-casting-algorithm/REXX/ray-casting-algorithm.rexx index e2e2636cff..3c3baaf861 100644 --- a/Task/Ray-casting-algorithm/REXX/ray-casting-algorithm.rexx +++ b/Task/Ray-casting-algorithm/REXX/ray-casting-algorithm.rexx @@ -1,52 +1,51 @@ -/*REXX pgm checks to see if a horizontal ray from point P intersects a polygon*/ -call points 5 5, 5 8, -10 5, 0 5, 10 5, 8 5, 10 10 -A=2.5; B=7.5 /*◄───for shorter args*/ -call poly 0 0, 10 0, 10 10, 0 10 ; call test 'square' -call poly 0 0, 10 0, 10 10, 0 10, A A, B A, B B, A B ; call test 'square hole -call poly 0 0, A A, 0 10, A B, B B, 10 10, 10 0 ; call test 'irregular' -call poly 3 0, 7 0, 10 5, 7 10, 3 10, 0 5 ; call test 'hexagon' -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -in_out: procedure expose point. poly.; parse arg p; #=0 - do side=1 to poly.0 by 2; #=#+ray_intersect(p,side) - end /*side*/ - return #//2 /*ODD is inside. EVEN is outside. */ -/*────────────────────────────────────────────────────────────────────────────*/ -points: n=0; v='POINT.'; do j=1 for arg(); n=n+1; _=arg(j); parse var _ xx yy - call value v||n'.X',xx - call value v||n'.Y',yy - end /*j*/ - call value v'0',n /*define the number of points.*/ +/*REXX program verifies if a horizontal ray from point P intersects a polygon. */ +call points 5 5, 5 8, -10 5, 0 5, 10 5, 8 5, 10 10 +A=2.5; B=7.5 /* ◄───── used for shorter arguments (below).*/ +call poly 0 0, 10 0, 10 10, 0 10 ; call test 'square' +call poly 0 0, 10 0, 10 10, 0 10, A A, B A, B B, A B ; call test 'square hole' +call poly 0 0, A A, 0 10, A B, B B, 10 10, 10 0 ; call test 'irregular' +call poly 3 0, 7 0, 10 5, 7 10, 3 10, 0 5 ; call test 'hexagon' +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +in$out: procedure expose point. poly.; parse arg p; #=0 + do side=1 to poly.0 by 2; #=#+intersect(p,side); end /*side*/ + return # // 2 /*ODD is inside. EVEN is outside.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +intersect: procedure expose point. poly.; parse arg ?,s; sp=s+1 + epsilon='1e' || (-digits()%2); infinity="1e" || (digits() *2) + Px=point.?.x; Ax=poly.s.x; Ay=poly.s.y + Py=point.?.y; Bx=poly.sp.x; By=poly.sp.y /* [↓] do a swap.*/ + if Ay>By then parse value Ax Ay Bx By with Bx By Ax Ay + if Py=Ay | Py=By then Py=Py + epsilon + if PyBy | Px>max(Ax,Bx) then return 0 + if Px= m_red +/*──────────────────────────────────────────────────────────────────────────────────────*/ +points: wx=0; wy=0; do j=1 for arg(); parse value arg(j) with xx yy + wx=max(wx, length(xx) ); call value 'POINT.'j".X", xx + wy=max(wy, length(yy) ); call value 'POINT.'j".Y", yy + end /*j*/ + call value point.0, j-1 /*define the number of points. */ return -/*────────────────────────────────────────────────────────────────────────────*/ -poly: n=0; v='POLY.'; parse arg Fx Fy /* [↓] process the X,Y points*/ - - do j=1 for arg(); n=n+1; _=arg(j); parse var _ xx yy - call value v||n'.X', word(_,1); call value v||n'.Y', word(_,2) - if n//2 then iterate - n=n+1 - call value v||n'.X', word(_,1); call value v||n'.Y', word(_,2) - end /*j*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +poly: @='POLY.'; parse arg Fx Fy /* [↓] process the X,Y points.*/ + n=0 + do j=1 for arg(); n=n+1; parse value arg(j) with xx yy + call value @ || n'.X', xx ; call value @ || n".Y", yy + if n//2 then iterate; n=n+1 + call value @ || n'.X', xx ; call value @ || n".Y", yy + end /*j*/ n=n+1 - call value v||n".X", Fx; call value v||n".Y", Fy; call value v'0',n - return /*POLY.0 is number of segments/sides.*/ -/*────────────────────────────────────────────────────────────────────────────*/ -ray_intersect: procedure expose point. poly.; parse arg ?,s; sp=s+1 - epsilon='1e' || (digits()%2); infinity='1e' || (digits() *2) - Px=point.?.x; Ax=poly.s.x; Ay=poly.s.y - Py=point.?.y; Bx=poly.sp.x; By=poly.sp.y /* [↓] do a swap*/ - if Ay>By then parse value Ax Ay Bx By with Bx By Ax Ay - if Py=Ay | Py=By then Py=Py+epsilon - if PyBy | Px>max(Ax,Bx) then return 0 - if Px=m_red -/*────────────────────────────────────────────────────────────────────────────*/ -test: say; do k=1 for point.0; say right(' ['arg(1)"] point:",30), - right(point.k.x', 'point.k.y, 9) " is ", - word('outside inside', in_out(k)+1) - end /*k*/ - return + call value @ || n'.X', Fx; call value @ || n".Y", Fy; call value @'0',n + return /*POLY.0 is # segments(sides).*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +test: say; do k=1 for point.0; w=wx+wy+2 + say right(' ['arg(1)"] point:", 30), + right( right(point.k.x, wx)', 'right(point.k.y, wy), w) " is ", + right( word('outside inside', in$out(k)+1), 7) + end /*k*/ + return diff --git a/Task/Ray-casting-algorithm/Scala/ray-casting-algorithm.scala b/Task/Ray-casting-algorithm/Scala/ray-casting-algorithm.scala index 8397fd1a45..0c2d12b6a7 100644 --- a/Task/Ray-casting-algorithm/Scala/ray-casting-algorithm.scala +++ b/Task/Ray-casting-algorithm/Scala/ray-casting-algorithm.scala @@ -1,46 +1,47 @@ -case class Figure(name: String, edges: ((Double, Double), (Double, Double))*) {} +package scala.ray_casting + +case class Edge(_1: (Double, Double), _2: (Double, Double)) { + import Math._ + import Double._ + + def raySegI(p: (Double, Double)): Boolean = { + if (_1._2 > _2._2) return Edge(_2, _1).raySegI(p) + if (p._2 == _1._2 || p._2 == _2._2) return raySegI((p._1, p._2 + epsilon)) + if (p._2 > _2._2 || p._2 < _1._2 || p._1 > max(_1._1, _2._1)) + return false + if (p._1 < min(_1._1, _2._1)) return true + val blue = if (abs(_1._1 - p._1) > MinValue) (p._2 - _1._2) / (p._1 - _1._1) else MaxValue + val red = if (abs(_1._1 - _2._1) > MinValue) (_2._2 - _1._2) / (_2._1 - _1._1) else MaxValue + blue >= red + } + + final val epsilon = 0.00001 +} + +case class Figure(name: String, edges: Seq[Edge]) { + def contains(p: (Double, Double)) = edges.count(_.raySegI(p)) % 2 != 0 +} object Ray_casting extends App { - import Math._ - import Double._ + val figures = Seq(Figure("Square", Seq(((0.0, 0.0), (10.0, 0.0)), ((10.0, 0.0), (10.0, 10.0)), + ((10.0, 10.0), (0.0, 10.0)),((0.0, 10.0), (0.0, 0.0)))), + Figure("Square hole", Seq(((0.0, 0.0), (10.0, 0.0)), ((10.0, 0.0), (10.0, 10.0)), + ((10.0, 10.0), (0.0, 10.0)), ((0.0, 10.0), (0.0, 0.0)), ((2.5, 2.5), (7.5, 2.5)), + ((7.5, 2.5), (7.5, 7.5)),((7.5, 7.5), (2.5, 7.5)), ((2.5, 7.5), (2.5, 2.5)))), + Figure("Strange", Seq(((0.0, 0.0), (2.5, 2.5)), ((2.5, 2.5), (0.0, 10.0)), + ((0.0, 10.0), (2.5, 7.5)), ((2.5, 7.5), (7.5, 7.5)), ((7.5, 7.5), (10.0, 10.0)), + ((10.0, 10.0), (10.0, 0.0)), ((10.0, 0.0), (2.5, 2.5)))), + Figure("Exagon", Seq(((3.0, 0.0), (7.0, 0.0)), ((7.0, 0.0), (10.0, 5.0)), ((10.0, 5.0), (7.0, 10.0)), + ((7.0, 10.0), (3.0, 10.0)), ((3.0, 10.0), (0.0, 5.0)), ((0.0, 5.0), (3.0, 0.0))))) - val figures = Array(Figure("Square", ((0.0, 0.0), (10.0, 0.0)), - ((10.0, 0.0), (10.0, 10.0)), ((10.0, 10.0), (0.0, 10.0)), - ((0.0, 10.0), (0.0, 0.0))), - Figure("Square hole", ((0.0, 0.0), (10.0, 0.0)), ((10.0, 0.0), (10.0, 10.0)), - ((10.0, 10.0), (0.0, 10.0)), ((0.0, 10.0), (0.0, 0.0)), - ((2.5, 2.5), (7.5, 2.5)), ((7.5, 2.5), (7.5, 7.5)), - ((7.5, 7.5), (2.5, 7.5)), ((2.5, 7.5), (2.5, 2.5))), - Figure("Strange", ((0.0, 0.0), (2.5, 2.5)), ((2.5, 2.5), (0.0, 10.0)), - ((0.0, 10.0), (2.5, 7.5)), ((2.5, 7.5), (7.5, 7.5)), - ((7.5, 7.5), (10.0, 10.0)), ((10.0, 10.0), (10.0, 0.0)), - ((10.0, 0), (2.5, 2.5))), - Figure("Exagon", ((3.0, 0.0), (7.0, 0.0)), ((7.0, 0.0), (10.0, 5.0)), - ((10.0, 5.0), (7.0, 10.0)), ((7.0, 10.0), (3.0, 10.0)), - ((3.0, 10.0), (0.0, 5.0)), ((0.0, 5.0), (3.0, 0.0)))) + val points = Seq((5.0, 5.0), (5.0, 8.0), (-10.0, 5.0), (0.0, 5.0), (10.0, 5.0), (8.0, 5.0), (10.0, 10.0)) - val points = Array((5.0, 5.0), (5.0, 8.0), (-10.0, 5.0), (0.0, 5.0), (10.0, 5.0), (8.0, 5.0), (10.0, 10.0)) + println("points: " + points) + for (f <- figures) { + println("figure: " + f.name) + println(" " + f.edges) + println("result: " + (points map f.contains)) + } - figures foreach { f => - println("Is point inside figure " + f.name + '?') - points foreach { p => println(" " + p + ": " + contains(f, p)) } - println - } - - private def raySegI(p: (Double, Double), e: ((Double, Double), (Double, Double))): Boolean = { - val epsilon = 0.00001 - if (e._1._2 > e._2._2) - return raySegI(p, (e._2, e._1)) - if (p._2 == e._1._2 || p._2 == e._2._2) - return raySegI((p._1, p._2 + epsilon), e) - if (p._2 > e._2._2 || p._2 < e._1._2 || p._1 > max(e._1._1, e._2._1)) - return false - if (p._1 < min(e._1._1, e._2._1)) - return true - val blue = if (abs(e._1._1 - p._1) > MinValue) (p._2 - e._1._2) / (p._1 - e._1._1) else MaxValue - val red = if (abs(e._1._1 - e._2._1) > MinValue) (e._2._2 - e._1._2) / (e._2._1 - e._1._1) else MaxValue - blue >= red - } - - private def contains(f: Figure, p: (Double, Double)) = f.edges.count(raySegI(p, _)) % 2 != 0 + private implicit def to_edge(p: ((Double, Double), (Double, Double))): Edge = Edge(p._1, p._2) } diff --git a/Task/Read-a-configuration-file/00DESCRIPTION b/Task/Read-a-configuration-file/00DESCRIPTION index 372a493762..ae216eaf54 100644 --- a/Task/Read-a-configuration-file/00DESCRIPTION +++ b/Task/Read-a-configuration-file/00DESCRIPTION @@ -46,3 +46,4 @@ We also have an option that contains multiple parameters. These may be stored in '''See also:''' * [[Update a configuration file]] +

    diff --git a/Task/Read-a-configuration-file/BASIC/read-a-configuration-file.basic b/Task/Read-a-configuration-file/BASIC/read-a-configuration-file.basic new file mode 100644 index 0000000000..d1c0f2549a --- /dev/null +++ b/Task/Read-a-configuration-file/BASIC/read-a-configuration-file.basic @@ -0,0 +1,253 @@ +' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' +' Read a Configuration File V1.0 ' +' ' +' Developed by A. David Garza Marín in VB-DOS for ' +' RosettaCode. December 2, 2016. ' +' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' + +OPTION EXPLICIT ' For VB-DOS, PDS 7.1 +' OPTION _EXPLICIT ' For QB64 + +' SUBs and FUNCTIONs +DECLARE FUNCTION ErrorMessage$ (WhichError AS INTEGER) +DECLARE FUNCTION YorN$ () +DECLARE FUNCTION FileExists% (WhichFile AS STRING) +DECLARE FUNCTION ReadConfFile% (NameOfConfFile AS STRING) +DECLARE FUNCTION getVariable$ (WhichVariable AS STRING) +DECLARE FUNCTION getArrayVariable$ (WhichVariable AS STRING, WhichIndex AS INTEGER) + +' Register for values located +TYPE regVarValue + VarName AS STRING * 20 + VarType AS INTEGER ' 1=String, 2=Integer, 3=Real + VarValue AS STRING * 30 +END TYPE + +' Var +DIM rVarValue() AS regVarValue, iErr AS INTEGER, i AS INTEGER, iHMV AS INTEGER +DIM otherfamily(1 TO 2) AS STRING +DIM fullname AS STRING, favouritefruit AS STRING, needspeeling AS INTEGER, seedsremoved AS INTEGER +CONST ConfFileName = "config.fil" + +' ------------------- Main Program ------------------------ +CLS +PRINT "This program reads a configuration file and shows the result." +PRINT +PRINT "Default file name: "; ConfFileName +PRINT +iErr = ReadConfFile(ConfFileName) +IF iErr = 0 THEN + iHMV = UBOUND(rVarValue) + PRINT "Variables found in file:" + FOR i = 1 TO iHMV + PRINT RTRIM$(rVarValue(i).VarName); " = "; RTRIM$(rVarValue(i).VarValue); " ("; + SELECT CASE rVarValue(i).VarType + CASE 0: PRINT "Undefined"; + CASE 1: PRINT "String"; + CASE 2: PRINT "Integer"; + CASE 3: PRINT "Real"; + END SELECT + PRINT ")" + NEXT i + PRINT + + ' Sets required variables + fullname = getVariable$("FullName") + favouritefruit = getVariable$("FavouriteFruit") + needspeeling = VAL(getVariable$("NeedSpeeling")) + seedsremoved = VAL(getVariable$("SeedsRemoved")) + FOR i = 1 TO 2 + otherfamily(i) = getArrayVariable$("OtherFamily", i) + NEXT i + PRINT "Variables requested to set values:" + PRINT "fullname = "; fullname + PRINT "favouritefruit = "; favouritefruit + PRINT "needspeeling = "; + IF needspeeling = 0 THEN PRINT "false" ELSE PRINT "true" + PRINT "seedsremoved = "; + IF seedsremoved = 0 THEN PRINT "false" ELSE PRINT "true" + FOR i = 1 TO 2 + PRINT "otherfamily("; i; ") = "; otherfamily(i) + NEXT i +ELSE + PRINT ErrorMessage$(iErr) +END IF +' --------- End of Main Program ----------------------- + +END + +FileError: + iErr = ERR +RESUME NEXT + +FUNCTION ErrorMessage$ (WhichError AS INTEGER) + ' Var + DIM sError AS STRING + + SELECT CASE WhichError + CASE 0: sError = "Everything went ok." + CASE 1: sError = "Configuration file doesn't exist." + CASE 2: sError = "There are no variables in the given file." + END SELECT + + ErrorMessage$ = sError +END FUNCTION + +FUNCTION FileExists% (WhichFile AS STRING) + ' Var + DIM iFile AS INTEGER + DIM iItExists AS INTEGER + SHARED iErr AS INTEGER + + ON ERROR GOTO FileError + iFile = FREEFILE + iErr = 0 + OPEN WhichFile FOR BINARY AS #iFile + IF iErr = 0 THEN + iItExists = LOF(iFile) > 0 + CLOSE #iFile + + IF NOT iItExists THEN + KILL WhichFile + END IF + END IF + ON ERROR GOTO 0 + FileExists% = iItExists + +END FUNCTION + +FUNCTION getArrayVariable$ (WhichVariable AS STRING, WhichIndex AS INTEGER) + ' Var + DIM i AS INTEGER, iHMV AS INTEGER, iCount AS INTEGER + DIM sVar AS STRING, sVal AS STRING, sWV AS STRING + SHARED rVarValue() AS regVarValue + + ' Looks for a variable name and returns its value + iHMV = UBOUND(rVarValue) + sWV = UCASE$(LTRIM$(RTRIM$(WhichVariable))) + sVal = "" + DO + i = i + 1 + sVar = UCASE$(RTRIM$(rVarValue(i).VarName)) + IF sVar = sWV THEN + iCount = iCount + 1 + IF iCount = WhichIndex THEN + sVal = LTRIM$(RTRIM$(rVarValue(i).VarValue)) + END IF + END IF + LOOP UNTIL i >= iHMV OR sVal <> "" + + ' Found it or not, it will return the result. + ' If the result is "" then it didn't found the requested variable. + getArrayVariable$ = sVal + +END FUNCTION + +FUNCTION getVariable$ (WhichVariable AS STRING) + ' Var + DIM i AS INTEGER, iHMV AS INTEGER + DIM sVal AS STRING + + ' For a single variable, looks in the first (and only) + ' element of the array that contains the name requested. + sVal = getArrayVariable$(WhichVariable, 1) + + getVariable$ = sVal +END FUNCTION + +FUNCTION ReadConfFile% (NameOfConfFile AS STRING) + ' Var + DIM iFile AS INTEGER, iType AS INTEGER, iVar AS INTEGER, iHMV AS INTEGER + DIM iVal AS INTEGER, iCurVar AS INTEGER, i AS INTEGER, iErr AS INTEGER + DIM dValue AS DOUBLE + DIM sLine AS STRING, sVar AS STRING, sValue AS STRING + SHARED rVarValue() AS regVarValue + + ' This procedure reads a configuration file with variables + ' and values separated by the equal sign (=) or a space. + ' It needs the FileExists% function. + ' Lines begining with # or blank will be ignored. + IF FileExists%(NameOfConfFile) THEN + iFile = FREEFILE + REDIM rVarValue(1 TO 10) AS regVarValue + OPEN NameOfConfFile FOR INPUT AS #iFile + WHILE NOT EOF(iFile) + LINE INPUT #iFile, sLine + sLine = RTRIM$(LTRIM$(sLine)) + IF LEN(sLine) > 0 THEN ' Does it have any content? + IF LEFT$(sLine, 1) <> "#" THEN ' Is not a comment? + IF LEFT$(sLine,1) = ";" THEN ' It is a commented variable + sLine = LTRIM$(MID$(sLine, 2)) + END IF + iVar = INSTR(sLine, "=") ' Is there an equal sign? + IF iVar = 0 THEN iVar = INSTR(sLine, " ") ' if not then is there a space? + + GOSUB AddASpaceForAVariable + iCurVar = iHMV + IF iVar > 0 THEN ' Is a variable and a value + rVarValue(iHMV).VarName = LEFT$(sLine, iVar - 1) + ELSE ' Is just a variable name + rVarValue(iHMV).VarName = sLine + rVarValue(iHMV).VarValue = "" + END IF + + IF iVar > 0 THEN ' Get the value(s) + sLine = LTRIM$(MID$(sLine, iVar + 1)) + DO ' Look for commas + iVal = INSTR(sLine, ",") + IF iVal > 0 THEN ' There is a comma + rVarValue(iHMV).VarValue = RTRIM$(LEFT$(sLine, iVal - 1)) + GOSUB AddASpaceForAVariable + rVarValue(iHMV).VarName = rVarValue(iHMV - 1).VarName ' Repeats the variable name + sLine = LTRIM$(MID$(sLine, iVal + 1)) + END IF + LOOP UNTIL iVal = 0 + rVarValue(iHMV).VarValue = sLine + + ' Determine the variable type of each variable found in this step + FOR i = iCurVar TO iHMV + GOSUB DetermineVariableType + NEXT i + END IF + END IF + END IF + WEND + CLOSE iFile + IF iHMV > 0 THEN + REDIM PRESERVE rVarValue(1 TO iHMV) AS regVarValue + iErr = 0 ' Everything ran ok. + ELSE + REDIM rVarValue(1 TO 1) AS regVarValue + iErr = 2 ' No variables found in configuration file + END IF + ELSE + iErr = 1 ' File doesn't exist + END IF + + ReadConfFile = iErr + +EXIT FUNCTION + +AddASpaceForAVariable: + iHMV = iHMV + 1 + + IF UBOUND(rVarValue) < iHMV THEN ' Are there space for a new one? + REDIM PRESERVE rVarValue(1 TO iHMV + 9) AS regVarValue + END IF +RETURN + +DetermineVariableType: + sValue = RTRIM$(rVarValue(i).VarValue) + IF ASC(LEFT$(sValue, 1)) < 48 OR ASC(LEFT$(sValue, 1)) > 57 THEN + rVarValue(i).VarType = 1 ' String + ELSE + dValue = VAL(sValue) + IF CLNG(dValue) = dValue THEN + rVarValue(i).VarType = 2 ' Integer + ELSE + rVarValue(i).VarType = 3 ' Real + END IF + END IF +RETURN + +END FUNCTION diff --git a/Task/Read-a-configuration-file/Elixir/read-a-configuration-file.elixir b/Task/Read-a-configuration-file/Elixir/read-a-configuration-file.elixir new file mode 100644 index 0000000000..d6d068646b --- /dev/null +++ b/Task/Read-a-configuration-file/Elixir/read-a-configuration-file.elixir @@ -0,0 +1,35 @@ +defmodule Configuration_file do + def read(file) do + File.read!(file) + |> String.split(~r/\n|\r\n|\r/, trim: true) + |> Enum.reject(fn line -> String.starts_with?(line, ["#", ";"]) end) + |> Enum.map(fn line -> + case String.split(line, ~r/\s/, parts: 2) do + [option] -> {to_atom(option), true} + [option, values] -> {to_atom(option), separate(values)} + end + end) + end + + def task do + defaults = [fullname: "Kalle", favouritefruit: "apple", needspeeling: false, seedsremoved: false] + options = read("configuration_file") ++ defaults + [:fullname, :favouritefruit, :needspeeling, :seedsremoved, :otherfamily] + |> Enum.each(fn x -> + values = options[x] + if is_boolean(values) or length(values)==1 do + IO.puts "#{x} = #{values}" + else + Enum.with_index(values) |> Enum.each(fn {value,i} -> + IO.puts "#{x}(#{i+1}) = #{value}" + end) + end + end) + end + + defp to_atom(option), do: String.downcase(option) |> String.to_atom + + defp separate(values), do: String.split(values, ",") |> Enum.map(&String.strip/1) +end + +Configuration_file.task diff --git a/Task/Read-a-configuration-file/Forth/read-a-configuration-file.fth b/Task/Read-a-configuration-file/Forth/read-a-configuration-file.fth new file mode 100644 index 0000000000..9cdc629c4b --- /dev/null +++ b/Task/Read-a-configuration-file/Forth/read-a-configuration-file.fth @@ -0,0 +1,42 @@ +\ declare the configuration variables in the FORTH app +FORTH DEFINITIONS + +32 CONSTANT $SIZE + +VARIABLE FULLNAME $SIZE ALLOT +VARIABLE FAVOURITEFRUIT $SIZE ALLOT +VARIABLE NEEDSPEELING +VARIABLE SEEDSREMOVED +VARIABLE OTHERFAMILY(1) $SIZE ALLOT +VARIABLE OTHERFAMILY(2) $SIZE ALLOT + +: -leading ( addr len -- addr' len' ) + begin over c@ bl = while 1 /string repeat ; \ remove leading blanks + +: trim ( addr len -- addr len) -leading -trailing ; \ remove blanks both ends + +\ create the config file interpreter ------- +VOCABULARY CONFIG \ create a namespace +CONFIG DEFINITIONS \ put things in the namespace +: SET ( addr --) true swap ! ; +: RESET ( addr --) false swap ! ; +: # ( -- ) 1 PARSE 2DROP ; \ parse line and throw away +: = ( addr --) 1 PARSE trim ROT PLACE ; \ string assignment operator +synonym ; # \ 2nd comment operator is simple + +FORTH DEFINITIONS +\ this command reads and interprets the config.txt file +: CONFIGURE ( -- ) CONFIG s" CONFIG.TXT" INCLUDED FORTH ; +\ config file interpreter ends ------ + +\ tools to validate the CONFIG interpreter +: $. ( str --) count type ; +: BOOL. ( ? --) @ IF ." ON" ELSE ." OFF" THEN ; + +: .CONFIG CR ." Fullname : " FULLNAME $. + CR ." Favourite fruit: " FAVOURITEFRUIT $. + CR ." Needs peeling : " NEEDSPEELING bool. + CR ." Seeds removed : " SEEDSREMOVED bool. + CR ." Family:" + CR otherfamily(1) $. + CR otherfamily(2) $. ; diff --git a/Task/Read-a-configuration-file/Perl-6/read-a-configuration-file.pl6 b/Task/Read-a-configuration-file/Perl-6/read-a-configuration-file.pl6 index df3a93bf4c..fe23f90c37 100644 --- a/Task/Read-a-configuration-file/Perl-6/read-a-configuration-file.pl6 +++ b/Task/Read-a-configuration-file/Perl-6/read-a-configuration-file.pl6 @@ -24,9 +24,9 @@ grammar ConfFile { token line:sym { ^^ [ ';' | '#' ] \N* } token line:sym { ^^ \h* $$ } - token line:sym {:i fullname» { $fullname = $[0].trim } } - token line:sym {:i favouritefruit» { $favouritefruit = $[0].trim } } - token line:sym {:i needspeeling» { $needspeeling = defined $[0] } } + token line:sym {:i fullname» { $fullname = $.trim } } + token line:sym {:i favouritefruit» { $favouritefruit = $.trim } } + token line:sym {:i needspeeling» { $needspeeling = defined $ } } token rest { \h* '='? (\N*) } token yes { :i \h* '='? \h* [ @@ -38,15 +38,13 @@ grammar ConfFile { } grammar MyConfFile is ConfFile { - token line:sym {:i otherfamily» { @otherfamily = $[0]».trim} } - token many { \h*'='? ([ \N ]*) ** ',' } + token line:sym {:i otherfamily» { @otherfamily = $.split(',')».trim } } } MyConfFile.parsefile('file.cfg'); -.perl.say for - :$fullname, - :$favouritefruit, - :$needspeeling, - :$seedsremoved, - :@otherfamily; +say "fullname: $fullname"; +say "favouritefruit: $favouritefruit"; +say "needspeeling: $needspeeling"; +say "seedsremoved: $seedsremoved"; +print "otherfamily: "; say @otherfamily.perl; diff --git a/Task/Read-a-configuration-file/PowerShell/read-a-configuration-file-1.psh b/Task/Read-a-configuration-file/PowerShell/read-a-configuration-file-1.psh new file mode 100644 index 0000000000..c8aa9d1380 --- /dev/null +++ b/Task/Read-a-configuration-file/PowerShell/read-a-configuration-file-1.psh @@ -0,0 +1,68 @@ +function Read-ConfigurationFile +{ + [CmdletBinding()] + Param + ( + # Path to the configuration file. Default is "C:\ConfigurationFile.cfg" + [Parameter(Mandatory=$false, Position=0)] + [string] + $Path = "C:\ConfigurationFile.cfg" + ) + + [string]$script:fullName = "" + [string]$script:favouriteFruit = "" + [bool]$script:needsPeeling = $false + [bool]$script:seedsRemoved = $false + [string[]]$script:otherFamily = @() + + function Get-Value ([string]$Line) + { + if ($Line -match "=") + { + [string]$value = $Line.Split("=",2).Trim()[1] + } + elseif ($Line -match " ") + { + [string]$value = $Line.Split(" ",2).Trim()[1] + } + + $value + } + + # Process each line in file that is not a comment. + Get-Content $Path | Select-String -Pattern "^[^#;]" | ForEach-Object { + + [string]$line = $_.Line.Trim() + + if ($line -eq [String]::Empty) + { + # do nothing for empty lines + } + elseif ($line.ToUpper().StartsWith("FULLNAME")) + { + $script:fullName = Get-Value $line + } + elseif ($line.ToUpper().StartsWith("FAVOURITEFRUIT")) + { + $script:favouriteFruit = Get-Value $line + } + elseif ($line.ToUpper().StartsWith("NEEDSPEELING")) + { + $script:needsPeeling = $true + } + elseif ($line.ToUpper().StartsWith("SEEDSREMOVED")) + { + $script:seedsRemoved = $true + } + elseif ($line.ToUpper().StartsWith("OTHERFAMILY")) + { + $script:otherFamily = (Get-Value $line).Split(',').Trim() + } + } + + Write-Verbose -Message ("{0,-15}= {1}" -f "FULLNAME", $script:fullName) + Write-Verbose -Message ("{0,-15}= {1}" -f "FAVOURITEFRUIT", $script:favouriteFruit) + Write-Verbose -Message ("{0,-15}= {1}" -f "NEEDSPEELING", $script:needsPeeling) + Write-Verbose -Message ("{0,-15}= {1}" -f "SEEDSREMOVED", $script:seedsRemoved) + Write-Verbose -Message ("{0,-15}= {1}" -f "OTHERFAMILY", ($script:otherFamily -join ", ")) +} diff --git a/Task/Read-a-configuration-file/PowerShell/read-a-configuration-file-2.psh b/Task/Read-a-configuration-file/PowerShell/read-a-configuration-file-2.psh new file mode 100644 index 0000000000..2ebf1c7386 --- /dev/null +++ b/Task/Read-a-configuration-file/PowerShell/read-a-configuration-file-2.psh @@ -0,0 +1 @@ +Read-ConfigurationFile -Path .\temp.txt -Verbose diff --git a/Task/Read-a-configuration-file/PowerShell/read-a-configuration-file-3.psh b/Task/Read-a-configuration-file/PowerShell/read-a-configuration-file-3.psh new file mode 100644 index 0000000000..c85fa0533e --- /dev/null +++ b/Task/Read-a-configuration-file/PowerShell/read-a-configuration-file-3.psh @@ -0,0 +1 @@ +Get-Variable -Name fullName, favouriteFruit, needsPeeling, seedsRemoved, otherFamily diff --git a/Task/Read-a-configuration-file/REXX/read-a-configuration-file.rexx b/Task/Read-a-configuration-file/REXX/read-a-configuration-file.rexx index 5dbb535ec1..885107a975 100644 --- a/Task/Read-a-configuration-file/REXX/read-a-configuration-file.rexx +++ b/Task/Read-a-configuration-file/REXX/read-a-configuration-file.rexx @@ -1,47 +1,46 @@ -/*REXX program to read a config file and assign VARs as found within. */ -signal on syntax; signal on novalue /*handle REXX program errors. */ -parse arg cFID _ . /*cFID = config file to be read. */ -if cFID=='' then cFID='CONFIG.DAT' /*Not specified? Use the default*/ -bad= /*this will contain all bad VARs.*/ -varList= /*this will contain all the VARs.*/ -maxLenV=0; blanks=0; hashes=0; semics=0; badVar=0 /*zero 'em.*/ +/*REXX program reads a config (configuration) file and assigns VARs as found within. */ +signal on syntax; signal on novalue /*handle REXX source program errors. */ +parse arg cFID _ . /*cFID: is the CONFIG file to be read.*/ +if cFID=='' then cFID='CONFIG.DAT' /*Not specified? Then use the default.*/ +bad= /*this will contain all the bad VARs. */ +varList= /* " " " " " good " */ +maxLenV=0; blanks=0; hashes=0; semics=0; badVar=0 /*zero all these variables.*/ - do j=0 while lines(cFID)\==0 /*J count's the file's lines. */ - txt=strip(linein(cFID)) /*read a line (record) from file,*/ - /*& strip leading/trailing blanks*/ - if txt ='' then do; blanks=blanks+1; iterate; end - if left(txt,1)=='#' then do; hashes=hashes+1; iterate; end - if left(txt,1)==';' then do; semics=semics+1; iterate; end - eqS=pos('=',txt) /*can't use the TRANSLATE bif. */ - if eqS\==0 then txt=overlay(' ',txt,eqS) /*replace 1st '=' with blank*/ - parse var txt xxx value; upper xxx /*get the variableName and value.*/ - value=strip(value) /*strip leading & trailing blanks*/ - if value='' then value='true' /*if no value, then use "true". */ - if symbol(xxx)=='BAD' then do /*can REXX use the variable name?*/ - badVar=badVar+1; bad=bad xxx; iterate + do j=0 while lines(cFID)\==0 /*J: it counts the lines in the file.*/ + txt=strip(linein(cFID)) /*read a line (record) from the file, */ + /* ··· & strip leading/trailing blanks*/ + if txt ='' then do; blanks=blanks+1; iterate; end /*count # blank lines.*/ + if left(txt,1)=='#' then do; hashes=hashes+1; iterate; end /* " " lines with #*/ + if left(txt,1)==';' then do; semics=semics+1; iterate; end /* " " " " ;*/ + eqS=pos('=',txt) /*we can't use the TRANSLATE BIF. */ + if eqS\==0 then txt=overlay(' ',txt,eqS) /*replace the first '=' with a blank.*/ + parse var txt xxx value; upper xxx /*get the variable name and it's value.*/ + value=strip(value) /*strip leading and trailing blanks. */ + if value='' then value='true' /*if no value, then use "true". */ + if symbol(xxx)=='BAD' then do /*can REXX utilize the variable name ? */ + badVar=badVar+1; bad=bad xxx; iterate /*append to list*/ end - varList=varList xxx /*add it to the list of variables*/ - call value xxx,value /*now, use VALUE to set the var. */ - maxLenV=max(maxLenV,length(value)) /*maxLen of varNames, pretty disp*/ + varList=varList xxx /*add it to the list of good variables.*/ + call value xxx,value /*now, use VALUE to set the variable. */ + maxLenV=max(maxLenV,length(value)) /*maxLen of varNames, pretty display. */ end /*j*/ -vars=words(varList) - say #(j) 'record's(j) "were read from file: " cFID -if blanks\==0 then say #(blanks) 'blank record's(blanks) "were read." -if hashes\==0 then say #(hashes) 'record's(hashes) "ignored that began with a # (hash)." -if semics\==0 then say #(semics) 'record's(semics) "ignored that began with a ; (semicolon)." -if badVar\==0 then say #(badVar) 'bad variable name's(badVar) 'detected:' bad -say; say 'The list of' vars "variable"s(vars) 'and' s(vars,'their',"it's") "value"s(vars) 'follows:'; say - - do k=1 for vars +vars=words(varList); @ig= 'ignored that began with a' + say #(j) 'record's(j) "were read from file: " cFID +if blanks\==0 then say #(blanks) 'blank record's(blanks) "were read." +if hashes\==0 then say #(hashes) 'record's(hashes) @ig "# (hash)." +if semics\==0 then say #(semics) 'record's(semics) @ig "; (semicolon)." +if badVar\==0 then say #(badVar) 'bad variable name's(badVar) 'detected:' bad +say; say 'The list of' vars "variable"s(vars) 'and' s(vars,'their',"it's"), + "value"s(vars) 'follows:' +say; do k=1 for vars v=word(varList,k) say right(v,maxLenV) '=' value(v) end /*k*/ -exit /*stick a fork in it, we're done.*/ -/*───────────────────────────────error handling subroutines and others.─*/ -s: if arg(1)==1 then return arg(3); return word(arg(2) 's',1) -#: return right(arg(1),length(j)+11) /*right justify a number +indent*/ -err: say; say; say center(' error! ', max(40, linesize()%2), "*"); say - do j=1 for arg(); say arg(j); say; end; say; exit 13 +say; exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +s: if arg(1)==1 then return arg(3); return word(arg(2) 's',1) +#: return right(arg(1),length(j)+11) /*right justify a number & also indent.*/ +err: do j=1 for arg(); say '***error*** ' arg(j); say; end /*j*/; exit 13 novalue: syntax: call err 'REXX program' condition('C') "error",, condition('D'),'REXX source statement (line' sigl"):",sourceline(sigl) diff --git a/Task/Read-a-file-line-by-line/00DESCRIPTION b/Task/Read-a-file-line-by-line/00DESCRIPTION index f27e42992e..31ce53bf59 100644 --- a/Task/Read-a-file-line-by-line/00DESCRIPTION +++ b/Task/Read-a-file-line-by-line/00DESCRIPTION @@ -8,6 +8,8 @@ Read a file one line at a time, as opposed to [[Read entire file|reading the entire file at once]]. -;See also + +;Related tasks: * [[Read a file character by character]] * [[Input loop]]. +

    diff --git a/Task/Read-a-file-line-by-line/360-Assembly/read-a-file-line-by-line.360 b/Task/Read-a-file-line-by-line/360-Assembly/read-a-file-line-by-line.360 new file mode 100644 index 0000000000..4188ae7f96 --- /dev/null +++ b/Task/Read-a-file-line-by-line/360-Assembly/read-a-file-line-by-line.360 @@ -0,0 +1,33 @@ +* Read a file line by line 12/06/2016 +READFILE CSECT + SAVE (14,12) save registers on entry + PRINT NOGEN + BALR R12,0 establish addressability + USING *,R12 set base register + ST R13,SAVEA+4 link mySA->prevSA + LA R11,SAVEA mySA + ST R11,8(R13) link prevSA->mySA + LR R13,R11 set mySA pointer + OPEN (INDCB,INPUT) open the input file + OPEN (OUTDCB,OUTPUT) open the output file +LOOP GET INDCB,PG read record + CLI EOFFLAG,C'Y' eof reached? + BE EOF + PUT OUTDCB,PG write record + B LOOP +EOF CLOSE (INDCB) close input + CLOSE (OUTDCB) close output + L R13,SAVEA+4 previous save area addrs + RETURN (14,12),RC=0 return to caller with rc=0 +INEOF CNOP 0,4 end-of-data routine + MVI EOFFLAG,C'Y' set the end-of-file flag + BR R14 return to caller +SAVEA DS 18F save area for chaining +INDCB DCB DSORG=PS,MACRF=PM,DDNAME=INDD,LRECL=80, * + RECFM=FB,EODAD=INEOF +OUTDCB DCB DSORG=PS,MACRF=PM,DDNAME=OUTDD,LRECL=80, * + RECFM=FB +EOFFLAG DC C'N' end-of-file flag +PG DS CL80 buffer + YREGS + END READFILE diff --git a/Task/Read-a-file-line-by-line/Ada/read-a-file-line-by-line.ada b/Task/Read-a-file-line-by-line/Ada/read-a-file-line-by-line.ada index bacabd1df0..ad07b813ee 100644 --- a/Task/Read-a-file-line-by-line/Ada/read-a-file-line-by-line.ada +++ b/Task/Read-a-file-line-by-line/Ada/read-a-file-line-by-line.ada @@ -1,19 +1,15 @@ -with Ada.Text_IO; +with Ada.Text_IO; use Ada.Text_IO; + procedure Line_By_Line is - Filename : String := "line_by_line.adb"; - File : Ada.Text_IO.File_Type; - Line_Count : Natural := 0; + File : File_Type; begin - Ada.Text_IO.Open (File => File, - Mode => Ada.Text_IO.In_File, - Name => Filename); - while not Ada.Text_IO.End_Of_File (File) loop - declare - Line : String := Ada.Text_IO.Get_Line (File); - begin - Line_Count := Line_Count + 1; - Ada.Text_IO.Put_Line (Natural'Image (Line_Count) & ": " & Line); - end; + Open (File => File, + Mode => In_File, + Name => "line_by_line.adb"); + loop + exit when End_Of_File (File); + Put_Line (Get_Line (File)); end loop; - Ada.Text_IO.Close (File); + + Close (File); end Line_By_Line; diff --git a/Task/Read-a-file-line-by-line/Elena/read-a-file-line-by-line.elena b/Task/Read-a-file-line-by-line/Elena/read-a-file-line-by-line.elena new file mode 100644 index 0000000000..9f9871c8e9 --- /dev/null +++ b/Task/Read-a-file-line-by-line/Elena/read-a-file-line-by-line.elena @@ -0,0 +1,9 @@ +#import system. +#import system'io. +#import extensions. +#import extensions'routines. + +#symbol program = +[ + "file.txt" file_path run &eachLine:printingLn. +]. diff --git a/Task/Read-a-file-line-by-line/Fortran/read-a-file-line-by-line.f b/Task/Read-a-file-line-by-line/Fortran/read-a-file-line-by-line.f new file mode 100644 index 0000000000..d1f75b19b2 --- /dev/null +++ b/Task/Read-a-file-line-by-line/Fortran/read-a-file-line-by-line.f @@ -0,0 +1,30 @@ + INTEGER ENUFF !A value has to be specified beforehand,. + PARAMETER (ENUFF = 2468) !Provide some provenance. + CHARACTER*(ENUFF) ALINE !A perfect size? + CHARACTER*66 FNAME !What about file name sizes? + INTEGER LINPR,IN !I/O unit numbers. + INTEGER L,N !A length, and a record counter. + LOGICAL EXIST !This can't be asked for in an "OPEN" statement. + LINPR = 6 !Standard output via this unit number. + IN = 10 !Some unit number for the input file. + FNAME = "Read.for" !Choose a file name. + INQUIRE (FILE = FNAME, EXIST = EXIST) !A basic question. + IF (.NOT.EXIST) THEN !Absent? + WRITE (LINPR,1) FNAME !Alas, name the absentee. + 1 FORMAT ("No sign of file ",A) !The name might be mistyped. + STOP "No file, no go." !Give up. + END IF !So much for the most obvious mishap. + OPEN (IN,FILE = FNAME, STATUS = "OLD", ACTION = "READ") !For formatted input. + + N = 0 !No records read so far. + 10 READ (IN,11,END = 20) L,ALINE(1:MIN(L,ENUFF)) !Read only the L characters in the record, up to ENUFF. + 11 FORMAT (Q,A) !Q = "how many characters yet to be read", A = characters with no limit. + N = N + 1 !A record has been read. + IF (L.GT.ENUFF) WRITE (LINPR,12) N,L,ENUFF !Was it longer than ALINE could accommodate? + 12 FORMAT ("Record ",I0," has length ",I0,": my limit is ",I0) !Yes. Explain. + WRITE (LINPR,13) N,ALINE(1:MIN(L,ENUFF)) !Print the record, prefixed by the count. + 13 FORMAT (I9,":",A) !Fixed number size for alignment. + GO TO 10 !Do it again. + + 20 CLOSE (IN) !All done. + END !That's all. diff --git a/Task/Read-a-file-line-by-line/JavaScript/read-a-file-line-by-line.js b/Task/Read-a-file-line-by-line/JavaScript/read-a-file-line-by-line.js new file mode 100644 index 0000000000..c5f9005561 --- /dev/null +++ b/Task/Read-a-file-line-by-line/JavaScript/read-a-file-line-by-line.js @@ -0,0 +1,7 @@ +var fs = require("fs"); + +var readFile = function(path) { + return fs.readFileSync(path).toString(); +}; + +console.log(readFile('file.txt')); diff --git a/Task/Read-a-file-line-by-line/Mercury/read-a-file-line-by-line-1.mercury b/Task/Read-a-file-line-by-line/Mercury/read-a-file-line-by-line-1.mercury new file mode 100644 index 0000000000..37b7109129 --- /dev/null +++ b/Task/Read-a-file-line-by-line/Mercury/read-a-file-line-by-line-1.mercury @@ -0,0 +1,39 @@ +:- module read_a_file_line_by_line. +:- interface. + +:- import_module io. + +:- pred main(io::di, io::uo) is det. + +:- implementation. + +:- import_module int, list, require, string. + +main(!IO) :- + io.open_input("test.txt", OpenResult, !IO), + ( + OpenResult = ok(File), + read_file_line_by_line(File, 0, !IO) + ; + OpenResult = error(Error), + error(io.error_message(Error)) + ). + +:- pred read_file_line_by_line(io.text_input_stream::in, int::in, + io::di, io::uo) is det. + +read_file_line_by_line(File, !.LineCount, !IO) :- + % We could also use io.read_line/3 which returns a list of characters + % instead of a string. + io.read_line_as_string(File, ReadLineResult, !IO), + ( + ReadLineResult = ok(Line), + !:LineCount = !.LineCount + 1, + io.format("%d: %s", [i(!.LineCount), s(Line)], !IO), + read_file_line_by_line(File, !.LineCount, !IO) + ; + ReadLineResult = eof + ; + ReadLineResult = error(Error), + error(io.error_message(Error)) + ). diff --git a/Task/Read-a-file-line-by-line/Mercury/read-a-file-line-by-line-2.mercury b/Task/Read-a-file-line-by-line/Mercury/read-a-file-line-by-line-2.mercury new file mode 100644 index 0000000000..28caf2da18 --- /dev/null +++ b/Task/Read-a-file-line-by-line/Mercury/read-a-file-line-by-line-2.mercury @@ -0,0 +1,32 @@ +:- module read_a_file_line_by_line. +:- interface. + +:- import_module io. + +:- pred main(io::di, io::uo) is det. + +:- implementation. + +:- import_module int, list, require, string, stream. + +main(!IO) :- + io.open_input("test.txt", OpenResult, !IO), + ( + OpenResult = ok(File), + stream.input_stream_fold2_state(File, process_line, 0, Result, !IO), + ( + Result = ok(_) + ; + Result = error(_, Error), + error(io.error_message(Error)) + ) + ; + OpenResult = error(Error), + error(io.error_message(Error)) + ). + +:- pred process_line(line::in, int::in, int::out, io::di, io::uo) is det. + +process_line(line(Line), !LineCount, !IO) :- + !:LineCount = !.LineCount + 1, + io.format("%d: %s", [i(!.LineCount), s(Line)], !IO). diff --git a/Task/Read-a-file-line-by-line/Pascal/read-a-file-line-by-line.pascal b/Task/Read-a-file-line-by-line/Pascal/read-a-file-line-by-line.pascal new file mode 100644 index 0000000000..4cc690ff6c --- /dev/null +++ b/Task/Read-a-file-line-by-line/Pascal/read-a-file-line-by-line.pascal @@ -0,0 +1,19 @@ +(* Read a file line by line *) + program ReadFileByLine; + var + InputFile,OutputFile: File; + TextLine: String; + begin + Assign(InputFile, 'c:\testin.txt'); + Reset(InputFile); + Assign(InputFile, 'c:\testout.txt'); + Rewrite(InputFile); + while not Eof(InputFile) do + begin + ReadLn(InputFile, TextLine); + (* do someting with TextLine *) + WriteLn(OutputFile, TextLine) + end; + Close(InputFile); + Close(OutputFile) + end. diff --git a/Task/Read-a-file-line-by-line/Racket/read-a-file-line-by-line.rkt b/Task/Read-a-file-line-by-line/Racket/read-a-file-line-by-line-1.rkt similarity index 83% rename from Task/Read-a-file-line-by-line/Racket/read-a-file-line-by-line.rkt rename to Task/Read-a-file-line-by-line/Racket/read-a-file-line-by-line-1.rkt index 70bde965e6..5cee608f96 100644 --- a/Task/Read-a-file-line-by-line/Racket/read-a-file-line-by-line.rkt +++ b/Task/Read-a-file-line-by-line/Racket/read-a-file-line-by-line-1.rkt @@ -1,5 +1,5 @@ (define (read-next-line-iter file) - (let ((line (read-line file))) + (let ((line (read-line file 'any))) (unless (eof-object? line) (display line) (newline) diff --git a/Task/Read-a-file-line-by-line/Racket/read-a-file-line-by-line-2.rkt b/Task/Read-a-file-line-by-line/Racket/read-a-file-line-by-line-2.rkt new file mode 100644 index 0000000000..89aad960bd --- /dev/null +++ b/Task/Read-a-file-line-by-line/Racket/read-a-file-line-by-line-2.rkt @@ -0,0 +1,4 @@ +(define in (open-input-file file-name)) +(for ([line (in-lines in)]) + (displayln line)) +(close-input-port in) diff --git a/Task/Read-a-file-line-by-line/VBA/read-a-file-line-by-line.vba b/Task/Read-a-file-line-by-line/VBA/read-a-file-line-by-line.vba new file mode 100644 index 0000000000..38455bf13d --- /dev/null +++ b/Task/Read-a-file-line-by-line/VBA/read-a-file-line-by-line.vba @@ -0,0 +1,16 @@ +' Read a file line by line +Sub Main() + Dim fInput As String, fOutput As String 'File names + Dim sInput As String, sOutput As String 'Lines + fInput = "input.txt" + fOutput = "output.txt" + Open fInput For Input As #1 + Open fOutput For Output As #2 + While Not EOF(1) + Line Input #1, sInput + sOutput = Process(sInput) 'do something + Print #2, sOutput + Wend + Close #1 + Close #2 +End Sub 'Main diff --git a/Task/Read-a-file-line-by-line/Visual-Basic/read-a-file-line-by-line-1.vb b/Task/Read-a-file-line-by-line/Visual-Basic/read-a-file-line-by-line-1.vb new file mode 100644 index 0000000000..2c4958893c --- /dev/null +++ b/Task/Read-a-file-line-by-line/Visual-Basic/read-a-file-line-by-line-1.vb @@ -0,0 +1,24 @@ +' Read a file line by line +Sub Main() + Dim fInput As String, fOutput As String 'File names + Dim sInput As String, sOutput As String 'Lines + Dim nRecord As Long + fInput = "input.txt" + fOutput = "output.txt" + On Error GoTo InputError + Open fInput For Input As #1 + On Error GoTo 0 'reset error handling + Open fOutput For Output As #2 + nRecord = 0 + While Not EOF(1) + Line Input #1, sInput + sOutput = Process(sInput) 'do something + nRecord = nRecord + 1 + Print #2, sOutput + Wend + Close #1 + Close #2 + Exit Sub +InputError: + MsgBox "File: " & fInput & " not found" +End Sub 'Main diff --git a/Task/Read-a-file-line-by-line/Visual-Basic/read-a-file-line-by-line.vb b/Task/Read-a-file-line-by-line/Visual-Basic/read-a-file-line-by-line-2.vb similarity index 100% rename from Task/Read-a-file-line-by-line/Visual-Basic/read-a-file-line-by-line.vb rename to Task/Read-a-file-line-by-line/Visual-Basic/read-a-file-line-by-line-2.vb diff --git a/Task/Read-a-specific-line-from-a-file/00DESCRIPTION b/Task/Read-a-specific-line-from-a-file/00DESCRIPTION index 0e4fc1bf49..6adca9170a 100644 --- a/Task/Read-a-specific-line-from-a-file/00DESCRIPTION +++ b/Task/Read-a-specific-line-from-a-file/00DESCRIPTION @@ -1,2 +1,8 @@ Some languages have special semantics for obtaining a known line number from a file. -The task is to demonstrate how to obtain the contents of a specific line within a file. For the purpose of this task demonstrate how the contents of the seventh line of a file can be obtained, and store it in a variable or in memory (for potential future use within the program if the code were to become embedded). If the file does not contain seven lines, or the seventh line is empty, or too big to be retrieved, output an appropriate message. If no special semantics are available for obtaining the required line, it is permissible to read line by line. Note that empty lines are considered and should still be counted. Note that for functional languages or languages without variables or storage, it is permissible to output the extracted data to standard output. + + +;Task: +Demonstrate how to obtain the contents of a specific line within a file. + +For the purpose of this task demonstrate how the contents of the seventh line of a file can be obtained, and store it in a variable or in memory (for potential future use within the program if the code were to become embedded). If the file does not contain seven lines, or the seventh line is empty, or too big to be retrieved, output an appropriate message. If no special semantics are available for obtaining the required line, it is permissible to read line by line. Note that empty lines are considered and should still be counted. Note that for functional languages or languages without variables or storage, it is permissible to output the extracted data to standard output. +

    diff --git a/Task/Read-a-specific-line-from-a-file/Ada/read-a-specific-line-from-a-file.ada b/Task/Read-a-specific-line-from-a-file/Ada/read-a-specific-line-from-a-file.ada index 1130889680..3fe11115de 100644 --- a/Task/Read-a-specific-line-from-a-file/Ada/read-a-specific-line-from-a-file.ada +++ b/Task/Read-a-specific-line-from-a-file/Ada/read-a-specific-line-from-a-file.ada @@ -1,38 +1,15 @@ -with Ada.Command_Line, - Ada.Text_IO; +with Ada.Text_IO; use Ada.Text_IO; procedure Rosetta_Read is - use Ada.Command_Line, Ada.Text_IO; - - Source : File_Type; + File : File_Type; begin - - if Argument_Count /= 1 then - Put_Line (File => Standard_Error, - Item => "Usage: " & Command_Name & " file_name"); - Set_Exit_Status (Failure); - return; - end if; + Open (File => File, + Mode => In_File, + Name => "rosetta_read.adb"); + Set_Line (File, To => 7); declare - File_Name : String renames Argument (Number => 1); - begin - Open (File => Source, - Mode => In_File, - Name => File_Name); - exception - when others => - Put_Line (File => Standard_Error, - Item => "Can not open '" & File_Name & "'."); - Set_Exit_Status (Failure); - return; - end; - - Set_Line (File => Source, - To => 7); - - declare - Line_7 : constant String := Get_Line (File => Source); + Line_7 : constant String := Get_Line (File); begin if Line_7'Length = 0 then Put_Line ("Line 7 is empty."); @@ -40,15 +17,13 @@ begin Put_Line (Line_7); end if; end; + + Close (File); exception when End_Error => - Put_Line (File => Standard_Error, - Item => "The file contains fewer than 7 lines."); - Set_Exit_Status (Failure); - return; + Put_Line ("The file contains fewer than 7 lines."); + Close (File); when Storage_Error => - Put_Line (File => Standard_Error, - Item => "Line 7 is too long to load."); - Set_Exit_Status (Failure); - return; + Put_Line ("Line 7 is too long to load."); + Close (File); end Rosetta_Read; diff --git a/Task/Read-a-specific-line-from-a-file/Fortran/read-a-specific-line-from-a-file-1.f b/Task/Read-a-specific-line-from-a-file/Fortran/read-a-specific-line-from-a-file-1.f new file mode 100644 index 0000000000..8277ff5457 --- /dev/null +++ b/Task/Read-a-specific-line-from-a-file/Fortran/read-a-specific-line-from-a-file-1.f @@ -0,0 +1,67 @@ + MODULE SAMPLER !To sample a record from a file. SAM00100 + CONTAINS SAM00200 + CHARACTER*20 FUNCTION GETREC(N,F,IS) !Returns a status. SAM00300 +Careful. Some compilers get confused over the function name's usage. SAM00400 + INTEGER N !The desired record number. SAM00500 + INTEGER F !Of this file. SAM00600 + CHARACTER*(*) IS !Stashed here. SAM00700 + INTEGER I,L !Assistants. SAM00800 + IS = "" !Clear previous content, even if null...SAM00900 + IF (N.LE.0) THEN !Start on errors. SAM01000 + WRITE (GETREC,1) "!No record",N !Could never be found. SAM01100 + 1 FORMAT (A,1X,I0) !Message, number. SAM01200 + ELSE IF (F.LE.0) THEN !Obviously wrong? SAM01300 + WRITE (GETREC,1) "!No unit number",F!Positive is valid. SAM01400 + ELSE IF (LEN(IS).LE.0) THEN !Space awaits? SAM01500 + WRITE (GETREC,1) "!String size",LEN(IS) !Nope. SAM01600 + ELSE !Otherwise, there is hope. SAM01700 + REWIND (F) !Clarify the file position. SAM01800 + DO I = 1,N - 1 !Grind up to the desired record. SAM01900 + READ (F,2,END=3) !Ignoring any content. SAM02000 + END DO !Are we there yet? SAM02100 + READ (F,2,END = 3) L,IS(1:MIN(L,LEN(IS))) !At last. SAM02200 + 2 FORMAT (Q,A) !Q = characters yet unread. SAM02300 + IF (L.LT.LEN(IS)) IS(L + 1:) = "" !Clear the tail. SAM02400 + IF (L.GT.LEN(IS)) THEN !Now for more silliness.SAM02500 + WRITE (GETREC,1) "+Length",L !Too long to fit in IS. SAM02600 + ELSE IF (L.LE.0) THEN !A zero-length record SAM02700 + WRITE (GETREC,1) "+Null" !Is not the same SAM02800 + ELSE IF (IS.EQ."") THEN !As a record SAM02900 + WRITE (GETREC,1) "+Blank",L !Containing spaces. SAM03000 + ELSE !But otherwise, SAM03100 + WRITE (GETREC,1) " Length",L !Note the leading space.SAM03200 + END IF !Righto, we've decided. SAM03300 + END IF !And, no more options. SAM03400 + RETURN !So, done. SAM03500 + 3 WRITE (GETREC,1) "!End on read",I !An alternative ending. SAM03600 + END FUNCTION GETREC !That was interesting. SAM03700 + END MODULE SAMPLER !Just a sample of possibility. SAM03800 + SAM03900 + PROGRAM POKE POK00100 + USE SAMPLER POK00200 + INTEGER ENUFF !Some sizes. POK00300 + PARAMETER (ENUFF = 666) !Sufficient? POK00400 + CHARACTER*(ENUFF) STUFF !Lots of memory these days. POK00500 + CHARACTER*20 RESULT POK00600 + INTEGER MSG,F !I/O unit numbers. POK00700 + MSG = 6 !Standard output. POK00800 + F = 10 !Chooose a unit number. POK00900 + WRITE (MSG,*) " To select record 7 from a disc file." POK01000 + POK01100 + WRITE (MSG,*) "As a FORMATTED file." POK01200 + OPEN (F,FILE="FileSlurpN.for",STATUS="OLD",ACTION="READ") POK01300 + RESULT = GETREC(7,F,STUFF) POK01400 + WRITE (MSG,1) "Result",RESULT POK01500 + WRITE (MSG,1) "Record",STUFF POK01600 + 1 FORMAT (A,":",A) POK01700 + POK01800 + CLOSE (F) POK01900 + WRITE (MSG,*) "As a random-access unformatted file." POK02000 + OPEN (F,FILE="FileSlurpN.for",STATUS="OLD",ACTION="READ", POK02100 + 1 ACCESS="DIRECT",FORM="UNFORMATTED",RECL=82) !Not 80! POK02200 + STUFF = "Cleared." POK02300 + READ (F,REC = 7,ERR = 666) STUFF(1:80) POK02400 + WRITE (MSG,1) "Record",STUFF(1:80) POK02500 + STOP POK02600 + 666 WRITE (MSG,*) "Can't get the record!" POK02700 + END !That was easy. POK02800 diff --git a/Task/Read-a-specific-line-from-a-file/Fortran/read-a-specific-line-from-a-file-2.f b/Task/Read-a-specific-line-from-a-file/Fortran/read-a-specific-line-from-a-file-2.f new file mode 100644 index 0000000000..ca88e7ac7f --- /dev/null +++ b/Task/Read-a-specific-line-from-a-file/Fortran/read-a-specific-line-from-a-file-2.f @@ -0,0 +1 @@ +READ (F'7) STUFF(1:80) diff --git a/Task/Read-a-specific-line-from-a-file/Fortran/read-a-specific-line-from-a-file-3.f b/Task/Read-a-specific-line-from-a-file/Fortran/read-a-specific-line-from-a-file-3.f new file mode 100644 index 0000000000..769c8555c0 --- /dev/null +++ b/Task/Read-a-specific-line-from-a-file/Fortran/read-a-specific-line-from-a-file-3.f @@ -0,0 +1,6 @@ + READ (F,REC = 7,ERR = 666, IOSTAT = IOSTAT) STUFF(1:80) + 666 IF (IOSTAT.NE.0) THEN + WRITE (MSG,*) "Can't get the record: code",IOSTAT + ELSE + WRITE (MSG,1) "Record",STUFF(1:80) + END IF diff --git a/Task/Read-a-specific-line-from-a-file/REBOL/read-a-specific-line-from-a-file.rebol b/Task/Read-a-specific-line-from-a-file/REBOL/read-a-specific-line-from-a-file.rebol new file mode 100644 index 0000000000..22915a7820 --- /dev/null +++ b/Task/Read-a-specific-line-from-a-file/REBOL/read-a-specific-line-from-a-file.rebol @@ -0,0 +1,2 @@ +x: pick read/lines request-file/only 7 +either x [print x] [print "No seventh line"] diff --git a/Task/Read-a-specific-line-from-a-file/REXX/read-a-specific-line-from-a-file-1.rexx b/Task/Read-a-specific-line-from-a-file/REXX/read-a-specific-line-from-a-file-1.rexx new file mode 100644 index 0000000000..f30bd0aea0 --- /dev/null +++ b/Task/Read-a-specific-line-from-a-file/REXX/read-a-specific-line-from-a-file-1.rexx @@ -0,0 +1,18 @@ +/*REXX program reads a specific line from a file (and displays the length and content).*/ +parse arg FID n . /*obtain optional arguments from the CL*/ +if FID=='' | FID=="," then FID= 'JUNK.TXT' /*not specified? Then use the default.*/ +if n=='' | n=="," then n=7 /* " " " " " " */ + +if lines(FID)==0 then call ser "wasn't found." /*see if the file exists (or not). */ + +call linein FID, n-1 /*read the record previous to N. */ +if lines(FID)==0 then call ser "doesn't contain" N 'lines.' + /* [↑] any more lines to read in file?*/ + +$=linein(FID) /*read the Nth record in the file. */ + +say 'File ' FID " line " N ' has a length of: ' length($) +say 'File ' FID " line " N 'contents: ' $ /*display the contents of the Nth line.*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +ser: say; say '***error!*** File ' FID " " arg(1); say; exit 13 diff --git a/Task/Read-a-specific-line-from-a-file/REXX/read-a-specific-line-from-a-file-2.rexx b/Task/Read-a-specific-line-from-a-file/REXX/read-a-specific-line-from-a-file-2.rexx new file mode 100644 index 0000000000..1c0156b2ba --- /dev/null +++ b/Task/Read-a-specific-line-from-a-file/REXX/read-a-specific-line-from-a-file-2.rexx @@ -0,0 +1,21 @@ +/*REXX program reads a specific line from a file (and displays the length and content).*/ +parse arg FID n . /*obtain optional arguments from the CL*/ +if FID=='' | FID=="," then FID= 'JUNK.TXT' /*not specified? Then use the default.*/ +if n=='' | n=="," then n=7 /* " " " " " " */ + +if lines(FID)==0 then call ser "wasn't found." /*see if the file exists (or not). */ + + do n-1 + call linein FID /*read all the lines previous to N. */ + end /*n-1*/ + +if lines(FID)==0 then call ser "doesn't contain" N 'lines.' + /* [↑] any more lines to read in file?*/ + +$=linein(FID) /*read the Nth record in the file. */ + +say 'File ' FID " line " N ' has a length of: ' length($) +say 'File ' FID " line " N 'contents: ' $ /*display the contents of the Nth line.*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +ser: say; say '***error!*** File ' FID " " arg(1); say; exit 13 diff --git a/Task/Read-a-specific-line-from-a-file/REXX/read-a-specific-line-from-a-file.rexx b/Task/Read-a-specific-line-from-a-file/REXX/read-a-specific-line-from-a-file.rexx deleted file mode 100644 index 5cdaff8c24..0000000000 --- a/Task/Read-a-specific-line-from-a-file/REXX/read-a-specific-line-from-a-file.rexx +++ /dev/null @@ -1,10 +0,0 @@ -/*REXX program to read a specific line from a file. */ -parse arg fileId n . /*get the user args: fileid n */ -if fileID=='' then fileId='JUNK.TXT' /*assume fileID default: JUNK.TXT*/ -if n=='' then n=7 /*assume N default: 7 */ -L=lines(fileid) /*first, see if the file exists. */ -if L==0 then do; say 'error, fileID not found:' fileId; exit; end -q=linein(fileId, n) /*read the Nth line, store in Q.*/ -if length(q)==0 then say 'line' n "not found." - else say 'file' fileId "record" n '=' q - /*stick a fork in it, we're done.*/ diff --git a/Task/Read-entire-file/00DESCRIPTION b/Task/Read-entire-file/00DESCRIPTION index 178ff4474f..2832375240 100644 --- a/Task/Read-entire-file/00DESCRIPTION +++ b/Task/Read-entire-file/00DESCRIPTION @@ -4,11 +4,13 @@ {{omit from|TI-89 BASIC|No filesystem.}} {{omit from|Unlambda|Does not know files.}} +;Task: Load the entire contents of some text file as a single string variable. If applicable, discuss: encoding selection, the possibility of memory-mapping. -Of course, one should avoid reading an entire file at once +Of course, in practice one should avoid reading an entire file at once if the file is large and the task can be accomplished incrementally instead (in which case check [[File IO]]); this is for those cases where having the entire file is actually what is wanted. +

    diff --git a/Task/Read-entire-file/C/read-entire-file-3.c b/Task/Read-entire-file/C/read-entire-file-3.c new file mode 100644 index 0000000000..2ffa4e227c --- /dev/null +++ b/Task/Read-entire-file/C/read-entire-file-3.c @@ -0,0 +1,19 @@ +#include +#include + +int main() { + HANDLE hFile, hMap; + DWORD filesize; + char *p; + + hFile = CreateFile("mmap_win.c", GENERIC_READ, 0, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); + filesize = GetFileSize(hFile, NULL); + hMap = CreateFileMapping(hFile, NULL, PAGE_READONLY, 0, 0, NULL); + p = MapViewOfFile(hMap, FILE_MAP_READ, 0, 0, 0); + + fwrite(p, filesize, 1, stdout); + + CloseHandle(hMap); + CloseHandle(hFile); + return 0; +} diff --git a/Task/Read-entire-file/Fortran/read-entire-file-1.f b/Task/Read-entire-file/Fortran/read-entire-file-1.f new file mode 100644 index 0000000000..42284d0834 --- /dev/null +++ b/Task/Read-entire-file/Fortran/read-entire-file-1.f @@ -0,0 +1,14 @@ +program read_file + implicit none + integer :: n + character(:), allocatable :: s + + open(unit=10, file="read_file.f90", action="read", & + form="unformatted", access="stream") + inquire(unit=10, size=n) + allocate(character(n) :: s) + read(10) s + close(10) + + print "(A)", s +end program diff --git a/Task/Read-entire-file/Fortran/read-entire-file-2.f b/Task/Read-entire-file/Fortran/read-entire-file-2.f new file mode 100644 index 0000000000..fa672969c0 --- /dev/null +++ b/Task/Read-entire-file/Fortran/read-entire-file-2.f @@ -0,0 +1,22 @@ +program file_win + use kernel32 + use iso_c_binding + implicit none + + integer(HANDLE) :: hFile, hMap, hOutput + integer(DWORD) :: fileSize + integer(LPVOID) :: ptr + integer(LPDWORD) :: charsWritten + integer(BOOL) :: s + + hFile = CreateFile("file_win.f90" // c_null_char, GENERIC_READ, & + 0, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL) + filesize = GetFileSize(hFile, NULL) + hMap = CreateFileMapping(hFile, NULL, PAGE_READONLY, 0, 0, NULL) + ptr = MapViewOfFile(hMap, FILE_MAP_READ, 0, 0, 0) + + hOutput = GetStdHandle(STD_OUTPUT_HANDLE) + s = WriteConsole(hOutput, ptr, fileSize, transfer(c_loc(charsWritten), 0_c_intptr_t), NULL) + s = CloseHandle(hMap) + s = CloseHandle(hFile) +end program diff --git a/Task/Read-entire-file/Java/read-entire-file-1.java b/Task/Read-entire-file/Java/read-entire-file-1.java index d12b424516..7683787bce 100644 --- a/Task/Read-entire-file/Java/read-entire-file-1.java +++ b/Task/Read-entire-file/Java/read-entire-file-1.java @@ -16,6 +16,7 @@ public class ReadFile { contents.append(buffer, 0, read); read = in.read(buffer); } while (read >= 0); + in.close(); return contents.toString(); } } diff --git a/Task/Read-entire-file/Perl-6/read-entire-file.pl6 b/Task/Read-entire-file/Perl-6/read-entire-file-1.pl6 similarity index 100% rename from Task/Read-entire-file/Perl-6/read-entire-file.pl6 rename to Task/Read-entire-file/Perl-6/read-entire-file-1.pl6 diff --git a/Task/Read-entire-file/Perl-6/read-entire-file-2.pl6 b/Task/Read-entire-file/Perl-6/read-entire-file-2.pl6 new file mode 100644 index 0000000000..6edd3cbf75 --- /dev/null +++ b/Task/Read-entire-file/Perl-6/read-entire-file-2.pl6 @@ -0,0 +1 @@ +my $string = slurp 'sample.txt', :enc; diff --git a/Task/Read-entire-file/Perl-6/read-entire-file-3.pl6 b/Task/Read-entire-file/Perl-6/read-entire-file-3.pl6 new file mode 100644 index 0000000000..765500d336 --- /dev/null +++ b/Task/Read-entire-file/Perl-6/read-entire-file-3.pl6 @@ -0,0 +1 @@ +my $string = 'sample.txt'.IO.slurp; diff --git a/Task/Read-entire-file/Perl/read-entire-file-1.pl b/Task/Read-entire-file/Perl/read-entire-file-1.pl index 064e133064..c921a94e52 100644 --- a/Task/Read-entire-file/Perl/read-entire-file-1.pl +++ b/Task/Read-entire-file/Perl/read-entire-file-1.pl @@ -1 +1,2 @@ -my $text = do { local( @ARGV, $/ ) = ( $filename ); <> }; +use File::Slurper 'read_text'; +my $text = read_text($filename, $data); diff --git a/Task/Read-entire-file/Perl/read-entire-file-2.pl b/Task/Read-entire-file/Perl/read-entire-file-2.pl index 2898a26969..2a36d28a44 100644 --- a/Task/Read-entire-file/Perl/read-entire-file-2.pl +++ b/Task/Read-entire-file/Perl/read-entire-file-2.pl @@ -1,3 +1,2 @@ -open my $fh, $filename; -my $text; read $fh, $text, -s $filename; -close $fh; +use Path::Tiny; +my $text = path($filename)->slurp_utf8; diff --git a/Task/Read-entire-file/Perl/read-entire-file-3.pl b/Task/Read-entire-file/Perl/read-entire-file-3.pl index 225de97e14..61df813b4e 100644 --- a/Task/Read-entire-file/Perl/read-entire-file-3.pl +++ b/Task/Read-entire-file/Perl/read-entire-file-3.pl @@ -1,2 +1,2 @@ -use File::Slurp; -my $text = read_file($filename); +use IO::All; +$text = io($filename)->utf8->all; diff --git a/Task/Read-entire-file/Perl/read-entire-file-4.pl b/Task/Read-entire-file/Perl/read-entire-file-4.pl index b442fc3937..492e7b9706 100644 --- a/Task/Read-entire-file/Perl/read-entire-file-4.pl +++ b/Task/Read-entire-file/Perl/read-entire-file-4.pl @@ -1,2 +1,4 @@ -use Perl6::Slurp qw(slurp); -my $text = slurp($filename); +open my $fh, '<:encoding(UTF-8)', $filename or die "Could not open '$filename': $!"; +my $text; +read $fh, $text, -s $filename; +close $fh; diff --git a/Task/Read-entire-file/Perl/read-entire-file-5.pl b/Task/Read-entire-file/Perl/read-entire-file-5.pl index 30f5d8ae23..9ebd0c57df 100644 --- a/Task/Read-entire-file/Perl/read-entire-file-5.pl +++ b/Task/Read-entire-file/Perl/read-entire-file-5.pl @@ -1,6 +1,7 @@ -use IO::All; -$text = io($filename)->all; -$text = io($filename)->utf8->all; -@text = io($filename)->slurp; -$text < io($filename); -io($filename) > $text; +my $text; +{ + local $/ = undef; + open my $fh, '<:encoding(UTF-8)', $filename or die "Could not open '$filename': $!"; + $text = <$fh>; + close $fh; +} diff --git a/Task/Read-entire-file/Perl/read-entire-file-6.pl b/Task/Read-entire-file/Perl/read-entire-file-6.pl index b3889b504a..064e133064 100644 --- a/Task/Read-entire-file/Perl/read-entire-file-6.pl +++ b/Task/Read-entire-file/Perl/read-entire-file-6.pl @@ -1 +1 @@ -perl -n -0777 -e 'print "file len: ".length' stuff.txt +my $text = do { local( @ARGV, $/ ) = ( $filename ); <> }; diff --git a/Task/Read-entire-file/Perl/read-entire-file-7.pl b/Task/Read-entire-file/Perl/read-entire-file-7.pl index 51bfc7043e..b3889b504a 100644 --- a/Task/Read-entire-file/Perl/read-entire-file-7.pl +++ b/Task/Read-entire-file/Perl/read-entire-file-7.pl @@ -1,3 +1 @@ -use File::Map 'map_file'; -map_file(my $str, "foo.txt"); -print $str; +perl -n -0777 -e 'print "file len: ".length' stuff.txt diff --git a/Task/Read-entire-file/Perl/read-entire-file-8.pl b/Task/Read-entire-file/Perl/read-entire-file-8.pl index 786b227298..51bfc7043e 100644 --- a/Task/Read-entire-file/Perl/read-entire-file-8.pl +++ b/Task/Read-entire-file/Perl/read-entire-file-8.pl @@ -1,4 +1,3 @@ -use Sys::Mmap; -Sys::Mmap->new(my $str, 0, 'foo.txt') - or die "Cannot Sys::Mmap->new: $!"; +use File::Map 'map_file'; +map_file(my $str, "foo.txt"); print $str; diff --git a/Task/Read-entire-file/Perl/read-entire-file-9.pl b/Task/Read-entire-file/Perl/read-entire-file-9.pl new file mode 100644 index 0000000000..786b227298 --- /dev/null +++ b/Task/Read-entire-file/Perl/read-entire-file-9.pl @@ -0,0 +1,4 @@ +use Sys::Mmap; +Sys::Mmap->new(my $str, 0, 'foo.txt') + or die "Cannot Sys::Mmap->new: $!"; +print $str; diff --git a/Task/Read-entire-file/REXX/read-entire-file-1.rexx b/Task/Read-entire-file/REXX/read-entire-file-1.rexx index 84e879d6d1..8d3b430947 100644 --- a/Task/Read-entire-file/REXX/read-entire-file-1.rexx +++ b/Task/Read-entire-file/REXX/read-entire-file-1.rexx @@ -1,8 +1,7 @@ -/*REXX program reads a file and stores it as a continuous character str.*/ -iFID = 'a_file' /*name of the input file. */ -aString = /*value of file's contents so far*/ - /* [↓] read file line-by-line. */ - do while lines(iFID) \== 0 /*read file's lines 'til finished*/ - aString = aString || linein(iFID) /*append a (file) line to aString*/ - end /*while*/ - /*stick a fork in it, we're done.*/ +/*REXX program reads an entire file line-by-line and stores it as a continuous string.*/ +parse arg iFID . /*obtain optional argument from the CL.*/ +if iFID=='' then iFID= 'a_file' /*Not specified? Then use the default.*/ +$= /*a string of file's contents (so far).*/ + do while lines(iFID)\==0 /*read the file's lines until finished.*/ + $=$ || linein(iFID) /*append a (file's) line to the string,*/ + end /*while*/ /*stick a fork in it, we're all done. */ diff --git a/Task/Real-constants-and-functions/00DESCRIPTION b/Task/Real-constants-and-functions/00DESCRIPTION index 46fd609154..dc11248d19 100644 --- a/Task/Real-constants-and-functions/00DESCRIPTION +++ b/Task/Real-constants-and-functions/00DESCRIPTION @@ -1,12 +1,16 @@ -Show how to use the following math constants and functions in your language (if not available, note it): -*e (base of the natural logarithm) -*\pi -*square root -*logarithm (any base allowed) -*exponential (e^x) -*absolute value (a.k.a. "magnitude") -*floor (largest integer less than or equal to this number--not the same as truncate or int) -*ceiling (smallest integer not less than this number--not the same as round up) -*power (x^y) +;Task: +Show how to use the following math constants and functions in your language   (if not available, note it): +:*   ''e''   (base of the natural logarithm) +:*   \pi +:*   square root +:*   logarithm   (any base allowed) +:*   exponential   (''e''''x'' ) +:*   absolute value   (a.k.a. "magnitude") +:*   floor   (largest integer less than or equal to this number--not the same as truncate or int) +:*   ceiling   (smallest integer not less than this number--not the same as round up) +:*   power   (''x''''y'' ) -See also [[Trigonometric Functions]] + +;Related task: +*   [[Trigonometric Functions]] +

    diff --git a/Task/Real-constants-and-functions/Elixir/real-constants-and-functions.elixir b/Task/Real-constants-and-functions/Elixir/real-constants-and-functions.elixir new file mode 100644 index 0000000000..97e57f1040 --- /dev/null +++ b/Task/Real-constants-and-functions/Elixir/real-constants-and-functions.elixir @@ -0,0 +1,16 @@ +defmodule Real_constants_and_functions do + def main do + IO.puts :math.exp(1) # e + IO.puts :math.pi # pi + IO.puts :math.sqrt(16) # square root + IO.puts :math.log(10) # natural logarithm + IO.puts :math.log10(10) # base 10 logarithm + IO.puts :math.exp(2) # e raised to the power of x + IO.puts abs(-2.24) # absolute value + IO.puts Float.floor(3.1423) # floor + IO.puts Float.ceil(20.125) # ceiling + IO.puts :math.pow(3,2) # exponentiation + end +end + +Real_constants_and_functions.main diff --git a/Task/Real-constants-and-functions/Fortran/real-constants-and-functions.f b/Task/Real-constants-and-functions/Fortran/real-constants-and-functions.f index c6729059ad..3fe3739976 100644 --- a/Task/Real-constants-and-functions/Fortran/real-constants-and-functions.f +++ b/Task/Real-constants-and-functions/Fortran/real-constants-and-functions.f @@ -1,10 +1,10 @@ -e ! Not available. Can be calculated EXP(1.0) -pi ! Not available. Can be calculated 4.0*ATAN(1.0) -SQRT(x) ! square root -LOG(x) ! natural logarithm -LOG10(x) ! logarithm to base 10 -EXP(x) ! exponential -ABS(x) ! absolute value -FLOOR(x) ! floor - Fortran 90 or later only -CEILING(x) ! ceiling - Fortran 90 or later only -x**y ! x raised to the y power + e ! Not available. Can be calculated EXP(1.0) + pi ! Not available. Can be calculated 4.0*ATAN(1.0) + SQRT(x) ! square root + LOG(x) ! natural logarithm + LOG10(x) ! logarithm to base 10 + EXP(x) ! exponential + ABS(x) ! absolute value + FLOOR(x) ! floor - Fortran 90 or later only + CEILING(x) ! ceiling - Fortran 90 or later only + x**y ! x raised to the y power diff --git a/Task/Real-constants-and-functions/Go/real-constants-and-functions.go b/Task/Real-constants-and-functions/Go/real-constants-and-functions.go index e39b7a3af1..b7897e95ca 100644 --- a/Task/Real-constants-and-functions/Go/real-constants-and-functions.go +++ b/Task/Real-constants-and-functions/Go/real-constants-and-functions.go @@ -1,18 +1,54 @@ -import "math" +package main -// e and pi defined as constants. -// In Go, that means they are not of a specific data type and can be used as float32 or float64. -math.E -math.Pi +import ( + "fmt" + "math" + "math/big" +) -// The following functions all take and return the float64 data type. +func main() { + // e and pi defined as constants. + // In Go, that means they are not of a specific data type and can be used + // as float32 or float64. Println takes the float64 values. + fmt.Println("float64 values:") + fmt.Println("e:", math.E) + fmt.Println("π:", math.Pi) -math.Sqrt(x) // square root--cube root also available (math.Cbrt) -// natural logarithm--log base 10, 2 also available (math.Log10, math.Log2) -// also available is log1p, the log of 1+x. It is more accurate when x is near zero. -math.Log(x) -math.Exp(x) // exponential--exp base 10, 2 also available (math.Pow10, math.Exp2) -math.Abs(x) // absolute value -math.Floor(x) // floor -math.Ceil(x) // ceiling -math.Pow(x,y) // power + // The following functions all take and return the float64 data type. + + // square root. cube root also available (math.Cbrt) + fmt.Println("square root(1.44):", math.Sqrt(1.44)) + // natural logarithm--log base 10, 2 also available (math.Log10, math.Log2) + // also available is log1p, the log of 1+x. (using log1p can be more + // accurate when x is near zero.) + fmt.Println("ln(e):", math.Log(math.E)) + // exponential. also available are exp base 10, 2 (math.Pow10, math.Exp2) + fmt.Println("exponential(1):", math.Exp(1)) + fmt.Println("absolute value(-1.2):", math.Abs(-1.2)) + fmt.Println("floor(-1.2):", math.Floor(-1.2)) + fmt.Println("ceiling(-1.2):", math.Ceil(-1.2)) + fmt.Println("power(1.44, .5):", math.Pow(1.44, .5)) + + // Equivalent functions for the float32 type are not in the standard + // library. Here are the constants e and π as float32s however. + fmt.Println("\nfloat32 values:") + fmt.Println("e:", float32(math.E)) + fmt.Println("π:", float32(math.Pi)) + + // The standard library has an arbitrary precision floating point type but + // provides only the most basic methods. Also while the constants math.E + // and math.Pi are provided to over 80 decimal places, there is no + // convenient way of loading these numbers (with their full precision) + // into a big.Float. A hack is cutting and pasting into a string, but + // of course if you're going to do that you are free to cut and paste from + // any other source. (The documentation cites OEIS as its source.) + pi := "3.141592653589793238462643383279502884197169399375105820974944" + π, _, _ := big.ParseFloat(pi, 10, 200, 0) + fmt.Println("\nbig.Float values:") + fmt.Println("π:", π) + // Of functions requested by the task, only absolute value is provided. + x := new(big.Float).Neg(π) + y := new(big.Float) + fmt.Println("x:", x) + fmt.Println("abs(x):", y.Abs(x)) +} diff --git a/Task/Real-constants-and-functions/Perl-6/real-constants-and-functions.pl6 b/Task/Real-constants-and-functions/Perl-6/real-constants-and-functions.pl6 index 7e96d6eb03..f13f7284f7 100644 --- a/Task/Real-constants-and-functions/Perl-6/real-constants-and-functions.pl6 +++ b/Task/Real-constants-and-functions/Perl-6/real-constants-and-functions.pl6 @@ -1,10 +1,38 @@ say e; # e -say pi; # pi -say π,e; # if you prefer unicode +say π; # or pi # pi +say τ; # or tau # tau + +# Common mathmatical function are availble +# as subroutines and as numeric methods. +# It is a matter of personal taste and +# programming style as to which is used. say sqrt 2; # Square root +say 2.sqrt; # Square root + +# If you omit a base, does natural logarithm say log 2; # Natural logarithm -say exp 42; # Exponentiation base e +say 2.log; # Natural logarithm + +# Specify a base if other than e +say log 4, 10; # Base 10 logarithm +say 4.log(10); # Base 10 logarithm +say 4.log10; # Convenience, base 10 only logarithm + +say exp 7; # Exponentiation base e +say 7.exp; # Exponentiation base e + +# Specify a base if other than e +say exp 7, 4; # Exponentiation +say 7.exp(4); # Exponentiation +say 4 ** 7; # Exponentiation + say abs -2; # Absolute value -say floor pi; # Floor +say (-2).abs; # Absolute value + +say floor -3.5; # Floor +say (-3.5).floor; # Floor + say ceiling pi; # Ceiling -say 4**7; # Exponentiation +say pi.ceiling; # Ceiling + +say e ** π\i + 1 ≅ 0; # :-) diff --git a/Task/Real-constants-and-functions/Rust/real-constants-and-functions.rust b/Task/Real-constants-and-functions/Rust/real-constants-and-functions.rust new file mode 100644 index 0000000000..536cd1aaa7 --- /dev/null +++ b/Task/Real-constants-and-functions/Rust/real-constants-and-functions.rust @@ -0,0 +1,24 @@ +use std::f64::consts::*; + +fn main() { + // e (base of the natural logarithm) + let mut x = E; + // π + x += PI; + // square root + x = x.sqrt(); + // logarithm (any base allowed) + x = x.ln(); + // ceiling (smallest integer not less than this number--not the same as round up) + x = x.ceil(); + // exponential (ex) + x = x.exp(); + // absolute value (a.k.a. "magnitude") + x = x.abs(); + // floor (largest integer less than or equal to this number--not the same as truncate or int) + x = x.floor(); + // power (xy) + x = x.powf(x); + + assert_eq!(x, 4.0); +} diff --git a/Task/Reduced-row-echelon-form/Perl-6/reduced-row-echelon-form-1.pl6 b/Task/Reduced-row-echelon-form/Perl-6/reduced-row-echelon-form-1.pl6 index 2d4c9e69fb..5c2f5663ef 100644 --- a/Task/Reduced-row-echelon-form/Perl-6/reduced-row-echelon-form-1.pl6 +++ b/Task/Reduced-row-echelon-form/Perl-6/reduced-row-echelon-form-1.pl6 @@ -1,9 +1,9 @@ -sub rref (@m is rw) { +sub rref (@m) { @m or return; my ($lead, $rows, $cols) = 0, +@m, +@m[0]; for ^$rows -> $r { - $lead < $cols or return @m; + return @m if $lead >= $cols; my $i = $r; until @m[$i][$lead] { @@ -23,18 +23,18 @@ sub rref (@m is rw) { } ++$lead; } - @m; + @m } -sub rat_or_int ($num is rw) { +sub rat-or-int ($num) { return $num unless $num ~~ Rat; - return $num.Int if $num.denominator == 1; - return $num.perl; + return $num.narrow if $num.narrow.WHAT ~~ Int; + $num.nude.join: '/'; } sub say_it ($message, @array) { say "\n$message"; - $_».&rat_or_int.fmt(" %5s").say for @array; + $_».&rat-or-int.fmt(" %5s").say for @array; } my @M = ( diff --git a/Task/Reduced-row-echelon-form/Perl-6/reduced-row-echelon-form-2.pl6 b/Task/Reduced-row-echelon-form/Perl-6/reduced-row-echelon-form-2.pl6 index 34f57858dd..8685e08799 100644 --- a/Task/Reduced-row-echelon-form/Perl-6/reduced-row-echelon-form-2.pl6 +++ b/Task/Reduced-row-echelon-form/Perl-6/reduced-row-echelon-form-2.pl6 @@ -1,6 +1,6 @@ sub swap_rows ( @M, $r1, $r2 ) { @M[ $r1, $r2 ] = @M[ $r2, $r1 ] }; -sub scale_row ( @M, $scale, $r ) { @M[$r] = @M[$r] X* $scale }; -sub shear_row ( @M, $scale, $r1, $r2 ) { @M[$r1] = @M[$r1] Z+ ( @M[$r2] X* $scale ) }; +sub scale_row ( @M, $scale, $r ) { @M[$r] = @M[$r] »*» $scale }; +sub shear_row ( @M, $scale, $r1, $r2 ) { @M[$r1] = @M[$r1].list »+» ( @M[$r2] »*» $scale ) }; sub reduce_row ( @M, $r, $c ) { scale_row( @M, 1/@M[$r][$c], $r ) }; sub clear_column ( @M, $r, $c ) { for @M.keys.grep( * != $r ) -> $row_num { diff --git a/Task/Reduced-row-echelon-form/Perl-6/reduced-row-echelon-form-3.pl6 b/Task/Reduced-row-echelon-form/Perl-6/reduced-row-echelon-form-3.pl6 index 37708e0f6d..fa3d7f0dd6 100644 --- a/Task/Reduced-row-echelon-form/Perl-6/reduced-row-echelon-form-3.pl6 +++ b/Task/Reduced-row-echelon-form/Perl-6/reduced-row-echelon-form-3.pl6 @@ -1,9 +1,9 @@ class Matrix is Array { method unscale_row ( @M: $scale, $row ) { - @M[$row] = @M[$row] X/ $scale; + @M[$row] = @M[$row] »/» $scale; } method unshear_row ( @M: $scale, $r1, $r2 ) { - @M[$r1] = @M[$r1] Z- ( @M[$r2] X* $scale ); + @M[$r1] = @M[$r1] »-» ( @M[$r2] »*» $scale ); } method reduce_row ( @M: $row, $col ) { @M.unscale_row( @M[$row][$col], $row ); @@ -32,7 +32,7 @@ class Matrix is Array { } } -my $M = Matrix.new.push( +my $M = Matrix.new( [< 1 2 -1 -4 >], [< 2 3 -1 -11 >], [< -2 0 -3 22 >], diff --git a/Task/Remove-duplicate-elements/00DESCRIPTION b/Task/Remove-duplicate-elements/00DESCRIPTION index 4dc178b960..bd7ea66b8b 100644 --- a/Task/Remove-duplicate-elements/00DESCRIPTION +++ b/Task/Remove-duplicate-elements/00DESCRIPTION @@ -4,3 +4,4 @@ There are basically three approaches seen here: * Put the elements into a hash table which does not allow duplicates. The complexity is O(''n'') on average, and O(''n''2) worst case. This approach requires a hash function for your type (which is compatible with equality), either built-in to your language, or provided by the user. * Sort the elements and remove consecutive duplicate elements. The complexity of the best sorting algorithms is O(''n'' log ''n''). This approach requires that your type be "comparable", i.e., have an ordering. Putting the elements into a self-balancing binary search tree is a special case of sorting. * Go through the list, and for each element, check the rest of the list to see if it appears again, and discard it if it does. The complexity is O(''n''2). The up-shot is that this always works on any type (provided that you can test for equality). +

    diff --git a/Task/Remove-duplicate-elements/ALGOL-68/remove-duplicate-elements-1.alg b/Task/Remove-duplicate-elements/ALGOL-68/remove-duplicate-elements-1.alg new file mode 100644 index 0000000000..1a05e1f4bb --- /dev/null +++ b/Task/Remove-duplicate-elements/ALGOL-68/remove-duplicate-elements-1.alg @@ -0,0 +1,31 @@ +# use the associative array in the Associate array/iteration task # +# this example uses strings - for other types, the associative # +# array modes AAELEMENT and AAKEY should be modified as required # +PR read "aArray.a68" PR + +# returns the unique elements of list # +PROC remove duplicates = ( []STRING list )[]STRING: + BEGIN + REF AARRAY elements := INIT LOC AARRAY; + INT count := 0; + FOR pos FROM LWB list TO UPB list DO + IF NOT ( elements CONTAINSKEY list[ pos ] ) THEN + # first occurance of this element # + elements // list[ pos ] := ""; + count +:= 1 + FI + OD; + # construct an array of the unique elements from the # + # associative array - the new list will not necessarily be # + # in the original order # + [ count ]STRING result; + REF AAELEMENT e := FIRST elements; + FOR pos WHILE e ISNT nil element DO + result[ pos ] := key OF e; + e := NEXT elements + OD; + result + END; # remove duplicates # + +# test the duplicate removal # +print( ( remove duplicates( ( "A", "B", "D", "A", "C", "F", "F", "A" ) ), newline ) ) diff --git a/Task/Remove-duplicate-elements/ALGOL-68/remove-duplicate-elements-2.alg b/Task/Remove-duplicate-elements/ALGOL-68/remove-duplicate-elements-2.alg new file mode 100644 index 0000000000..76fc8b13c5 --- /dev/null +++ b/Task/Remove-duplicate-elements/ALGOL-68/remove-duplicate-elements-2.alg @@ -0,0 +1,2 @@ +∪ 1 2 3 1 2 3 4 1 +1 2 3 4 diff --git a/Task/Remove-duplicate-elements/ALGOL-68/remove-duplicate-elements-3.alg b/Task/Remove-duplicate-elements/ALGOL-68/remove-duplicate-elements-3.alg new file mode 100644 index 0000000000..1e01817e31 --- /dev/null +++ b/Task/Remove-duplicate-elements/ALGOL-68/remove-duplicate-elements-3.alg @@ -0,0 +1,3 @@ +w←1 2 3 1 2 3 4 1 + ((⍳⍨w)=⍳⍴w)/w +1 2 3 4 diff --git a/Task/Remove-duplicate-elements/Ada/remove-duplicate-elements.ada b/Task/Remove-duplicate-elements/Ada/remove-duplicate-elements.ada new file mode 100644 index 0000000000..c8e014d55b --- /dev/null +++ b/Task/Remove-duplicate-elements/Ada/remove-duplicate-elements.ada @@ -0,0 +1,21 @@ +with Ada.Containers.Ordered_Sets; +with Ada.Text_IO; use Ada.Text_IO; + +procedure Unique_Set is + package Int_Sets is new Ada.Containers.Ordered_Sets(Integer); + use Int_Sets; + Nums : array (Natural range <>) of Integer := (1,2,3,4,5,5,6,7,1); + Unique : Set; + Set_Cur : Cursor; + Success : Boolean; +begin + for I in Nums'range loop + Unique.Insert(Nums(I), Set_Cur, Success); + end loop; + Set_Cur := Unique.First; + loop + Put_Line(Item => Integer'Image(Element(Set_Cur))); + exit when Set_Cur = Unique.Last; + Set_Cur := Next(Set_Cur); + end loop; +end Unique_Set; diff --git a/Task/Remove-duplicate-elements/AppleScript/remove-duplicate-elements-1.applescript b/Task/Remove-duplicate-elements/AppleScript/remove-duplicate-elements-1.applescript new file mode 100644 index 0000000000..3a4642f4a4 --- /dev/null +++ b/Task/Remove-duplicate-elements/AppleScript/remove-duplicate-elements-1.applescript @@ -0,0 +1,9 @@ +unique({1, 2, 3, "a", "b", "c", 2, 3, 4, "b", "c", "d"}) + +on unique(x) + set R to {} + repeat with i in x + if i is not in R then set end of R to i's contents + end repeat + return R +end unique diff --git a/Task/Remove-duplicate-elements/AppleScript/remove-duplicate-elements-2.applescript b/Task/Remove-duplicate-elements/AppleScript/remove-duplicate-elements-2.applescript new file mode 100644 index 0000000000..23c817862c --- /dev/null +++ b/Task/Remove-duplicate-elements/AppleScript/remove-duplicate-elements-2.applescript @@ -0,0 +1,96 @@ +-- CASE INSENSITIVE VERSION + +-- nub :: [a] -> [a] +on nub(xs) + -- Eq :: a -> a -> Bool + script Eq + on lambda(x, y) + ignoring case + x = y + end ignoring + end lambda + end script + + nubBy(Eq, xs) +end nub + + +-- TEST +on run {} + {intercalate(space, ¬ + nub(splitOn(space, "4 3 2 8 0 1 9 5 1 7 6 3 9 9 4 2 1 5 3 2"))), ¬ + intercalate("", ¬ + nub(characters of "abcabc ABCABC"))} + + --> {"4 3 2 8 0 1 9 5 7 6", "abc "} +end run + + +--------------------------------------------------------------------------- + +-- GENERIC FUNCTIONS + +-- nubBy :: (a -> a -> Bool) -> [a] -> [a] +on nubBy(fnEq, xxs) + + set lng to length of xxs + if lng > 1 then + set x to item 1 of xxs + set xs to items 2 thru -1 of xxs + set p to mReturn(fnEq) + + -- notEq :: a -> Bool + script notEq + on lambda(a) + not (p's lambda(a, x)) + end lambda + end script + + {x} & nubBy(fnEq, filter(notEq, xs)) + else + xxs + end if +end nubBy + +-- 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 + +-- 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 + +-- FOR THE TEST + +-- splitOn :: Text -> Text -> [Text] +on splitOn(strDelim, strMain) + set {dlm, my text item delimiters} to {my text item delimiters, strDelim} + set lstParts to text items of strMain + set my text item delimiters to dlm + return lstParts +end splitOn + +-- intercalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate diff --git a/Task/Remove-duplicate-elements/AppleScript/remove-duplicate-elements-3.applescript b/Task/Remove-duplicate-elements/AppleScript/remove-duplicate-elements-3.applescript new file mode 100644 index 0000000000..e21ba731be --- /dev/null +++ b/Task/Remove-duplicate-elements/AppleScript/remove-duplicate-elements-3.applescript @@ -0,0 +1 @@ +{"4 3 2 8 0 1 9 5 7 6", "abc "} diff --git a/Task/Remove-duplicate-elements/AppleScript/remove-duplicate-elements.applescript b/Task/Remove-duplicate-elements/AppleScript/remove-duplicate-elements.applescript deleted file mode 100644 index 184753efb1..0000000000 --- a/Task/Remove-duplicate-elements/AppleScript/remove-duplicate-elements.applescript +++ /dev/null @@ -1,9 +0,0 @@ -unique({1, 2, 3, "a", "b", "c", 2, 3, 4, "b", "c", "d"}) - -on unique(x) - set R to {} - repeat with i in x - if i is not in R then set end of R to i's contents - end repeat - return R -end unique diff --git a/Task/Remove-duplicate-elements/CoffeeScript/remove-duplicate-elements.coffee b/Task/Remove-duplicate-elements/CoffeeScript/remove-duplicate-elements.coffee new file mode 100644 index 0000000000..8a2018bfb2 --- /dev/null +++ b/Task/Remove-duplicate-elements/CoffeeScript/remove-duplicate-elements.coffee @@ -0,0 +1,6 @@ +data = [ 1, 2, 3, "a", "b", "c", 2, 3, 4, "b", "c", "d" ] +set = [] +set.push i for i in data when not (i in set) + +console.log data +console.log set diff --git a/Task/Remove-duplicate-elements/Elixir/remove-duplicate-elements.elixir b/Task/Remove-duplicate-elements/Elixir/remove-duplicate-elements.elixir index d1f0f2b7ab..bae539ace7 100644 --- a/Task/Remove-duplicate-elements/Elixir/remove-duplicate-elements.elixir +++ b/Task/Remove-duplicate-elements/Elixir/remove-duplicate-elements.elixir @@ -1,28 +1,27 @@ defmodule RC do - # hash table approach - def uniq1(list) do - Enum.reduce(list, HashSet.new, fn x, set -> Set.put(set, x) end) - |> Set.to_list - end + # Set approach + def uniq1(list), do: MapSet.new(list) |> MapSet.to_list # Sort approach - def uniq2(list), do: Enum.sort(list) |> uniq2([]) - - defp uniq2([], uniq), do: Enum.reverse(uniq) - defp uniq2([h|t], uniq) when h==hd(uniq), do: uniq2(t, uniq) - defp uniq2([h|t], uniq) , do: uniq2(t, [h | uniq]) + def uniq2(list), do: Enum.sort(list) |> Enum.dedup # Go through the list approach def uniq3(list), do: uniq3(list, []) - defp uniq3([], uniq), do: Enum.reverse(uniq) - defp uniq3([h|t], uniq) do - if Enum.member?(uniq, h), do: uniq3(t, uniq), else: uniq3(t, [h | uniq]) + defp uniq3([], res), do: Enum.reverse(res) + defp uniq3([h|t], res) do + if h in res, do: uniq3(t, res), else: uniq3(t, [h | res]) end end -list = [1,1,2,1,'redundant',[1,2,3],[1,2,3],'redundant'] -IO.inspect Enum.uniq(list) -IO.inspect RC.uniq1(list) -IO.inspect RC.uniq2(list) -IO.inspect RC.uniq3(list) +num = 10000 +max = div(num, 10) +list = for _ <- 1..num, do: :rand.uniform(max) +funs = [&Enum.uniq/1, &RC.uniq1/1, &RC.uniq2/1, &RC.uniq3/1] +Enum.each(funs, fn fun -> + result = fun.([1,1,2,1,'redundant',1.0,[1,2,3],[1,2,3],'redundant',1.0]) + :timer.tc(fn -> + Enum.each(1..100, fn _ -> fun.(list) end) + end) + |> fn{t,_} -> IO.puts "#{inspect fun}:\t#{t/1000000}\t#{inspect result}" end.() +end) diff --git a/Task/Remove-duplicate-elements/Groovy/remove-duplicate-elements.groovy b/Task/Remove-duplicate-elements/Groovy/remove-duplicate-elements.groovy index c0c0745857..083d50c33d 100644 --- a/Task/Remove-duplicate-elements/Groovy/remove-duplicate-elements.groovy +++ b/Task/Remove-duplicate-elements/Groovy/remove-duplicate-elements.groovy @@ -1,21 +1,22 @@ def list = [1, 2, 3, 'a', 'b', 'c', 2, 3, 4, 'b', 'c', 'd'] assert list.size() == 12 -println " Original List: ${list}" +println " Original List: ${list}" -// Filtering the List +// Filtering the List (non-mutating) +def list2 = list.unique(false) +assert list2.size() == 8 +assert list.size() == 12 +println " Filtered List: ${list2}" + +// Filtering the List (in place) list.unique() assert list.size() == 8 -println " Filtered List: ${list}" +println " Original List, filtered: ${list}" -list = [1, 2, 3, 'a', 'b', 'c', 2, 3, 4, 'b', 'c', 'd'] -assert list.size() == 12 +def list3 = [1, 2, 3, 'a', 'b', 'c', 2, 3, 4, 'b', 'c', 'd'] +assert list3.size() == 12 // Converting to Set -def set = new HashSet(list) +def set = list as Set assert set.size() == 8 -println " Set: ${set}" - -// Converting to Order-preserving Set -set = new LinkedHashSet(list) -assert set.size() == 8 -println "List-ordered Set: ${set}" +println " Set: ${set}" diff --git a/Task/Remove-duplicate-elements/Java/remove-duplicate-elements-1.java b/Task/Remove-duplicate-elements/Java/remove-duplicate-elements-1.java new file mode 100644 index 0000000000..be73e84743 --- /dev/null +++ b/Task/Remove-duplicate-elements/Java/remove-duplicate-elements-1.java @@ -0,0 +1,12 @@ +import java.util.*; + +class Test { + + public static void main(String[] args) { + + Object[] data = {1, 1, 2, 2, 3, 3, 3, "a", "a", "b", "b", "c", "d"}; + Set uniqueSet = new HashSet(Arrays.asList(data)); + for (Object o : uniqueSet) + System.out.printf("%s ", o); + } +} diff --git a/Task/Remove-duplicate-elements/Java/remove-duplicate-elements-2.java b/Task/Remove-duplicate-elements/Java/remove-duplicate-elements-2.java new file mode 100644 index 0000000000..f1bd2c943f --- /dev/null +++ b/Task/Remove-duplicate-elements/Java/remove-duplicate-elements-2.java @@ -0,0 +1,10 @@ +import java.util.*; + +class Test { + + public static void main(String[] args) { + + Object[] data = {1, 1, 2, 2, 3, 3, 3, "a", "a", "b", "b", "c", "d"}; + Arrays.stream(data).distinct().forEach((o) -> System.out.printf("%s ", o)); + } +} diff --git a/Task/Remove-duplicate-elements/Java/remove-duplicate-elements.java b/Task/Remove-duplicate-elements/Java/remove-duplicate-elements.java deleted file mode 100644 index 9999d778a2..0000000000 --- a/Task/Remove-duplicate-elements/Java/remove-duplicate-elements.java +++ /dev/null @@ -1,7 +0,0 @@ -import java.util.Set; -import java.util.HashSet; -import java.util.Arrays; - -Object[] data = {1, 2, 3, "a", "b", "c", 2, 3, 4, "b", "c", "d"}; -Set uniqueSet = new HashSet(Arrays.asList(data)); -Object[] unique = uniqueSet.toArray(); diff --git a/Task/Remove-duplicate-elements/JavaScript/remove-duplicate-elements-6.js b/Task/Remove-duplicate-elements/JavaScript/remove-duplicate-elements-6.js new file mode 100644 index 0000000000..3ecba34741 --- /dev/null +++ b/Task/Remove-duplicate-elements/JavaScript/remove-duplicate-elements-6.js @@ -0,0 +1,39 @@ +(function () { + 'use strict'; + + // nub :: [a] -> [a] + function nub(xs) { + + // Eq :: a -> a -> Bool + function Eq(a, b) { + return a === b; + } + + // nubBy :: (a -> a -> Bool) -> [a] -> [a] + function nubBy(fnEq, xs) { + var x = xs.length ? xs[0] : undefined; + + return x !== undefined ? [x].concat( + nubBy(fnEq, xs.slice(1) + .filter(function (y) { + return !fnEq(x, y); + })) + ) : []; + } + + return nubBy(Eq, xs); + } + + + // TEST + + return [ + nub('4 3 2 8 0 1 9 5 1 7 6 3 9 9 4 2 1 5 3 2'.split(' ')) + .map(function (x) { + return Number(x); + }), + nub('chthonic eleemosynary paronomasiac'.split('')) + .join('') + ] + +})(); diff --git a/Task/Remove-duplicate-elements/Kotlin/remove-duplicate-elements.kotlin b/Task/Remove-duplicate-elements/Kotlin/remove-duplicate-elements.kotlin new file mode 100644 index 0000000000..ada469287a --- /dev/null +++ b/Task/Remove-duplicate-elements/Kotlin/remove-duplicate-elements.kotlin @@ -0,0 +1,7 @@ +fun main(args: Array) { + val data = listOf(1, 2, 3, "a", "b", "c", 2, 3, 4, "b", "c", "d") + val set = data.distinct() + + println(data) + println(set) +} diff --git a/Task/Remove-duplicate-elements/Run-BASIC/remove-duplicate-elements.run b/Task/Remove-duplicate-elements/Run-BASIC/remove-duplicate-elements.run new file mode 100644 index 0000000000..404d2a07c5 --- /dev/null +++ b/Task/Remove-duplicate-elements/Run-BASIC/remove-duplicate-elements.run @@ -0,0 +1,14 @@ +a$ = "2 3 5 7 11 13 17 19 cats 222 -100.2 +11 1.1 +7 7. 7 5 5 3 2 0 4.4 2" + +for i = 1 to len(a$) + a1$ = word$(a$,i) + if a1$ = "" then exit for + for i1 = 1 to len(b$) + if a1$ = word$(b$,i1) then [nextWord] + next i1 + b$ = b$ + a1$ + " " +[nextWord] +next i + + print "Dups:";a$ + print "No Dups:";b$ diff --git a/Task/Remove-duplicate-elements/Rust/remove-duplicate-elements.rust b/Task/Remove-duplicate-elements/Rust/remove-duplicate-elements.rust new file mode 100644 index 0000000000..0ae55d2601 --- /dev/null +++ b/Task/Remove-duplicate-elements/Rust/remove-duplicate-elements.rust @@ -0,0 +1,16 @@ +use std::vec::Vec; +use std::collections::HashSet; +use std::hash::Hash; +use std::cmp::Eq; + +fn main(){ + let mut sample_elements = vec![0u8,0,1,1,2,3,2]; + println!("Before removal of duplicates : {:?}", sample_elements); + remove_duplicate_elements(&mut sample_elements); + println!("After removal of duplicates : {:?}", sample_elements); +} + +fn remove_duplicate_elements(elements: &mut Vec){ + let set : HashSet<_> = elements.drain(..).collect(); + elements.extend(set.into_iter()); +} diff --git a/Task/Remove-lines-from-a-file/00DESCRIPTION b/Task/Remove-lines-from-a-file/00DESCRIPTION index 7c34897a03..bdd542ec4e 100644 --- a/Task/Remove-lines-from-a-file/00DESCRIPTION +++ b/Task/Remove-lines-from-a-file/00DESCRIPTION @@ -1,3 +1,11 @@ -The task is to demonstrate how to remove a specific line or a number of lines from a file. This should be implemented as a routine that takes three parameters (filename, starting line, and the number of lines to be removed). For the purpose of this task, line numbers and the number of lines start at one, so to remove the first two lines from the file foobar.txt, the parameters should be: foobar.txt, 1, 2 +;Task: +Remove a specific line or a number of lines from a file. -Empty lines are considered and should still be counted, and if the specified line is empty, it should still be removed. An appropriate message should appear if an attempt is made to remove lines beyond the end of the file. +This should be implemented as a routine that takes three parameters (filename, starting line, and the number of lines to be removed). + +For the purpose of this task, line numbers and the number of lines start at one, so to remove the first two lines from the file foobar.txt, the parameters should be: foobar.txt, 1, 2 + +Empty lines are considered and should still be counted, and if the specified line is empty, it should still be removed. + +An appropriate message should appear if an attempt is made to remove lines beyond the end of the file. +

    diff --git a/Task/Remove-lines-from-a-file/BASIC/remove-lines-from-a-file.basic b/Task/Remove-lines-from-a-file/BASIC/remove-lines-from-a-file.basic new file mode 100644 index 0000000000..9237e5f846 --- /dev/null +++ b/Task/Remove-lines-from-a-file/BASIC/remove-lines-from-a-file.basic @@ -0,0 +1,242 @@ +' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' +' Remove File Lines V1.0 ' +' ' +' Developed by A. David Garza Marín in VB-DOS for ' +' RosettaCode. November 30, 2016. ' +' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' + +'OPTION _EXPLICIT ' For QB45 +'OPTION EXPLICIT ' For VBDOS, PDS 7.1 + +' SUBs and FUNCTIONs +DECLARE FUNCTION DeleteLinesFromFile% (WhichFile AS STRING, Start AS LONG, HowMany AS LONG) +DECLARE FUNCTION FileExists% (WhichFile AS STRING) +DECLARE FUNCTION GetDummyFile$ (WhichFile AS STRING) +DECLARE FUNCTION ErrorMessage$ (WhichError AS INTEGER) +DECLARE FUNCTION CountLines& (WhichFile AS STRING) +DECLARE FUNCTION YorN$ () + +' Var +DIM iOk AS INTEGER, iErr AS INTEGER, lStart AS LONG, lHowMany AS LONG, lSize AS LONG +DIM sFile AS STRING + +' Const +CONST ProgramName = "RemFLine (Remove File Lines) Enhanced V1.0" + +' ----------------------------- Main program cycle -------------------------------- +CLS +PRINT ProgramName +PRINT +PRINT "This program will remove as many lines of a text file as you state, starting" +PRINT "with the line number you also state. If the starting line number is beyond" +PRINT "total lines in the text file stated, then the process will be aborted. If the" +PRINT "quantity of lines stated to be deleted is beyond the total lines in the text" +PRINT "file, the process also will be aborted. The program will give you a message" +PRINT "if everything ran ok or if any error happened. Includes a function to count" +PRINT "how many lines has the intended file." +DO + PRINT + INPUT "Please, type the name of the file"; sFile + sFile = LTRIM$(RTRIM$(sFile)) + IF sFile <> "" THEN + lSize = CountLines&(sFile) + IF lSize > 0 THEN + PRINT "Delete starting on which line (Default=1, Max="; lSize; ")"; + INPUT lStart + + IF lStart = 0 THEN lStart = 1 + IF lStart < lSize THEN + PRINT "How many lines do you want to remove (Default=1, Max="; (lSize - lStart) + 1; ")"; + INPUT lHowMany + IF lHowMany = 0 THEN lHowMany = 1 + IF lHowMany + lStart <= lSize THEN + iOk = DeleteLinesFromFile%(sFile, lStart, lHowMany) + ELSE + iOk = 1 + END IF + ELSE + iOk = 2 + END IF + ELSEIF lSize = -1 THEN + iOk = 3 + ELSE + iOk = 4 ' The file is not a text file + END IF + ELSE + iOk = 5 ' Null file name not allowed + END IF + PRINT + PRINT ErrorMessage$(iOk) + PRINT "Do you want to try again? (Y/N)" +LOOP UNTIL YorN$ = "N" +'----------------End of Main program Cycle ---------------- + +END + +FileError: + iErr = ERR +RESUME NEXT + +FUNCTION CountLines& (WhichFile AS STRING) + ' Var + DIM iFile AS INTEGER + DIM l AS LONG, li AS LONG, j AS LONG, lFileSize AS LONG, lLines AS LONG + DIM sLine AS STRING, strR AS STRING + + ' This function will count how many lines has the file + IF FileExists%(WhichFile) THEN + strR = CHR$(13) + li = 1 + iFile = FREEFILE + sLine = SPACE$(128) + lLines = 0 + OPEN WhichFile FOR BINARY AS #iFile + lFileSize = LOF(iFile) + DO + IF (LOC(iFile) + LEN(sLine)) > lFileSize THEN + sLine = SPACE$(lFileSize - LOC(iFile)) + END IF + IF LEN(sLine) > 0 THEN + GET #iFile, , sLine + GOSUB AnalizeLine + END IF + LOOP UNTIL LEN(sLine) < 128 + CLOSE iFile + ELSE + lLines = -1 + END IF + + CountLines& = lLines + +EXIT FUNCTION + +AnalizeLine: + li = 1 + DO + l = INSTR(li, sLine, strR) + IF l > 0 THEN + lLines = lLines + 1 + li = l + 1 + END IF + LOOP UNTIL l = 0 +RETURN +END FUNCTION + +FUNCTION DeleteLinesFromFile% (WhichFile AS STRING, Start AS LONG, HowMany AS LONG) + ' Var + DIM lCount AS LONG, iFile AS INTEGER, iFile2 AS INTEGER, lhm AS LONG, iError AS INTEGER + DIM sLine AS STRING, sDummyFile AS STRING + + IF FileExists%(WhichFile) THEN + sDummyFile = GetDummyFile$(WhichFile) + + ' It is assumed a text file + iFile = FREEFILE + OPEN WhichFile FOR INPUT AS #iFile + + iFile2 = FREEFILE + OPEN sDummyFile FOR OUTPUT AS #iFile2 + + lhm = 0 + DO WHILE NOT EOF(iFile) + LINE INPUT #iFile, sLine + lCount = lCount + 1 + IF lCount >= Start AND lhm < HowMany THEN + lhm = lhm + 1 + ELSE + PRINT #iFile2, sLine + END IF + LOOP + + CLOSE iFile2, iFile + + ' Check if everything went ok or not + iError = 0 + IF lCount < Start THEN + iError = 2 ' Full file is shorter than the start line stated, + ' process will be aborted. + ELSEIF lhm < HowMany THEN + iError = 1 ' File was shorter than lines requested to be removed, + ' process will be aborted. + END IF + + IF iError > 0 THEN + KILL sDummyFile ' Process aborted + ELSE + KILL WhichFile + NAME sDummyFile AS WhichFile + END IF + ELSE + iError = 3 ' The file doesn't exist. The process is aborted. + END IF + + DeleteLinesFromFile% = iError + +END FUNCTION + +FUNCTION ErrorMessage$ (WhichError AS INTEGER) + ' Var + DIM sError AS STRING + + SELECT CASE WhichError + CASE 0: sError = "Everything went Ok. Lines removed from file." + CASE 1: sError = "File is shorter than the number of lines stated to remove. Process aborted." + CASE 2: sError = "Whole file is shorter than the starting point stated. Process aborted." + CASE 3: sError = "File doesn't exist. Process aborted." + CASE 4: sError = "The file doesn't seem to be a text file. Process aborted." + CASE 5: sError = "You need to provide a valid file name, please." + END SELECT + + ErrorMessage$ = sError +END FUNCTION + +FUNCTION FileExists% (WhichFile AS STRING) + ' Var + DIM iFile AS INTEGER + DIM iItExists AS INTEGER + SHARED iErr AS INTEGER + + ON ERROR GOTO FileError + iFile = FREEFILE + iErr = 0 + OPEN WhichFile FOR BINARY AS #iFile + IF iErr = 0 THEN + iItExists = LOF(iFile) > 0 + CLOSE #iFile + + IF NOT iItExists THEN + KILL WhichFile + END IF + END IF + ON ERROR GOTO 0 + FileExists% = iItExists + +END FUNCTION + +FUNCTION GetDummyFile$ (WhichFile AS STRING) + ' Var + DIM i AS INTEGER, j AS INTEGER + + ' Gets the path specified in WhichFile + i = 1 + DO + j = INSTR(i, WhichFile, "\") + IF j > 0 THEN i = j + 1 + LOOP UNTIL j = 0 + + GetDummyFile$ = LEFT$(WhichFile, i - 1) + "$dummyf$.tmp" +END FUNCTION + +FUNCTION YorN$ () + ' Var + DIM sYorN AS STRING + + DO + sYorN = UCASE$(INPUT$(1)) + IF INSTR("YN", sYorN) = 0 THEN + BEEP + END IF + LOOP UNTIL sYorN = "Y" OR sYorN = "N" + + YorN$ = sYorN +END FUNCTION diff --git a/Task/Remove-lines-from-a-file/C-sharp/remove-lines-from-a-file.cs b/Task/Remove-lines-from-a-file/C-sharp/remove-lines-from-a-file.cs new file mode 100644 index 0000000000..e3f429c176 --- /dev/null +++ b/Task/Remove-lines-from-a-file/C-sharp/remove-lines-from-a-file.cs @@ -0,0 +1,19 @@ +using System; +using System.IO; + +public class Rosetta +{ + /* C# 6 version: + public static void Main() => RemoveLines("foobar.txt", start: 1, count: 2); + */ + + public static void Main() { + RemoveLines("foobar.txt", start: 1, count: 2); + } + + static void RemoveLines(string filename, int start, int count = 1) { + //Reads and writes one line at a time, so no memory overhead. + File.WriteAllLines(filename, File.ReadAllLines(filename) + .Where((line, index) => index < start - 1 || index >= start + count - 1)); + } +} diff --git a/Task/Remove-lines-from-a-file/Elixir/remove-lines-from-a-file.elixir b/Task/Remove-lines-from-a-file/Elixir/remove-lines-from-a-file.elixir new file mode 100644 index 0000000000..ec4212775d --- /dev/null +++ b/Task/Remove-lines-from-a-file/Elixir/remove-lines-from-a-file.elixir @@ -0,0 +1,29 @@ +defmodule RC do + def remove_lines(filename, start, number) do + File.open!(filename, [:read], fn file -> + remove_lines(file, start, number, IO.read(file, :line)) + end) + end + + defp remove_lines(_file, 0, 0, :eof), do: :ok + defp remove_lines(_file, _, _, :eof) do + IO.puts(:stderr, "Warning: End of file encountered before all lines removed") + end + defp remove_lines(file, 0, 0, line) do + IO.write line + remove_lines(file, 0, 0, IO.read(file, :line)) + end + defp remove_lines(file, 0, number, _line) do + remove_lines(file, 0, number-1, IO.read(file, :line)) + end + defp remove_lines(file, start, number, line) do + IO.write line + remove_lines(file, start-1, number, IO.read(file, :line)) + end +end + +[filename, start, number] = System.argv +IO.puts "before:" +IO.puts File.read!(filename) +IO.puts "after:" +RC.remove_lines(filename, String.to_integer(start), String.to_integer(number) diff --git a/Task/Remove-lines-from-a-file/NewLISP/remove-lines-from-a-file.newlisp b/Task/Remove-lines-from-a-file/NewLISP/remove-lines-from-a-file.newlisp new file mode 100644 index 0000000000..ca92368137 --- /dev/null +++ b/Task/Remove-lines-from-a-file/NewLISP/remove-lines-from-a-file.newlisp @@ -0,0 +1,35 @@ +(context 'ABC) + +(define (remove-lines-from-a-file filename start num) + (setf new-content "") + (setf row-counter 0) + (setf start-delete-row start) + (setf end-delete-row (+ start num -1)) + (setf file-content (read-file filename)) + (setf max-rows (length (parse file-content "\n" 0))) + + (cond + ((<= start 0) + (println "Start line must be >= 1. Value passed: " start)) + ((<= num 0) + (println "# of lines to remove must be >= 1. Value passed: " num)) + ((> start max-rows) + (println "Start line must be <= " max-rows ". Value passed: " start)) + ((> end-delete-row max-rows) + (println "Not so much lines available to be removed. Max " (- max-rows start-delete-row) ". Value passed: " num)) + (true + (dolist (row (parse file-content "\n" 0)) + (++ row-counter) + (if (or (< row-counter start-delete-row) (> row-counter end-delete-row)) + (setf new-content (append new-content row "\n")) + ) + ) + (write-file filename new-content) + ) + ) +) + +(context 'MAIN) + +(ABC:remove-lines-from-a-file "foobar.txt" 8 3) +(exit) diff --git a/Task/Remove-lines-from-a-file/PureBasic/remove-lines-from-a-file.purebasic b/Task/Remove-lines-from-a-file/PureBasic/remove-lines-from-a-file.purebasic new file mode 100644 index 0000000000..fd5e091833 --- /dev/null +++ b/Task/Remove-lines-from-a-file/PureBasic/remove-lines-from-a-file.purebasic @@ -0,0 +1,69 @@ +; Contents of file 'input.txt' before deletion of lines : +; +; cat +; dog +; giraffe +; lion +; mouse +; pig +; tiger +; zebra + +EnableExplicit + +#Output$ = "output.txt"; insert path to temporary output file + +Procedure RemoveLines(Input$, StartLine, NbLines) + Protected lineCount = 0 + Protected endline = StartLine + NbLines - 1 + Protected row$ + + If Not ReadFile(0, Input$) + PrintN("Error opening input file") + ProcedureReturn + EndIf + + If Not CreateFile(1, #Output$) + PrintN("Error creating output file") + CloseFile(0) + ProcedureReturn + EndIf + + While Not Eof(0) + row$ = ReadString(0) + lineCount + 1 + If lineCount < StartLine Or lineCount > endLine + WriteStringN(1, row$) + EndIf + Wend + + If endLine > lineCount + PrintN("Attempted to remove lines beyond the end of the file") + ; but still allow removal of lines (if any) up to the end of the file + EndIf + + CloseFile(0) + CloseFile(1) + + If Not DeleteFile(Input$) + PrintN("Unable to delete input file so output file can be renamed") + ProcedureReturn + EndIf + + If Not RenameFile(#Output$, Input$) + PrintN("Unable to rename output file") + EndIf + +EndProcedure + +Define fInput$ + +If OpenConsole() + ; delete lines 2,3 amnd 4 of 'input.txt' + fInput$ = "input.txt"; insert path to input file + RemoveLines(fInput$, 2, 3) + PrintN("") + PrintN("Press any key to close the console") + Repeat: Delay(10) : Until Inkey() <> "" + CloseConsole() +EndIf diff --git a/Task/Remove-lines-from-a-file/REXX/remove-lines-from-a-file.rexx b/Task/Remove-lines-from-a-file/REXX/remove-lines-from-a-file.rexx index e963ecb0f4..c227a1b196 100644 --- a/Task/Remove-lines-from-a-file/REXX/remove-lines-from-a-file.rexx +++ b/Task/Remove-lines-from-a-file/REXX/remove-lines-from-a-file.rexx @@ -1,23 +1,23 @@ -/*REXX program reads/writes a specified file and delete(s) specified record(s)*/ -parse arg iFID ',' N ',' many /*input FID, start of delete, how many.*/ -if iFID='' then call er "no input fileID specified." /*oops.*/ -if N='' then call er "no start number specified." /*oops.*/ -if many='' then many=1 /*Not specified? Assume delete 1 line.*/ -stop=N+many-1 /*calculate high end of delete range.*/ -oFID=iFID'.$$$' /*temp name (fileID) of the output file*/ -#=0 /*the count (so far) of records written*/ - do j=1 while lines(iFID)\==0 /*J is the record# (line) being read.*/ - @=linein(iFID) /*read a record (line) from input file.*/ - if j>=N & j<=stop then iterate /*if it's in the range, then ignore it.*/ - call lineout oFID,@; #=#+1 /*write record (line);, bump write cnt.*/ - end /*j*/ /* [↑] by ignoring it is to delete it.*/ -j=j-1 /*adjust J (because of DO loop advance)*/ +/*REXX program reads and writes a specified file and delete(s) specified record(s). */ +parse arg iFID ',' N "," many . /*input FID, start of delete, how many.*/ +if iFID='' then call er "no input fileID specified." /*oops.*/ +if N='' then call er "no start number specified." /*oops.*/ +if many='' then many=1 /*Not specified? Assume delete 1 line.*/ +stop=N+many-1 /*calculate high end of delete range.*/ +oFID=iFID'.$$$' /*temp name (fileID) of the output file*/ +#=0 /*the count (so far) of records written*/ + do j=1 while lines(iFID)\==0 /*J is the record# (line) being read.*/ + @=linein(iFID) /*read a record (line) from input file.*/ + if j>=N & j<=stop then iterate /*if it's in the range, then ignore it.*/ + call lineout oFID,@; #=#+1 /*write record (line);, bump write cnt.*/ + end /*j*/ /* [↑] by ignoring it is to delete it.*/ +j=j-1 /*adjust J (because of DO loop advance)*/ if j&2 "$0: $*" exit 1 } @@ -8,8 +8,9 @@ error() { file=$1 start=$2 -end=$3 +count=$3 +end=`expr $start + $count - 1` -[ -f $file ] || error "$file does not exist" +[ -f "$file" ] || error "$file does not exist" -sed $start,${end}d $file >/tmp/$$ && mv /tmp/$$ $file +sed "$start,${end}d" "$file" >/tmp/$$ && mv /tmp/$$ "$file" diff --git a/Task/Remove-lines-from-a-file/UNIX-Shell/remove-lines-from-a-file-2.sh b/Task/Remove-lines-from-a-file/UNIX-Shell/remove-lines-from-a-file-2.sh index d9297662af..a04e6b9bde 100644 --- a/Task/Remove-lines-from-a-file/UNIX-Shell/remove-lines-from-a-file-2.sh +++ b/Task/Remove-lines-from-a-file/UNIX-Shell/remove-lines-from-a-file-2.sh @@ -1 +1 @@ -sed -i $start,${end}d $file +sed -i "$start,${end}d" "$file" diff --git a/Task/Rename-a-file/00DESCRIPTION b/Task/Rename-a-file/00DESCRIPTION index 1cc8e88e62..9aba3715f5 100644 --- a/Task/Rename-a-file/00DESCRIPTION +++ b/Task/Rename-a-file/00DESCRIPTION @@ -1,9 +1,14 @@ -In this task, the job is to rename the file called "input.txt" into "output.txt" and a directory called "docs" into "mydocs". +;Task: +Rename: +:::*   a file called     '''input.txt'''     into     '''output.txt'''     and +:::*   a directory called     '''docs'''     into     '''mydocs'''. -This should be done twice: -once "here", i.e. in the current working directory -and once in the filesystem root. + +This should be done twice:   +once "here", i.e. in the current working directory and once in the filesystem root. It can be assumed that the user has the rights to do so. + (In unix-type systems, only the user root would have -sufficient permissions in the filesystem root) +sufficient permissions in the filesystem root.) +

    diff --git a/Task/Rename-a-file/Elixir/rename-a-file.elixir b/Task/Rename-a-file/Elixir/rename-a-file.elixir new file mode 100644 index 0000000000..e2bc308733 --- /dev/null +++ b/Task/Rename-a-file/Elixir/rename-a-file.elixir @@ -0,0 +1,4 @@ +File.rename "input.txt","output.txt" +File.rename "docs", "mydocs" +File.rename "/input.txt", "/output.txt" +File.rename "/docs", "/mydocs" diff --git a/Task/Rename-a-file/PARI-GP/rename-a-file.pari b/Task/Rename-a-file/PARI-GP/rename-a-file-1.pari similarity index 100% rename from Task/Rename-a-file/PARI-GP/rename-a-file.pari rename to Task/Rename-a-file/PARI-GP/rename-a-file-1.pari diff --git a/Task/Rename-a-file/PARI-GP/rename-a-file-2.pari b/Task/Rename-a-file/PARI-GP/rename-a-file-2.pari new file mode 100644 index 0000000000..d950dd3bb3 --- /dev/null +++ b/Task/Rename-a-file/PARI-GP/rename-a-file-2.pari @@ -0,0 +1,2 @@ +install("rename","iss","rename"); +rename("input.txt", "output.txt"); diff --git a/Task/Rename-a-file/Rust/rename-a-file.rust b/Task/Rename-a-file/Rust/rename-a-file.rust new file mode 100644 index 0000000000..d7e2f0765f --- /dev/null +++ b/Task/Rename-a-file/Rust/rename-a-file.rust @@ -0,0 +1,9 @@ +use std::fs; + +fn main() { + let err = "File move error"; + fs::rename("input.txt", "output.txt").ok().expect(err); + fs::rename("docs", "mydocs").ok().expect(err); + fs::rename("/input.txt", "/output.txt").ok().expect(err); + fs::rename("/docs", "/mydocs").ok().expect(err); +} diff --git a/Task/Rename-a-file/TXR/rename-a-file.txr b/Task/Rename-a-file/TXR/rename-a-file.txr index 7a2252dc8a..d8c0783dc0 100644 --- a/Task/Rename-a-file/TXR/rename-a-file.txr +++ b/Task/Rename-a-file/TXR/rename-a-file.txr @@ -1,5 +1,5 @@ -@(do (rename-path "input.txt" "output.txt") - ;; Windows (MinGW based port) - (rename-path "C:\\input.txt" "C:\\output.txt") - ;; Unix; Windows (Cygwin port) - (rename-path "/input.txt" "/output.txt")) +(rename-path "input.txt" "output.txt") +;; Windows (MinGW based port) +(rename-path "C:\\input.txt" "C:\\output.txt") +;; Unix; Windows (Cygwin port) +(rename-path "/input.txt" "/output.txt")) diff --git a/Task/Rendezvous/Perl-6/rendezvous.pl6 b/Task/Rendezvous/Perl-6/rendezvous.pl6 new file mode 100644 index 0000000000..ec854ea67c --- /dev/null +++ b/Task/Rendezvous/Perl-6/rendezvous.pl6 @@ -0,0 +1,52 @@ +class X::OutOfInk is Exception { + method message() { "Printer out of ink" } +} + +class Printer { + has Str $.id; + has Int $.ink = 5; + has Lock $!lock .= new; + has ::?CLASS $.fallback; + + method print ($line) { + $!lock.protect: { + if $!ink { say "$!id: $line"; $!ink-- } + elsif $!fallback { $!fallback.print: $line } + else { die X::OutOfInk.new } + } + } +} + +my $printer = + Printer.new: id => 'main', fallback => + Printer.new: id => 'reserve'; + +sub client ($id, @lines) { + start { + for @lines { + $printer.print: $_; + CATCH { + when X::OutOfInk { note "<$id stops for lack of ink>"; exit } + } + } + note "<$id is done>"; + } +} + +await + client('Humpty', q:to/END/.lines), + Humpty Dumpty sat on a wall. + Humpty Dumpty had a great fall. + All the king's horses and all the king's men, + Couldn't put Humpty together again. + END + client('Goose', q:to/END/.lines); + Old Mother Goose, + When she wanted to wander, + Would ride through the air, + On a very fine gander. + Jack's mother came in, + And caught the goose soon, + And mounting its back, + Flew up to the moon. + END diff --git a/Task/Rep-string/00DESCRIPTION b/Task/Rep-string/00DESCRIPTION index 0c24faa753..26ebb672dc 100644 --- a/Task/Rep-string/00DESCRIPTION +++ b/Task/Rep-string/00DESCRIPTION @@ -1,22 +1,28 @@ Given a series of ones and zeroes in a string, define a repeated string or ''rep-string'' as a string which is created by repeating a substring of the ''first'' N characters of the string ''truncated on the right to the length of the input string, and in which the substring appears repeated at least twice in the original''. -For example, the string '10011001100' is a rep-string as the leftmost four characters of '1001' are repeated three times and truncated on the right to give the original string. +For example, the string     '''10011001100'''     is a rep-string as the leftmost four characters of     '''1001'''     are repeated three times and truncated on the right to give the original string. -Note that the requirement for having the repeat occur two or more times means that the repeating unit is ''never'' longer than half the length of the input string. +Note that the requirement for having the repeat occur two or more times means that the repeating unit is   ''never''   longer than half the length of the input string. -The task is to: -* Write a function/subroutine/method/... that takes a string and returns an indication of if it is a rep-string and the repeated string. (Either the string that is repeated, or the number of repeated characters would suffice). + +;Task: +* Write a function/subroutine/method/... that takes a string and returns an indication of if it is a rep-string and the repeated string.   (Either the string that is repeated, or the number of repeated characters would suffice). * There may be multiple sub-strings that make a string a rep-string - in that case an indication of all, or the longest, or the shortest would suffice. * Use the function to indicate the repeating substring if any, in the following: -
    '1001110011'
    -'1110111011'
    -'0010010010'
    -'1010101010'
    -'1111111111'
    -'0100101101'
    -'0100100'
    -'101'
    -'11'
    -'00'
    -'1'
    +
    +
    +1001110011
    +1110111011
    +0010010010
    +1010101010
    +1111111111
    +0100101101
    +0100100
    +101
    +11
    +00
    +1
    +
    +
    * Show your output on this page. +

    diff --git a/Task/Rep-string/Common-Lisp/rep-string-1.lisp b/Task/Rep-string/Common-Lisp/rep-string-1.lisp new file mode 100644 index 0000000000..d9777aa004 --- /dev/null +++ b/Task/Rep-string/Common-Lisp/rep-string-1.lisp @@ -0,0 +1,18 @@ +(ql:quickload :alexandria) +(defun rep-stringv (a-str &optional (max-rotation (floor (/ (length a-str) 2)))) + ;; Exit condition if no repetition found. + (cond ((< max-rotation 1) "Not a repeating string") + ;; Two checks: + ;; 1. Truncated string must be equal to rotation by repetion size. + ;; 2. Remaining chars (rest-str) are identical to starting chars (beg-str) + ((let* ((trunc (* max-rotation (truncate (length a-str) max-rotation))) + (truncated-str (subseq a-str 0 trunc)) + (rest-str (subseq a-str trunc)) + (beg-str (subseq a-str 0 (rem (length a-str) max-rotation)))) + (and (string= beg-str rest-str) + (string= (alexandria:rotate (copy-seq truncated-str) max-rotation) + truncated-str))) + ;; If both checks pass, return the repeting string. + (subseq a-str 0 max-rotation)) + ;; Recurse function reducing length of rotation. + (t (rep-stringv a-str (1- max-rotation))))) diff --git a/Task/Rep-string/Common-Lisp/rep-string-2.lisp b/Task/Rep-string/Common-Lisp/rep-string-2.lisp new file mode 100644 index 0000000000..91061333d1 --- /dev/null +++ b/Task/Rep-string/Common-Lisp/rep-string-2.lisp @@ -0,0 +1,15 @@ +(setf test-strings '("1001110011" + "1110111011" + "0010010010" + "1010101010" + "1111111111" + "0100101101" + "0100100" + "101" + "11" + "00" + "1" + )) + +(loop for item in test-strings + collecting (cons item (rep-stringv item))) diff --git a/Task/Rep-string/Elixir/rep-string.elixir b/Task/Rep-string/Elixir/rep-string.elixir new file mode 100644 index 0000000000..37eea758e4 --- /dev/null +++ b/Task/Rep-string/Elixir/rep-string.elixir @@ -0,0 +1,29 @@ +defmodule Rep_string do + def find(""), do: IO.puts "String was empty (no repetition)" + def find(str) do + IO.puts str + rep_pos = Enum.find(div(String.length(str),2)..1, fn pos -> + String.starts_with?(str, String.slice(str, pos..-1)) + end) + if rep_pos && rep_pos>0 do + IO.puts String.duplicate(" ", rep_pos) <> String.slice(str, 0, rep_pos) + else + IO.puts "(no repetition)" + end + IO.puts "" + end +end + +strs = ~w(1001110011 + 1110111011 + 0010010010 + 1010101010 + 1111111111 + 0100101101 + 0100100 + 101 + 11 + 00 + 1) + +Enum.each(strs, fn str -> Rep_string.find(str) end) diff --git a/Task/Rep-string/PicoLisp/rep-string-1.l b/Task/Rep-string/PicoLisp/rep-string-1.l new file mode 100644 index 0000000000..4684d26d86 --- /dev/null +++ b/Task/Rep-string/PicoLisp/rep-string-1.l @@ -0,0 +1,11 @@ +(de repString (Str) + (let Lst (chop Str) + (for (N (/ (length Lst) 2) (gt0 N) (dec N)) + (T + (use (Lst X) + (let H (cut N 'Lst) + (loop + (setq X (cut N 'Lst)) + (NIL (head X H)) + (NIL Lst T) ) ) ) + N ) ) ) ) diff --git a/Task/Rep-string/PicoLisp/rep-string-2.l b/Task/Rep-string/PicoLisp/rep-string-2.l new file mode 100644 index 0000000000..258c02cbf5 --- /dev/null +++ b/Task/Rep-string/PicoLisp/rep-string-2.l @@ -0,0 +1,12 @@ +(test 5 (repString "1001110011")) +(test 4 (repString "1110111011")) +(test 3 (repString "0010010010")) +(test 4 (repString "1010101010")) +(test 5 (repString "1111111111")) +(test NIL (repString "0100101101")) +(test 3 (repString "0100100")) +(test NIL (repString "101")) +(test 1 (repString "11")) +(test 1 (repString "00")) +(test NIL (repString "1")) +(test NIL (repString "0100101")) diff --git a/Task/Rep-string/REXX/rep-string-2.rexx b/Task/Rep-string/REXX/rep-string-2.rexx index c6142a9905..77d95971e2 100644 --- a/Task/Rep-string/REXX/rep-string-2.rexx +++ b/Task/Rep-string/REXX/rep-string-2.rexx @@ -1,17 +1,16 @@ -/*REXX pgm determines if a string is a repString, returns min. length repStr. */ -parse arg s /*get optional strings from the C.L. */ +/*REXX pgm determines if a string is a repString, it returns minimum length repString.*/ +parse arg s /*get optional strings from the C.L. */ if s='' then s=1001110011 1110111011 0010010010 1010101010 1111111111 0100101101 0100100 101 11 00 1 45 - /* [↑] S not specified? Use defaults*/ - do k=1 for words(s); _=word(s,k); w=length(_) /*process binary strings.*/ - say right(_,max(25,w)) repString(_) /*show repString & result*/ - end /*k*/ /* [↑] the "result" may be negatory.*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -repString: procedure; parse arg x; L=length(x) -if \datatype(x,'B') then return " ***error!*** string isn't a binary string." - - do j=1 for L-1 while j<=L%2; $=left(x,j); $$=copies($,L) - if left($$,L)==x then return ' rep string=' left($,15) '[length' j"]" - end /*j*/ /* [↑] we have found a good repString.*/ - -return ' (no repetitions)' /*(sigh)··· a failure to find repString*/ + /* [↑] S not specified? Use defaults*/ + do k=1 for words(s); _=word(s,k); w=length(_) /*process binary strings. */ + say right(_,max(25,w)) repString(_) /*show repString & result.*/ + end /*k*/ /* [↑] the "result" may be negatory.*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +repString: procedure; parse arg x; L=length(x); @rep=' rep string=' + if \datatype(x,'B') then return " ***error*** string isn't a binary string." + h=L%2 + do j=1 for L-1 while j<=h; $=left(x,j); $$=copies($,L) + if left($$,L)==x then return @rep left($,15) "[length" j']' + end /*j*/ /* [↑] we have found a good repString.*/ + return ' (no repetitions)' /*failure to find repString.*/ diff --git a/Task/Repeat-a-string/00DESCRIPTION b/Task/Repeat-a-string/00DESCRIPTION index c271ccd070..cb024593f3 100644 --- a/Task/Repeat-a-string/00DESCRIPTION +++ b/Task/Repeat-a-string/00DESCRIPTION @@ -1,3 +1,6 @@ -Take a string and repeat it some number of times. Example: repeat("ha", 5) => "hahahahaha" +Take a string and repeat it some number of times. + +Example: repeat("ha", 5)   =>   "hahahahaha" If there is a simpler/more efficient way to repeat a single “character” (i.e. creating a string filled with a certain character), you might want to show that as well (i.e. repeat-char("*", 5) => "*****"). +

    diff --git a/Task/Repeat-a-string/APL/repeat-a-string-1.apl b/Task/Repeat-a-string/APL/repeat-a-string-1.apl new file mode 100644 index 0000000000..f5e7c3eda3 --- /dev/null +++ b/Task/Repeat-a-string/APL/repeat-a-string-1.apl @@ -0,0 +1,2 @@ + 10⍴'ha' +hahahahaha diff --git a/Task/Repeat-a-string/APL/repeat-a-string-2.apl b/Task/Repeat-a-string/APL/repeat-a-string-2.apl new file mode 100644 index 0000000000..c72478d1c5 --- /dev/null +++ b/Task/Repeat-a-string/APL/repeat-a-string-2.apl @@ -0,0 +1,3 @@ + REPEAT←{(⍺×⍴⍵)⍴⍵} + 5 REPEAT 'ha' +hahahahaha diff --git a/Task/Repeat-a-string/AppleScript/repeat-a-string.applescript b/Task/Repeat-a-string/AppleScript/repeat-a-string-1.applescript similarity index 59% rename from Task/Repeat-a-string/AppleScript/repeat-a-string.applescript rename to Task/Repeat-a-string/AppleScript/repeat-a-string-1.applescript index 98be0e84ee..dda8153011 100644 --- a/Task/Repeat-a-string/AppleScript/repeat-a-string.applescript +++ b/Task/Repeat-a-string/AppleScript/repeat-a-string-1.applescript @@ -1,5 +1,5 @@ set str to "ha" set final_string to "" repeat 5 times - set final_string to final_string & str + set final_string to final_string & str end repeat diff --git a/Task/Repeat-a-string/AppleScript/repeat-a-string-2.applescript b/Task/Repeat-a-string/AppleScript/repeat-a-string-2.applescript new file mode 100644 index 0000000000..14509c1f68 --- /dev/null +++ b/Task/Repeat-a-string/AppleScript/repeat-a-string-2.applescript @@ -0,0 +1,17 @@ +on run + nreps("ha", 50000) +end run + + +-- String -> Int -> String +on nreps(s, n) + set o to "" + if n < 1 then return o + + repeat while (n > 1) + if (n mod 2) > 0 then set o to o & s + set n to (n div 2) + set s to (s & s) + end repeat + return o & s +end nreps diff --git a/Task/Repeat-a-string/Applesoft-BASIC/repeat-a-string.applesoft b/Task/Repeat-a-string/Applesoft-BASIC/repeat-a-string.applesoft new file mode 100644 index 0000000000..21bad97e6c --- /dev/null +++ b/Task/Repeat-a-string/Applesoft-BASIC/repeat-a-string.applesoft @@ -0,0 +1,3 @@ +FOR I = 1 TO 5 : S$ = S$ + "HA" : NEXT + +? "X" SPC(20) "X" diff --git a/Task/Repeat-a-string/Befunge/repeat-a-string.bf b/Task/Repeat-a-string/Befunge/repeat-a-string.bf new file mode 100644 index 0000000000..c1b642cf83 --- /dev/null +++ b/Task/Repeat-a-string/Befunge/repeat-a-string.bf @@ -0,0 +1,4 @@ +v> ">:#,_v +>29*+00p>~:"0"- #v_v $ + v ^p0p00:-1g00< $ > + v p00&p0-1g00+4*65< >00g1-:00p#^_@ diff --git a/Task/Repeat-a-string/COBOL/repeat-a-string.cobol b/Task/Repeat-a-string/COBOL/repeat-a-string.cobol new file mode 100644 index 0000000000..b4888774d0 --- /dev/null +++ b/Task/Repeat-a-string/COBOL/repeat-a-string.cobol @@ -0,0 +1,9 @@ +IDENTIFICATION DIVISION. +PROGRAM-ID. REPEAT-PROGRAM. +DATA DIVISION. +WORKING-STORAGE SECTION. +77 HAHA PIC A(10). +PROCEDURE DIVISION. + MOVE ALL 'ha' TO HAHA. + DISPLAY HAHA. + STOP RUN. diff --git a/Task/Repeat-a-string/Elena/repeat-a-string.elena b/Task/Repeat-a-string/Elena/repeat-a-string.elena new file mode 100644 index 0000000000..b029d5ee7b --- /dev/null +++ b/Task/Repeat-a-string/Elena/repeat-a-string.elena @@ -0,0 +1,8 @@ +#import system. +#import system'routines. +#import extensions. + +#symbol program = +[ + #var s := 0 repeat &till:5 &each: n [ "ha" ] summarize:(String new) literal. +]. diff --git a/Task/Repeat-a-string/Glee/repeat-a-string-1.glee b/Task/Repeat-a-string/Glee/repeat-a-string-1.glee new file mode 100644 index 0000000000..ef45d79aa7 --- /dev/null +++ b/Task/Repeat-a-string/Glee/repeat-a-string-1.glee @@ -0,0 +1 @@ +'*' %% 5 diff --git a/Task/Repeat-a-string/Glee/repeat-a-string-2.glee b/Task/Repeat-a-string/Glee/repeat-a-string-2.glee new file mode 100644 index 0000000000..85044b7dd1 --- /dev/null +++ b/Task/Repeat-a-string/Glee/repeat-a-string-2.glee @@ -0,0 +1,4 @@ +'ha' => Str; +Str# => Len; +1..Len %% (Len * 5) => Idx; +Str [Idx] $; diff --git a/Task/Repeat-a-string/Glee/repeat-a-string-3.glee b/Task/Repeat-a-string/Glee/repeat-a-string-3.glee new file mode 100644 index 0000000000..ca6cc70113 --- /dev/null +++ b/Task/Repeat-a-string/Glee/repeat-a-string-3.glee @@ -0,0 +1 @@ +'ha'=>S[1..(S#)%%(S# *5)] diff --git a/Task/Repeat-a-string/PARI-GP/repeat-a-string-3.pari b/Task/Repeat-a-string/PARI-GP/repeat-a-string-3.pari new file mode 100644 index 0000000000..4e380b28ec --- /dev/null +++ b/Task/Repeat-a-string/PARI-GP/repeat-a-string-3.pari @@ -0,0 +1,8 @@ +repeat(s,n)={ + if(n<4, return(concat(vector(n,i, s)))); + if(n%2, + Str(repeat(Str(s,s),n\2),s) + , + repeat(Str(s,s),n\2) + ); +} diff --git a/Task/Repeat-a-string/PARI-GP/repeat-a-string-4.pari b/Task/Repeat-a-string/PARI-GP/repeat-a-string-4.pari new file mode 100644 index 0000000000..b62aee54c2 --- /dev/null +++ b/Task/Repeat-a-string/PARI-GP/repeat-a-string-4.pari @@ -0,0 +1,20 @@ +\\ Repeat a string str the specified number of times ntimes and return composed string. +\\ 3/3/2016 aev +srepeat(str,ntimes)={ +my(srez=str,nt=ntimes-1); +if(ntimes<1||#str==0,return("")); +if(ntimes==1,return(str)); +for(i=1,nt, srez=concat(srez,str)); +return(srez); +} + +{ +\\ TESTS +print(" *** Testing srepeat:"); +print("1.",srepeat("a",5)); +print("2.",srepeat("ab",5)); +print("3.",srepeat("c",1)); +print("4.|",srepeat("d",0),"|"); +print("5.|",srepeat("",5),"|"); +print1("6."); for(i=1,10000000, srepeat("e",10)); +} diff --git a/Task/Resistor-mesh/00DESCRIPTION b/Task/Resistor-mesh/00DESCRIPTION index 1d51b6b80d..a81b450dc3 100644 --- a/Task/Resistor-mesh/00DESCRIPTION +++ b/Task/Resistor-mesh/00DESCRIPTION @@ -1,6 +1,10 @@ -[[image:resistor-mesh.svg]] +[[image:resistor-mesh.svg|300px||right]] -Given 10 × 10 grid nodes interconnected by 1Ω resistors as shown, -find the resistance between point A and B. +;Task: +Given   10×10   grid nodes   (as shown in the image)   interconnected by     resistors as shown, +
    find the resistance between point   '''A'''   and   '''B'''. -See also [[http://xkcd.com/356/]] + +;See also: +*   (humor, nerd sniping)   [http://xkcd.com/356/ xkcd.com cartoon] +

    diff --git a/Task/Resistor-mesh/Haskell/resistor-mesh.hs b/Task/Resistor-mesh/Haskell/resistor-mesh.hs new file mode 100644 index 0000000000..c60e257400 --- /dev/null +++ b/Task/Resistor-mesh/Haskell/resistor-mesh.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE ParallelListComp #-} +import Numeric.LinearAlgebra (linearSolve, toDense, (!), flatten) +import Data.Monoid ((<>), Sum(..)) + +rMesh n (ar, ac) (br, bc) + | n < 2 = Nothing + | any (\x -> x < 1 || x > n) [ar, ac, br, bc] = Nothing + | otherwise = between a b <$> voltage + where + a = (ac - 1) + n*(ar - 1) + b = (bc - 1) + n*(br - 1) + + between x y v = abs (v ! a - v ! b) + + voltage = flatten <$> linearSolve matrixG current + + matrixG = toDense $ concat [ element row col node + | row <- [1..n], col <- [1..n] + | node <- [0..] ] + + element row col node = + let (Sum c, elements) = + (Sum 1, [((node, node-n), -1)]) `when` (row > 1) <> + (Sum 1, [((node, node+n), -1)]) `when` (row < n) <> + (Sum 1, [((node, node-1), -1)]) `when` (col > 1) <> + (Sum 1, [((node, node+1), -1)]) `when` (col < n) + in [((node, node), c)] <> elements + + x `when` p = if p then x else mempty + + current = toDense [ ((a, 0), -1) , ((b, 0), 1) , ((n^2-1, 0), 0) ] diff --git a/Task/Resistor-mesh/J/resistor-mesh-1.j b/Task/Resistor-mesh/J/resistor-mesh-1.j index 57d25e8993..0563765fe8 100644 --- a/Task/Resistor-mesh/J/resistor-mesh-1.j +++ b/Task/Resistor-mesh/J/resistor-mesh-1.j @@ -2,9 +2,11 @@ nodes=: 10 10 #: i. 100 nodeA=: 1 1 nodeB=: 6 7 +NB. verb to pair up coordinates along a specific offset conn =: [: (#~ e.~/@|:~&0 2) ([ ,: +)"1 -ref =: ~. nodeA,nodes-.nodeB -wiring=: /:~ ref i. ,/ nodes conn"2 1 (,-)=i.2 -Yii=: _1 _1 }. (* =@i.@#) #/.~ {."1 wiring -Yij=: - _1 _1 }. 1:`(<"1@[)`]}&(+/~ 0*i.1+#ref) wiring -Y=: Yii+Yij + +ref =: ~. nodeA,nodes-.nodeB NB. all nodes, with A first and B omitted +wiring=: /:~ ref i. ,/ nodes conn"2 1 (,-)=i.2 NB. connected pairs (indices into ref) +Yii=: (* =@i.@#) #/.~ {."1 wiring NB. diagonal of Y represents connections to B +Yij=: -1:`(<"1@[)`]}&(+/~ 0*i.1+#ref) wiring NB. off diagonal of Y represents wiring +Y=: _1 _1 }. Yii+Yij diff --git a/Task/Resistor-mesh/J/resistor-mesh-4.j b/Task/Resistor-mesh/J/resistor-mesh-4.j new file mode 100644 index 0000000000..b712e27bc2 --- /dev/null +++ b/Task/Resistor-mesh/J/resistor-mesh-4.j @@ -0,0 +1,28 @@ + 3 3 #: i.9 +0 0 +0 1 +0 2 +1 0 +1 1 +1 2 +2 0 +2 1 +2 2 + (3 3 #: i.9) conn 0 1 +0 0 +0 1 + +0 1 +0 2 + +1 0 +1 1 + +1 1 +1 2 + +2 0 +2 1 + +2 1 +2 2 diff --git a/Task/Resistor-mesh/Perl-6/resistor-mesh.pl6 b/Task/Resistor-mesh/Perl-6/resistor-mesh.pl6 index 629bb6ca5d..9788c78739 100644 --- a/Task/Resistor-mesh/Perl-6/resistor-mesh.pl6 +++ b/Task/Resistor-mesh/Perl-6/resistor-mesh.pl6 @@ -20,7 +20,7 @@ sub force-v(@v) { sub calc_diff(@v, @d, Int $w, Int $h) { my $total = 0; - for ^$h X ^$w -> $i, $j { + for (flat ^$h X ^$w) -> $i, $j { my @neighbors = grep *.defined, @v[$i-1][$j], @v[$i][$j-1], @v[$i+1][$j], @v[$i][$j+1]; my $v = [+] @neighbors; @d[$i][$j] = $v = @v[$i][$j] - $v / +@neighbors; @@ -37,12 +37,12 @@ sub iter(@v, Int $w, Int $h) { while $diff > 1e-24 { force-v(@v); $diff = calc_diff(@v, @d, $w, $h); - for ^$h X ^$w -> $i, $j { + for (flat ^$h X ^$w) -> $i, $j { @v[$i][$j] -= @d[$i][$j]; } } - for ^$h X ^$w -> $i, $j { + for (flat ^$h X ^$w) -> $i, $j { @cur[ @fixed[$i][$j] + 1 ] += @d[$i][$j] * (?$i + ?$j + ($i < $h - 1) + ($j < $w - 1)); } diff --git a/Task/Resistor-mesh/REXX/resistor-mesh.rexx b/Task/Resistor-mesh/REXX/resistor-mesh.rexx index b973a36fd9..c51e51f245 100644 --- a/Task/Resistor-mesh/REXX/resistor-mesh.rexx +++ b/Task/Resistor-mesh/REXX/resistor-mesh.rexx @@ -1,40 +1,46 @@ -/*REXX pgm calculates resistance between any 2 points on a resister grid*/ -numeric digits 20 /*use moderate digits (precision)*/ -minVal = (1'e-' || (digits()*2)) / 1 /*calculate the threshold min val*/ -if 1=='f1'x then ohms = 'ohms' /*EBCDIC machine? Use 'ohms'. */ - else ohms = 'ea'x /* ASCII machine? Use Greek Ω.*/ -parse arg high wide Arow Acol Brow Bcol . -say 'minVal = ' format(minVal,,,,0) ; say -say 'resistor mesh is of size: ' wide "wide, " high 'high.' ; say -say 'point A is at (row,col): ' Arow","Acol -say 'point B is at (row,col): ' Brow","Bcol +/*REXX program calculates the resistance between any two points on a resister grid.*/ +numeric digits 20 /*use moderate decimal digs (precision)*/ +minVal = (1'e-' || (digits()*2)) / 1 /*calculate the threshold minimul value*/ +if 1=='f1'x then ohms = 'ohms' /*EBCDIC machine? Then use 'ohms'. */ + else ohms = 'ea'x /* ASCII " " " Greek Ω.*/ +parse arg high wide Arow Acol Brow Bcol . /*obtain optional arguments from the CL*/ +if high=='' | high=="," then high=10 /*Not specified? Then use the default.*/ +if wide=='' | wide=="," then wide=10 /* " " " " " " */ +if Arow=='' | Arow=="," then Arow= 2 /* " " " " " " */ +if Acol=='' | Acol=="," then Acol= 2 /* " " " " " " */ +if Brow=='' | Brow=="," then Brow= 7 /* " " " " " " */ +if Bcol=='' | Bcol=="," then Bcol= 8 /* " " " " " " */ +say ' minimum value = ' translate(format(minVal, , , , 0), "e", 'E'); say +say ' resistor mesh is of size: ' wide "wide, " high 'high' ; say +say ' point A is at (row,col): ' Arow"," Acol +say ' point B is at (row,col): ' Brow"," Bcol @.=0; cell.=1 - do until $ <= minVal; $=0; v = 0 + do until $ <= minVal; v = 0 @.Arow.Acol = +1 ; cell.Arow.Acol = 0 @.Brow.Bcol = -1 ; cell.Brow.Bcol = 0 - - do i=1 for high; im=i-1; ip=i+1 - do j=1 for wide; jm=j-1; jp=j+1; n=0; v=0 - if i\==1 then do; v=v+@.im.j; n=n+1; end - if j\==1 then do; v=v+@.i.jm; n=n+1; end - if i diff --git a/Task/Respond-to-an-unknown-method-call/SuperCollider/respond-to-an-unknown-method-call-4.supercollider b/Task/Respond-to-an-unknown-method-call/SuperCollider/respond-to-an-unknown-method-call-4.supercollider new file mode 100644 index 0000000000..5da54b8b19 --- /dev/null +++ b/Task/Respond-to-an-unknown-method-call/SuperCollider/respond-to-an-unknown-method-call-4.supercollider @@ -0,0 +1,2 @@ +i = Ingorabilis.new +try { i.think } { "We are not delegating to super, because I don't want it".postln }; diff --git a/Task/Return-multiple-values/00DESCRIPTION b/Task/Return-multiple-values/00DESCRIPTION index 892961ce7b..3bf05cfe13 100644 --- a/Task/Return-multiple-values/00DESCRIPTION +++ b/Task/Return-multiple-values/00DESCRIPTION @@ -1,3 +1,5 @@ {{omit from|GUISS}} +;Task: Show how to return more than one value from a function. +

    diff --git a/Task/Return-multiple-values/ALGOL-W/return-multiple-values.alg b/Task/Return-multiple-values/ALGOL-W/return-multiple-values.alg new file mode 100644 index 0000000000..d57bab98dd --- /dev/null +++ b/Task/Return-multiple-values/ALGOL-W/return-multiple-values.alg @@ -0,0 +1,28 @@ +begin + % example using a record type to return multiple values from a procedure % + record Element ( string(2) symbol; integer atomicNumber ); + reference(Element) procedure getElement( integer value n ) ; + begin + Element( if n < 1 then "?<" + else if n > 3 then "?>" + else case n of ( %1% "H" + , %2% "He" + , %3% "Li" + ) + , n + ) + end getElement ; + % test the procedure % + begin + reference(Element) elementData; + for n := 0 until 4 do begin + elementData := getElement(n); + write( s_w := 0, i_w := 1 + , atomicNumber(elementData) + , " " + , symbol(elementData) + ); + end + end + +end. diff --git a/Task/Return-multiple-values/COBOL/return-multiple-values.cobol b/Task/Return-multiple-values/COBOL/return-multiple-values.cobol new file mode 100644 index 0000000000..7f4791f87c --- /dev/null +++ b/Task/Return-multiple-values/COBOL/return-multiple-values.cobol @@ -0,0 +1,73 @@ + identification division. + program-id. multiple-values. + + environment division. + configuration section. + repository. + function multiples + function all intrinsic. + + REPLACE ==:linked-items:== BY == + 01 a usage binary-long. + 01 b pic x(10). + 01 c usage float-short. + == + ==:record-item:== BY == + 01 master. + 05 ma usage binary-long. + 05 mb pic x(10). + 05 mc usage float-short. + ==. + + data division. + working-storage section. + :linked-items: + + :record-item: + + procedure division. + sample-main. + + move 41 to a + move "aaaaabbbbb" to b + move function e to c + + display "Original: " a ", " b ", " c + call "subprogram" using a b c + display "Modified: " a ", " b ", " c + + move multiples() to master + display "Multiple: " ma ", " mb ", " mc + + goback. + end program multiple-values. + + *> subprogram + identification division. + program-id. subprogram. + + data division. + linkage section. + :linked-items: + + procedure division using a b c. + add 1 to a + inspect b converting "a" to "b" + divide 2 into c + goback. + end program subprogram. + + *> multiples function + identification division. + function-id. multiples. + + data division. + linkage section. + :record-item: + + procedure division returning master. + move 84 to ma + move "multiple" to mb + move function pi to mc + goback. + end function multiples. diff --git a/Task/Return-multiple-values/D/return-multiple-values.d b/Task/Return-multiple-values/D/return-multiple-values.d index a1b87c2156..904fde8643 100644 --- a/Task/Return-multiple-values/D/return-multiple-values.d +++ b/Task/Return-multiple-values/D/return-multiple-values.d @@ -1,10 +1,14 @@ -import std.stdio, std.typecons; +import std.stdio, std.typecons, std.algorithm; auto addSub(T)(T x, T y) { return tuple(x + y, x - y); } +alias _(T...) = T; // костыль + void main() { - auto r = addSub(33, 12); - writefln("33 + 12 = %d\n33 - 12 = %d", r.tupleof); + int a, b; + _!(a, b) = addSub(33, 12); // _!(a, b) = [33, 12].fold!("a+b","a-b"); + + writefln("33 + 12 = %d\n33 - 12 = %d", a, b); } diff --git a/Task/Return-multiple-values/Erlang/return-multiple-values.erl b/Task/Return-multiple-values/Erlang/return-multiple-values.erl index 6cb55fc2e0..f7e8302c32 100644 --- a/Task/Return-multiple-values/Erlang/return-multiple-values.erl +++ b/Task/Return-multiple-values/Erlang/return-multiple-values.erl @@ -1,17 +1,10 @@ -% Implemented by Arjun Sunel --module(return_multi). --export([main/0]). +% Put this code in return_multi.erl and run it as "escript return_multi.erl" -main() -> - K=multiply(3,4), - C =lists:nth(1,K), - D = lists:nth(2,K), - E = lists:nth(3,K), - io:format("~p~n",[C]), - io:format("~p~n",[D]), - io:format("~p~n",[E]). - -multiply(A,B) -> - case {A,B} of - {A, B} ->[A*B, A+B, A-B] - end. +-module(return_multi). + +main(_) -> + {C, D, E} = multiply(3, 4), + io:format("~p ~p ~p~n", [C, D, E]). + +multiply(A, B) -> + {A * B, A + B, A - B}. diff --git a/Task/Return-multiple-values/Java/return-multiple-values.java b/Task/Return-multiple-values/Java/return-multiple-values-1.java similarity index 100% rename from Task/Return-multiple-values/Java/return-multiple-values.java rename to Task/Return-multiple-values/Java/return-multiple-values-1.java diff --git a/Task/Return-multiple-values/Java/return-multiple-values-2.java b/Task/Return-multiple-values/Java/return-multiple-values-2.java new file mode 100644 index 0000000000..7cd1eb05f2 --- /dev/null +++ b/Task/Return-multiple-values/Java/return-multiple-values-2.java @@ -0,0 +1,31 @@ +public class Values { + private final Object[] objects; + public Values(Object ... objects) { + this.objects = objects; + } + public T get(int i) { + return (T) objects[i]; + } + public Object[] get() { + return objects; + } + + // to test + public static void main(String[] args) { + Values v = getValues(); + int i = v.get(0); + System.out.println(i); + printValues(i, v.get(1)); + printValues(v.get()); + } + private static Values getValues() { + return new Values(1, 3.8, "text"); + } + private static void printValues(int i, double d) { + System.out.println(i + ", " + d); + } + private static void printValues(Object ... objects) { + for (int i=0; i
    diff --git a/Task/Reverse-a-string/360-Assembly/reverse-a-string.360 b/Task/Reverse-a-string/360-Assembly/reverse-a-string.360 new file mode 100644 index 0000000000..d93646bd11 --- /dev/null +++ b/Task/Reverse-a-string/360-Assembly/reverse-a-string.360 @@ -0,0 +1,30 @@ +* Reverse a string 21/05/2016 +REVERSE CSECT + USING REVERSE,R13 base register + B 72(R15) skip savearea + DC 17F'0' savearea + STM R14,R12,12(R13) prolog + ST R13,4(R15) " + ST R15,8(R13) " + LR R13,R15 " + MVC TMP(L'C),C tmp=c + LA R8,C @c[1] + LA R9,TMP+L'C-1 @tmp[n-1] + LA R6,1 i=1 + LA R7,L'C n=length(c) +LOOPI CR R6,R7 do i=1 to n + BH ELOOPI leave i + MVC 0(1,R8),0(R9) substr(c,i,1)=substr(tmp,n-i+1,1) + LA R8,1(R8) @c=@c+1 + BCTR R9,0 @tmp=@tmp-1 + LA R6,1(R6) i=i+1 + B LOOPI next i +ELOOPI XPRNT C,L'C print c + L R13,4(0,R13) epilog + LM R14,R12,12(R13) " + XR R15,R15 " + BR R14 exit +C DC CL12'edoC attesoR' +TMP DS CL12 + YREGS + END REVERSE diff --git a/Task/Reverse-a-string/ALGOL-68/reverse-a-string.alg b/Task/Reverse-a-string/ALGOL-68/reverse-a-string.alg new file mode 100644 index 0000000000..b3ee6c60e3 --- /dev/null +++ b/Task/Reverse-a-string/ALGOL-68/reverse-a-string.alg @@ -0,0 +1,13 @@ +PROC reverse = (REF STRING s)VOID: + FOR i TO UPB s OVER 2 DO + CHAR c = s[i]; + s[i] := s[UPB s - i + 1]; + s[UPB s - i + 1] := c + OD; + +main: +( + STRING text := "Was it a cat I saw"; + reverse(text); + print((text, new line)) +) diff --git a/Task/Reverse-a-string/AppleScript/reverse-a-string.applescript b/Task/Reverse-a-string/AppleScript/reverse-a-string-1.applescript similarity index 62% rename from Task/Reverse-a-string/AppleScript/reverse-a-string.applescript rename to Task/Reverse-a-string/AppleScript/reverse-a-string-1.applescript index fda371212f..813a6d78a5 100644 --- a/Task/Reverse-a-string/AppleScript/reverse-a-string.applescript +++ b/Task/Reverse-a-string/AppleScript/reverse-a-string-1.applescript @@ -1,5 +1,5 @@ reverseString("Hello World!") on reverseString(str) - reverse of characters of str as string + reverse of characters of str as string end reverseString diff --git a/Task/Reverse-a-string/AppleScript/reverse-a-string-2.applescript b/Task/Reverse-a-string/AppleScript/reverse-a-string-2.applescript new file mode 100644 index 0000000000..842dc6dc49 --- /dev/null +++ b/Task/Reverse-a-string/AppleScript/reverse-a-string-2.applescript @@ -0,0 +1,82 @@ +-- Using either a generic foldr(f, a, xs) + +-- reverse1 :: [a] -> [a] +on reverse1(xs) + script rev + on lambda(a, x) + a & x + end lambda + end script + + if class of xs is text then + foldr(rev, {}, xs) as text + else + foldr(rev, {}, xs) + end if +end reverse1 + + +-- or the built-in reverse method for lists + +-- reverse2 :: [a] -> [a] +on reverse2(xs) + if class of xs is text then + (reverse of characters of xs) as text + else + reverse of xs + end if +end reverse2 + + + +-- TESTING reverse1 and reverse2 with same string and list +on run + script test + on lambda(f) + map(f, ["Hello there !", {1, 2, 3, 4, 5}]) + end lambda + end script + + map(test, [reverse1, reverse2]) +end run + + + + +-- GENERIC LIBRARY FUNCTIONS + +-- foldr :: (a -> b -> a) -> a -> [b] -> a +on foldr(f, startValue, xs) + tell mReturn(f) + set v to startValue + set lng to length of xs + repeat with i from lng to 1 by -1 + set v to lambda(v, item i of xs, i, xs) + end repeat + return v + end tell +end foldr + +-- 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 + +-- 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 diff --git a/Task/Reverse-a-string/AppleScript/reverse-a-string-3.applescript b/Task/Reverse-a-string/AppleScript/reverse-a-string-3.applescript new file mode 100644 index 0000000000..5b654a4afe --- /dev/null +++ b/Task/Reverse-a-string/AppleScript/reverse-a-string-3.applescript @@ -0,0 +1,2 @@ +{{"! ereht olleH", {5, 4, 3, 2, 1}}, + {"! ereht olleH", {5, 4, 3, 2, 1}}} diff --git a/Task/Reverse-a-string/Ela/reverse-a-string-1.ela b/Task/Reverse-a-string/Ela/reverse-a-string-1.ela new file mode 100644 index 0000000000..2b9fbc1e7f --- /dev/null +++ b/Task/Reverse-a-string/Ela/reverse-a-string-1.ela @@ -0,0 +1,7 @@ +reverse_string str = rev len str + where len = length str + rev 0 str = "" + rev n str = toString (str : nn) +> rev nn str + where nn = n - 1 + +reverse_string "Hello" diff --git a/Task/Reverse-a-string/Ela/reverse-a-string-2.ela b/Task/Reverse-a-string/Ela/reverse-a-string-2.ela new file mode 100644 index 0000000000..ea88ff885a --- /dev/null +++ b/Task/Reverse-a-string/Ela/reverse-a-string-2.ela @@ -0,0 +1,2 @@ +open string +fromList <| reverse <| toList "Hello" ::: String diff --git a/Task/Reverse-a-string/Elena/reverse-a-string.elena b/Task/Reverse-a-string/Elena/reverse-a-string.elena new file mode 100644 index 0000000000..ba293bc10a --- /dev/null +++ b/Task/Reverse-a-string/Elena/reverse-a-string.elena @@ -0,0 +1,14 @@ +#import system. +#import system'routines. +#import extensions. + +#class(extension) extension +{ + #method reversedLiteral + = self toArray reverse summarize:(String new) literal. +} + +#symbol program = +[ + console writeLine:("Hello World" reversedLiteral). +]. diff --git a/Task/Reverse-a-string/Emacs-Lisp/reverse-a-string.l b/Task/Reverse-a-string/Emacs-Lisp/reverse-a-string.l index 57f25aca50..b0443cd90a 100644 --- a/Task/Reverse-a-string/Emacs-Lisp/reverse-a-string.l +++ b/Task/Reverse-a-string/Emacs-Lisp/reverse-a-string.l @@ -1 +1 @@ -(concat (reverse (append "Hello World" nil))) +(reverse "Hello World") diff --git a/Task/Reverse-a-string/Forth/reverse-a-string-3.fth b/Task/Reverse-a-string/Forth/reverse-a-string-3.fth new file mode 100644 index 0000000000..910ac1aa0c --- /dev/null +++ b/Task/Reverse-a-string/Forth/reverse-a-string-3.fth @@ -0,0 +1,9 @@ +: xreverse {: c-addr u -- c-addr2 u :} + u allocate throw u + c-addr swap over u + >r begin ( from to r:end) + over r@ u< while + over r@ over - x-size dup >r - 2dup r@ cmove + swap r> + swap repeat + r> drop nip u ; + +\ example use +s" ώщыē" xreverse type \ outputs "ēыщώ" diff --git a/Task/Reverse-a-string/Groovy/reverse-a-string.groovy b/Task/Reverse-a-string/Groovy/reverse-a-string-1.groovy similarity index 100% rename from Task/Reverse-a-string/Groovy/reverse-a-string.groovy rename to Task/Reverse-a-string/Groovy/reverse-a-string-1.groovy diff --git a/Task/Reverse-a-string/Groovy/reverse-a-string-2.groovy b/Task/Reverse-a-string/Groovy/reverse-a-string-2.groovy new file mode 100644 index 0000000000..795ff0ee00 --- /dev/null +++ b/Task/Reverse-a-string/Groovy/reverse-a-string-2.groovy @@ -0,0 +1,15 @@ +def string = "as⃝df̅" + +List combiningBlocks = [ + Character.UnicodeBlock.COMBINING_DIACRITICAL_MARKS, + Character.UnicodeBlock.COMBINING_DIACRITICAL_MARKS_SUPPLEMENT, + Character.UnicodeBlock.COMBINING_HALF_MARKS, + Character.UnicodeBlock.COMBINING_MARKS_FOR_SYMBOLS +] +List chars = string as List +chars[1..-1].eachWithIndex { ch, i -> + if (Character.UnicodeBlock.of((char)ch) in combiningBlocks) { + chars[i..(i+1)] = chars[(i+1)..i] + } +} +println chars.reverse().join() diff --git a/Task/Reverse-a-string/JavaScript/reverse-a-string.js b/Task/Reverse-a-string/JavaScript/reverse-a-string-1.js similarity index 100% rename from Task/Reverse-a-string/JavaScript/reverse-a-string.js rename to Task/Reverse-a-string/JavaScript/reverse-a-string-1.js diff --git a/Task/Reverse-a-string/JavaScript/reverse-a-string-2.js b/Task/Reverse-a-string/JavaScript/reverse-a-string-2.js new file mode 100644 index 0000000000..ed1cb3fefb --- /dev/null +++ b/Task/Reverse-a-string/JavaScript/reverse-a-string-2.js @@ -0,0 +1,18 @@ +(() => { + + // .reduceRight() can be useful when reversals + // are composed with some other process + + let reverse1 = s => Array.from(s) + .reduceRight((a, x) => a + (x !== ' ' ? x : ' <- '), ''), + + // but ( join . reverse . split ) is faster for + // simple string reversals in isolation + + reverse2 = s => s.split('').reverse().join(''); + + + return [reverse1, reverse2] + .map(f => f("Some string to be reversed")); + +})(); diff --git a/Task/Reverse-a-string/JavaScript/reverse-a-string-3.js b/Task/Reverse-a-string/JavaScript/reverse-a-string-3.js new file mode 100644 index 0000000000..36509bdaf3 --- /dev/null +++ b/Task/Reverse-a-string/JavaScript/reverse-a-string-3.js @@ -0,0 +1 @@ +["desrever <- eb <- ot <- gnirts <- emoS", "desrever eb ot gnirts emoS"] diff --git a/Task/Reverse-a-string/Kotlin/reverse-a-string.kotlin b/Task/Reverse-a-string/Kotlin/reverse-a-string.kotlin new file mode 100644 index 0000000000..e3eb195de1 --- /dev/null +++ b/Task/Reverse-a-string/Kotlin/reverse-a-string.kotlin @@ -0,0 +1,3 @@ +fun main(args: Array) { + println("asdf".reversed()) +} diff --git a/Task/Reverse-a-string/MIPS-Assembly/reverse-a-string.mips b/Task/Reverse-a-string/MIPS-Assembly/reverse-a-string.mips new file mode 100644 index 0000000000..4df8c5439f --- /dev/null +++ b/Task/Reverse-a-string/MIPS-Assembly/reverse-a-string.mips @@ -0,0 +1,67 @@ +# First, it gets the length of the original string +# Then, it allocates memory from the copy +# Then it copies the pointer to the original string, and adds the strlen +# subtract 1, then that new pointer is at the last char. +# while(strlen) +# copy char +# decrement strlen +# decrement source pointer +# increment target pointer + +.data + ex_msg_og: .asciiz "Original string:\n" + ex_msg_cpy: .asciiz "\nCopied string:\n" + string: .asciiz "Wow, what a string!" + +.text + main: + la $v1,string #load addr of string into $v0 + la $t1,($v1) #copy addr into $t0 for later access + lb $a1,($v1) #load byte from string addr + strlen_loop: + beqz $a1,alloc_mem + addi $a0,$a0,1 #increment strlen_counter + addi $v1,$v1,1 #increment ptr + lb $a1,($v1) #load the byte + j strlen_loop + + alloc_mem: + li $v0,9 #alloc memory, $a0 is arg for how many bytes to allocate + #result is stored in $v0 + syscall + la $t0,($v0) #$v0 is static, $t0 is the moving ptr + la $v1,($t1) #get a copy we can increment + + add $t1,$t1,$a0 #add strlen to our original, static addr to equal last char + subi $t1,$t1,1 #previous operation is on NULL byte, i.e. off-by-one error. + #this corrects. + copy_str: + lb $a1,($t1) #copy first byte from source + + strcopy_loop: + beq $a0,0,exit_procedure + sb $a1,($t0) #store the byte at the target pointer + addi $t0,$t0,1 #increment target ptr + subi $t1,$t1,1 + subi $a0,$a0,1 + lb $a1,($t1) #load next byte from source ptr + j strcopy_loop + + exit_procedure: + la $a1,($v0) #store our string at $v0 so it doesn't get overwritten + li $v0,4 #set syscall to PRINT + + la $a0,ex_msg_og #PRINT("original string:") + syscall + + la $a0,($v1) #PRINT(original string) + syscall + + la $a0,ex_msg_cpy #PRINT("copied string:") + syscall + + la $a0,($a1) #PRINT(strcopy) + syscall + + li $v0,10 #EXIT(0) + syscall diff --git a/Task/Reverse-a-string/OCaml/reverse-a-string-4.ocaml b/Task/Reverse-a-string/OCaml/reverse-a-string-4.ocaml new file mode 100644 index 0000000000..5e9e436dc4 --- /dev/null +++ b/Task/Reverse-a-string/OCaml/reverse-a-string-4.ocaml @@ -0,0 +1,6 @@ +let string_rev s = + let len = String.length s in + String.init len (fun i -> s.[len - 1 - i]) + +let () = + print_endline (string_rev "Hello world!") diff --git a/Task/Reverse-a-string/PARI-GP/reverse-a-string.pari b/Task/Reverse-a-string/PARI-GP/reverse-a-string-1.pari similarity index 100% rename from Task/Reverse-a-string/PARI-GP/reverse-a-string.pari rename to Task/Reverse-a-string/PARI-GP/reverse-a-string-1.pari diff --git a/Task/Reverse-a-string/PARI-GP/reverse-a-string-2.pari b/Task/Reverse-a-string/PARI-GP/reverse-a-string-2.pari new file mode 100644 index 0000000000..cece35b7d9 --- /dev/null +++ b/Task/Reverse-a-string/PARI-GP/reverse-a-string-2.pari @@ -0,0 +1,12 @@ +\\ Return reversed string str. +\\ 3/3/2016 aev +sreverse(str)={return(Strchr(Vecrev(Vecsmall(str))))} + +{ +\\ TEST1 +print(" *** Testing sreverse from Version #2:"); +print(sreverse("ABCDEF")); +my(s,sr,n=10000000); +s="ABCDEFGHIJKL"; +for(i=1,n, sr=sreverse(s)); +} diff --git a/Task/Reverse-a-string/PARI-GP/reverse-a-string-3.pari b/Task/Reverse-a-string/PARI-GP/reverse-a-string-3.pari new file mode 100644 index 0000000000..f783390304 --- /dev/null +++ b/Task/Reverse-a-string/PARI-GP/reverse-a-string-3.pari @@ -0,0 +1,11 @@ +\\ Version #1 upgraded to complete function. Practically the same. +reverse(str)={return(concat(Vecrev(str)))} + +{ +\\ TEST2 +print(" *** Testing reverse from Version #1:"); +print(reverse("ABCDEF")); +my(s,sr,n=10000000); +s="ABCDEFGHIJKL"; +for(i=1,n, sr=reverse(s)); +} diff --git a/Task/Reverse-a-string/Perl-6/reverse-a-string.pl6 b/Task/Reverse-a-string/Perl-6/reverse-a-string.pl6 index 9d9b2bd958..51484577f7 100644 --- a/Task/Reverse-a-string/Perl-6/reverse-a-string.pl6 +++ b/Task/Reverse-a-string/Perl-6/reverse-a-string.pl6 @@ -1,4 +1,2 @@ -# Not transformative. -my $reverse = flip $string; -# or say "hello world".flip; +say "as⃝df̅".flip diff --git a/Task/Reverse-a-string/PowerShell/reverse-a-string-7.psh b/Task/Reverse-a-string/PowerShell/reverse-a-string-7.psh new file mode 100644 index 0000000000..5209ca1db1 --- /dev/null +++ b/Task/Reverse-a-string/PowerShell/reverse-a-string-7.psh @@ -0,0 +1 @@ +[Regex]::Matches('abc','.','RightToLeft').Value -join '' diff --git a/Task/Reverse-a-string/Python/reverse-a-string-3.py b/Task/Reverse-a-string/Python/reverse-a-string-3.py index 621071bae6..5f27bbb6e7 100644 --- a/Task/Reverse-a-string/Python/reverse-a-string-3.py +++ b/Task/Reverse-a-string/Python/reverse-a-string-3.py @@ -1,36 +1 @@ -''' - Reverse a Unicode string with proper handling of combining characters -''' - -import unicodedata - -def ureverse(ustring): - ''' - Reverse a string including unicode combining characters - - Example: - >>> ucode = ''.join( chr(int(n, 16)) - for n in ['61', '73', '20dd', '64', '66', '305'] ) - >>> ucoderev = ureverse(ucode) - >>> ['%x' % ord(char) for char in ucoderev] - ['66', '305', '64', '73', '20dd', '61'] - >>> - ''' - groupedchars = [] - uchar = list(ustring) - while uchar: - if 'COMBINING' in unicodedata.name(uchar[0], ''): - groupedchars[-1] += uchar.pop(0) - else: - groupedchars.append(uchar.pop(0)) - # Grouped reversal - groupedchars = groupedchars[::-1] - - return ''.join(groupedchars) - -if __name__ == '__main__': - ucode = ''.join( chr(int(n, 16)) - for n in ['61', '73', '20dd', '64', '66', '305'] ) - ucoderev = ureverse(ucode) - print (ucode) - print (ucoderev) +''.join(reversed(string)) diff --git a/Task/Reverse-a-string/Python/reverse-a-string-4.py b/Task/Reverse-a-string/Python/reverse-a-string-4.py new file mode 100644 index 0000000000..621071bae6 --- /dev/null +++ b/Task/Reverse-a-string/Python/reverse-a-string-4.py @@ -0,0 +1,36 @@ +''' + Reverse a Unicode string with proper handling of combining characters +''' + +import unicodedata + +def ureverse(ustring): + ''' + Reverse a string including unicode combining characters + + Example: + >>> ucode = ''.join( chr(int(n, 16)) + for n in ['61', '73', '20dd', '64', '66', '305'] ) + >>> ucoderev = ureverse(ucode) + >>> ['%x' % ord(char) for char in ucoderev] + ['66', '305', '64', '73', '20dd', '61'] + >>> + ''' + groupedchars = [] + uchar = list(ustring) + while uchar: + if 'COMBINING' in unicodedata.name(uchar[0], ''): + groupedchars[-1] += uchar.pop(0) + else: + groupedchars.append(uchar.pop(0)) + # Grouped reversal + groupedchars = groupedchars[::-1] + + return ''.join(groupedchars) + +if __name__ == '__main__': + ucode = ''.join( chr(int(n, 16)) + for n in ['61', '73', '20dd', '64', '66', '305'] ) + ucoderev = ureverse(ucode) + print (ucode) + print (ucoderev) diff --git a/Task/Reverse-a-string/REXX/reverse-a-string-3.rexx b/Task/Reverse-a-string/REXX/reverse-a-string-3.rexx index 93e1f48289..f4d160ab92 100644 --- a/Task/Reverse-a-string/REXX/reverse-a-string-3.rexx +++ b/Task/Reverse-a-string/REXX/reverse-a-string-3.rexx @@ -1,3 +1,3 @@ string2 = substr(string1,j,1) || string2 /*───── or ─────*/ - string2=substr(string1,j,1)||string2 + string2=substr(string1,j,1)string2 diff --git a/Task/Reverse-a-string/S-lang/reverse-a-string-1.slang b/Task/Reverse-a-string/S-lang/reverse-a-string-1.slang new file mode 100644 index 0000000000..2722ce242b --- /dev/null +++ b/Task/Reverse-a-string/S-lang/reverse-a-string-1.slang @@ -0,0 +1,10 @@ +variable sa = "Hello, World", aa = Char_Type[strlen(sa)+1]; +init_char_array(aa, sa); +array_reverse(aa); +% print(aa); + +% Unfortunately, strjoin() only joins strings, so we map char() +% [sadly named: actually converts char into single-length string] +% onto the array: + +print( strjoin(array_map(String_Type, &char, aa), "") ); diff --git a/Task/Reverse-a-string/S-lang/reverse-a-string-2.slang b/Task/Reverse-a-string/S-lang/reverse-a-string-2.slang new file mode 100644 index 0000000000..9f49775c81 --- /dev/null +++ b/Task/Reverse-a-string/S-lang/reverse-a-string-2.slang @@ -0,0 +1,17 @@ +define init_unicode_array(a, buf) +{ + variable len = strbytelen(buf), ch, p0 = 0, p1 = 0; + while (p1 < len) { + (p1, ch) = strskipchar(buf, p1, 1); + if (ch < 0) print("oops."); + a[p0] = ch; + p0++; + } +} + +variable su = "Σὲ γνωρίζω ἀπὸ τὴν κόψη"; +variable au = Int_Type[strlen(su)+1]; +init_unicode_array(au, su); +array_reverse(au); +% print(au); +print(strjoin(array_map(String_Type, &char, au), "") ); diff --git a/Task/Reverse-a-string/Vala/reverse-a-string.vala b/Task/Reverse-a-string/Vala/reverse-a-string.vala new file mode 100644 index 0000000000..b6e12b355e --- /dev/null +++ b/Task/Reverse-a-string/Vala/reverse-a-string.vala @@ -0,0 +1,12 @@ +int main (string[] args) { + if (args.length < 2) { + stdout.printf ("Please, input a string.\n"); + return 0; + } + var str = new StringBuilder (); + for (var i = 1; i < args.length; i++) { + str.append (args[i] + " "); + } + stdout.printf ("%s\n", str.str.strip ().reverse ()); + return 0; +} diff --git a/Task/Reverse-words-in-a-string/00DESCRIPTION b/Task/Reverse-words-in-a-string/00DESCRIPTION index 23329c62b8..ab9cfdbdc0 100644 --- a/Task/Reverse-words-in-a-string/00DESCRIPTION +++ b/Task/Reverse-words-in-a-string/00DESCRIPTION @@ -1,16 +1,22 @@ -The task is to reverse the order of all tokens in each of a number of strings and display the result;   the order of characters within a token should not be modified. -: '''Example:'''   “Hey you, Bub!”   would be shown reversed as:   “Bub! you, Hey” +;Task: +Reverse the order of all tokens in each of a number of strings and display the result;   the order of characters within a token should not be modified. -Tokens are any non-space characters separated by spaces (formally, white-space);   the visible punctuation forms part of the word within which it is located and should not be modified. + +;Example: +Hey you, Bub!   would be shown reversed as:   Bub! you, Hey + + +Tokens are any non-space characters separated by spaces (formally, white-space);   the visible punctuation form part of the word within which it is located and should not be modified. You may assume that there are no significant non-visible characters in the input.   Multiple or superfluous spaces may be compressed into a single space. -Some strings have no tokens, so an empty string (or one just containing spaces) would be the result. +Some strings have no tokens, so an empty string   (or one just containing spaces)   would be the result. -'''Display''' the strings in order (1st, 2nd, 3rd, ···),   and one string per line. +'''Display''' the strings in order   (1st, 2nd, 3rd, ···),   and one string per line. (You can consider the ten strings as ten lines, and the tokens as words.) + ;Input data
                  (ten lines within the box)
    @@ -31,3 +37,4 @@ Some strings have no tokens, so an empty string (or one just containing spaces)
     
     ;Cf.
     * [[Phrase reversals]]
    +

    diff --git a/Task/Reverse-words-in-a-string/ALGOL-68/reverse-words-in-a-string.alg b/Task/Reverse-words-in-a-string/ALGOL-68/reverse-words-in-a-string.alg new file mode 100644 index 0000000000..a94dc6629d --- /dev/null +++ b/Task/Reverse-words-in-a-string/ALGOL-68/reverse-words-in-a-string.alg @@ -0,0 +1,43 @@ +# returns original phrase with the order of the words reversed # +# a word is a sequence of non-blank characters # +PROC reverse word order = ( STRING original phrase )STRING: + BEGIN + STRING words reversed := ""; + STRING separator := ""; + INT start pos := LWB original phrase; + WHILE + # skip leading spaces # + WHILE IF start pos <= UPB original phrase + THEN original phrase[ start pos ] = " " + ELSE FALSE + FI + DO start pos +:= 1 + OD; + start pos <= UPB original phrase + DO + # have another word, find it # + INT end pos := start pos; + WHILE IF end pos <= UPB original phrase + THEN original phrase[ end pos ] /= " " + ELSE FALSE + FI + DO end pos +:= 1 + OD; + ( original phrase[ start pos : end pos - 1 ] + separator ) +=: words reversed; + separator := " "; + start pos := end pos + 1 + OD; + words reversed + END # reverse word order # ; + +# reverse the words in the lines as per the task # +print( ( reverse word order ( "--------- Ice and Fire ------------ " ), newline ) ); +print( ( reverse word order ( " " ), newline ) ); +print( ( reverse word order ( "fire, in end will world the say Some" ), newline ) ); +print( ( reverse word order ( "ice. in say Some " ), newline ) ); +print( ( reverse word order ( "desire of tasted I've what From " ), newline ) ); +print( ( reverse word order ( "fire. favor who those with hold I " ), newline ) ); +print( ( reverse word order ( " " ), newline ) ); +print( ( reverse word order ( "... elided paragraph last ... " ), newline ) ); +print( ( reverse word order ( " " ), newline ) ); +print( ( reverse word order ( "Frost Robert -----------------------" ), newline ) ) diff --git a/Task/Reverse-words-in-a-string/AppleScript/reverse-words-in-a-string.applescript b/Task/Reverse-words-in-a-string/AppleScript/reverse-words-in-a-string.applescript new file mode 100644 index 0000000000..1225dba4b1 --- /dev/null +++ b/Task/Reverse-words-in-a-string/AppleScript/reverse-words-in-a-string.applescript @@ -0,0 +1,77 @@ +on run {} + + unlines(map(reverseWords, |lines|("---------- Ice and Fire ------------ + +fire, in end will world the say Some +ice. in say Some +desire of tasted I've what From +fire. favor who those with hold I + +... elided paragraph last ... + +Frost Robert -----------------------"))) + +end run + +-- reverseWords :: String -> String +on reverseWords(str) + unwords(|reverse|(|words|(str))) +end reverseWords + +-- |reverse| :: [a] -> [a] +on |reverse|(xs) + if class of xs is text then + (reverse of characters of xs) as text + else + reverse of xs + end if +end |reverse| + +-- |lines| :: Text -> [Text] +on |lines|(str) + splitOn(linefeed, str) +end |lines| + +-- |words| :: Text -> [Text] +on |words|(str) + splitOn(space, str) +end |words| + +-- ulines :: [Text] -> Text +on unlines(lstLines) + intercalate(linefeed, lstLines) +end unlines + +-- unwords :: [Text] -> Text +on unwords(lstWords) + intercalate(space, lstWords) +end unwords + +-- splitOn :: Text -> Text -> [Text] +on splitOn(strDelim, strMain) + set {dlm, my text item delimiters} to {my text item delimiters, strDelim} + set lstParts to text items of strMain + set my text item delimiters to dlm + lstParts +end splitOn + +-- interCalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + strJoined +end intercalate + +-- map :: (a -> b) -> [a] -> [b] +on map(f, xs) + script mf + property lambda : f + end script + set lst to {} + set lng to length of xs + repeat with i from 1 to lng + set end of lst to mf's lambda(item i of xs, i, xs) + end repeat + return lst +end map diff --git a/Task/Reverse-words-in-a-string/COBOL/reverse-words-in-a-string.cobol b/Task/Reverse-words-in-a-string/COBOL/reverse-words-in-a-string.cobol new file mode 100644 index 0000000000..49cfa8a0dd --- /dev/null +++ b/Task/Reverse-words-in-a-string/COBOL/reverse-words-in-a-string.cobol @@ -0,0 +1,62 @@ + program-id. rev-word. + data division. + working-storage section. + 1 text-block. + 2 pic x(36) value "---------- Ice and Fire ------------". + 2 pic x(36) value " ". + 2 pic x(36) value "fire, in end will world the say Some". + 2 pic x(36) value "ice. in say Some ". + 2 pic x(36) value "desire of tasted I've what From ". + 2 pic x(36) value "fire. favor who those with hold I ". + 2 pic x(36) value " ". + 2 pic x(36) value "... elided paragraph last ... ". + 2 pic x(36) value " ". + 2 pic x(36) value "Frost Robert -----------------------". + 1 redefines text-block. + 2 occurs 10. + 3 text-line pic x(36). + 1 text-word. + 2 wk-len binary pic 9(4). + 2 wk-word pic x(36). + 1 word-stack. + 2 occurs 10. + 3 word-entry. + 4 word-len binary pic 9(4). + 4 word pic x(36). + 1 binary. + 2 i pic 9(4). + 2 pos pic 9(4). + 2 word-stack-ptr pic 9(4). + + procedure division. + perform varying i from 1 by 1 + until i > 10 + perform push-words + perform pop-words + end-perform + stop run + . + + push-words. + move 1 to pos + move 0 to word-stack-ptr + perform until pos > 36 + unstring text-line (i) delimited by all space + into wk-word count in wk-len + pointer pos + end-unstring + add 1 to word-stack-ptr + move text-word to word-entry (word-stack-ptr) + end-perform + . + + pop-words. + perform varying word-stack-ptr from word-stack-ptr + by -1 + until word-stack-ptr < 1 + move word-entry (word-stack-ptr) to text-word + display wk-word (1:wk-len) space with no advancing + end-perform + display space + . + end program rev-word. diff --git a/Task/Reverse-words-in-a-string/Clojure/reverse-words-in-a-string.clj b/Task/Reverse-words-in-a-string/Clojure/reverse-words-in-a-string.clj index 441eb89ea2..006a9908c4 100644 --- a/Task/Reverse-words-in-a-string/Clojure/reverse-words-in-a-string.clj +++ b/Task/Reverse-words-in-a-string/Clojure/reverse-words-in-a-string.clj @@ -10,5 +10,5 @@ Frost Robert -----------------------") -(doall +(dorun (map println (map #(apply str (interpose " " (reverse (re-seq #"[^\s]+" %)))) (clojure.string/split poem #"\n")))) diff --git a/Task/Reverse-words-in-a-string/CoffeeScript/reverse-words-in-a-string.coffee b/Task/Reverse-words-in-a-string/CoffeeScript/reverse-words-in-a-string.coffee new file mode 100644 index 0000000000..76985b5e85 --- /dev/null +++ b/Task/Reverse-words-in-a-string/CoffeeScript/reverse-words-in-a-string.coffee @@ -0,0 +1,12 @@ +strReversed = '---------- Ice and Fire ------------\n\n +fire, in end will world the say Some\n +ice. in say Some\n +desire of tasted I\'ve what From\n +fire. favor who those with hold I\n\n +... elided paragraph last ...\n\n +Frost Robert -----------------------' + +reverseString = (s) -> + s.split('\n').map((l) -> l.split(/\s/).reverse().join ' ').join '\n' + +console.log reverseString(strReversed) diff --git a/Task/Reverse-words-in-a-string/Elena/reverse-words-in-a-string.elena b/Task/Reverse-words-in-a-string/Elena/reverse-words-in-a-string.elena new file mode 100644 index 0000000000..0be3a71ffe --- /dev/null +++ b/Task/Reverse-words-in-a-string/Elena/reverse-words-in-a-string.elena @@ -0,0 +1,25 @@ +#import system. +#import system'routines. + +#symbol program = +[ + #var text := ("---------- Ice and Fire ------------", + "", + "fire, in end will world the say Some", + "ice. in say Some", + "desire of tasted I've what From", + "fire. favor who those with hold I", + "", + "... elided paragraph last ...", + "", + "Frost Robert -----------------------"). + + text run &each: line + [ + line split &by:" " reverse run &each: word + [ + console write:word write:" ". + ]. + console writeLine. + ]. +]. diff --git a/Task/Reverse-words-in-a-string/Forth/reverse-words-in-a-string.fth b/Task/Reverse-words-in-a-string/Forth/reverse-words-in-a-string.fth new file mode 100644 index 0000000000..832625ffad --- /dev/null +++ b/Task/Reverse-words-in-a-string/Forth/reverse-words-in-a-string.fth @@ -0,0 +1,31 @@ +create buf 1000 chars allot \ string buffer +buf value pp \ pp points to buffer address + +: tr ( caddr u -- ) + dup >r pp swap cmove \ move string into buffer + r> pp + to pp ; \ advance pointer by u bytes + +: collect ( -- addr len .. addr[n] len[n]) \ words deposit on data stack + begin + parse-name dup \ parse input stream, dup the len + while \ while stack <> 0 + tuck pp >r tr r> swap + repeat + 2drop ; \ clean up stack + +: reverse ( -- ) + buf to pp \ initialize pointer to buffer address + collect + depth 2/ 0 ?do type space loop \ type the strings with a trailing space + cr ; \ final new line + +reverse ---------- Ice and Fire ------------ +reverse +reverse fire, in end will world the say Some +reverse ice. in say Some +reverse desire of tasted I've what From +reverse fire. favor who those with hold I +reverse +reverse ... elided paragraph last ... +reverse +reverse Frost Robert ----------------------- diff --git a/Task/Reverse-words-in-a-string/Logo/reverse-words-in-a-string.logo b/Task/Reverse-words-in-a-string/Logo/reverse-words-in-a-string.logo new file mode 100644 index 0000000000..9071721036 --- /dev/null +++ b/Task/Reverse-words-in-a-string/Logo/reverse-words-in-a-string.logo @@ -0,0 +1,5 @@ +do.until [ + make "line readlist + print reverse :line +] [word? :line] +bye diff --git a/Task/Reverse-words-in-a-string/PHP/reverse-words-in-a-string-1.php b/Task/Reverse-words-in-a-string/PHP/reverse-words-in-a-string-1.php new file mode 100644 index 0000000000..f9037587a6 --- /dev/null +++ b/Task/Reverse-words-in-a-string/PHP/reverse-words-in-a-string-1.php @@ -0,0 +1,28 @@ +'; + } + + return $str_inv; + + } + + $string[] = "---------- Ice and Fire ------------"; + $string[] = ""; + $string[] = "fire, in end will world the say Some"; + $string[] = "ice. in say Some"; + $string[] = "desire of tasted I've what From"; + $string[] = "fire. favor who those with hold I"; + $string[] = ""; + $string[] = "... elided paragraph last ..."; + $string[] = ""; + $string[] = "Frost Robert ----------------------- "; + + +echo strInv($string); diff --git a/Task/Reverse-words-in-a-string/PHP/reverse-words-in-a-string-2.php b/Task/Reverse-words-in-a-string/PHP/reverse-words-in-a-string-2.php new file mode 100644 index 0000000000..de243a8823 --- /dev/null +++ b/Task/Reverse-words-in-a-string/PHP/reverse-words-in-a-string-2.php @@ -0,0 +1,10 @@ +------------ Fire and Ice ---------- + +Some say the world will end in fire, +Some say in ice. +From what I've tasted of desire +I hold with those who favor fire. + +... last paragraph elided ... + +----------------------- Robert Frost diff --git a/Task/Reverse-words-in-a-string/Pascal/reverse-words-in-a-string.pascal b/Task/Reverse-words-in-a-string/Pascal/reverse-words-in-a-string.pascal new file mode 100644 index 0000000000..61bac8b75b --- /dev/null +++ b/Task/Reverse-words-in-a-string/Pascal/reverse-words-in-a-string.pascal @@ -0,0 +1,46 @@ +program Reverse_words(Output); +{$H+} + +const + nl = chr(10); // Linefeed + sp = chr(32); // Space + TXT = + '---------- Ice and Fire -----------'+nl+ + nl+ + 'fire, in end will world the say Some'+nl+ + 'ice. in say Some'+nl+ + 'desire of tasted I''ve what From'+nl+ + 'fire. favor who those with hold I'+nl+ + nl+ + '... elided paragraph last ...'+nl+ + nl+ + 'Frost Robert -----------------------'+nl; + +var + I : integer; + ew, lw : ansistring; + c : char; + +function addW : ansistring; +var r : ansistring = ''; +begin + r := ew + sp + lw; + ew := ''; + addW := r +end; + +begin + ew := ''; + lw := ''; + + for I := 1 to strlen(TXT) do + begin + c := TXT[I]; + case c of + sp : lw := addW; + nl : begin writeln(addW); lw := '' end; + else ew := ew + c + end; + end; + readln; +end. diff --git a/Task/Reverse-words-in-a-string/Run-BASIC/reverse-words-in-a-string.run b/Task/Reverse-words-in-a-string/Run-BASIC/reverse-words-in-a-string.run new file mode 100644 index 0000000000..87eabafd5d --- /dev/null +++ b/Task/Reverse-words-in-a-string/Run-BASIC/reverse-words-in-a-string.run @@ -0,0 +1,22 @@ +for i = 1 to 10 + read string$ + j = 1 + r$ = "" + while word$(string$,j) <> "" + r$ = word$(string$,j) + " " + r$ + j = j + 1 + WEND + print r$ +next +end + +data "---------- Ice and Fire ------------" +data "" +data "fire, in end will world the say Some" +data "ice. in say Some" +data "desire of tasted I've what From" +data "fire. favor who those with hold I" +data "" +data "... elided paragraph last ..." +data "" +data "Frost Robert -----------------------" diff --git a/Task/Reverse-words-in-a-string/S-lang/reverse-words-in-a-string.slang b/Task/Reverse-words-in-a-string/S-lang/reverse-words-in-a-string.slang new file mode 100644 index 0000000000..314ffca70f --- /dev/null +++ b/Task/Reverse-words-in-a-string/S-lang/reverse-words-in-a-string.slang @@ -0,0 +1,16 @@ +variable ln, in = + ["---------- Ice and Fire ------------", + "fire, in end will world the say Some", + "ice. in say Some", + "desire of tasted I've what From", + "fire. favor who those with hold I", + "", + "... elided paragraph last ...", + "", + "Frost Robert -----------------------"]; + +foreach ln (in) { + ln = strtok(ln, " \t"); + array_reverse(ln); + () = printf("%s\n", strjoin(ln, " ")); +} diff --git a/Task/Reverse-words-in-a-string/VBScript/reverse-words-in-a-string.vb b/Task/Reverse-words-in-a-string/VBScript/reverse-words-in-a-string.vb new file mode 100644 index 0000000000..496678bf0a --- /dev/null +++ b/Task/Reverse-words-in-a-string/VBScript/reverse-words-in-a-string.vb @@ -0,0 +1,39 @@ +Option Explicit + +Dim objFSO, objInFile, objOutFile +Dim srcDir, line + +Set objFSO = CreateObject("Scripting.FileSystemObject") + +srcDir = objFSO.GetParentFolderName(WScript.ScriptFullName) & "\" + +Set objInFile = objFSO.OpenTextFile(srcDir & "In.txt",1,False,0) + +Set objOutFile = objFSO.OpenTextFile(srcDir & "Out.txt",2,True,0) + +Do Until objInFile.AtEndOfStream + line = objInFile.ReadLine + If line = "" Then + objOutFile.WriteLine "" + Else + objOutFile.WriteLine Reverse_String(line) + End If +Loop + +Function Reverse_String(s) + Dim arr, i + arr = Split(s," ") + For i = UBound(arr) To LBound(arr) Step -1 + If arr(i) <> "" Then + If i = UBound(arr) Then + Reverse_String = Reverse_String & arr(i) + Else + Reverse_String = Reverse_String & " " & arr(i) + End If + End If + Next +End Function + +objInFile.Close +objOutFile.Close +Set objFSO = Nothing diff --git a/Task/Rock-paper-scissors/00DESCRIPTION b/Task/Rock-paper-scissors/00DESCRIPTION index 4920b7980d..793cf793c8 100644 --- a/Task/Rock-paper-scissors/00DESCRIPTION +++ b/Task/Rock-paper-scissors/00DESCRIPTION @@ -1,13 +1,24 @@ -The task is to implement the classic children's game [[wp:Rock-paper-scissors|Rock-paper-scissors]], as well as a simple predictive AI player. +;Task: +Implement the classic children's game [[wp:Rock-paper-scissors|Rock-paper-scissors]], as well as a simple predictive   '''AI'''   (artificial intelligence)   player. -Rock Paper Scissors is a two player game. Each player chooses one of rock, paper or scissors, without knowing the other player's choice. The winner is decided by a set of rules: +Rock Paper Scissors is a two player game. -* Rock beats scissors -* Scissors beat paper -* Paper beats rock. +Each player chooses one of rock, paper or scissors, without knowing the other player's choice. +The winner is decided by a set of rules: + +:::*   Rock beats scissors +:::*   Scissors beat paper +:::*   Paper beats rock + +
    If both players choose the same thing, there is no winner for that round. -For this task, the computer will be one of the players. The operator will select Rock, Paper or Scissors and the computer will keep a record of the choice frequency, and use that information to make a [[Probabilistic choice|weighted random choice]] in an attempt to defeat its opponent. +For this task, the computer will be one of the players. -'''Extra credit:''' easy support for [[wp:Rock-paper-scissors#Additional_weapons|additional weapons]]. +The operator will select Rock, Paper or Scissors and the computer will keep a record of the choice frequency, and use that information to make a [[Probabilistic choice|weighted random choice]] in an attempt to defeat its opponent. + + +;Extra credit: +Support additional choices   [[wp:Rock-paper-scissors#Additional_weapons|additional weapons]]. +

    diff --git a/Task/Rock-paper-scissors/Elixir/rock-paper-scissors.elixir b/Task/Rock-paper-scissors/Elixir/rock-paper-scissors.elixir new file mode 100644 index 0000000000..7aad1901eb --- /dev/null +++ b/Task/Rock-paper-scissors/Elixir/rock-paper-scissors.elixir @@ -0,0 +1,48 @@ +defmodule Rock_paper_scissors do + def play, do: loop([1,1,1]) + + defp loop([r,p,s]=odds) do + IO.gets("What is your move? (R,P,S,Q) ") |> String.upcase |> String.first + |> case do + "Q" -> IO.puts "Good bye!" + human when human in ["R","P","S"] -> + IO.puts "Your move is #{play_to_string(human)}." + computer = select_play(odds) + IO.puts "My move is #{play_to_string(computer)}" + case beats(human,computer) do + true -> IO.puts "You win!" + false -> IO.puts "I win!" + _ -> IO.puts "Draw" + end + case human do + "R" -> loop([r+1,p,s]) + "P" -> loop([r,p+1,s]) + "S" -> loop([r,p,s+1]) + end + _ -> + IO.puts "Invalid play" + loop(odds) + end + end + + defp beats("R","S"), do: true + defp beats("P","R"), do: true + defp beats("S","P"), do: true + defp beats(x,x), do: :draw + defp beats(_,_), do: false + + defp play_to_string("R"), do: "Rock" + defp play_to_string("P"), do: "Paper" + defp play_to_string("S"), do: "Scissors" + + defp select_play([r,p,s]) do + n = :rand.uniform(r+p+s) + cond do + n <= r -> "P" + n <= r+p -> "S" + true -> "R" + end + end +end + +Rock_paper_scissors.play diff --git a/Task/Rock-paper-scissors/Perl-6/rock-paper-scissors-1.pl6 b/Task/Rock-paper-scissors/Perl-6/rock-paper-scissors-1.pl6 index 68bfd55a72..b7168f6dc7 100644 --- a/Task/Rock-paper-scissors/Perl-6/rock-paper-scissors-1.pl6 +++ b/Task/Rock-paper-scissors/Perl-6/rock-paper-scissors-1.pl6 @@ -29,7 +29,7 @@ while my $player = (prompt "Round {++$round}: " ~ $prompt).lc { $player.=substr(0,2); say 'Invalid choice, try again.' and $round-- and next unless $player.chars == 2 and $player ~~ /<$keys>/; - my $computer = %weight.keys.map( { $_ xx %weight{$_} } ).pick; + my $computer = (flat %weight.keys.map( { $_ xx %weight{$_} } )).pick; %weight{$_.key}++ for %vs{$player}.grep( { $_.value[0] == 1 } ); my $result = %vs{$player}{$computer}[0]; @stats[$result]++; diff --git a/Task/Rock-paper-scissors/REXX/rock-paper-scissors-1.rexx b/Task/Rock-paper-scissors/REXX/rock-paper-scissors-1.rexx index 32e70f85f6..64e88b8962 100644 --- a/Task/Rock-paper-scissors/REXX/rock-paper-scissors-1.rexx +++ b/Task/Rock-paper-scissors/REXX/rock-paper-scissors-1.rexx @@ -1,35 +1,35 @@ -/*REXX program plays rock─paper─scissors with a CBLF: carbon─based life form.*/ -!= '────────'; err=! '***error!***'; @.=0 /*some program constants. */ -prompt=! 'Please enter one of: Rock Paper Scissors (or Quit)' -$.p='paper' ; $.s='scissors'; $.r='rock' /*list of computer's choices*/ -t.p=$.r ; t.s=$.p ; t.r=$.s /*thingys that beats stuff */ -w.p=$.s ; w.s=$.r ; w.r=$.p /*stuff " " thingys*/ -b.p='covers'; b.s='cuts' ; b.r='breaks' /*verbs: how the choice wins*/ +/*REXX program plays rock─paper─scissors with a human; tracks what human tends to use. */ +!= '────────'; err=! '***error***'; @.=0 /*some constants for this program. */ +prompt=! 'Please enter one of: Rock Paper Scissors (or Quit)' +$.p='paper' ; $.s='scissors'; $.r='rock' /*list of the choices in this program. */ +t.p=$.r ; t.s=$.p ; t.r=$.s /*thingys that beats stuff. */ +w.p=$.s ; w.s=$.r ; w.r=$.p /*stuff " " thingys. */ +b.p='covers'; b.s='cuts' ; b.r='breaks' /*verbs: how the choice wins. */ - do forever; say; say prompt; say /*prompt the CBLF; then get a response.*/ - c=word($.p $.s $.r, random(1, 3)) /*choose the computer's first pick. */ - m=max(@.r, @.p, @.s); c=w.r /*prepare to examine the choice history*/ - if @.p==m then c=w.p /*emulate JC's: The Amazing Karnac. */ - if @.s==m then c=w.s /* " " " " " */ - c1=left(c,1) /*C1 is used for faster comparing. */ - parse pull u; a=strip(u) /*get the CBLF's choice/pick (answer). */ - upper a c1 ; a1=left(a,1) /*uppercase choices, get 1st character.*/ - ok=0 /*indicate answer isn't OK (so far). */ - select /*process/verify the CBLF's choice. */ - when words(u)==0 then say err 'nothing entered' + do forever; say; say prompt; say /*prompt the CBLF; then get a response.*/ + c=word($.p $.s $.r, random(1, 3)) /*choose the computer's first pick. */ + m=max(@.r, @.p, @.s); c=w.r /*prepare to examine the choice history*/ + if @.p==m then c=w.p /*emulate JC's: The Amazing Karnac. */ + if @.s==m then c=w.s /* " " " " " */ + c1=left(c,1) /*C1 is used for faster comparing. */ + parse pull u; a=strip(u) /*get the CBLF's choice/pick (answer). */ + upper a c1 ; a1=left(a,1) /*uppercase choices, get 1st character.*/ + ok=0 /*indicate answer isn't OK (so far). */ + select /*process/verify the CBLF's choice. */ + when words(u)==0 then say err 'nothing entered' when words(u)>1 then say err 'too many choices: ' u when abbrev('QUIT', a) then do; say ! 'quitting.'; exit; end when abbrev('ROCK', a) |, abbrev('PAPER', a) |, - abbrev('SCISSORS',a) then ok=1 /*Yes? A valid answer by CBLF.*/ + abbrev('SCISSORS',a) then ok=1 /*Yes? This is a valid answer by CBLF.*/ otherwise say err 'you entered a bad choice: ' u end /*select*/ - if \ok then iterate /*answer ¬OK? Then get another choice.*/ - @.a1=@.a1+1 /*keep a history of the CBLF's choices.*/ + if \ok then iterate /*answer ¬OK? Then get another choice.*/ + @.a1=@.a1+1 /*keep a history of the CBLF's choices.*/ say ! 'computer chose: ' c - if a1==c1 then do; say ! 'draw.'; iterate; end /*it's a draw. */ + if a1==c1 then do; say ! 'draw.'; iterate; end if $.a1==t.c1 then say ! 'the computer wins. ' ! $.c1 b.c1 $.a1 else say ! 'you win! ' ! $.a1 b.a1 $.c1 end /*forever*/ - /*stick a fork in it, we're all done. */ + /*stick a fork in it, we're all done. */ diff --git a/Task/Rock-paper-scissors/REXX/rock-paper-scissors-2.rexx b/Task/Rock-paper-scissors/REXX/rock-paper-scissors-2.rexx index 71390367c9..a84852bc3b 100644 --- a/Task/Rock-paper-scissors/REXX/rock-paper-scissors-2.rexx +++ b/Task/Rock-paper-scissors/REXX/rock-paper-scissors-2.rexx @@ -1,25 +1,25 @@ -/*REXX program plays rock─paper─scissors with a CBLF: carbon─based life form.*/ -!= '────────'; err=! '***error!***'; @.=0 /*some program constants.*/ +/*REXX pgm plays rock─paper─scissors─lizard─Spock with human; tracks human usage trend. */ +!= '────────'; err=! '***error***'; @.=0 /*some constants for this REXX program.*/ prompt=! 'Please enter one of: Rock Paper SCissors Lizard SPock (Vulcan) (or Quit)' $.p='paper' ; $.s='scissors' ; $.r='rock' ; $.L='lizard' ; $.v='Spock' /*names of the thingys*/ t.p= $.r $.v ; t.s= $.p $.L ; t.r= $.s $.L ; t.L= $.p $.v ; t.v= $.r $.s /*thingys beats stuff.*/ w.p= $.L $.s ; w.s= $.v $.r ; w.r= $.v $.p ; w.L= $.r $.s ; w.v= $.L $.p /*stuff beats thingys.*/ -b.p='covers disproves'; b.s='cuts decapitates'; b.r='breaks crushes'; b.L='eats poisons'; b.v='vaporizes smashes' /*how the choice wins.*/ -whom.1=! 'the computer wins. ' !; whom.2=! 'you win! ' !; win=words(t.p) +b.p='covers disproves'; b.s="cuts decapitates"; b.r='breaks crushes'; b.L="eats poisons"; b.v='vaporizes smashes' /*how the choice wins.*/ +whom.1=! 'the computer wins. ' !; whom.2=! "you win! " !; win=words(t.p) - do forever; say; say prompt; say /*prompt CBLF; then get a response.*/ - c=word($.p $.s $.r $.L $.v,random(1,5)) /*the computer's first choice/pick.*/ - m=max(@.r,@.p,@.s,@.L,@.v) /*used in examining CBLF's history.*/ - if @.p==m then c=word(w.p,random(1,2)) /*emulate JC's The Amazing Karnac.*/ - if @.s==m then c=word(w.s,random(1,2)) /* " " " " " */ - if @.r==m then c=word(w.r,random(1,2)) /* " " " " " */ - if @.L==m then c=word(w.L,random(1,2)) /* " " " " " */ - if @.v==m then c=word(w.v,random(1,2)) /* " " " " " */ - c1=left(c,1) /*C1 is used for faster comparing. */ - parse pull u; a=strip(u) /*obtain the CBLF's choice/pick. */ - upper a c1 ; a1=left(a,1) /*uppercase the choices, get 1st char. */ - ok=0 /*indicate answer isn't OK (so far). */ - select /* [↓] process the CBLF's choice/pick.*/ + do forever; say; say prompt; say /*prompt CBLF; then get a response. */ + c=word($.p $.s $.r $.L $.v,random(1,5)) /*the computer's first choice/pick. */ + m=max(@.r,@.p,@.s,@.L,@.v) /*used in examining CBLF's history. */ + if @.p==m then c=word(w.p,random(1,2)) /*emulate JC's The Amazing Karnac. */ + if @.s==m then c=word(w.s,random(1,2)) /* " " " " " */ + if @.r==m then c=word(w.r,random(1,2)) /* " " " " " */ + if @.L==m then c=word(w.L,random(1,2)) /* " " " " " */ + if @.v==m then c=word(w.v,random(1,2)) /* " " " " " */ + c1=left(c,1) /*C1 is used for faster comparing. */ + parse pull u; a=strip(u) /*obtain the CBLF's choice/pick. */ + upper a c1 ; a1=left(a,1) /*uppercase the choices, get 1st char. */ + ok=0 /*indicate answer isn't OK (so far). */ + select /* [↓] process the CBLF's choice/pick.*/ when words(u)==0 then say err 'nothing entered.' when words(u)>1 then say err 'too many choices: ' u when abbrev('QUIT', a) then do; say ! 'quitting.'; exit; end @@ -28,21 +28,21 @@ whom.1=! 'the computer wins. ' !; whom.2=! 'you win! ' !; win=words(t.p) abbrev('PAPER', a) |, abbrev('Vulcan', a) |, abbrev('SPOCK', a,2) | , - abbrev('SCISSORS',a,2) then ok=1 /*it's a valid CBLF choice.*/ + abbrev('SCISSORS',a,2) then ok=1 /*it's a valid choice for the human. */ otherwise say err 'you entered a bad choice: ' u end /*select*/ - if \ok then iterate /*answer ¬OK? Then get another choice.*/ - @.a1=@.a1+1 /*keep a history of the CBLF's choices.*/ + if \ok then iterate /*answer ¬OK? Then get another choice.*/ + @.a1=@.a1+1 /*keep a history of the CBLF's choices.*/ say ! 'computer chose: ' c - if a1==c1 then say ! 'draw.' /*Oh rats! The contest ended up a draw*/ - else do who=1 for 2 /*either the computer or the CBLF won. */ + if a1==c1 then say ! 'draw.' /*Oh rats! The contest ended up a draw*/ + else do who=1 for 2 /*either the computer or the CBLF won. */ if who==2 then parse value a1 c1 with c1 a1 - do j=1 for win /*see who won. */ - if $.a1\==word(t.c1,j) then iterate /*not this 'un. */ - say whom.who $.c1 word(b.c1,j) $.a1 /*notify winner.*/ - leave /*leave J loop.*/ + do j=1 for win /*see who won. */ + if $.a1\==word(t.c1,j) then iterate /*not this 'un. */ + say whom.who $.c1 word(b.c1,j) $.a1 /*notify winner.*/ + leave /*leave J loop.*/ end /*j*/ end /*who*/ end /*forever*/ - /*stick a fork in it, we're all done. */ + /*stick a fork in it, we're all done. */ diff --git a/Task/Roman-numerals-Decode/00DESCRIPTION b/Task/Roman-numerals-Decode/00DESCRIPTION index 69a193e9f8..9581b35f23 100644 --- a/Task/Roman-numerals-Decode/00DESCRIPTION +++ b/Task/Roman-numerals-Decode/00DESCRIPTION @@ -1,5 +1,13 @@ -Create a function that takes a Roman numeral as its argument and returns its value as a numeric decimal integer. You don't need to validate the form of the Roman numeral. +;Task: +Create a function that takes a Roman numeral as its argument and returns its value as a numeric decimal integer. -Modern Roman numerals are written by expressing each decimal digit of the number to be encoded separately, starting with the leftmost digit and skipping any 0s. -So 1990 is rendered "MCMXC" (1000 = M, 900 = CM, 90 = XC) and 2008 is rendered "MMVIII" (2000 = MM, 8 = VIII). -The Roman numeral for 1666, "MDCLXVI", uses each letter in descending order. +You don't need to validate the form of the Roman numeral. + +Modern Roman numerals are written by expressing each decimal digit of the number to be encoded separately, +
    starting with the leftmost decimal digit and skipping any '''0'''s   (zeroes). + +'''1990''' is rendered as   '''MCMXC'''     (1000 = M,   900 = CM,   90 = XC)     and +
    '''2008''' is rendered as   '''MMVIII'''       (2000 = MM,   8 = VIII). + +The Roman numeral for '''1666''',   '''MDCLXVI''',   uses each letter in descending order. +

    diff --git a/Task/Roman-numerals-Decode/AppleScript/roman-numerals-decode-1.applescript b/Task/Roman-numerals-Decode/AppleScript/roman-numerals-decode-1.applescript new file mode 100644 index 0000000000..824414cef3 --- /dev/null +++ b/Task/Roman-numerals-Decode/AppleScript/roman-numerals-decode-1.applescript @@ -0,0 +1,129 @@ +on run + map(romanValue, {"MCMXC", "MDCLXVI", "MMVIII"}) + + --> {1990, 1666, 2008} +end run + +-- romanValue :: String -> Int +on romanValue(s) + script roman + property mapping : [["M", 1000], ["CM", 900], ["D", 500], ["CD", 400], ¬ + ["C", 100], ["XC", 90], ["L", 50], ["XL", 40], ["X", 10], ["IX", 9], ¬ + ["V", 5], ["IV", 4], ["I", 1]] + + -- Value of first Roman glyph + value of remaining glyphs + -- toArabic :: [Char] -> Int + on toArabic(xs) + script transcribe + -- If this glyph:value pair matches the head of the list + -- return the value and the tail of the list + -- transcribe :: (String, Number) -> Maybe (Number, [String]) + on lambda(lstPair) + set lstR to characters of (item 1 of lstPair) + if isPrefixOf(lstR, xs) then + -- Value of this matching glyph, with any remaining glyphs + {item 2 of lstPair, drop(length of lstR, xs)} + else + {} + end if + end lambda + end script + + if length of xs > 0 then + set lstParse to concatMap(transcribe, mapping) + (item 1 of lstParse) + toArabic(item 2 of lstParse) + else + 0 + end if + end toArabic + end script + + toArabic(characters of s) of roman +end romanValue + + +-- GENERIC LIBRARY FUNCTIONS + +-- isPrefixOf :: [a] -> [a] -> Bool +on isPrefixOf(xs, ys) + if length of xs = 0 then + true + else + if length of ys = 0 then + false + else + set {x, xt} to uncons(xs) + set {y, yt} to uncons(ys) + (x = y) and isPrefixOf(xt, yt) + end if + end if +end isPrefixOf + +-- drop :: Int -> a -> a +on drop(n, a) + if n < length of a then + if class of a is text then + text (n + 1) thru -1 of a + else + items (n + 1) thru -1 of a + end if + else + {} + end if +end drop + +-- concatMap :: (a -> [b]) -> [a] -> [b] +on concatMap(f, xs) + script append + on lambda(a, b) + a & b + end lambda + end script + + foldl(append, {}, map(f, xs)) +end concatMap + +-- 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 + +-- 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 + +-- uncons :: [a] -> Maybe (a, [a]) +on uncons(xs) + if length of xs > 0 then + {item 1 of xs, rest of xs} + else + missing value + end if +end uncons + +-- 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 diff --git a/Task/Roman-numerals-Decode/AppleScript/roman-numerals-decode-2.applescript b/Task/Roman-numerals-Decode/AppleScript/roman-numerals-decode-2.applescript new file mode 100644 index 0000000000..ec75e9021b --- /dev/null +++ b/Task/Roman-numerals-Decode/AppleScript/roman-numerals-decode-2.applescript @@ -0,0 +1 @@ +{1990, 1666, 2008} diff --git a/Task/Roman-numerals-Decode/Clojure/roman-numerals-decode.clj b/Task/Roman-numerals-Decode/Clojure/roman-numerals-decode.clj index 6889c95f9d..a0ec81b8e7 100644 --- a/Task/Roman-numerals-Decode/Clojure/roman-numerals-decode.clj +++ b/Task/Roman-numerals-Decode/Clojure/roman-numerals-decode.clj @@ -1,6 +1,7 @@ +;; Incorporated some improvements from the alternative implementation below (defn ro2ar [r] - (->> (reverse r) - (replace (zipmap "MDCLXVI" [1000 500 100 50 10 5 1])) + (->> (reverse (.toUpperCase r)) + (map {\M 1000 \D 500 \C 100 \L 50 \X 10 \V 5 \I 1}) (partition-by identity) (map (partial apply +)) (reduce #(if (< %1 %2) (+ %1 %2) (- %1 %2))))) diff --git a/Task/Roman-numerals-Decode/Haskell/roman-numerals-decode.hs b/Task/Roman-numerals-Decode/Haskell/roman-numerals-decode-1.hs similarity index 100% rename from Task/Roman-numerals-Decode/Haskell/roman-numerals-decode.hs rename to Task/Roman-numerals-Decode/Haskell/roman-numerals-decode-1.hs diff --git a/Task/Roman-numerals-Decode/Haskell/roman-numerals-decode-2.hs b/Task/Roman-numerals-Decode/Haskell/roman-numerals-decode-2.hs new file mode 100644 index 0000000000..242362e131 --- /dev/null +++ b/Task/Roman-numerals-Decode/Haskell/roman-numerals-decode-2.hs @@ -0,0 +1,16 @@ +import Data.List (mapAccumL, isPrefixOf) + +romanValue :: String -> Int +romanValue s = sum . snd $ mapAccumL tr s + [("M", 1000), ("CM", 900), ("D", 500), ("CD", 400), + ("C", 100), ("XC", 90) ,("L", 50), ("XL", 40), + ("X", 10), ("IX", 9), ("V", 5), ("IV", 4), + ("I", 1)] + where + tr s (k, v) = + until (\(s, _) -> not $ isPrefixOf k s) + (\(s, n) -> (drop (length k) s, n + v)) (s, 0) + +main :: IO () +main = mapM_ (putStrLn . show . romanValue) + ["MDCLXVI", "MCMXC", "MMVIII", "MMXVI", "MMXVII"] diff --git a/Task/Roman-numerals-Decode/Maple/roman-numerals-decode.maple b/Task/Roman-numerals-Decode/Maple/roman-numerals-decode.maple new file mode 100644 index 0000000000..6321cdce2a --- /dev/null +++ b/Task/Roman-numerals-Decode/Maple/roman-numerals-decode.maple @@ -0,0 +1,2 @@ +f := n -> convert(n, arabic): +seq(printf("%a\n", f(i)), i in [MCMXC, MMVIII, MDCLXVI]); diff --git a/Task/Roman-numerals-Decode/Mathematica/roman-numerals-decode.math b/Task/Roman-numerals-Decode/Mathematica/roman-numerals-decode.math index 98bb1db86e..d027a55b9e 100644 --- a/Task/Roman-numerals-Decode/Mathematica/roman-numerals-decode.math +++ b/Task/Roman-numerals-Decode/Mathematica/roman-numerals-decode.math @@ -1 +1 @@ -FromDigits["MMCDV", "Roman"] +FromRomanNumeral["MMCDV"] diff --git a/Task/Roman-numerals-Decode/OCaml/roman-numerals-decode.ocaml b/Task/Roman-numerals-Decode/OCaml/roman-numerals-decode-1.ocaml similarity index 100% rename from Task/Roman-numerals-Decode/OCaml/roman-numerals-decode.ocaml rename to Task/Roman-numerals-Decode/OCaml/roman-numerals-decode-1.ocaml diff --git a/Task/Roman-numerals-Decode/OCaml/roman-numerals-decode-2.ocaml b/Task/Roman-numerals-Decode/OCaml/roman-numerals-decode-2.ocaml new file mode 100644 index 0000000000..3c60a05431 --- /dev/null +++ b/Task/Roman-numerals-Decode/OCaml/roman-numerals-decode-2.ocaml @@ -0,0 +1,57 @@ +(* Scan the roman number from right to left. *) +(* When processing a roman digit, if the previously processed roman digit was + * greater than the current one, we must substract the latter from the current + * total, otherwise add it. + * Example: + * - MCMLXX read from right to left is XXLMCM + * the sum is 10 + 10 + 50 + 1000 - 100 + 1000 *) +let decimal_of_roman roman = + (* Use 'String.uppercase' for OCaml 4.02 and previous. *) + let rom = String.uppercase_ascii roman in + (* A simple association list. IMHO a Hashtbl is a bit overkill here. *) + let romans = List.combine ['I'; 'V'; 'X'; 'L'; 'C'; 'D'; 'M'] + [1; 5; 10; 50; 100; 500; 1000] in + let compare x y = + if x < y then -1 else 1 + in + (* Scan the string from right to left using index i, and keeping track of + * the previously processed roman digit in prevdig. *) + let rec doloop i prevdig = + if i < 0 then 0 + else + try + let currdig = List.assoc rom.[i] romans in + (currdig * compare currdig prevdig) + doloop (i - 1) currdig + with + (* Ignore any incorrect roman digit and just process the next one. *) + Not_found -> doloop (i - 1) 0 + in + doloop (String.length rom - 1) 0 + + +(* Some simple tests. *) +let () = + let testit roman decimal = + let conv = decimal_of_roman roman in + let status = if conv = decimal then "PASS" else "FAIL" in + Printf.sprintf "[%s] %s\tgives %d.\tExpected: %d.\t" + status roman conv decimal + in + print_endline ">>> Usual roman numbers."; + print_endline (testit "MCMXC" 1990); + print_endline (testit "MMVIII" 2008); + print_endline (testit "MDCLXVI" 1666); + print_newline (); + + print_endline ">>> Roman numbers with lower case letters are OK."; + print_endline (testit "McmXC" 1990); + print_endline (testit "MMviii" 2008); + print_endline (testit "mdCLXVI" 1666); + print_newline (); + + print_endline ">>> Incorrect roman digits are ignored."; + print_endline (testit "McmFFXC" 1990); + print_endline (testit "MMviiiPPPPP" 2008); + print_endline (testit "mdCLXVI_WHAT_NOW" 1666); + print_endline (testit "2 * PI ^ 2" 1); (* The I in PI... *) + print_endline (testit "E = MC^2" 1100) diff --git a/Task/Roman-numerals-Decode/PowerShell/roman-numerals-decode.psh b/Task/Roman-numerals-Decode/PowerShell/roman-numerals-decode-1.psh similarity index 99% rename from Task/Roman-numerals-Decode/PowerShell/roman-numerals-decode.psh rename to Task/Roman-numerals-Decode/PowerShell/roman-numerals-decode-1.psh index 6df0d6c8a4..1ab7f7e3af 100644 --- a/Task/Roman-numerals-Decode/PowerShell/roman-numerals-decode.psh +++ b/Task/Roman-numerals-Decode/PowerShell/roman-numerals-decode-1.psh @@ -87,7 +87,4 @@ function ConvertFrom-RomanNumeral $value } - End - { - } } diff --git a/Task/Roman-numerals-Decode/PowerShell/roman-numerals-decode-2.psh b/Task/Roman-numerals-Decode/PowerShell/roman-numerals-decode-2.psh new file mode 100644 index 0000000000..52ee9b055e --- /dev/null +++ b/Task/Roman-numerals-Decode/PowerShell/roman-numerals-decode-2.psh @@ -0,0 +1 @@ +-split "MM MMI MMII MMIII MMIV MMV MMVI MMVII MMVIII MMIX MMX MMXI MMXII MMXIII MMXIV MMXV MMXVI" | ConvertFrom-RomanNumeral diff --git a/Task/Roman-numerals-Decode/Python/roman-numerals-decode-3.py b/Task/Roman-numerals-Decode/Python/roman-numerals-decode-3.py new file mode 100644 index 0000000000..0dc837be57 --- /dev/null +++ b/Task/Roman-numerals-Decode/Python/roman-numerals-decode-3.py @@ -0,0 +1,3 @@ +numerals = { 'M' : 1000, 'D' : 500, 'C' : 100, 'L' : 50, 'X' : 10, 'V' : 5, 'I' : 1 } +def romannumeral2number(s): + return reduce(lambda x, y: -x + y if x < y else x + y, map(lambda x: numerals.get(x, 0), s.upper())) diff --git a/Task/Roman-numerals-Decode/REXX/roman-numerals-decode-2.rexx b/Task/Roman-numerals-Decode/REXX/roman-numerals-decode-2.rexx index 7f9c864a34..7f39e8ffb0 100644 --- a/Task/Roman-numerals-Decode/REXX/roman-numerals-decode-2.rexx +++ b/Task/Roman-numerals-Decode/REXX/roman-numerals-decode-2.rexx @@ -1,29 +1,26 @@ -/*REXX program to convert Roman numeral number(s) to Arabic number(s). */ -rYear = 'MCMXC' ; say right(rYear,9)':' rom2dec(rYear) -rYear = 'mmviii' ; say right(rYear,9)':' rom2dec(rYear) -rYear = 'MDCLXVI' ; say right(rYear,9)':' rom2dec(rYear) -exit - -rom2dec: procedure; arg roman . -if verify(roman,'MDCLXVI')\==0 then do - say 'invalid Roman number:' roman - return '***error!***' - end -#=rChar(right(roman,1)) /*start with the last numeral*/ +/*REXX program converts Roman numeral number(s) ───► Arabic numerals (or numbers). */ +rYear = 'MCMXC' ; say right(rYear, 9)":" rom2dec(rYear) +rYear = 'mmviii' ; say right(rYear, 9)":" rom2dec(rYear) +rYear = 'MDCLXVI' ; say right(rYear, 9)":" rom2dec(rYear) +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +rom2dec: procedure; arg roman . /*obtain the Roman numeral number. */ +if verify(roman, 'MDCLXVI')\==0 then return "***error*** invalid Roman number:" roman +#=rChar(right(roman, 1)) /*start with the last Roman numeral. */ do j=1 for length(roman) - 1 - x=rChar(substr(roman,j ,1)) /*the current Roman numeral. */ - y=rChar(substr(roman,j+1,1)) /*the next Roman numeral. */ - if xh then h=_ /*remember Roman numeral.*/ - if _next? Then sub. */ - else #=#+_ /* else add. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +rom2dec: procedure; h='0'x; #=0; $=1; arg n . /*"ARG" uppercases N. */ +n=translate(n, '()()', "[]{}"); _=verify(n, 'MDCLXVUIJ()') /*trans grouping symbols.*/ +if _\==0 then return '***error*** invalid Roman numeral:' substr(n,_,1) /*tell error*/ +@.=1; @.m=1000; @.d=500; @.c=100; @.l=50; @.x=10; @.u=5; @.v=5 /*Roman numeral values. */ + /* [↓] convert number. */ + do k=length(n) to 1 by -1; _=substr(n, k, 1) /*examine a Roman numeral*/ + /* [↑] scale up or down.*/ + if _=='(' | _==")" then do; $=$*1000; if _=='(' then $=1 /* (≡scale ↑; )≡scale ↓ */ + iterate /*go & process next digit*/ + end + _=@._*$ /*scale it if necessary. */ + if _>h then h=_ /*remember Roman numeral.*/ + if _next? Then sub. */ + else #=#+_ /* else add. */ end /*k*/ -return # /*return Arabic number. */ +return # /*return Arabic number. */ diff --git a/Task/Roman-numerals-Encode/00DESCRIPTION b/Task/Roman-numerals-Encode/00DESCRIPTION index 93be26b833..cf5126afbf 100644 --- a/Task/Roman-numerals-Encode/00DESCRIPTION +++ b/Task/Roman-numerals-Encode/00DESCRIPTION @@ -1,12 +1,11 @@ {{omit from|GUISS}} -Create a function taking a positive integer as its parameter -and returning a string containing the Roman Numeral representation -of that integer. +;Task: +Create a function taking a positive integer as its parameter and returning a string containing the Roman numeral representation of that integer. Modern Roman numerals are written by expressing each digit separately, starting with the left most digit and skipping any digit with a value of zero. -Modern Roman numerals are written by expressing each digit separately, -starting with the left most digit and skipping any digit with a value of zero. -In Roman numerals 1990 is rendered: 1000=M, 900=CM, 90=XC; resulting in MCMXC.
    -2008 is written as 2000=MM, 8=VIII; or MMVIII.
    -1666 uses each Roman symbol in descending order: MDCLXVI. +In Roman numerals: +* 1990 is rendered: 1000=M, 900=CM, 90=XC; resulting in MCMXC +* 2008 is written as 2000=MM, 8=VIII; or MMVIII +* 1666 uses each Roman symbol in descending order: MDCLXVI +

    diff --git a/Task/Roman-numerals-Encode/AppleScript/roman-numerals-encode.applescript b/Task/Roman-numerals-Encode/AppleScript/roman-numerals-encode.applescript new file mode 100644 index 0000000000..e22095ff6b --- /dev/null +++ b/Task/Roman-numerals-Encode/AppleScript/roman-numerals-encode.applescript @@ -0,0 +1,92 @@ +-- roman :: Int -> String +on roman(n) + script romanDigits + on lambda(a, lstPair) + set n to remainder of a + set v to item 1 of lstPair + + if v > n then + a + else + {remainder:n mod v, roman:(roman of a) & ¬ + replicate(n div v, item 2 of lstPair)} + end if + end lambda + end script + + roman of foldl(romanDigits, {remainder:n, roman:""}, ¬ + [[1000, "M"], [900, "CM"], [500, "D"], ¬ + [400, "CD"], [100, "C"], [90, "XC"], [50, "L"], [40, "XL"], ¬ + [10, "X"], [9, "IX"], [5, "V"], [4, "IV"], [1, "I"]]) +end roman + + +-- TEST + +on run + map(roman, [2016, 1990, 2008, 2000, 1666]) + + --> {"MMXVI", "MCMXC", "MMVIII", "MM", "MDCLXVI"} +end run + + + +-- GENERIC LIBRARY FUNCTIONS + +-- 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 + +-- 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 + +-- Egyptian multiplication - progressively doubling a list, appending +-- stages of doubling to an accumulator where needed for binary +-- assembly of a target length + +-- replicate :: Int -> a -> [a] +on replicate(n, a) + if class of a is list then + set out to {} + else + set out to "" + end if + if n < 1 then return out + set dbl to a + + repeat while (n > 1) + if (n mod 2) > 0 then set out to out & dbl + set n to (n div 2) + set dbl to (dbl & dbl) + end repeat + return out & dbl +end replicate + +-- 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 diff --git a/Task/Roman-numerals-Encode/Ela/roman-numerals-encode.ela b/Task/Roman-numerals-Encode/Ela/roman-numerals-encode.ela new file mode 100644 index 0000000000..81bb7adf0a --- /dev/null +++ b/Task/Roman-numerals-Encode/Ela/roman-numerals-encode.ela @@ -0,0 +1,16 @@ +open number string math + +digit x y z k = + [[x],[x,x],[x,x,x],[x,y],[y],[y,x],[y,x,x],[y,x,x,x],[x,z]] : + (toInt k - 1) + +toRoman 0 = "" +toRoman x | x < 0 = fail "Negative roman numeral" + | x >= 1000 = 'M' :: toRoman (x - 1000) + | x >= 100 = let (q,r) = x `divrem` 100 in + digit 'C' 'D' 'M' q ++ toRoman r + | x >= 10 = let (q,r) = x `divrem` 10 in + digit 'X' 'L' 'C' q ++ toRoman r + | else = digit 'I' 'V' 'X' x + +map (join "" << toRoman) [1999,25,944] diff --git a/Task/Roman-numerals-Encode/Haskell/roman-numerals-encode-2.hs b/Task/Roman-numerals-Encode/Haskell/roman-numerals-encode-2.hs index 1d1e3313de..e5754d187c 100644 --- a/Task/Roman-numerals-Encode/Haskell/roman-numerals-encode-2.hs +++ b/Task/Roman-numerals-Encode/Haskell/roman-numerals-encode-2.hs @@ -1,2 +1,15 @@ -*Main> map toRoman [1999,25,944] -["MCMXCIX","XXV","CMXLIV"] +import Data.List (mapAccumL) + +roman :: Int -> String +roman n = concatMap concat . snd $ mapAccumL tr n + [(1000, "M"), (900, "CM"), (500, "D") ,( 400, "CD"), + ( 100, "C"), ( 90, "XC") ,( 50, "L"), ( 40, "XL"), + ( 10, "X"), ( 9, "IX"), ( 5, "V"), ( 4, "IV"), + ( 1, "I")] + where + tr a (m, s) = (r, replicate q s) + where + (q, r) = quotRem a m + +main :: IO () +main = mapM_ (putStrLn . roman) [1666, 1990, 2008, 2016, 2017] diff --git a/Task/Roman-numerals-Encode/Haskell/roman-numerals-encode.hs b/Task/Roman-numerals-Encode/Haskell/roman-numerals-encode.hs deleted file mode 100644 index 1bb1ed0b84..0000000000 --- a/Task/Roman-numerals-Encode/Haskell/roman-numerals-encode.hs +++ /dev/null @@ -1,13 +0,0 @@ -digit x y z k = - [[x],[x,x],[x,x,x],[x,y],[y],[y,x],[y,x,x],[y,x,x,x],[x,z]] !! - (fromInteger k - 1) - -toRoman :: Integer -> String -toRoman 0 = "" -toRoman x | x < 0 = error "Negative roman numeral" -toRoman x | x >= 1000 = 'M' : toRoman (x - 1000) -toRoman x | x >= 100 = digit 'C' 'D' 'M' q ++ toRoman r where - (q,r) = x `divMod` 100 -toRoman x | x >= 10 = digit 'X' 'L' 'C' q ++ toRoman r where - (q,r) = x `divMod` 10 -toRoman x = digit 'I' 'V' 'X' x diff --git a/Task/Roman-numerals-Encode/JavaScript/roman-numerals-encode-2.js b/Task/Roman-numerals-Encode/JavaScript/roman-numerals-encode-2.js index b72885b53a..19b02469be 100644 --- a/Task/Roman-numerals-Encode/JavaScript/roman-numerals-encode-2.js +++ b/Task/Roman-numerals-Encode/JavaScript/roman-numerals-encode-2.js @@ -1,50 +1,49 @@ -function roman(strIntegers) { - 'use strict'; - // DICTIONARY OF GLYPH:VALUE MAPPINGS - var dctGlyphs = { - M: 1000, - CM: 900, - D: 500, - CD: 400, - C: 100, - XC: 90, - L: 50, - XL: 40, - X: 10, - IX: 9, - V: 5, - IV: 4, - I: 1 - }; - - // LIST OF INTEGER STRINGS, WITH ANY SEPARATOR - var strNums = typeof strIntegers === 'string' ? strIntegers : strIntegers.toString(), - lstParts = strNums.split(/\d+/), - strSeparator = lstParts.length > 1 ? lstParts[1] : '', - lstDecimal = strSeparator ? strIntegers.split(strSeparator) : [strNums]; +(function () { + 'use strict'; - // REWRITE OF DECIMAL INTEGER AS ROMAN - function rewrite(strN) { - var n = Number(strN); + // If the Roman is a string, pass any delimiters through - /* Starting with the highest-valued glyph: - take as many bites as we can with it - (decrementing residual value with each bite, - and appending a corresponding glyph copy to the string) - before moving down to the next most expensive glyph */ + // (Int | String) -> String + function romanTranscription(a) { + if (typeof a === 'string') { + var ps = a.split(/\d+/), + dlm = ps.length > 1 ? ps[1] : undefined; - // return Object.keys(dctGlyphs).reduce( - // OR: - return 'M CM D CD C XC L XL X IX V IV I'.split(' ').reduce( - function (s, k) { - var v = dctGlyphs[k]; - return n >= v ? (n -= v, s + k) : s; - }, '' - ) + return (dlm ? a.split(dlm) + .map(function (x) { + return Number(x); + }) : [a]) + .map(roman) + .join(dlm); + } else return roman(a); + } - } + // roman :: Int -> String + function roman(n) { + return [[1000, "M"], [900, "CM"], [500, "D"], [400, "CD"], [100, + "C"], [90, "XC"], [50, "L"], [40, "XL"], [10, "X"], [9, + "IX"], [5, "V"], [4, "IV"], [1, "I"]] + .reduce(function (a, lstPair) { + var m = a.remainder, + v = lstPair[0]; - // ALL REWRITTEN, WITH SEPARATOR RESTORED - return lstDecimal.map(rewrite).join(strSeparator); -} + return (v > m ? a : { + remainder: m % v, + roman: a.roman + Array( + Math.floor(m / v) + 1 + ) + .join(lstPair[1]) + }); + }, { + remainder: n, + roman: '' + }).roman; + } + + // TEST + + return [2016, 1990, 2008, "14.09.2015", 2000, 1666].map( + romanTranscription); + +})(); diff --git a/Task/Roman-numerals-Encode/JavaScript/roman-numerals-encode-3.js b/Task/Roman-numerals-Encode/JavaScript/roman-numerals-encode-3.js index 4b13115362..c335291dbd 100644 --- a/Task/Roman-numerals-Encode/JavaScript/roman-numerals-encode-3.js +++ b/Task/Roman-numerals-Encode/JavaScript/roman-numerals-encode-3.js @@ -1,5 +1 @@ -roman(1999); -// --> "MCMXCIX" - -[1990, 2008, "14.09.2015", 2000, 1666].map(roman); -// --> ["MCMXC", "MCMCVI", "XIV.IX.MCMCXV", "MCMC", "MDCLXVI"] +["MMXVI", "MCMXC", "MMVIII", "XIV.IX.MMXV", "MM", "MDCLXVI"] diff --git a/Task/Roman-numerals-Encode/JavaScript/roman-numerals-encode-4.js b/Task/Roman-numerals-Encode/JavaScript/roman-numerals-encode-4.js new file mode 100644 index 0000000000..8f5d7fff24 --- /dev/null +++ b/Task/Roman-numerals-Encode/JavaScript/roman-numerals-encode-4.js @@ -0,0 +1,55 @@ +(() => { + 'use strict'; + + // roman :: Int -> String + const roman = n => [ + [1000, "M"], + [900, "CM"], + [500, "D"], + [400, "CD"], + [100,"C"], + [90, "XC"], + [50, "L"], + [40, "XL"], + [10, "X"], + [9,"IX"], + [5, "V"], + [4, "IV"], + [1, "I"] + ] + .reduce((a, lstPair) => { + const m = a.remainder, + v = lstPair[0]; + return (v > m ? a : { + remainder: m % v, + roman: a.roman + Array( + Math.floor(m / v) + 1 + ) + .join(lstPair[1]) + }); + }, { + remainder: n, + roman: '' + }) + .roman; + + // TEST + + // If the input is a decimal string, pass any delimiters through + // romanTranscription :: (Int | String) -> String + const romanTranscription = a => { + if (typeof a === 'string') { + const ps = a.split(/\d+/), + dlm = ps.length > 1 ? ps[1] : undefined; + + return (dlm ? a.split(dlm) + .map(Number) : [a]) + .map(roman) + .join(dlm); + } else return roman(a); + } + + // TEST + return [2016, 1990, 2008, "14.09.2015", 2000, 1666] + .map(romanTranscription); +})(); diff --git a/Task/Roman-numerals-Encode/JavaScript/roman-numerals-encode-5.js b/Task/Roman-numerals-Encode/JavaScript/roman-numerals-encode-5.js new file mode 100644 index 0000000000..76a1730b6e --- /dev/null +++ b/Task/Roman-numerals-Encode/JavaScript/roman-numerals-encode-5.js @@ -0,0 +1,8 @@ +[ + "MMXVI", + "MCMXC", + "MMVIII", + "XIV.IX.MMXV", + "MM", + "MDCLXVI" +] diff --git a/Task/Roman-numerals-Encode/Kotlin/roman-numerals-encode.kotlin b/Task/Roman-numerals-Encode/Kotlin/roman-numerals-encode.kotlin new file mode 100644 index 0000000000..6bc5d0aada --- /dev/null +++ b/Task/Roman-numerals-Encode/Kotlin/roman-numerals-encode.kotlin @@ -0,0 +1,36 @@ +val romanNumerals = mapOf( + 1000 to "M", + 900 to "CM", + 500 to "D", + 400 to "CD", + 100 to "C", + 90 to "XC", + 50 to "L", + 40 to "XL", + 10 to "X", + 9 to "IX", + 5 to "V", + 4 to "IV", + 1 to "I" +) + +fun encode(number: Int): String? { + if (number > 5000 || number < 1) { + return null + } + var num = number + val buffer = StringBuffer() + for ((multiple, numeral) in romanNumerals) { + while (num >= multiple) { + num -= multiple + buffer.append(numeral) + } + } + return buffer.toString() +} + +fun main(args: Array) { + println(encode(1990)) + println(encode(1666)) + println(encode(2008)) +} diff --git a/Task/Roman-numerals-Encode/Mathematica/roman-numerals-encode-1.math b/Task/Roman-numerals-Encode/Mathematica/roman-numerals-encode-1.math index bff98c1877..b2b058cd9d 100644 --- a/Task/Roman-numerals-Encode/Mathematica/roman-numerals-encode-1.math +++ b/Task/Roman-numerals-Encode/Mathematica/roman-numerals-encode-1.math @@ -1,10 +1,5 @@ -RomanForm[i_Integer?Positive] := - Module[{num = i, string = "", value, letters, digits}, - digits = {{1000, "M"}, {900, "CM"}, {500, "D"}, {400, "CD"}, {100, - "C"}, {90, "XC"}, {50, "L"}, {40, "XL"}, {10, "X"}, {9, - "IX"}, {5, "V"}, {4, "IV"}, {1, "I"}}; - While[num > 0, {value, letters} = - Which @@ Flatten[{num >= #[[1]], ##} & /@ digits, 1]; - num -= value; - string = string <> letters;]; - string] +RomanNumeral[4] +RomanNumeral[99] +RomanNumeral[1337] +RomanNumeral[1666] +RomanNumeral[6889] diff --git a/Task/Roman-numerals-Encode/Mathematica/roman-numerals-encode-2.math b/Task/Roman-numerals-Encode/Mathematica/roman-numerals-encode-2.math index 7fc493446b..f87b75c0cb 100644 --- a/Task/Roman-numerals-Encode/Mathematica/roman-numerals-encode-2.math +++ b/Task/Roman-numerals-Encode/Mathematica/roman-numerals-encode-2.math @@ -1,5 +1,5 @@ -RomanForm[4] -RomanForm[99] -RomanForm[1337] -RomanForm[1666] -RomanForm[6889] +IV +XCIX +MCCCXXXVII +MDCLXVI +MMMMMMDCCCLXXXIX diff --git a/Task/Roman-numerals-Encode/Mathematica/roman-numerals-encode-3.math b/Task/Roman-numerals-Encode/Mathematica/roman-numerals-encode-3.math index f87b75c0cb..e4e29920f3 100644 --- a/Task/Roman-numerals-Encode/Mathematica/roman-numerals-encode-3.math +++ b/Task/Roman-numerals-Encode/Mathematica/roman-numerals-encode-3.math @@ -1,5 +1,52 @@ -IV -XCIX -MCCCXXXVII -MDCLXVI -MMMMMMDCCCLXXXIX +:- module roman. + +:- interface. + +:- import_module io. + +:- pred main(io::di, io::uo) is det. + +:- implementation. + +:- import_module char, int, list, string. + +main(!IO) :- + command_line_arguments(Args, !IO), + filter(is_all_digits, Args, CleanArgs), + foldl((pred(Arg::in, !.IO::di, !:IO::uo) is det :- + ( Roman = to_roman(Arg) -> + format("%s => %s", [s(Arg), s(Roman)], !IO), nl(!IO) + ; format("%s cannot be converted.", [s(Arg)], !IO), nl(!IO) ) + ), CleanArgs, !IO). + +:- func to_roman(string::in) = (string::out) is semidet. +to_roman(Number) = from_char_list(build_roman(reverse(to_char_list(Number)))). + +:- func build_roman(list(char)) = list(char). +:- mode build_roman(in) = out is semidet. +build_roman([]) = []. +build_roman([D|R]) = Roman :- + map(promote, build_roman(R), Interim), + Roman = Interim ++ digit_to_roman(D). + +:- func digit_to_roman(char) = list(char). +:- mode digit_to_roman(in) = out is semidet. +digit_to_roman('0') = []. +digit_to_roman('1') = ['I']. +digit_to_roman('2') = ['I','I']. +digit_to_roman('3') = ['I','I','I']. +digit_to_roman('4') = ['I','V']. +digit_to_roman('5') = ['V']. +digit_to_roman('6') = ['V','I']. +digit_to_roman('7') = ['V','I','I']. +digit_to_roman('8') = ['V','I','I','I']. +digit_to_roman('9') = ['I','X']. + +:- pred promote(char::in, char::out) is semidet. +promote('I', 'X'). +promote('V', 'L'). +promote('X', 'C'). +promote('L', 'D'). +promote('C', 'M'). + +:- end_module roman. diff --git a/Task/Roman-numerals-Encode/Mathematica/roman-numerals-encode-4.math b/Task/Roman-numerals-Encode/Mathematica/roman-numerals-encode-4.math index e4e29920f3..9215a87478 100644 --- a/Task/Roman-numerals-Encode/Mathematica/roman-numerals-encode-4.math +++ b/Task/Roman-numerals-Encode/Mathematica/roman-numerals-encode-4.math @@ -1,4 +1,4 @@ -:- module roman. +:- module roman2. :- interface. @@ -12,41 +12,37 @@ main(!IO) :- command_line_arguments(Args, !IO), - filter(is_all_digits, Args, CleanArgs), + filter_map(to_int, Args, CleanArgs), foldl((pred(Arg::in, !.IO::di, !:IO::uo) is det :- ( Roman = to_roman(Arg) -> - format("%s => %s", [s(Arg), s(Roman)], !IO), nl(!IO) - ; format("%s cannot be converted.", [s(Arg)], !IO), nl(!IO) ) + format("%i => %s", + [i(Arg), s(from_char_list(Roman))], !IO), + nl(!IO) + ; format("%i cannot be converted.", [i(Arg)], !IO), nl(!IO) ) ), CleanArgs, !IO). -:- func to_roman(string::in) = (string::out) is semidet. -to_roman(Number) = from_char_list(build_roman(reverse(to_char_list(Number)))). +:- func to_roman(int) = list(char). +:- mode to_roman(in) = out is semidet. +to_roman(N) = ( N >= 1000 -> + ['M'] ++ to_roman(N - 1000) + ;( N >= 100 -> + digit(N / 100, 'C', 'D', 'M') ++ to_roman(N rem 100) + ;( N >= 10 -> + digit(N / 10, 'X', 'L', 'C') ++ to_roman(N rem 10) + ;( N >= 1 -> + digit(N, 'I', 'V', 'X') + ; [] ) ) ) ). -:- func build_roman(list(char)) = list(char). -:- mode build_roman(in) = out is semidet. -build_roman([]) = []. -build_roman([D|R]) = Roman :- - map(promote, build_roman(R), Interim), - Roman = Interim ++ digit_to_roman(D). +:- func digit(int, char, char, char) = list(char). +:- mode digit(in, in, in, in) = out is semidet. +digit(1, X, _, _) = [X]. +digit(2, X, _, _) = [X, X]. +digit(3, X, _, _) = [X, X, X]. +digit(4, X, Y, _) = [X, Y]. +digit(5, _, Y, _) = [Y]. +digit(6, X, Y, _) = [Y, X]. +digit(7, X, Y, _) = [Y, X, X]. +digit(8, X, Y, _) = [Y, X, X, X]. +digit(9, X, _, Z) = [X, Z]. -:- func digit_to_roman(char) = list(char). -:- mode digit_to_roman(in) = out is semidet. -digit_to_roman('0') = []. -digit_to_roman('1') = ['I']. -digit_to_roman('2') = ['I','I']. -digit_to_roman('3') = ['I','I','I']. -digit_to_roman('4') = ['I','V']. -digit_to_roman('5') = ['V']. -digit_to_roman('6') = ['V','I']. -digit_to_roman('7') = ['V','I','I']. -digit_to_roman('8') = ['V','I','I','I']. -digit_to_roman('9') = ['I','X']. - -:- pred promote(char::in, char::out) is semidet. -promote('I', 'X'). -promote('V', 'L'). -promote('X', 'C'). -promote('L', 'D'). -promote('C', 'M'). - -:- end_module roman. +:- end_module roman2. diff --git a/Task/Roman-numerals-Encode/PowerShell/roman-numerals-encode.psh b/Task/Roman-numerals-Encode/PowerShell/roman-numerals-encode-1.psh similarity index 98% rename from Task/Roman-numerals-Encode/PowerShell/roman-numerals-encode.psh rename to Task/Roman-numerals-Encode/PowerShell/roman-numerals-encode-1.psh index 16d4475449..b380629b42 100644 --- a/Task/Roman-numerals-Encode/PowerShell/roman-numerals-encode.psh +++ b/Task/Roman-numerals-Encode/PowerShell/roman-numerals-encode-1.psh @@ -58,7 +58,4 @@ function ConvertTo-RomanNumeral $RomanNumeral } - End - { - } } diff --git a/Task/Roman-numerals-Encode/PowerShell/roman-numerals-encode-2.psh b/Task/Roman-numerals-Encode/PowerShell/roman-numerals-encode-2.psh new file mode 100644 index 0000000000..25f984e80c --- /dev/null +++ b/Task/Roman-numerals-Encode/PowerShell/roman-numerals-encode-2.psh @@ -0,0 +1,6 @@ +1..50 | ForEach-Object { + [PSCustomObject]@{ + SuperbowlNumber = $_ + SuperbowlNumeral = ConvertTo-RomanNumeral -Number $_ + } +} diff --git a/Task/Roman-numerals-Encode/Python/roman-numerals-encode-4.py b/Task/Roman-numerals-Encode/Python/roman-numerals-encode-4.py new file mode 100644 index 0000000000..bb2df40e55 --- /dev/null +++ b/Task/Roman-numerals-Encode/Python/roman-numerals-encode-4.py @@ -0,0 +1,11 @@ +rnl = [ { '4' : 'MMMM', '3' : 'MMM', '2' : 'MM', '1' : 'M', '0' : '' }, { '9' : 'CM', '8' : 'DCCC', '7' : 'DCC', + '6' : 'DC', '5' : 'D', '4' : 'CD', '3' : 'CCC', '2' : 'CC', '1' : 'C', '0' : '' }, { '9' : 'XC', + '8' : 'LXXX', '7' : 'LXX', '6' : 'LX', '5' : 'L', '4' : 'XL', '3' : 'XXX', '2' : 'XX', '1' : 'X', + '0' : '' }, { '9' : 'IX', '8' : 'VIII', '7' : 'VII', '6' : 'VI', '5' : 'V', '4' : 'IV', '3' : 'III', + '2' : 'II', '1' : 'I', '0' : '' }] +# Option 1 +def number2romannumeral(n): + return ''.join([rnl[x][y] for x, y in zip(range(4), str(n).zfill(4)) if n < 5000 and n > -1]) +# Option 2 +def number2romannumeral(n): + return reduce(lambda x, y: x + y, map(lambda x, y: rnl[x][y], range(4), str(n).zfill(4))) if -1 < n < 5000 else None diff --git a/Task/Roman-numerals-Encode/REXX/roman-numerals-encode-2.rexx b/Task/Roman-numerals-Encode/REXX/roman-numerals-encode-2.rexx index 245c16ed42..ae0496e3d0 100644 --- a/Task/Roman-numerals-Encode/REXX/roman-numerals-encode-2.rexx +++ b/Task/Roman-numerals-Encode/REXX/roman-numerals-encode-2.rexx @@ -1,64 +1,53 @@ -/*REXX program converts (Arabic) decimal numbers (≥0) ──► Roman numerals*/ -numeric digits 10000 /*could be higher if wanted*/ -parse arg nums +/*REXX program converts (Arabic) non─negative decimal integers (≥0) ───► Roman numerals.*/ +numeric digits 10000 /*decimal digs can be higher if wanted.*/ +parse arg # /*obtain optional integers from the CL.*/ +@er= "argument isn't a non-negative integer: " /*literal used when issuing error msg. */ +if #='' then /*Nothing specified? Then generate #s.*/ + do + do j= 0 by 11 to 111; #=# j; end + #=# 49; do k=88 by 100 to 1200; #=# k; end + #=# 1000 2000 3000 4000 5000 6000; do m=88 by 200 to 1200; #=# m; end + #=# 1304 1405 1506 1607 1708 1809 1910 2011; do p= 4 to 50; #=# 10**p; end + end /*finished with generation of numbers. */ -if nums='' then do /*not specified? Gen some.*/ - do j=0 by 11 to 111 - nums=nums j - end /*j*/ - nums=nums 49 - do k=88 by 100 to 1200 - nums=nums k - end /*k*/ - nums=nums 1000 2000 3000 4000 5000 6000 - do m=88 by 200 to 1200 - nums=nums m - end /*m*/ - nums=nums 1304 1405 1506 1607 1708 1809 1910 2011 - do p=4 to 50 /*there is no limit to this*/ - nums=nums 10**p - end /*p*/ - end /*end generation of numbers*/ - - do i=1 for words(nums); x=word(nums,i) - say right(x,55) dec2rom(x) - end /*i*/ -exit /*stick a fork in it, we're done.*/ -/*───────────────────────────DEC2ROM subroutine─────────────────────────*/ -dec2rom: procedure; parse arg n,# /*get number, assign # to a null. */ -n=space(translate(n,,','),0) /*remove any commas from number. */ -nulla='ZEPHIRUM NULLAE NULLA NIHIL' /*Roman words for nothing or none.*/ -if n==0 then return word(nulla,1) /*return a Roman word for zero. */ -maxnp=(length(n)-1)%3 /*find max(+1) # of parens to use.*/ -highPos=(maxnp+1)*3 /*highest position of number. */ -nn=reverse(right(n,highPos,0)) /*digits for Arabic───►Roman conv.*/ -nine=9 -four=4; do j=highPos to 1 by -3 - _=substr(nn,j,1); select - when _==nine then hx='CM' - when _>= 5 then hx='D'copies("C",_-5) - when _==four then hx='CD' - otherwise hx=copies('C',_) - end - _=substr(nn,j-1,1); select - when _==nine then tx='XC' - when _>= 5 then tx='L'copies("X",_-5) - when _==four then tx='XL' - otherwise tx=copies('X',_) - end - _=substr(nn,j-2,1); select - when _==nine then ux='IX' - when _>= 5 then ux='V'copies("I",_-5) - when _==four then ux='IV' - otherwise ux=copies('I',_) - end - xx=hx || tx || ux - if xx\=='' then #=# ||copies('(',(j-1)%3)xx ||copies(')',(j-1)%3) - end /*j*/ - -if pos('(I',#)\==0 then do i=1 for 4 /*special case: M,MM,MMM,MMMM.*/ - if i==4 then _ = '(IV)' - else _ = '('copies("I",i)')' - if pos(_,#)\==0 then #=changestr(_,#,copies('M',i)) - end /*i*/ -return # + do i=1 for words(#); x=word(#, i) /*convert each of the numbers───►Roman.*/ + if \datatype(x, 'W') | x<0 then say "***error***" @er x /*¬ whole #? negative?*/ + say right(x, 55) dec2rom(x) + end /*i*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +dec2rom: procedure; parse arg n,# /*obtain the number, assign # to a null*/ + n=space(translate(n/1, , ','), 0) /*remove commas from normalized integer*/ + nulla= 'ZEPHIRUM NULLAE NULLA NIHIL' /*Roman words for "nothing" or "none". */ + if n==0 then return word(nulla, 1) /*return a Roman word for "zero". */ + maxnp=(length(n)-1)%3 /*find max(+1) # of parenthesis to use.*/ + highPos=(maxnp+1)*3 /*highest position of number. */ + nn=reverse( right(n, highPos, 0) ) /*digits for Arabic──►Roman conversion.*/ + do j=highPos to 1 by -3 + _=substr(nn, j, 1); select /*════════════════════hundreds.*/ + when _==9 then hx='CM' + when _>=5 then hx='D'copies("C", _-5) + when _==4 then hx='CD' + otherwise hx= copies('C', _) + end /*select hundreds*/ + _=substr(nn, j-1, 1); select /*════════════════════════tens.*/ + when _==9 then tx='XC' + when _>=5 then tx='L'copies("X", _-5) + when _==4 then tx='XL' + otherwise tx= copies('X', _) + end /*select tens*/ + _=substr(nn, j-2, 1); select /*═══════════════════════units.*/ + when _==9 then ux='IX' + when _>=5 then ux='V'copies("I", _-5) + when _==4 then ux='IV' + otherwise ux= copies('I', _) + end /*select units*/ + $=hx || tx || ux + if $\=='' then #=# || copies("(", (j-1)%3)$ ||copies(')', (j-1)%3) + end /*j*/ + if pos('(I',#)\==0 then do i=1 for 4 /*special case: M,MM,MMM,MMMM.*/ + if i==4 then _ = '(IV)' + else _ = '('copies("I", i)')' + if pos(_, #)\==0 then #=changestr(_, #, copies('M', i)) + end /*i*/ + return # diff --git a/Task/Roman-numerals-Encode/Racket/roman-numerals-encode-1.rkt b/Task/Roman-numerals-Encode/Racket/roman-numerals-encode-1.rkt index b796d884db..1669236765 100644 --- a/Task/Roman-numerals-Encode/Racket/roman-numerals-encode-1.rkt +++ b/Task/Roman-numerals-Encode/Racket/roman-numerals-encode-1.rkt @@ -9,6 +9,7 @@ ((>= number 50) (string-append "L" (encode/roman (- number 50)))) ((>= number 40) (string-append "XL" (encode/roman (- number 40)))) ((>= number 10) (string-append "X" (encode/roman (- number 10)))) + ((>= number 9) (string-append "IX" (encode/roman (- number 9)))) ((>= number 5) (string-append "V" (encode/roman (- number 5)))) ((>= number 4) (string-append "IV" (encode/roman (- number 4)))) ((>= number 1) (string-append "I" (encode/roman (- number 1)))) diff --git a/Task/Roman-numerals-Encode/Racket/roman-numerals-encode-2.rkt b/Task/Roman-numerals-Encode/Racket/roman-numerals-encode-2.rkt index 60ea5db129..bd27835744 100644 --- a/Task/Roman-numerals-Encode/Racket/roman-numerals-encode-2.rkt +++ b/Task/Roman-numerals-Encode/Racket/roman-numerals-encode-2.rkt @@ -1,8 +1,8 @@ #lang racket (define (number->list n) (for/fold ([result null]) - ([decimal '(1000 900 500 400 100 90 50 40 10 5 4 1)] - [roman '(M CM D CD C XC L XL X V IV I)]) + ([decimal '(1000 900 500 400 100 90 50 40 10 9 5 4 1)] + [roman '(M CM D CD C XC L XL X IX V IV I)]) #:break (= n 0) (let-values ([(q r) (quotient/remainder n decimal)]) (set! n r) diff --git a/Task/Roman-numerals-Encode/SQL/roman-numerals-encode.sql b/Task/Roman-numerals-Encode/SQL/roman-numerals-encode.sql index cff356195f..95748e7dd4 100644 --- a/Task/Roman-numerals-Encode/SQL/roman-numerals-encode.sql +++ b/Task/Roman-numerals-Encode/SQL/roman-numerals-encode.sql @@ -1,16 +1,9 @@ -- -- This only works under Oracle and has the limitation of 1 to 3999 ---- Higher numbers in the Middle Ages were represented by "superscores" on top of the numeral to multiply by 1000 ---- Vertical bars to the sides multiply by 100. So |M| means 100,000 --- When the query is run, user provides the Arabic numerals for the ar_year --- A.Kebedjiev --- -SELECT to_char(to_char(to_date(&ar_year,'YYYY'), 'RRRR'), 'RN') AS roman_year FROM DUAL; --- or you can type in the year directly +SQL> select to_char(1666, 'RN') urcoman, to_char(1666, 'rn') lcroman from dual; -SELECT to_char(to_char(to_date(1666,'YYYY'), 'RRRR'), 'RN') AS roman_year FROM DUAL; - -ROMAN_YEAR -MDCLXVI +URCOMAN LCROMAN +--------------- --------------- + MDCLXVI mdclxvi diff --git a/Task/Roman-numerals-Encode/Scheme/roman-numerals-encode.ss b/Task/Roman-numerals-Encode/Scheme/roman-numerals-encode-1.ss similarity index 100% rename from Task/Roman-numerals-Encode/Scheme/roman-numerals-encode.ss rename to Task/Roman-numerals-Encode/Scheme/roman-numerals-encode-1.ss diff --git a/Task/Roman-numerals-Encode/Scheme/roman-numerals-encode-2.ss b/Task/Roman-numerals-Encode/Scheme/roman-numerals-encode-2.ss new file mode 100644 index 0000000000..82f2387487 --- /dev/null +++ b/Task/Roman-numerals-Encode/Scheme/roman-numerals-encode-2.ss @@ -0,0 +1,34 @@ +(define roman-decimal + '(("M" . 1000) + ("CM" . 900) + ("D" . 500) + ("CD" . 400) + ("C" . 100) + ("XC" . 90) + ("L" . 50) + ("XL" . 40) + ("X" . 10) + ("IX" . 9) + ("V" . 5) + ("IV" . 4) + ("I" . 1))) + +(define (to-roman value) + (apply string-append + (let loop ((v value) + (decode roman-decimal)) + (let ((r (caar decode)) + (d (cdar decode))) + (cond + ((= v 0) '()) + ((>= v d) (cons r (loop (- v d) decode))) + (else (loop v (cdr decode)))))))) + + +(let loop ((n '(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 25 30 40 + 50 60 69 70 80 90 99 100 200 300 400 500 600 666 700 800 900 + 1000 1009 1444 1666 1945 1997 1999 2000 2008 2010 2011 2500 + 3000 3999))) + (unless (null? n) + (printf "~a ~a\n" (car n) (to-roman (car n))) + (loop (cdr n)))) diff --git a/Task/Roots-of-a-function/00DESCRIPTION b/Task/Roots-of-a-function/00DESCRIPTION index 23295a88f4..3cc9eaa9db 100644 --- a/Task/Roots-of-a-function/00DESCRIPTION +++ b/Task/Roots-of-a-function/00DESCRIPTION @@ -1,3 +1,8 @@ -Create a program that finds and outputs the roots of a given function, range and (if applicable) step width. The program should identify whether the root is exact or approximate. +;Task: +Create a program that finds and outputs the roots of a given function, range and (if applicable) step width. -For this example, use f(x)=x3-3x2+2x. +The program should identify whether the root is exact or approximate. + + +For this task, use:     ƒ(x)   =   x3 - 3x2 + 2x +

    diff --git a/Task/Roots-of-a-function/Haskell/roots-of-a-function-5.hs b/Task/Roots-of-a-function/Haskell/roots-of-a-function-5.hs new file mode 100644 index 0000000000..143b5abee9 --- /dev/null +++ b/Task/Roots-of-a-function/Haskell/roots-of-a-function-5.hs @@ -0,0 +1,21 @@ +import Control.Applicative + +data Root a = Exact a | Approximate a deriving (Show, Eq) + +-- looks for roots on an interval +bisection :: (Alternative f, Floating a, Ord a) => + (a -> a) -> a -> a -> f (Root a) +bisection f a b | f a * f b > 0 = empty + | f a == 0 = pure (Exact a) + | f b == 0 = pure (Exact b) + | smallInterval = pure (Approximate c) + | otherwise = bisection f a c <|> bisection f c b + where c = (a + b) / 2 + smallInterval = abs (a-b) < 1e-15 || abs ((a-b)/c) < 1e-15 + +-- looks for roots on a grid +findRoots :: (Alternative f, Floating a, Ord a) => + (a -> a) -> [a] -> а (Root a) +findRoots f [] = empty +findRoots f [x] = if f x == 0 then pure (Exact x) else empty +findRoots f (a:b:xs) = bisection f a b <|> findRoots f (b:xs) diff --git a/Task/Roots-of-a-function/Julia/roots-of-a-function.julia b/Task/Roots-of-a-function/Julia/roots-of-a-function-1.julia similarity index 100% rename from Task/Roots-of-a-function/Julia/roots-of-a-function.julia rename to Task/Roots-of-a-function/Julia/roots-of-a-function-1.julia diff --git a/Task/Roots-of-a-function/Julia/roots-of-a-function-2.julia b/Task/Roots-of-a-function/Julia/roots-of-a-function-2.julia new file mode 100644 index 0000000000..fd08007aff --- /dev/null +++ b/Task/Roots-of-a-function/Julia/roots-of-a-function-2.julia @@ -0,0 +1,23 @@ +function newton(f, fp, x,tol=1e-14,maxsteps=100) + #f: the function of x + #fp: the derivative of f + + xnew, xold = x, Inf + fn, fo = f(xnew), Inf + + + counter = 1 + + while (counter < maxsteps) && (abs(xnew - xold) > tol) && ( abs(fn - fo) > tol ) + x = xnew - f(xnew)/fp(xnew) # update step + xnew, xold = x, xnew + fn, fo = f(xnew), fn + counter = counter + 1 + end + + if counter == maxsteps + error("Did not converge in ", string(maxsteps), " steps") + else + xnew, counter + end +end diff --git a/Task/Roots-of-a-function/Julia/roots-of-a-function-3.julia b/Task/Roots-of-a-function/Julia/roots-of-a-function-3.julia new file mode 100644 index 0000000000..98207faf34 --- /dev/null +++ b/Task/Roots-of-a-function/Julia/roots-of-a-function-3.julia @@ -0,0 +1,4 @@ +f(x) = x^3 - 3*x^2 + 2*x +fp(x) = 3*x^2-6*x+2 + +x_s, count = newton(f,fp,1.00) diff --git a/Task/Roots-of-a-function/Lua/roots-of-a-function-1.lua b/Task/Roots-of-a-function/Lua/roots-of-a-function-1.lua new file mode 100644 index 0000000000..afd22595f4 --- /dev/null +++ b/Task/Roots-of-a-function/Lua/roots-of-a-function-1.lua @@ -0,0 +1,30 @@ +-- Function to have roots found +function f (x) return x^3 - 3*x^2 + 2*x end + +-- Find roots of f within x=[start, stop] or approximations thereof +function root (f, start, stop, step) + local roots, x, sign, foundExact, value = {}, start, f(start) > 0 + while x <= stop do + value = f(x) + if value == 0 then + table.insert(roots, {val = x, err = 0}) + foundExact = true + end + if value > 0 ~= sign then + if foundExact then + foundExact = false + else + table.insert(roots, {val = x, err = step}) + end + end + sign = value > 0 + x = x + step + end + return roots +end + +-- Main procedure +print("Root (to 12DP)\tMax. Error\n") +for _, r in pairs(root(f, -1, 3, 10^-6)) do + print(string.format("%0.12f", r.val), r.err) +end diff --git a/Task/Roots-of-a-function/Lua/roots-of-a-function-2.lua b/Task/Roots-of-a-function/Lua/roots-of-a-function-2.lua new file mode 100644 index 0000000000..d79c01a8f4 --- /dev/null +++ b/Task/Roots-of-a-function/Lua/roots-of-a-function-2.lua @@ -0,0 +1,5 @@ +-- Main procedure +print("Root (to 12DP)\tMax. Error\n") +for _, r in pairs(root(f, -1, 3, 2^-10)) do + print(string.format("%0.12f", r.val), r.err) +end diff --git a/Task/Roots-of-a-function/REXX/roots-of-a-function.rexx b/Task/Roots-of-a-function/REXX/roots-of-a-function.rexx new file mode 100644 index 0000000000..93f6e66b49 --- /dev/null +++ b/Task/Roots-of-a-function/REXX/roots-of-a-function.rexx @@ -0,0 +1,18 @@ +/*REXX program finds the roots of a specific function: x^3 - 3*x^2 + 2*x via bisection*/ +parse arg bot top inc . /*obtain optional arguments from the CL*/ +if bot=='' | bot=="," then bot= -5 /*Not specified? Then use the default.*/ +if top=='' | top=="," then top= +5 /* " " " " " " */ +if inc=='' | inc=="," then inc= .0001 /* " " " " " " */ +z=f(bot-inc); !=sign(z) /*use these values for initial compare.*/ + + do j=bot to top by inc /*traipse through the specified range. */ + z=f(j); $=sign(z) /*compute new value; obtain the sign. */ + if z=0 then say 'found an exact root at' j/1 + else if !\==$ then if !\==0 then say 'passed a root at' j/1 + !=$ /*use the new sign for the next compare*/ + end /*j*/ /*dividing by unity normalizes J [↑] */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +f: parse arg x; return x*(x*(x-3)+2) /*formula used ──► x^3 - 3x^2 + 2x */ + /*with factoring ──► x{ x^2 -3x + 2 } */ + /*more " ──► x{ x( x-3 ) + 2 } */ diff --git a/Task/Roots-of-a-quadratic-function/Common-Lisp/roots-of-a-quadratic-function.lisp b/Task/Roots-of-a-quadratic-function/Common-Lisp/roots-of-a-quadratic-function.lisp index 46307bfa8a..cef39b2c0e 100644 --- a/Task/Roots-of-a-quadratic-function/Common-Lisp/roots-of-a-quadratic-function.lisp +++ b/Task/Roots-of-a-quadratic-function/Common-Lisp/roots-of-a-quadratic-function.lisp @@ -1,7 +1,4 @@ (defun quadratic (a b c) - "Compute the roots of a quadratic in the form ax^2 + bx + c = 1. Evaluates to a list of the two roots." - (let ((discriminant (- (expt b 2) (* 4 a c))) - (denominator (* 2 a)) - (neg-b (* b -1))) - (list (/ (+ neg-b (sqrt discriminant)) denominator) - (/ (- neg-b (sqrt discriminant)) denominator)))) + (list + (/ (+ (- b) (sqrt (- (expt b 2) (* 4 a c)))) (* 2 a)) + (/ (- (- b) (sqrt (- (expt b 2) (* 4 a c)))) (* 2 a)))) diff --git a/Task/Roots-of-a-quadratic-function/Kotlin/roots-of-a-quadratic-function.kotlin b/Task/Roots-of-a-quadratic-function/Kotlin/roots-of-a-quadratic-function.kotlin new file mode 100644 index 0000000000..9e567cccb8 --- /dev/null +++ b/Task/Roots-of-a-quadratic-function/Kotlin/roots-of-a-quadratic-function.kotlin @@ -0,0 +1,44 @@ +import java.lang.Math.* + +data class Equation(val a: Double, val b: Double, val c: Double) { + data class Complex(val r: Double, val i: Double) { + override fun toString() = when { + i == 0.0 -> r.toString() + r == 0.0 -> "${i}i" + else -> "$r + ${i}i" + } + } + + data class Solution(val x1: Any, val x2: Any) { + override fun toString() = when(x1) { + x2 -> "X1,2 = $x1" + else -> "X1 = $x1, X2 = $x2" + } + } + + val quadraticRoots by lazy { + val _2a = a + a + val d = b * b - 4.0 * a * c // discriminant + if (d < 0.0) { + val r = -b / _2a + val i = sqrt(-d) / _2a + Solution(Complex(r, i), Complex(r, -i)) + } else { + // avoid calculating -b +/- sqrt(d), to avoid any + // subtractive cancellation when it is near zero. + val r = if (b < 0.0) (-b + sqrt(d)) / _2a else (-b - sqrt(d)) / _2a + Solution(r, c / (a * r)) + } + } +} + +fun main(args: Array) { + val equations = listOf(Equation(1.0, 22.0, -1323.0), // two distinct real roots + Equation(6.0, -23.0, 20.0), // with a != 1.0 + Equation(1.0, -1.0e9, 1.0), // with one root near zero + Equation(1.0, 2.0, 1.0), // one real root (double root) + Equation(1.0, 0.0, 1.0), // two imaginary roots + Equation(1.0, 1.0, 1.0)) // two complex roots + + equations.forEach { println("$it\n" + it.quadraticRoots) } +} diff --git a/Task/Roots-of-a-quadratic-function/Perl-6/roots-of-a-quadratic-function.pl6 b/Task/Roots-of-a-quadratic-function/Perl-6/roots-of-a-quadratic-function.pl6 index 9b94845554..8debf5d30b 100644 --- a/Task/Roots-of-a-quadratic-function/Perl-6/roots-of-a-quadratic-function.pl6 +++ b/Task/Roots-of-a-quadratic-function/Perl-6/roots-of-a-quadratic-function.pl6 @@ -1,23 +1,17 @@ -my @sets = [1, 2, 1], - [1, 2, 3], - [1, -2, 1], - [1, 0, -4], - [1, -10**6, 1]; - -for @sets -> @coefficients { - say "Roots for @coefficients.join(', ').fmt("%-16s")", - "=> (&quadroots( @coefficients ).join(', '))"; +for +[1, 2, 1], +[1, 2, 3], +[1, -2, 1], +[1, 0, -4], +[1, -10**6, 1] +-> @coefficients { + printf "Roots for %d, %d, %d\t=> (%s, %s)\n", + |@coefficients, |quadroots(@coefficients); } -multi sub quadroots ($a, $b, $c) { - my $root = (my $t = $b ** 2 - 4 * $a * $c ) < 0 - ?? $t.Complex.sqrt - !! $t.sqrt; - return ( -$b + $root ) / (2 * $a), - ( -$b - $root ) / (2 * $a); -} - -multi sub quadroots (@a) { - @a == 3 or die "Expected three elements, got {+@a}"; - quadroots |@a; +sub quadroots (*[$a, $b, $c]) { + ( -$b + $_ ) / (2 * $a), + ( -$b - $_ ) / (2 * $a) + given + ($b ** 2 - 4 * $a * $c ).Complex.sqrt.narrow } diff --git a/Task/Roots-of-unity/00DESCRIPTION b/Task/Roots-of-unity/00DESCRIPTION index 3a1caea77f..93d23a1d99 100644 --- a/Task/Roots-of-unity/00DESCRIPTION +++ b/Task/Roots-of-unity/00DESCRIPTION @@ -1 +1,6 @@ -The purpose of this task is to explore working with complex numbers. Given n, find the n-th [[wp:Roots of unity|roots of unity]]. +The purpose of this task is to explore working with   [https://en.wikipedia.org/wiki/Complex_number complex numbers]. + + +;Task: +Given   n,   find the   n-th   [[wp:Roots of unity|roots of unity]]. +

    diff --git a/Task/Roots-of-unity/AWK/roots-of-unity.awk b/Task/Roots-of-unity/AWK/roots-of-unity.awk new file mode 100644 index 0000000000..559f7b3fe8 --- /dev/null +++ b/Task/Roots-of-unity/AWK/roots-of-unity.awk @@ -0,0 +1,15 @@ +# syntax: GAWK -f ROOTS_OF_UNITY.AWK +BEGIN { + pi = 3.1415926 + for (n=2; n<=5; n++) { + printf("%d: ",n) + for (root=0; root<=n-1; root++) { + real = cos(2 * pi * root / n) + imag = sin(2 * pi * root / n) + printf("%8.5f %8.5fi",real,imag) + if (root != n-1) { printf(", ") } + } + printf("\n") + } + exit(0) +} diff --git a/Task/Roots-of-unity/Java/roots-of-unity.java b/Task/Roots-of-unity/Java/roots-of-unity.java index 6fe2245de0..4d02ddd752 100644 --- a/Task/Roots-of-unity/Java/roots-of-unity.java +++ b/Task/Roots-of-unity/Java/roots-of-unity.java @@ -1,10 +1,29 @@ -public static void unity(int n){ - //all the way around the circle at even intervals - for(double angle = 0;angle < 2 * Math.PI;angle += (2 * Math.PI) / n){ - double real = Math.cos(angle); //real axis is the x axis - if(Math.abs(real) < 1.0E-3) real = 0.0; //get rid of annoying sci notation - double imag = Math.sin(angle); //imaginary axis is the y axis - if(Math.abs(imag) < 1.0E-3) imag = 0.0; //get rid of annoying sci notation - System.out.print(real + " + " + imag + "i\t"); //tab-separated answers - } +import java.util.Locale; + +public class Test { + + public static void main(String[] a) { + for (int n = 2; n < 6; n++) + unity(n); + } + + public static void unity(int n) { + System.out.printf("%n%d: ", n); + + //all the way around the circle at even intervals + for (double angle = 0; angle < 2 * Math.PI; angle += (2 * Math.PI) / n) { + + double real = Math.cos(angle); //real axis is the x axis + + if (Math.abs(real) < 1.0E-3) + real = 0.0; //get rid of annoying sci notation + + double imag = Math.sin(angle); //imaginary axis is the y axis + + if (Math.abs(imag) < 1.0E-3) + imag = 0.0; + + System.out.printf(Locale.US, "(%9f,%9f) ", real, imag); + } + } } diff --git a/Task/Roots-of-unity/Kotlin/roots-of-unity.kotlin b/Task/Roots-of-unity/Kotlin/roots-of-unity.kotlin new file mode 100644 index 0000000000..700c80cee2 --- /dev/null +++ b/Task/Roots-of-unity/Kotlin/roots-of-unity.kotlin @@ -0,0 +1,21 @@ +import java.lang.Math.* + +data class Complex(val r: Double, val i: Double) { + override fun toString() = when { + i == 0.0 -> r.toString() + r == 0.0 -> i.toString() + 'i' + else -> "$r + ${i}i" + } +} + +fun unity_roots(n: Number) = (1..n.toInt() - 1).map { + val a = it * 2 * PI / n.toDouble() + var r = cos(a); if (abs(r) < 1e-6) r = 0.0 + var i = sin(a); if (abs(i) < 1e-6) i = 0.0 + Complex(r, i) +} + +fun main(args: Array) { + (1..4).forEach { println(listOf(1) + unity_roots(it)) } + println(listOf(1) + unity_roots(5.0)) +} diff --git a/Task/Roots-of-unity/OoRexx/roots-of-unity.rexx b/Task/Roots-of-unity/OoRexx/roots-of-unity.rexx new file mode 100644 index 0000000000..c265206a03 --- /dev/null +++ b/Task/Roots-of-unity/OoRexx/roots-of-unity.rexx @@ -0,0 +1,26 @@ +/*REXX program computes the K roots of unity (which include complex roots).*/ +parse Version v +Say v +parse arg n frac . /*get optional arguments from the C.L. */ +if n=='' then n=1 /*Not specified? Then use the default.*/ +if frac='' then frac=5 /* " " " " " " */ +start=abs(n) /*assume only one K is wanted. */ +if n<0 then start=1 /*Negative? Then use a range of K's. */ + /*display unity roots for a range, or */ + do k=start to abs(n) /* just for one K. */ + say right(k 'roots of unity',40,"-") /*display a pretty separator with title*/ + do angle=0 by 360/k for k /*compute the angle for each root. */ + rp=adjust(rxCalcCos(angle,,'D')) /*compute real part via COS function.*/ + if left(rp,1)\=='-' then rp=" "rp /*not negative? Then pad with a blank.*/ + ip=adjust(rxCalcSin(angle,,'D')) /*compute imaginary part via SIN funct.*/ + if left(ip,1)\=='-' then ip="+"ip /*Not negative? Then pad with + char.*/ + if ip=0 then say rp /*Only real part? Ignore imaginary part*/ + else say left(rp,frac+4)ip'i' /*show the real & imaginary part*/ + end /*angle*/ + end /*k*/ +exit /*stick a fork in it, we're all done. */ +/*----------------------------------------------------------------------------*/ +adjust: parse arg x; near0='1e-' || (digits()-digits()%10) /*compute small #*/ + if abs(x) \k { + say cis(k*τ/n); } - -printf "%+.5f%+.5fi\n", .reals for roots-of-unity 10; diff --git a/Task/Roots-of-unity/REXX/roots-of-unity.rexx b/Task/Roots-of-unity/REXX/roots-of-unity.rexx index 4a6e324f00..23cf913f35 100644 --- a/Task/Roots-of-unity/REXX/roots-of-unity.rexx +++ b/Task/Roots-of-unity/REXX/roots-of-unity.rexx @@ -1,48 +1,40 @@ -/*REXX program to compute the K roots of unity. */ -parse arg n frac . /*get the argument(s) (if any). */ -if n=='' then n=1 /*no argument given? Use one. */ -start=abs(n) /*assume only one K is wanted. */ -if n<0 then start=1 /*Negative? Use a range of K's. */ -if frac='' then frac=5 /*No frac? Use default of 5 digs*/ -numeric digits 60 /*use sixty digits of precision. */ -pi=pi() /*compute π to sixty digits. */ - /*display unity roots for a ... */ - do k=start to abs(n) /* ... range or just for one K. */ - say right(k 'roots of unity',40,"─") /*display a pretty separator. */ - - do angle=0 by 2*pi/k for k /*compute angle for each root. */ - rp=cos(angle) /*compute real part via COS func.*/ - rp=adjust(rp) /*adjust Rpart by limiting digs. */ - if left(rp,1)\=='-' then rp=' 'rp /*not negative? Pad with blank. */ - - ip=sin(angle) /*compute imag part via SIN func.*/ - ip=adjust(ip) /*adjust Ipart by limiting digs. */ - if left(ip,1)\=='-' then ip='+'ip /*not negative? Pad with + char.*/ - - if ip=0 then say rp /*only real part? Ignore IMAG. */ - else say left(rp,frac+4)ip'i' /*show real and imag part.*/ - - end /*angle*/ +/*REXX program computes the K roots of unity (which usually includes complex roots).*/ +parse arg n frac . /*get optional arguments from the C.L. */ +if n=='' | n=="," then n=1 /*Not specified? Then use the default.*/ +if frac='' | frac=="," then frac=5 /* " " " " " " */ +start=abs(n) /*assume only one K is wanted. */ +if n<0 then start=1 /*Negative? Then use a range of K's. */ +numeric digits length(pi()) - 1 /*use number of decimal digits in pi. */ +pi2=pi*2 /*obtain the value of pi doubled. */ + /*display unity roots for a range, or */ + do k=start to abs(n) /* just for one K. */ + say right(k 'roots of unity', 40, "─") /*display a pretty separator with title*/ + do angle=0 by pi2/k for k /*compute the angle for each root. */ + rp=adjust(cos(angle)) /*compute real part via COS function.*/ + if left(rp,1)\=='-' then rp=" "rp /*not negative? Then pad with a blank.*/ + ip=adjust(sin(angle)) /*compute imaginary part via SIN funct.*/ + if left(ip,1)\=='-' then ip="+"ip /*Not negative? Then pad with + char.*/ + if ip=0 then say rp /*Only real part? Ignore imaginary part*/ + else say left(rp,frac+4)ip'i' /*display the real and imaginary part. */ + end /*angle*/ end /*k*/ - -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────ADJUST subroutine───────────────────*/ -adjust: arg x; near0='1e-'||(digits()-digits()%10) /*compute small #. */ -if abs(x) +360 deg.*/ -/*──────────────────────────────────COS subroutine──────────────────────*/ -cos: procedure; arg x; x=r2r(x); a=abs(x); numeric fuzz min(9,digits()-9); -if a=pi() then return -1; if a=pi()/2 | a=2*pi() then return 0 -if a=pi()/3 then return .5; if a=2*pi()/3 then return -.5; return .sincos(1,1,-1) -/*──────────────────────────────────SIN subroutine──────────────────────*/ -sin: procedure; arg x; x=r2r(x); numeric fuzz min(5,digits()-3) -if abs(x)=pi() then return 0; return .sincos(x,x,1) -/*──────────────────────────────────.SINCOS subroutine──────────────────*/ -.sincos: parse arg z,_,i; x=x*x; p=z - do k=2 by 2; _=-_*x/(k*(k+i)); z=z+_; if z=p then leave; p=z; end; -return z +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +adjust: parse arg x; near0='1e-' || (digits()-digits()%10) /*compute a tiny number.*/ + if abs(x) n-1 then PRINT "," ; + NEXT + PRINT +NEXT diff --git a/Task/Rot-13/00DESCRIPTION b/Task/Rot-13/00DESCRIPTION index 558acfddf7..04d60a82c5 100644 --- a/Task/Rot-13/00DESCRIPTION +++ b/Task/Rot-13/00DESCRIPTION @@ -1,39 +1,27 @@ -Implement a "rot-13" function (or procedure, class, subroutine, -or other "callable" object as appropriate to your programming environment). +;Task: +Implement a   '''rot-13'''   function   (or procedure, class, subroutine, or other "callable" object as appropriate to your programming environment). -Optionally wrap this function in a utility program (like [[:Category:Tr|tr]], -which acts like a common [[UNIX]] utility, performing a line-by-line rot-13 encoding -of every line of input contained in each file listed on its command line, or -(if no filenames are passed thereon) acting as a filter on itsc "standard input." +Optionally wrap this function in a utility program   (like [[:Category:Tr|tr]],   which acts like a common [[UNIX]] utility, performing a line-by-line rot-13 encoding of every line of input contained in each file listed on its command line,   or (if no filenames are passed thereon) acting as a filter on its   "standard input." -(A number of UNIX scripting languages and utilities, such as -''awk'' and ''sed'' either default to processing files in this way -or have command line switches or modules to easily implement -these wrapper semantics, e.g., [[Perl]] and [[Python]]). -The "rot-13" encoding is commonly known from the early days of -Usenet "Netnews" as a way of obfuscating text to prevent casual reading -of [[wp:Spoiler (media)|spoiler]] or potentially offensive material. +(A number of UNIX scripting languages and utilities, such as   ''awk''   and   ''sed''   either default to processing files in this way or have command line switches or modules to easily implement these wrapper semantics, e.g.,   [[Perl]]   and   [[Python]]). -Many news reader and mail user agent programs have built-in "rot-13" encoder/decoders -or have the ability to feed a message through any external utility script for -performing this (or other) actions. +The   '''rot-13'''   encoding is commonly known from the early days of Usenet "Netnews" as a way of obfuscating text to prevent casual reading of   [[wp:Spoiler (media)|spoiler]]   or potentially offensive material. -The definition of the rot-13 function is to simply replace every letter -of the ASCII alphabet with the letter which is "rotated" 13 characters -"around" the 26 letter alphabet from its normal cardinal position -(wrapping around from "z" to "a" as necessary). +Many news reader and mail user agent programs have built-in '''rot-13''' encoder/decoders or have the ability to feed a message through any external utility script for performing this (or other) actions. -Thus the letters "abc" become "nop" and so on. -Technically rot-13 is a "monoalphabetic substitution cipher" -with a trivial "key". +The definition of the rot-13 function is to simply replace every letter of the ASCII alphabet with the letter which is "rotated" 13 characters "around" the 26 letter alphabet from its normal cardinal position   (wrapping around from   '''z''''   to   '''a'''   as necessary). -A proper implementation should work on upper and lower case letters, -preserve case, and pass all non-alphabetic characters +Thus the letters   '''abc'''   become   '''nop'''   and so on. + +Technically '''rot-13''' is a   "mono-alphabetic substitution cipher"   with a trivial   "key". + +A proper implementation should work on upper and lower case letters, preserve case, and pass all non-alphabetic characters in the input stream through without alteration. -;See also -* [[Caesar cipher]] -* [[Substitution Cipher]] -* [[Vigenère Cipher/Cryptanalysis]] -
    + +;Related tasks: +*   [[Caesar cipher]] +*   [[Substitution Cipher]] +*   [[Vigenère Cipher/Cryptanalysis]] +

    diff --git a/Task/Rot-13/AppleScript/rot-13-4.applescript b/Task/Rot-13/AppleScript/rot-13-4.applescript new file mode 100644 index 0000000000..e633f57fc3 --- /dev/null +++ b/Task/Rot-13/AppleScript/rot-13-4.applescript @@ -0,0 +1,61 @@ +-- rot13 :: String -> String +on rot13(str) + script rt13 + on lambda(x) + if (x ≥ "a" and x ≤ "m") or (x ≥ "A" and x ≤ "M") then + character id ((id of x) + 13) + else if (x ≥ "n" and x ≤ "z") or (x ≥ "N" and x ≤ "Z") then + character id ((id of x) - 13) + else + x + end if + end lambda + end script + + intercalate("", map(rt13, characters of str)) +end rot13 + + +-- TEST +on run + + rot13("nowhere ABJURER") + + --> "abjurer NOWHERE" + +end run + + +-- GENERIC FUNCTIONS + +-- 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 + +-- intercalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate + +-- 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 diff --git a/Task/Rot-13/Kotlin/rot-13.kotlin b/Task/Rot-13/Kotlin/rot-13.kotlin new file mode 100644 index 0000000000..ff9e8397d7 --- /dev/null +++ b/Task/Rot-13/Kotlin/rot-13.kotlin @@ -0,0 +1,19 @@ +import java.io.* + +fun String.rot13() = map { + when { + it.isUpperCase() -> { val x = it + 13; if (x > 'Z') x - 26 else x } + it.isLowerCase() -> { val x = it + 13; if (x > 'z') x - 26 else x } + else -> it + } }.toCharArray() + +fun InputStreamReader.println() = + try { BufferedReader(this).forEachLine { println(it.rot13()) } } + catch (e: IOException) { e.printStackTrace() } + +fun main(args: Array) { + if (args.any()) + args.forEach { FileReader(it).println() } + else + InputStreamReader(System.`in`).println() +} diff --git a/Task/Rot-13/Lua/rot-13.lua b/Task/Rot-13/Lua/rot-13-1.lua similarity index 100% rename from Task/Rot-13/Lua/rot-13.lua rename to Task/Rot-13/Lua/rot-13-1.lua diff --git a/Task/Rot-13/Lua/rot-13-2.lua b/Task/Rot-13/Lua/rot-13-2.lua new file mode 100644 index 0000000000..79cd59dcf7 --- /dev/null +++ b/Task/Rot-13/Lua/rot-13-2.lua @@ -0,0 +1,3 @@ +function rot13(s) + return (s:gsub("%a", function(c) c=c:byte() return string.char(c+(c%32<14 and 13 or -13)) end)) +end diff --git a/Task/Rot-13/Perl-6/rot-13.pl6 b/Task/Rot-13/Perl-6/rot-13.pl6 index 6809989251..f528435343 100644 --- a/Task/Rot-13/Perl-6/rot-13.pl6 +++ b/Task/Rot-13/Perl-6/rot-13.pl6 @@ -1,4 +1 @@ -sub rot13 { $^s.trans: 'a..mn..z' => 'n..za..m', :ii } - -multi MAIN () { print rot13 slurp } -multi MAIN (*@files) { print rot13 [~] map &slurp, @files } +.=trans: 'a..mn..z' => 'n..za..m', :ii diff --git a/Task/Rot-13/REXX/rot-13.rexx b/Task/Rot-13/REXX/rot-13.rexx index 5c8355b8d4..2a76035f97 100644 --- a/Task/Rot-13/REXX/rot-13.rexx +++ b/Task/Rot-13/REXX/rot-13.rexx @@ -1,15 +1,14 @@ -/*REXX program encodes several example text strings with the ROT-13 algorithm.*/ +/*REXX program encodes several example text strings using the ROT-13 algorithm. */ @simple = 'simple text =' @rot_13 = 'rot-13 text =' -$= 'foo' ; say @simple $; say @rot_13 rot13($); say -$= 'bar' ; say @simple $; say @rot_13 rot13($); say -$= "Noyr jnf V, 'rer V fnj Ryon." ; say @simple $; say @rot_13 rot13($); say -$= 'abc? ABC!' ; say @simple $; say @rot_13 rot13($); say -$= 'abjurer NOWHERE' ; say @simple $; say @rot_13 rot13($); say +$= 'foo' ; say @simple $; say @rot_13 rot13($); say +$= 'bar' ; say @simple $; say @rot_13 rot13($); say +$= "Noyr jnf V, 'rer V fnj Ryon." ; say @simple $; say @rot_13 rot13($); say +$= 'abc? ABC!' ; say @simple $; say @rot_13 rot13($); say +$= 'abjurer NOWHERE' ; say @simple $; say @rot_13 rot13($); say -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -rot13: return translate(arg(1), , - 'abcdefghijklmABCDEFGHIJKLMnopqrstuvwxyzNOPQRSTUVWXYZ', , - 'nopqrstuvwxyzNOPQRSTUVWXYZabcdefghijklmABCDEFGHIJKLM') +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +rot13: return translate( arg(1), 'abcdefghijklmABCDEFGHIJKLMnopqrstuvwxyzNOPQRSTUVWXYZ',, + "nopqrstuvwxyzNOPQRSTUVWXYZabcdefghijklmABCDEFGHIJKLM") diff --git a/Task/Rot-13/S-lang/rot-13.slang b/Task/Rot-13/S-lang/rot-13.slang new file mode 100644 index 0000000000..701b86dbf0 --- /dev/null +++ b/Task/Rot-13/S-lang/rot-13.slang @@ -0,0 +1,23 @@ +variable old = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"; +variable new = "NOPQRSTUVWXYZABCDEFGHIJKLMnopqrstuvwxyzabcdefghijklm"; + +define rot13(s) { + s = strtrans(s, old, new); + return s; +} + +define rot13_stream(s) { + variable ln; + while (-1 != fgets(&ln, s)) + fputs(rot13(ln), stdout); +} + +if (__argc > 1) { + variable arg, fp; + foreach arg (__argv[[1:]]) { + fp = fopen(arg, "r"); + rot13_stream(fp); + } +} +else + rot13_stream(stdin); diff --git a/Task/Rot-13/TXR/rot-13-2.txr b/Task/Rot-13/TXR/rot-13-2.txr index 9a6a390763..367f66594c 100644 --- a/Task/Rot-13/TXR/rot-13-2.txr +++ b/Task/Rot-13/TXR/rot-13-2.txr @@ -1,9 +1,8 @@ -@(do - (defun rot13 (ch) - (cond - ((<= #\A (chr-toupper ch) #\M) (+ ch 13)) - ((<= #\N (chr-toupper ch) #\Z) (- ch 13)) - (t ch))) +(defun rot13 (ch) + (cond + ((<= #\A ch #\Z) (wrap #\A #\Z (+ ch 13))) + ((<= #\a ch #\z) (wrap #\a #\z (+ ch 13))) + (t ch))) - (each ((l (gun (get-line nil)))) - (put-line [mapcar rot13 l]))) + (whilet ((ch (get-char))) + (put-char (rot13 ch))) diff --git a/Task/Run-length-encoding/Haskell/run-length-encoding.hs b/Task/Run-length-encoding/Haskell/run-length-encoding-1.hs similarity index 83% rename from Task/Run-length-encoding/Haskell/run-length-encoding.hs rename to Task/Run-length-encoding/Haskell/run-length-encoding-1.hs index 0e3a410317..f10369876c 100644 --- a/Task/Run-length-encoding/Haskell/run-length-encoding.hs +++ b/Task/Run-length-encoding/Haskell/run-length-encoding-1.hs @@ -1,4 +1,5 @@ import Data.List (group) +import Control.Arrow ((&&&)) -- Datatypes type Encoded = [(Int, Char)] -- An encoded String with form [(times, char), ...] @@ -6,12 +7,11 @@ type Decoded = String -- Takes a decoded string and returns an encoded list of tuples rlencode :: Decoded -> Encoded -rlencode = map (\g -> (length g, head g)) . group +rlencode = map (length &&& head) . group -- Takes an encoded list of tuples and returns the associated decoded String rldecode :: Encoded -> Decoded -rldecode = concatMap decodeTuple - where decodeTuple (n,c) = replicate n c +rldecode = concatMap (uncurry replicate) main :: IO () main = do diff --git a/Task/Run-length-encoding/Haskell/run-length-encoding-2.hs b/Task/Run-length-encoding/Haskell/run-length-encoding-2.hs new file mode 100644 index 0000000000..d573a36e86 --- /dev/null +++ b/Task/Run-length-encoding/Haskell/run-length-encoding-2.hs @@ -0,0 +1,13 @@ +import Data.List +import Data.Char + +runLengthEncode = concatMap (\xs@(x:_) -> (show.length $ xs) ++ [x]).group +runLengthDecode = concat.uncurry (zipWith (\[x] ns -> replicate (read ns) x)) + .foldr (\z (x,y) -> (y,z:x)) ([],[]).groupBy (\x y -> all isDigit [x,y]) + +main = do + let text = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW" + let encode = runLengthEncode text + let decode = runLengthDecode encode + mapM_ putStrLn [text,encode,decode] + putStrLn $ "test: text == decode => " ++ (show $ text == decode) diff --git a/Task/Run-length-encoding/J/run-length-encoding-1.j b/Task/Run-length-encoding/J/run-length-encoding-1.j index 8a7b83196b..aab6912038 100644 --- a/Task/Run-length-encoding/J/run-length-encoding-1.j +++ b/Task/Run-length-encoding/J/run-length-encoding-1.j @@ -1,2 +1,2 @@ -rle=: ;@(<@(":@#,{.);.1~ 1, 2 ~:/\ ]) -rld=: '0123456789'&(-.~ #~ i. ".@:{ ' ' ,~ [) +rle=: ;@(<@(":@(#-.1:),{.);.1~ 1, 2 ~:/\ ]) +rld=: ;@(-.@e.&'0123456789' <@({:#~1{.@,~".@}:);.2 ]) diff --git a/Task/Run-length-encoding/Perl-6/run-length-encoding.pl6 b/Task/Run-length-encoding/Perl-6/run-length-encoding.pl6 index ae3d9bce30..72141ffc06 100644 --- a/Task/Run-length-encoding/Perl-6/run-length-encoding.pl6 +++ b/Task/Run-length-encoding/Perl-6/run-length-encoding.pl6 @@ -1,6 +1,6 @@ -sub encode($str) { $str.subst(/(.) $0*/, -> $/ { $/.chars ~ $0 ~ ' ' }, :g); } +sub encode($str) { $str.subst(/(.) $0*/, { $/.chars ~ $0 }, :g) } -sub decode($str) { $str.subst(/(\d+) (.) ' '/, -> $/ {$1 x $0}, :g); } +sub decode($str) { $str.subst(/(\d+) (.)/, { $1 x $0 }, :g) } my $e = encode('WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW'); say $e; diff --git a/Task/Runge-Kutta-method/00DESCRIPTION b/Task/Runge-Kutta-method/00DESCRIPTION index 54f2f3273d..6bd267ee56 100644 --- a/Task/Runge-Kutta-method/00DESCRIPTION +++ b/Task/Runge-Kutta-method/00DESCRIPTION @@ -5,7 +5,7 @@ With initial condition: This equation has an exact solution: :y(t) = \tfrac{1}{16}(t^2 +4)^2 ;Task -Demonstrate the commonly used explicit [[wp:Runge–Kutta_methods#Common_fourth-order_Runge.E2.80.93Kutta_method|fourth-order Runge–Kutta method]] to solve the above differential equation. +Demonstrate the commonly used explicit   [[wp:Runge–Kutta_methods#Common_fourth-order_Runge.E2.80.93Kutta_method|fourth-order Runge–Kutta method]]   to solve the above differential equation. * Solve the given differential equation over the range t = 0 \ldots 10 with a step value of \delta t=0.1 (101 total points, the first being given) * Print the calculated values of y at whole numbered t's (0.0, 1.0, \ldots 10.0) along with error as compared to the exact solution. ;Method summary diff --git a/Task/Runge-Kutta-method/APL/runge-kutta-method.apl b/Task/Runge-Kutta-method/APL/runge-kutta-method.apl new file mode 100644 index 0000000000..bcf2dbcf62 --- /dev/null +++ b/Task/Runge-Kutta-method/APL/runge-kutta-method.apl @@ -0,0 +1,21 @@ + ∇RK4[⎕]∇ + ∇ +[0] Z←R(Y¯ RK4)Y;T;YN;TN;∆T;∆Y1;∆Y2;∆Y3;∆Y4 +[1] (T R ∆T)←R +[2] LOOP:→(R≤TN←¯1↑T)/EXIT +[3] ∆Y1←∆T×TN Y¯ YN←¯1↑Y +[4] ∆Y2←∆T×(TN+∆T÷2)Y¯ YN+∆Y1÷2 +[5] ∆Y3←∆T×(TN+∆T÷2)Y¯ YN+∆Y2÷2 +[6] ∆Y4←∆T×(TN+∆T)Y¯ YN+∆Y3 +[7] Y←Y,YN+(∆Y1+(2×∆Y2)+(2×∆Y3)+∆Y4)÷6 +[8] T←T,TN+∆T +[9] →LOOP +[10] EXIT:Z←T,[⎕IO+.5]Y + ∇ + + ∇PRINT[⎕]∇ + ∇ +[0] PRINT;TABLE +[1] TABLE←0 10 .1({⍺×⍵*.5}RK4)1 +[2] ⎕←'T' 'RK4 Y' 'ERROR'⍪TABLE,TABLE[;2]-{((4+⍵*2)*2)÷16}TABLE[;1] + ∇ diff --git a/Task/Runge-Kutta-method/C++/runge-kutta-method.cpp b/Task/Runge-Kutta-method/C++/runge-kutta-method.cpp new file mode 100644 index 0000000000..0d1727b7b3 --- /dev/null +++ b/Task/Runge-Kutta-method/C++/runge-kutta-method.cpp @@ -0,0 +1,44 @@ +/* + * compiled with gcc 5.4: + * g++-mp-5 -std=c++14 -o rk4 rk4.cc + * + */ +# include +# include +using namespace std; + +auto rk4(double f(double, double)) +{ + return + [ f ](double t, double y, double dt ) -> double{ return + [t,y,dt,f ]( double dy1) -> double{ return + [t,y,dt,f,dy1 ]( double dy2) -> double{ return + [t,y,dt,f,dy1,dy2 ]( double dy3) -> double{ return + [t,y,dt,f,dy1,dy2,dy3]( double dy4) -> double{ return + ( dy1 + 2*dy2 + 2*dy3 + dy4 ) / 6 ;} ( + dt * f( t+dt , y+dy3 ) );} ( + dt * f( t+dt/2, y+dy2/2 ) );} ( + dt * f( t+dt/2, y+dy1/2 ) );} ( + dt * f( t , y ) );} ; +} + +int main(void) +{ + const double TIME_MAXIMUM = 10.0, WHOLE_TOLERANCE = 1e-12 ; + const double T_START = 0.0, Y_START = 1.0, DT = 0.10; + + auto eval_diff_eqn = [ ](double t, double y)->double{ return t*sqrt(y) ; } ; + auto eval_solution = [ ](double t )->double{ return pow(t*t+4,2)/16 ; } ; + auto find_error = [eval_solution ](double t, double y)->double{ return fabs(y-eval_solution(t)) ; } ; + auto is_whole = [WHOLE_TOLERANCE](double t )->bool { return fabs(t-round(t)) < WHOLE_TOLERANCE; } ; + + auto dy = rk4( eval_diff_eqn ) ; + + double y = Y_START, t = T_START ; + + while(t <= TIME_MAXIMUM) { + if (is_whole(t)) { printf("y(%4.1f)\t=%12.6f \t error: %12.6e\n",t,y,find_error(t,y)); } + y += dy(t,y,DT) ; t += DT; + } + return 0; +} diff --git a/Task/Runge-Kutta-method/Java/runge-kutta-method.java b/Task/Runge-Kutta-method/Java/runge-kutta-method.java new file mode 100644 index 0000000000..ebe8a41da9 --- /dev/null +++ b/Task/Runge-Kutta-method/Java/runge-kutta-method.java @@ -0,0 +1,38 @@ +import static java.lang.Math.*; +import java.util.function.BiFunction; + +public class RungeKutta { + + static void runge(BiFunction yp_func, double[] t, + double[] y, double dt) { + + for (int n = 0; n < t.length - 1; n++) { + double dy1 = dt * yp_func.apply(t[n], y[n]); + double dy2 = dt * yp_func.apply(t[n] + dt / 2.0, y[n] + dy1 / 2.0); + double dy3 = dt * yp_func.apply(t[n] + dt / 2.0, y[n] + dy2 / 2.0); + double dy4 = dt * yp_func.apply(t[n] + dt, y[n] + dy3); + t[n + 1] = t[n] + dt; + y[n + 1] = y[n] + (dy1 + 2.0 * (dy2 + dy3) + dy4) / 6.0; + } + } + + static double calc_err(double t, double calc) { + double actual = pow(pow(t, 2.0) + 4.0, 2) / 16.0; + return abs(actual - calc); + } + + public static void main(String[] args) { + double dt = 0.10; + double[] t_arr = new double[101]; + double[] y_arr = new double[101]; + y_arr[0] = 1.0; + + runge((t, y) -> t * sqrt(y), t_arr, y_arr, dt); + + for (int i = 0; i < t_arr.length; i++) + if (i % 10 == 0) + System.out.printf("y(%.1f) = %.8f Error: %.6f%n", + t_arr[i], y_arr[i], + calc_err(t_arr[i], y_arr[i])); + } +} diff --git a/Task/Runge-Kutta-method/Perl-6/runge-kutta-method.pl6 b/Task/Runge-Kutta-method/Perl-6/runge-kutta-method.pl6 index 9ecf43c71e..3ca1ec1111 100644 --- a/Task/Runge-Kutta-method/Perl-6/runge-kutta-method.pl6 +++ b/Task/Runge-Kutta-method/Perl-6/runge-kutta-method.pl6 @@ -14,8 +14,8 @@ my &δy = runge-kutta { $^t * sqrt($^y) }; loop ( my ($t, $y) = (0, 1); $t <= 10; - $t, $y Z[+=] δt, δy($t, $y, δt) + ($t, $y) »+=« (δt, δy($t, $y, δt)) ) { printf "y(%2d) = %12f ± %e\n", $t, $y, abs($y - ($t**2 + 4)**2 / 16) - if $t.narrow ~~ Int; + if $t %% 1; } diff --git a/Task/Runge-Kutta-method/PureBasic/runge-kutta-method.purebasic b/Task/Runge-Kutta-method/PureBasic/runge-kutta-method.purebasic new file mode 100644 index 0000000000..65ba7dfc51 --- /dev/null +++ b/Task/Runge-Kutta-method/PureBasic/runge-kutta-method.purebasic @@ -0,0 +1,19 @@ +EnableExplicit +Define.i i +Define.d y=1.0, k1=0.0, k2=0.0, k3=0.0, k4=0.0, t=0.0 + +If OpenConsole() + For i=0 To 100 + t=i/10 + If Not i%10 + PrintN("y("+RSet(StrF(t,0),2," ")+") ="+RSet(StrF(y,4),9," ")+#TAB$+"Error ="+RSet(StrF(Pow(Pow(t,2)+4,2)/16-y,10),14," ")) + EndIf + k1=t*Sqr(y) + k2=(t+0.05)*Sqr(y+0.05*k1) + k3=(t+0.05)*Sqr(y+0.05*k2) + k4=(t+0.10)*Sqr(y+0.10*k3) + y+0.1*(k1+2*(k2+k3)+k4)/6 + Next + Print("Press return to exit...") : Input() +EndIf +End diff --git a/Task/Runge-Kutta-method/Python/runge-kutta-method-2.py b/Task/Runge-Kutta-method/Python/runge-kutta-method-2.py index 9727676e3d..029a2173c9 100644 --- a/Task/Runge-Kutta-method/Python/runge-kutta-method-2.py +++ b/Task/Runge-Kutta-method/Python/runge-kutta-method-2.py @@ -1,35 +1,35 @@ from math import sqrt def rk4(f, x0, y0, x1, n): - vx = [0]*(n + 1) - vy = [0]*(n + 1) - h = (x1 - x0)/n + vx = [0] * (n + 1) + vy = [0] * (n + 1) + h = (x1 - x0) / float(n) vx[0] = x = x0 vy[0] = y = y0 for i in range(1, n + 1): - k1 = h*f(x, y) - k2 = h*f(x + 0.5*h, y + 0.5*k1) - k3 = h*f(x + 0.5*h, y + 0.5*k2) - k4 = h*f(x + h, y + k3) - vx[i] = x = x0 + i*h - vy[i] = y = y + (k1 + k2 + k2 + k3 + k3 + k4)/6 + k1 = h * f(x, y) + k2 = h * f(x + 0.5 * h, y + 0.5 * k1) + k3 = h * f(x + 0.5 * h, y + 0.5 * k2) + k4 = h * f(x + h, y + k3) + vx[i] = x = x0 + i * h + vy[i] = y = y + (k1 + k2 + k2 + k3 + k3 + k4) / 6 return vx, vy def f(x, y): - return x*sqrt(y) + return x * sqrt(y) vx, vy = rk4(f, 0, 1, 10, 100) for x, y in list(zip(vx, vy))[::10]: - print(x, y, y - (4 + x*x)**2/16) + print("%4.1f %10.5f %+12.4e" % (x, y, y - (4 + x * x)**2 / 16)) -0 1 0.0 -1.0 1.562499854278108 -1.4572189210859676e-07 -2.0 3.9999990805207997 -9.194792003341945e-07 -3.0 10.562497090437551 -2.9095624487496252e-06 -4.0 24.999993765090636 -6.234909363911356e-06 -5.0 52.562489180302585 -1.0819697415342944e-05 -6.0 99.99998340540358 -1.659459641700778e-05 -7.0 175.56247648227125 -2.3517728749311573e-05 -8.0 288.9999684347986 -3.156520142510999e-05 -9.0 451.56245927683966 -4.07231603389846e-05 -10.0 675.9999490167097 -5.098329029351589e-05 + 0.0 1.00000 +0.0000e+00 + 1.0 1.56250 -1.4572e-07 + 2.0 4.00000 -9.1948e-07 + 3.0 10.56250 -2.9096e-06 + 4.0 24.99999 -6.2349e-06 + 5.0 52.56249 -1.0820e-05 + 6.0 99.99998 -1.6595e-05 + 7.0 175.56248 -2.3518e-05 + 8.0 288.99997 -3.1565e-05 + 9.0 451.56246 -4.0723e-05 +10.0 675.99995 -5.0983e-05 diff --git a/Task/Runge-Kutta-method/REXX/runge-kutta-method.rexx b/Task/Runge-Kutta-method/REXX/runge-kutta-method.rexx index 3a4dc91690..0e696e2918 100644 --- a/Task/Runge-Kutta-method/REXX/runge-kutta-method.rexx +++ b/Task/Runge-Kutta-method/REXX/runge-kutta-method.rexx @@ -1,34 +1,32 @@ -/*REXX program uses the Runge─Kutta method to solve the differential equation:*/ -/* _____ ══ the exact solution: y(t)=(t²+4)²/16 ══*/ -/* y'(t)═t² √ y(t) ══════════════════════════════════════════*/ +/*REXX program uses the Runge─Kutta method to solve the equation: y'(t)=t² √[y(t)] */ +numeric digits 40; f=digits()%4 /*use 40 digits, but only show 1/4 that*/ +x0=0; x1=10; w=digits()%2; dx= .1 /*set X0 & X1; calculate W & DX */ +n=1 + (x1-x0) / dx +y.=1; do m=1 for n-1; mm=m-1 + y.m=RK4(dx, x0+dx*mm, y.mm) /*use 4th order Runge─Kutta.*/ + end /*m*/ -numeric digits 40; d=digits()%2 /*use 40 digits, but only show ½ that.*/ -x0=0; x1=10; dx=.1; n=1 + (x1-x0)/dx -y.=1 - do m=1 for n-1; mm=m-1 - y.m=Runge_Kutta(dx, x0+dx*mm, y.mm) - end /*m*/ +say center('X', f, "═") center('Y', w+2, "═") center("relative error", w+8, '═') -say center(x,13,'─') center(y,d,'─') ' ' center('relative error',d,'─') - - do i=0 to n-1 by 10; x=(x0+dx*i)/1; y2=(x*x/4+1)**2 - relE=format(y.i/y2-1,,13)/1; if relE==0 then relE=' 0' /*adjust for 0*/ - say center(x,13) right(format(y.i,,12),d) ' ' left(relE,d) + do i=0 to n-1 by 10; x=(x0+dx*i)/1; $=y.i / (x*x/4+1)**2 - 1 + say center(x,f) fmt(y.i) left('', 2 + ($>=0)) fmt($) end /*i*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -rate: return arg(1) * sqrt(arg(2)) -/*────────────────────────────────────────────────────────────────────────────*/ -Runge_Kutta: procedure; parse arg dx,x,y - k1 = dx * rate(x , y ) - k2 = dx * rate(x+dx/2 , y+k1/2 ) - k3 = dx * rate(x+dx/2 , y+k2/2 ) - k4 = dx * rate(x+dx , y+k3 ) -return y + (k1 + 2*k2 + 2*k3 + k4) / 6 -/*────────────────────────────────────────────────────────────────────────────*/ -sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); i=; m.=9 - numeric digits 9; numeric form; h=d+6; if x<0 then do; x=-x; i='i'; end - parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_%2 - do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ - do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ - numeric digits d; return (g/1)i /*make complex if X < 0.*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +fmt: z=right( format( arg(1), w, f), w); hasE=pos('E', z)\==0 /*right adjust number.*/ + if pos(.,z)\==0 & \hasE then z=left( strip( strip(z, 'T', 0), "T", .), w) + return translate(right(z, (z>=0) + w + 5*hasE), 'e', "E") /*Positive | E, adjust*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +rate: return arg(1) * sqrt( arg(2) ) /*compute the rate. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +RK4: procedure; parse arg dx,x,y; k1= dx * rate( x , y ) + k2= dx * rate( x +dx/2 , y +k1/2 ) + k3= dx * rate( x +dx/2 , y +k2/2 ) + k4= dx * rate( x +dx , y +k3 ) + return y + (k1 + k2+k2 + k3+k3 + k4) / 6 +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); m.=9; numeric form; h=d+6 + numeric digits; parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_ %2 + do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ + do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ + numeric digits d; return g/1 diff --git a/Task/Runge-Kutta-method/Scala/runge-kutta-method.scala b/Task/Runge-Kutta-method/Scala/runge-kutta-method.scala new file mode 100644 index 0000000000..92528582a1 --- /dev/null +++ b/Task/Runge-Kutta-method/Scala/runge-kutta-method.scala @@ -0,0 +1,27 @@ +object Main extends App { + val f = (t: Double, y: Double) => t * Math.sqrt(y) // Runge-Kutta solution + val g = (t: Double) => Math.pow(t * t + 4, 2) / 16 // Exact solution + new Calculator(f, Some(g)).compute(100, 0, .1, 1) +} + +class Calculator(f: (Double, Double) => Double, g: Option[Double => Double] = None) { + def compute(counter: Int, tn: Double, dt: Double, yn: Double): Unit = { + if (counter % 10 == 0) { + val c = (x: Double => Double) => (t: Double) => { + val err = Math.abs(x(t) - yn) + f" Error: $err%7.5e" + } + val s = g.map(c(_)).getOrElse((x: Double) => "") // If we don't have exact solution, just print nothing + println(f"y($tn%4.1f) = $yn%12.8f${s(tn)}") // Else, print Error estimation here + } + if (counter > 0) { + val dy1 = dt * f(tn, yn) + val dy2 = dt * f(tn + dt / 2, yn + dy1 / 2) + val dy3 = dt * f(tn + dt / 2, yn + dy2 / 2) + val dy4 = dt * f(tn + dt, yn + dy3) + val y = yn + (dy1 + 2 * dy2 + 2 * dy3 + dy4) / 6 + val t = tn + dt + compute(counter - 1, t, dt, y) + } + } +} diff --git a/Task/Runtime-evaluation-In-an-environment/AppleScript/runtime-evaluation-in-an-environment-1.applescript b/Task/Runtime-evaluation-In-an-environment/AppleScript/runtime-evaluation-in-an-environment-1.applescript new file mode 100644 index 0000000000..18f78c5ed2 --- /dev/null +++ b/Task/Runtime-evaluation-In-an-environment/AppleScript/runtime-evaluation-in-an-environment-1.applescript @@ -0,0 +1,6 @@ +on task_with_x(pgrm, x1, x2) + local rslt1, rslt2 + set rslt1 to run script pgrm with parameters {x1} + set rslt2 to run script pgrm with parameters {x2} + rslt2 - rslt1 +end task_with_x diff --git a/Task/Runtime-evaluation-In-an-environment/AppleScript/runtime-evaluation-in-an-environment-2.applescript b/Task/Runtime-evaluation-In-an-environment/AppleScript/runtime-evaluation-in-an-environment-2.applescript new file mode 100644 index 0000000000..18591f4f89 --- /dev/null +++ b/Task/Runtime-evaluation-In-an-environment/AppleScript/runtime-evaluation-in-an-environment-2.applescript @@ -0,0 +1,6 @@ +set pgrm_with_x to " +on run {x} + 2^x +end" + +task_with_x(pgrm_with_x, 3, 5) diff --git a/Task/Runtime-evaluation-In-an-environment/Perl-6/runtime-evaluation-in-an-environment.pl6 b/Task/Runtime-evaluation-In-an-environment/Perl-6/runtime-evaluation-in-an-environment.pl6 index 9e3141d211..a2cf96660a 100644 --- a/Task/Runtime-evaluation-In-an-environment/Perl-6/runtime-evaluation-in-an-environment.pl6 +++ b/Task/Runtime-evaluation-In-an-environment/Perl-6/runtime-evaluation-in-an-environment.pl6 @@ -1,4 +1,5 @@ -sub eval_with_x($code, *@x) { [R-] @x.map: -> \x { eval $code } } +use MONKEY-SEE-NO-EVAL; +sub eval_with_x($code, *@x) { [R-] @x.map: -> \x { EVAL $code } } say eval_with_x('3 * x', 5, 10); # Says "15". -say eval_with_x('3 * x', 5, 10, 50); # Says "135". +say eval_with_x('3 * x', 5, 10, 50); # Says "105". diff --git a/Task/Runtime-evaluation/00DESCRIPTION b/Task/Runtime-evaluation/00DESCRIPTION index d104759f95..106a4393fe 100644 --- a/Task/Runtime-evaluation/00DESCRIPTION +++ b/Task/Runtime-evaluation/00DESCRIPTION @@ -1,6 +1,9 @@ -Demonstrate your language's ability for programs to execute code written in the language provided at runtime. -Show us what kind of program fragments are permitted (e.g. expressions vs. statements), how you get values in and out (e.g. environments, arguments, return values), if applicable what lexical/static environment the program is evaluated in, and what facilities for restricting (e.g. sandboxes, resource limits) or customizing (e.g. debugging facilities) the execution. +;Task: +Demonstrate a language's ability for programs to execute code written in the language provided at runtime. + +Show what kind of program fragments are permitted (e.g. expressions vs. statements), and how to get values in and out (e.g. environments, arguments, return values), if applicable what lexical/static environment the program is evaluated in, and what facilities for restricting (e.g. sandboxes, resource limits) or customizing (e.g. debugging facilities) the execution. You may not invoke a separate evaluator program, or invoke a compiler and then its output, unless the interface of that program, and the syntax and means of executing it, are considered part of your language/library/platform. For a more constrained task giving a specific program fragment to evaluate, see [[Eval in environment]]. +

    diff --git a/Task/Runtime-evaluation/BASIC/runtime-evaluation.basic b/Task/Runtime-evaluation/BASIC/runtime-evaluation-1.basic similarity index 100% rename from Task/Runtime-evaluation/BASIC/runtime-evaluation.basic rename to Task/Runtime-evaluation/BASIC/runtime-evaluation-1.basic diff --git a/Task/Runtime-evaluation/BASIC/runtime-evaluation-2.basic b/Task/Runtime-evaluation/BASIC/runtime-evaluation-2.basic new file mode 100644 index 0000000000..f50c50341e --- /dev/null +++ b/Task/Runtime-evaluation/BASIC/runtime-evaluation-2.basic @@ -0,0 +1,5 @@ +10 LET f$=CHR$ 187+"(x)+"+CHR$ 178+"(x*3)/2": REM LET f$="SQR (x)+SIN (x*3)/2" +20 FOR x=0 TO 2 STEP 0.2 +30 LET y=VAL f$ +40 PRINT y +50 NEXT x diff --git a/Task/Runtime-evaluation/BASIC/runtime-evaluation-3.basic b/Task/Runtime-evaluation/BASIC/runtime-evaluation-3.basic new file mode 100644 index 0000000000..56f8842bfb --- /dev/null +++ b/Task/Runtime-evaluation/BASIC/runtime-evaluation-3.basic @@ -0,0 +1 @@ +10 LET f= SQR (x)+SIN (x*3)/2 diff --git a/Task/Runtime-evaluation/BASIC/runtime-evaluation-4.basic b/Task/Runtime-evaluation/BASIC/runtime-evaluation-4.basic new file mode 100644 index 0000000000..0381b6cd01 --- /dev/null +++ b/Task/Runtime-evaluation/BASIC/runtime-evaluation-4.basic @@ -0,0 +1 @@ +10 LET f$=" SQR (x)+SIN (x*3)/2" diff --git a/Task/Runtime-evaluation/Elixir/runtime-evaluation.elixir b/Task/Runtime-evaluation/Elixir/runtime-evaluation.elixir new file mode 100644 index 0000000000..8ff9684b38 --- /dev/null +++ b/Task/Runtime-evaluation/Elixir/runtime-evaluation.elixir @@ -0,0 +1,6 @@ +iex(1)> Code.eval_string("x + 4 * Enum.sum([1,2,3,4])", [x: 17]) +{57, [x: 17]} +iex(2)> Code.eval_string("c = a + b", [a: 1, b: 2]) +{3, [a: 1, b: 2, c: 3]} +iex(3)> Code.eval_string("a = a + b", [a: 1, b: 2]) +{3, [a: 3, b: 2]} diff --git a/Task/Runtime-evaluation/Perl-6/runtime-evaluation.pl6 b/Task/Runtime-evaluation/Perl-6/runtime-evaluation.pl6 index 619594a738..aea87274bb 100644 --- a/Task/Runtime-evaluation/Perl-6/runtime-evaluation.pl6 +++ b/Task/Runtime-evaluation/Perl-6/runtime-evaluation.pl6 @@ -1,2 +1,4 @@ +use MONKEY-SEE-NO-EVAL; + my ($a, $b) = (-5, 7); -my $ans = eval 'abs($a * $b)'; # => 35 +my $ans = EVAL 'abs($a * $b)'; # => 35 diff --git a/Task/Runtime-evaluation/REXX/runtime-evaluation.rexx b/Task/Runtime-evaluation/REXX/runtime-evaluation.rexx index 58380d13dd..938f95e5fe 100644 --- a/Task/Runtime-evaluation/REXX/runtime-evaluation.rexx +++ b/Task/Runtime-evaluation/REXX/runtime-evaluation.rexx @@ -1,22 +1,20 @@ -/*REXX program illustrates ability to execute code entered at "runtime".*/ -numeric digits 10000000 /*ten million digits should do it*/ +/*REXX program illustrates the ability to execute code entered at runtime (from C.L.)*/ +numeric digits 10000000 /*ten million digits should do it. */ bee=51 stuff= 'bee=min(-2,44); say 13*2 "[from inside the box.]"; abc=abs(bee)' interpret stuff -say 'bee=' bee -say 'abc=' abc +say 'bee=' bee +say 'abc=' abc say - /* [↓] now, we hear from da user*/ + /* [↓] now, we hear from the user. */ say 'enter an expression:' pull expression say -say 'expression entered is:' expression +say 'expression entered is:' expression +say interpret '?='expression -say say 'length of result='length(?) -say ' left 50 bytes of result='left(?,50)'···' -say 'right 50 bytes of result=···'right(?,50) - - /*stick a fork in it, we're done.*/ +say ' left 50 bytes of result='left(?,50)"···" +say 'right 50 bytes of result=···'right(?, 50) /*stick a fork in it, we're all done. */ diff --git a/Task/S-Expressions/00DESCRIPTION b/Task/S-Expressions/00DESCRIPTION index 2d9f2d65b0..bc86ac0a38 100644 --- a/Task/S-Expressions/00DESCRIPTION +++ b/Task/S-Expressions/00DESCRIPTION @@ -1,10 +1,18 @@ -[[wp:S-Expression|S-Expressions]] are one convenient way to parse and store data. +[[wp:S-Expression|S-Expressions]]   are one convenient way to parse and store data. + +;Task: Write a simple reader and writer for S-Expressions that handles quoted and unquoted strings, integers and floats. -The reader should read a single but nested S-Expression from a string and store it in a suitable datastructure (list, array, etc). Newlines and other whitespace may be ignored unless contained within a quoted string. “()” inside quoted strings are not interpreted, but treated as part of the string. Handling escaped quotes inside a string is optional; thus “(foo"bar)” maybe treated as a string “foo"bar”, or as an error. +The reader should read a single but nested S-Expression from a string and store it in a suitable datastructure (list, array, etc). -For this, the reader need not recognise “\” for escaping, but should, in addition, recognize numbers if the language has appropriate datatypes. +Newlines and other whitespace may be ignored unless contained within a quoted string. + +“()”   inside quoted strings are not interpreted, but treated as part of the string. + +Handling escaped quotes inside a string is optional;   thus “(foo"bar)” maybe treated as a string “foo"bar”, or as an error. + +For this, the reader need not recognize “\” for escaping, but should, in addition, recognize numbers if the language has appropriate datatypes. Languages that support it may treat unquoted strings as symbols. @@ -18,4 +26,7 @@ and turn it into a native datastructure. (see the [[#Pike|Pike]], [[#Python|Pyth The writer should be able to take the produced list and turn it into a new S-Expression. Strings that don't contain whitespace or parentheses () don't need to be quoted in the resulting S-Expression, but as a simplification, any string may be quoted. -'''Extra Credit:''' Let the writer produce pretty printed output with indenting and line-breaks + +;Extra Credit: +Let the writer produce pretty printed output with indenting and line-breaks. +

    diff --git a/Task/S-Expressions/ALGOL-68/s-expressions.alg b/Task/S-Expressions/ALGOL-68/s-expressions.alg new file mode 100644 index 0000000000..cb5dae63bc --- /dev/null +++ b/Task/S-Expressions/ALGOL-68/s-expressions.alg @@ -0,0 +1,127 @@ +# S-Expressions # +CHAR nl = REPR 10; +# mode representing an S-expression # +MODE SEXPR = STRUCT( UNION( VOID, STRING, REF SEXPR ) element, REF SEXPR next ); +# creates an initialises an SEXPR # +PROC new s expr = REF SEXPR: HEAP SEXPR := ( EMPTY, NIL ); +# reports an error # +PROC error = ( STRING msg )VOID: print( ( "**** ", msg, newline ) ); +# S-expression reader - reads and returns an S-expression from the string s # +PROC s reader = ( STRING s )REF SEXPR: + BEGIN + PROC at end = BOOL: s pos > UPB s; + PROC curr = CHAR: IF at end THEN REPR 0 ELSE s[ s pos ] FI; + PROC skip spaces = VOID: WHILE NOT at end AND ( curr = " " OR curr = nl ) DO s pos +:= 1 OD; + PROC end of list = BOOL: at end OR curr = ")"; + INT s pos := LWB s; + INT t pos; + [ ( UPB s - LWB s ) + 1 ]CHAR token; # token text - large enough to hold the whole string if necessary # + # adds the current character to the token # + PROC add curr = VOID: token[ t pos +:= 1 ] := curr; + # get an s expression element from s # + PROC get element = REF SEXPR: + BEGIN + REF SEXPR result = new s expr; + skip spaces; + # get token text # + IF at end THEN + # no element # + element OF result := EMPTY + ELIF curr = "(" THEN + s pos +:= 1; + skip spaces; + IF NOT end of list + THEN + REF SEXPR nested expression = get element; + REF SEXPR element pos := nested expression; + element OF result := nested expression; + skip spaces; + WHILE NOT end of list + DO + element pos := next OF element pos := get element; + skip spaces + OD + FI; + IF curr = ")" THEN + s pos +:= 1 + ELSE + error( "Missing "")""" ) + FI + ELIF curr = ")" THEN + s pos +:= 1; + error( "Unexpected "")""" ); + element OF result := EMPTY + ELSE + # quoted or unquoted string # + t pos := LWB token - 1; + IF curr /= """" THEN + # unquoted string # + WHILE add curr; + s pos +:= 1; + NOT at end AND curr /= " " AND curr /= "(" + AND curr /= ")" AND curr /= """" + AND curr /= nl + DO SKIP OD + ELSE + # quoted string # + WHILE add curr; + s pos +:= 1; + NOT at end AND curr /= """" + DO SKIP OD; + IF curr /= """" THEN + # missing string quote # + error( "Unterminated string: <<" + token[ : t pos ] + ">>" ) + ELSE + # have the closing quote # + add curr; + s pos +:= 1 + FI + FI; + element OF result := token[ : t pos ] + FI; + result + END # get element # ; + + REF SEXPR s expr = get element; + skip spaces; + IF NOT at end THEN + # extraneuos text after the expression # + error( "Unexpected text at end of expression: " + s[ s pos : ] ) + FI; + + s expr + END # s reader # ; +# prints an S expression # +PROC s writer = ( REF SEXPR s expr )VOID: + BEGIN + # prints an S expression with a suitable indent # + PROC print indented s expression = ( REF SEXPR s expr, INT indent )VOID: + BEGIN + REF SEXPR s pos := s expr; + WHILE REF SEXPR( s pos ) ISNT REF SEXPR( NIL ) DO + FOR i TO indent DO print( ( " " ) ) OD; + CASE element OF s pos + IN (VOID ): print( ( "()", newline ) ) + , (STRING s): print( ( s, newline ) ) + , (REF SEXPR e): BEGIN + print( ( "(", newline ) ); + print indented s expression( e, indent + 4 ); + FOR i TO indent DO print( ( " " ) ) OD; + print( ( ")", newline ) ) + END + OUT + error( "Unexpected S expression element" ) + ESAC; + s pos := next OF s pos + OD + END # print indented s expression # ; + + print indented s expression( s expr, 0 ) + END # s writer # ; +# test the eader and writer with the example from the task # +s writer( s reader( "((data ""quoted data"" 123 4.5)" + + nl + + " (data (!@# (4.5) ""(more"" ""data)"")))" + + nl + ) + ) diff --git a/Task/S-Expressions/Haskell/s-expressions.hs b/Task/S-Expressions/Haskell/s-expressions.hs index 7aa77a370a..df2b3db540 100644 --- a/Task/S-Expressions/Haskell/s-expressions.hs +++ b/Task/S-Expressions/Haskell/s-expressions.hs @@ -1,8 +1,8 @@ -import Text.ParserCombinators.Parsec ((<|>), (), many, many1, char, try, parse, sepBy, choice) -import Text.ParserCombinators.Parsec.Char (noneOf) -import Text.ParserCombinators.Parsec.Token (integer, float, whiteSpace, stringLiteral, makeTokenParser) -import Text.ParserCombinators.Parsec.Language (haskellDef) - +import Data.Functor +import Text.Parsec ((<|>), (), many, many1, char, try, parse, sepBy, choice) +import Text.Parsec.Char (noneOf) +import Text.Parsec.Token (integer, float, whiteSpace, stringLiteral, makeTokenParser) +import Text.Parsec.Language (haskell) data Val = Int Integer | Float Double @@ -10,40 +10,19 @@ data Val = Int Integer | Symbol String | List [Val] deriving (Eq, Show) -lexer = makeTokenParser haskellDef - -tInteger = (integer lexer) >>= (return . Int) "integer" - -tFloat = (float lexer) >>= (return . Float) "floating point number" - -tString = (stringLiteral lexer) >>= (return . String) "string" - -tSymbol = (many1 $ noneOf "()\" \t\n\r") >>= (return . Symbol) "symbol" - -tAtom = choice [try tFloat, try tInteger, tSymbol, tString] "atomic expression" - -tExpr = do - whiteSpace lexer - expr <- tList <|> tAtom - whiteSpace lexer - return expr - "expression" - -tList = do - char '(' - list <- many tExpr - char ')' - return $ List list - "list" - tProg = many tExpr "program" + where tExpr = between ws ws (tList <|> tAtom) "expression" + ws = whiteSpace haskell + tAtom = try (Int <$> integer haskell) "integer" + <|> try (Float <$> float haskell) "floating point number" + <|> String <$> stringLiteral haskell "string" + <|> Symbol <$> many1 (noneOf "()\"\t\n\r") "symbol" + "atomic expression" + tList = List <$> between (char '(') (char ')') (many tExpr) "list" -p ex = case parse tProg "" ex of - Right x -> putStrLn $ unwords $ map show x - Left err -> print err +p = either print (putStrLn . unwords . map show) . parse tProg "" main = do let expr = "((data \"quoted data\" 123 4.5)\n (data (!@# (4.5) \"(more\" \"data)\")))" - putStrLn $ "The input:\n" ++ expr ++ "\n" - putStr "Parsed as:\n" + putStrLn ("The input:\n" ++ expr ++ "\nParsed as:") p expr diff --git a/Task/S-Expressions/Perl/s-expressions-1.pl b/Task/S-Expressions/Perl/s-expressions-1.pl index 1a015a427e..c5ad8c82c6 100644 --- a/Task/S-Expressions/Perl/s-expressions-1.pl +++ b/Task/S-Expressions/Perl/s-expressions-1.pl @@ -1,34 +1,55 @@ -use Text::Balanced qw(extract_delimited extract_bracketed); +#!/usr/bin/perl -w +use strict; +use warnings; sub sexpr { - my $txt = $_[0]; - $txt =~ s/^\s+//s; - $txt =~ s/\s+$//s; - $txt =~ /^\((.*)\)$/s or die "Not an s-expression: <<<$txt>>>"; - $txt = $1; + my @stack = ([]); + local $_ = $_[0]; - my $ret = []; - my $w; - while ($txt ne '') { - my $c = substr $txt,0,1; - if ($c eq '(') { - ($w, $txt) = extract_bracketed($txt, '()'); - $w = sexpr($w); - } elsif ($c eq '"') { - ($w, $txt) = extract_delimited($txt, '"'); - $w =~ s/^"(.*)"/$1/; + while (m{ + \G # start match right at the end of the previous one + \s*+ # skip whitespaces + # now try to match any of possible tokens in THIS order: + (?\() | + (?\)) | + (?[0-9]*+\.[0-9]*+) | + (?[0-9]++) | + (?:"(?([^\"\\]|\\.)*+)") | + (?[^\s()]++) + # Flags: + # g = match the same string repeatedly + # m = ^ and $ match at \n + # s = dot and \s matches \n + # x = allow comments within regex + }gmsx) + { + die "match error" if 0+(keys %+) != 1; + + my $token = (keys %+)[0]; + my $val = $+{$token}; + + if ($token eq 'lparen') { + my $a = []; + push @{$stack[$#stack]}, $a; + push @stack, $a; + } elsif ($token eq 'rparen') { + pop @stack; } else { - $txt =~ s/^(\S+)// and $w = $1; + push @{$stack[$#stack]}, bless \$val, $token; } - push @$ret, $w; - $txt =~ s/^\s+//s; } - return $ret; + return $stack[0]->[0]; } sub quote { (local $_ = $_[0]) =~ /[\s\"\(\)]/s ? do{s/\"/\\\"/gs; qq{"$_"}} : $_; } sub sexpr2txt -{ qq{(@{[ map { ref($_) eq '' ? quote($_) : sexpr2txt($_) } @{$_[0]} ]})} } +{ + qq{(@{[ map { + ref($_) eq '' ? quote($_) : + ref($_) eq 'STRING' ? quote($$_) : + ref($_) eq 'ARRAY' ? sexpr2txt($_) : $$_ + } @{$_[0]} ]})} +} diff --git a/Task/S-Expressions/REXX/s-expressions.rexx b/Task/S-Expressions/REXX/s-expressions.rexx index 01bc5275fb..25179548fd 100644 --- a/Task/S-Expressions/REXX/s-expressions.rexx +++ b/Task/S-Expressions/REXX/s-expressions.rexx @@ -1,24 +1,24 @@ -/*REXX program parses an S-expression and displays the results. */ +/*REXX program parses an S-expression and displays the results. */ input= '((data "quoted data" 123 4.5) (data (!@# (4.5) "(more" "data)")))' -say 'input:'; say input /*display the input data string to term*/ -say copies('═',length(input)) /*also, display a header fence. */ -groupO.= /*default value for grouping symbols. */ -groupO.1 = '{' ; groupC.1 = '}' /*grouping symbols (Open & Close). */ -groupO.2 = '[' ; groupC.2 = ']' /* " " " " " */ -groupO.3 = '(' ; groupC.3 = ')' /* " " " " " */ -# = 0 /*the number of tokens found (so far). */ -tabs = 10 /*used for the indenting of the levels.*/ -q.1 = "'" /*literal string delimiter, first. */ -q.2 = '"' /* " " " second. */ -numLits = 2 /*the number of kinds of literals. */ -seps = ',;' /*characters used for separation. */ -atoms = ' 'seps /*characters used to separate atoms. */ -level = 0 /*the current level being processed. */ -quoted = 0 /*quotation level (when nested). */ -groupu = /*used to go ↑ an expression level. */ -groupd = /* " " " ↓ " " " */ -$.= /*the stem array to hold the tokens. */ - do n=1 while groupO.n\=='' /*handle the number of grouping symbols*/ +say 'input:'; say input /*display the input data string to term*/ +say copies('═', length(input)) /*also, display a header fence. */ +groupO.= /*default value for grouping symbols. */ +groupO.1 = '{' ; groupC.1 = "}" /*grouping symbols (Open & Close). */ +groupO.2 = '[' ; groupC.2 = "]" /* " " " " " */ +groupO.3 = '(' ; groupC.3 = ")" /* " " " " " */ +# = 0 /*the number of tokens found (so far). */ +tabs = 10 /*used for the indenting of the levels.*/ +q.1 = "'" /*literal string delimiter, first. */ +q.2 = '"' /* " " " second. */ +numLits = 2 /*the number of kinds of literals. */ +seps = ',;' /*characters used for separation. */ +atoms = ' 'seps /*characters used to separate atoms. */ +level = 0 /*the current level being processed. */ +quoted = 0 /*quotation level (when nested). */ +groupu = /*used to go ↑ an expression level. */ +groupd = /* " " " ↓ " " " */ +$.= /*the stem array to hold the tokens. */ + do n=1 while groupO.n\=='' /*handle the number of grouping symbols*/ atoms =atoms || groupO.n || groupC.n groupu=groupu || groupO.n groupd=groupd || groupC.n @@ -28,38 +28,37 @@ literals= literals=literals || q.k end /*k*/ != - /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒ text parsing ▒▒▒▒▒▒▒▒*/ - do j=1 to length(input); _=substr(input,j,1) /*▒*/ - /*▒*/ - if quoted then do; !=! || _ /*▒*/ - if _==literalStart then quoted=0 /*▒*/ - iterate /*▒*/ - end /*▒*/ - /*▒*/ - if pos(_,literals)\==0 then do; literalStart=_ /*▒*/ - !=! || _ /*▒*/ - quoted=1 /*▒*/ - iterate /*▒*/ - end /*▒*/ - /*▒*/ - if pos(_,atoms)==0 then do; !=! || _ ; iterate; end /*▒*/ - else do; call add!; !=_; end /*▒*/ - /*▒*/ - if pos(_,literals)==0 then do /*▒*/ - if pos(_,groupu)\==0 then level=level+1 /*▒*/ - call add! /*▒*/ - if pos(_,groupd)\==0 then level=level-1 /*▒*/ - if level<0 then say 'oops, mismatched' _ /*▒*/ - end /*▒*/ - end /*j*/ /*▒*/ - /*▒*/ -call add! /*handle any residual tokens.*/ /*▒*/ -if level\==0 then say 'oops, mismatched grouping symbol' /*▒*/ -if quoted then say 'oops, no end of quoted literal' literalStart /*▒*/ - /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/ + /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒ text parsing ▒▒▒▒▒▒▒▒*/ + do j=1 to length(input); _=substr(input,j,1) /*▒*/ + /*▒*/ + if quoted then do; !=! || _ /*▒*/ + if _==literalStart then quoted=0 /*▒*/ + iterate /*▒*/ + end /*▒*/ + /*▒*/ + if pos(_,literals)\==0 then do; literalStart=_ /*▒*/ + !=! || _ /*▒*/ + quoted=1 /*▒*/ + iterate /*▒*/ + end /*▒*/ + /*▒*/ + if pos(_,atoms)==0 then do; !=! || _ ; iterate; end /*▒*/ + else do; call add!; !=_; end /*▒*/ + /*▒*/ + if pos(_,literals)==0 then do; if pos(_,groupu)\==0 then level=level+1 /*▒*/ + call add! /*▒*/ + if pos(_,groupd)\==0 then level=level-1 /*▒*/ + if level<0 then say 'oops, mismatched' _ /*▒*/ + end /*▒*/ + end /*j*/ /*▒*/ + /*▒*/ +call add! /*handle any residual tokens.*/ /*▒*/ +if level\==0 then say 'oops, mismatched grouping symbol' /*▒*/ +if quoted then say 'oops, no end of quoted literal' literalStart /*▒*/ + /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒*/ - do j=1 for #; say $.j; end /*display the tokens to the terminal. */ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -add!: if !\='' then do; #=#+1; $.#=left('', max(0, tabs*(level-1)))!; end; != -return + do m=1 for #; say $.m; end /*m*/ /*display the tokens to the terminal. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +add!: if !\='' then do; #=#+1; $.#=left('', max(0, tabs*(level-1)))!; end; != + return diff --git a/Task/S-Expressions/TXR/s-expressions-1.txr b/Task/S-Expressions/TXR/s-expressions-1.txr index 1890604753..483f5e8515 100644 --- a/Task/S-Expressions/TXR/s-expressions-1.txr +++ b/Task/S-Expressions/TXR/s-expressions-1.txr @@ -1,4 +1,44 @@ -$ txr -c '@(do (print (read)) (put-line ""))' -((data "quoted data" 123 4.5) <- input from TTY - (data (!@# (4.5) "(more" "data)"))) -((data "quoted data" 123 4.5) (data (! (sys:var #) (4.5) "(more" "data)"))) <- output +@(define float (f))@\ + @(local (tok))@\ + @(cases)@\ + @{tok /[+\-]?\d+\.\d*([Ee][+\-]?\d+)?/}@\ + @(or)@\ + @{tok /[+\-]?\d*\.\d+([Ee][+\-]?\d+)?/}@\ + @(or)@\ + @{tok /[+\-]?\d+[Ee][+\-]?\d+/}@\ + @(end)@\ + @(bind f @(flo-str tok))@\ +@(end) +@(define int (i))@\ + @(local (tok))@\ + @{tok /[+\-]?\d+/}@\ + @(bind i @(int-str tok))@\ +@(end) +@(define sym (s))@\ + @(local (tok))@\ + @{tok /[^\s()]+/}@\ + @(bind s @(intern tok))@\ +@(end) +@(define str (s))@\ + @(local (tok))@\ + @{tok /"(\\"|[^"])*"/}@\ + @(bind s @[tok 1..-1])@\ +@(end) +@(define atom (a))@\ + @(cases)@\ + @(float a)@(or)@(int a)@(or)@(str a)@(or)@(sym a)@\ + @(end)@\ +@(end) +@(define expr (e))@\ + @(cases)@\ + @/\s*/@(atom e)@\ + @(or)@\ + @/\s*\(\s*/@(coll :vars (e))@(expr e)@/\s*/@(last))@(end)@\ + @(end)@\ +@(end) +@(freeform) +@(expr e)@junk +@(output) +expr: @(format nil "~s" e) +junk: @junk +@(end) diff --git a/Task/S-Expressions/TXR/s-expressions-2.txr b/Task/S-Expressions/TXR/s-expressions-2.txr index 483f5e8515..e60497e242 100644 --- a/Task/S-Expressions/TXR/s-expressions-2.txr +++ b/Task/S-Expressions/TXR/s-expressions-2.txr @@ -1,44 +1 @@ -@(define float (f))@\ - @(local (tok))@\ - @(cases)@\ - @{tok /[+\-]?\d+\.\d*([Ee][+\-]?\d+)?/}@\ - @(or)@\ - @{tok /[+\-]?\d*\.\d+([Ee][+\-]?\d+)?/}@\ - @(or)@\ - @{tok /[+\-]?\d+[Ee][+\-]?\d+/}@\ - @(end)@\ - @(bind f @(flo-str tok))@\ -@(end) -@(define int (i))@\ - @(local (tok))@\ - @{tok /[+\-]?\d+/}@\ - @(bind i @(int-str tok))@\ -@(end) -@(define sym (s))@\ - @(local (tok))@\ - @{tok /[^\s()]+/}@\ - @(bind s @(intern tok))@\ -@(end) -@(define str (s))@\ - @(local (tok))@\ - @{tok /"(\\"|[^"])*"/}@\ - @(bind s @[tok 1..-1])@\ -@(end) -@(define atom (a))@\ - @(cases)@\ - @(float a)@(or)@(int a)@(or)@(str a)@(or)@(sym a)@\ - @(end)@\ -@(end) -@(define expr (e))@\ - @(cases)@\ - @/\s*/@(atom e)@\ - @(or)@\ - @/\s*\(\s*/@(coll :vars (e))@(expr e)@/\s*/@(last))@(end)@\ - @(end)@\ -@(end) -@(freeform) -@(expr e)@junk -@(output) -expr: @(format nil "~s" e) -junk: @junk -@(end) + @/\s*\(\s*/@(coll :vars (e))@(expr e)@/\s*/@(last))@(end) diff --git a/Task/SEDOLs/00DESCRIPTION b/Task/SEDOLs/00DESCRIPTION index 5c45ca3a88..3d0ef13d32 100644 --- a/Task/SEDOLs/00DESCRIPTION +++ b/Task/SEDOLs/00DESCRIPTION @@ -1,6 +1,10 @@ +;Task: For each number list of '''6'''-digit [[wp:SEDOL|SEDOL]]s, calculate and append the checksum digit. -That is, given this input:
    710889
    +
    +That is, given this input:
    +
    +710889
     B0YBKJ
     406566
     B0YBLH
    @@ -10,8 +14,11 @@ B0YBKL
     B0YBKR
     585284
     B0YBKT
    -B00030
    Produce this output: -
    7108899
    +B00030
    +
    +Produce this output: +
    +7108899
     B0YBKJ7
     4065663
     B0YBLH2
    @@ -21,8 +28,14 @@ B0YBKL9
     B0YBKR5
     5852842
     B0YBKT7
    -B000300
    +B000300 +
    -For extra credit, check each input is correctly formed, especially with respect to valid characters allowed in a SEDOL string. +;Extra credit: +Check each input is correctly formed, especially with respect to valid characters allowed in a SEDOL string. -C.f. [[Luhn test]], [[Calculate International Securities Identification Number|ISIN]] + +;Related tasks: +*   [[Luhn test]] +*   [[Calculate International Securities Identification Number|ISIN]] +

    diff --git a/Task/SEDOLs/Elixir/sedols.elixir b/Task/SEDOLs/Elixir/sedols.elixir new file mode 100644 index 0000000000..060aefec61 --- /dev/null +++ b/Task/SEDOLs/Elixir/sedols.elixir @@ -0,0 +1,43 @@ +defmodule SEDOL do + @sedol_char "0123456789BCDFGHJKLMNPQRSTVWXYZ" |> String.codepoints + @sedolweight [1,3,1,7,3,9] + + defp char2value(c) do + unless c in @sedol_char, do: raise ArgumentError, "No vowels" + String.to_integer(c,36) + end + + def checksum(sedol) do + if String.length(sedol) != length(@sedolweight), do: raise ArgumentError, "Invalid length" + sum = Enum.zip(String.codepoints(sedol), @sedolweight) + |> Enum.map(fn {ch, weight} -> char2value(ch) * weight end) + |> Enum.sum + to_string(rem(10 - rem(sum, 10), 10)) + end +end + +data = ~w{ + 710889 + B0YBKJ + 406566 + B0YBLH + 228276 + B0YBKL + 557910 + B0YBKR + 585284 + B0YBKT + B00030 + C0000 + 1234567 + 00000A + } + +Enum.each(data, fn sedol -> + :io.fwrite "~-8s ", [sedol] + try do + IO.puts sedol <> SEDOL.checksum(sedol) + rescue + e in ArgumentError -> IO.inspect e + end +end) diff --git a/Task/SEDOLs/J/sedols-3.j b/Task/SEDOLs/J/sedols-3.j index 11018851bb..2d2723b23d 100644 --- a/Task/SEDOLs/J/sedols-3.j +++ b/Task/SEDOLs/J/sedols-3.j @@ -1 +1 @@ -ac1 =: (, 10 | 9 7 9 3 7 1 +/@:* ])&.(sn i. |:) +ac2 =: (, 10 | 9 7 9 3 7 1 +/@:* ])&.(sn i. |:) diff --git a/Task/SEDOLs/J/sedols-4.j b/Task/SEDOLs/J/sedols-4.j index dd40068d16..497b5d2030 100644 --- a/Task/SEDOLs/J/sedols-4.j +++ b/Task/SEDOLs/J/sedols-4.j @@ -1 +1 @@ -ac2 =. (,"1 0 (841 $ '0987654321') {~ 1 3 1 7 3 9 +/ .*~ sn i. ]) +ac3 =: (,"1 0 (841 $ '0987654321') {~ 1 3 1 7 3 9 +/ .*~ sn i. ]) diff --git a/Task/SEDOLs/Perl-6/sedols.pl6 b/Task/SEDOLs/Perl-6/sedols.pl6 index e561063fc4..88f7a226ae 100644 --- a/Task/SEDOLs/Perl-6/sedols.pl6 +++ b/Task/SEDOLs/Perl-6/sedols.pl6 @@ -2,7 +2,7 @@ sub sedol( Str $s ) { die 'No vowels allowed' if $s ~~ /<[AEIOU]>/; die 'Invalid format' if $s !~~ /^ <[0..9B..DF..HJ..NP..TV..Z]>**6 $ /; - my %base36 = ( 0..9, 'A'..'Z' ) Z ( ^36 ); + my %base36 = (flat 0..9, 'A'..'Z') »=>« ^36; my @weights = 1, 3, 1, 7, 3, 9; my @vs = %base36{ $s.comb }; diff --git a/Task/SEDOLs/PowerShell/sedols.psh b/Task/SEDOLs/PowerShell/sedols.psh new file mode 100644 index 0000000000..2a07c8b386 --- /dev/null +++ b/Task/SEDOLs/PowerShell/sedols.psh @@ -0,0 +1,48 @@ +function Add-SEDOLCheckDigit + { + Param ( # Validate input as six-digit SEDOL number + [ValidatePattern( "^[0123456789bcdfghjklmnpqrstvwxyz]{6}$" )] + [parameter ( Mandatory = $True ) ] + [string] + $SixDigitSEDOL ) + + # Convert to array of single character strings, using type char as an intermediary + $SEDOL = [string[]][char[]]$SixDigitSEDOL + + # Define place weights + $Weight = @( 1, 3, 1, 7, 3, 9 ) + + # Define character values (implicit in 0-based location within string) + $Characters = "0123456789abcdefghijklmnopqrstuvwxyz" + + $CheckSum = 0 + + # For each digit, multiply the character value by the weight and add to check sum + 0..5 | ForEach { $CheckSum += $Characters.IndexOf( $SEDOL[$_].ToLower() ) * $Weight[$_] } + + # Derive the check digit from the partial check sum + $CheckDigit = ( 10 - $CheckSum % 10 ) % 10 + + # Return concatenated result + return ( $SixDigitSEDOL + $CheckDigit ) + } + +# Test +$List = @( + "710889" + "B0YBKJ" + "406566" + "B0YBLH" + "228276" + "B0YBKL" + "557910" + "B0YBKR" + "585284" + "B0YBKT" + "B00030" + ) + +ForEach ( $PartialSEDOL in $List ) + { + Add-SEDOLCheckDigit -SixDigitSEDOL $PartialSEDOL + } diff --git a/Task/SEDOLs/REXX/sedols.rexx b/Task/SEDOLs/REXX/sedols.rexx index 8fb8f10cb0..e1063dcbda 100644 --- a/Task/SEDOLs/REXX/sedols.rexx +++ b/Task/SEDOLs/REXX/sedols.rexx @@ -1,53 +1,42 @@ -/*REXX program computes the check (last) digit for 6 or 7 char SEDOLs.*/ - /*if the SEDOL is 6 characters, */ - /*a check digit is added. */ - - /*if the SEDOL is 7 characters, a */ - /*check digit is created and it is*/ - /*verified that it's equal to the */ - /*check digit already on the SEDOL*/ -@.= -arg @.1 . /*allow a user-specified SEDOL. */ -if @.1=='' then do /*if none, then assume 11 defaults*/ - @.1 = 710889 - @.2 ='B0YBKJ' - @.3 = 406566 - @.4 ='B0YBLH' - @.5 = 228276 - @.6 ='B0YBKL' - @.7 = 557910 - @.8 ='B0YBKR' - @.9 = 585284 - @.10='B0YBKT' - @.11='B00030' +/*REXX program computes the check digit (last digit) for six or seven character SEDOLs.*/ +@abcU = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' /*the uppercase Latin alphabet. */ +alphaDigs= '0123456789'@abcU /*legal characters, and then some. */ +allowable=space(translate(alphaDigs,,'AEIOU'),0) /*remove the vowels from the alphabet. */ +weights = 1317391 /*various weights for SEDOL characters.*/ +@.= /* [↓] the ARG statement capitalizes. */ +arg @.1 . /*allow a user─specified SEDOL from CL*/ +if @.1=='' then do /*if none, then assume eleven defaults.*/ + @.1 = 710889 /*if all numeric, we don't need quotes.*/ + @.2 = 'B0YBKJ' + @.3 = 406566 + @.4 = 'B0YBLH' + @.5 = 228276 + @.6 = 'B0YBKL' + @.7 = 557910 + @.8 = 'B0YBKR' + @.9 = 585284 + @.10 = 'B0YBKT' + @.11 = 'B00030' end -@abcU='ABCDEFGHIJKLMNOPQRSTUVWXYZ' /*the uppercase Latin alphabet. */ -alphaDigs='0123456789'@abcU /*legal chars, and then some. */ -allowable=space(translate(alphaDigs,,'AEIOU'),0) /*remove the vowels.*/ -weights=1317391 /*various weights for SEDOL chars*/ - /*an alternative would be to use:*/ - /* weights='1 3 1 7 3 9 1' if */ - /*any weights were greater than 9*/ - do j=1 while @.j\==''; sedol=@.j /*process each specified SEDOL. */ - L=length(sedol) - if L<6 | L>7 then call ser "SEDOL isn't a valid length" - if left(sedol,1)==9 then call swa 'SEDOL is reserved for end user allocation' - _=verify(sedol,allowable) - if _\==0 then call ser 'illegal character in SEDOL:' substr(sedol,_,1) - sum=0 /*checkDigit sum (so far). */ - do k=1 for 6 /*process each character in SEDOL*/ - sum=sum+(pos(substr(sedol,k,1),alphaDigs)-1)*substr(weights,k,1) - end /*k*/ + do j=1 while @.j\==''; sedol=@.j /*process each of the specified SEDOLs.*/ + L=length(sedol) + if L<6 | L>7 then call ser "SEDOL isn't a valid length" + if left(sedol,1)==9 then call swa 'SEDOL is reserved for end user allocation' + _=verify(sedol, allowable) + if _\==0 then call ser 'illegal character in SEDOL:' substr(sedol, _, 1) + sum=0 /*the checkDigit sum (so far). */ + do k=1 for 6 /*process each character in the SEDOL. */ + sum=sum + ( pos( substr(sedol, k, 1), alphaDigs) -1) * substr(weights, k, 1) + end /*k*/ - chkDig= (10-sum//10) // 10 - r=right(sedol,1) - if L==7 & chkDig\==r then call ser sedol,'invalid check digit:' r - say 'SEDOL:' left(sedol,9) 'SEDOL + check digit:' left(sedol,6)chkDig - end /*j*/ - -exit /*stick a fork in it, we're done.*/ -/*─────────────────────────────────────subroutines──────────────────────*/ -sed: say; say 'SEDOL:' sedol; say; return -ser: say; say '*** error! ***'; say; say arg(1); call sed; exit 13 -swa: say; say '*** warning! ***' arg(1); say; return + chkDig= (10-sum//10) // 10 + r=right(sedol, 1) + if L==7 & chkDig\==r then call ser sedol, 'invalid check digit:' r + say 'SEDOL:' left(sedol,15) 'SEDOL + check digit ───► ' left(sedol,6)chkDig + end /*j*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sed: say; say 'SEDOL:' sedol; say; return +ser: say; say '***error***' arg(1); call sed; exit 13 +swa: say; say '***warning***' arg(1); say; return diff --git a/Task/SHA-1/DWScript/sha-1.dw b/Task/SHA-1/DWScript/sha-1.dw new file mode 100644 index 0000000000..94f8d808c9 --- /dev/null +++ b/Task/SHA-1/DWScript/sha-1.dw @@ -0,0 +1 @@ +PrintLn( HashSHA1.HashData('Rosetta code') ); diff --git a/Task/SHA-1/Fortran/sha-1.f b/Task/SHA-1/Fortran/sha-1.f new file mode 100644 index 0000000000..65022c18e5 --- /dev/null +++ b/Task/SHA-1/Fortran/sha-1.f @@ -0,0 +1,96 @@ +module sha1_m + use kernel32 + use advapi32 + implicit none + integer, parameter :: SHA1LEN = 20 +contains + subroutine sha1hash(name, hash, dwStatus, filesize) + implicit none + character(*) :: name + integer, parameter :: BUFLEN = 32768 + integer(HANDLE) :: hFile, hProv, hHash + integer(DWORD) :: dwStatus, nRead + integer(BOOL) :: status + integer(BYTE) :: buffer(BUFLEN) + integer(BYTE) :: hash(SHA1LEN) + integer(UINT64) :: filesize + + dwStatus = 0 + filesize = 0 + hFile = CreateFile(trim(name) // char(0), GENERIC_READ, FILE_SHARE_READ, NULL, & + OPEN_EXISTING, FILE_FLAG_SEQUENTIAL_SCAN, NULL) + + if (hFile == INVALID_HANDLE_VALUE) then + dwStatus = GetLastError() + print *, "CreateFile failed." + return + end if + + if (CryptAcquireContext(hProv, NULL, NULL, PROV_RSA_FULL, & + CRYPT_VERIFYCONTEXT) == FALSE) then + + dwStatus = GetLastError() + print *, "CryptAcquireContext failed." + goto 3 + end if + + if (CryptCreateHash(hProv, CALG_SHA1, 0_ULONG_PTR, 0_DWORD, hHash) == FALSE) then + + dwStatus = GetLastError() + print *, "CryptCreateHash failed." + go to 2 + end if + + do + status = ReadFile(hFile, loc(buffer), BUFLEN, loc(nRead), NULL) + if (status == FALSE .or. nRead == 0) exit + filesize = filesize + nRead + if (CryptHashData(hHash, buffer, nRead, 0) == FALSE) then + dwStatus = GetLastError() + print *, "CryptHashData failed." + go to 1 + end if + end do + + if (status == FALSE) then + dwStatus = GetLastError() + print *, "ReadFile failed." + go to 1 + end if + + nRead = SHA1LEN + if (CryptGetHashParam(hHash, HP_HASHVAL, hash, nRead, 0) == FALSE) then + dwStatus = GetLastError() + print *, "CryptGetHashParam failed.", status, nRead, dwStatus + end if + + 1 status = CryptDestroyHash(hHash) + 2 status = CryptReleaseContext(hProv, 0) + 3 status = CloseHandle(hFile) + end subroutine +end module + +program sha1 + use sha1_m + implicit none + integer :: n, m, i, j + character(:), allocatable :: name + integer(DWORD) :: dwStatus + integer(BYTE) :: hash(SHA1LEN) + integer(UINT64) :: filesize + + n = command_argument_count() + do i = 1, n + call get_command_argument(i, length=m) + allocate(character(m) :: name) + call get_command_argument(i, name) + call sha1hash(name, hash, dwStatus, filesize) + if (dwStatus*0 == 0) then + do j = 1, SHA1LEN + write(*, "(Z2.2)", advance="NO") hash(j) + end do + write(*, "(' ',A,' (',G0,' bytes)')") name, filesize + end if + deallocate(name) + end do +end program diff --git a/Task/SHA-1/J/sha-1-1.j b/Task/SHA-1/J/sha-1-1.j index 1e843a5d7d..6e8f38ccd4 100644 --- a/Task/SHA-1/J/sha-1-1.j +++ b/Task/SHA-1/J/sha-1-1.j @@ -1,36 +1,4 @@ -pad=: ,1,(0#~512 | [: - 65 + #),(64#2)#:# - -f=:4 :0 - 'B C D'=: _32 ]\ y - if. x < 20 do. - (B*C)+.D>B - elseif. x < 40 do. - B~:C~:D - elseif. x < 60 do. - (B*C)+.(B*D)+.C*D - elseif. x < 80 do. - B~:C~:D - end. -) - -K=: ((32#2) #: 16b5a827999 16b6ed9eba1 16b8f1bbcdc 16bca62c1d6) {~ <.@%&20 - -plus=:+&.((32#2)&#.) - -H=: #: 16b67452301 16befcdab89 16b98badcfe 16b10325476 16bc3d2e1f0 - -process=:4 :0 - W=. (, [: , 1 |."#. _3 _8 _14 _16 ~:/@:{ ])^:64 x ]\~ _32 - 'A B C D E'=. y=._32[\,y - for_t. i.80 do. - TEMP=. (5|.A) plus (t f B,C,D) plus E plus (W{~t) plus K t - E=. D - D=. C - C=. 30 |. B - B=. A - A=. TEMP - end. - ,y plus A,B,C,D,:E -) - -sha1=: [:> [: process&.>/ (B + elseif. x < 40 do. + B~:C~:D + elseif. x < 60 do. + (B*C)+.(B*D)+.C*D + elseif. x < 80 do. + B~:C~:D + end. +) + +K=: ((32#2) #: 16b5a827999 16b6ed9eba1 16b8f1bbcdc 16bca62c1d6) {~ <.@%&20 + +plus=:+&.((32#2)&#.) + +H=: #: 16b67452301 16befcdab89 16b98badcfe 16b10325476 16bc3d2e1f0 + +process=:4 :0 + W=. (, [: , 1 |."#. _3 _8 _14 _16 ~:/@:{ ])^:64 x ]\~ _32 + 'A B C D E'=. y=._32[\,y + for_t. i.80 do. + TEMP=. (5|.A) plus (t f B,C,D) plus E plus (W{~t) plus K t + E=. D + D=. C + C=. 30 |. B + B=. A + A=. TEMP + end. + ,y plus A,B,C,D,:E +) + +sha1=: [:> [: process&.>/ ( "+b$) +Input() diff --git a/Task/SHA-1/S-lang/sha-1.slang b/Task/SHA-1/S-lang/sha-1.slang new file mode 100644 index 0000000000..e205df121c --- /dev/null +++ b/Task/SHA-1/S-lang/sha-1.slang @@ -0,0 +1,2 @@ +require("chksum"); +print(sha1sum("Rosetta Code")); diff --git a/Task/SHA-1/Scheme/sha-1-1.ss b/Task/SHA-1/Scheme/sha-1-1.ss index 9b21ce4141..f97f65242d 100644 --- a/Task/SHA-1/Scheme/sha-1-1.ss +++ b/Task/SHA-1/Scheme/sha-1-1.ss @@ -1,11 +1,3 @@ -(define-library (lib sha1) - (export - sha1:digest) - - (import (r5rs base) - (owl math) (owl list) (owl string) (owl list-extra)) -(begin - ; band - binary AND operation ; bor - binary OR operation ; bxor - binary XOR operation @@ -166,4 +158,3 @@ (->32 (+ C c)) (->32 (+ D d)) (->32 (+ E e))))))))) -)) diff --git a/Task/SHA-1/Scheme/sha-1-2.ss b/Task/SHA-1/Scheme/sha-1-2.ss index bae5015050..19c1704c51 100644 --- a/Task/SHA-1/Scheme/sha-1-2.ss +++ b/Task/SHA-1/Scheme/sha-1-2.ss @@ -1,4 +1,3 @@ -(import (lib sha1)) (define (->string value) (runes->string (let ((L "0123456789abcdef")) diff --git a/Task/SHA-256/00DESCRIPTION b/Task/SHA-256/00DESCRIPTION index 4e0bdf6ba6..e91c0e5110 100644 --- a/Task/SHA-256/00DESCRIPTION +++ b/Task/SHA-256/00DESCRIPTION @@ -1,3 +1,3 @@ -'''[[wp:SHA-256|SHA-256]]''' is the recommended stronger alternative to [[SHA-1]]. +'''[[wp:SHA-256|SHA-256]]''' is the recommended stronger alternative to [[SHA-1]]. See [http://nvlpubs.nist.gov/nistpubs/FIPS/NIST.FIPS.180-4.pdf FIPS PUB 180-4] for implementation details. Either by using a dedicated library or implementing the algorithm in your language, show that the SHA-256 digest of the string "Rosetta code" is: 764faf5c61ac315f1497f9dfa542713965b785e5cc2f707d6468d7d1124cdfcf diff --git a/Task/SHA-256/DWScript/sha-256.dw b/Task/SHA-256/DWScript/sha-256.dw new file mode 100644 index 0000000000..aeb8735b75 --- /dev/null +++ b/Task/SHA-256/DWScript/sha-256.dw @@ -0,0 +1 @@ +PrintLn( HashSHA256.HashData('Rosetta code') ); diff --git a/Task/SHA-256/Fortran/sha-256.f b/Task/SHA-256/Fortran/sha-256.f new file mode 100644 index 0000000000..cc23a1eb83 --- /dev/null +++ b/Task/SHA-256/Fortran/sha-256.f @@ -0,0 +1,98 @@ +module sha256_m + use kernel32 + use advapi32 + implicit none + integer, parameter :: SHA256LEN = 32 + integer(DWORD), parameter :: CALG_SHA_256 = 32780 + character(*), parameter :: MS_ENH_RSA_AES_PROV = "Microsoft Enhanced RSA and AES Cryptographic Provider"C +contains + subroutine sha256hash(name, hash, dwStatus, filesize) + implicit none + character(*) :: name + integer, parameter :: BUFLEN = 32768 + integer(HANDLE) :: hFile, hProv, hHash + integer(DWORD) :: dwStatus, nRead + integer(BOOL) :: status + integer(BYTE) :: buffer(BUFLEN) + integer(BYTE) :: hash(SHA256LEN) + integer(UINT64) :: filesize + + dwStatus = 0 + filesize = 0 + hFile = CreateFile(trim(name) // char(0), GENERIC_READ, FILE_SHARE_READ, NULL, & + OPEN_EXISTING, FILE_FLAG_SEQUENTIAL_SCAN, NULL) + + if (hFile == INVALID_HANDLE_VALUE) then + dwStatus = GetLastError() + print *, "CreateFile failed." + return + end if + + if (CryptAcquireContext(hProv, NULL, MS_ENH_RSA_AES_PROV, PROV_RSA_AES, & + CRYPT_VERIFYCONTEXT) == FALSE) then + + dwStatus = GetLastError() + print *, "CryptAcquireContext failed.", dwStatus + goto 3 + end if + + if (CryptCreateHash(hProv, CALG_SHA_256, 0_ULONG_PTR, 0_DWORD, hHash) == FALSE) then + + dwStatus = GetLastError() + print *, "CryptCreateHash failed." + go to 2 + end if + + do + status = ReadFile(hFile, loc(buffer), BUFLEN, loc(nRead), NULL) + if (status == FALSE .or. nRead == 0) exit + filesize = filesize + nRead + if (CryptHashData(hHash, buffer, nRead, 0) == FALSE) then + dwStatus = GetLastError() + print *, "CryptHashData failed." + go to 1 + end if + end do + + if (status == FALSE) then + dwStatus = GetLastError() + print *, "ReadFile failed." + go to 1 + end if + + nRead = SHA256LEN + if (CryptGetHashParam(hHash, HP_HASHVAL, hash, nRead, 0) == FALSE) then + dwStatus = GetLastError() + print *, "CryptGetHashParam failed." + end if + + 1 status = CryptDestroyHash(hHash) + 2 status = CryptReleaseContext(hProv, 0) + 3 status = CloseHandle(hFile) + end subroutine +end module + +program sha256 + use sha256_m + implicit none + integer :: n, m, i, j + character(:), allocatable :: name + integer(DWORD) :: dwStatus + integer(BYTE) :: hash(SHA256LEN) + integer(UINT64) :: filesize + + n = command_argument_count() + do i = 1, n + call get_command_argument(i, length=m) + allocate(character(m) :: name) + call get_command_argument(i, name) + call sha256hash(name, hash, dwStatus, filesize) + if (dwStatus*0 == 0) then + do j = 1, SHA256LEN + write(*, "(Z2.2)", advance="NO") hash(j) + end do + write(*, "(' ',A,' (',G0,' bytes)')") name, filesize + end if + deallocate(name) + end do +end program diff --git a/Task/SHA-256/J/sha-256-1.j b/Task/SHA-256/J/sha-256-1.j new file mode 100644 index 0000000000..d06b831681 --- /dev/null +++ b/Task/SHA-256/J/sha-256-1.j @@ -0,0 +1,2 @@ +require '~addons/ide/qt/qt.ijs' +getsha256=: 'sha256'&gethash_jqtide_ diff --git a/Task/SHA-256/J/sha-256-2.j b/Task/SHA-256/J/sha-256-2.j new file mode 100644 index 0000000000..3a7a430748 --- /dev/null +++ b/Task/SHA-256/J/sha-256-2.j @@ -0,0 +1,2 @@ + getsha256 'Rosetta code' +764faf5c61ac315f1497f9dfa542713965b785e5cc2f707d6468d7d1124cdfcf diff --git a/Task/SHA-256/Perl-6/sha-256.pl6 b/Task/SHA-256/Perl-6/sha-256.pl6 index 997da999f3..ef52b630b9 100644 --- a/Task/SHA-256/Perl-6/sha-256.pl6 +++ b/Task/SHA-256/Perl-6/sha-256.pl6 @@ -16,7 +16,7 @@ multi sha256(Blob $data) { constant K = init(* **(1/3))[^64]; my @b = flat $data.list, 0x80; push @b, 0 until (8 * @b - 448) %% 512; - push @b, reverse (8 * $data).polymod(256 xx 7); + push @b, slip reverse (8 * $data).polymod(256 xx 7); my @word = :256[@b.shift xx 4] xx @b/4; my @H = init(&sqrt)[^8]; @@ -40,5 +40,5 @@ multi sha256(Blob $data) { } @H [Z[m+]]= @h; } - return Blob.new: map { reverse .polymod(256 xx 3) }, @H; + return Blob.new: map { |reverse .polymod(256 xx 3) }, @H; } diff --git a/Task/SHA-256/PureBasic/sha-256.purebasic b/Task/SHA-256/PureBasic/sha-256.purebasic new file mode 100644 index 0000000000..4696946389 --- /dev/null +++ b/Task/SHA-256/PureBasic/sha-256.purebasic @@ -0,0 +1,8 @@ +a$="Rosetta code" +bit.i= 256 + +UseSHA2Fingerprint() : b$=StringFingerprint(a$, #PB_Cipher_SHA2, bit) + +OpenConsole() +Print("[SHA2 "+Str(bit)+" bit] Text: "+a$+" ==> "+b$) +Input() diff --git a/Task/Safe-addition/00DESCRIPTION b/Task/Safe-addition/00DESCRIPTION index 7e920c4d7e..4e577c7ca8 100644 --- a/Task/Safe-addition/00DESCRIPTION +++ b/Task/Safe-addition/00DESCRIPTION @@ -1,8 +1,24 @@ -Implementation of [[wp:Interval_arithmetic|interval arithmetic]] and more generally fuzzy number arithmetic require operations that yield safe upper and lower bounds of the exact result. For example, for an addition, it is the operations +↑ and +↓ defined as: ''a'' +↓ ''b'' ≤ ''a'' + ''b'' ≤ ''a'' +↑ ''b''. Additionally it is desired that the width of the interval (''a'' +↑ ''b'') - (''a'' +↓ ''b'') would be about the machine epsilon after removing the exponent part. +Implementation of   [[wp:Interval_arithmetic|interval arithmetic]]   and more generally fuzzy number arithmetic require operations that yield safe upper and lower bounds of the exact result. -Differently to the standard floating-point arithmetic, safe interval arithmetic is '''accurate''' (but still imprecise). I.e. the result of each defined operation contains (though does not identify) the exact mathematical outcome. +For example, for an addition, it is the operations   +↑   and   +↓   defined as:   ''a'' +↓ ''b'' ≤ ''a'' + ''b'' ≤ ''a'' +↑ ''b''. -Usually a [[wp:Floating_Point_Unit|FPU's]] have machine +,-,*,/ operations accurate within the machine precision. To illustrate it, let us consider a machine with decimal floating-point arithmetic that has the precision is 3 decimal points. If the result of the machine addition is 1.23, then the exact mathematical result is within the interval ]1.22, 1.24[. When the machine rounds towards zero, then the exact result is within [1.23,1.24[. This is the basis for an implementation of safe addition. +Additionally it is desired that the width of the interval   (''a'' +↑ ''b'') - (''a'' +↓ ''b'')   would be about the machine epsilon after removing the exponent part. -===Task=== -Show how +↓ and +↑ can be implemented in your language using the standard floating-point type. Define an interval type based on the standard floating-point one, and implement an interval-valued addition of two floating-point numbers considering them exact, in short an operation that yields the interval [''a'' +↓ ''b'', ''a'' +↑ ''b'']. +Differently to the standard floating-point arithmetic, safe interval arithmetic is '''accurate''' (but still imprecise). + +I.E.:   the result of each defined operation contains (though does not identify) the exact mathematical outcome. + +Usually a   [[wp:Floating_Point_Unit|FPU's]]   have machine   +,-,*,/   operations accurate within the machine precision. + +To illustrate it, let us consider a machine with decimal floating-point arithmetic that has the precision is '''3''' decimal points. + +If the result of the machine addition is   1.23,   then the exact mathematical result is within the interval   ]1.22, 1.24[. + +When the machine rounds towards zero, then the exact result is within   [1.23,1.24[.   This is the basis for an implementation of safe addition. + + +;Task; +Show how   +↓   and   +↑   can be implemented in your language using the standard floating-point type. + +Define an interval type based on the standard floating-point one,   and implement an interval-valued addition of two floating-point numbers considering them exact, in short an operation that yields the interval   [''a'' +↓ ''b'', ''a'' +↑ ''b'']. +

    diff --git a/Task/Scope-Function-names-and-labels/00DESCRIPTION b/Task/Scope-Function-names-and-labels/00DESCRIPTION index dbae0e9d5a..c07ccaecb5 100644 --- a/Task/Scope-Function-names-and-labels/00DESCRIPTION +++ b/Task/Scope-Function-names-and-labels/00DESCRIPTION @@ -1,5 +1,8 @@ -The task is to explain or demonstrate the levels of visibility of function names and labels within the language. +;Task: +Explain or demonstrate the levels of visibility of function names and labels within the language. -;See also + +;See also: * [[Variables]] for levels of scope relating to visibility of program variables * [[Scope modifiers]] for general scope modification facilities +

    diff --git a/Task/Scope-Function-names-and-labels/ALGOL-68/scope-function-names-and-labels.alg b/Task/Scope-Function-names-and-labels/ALGOL-68/scope-function-names-and-labels.alg new file mode 100644 index 0000000000..ca3470fd65 --- /dev/null +++ b/Task/Scope-Function-names-and-labels/ALGOL-68/scope-function-names-and-labels.alg @@ -0,0 +1,12 @@ +IF PROC x = ...; + ... +THEN + # can call x here # + PROC y = ...; + ... + GO TO l1 # invalid!! # +ELSE + # can call x here, but not y # + ... + l1: ... +FI diff --git a/Task/Scope-Function-names-and-labels/C/scope-function-names-and-labels.c b/Task/Scope-Function-names-and-labels/C/scope-function-names-and-labels.c index 327f7f17a9..72da19ffb9 100644 --- a/Task/Scope-Function-names-and-labels/C/scope-function-names-and-labels.c +++ b/Task/Scope-Function-names-and-labels/C/scope-function-names-and-labels.c @@ -1,44 +1,52 @@ -/*Abhishek Ghosh, 8th November 2013, Rotterdam*/ -#include +/* Abhishek Ghosh, 8th November 2013, Rotterdam */ +#include -#define sqr(x) x*x -#define greet printf("\nHello There !"); +#define sqr(x) ((x) * (x)) +#define greet printf("Hello There!\n") int twice(int x) { - return 2*x; + return 2 * x; } -int main() +int main(void) { int x; - printf("\nThis will demonstrate function and label scopes."); - printf("\nAll output is happening throung printf(), a function declared in the header file stdio.h, which is external to this program."); - printf("\nEnter a number : "); - scanf("%d",&x); + + printf("This will demonstrate function and label scopes.\n"); + printf("All output is happening throung printf(), a function declared in the header stdio.h, which is external to this program.\n"); + printf("Enter a number: "); + if (scanf("%d", &x) != 1) + return 0; - switch(x%2){ - default:printf("\nCase labels in switch statements have scope local to the switch block."); - case 0: printf("\nYou entered an even number."); - printf("\nIt's square is %d, which was computed by a macro. It has global scope within the program file.",sqr(x)); - break; - case 1: printf("\nYou entered an odd number."); - goto sayhello; - jumpin: printf("\n2 times %d is %d, which was computed by a function defined in this file. It has global scope within the program file.",x,twice(x)); - printf("\nSince you jumped in, you will now be greeted, again !"); - sayhello: greet - if(x==-1)goto scram; - break; - }; - - printf("\nWe now come to goto, it's extremely powerful but it's also prone to misuse. It's use is discouraged and it wasn't even adopted by Java and later languages."); - - if(x!=-1){ - x = -1; /*To break goto infinite loop.*/ - goto jumpin; - } - - scram: printf("\nIf you are trying to figure out what happened, you now understand goto."); - return 0; + switch (x % 2) { + default: + printf("Case labels in switch statements have scope local to the switch block.\n"); + case 0: + printf("You entered an even number.\n"); + printf("Its square is %d, which was computed by a macro. It has global scope within the translation unit.\n", sqr(x)); + break; + case 1: + printf("You entered an odd number.\n"); + goto sayhello; + jumpin: + printf("2 times %d is %d, which was computed by a function defined in this file. It has global scope within the translation unit.\n", x, twice(x)); + printf("Since you jumped in, you will now be greeted, again!\n"); + sayhello: + greet; + if (x == -1) + goto scram; + break; + } + + printf("We now come to goto, it's extremely powerful but it's also prone to misuse. Its use is discouraged and it wasn't even adopted by Java and later languages.\n"); + + if (x != -1) { + x = -1; /* To break goto infinite loop. */ + goto jumpin; + } + +scram: + printf("If you are trying to figure out what happened, you now understand goto.\n"); + return 0; } - diff --git a/Task/Scope-Function-names-and-labels/J/scope-function-names-and-labels-1.j b/Task/Scope-Function-names-and-labels/J/scope-function-names-and-labels-1.j new file mode 100644 index 0000000000..c7e08147b1 --- /dev/null +++ b/Task/Scope-Function-names-and-labels/J/scope-function-names-and-labels-1.j @@ -0,0 +1 @@ + a=. 1 diff --git a/Task/Scope-Function-names-and-labels/J/scope-function-names-and-labels-2.j b/Task/Scope-Function-names-and-labels/J/scope-function-names-and-labels-2.j new file mode 100644 index 0000000000..a8bb959ce3 --- /dev/null +++ b/Task/Scope-Function-names-and-labels/J/scope-function-names-and-labels-2.j @@ -0,0 +1 @@ + b=: 2 diff --git a/Task/Scope-Function-names-and-labels/J/scope-function-names-and-labels-3.j b/Task/Scope-Function-names-and-labels/J/scope-function-names-and-labels-3.j new file mode 100644 index 0000000000..12006e06e1 --- /dev/null +++ b/Task/Scope-Function-names-and-labels/J/scope-function-names-and-labels-3.j @@ -0,0 +1,5 @@ + c_thingy_=: 3 + d=: <'test' + e__d=: 4 + b + e_test_ +6 diff --git a/Task/Scope-Function-names-and-labels/J/scope-function-names-and-labels-4.j b/Task/Scope-Function-names-and-labels/J/scope-function-names-and-labels-4.j new file mode 100644 index 0000000000..6f117d0995 --- /dev/null +++ b/Task/Scope-Function-names-and-labels/J/scope-function-names-and-labels-4.j @@ -0,0 +1,8 @@ +verb define '' + f=. 6 + g=: 7 + g=. 8 + g=: 9 +) +|domain error +| g =:9 diff --git a/Task/Scope-Function-names-and-labels/PowerShell/scope-function-names-and-labels-1.psh b/Task/Scope-Function-names-and-labels/PowerShell/scope-function-names-and-labels-1.psh new file mode 100644 index 0000000000..c7ec63f2b1 --- /dev/null +++ b/Task/Scope-Function-names-and-labels/PowerShell/scope-function-names-and-labels-1.psh @@ -0,0 +1,4 @@ +function global:Get-DependentService +{ + Get-Service | Where-Object {$_.DependentServices} +} diff --git a/Task/Scope-Function-names-and-labels/PowerShell/scope-function-names-and-labels-2.psh b/Task/Scope-Function-names-and-labels/PowerShell/scope-function-names-and-labels-2.psh new file mode 100644 index 0000000000..84e8c4ef42 --- /dev/null +++ b/Task/Scope-Function-names-and-labels/PowerShell/scope-function-names-and-labels-2.psh @@ -0,0 +1 @@ +Get-Help about_Scopes diff --git a/Task/Scope-Function-names-and-labels/REXX/scope-function-names-and-labels.rexx b/Task/Scope-Function-names-and-labels/REXX/scope-function-names-and-labels.rexx index 951ca0d30b..e02a48838f 100644 --- a/Task/Scope-Function-names-and-labels/REXX/scope-function-names-and-labels.rexx +++ b/Task/Scope-Function-names-and-labels/REXX/scope-function-names-and-labels.rexx @@ -1,17 +1,15 @@ -/*REXX program demonstrates use of labels and a CALL statement. */ -zz=4 -signal do_add /*transfer program control to a label.*/ -ttt=sinD(30) /*this REXX statement is never executed.*/ - /* [↓] Note the case doesn't matter. */ -do_Add: /*coming here from the SIGNAL statement.*/ +/*REXX program demonstrates the use of labels and also a CALL statement. */ +blarney = -0 /*just a blarney & balderdash statement*/ +signal do_add /*transfer program control to a label.*/ +ttt = sinD(30) /*this REXX statement is never executed*/ + /* [↓] Note the case doesn't matter. */ +DO_Add: /*coming here from the SIGNAL statement*/ say 'calling the sub: add.2.args' -call add.2.args 1,7 /*pass two arguments: 1 and a 7 */ -say 'sum =' result -exit /*stick a fork in it, 'cause we're done.*/ -/*────────────────────────────────subroutines (or functions)────────────*/ -add.2.args: procedure; parse arg x,y; return x+y - -add.2.args: say 'Whoa Nelly!! Has the universe run amok?' - /* [↑] dead code, never XEQed*/ -add.2.args: return arg(1) + arg(2) /*concise, but never executed.*/ +call add.2.args 1, 7 /*pass two arguments: 1 and a 7 */ +say 'sum =' result /*display the result from the function.*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +add.2.args: procedure; parse arg x,y; return x+y /*first come, first served ···*/ +add.2.args: say 'Whoa Nelly!! Has the universe run amok?' /*didactic, but never executed*/ +add.2.args: return arg(1) + arg(2) /*concise, " " " */ diff --git a/Task/Search-a-list/00DESCRIPTION b/Task/Search-a-list/00DESCRIPTION index cdb83ba451..fa0507a16a 100644 --- a/Task/Search-a-list/00DESCRIPTION +++ b/Task/Search-a-list/00DESCRIPTION @@ -1,4 +1,17 @@ -Find the index of a string (needle) in an indexable, ordered collection of strings (haystack). Raise an exception if the needle is missing. +{{task heading}} + +Find the index of a string (needle) in an indexable, ordered collection of strings (haystack). + +Raise an exception if the needle is missing. + If there is more than one occurrence then return the smallest index to the needle. -As an extra task, return the largest index to a needle that has multiple occurrences in the haystack. +{{task heading|Extra credit}} + +Return the largest index to a needle that has multiple occurrences in the haystack. + +{{task heading|See also}} + +* [[Search a list of records]] + +
    diff --git a/Task/Search-a-list/C++/search-a-list.cpp b/Task/Search-a-list/C++/search-a-list-1.cpp similarity index 100% rename from Task/Search-a-list/C++/search-a-list.cpp rename to Task/Search-a-list/C++/search-a-list-1.cpp diff --git a/Task/Search-a-list/C++/search-a-list-2.cpp b/Task/Search-a-list/C++/search-a-list-2.cpp new file mode 100644 index 0000000000..b6502499d2 --- /dev/null +++ b/Task/Search-a-list/C++/search-a-list-2.cpp @@ -0,0 +1,106 @@ +/* new c++-11 features + * list class + * initialization strings + * auto typing + * lambda functions + * noexcept + * find + * for/in loop + */ + +#include // std::cout, std::endl +#include // std::find +#include // std::list +#include // std::vector +#include // string::basic_string + + +using namespace std; // saves typing of "std::" before everything + +int main() +{ + + // initialization lists + // create objects and fully initialize them with given values + + list l { "Zig", "Zag", "Wally", "Homer", "Madge", + "Watson", "Ronald", "Bush", "Krusty", "Charlie", + "Bush", "Bush", "Boz", "Zag" }; + + list n { "Bush" , "Obama", "Homer", "Sherlock" }; + + + // lambda function with auto typing + // auto is easier to write than looking up the compicated + // specialized iterator type that is actually returned. + // Just know that it returns an iterator for the list at the position found, + // or throws an exception if s in not in the list. + // runtime_error is used because it can be initialized with a message string. + + auto contains = [](list l, string s) throw(runtime_error) + { + auto r = find(begin(l), end(l), s ); + + if ( r == end(l) ) throw runtime_error( s + " not found" ); + + return r; + }; + + + // returns an int vector with the indexes of the search string + // The & is a "default capture" meaning that it "allows in" + // the variables that are in scope where it is called by their + // name to simplify things. + + auto index = [&](list l, string s) noexcept + { + vector index_v; + + int idx = 0; + + for(auto& r : l) + { + if ( s.compare(r) == 0 ) index_v.push_back(idx); // match -- add to vector + idx++; + } + + // even though index_v is local to the lambda function, + // c++11 move semantics does what you want and returns it + // live and intact instead of destroying it or returning a copy. + // (very efficient for large objects!) + return index_v; + }; + + + + // for/in loop + for (const string& s : n) // new iteration syntax is simple and intuitive + { + try + { + + auto cont = contains( l , s); // checks if there is any match + + vector vf = index( l, s ); + + cout << "l contains: " << s << " at " ; + + for (auto x : vf) + { cout << x << " "; } // if vector is empty this doesn't run + + cout << endl ; + + } + catch (const runtime_error& r) // string not found + { + cout << r.what() << endl; + continue; // try next string + } + } //for + + + return 0; + +} // main + +/* end */ diff --git a/Task/Search-a-list/Elena/search-a-list.elena b/Task/Search-a-list/Elena/search-a-list.elena new file mode 100644 index 0000000000..5e8e986c1e --- /dev/null +++ b/Task/Search-a-list/Elena/search-a-list.elena @@ -0,0 +1,17 @@ +#import system. +#import system'routines. +#import extensions. + +#symbol program = +[ + #var haystack := ("Zig", "Zag", "Wally", "Ronald", "Bush", "Krusty", "Charlie", "Bush", "Bozo"). + + ("Washington", "Bush") run &each: needle + [ + #var index := haystack indexOf:needle. + + (index == -1) + ? [ console writeLine:needle:" is not in haystack" ] + ! [ console writeLine:index:" ":needle ]. + ]. +]. diff --git a/Task/Search-a-list/Io/search-a-list.io b/Task/Search-a-list/Io/search-a-list.io new file mode 100644 index 0000000000..9f974b6063 --- /dev/null +++ b/Task/Search-a-list/Io/search-a-list.io @@ -0,0 +1,26 @@ +NotFound := Exception clone +List firstIndex := method(obj, + indexOf(obj) ifNil(NotFound raise) +) +List lastIndex := method(obj, + reverseForeach(i,v, + if(v == obj, return i) + ) + NotFound raise +) + +haystack := list("Zig","Zag","Wally","Ronald","Bush","Krusty","Charlie","Bush","Bozo") +list("Washington","Bush") foreach(needle, + try( + write("firstIndex(\"",needle,"\"): ") + writeln(haystack firstIndex(needle)) + )catch(NotFound, + writeln(needle," is not in haystack") + )pass + try( + write("lastIndex(\"",needle,"\"): ") + writeln(haystack lastIndex(needle)) + )catch(NotFound, + writeln(needle," is not in haystack") + )pass +) diff --git a/Task/Search-a-list/Perl-6/search-a-list-1.pl6 b/Task/Search-a-list/Perl-6/search-a-list-1.pl6 new file mode 100644 index 0000000000..b235a31f3f --- /dev/null +++ b/Task/Search-a-list/Perl-6/search-a-list-1.pl6 @@ -0,0 +1,5 @@ +my @haystack = ; + +for -> $needle { + say "$needle -- { @haystack.first($needle, :k) // 'not in haystack' }"; +} diff --git a/Task/Search-a-list/Perl-6/search-a-list-2.pl6 b/Task/Search-a-list/Perl-6/search-a-list-2.pl6 new file mode 100644 index 0000000000..f205aff3b6 --- /dev/null +++ b/Task/Search-a-list/Perl-6/search-a-list-2.pl6 @@ -0,0 +1,13 @@ +my Str @haystack = ; + +for -> $needle { + my $first = @haystack.first($needle, :k); + + if defined $first { + my $last = @haystack.first($needle, :k, :end); + say "$needle -- first at $first, last at $last"; + } + else { + say "$needle -- not in haystack"; + } +} diff --git a/Task/Search-a-list/Perl-6/search-a-list-3.pl6 b/Task/Search-a-list/Perl-6/search-a-list-3.pl6 new file mode 100644 index 0000000000..bc73746884 --- /dev/null +++ b/Task/Search-a-list/Perl-6/search-a-list-3.pl6 @@ -0,0 +1,8 @@ +my @haystack = ; + +my %index; +%index{.value} //= .key for @haystack.pairs; + +for -> $needle { + say "$needle -- { %index{$needle} // 'not in haystack' }"; +} diff --git a/Task/Search-a-list/Perl-6/search-a-list.pl6 b/Task/Search-a-list/Perl-6/search-a-list.pl6 deleted file mode 100644 index de1794c6f2..0000000000 --- a/Task/Search-a-list/Perl-6/search-a-list.pl6 +++ /dev/null @@ -1,20 +0,0 @@ -sub find ($matcher, $container) { - for $container.kv -> $k, $v { - $v ~~ $matcher and return $k; - } - fail 'No values matched'; -} - -my Str @haystack = ; - -for -> $needle { - my $pos = find $needle, @haystack; - if defined $pos { - say "Found '$needle' at index $pos"; - say 'Largest index: ', @haystack.end - - find { $needle eq $^x }, reverse @haystack; - } - else { - say "'$needle' not in haystack"; - } -} diff --git a/Task/Search-a-list/PowerShell/search-a-list.psh b/Task/Search-a-list/PowerShell/search-a-list-1.psh similarity index 100% rename from Task/Search-a-list/PowerShell/search-a-list.psh rename to Task/Search-a-list/PowerShell/search-a-list-1.psh diff --git a/Task/Search-a-list/PowerShell/search-a-list-2.psh b/Task/Search-a-list/PowerShell/search-a-list-2.psh new file mode 100644 index 0000000000..9c6a36935b --- /dev/null +++ b/Task/Search-a-list/PowerShell/search-a-list-2.psh @@ -0,0 +1,57 @@ +function Find-Needle +{ + [CmdletBinding()] + [OutputType([int])] + Param + ( + [Parameter(Mandatory=$true, Position=0)] + [string] + $Needle, + + [Parameter(Mandatory=$true, Position=1)] + [string[]] + $Haystack, + + [switch] + $LastIndex + ) + + if ($LastIndex) + { + $index = [Array]::LastIndexOf($Haystack,$Needle) + + if ($index -eq -1) + { + Write-Verbose "Needle not found in Haystack" + return $index + } + + if ((($Haystack | Group-Object | Where-Object Count -GT 1).Group).IndexOf($Needle) -ne -1) + { + Write-Verbose "Last needle found in Haystack at index $index" + } + else + { + Write-Verbose "Needle found in Haystack at index $index (No duplicates were found)" + } + + return $index + } + else + { + $index = [Array]::IndexOf($Haystack,$Needle) + + if ($index -eq -1) + { + Write-Verbose "Needle not found in Haystack" + } + else + { + Write-Verbose "Needle found in Haystack at index $index" + } + + return $index + } +} + +$haystack = @("word", "phrase", "preface", "title", "house", "line", "chapter", "page", "book", "house") diff --git a/Task/Search-a-list/PowerShell/search-a-list-3.psh b/Task/Search-a-list/PowerShell/search-a-list-3.psh new file mode 100644 index 0000000000..a17a1b0b44 --- /dev/null +++ b/Task/Search-a-list/PowerShell/search-a-list-3.psh @@ -0,0 +1 @@ +Find-Needle "house" $haystack diff --git a/Task/Search-a-list/PowerShell/search-a-list-4.psh b/Task/Search-a-list/PowerShell/search-a-list-4.psh new file mode 100644 index 0000000000..ed9cfa47e2 --- /dev/null +++ b/Task/Search-a-list/PowerShell/search-a-list-4.psh @@ -0,0 +1 @@ +Find-Needle "house" $haystack -Verbose diff --git a/Task/Search-a-list/PowerShell/search-a-list-5.psh b/Task/Search-a-list/PowerShell/search-a-list-5.psh new file mode 100644 index 0000000000..e72783d70c --- /dev/null +++ b/Task/Search-a-list/PowerShell/search-a-list-5.psh @@ -0,0 +1 @@ +Find-Needle "house" $haystack -LastIndex -Verbose diff --git a/Task/Search-a-list/PowerShell/search-a-list-6.psh b/Task/Search-a-list/PowerShell/search-a-list-6.psh new file mode 100644 index 0000000000..487cf0448e --- /dev/null +++ b/Task/Search-a-list/PowerShell/search-a-list-6.psh @@ -0,0 +1 @@ +Find-Needle "title" $haystack -LastIndex -Verbose diff --git a/Task/Search-a-list/PowerShell/search-a-list-7.psh b/Task/Search-a-list/PowerShell/search-a-list-7.psh new file mode 100644 index 0000000000..5d0b1abaa6 --- /dev/null +++ b/Task/Search-a-list/PowerShell/search-a-list-7.psh @@ -0,0 +1 @@ +Find-Needle "something" $haystack -Verbose diff --git a/Task/Search-a-list/REXX/search-a-list-1.rexx b/Task/Search-a-list/REXX/search-a-list-1.rexx index 56cb3c73d5..2942696a3b 100644 --- a/Task/Search-a-list/REXX/search-a-list-1.rexx +++ b/Task/Search-a-list/REXX/search-a-list-1.rexx @@ -1,5 +1,5 @@ -/*REXX program searches a collection of strings. */ -hay.= /*initialize haystack collection.*/ +/*REXX program searches a collection of strings (an array of periodic table elements).*/ +hay.= /*initialize the haystack collection. */ hay.1 = 'sodium' hay.2 = 'phosphorous' hay.3 = 'californium' @@ -13,18 +13,17 @@ hay.10 = 'copper' hay.11 = 'helium' hay.12 = 'sulfur' -needle='gold' /*we'll be looking for the gold. */ -upper needle /*in case some people capitalize.*/ -found=0 /*assume needle isn't found yet. */ +needle = 'gold' /*we'll be looking for the gold. */ +upper needle /*in case some people capitalize stuff.*/ +found=0 /*assume the needle isn't found yet. */ - do j=1 while hay.j\=='' /*keep looking in haystack. */ - _=hay.j; upper _ /*make it uppercase to be safe. */ - if _=needle then do /*we've found needle in haystack.*/ - found=1 /*indicate that needle was found,*/ - leave /* and stop looking, of course. */ + do j=1 while hay.j\=='' /*keep looking in the haystack. */ + _=hay.j; upper _ /*make it uppercase to be safe. */ + if _=needle then do; found=1 /*we've found the needle in haystack. */ + leave /* ··· and stop looking, of course. */ end end /*j*/ -if found then return j /*return haystack index number. */ +if found then return j /*return the haystack index number. */ else say needle "wasn't found in the haystack!" -return 0 /*indicates needle wasn't found. */ +return 0 /*indicates the needle wasn't found. */ diff --git a/Task/Search-a-list/REXX/search-a-list-2.rexx b/Task/Search-a-list/REXX/search-a-list-2.rexx index 3796ba7bcb..5b7d5f3701 100644 --- a/Task/Search-a-list/REXX/search-a-list-2.rexx +++ b/Task/Search-a-list/REXX/search-a-list-2.rexx @@ -1,6 +1,6 @@ -/*REXX program searches a collection of strings. */ -hay.0=1000 /*safely indicate highest item #.*/ -hay.200 = 'binilnilium' +/*REXX program searches a collection of strings (an array of periodic table elements).*/ +hay.0 = 1000 /*safely indicate highest item number. */ +hay.200 = 'Binilnilium' hay.98 = 'californium' hay.6 = 'carbon' hay.112 = 'copernicium' @@ -17,28 +17,18 @@ hay.11 = 'sodium' hay.16 = 'sulfur' hay.81 = 'thallium' hay.92 = 'uranium' + /* [↑] sorted by the element name. */ +needle = 'gold' /*we'll be looking for the gold. */ +upper needle /*in case some people capitalize. */ +found=0 /*assume the needle isn't found (yet).*/ -needle = 'gold' /*we'll be looking for the gold. */ -upper needle /*in case some people capitalize.*/ -found=0 /*assume needle isn't found, yet.*/ - - do j=1 for hay.0 /*start looking in haystack item1*/ - _=hay.j; upper _ /*make it uppercase to be safe. */ - if _=needle then do /*we've found needle in haystack.*/ - found=1 /*indicate that needle was found,*/ - leave /* and stop looking, of course. */ + do j=1 for hay.0 /*start looking in haystack, item 1. */ + _=hay.j; upper _ /*make it uppercase just to be safe. */ + if _=needle then do; found=1 /*we've found the needle in haystack. */ + leave /* ··· and stop looking, of course. */ end end /*j*/ -if found then return j /*return haystack index number. */ +if found then return j /*return the haystack index number. */ else say needle "wasn't found in the haystack!" -return 0 /*indicates needle wasn't found. */ - -/*─────────────────────────────────────────────── incidentally, to find */ - /* the number of haystack items: */ -hayItems=0 - - do k=1 for hay.0 /*find item AFTER the last item.*/ - if hay.k\=='' then hayItems=hayItems+1 /*bump the item counter.*/ - end /*k*/ - /*stick a fork in it, we're done.*/ +return 0 /*indicates the needle wasn't found. */ diff --git a/Task/Search-a-list/REXX/search-a-list-3.rexx b/Task/Search-a-list/REXX/search-a-list-3.rexx index 6ac0973e04..1a305d1ffe 100644 --- a/Task/Search-a-list/REXX/search-a-list-3.rexx +++ b/Task/Search-a-list/REXX/search-a-list-3.rexx @@ -1,29 +1,29 @@ -/*REXX program searches a collection of strings. */ -hay.=0 /*initialize haystack collection.*/ -hay._sodium = 1 -hay._phosphorous = 1 -hay._califonium = 1 -hay._copernicium = 1 -hay._gold = 1 -hay._thallium = 1 -hay._carbon = 1 -hay._silver = 1 -hay._copper = 1 -hay._helium = 1 -hay._sulfur = 1 - /*underscores (_) are used to NOT*/ - /* conflict with variable names.*/ +/*REXX program searches a collection of strings (an array of periodic table elements).*/ +hay.=0 /*initialize the haystack collection. */ +hay._sodium = 1 +hay._phosphorous = 1 +hay._californium = 1 +hay._copernicium = 1 +hay._gold = 1 +hay._thallium = 1 +hay._carbon = 1 +hay._silver = 1 +hay._copper = 1 +hay._helium = 1 +hay._sulfur = 1 + /*underscores (_) are used to NOT ... */ + /* ... conflict with variable names. */ -needle = 'gold' /*we'll be looking for the gold. */ +needle = 'gold' /*we'll be looking for the gold. */ -Xneedle = '_'needle /*prefix an underscore (_) char. */ -upper Xneedle /*uppercase: how REXX stores 'em.*/ +Xneedle = '_'needle /*prefix an underscore (_) character. */ +upper Xneedle /*uppercase: how REXX stores them. */ - /*alternative version of above, */ - /* Xneedle=translate('_'needle)*/ + /*alternative version of above: */ + /* Xneedle=translate('_'needle) */ -found=hay.Xneedle /*this is it, it's found or not.*/ +found=hay.Xneedle /*this is it, it's found (or maybe not)*/ -if found then return j /*return haystack index number. */ +if found then return j /*return the haystack index number. */ else say needle "wasn't found in the haystack!" -return 0 /*indicates needle wasn't found. */ +return 0 /*indicates the needle wasn't found. */ diff --git a/Task/Search-a-list/REXX/search-a-list-4.rexx b/Task/Search-a-list/REXX/search-a-list-4.rexx index b805f349e0..02d8809a52 100644 --- a/Task/Search-a-list/REXX/search-a-list-4.rexx +++ b/Task/Search-a-list/REXX/search-a-list-4.rexx @@ -1,24 +1,21 @@ -/*REXX program searches a collection of strings. */ +/*REXX program searches a collection of strings (an array of periodic table elements).*/ -haystack=, /*names of the first 200 elements of the periodic table*/ - 'hydrogen helium lithium berylliumbon nitrogen oxygen fluorine neon sodium magnesium aluminum silicon phosphorous sulfur chlorine argon potassium calcium scandium titanium', - 'vanadium chromium manganese iron kel copper zinc gallium germanium arsenic selenium bromine krypton rubidium strontium yttrium zirconium niobium molybdenum technetium ruthenium', - 'rhodium palladium silver cadmium antimony tellurium iodine xenon cesium barium lanthanum cerium praseodymium neodymium promethium samarium europium gadolinium terbium dysprosium', - 'holmium erbium thulium ytterbium afnium tantalum tungsten rhenium osmium irdium platinum gold mercury thallium lead bismuth polonium astatine radon francium radium actinium', - 'thorium protactinium uranium neptonium americium curium berkelium californium einsteinum fermium mendelevium nobelium lawrencium rutherfordium dubnium seaborgium bohrium hassium', - 'meitnerium darmstadtium roentgenicium ununtrium flerovium ununpentium livermorium ununseptium ununoctium ununennium unbinilium unbiunium unbibium unbitrium unbiquadium', - 'unbipentium unbihexium unbiseptiuum unbiennium untrinilium untriunium untribium untritrium untriquadium untripentium untrihexium untriseptium untrioctium untriennium unquadnilium', - 'unquadunium unquadbium unquadtriuadium unquadpentium unquadhexium unquadseptium unquadoctium unquadennium unpentnilium unpentunium unpentbium unpenttrium unpentquadium', - 'unpentpentium unpenthexium unpentpentoctium unpentennium unhexnilium unhexunium unhexbium unhextrium unhexquadium unhexpentium unhexhexium unhexseptium unhexoctium unhexennium', - 'unseptnilium unseptunium unseptbirium unseptquadium unseptpentium unsepthexium unseptseptium unseptoctium unseptennium unoctnilium unoctunium unoctbium unocttrium unoctquadium', - 'unoctpentium unocthexium unoctsepoctium unoctennium unennilium unennunium unennbium unenntrium unennquadium unennpentium unennhexium unennseptium unennoctium unennennium binilnilium' +haystack=, /*names of the first 200 elements of the periodic table*/ + 'hydrogen helium lithium beryllium boron carbon nitrogen oxygen fluorine neon sodium magnesium aluminum silicon phosphorous sulfur chlorine argon potassium calcium scandium titanium', + 'vanadium chromium manganese iron cobalt nickel copper zinc gallium germanium arsenic selenium bromine krypton rubidium strontium yttrium zirconium niobium molybdenum technetium ruthenium', + 'rhodium palladium silver cadmium indium tin antimony tellurium iodine xenon cesium barium lanthanum cerium praseodymium neodymium promethium samarium europium gadolinium terbium dysprosium', + 'holmium erbium thulium ytterbium lutetium hafnium tantalum tungsten rhenium osmium iridium platinum gold mercury thallium lead bismuth polonium astatine radon francium radium actinium', + 'thorium protactinium uranium neptunium plutonium americium curium berkelium californium einsteinium fermium mendelevium nobelium lawrencium rutherfordium dubnium seaborgium bohrium hassium', + 'meitnerium darmstadtium roentgenium copernicium Ununtrium flerovium Ununpentium livermorium Ununseptium Ununoctium Ununennium Unbinilium Unbiunium Unbibium Unbitrium Unbiquadium', + 'Unbipentium Unbihexium Unbiseptium Unbioctium Unbiennium Untrinilium Untriunium Untribium Untritrium Untriquadium Untripentium Untrihexium Untriseptium Untrioctium Untriennium Unquadnilium', + 'Unquadunium Unquadbium Unquadtrium Unquadquadium Unquadpentium Unquadhexium Unquadseptium Unquadoctium Unquadennium Unpentnilium Unpentunium Unpentbium Unpenttrium Unpentquadium', + 'Unpentpentium Unpenthexium Unpentseptium Unpentoctium Unpentennium Unhexnilium Unhexunium Unhexbium Unhextrium Unhexquadium Unhexpentium Unhexhexium Unhexseptium Unhexoctium Unhexennium', + 'Unseptnilium Unseptunium Unseptbium Unsepttrium Unseptquadium Unseptpentium Unsepthexium Unseptseptium Unseptoctium Unseptennium Unoctnilium Unoctunium Niobium Unocttrium Unoctquadium', + 'Unoctpentium Unocthexium Unoctseptium Unoctoctium Unoctennium Unennilium Unennunium Unennbium Unenntrium Unennquadium Unennpentium Unennhexium Unennseptium Unennoctium Unennennium Binilnilium' -needle = 'gold' /*we'll be looking for the gold. */ - -upper needle haystack /*in case some people capitalize.*/ - -idx=wordpos(needle,haystack) /*use REXX's bif: WORDPOS */ - /* bif: built-in function.*/ -if idx\==0 then return idx /*return haystack index number. */ +needle = 'gold' /*we'll be looking for the gold. */ +upper needle haystack /*in case some people capitalize stuff. */ +idx=wordpos(needle,haystack) /*use REXX's BIF: WORDPOS */ +if idx\==0 then return idx /*return the haystack index number. */ else say needle "wasn't found in the haystack!" -return 0 /*indicates needle wasn't found. */ +return 0 /*indicates the needle wasn't found. */ diff --git a/Task/Secure-temporary-file/00DESCRIPTION b/Task/Secure-temporary-file/00DESCRIPTION index 8bb90b7a3b..2bfa706930 100644 --- a/Task/Secure-temporary-file/00DESCRIPTION +++ b/Task/Secure-temporary-file/00DESCRIPTION @@ -1 +1,7 @@ -Create a temporary file, '''securely and exclusively''' (opening it such that there are no possible [[race condition|race conditions]]). It's fine assuming local filesystem semantics (NFS or other networking filesystems can have signficantly more complicated semantics for satisfying the "no race conditions" criteria). The function should automatically resolve name collisions and should only fail in cases where permission is denied, the filesystem is read-only or full, or similar conditions exist (returning an error or raising an exception as appropriate to the language/environment). +;Task: +Create a temporary file, '''securely and exclusively''' (opening it such that there are no possible [[race condition|race conditions]]). + +It's fine assuming local filesystem semantics (NFS or other networking filesystems can have signficantly more complicated semantics for satisfying the "no race conditions" criteria). + +The function should automatically resolve name collisions and should only fail in cases where permission is denied, the filesystem is read-only or full, or similar conditions exist (returning an error or raising an exception as appropriate to the language/environment). +

    diff --git a/Task/Secure-temporary-file/Fortran/secure-temporary-file.f b/Task/Secure-temporary-file/Fortran/secure-temporary-file.f new file mode 100644 index 0000000000..a0a0918f45 --- /dev/null +++ b/Task/Secure-temporary-file/Fortran/secure-temporary-file.f @@ -0,0 +1 @@ + OPEN (F,STATUS = 'SCRATCH') !Temporary disc storage. diff --git a/Task/Secure-temporary-file/Go/secure-temporary-file.go b/Task/Secure-temporary-file/Go/secure-temporary-file.go new file mode 100644 index 0000000000..aa03714f37 --- /dev/null +++ b/Task/Secure-temporary-file/Go/secure-temporary-file.go @@ -0,0 +1,32 @@ +package main + +import ( + "fmt" + "io/ioutil" + "log" + "os" +) + +func main() { + f, err := ioutil.TempFile("", "foo") + if err != nil { + log.Fatal(err) + } + defer f.Close() + + // We need to make sure we remove the file + // once it is no longer needed. + defer os.Remove(f.Name()) + + // … use the file via 'f' … + fmt.Fprintln(f, "Using temporary file:", f.Name()) + f.Seek(0, 0) + d, err := ioutil.ReadAll(f) + if err != nil { + log.Fatal(err) + } + fmt.Printf("Wrote and read: %s\n", d) + + // The defer statements above will close and remove the + // temporary file here (or on any return of this function). +} diff --git a/Task/Secure-temporary-file/Groovy/secure-temporary-file.groovy b/Task/Secure-temporary-file/Groovy/secure-temporary-file.groovy index 69ceccb281..fc4f315d4d 100644 --- a/Task/Secure-temporary-file/Groovy/secure-temporary-file.groovy +++ b/Task/Secure-temporary-file/Groovy/secure-temporary-file.groovy @@ -1,3 +1,6 @@ def file = File.createTempFile( "xxx", ".txt" ) -file.deleteOnExit() + +// There is no requirement in the instructions to delete the file. +//file.deleteOnExit() + println file diff --git a/Task/Secure-temporary-file/PowerShell/secure-temporary-file.psh b/Task/Secure-temporary-file/PowerShell/secure-temporary-file.psh new file mode 100644 index 0000000000..929c10f3e0 --- /dev/null +++ b/Task/Secure-temporary-file/PowerShell/secure-temporary-file.psh @@ -0,0 +1,4 @@ +$tempFile = [System.IO.Path]::GetTempFileName() +Set-Content -Path $tempFile -Value "FileName = $tempFile" +Get-Content -Path $tempFile +Remove-Item -Path $tempFile diff --git a/Task/Self-describing-numbers/00DESCRIPTION b/Task/Self-describing-numbers/00DESCRIPTION index be7f194965..8d1f48b27d 100644 --- a/Task/Self-describing-numbers/00DESCRIPTION +++ b/Task/Self-describing-numbers/00DESCRIPTION @@ -2,15 +2,18 @@ There are several so-called "self-describing" or "[[wp:Self-descriptive number|s An integer is said to be "self-describing" if it has the property that, when digit positions are labeled 0 to N-1, the digit in each position is equal to the number of times that that digit appears in the number. -For example, 2020 is a four-digit self describing number: +For example,   '''2020'''   is a four-digit self describing number: -* position 0 has value 2 and there are two 0s in the number; -* position 1 has value 0 and there are no 1s in the number; -* position 2 has value 2 and there are two 2s; -* position 3 has value 0 and there are zero 3s. +*   position   0   has value   2   and there are two 0s in the number; +*   position   1   has value   0   and there are no 1s in the number; +*   position   2   has value   2   and there are two 2s; +*   position   3   has value   0   and there are zero 3s. + +
    +Self-describing numbers < 100.000.000  are:     1210,   2020,   21200,   3211000,   42101000. -Self-describing numbers < 100.000.000: 1210, 2020, 21200, 3211000, 42101000. ;Task Description # Write a function/routine/method/... that will check whether a given positive integer is self-describing. # As an optional stretch goal - generate and display the set of self-describing numbers. +

    diff --git a/Task/Self-describing-numbers/C/self-describing-numbers-5.c b/Task/Self-describing-numbers/C/self-describing-numbers-5.c new file mode 100644 index 0000000000..2e75fa52e5 --- /dev/null +++ b/Task/Self-describing-numbers/C/self-describing-numbers-5.c @@ -0,0 +1,94 @@ +#include +#include +#include + +#define BASE_MIN 2 +#define BASE_MAX 94 + +void selfdesc(unsigned long); + +const char *ref = "!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~"; +char *digs; +unsigned long *nums, *inds, inds_sum, inds_val, base; + +int main(int argc, char *argv[]) { +int used[BASE_MAX]; +unsigned long digs_n, i; + if (argc != 2) { + fprintf(stderr, "Usage is %s \n", argv[0]); + return EXIT_FAILURE; + } + digs = argv[1]; + digs_n = strlen(digs); + if (digs_n < BASE_MIN || digs_n > BASE_MAX) { + fprintf(stderr, "Invalid number of digits\n"); + return EXIT_FAILURE; + } + for (i = 0; i < BASE_MAX; i++) { + used[i] = 0; + } + for (i = 0; i < digs_n && strchr(ref, digs[i]) && !used[digs[i]-*ref]; i++) { + used[digs[i]-*ref] = 1; + } + if (i < digs_n) { + fprintf(stderr, "Invalid digits\n"); + return EXIT_FAILURE; + } + nums = calloc(digs_n, sizeof(unsigned long)); + if (!nums) { + fprintf(stderr, "Could not allocate memory for nums\n"); + return EXIT_FAILURE; + } + inds = malloc(sizeof(unsigned long)*digs_n); + if (!inds) { + fprintf(stderr, "Could not allocate memory for inds\n"); + free(nums); + return EXIT_FAILURE; + } + inds_sum = 0; + inds_val = 0; + for (base = BASE_MIN; base <= digs_n; base++) { + selfdesc(base); + } + free(inds); + free(nums); + return EXIT_SUCCESS; +} + +void selfdesc(unsigned long i) { +unsigned long diff_sum, upper_min, j, lower, upper, k; + if (i) { + diff_sum = base-inds_sum; + upper_min = inds_sum ? diff_sum:base-1; + j = i-1; + if (j) { + lower = 0; + upper = (base-inds_val)/j; + } + else { + lower = diff_sum; + upper = diff_sum; + } + if (upper < upper_min) { + upper_min = upper; + } + for (inds[j] = lower; inds[j] <= upper_min; inds[j]++) { + nums[inds[j]]++; + inds_sum += inds[j]; + inds_val += inds[j]*j; + for (k = base-1; k > j && nums[k] <= inds[k] && inds[k]-nums[k] <= i; k--); + if (k == j) { + selfdesc(i-1); + } + inds_val -= inds[j]*j; + inds_sum -= inds[j]; + nums[inds[j]]--; + } + } + else { + for (j = 0; j < base; j++) { + putchar(digs[inds[j]]); + } + puts(""); + } +} diff --git a/Task/Self-describing-numbers/C/self-describing-numbers-6.c b/Task/Self-describing-numbers/C/self-describing-numbers-6.c new file mode 100644 index 0000000000..ba43700dd0 --- /dev/null +++ b/Task/Self-describing-numbers/C/self-describing-numbers-6.c @@ -0,0 +1,38 @@ +$ time ./selfdesc.exe 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ +1210 +2020 +21200 +3211000 +42101000 +521001000 +6210001000 +72100001000 +821000001000 +9210000001000 +A2100000001000 +B21000000001000 +C210000000001000 +D2100000000001000 +E21000000000001000 +F210000000000001000 +G2100000000000001000 +H21000000000000001000 +I210000000000000001000 +J2100000000000000001000 +K21000000000000000001000 +L210000000000000000001000 +M2100000000000000000001000 +N21000000000000000000001000 +O210000000000000000000001000 +P2100000000000000000000001000 +Q21000000000000000000000001000 +R210000000000000000000000001000 +S2100000000000000000000000001000 +T21000000000000000000000000001000 +U210000000000000000000000000001000 +V2100000000000000000000000000001000 +W21000000000000000000000000000001000 + +real 0m0.094s +user 0m0.046s +sys 0m0.030s diff --git a/Task/Self-describing-numbers/Elixir/self-describing-numbers.elixir b/Task/Self-describing-numbers/Elixir/self-describing-numbers.elixir new file mode 100644 index 0000000000..4b447b10ca --- /dev/null +++ b/Task/Self-describing-numbers/Elixir/self-describing-numbers.elixir @@ -0,0 +1,11 @@ +defmodule Self_describing do + def number(n) do + digits = Integer.digits(n) + Enum.map(0..length(digits)-1, fn s -> + length(Enum.filter(digits, fn c -> c==s end)) + end) == digits + end +end + +m = 3300000 +Enum.filter(0..m, fn n -> Self_describing.number(n) end) diff --git a/Task/Self-describing-numbers/PowerShell/self-describing-numbers-1.psh b/Task/Self-describing-numbers/PowerShell/self-describing-numbers-1.psh new file mode 100644 index 0000000000..45fbee13b7 --- /dev/null +++ b/Task/Self-describing-numbers/PowerShell/self-describing-numbers-1.psh @@ -0,0 +1,12 @@ +function Test-SelfDescribing ([int]$Number) +{ + [int[]]$digits = $Number.ToString().ToCharArray() | ForEach-Object {[Char]::GetNumericValue($_)} + [int]$sum = 0 + + for ($i = 0; $i -lt $digits.Count; $i++) + { + $sum += $i * $digits[$i] + } + + $sum -eq $digits.Count +} diff --git a/Task/Self-describing-numbers/PowerShell/self-describing-numbers-2.psh b/Task/Self-describing-numbers/PowerShell/self-describing-numbers-2.psh new file mode 100644 index 0000000000..b923c4ca1f --- /dev/null +++ b/Task/Self-describing-numbers/PowerShell/self-describing-numbers-2.psh @@ -0,0 +1 @@ +Test-SelfDescribing -Number 2020 diff --git a/Task/Self-describing-numbers/PowerShell/self-describing-numbers-3.psh b/Task/Self-describing-numbers/PowerShell/self-describing-numbers-3.psh new file mode 100644 index 0000000000..dff5abb69b --- /dev/null +++ b/Task/Self-describing-numbers/PowerShell/self-describing-numbers-3.psh @@ -0,0 +1,6 @@ +11,2020,21200,321100 | ForEach-Object { + [PSCustomObject]@{ + Number = $_ + IsSelfDescribing = Test-SelfDescribing -Number $_ + } +} | Format-Table -AutoSize diff --git a/Task/Self-describing-numbers/REXX/self-describing-numbers-1.rexx b/Task/Self-describing-numbers/REXX/self-describing-numbers-1.rexx index 6de0587d5e..c0d3b437d5 100644 --- a/Task/Self-describing-numbers/REXX/self-describing-numbers-1.rexx +++ b/Task/Self-describing-numbers/REXX/self-describing-numbers-1.rexx @@ -1,39 +1,26 @@ -/*REXX program checks if a number (base 10) is self-describing, */ -/* self-descriptive, */ -/* autobiographical, or */ -/* a curious number. */ -/* */ -/* Also see: http://oeis.org/A046043 */ -/* and: http://oeis.org/A138480 */ +/*REXX program determines if a number (in base 10) is a self─describing, */ +/*────────────────────────────────────────────────────── self─descriptive, */ +/*────────────────────────────────────────────────────── autobiographical, or a */ +/*────────────────────────────────────────────────────── curious number. */ +parse arg x y . /*obtain optional arguments from the CL*/ +if x=='' | x=="," then exit /*Not specified? Then get out of Dodge*/ +if y=='' | y=="," then y=x /* " " Then use the X value.*/ +w=length(y) /*use Y's width for aligned output. */ +numeric digits max(9, w) /*ensure we can handle larger numbers. */ +if x==y then do /*handle the case of a single number. */ + noYes=test_SDN(y) /*is it or ain't it? */ + say y word("is isn't", noYes+1) 'a self-describing number.' + exit + end -parse arg x y . /*get args from the command line.*/ -if x=='' then exit /*if no X, then get out of Dodge.*/ -if y=='' then y=x /*if no Y, then use the X value. */ -y=min(y,999999999) -w=length(y) /*use Y's width for pretty output*/ -/*══════════════════════════════════════test for a single number. */ -if x==y then do /*handle the case of a single #. */ - noYes=test_sdn(y) /*is it or ain't it? */ - say y word("is isn't",noYes+1) 'a self-describing number.' - exit - end -/*══════════════════════════════════════test for a range of numbers. */ - do n=x to y - if test_sdn(n) then iterate /*if ¬ self-describing, try again*/ - say right(n,w) 'is a self-describing number.' /*is it? */ + do n=x to y + if test_SDN(n) then iterate /*if not self─describing, try again. */ + say right(n,w) 'is a self-describing number.' /*is it? */ end /*n*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────TEST_SDN subroutine─────────────────*/ -test_sdn: procedure; parse arg ?; L=length(?) - do j=L to 1 by -1 /*backwards is slightly faster. */ - if substr(?,j,1)\==L-length(space(translate(?,,j-1),0)) then return 1 - end /*j*/ -return 0 /*faster if inverted truth table.*/ -/* ┌──────────────────────────────────────────────────────────────────┐ - │ The method used above is to TRANSLATE the digit being queried to │ - │ blanks, then use the SPACE bif function to remove all blanks, │ - │ and then compare the new number's length to the original length. │ - │ The difference in length is the number of digits translated. │ - │ This method works if there're no imbedded/leading/trailing blanks│ - │ (or other whitespace like tabs) in the number. │ - └──────────────────────────────────────────────────────────────────┘ */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +test_SDN: procedure; parse arg ?; L=length(?) /*obtain the argument and its length.*/ + do j=L to 1 by -1 /*parsing backwards is slightly faster.*/ + if substr(?,j,1)\==L-length(space(translate(?,,j-1),0)) then return 1 + end /*j*/ + return 0 /*faster if used inverted truth table. */ diff --git a/Task/Self-describing-numbers/REXX/self-describing-numbers-2.rexx b/Task/Self-describing-numbers/REXX/self-describing-numbers-2.rexx index 1b9675d6f2..496c9e0b88 100644 --- a/Task/Self-describing-numbers/REXX/self-describing-numbers-2.rexx +++ b/Task/Self-describing-numbers/REXX/self-describing-numbers-2.rexx @@ -1,21 +1,19 @@ -/*REXX program checks if a number (base 10) is self-describing */ -parse arg x y . /*get args from the command line.*/ -if x=='' then exit /*if no X, then get out of Dodge.*/ -if y=='' then y=x /*if no Y, then use the X value. */ -y=min(y,999999999) -w=length(y) /*use Y's width for pretty output*/ -/*══════════════════════════════════════test for a single number. */ -if x==y then do /*handle the case of a single #. */ - noYes=test_sdn(y) /*is it or ain't it? */ - say y word("is isn't",noYes+1) 'a self-describing number.' - exit - end -/*══════════════════════════════════════test for a range of numbers. */ - do n=x to y - if test_sdn(n) then iterate /*if ¬ self-describing, try again*/ - say right(n,w) 'is a self-describing number.' /*is it? */ +/*REXX program determines if a number (in base 10) is a self-describing number.*/ +parse arg x y . /*obtain optional arguments from the CL*/ +if x=='' | x=="," then exit /*Not specified? Then get out of Dodge*/ +if y=='' | y=="," then y=x /*Not specified? Then use the X value.*/ +w=length(y) /*use Y's width for aligned output. */ +numeric digits max(9, w) /*handle the possibility of larger #'s.*/ +$= '1210 2020 21200 3211000 42101000 521001000 6210001000' /*the list of numbers.*/ + /*test for a single integer. */ +if x==y then do /*handle the case of a single number. */ + say word("isn't is", wordpos(x, $) + 1) 'a self-describing number.' + exit + end + /* [↓] test for a range of integers.*/ + do n=x to y; parse var n '' -1 _ /*obtain the last decimal digit of N. */ + if _\==0 then iterate + if wordpos(n, $)==0 then iterate + say right(n,w) 'is a self-describing number.' end /*n*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────TEST_SDN subroutine─────────────────*/ -test_sdn: procedure; parse arg ?; if right(?,1)\==0 then return 1 -return wordpos(?,'1210 2020 21200 3211000 42101000 521001000 6210001000')==0 + /*stick a fork in it, we're all done. */ diff --git a/Task/Self-describing-numbers/REXX/self-describing-numbers-3.rexx b/Task/Self-describing-numbers/REXX/self-describing-numbers-3.rexx index 8392b1ea8c..f5addc85b5 100644 --- a/Task/Self-describing-numbers/REXX/self-describing-numbers-3.rexx +++ b/Task/Self-describing-numbers/REXX/self-describing-numbers-3.rexx @@ -1,23 +1,17 @@ -/*REXX program checks if a number (base 10) is self-describing */ -parse arg x y . /*get args from the command line.*/ -if x=='' then exit /*if no X, then get out of Dodge.*/ -if y=='' then y=x /*if no Y, then use the X value. */ -y=min(y,999999999) -w=length(y) /*use Y's width for pretty output*/ -$='1210 2020 21200 3211000 42101000 521001000 6210001000' /*the list.*/ -/*══════════════════════════════════════test for a single number. */ -if x==y then do /*handle the case of a single #. */ - noYes=test_sdn(y) /*is it or ain't it? */ - say y word("is isn't",noYes+1) 'a self-describing number.' - exit - end -/*══════════════════════════════════════test for a range of numbers. */ - do n=1 for words($) /*look for nums that are in range*/ - _=word($,n) - if _y then iterate /*if ¬ self-describing, try again*/ - say right(_,w) 'is a self-describing number.' /*display it.*/ - end /*n*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────TEST_SDN subroutine─────────────────*/ -test_sdn: procedure expose $; parse arg ? -if right(?,1)\==0 then return 1; return wordpos(?,$)==0 +/*REXX program determines if a number (in base 10) is a self-describing number.*/ +parse arg x y . /*obtain optional arguments from the CL*/ +if x=='' | x=="," then exit /*Not specified? Then get out of Dodge*/ +if y=='' | y=="," then y=x /*Not specified? Then use the X value.*/ +w=length(y) /*use Y's width for aligned output. */ +numeric digits max(9, w) /*handle the possibility of larger #'s.*/ +$= '1210 2020 21200 3211000 42101000 521001000 6210001000' /*the list of numbers.*/ + /*test for a single integer. */ +if x==y then do /*handle the case of a single number. */ + say word("isn't is", wordpos(x, $) + 1) 'a self-describing number.' + exit + end + /* [↓] test for a range of integers.*/ + do n=1 for words($); _=word($, n) /*look for integers that are in range. */ + if _y then iterate /*if not self-describing, try again. */ + say right(_, w) 'is a self-describing number.' + end /*n*/ /*stick a fork in it, we're all done. */ diff --git a/Task/Self-describing-numbers/Ruby/self-describing-numbers.rb b/Task/Self-describing-numbers/Ruby/self-describing-numbers.rb index 353f524954..6f6d695f06 100644 --- a/Task/Self-describing-numbers/Ruby/self-describing-numbers.rb +++ b/Task/Self-describing-numbers/Ruby/self-describing-numbers.rb @@ -1,14 +1,6 @@ def is_self_describing?(n) - digits = n.to_s.chars.collect {|digit| digit.to_i} - len = digits.length - count = Array.new(len, 0) - - digits.each do |digit| - return false if digit >= len - count[digit] = count[digit] + 1 - end - - digits.eql?(count) + digits = n.to_s.chars.map(&:to_i) + digits.each_with_index.all?{|digit, idx| digits.count(idx) == digit} end 3_300_000.times {|n| puts n if is_self_describing?(n)} diff --git a/Task/Self-referential-sequence/Lua/self-referential-sequence.lua b/Task/Self-referential-sequence/Lua/self-referential-sequence.lua new file mode 100644 index 0000000000..87ad882840 --- /dev/null +++ b/Task/Self-referential-sequence/Lua/self-referential-sequence.lua @@ -0,0 +1,53 @@ +-- Return the next term in the self-referential sequence +function findNext (nStr) + local nTab, outStr, pos, count = {}, "", 1, 1 + for i = 1, #nStr do nTab[i] = nStr:sub(i, i) end + table.sort(nTab, function (a, b) return a > b end) + while pos <= #nTab do + if nTab[pos] == nTab[pos + 1] then + count = count + 1 + else + outStr = outStr .. count .. nTab[pos] + count = 1 + end + pos = pos + 1 + end + return outStr +end + +-- Return boolean indicating whether table t contains string s +function contains (t, s) + for k, v in pairs(t) do + if v == s then return true end + end + return false +end + +-- Return the sequence generated by the given seed term +function buildSeq (term) + local sequence = {} + repeat + table.insert(sequence, term) + if not nextTerm[term] then nextTerm[term] = findNext(term) end + term = nextTerm[term] + until contains(sequence, term) + return sequence +end + +-- Main procedure +nextTerm = {} +local highest, seq, hiSeq = 0 +for i = 1, 10^6 do + seq = buildSeq(tostring(i)) + if #seq > highest then + highest = #seq + hiSeq = {seq} + elseif #seq == highest then + table.insert(hiSeq, seq) + end +end +io.write("Seed values: ") +for _, v in pairs(hiSeq) do io.write(v[1] .. " ") end +print("\n\nIterations: " .. highest) +print("\nSample sequence:") +for _, v in pairs(hiSeq[1]) do print(v) end diff --git a/Task/Self-referential-sequence/Perl-6/self-referential-sequence.pl6 b/Task/Self-referential-sequence/Perl-6/self-referential-sequence.pl6 index 7f2971b781..18b3fb2760 100644 --- a/Task/Self-referential-sequence/Perl-6/self-referential-sequence.pl6 +++ b/Task/Self-referential-sequence/Perl-6/self-referential-sequence.pl6 @@ -5,7 +5,7 @@ my %seen; for 1 .. 1000000 -> $m { next unless $m ~~ /0/; # seed must have a zero my $j = join '', $m.comb.sort; - next if %seen.exists($j); # already tested a permutation + next if %seen{$j}:exists; # already tested a permutation %seen{$j} = ''; my @seq := converging($m); my %elems; @@ -23,7 +23,7 @@ for 1 .. 1000000 -> $m { }; for @list -> $m { - say "Seed Value(s): ", ~permutations($m).uniq.grep( { .substr(0,1) != 0 } ); + say "Seed Value(s): ", my $seeds = ~permutations($m).unique.grep( { .substr(0,1) != 0 } ); my @seq := converging($m); my %elems; my $count; @@ -41,7 +41,7 @@ sub permutations ($string, $sofar? = '' ) { for ^$string.chars -> $idx { my $this = $string.substr(0,$idx)~$string.substr($idx+1); my $char = substr($string, $idx,1); - @perms.push( permutations( $this, join '', $sofar, $char ) ) ; + @perms.push( |permutations( $this, join '', $sofar, $char ) ); } return @perms; } diff --git a/Task/Self-referential-sequence/TXR/self-referential-sequence-1.txr b/Task/Self-referential-sequence/TXR/self-referential-sequence-1.txr index af8902f0f6..b019fc7772 100644 --- a/Task/Self-referential-sequence/TXR/self-referential-sequence-1.txr +++ b/Task/Self-referential-sequence/TXR/self-referential-sequence-1.txr @@ -1,59 +1,58 @@ -@(do - ;; Syntactic sugar for calling reduce-left - (defmacro reduce-with ((acc init item sequence) . body) - ^(reduce-left (lambda (,acc ,item) ,*body) ,sequence ,init)) +;; Syntactic sugar for calling reduce-left +(defmacro reduce-with ((acc init item sequence) . body) + ^(reduce-left (lambda (,acc ,item) ,*body) ,sequence ,init)) - ;; Macro similar to clojure's ->> and -> - (defmacro opchain (val . ops) - ^[[chain ,*[mapcar [iffi consp (op cons 'op)] ops]] ,val]) + ;; Macro similar to clojure's ->> and -> +(defmacro opchain (val . ops) + ^[[chain ,*[mapcar [iffi consp (op cons 'op)] ops]] ,val]) - ;; Reduce integer to a list of integers representing its decimal digits. - (defun digits (n) - (if (< n 10) - (list n) - (opchain n tostring list-str (mapcar (op - @1 #\0))))) +;; Reduce integer to a list of integers representing its decimal digits. +(defun digits (n) + (if (< n 10) + (list n) + (opchain n tostring list-str (mapcar (op - @1 #\0))))) - (defun dcount (ds) - (digits (length ds))) +(defun dcount (ds) + (digits (length ds))) - ;; Perform a look-say step like (1 2 2) --"one 1, two 2's"-> (1 1 2 2). - (defun summarize-prev (ds) - (opchain ds copy (sort @1 >) (partition-by identity) - (mapcar [juxt dcount first]) flatten)) +;; Perform a look-say step like (1 2 2) --"one 1, two 2's"-> (1 1 2 2). +(defun summarize-prev (ds) + (opchain ds copy (sort @1 >) (partition-by identity) + (mapcar [juxt dcount first]) flatten)) - ;; Take a starting digit string and iterate the look-say steps, - ;; to generate the whole sequence, which ends when convergence is reached. - (defun convergent-sequence (ds) - (reduce-with (cur-seq nil ds [giterate true summarize-prev ds]) - (if (member ds cur-seq) - (return-from convergent-sequence cur-seq) - (nconc cur-seq (list ds))))) +;; Take a starting digit string and iterate the look-say steps, +;; to generate the whole sequence, which ends when convergence is reached. +(defun convergent-sequence (ds) + (reduce-with (cur-seq nil ds [giterate true summarize-prev ds]) + (if (member ds cur-seq) + (return-from convergent-sequence cur-seq) + (nconc cur-seq (list ds))))) - ;; A candidate sequence is one which begins with montonically - ;; decreasing digits. We don't bother with (9 0 9 0) or (9 0 0 9); - ;; which yield identical sequences to (9 9 0 0). - (defun candidate-seq (n) - (let ((ds (digits n))) - (if [apply >= ds] - (convergent-sequence ds)))) +;; A candidate sequence is one which begins with montonically +;; decreasing digits. We don't bother with (9 0 9 0) or (9 0 0 9); +;; which yield identical sequences to (9 9 0 0). +(defun candidate-seq (n) + (let ((ds (digits n))) + (if [apply >= ds] + (convergent-sequence ds)))) - ;; Discover the set of longest sequences. - (defun find-longest (limit) - (reduce-with (max-seqs nil new-seq [mapcar candidate-seq (range 1 limit)]) - (let ((cmp (- (opchain max-seqs first length) (length new-seq)))) - (cond ((> cmp 0) max-seqs) - ((< cmp 0) (list new-seq)) - (t (nconc max-seqs (list new-seq))))))) +;; Discover the set of longest sequences. +(defun find-longest (limit) + (reduce-with (max-seqs nil new-seq [mapcar candidate-seq (range 1 limit)]) + (let ((cmp (- (opchain max-seqs first length) (length new-seq)))) + (cond ((> cmp 0) max-seqs) + ((< cmp 0) (list new-seq)) + (t (nconc max-seqs (list new-seq))))))) - (defvar *results* (find-longest 1000000)) +(defvar *results* (find-longest 1000000)) - (each ((result *results*)) - (flet ((strfy (list) ;; (strfy '((1 2 3 4) (5 6 7 8))) -> ("1234" "5678") - (mapcar [chain (op mapcar tostring) cat-str] list))) - (let* ((seed (first result)) - (seeds (opchain seed perm uniq (remove-if zerop @1 first)))) - (put-line `Seed value(s): @(strfy seeds)`) - (put-line) - (put-line `Iterations: @(length result)`) +(each ((result *results*)) + (flet ((strfy (list) ;; (strfy '((1 2 3 4) (5 6 7 8))) -> ("1234" "5678") + (mapcar [chain (op mapcar tostring) cat-str] list))) + (let* ((seed (first result)) + (seeds (opchain seed perm uniq (remove-if zerop @1 first)))) + (put-line `Seed value(s): @(strfy seeds)`) (put-line) - (put-line `Sequence: @(strfy result)`))))) + (put-line `Iterations: @(length result)`) + (put-line) + (put-line `Sequence: @(strfy result)`)))) diff --git a/Task/Self-referential-sequence/TXR/self-referential-sequence-2.txr b/Task/Self-referential-sequence/TXR/self-referential-sequence-2.txr index f9a12b59d1..e23cfe9f8c 100644 --- a/Task/Self-referential-sequence/TXR/self-referential-sequence-2.txr +++ b/Task/Self-referential-sequence/TXR/self-referential-sequence-2.txr @@ -1,32 +1,27 @@ -@(do - (defun count-and-say (str) - (let* ((s [sort (copy-str str) <]) - (out `@[s 0]0`)) - (each ((x s)) - (if (eql x [out -1]) - (inc [out -2]) - (set out `@{out}1@x`))) - out)) +(defun count-and-say (str) + (let* ((s [sort (copy-str str) <]) + (out `@[s 0]0`)) + (each ((x s)) + (if (eql x [out -1]) + (inc [out -2]) + (set out `@{out}1@x`))) + out)) - (defun ref-seq-len (n : doprint) - (let ((s (tostring n)) hist) - (while t - (push s hist) - (if doprint (pprinl s)) - (set s (count-and-say s)) - (each ((item hist) - (i (range 0 2))) - (when (equal s item) - (return-from ref-seq-len (length hist))))))) +(defun ref-seq-len (n : doprint) + (let ((s (tostring n)) hist) + (while t + (push s hist) + (if doprint (pprinl s)) + (set s (count-and-say s)) + (each ((item hist) + (i (range 0 2))) + (when (equal s item) + (return-from ref-seq-len (length hist))))))) - (defun find-longest (top) - (let (nums (len 0)) - (each ((x (range 0 top))) - (let ((l (ref-seq-len x))) - (when (> l len) (set len l) (set nums nil)) - (when (= l len) (push x nums)))) - (list nums len))) - - (let ((r (find-longest 1000000))) - (format t "Longest: ~a\n" r) - (ref-seq-len (first (first r)) t))) +(defun find-longest (top) + (let (nums (len 0)) + (each ((x (range 0 top))) + (let ((l (ref-seq-len x))) + (when (> l len) (set len l) (set nums nil)) + (when (= l len) (push x nums)))) + (list nums len))) diff --git a/Task/Self-referential-sequence/TXR/self-referential-sequence-3.txr b/Task/Self-referential-sequence/TXR/self-referential-sequence-3.txr index 26b959d698..333f0eb67e 100644 --- a/Task/Self-referential-sequence/TXR/self-referential-sequence-3.txr +++ b/Task/Self-referential-sequence/TXR/self-referential-sequence-3.txr @@ -1,47 +1,46 @@ -@(do - ;; Macro very similar to Racket's for/fold - (defmacro for-accum (accum-var-inits each-vars . body) - (let ((accum-vars [mapcar first accum-var-inits]) - (block-sym (gensym)) - (next-args [mapcar (ret (progn @rest (gensym))) accum-var-inits]) - (nvars (length accum-var-inits))) - ^(let ,accum-var-inits - (flet ((iter (,*next-args) - ,*[mapcar (ret ^(set ,@1 ,@2)) accum-vars next-args])) - (each ,each-vars - ,*body) - (list ,*accum-vars))))) +;; Macro very similar to Racket's for/fold +(defmacro for-accum (accum-var-inits each-vars . body) + (let ((accum-vars [mapcar first accum-var-inits]) + (block-sym (gensym)) + (next-args [mapcar (ret (progn @rest (gensym))) accum-var-inits]) + (nvars (length accum-var-inits))) + ^(let ,accum-var-inits + (flet ((iter (,*next-args) + ,*[mapcar (ret ^(set ,@1 ,@2)) accum-vars next-args])) + (each ,each-vars + ,*body) + (list ,*accum-vars))))) - (defun next (s) - (let ((v (vector 10 0))) - (each ((c s)) - (inc [v (- #\9 c)])) - (cat-str - (collect-each ((x v) - (i (range 9 0 -1))) - (when (> x 0) - `@x@i`))))) +(defun next (s) + (let ((v (vector 10 0))) + (each ((c s)) + (inc [v (- #\9 c)])) + (cat-str + (collect-each ((x v) + (i (range 9 0 -1))) + (when (> x 0) + `@x@i`))))) - (defun seq-of (s) - (for* ((ns ())) - ((not (member s ns)) (reverse ns)) - ((push s ns) (set s (next s))))) +(defun seq-of (s) + (for* ((ns ())) + ((not (member s ns)) (reverse ns)) + ((push s ns) (set s (next s))))) - (defun sort-string (s) - [sort (copy s) >]) +(defun sort-string (s) + [sort (copy s) >]) - (tree-bind (len nums seq) - (for-accum ((*len nil) (*nums nil) (*seq nil)) - ((n (range 1000000 0 -1))) ;; start at the high end - (let* ((s (tostring n)) - (sorted (sort-string s))) - (if (equal s sorted) - (let* ((seq (seq-of s)) - (len (length seq))) - (cond ((or (not *len) (> len *len)) (iter len (list s) seq)) - ((= len *len) (iter len (cons s *nums) seq)))) - (iter *len - (if (and *nums (member sorted *nums)) (cons s *nums) *nums) - *seq)))) - (put-line `Numbers: @{nums ", "}\nLength: @len`) - (each ((n seq)) (put-line ` @n`))) +(tree-bind (len nums seq) + (for-accum ((*len nil) (*nums nil) (*seq nil)) + ((n (range 1000000 0 -1))) ;; start at the high end + (let* ((s (tostring n)) + (sorted (sort-string s))) + (if (equal s sorted) + (let* ((seq (seq-of s)) + (len (length seq))) + (cond ((or (not *len) (> len *len)) (iter len (list s) seq)) + ((= len *len) (iter len (cons s *nums) seq)))) + (iter *len + (if (and *nums (member sorted *nums)) (cons s *nums) *nums) + *seq)))) + (put-line `Numbers: @{nums ", "}\nLength: @len`) + (each ((n seq)) (put-line ` @n`))) diff --git a/Task/Semiprime/00DESCRIPTION b/Task/Semiprime/00DESCRIPTION index d4d41a6253..daf1c8c727 100644 --- a/Task/Semiprime/00DESCRIPTION +++ b/Task/Semiprime/00DESCRIPTION @@ -1,3 +1,12 @@ - Semiprime numbers are natural numbers that are products of exactly two (possibly equal) [[prime_number|prime numbers]]. Example: 1679 = 23 × 73 (This particular number was chosen as the length of the [http://en.wikipedia.org/wiki/Arecibo_message Arecibo message]). +Semiprime numbers are natural numbers that are products of exactly two (possibly equal) [[prime_number|prime numbers]]. + +;Example: + 1679 = 23 × 73 + +(This particular number was chosen as the length of the [http://en.wikipedia.org/wiki/Arecibo_message Arecibo message]). + + +;Task; Write a function determining whether a given number is semiprime. +

    diff --git a/Task/Semiprime/ALGOL-68/semiprime.alg b/Task/Semiprime/ALGOL-68/semiprime.alg new file mode 100644 index 0000000000..9e428998d2 --- /dev/null +++ b/Task/Semiprime/ALGOL-68/semiprime.alg @@ -0,0 +1,38 @@ +# returns TRUE if n is semi-prime, FALSE otherwise # +# n is semi prime if it has exactly two prime factors # +PROC is semiprime = ( INT n )BOOL: + BEGIN + # We only need to consider factors between 2 and # + # sqrt( n ) inclusive. If there is only one of these # + # then it must be a prime factor and so the number # + # is semi prime # + INT factor count := 0; + FOR factor FROM 2 TO ENTIER sqrt( ABS n ) + WHILE IF n MOD factor = 0 THEN + factor count +:= 1; + # check the factor isn't a repeated factor # + IF n /= factor * factor THEN + # the factor isn't the square root # + INT other factor = n OVER factor; + IF other factor MOD factor = 0 THEN + # have a repeated factor # + factor count +:= 1 + FI + FI + FI; + factor count < 2 + DO SKIP OD; + factor count = 1 + END # is semiprime # ; + +# determine the first few semi primes # +print( ( "semi primes below 100: " ) ); +FOR i TO 99 DO + IF is semi prime( i ) THEN print( ( whole( i, 0 ), " " ) ) FI +OD; +print( ( newline ) ); +print( ( "semi primes below between 1670 and 1690: " ) ); +FOR i FROM 1670 TO 1690 DO + IF is semi prime( i ) THEN print( ( whole( i, 0 ), " " ) ) FI +OD; +print( ( newline ) ) diff --git a/Task/Semiprime/Elixir/semiprime.elixir b/Task/Semiprime/Elixir/semiprime.elixir new file mode 100644 index 0000000000..9dd38d1a9c --- /dev/null +++ b/Task/Semiprime/Elixir/semiprime.elixir @@ -0,0 +1,14 @@ +defmodule Prime do + def semiprime?(n), do: length(decomposition(n)) == 2 + + def decomposition(n), do: decomposition(n, 2, []) + + defp decomposition(n, k, acc) when n < k*k, do: Enum.reverse(acc, [n]) + defp decomposition(n, k, acc) when rem(n, k) == 0, do: decomposition(div(n, k), k, [k | acc]) + defp decomposition(n, k, acc), do: decomposition(n, k+1, acc) +end + +IO.inspect Enum.filter(1..100, &Prime.semiprime?(&1)) +Enum.each(1675..1680, fn n -> + :io.format "~w -> ~w\t~s~n", [n, Prime.semiprime?(n), Prime.decomposition(n)|>Enum.join(" x ")] +end) diff --git a/Task/Semiprime/Lua/semiprime.lua b/Task/Semiprime/Lua/semiprime.lua new file mode 100644 index 0000000000..bed42b83f2 --- /dev/null +++ b/Task/Semiprime/Lua/semiprime.lua @@ -0,0 +1,16 @@ +function semiprime (n) + local divisor, count = 2, 0 + while count < 3 and n ~= 1 do + if n % divisor == 0 then + n = n / divisor + count = count + 1 + else + divisor = divisor + 1 + end + end + return count == 2 +end + +for n = 1675, 1680 do + print(n, semiprime(n)) +end diff --git a/Task/Semiprime/Maple/semiprime-1.maple b/Task/Semiprime/Maple/semiprime-1.maple index 480a0f3ff3..33233f34e5 100644 --- a/Task/Semiprime/Maple/semiprime-1.maple +++ b/Task/Semiprime/Maple/semiprime-1.maple @@ -1,10 +1,10 @@ SemiPrimes := proc( n ) local fact; - fact := numtheory:-divisors( n ) minus {1, n}; + fact := NumberTheory:-Divisors( n ) minus {1, n}; if numelems( fact ) in {1,2} and not( member( 'false', isprime ~ ( fact ) ) ) then return n; else return NULL; end if; end proc: -{ seq( SemiPrime( i ), i = 1..100 ) }; +{ seq( SemiPrimes( i ), i = 1..100 ) }; diff --git a/Task/Semiprime/PowerShell/semiprime.psh b/Task/Semiprime/PowerShell/semiprime.psh new file mode 100644 index 0000000000..a4582eb35b --- /dev/null +++ b/Task/Semiprime/PowerShell/semiprime.psh @@ -0,0 +1,26 @@ +function isPrime ($n) { + if ($n -le 1) {$false} + elseif (($n -eq 2) -or ($n -eq 3)) {$true} + else{ + $m = [Math]::Floor([Math]::Sqrt($n)) + (@(2..$m | where {($_ -lt $n) -and ($n % $_ -eq 0) }).Count -eq 0) + } +} +function semiprime ($n) { + if($n -gt 3) { + $lim = [Math]::Floor($n/2)+1 + $i = 2 + while(($i -lt $lim) -and ($n%$i -ne 0)){ $i += 1} + if($i -eq $lim){@()} + elseif(-not (isPrime ($n/$i))){@()} + else{@($i,($n/$i))} + } else {@()} +} +$OFS = " x " +"1679: $(semiprime 1679)" +"87: $(semiprime 87)" +"25: $(semiprime 25)" +"12: $(semiprime 12)" +"6: $(semiprime 6)" +$OFS = " " +"semiprime form 1 to 100: $(1..100 | where {semiprime $_})" diff --git a/Task/Semiprime/REXX/semiprime-2.rexx b/Task/Semiprime/REXX/semiprime-2.rexx index 33514f1b39..1b2ae9382a 100644 --- a/Task/Semiprime/REXX/semiprime-2.rexx +++ b/Task/Semiprime/REXX/semiprime-2.rexx @@ -1,31 +1,31 @@ -/*REXX program determines if any number (or a range) is/are semiprime. */ -parse arg bot top . /*obtain optional numbers from the C.L.*/ -if bot==''|bot=="," then bot=random() /*None given? User wants us to guess.*/ -if top==''|top=="," then top=bot /*maybe define a range of numbers. */ -w=max(length(bot), length(top)) /*obtain the maximum width of numbers. */ -numeric digits max(9,w) /*ensure there're enough decimal digits*/ - do n=bot to top /*show results for a range of numbers. */ - if isSemiPrime(n) then say right(n,w) " is semiprime." - else say right(n,w) " isn't semiprime." +/*REXX program determines if any integer (or a range of integers) is/are semiprime. */ +parse arg bot top . /*obtain optional arguments from the CL*/ +if bot=='' | bot=="," then bot=random() /*None given? User wants us to guess.*/ +if top=='' | top=="," then top=bot /*maybe define a range of numbers. */ +w=max(length(bot), length(top)) /*obtain the maximum width of numbers. */ +numeric digits max(9, w) /*ensure there're enough decimal digits*/ + do n=bot to top /*show results for a range of numbers. */ + if isSemiPrime(n) then say right(n, w) " is semiprime." + else say right(n, w) " isn't semiprime." end /*n*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -isPrime: procedure; parse arg x; if x<2 then return 0 /*number too low*/ -if wordpos(x, '2 3 5 7 11 13 17 19 23')\==0 then return 1 /*it's low prime*/ -if x//2==0 then return 0; if x//3==0 then return 0 /*÷ by 2;÷ by 3?*/ - do j=5 by 6 until j*j>x; if x//j==0 then return 0 /*not a prime. */ - if x//(j+2)==0 then return 0 /* " " " */ - end /*j*/ -return 1 /*indicate that X is a prime number. */ -/*────────────────────────────────────────────────────────────────────────────*/ -isSemiPrime: procedure; parse arg x; if \datatype(x,'W') | x<4 then return 0 -x=x/1 - do i=2 for 2; if x//i==0 then if isPrime(x%i) then return 1 - else return 0 - end /*i*/ - /* ___ */ - do j=5 by 6; if j*j>x then return 0 /* > √ x ? */ - do k=j by 2 for 2; if x//k==0 then if isPrime(x%k) then return 1 - else return 0 - end /*k*/ /* [↑] see if 2nd factor is prime or ¬*/ - end /*j*/ /* [↑] never ÷ by J if J is mult. of 3*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +isPrime: procedure; parse arg x; if x<2 then return 0 /*number too low?*/ + if wordpos(x, '2 3 5 7 11 13 17 19 23')\==0 then return 1 /*it's low prime.*/ + if x//2==0 then return 0; if x//3==0 then return 0 /*÷ by 2; ÷ by 3?*/ + do j=5 by 6 until j*j>x; if x//j==0 then return 0 /*not a prime. */ + if x//(j+2)==0 then return 0 /* " " " */ + end /*j*/ + return 1 /*indicate that X is a prime number. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +isSemiPrime: procedure; parse arg x; if x<4 then return 0 + + do i=2 for 2; if x//i==0 then if isPrime(x%i) then return 1 + else return 0 + end /*i*/ + /* ___ */ + do j=5 by 6; if j*j>x then return 0 /* > √ x ?*/ + do k=j by 2 for 2; if x//k==0 then if isPrime(x%k) then return 1 + else return 0 + end /*k*/ /* [↑] see if 2nd factor is prime or ¬*/ + end /*j*/ /* [↑] J is never a multiple of three.*/ diff --git a/Task/Semordnilap/00DESCRIPTION b/Task/Semordnilap/00DESCRIPTION index d69ef0389d..f1b6f8f781 100644 --- a/Task/Semordnilap/00DESCRIPTION +++ b/Task/Semordnilap/00DESCRIPTION @@ -1,8 +1,11 @@ -A '''[[wp:semordnilap|semordnilap]]''' is a word (or phrase) that spells a different word (or phrase) backward. "Semordnilap" is a word that itself is a semordnilap. - -Example: ''lager'' and ''regal'' +A [[wp:semordnilap|semordnilap]] is a word (or phrase) that spells a different word (or phrase) backward. +"Semordnilap" is a word that itself is a semordnilap. +Example: ''lager'' and ''regal'' +

    +;Task Using only words from the [http://www.puzzlers.org/pub/wordlists/unixdict.txt unixdict], report the total number of unique semordnilap pairs, and print 5 examples. (Note that lager/regal and regal/lager should be counted as one unique pair.) - -;Cf. +

    +;Related tasks * [[Palindrome_detection|Palindrome detection]] +

    diff --git a/Task/Semordnilap/ALGOL-68/semordnilap.alg b/Task/Semordnilap/ALGOL-68/semordnilap.alg new file mode 100644 index 0000000000..58dcfed954 --- /dev/null +++ b/Task/Semordnilap/ALGOL-68/semordnilap.alg @@ -0,0 +1,62 @@ +# find the semordnilaps in a list of words # +# use the associative array in the Associate array/iteration task # +PR read "aArray.a68" PR + +# returns text with the characters reversed # +OP REVERSE = ( STRING text )STRING: + BEGIN + STRING reversed := text; + INT start pos := LWB text; + FOR end pos FROM UPB reversed BY -1 TO LWB reversed + DO + reversed[ end pos ] := text[ start pos ]; + start pos +:= 1 + OD; + reversed + END # REVERSE # ; + +# read the list of words and store the words in an associative array # +# check for semordnilaps # +IF FILE input file; + STRING file name = "unixdict.txt"; + open( input file, file name, stand in channel ) /= 0 +THEN + # failed to open the file # + print( ( "Unable to open """ + file name + """", newline ) ) +ELSE + # file opened OK # + BOOL at eof := FALSE; + # set the EOF handler for the file # + on logical file end( input file, ( REF FILE f )BOOL: + BEGIN + # note that we reached EOF on the # + # latest read # + at eof := TRUE; + # return TRUE so processing can continue # + TRUE + END + ); + REF AARRAY words := INIT LOC AARRAY; + STRING word; + INT semordnilap count := 0; + WHILE NOT at eof + DO + STRING word; + get( input file, ( word, newline ) ); + STRING reversed word = REVERSE word; + IF ( words // reversed word ) = "" + THEN + # the reversed word isn't in the array # + words // word := reversed word + ELSE + # we already have this reversed - we have a semordnilap # + semordnilap count +:= 1; + IF semordnilap count <= 5 + THEN + print( ( reversed word, " & ", word, newline ) ) + FI + FI + OD; + close( input file ); + print( ( whole( semordnilap count, 0 ), " semordnilaps found", newline ) ) +FI diff --git a/Task/Semordnilap/C-sharp/semordnilap.cs b/Task/Semordnilap/C-sharp/semordnilap.cs new file mode 100644 index 0000000000..f25e2996c5 --- /dev/null +++ b/Task/Semordnilap/C-sharp/semordnilap.cs @@ -0,0 +1,39 @@ +using System; +using System.Net; +using System.Collections.Generic; +using System.Linq; +using System.IO; + +public class Semordnilap +{ + public static void Main() { + var results = FindSemordnilaps("http://www.puzzlers.org/pub/wordlists/unixdict.txt").ToList(); + Console.WriteLine(results.Count); + var random = new Random(); + Console.WriteLine("5 random results:"); + foreach (string s in results.OrderBy(_ => random.Next()).Distinct().Take(5)) Console.WriteLine(s + " " + Reversed(s)); + } + + private static IEnumerable FindSemordnilaps(string url) { + var found = new HashSet(); + foreach (string line in GetLines(url)) { + string reversed = Reversed(line); + //Not taking advantage of the fact the input file is sorted + if (line.CompareTo(reversed) != 0) { + if (found.Remove(reversed)) yield return reversed; + else found.Add(line); + } + } + } + + private static IEnumerable GetLines(string url) { + WebRequest request = WebRequest.Create(url); + using (var reader = new StreamReader(request.GetResponse().GetResponseStream(), true)) { + while (!reader.EndOfStream) { + yield return reader.ReadLine(); + } + } + } + + private static string Reversed(string value) => new string(value.Reverse().ToArray()); +} diff --git a/Task/Semordnilap/Elixir/semordnilap.elixir b/Task/Semordnilap/Elixir/semordnilap.elixir new file mode 100644 index 0000000000..4e26093860 --- /dev/null +++ b/Task/Semordnilap/Elixir/semordnilap.elixir @@ -0,0 +1,7 @@ +words = File.stream!("unixdict.txt") + |> Enum.map(&String.strip/1) + |> Enum.group_by(&min(&1, String.reverse &1)) + |> Map.values + |> Enum.filter(&(length &1) == 2) +IO.puts "Semordnilap pair: #{length(words)}" +IO.inspect Enum.take(words,5) diff --git a/Task/Semordnilap/Forth/semordnilap.fth b/Task/Semordnilap/Forth/semordnilap.fth new file mode 100644 index 0000000000..509d459659 --- /dev/null +++ b/Task/Semordnilap/Forth/semordnilap.fth @@ -0,0 +1,35 @@ +wordlist constant dict + +: load-dict ( c-addr u -- ) + r/o open-file throw >r + begin + pad 1024 r@ read-line throw while + pad swap ['] create execute-parsing + repeat + drop r> close-file throw ; + +: xreverse {: c-addr u -- c-addr2 u :} + u allocate throw u + c-addr swap over u + >r begin ( from to r:end) + over r@ u< while + over r@ over - x-size dup >r - 2dup r@ cmove + swap r> + swap repeat + r> drop nip u ; + +: .example ( c-addr u u1 -- ) + 5 < if + cr 2dup type space 2dup xreverse 2dup type drop free throw then + 2drop ; + +: nt-semicheck ( u1 nt -- u2 f ) + dup >r name>string xreverse 2dup dict find-name-in dup if ( u1 c-addr u nt2) + r@ < if ( u1 c-addr u ) \ count pairs only once and not palindromes + 2dup 4 pick .example + rot 1+ -rot then + else + drop then + drop free throw r> drop true ; + +get-current dict set-current s" unixdict.txt" load-dict set-current + +0 ' nt-semicheck dict traverse-wordlist cr . +cr bye diff --git a/Task/Semordnilap/Kotlin/semordnilap.kotlin b/Task/Semordnilap/Kotlin/semordnilap.kotlin index ce88182048..0ad117db5a 100644 --- a/Task/Semordnilap/Kotlin/semordnilap.kotlin +++ b/Task/Semordnilap/Kotlin/semordnilap.kotlin @@ -1,9 +1,6 @@ -import java.nio.file.Files -import java.nio.file.Paths - fun semordnilap() { - val words = Files.readAllLines(Paths.get("unixdict.txt"), Charsets.UTF_8).toSet() - val pairs = words.asSequence().map { it to it.reverse() } // Pair(word, reversed word) + val words = File("unixdict.txt").readLines().toSet() + val pairs = words.asSequence().map { it to it.reversed() } // Pair(word, reversed word) .filter { it.first < it.second && it.second in words }.toList() // avoid dupes+palindromes, find matches println("Found ${pairs.size()} semordnilap pairs") println(pairs.take(5)) diff --git a/Task/Semordnilap/PowerShell/semordnilap.psh b/Task/Semordnilap/PowerShell/semordnilap.psh new file mode 100644 index 0000000000..50e0138457 --- /dev/null +++ b/Task/Semordnilap/PowerShell/semordnilap.psh @@ -0,0 +1,35 @@ +function Reverse-String ([string]$String) +{ + [char[]]$output = $String.ToCharArray() + [Array]::Reverse($output) + $output -join "" +} + +[string]$url = "http://www.puzzlers.org/pub/wordlists/unixdict.txt" +[string]$out = ".\unixdict.txt" + +(New-Object System.Net.WebClient).DownloadFile($url, $out) + +[string[]]$file = Get-Content -Path $out + +[hashtable]$unixDict = @{} +[hashtable]$semordnilap = @{} + +foreach ($line in $file) +{ + if ($line.Length -gt 1) + { + $unixDict.Add($line,"") + } + + [string]$reverseLine = Reverse-String $line + + if ($reverseLine -notmatch $line -and $unixDict.ContainsKey($reverseLine)) + { + $semordnilap.Add($line,$reverseLine) + } +} + +$semordnilap + +"`nSemordnilap count: {0}" -f ($semordnilap.GetEnumerator() | Measure-Object).Count diff --git a/Task/Semordnilap/REXX/semordnilap-2.rexx b/Task/Semordnilap/REXX/semordnilap-2.rexx index 3f884e033c..2ce6adac2a 100644 --- a/Task/Semordnilap/REXX/semordnilap-2.rexx +++ b/Task/Semordnilap/REXX/semordnilap-2.rexx @@ -1,15 +1,16 @@ -/*REXX program finds palindrome pairs using a dictionary (UNIXDICT.TXT).*/ -#=0 /*# palindromes (so far)*/ -parse arg iFID .; if iFID=='' then iFID='UNIXDICT.TXT' /*use default?*/ -@.= /*caseless no-duped word*/ - do while lines(iFID)\==0; _=space(linein(iFID),0); parse upper var _ u - if length(_)<2 | @.u\=='' then iterate /*can't be a unique pal.*/ - r=reverse(u) /*get the reverse of U. */ - if @.r\=='' then do; #=#+1 /*found palindrome pair?*/ - if #<6 then say @.r',' _ /*only list first 5 pals*/ - end /* [↑] bump count, show*/ - @.u=_ /*define palindromic pal*/ - end /*while*/ /* [↑] read dictionary.*/ +/*REXX program finds palindrome pairs in a dictionary (the default is UNIXDICT.TXT). */ +#=0 /*number palindromes (so far).*/ +parse arg iFID .; if iFID=='' then iFID='UNIXDICT.TXT' /*Not specified? Use default.*/ +@.= /*uppercase no─duplicated word*/ + do while lines(iFID)\==0; _=space(linein(iFID),0) /*read a word from dictionary.*/ + parse upper var _ u /*obtain an uppercase version.*/ + if length(_)<2 | @.u\=='' then iterate /*can't be a unique palindrome*/ + r=reverse(u) /*get the reverse of the word.*/ + if @.r\=='' then do; #=#+1 /*find a palindrome pair ? */ + if #<6 then say @.r',' _ /*just show 1st 5 palindromes.*/ + end /* [↑] bump palindrome count.*/ + @.u=_ /*define a unique palindrome. */ + end /*while*/ /* [↑] read the dictionary. */ say -say "There're" # 'unique palindrome pairs in the dictionary file: ' iFID - /*stick a fork in it, we're done.*/ +say "There're " # ' unique palindrome pairs in the dictionary file: ' iFID + /*stick a fork in it, we're done. */ diff --git a/Task/Semordnilap/Ruby/semordnilap.rb b/Task/Semordnilap/Ruby/semordnilap-1.rb similarity index 100% rename from Task/Semordnilap/Ruby/semordnilap.rb rename to Task/Semordnilap/Ruby/semordnilap-1.rb diff --git a/Task/Semordnilap/Ruby/semordnilap-2.rb b/Task/Semordnilap/Ruby/semordnilap-2.rb new file mode 100644 index 0000000000..3add88ca3c --- /dev/null +++ b/Task/Semordnilap/Ruby/semordnilap-2.rb @@ -0,0 +1,6 @@ +words = File.readlines("unixdict.txt") + .group_by{|x| [x.strip!, x.reverse].min} + .values + .select{|v| v.size==2} +puts "There are #{words.size} semordnilaps, of which the following are 5:" +words.take(5).each {|a,b| puts "#{a} #{b}"} diff --git a/Task/Semordnilap/SuperCollider/semordnilap-1.supercollider b/Task/Semordnilap/SuperCollider/semordnilap-1.supercollider new file mode 100644 index 0000000000..aa3774f558 --- /dev/null +++ b/Task/Semordnilap/SuperCollider/semordnilap-1.supercollider @@ -0,0 +1,12 @@ +( +var text, words, sdrow, semordnilap, selection; +File.use("unixdict.txt".resolveRelative, "r", { |f| x = text = f.readAllString }); +words = text.split(Char.nl).collect { |each| each.asSymbol }; +sdrow = text.reverse.split(Char.nl).collect { |each| each.asSymbol }; +semordnilap = sect(words, sdrow); // converted to symbols so intersection is possible +semordnilap = semordnilap.collect { |each| each.asString }; +"There are % in unixdict.txt\n".postf(semordnilap.size); +"For example those, with more than 3 characters:".postln; +selection = semordnilap.select { |each| each.size >= 4 }.scramble.keep(4); +selection.do { |each| "% %\n".postf(each, each.reverse); }; +) diff --git a/Task/Semordnilap/SuperCollider/semordnilap-2.supercollider b/Task/Semordnilap/SuperCollider/semordnilap-2.supercollider new file mode 100644 index 0000000000..c33b0276f6 --- /dev/null +++ b/Task/Semordnilap/SuperCollider/semordnilap-2.supercollider @@ -0,0 +1,6 @@ +There are 405 in unixdict.txt +For example those, with more than 3 characters: +live evil +tram mart +drib bird +eros sore diff --git a/Task/Send-an-unknown-method-call/Elena/send-an-unknown-method-call.elena b/Task/Send-an-unknown-method-call/Elena/send-an-unknown-method-call.elena new file mode 100644 index 0000000000..9b8471e6a6 --- /dev/null +++ b/Task/Send-an-unknown-method-call/Elena/send-an-unknown-method-call.elena @@ -0,0 +1,18 @@ +#import system. +#import extensions. + +#class Example +{ + #method foo : x + = x + 42. +} + +#symbol program = +[ + #var example := Example new. + #var methodSignature := "foo". + + #var result := example::(Signature new &literal:methodSignature) eval:5. + + console writeLine:methodSignature:"(":5:") = ":result. +]. diff --git a/Task/Send-an-unknown-method-call/Io/send-an-unknown-method-call.io b/Task/Send-an-unknown-method-call/Io/send-an-unknown-method-call.io new file mode 100644 index 0000000000..53ed2e3612 --- /dev/null +++ b/Task/Send-an-unknown-method-call/Io/send-an-unknown-method-call.io @@ -0,0 +1,5 @@ +Example := Object clone +Example foo := method(x, 42+x) + +name := "foo" +Example clone perform(name,5) println // prints "47" diff --git a/Task/Send-email/00DESCRIPTION b/Task/Send-email/00DESCRIPTION index f53408c05f..cd588c9533 100644 --- a/Task/Send-email/00DESCRIPTION +++ b/Task/Send-email/00DESCRIPTION @@ -1,6 +1,11 @@ -Write a function to send an email. The function should have parameters for setting From, To and Cc addresses; the Subject, and the message text, and optionally fields for the server name and login details. +;Task: +Write a function to send an email. + +The function should have parameters for setting From, To and Cc addresses; the Subject, and the message text, and optionally fields for the server name and login details. * If appropriate, explain what notifications of problems/success are given. * Solutions using libraries or functions from the language are preferred, but failing that, external programs can be used with an explanation. * Note how portable the solution given is between operating systems when multi-OS languages are used. +
    (Remember to obfuscate any sensitive data used in examples) +

    diff --git a/Task/Send-email/Factor/send-email.factor b/Task/Send-email/Factor/send-email.factor index afda093ae8..a112fd9da6 100644 --- a/Task/Send-email/Factor/send-email.factor +++ b/Task/Send-email/Factor/send-email.factor @@ -1,14 +1,8 @@ -USING: kernel accessors smtp io.sockets namespaces ; -IN: learn - -: send-mail ( from to cc subject body -- ) - "smtp.gmail.com" 587 smtp-server set - smtp-tls? on - "noneofyourbuisness@gmail.com" "password" smtp-auth set - - swap >>from - swap >>to - swap >>cc - swap >>subject - swap >>body - send-email ; +USING: accessors io.sockets locals namespaces smtp ; +IN: scratchpad +:: send-mail ( f t c s b -- ) + default-smtp-config "smtp.gmail.com" 587 >>server + t >>tls? + "my.gmail.address@gmail.com" "qwertyuiasdfghjk" + >>auth \ smtp-config set-global f >>from t >>to + c >>cc s >>subject b >>body send-email ; diff --git a/Task/Send-email/Fortran/send-email.f b/Task/Send-email/Fortran/send-email.f new file mode 100644 index 0000000000..5fa01e3bd2 --- /dev/null +++ b/Task/Send-email/Fortran/send-email.f @@ -0,0 +1,16 @@ +program sendmail + use ifcom + use msoutl + implicit none + integer(4) :: app, status, msg + + call cominitialize(status) + call comcreateobject("Outlook.Application", app, status) + msg = $Application_CreateItem(app, olMailItem, status) + call $MailItem_SetTo(msg, "somebody@somewhere", status) + call $MailItem_SetSubject(msg, "Title", status) + call $MailItem_SetBody(msg, "Hello", status) + call $MailItem_Send(msg, status) + call $Application_Quit(app, status) + call comuninitialize() +end program diff --git a/Task/Send-email/PowerShell/send-email.psh b/Task/Send-email/PowerShell/send-email.psh new file mode 100644 index 0000000000..96f64aa3d6 --- /dev/null +++ b/Task/Send-email/PowerShell/send-email.psh @@ -0,0 +1,14 @@ +[hashtable]$mailMessage = @{ + From = "weirdBoy@gmail.com" + To = "anudderBoy@YourDomain.com" + Cc = "daWaghBoss@YourDomain.com" + Attachment = "C:\temp\Waggghhhh!_plan.txt" + Subject = "Waggghhhh!" + Body = "Wagggghhhhhh!" + SMTPServer = "smtp.gmail.com" + SMTPPort = "587" + UseSsl = $true + ErrorAction = "SilentlyContinue" +} + +Send-MailMessage @mailMessage diff --git a/Task/Send-email/Python/send-email-3.py b/Task/Send-email/Python/send-email-3.py new file mode 100644 index 0000000000..592a8d523c --- /dev/null +++ b/Task/Send-email/Python/send-email-3.py @@ -0,0 +1,13 @@ +import win32com.client + +def sendmail(to, title, body): + olMailItem = 0 + ol = win32com.client.Dispatch("Outlook.Application") + msg = ol.CreateItem(olMailItem) + msg.To = to + msg.Subject = title + msg.Body = body + msg.Send() + ol.Quit() + +sendmail("somebody@somewhere", "Title", "Hello") diff --git a/Task/Send-email/R/send-email.r b/Task/Send-email/R/send-email.r new file mode 100644 index 0000000000..3ccf26d2b2 --- /dev/null +++ b/Task/Send-email/R/send-email.r @@ -0,0 +1,14 @@ +library(RDCOMClient) + +send.mail <- function(to, title, body) { + olMailItem <- 0 + ol <- COMCreate("Outlook.Application") + msg <- ol$CreateItem(olMailItem) + msg[["To"]] <- to + msg[["Subject"]] <- title + msg[["Body"]] <- body + msg$Send() + ol$Quit() +} + +send.mail("somebody@somewhere", "Title", "Hello") diff --git a/Task/Send-email/TXR/send-email.txr b/Task/Send-email/TXR/send-email.txr index f7364a3d3e..f04b259941 100644 --- a/Task/Send-email/TXR/send-email.txr +++ b/Task/Send-email/TXR/send-email.txr @@ -1,4 +1,5 @@ #!/usr/bin/txr +#!/usr/bin/txr @(next :args) @(cases) @TO @@ -11,11 +12,11 @@ @(or) @ (throw error "must specify at least To and Subject") @(end) -@(next "-") +@(next *stdin*) @(collect) @BODY @(end) -@(output `!mail -s "@SUBJ" -c "@CC" "@TO"`) +@(output (open-command `mail -s "@SUBJ" -a CC: "@CC" "@TO"` "w")) @(repeat) @BODY @(end) diff --git a/Task/Send-email/VBA/send-email.vba b/Task/Send-email/VBA/send-email.vba new file mode 100644 index 0000000000..2c2c545c47 --- /dev/null +++ b/Task/Send-email/VBA/send-email.vba @@ -0,0 +1,19 @@ +Option Explicit +Const olMailItem = 0 + +Sub SendMail(MsgTo As String, MsgTitle As String, MsgBody As String) + Dim OutlookApp As Object, Msg As Object + Set OutlookApp = CreateObject("Outlook.Application") + Set Msg = OutlookApp.CreateItem(olMailItem) + With Msg + .To = MsgTo + .Subject = MsgTitle + .Body = MsgBody + .Send + End With + Set OutlookApp = Nothing +End Sub + +Sub Test() + SendMail "somebody@somewhere", "Title", "Hello" +End Sub diff --git a/Task/Sequence-of-non-squares/00DESCRIPTION b/Task/Sequence-of-non-squares/00DESCRIPTION index 00a4ca5a0c..1a034e3ffd 100644 --- a/Task/Sequence-of-non-squares/00DESCRIPTION +++ b/Task/Sequence-of-non-squares/00DESCRIPTION @@ -1,5 +1,9 @@ +;Task: Show that the following remarkable formula gives the [http://www.research.att.com/~njas/sequences/A000037 sequence] of non-square [[wp:Natural_number|natural numbers]]: n + floor(1/2 + sqrt(n)) -* Print out the values for n in the range 1 to 22 -* Show that no squares occur for n less than one million -* This sequence is also known as [http://oeis.org/A000037 A000037]. +* Print out the values for   n   in the range   '''1'''   to   '''22''' +* Show that no squares occur for   n   less than one million + + +This sequence is also known as   [http://oeis.org/A000037 A000037]   in the '''OEIS''' database. +

    diff --git a/Task/Sequence-of-non-squares/APL/sequence-of-non-squares-1.apl b/Task/Sequence-of-non-squares/APL/sequence-of-non-squares-1.apl new file mode 100644 index 0000000000..074e42dfb6 --- /dev/null +++ b/Task/Sequence-of-non-squares/APL/sequence-of-non-squares-1.apl @@ -0,0 +1,3 @@ + NONSQUARE←{(⍳⍵)+⌊0.5+(⍳⍵)*0.5} + NONSQUARE 22 +2 3 5 6 7 8 10 11 12 13 14 15 17 18 19 20 21 22 23 24 26 27 diff --git a/Task/Sequence-of-non-squares/APL/sequence-of-non-squares-2.apl b/Task/Sequence-of-non-squares/APL/sequence-of-non-squares-2.apl new file mode 100644 index 0000000000..cb3b9faa2d --- /dev/null +++ b/Task/Sequence-of-non-squares/APL/sequence-of-non-squares-2.apl @@ -0,0 +1,3 @@ + HOWMANYSQUARES←{+⌿⍵=(⌊⍵*0.5)*2} + HOWMANYSQUARES NONSQUARE 1000000 +0 diff --git a/Task/Sequence-of-non-squares/Elixir/sequence-of-non-squares.elixir b/Task/Sequence-of-non-squares/Elixir/sequence-of-non-squares.elixir new file mode 100644 index 0000000000..e6d39d69c3 --- /dev/null +++ b/Task/Sequence-of-non-squares/Elixir/sequence-of-non-squares.elixir @@ -0,0 +1,12 @@ +f = fn n -> n + trunc(0.5 + :math.sqrt(n)) end + +IO.inspect for n <- 1..22, do: f.(n) + +n = 1_000_000 +non_squares = for i <- 1..n, do: f.(i) +m = :math.sqrt(f.(n)) |> Float.ceil |> trunc +squares = for i <- 1..m, do: i*i +case Enum.find_value(squares, fn i -> i in non_squares end) do + nil -> IO.puts "No squares found below #{n}" + val -> IO.puts "Error: number is a square: #{val}" +end diff --git a/Task/Sequence-of-non-squares/JavaScript/sequence-of-non-squares.js b/Task/Sequence-of-non-squares/JavaScript/sequence-of-non-squares-1.js similarity index 100% rename from Task/Sequence-of-non-squares/JavaScript/sequence-of-non-squares.js rename to Task/Sequence-of-non-squares/JavaScript/sequence-of-non-squares-1.js diff --git a/Task/Sequence-of-non-squares/JavaScript/sequence-of-non-squares-2.js b/Task/Sequence-of-non-squares/JavaScript/sequence-of-non-squares-2.js new file mode 100644 index 0000000000..d72774e668 --- /dev/null +++ b/Task/Sequence-of-non-squares/JavaScript/sequence-of-non-squares-2.js @@ -0,0 +1,36 @@ +(() => { + + // nonSquare :: Int -> Int + let nonSquare = n => + n + floor(1 / 2 + sqrt(n)); + + + + // floor :: Num -> Int + let floor = Math.floor, + + // sqrt :: Num -> Num + sqrt = Math.sqrt, + + // isSquare :: Int -> Bool + isSquare = n => { + let root = sqrt(n); + + return root === floor(root); + }; + + + // TEST + return { + first22: Array.from({ + length: 22 + }, (_, i) => nonSquare(i + 1)), + + firstMillionNotSquare: Array.from({ + length: 10E6 + }, (_, i) => nonSquare(i + 1)) + .filter(isSquare) + .length === 0 + }; + +})(); diff --git a/Task/Sequence-of-non-squares/JavaScript/sequence-of-non-squares-3.js b/Task/Sequence-of-non-squares/JavaScript/sequence-of-non-squares-3.js new file mode 100644 index 0000000000..dccb279d0e --- /dev/null +++ b/Task/Sequence-of-non-squares/JavaScript/sequence-of-non-squares-3.js @@ -0,0 +1,5 @@ +{ + "first22":[2, 3, 5, 6, 7, 8, 10, 11, 12, 13, 14, 15, + 17, 18, 19, 20, 21, 22, 23, 24, 26, 27], + "firstMillionNotSquare":true +} diff --git a/Task/Sequence-of-non-squares/K/sequence-of-non-squares-1.k b/Task/Sequence-of-non-squares/K/sequence-of-non-squares-1.k new file mode 100644 index 0000000000..677e898d12 --- /dev/null +++ b/Task/Sequence-of-non-squares/K/sequence-of-non-squares-1.k @@ -0,0 +1,2 @@ + nonsquare:{x+_.5+%x} + nonsquare[1_!23] diff --git a/Task/Sequence-of-non-squares/K/sequence-of-non-squares-2.k b/Task/Sequence-of-non-squares/K/sequence-of-non-squares-2.k new file mode 100644 index 0000000000..012b27bd40 --- /dev/null +++ b/Task/Sequence-of-non-squares/K/sequence-of-non-squares-2.k @@ -0,0 +1,2 @@ + issquare:{(%x)=_%x} + +/issquare[nonsquare[1_!1000001]] / Number of squares in first million results diff --git a/Task/Sequence-of-non-squares/Lua/sequence-of-non-squares.lua b/Task/Sequence-of-non-squares/Lua/sequence-of-non-squares.lua index 71bb49b84a..b1246c9616 100644 --- a/Task/Sequence-of-non-squares/Lua/sequence-of-non-squares.lua +++ b/Task/Sequence-of-non-squares/Lua/sequence-of-non-squares.lua @@ -1 +1,17 @@ -for i = 1, 22 do print(i + math.round(i^.5)) end +function nonSquare (n) + return n + math.floor(1/2 + math.sqrt(n)) +end + +for n = 1, 22 do + io.write(nonSquare(n) .. " ") +end +print() +local sr +for n = 1, 10^6 do + sr = math.sqrt(nonSquare(n)) + if sr == math.floor(sr) then + print("Result for n = " .. n .. " is square!") + os.exit() + end +end +print("No squares found") diff --git a/Task/Sequence-of-non-squares/Perl-6/sequence-of-non-squares.pl6 b/Task/Sequence-of-non-squares/Perl-6/sequence-of-non-squares.pl6 index c8e7878f38..b757da884a 100644 --- a/Task/Sequence-of-non-squares/Perl-6/sequence-of-non-squares.pl6 +++ b/Task/Sequence-of-non-squares/Perl-6/sequence-of-non-squares.pl6 @@ -1,7 +1,9 @@ -sub nth_term (Int $n) { $n + round sqrt $n } +sub nth-term (Int $n) { $n + round sqrt $n } -say nth_term $_ for 1 .. 22; +# Print the first 22 values of the sequence +say (nth-term $_ for 1 .. 22); -loop (my $i = 1; $i <= 1_000_000; $i++) { - $i.&nth_term.sqrt %% 1 and say "nth_term($i) is square."; +# Check that the first million values of the sequence are indeed non-square +for 1 .. 1_000_000 -> $i { + say "Oops, nth-term($i) is square!" if (sqrt nth-term $i) %% 1; } diff --git a/Task/Sequence-of-non-squares/Perl/sequence-of-non-squares.pl b/Task/Sequence-of-non-squares/Perl/sequence-of-non-squares.pl index 833c0733f4..fff4f8af3f 100644 --- a/Task/Sequence-of-non-squares/Perl/sequence-of-non-squares.pl +++ b/Task/Sequence-of-non-squares/Perl/sequence-of-non-squares.pl @@ -1,6 +1,8 @@ -sub nonsqr { my $n = shift; $n + int(0.5 + sqrt($n)) } +sub nonsqr { my $n = shift; $n + int(0.5 + sqrt $n) } + print join(' ', map nonsqr($_), 1..22), "\n"; + foreach my $i (1..1_000_000) { - my $j = sqrt(nonsqr($i)); - $j != int($j) or die "Found a square in the sequence: $i"; + my $root = sqrt nonsqr($i); + die "Oops, nonsqr($i) is a square!" if $root == int $root; } diff --git a/Task/Sequence-of-non-squares/REXX/sequence-of-non-squares.rexx b/Task/Sequence-of-non-squares/REXX/sequence-of-non-squares.rexx index a88ff3acbc..788f9c4d36 100644 --- a/Task/Sequence-of-non-squares/REXX/sequence-of-non-squares.rexx +++ b/Task/Sequence-of-non-squares/REXX/sequence-of-non-squares.rexx @@ -1,27 +1,32 @@ -/*REXX program displays some non─square numbers (with a validation check). */ - do j=1 for 22 - say right(j, 6) right(j + floor(1/2 + sqrt(j)), 7) +/*REXX program displays some non─square numbers, and also displays a validation check.*/ +parse arg N M . /*obtain optional arguments from the CL*/ +if N=='' | N=="," then N= 22 /*Not specified? Then use the default.*/ +if M=='' | M=="," then M= 1000000 /* " " " " " " */ +say 'The first ' N " non-square numbers:" /*display a header of what's to come. */ +say + do j=1 for N + say right(j, 6) right(j + floor(1/2 + sqrt(j)), 7) /*could use (.5+ ··· */ end /*j*/ -oops=0 - do k=1 for 1000000-1 - n=k+floor(.5+sqrt(k)) - iroot=isqrt(n) - if iroot*iroot==n then oops=oops+1 +#oops=0 + do k=1 for abs(M-1) /*have it step through a million of 'em*/ + n=k+floor( .5 + sqrt(k)) /*use the specified formula (algorithm)*/ + iRoot=iSqrt(n) /*··· and also use the ISQRT function.*/ + if iRoot*iRoot==n then #oops=#oops+1 /*have we found a mistook? (sic) */ end /*k*/ say -say oops 'squares found up to' k-1 -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -floor: procedure; parse arg x; return trunc(x- (x<0) ) -/*────────────────────────────────────────────────────────────────────────────*/ -isqrt: procedure; parse arg x; x=trunc(x); r=0; q=1 - do while q<=x; q=q*4; end - do while q>1; q=q%4; _=x-r-q; r=r%2; if _>=0 then do; x=_;r=r+q;end;end - return r /*return the integer square root of X.*/ -/*────────────────────────────────────────────────────────────────────────────*/ -sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); i=; m.=9 - numeric digits 9; numeric form; h=d+6; if x<0 then do; x=-x; i='i'; end - parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_%2 - do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ - do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ - numeric digits d; return (g/1)i /*make complex if X < 0.*/ +say 'Using the formula: floor[ 1/2 + sqrt(n) ], ' #oops " squares found up to " M'.' + /* [↑] display (possible) error count.*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +floor: procedure; parse arg x; return trunc( x - (x<0) ) +/*──────────────────────────────────────────────────────────────────────────────────────*/ +iSqrt: procedure; parse arg x; x=trunc(x); r=0; q=1 + do while q<=x; q=q*4; end + do while q>1; q=q%4; _=x-r-q; r=r%2; if _>=0 then do; x=_; r=r+q; end; end + return r /*return the integer square root of X.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); m.=9; numeric form; h=d+6 + numeric digits; parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g *.5'e'_ %2 + do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ + do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ + return g diff --git a/Task/Sequence-of-primes-by-Trial-Division/00DESCRIPTION b/Task/Sequence-of-primes-by-Trial-Division/00DESCRIPTION index 461d54472e..7812f6e9b2 100644 --- a/Task/Sequence-of-primes-by-Trial-Division/00DESCRIPTION +++ b/Task/Sequence-of-primes-by-Trial-Division/00DESCRIPTION @@ -1,7 +1,19 @@ +;Task: Generate a sequence of primes by means of trial division. -Trial division is an algorithm where a candidate number is tested for being a prime by trying to divide it by other numbers. You may use primes, or any numbers of your choosing, as long as the result is indeed a sequence of primes. -The sequence may be bounded (i.e. up to some limit), unbounded, starting from the start (i.e. 2) or above some given value. Organize your function as you wish, in particular, it might resemble a filtering operation, or a sieving operation. If you want to use a ready-made is_prime function, use one from the [[Primality by trial division]] page (i.e., add yours there if it isn't there already). +Trial division is an algorithm where a candidate number is tested for being a prime by trying to divide it by other numbers. -* Closely related to: [[Primality by trial division]], [[Sieve of Eratosthenes]]. +You may use primes, or any numbers of your choosing, as long as the result is indeed a sequence of primes. + +The sequence may be bounded (i.e. up to some limit), unbounded, starting from the start (i.e. 2) or above some given value. + +Organize your function as you wish, in particular, it might resemble a filtering operation, or a sieving operation. + +If you want to use a ready-made is_prime function, use one from the [[Primality by trial division]] page (i.e., add yours there if it isn't there already). + + +;Related tasks: +:*   [[Primality by trial division]] +:*   [[Sieve of Eratosthenes]] +

    diff --git a/Task/Sequence-of-primes-by-Trial-Division/ALGOL-68/sequence-of-primes-by-trial-division.alg b/Task/Sequence-of-primes-by-Trial-Division/ALGOL-68/sequence-of-primes-by-trial-division.alg new file mode 100644 index 0000000000..54d6c273dc --- /dev/null +++ b/Task/Sequence-of-primes-by-Trial-Division/ALGOL-68/sequence-of-primes-by-trial-division.alg @@ -0,0 +1,34 @@ +# is prime PROC from the primality by trial division task # +MODE ISPRIMEINT = INT; +PROC is prime = ( ISPRIMEINT p )BOOL: + IF p <= 1 OR ( NOT ODD p AND p/= 2) THEN + FALSE + ELSE + BOOL prime := TRUE; + FOR i FROM 3 BY 2 TO ENTIER sqrt(p) + WHILE prime := p MOD i /= 0 DO SKIP OD; + prime + FI; +# end of code from the primality by trial division task # + +# returns an array of n primes >= start # +PROC prime sequence = ( INT start, INT n )[]INT: + BEGIN + [ n ]INT seq; + INT prime count := 0; + FOR p FROM start WHILE prime count < n DO + IF is prime( p ) THEN + prime count +:= 1; + seq[ prime count ] := p + FI + OD; + seq + END; # prime sequence # + +# find 20 primes >= 30 # +[]INT primes = prime sequence( 30, 20 ); +print( ( "20 primes starting at 30: " ) ); +FOR p FROM LWB primes TO UPB primes DO + print( ( " ", whole( primes[ p ], 0 ) ) ) +OD; +print( ( newline ) ) diff --git a/Task/Sequence-of-primes-by-Trial-Division/Batch-File/sequence-of-primes-by-trial-division.bat b/Task/Sequence-of-primes-by-Trial-Division/Batch-File/sequence-of-primes-by-trial-division.bat new file mode 100644 index 0000000000..58edde710e --- /dev/null +++ b/Task/Sequence-of-primes-by-Trial-Division/Batch-File/sequence-of-primes-by-trial-division.bat @@ -0,0 +1,41 @@ +@echo off +::Prime list using trial division +:: Unbounded (well, up to 2^31-1, but you'll kill it before :) +:: skips factors of 2 and 3 in candidates and in divisors +:: uses integer square root to find max divisor to test +:: outputs numbers in rows of 10 right aligned primes +setlocal enabledelayedexpansion + +cls +echo prime list +set lin= 0: +set /a num=1, inc1=4, cnt=0 +call :line 2 +call :line 3 + + +:nxtcand +set /a num+=inc1, inc1=6-inc1,div=1, inc2=4 +call :sqrt2 %num% & set maxdiv=!errorlevel! + +:nxtdiv +set /a div+=inc2, inc2=6-inc2, res=(num%%div) +if %div% gtr !maxdiv! call :line %num% & goto nxtcand +if %res% equ 0 (goto :nxtcand ) else ( goto nxtdiv) + +:sqrt2 [num] calculates integer square root +if %1 leq 0 exit /b 0 +set /A "x=%1/(11*1024)+40, x=(%1/x+x)>>1, x=(%1/x+x)>>1, x=(%1/x+x)>>1, x=(%1/x+x)>>1, x=(%1/x+x)>>1, x+=(%1-x*x)>>31,sq=x*x +if sq gtr %1 set x-=1 +exit /b !x! +goto:eof + +:line formats output in 10 right aligned columns +set num1= %1 +set lin=!lin!%num1:~-7% +set /a cnt+=1,res1=(cnt%%10) +if %res1% neq 0 goto:eof +echo %lin% +set cnt1= !cnt! +set lin=!cnt1:~-5!: +goto:eof diff --git a/Task/Sequence-of-primes-by-Trial-Division/Clojure/sequence-of-primes-by-trial-division.clj b/Task/Sequence-of-primes-by-Trial-Division/Clojure/sequence-of-primes-by-trial-division.clj new file mode 100644 index 0000000000..299d13e810 --- /dev/null +++ b/Task/Sequence-of-primes-by-Trial-Division/Clojure/sequence-of-primes-by-trial-division.clj @@ -0,0 +1,16 @@ +(ns test-p.core + (:require [clojure.math.numeric-tower :as math])) + +(defn prime? [a] + " Uses trial division to determine if number is prime " + (not (or (< a 2) + (some #(= 0 (mod a %)) + (range 3 (inc (int (Math/ceil (math/sqrt a)))) 2))))) ; 3 to sqrt(n) stepping by 2 + +(defn primes-below [n] + " Finds primes below number n " + (for [q (range 2 (inc n)) + :when (prime? q)] + q)) + +(println (primes-below 100)) diff --git a/Task/Sequence-of-primes-by-Trial-Division/Common-Lisp/sequence-of-primes-by-trial-division.lisp b/Task/Sequence-of-primes-by-Trial-Division/Common-Lisp/sequence-of-primes-by-trial-division.lisp new file mode 100644 index 0000000000..c9f767800d --- /dev/null +++ b/Task/Sequence-of-primes-by-Trial-Division/Common-Lisp/sequence-of-primes-by-trial-division.lisp @@ -0,0 +1,12 @@ +(defun primes-up-to (max-number) + "Compute all primes up to MAX-NUMBER using trial division" + (loop for n from 2 upto max-number + when (notany (evenly-divides n) primes) + collect n into primes + finally (return primes))) + +(defun evenly-divides (n) + "Create a function that checks whether its input divides N evenly" + (lambda (x) (integerp (/ n x)))) + +(print (primes-up-to 100)) diff --git a/Task/Sequence-of-primes-by-Trial-Division/Elixir/sequence-of-primes-by-trial-division.elixir b/Task/Sequence-of-primes-by-Trial-Division/Elixir/sequence-of-primes-by-trial-division.elixir new file mode 100644 index 0000000000..b215dc21e1 --- /dev/null +++ b/Task/Sequence-of-primes-by-Trial-Division/Elixir/sequence-of-primes-by-trial-division.elixir @@ -0,0 +1,15 @@ +defmodule Prime do + def sequence do + Stream.iterate(2, &(&1+1)) |> Stream.filter(&is_prime/1) + end + + def is_prime(2), do: true + def is_prime(n) when n<2 or rem(n,2)==0, do: false + def is_prime(n), do: is_prime(n,3) + + defp is_prime(n,k) when n Enum.take(20) diff --git a/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-1.hs b/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-1.hs index 698797d55c..0e5fdda907 100644 --- a/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-1.hs +++ b/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-1.hs @@ -1 +1 @@ -primesFromTo n m = filter isPrime [n..m] +[n | n <- [2..], []==[i | i <- [2..n-1], rem n i == 0]] diff --git a/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-10.hs b/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-10.hs new file mode 100644 index 0000000000..b6c38758da --- /dev/null +++ b/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-10.hs @@ -0,0 +1,8 @@ +primesPT = sieve primesPT [2..] + where + sieve ~(p:ps) (x:xs) = x : after (p*p) xs + (sieve ps . filter ((> 0).(`rem` p))) + after q (x:xs) f | x < q = x : after q xs f + | otherwise = f (x:xs) +-- fix $ concatMap (fst.fst) . iterate (\((_,t),p:ps) -> +-- (span (< head ps^2) [x | x <- t, rem x p > 0], ps)) . (,) ([2,3],[4..]) diff --git a/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-11.hs b/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-11.hs new file mode 100644 index 0000000000..f658b8cb00 --- /dev/null +++ b/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-11.hs @@ -0,0 +1,6 @@ +import Data.List (inits) + +primesST = 2 : 3 : sieve 5 9 (drop 2 primesST) (inits $ tail primesST) + where + sieve x q ps (fs:ft) = filter (\y-> all ((/=0).rem y) fs) [x,x+2..q-2] + ++ sieve (q+2) (head ps^2) (tail ps) ft diff --git a/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-2.hs b/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-2.hs index 50a2967ae8..6ae2ed43db 100644 --- a/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-2.hs +++ b/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-2.hs @@ -1,3 +1 @@ -import Data.List (nubBy) - -primes = nubBy (((>1).).gcd) [2..] +[n | n <- [2..], []==[i | i <- [2..n-1], j <- [i,i+i..n], j==n]] diff --git a/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-3.hs b/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-3.hs index 7df982ee69..5da3c88c62 100644 --- a/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-3.hs +++ b/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-3.hs @@ -1,2 +1 @@ -primes = 2 : 3 : [n | n <- [5,7..], foldr (\p r-> p*p > n || rem n p > 0 && r) - True (drop 1 primes)] +foldr (\x r -> x : filter ((> 0).(`rem` x)) r) [] [2..] diff --git a/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-4.hs b/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-4.hs index 27786e8159..a48cb4fc56 100644 --- a/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-4.hs +++ b/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-4.hs @@ -1,5 +1 @@ -primesT = sieve [2..] - where - sieve (p:xs) = p : sieve [x | x <- xs, rem x p /= 0] --- map head --- . iterate (\(p:xs)-> filter ((>0).(`rem`p)) xs) $ [2..] +Data.List.unfoldr (\(x:xs) -> Just (x, filter ((> 0).(`rem` x)) xs)) [2..] diff --git a/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-5.hs b/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-5.hs index 75bad55f76..698797d55c 100644 --- a/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-5.hs +++ b/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-5.hs @@ -1,6 +1 @@ -primesTo m = 2 : sieve [3,5..m] - where - sieve (p:xs) | p*p > m = p : xs - | otherwise = p : sieve [x | x <- xs, rem x p /= 0] --- map fst a ++ b:c where (a,(b,c):_) = span ((< m).(^2).fst) --- . iterate (\(_,p:xs)-> (p, [x | x <- xs, rem x p /= 0])) $ (2, [3,5..m]) +primesFromTo n m = filter isPrime [n..m] diff --git a/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-6.hs b/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-6.hs index 62a5e6ede6..f4445a09da 100644 --- a/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-6.hs +++ b/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-6.hs @@ -1,8 +1,3 @@ -primesPT = 2 : 3 : sieve [5,7..] 9 (tail primesPT) - where - sieve (x:xs) q ps@(p:t) - | x < q = x : sieve xs q ps -- inlined (span (< q)) - | otherwise = sieve [y | y <- xs, rem y p /= 0] (head t^2) t --- fix $ (2:) . concatMap (fst.snd) --- . iterate (\(p:t,(h,xs)) -> (t,span (< head t^2) [y | y <- xs, rem y p /= 0])) --- . (, ([3],[4..])) +-- primes = filter isPrime [2..] +primes = 2 : [n | n <- [3..], foldr (\p r-> p*p > n || rem n p > 0 && r) + True primes] diff --git a/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-7.hs b/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-7.hs index f658b8cb00..dd770417d7 100644 --- a/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-7.hs +++ b/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-7.hs @@ -1,6 +1,6 @@ -import Data.List (inits) - -primesST = 2 : 3 : sieve 5 9 (drop 2 primesST) (inits $ tail primesST) - where - sieve x q ps (fs:ft) = filter (\y-> all ((/=0).rem y) fs) [x,x+2..q-2] - ++ sieve (q+2) (head ps^2) (tail ps) ft +primes = 2 : 3 : [n | n <- [5,7..], foldr (\p r-> p*p > n || rem n p > 0 && r) + True (drop 1 primes)] + = [2,3,5] ++ [n | n <- scanl (+) 7 (cycle [4,2]), + foldr (\p r-> p*p > n || rem n p > 0 && r) + True (drop 2 primes)] + -- = [2,3,5,7] ++ [n | n <- scanl (+) 11 (cycle [2,4,2,4,6,2,6,4]), ... (drop 3 primes)] diff --git a/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-8.hs b/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-8.hs new file mode 100644 index 0000000000..c0348c5acc --- /dev/null +++ b/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-8.hs @@ -0,0 +1,5 @@ +primesT = sieve [2..] + where + sieve (p:xs) = p : sieve [x | x <- xs, rem x p /= 0] +-- map head +-- . iterate (\(p:xs) -> filter ((> 0).(`rem` p)) xs) $ [2..] diff --git a/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-9.hs b/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-9.hs new file mode 100644 index 0000000000..e414e759a8 --- /dev/null +++ b/Task/Sequence-of-primes-by-Trial-Division/Haskell/sequence-of-primes-by-trial-division-9.hs @@ -0,0 +1,6 @@ +primesTo m = sieve [2..m] + where + sieve (p:xs) | p*p > m = p : xs + | otherwise = p : sieve [x | x <- xs, rem x p /= 0] +-- (\(a,b:_) -> map head a ++ b) . span ((< m).(^2).head) +-- $ iterate (\(p:xs) -> filter ((>0).(`rem`p)) xs) [2..m] diff --git a/Task/Sequence-of-primes-by-Trial-Division/Java/sequence-of-primes-by-trial-division.java b/Task/Sequence-of-primes-by-Trial-Division/Java/sequence-of-primes-by-trial-division.java new file mode 100644 index 0000000000..97e5320eba --- /dev/null +++ b/Task/Sequence-of-primes-by-Trial-Division/Java/sequence-of-primes-by-trial-division.java @@ -0,0 +1,25 @@ +import java.util.stream.IntStream; + +public class Test { + + static IntStream getPrimes(int start, int end) { + return IntStream.rangeClosed(start, end).filter(n -> isPrime(n)); + } + + public static boolean isPrime(long x) { + if (x < 3 || x % 2 == 0) + return x == 2; + + long max = (long) Math.sqrt(x); + for (long n = 3; n <= max; n += 2) { + if (x % n == 0) { + return false; + } + } + return true; + } + + public static void main(String[] args) { + getPrimes(0, 100).forEach(p -> System.out.printf("%d, ", p)); + } +} diff --git a/Task/Sequence-of-primes-by-Trial-Division/Liberty-BASIC/sequence-of-primes-by-trial-division.liberty b/Task/Sequence-of-primes-by-Trial-Division/Liberty-BASIC/sequence-of-primes-by-trial-division.liberty new file mode 100644 index 0000000000..e3a7035455 --- /dev/null +++ b/Task/Sequence-of-primes-by-Trial-Division/Liberty-BASIC/sequence-of-primes-by-trial-division.liberty @@ -0,0 +1,20 @@ +print "Rosetta Code - Sequence of primes by trial division" +print: print "Prime numbers between 1 and 50" +for x=1 to 50 + if isPrime(x) then print x +next x +[start] +input "Enter an integer: "; x +if x=0 then print "Program complete.": end +if isPrime(x) then print x; " is prime" else print x; " is not prime" +goto [start] + +function isPrime(p) + p=int(abs(p)) + if p=2 or then isPrime=1: exit function 'prime + if p=0 or p=1 or (p mod 2)=0 then exit function 'not prime + for i=3 to sqr(p) step 2 + if (p mod i)=0 then exit function 'not prime + next i + isPrime=1 +end function diff --git a/Task/Sequence-of-primes-by-Trial-Division/Lua/sequence-of-primes-by-trial-division.lua b/Task/Sequence-of-primes-by-Trial-Division/Lua/sequence-of-primes-by-trial-division.lua index 71d71bc0b5..5c8759b712 100644 --- a/Task/Sequence-of-primes-by-Trial-Division/Lua/sequence-of-primes-by-trial-division.lua +++ b/Task/Sequence-of-primes-by-Trial-Division/Lua/sequence-of-primes-by-trial-division.lua @@ -1,16 +1,33 @@ -function isPrime (n) -- Function to test primality by trial division - if n < 2 then return false end - if n < 4 then return true end - if n % 2 == 0 then return false end - for d = 3, math.sqrt(n), 2 do - if n % d == 0 then return false end - end - return true +-- Returns true if x is prime, and false otherwise +function isprime (x) + if x < 2 then return false end + if x < 4 then return true end + if x % 2 == 0 then return false end + for d = 3, math.sqrt(x), 2 do + if x % d == 0 then return false end + end + return true end -local start = arg[1] or 1 -- Default limits may be overridden with -local bound = arg[2] or 100 -- command line arguments, for example: - -- lua primes.lua 1000 2000 -for i = start, bound do - if isPrime(i) then io.write(i .. " ") end +-- Returns table of prime numbers (from lo, if specified) up to hi +function primes (lo, hi) + local t = {} + if not hi then + hi = lo + lo = 2 + end + for n = lo, hi do + if isprime(n) then table.insert(t, n) end + end + return t end + +-- Show all the values of a table in one line +function show (x) + for _, v in pairs(x) do io.write(v .. " ") end + print() +end + +-- Main procedure +show(primes(100)) +show(primes(50, 150)) diff --git a/Task/Sequence-of-primes-by-Trial-Division/REXX/sequence-of-primes-by-trial-division-1.rexx b/Task/Sequence-of-primes-by-Trial-Division/REXX/sequence-of-primes-by-trial-division-1.rexx index f1c6e6e7dc..77473f3510 100644 --- a/Task/Sequence-of-primes-by-Trial-Division/REXX/sequence-of-primes-by-trial-division-1.rexx +++ b/Task/Sequence-of-primes-by-Trial-Division/REXX/sequence-of-primes-by-trial-division-1.rexx @@ -1,18 +1,18 @@ -/*REXX pgm lists a sequence of primes by testing primality by trial div.*/ -parse arg n . /*let user choose how many, maybe*/ -if n=='' then n=26 /*if not, then assume the default*/ -tell=n>0; n=abs(n) /*N is negative? Don't display.*/ -@.1=2; if tell then say right(@.1,9) /*display 2 as a special case. */ -#=1 /*# is the number of primes found*/ - /* [↑] N default lists up to 101*/ - do j=3 by 2 while #0); n=abs(n) /*Is N negative? Then don't display.*/ +@.1=2; if tell then say right(@.1, 9) /*display 2 as a special prime case. */ +#=1 /*# is number of primes found (so far)*/ + /* [↑] N: default lists up to 101 #s.*/ + do j=3 by 2 while #0; n=abs(n) /*N is negative? Then don't display. */ -@.1=2; @.2=3; @.3=5; @.4=7; @.5=11; @.6=13; #=5; s=@.#+2 - /* [↑] is the number of low primes. */ - do p=1 for # while p<=n /* [↓] find primes, but don't show 'em*/ - if tell then say right(@.p,9) /*display some pre-defined low primes. */ - !.p=@.p**2 /*also compute the squared value of P. */ - end /*p*/ /* [↑] allows faster loop (below). */ - /* [↓] N: default lists up to 101 #s.*/ - do j=s by 2 while #0); n=abs(n) /*N is negative? Then don't display. */ +@.1=2; @.2=3; @.3=5; @.4=7; @.5=11; @.6=13; #=5; s=@.#+2 + /* [↑] is the number of low primes.*/ + do p=1 for # while p<=n /* [↓] find primes, but don't show 'em*/ + if tell then say right(@.p, 9) /*display some pre-defined low primes. */ + !.p=@.p**2 /*also compute the squared value of P. */ + end /*p*/ /* [↑] allows faster loop (below). */ + /* [↓] N: default lists up to 101 #s.*/ + do j=s by 2 while #2 then the result is the same as repeatedly replacing all combinations of two sets by their consolidation until no further consolidation between set pairs is possible. +
    Given N sets of items where N>2 then the result is the same as repeatedly replacing all combinations of two sets by their consolidation until no further consolidation between set pairs is possible. If N<2 then consolidation has no strict meaning and the input can be returned. ;'''Example 1:''' @@ -16,6 +16,7 @@ If N<2 then consolidation has no strict meaning and the input can be returned. ::{H,I,K}, {A,B}, {C,D}, {D,B}, and {F,G,H} :Is the two sets: ::{A, C, B, D}, and {G, F, I, H, K} - -'''See also:''' +
    +'''See also''' * [[wp:Connected component (graph theory)|Connected component (graph theory)]] +

    diff --git a/Task/Set-consolidation/C-sharp/set-consolidation.cs b/Task/Set-consolidation/C-sharp/set-consolidation.cs new file mode 100644 index 0000000000..717a52e16c --- /dev/null +++ b/Task/Set-consolidation/C-sharp/set-consolidation.cs @@ -0,0 +1,107 @@ +using System; +using System.Linq; +using System.Collections.Generic; + +public class SetConsolidation +{ + public static void Main() + { + var setCollection1 = new[] {new[] {"A", "B"}, new[] {"C", "D"}}; + var setCollection2 = new[] {new[] {"A", "B"}, new[] {"B", "D"}}; + var setCollection3 = new[] {new[] {"A", "B"}, new[] {"C", "D"}, new[] {"B", "D"}}; + var setCollection4 = new[] {new[] {"H", "I", "K"}, new[] {"A", "B"}, new[] {"C", "D"}, + new[] {"D", "B"}, new[] {"F", "G", "H"}}; + var input = new[] {setCollection1, setCollection2, setCollection3, setCollection4}; + + foreach (var sets in input) { + Console.WriteLine("Start sets:"); + Console.WriteLine(string.Join(", ", sets.Select(s => "{" + string.Join(", ", s) + "}"))); + Console.WriteLine("Sets consolidated using Nodes:"); + Console.WriteLine(string.Join(", ", ConsolidateSets1(sets).Select(s => "{" + string.Join(", ", s) + "}"))); + Console.WriteLine("Sets consolidated using Set operations:"); + Console.WriteLine(string.Join(", ", ConsolidateSets2(sets).Select(s => "{" + string.Join(", ", s) + "}"))); + Console.WriteLine(); + } + } + + /// + /// Consolidates sets using a connected-component-finding-algorithm involving Nodes with parent pointers. + /// The more efficient solution, but more elaborate code. + /// + private static IEnumerable> ConsolidateSets1(IEnumerable> sets, + IEqualityComparer comparer = null) + { + if (comparer == null) comparer = EqualityComparer.Default; + var elements = new Dictionary>(); + foreach (var set in sets) { + Node top = null; + foreach (T value in set) { + Node element; + if (elements.TryGetValue(value, out element)) { + if (top != null) { + var newTop = element.FindTop(); + top.Parent = newTop; + element.Parent = newTop; + top = newTop; + } else { + top = element.FindTop(); + } + } else { + elements.Add(value, element = new Node(value)); + if (top == null) top = element; + else element.Parent = top; + } + } + } + foreach (var g in elements.Values.GroupBy(element => element.FindTop().Value)) + yield return g.Select(e => e.Value); + } + + private class Node + { + public Node(T value, Node parent = null) { + Value = value; + Parent = parent ?? this; + } + + public T Value { get; } + public Node Parent { get; set; } + + public Node FindTop() { + var top = this; + while (top != top.Parent) top = top.Parent; + //Set all parents to the top element to prevent repeated iteration in the future + var element = this; + while (element.Parent != top) { + var parent = element.Parent; + element.Parent = top; + element = parent; + } + return top; + } + } + + /// + /// Consolidates sets using operations on the HashSet<T> class. + /// Less efficient than the other method, but easier to write. + /// + private static IEnumerable> ConsolidateSets2(IEnumerable> sets, + IEqualityComparer comparer = null) + { + if (comparer == null) comparer = EqualityComparer.Default; + var currentSets = sets.Select(s => new HashSet(s)).ToList(); + int previousSize; + do { + previousSize = currentSets.Count; + for (int i = 0; i < currentSets.Count - 1; i++) { + for (int j = currentSets.Count - 1; j > i; j--) { + if (currentSets[i].Overlaps(currentSets[j])) { + currentSets[i].UnionWith(currentSets[j]); + currentSets.RemoveAt(j); + } + } + } + } while (previousSize > currentSets.Count); + foreach (var set in currentSets) yield return set.Select(value => value); + } +} diff --git a/Task/Set-consolidation/Ela/set-consolidation-2.ela b/Task/Set-consolidation/Ela/set-consolidation-2.ela index ce9b3f5fa7..1bdadabdfe 100644 --- a/Task/Set-consolidation/Ela/set-consolidation-2.ela +++ b/Task/Set-consolidation/Ela/set-consolidation-2.ela @@ -1,4 +1,9 @@ -open console +open monad io -consolidate [['H','I','K'], ['A','B'], ['C','D'], ['D','B'], ['F','G','H']] |> writen $ - consolidate [['A','B'], ['B','D']] |> writen +:::IO + +do + x <- return $ consolidate [['H','I','K'], ['A','B'], ['C','D'], ['D','B'], ['F','G','H']] + putLn x + y <- return $ consolidate [['A','B'], ['B','D']] + putLn y diff --git a/Task/Set-consolidation/Elixir/set-consolidation.elixir b/Task/Set-consolidation/Elixir/set-consolidation.elixir new file mode 100644 index 0000000000..80aaea6a60 --- /dev/null +++ b/Task/Set-consolidation/Elixir/set-consolidation.elixir @@ -0,0 +1,23 @@ +defmodule RC do + def set_consolidate(sets, result\\[]) + def set_consolidate([], result), do: result + def set_consolidate([h|t], result) do + case Enum.find(t, fn set -> not MapSet.disjoint?(h, set) end) do + nil -> set_consolidate(t, [h | result]) + set -> set_consolidate([MapSet.union(h, set) | t -- [set]], result) + end + end +end + +examples = [[[:A,:B], [:C,:D]], + [[:A,:B], [:B,:D]], + [[:A,:B], [:C,:D], [:D,:B]], + [[:H,:I,:K], [:A,:B], [:C,:D], [:D,:B], [:F,:G,:H]]] + |> Enum.map(fn sets -> + Enum.map(sets, fn set -> MapSet.new(set) end) + end) + +Enum.each(examples, fn sets -> + IO.write "#{inspect sets} =>\n\t" + IO.inspect RC.set_consolidate(sets) +end) diff --git a/Task/Set-consolidation/Perl/set-consolidation.pl b/Task/Set-consolidation/Perl/set-consolidation.pl new file mode 100644 index 0000000000..b80866076e --- /dev/null +++ b/Task/Set-consolidation/Perl/set-consolidation.pl @@ -0,0 +1,47 @@ +use strict; +use English; +use Smart::Comments; + +my @ex1 = consolidate( (['A', 'B'], ['C', 'D']) ); +### Example 1: @ex1 +my @ex2 = consolidate( (['A', 'B'], ['B', 'D']) ); +### Example 2: @ex2 +my @ex3 = consolidate( (['A', 'B'], ['C', 'D'], ['D', 'B']) ); +### Example 3: @ex3 +my @ex4 = consolidate( (['H', 'I', 'K'], ['A', 'B'], ['C', 'D'], ['D', 'B'], ['F', 'G', 'H']) ); +### Example 4: @ex4 +exit 0; + +sub consolidate { + scalar(@ARG) >= 2 or return @ARG; + my @result = ( shift(@ARG) ); + my @recursion = consolidate(@ARG); + foreach my $r (@recursion) { + if (set_intersection($result[0], $r)) { + $result[0] = [ set_union($result[0], $r) ]; + } + else { + push @result, $r; + } + } + return @result; +} + +sub set_union { + my ($a, $b) = @ARG; + my %union; + foreach my $a_elt (@{$a}) { $union{$a_elt}++; } + foreach my $b_elt (@{$b}) { $union{$b_elt}++; } + return keys(%union); +} + +sub set_intersection { + my ($a, $b) = @ARG; + my %a_hash; + foreach my $a_elt (@{$a}) { $a_hash{$a_elt}++; } + my @result; + foreach my $b_elt (@{$b}) { + push(@result, $b_elt) if exists($a_hash{$b_elt}); + } + return @result; +} diff --git a/Task/Set-consolidation/REXX/set-consolidation.rexx b/Task/Set-consolidation/REXX/set-consolidation.rexx index 3af64313f4..aec679d0ec 100644 --- a/Task/Set-consolidation/REXX/set-consolidation.rexx +++ b/Task/Set-consolidation/REXX/set-consolidation.rexx @@ -1,52 +1,52 @@ -/*REXX program demonstrates a method of consolidating some sample sets. */ +/*REXX program demonstrates a method of consolidating some sample sets. */ @.=; @.1 = '{A,B} {C,D}' @.2 = "{A,B} {B,D}" @.3 = '{A,B} {C,D} {D,B}' @.4 = '{H,I,K} {A,B} {C,D} {D,B} {F,G,H}' @.5 = '{snow,ice,slush,frost,fog} {icebergs,icecubes} {rain,fog,sleet}' - do j=1 while @.j\=='' /*traipse through each of sample sets. */ - call SETconsolidate @.j /*have the function do the heavy work. */ + do j=1 while @.j\=='' /*traipse through each of sample sets. */ + call SETconsolidate @.j /*have the function do the heavy work. */ end /*j*/ -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────ISIN SUBRoutine───────────────────────────*/ -isIn: return wordpos(arg(1), arg(2))\==0 /*is (word) arg1 in set arg2 ? */ -/*──────────────────────────────────SETCONSOLIDATE subroutine─────────────────*/ -SETconsolidate: procedure; parse arg old,new; #=words(old) /*nullify NEW.*/ -say ' the old set=' space(old) +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +isIn: return wordpos(arg(1), arg(2))\==0 /*is (word) argument 1 in the set arg2?*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +SETconsolidate: procedure; parse arg old; #=words(old); new= + say ' the old set=' space(old) - do k=1 for # /* [↓] change all commas to a blank. */ - !.k=translate(word(old,k), , '},{') /*create a list of words (aka, a set).*/ - end /*k*/ /* [↑] ··· and also remove the braces.*/ + do k=1 for # /* [↓] change all commas to a blank. */ + !.k=translate(word(old,k), , '},{') /*create a list of words (aka, a set).*/ + end /*k*/ /* [↑] ··· and also remove the braces.*/ - do until \changed; changed=0 /*consolidate some sets (well, maybe).*/ - do set=1 for #-1 - do item=1 for words(!.set); x=word(!.set,item) - do other=set+1 to # - if isIn(x,!.other) then do; changed=1 /*has changed*/ - !.set=!.set !.other; !.other= - iterate set - end - end /*other*/ - end /*item */ - end /*set */ - end /*until*/ - /* ╔╦══════════════════════════════════════════════════elide any duplicates.*/ - do set=1 for #; $= /*nullify $ */ - do items=1 for words(!.set); x=word(!.set, items) - if x==',' then iterate; if x=='' then leave - $=$ x /*build new. */ - do until \isIn(x, !.set) - _=wordpos(x, !.set) - !.set=subword(!.set,1,_-1) ',' subword(!.set,_+1) /*purify set.*/ - end /*until ¬isIn ··· */ - end /*items*/ - !.set=translate(strip($), ',', " ") - end /*set*/ + do until \changed; changed=0 /*consolidate some sets (well, maybe).*/ + do set=1 for #-1 + do item=1 for words(!.set); x=word(!.set, item) + do other=set+1 to # + if isIn(x, !.other) then do; changed=1 /*it's changed*/ + !.set=!.set !.other; !.other= + iterate set + end + end /*other*/ + end /*item */ + end /*set */ + end /*until ¬changed*/ - do i=1 for #; if !.i=='' then iterate - new=space(new '{'!.i"}") - end /*i*/ + do set=1 for #; $= /*elide dups*/ + do items=1 for words(!.set); x=word(!.set, items) + if x==',' then iterate; if x=='' then leave + $=$ x /*build new. */ + do until \isIn(x, !.set) + _=wordpos(x, !.set) + !.set=subword(!.set, 1, _-1) ',' subword(!.set, _+1) /*purify set*/ + end /*until ¬isIn ··· */ + end /*items*/ + !.set=translate(strip($), ',', " ") + end /*set*/ -say ' the new set=' new; say -return + do i=1 for #; if !.i=='' then iterate /*ignore any set that is a null set. */ + new=space(new '{'!.i"}") /*prepend and append a set identifier. */ + end /*i*/ + + say ' the new set=' new; say + return diff --git a/Task/Set-consolidation/TXR/set-consolidation-1.txr b/Task/Set-consolidation/TXR/set-consolidation-1.txr index 6208b8643a..815561ecb5 100644 --- a/Task/Set-consolidation/TXR/set-consolidation-1.txr +++ b/Task/Set-consolidation/TXR/set-consolidation-1.txr @@ -1,26 +1,25 @@ -@(do - (defun mkset (p x) (set [p x] (or [p x] x))) +(defun mkset (p x) (set [p x] (or [p x] x))) - (defun fnd (p x) (if (eq [p x] x) x (fnd p [p x]))) +(defun fnd (p x) (if (eq [p x] x) x (fnd p [p x]))) - (defun uni (p x y) - (let ((xr (fnd p x)) (yr (fnd p y))) - (set [p xr] yr))) +(defun uni (p x y) + (let ((xr (fnd p x)) (yr (fnd p y))) + (set [p xr] yr))) - (defun consoli (sets) - (let ((p (hash))) - (each ((s sets)) - (each ((e s)) - (mkset p e) - (uni p e (car s)))) - (hash-values - [group-by (op fnd p) (hash-keys - [group-by identity (flatten sets)])]))) +(defun consoli (sets) + (let ((p (hash))) + (each ((s sets)) + (each ((e s)) + (mkset p e) + (uni p e (car s)))) + (hash-values + [group-by (op fnd p) (hash-keys + [group-by identity (flatten sets)])]))) - ;; tests +;; tests - (each ((test '(((a b) (c d)) - ((a b) (b d)) - ((a b) (c d) (d b)) - ((h i k) (a b) (c d) (d b) (f g h))))) - (format t "~s -> ~s\n" test (consoli test)))) +(each ((test '(((a b) (c d)) + ((a b) (b d)) + ((a b) (c d) (d b)) + ((h i k) (a b) (c d) (d b) (f g h))))) + (format t "~s -> ~s\n" test (consoli test))) diff --git a/Task/Set-consolidation/TXR/set-consolidation-2.txr b/Task/Set-consolidation/TXR/set-consolidation-2.txr index 2ee935f256..bce2ca7116 100644 --- a/Task/Set-consolidation/TXR/set-consolidation-2.txr +++ b/Task/Set-consolidation/TXR/set-consolidation-2.txr @@ -1,21 +1,20 @@ -@(do - (defun mkset (items) [group-by identity items]) +(defun mkset (items) [group-by identity items]) - (defun empty-p (set) (zerop (hash-count set))) +(defun empty-p (set) (zerop (hash-count set))) - (defun consoli (ss) - (defun comb (cs s) - (cond ((empty-p s) cs) - ((null cs) (list s)) - ((empty-p (hash-isec s (first cs))) - (cons (first cs) (comb (rest cs) s))) - (t (consoli (cons (hash-uni s (first cs)) (rest cs)))))) - [reduce-left comb ss nil]) +(defun consoli (ss) + (defun combi (cs s) + (cond ((empty-p s) cs) + ((null cs) (list s)) + ((empty-p (hash-isec s (first cs))) + (cons (first cs) (combi (rest cs) s))) + (t (consoli (cons (hash-uni s (first cs)) (rest cs)))))) + [reduce-left combi ss nil]) - ;; tests - (each ((test '(((a b) (c d)) - ((a b) (b d)) - ((a b) (c d) (d b)) - ((h i k) (a b) (c d) (d b) (f g h))))) - (format t "~s -> ~s\n" test - [mapcar hash-keys (consoli [mapcar mkset test])]))) +;; tests +(each ((test '(((a b) (c d)) + ((a b) (b d)) + ((a b) (c d) (d b)) + ((h i k) (a b) (c d) (d b) (f g h))))) + (format t "~s -> ~s\n" test + [mapcar hash-keys (consoli [mapcar mkset test])])) diff --git a/Task/Set-of-real-numbers/Elena/set-of-real-numbers.elena b/Task/Set-of-real-numbers/Elena/set-of-real-numbers.elena new file mode 100644 index 0000000000..80bc24e392 --- /dev/null +++ b/Task/Set-of-real-numbers/Elena/set-of-real-numbers.elena @@ -0,0 +1,38 @@ +#import system. +#import extensions. + +#class(extension)setOp +{ + #method union : func + = val [ self eval:val || func eval:val ]. + + #method intersection : func + = val [ self eval:val && func eval:val ]. + + #method difference : func + = val [ self eval:val && func eval:val not ]. +} + +#symbol program = +[ + // union + #var set := x [ (x >= 0.0r) && (x <= 1.0r) ] union: x [ (x >= 0.0r) && (x < 2.0r) ]. + + set eval:0.0r assert &ifTrue. + set eval:1.0r assert &ifTrue. + set eval:2.0r assert &ifFalse. + + // intersection + #var set2 := x [ (x >= 0.0r) && (x < 2.0r) ] intersection: x [ (x >= 1.0r) && (x <= 2.0r) ]. + + set2 eval:0.0r assert &ifFalse. + set2 eval:1.0r assert &ifTrue. + set2 eval:2.0r assert &ifFalse. + + // difference + #var set3 := x [ (x >= 0.0r) && (x < 3.0r) ] difference: x [ (x >= 0.0r) && (x <= 1.0r) ]. + + set3 eval:0.0r assert &ifFalse. + set3 eval:1.0r assert &ifFalse. + set3 eval:2.0r assert &ifTrue. +]. diff --git a/Task/Set-of-real-numbers/J/set-of-real-numbers-1.j b/Task/Set-of-real-numbers/J/set-of-real-numbers-1.j index 606f659e2f..4883a2c8ee 100644 --- a/Task/Set-of-real-numbers/J/set-of-real-numbers-1.j +++ b/Task/Set-of-real-numbers/J/set-of-real-numbers-1.j @@ -12,7 +12,6 @@ interval=: 3 :0 (lo&(<`<:@.cL) *. hi&(>`>:@.cH))ing ) -in=: 4 :'y has x' union=: 4 :'(x has +. y has)ing' intersect=: 4 :'(x has *. y has)ing' without=: 4 :'(x has *. [: -. y has)ing' diff --git a/Task/Set-of-real-numbers/J/set-of-real-numbers-4.j b/Task/Set-of-real-numbers/J/set-of-real-numbers-4.j index afbf3b4725..74833b64a1 100644 --- a/Task/Set-of-real-numbers/J/set-of-real-numbers-4.j +++ b/Task/Set-of-real-numbers/J/set-of-real-numbers-4.j @@ -16,8 +16,8 @@ interval=: 3 :0 (lo&(<`<:@.cL) *. hi&(>`>:@.cH))ing ; lo,hi ) -in=: 4 :'y has x' union=: 4 :'(x has +. y has)ing; x edges y' intersect=: 4 :'(x has *. y has)ing; x edges y' without=: 4 :'(x has *. [: -. y has)ing; x edges y' +in=: 4 :'y has x' isEmpty=: 1 -.@e. contour in ] diff --git a/Task/Set-puzzle/00DESCRIPTION b/Task/Set-puzzle/00DESCRIPTION index f2ede9c7b0..adbd305542 100644 --- a/Task/Set-puzzle/00DESCRIPTION +++ b/Task/Set-puzzle/00DESCRIPTION @@ -1,29 +1,28 @@ {{omit from|GUISS}} -Set Puzzles are created with a deck of cards from the [[wp:Set (game)|Set Game™]]. The object of the puzzle is to find sets of 3 cards in a rectangle of cards that have been dealt face up.
    +Set Puzzles are created with a deck of cards from the [[wp:Set (game)|Set Game™]]. The object of the puzzle is to find sets of 3 cards in a rectangle of cards that have been dealt face up.

    There are 81 cards in a deck. Each card contains a unique variation of the following four features: ''color, symbol, number and shading''. -; there are three colors: '''red''', '''green''', or '''purple''' +* there are three colors:
       ''red, green, purple''

    -; there are three symbols: '''oval''', '''squiggle''', or '''diamond''' +* there are three symbols:
       ''oval, squiggle, diamond''

    -; there is a number of symbols on the card: '''one''', '''two''', or '''three''' +* there is a number of symbols on the card:
       ''one, two, three''

    -; there are three shadings: '''solid''', '''open''', or '''striped''' +* there are three shadings:
       ''solid, open, striped''

    -Three cards form a ''set'' if each feature is either the same on each card, or is different on each card.
    -For instance: all 3 cards are red, all 3 cards have a different symbol, all 3 cards have a different number of symbols, all 3 cards are striped. +Three cards form a ''set'' if each feature is either the same on each card, or is different on each card. For instance: all 3 cards are red, all 3 cards have a different symbol, all 3 cards have a different number of symbols, all 3 cards are striped. + +There are two degrees of difficulty: [http://www.setgame.com/set/rules_basic.htm ''basic''] and [http://www.setgame.com/set/rules_advanced.htm ''advanced'']. The basic mode deals 9 cards, that contain exactly 4 sets; the advanced mode deals 12 cards that contain exactly 6 sets. -There are two degrees of difficulty: [http://www.setgame.com/set/rules_basic.htm ''basic''] and [http://www.setgame.com/set/rules_advanced.htm ''advanced''].
    -The basic mode deals 9 cards, that contain exactly 4 sets; -the advanced mode deals 12 cards that contain exactly 6 sets. When creating sets you may use the same card more than once. +

    -;The task: -Is to write code that deals the cards (9 or 12, depending on selected mode) from a shuffled deck in which the total number of sets that could be found is 4 (or 6, respectively); and print the contents of the cards and the sets. +;Task +Write code that deals the cards (9 or 12, depending on selected mode) from a shuffled deck in which the total number of sets that could be found is 4 (or 6, respectively); and print the contents of the cards and the sets. -For instance: +For instance:

    '''DEALT 9 CARDS:''' @@ -44,7 +43,7 @@ For instance: :red, three, oval, open :red, three, diamond, solid - +
    '''CONTAINING 4 SETS:''' :green, one, oval, striped @@ -73,3 +72,4 @@ For instance: :purple, two, squiggle, open :purple, three, oval, open +

    diff --git a/Task/Set-puzzle/Elixir/set-puzzle.elixir b/Task/Set-puzzle/Elixir/set-puzzle.elixir new file mode 100644 index 0000000000..a1f5de7dd6 --- /dev/null +++ b/Task/Set-puzzle/Elixir/set-puzzle.elixir @@ -0,0 +1,54 @@ +defmodule RC do + def set_puzzle(deal, goal) do + {puzzle, sets} = get_puzzle_and_answer(deal, goal, produce_deck) + IO.puts "Dealt #{length(puzzle)} cards:" + print_cards(puzzle) + IO.puts "Containing #{length(sets)} sets:" + Enum.each(sets, fn set -> print_cards(set) end) + end + + defp get_puzzle_and_answer(hand_size, num_sets_goal, deck) do + hand = Enum.take_random(deck, hand_size) + sets = get_all_sets(hand) + if length(sets) == num_sets_goal do + {hand, sets} + else + get_puzzle_and_answer(hand_size, num_sets_goal, deck) + end + end + + defp get_all_sets(hand) do + Enum.filter(comb(hand, 3), fn candidate -> + List.flatten(candidate) + |> Enum.group_by(&(&1)) + |> Map.values + |> Enum.all?(fn v -> length(v) != 2 end) + end) + end + + defp print_cards(cards) do + Enum.each(cards, fn card -> + :io.format " ~-8s ~-8s ~-8s ~-8s~n", card + end) + IO.puts "" + end + + @colors ~w(red green purple)a + @symbols ~w(oval squiggle diamond)a + @numbers ~w(one two three)a + @shadings ~w(solid open striped)a + + defp produce_deck do + for color <- @colors, symbol <- @symbols, number <- @numbers, shading <- @shadings, + do: [color, symbol, number, shading] + end + + defp comb(_, 0), do: [[]] + defp comb([], _), do: [] + defp comb([h|t], m) do + (for l <- comb(t, m-1), do: [h|l]) ++ comb(t, m) + end +end + +RC.set_puzzle(9, 4) +RC.set_puzzle(12, 6) diff --git a/Task/Set/00DESCRIPTION b/Task/Set/00DESCRIPTION index b26872fe6a..1358650296 100644 --- a/Task/Set/00DESCRIPTION +++ b/Task/Set/00DESCRIPTION @@ -1,6 +1,8 @@ {{data structure}} -A set is a collection of elements, without duplicates and without order. +A   '''set'''  is a collection of elements, without duplicates and without order. + +;Task: Show each of these set operations: * Set creation @@ -9,13 +11,21 @@ Show each of these set operations: * A ∩ B -- ''intersection''; a set of all elements in ''both'' set A and set B. * A ∖ B -- ''difference''; a set of all elements in set A, except those in set B. * A ⊆ B -- ''subset''; true if every element in set A is also in set B. -* A = B -- ''equality''; true if every element of set A is in set B and vice-versa. +* A = B -- ''equality''; true if every element of set A is in set B and vice versa. + +
    +As an option, show some other set operations. +
    (If A ⊆ B, but A ≠ B, then A is called a true or proper subset of B, written A ⊂ B or A ⊊ B.) -As an option, show some other set operations. (If A ⊆ B, but A ≠ B, then A is called a true or proper subset of B, written A ⊂ B or A ⊊ B.) As another option, show how to modify a mutable set. + One might implement a set using an [[associative array]] (with set elements as array keys and some dummy value as the values). -One might also implement a set with a binary search tree, or with a hash table, or with an ordered array of binary bits (operated on with bitwise binary operators). + +One might also implement a set with a binary search tree, or with a hash table, or with an ordered array of binary bits (operated on with bit-wise binary operators). + The basic test, m ∈ S, is [[O]](n) with a sequential list of elements, O(''log'' n) with a balanced binary search tree, or (O(1) average-case, O(n) worst case) with a hash table. + {{Template:See also lists}} +

    diff --git a/Task/Set/Elixir/set.elixir b/Task/Set/Elixir/set.elixir index a5c6c1174a..99bcbc0f5e 100644 --- a/Task/Set/Elixir/set.elixir +++ b/Task/Set/Elixir/set.elixir @@ -1,26 +1,28 @@ -iex(101)> s = HashSet.new -#HashSet<[]> -iex(102)> sa = Set.put(s, :a) -#HashSet<[:a]> -iex(103)> sab = Set.put(sa, :b) -#HashSet<[:b, :a]> -iex(104)> sbc = Enum.into([:b,:c], HashSet.new) -#HashSet<[:c, :b]> -iex(105)> Set.member?(sa, :a) +iex(1)> s = MapSet.new +#MapSet<[]> +iex(2)> sa = MapSet.put(s, :a) +#MapSet<[:a]> +iex(3)> sab = MapSet.put(sa, :b) +#MapSet<[:a, :b]> +iex(4)> sbc = Enum.into([:b, :c], MapSet.new) +#MapSet<[:b, :c]> +iex(5)> MapSet.member?(sab, :a) true -iex(106)> Set.member?(sa, :b) +iex(6)> MapSet.member?(sab, :c) false -iex(107)> Set.union(sab, sbc) -#HashSet<[:c, :b, :a]> -iex(108)> Set.intersection(sab, sbc) -#HashSet<[:b]> -iex(109)> Set.difference(sab, sbc) -#HashSet<[:a]> -iex(110)> Set.disjoint?(sab, sbc) -false -iex(111)> Set.subset?(sa, sab) +iex(7)> :a in sab true -iex(112)> Set.subset?(sab, sa) +iex(8)> MapSet.union(sab, sbc) +#MapSet<[:a, :b, :c]> +iex(9)> MapSet.intersection(sab, sbc) +#MapSet<[:b]> +iex(10)> MapSet.difference(sab, sbc) +#MapSet<[:a]> +iex(11)> MapSet.disjoint?(sab, sbc) false -iex(113)> sa == sab +iex(12)> MapSet.subset?(sa, sab) +true +iex(13)> MapSet.subset?(sab, sa) +false +iex(14)> sa == sab false diff --git a/Task/Set/Forth/set.fth b/Task/Set/Forth/set.fth new file mode 100644 index 0000000000..ad4e8e7019 --- /dev/null +++ b/Task/Set/Forth/set.fth @@ -0,0 +1,57 @@ +include FMS-SI.f +include FMS-SILib.f + +: union {: a b -- c :} + begin + b each: + while dup + a indexOf: if 2drop else a add: then + repeat b 1-array2 to c + begin + b each: + while dup + a indexOf: if drop c add: else drop then + repeat a b free2 c dup sort: ; + +i{ 2 5 4 3 } i{ 5 6 7 } intersect p: i{ 5 } ok + + +: diff {: a b | c -- c :} + heap> 1-array2 to c + begin + a each: + while dup + b indexOf: if 2drop else c add: then + repeat a b free2 c dup sort: ; + +i{ 2 5 4 3 } i{ 5 6 7 } diff p: i{ 2 3 4 } ok + +: subset {: a b -- flag :} + begin + a each: + while + b indexOf: if drop else false exit then + repeat a b free2 true ; + +i{ 2 5 4 3 } i{ 5 6 7 } subset . 0 ok +i{ 5 6 } i{ 5 6 7 } subset . -1 ok + + +: set= {: a b -- flag :} + a size: b size: <> if a b free2 false exit then + a sort: b sort: + begin + a each: drop b each: + while + <> if a b free2 false exit then + repeat a b free2 true ; + +i{ 5 6 } i{ 5 6 7 } set= . 0 ok +i{ 6 5 7 } i{ 5 6 7 } set= . -1 ok diff --git a/Task/Set/Go/set.go b/Task/Set/Go/set-1.go similarity index 81% rename from Task/Set/Go/set.go rename to Task/Set/Go/set-1.go index 5afb85b476..9be2bb349b 100644 --- a/Task/Set/Go/set.go +++ b/Task/Set/Go/set-1.go @@ -2,7 +2,14 @@ package main import "fmt" -type set map[int]bool +// Define set as a type to hold a set of complex numbers. A type +// could be defined similarly to hold other types of elements. A common +// variation is to make a map of interface{} to represent a set of +// mixed types. Also here the map value is a bool. By always storing +// true, the code is nicely readable. A variation to use less memory +// is to make the map value an empty struct. The relative advantages +// can be debated. +type set map[complex128]bool func main() { // task: set creation @@ -11,7 +18,7 @@ func main() { s2 := set{3: true, 1: true} // create set with two elements // option: another way to create a set - s3 := newSet([]int{3, 1, 4, 1, 5, 9}) + s3 := newSet(3, 1, 4, 1, 5, 9) // option: output! fmt.Println("s0:", s0) @@ -52,7 +59,7 @@ func main() { fmt.Println("s3, 3 deleted:", s3) } -func newSet(ms []int) set { +func newSet(ms ...complex128) set { s := make(set) for _, m := range ms { s[m] = true @@ -71,7 +78,7 @@ func (s set) String() string { return r[:len(r)-2] + "}" } -func (s set) hasElement(m int) bool { +func (s set) hasElement(m complex128) bool { return s[m] } diff --git a/Task/Set/Go/set-2.go b/Task/Set/Go/set-2.go new file mode 100644 index 0000000000..173f4ed98b --- /dev/null +++ b/Task/Set/Go/set-2.go @@ -0,0 +1,133 @@ +package main + +import ( + "fmt" + "math/big" +) + +func main() { + // create an empty set + var s0 big.Int + + // create sets with elements + s1 := newSet(3) + s2 := newSet(3, 1) + s3 := newSet(3, 1, 4, 1, 5, 9) + + // output + fmt.Println("s0:", format(s0)) + fmt.Println("s1:", format(s1)) + fmt.Println("s2:", format(s2)) + fmt.Println("s3:", format(s3)) + + // element predicate + fmt.Printf("%v ∈ s0: %t\n", 3, hasElement(s0, 3)) + fmt.Printf("%v ∈ s3: %t\n", 3, hasElement(s3, 3)) + fmt.Printf("%v ∈ s3: %t\n", 2, hasElement(s3, 2)) + + // union + b := newSet(4, 2) + fmt.Printf("s3 ∪ %v: %v\n", format(b), format(union(s3, b))) + + // intersection + fmt.Printf("s3 ∩ %v: %v\n", format(b), format(intersection(s3, b))) + + // difference + fmt.Printf("s3 \\ %v: %v\n", format(b), format(difference(s3, b))) + + // subset predicate + fmt.Printf("%v ⊆ s3: %t\n", format(b), subset(b, s3)) + fmt.Printf("%v ⊆ s3: %t\n", format(s2), subset(s2, s3)) + fmt.Printf("%v ⊆ s3: %t\n", format(s0), subset(s0, s3)) + + // equality + s2Same := newSet(1, 3) + fmt.Printf("%v = s2: %t\n", format(s2Same), equal(s2Same, s2)) + + // proper subset + fmt.Printf("%v ⊂ s2: %t\n", format(s2Same), properSubset(s2Same, s2)) + fmt.Printf("%v ⊂ s3: %t\n", format(s2Same), properSubset(s2Same, s3)) + + // delete + remove(&s3, 3) + fmt.Println("s3, 3 removed:", format(s3)) +} + +func newSet(ms ...int) (set big.Int) { + for _, m := range ms { + set.SetBit(&set, m, 1) + } + return +} + +func remove(set *big.Int, m int) { + set.SetBit(set, m, 0) +} + +func format(set big.Int) string { + if len(set.Bits()) == 0 { + return "∅" + } + r := "{" + for e, l := 0, set.BitLen(); e < l; e++ { + if set.Bit(e) == 1 { + r = fmt.Sprintf("%s%v, ", r, e) + } + } + return r[:len(r)-2] + "}" +} + +func hasElement(set big.Int, m int) bool { + return set.Bit(m) == 1 +} + +func union(a, b big.Int) (set big.Int) { + set.Or(&a, &b) + return +} + +func intersection(a, b big.Int) (set big.Int) { + set.And(&a, &b) + return +} + +func difference(a, b big.Int) (set big.Int) { + set.AndNot(&a, &b) + return +} + +func subset(a, b big.Int) bool { + ab := a.Bits() + bb := b.Bits() + if len(ab) > len(bb) { + return false + } + for i, aw := range ab { + if aw&^bb[i] != 0 { + return false + } + } + return true +} + +func equal(a, b big.Int) bool { + return a.Cmp(&b) == 0 +} + +func properSubset(a, b big.Int) (p bool) { + ab := a.Bits() + bb := b.Bits() + if len(ab) > len(bb) { + return false + } + for i, aw := range ab { + bw := bb[i] + if aw&^bw != 0 { + return false + } + if aw != bw { + p = true + } + } + return +} diff --git a/Task/Set/Go/set-3.go b/Task/Set/Go/set-3.go new file mode 100644 index 0000000000..17d67c59af --- /dev/null +++ b/Task/Set/Go/set-3.go @@ -0,0 +1,60 @@ +package main + +import ( + "fmt" + + "golang.org/x/tools/container/intsets" +) + +func main() { + var s0, s1 intsets.Sparse // create some empty sets + s1.Insert(3) // insert an element + s2 := newSet(3, 1) // create sets with elements + s3 := newSet(3, 1, 4, 1, 5, 9) + + // output + fmt.Println("s0:", &s0) + fmt.Println("s1:", &s1) + fmt.Println("s2:", s2) + fmt.Println("s3:", s3) + + // element predicate + fmt.Printf("%v ∈ s0: %t\n", 3, s0.Has(3)) + fmt.Printf("%v ∈ s3: %t\n", 3, s3.Has(3)) + fmt.Printf("%v ∈ s3: %t\n", 2, s3.Has(2)) + + // union + b := newSet(4, 2) + var s intsets.Sparse + s.Union(s3, b) + fmt.Printf("s3 ∪ %v: %v\n", b, &s) + + // intersection + s.Intersection(s3, b) + fmt.Printf("s3 ∩ %v: %v\n", b, &s) + + // difference + s.Difference(s3, b) + fmt.Printf("s3 \\ %v: %v\n", b, &s) + + // subset predicate + fmt.Printf("%v ⊆ s3: %t\n", b, b.SubsetOf(s3)) + fmt.Printf("%v ⊆ s3: %t\n", s2, s2.SubsetOf(s3)) + fmt.Printf("%v ⊆ s3: %t\n", &s0, s0.SubsetOf(s3)) + + // equality + s2Same := newSet(1, 3) + fmt.Printf("%v = s2: %t\n", s2Same, s2Same.Equals(s2)) + + // delete + s3.Remove(3) + fmt.Println("s3, 3 removed:", s3) +} + +func newSet(ms ...int) *intsets.Sparse { + var set intsets.Sparse + for _, m := range ms { + set.Insert(m) + } + return &set +} diff --git a/Task/Set/JavaScript/set.js b/Task/Set/JavaScript/set.js index 773cc7babc..c169cb53c6 100644 --- a/Task/Set/JavaScript/set.js +++ b/Task/Set/JavaScript/set.js @@ -8,7 +8,7 @@ set.add('three'); set.has(0); //=> true set.has(3); //=> false set.has('two'); // true -set.has(Math.sqrt(4)); //=> true +set.has(Math.sqrt(4)); //=> false set.has('TWO'.toLowerCase()); //=> true set.size; //=> 4 diff --git a/Task/Set/Lua/set.lua b/Task/Set/Lua/set.lua new file mode 100644 index 0000000000..ef80e587fa --- /dev/null +++ b/Task/Set/Lua/set.lua @@ -0,0 +1,68 @@ +function emptySet() return { } end +function insert(set, item) set[item] = true end +function remove(set, item) set[item] = nil end +function member(set, item) return set[item] end +function size(set) + local result = 0 + for _ in pairs(set) do result = result + 1 end + return result +end +function fromTable(tbl) -- ignore the keys of tbl + local result = { } + for _, val in pairs(tbl) do + result[val] = true + end + return result +end +function toArray(set) + local result = { } + for key in pairs(set) do + table.insert(result, key) + end + return result +end +function printSet(set) + print(table.concat(toArray(set), ", ")) +end +function union(setA, setB) + local result = { } + for key, _ in pairs(setA) do + result[key] = true + end + for key, _ in pairs(setB) do + result[key] = true + end + return result +end +function intersection(setA, setB) + local result = { } + for key, _ in pairs(setA) do + if setB[key] then + result[key] = true + end + end + return result +end +function difference(setA, setB) + local result = { } + for key, _ in pairs(setA) do + if not setB[key] then + result[key] = true + end + end + return result +end +function subset(setA, setB) + for key, _ in pairs(setA) do + if not setB[key] then + return false + end + end + return true +end +function properSubset(setA, setB) + return subset(setA, setB) and (size(setA) ~= size(setB)) +end +function equals(setA, setB) + return subset(setA, setB) and (size(setA) == size(setB)) +end diff --git a/Task/Set/REXX/set.rexx b/Task/Set/REXX/set.rexx index 4b3a49b759..e04e6a4c81 100644 --- a/Task/Set/REXX/set.rexx +++ b/Task/Set/REXX/set.rexx @@ -1,56 +1,56 @@ -/*REXX program demonstrates some common SET functions. */ -truth.0='false'; truth.1='true' /*common names for truth table. */ -set.= /*order of sets isn't important. */ +/*REXX program demonstrates some common SET functions. */ +truth.0= 'false'; truth.1= "true" /*two common names for a truth table. */ +set.= /*the order of sets isn't important. */ call setAdd 'prime',2 3 2 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 -call setSay 'prime' /*a small set of primes (numbers).*/ +call setSay 'prime' /*a small set of some prime numbers. */ call setAdd 'emirp',97 97 89 83 79 73 71 67 61 59 53 47 43 41 37 31 29 23 19 17 13 11 7 5 3 2 -call setSay 'emirp' /*a small set of baclward primes. */ +call setSay 'emirp' /*a small set of backward primes. */ call setAdd 'happy',1 7 10 13 19 23 28 31 32 44 49 68 70 79 82 86 91 100 94 97 97 97 97 97 -call setSay 'happy' /*a small set of happy numbers. */ +call setSay 'happy' /*a small set of some happy numbers. */ - do j=11 to 100 by 10 /*see if PRIME contains some nums*/ - call setHas 'prime',j - say ' prime contains' j":" truth.result + do j=11 to 100 by 10 /*see if PRIME contains some numbers. */ + call setHas 'prime', j + say ' prime contains' j":" truth.result end /*j*/ -call setUnion 'prime','happy','eweion'; call setSay 'eweion' -call setCommon 'prime','happy','common'; call setSay 'common' -call setDiff 'prime','happy','diff' ; call setSay 'diff' -call setSubset 'prime','happy' ; say ' prime is a subset of happy:' truth.result -call setEqual 'prime','emirp' ; say ' prime is equal to emirp:' truth.result -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────subroutines─────────────────────────*/ -setHas: procedure expose set.; arg _ .,! .;return wordpos(!,set._)\==0 -setAdd: return set$('add' ,arg(1),arg(2)) -setDiff: return set$('diff' ,arg(1),arg(2),arg(3)) -setSay: return set$('say' ,arg(1),arg(2)) -setUnion: return set$('union' ,arg(1),arg(2),arg(3)) -setCommon: return set$('common',arg(1),arg(2),arg(3)) -setEqual: return set$('equal' ,arg(1),arg(2)) -setSubset: return set$('subSet',arg(1),arg(2)) -/*──────────────────────────────────set$ subroutine─────────────────────*/ -set$: procedure expose set.; arg $,_1,_2,_3; set_=set._1; t=_3; s=t; !=1 -if $=='SAY' then do; say '[set.'_1"]="set._1; return set._1; end -if $=='UNION' then do - call set$ 'add',_3,set._1 - call set$ 'add',_3,set._2 - return set._3 - end -add=$=='ADD';common=$=='COMMON';diff=$=='DIFF';eq=$=='EQUAL';subset=$=='SUBSET' -if common | diff | eq | subset then s=_2 -if add then do; set_=_2; t=_1; s=_1; end +call setUnion 'prime','happy','eweion'; call setSay 'eweion' /* (sic). */ +call setCommon 'prime','happy','common'; call setSay 'common' +call setDiff 'prime','happy','diff' ; call setSay 'diff'; _=left('', 12) +call setSubset 'prime','happy' ; say _ 'prime is a subset of happy:' truth.result +call setEqual 'prime','emirp' ; say _ 'prime is equal to emirp:' truth.result +exit /*stick a fork in it, we're done.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +setHas: procedure expose set.; arg _ .,! .; return wordpos(!, set._)\==0 +setAdd: return set$('add' , arg(1), arg(2)) +setDiff: return set$('diff' , arg(1), arg(2), arg(3)) +setSay: return set$('say' , arg(1), arg(2)) +setUnion: return set$('union' , arg(1), arg(2), arg(3)) +setCommon: return set$('common' , arg(1), arg(2), arg(3)) +setEqual: return set$('equal' , arg(1), arg(2)) +setSubset: return set$('subSet' , arg(1), arg(2)) +/*──────────────────────────────────────────────────────────────────────────────────────*/ +set$: procedure expose set.; arg $,_1,_2,_3; set_=set._1; t=_3; s=t; !=1 + if $=='SAY' then do; say "[set."_1']= 'set._1; return set._1; end + if $=='UNION' then do + call set$ 'add', _3, set._1 + call set$ 'add', _3, set._2 + return set._3 + end + add=$=='ADD'; common=$=='COMMON'; diff=$=='DIFF'; eq=$=='EQUAL'; subset=$=='SUBSET' + if common | diff | eq | subset then s=_2 + if add then do; set_=_2; t=_1; s=_1; end - do j=1 for words(set_); _=word(set_,j); has=wordpos(_,set.s)\==0 - if (add & \has) |, - (common & has) |, - (diff & \has) then set.t=space(set.t _) - if (eq | subset) & \has then return 0 - end /*j*/ + do j=1 for words(set_); _=word(set_, j); has=wordpos(_, set.s)\==0 + if (add & \has) |, + (common & has) |, + (diff & \has) then set.t=space(set.t _) + if (eq | subset) & \has then return 0 + end /*j*/ -if subset then return 1 -if eq then if arg()>3 then return 1 - else return set$('equal',_2,_1,1) -return set.t + if subset then return 1 + if eq then if arg()>3 then return 1 + else return set$('equal', _2, _1, 1) + return set.t diff --git a/Task/Set/Run-BASIC/set.run b/Task/Set/Run-BASIC/set.run new file mode 100644 index 0000000000..b5f909bd6a --- /dev/null +++ b/Task/Set/Run-BASIC/set.run @@ -0,0 +1,70 @@ +A$ = "apple cherry elderberry grape" +B$ = "banana cherry date elderberry fig" +C$ = "apple cherry elderberry grape orange" +D$ = "apple cherry elderberry grape" +E$ = "apple cherry elderberry" +M$ = "banana" + +print "A = ";A$ +print "B = ";B$ +print "C = ";C$ +print "D = ";D$ +print "E = ";E$ +print "M = ";M$ + +if instr(A$,M$) = 0 then a$ = "not " +print "M is ";a$; "an element of Set A" +a$ = "" +if instr(B$,M$) = 0 then a$ = "not " +print "M is ";a$; "an element of Set B" + +un$ = A$ + " " +for i = 1 to 5 + if instr(un$,word$(B$,i)) = 0 then un$ = un$ + word$(B$,i) + " " +next i +print "union(A,B) = ";un$ + +for i = 1 to 5 + if instr(A$,word$(B$,i)) <> 0 then ins$ = ins$ + word$(B$,i) + " " +next i +print "Intersection(A,B) = ";ins$ + +for i = 1 to 5 + if instr(B$,word$(A$,i)) = 0 then dif$ = dif$ + word$(A$,i) + " " +next i +print "Difference(A,B) = ";dif$ + +a = subs(A$,B$,"AB") +a = subs(A$,C$,"AC") +a = subs(A$,D$,"AD") +a = subs(A$,E$,"AE") + +a = eqs(A$,B$,"AB") +a = eqs(A$,C$,"AC") +a = eqs(A$,D$,"AD") +a = eqs(A$,E$,"AE") +end + +function subs(a$,b$,sets$) + for i = 1 to 5 + if instr(b$,word$(a$,i)) <> 0 then subs = subs + 1 + next i +if subs = 4 then + print left$(sets$,1);" is a subset of ";right$(sets$,1) +else + print left$(sets$,1);" is not a subset of ";right$(sets$,1) +end if +end function + +function eqs(a$,b$,sets$) +for i = 1 to 5 + if word$(a$,i) <> "" then a = a + 1 + if word$(b$,i) <> "" then b = b + 1 + if instr(b$,word$(a$,i)) <> 0 then c = c + 1 +next i +if (a = b) and (a = c) then + print left$(sets$,1);" is equal ";right$(sets$,1) +else + print left$(sets$,1);" is not equal ";right$(sets$,1) +end if +end function diff --git a/Task/Seven-sided-dice-from-five-sided-dice/00DESCRIPTION b/Task/Seven-sided-dice-from-five-sided-dice/00DESCRIPTION index 8b54219441..8f83fb5734 100644 --- a/Task/Seven-sided-dice-from-five-sided-dice/00DESCRIPTION +++ b/Task/Seven-sided-dice-from-five-sided-dice/00DESCRIPTION @@ -1,7 +1,9 @@ -Given an equal-probability generator of one of the integers 1 to 5 -as dice5; create dice7 that generates a pseudo-random integer from +;Task: +(Given an equal-probability generator of one of the integers 1 to 5 +as dice5),   create dice7 that generates a pseudo-random integer from 1 to 7 in equal probability using only dice5 as a source of random -numbers, and check the distribution for at least 1000000 calls using the function created in [[Verify distribution uniformity/Naive|Simple Random Distribution Checker]]. +numbers,   and check the distribution for at least one million calls using the function created in   [[Verify distribution uniformity/Naive|Simple Random Distribution Checker]]. + '''Implementation suggestion:''' dice7 might call dice5 twice, re-call if four of the 25 @@ -9,3 +11,4 @@ combinations are given, otherwise split the other 21 combinations into 7 groups of three, and return the group index from the rolls. (Task adapted from an answer [http://stackoverflow.com/questions/90715/what-are-the-best-programming-puzzles-you-came-across here]) +

    diff --git a/Task/Seven-sided-dice-from-five-sided-dice/Elixir/seven-sided-dice-from-five-sided-dice.elixir b/Task/Seven-sided-dice-from-five-sided-dice/Elixir/seven-sided-dice-from-five-sided-dice.elixir index 70f2892627..eac2ff8268 100644 --- a/Task/Seven-sided-dice-from-five-sided-dice/Elixir/seven-sided-dice-from-five-sided-dice.elixir +++ b/Task/Seven-sided-dice-from-five-sided-dice/Elixir/seven-sided-dice-from-five-sided-dice.elixir @@ -1,19 +1,18 @@ defmodule Dice do - def dice5, do: :random.uniform( 5 ) + def dice5, do: :rand.uniform( 5 ) def dice7 do dice7_from_dice5 end - def dice7_from_dice5 do + defp dice7_from_dice5 do d55 = 5*dice5 + dice5 - 6 # 0..24 if d55 < 21, do: rem( d55, 7 ) + 1, else: dice7_from_dice5 end end -:random.seed(:erlang.now) fun5 = fn -> Dice.dice5 end -IO.inspect VerifyDistribution.naive( fun5, 1000000 ) +IO.inspect VerifyDistribution.naive( fun5, 1000000, 3 ) fun7 = fn -> Dice.dice7 end -IO.inspect VerifyDistribution.naive( fun7, 1000000 ) +IO.inspect VerifyDistribution.naive( fun7, 1000000, 3 ) diff --git a/Task/Shell-one-liner/00DESCRIPTION b/Task/Shell-one-liner/00DESCRIPTION index 9eccb028a6..bd22fe8272 100644 --- a/Task/Shell-one-liner/00DESCRIPTION +++ b/Task/Shell-one-liner/00DESCRIPTION @@ -1,3 +1,5 @@ +;Task: Show how to specify and execute a short program in the language from a command shell, where the input to the command shell is only one line in length. Avoid depending on the particular shell or operating system used as much as is reasonable; if the language has notable implementations which have different command argument syntax, or the systems those implementations run on have different styles of shells, it would be good to show multiple examples. +

    diff --git a/Task/Shell-one-liner/Bc/shell-one-liner.bc b/Task/Shell-one-liner/Bc/shell-one-liner.bc new file mode 100644 index 0000000000..6334b7ef84 --- /dev/null +++ b/Task/Shell-one-liner/Bc/shell-one-liner.bc @@ -0,0 +1 @@ +$ echo 'print "Hello "; var=99; ++var + 20 + 3' | bc diff --git a/Task/Shell-one-liner/COBOL/shell-one-liner-1.cobol b/Task/Shell-one-liner/COBOL/shell-one-liner-1.cobol new file mode 100644 index 0000000000..e82109ce0f --- /dev/null +++ b/Task/Shell-one-liner/COBOL/shell-one-liner-1.cobol @@ -0,0 +1 @@ +echo 'display "hello".' | cobc -xFj -frelax - diff --git a/Task/Shell-one-liner/COBOL/shell-one-liner-2.cobol b/Task/Shell-one-liner/COBOL/shell-one-liner-2.cobol new file mode 100644 index 0000000000..8c7b92b464 --- /dev/null +++ b/Task/Shell-one-liner/COBOL/shell-one-liner-2.cobol @@ -0,0 +1 @@ +echo 'id division. program-id. hello. procedure division. display "hello".' | cobc -xFj - diff --git a/Task/Shell-one-liner/REXX/shell-one-liner.rexx b/Task/Shell-one-liner/REXX/shell-one-liner.rexx index 9051912099..5f30d72ed7 100644 --- a/Task/Shell-one-liner/REXX/shell-one-liner.rexx +++ b/Task/Shell-one-liner/REXX/shell-one-liner.rexx @@ -1,5 +1,8 @@ - ┌────────────────────────────────────────────────┐ - │ from the MS Windows® command line (cmd.exe) │ - └────────────────────────────────────────────────┘ + ╔══════════════════════════════════════════════╗ + ║ ║ + ║ from the MS Window command line (cmd.exe) ║ + ║ ║ + ╚══════════════════════════════════════════════╝ -echo do j=10 by 20 for 4;say right('hello',j);end | regina + +echo do j=10 by 20 for 4; say right('hello',j); end | regina diff --git a/Task/Shell-one-liner/Rust/shell-one-liner.rust b/Task/Shell-one-liner/Rust/shell-one-liner.rust new file mode 100644 index 0000000000..0936bf8290 --- /dev/null +++ b/Task/Shell-one-liner/Rust/shell-one-liner.rust @@ -0,0 +1 @@ +$ echo 'fn main(){println!("Hello!")}' | rustc -;./rust_out diff --git a/Task/Shell-one-liner/S-lang/shell-one-liner-1.slang b/Task/Shell-one-liner/S-lang/shell-one-liner-1.slang new file mode 100644 index 0000000000..9bbac42c1f --- /dev/null +++ b/Task/Shell-one-liner/S-lang/shell-one-liner-1.slang @@ -0,0 +1 @@ +slsh -e 'print("Hello, World")' diff --git a/Task/Shell-one-liner/S-lang/shell-one-liner-2.slang b/Task/Shell-one-liner/S-lang/shell-one-liner-2.slang new file mode 100644 index 0000000000..f255cbc6c0 --- /dev/null +++ b/Task/Shell-one-liner/S-lang/shell-one-liner-2.slang @@ -0,0 +1 @@ +slsh -e "print(\"Hello, World\")" diff --git a/Task/Short-circuit-evaluation/00DESCRIPTION b/Task/Short-circuit-evaluation/00DESCRIPTION index 63491a505d..0b28520dbd 100644 --- a/Task/Short-circuit-evaluation/00DESCRIPTION +++ b/Task/Short-circuit-evaluation/00DESCRIPTION @@ -1,18 +1,28 @@ {{Control Structures}} -Assume functions a and b return boolean values, and further, the execution of function b takes considerable resources without side effects, and is to be minimised. -If we needed to compute the conjunction (and): -:x = a() and b() -Then it would be best to not compute the value of b() if the value of a() is computed as \mathrm{false}, as the value of x can then only ever be \mathrm{false}. +Assume functions   a   and   b   return boolean values,   and further, the execution of function   b   takes considerable resources without side effects, and is to be minimized. + +If we needed to compute the conjunction   (and): +:::: x = a() and b() + +Then it would be best to not compute the value of   b()   if the value of   a()   is computed as   false,   as the value of   x   can then only ever be   false. Similarly, if we needed to compute the disjunction (or): -:y = a() or b() -Then it would be best to not compute the value of b() if the value of a() is computed as \mathrm{true}, as the value of y can then only ever be \mathrm{true}. +:::: y = a() or b() -Some languages will stop further computation of boolean equations as soon as the result is known, so-called [[wp:Short-circuit evaluation|short-circuit evaluation]] of boolean expressions +Then it would be best to not compute the value of   b()   if the value of   a()   is computed as   true,   as the value of   y   can then only ever be   true. -;Task Description -The task is to create two functions named a and b, that take and return the same boolean value. The functions should also print their name whenever they are called. Calculate and assign the values of the following equations to a variable in such a way that function b is only called when necessary: -:x = a(i) and b(j) -:y = a(i) or b(j) -If the language does not have short-circuit evaluation, this might be achieved with nested if statements. +Some languages will stop further computation of boolean equations as soon as the result is known, so-called   [[wp:Short-circuit evaluation|short-circuit evaluation]]   of boolean expressions + + +;Task: +Create two functions named   a   and   b,   that take and return the same boolean value. + +The functions should also print their name whenever they are called. + +Calculate and assign the values of the following equations to a variable in such a way that function   b   is only called when necessary: +:::: x = a(i) and b(j) +:::: y = a(i) or b(j) + +
    If the language does not have short-circuit evaluation, this might be achieved with nested     '''if'''     statements. +

    diff --git a/Task/Short-circuit-evaluation/AppleScript/short-circuit-evaluation.applescript b/Task/Short-circuit-evaluation/AppleScript/short-circuit-evaluation.applescript new file mode 100644 index 0000000000..319bb5b3c6 --- /dev/null +++ b/Task/Short-circuit-evaluation/AppleScript/short-circuit-evaluation.applescript @@ -0,0 +1,52 @@ +on run + + map(test, {|and|, |or|}) + +end run + +-- test :: ((Bool, Bool) -> Bool) -> (Bool, Bool, Bool, Bool) +on test(f) + map(f, {{true, true}, {true, false}, {false, true}, {false, false}}) +end test + + + +-- |and| :: (Bool, Bool) -> Bool +on |and|(tuple) + set {x, y} to tuple + + a(x) and b(y) +end |and| + +-- |or| :: (Bool, Bool) -> Bool +on |or|(tuple) + set {x, y} to tuple + + a(x) or b(y) +end |or| + +-- a :: Bool -> Bool +on a(bool) + log "a" + return bool +end a + +-- b :: Bool -> Bool +on b(bool) + log "b" + return bool +end b + + +-- map :: (a -> b) -> [a] -> [b] +on map(f, xs) + script mf + property lambda : f + end script + set lng to length of xs + set lst to {} + repeat with i from 1 to lng + set end of lst to mf's lambda(item i of xs, i, xs) + end repeat + return lst +end map diff --git a/Task/Short-circuit-evaluation/Elena/short-circuit-evaluation.elena b/Task/Short-circuit-evaluation/Elena/short-circuit-evaluation.elena new file mode 100644 index 0000000000..718984238c --- /dev/null +++ b/Task/Short-circuit-evaluation/Elena/short-circuit-evaluation.elena @@ -0,0 +1,22 @@ +#import system. +#import system'routines. +#import extensions. + +#symbol a = x [ console writeLine:"a". ^ x. ]. + +#symbol b = x [ console writeLine:"b". ^ x. ]. + +#symbol program = +[ + (false, true) run &each: i + [ + (false, true) run &each: j + [ + console writeLine:i:" and ":j:" = ":(a eval:i and:[ b eval:j ]). + + console writeLine. + console writeLine:i:" or ":j:" = ":(a eval:i or:[ b eval:j ]). + console writeLine. + ]. + ]. +]. diff --git a/Task/Short-circuit-evaluation/Io/short-circuit-evaluation.io b/Task/Short-circuit-evaluation/Io/short-circuit-evaluation.io new file mode 100644 index 0000000000..7a0422c5e2 --- /dev/null +++ b/Task/Short-circuit-evaluation/Io/short-circuit-evaluation.io @@ -0,0 +1,19 @@ +a := method(bool, + writeln("a(#{bool}) called." interpolate) + bool +) +b := method(bool, + writeln("b(#{bool}) called." interpolate) + bool +) + +list(true,false) foreach(avalue, + list(true,false) foreach(bvalue, + x := a(avalue) and b(bvalue) + writeln("x = a(#{avalue}) and b(#{bvalue}) is #{x}" interpolate) + writeln + y := a(avalue) or b(bvalue) + writeln("y = a(#{avalue}) or b(#{bvalue}) is #{y}" interpolate) + writeln + ) +) diff --git a/Task/Short-circuit-evaluation/JavaScript/short-circuit-evaluation.js b/Task/Short-circuit-evaluation/JavaScript/short-circuit-evaluation.js new file mode 100644 index 0000000000..dc5baa6376 --- /dev/null +++ b/Task/Short-circuit-evaluation/JavaScript/short-circuit-evaluation.js @@ -0,0 +1,22 @@ +(function () { + 'use strict'; + + function a(bool) { + console.log('a -->', bool); + + return bool; + } + + function b(bool) { + console.log('b -->', bool); + + return bool; + } + + + var x = a(false) && b(true), + y = a(true) || b(false), + z = true ? a(true) : b(false); + + return [x, y, z]; +})(); diff --git a/Task/Short-circuit-evaluation/Perl-6/short-circuit-evaluation.pl6 b/Task/Short-circuit-evaluation/Perl-6/short-circuit-evaluation.pl6 index ec267ad643..c425fce02e 100644 --- a/Task/Short-circuit-evaluation/Perl-6/short-circuit-evaluation.pl6 +++ b/Task/Short-circuit-evaluation/Perl-6/short-circuit-evaluation.pl6 @@ -1,11 +1,13 @@ +use MONKEY-SEE-NO-EVAL; + sub a ($p) { print 'a'; $p } sub b ($p) { print 'b'; $p } -for '&&', '||' -> $op { - for True, False X True, False -> $p, $q { +for 1, 0 X 1, 0 -> ($p, $q) { + for '&&', '||' -> $op { my $s = "a($p) $op b($q)"; print "$s: "; - eval $s; + EVAL $s; print "\n"; } } diff --git a/Task/Short-circuit-evaluation/PowerShell/short-circuit-evaluation.psh b/Task/Short-circuit-evaluation/PowerShell/short-circuit-evaluation.psh new file mode 100644 index 0000000000..4a8a9cac08 --- /dev/null +++ b/Task/Short-circuit-evaluation/PowerShell/short-circuit-evaluation.psh @@ -0,0 +1,33 @@ +# Simulated fast function +function a ( [boolean]$J ) { return $J } + +# Simulated slow function +function b ( [boolean]$J ) { Sleep -Seconds 2; return $J } + +# These all short-circuit and do not evaluate the right hand function +( a $True ) -or ( b $False ) +( a $True ) -or ( b $True ) +( a $False ) -and ( b $False ) +( a $False ) -and ( b $True ) + +# Measure of execution time +Measure-Command { +( a $True ) -or ( b $False ) +( a $True ) -or ( b $True ) +( a $False ) -and ( b $False ) +( a $False ) -and ( b $True ) +} | Select TotalMilliseconds + +# These all appropriately do evaluate the right hand function +( a $False ) -or ( b $False ) +( a $False ) -or ( b $True ) +( a $True ) -and ( b $False ) +( a $True ) -and ( b $True ) + +# Measure of execution time +Measure-Command { +( a $False ) -or ( b $False ) +( a $False ) -or ( b $True ) +( a $True ) -and ( b $False ) +( a $True ) -and ( b $True ) +} | Select TotalMilliseconds diff --git a/Task/Short-circuit-evaluation/REXX/short-circuit-evaluation.rexx b/Task/Short-circuit-evaluation/REXX/short-circuit-evaluation.rexx index 4e3ec8332f..d861114a6e 100644 --- a/Task/Short-circuit-evaluation/REXX/short-circuit-evaluation.rexx +++ b/Task/Short-circuit-evaluation/REXX/short-circuit-evaluation.rexx @@ -1,12 +1,16 @@ -/*REXX programs demonstrates short-circuit evaulation testing. */ +/*REXX programs demonstrates short-circuit evaluation testing (in an IF statement).*/ +parse arg LO HI . /*obtain optional arguments from he CL.*/ +if LO=='' | LO=="," then LO= -2 /*Not specified? Then use the default.*/ +if HI=='' | HI=="," then HI= 2 /* " " " " " " */ - do i=-2 to 2 - x=a(i) & b(i) - y=a(i) - if \y then y=b(i) - say copies('─',30) 'x='||x 'y='y 'i='i - end /*j*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────subroutines─────────────────────────*/ -a: say 'A entered with:' arg(1);return abs(arg(1)//2) /*1=odd, 0=even */ -b: say 'B entered with:' arg(1);return arg(1)<0 /*1=neg, 0=if not*/ + do j=LO to HI /*process from the low to the high.*/ + x=a(j) & b(j) /*compute function A and function B */ + y=a(j) | b(j) /* " " " or " " */ + if \y then y=b(j) /* " " B (for negation).*/ + say copies('═', 30) ' x=' || x ' y='y ' j='j + say + end /*j*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +a: say ' A entered with:' arg(1); return abs( arg(1) // 2) /*1=odd, 0=even */ +b: say ' B entered with:' arg(1); return arg(1) < 0 /*1=neg, 0=if not*/ diff --git a/Task/Show-the-epoch/00DESCRIPTION b/Task/Show-the-epoch/00DESCRIPTION index 1b374aa928..956f7a8c4a 100644 --- a/Task/Show-the-epoch/00DESCRIPTION +++ b/Task/Show-the-epoch/00DESCRIPTION @@ -1,3 +1,11 @@ -Choose popular date libraries used by your language and show the [[wp:Epoch_(reference_date)#Computing|epoch]] those libraries use. A demonstration is preferable (e.g. setting the internal representation of the date to 0 ms/ns/etc., or another way that will still show the epoch even if it is changed behind the scenes by the implementers), but text from (with links to) documentation is also acceptable where a demonstration is impossible/impractical. For consistency's sake, show the date in UTC time where possible. +;Task: +Choose popular date libraries used by your language and show the   [[wp:Epoch_(reference_date)#Computing|epoch]]   those libraries use. -See also: [[Date format]] +A demonstration is preferable   (e.g. setting the internal representation of the date to 0 ms/ns/etc.,   or another way that will still show the epoch even if it is changed behind the scenes by the implementers),   but text from (with links to) documentation is also acceptable where a demonstration is impossible/impractical. + +For consistency's sake, show the date in UTC time where possible. + + +;Related task: +*   [[Date format]] +

    diff --git a/Task/Show-the-epoch/Lua/show-the-epoch.lua b/Task/Show-the-epoch/Lua/show-the-epoch.lua new file mode 100644 index 0000000000..d69a545ce2 --- /dev/null +++ b/Task/Show-the-epoch/Lua/show-the-epoch.lua @@ -0,0 +1 @@ +print(os.date("%c", 0)) diff --git a/Task/Sierpinski-carpet/00DESCRIPTION b/Task/Sierpinski-carpet/00DESCRIPTION index 7541748723..ac0044a822 100644 --- a/Task/Sierpinski-carpet/00DESCRIPTION +++ b/Task/Sierpinski-carpet/00DESCRIPTION @@ -1,5 +1,10 @@ -Produce a graphical or ASCII-art representation of a [[wp:Sierpinski carpet|Sierpinski carpet]] of order N. For example, the Sierpinski carpet of order 3 should look like this: -
    ###########################
    +;Task
    +Produce a graphical or ASCII-art representation of a [[wp:Sierpinski carpet|Sierpinski carpet]] of order   '''N'''.
    +
    +
    +For example, the Sierpinski carpet of order   '''3'''   should look like this:
    +
    +###########################
     # ## ## ## ## ## ## ## ## #
     ###########################
     ###   ######   ######   ###
    @@ -25,8 +30,14 @@ Produce a graphical or ASCII-art representation of a [[wp:Sierpinski carpet|Sier
     ###   ######   ######   ###
     ###########################
     # ## ## ## ## ## ## ## ## #
    -###########################
    +########################### +
    -The use of # characters is not rigidly required for ASCII art. The important requirement is the placement of whitespace and non-whitespace characters. +The use of the   #   character is not rigidly required for ASCII art. -See also [[Sierpinski triangle]] +The important requirement is the placement of whitespace and non-whitespace characters. + + +;Related task: +*   [[Sierpinski triangle]] +

    diff --git a/Task/Sierpinski-carpet/AppleScript/sierpinski-carpet.applescript b/Task/Sierpinski-carpet/AppleScript/sierpinski-carpet.applescript new file mode 100644 index 0000000000..2ee4ce3fc5 --- /dev/null +++ b/Task/Sierpinski-carpet/AppleScript/sierpinski-carpet.applescript @@ -0,0 +1,125 @@ +-- CARPET MODEL + +-- sierpinskiCarpet :: Int -> [[Bool]] +on sierpinskiCarpet(n) + + -- rowStates :: Int -> [Bool] + script rowStates + on lambda(x, _, xs) + + -- cellState :: Int -> Bool + script cellState + -- inCarpet :: Int -> Int -> Bool + on inCarpet(x, y) + if (x = 0 or y = 0) then + true + else + not ((x mod 3 = 1) and ¬ + (y mod 3 = 1)) and ¬ + inCarpet(x div 3, y div 3) + end if + end inCarpet + + on lambda(y) + inCarpet(x, y) + end lambda + end script + + map(cellState, xs) + end lambda + end script + + map(rowStates, range(0, (3 ^ n) - 1)) +end sierpinskiCarpet + + +-- TEST + +on run + -- Carpets of orders 1, 2, 3 + + set strCarpets to ¬ + intercalate(linefeed & linefeed, ¬ + map(showCarpet, range(1, 3))) + + set the clipboard to strCarpets + + return strCarpets +end run + + +-- CARPET DISPLAY + +-- showCarpet :: Int -> String +on showCarpet(n) + -- showRow :: [Bool] -> String + script showRow + -- showBool :: Bool -> String + script showBool + on lambda(bool) + if bool then + character id 9608 + else + " " + end if + end lambda + end script + + on lambda(xs) + intercalate("", map(my showBool, xs)) + end lambda + end script + + intercalate(linefeed, map(showRow, sierpinskiCarpet(n))) +end showCarpet + + +--------------------------------------------------------------------------- + +-- GENERIC LIBRARY FUNCTIONS + +-- 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 + +-- intercalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate + +-- range :: Int -> Int -> [Int] +on range(m, n) + if n < m then + set d to -1 + else + set d to 1 + end if + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range + +-- 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 diff --git a/Task/Sierpinski-carpet/Io/sierpinski-carpet.io b/Task/Sierpinski-carpet/Io/sierpinski-carpet.io new file mode 100644 index 0000000000..dba28df891 --- /dev/null +++ b/Task/Sierpinski-carpet/Io/sierpinski-carpet.io @@ -0,0 +1,13 @@ +sierpinskiCarpet := method(n, + carpet := list("@") + n repeat( + next := list() + carpet foreach(s, next append(s .. s .. s)) + carpet foreach(s, next append(s .. (s asMutable replaceSeq("@"," ")) .. s)) + carpet foreach(s, next append(s .. s .. s)) + carpet = next + ) + carpet join("\n") +) + +sierpinskiCarpet(3) println diff --git a/Task/Sierpinski-carpet/JavaScript/sierpinski-carpet-3.js b/Task/Sierpinski-carpet/JavaScript/sierpinski-carpet-3.js new file mode 100644 index 0000000000..8d907c5ede --- /dev/null +++ b/Task/Sierpinski-carpet/JavaScript/sierpinski-carpet-3.js @@ -0,0 +1,43 @@ +(() => { + 'use strict'; + + // sierpinskiCarpet :: Int -> String + let sierpinskiCarpet = n => { + + // carpet :: Int -> [[String]] + let carpet = n => { + let xs = range(0, Math.pow(3, n) - 1); + return xs.map(x => xs.map(y => inCarpet(x, y))); + }, + + // https://en.wikipedia.org/wiki/Sierpinski_carpet#Construction + + // inCarpet :: Int -> Int -> Bool + inCarpet = (x, y) => + (!x || !y) ? true : !( + (x % 3 === 1) && + (y % 3 === 1) + ) && inCarpet( + x / 3 | 0, + y / 3 | 0 + ); + + return carpet(n) + .map(line => line.map(bool => bool ? '\u2588' : ' ') + .join('')) + .join('\n'); + }; + + // GENERIC + + // range :: Int -> Int -> [Int] + let range = (m, n) => + Array.from({ + length: Math.floor(n - m) + 1 + }, (_, i) => m + i); + + // TEST + + return [1, 2, 3] + .map(sierpinskiCarpet); +})(); diff --git a/Task/Sierpinski-carpet/PARI-GP/sierpinski-carpet.pari b/Task/Sierpinski-carpet/PARI-GP/sierpinski-carpet.pari new file mode 100644 index 0000000000..0bf8c09c63 --- /dev/null +++ b/Task/Sierpinski-carpet/PARI-GP/sierpinski-carpet.pari @@ -0,0 +1,23 @@ +\\ Sierpinski carpet fractal +\\ Note: plotmat() can be found here on +\\ http://rosettacode.org/wiki/Brownian_tree#PARI.2FGP page. +\\ 6/10/16 aev +inSC(x,y)={ +while(1, if(!x||!y,return(1)); + if(x%3==1&&y%3==1, return(0)); + x\=3; y\=3;);\\wend +} +pSierpinskiC(n,pflg=0)={ +my(n3=3^n-1,M); +if(pflg<0||pflg>1, pflg=0); if(pflg, M=matrix(n3+1,n3+1)); +for(i=0,n3, for(j=0,n3, + if(inSC(i,j), + if(pflg, M[i+1,j+1]=1, print1("* ")), if(!pflg, print1(" "))); + ); if(!pflg, print("")); + );\\fend i +if(pflg, plotmat(M)); +} +{\\ Test: +pSierpinskiC(3); +pSierpinskiC(5,1); \\ SierpC5.png +} diff --git a/Task/Sierpinski-carpet/PowerShell/sierpinski-carpet-1.psh b/Task/Sierpinski-carpet/PowerShell/sierpinski-carpet-1.psh new file mode 100644 index 0000000000..faebbde3fa --- /dev/null +++ b/Task/Sierpinski-carpet/PowerShell/sierpinski-carpet-1.psh @@ -0,0 +1,17 @@ +function Draw-SierpinskiCarpet ( [int]$N ) + { + $Carpet = @( '#' ) * [math]::Pow( 3, $N ) + ForEach ( $i in 1..$N ) + { + $S = [math]::Pow( 3, $i - 1 ) + ForEach ( $Row in 0..($S-1) ) + { + $Carpet[$Row+$S+$S] = $Carpet[$Row] * 3 + $Carpet[$Row+$S] = $Carpet[$Row] + ( " " * $Carpet[$Row].Length ) + $Carpet[$Row] + $Carpet[$Row] = $Carpet[$Row] * 3 + } + } + $Carpet + } + +Draw-SierpinskiCarpet 3 diff --git a/Task/Sierpinski-carpet/PowerShell/sierpinski-carpet-2.psh b/Task/Sierpinski-carpet/PowerShell/sierpinski-carpet-2.psh new file mode 100644 index 0000000000..5d363df01c --- /dev/null +++ b/Task/Sierpinski-carpet/PowerShell/sierpinski-carpet-2.psh @@ -0,0 +1,54 @@ +Function Draw-SierpinskiCarpet ( [int]$N ) + { + # Define form + $Form = [System.Windows.Forms.Form]@{ Size = '300, 300' } + $Form.Controls.Add(( $PictureBox = [System.Windows.Forms.PictureBox]@{ Size = $Form.ClientSize; Anchor = 'Top, Bottom, Left, Right' } )) + + # Main code to draw Sierpinski carpet + $Draw = { + + # Create graphics objects to use + $PictureBox.Image = ( $Canvas = New-Object System.Drawing.Bitmap ( $PictureBox.Size.Width, $PictureBox.Size.Height ) ) + $Graphics = [System.Drawing.Graphics]::FromImage( $Canvas ) + + # Draw single pixel + $Graphics.FillRectangle( [System.Drawing.Brushes]::Black, 0, 0, 1, 1 ) + + # If N was not specified, use an N that will fill the form + If ( -not $N ) { $N = [math]::Ceiling( [math]::Log( [math]::Max( $PictureBox.Size.Height, $PictureBox.Size.Width ) ) / [math]::Log( 3 ) ) } + + # Define the shape of the fractal + $P = @( @( 0, 0 ), @( 0, 1 ), @( 0, 2 ) ) + $P += @( @( 1, 0 ), @( 1, 2 ) ) + $P += @( @( 2, 0 ), @( 2, 1 ), @( 2, 2 ) ) + + # For each iteration + ForEach ( $i in 0..$N ) + { + # Copy the result of the previous iteration + $Copy = New-Object System.Drawing.TextureBrush ( $Canvas ) + + # Calulate the size of the copy + $S = [math]::Pow( 3, $i ) + + # For each position in the next layer of the fractal + ForEach ( $i in 1..7 ) + { + # Adjust the copy for the new location + $Copy.TranslateTransform( - $P[$i-1][0] * $S + $P[$i][0] * $S, - $P[$i-1][1] * $S + $P[$i][1] * $S ) + + # Paste the copy of the previous iteration into the new location + $Graphics.FillRectangle( $Copy, $P[$i][0] * $S, $P[$i][1] * $S, $S, $S ) + } + } + } + + # Add the main drawing code to the appropriate events to be drawn when the form is first shown and redrawn when the form size is changed + $Form.Add_Shown( $Draw ) + $Form.Add_Resize( $Draw ) + + # Launch the form + $Null = $Form.ShowDialog() + } + +Draw-SierpinskiCarpet 4 diff --git a/Task/Sierpinski-carpet/PowerShell/sierpinski-carpet.psh b/Task/Sierpinski-carpet/PowerShell/sierpinski-carpet.psh deleted file mode 100644 index d01cb8e5b1..0000000000 --- a/Task/Sierpinski-carpet/PowerShell/sierpinski-carpet.psh +++ /dev/null @@ -1,21 +0,0 @@ -function inCarpet($x, $y) { - while ($x -ne 0 -and $y -ne 0) { - if ($x % 3 -eq 1 -and $y % 3 -eq 1) { - return " " - } - $x = [Math]::Truncate($x / 3) - $y = [Math]::Truncate($y / 3) - } - return "#" -} - -function carpet($n) { - for ($y = 0; $y -lt [Math]::Pow(3, $n); $y++) { - for ($x = 0; $x -lt [Math]::Pow(3, $n); $x++) { - Write-Host -NoNewline (inCarpet $x $y) - } - Write-Host - } -} - #Display the carpet for N=3... - carpet 3 diff --git a/Task/Sierpinski-carpet/REXX/sierpinski-carpet.rexx b/Task/Sierpinski-carpet/REXX/sierpinski-carpet.rexx index f0437c6882..8c46c0d60b 100644 --- a/Task/Sierpinski-carpet/REXX/sierpinski-carpet.rexx +++ b/Task/Sierpinski-carpet/REXX/sierpinski-carpet.rexx @@ -1,23 +1,27 @@ -/*REXX program draws any order Sierpinski carpet up to order 15. */ - /*order 1k would be 1Mx1M carpet.*/ -parse arg n char . /*get the order of the carpet. */ -if n=='' | n==',' then n=3 /*if none specified, assume 3. */ -if char=='' then char='*' /*use the default of an asterisk.*/ -if length(char)==2 then char=x2c(char) /*it was specified in hexadecimal*/ -if length(char)==3 then char=d2c(char) /*it was specified in decimal. */ -width=132 /*width of a terminal screen. */ - do j=0 for 3**n; z= /* z is the line to be displayed.*/ - do k=0 for 3**n; jj=j; kk=k; xChar=char - do while jj\==0 & kk\==0 /*one symbol for a not (¬) is \ */ - if jj//3==1 & kk//3==1 then do /* // = remainder.*/ - xChar=' ' /*use a blank. */ - leave /*leaves DO while.*/ - end - jj=jj%3 - kk=kk%3 /*% means it's integer division.*/ - end /*while*/ - z=z || xChar /*xChar is either black or white.*/ - end /*k*/ - if length(z)18 then numeric digits 1000 /*just in case the user went ka─razy. */ +nnn=3**N /* [↓] NNN is the cube of N. */ + + do j=0 for nnn; z= /*Z: is the line to be displayed. */ + do k=0 for nnn; jj=j; kk=k; xChar=char + + do while jj\==0 & kk\==0 /*one symbol for a not (¬) is a \ */ + if jj//3==1 & kk//3==1 then do /*in REXX: // ≡ division remainder*/ + xChar=' ' /*use a blank for this display line. */ + leave /*LEAVE terminates this DO WHILE. */ + end + jj=jj%3; kk=kk%3 /*in REXX: % ≡ integer division. */ + end /*while*/ + + z=z || xChar /*xChar is either black or white. */ + end /*k*/ /* [↑] " " " " blank. */ + + if length(z) +#include +#include + +const int BMP_SIZE = 612; + +class myBitmap { +public: + myBitmap() : pen( NULL ), brush( NULL ), clr( 0 ), wid( 1 ) {} + ~myBitmap() { + DeleteObject( pen ); DeleteObject( brush ); + DeleteDC( hdc ); DeleteObject( bmp ); + } + bool create( int w, int h ) { + BITMAPINFO bi; + ZeroMemory( &bi, sizeof( bi ) ); + bi.bmiHeader.biSize = sizeof( bi.bmiHeader ); + bi.bmiHeader.biBitCount = sizeof( DWORD ) * 8; + bi.bmiHeader.biCompression = BI_RGB; + bi.bmiHeader.biPlanes = 1; + bi.bmiHeader.biWidth = w; + bi.bmiHeader.biHeight = -h; + HDC dc = GetDC( GetConsoleWindow() ); + bmp = CreateDIBSection( dc, &bi, DIB_RGB_COLORS, &pBits, NULL, 0 ); + if( !bmp ) return false; + hdc = CreateCompatibleDC( dc ); + SelectObject( hdc, bmp ); + ReleaseDC( GetConsoleWindow(), dc ); + width = w; height = h; + return true; + } + void clear( BYTE clr = 0 ) { + memset( pBits, clr, width * height * sizeof( DWORD ) ); + } + void setBrushColor( DWORD bClr ) { + if( brush ) DeleteObject( brush ); + brush = CreateSolidBrush( bClr ); + SelectObject( hdc, brush ); + } + void setPenColor( DWORD c ) { + clr = c; createPen(); + } + void setPenWidth( int w ) { + wid = w; createPen(); + } + void saveBitmap( std::string path ) { + BITMAPFILEHEADER fileheader; + BITMAPINFO infoheader; + BITMAP bitmap; + DWORD wb; + GetObject( bmp, sizeof( bitmap ), &bitmap ); + DWORD* dwpBits = new DWORD[bitmap.bmWidth * bitmap.bmHeight]; + ZeroMemory( dwpBits, bitmap.bmWidth * bitmap.bmHeight * sizeof( DWORD ) ); + ZeroMemory( &infoheader, sizeof( BITMAPINFO ) ); + ZeroMemory( &fileheader, sizeof( BITMAPFILEHEADER ) ); + infoheader.bmiHeader.biBitCount = sizeof( DWORD ) * 8; + infoheader.bmiHeader.biCompression = BI_RGB; + infoheader.bmiHeader.biPlanes = 1; + infoheader.bmiHeader.biSize = sizeof( infoheader.bmiHeader ); + infoheader.bmiHeader.biHeight = bitmap.bmHeight; + infoheader.bmiHeader.biWidth = bitmap.bmWidth; + infoheader.bmiHeader.biSizeImage = bitmap.bmWidth * bitmap.bmHeight * sizeof( DWORD ); + fileheader.bfType = 0x4D42; + fileheader.bfOffBits = sizeof( infoheader.bmiHeader ) + sizeof( BITMAPFILEHEADER ); + fileheader.bfSize = fileheader.bfOffBits + infoheader.bmiHeader.biSizeImage; + GetDIBits( hdc, bmp, 0, height, ( LPVOID )dwpBits, &infoheader, DIB_RGB_COLORS ); + HANDLE file = CreateFile( path.c_str(), GENERIC_WRITE, 0, NULL, CREATE_ALWAYS, + FILE_ATTRIBUTE_NORMAL, NULL ); + WriteFile( file, &fileheader, sizeof( BITMAPFILEHEADER ), &wb, NULL ); + WriteFile( file, &infoheader.bmiHeader, sizeof( infoheader.bmiHeader ), &wb, NULL ); + WriteFile( file, dwpBits, bitmap.bmWidth * bitmap.bmHeight * 4, &wb, NULL ); + CloseHandle( file ); + delete [] dwpBits; + } + HDC getDC() const { return hdc; } + int getWidth() const { return width; } + int getHeight() const { return height; } +private: + void createPen() { + if( pen ) DeleteObject( pen ); + pen = CreatePen( PS_SOLID, wid, clr ); + SelectObject( hdc, pen ); + } + HBITMAP bmp; HDC hdc; + HPEN pen; HBRUSH brush; + void *pBits; int width, height, wid; + DWORD clr; +}; +class sierpinski { +public: + void draw( int o ) { + colors[0] = 0xff0000; colors[1] = 0x00ff33; colors[2] = 0x0033ff; + colors[3] = 0xffff00; colors[4] = 0x00ffff; colors[5] = 0xffffff; + bmp.create( BMP_SIZE, BMP_SIZE ); HDC dc = bmp.getDC(); + drawTri( dc, 0, 0, ( float )BMP_SIZE, ( float )BMP_SIZE, o / 2 ); + bmp.setPenColor( colors[0] ); MoveToEx( dc, BMP_SIZE >> 1, 0, NULL ); + LineTo( dc, 0, BMP_SIZE - 1 ); LineTo( dc, BMP_SIZE - 1, BMP_SIZE - 1 ); + LineTo( dc, BMP_SIZE >> 1, 0 ); bmp.saveBitmap( "./st.bmp" ); + } +private: + void drawTri( HDC dc, float l, float t, float r, float b, int i ) { + float w = r - l, h = b - t, hh = h / 2.f, ww = w / 4.f; + if( i ) { + drawTri( dc, l + ww, t, l + ww * 3.f, t + hh, i - 1 ); + drawTri( dc, l, t + hh, l + w / 2.f, t + h, i - 1 ); + drawTri( dc, l + w / 2.f, t + hh, l + w, t + h, i - 1 ); + } + bmp.setPenColor( colors[i % 6] ); + MoveToEx( dc, ( int )( l + ww ), ( int )( t + hh ), NULL ); + LineTo ( dc, ( int )( l + ww * 3.f ), ( int )( t + hh ) ); + LineTo ( dc, ( int )( l + ( w / 2.f ) ), ( int )( t + h ) ); + LineTo ( dc, ( int )( l + ww ), ( int )( t + hh ) ); + } + myBitmap bmp; + DWORD colors[6]; +}; +int main(int argc, char* argv[]) { + sierpinski s; s.draw( 12 ); + return 0; +} diff --git a/Task/Sierpinski-triangle-Graphical/Lua/sierpinski-triangle-graphical.lua b/Task/Sierpinski-triangle-Graphical/Lua/sierpinski-triangle-graphical.lua new file mode 100644 index 0000000000..3ac2db70c9 --- /dev/null +++ b/Task/Sierpinski-triangle-Graphical/Lua/sierpinski-triangle-graphical.lua @@ -0,0 +1,21 @@ +-- The argument 'tri' is a list of co-ords: {x1, y1, x2, y2, x3, y3} +function sierpinski (tri, order) + local new, p, t = {} + if order > 0 then + for i = 1, #tri do + p = i + 2 + if p > #tri then p = p - #tri end + new[i] = (tri[i] + tri[p]) / 2 + end + sierpinski({tri[1],tri[2],new[1],new[2],new[5],new[6]}, order-1) + sierpinski({new[1],new[2],tri[3],tri[4],new[3],new[4]}, order-1) + sierpinski({new[5],new[6],new[3],new[4],tri[5],tri[6]}, order-1) + else + love.graphics.polygon("fill", tri) + end +end + +-- Callback function used to draw on the screen every frame +function love.draw () + sierpinski({400, 100, 700, 500, 100, 500}, 7) +end diff --git a/Task/Sierpinski-triangle-Graphical/PARI-GP/sierpinski-triangle-graphical.pari b/Task/Sierpinski-triangle-Graphical/PARI-GP/sierpinski-triangle-graphical.pari new file mode 100644 index 0000000000..044089391d --- /dev/null +++ b/Task/Sierpinski-triangle-Graphical/PARI-GP/sierpinski-triangle-graphical.pari @@ -0,0 +1,12 @@ +\\ Sierpinski triangle fractal +\\ Note: plotmat() can be found here on +\\ http://rosettacode.org/wiki/Brownian_tree#PARI.2FGP page. +\\ 6/3/16 aev +pSierpinskiT(n)={ +my(sz=2^n,M=matrix(sz,sz),x,y); +for(y=1,sz, for(x=1,sz, if(!bitand(x,y),M[x,y]=1);));\\fends +plotmat(M); +} +{\\ Test: +pSierpinskiT(9); \\ SierpT9.png +} diff --git a/Task/Sierpinski-triangle/00DESCRIPTION b/Task/Sierpinski-triangle/00DESCRIPTION index b4e0765099..4a6c2000a8 100644 --- a/Task/Sierpinski-triangle/00DESCRIPTION +++ b/Task/Sierpinski-triangle/00DESCRIPTION @@ -1,5 +1,9 @@ -Produce an ASCII representation of a [[wp:Sierpinski triangle|Sierpinski triangle]] of order N. -For example, the Sierpinski triangle of order 4 should look like this: +;Task +Produce an ASCII representation of a [[wp:Sierpinski triangle|Sierpinski triangle]] of order '''N'''. + + +;Example +The Sierpinski triangle of order '''4''' should look like this:
                            *
                           * *
    @@ -19,5 +23,8 @@ For example, the Sierpinski triangle of order 4 should look like this:
             * * * * * * * * * * * * * * * *
     
    -See [[Sierpinski triangle/Graphical]] for graphics images of this pattern. -See also [[Sierpinski carpet]] + +;Related tasks +* [[Sierpinski triangle/Graphical]] for graphics images of this pattern. +* [[Sierpinski carpet]] +

    diff --git a/Task/Sierpinski-triangle/AppleScript/sierpinski-triangle.applescript b/Task/Sierpinski-triangle/AppleScript/sierpinski-triangle.applescript new file mode 100644 index 0000000000..9364cc72ca --- /dev/null +++ b/Task/Sierpinski-triangle/AppleScript/sierpinski-triangle.applescript @@ -0,0 +1,149 @@ +-- sierpinskiTriangle :: Int -> String +on sierpinskiTriangle(intOrder) + + -- A Sierpinski triangle of order N + -- is a Pascal triangle (of N^2 rows) + -- mod 2 + + -- pascalModTwo :: Int -> [[String]] + script pascalModTwo + on lambda(intRows) + + -- addRow [[Int]] -> [[Int]] + script addRow + + -- nextRow :: [Int] -> [Int] + on nextRow(row) + -- The composition of AsciiBinary . mod two . add + -- is reduced here to a rule from + -- two parent characters above, + -- to the child character below. + + -- Rule 90 also reduces to this XOR relationship + -- between left and right neighbours. + + -- rule :: Character -> Character -> Character + script rule + on lambda(a, b) + cond(a = b, space, "*") + end lambda + end script + + zipWith(rule, {" "} & row, row & {" "}) + end nextRow + + on lambda(xs) + xs & {nextRow(item -1 of xs)} + end lambda + end script + + foldr(addRow, {{"*"}}, range(1, intRows - 1)) + end lambda + end script + + -- The centring foldr (fold right) below starts from the end of the list, + -- (the base of the triangle) which has zero indent. + + -- Each preceding row has one more indent space than the row below it. + + script centred + on lambda(sofar, row) + set strIndent to indent of sofar + + {triangle:strIndent & intercalate(space, row) & linefeed & ¬ + triangle of sofar, indent:strIndent & space} + end lambda + end script + + triangle of foldr(centred, {triangle:"", indent:""}, ¬ + pascalModTwo's lambda(intOrder ^ 2)) + +end sierpinskiTriangle + + +-- TEST +on run + + set strTriangle to sierpinskiTriangle(4) + + set the clipboard to strTriangle + + strTriangle + +end run + + +-- GENERIC LIBRARY FUNCTIONS + +-- foldr :: (a -> b -> a) -> a -> [b] -> a +on foldr(f, startValue, xs) + tell mReturn(f) + set v to startValue + set lng to length of xs + repeat with i from lng to 1 by -1 + set v to lambda(v, item i of xs, i, xs) + end repeat + return v + end tell +end foldr + +-- intercalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate + +-- 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 + +-- range :: Int -> Int -> [Int] +on range(m, n) + if n < m then + set d to -1 + else + set d to 1 + end if + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range + +-- 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 + +-- cond :: Bool -> (a -> b) -> (a -> b) -> (a -> b) +on cond(bool, f, g) + if bool then + f + else + g + end if +end cond diff --git a/Task/Sierpinski-triangle/COBOL/sierpinski-triangle.cobol b/Task/Sierpinski-triangle/COBOL/sierpinski-triangle.cobol new file mode 100644 index 0000000000..ec6693286d --- /dev/null +++ b/Task/Sierpinski-triangle/COBOL/sierpinski-triangle.cobol @@ -0,0 +1,36 @@ +identification division. +program-id. sierpinski-triangle-program. +data division. +working-storage section. +01 sierpinski. + 05 n pic 99. + 05 i pic 999. + 05 k pic 999. + 05 m pic 999. + 05 c pic 9(18). + 05 i-limit pic 999. + 05 q pic 9(18). + 05 r pic 9. +procedure division. +control-paragraph. + move 4 to n. + multiply n by 4 giving i-limit. + subtract 1 from i-limit. + perform sierpinski-paragraph + varying i from 0 by 1 until i is greater than i-limit. + stop run. +sierpinski-paragraph. + subtract i from i-limit giving m. + multiply m by 2 giving m. + perform m times, + display space with no advancing, + end-perform. + move 1 to c. + perform inner-loop-paragraph + varying k from 0 by 1 until k is greater than i. + display ''. +inner-loop-paragraph. + divide c by 2 giving q remainder r. + if r is equal to zero then display ' * ' with no advancing. + if r is not equal to zero then display ' ' with no advancing. + compute c = c * (i - k) / (k + 1). diff --git a/Task/Sierpinski-triangle/Haskell/sierpinski-triangle-3.hs b/Task/Sierpinski-triangle/Haskell/sierpinski-triangle-3.hs new file mode 100644 index 0000000000..44f17c1eb4 --- /dev/null +++ b/Task/Sierpinski-triangle/Haskell/sierpinski-triangle-3.hs @@ -0,0 +1,16 @@ +import Data.List (intersperse) + +sierpinski :: Int -> String +sierpinski n = let + + -- Top down, each row after the first is an XOR rewrite + rule90 n = (scanl next ['*'] [1..n-1]) where + next line _ = zipWith xor (" " ++ line) (line ++ " ") + xor l r | l == r = ' ' | otherwise = '*' + + -- Bottom up, each line above the base is indented 1 more space + in fst (foldr spacing ("", "") (rule90 (2^n))) where + spacing x (s, w) = + (concat [w, intersperse ' ' x, "\n", s], w ++ " ") + +main = putStr $ sierpinski 4 diff --git a/Task/Sierpinski-triangle/JavaScript/sierpinski-triangle-1.js b/Task/Sierpinski-triangle/JavaScript/sierpinski-triangle-1.js index dcce5dd458..577e5b4288 100644 --- a/Task/Sierpinski-triangle/JavaScript/sierpinski-triangle-1.js +++ b/Task/Sierpinski-triangle/JavaScript/sierpinski-triangle-1.js @@ -1,81 +1,58 @@ -// A Sierpinski triangle of order N, -// constructed as Pascal's triangle mod 2 -// and mapped to 2^N lines of centred {1:asterisk, 0:space} strings +(function (order) { -(function (n) { - var nRows = Math.pow(2, n), - lstSierpinski = sierpinski(nRows).map(asciiBinary), + // Sierpinski triangle of order N constructed as + // Pascal triangle of 2^N rows mod 2 + // with 1 encoded as "▲" + // and 0 encoded as " " + function sierpinski(intOrder) { + return function asciiPascalMod2(intRows) { + return range(1, intRows - 1) + .reduce(function (lstRows) { + var lstPrevRow = lstRows.slice(-1)[0]; - nBaseWidth = lstSierpinski[nRows - 1].length; + // Each new row is a function of the previous row + return lstRows.concat([zipWith(function (left, right) { + // The composition ( asciiBinary . mod 2 . add ) + // reduces to a rule from 2 parent characters + // to a single child character + + // Rule 90 also reduces to the same XOR + // relationship between left and right neighbours + + return left === right ? " " : "▲"; + }, [' '].concat(lstPrevRow), lstPrevRow.concat(' '))]); + }, [ + ["▲"] // Tip of triangle + ]); + }(Math.pow(2, intOrder)) + + // As centred lines, from bottom (0 indent) up (indent below + 1) + .reduceRight(function (sofar, lstLine) { + return { + triangle: sofar.indent + lstLine.join(" ") + "\n" + + sofar.triangle, + indent: sofar.indent + " " + }; + }, { + triangle: "", + indent: "" + }).triangle; + }; + + var zipWith = function (f, xs, ys) { + return xs.length === ys.length ? xs + .map(function (x, i) { + return f(x, ys[i]); + }) : undefined; + }, + range = function (m, n) { + return Array.apply(null, Array(n - m + 1)) + .map(function (x, i) { + return m + i; + }); + }; + + // TEST + return sierpinski(order); - return lstSierpinski.map( - function (s) { - return centreAligned(s, nBaseWidth); - } - ).join('\n'); })(4); - -// A Sierpinski sieve of n rows -// (Pascal triangle mod 2) -// n --> [bool] -function sierpinski(n) { - return pascalTriangle(n).map( - function (line) { - return line.map(function (x) { - return x % 2; - }); - } - ) -} - -// A Pascal triangle of n rows -// n --> [[n]] -function pascalTriangle(n) { - - // Sums of each consecutive pair of numbers - // [n] --> [n] - function pairSums(lst) { - return lst.reduce(function (acc, n, i, l) { - var iPrev = i ? i - 1 : 0; - return i ? acc.concat(l[iPrev] + l[i]) : acc - }, []); - } - - // Next line in a Pascal triangle series - // [n] --> [n] - function nextPascal(lst) { - return lst.length ? [1].concat( - pairSums(lst) - ).concat(1) : [1]; - } - - // Each row is a function of the preceding row - return n ? Array.apply(null, Array(n - 1)).reduce( - function (a, _, i) { - return a.concat( - [nextPascal(a[i])] - ); - }, [ - [1] - ] - ) : []; -} - -// [bool] --> s -function asciiBinary(lst) { - return lst.map( - function (x) { - return x ? '*' : ' '; - } - ).join(' '); -} - -// Space-padded to left and right -// s --> n --> s -function centreAligned(s, n) { - var lngWhite = n - s.length, - lngMargin = lngWhite > 0 ? Math.ceil(lngWhite / 2) : 0, - strMargin = lngMargin ? Array(lngMargin + 1).join(' ') : ''; - - return strMargin ? strMargin + s + strMargin : s; -} diff --git a/Task/Sierpinski-triangle/JavaScript/sierpinski-triangle-2.js b/Task/Sierpinski-triangle/JavaScript/sierpinski-triangle-2.js index 1ae62d0c05..6170ccf6cd 100644 --- a/Task/Sierpinski-triangle/JavaScript/sierpinski-triangle-2.js +++ b/Task/Sierpinski-triangle/JavaScript/sierpinski-triangle-2.js @@ -1,18 +1,20 @@ function triangle(o) { - var n = 1<\n"); triangle(6); diff --git a/Task/Sierpinski-triangle/JavaScript/sierpinski-triangle-3.js b/Task/Sierpinski-triangle/JavaScript/sierpinski-triangle-3.js new file mode 100644 index 0000000000..0444cef9dc --- /dev/null +++ b/Task/Sierpinski-triangle/JavaScript/sierpinski-triangle-3.js @@ -0,0 +1,67 @@ +// A Sierpinski triangle of order N, +// constructed as 2^N lines of Pascal's triangle mod 2 +// and mapped to centred {1:asterisk, 0:space} strings + +(order => { + + // sierpinski :: Int -> [Bool] + let sierpinski = intOrder => { + + // asciiPascalMod2 :: Int -> [[Int]] + let asciiPascalMod2 = nRows => + range(1, nRows - 1) + .reduce(sofar => { + let lstPrev = sofar.slice(-1)[0]; + + // The composition of (asciiBinary . mod 2 . add) + // is reduced here to a rule from two parent characters + // to a single child character. + + // Rule 90 also reduces to the same XOR + // relationship between left and right neighbours. + + return sofar + .concat([zipWith( + (left, right) => left === right ? ' ' : '*', + [' '].concat(lstPrev), + lstPrev.concat(' ') + )]); + }, [ + ['*'] // Tip of triangle + ]); + + // Reduce/folding from the last item (base of list) + // which has zero left indent. + + // Each preceding row has one more indent space than the row beneath it + return asciiPascalMod2(Math.pow(2, intOrder)) + .reduceRight((a, x) => { + return { + triangle: a.indent + x.join(' ') + '\n' + a.triangle, + indent: a.indent + ' ' + } + }, { + triangle: '', + indent: '' + }).triangle + }; + + // zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] + let zipWith = (f, xs, ys) => + xs.length === ys.length ? ( + xs.map((x, i) => f(x, ys[i])) + ) : undefined, + + // range(intFrom, intTo, optional intStep) + // Int -> Int -> Maybe Int -> [Int] + range = (m, n, step) => { + let d = (step || 1) * (n >= m ? 1 : -1); + + return Array.from({ + length: Math.floor((n - m) / d) + 1 + }, (_, i) => m + (i * d)); + }; + + return sierpinski(order); + +})(4); diff --git a/Task/Sierpinski-triangle/Julia/sierpinski-triangle.julia b/Task/Sierpinski-triangle/Julia/sierpinski-triangle.julia index 52efdfb146..d6d6152bdc 100644 --- a/Task/Sierpinski-triangle/Julia/sierpinski-triangle.julia +++ b/Task/Sierpinski-triangle/Julia/sierpinski-triangle.julia @@ -2,7 +2,7 @@ pprint(matrix) = for i = 1:size(matrix,1) println(join(matrix[i,:])) end spaces(m,n) = [" " for i=1:m, j=1:n] function sierpinski(n) - x = ["*" for i=1, j=1] + x = ["*" for i=1:1, j=1:1] for i = 1:n h,w = size(x) s = spaces(h,(w+1)/2) diff --git a/Task/Sierpinski-triangle/Maple/sierpinski-triangle.maple b/Task/Sierpinski-triangle/Maple/sierpinski-triangle.maple new file mode 100644 index 0000000000..74842506b7 --- /dev/null +++ b/Task/Sierpinski-triangle/Maple/sierpinski-triangle.maple @@ -0,0 +1,15 @@ +S := proc(n) + local i, j, values, position; + values := [ seq(" ",i=1..2^n-1), "*" ]; + printf("%s\n",cat(op(values))); + for i from 2 to 2^n do + position := [ ListTools:-SearchAll( "*", values ) ]; + values := Array([ seq(0, i=1..2^n+i-1) ]); + for j to numelems(position) do + values[position[j]-1] := values[position[j]-1] + 1; + values[position[j]+1] := values[position[j]+1] + 1; + end do; + values := subs( { 2 = " ", 0 = " ", 1 = "*"}, values ); + printf("%s\n",cat(op(convert(values, list)))); + end do: +end proc: diff --git a/Task/Sierpinski-triangle/Perl-6/sierpinski-triangle.pl6 b/Task/Sierpinski-triangle/Perl-6/sierpinski-triangle.pl6 index 3901b94a7a..597705d360 100644 --- a/Task/Sierpinski-triangle/Perl-6/sierpinski-triangle.pl6 +++ b/Task/Sierpinski-triangle/Perl-6/sierpinski-triangle.pl6 @@ -2,7 +2,7 @@ sub sierpinski ($n) { my @down = '*'; my $space = ' '; for ^$n { - @down = flat @down.map({"$space$_$space"}), @down.map({"$_ $_"}); + @down = |("$space$_$space" for @down), |("$_ $_" for @down); $space x= 2; } return @down; diff --git a/Task/Sierpinski-triangle/REXX/sierpinski-triangle.rexx b/Task/Sierpinski-triangle/REXX/sierpinski-triangle.rexx index d4bb05f2bf..8654876c61 100644 --- a/Task/Sierpinski-triangle/REXX/sierpinski-triangle.rexx +++ b/Task/Sierpinski-triangle/REXX/sierpinski-triangle.rexx @@ -1,17 +1,17 @@ -/*REXX program draws a Sierpinski triangle of up to around order 10k. */ -parse arg n mk . /*get the order of the triangle. */ -if n=='' | n==',' then n=4 /*if none specified, assume 4. */ -if mk=='' then mk='*' /*use the default of an asterisk.*/ -if length(mk)==2 then mk=x2c(mk) /*MK was specified in hexadecimal*/ -if length(mk)==3 then mk=d2c(mk) /*MK was specified in decimal. */ -numeric digits 12000 /*this otta handle the die-hards.*/ - /* [↓] the blood-'n-guts of pgm.*/ - do j=0 for n*4; !=1; z=left('',n*4-1-j) /*indent the line. */ - do k=0 for j+1 /*build the line with J+1 parts*/ - if !//2==0 then z=z' ' /*it's either a blank, or ··· */ - else z=z mk /*it's one of them thar character*/ - !=!*(j-k)%(k+1) /*calculate a handy-dandy thingy.*/ - end /*k*/ /* [↑] finished building a line.*/ - say z /*display a line of the triangle.*/ - end /*j*/ /* [↑] finished displaying tri. */ - /*stick a fork in it, we're done.*/ +/*REXX program constructs and displays a Sierpinski triangle of up to around order 10k.*/ +parse arg n mark . /*get the order of Sierpinski triangle.*/ +if n=='' | n=="," then n=4 /*Not specified? Then use the default.*/ +if mark=='' then mark= "*" /*MARK was specified as a character. */ +if length(mark)==2 then mark=x2c(mark) /* " " " in hexadecimal. */ +if length(mark)==3 then mark=d2c(mark) /* " " " " decimal. */ +numeric digits 12000 /*this should handle the biggy numbers.*/ + /* [↓] the blood-'n-guts of the pgm. */ + do j=0 for n*4; !=1; z=left('', n*4 -1-j) /*indent the line to be displayed. */ + do k=0 for j+1 /*construct the line with J+1 parts. */ + if !//2==0 then z=z' ' /*it's either a blank, or ··· */ + else z=z mark /* ··· it's one of 'em thar characters.*/ + !=! * (j-k) % (k+1) /*calculate handy-dandy thing-a-ma-jig.*/ + end /*k*/ /* [↑] finished constructing a line. */ + say z /*display a line of the triangle. */ + end /*j*/ /* [↑] finished showing triangle. */ + /*stick a fork in it, we're all done. */ diff --git a/Task/Sierpinski-triangle/Run-BASIC/sierpinski-triangle.run b/Task/Sierpinski-triangle/Run-BASIC/sierpinski-triangle.run new file mode 100644 index 0000000000..68706fd411 --- /dev/null +++ b/Task/Sierpinski-triangle/Run-BASIC/sierpinski-triangle.run @@ -0,0 +1,22 @@ +nOrder=4 +dim xy$(40) +for i = 1 to 40 + xy$(i) = " " +next i +call triangle 1, 1, nOrder +for i = 1 to 36 + print xy$(i) +next i +end + +SUB triangle x, y, n + IF n = 0 THEN + xy$(y) = left$(xy$(y),x-1) + "*" + mid$(xy$(y),x+1) + ELSE + n=n-1 + length=2^n + call triangle x, y+length, n + call triangle x+length, y, n + call triangle x+length*2, y+length, n + END IF +END SUB diff --git a/Task/Sieve-of-Eratosthenes/00DESCRIPTION b/Task/Sieve-of-Eratosthenes/00DESCRIPTION index e180178c0d..abfefe5f14 100644 --- a/Task/Sieve-of-Eratosthenes/00DESCRIPTION +++ b/Task/Sieve-of-Eratosthenes/00DESCRIPTION @@ -1,15 +1,24 @@ {{clarified-review}} -The [[wp:Sieve_of_Eratosthenes|Sieve of Eratosthenes]] is a simple algorithm that finds the prime numbers up to a given integer. Implement this algorithm, with the only allowed optimization that the outer loop can stop at the square root of the limit, and the inner loop may start at the square of the prime just found. + +The [[wp:Sieve_of_Eratosthenes|Sieve of Eratosthenes]] is a simple algorithm that finds the prime numbers up to a given integer. + + +;Task: +Implement the   Sieve of Eratosthenes   algorithm, with the only allowed optimization that the outer loop can stop at the square root of the limit, and the inner loop may start at the square of the prime just found. + That means especially that you shouldn't optimize by using pre-computed ''wheels'', i.e. don't assume you need only to cross out odd numbers (wheel based on 2), numbers equal to 1 or 5 modulo 6 (wheel based on 2 and 3), or similar wheels based on low primes. -If there's an easy way to add such a wheel based optimization, implement this as an alternative version. +If there's an easy way to add such a wheel based optimization, implement it as an alternative version. + ;Note: * It is important that the sieve algorithm be the actual algorithm used to find prime numbers for the task. -;Cf: -* [[Primality by trial division]]. -* [[Sequence of primes by Trial Division]]. -* [[Prime decomposition]]. -* [[Extensible prime generator]]. -* [[Emirp primes]]. + +;Related tasks: +*   [[Primality by trial division]]. +*   [[Sequence of primes by Trial Division]]. +*   [[Prime decomposition]]. +*   [[Extensible prime generator]]. +*   [[Emirp primes]]. +

    diff --git a/Task/Sieve-of-Eratosthenes/360-Assembly/sieve-of-eratosthenes.360 b/Task/Sieve-of-Eratosthenes/360-Assembly/sieve-of-eratosthenes.360 index 044b190eb7..c73af56303 100644 --- a/Task/Sieve-of-Eratosthenes/360-Assembly/sieve-of-eratosthenes.360 +++ b/Task/Sieve-of-Eratosthenes/360-Assembly/sieve-of-eratosthenes.360 @@ -60,7 +60,7 @@ J DS F P DS PL8 packed Z DS ZL16 zoned C DS CL16 character -WTOMSG CNOP 0,4 +WTOMSG DS 0F DC H'80' length of WTO buffer DC H'0' must be binary zeroes WTOBUF DC 80C' ' diff --git a/Task/Sieve-of-Eratosthenes/6502-Assembly/sieve-of-eratosthenes.6502 b/Task/Sieve-of-Eratosthenes/6502-Assembly/sieve-of-eratosthenes.6502 new file mode 100644 index 0000000000..4c83cb00c5 --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/6502-Assembly/sieve-of-eratosthenes.6502 @@ -0,0 +1,39 @@ +ERATOS: STA $D0 ; value of n + LDA #$00 + LDX #$00 +SETUP: STA $1000,X ; populate array + ADC #$01 + INX + CPX $D0 + BPL SET + JMP SETUP +SET: LDX #$02 +SIEVE: LDA $1000,X ; find non-zero + INX + CPX $D0 + BPL SIEVED + CMP #$00 + BEQ SIEVE + STA $D1 ; current prime +MARK: CLC + ADC $D1 + TAY + LDA #$00 + STA $1000,Y + TYA + CMP $D0 + BPL SIEVE + JMP MARK +SIEVED: LDX #$01 + LDY #$00 +COPY: INX + CPX $D0 + BPL COPIED + LDA $1000,X + CMP #$00 + BEQ COPY + STA $2000,Y + INY + JMP COPY +COPIED: TYA ; how many found + RTS diff --git a/Task/Sieve-of-Eratosthenes/APL/sieve-of-eratosthenes-1.apl b/Task/Sieve-of-Eratosthenes/APL/sieve-of-eratosthenes-1.apl new file mode 100644 index 0000000000..45f9b13ad6 --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/APL/sieve-of-eratosthenes-1.apl @@ -0,0 +1,10 @@ +sieve2←{ + b←⍵⍴1 + b[⍳2⌊⍵]←0 + 2≥⍵:b + p←{⍵/⍳⍴⍵}∇⌈⍵*0.5 + m←1+⌊(⍵-1+p×p)÷p + b ⊣ p {b[⍺×⍺+⍳⍵]←0}¨ m +} + +primes2←{⍵/⍳⍴⍵}∘sieve2 diff --git a/Task/Sieve-of-Eratosthenes/APL/sieve-of-eratosthenes-2.apl b/Task/Sieve-of-Eratosthenes/APL/sieve-of-eratosthenes-2.apl new file mode 100644 index 0000000000..35b9050e87 --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/APL/sieve-of-eratosthenes-2.apl @@ -0,0 +1,10 @@ +sieve←{ + b←⍵⍴{∧⌿↑(×/⍵)⍴¨~⍵↑¨1}2 3 5 + b[⍳6⌊⍵]←(6⌊⍵)⍴0 0 1 1 0 1 + 49≥⍵:b + p←3↓{⍵/⍳⍴⍵}∇⌈⍵*0.5 + m←1+⌊(⍵-1+p×p)÷2×p + b ⊣ p {b[⍺×⍺+2×⍳⍵]←0}¨ m +} + +primes←{⍵/⍳⍴⍵}∘sieve diff --git a/Task/Sieve-of-Eratosthenes/APL/sieve-of-eratosthenes-3.apl b/Task/Sieve-of-Eratosthenes/APL/sieve-of-eratosthenes-3.apl new file mode 100644 index 0000000000..02e1557ef5 --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/APL/sieve-of-eratosthenes-3.apl @@ -0,0 +1,13 @@ + primes 100 +2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 + + primes¨ ⍳14 +┌┬┬┬─┬───┬───┬─────┬─────┬───────┬───────┬───────┬───────┬──────────┬──────────┐ +││││2│2 3│2 3│2 3 5│2 3 5│2 3 5 7│2 3 5 7│2 3 5 7│2 3 5 7│2 3 5 7 11│2 3 5 7 11│ +└┴┴┴─┴───┴───┴─────┴─────┴───────┴───────┴───────┴───────┴──────────┴──────────┘ + + sieve 13 +0 0 1 1 0 1 0 1 0 0 0 1 0 + + +/∘sieve¨ 10*⍳10 +0 4 25 168 1229 9592 78498 664579 5761455 50847534 diff --git a/Task/Sieve-of-Eratosthenes/Agena/sieve-of-eratosthenes.agena b/Task/Sieve-of-Eratosthenes/Agena/sieve-of-eratosthenes.agena new file mode 100644 index 0000000000..7b67d76b28 --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/Agena/sieve-of-eratosthenes.agena @@ -0,0 +1,32 @@ +# Sieve of Eratosthenes + +# generate and return a sequence containing the primes up to sieveSize +sieve := proc( sieveSize :: number ) :: sequence is + local sieve, result; + + result := seq(); # sequence of primes - initially empty + create register sieve( sieveSize ); # "vector" to be sieved + + sieve[ 1 ] := false; + for sPos from 2 to sieveSize do sieve[ sPos ] := true od; + + # sieve the primes + for sPos from 2 to entier( sqrt( sieveSize ) ) do + if sieve[ sPos ] then + for p from sPos * sPos to sieveSize by sPos do + sieve[ p ] := false + od + fi + od; + + # construct the sequence of primes + for sPos from 1 to sieveSize do + if sieve[ sPos ] then insert sPos into result fi + od + +return result +end; # sieve + + +# test the sieve proc +for i in sieve( 100 ) do write( " ", i ) od; print(); diff --git a/Task/Sieve-of-Eratosthenes/BASIC/sieve-of-eratosthenes-4.basic b/Task/Sieve-of-Eratosthenes/BASIC/sieve-of-eratosthenes-4.basic index 62e826386b..df85e016f3 100644 --- a/Task/Sieve-of-Eratosthenes/BASIC/sieve-of-eratosthenes-4.basic +++ b/Task/Sieve-of-Eratosthenes/BASIC/sieve-of-eratosthenes-4.basic @@ -1,12 +1,12 @@ -10 INPUT "Enter number to search to: ";l -20 DIM p(l) -30 FOR n=2 TO SQR l -40 IF p(n)<>0 THEN NEXT n -50 FOR k=n*n TO l STEP n +5 Rem MSX BRRJPA +10 INPUT "Search until: ";L +20 DIM p(L) +30 FOR n=2 TO SQR (L+1000) +40 IF p(n)<>0 THEN goto 80 +50 FOR k=n*n TO L STEP n 60 LET p(k)=1 70 NEXT k 80 NEXT n -90 REM Display the primes -100 FOR n=2 TO l -110 IF p(n)=0 THEN PRINT n;", "; -120 NEXT n +90 FOR n=2 TO L +100 IF p(n)=0 THEN PRINT n;", "; +110 NEXT n diff --git a/Task/Sieve-of-Eratosthenes/BASIC/sieve-of-eratosthenes-5.basic b/Task/Sieve-of-Eratosthenes/BASIC/sieve-of-eratosthenes-5.basic new file mode 100644 index 0000000000..62e826386b --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/BASIC/sieve-of-eratosthenes-5.basic @@ -0,0 +1,12 @@ +10 INPUT "Enter number to search to: ";l +20 DIM p(l) +30 FOR n=2 TO SQR l +40 IF p(n)<>0 THEN NEXT n +50 FOR k=n*n TO l STEP n +60 LET p(k)=1 +70 NEXT k +80 NEXT n +90 REM Display the primes +100 FOR n=2 TO l +110 IF p(n)=0 THEN PRINT n;", "; +120 NEXT n diff --git a/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-1.clj b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-1.clj index 0712ea1149..aebb746269 100644 --- a/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-1.clj +++ b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-1.clj @@ -1,13 +1,7 @@ -(defn primes-to - "Computes lazy sequence of prime numbers up to a given number using sieve of Eratosthenes" - [n] - (let [root (-> n Math/sqrt long), - cmpsts (boolean-array (inc n)), - cullp (fn [p] - (loop [i (* p p)] - (if (<= i n) - (do (aset cmpsts i true) - (recur (+ i p))))))] - (do (dorun (map #(cullp %) (filter #(not (aget cmpsts %)) - (range 2 (inc root))))) - (filter #(not (aget cmpsts %)) (range 2 (inc n)))))) +(defn primes< [n] + (if (<= n 2) + () + (remove (into #{} + (mapcat #(range (* % %) n %)) + (range 3 (Math/sqrt n) 2)) + (cons 2 (range 3 n 2))))) diff --git a/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-10.clj b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-10.clj index 18fd065157..88ef52e5a3 100644 --- a/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-10.clj +++ b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-10.clj @@ -1,17 +1,25 @@ -(defn primes-hashmap - "Infinite sequence of primes using an incremental Sieve or Eratosthenes with a Hashmap" +(defn primes-treeFolding + "Computes the unbounded sequence of primes using a Sieve of Eratosthenes algorithm modified from Bird." [] - (letfn [(nxtoddprm [c q bsprms cmpsts] - (if (>= c q) ;; only ever equal - (let [p2 (* (first bsprms) 2), nbps (next bsprms), nbp (first nbps)] - (recur (+ c 2) (* nbp nbp) nbps (assoc cmpsts (+ q p2) p2))) - (if (contains? cmpsts c) - (recur (+ c 2) q bsprms - (let [adv (cmpsts c), ncmps (dissoc cmpsts c)] - (assoc ncmps - (loop [try (+ c adv)] ;; ensure map entry is unique - (if (contains? ncmps try) - (recur (+ try adv)) try)) adv))) - (cons c (lazy-seq (nxtoddprm (+ c 2) q bsprms cmpsts))))))] - (do (def baseoddprms (cons 3 (lazy-seq (nxtoddprm 5 9 baseoddprms {})))) - (cons 2 (lazy-seq (nxtoddprm 3 9 baseoddprms {})))))) + (letfn [(mltpls [p] (let [p2 (* 2 p)] + (letfn [(nxtmltpl [c] + (cons c (lazy-seq (nxtmltpl (+ c p2)))))] + (nxtmltpl (* p p))))), + (allmtpls [ps] (cons (mltpls (first ps)) (lazy-seq (allmtpls (next ps))))), + (union [xs ys] (let [xv (first xs), yv (first ys)] + (if (< xv yv) (cons xv (lazy-seq (union (next xs) ys))) + (if (< yv xv) (cons yv (lazy-seq (union xs (next ys)))) + (cons xv (lazy-seq (union (next xs) (next ys)))))))), + (pairs [mltplss] (let [tl (next mltplss)] + (cons (union (first mltplss) (first tl)) + (lazy-seq (pairs (next tl)))))), + (mrgmltpls [mltplss] (cons (first (first mltplss)) + (lazy-seq (union (next (first mltplss)) + (mrgmltpls (pairs (next mltplss))))))), + (minusStrtAt [n cmpsts] (loop [n n, cmpsts cmpsts] + (if (< n (first cmpsts)) + (cons n (lazy-seq (minusStrtAt (+ n 2) cmpsts))) + (recur (+ n 2) (next cmpsts)))))] + (do (def oddprms (cons 3 (lazy-seq (let [cmpsts (-> oddprms (allmtpls) (mrgmltpls))] + (minusStrtAt 5 cmpsts))))) + (cons 2 (lazy-seq oddprms))))) diff --git a/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-11.clj b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-11.clj index 42c40e12a3..56556a39d9 100644 --- a/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-11.clj +++ b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-11.clj @@ -1,67 +1,48 @@ -(deftype PQEntry [k, v] - Object - (toString [_] (str "<" k "," v ">"))) -(deftype PQNode [^PQEntry ntry, lft, rght, lvl] - Object - (toString [_] (str "<" lvl ntry " left: " (str lft) " right: " (str rght) ">"))) - -(defn empty-pq [] nil) - -(defn getMin-pq ^PQEntry [pq] (condp instance? pq - PQEntry pq, - PQNode (.ntry ^PQNode pq) - nil)) - -(defn insert-pq [opq k v] - (loop [kv (->PQEntry k v), msk 0, pq opq, cont identity] - (condp instance? pq - PQEntry (if (< k (.k ^PQEntry pq)) (cont (->PQNode kv pq nil 2)) - (cont (->PQNode pq kv nil 2))), - PQNode (let [^PQNode pqn pq, kvn (.ntry pqn), l (.lft pqn), r (.rght pqn), - nlvl (+ (.lvl pqn) 1), - nmsk (if (zero? msk) ;; never ever 0 again with the bit or'ed 1 - (bit-or (bit-shift-left nlvl (- 64 (long (quot (Math/log (double nlvl)) - (Math/log (double 2)))))) 1) - (bit-shift-left msk 1))] - (if (<= k (.k ^PQEntry kvn)) - (if (neg? nmsk) - (recur kvn nmsk r (fn [npq] (cont (->PQNode kv l npq nlvl)))) - (recur kvn nmsk l (fn [npq] (cont (->PQNode kv npq r nlvl))))) - (if (neg? nmsk) - (recur kv nmsk r (fn [npq] (cont (->PQNode kvn l npq nlvl)))) - (recur kv nmsk l (fn [npq] (cont (->PQNode kvn npq r nlvl))))))), - (cont kv)))) - -(defn replaceMinAs-pq [opq k v] - (let [kv (->PQEntry k v)] - (loop [pq opq, cont identity] - (if (instance? PQNode pq) - (let [^PQNode pqn pq, l (.lft pqn), r (.rght pqn), lvl (.lvl pqn)] - (cond - (and (instance? PQEntry r) (> k (.k ^PQEntry r))) - (cond ;; right not empty so left is never empty - (and (instance? PQEntry l) (> k (.k ^PQEntry l))) ;; both qualify; choose least - (if (> (.k ^PQEntry l) (.k ^PQEntry r)) - (cont (->PQNode r l kv lvl)) - (cont (->PQNode l kv r lvl))), - (and (instance? PQNode l) (> k (.k ^PQEntry (.ntry ^PQNode l)))) - (let [^PQEntry kvl (.ntry ^PQNode l)] - (if (> (.k kvl) (.k ^PQEntry r)) ;; both qualify; choose least - (cont (->PQNode r l kv lvl)) - (recur l (fn [npq] (cont (->PQNode kvl npq r lvl)))))), - :else (cont (->PQNode r l kv lvl))), ;; only right qualifies; no recursion - (and (instance? PQNode r) (> k (.k ^PQEntry (.ntry ^PQNode r)))) - (let [^PQEntry kvr (.ntry ^PQNode r)] - (if (and (instance? PQNode l) (> k (.k ^PQEntry (.ntry ^PQNode l)))) - (let [^PQEntry kvl (.ntry ^PQNode l)] - (if (> (.k kvl) (.k kvr)) ;; both qualify; choose least - (recur r (fn [npq] (cont (->PQNode kvr l npq lvl)))) - (recur l (fn [npq] (cont (->PQNode kvl npq r lvl)))))) - (recur r (fn [npq] (cont (->PQNode kvr l npq lvl)))))), ;; only right qualifies - :else (cond ;; right is empty, but as this is a node, left is never empty - (and (instance? PQEntry l) (> k (.k ^PQEntry l))) - (cont (->PQNode l kv r lvl)), - (and (instance? PQNode l) (> k (.k ^PQEntry (.ntry ^PQNode l)))) - (recur l (fn [npq] (cont (->PQNode (.ntry ^PQNode l) npq r lvl)))), - :else (cont (->PQNode kv l r lvl))))) ;; just replace contents, leave same - (cont kv))))) ;; if was empty or just an entry, just use current entry +(defn primes-treeFoldingx + "Computes the unbounded sequence of primes using a Sieve of Eratosthenes algorithm modified from Bird." + [] + (do (deftype CIS [v cont] + clojure.lang.ISeq + (first [_] v) + (next [_] (if (nil? cont) nil (cont))) + (more [this] (let [nv (.next this)] (if (nil? nv) (CIS. nil nil) nv))) + (cons [this o] (clojure.core/cons o this)) + (empty [_] (if (and (nil? v) (nil? cont)) nil (CIS. nil nil))) + (equiv [this o] (loop [cis1 this, cis2 o] (if (nil? cis1) (if (nil? cis2) true false) + (if (or (not= (type cis1) (type cis2)) + (not= (.v cis1) (.v ^CIS cis2)) + (and (nil? (.cont cis1)) + (not (nil? (.cont ^CIS cis2)))) + (and (nil? (.cont ^CIS cis2)) + (not (nil? (.cont cis1))))) false + (if (nil? (.cont cis1)) true + (recur ((.cont cis1)) ((.cont ^CIS cis2)))))))) + (count [this] (loop [cis this, cnt 0] (if (or (nil? cis) (nil? (.cont cis))) cnt + (recur ((.cont cis)) (inc cnt))))) + clojure.lang.Seqable + (seq [this] (if (and (nil? v) (nil? cont)) nil this)) + clojure.lang.Sequential + Object + (toString [this] (if (and (nil? v) (nil? cont)) "()" (.toString (seq (map identity this)))))) + (letfn [(mltpls [p] (let [p2 (* 2 p)] + (letfn [(nxtmltpl [c] + (->CIS c (fn [] (nxtmltpl (+ c p2)))))] + (nxtmltpl (* p p))))), + (allmtpls [^CIS ps] (->CIS (mltpls (.v ps)) (fn [] (allmtpls ((.cont ps)))))), + (union [^CIS xs ^CIS ys] (let [xv (.v xs), yv (.v ys)] + (if (< xv yv) (->CIS xv (fn [] (union ((.cont xs)) ys))) + (if (< yv xv) (->CIS yv (fn [] (union xs ((.cont ys))))) + (->CIS xv (fn [] (union (next xs) ((.cont ys))))))))), + (pairs [^CIS mltplss] (let [^CIS tl ((.cont mltplss))] + (->CIS (union (.v mltplss) (.v tl)) + (fn [] (pairs ((.cont tl))))))), + (mrgmltpls [^CIS mltplss] (->CIS (.v ^CIS (.v mltplss)) + (fn [] (union ((.cont ^CIS (.v mltplss))) + (mrgmltpls (pairs ((.cont mltplss)))))))), + (minusStrtAt [n ^CIS cmpsts] (loop [n n, cmpsts cmpsts] + (if (< n (.v cmpsts)) + (->CIS n (fn [] (minusStrtAt (+ n 2) cmpsts))) + (recur (+ n 2) ((.cont cmpsts))))))] + (do (def oddprms (->CIS 3 (fn [] (let [cmpsts (-> oddprms (allmtpls) (mrgmltpls))] + (minusStrtAt 5 cmpsts))))) + (->CIS 2 (fn [] oddprms)))))) diff --git a/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-12.clj b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-12.clj index 7c36b3af08..18fd065157 100644 --- a/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-12.clj +++ b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-12.clj @@ -1,19 +1,17 @@ -(defn primes-pq - "Infinite sequence of primes using an incremental Sieve or Eratosthenes with a Priority Queue" +(defn primes-hashmap + "Infinite sequence of primes using an incremental Sieve or Eratosthenes with a Hashmap" [] (letfn [(nxtoddprm [c q bsprms cmpsts] (if (>= c q) ;; only ever equal (let [p2 (* (first bsprms) 2), nbps (next bsprms), nbp (first nbps)] - (recur (+ c 2) (* nbp nbp) nbps (insert-pq cmpsts (+ q p2) p2))) - (let [mn (getMin-pq cmpsts)] - (if (and mn (>= c (.k mn))) ;; never greater than - (recur (+ c 2) q bsprms - (loop [adv (.v mn), cmps cmpsts] ;; advance repeat composites for value - (let [ncmps (replaceMinAs-pq cmps (+ c adv) adv), - nmn (getMin-pq ncmps)] - (if (and nmn (>= c (.k nmn))) - (recur (.v nmn) ncmps) - ncmps)))) - (cons c (lazy-seq (nxtoddprm (+ c 2) q bsprms cmpsts)))))))] - (do (def baseoddprms (cons 3 (lazy-seq (nxtoddprm 5 9 baseoddprms (empty-pq))))) - (cons 2 (lazy-seq (nxtoddprm 3 9 baseoddprms (empty-pq))))))) + (recur (+ c 2) (* nbp nbp) nbps (assoc cmpsts (+ q p2) p2))) + (if (contains? cmpsts c) + (recur (+ c 2) q bsprms + (let [adv (cmpsts c), ncmps (dissoc cmpsts c)] + (assoc ncmps + (loop [try (+ c adv)] ;; ensure map entry is unique + (if (contains? ncmps try) + (recur (+ try adv)) try)) adv))) + (cons c (lazy-seq (nxtoddprm (+ c 2) q bsprms cmpsts))))))] + (do (def baseoddprms (cons 3 (lazy-seq (nxtoddprm 5 9 baseoddprms {})))) + (cons 2 (lazy-seq (nxtoddprm 3 9 baseoddprms {})))))) diff --git a/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-13.clj b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-13.clj new file mode 100644 index 0000000000..42c40e12a3 --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-13.clj @@ -0,0 +1,67 @@ +(deftype PQEntry [k, v] + Object + (toString [_] (str "<" k "," v ">"))) +(deftype PQNode [^PQEntry ntry, lft, rght, lvl] + Object + (toString [_] (str "<" lvl ntry " left: " (str lft) " right: " (str rght) ">"))) + +(defn empty-pq [] nil) + +(defn getMin-pq ^PQEntry [pq] (condp instance? pq + PQEntry pq, + PQNode (.ntry ^PQNode pq) + nil)) + +(defn insert-pq [opq k v] + (loop [kv (->PQEntry k v), msk 0, pq opq, cont identity] + (condp instance? pq + PQEntry (if (< k (.k ^PQEntry pq)) (cont (->PQNode kv pq nil 2)) + (cont (->PQNode pq kv nil 2))), + PQNode (let [^PQNode pqn pq, kvn (.ntry pqn), l (.lft pqn), r (.rght pqn), + nlvl (+ (.lvl pqn) 1), + nmsk (if (zero? msk) ;; never ever 0 again with the bit or'ed 1 + (bit-or (bit-shift-left nlvl (- 64 (long (quot (Math/log (double nlvl)) + (Math/log (double 2)))))) 1) + (bit-shift-left msk 1))] + (if (<= k (.k ^PQEntry kvn)) + (if (neg? nmsk) + (recur kvn nmsk r (fn [npq] (cont (->PQNode kv l npq nlvl)))) + (recur kvn nmsk l (fn [npq] (cont (->PQNode kv npq r nlvl))))) + (if (neg? nmsk) + (recur kv nmsk r (fn [npq] (cont (->PQNode kvn l npq nlvl)))) + (recur kv nmsk l (fn [npq] (cont (->PQNode kvn npq r nlvl))))))), + (cont kv)))) + +(defn replaceMinAs-pq [opq k v] + (let [kv (->PQEntry k v)] + (loop [pq opq, cont identity] + (if (instance? PQNode pq) + (let [^PQNode pqn pq, l (.lft pqn), r (.rght pqn), lvl (.lvl pqn)] + (cond + (and (instance? PQEntry r) (> k (.k ^PQEntry r))) + (cond ;; right not empty so left is never empty + (and (instance? PQEntry l) (> k (.k ^PQEntry l))) ;; both qualify; choose least + (if (> (.k ^PQEntry l) (.k ^PQEntry r)) + (cont (->PQNode r l kv lvl)) + (cont (->PQNode l kv r lvl))), + (and (instance? PQNode l) (> k (.k ^PQEntry (.ntry ^PQNode l)))) + (let [^PQEntry kvl (.ntry ^PQNode l)] + (if (> (.k kvl) (.k ^PQEntry r)) ;; both qualify; choose least + (cont (->PQNode r l kv lvl)) + (recur l (fn [npq] (cont (->PQNode kvl npq r lvl)))))), + :else (cont (->PQNode r l kv lvl))), ;; only right qualifies; no recursion + (and (instance? PQNode r) (> k (.k ^PQEntry (.ntry ^PQNode r)))) + (let [^PQEntry kvr (.ntry ^PQNode r)] + (if (and (instance? PQNode l) (> k (.k ^PQEntry (.ntry ^PQNode l)))) + (let [^PQEntry kvl (.ntry ^PQNode l)] + (if (> (.k kvl) (.k kvr)) ;; both qualify; choose least + (recur r (fn [npq] (cont (->PQNode kvr l npq lvl)))) + (recur l (fn [npq] (cont (->PQNode kvl npq r lvl)))))) + (recur r (fn [npq] (cont (->PQNode kvr l npq lvl)))))), ;; only right qualifies + :else (cond ;; right is empty, but as this is a node, left is never empty + (and (instance? PQEntry l) (> k (.k ^PQEntry l))) + (cont (->PQNode l kv r lvl)), + (and (instance? PQNode l) (> k (.k ^PQEntry (.ntry ^PQNode l)))) + (recur l (fn [npq] (cont (->PQNode (.ntry ^PQNode l) npq r lvl)))), + :else (cont (->PQNode kv l r lvl))))) ;; just replace contents, leave same + (cont kv))))) ;; if was empty or just an entry, just use current entry diff --git a/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-14.clj b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-14.clj new file mode 100644 index 0000000000..7c36b3af08 --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-14.clj @@ -0,0 +1,19 @@ +(defn primes-pq + "Infinite sequence of primes using an incremental Sieve or Eratosthenes with a Priority Queue" + [] + (letfn [(nxtoddprm [c q bsprms cmpsts] + (if (>= c q) ;; only ever equal + (let [p2 (* (first bsprms) 2), nbps (next bsprms), nbp (first nbps)] + (recur (+ c 2) (* nbp nbp) nbps (insert-pq cmpsts (+ q p2) p2))) + (let [mn (getMin-pq cmpsts)] + (if (and mn (>= c (.k mn))) ;; never greater than + (recur (+ c 2) q bsprms + (loop [adv (.v mn), cmps cmpsts] ;; advance repeat composites for value + (let [ncmps (replaceMinAs-pq cmps (+ c adv) adv), + nmn (getMin-pq ncmps)] + (if (and nmn (>= c (.k nmn))) + (recur (.v nmn) ncmps) + ncmps)))) + (cons c (lazy-seq (nxtoddprm (+ c 2) q bsprms cmpsts)))))))] + (do (def baseoddprms (cons 3 (lazy-seq (nxtoddprm 5 9 baseoddprms (empty-pq))))) + (cons 2 (lazy-seq (nxtoddprm 3 9 baseoddprms (empty-pq))))))) diff --git a/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-15.clj b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-15.clj new file mode 100644 index 0000000000..f85e812704 --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-15.clj @@ -0,0 +1,148 @@ +(set! *unchecked-math* true) + +(def PGSZ (bit-shift-left 1 14)) ;; size of CPU cache +(def PGBTS (bit-shift-left PGSZ 3)) +(def PGWRDS (bit-shift-right PGBTS 5)) +(def BPWRDS (bit-shift-left 1 7)) ;; smaller page buffer for base primes +(def BPBTS (bit-shift-left BPWRDS 5)) +(defn- count-pg + "count primes in the culled page buffer, with test for limit" + [lmt ^ints pg] + (let [pgsz (alength pg), + pgbts (bit-shift-left pgsz 5), + cntem (fn [lmtw] + (let [lmtw (long lmtw)] + (loop [i (long 0), c (long 0)] + (if (>= i lmtw) (- (bit-shift-left lmtw 5) c) + (recur (inc i) + (+ c (java.lang.Integer/bitCount (aget pg i))))))))] + (if (< lmt pgbts) + (let [lmtw (bit-shift-right lmt 5), + lmtb (bit-and lmt 31) + msk (bit-shift-left -2 lmtb)] + (+ (cntem lmtw) + (- 32 (java.lang.Integer/bitCount (bit-or (aget pg lmtw) + msk))))) + (- pgbts + (areduce pg i ret (long 0) (+ ret (java.lang.Integer/bitCount (aget pg i)))))))) +;; (cntem pgsz)))) +(defn- primes-pages + "unbounded Sieve of Eratosthenes producing a lazy sequence of culled page buffers." + [] + (letfn [(make-pg [lowi pgsz bpgs] + (let [lowi (long lowi), + pgbts (long (bit-shift-left pgsz 5)), + pgrng (long (+ (bit-shift-left (+ lowi pgbts) 1) 3)), + ^ints pg (int-array pgsz), + cull (fn [bpgs'] + (loop [i (long 0), bpgs' bpgs'] + (let [^ints fbpg (first bpgs'), + bpgsz (long (alength fbpg))] + (if (>= i bpgsz) + (recur 0 (next bpgs')) + (let [p (long (aget fbpg i)), + sqr (long (* p p))] + (if (< sqr pgrng) (do + (loop [j (long (let [s (long (bit-shift-right (- sqr 3) 1))] + (if (>= s lowi) (- s lowi) + (let [m (long (rem (- lowi s) p))] + (if (zero? m) + 0 + (- p m))))))] + (if (< j pgbts) ;; fast inner culling loop where most time is spent + (do + (let [w (bit-shift-right j 5)] + (aset pg w (int (bit-or (aget pg w) + (bit-shift-left 1 (bit-and j 31)))))) + (recur (+ j p))))) + (recur (inc i) bpgs'))))))))] + (do (if (nil? bpgs) + (letfn [(mkbpps [i] + (if (zero? (bit-and (aget pg (bit-shift-right i 5)) + (bit-shift-left 1 (bit-and i 31)))) + (cons (int-array 1 (+ i i 3)) (lazy-seq (mkbpps (inc i)))) + (recur (inc i))))] + (cull (mkbpps 0))) + (cull bpgs)) + pg))), + (page-seq [lowi pgsz bps] + (letfn [(next-seq [lwi] + (cons (make-pg lwi pgsz bps) + (lazy-seq (next-seq (+ lwi (bit-shift-left pgsz 5))))))] + (next-seq lowi))) + (pgs->bppgs [ppgs] + (letfn [(nxt-pg [lowi pgs] + (let [^ints pg (first pgs), + cnt (count-pg BPBTS pg), + npg (int-array cnt)] + (do (loop [i 0, j 0] + (if (< i BPBTS) + (if (zero? (bit-and (aget pg (bit-shift-right i 5)) + (bit-shift-left 1 (bit-and i 31)))) + (do (aset npg j (+ (bit-shift-left (+ lowi i) 1) 3)) + (recur (inc i) (inc j))) + (recur (inc i) j)))) + (cons npg (lazy-seq (nxt-pg (+ lowi BPBTS) (next pgs)))))))] + (nxt-pg 0 ppgs))), + (make-base-prms-pgs [] + (pgs->bppgs (cons (make-pg 0 BPWRDS nil) + (lazy-seq (page-seq BPBTS BPWRDS (make-base-prms-pgs))))))] + (page-seq 0 PGWRDS (make-base-prms-pgs)))) +(defn primes-paged + "unbounded Sieve of Eratosthenes producing a lazy sequence of primes" + [] + (do (deftype CIS [v cont] + clojure.lang.ISeq + (first [_] v) + (next [_] (if (nil? cont) nil (cont))) + (more [this] (let [nv (.next this)] (if (nil? nv) (CIS. nil nil) nv))) + (cons [this o] (clojure.core/cons o this)) + (empty [_] (if (and (nil? v) (nil? cont)) nil (CIS. nil nil))) + (equiv [this o] (loop [cis1 this, cis2 o] (if (nil? cis1) (if (nil? cis2) true false) + (if (or (not= (type cis1) (type cis2)) + (not= (.v cis1) (.v ^CIS cis2)) + (and (nil? (.cont cis1)) + (not (nil? (.cont ^CIS cis2)))) + (and (nil? (.cont ^CIS cis2)) + (not (nil? (.cont cis1))))) false + (if (nil? (.cont cis1)) true + (recur ((.cont cis1)) ((.cont ^CIS cis2)))))))) + (count [this] (loop [cis this, cnt 0] (if (or (nil? cis) (nil? (.cont cis))) cnt + (recur ((.cont cis)) (inc cnt))))) + clojure.lang.Seqable + (seq [this] (if (and (nil? v) (nil? cont)) nil this)) + clojure.lang.Sequential + Object + (toString [this] (if (and (nil? v) (nil? cont)) "()" (.toString (seq (map identity this)))))) + (letfn [(next-prm [lowi i pgseq] + (let [lowi (long lowi), + i (long i), + ^ints pg (first pgseq), + pgsz (long (alength pg)), + pgbts (long (bit-shift-left pgsz 5)), + ni (long (loop [j (long i)] + (if (or (>= j pgbts) + (zero? (bit-and (aget pg (bit-shift-right j 5)) + (bit-shift-left 1 (bit-and j 31))))) + j + (recur (inc j)))))] + (if (>= ni pgbts) + (recur (+ lowi pgbts) 0 (next pgseq)) + (->CIS (+ (bit-shift-left (+ lowi ni) 1) 3) + (fn [] (next-prm lowi (inc ni) pgseq))))))] + (->CIS 2 (fn [] (next-prm 0 0 (primes-pages))))))) +(defn primes-paged-count-to + "counts primes generated by page segments by Sieve of Eratosthenes to the top limit" + [top] + (cond (< top 2) 0 + (< top 3) 1 + :else (letfn [(nxt-pg [lowi pgseq cnt] + (let [topi (bit-shift-right (- top 3) 1) + nxti (+ lowi PGBTS), + pg (first pgseq)] + (if (> nxti topi) + (+ cnt (count-pg (- topi lowi) pg)) + (recur nxti + (next pgseq) + (+ cnt (count-pg PGBTS pg))))))] + (nxt-pg 0 (primes-pages) 1)))) diff --git a/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-2.clj b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-2.clj index 39af1285f7..0712ea1149 100644 --- a/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-2.clj +++ b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-2.clj @@ -1,11 +1,13 @@ (defn primes-to - "Returns a lazy sequence of prime numbers less than lim" - [lim] - (let [refs (boolean-array (+ lim 1) true) - root (int (Math/sqrt lim))] - (do (doseq [i (range 2 lim) - :while (<= i root) - :when (aget refs i)] - (doseq [j (range (* i i) lim i)] - (aset refs j false))) - (filter #(aget refs %) (range 2 lim))))) + "Computes lazy sequence of prime numbers up to a given number using sieve of Eratosthenes" + [n] + (let [root (-> n Math/sqrt long), + cmpsts (boolean-array (inc n)), + cullp (fn [p] + (loop [i (* p p)] + (if (<= i n) + (do (aset cmpsts i true) + (recur (+ i p))))))] + (do (dorun (map #(cullp %) (filter #(not (aget cmpsts %)) + (range 2 (inc root))))) + (filter #(not (aget cmpsts %)) (range 2 (inc n)))))) diff --git a/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-3.clj b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-3.clj index 70f5d2da32..39af1285f7 100644 --- a/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-3.clj +++ b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-3.clj @@ -1,9 +1,11 @@ (defn primes-to - "Computes lazy sequence of prime numbers up to a given number using sieve of Eratosthenes" - [n] - (letfn [(nxtprm [cs] ; current candidates - (let [p (first cs)] - (if (> p (Math/sqrt n)) cs - (cons p (lazy-seq (nxtprm (-> (range (* p p) (inc n) p) - set (remove cs) rest)))))))] - (nxtprm (range 2 (inc n))))) + "Returns a lazy sequence of prime numbers less than lim" + [lim] + (let [refs (boolean-array (+ lim 1) true) + root (int (Math/sqrt lim))] + (do (doseq [i (range 2 lim) + :while (<= i root) + :when (aget refs i)] + (doseq [j (range (* i i) lim i)] + (aset refs j false))) + (filter #(aget refs %) (range 2 lim))))) diff --git a/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-4.clj b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-4.clj index d9e6b989f2..bff7b0a43e 100644 --- a/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-4.clj +++ b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-4.clj @@ -1,15 +1,11 @@ (defn primes-to - "Computes lazy sequence of prime numbers up to a given number using sieve of Eratosthenes" - [max-prime] - (let [sieve (fn [s n] - (if (<= (* n n) max-prime) - (recur (if (s n) - (reduce #(assoc %1 %2 false) s (range (* n n) (inc max-prime) n)) - s) - (inc n)) - s))] - (->> (-> (reduce conj (vector-of :boolean) (map #(= % %) (range (inc max-prime)))) - (assoc 0 false) - (assoc 1 false) - (sieve 2)) - (map-indexed #(vector %2 %1)) (filter first) (map second)))) + "Returns a lazy sequence of prime numbers less than lim" + [lim] + (let [max-i (int (/ (- lim 1) 2)) + refs (boolean-array max-i true) + root (/ (dec (int (Math/sqrt lim))) 2)] + (do (doseq [i (range 1 (inc root)) + :when (aget refs i)] + (doseq [j (range (* (+ i i) (inc i)) max-i (+ i i 1))] + (aset refs j false))) + (cons 2 (map #(+ % % 1) (filter #(aget refs %) (range 1 max-i))))))) diff --git a/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-5.clj b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-5.clj index 167340129b..70f5d2da32 100644 --- a/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-5.clj +++ b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-5.clj @@ -1,27 +1,9 @@ -(set! *unchecked-math* true) - (defn primes-to "Computes lazy sequence of prime numbers up to a given number using sieve of Eratosthenes" [n] - (let [root (-> n Math/sqrt long), - rootndx (long (/ (- root 3) 2)), - ndx (long (/ (- n 3) 2)), - cmpsts (long-array (inc (/ ndx 64))), - isprm #(zero? (bit-and (aget cmpsts (bit-shift-right % 6)) - (bit-shift-left 1 (bit-and % 63)))), - cullp (fn [i] - (let [p (long (+ i i 3))] - (loop [i (bit-shift-right (- (* p p) 3) 1)] - (if (<= i ndx) - (do (let [w (bit-shift-right i 6)] - (aset cmpsts w (bit-or (aget cmpsts w) - (bit-shift-left 1 (bit-and i 63))))) - (recur (+ i p))))))), - cull (fn [] (loop [i 0] (if (<= i rootndx) - (do (if (isprm i) (cullp i)) (recur (inc i))))))] - (letfn [(nxtprm [i] (if (<= i ndx) - (cons (+ i i 3) (lazy-seq (nxtprm (loop [i (inc i)] - (if (or (> i ndx) (isprm i)) i - (recur (inc i)))))))))] - (if (< n 2) nil - (cons 3 (if (< n 3) nil (do (cull) (lazy-seq (nxtprm 0))))))))) + (letfn [(nxtprm [cs] ; current candidates + (let [p (first cs)] + (if (> p (Math/sqrt n)) cs + (cons p (lazy-seq (nxtprm (-> (range (* p p) (inc n) p) + set (remove cs) rest)))))))] + (nxtprm (range 2 (inc n))))) diff --git a/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-6.clj b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-6.clj index a00c63174f..d9e6b989f2 100644 --- a/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-6.clj +++ b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-6.clj @@ -1,73 +1,15 @@ -(defn primes-tox +(defn primes-to "Computes lazy sequence of prime numbers up to a given number using sieve of Eratosthenes" - [n] - (let [root (-> n Math/sqrt long), - rootndx (long (/ (- root 3) 2)), - ndx (max (long (/ (- n 3) 2)) 0), - lmt (quot ndx 64), - cmpsts (long-array (inc lmt)), - cullp (fn [i] - (let [p (long (+ i i 3))] - (loop [i (bit-shift-right (- (* p p) 3) 1)] - (if (<= i ndx) - (do (let [w (bit-shift-right i 6)] - (aset cmpsts w (bit-or (aget cmpsts w) - (bit-shift-left 1 (bit-and i 63))))) - (recur (+ i p))))))), - cull (fn [] (do (aset cmpsts lmt (bit-or (aget cmpsts lmt) - (bit-shift-left -2 (bit-and ndx 63)))) - (loop [i 0] - (when (<= i rootndx) - (when (zero? (bit-and (aget cmpsts (bit-shift-right i 6)) - (bit-shift-left 1 (bit-and i 63)))) - (cullp i)) - (recur (inc i)))))) - numprms (fn [] - (let [w (dec (alength cmpsts))] ;; fast results count bit counter - (loop [i 0, cnt (bit-shift-left (alength cmpsts) 6)] - (if (> i w) cnt - (recur (inc i) - (- cnt (java.lang.Long/bitCount (aget cmpsts i))))))))] - (if (< n 2) nil - (cons 2 (if (< n 3) nil - (do (cull) - (deftype OPSeq [^long i ^longs cmpsa ^long cnt ^long tcnt] ;; for arrays maybe need to embed the array so that it doesn't get garbage collected??? - clojure.lang.ISeq - (first [_] (if (nil? cmpsa) nil (+ i i 3))) - (next [_] (let [ncnt (inc cnt)] (if (>= ncnt tcnt) nil - (OPSeq. - (loop [j (inc i)] - (let [p? (zero? (bit-and (aget cmpsa (bit-shift-right j 6)) - (bit-shift-left 1 (bit-and j 63))))] - (if p? j (recur (inc j))))) - cmpsa ncnt tcnt)))) - (more [this] (let [ncnt (inc cnt)] (if (>= ncnt tcnt) (OPSeq. 0 nil tcnt tcnt) - (.next this)))) - (cons [this o] (clojure.core/cons o this)) - (empty [_] (if (= cnt tcnt) nil (OPSeq. 0 nil tcnt tcnt))) - (equiv [this o] (if (or (not= (type this) (type o)) - (not= cnt (.cnt ^OPSeq o)) (not= tcnt (.tcnt ^OPSeq o)) - (not= i (.i ^OPSeq o))) false true)) - clojure.lang.Counted - (count [_] (- tcnt cnt)) - clojure.lang.Seqable - (clojure.lang.Seqable/seq [this] (if (= cnt tcnt) nil this)) - clojure.lang.IReduce - (reduce [_ f v] (let [c (- tcnt cnt)] - (if (<= c 0) nil - (loop [ci i, n c, rslt v] - (if (zero? (bit-and (aget cmpsa (bit-shift-right ci 6)) - (bit-shift-left 1 (bit-and ci 63)))) - (let [rrslt (f rslt (+ ci ci 3)), - rdcd (reduced? rrslt), - nrslt (if rdcd @rrslt rrslt)] - (if (or (<= n 1) rdcd) nrslt - (recur (inc ci) (dec n) nrslt))) - (recur (inc ci) n rslt)))))) - (reduce [this f] (if (nil? i) (f) (if (= (.count this) 1) (+ i i 3) - (.reduce ^clojure.lang.IReduce (.next this) f (+ i i 3))))) - clojure.lang.Sequential - Object - (toString [this] (if (= cnt tcnt) "()" - (.toString (seq (map identity this)))))) - (->OPSeq 0 cmpsts 0 (numprms)))))))) + [max-prime] + (let [sieve (fn [s n] + (if (<= (* n n) max-prime) + (recur (if (s n) + (reduce #(assoc %1 %2 false) s (range (* n n) (inc max-prime) n)) + s) + (inc n)) + s))] + (->> (-> (reduce conj (vector-of :boolean) (map #(= % %) (range (inc max-prime)))) + (assoc 0 false) + (assoc 1 false) + (sieve 2)) + (map-indexed #(vector %2 %1)) (filter first) (map second)))) diff --git a/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-7.clj b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-7.clj index 50cc25e527..167340129b 100644 --- a/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-7.clj +++ b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-7.clj @@ -1,22 +1,27 @@ -(defn primes-Bird - "Computes the unbounded sequence of primes using a Sieve of Eratosthenes algorithm by Richard Bird." - [] - (letfn [(mltpls [p] (let [p2 (* 2 p)] - (letfn [(nxtmltpl [c] - (cons c (lazy-seq (nxtmltpl (+ c p2)))))] - (nxtmltpl (* p p))))), - (allmtpls [ps] (cons (mltpls (first ps)) (lazy-seq (allmtpls (next ps))))), - (union [xs ys] (let [xv (first xs), yv (first ys)] - (if (< xv yv) (cons xv (lazy-seq (union (next xs) ys))) - (if (< yv xv) (cons yv (lazy-seq (union xs (next ys)))) - (cons xv (lazy-seq (union (next xs) (next ys)))))))), - (mrgmltpls [mltplss] (cons (first (first mltplss)) - (lazy-seq (union (next (first mltplss)) - (mrgmltpls (next mltplss)))))), - (minusStrtAt [n cmpsts] (loop [n n, cmpsts cmpsts] - (if (< n (first cmpsts)) - (cons n (lazy-seq (minusStrtAt (+ n 2) cmpsts))) - (recur (+ n 2) (next cmpsts)))))] - (do (def oddprms (cons 3 (lazy-seq (let [cmpsts (-> oddprms (allmtpls) (mrgmltpls))] - (minusStrtAt 5 cmpsts))))) - (cons 2 (lazy-seq oddprms))))) +(set! *unchecked-math* true) + +(defn primes-to + "Computes lazy sequence of prime numbers up to a given number using sieve of Eratosthenes" + [n] + (let [root (-> n Math/sqrt long), + rootndx (long (/ (- root 3) 2)), + ndx (long (/ (- n 3) 2)), + cmpsts (long-array (inc (/ ndx 64))), + isprm #(zero? (bit-and (aget cmpsts (bit-shift-right % 6)) + (bit-shift-left 1 (bit-and % 63)))), + cullp (fn [i] + (let [p (long (+ i i 3))] + (loop [i (bit-shift-right (- (* p p) 3) 1)] + (if (<= i ndx) + (do (let [w (bit-shift-right i 6)] + (aset cmpsts w (bit-or (aget cmpsts w) + (bit-shift-left 1 (bit-and i 63))))) + (recur (+ i p))))))), + cull (fn [] (loop [i 0] (if (<= i rootndx) + (do (if (isprm i) (cullp i)) (recur (inc i))))))] + (letfn [(nxtprm [i] (if (<= i ndx) + (cons (+ i i 3) (lazy-seq (nxtprm (loop [i (inc i)] + (if (or (> i ndx) (isprm i)) i + (recur (inc i)))))))))] + (if (< n 2) nil + (cons 3 (if (< n 3) nil (do (cull) (lazy-seq (nxtprm 0))))))))) diff --git a/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-8.clj b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-8.clj index 88ef52e5a3..a00c63174f 100644 --- a/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-8.clj +++ b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-8.clj @@ -1,25 +1,73 @@ -(defn primes-treeFolding - "Computes the unbounded sequence of primes using a Sieve of Eratosthenes algorithm modified from Bird." - [] - (letfn [(mltpls [p] (let [p2 (* 2 p)] - (letfn [(nxtmltpl [c] - (cons c (lazy-seq (nxtmltpl (+ c p2)))))] - (nxtmltpl (* p p))))), - (allmtpls [ps] (cons (mltpls (first ps)) (lazy-seq (allmtpls (next ps))))), - (union [xs ys] (let [xv (first xs), yv (first ys)] - (if (< xv yv) (cons xv (lazy-seq (union (next xs) ys))) - (if (< yv xv) (cons yv (lazy-seq (union xs (next ys)))) - (cons xv (lazy-seq (union (next xs) (next ys)))))))), - (pairs [mltplss] (let [tl (next mltplss)] - (cons (union (first mltplss) (first tl)) - (lazy-seq (pairs (next tl)))))), - (mrgmltpls [mltplss] (cons (first (first mltplss)) - (lazy-seq (union (next (first mltplss)) - (mrgmltpls (pairs (next mltplss))))))), - (minusStrtAt [n cmpsts] (loop [n n, cmpsts cmpsts] - (if (< n (first cmpsts)) - (cons n (lazy-seq (minusStrtAt (+ n 2) cmpsts))) - (recur (+ n 2) (next cmpsts)))))] - (do (def oddprms (cons 3 (lazy-seq (let [cmpsts (-> oddprms (allmtpls) (mrgmltpls))] - (minusStrtAt 5 cmpsts))))) - (cons 2 (lazy-seq oddprms))))) +(defn primes-tox + "Computes lazy sequence of prime numbers up to a given number using sieve of Eratosthenes" + [n] + (let [root (-> n Math/sqrt long), + rootndx (long (/ (- root 3) 2)), + ndx (max (long (/ (- n 3) 2)) 0), + lmt (quot ndx 64), + cmpsts (long-array (inc lmt)), + cullp (fn [i] + (let [p (long (+ i i 3))] + (loop [i (bit-shift-right (- (* p p) 3) 1)] + (if (<= i ndx) + (do (let [w (bit-shift-right i 6)] + (aset cmpsts w (bit-or (aget cmpsts w) + (bit-shift-left 1 (bit-and i 63))))) + (recur (+ i p))))))), + cull (fn [] (do (aset cmpsts lmt (bit-or (aget cmpsts lmt) + (bit-shift-left -2 (bit-and ndx 63)))) + (loop [i 0] + (when (<= i rootndx) + (when (zero? (bit-and (aget cmpsts (bit-shift-right i 6)) + (bit-shift-left 1 (bit-and i 63)))) + (cullp i)) + (recur (inc i)))))) + numprms (fn [] + (let [w (dec (alength cmpsts))] ;; fast results count bit counter + (loop [i 0, cnt (bit-shift-left (alength cmpsts) 6)] + (if (> i w) cnt + (recur (inc i) + (- cnt (java.lang.Long/bitCount (aget cmpsts i))))))))] + (if (< n 2) nil + (cons 2 (if (< n 3) nil + (do (cull) + (deftype OPSeq [^long i ^longs cmpsa ^long cnt ^long tcnt] ;; for arrays maybe need to embed the array so that it doesn't get garbage collected??? + clojure.lang.ISeq + (first [_] (if (nil? cmpsa) nil (+ i i 3))) + (next [_] (let [ncnt (inc cnt)] (if (>= ncnt tcnt) nil + (OPSeq. + (loop [j (inc i)] + (let [p? (zero? (bit-and (aget cmpsa (bit-shift-right j 6)) + (bit-shift-left 1 (bit-and j 63))))] + (if p? j (recur (inc j))))) + cmpsa ncnt tcnt)))) + (more [this] (let [ncnt (inc cnt)] (if (>= ncnt tcnt) (OPSeq. 0 nil tcnt tcnt) + (.next this)))) + (cons [this o] (clojure.core/cons o this)) + (empty [_] (if (= cnt tcnt) nil (OPSeq. 0 nil tcnt tcnt))) + (equiv [this o] (if (or (not= (type this) (type o)) + (not= cnt (.cnt ^OPSeq o)) (not= tcnt (.tcnt ^OPSeq o)) + (not= i (.i ^OPSeq o))) false true)) + clojure.lang.Counted + (count [_] (- tcnt cnt)) + clojure.lang.Seqable + (clojure.lang.Seqable/seq [this] (if (= cnt tcnt) nil this)) + clojure.lang.IReduce + (reduce [_ f v] (let [c (- tcnt cnt)] + (if (<= c 0) nil + (loop [ci i, n c, rslt v] + (if (zero? (bit-and (aget cmpsa (bit-shift-right ci 6)) + (bit-shift-left 1 (bit-and ci 63)))) + (let [rrslt (f rslt (+ ci ci 3)), + rdcd (reduced? rrslt), + nrslt (if rdcd @rrslt rrslt)] + (if (or (<= n 1) rdcd) nrslt + (recur (inc ci) (dec n) nrslt))) + (recur (inc ci) n rslt)))))) + (reduce [this f] (if (nil? i) (f) (if (= (.count this) 1) (+ i i 3) + (.reduce ^clojure.lang.IReduce (.next this) f (+ i i 3))))) + clojure.lang.Sequential + Object + (toString [this] (if (= cnt tcnt) "()" + (.toString (seq (map identity this)))))) + (->OPSeq 0 cmpsts 0 (numprms)))))))) diff --git a/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-9.clj b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-9.clj index 56556a39d9..50cc25e527 100644 --- a/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-9.clj +++ b/Task/Sieve-of-Eratosthenes/Clojure/sieve-of-eratosthenes-9.clj @@ -1,48 +1,22 @@ -(defn primes-treeFoldingx - "Computes the unbounded sequence of primes using a Sieve of Eratosthenes algorithm modified from Bird." +(defn primes-Bird + "Computes the unbounded sequence of primes using a Sieve of Eratosthenes algorithm by Richard Bird." [] - (do (deftype CIS [v cont] - clojure.lang.ISeq - (first [_] v) - (next [_] (if (nil? cont) nil (cont))) - (more [this] (let [nv (.next this)] (if (nil? nv) (CIS. nil nil) nv))) - (cons [this o] (clojure.core/cons o this)) - (empty [_] (if (and (nil? v) (nil? cont)) nil (CIS. nil nil))) - (equiv [this o] (loop [cis1 this, cis2 o] (if (nil? cis1) (if (nil? cis2) true false) - (if (or (not= (type cis1) (type cis2)) - (not= (.v cis1) (.v ^CIS cis2)) - (and (nil? (.cont cis1)) - (not (nil? (.cont ^CIS cis2)))) - (and (nil? (.cont ^CIS cis2)) - (not (nil? (.cont cis1))))) false - (if (nil? (.cont cis1)) true - (recur ((.cont cis1)) ((.cont ^CIS cis2)))))))) - (count [this] (loop [cis this, cnt 0] (if (or (nil? cis) (nil? (.cont cis))) cnt - (recur ((.cont cis)) (inc cnt))))) - clojure.lang.Seqable - (seq [this] (if (and (nil? v) (nil? cont)) nil this)) - clojure.lang.Sequential - Object - (toString [this] (if (and (nil? v) (nil? cont)) "()" (.toString (seq (map identity this)))))) - (letfn [(mltpls [p] (let [p2 (* 2 p)] - (letfn [(nxtmltpl [c] - (->CIS c (fn [] (nxtmltpl (+ c p2)))))] - (nxtmltpl (* p p))))), - (allmtpls [^CIS ps] (->CIS (mltpls (.v ps)) (fn [] (allmtpls ((.cont ps)))))), - (union [^CIS xs ^CIS ys] (let [xv (.v xs), yv (.v ys)] - (if (< xv yv) (->CIS xv (fn [] (union ((.cont xs)) ys))) - (if (< yv xv) (->CIS yv (fn [] (union xs ((.cont ys))))) - (->CIS xv (fn [] (union (next xs) ((.cont ys))))))))), - (pairs [^CIS mltplss] (let [^CIS tl ((.cont mltplss))] - (->CIS (union (.v mltplss) (.v tl)) - (fn [] (pairs ((.cont tl))))))), - (mrgmltpls [^CIS mltplss] (->CIS (.v ^CIS (.v mltplss)) - (fn [] (union ((.cont ^CIS (.v mltplss))) - (mrgmltpls (pairs ((.cont mltplss)))))))), - (minusStrtAt [n ^CIS cmpsts] (loop [n n, cmpsts cmpsts] - (if (< n (.v cmpsts)) - (->CIS n (fn [] (minusStrtAt (+ n 2) cmpsts))) - (recur (+ n 2) ((.cont cmpsts))))))] - (do (def oddprms (->CIS 3 (fn [] (let [cmpsts (-> oddprms (allmtpls) (mrgmltpls))] - (minusStrtAt 5 cmpsts))))) - (->CIS 2 (fn [] oddprms)))))) + (letfn [(mltpls [p] (let [p2 (* 2 p)] + (letfn [(nxtmltpl [c] + (cons c (lazy-seq (nxtmltpl (+ c p2)))))] + (nxtmltpl (* p p))))), + (allmtpls [ps] (cons (mltpls (first ps)) (lazy-seq (allmtpls (next ps))))), + (union [xs ys] (let [xv (first xs), yv (first ys)] + (if (< xv yv) (cons xv (lazy-seq (union (next xs) ys))) + (if (< yv xv) (cons yv (lazy-seq (union xs (next ys)))) + (cons xv (lazy-seq (union (next xs) (next ys)))))))), + (mrgmltpls [mltplss] (cons (first (first mltplss)) + (lazy-seq (union (next (first mltplss)) + (mrgmltpls (next mltplss)))))), + (minusStrtAt [n cmpsts] (loop [n n, cmpsts cmpsts] + (if (< n (first cmpsts)) + (cons n (lazy-seq (minusStrtAt (+ n 2) cmpsts))) + (recur (+ n 2) (next cmpsts)))))] + (do (def oddprms (cons 3 (lazy-seq (let [cmpsts (-> oddprms (allmtpls) (mrgmltpls))] + (minusStrtAt 5 cmpsts))))) + (cons 2 (lazy-seq oddprms))))) diff --git a/Task/Sieve-of-Eratosthenes/Elixir/sieve-of-eratosthenes.elixir b/Task/Sieve-of-Eratosthenes/Elixir/sieve-of-eratosthenes-1.elixir similarity index 100% rename from Task/Sieve-of-Eratosthenes/Elixir/sieve-of-eratosthenes.elixir rename to Task/Sieve-of-Eratosthenes/Elixir/sieve-of-eratosthenes-1.elixir diff --git a/Task/Sieve-of-Eratosthenes/Elixir/sieve-of-eratosthenes-2.elixir b/Task/Sieve-of-Eratosthenes/Elixir/sieve-of-eratosthenes-2.elixir new file mode 100644 index 0000000000..cc9116678b --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/Elixir/sieve-of-eratosthenes-2.elixir @@ -0,0 +1,6 @@ +defmodule Sieve do + def primes_to(limit), do: sieve(Enum.to_list(2..limit)) + + defp sieve([h|t]), do: [h|sieve(t -- for n <- 1..length(t), do: h*n)] + defp sieve([]), do: [] +end diff --git a/Task/Sieve-of-Eratosthenes/Erlang/sieve-of-eratosthenes-5.erl b/Task/Sieve-of-Eratosthenes/Erlang/sieve-of-eratosthenes-5.erl new file mode 100644 index 0000000000..d933be98a7 --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/Erlang/sieve-of-eratosthenes-5.erl @@ -0,0 +1,64 @@ +#!/usr/bin/env escript +%% -*- erlang -*- +%%! -smp enable -sname p10_4 +% vim:syn=erlang + +-mode(compile). + +main([N0]) -> + N = list_to_integer(N0), + ets:new(comp, [public, named_table, {write_concurrency, true} ]), + ets:new(prim, [public, named_table, {write_concurrency, true}]), + composite_mc(N), + primes_mc(N), + io:format("Answer: ~p ~n", [lists:sort([X||{X,_}<-ets:tab2list(prim)])]). + +primes_mc(N) -> + case erlang:system_info(schedulers) of + 1 -> primes(N); + C -> launch_primes(lists:seq(1,C), C, N, N div C) + end. +launch_primes([1|T], C, N, R) -> P = self(), spawn(fun()-> primes(2,R), P ! {ok, prm} end), launch_primes(T, C, N, R); +launch_primes([H|[]], C, N, R)-> P = self(), spawn(fun()-> primes(R*(H-1)+1,N), P ! {ok, prm} end), wait_primes(C); +launch_primes([H|T], C, N, R) -> P = self(), spawn(fun()-> primes(R*(H-1)+1,R*H), P ! {ok, prm} end), launch_primes(T, C, N, R). + +wait_primes(0) -> ok; +wait_primes(C) -> + receive + {ok, prm} -> wait_primes(C-1) + after 1000 -> wait_primes(C) + end. + +primes(N) -> primes(2, N). +primes(I,N) when I =< N -> + case ets:lookup(comp, I) of + [] -> ets:insert(prim, {I,1}) + ;_ -> ok + end, + primes(I+1, N); +primes(I,N) when I > N -> ok. + + +composite_mc(N) -> composite_mc(N,2,round(math:sqrt(N)),erlang:system_info(schedulers)). +composite_mc(N,I,M,C) when I =< M, C > 0 -> + C1 = case ets:lookup(comp, I) of + [] -> comp_i_mc(I*I, I, N), C-1 + ;_ -> C + end, + composite_mc(N,I+1,M,C1); +composite_mc(_,I,M,_) when I > M -> ok; +composite_mc(N,I,M,0) -> + receive + {ok, cim} -> composite_mc(N,I,M,1) + after 1000 -> composite_mc(N,I,M,0) + end. + +comp_i_mc(J, I, N) -> + Parent = self(), + spawn(fun() -> + comp_i(J, I, N), + Parent ! {ok, cim} + end). + +comp_i(J, I, N) when J =< N -> ets:insert(comp, {J, 1}), comp_i(J+I, I, N); +comp_i(J, _, N) when J > N -> ok. diff --git a/Task/Sieve-of-Eratosthenes/Go/sieve-of-eratosthenes-2.go b/Task/Sieve-of-Eratosthenes/Go/sieve-of-eratosthenes-2.go index d33dd3e210..efafc1e673 100644 --- a/Task/Sieve-of-Eratosthenes/Go/sieve-of-eratosthenes-2.go +++ b/Task/Sieve-of-Eratosthenes/Go/sieve-of-eratosthenes-2.go @@ -1,60 +1,48 @@ package main -import "fmt" -type xint uint64 -type xgen func()(xint) +import ( + "fmt" + "math" +) -func primes() func()(xint) { - pp, psq := make([]xint, 0), xint(25) - - var sieve func(xint, xint)xgen - sieve = func(p, n xint) xgen { - m, next := xint(0), xgen(nil) - return func()(r xint) { - if next == nil { - r = n - if r <= psq { - n += p - return - } - - next = sieve(pp[0] * 2, psq) // chain in - pp = pp[1:] - psq = pp[0] * pp[0] - - m = next() +func primesOdds(top uint) func() uint { + topndx := int((top - 3) / 2) + topsqrtndx := (int(math.Sqrt(float64(top))) - 3) / 2 + cmpsts := make([]uint, (topndx/32)+1) + for i := 0; i <= topsqrtndx; i++ { + if cmpsts[i>>5]&(uint(1)<<(uint(i)&0x1F)) == 0 { + p := (i << 1) + 3 + for j := (p*p - 3) >> 1; j <= topndx; j += p { + cmpsts[j>>5] |= 1 << (uint(j) & 0x1F) } - switch { - case n < m: r, n = n, n + p - case n > m: r, m = m, next() - default: r, n, m = n, n + p, next() - } - return } } - - f := sieve(6, 9) - n, p := f(), xint(0) - - return func()(xint) { - switch { - case p < 2: p = 2 - case p < 3: p = 3 - default: - for p += 2; p == n; { - p += 2 - if p > n { - n = f() - } - } - pp = append(pp, p) + i := -1 + return func() uint { + oi := i + if i <= topndx { + i++ + } + for i <= topndx && cmpsts[i>>5]&(1<<(uint(i)&0x1F)) != 0 { + i++ + } + if oi < 0 { + return 2 + } else { + return (uint(oi) << 1) + 3 } - return p } } func main() { - for i, p := 0, primes(); i < 100000; i++ { - fmt.Println(p()) + iter := primesOdds(100) + for v := iter(); v <= 100; v = iter() { + print(v, " ") } + iter = primesOdds(1000000) + count := 0 + for v := iter(); v <= 1000000; v = iter() { + count++ + } + fmt.Printf("\r\n%v\r\n", count) } diff --git a/Task/Sieve-of-Eratosthenes/Go/sieve-of-eratosthenes-3.go b/Task/Sieve-of-Eratosthenes/Go/sieve-of-eratosthenes-3.go index f2ac3c958c..d33dd3e210 100644 --- a/Task/Sieve-of-Eratosthenes/Go/sieve-of-eratosthenes-3.go +++ b/Task/Sieve-of-Eratosthenes/Go/sieve-of-eratosthenes-3.go @@ -1,41 +1,60 @@ package main import "fmt" -// Send the sequence 2, 3, 4, ... to channel 'ch'. -func Generate(ch chan<- int) { - for i := 2; ; i++ { - ch <- i // Send 'i' to channel 'ch'. +type xint uint64 +type xgen func()(xint) + +func primes() func()(xint) { + pp, psq := make([]xint, 0), xint(25) + + var sieve func(xint, xint)xgen + sieve = func(p, n xint) xgen { + m, next := xint(0), xgen(nil) + return func()(r xint) { + if next == nil { + r = n + if r <= psq { + n += p + return + } + + next = sieve(pp[0] * 2, psq) // chain in + pp = pp[1:] + psq = pp[0] * pp[0] + + m = next() + } + switch { + case n < m: r, n = n, n + p + case n > m: r, m = m, next() + default: r, n, m = n, n + p, next() + } + return + } + } + + f := sieve(6, 9) + n, p := f(), xint(0) + + return func()(xint) { + switch { + case p < 2: p = 2 + case p < 3: p = 3 + default: + for p += 2; p == n; { + p += 2 + if p > n { + n = f() + } + } + pp = append(pp, p) + } + return p } } -// Copy the values from channel 'in' to channel 'out', -// removing those divisible by 'prime'. -// 'in' assumed to send increasing numbers -func Filter(in <-chan int, out chan<- int, prime int) { - m := prime + prime - for { - i := <-in // Receive value from 'in'. - for i > m { - m = m + prime - } - if i < m { - out <- i // Send 'i' to 'out'. - } - } -} - -// The prime sieve: Daisy-chain Filter processes. func main() { - ch := make(chan int) // Create a new channel. - go Generate(ch) // Launch Generate goroutine. - for i := 0; i < 100; i++ { - prime := <-ch - fmt.Printf("%4d", prime) - if (i+1)%20==0 { - fmt.Println("") - } - ch1 := make(chan int) - go Filter(ch, ch1, prime) - ch = ch1 + for i, p := 0, primes(); i < 100000; i++ { + fmt.Println(p()) } } diff --git a/Task/Sieve-of-Eratosthenes/Go/sieve-of-eratosthenes-4.go b/Task/Sieve-of-Eratosthenes/Go/sieve-of-eratosthenes-4.go new file mode 100644 index 0000000000..1e684cf3ee --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/Go/sieve-of-eratosthenes-4.go @@ -0,0 +1,52 @@ +package main +import "fmt" + +// Send the sequence 2, 3, 4, ... to channel 'out' +func Generate(out chan<- int) { + for i := 2; ; i++ { + out <- i // Send 'i' to channel 'out' + } +} + +// Copy the values from 'in' channel to 'out' channel, +// removing the multiples of 'prime' by counting. +// 'in' is assumed to send increasing numbers +func Filter(in <-chan int, out chan<- int, prime int) { + m := prime + prime // first multiple of prime + for { + i := <- in // Receive value from 'in' + for i > m { + m = m + prime // next multiple of prime + } + if i < m { + out <- i // Send 'i' to 'out' + } + } +} + +// The prime sieve: Daisy-chain Filter processes +func Sieve(out chan<- int) { + gen := make(chan int) // Create a new channel + go Generate(gen) // Launch Generate goroutine + for { + prime := <- gen + out <- prime + ft := make(chan int) + go Filter(gen, ft, prime) + gen = ft + } +} + +func main() { + sv := make(chan int) // Create a new channel + go Sieve(sv) // Launch Sieve goroutine + for i := 0; i < 1000; i++ { + prime := <- sv + if i >= 990 { + fmt.Printf("%4d ", prime) + if (i+1)%20==0 { + fmt.Println("") + } + } + } +} diff --git a/Task/Sieve-of-Eratosthenes/Go/sieve-of-eratosthenes-5.go b/Task/Sieve-of-Eratosthenes/Go/sieve-of-eratosthenes-5.go new file mode 100644 index 0000000000..5636d7877a --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/Go/sieve-of-eratosthenes-5.go @@ -0,0 +1,68 @@ +package main +import "fmt" + +// Send the sequence 2, 3, 4, ... to channel 'out' +func Generate(out chan<- int) { + for i := 2; ; i++ { + out <- i // Send 'i' to channel 'out' + } +} + +// Copy the values from 'in' channel to 'out' channel, +// removing the multiples of 'prime' by counting. +// 'in' is assumed to send increasing numbers +func Filter(in <-chan int, out chan<- int, prime int) { + m := prime * prime // start from square of prime + for { + i := <- in // Receive value from 'in' + for i > m { + m = m + prime // next multiple of prime + } + if i < m { + out <- i // Send 'i' to 'out' + } + } +} + +// The prime sieve: Postponed-creation Daisy-chain of Filters +func Sieve(out chan<- int) { + gen := make(chan int) // Create a new channel + go Generate(gen) // Launch Generate goroutine + p := <- gen + out <- p + p = <- gen // make recursion shallower ----> + out <- p // (Go channels are _push_, not _pull_) + + base_primes := make(chan int) // separate primes supply + go Sieve(base_primes) + bp := <- base_primes // 2 <---- here + bq := bp * bp // 4 + + for { + p = <- gen + if p == bq { // square of a base prime + ft := make(chan int) + go Filter(gen, ft, bp) // filter multiples of bp in gen out + gen = ft + bp = <- base_primes // 3 + bq = bp * bp // 9 + } else { + out <- p + } + } +} + +func main() { + sv := make(chan int) // Create a new channel + go Sieve(sv) // Launch Sieve goroutine + lim := 25000 + for i := 0; i < lim; i++ { + prime := <- sv + if i >= (lim-10) { + fmt.Printf("%4d ", prime) + if (i+1)%20==0 { + fmt.Println("") + } + } + } +} diff --git a/Task/Sieve-of-Eratosthenes/Haskell/sieve-of-eratosthenes-10.hs b/Task/Sieve-of-Eratosthenes/Haskell/sieve-of-eratosthenes-10.hs index f79534a9b9..1d4fb757b2 100644 --- a/Task/Sieve-of-Eratosthenes/Haskell/sieve-of-eratosthenes-10.hs +++ b/Task/Sieve-of-Eratosthenes/Haskell/sieve-of-eratosthenes-10.hs @@ -7,6 +7,6 @@ primesW = [2,3,5,7] ++ _Y ( (11:) . gapsW 13 (tail wheel) . _U . gapsW k (d:w) s@(c:cs) | k < c = k : gapsW (k+d) w s -- set difference | otherwise = gapsW (k+d) w cs -- k==c -wheel = 2:4:2:4:6:2:6:4:2:4:6:6:2:6:4:2:6:4:6:8:4:2:4:2: +wheel = 2:4:2:4:6:2:6:4:2:4:6:6:2:6:4:2:6:4:6:8:4:2:4:2: -- gaps = (`gapsW` cycle [2]) 4:8:6:4:6:2:4:6:2:6:6:4:2:4:6:2:6:4:2:4:2:10:2:10:wheel -- cycle $ zipWith (-) =<< tail $ [i | i <- [11..221], gcd i 210 == 1] diff --git a/Task/Sieve-of-Eratosthenes/Haskell/sieve-of-eratosthenes-4.hs b/Task/Sieve-of-Eratosthenes/Haskell/sieve-of-eratosthenes-4.hs index 17693021db..5ad8bd48a2 100644 --- a/Task/Sieve-of-Eratosthenes/Haskell/sieve-of-eratosthenes-4.hs +++ b/Task/Sieve-of-Eratosthenes/Haskell/sieve-of-eratosthenes-4.hs @@ -1,9 +1,9 @@ -primesTo m = 2 : eratos [3,5..m] where +primesTo m = eratos [2..m] where eratos (p : xs) | p*p > m = p : xs - | otherwise = p : eratos (xs `minus` [p*p, p*p+2*p..m]) - -- map (p*) [p,p+2..] - -- map (p*) (p:xs) -- (Euler's sieve) + | otherwise = p : eratos (xs `minus` [p*p, p*p+p..m]) + -- map (p*) [p..] + -- map (p*) (p:xs) -- (Euler's sieve) minus a@(x:xs) b@(y:ys) = case compare x y of LT -> x : minus xs b diff --git a/Task/Sieve-of-Eratosthenes/Haskell/sieve-of-eratosthenes-5.hs b/Task/Sieve-of-Eratosthenes/Haskell/sieve-of-eratosthenes-5.hs index f88220823d..fbb329d00e 100644 --- a/Task/Sieve-of-Eratosthenes/Haskell/sieve-of-eratosthenes-5.hs +++ b/Task/Sieve-of-Eratosthenes/Haskell/sieve-of-eratosthenes-5.hs @@ -1,3 +1,4 @@ primesE = sieve [2..] where sieve (p:xs) = p : sieve (minus xs [p, p+p..]) +-- unfoldr (\(p:xs)-> Just (p, minus xs [p, p+p..])) [2..] diff --git a/Task/Sieve-of-Eratosthenes/Haskell/sieve-of-eratosthenes-6.hs b/Task/Sieve-of-Eratosthenes/Haskell/sieve-of-eratosthenes-6.hs index ffd6526088..e00fe9bd2e 100644 --- a/Task/Sieve-of-Eratosthenes/Haskell/sieve-of-eratosthenes-6.hs +++ b/Task/Sieve-of-Eratosthenes/Haskell/sieve-of-eratosthenes-6.hs @@ -3,3 +3,6 @@ primesPE = 2 : sieve [3..] 4 primesPE sieve (x:xs) q (p:t) | x < q = x : sieve xs q (p:t) | otherwise = sieve (minus xs [q, q+p..]) (head t^2) t +-- fix $ (2:) . concat +-- . unfoldr (\(p:ps,xs)-> Just . second ((ps,) . (`minus` [p*p, p*p+p..])) +-- . span (< p*p) $ xs) . (,[3..]) diff --git a/Task/Sieve-of-Eratosthenes/Haskell/sieve-of-eratosthenes-8.hs b/Task/Sieve-of-Eratosthenes/Haskell/sieve-of-eratosthenes-8.hs index 5ffd86b063..5e1edbd456 100644 --- a/Task/Sieve-of-Eratosthenes/Haskell/sieve-of-eratosthenes-8.hs +++ b/Task/Sieve-of-Eratosthenes/Haskell/sieve-of-eratosthenes-8.hs @@ -1,9 +1,12 @@ -primesB = _Y $ ((2:) . minus [3..] - . foldr (\x-> (x*x :) . union [x*x+x, x*x+2*x..]) []) +primesB = _Y ( (2:) . minus [3..] . foldr (\p-> (p*p :) . union [p*p+p, p*p+2*p..]) [] ) -_Y g = g (_Y g) -- = g . g . g . ... non-sharing multistage fixpoint combinator --- = let x = g x in g x -- = g (fix g) two-stage fixpoint combinator --- = let x = g x in x -- = fix g sharing fixpoint combinator +-- = _Y ( (2:) . minus [3..] . _LU . map(\p-> [p*p, p*p+p..]) ) +-- _LU ((x:xs):t) = x : (union xs . _LU) t -- linear folding big union + +_Y g = g (_Y g) -- = g (g (g ( ... ))) non-sharing multistage fixpoint combinator +-- = g . g . g . ... ... = g^inf +-- = let x = g x in g x -- = g (fix g) two-stage fixpoint combinator +-- = let x = g x in x -- = fix g sharing fixpoint combinator union a@(x:xs) b@(y:ys) = case compare x y of LT -> x : union xs b diff --git a/Task/Sieve-of-Eratosthenes/Haskell/sieve-of-eratosthenes-9.hs b/Task/Sieve-of-Eratosthenes/Haskell/sieve-of-eratosthenes-9.hs index 53eb96f9a7..101296a226 100644 --- a/Task/Sieve-of-Eratosthenes/Haskell/sieve-of-eratosthenes-9.hs +++ b/Task/Sieve-of-Eratosthenes/Haskell/sieve-of-eratosthenes-9.hs @@ -1,9 +1,9 @@ primes :: [Int] primes = 2 : _Y ( (3:) . gaps 5 . _U . map(\p-> [p*p, p*p+2*p..]) ) -gaps k s@(c:cs) | k < c = k : gaps (k+2) s -- ~= ([k,k+2..] \\ s) - | otherwise = gaps (k+2) cs -- when null(s\\[k,k+2..]) +gaps k s@(c:cs) | k < c = k : gaps (k+2) s -- ~= ([k,k+2..] \\ s) + | otherwise = gaps (k+2) cs -- when null(s\\[k,k+2..]) -_U ((x:xs):t) = x : (union xs . _U . pairs) t -- ~= nub . sort . concat - where +_U ((x:xs):t) = x : (union xs . _U . pairs) t -- tree-shaped folding big union + where -- ~= nub . sort . concat pairs (xs:ys:t) = union xs ys : pairs t diff --git a/Task/Sieve-of-Eratosthenes/J/sieve-of-eratosthenes-10.j b/Task/Sieve-of-Eratosthenes/J/sieve-of-eratosthenes-10.j index dac74e190f..cceea9f574 100644 --- a/Task/Sieve-of-Eratosthenes/J/sieve-of-eratosthenes-10.j +++ b/Task/Sieve-of-Eratosthenes/J/sieve-of-eratosthenes-10.j @@ -1,10 +1 @@ -sieve1=: 3 : 0 - m=. <.%:y - z=. $0 - b=. y{.1 - while. m>:j=. 1+b i. 0 do. - b=. b+.y$(-j){.1 - z=. z,j - end. - z,1+I.-.b - ) +sieve0a=: verb def 'I.(y>2)*2=+/0=|/~ i.y' diff --git a/Task/Sieve-of-Eratosthenes/J/sieve-of-eratosthenes-11.j b/Task/Sieve-of-Eratosthenes/J/sieve-of-eratosthenes-11.j index 92011e64fa..dac74e190f 100644 --- a/Task/Sieve-of-Eratosthenes/J/sieve-of-eratosthenes-11.j +++ b/Task/Sieve-of-Eratosthenes/J/sieve-of-eratosthenes-11.j @@ -1,10 +1,10 @@ -sieve2=: 3 : 0 - m=. <.%:y - z=. y (>:#]) 2 3 5 7 - b=. 1,}.y$+./(*/z)$&>(-z){.&.>1 - while. m>:j=. 1+b i. 0 do. - b=. b+.y$(-j){.1 - z=. z,j - end. - z,1+I.-.b -) +sieve1=: 3 : 0 + m=. <.%:y + z=. $0 + b=. y{.1 + while. m>:j=. 1+b i. 0 do. + b=. b+.y$(-j){.1 + z=. z,j + end. + z,1+I.-.b + ) diff --git a/Task/Sieve-of-Eratosthenes/J/sieve-of-eratosthenes-12.j b/Task/Sieve-of-Eratosthenes/J/sieve-of-eratosthenes-12.j index e7182672de..92011e64fa 100644 --- a/Task/Sieve-of-Eratosthenes/J/sieve-of-eratosthenes-12.j +++ b/Task/Sieve-of-Eratosthenes/J/sieve-of-eratosthenes-12.j @@ -1,9 +1,10 @@ - 0=|/~ i.8 -1 0 0 0 0 0 0 0 -1 1 1 1 1 1 1 1 -1 0 1 0 1 0 1 0 -1 0 0 1 0 0 1 0 -1 0 0 0 1 0 0 0 -1 0 0 0 0 1 0 0 -1 0 0 0 0 0 1 0 -1 0 0 0 0 0 0 1 +sieve2=: 3 : 0 + m=. <.%:y + z=. y (>:#]) 2 3 5 7 + b=. 1,}.y$+./(*/z)$&>(-z){.&.>1 + while. m>:j=. 1+b i. 0 do. + b=. b+.y$(-j){.1 + z=. z,j + end. + z,1+I.-.b +) diff --git a/Task/Sieve-of-Eratosthenes/J/sieve-of-eratosthenes-13.j b/Task/Sieve-of-Eratosthenes/J/sieve-of-eratosthenes-13.j new file mode 100644 index 0000000000..e7182672de --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/J/sieve-of-eratosthenes-13.j @@ -0,0 +1,9 @@ + 0=|/~ i.8 +1 0 0 0 0 0 0 0 +1 1 1 1 1 1 1 1 +1 0 1 0 1 0 1 0 +1 0 0 1 0 0 1 0 +1 0 0 0 1 0 0 0 +1 0 0 0 0 1 0 0 +1 0 0 0 0 0 1 0 +1 0 0 0 0 0 0 1 diff --git a/Task/Sieve-of-Eratosthenes/J/sieve-of-eratosthenes-14.j b/Task/Sieve-of-Eratosthenes/J/sieve-of-eratosthenes-14.j new file mode 100644 index 0000000000..abf5823a21 --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/J/sieve-of-eratosthenes-14.j @@ -0,0 +1,12 @@ +sieve=:verb define + seq=: 2+i.y-1 NB. 2 thru y + n=. 2 + l=. #seq + whilst. -.seq-:prev do. + prev=. seq + mask=. l{.1-(0{.~n-1),1}.l$n{.1 + seq=. seq * mask + n=. {.((n-1)}.seq)-.0 + end. + seq -. 0 +) diff --git a/Task/Sieve-of-Eratosthenes/J/sieve-of-eratosthenes-15.j b/Task/Sieve-of-Eratosthenes/J/sieve-of-eratosthenes-15.j new file mode 100644 index 0000000000..df567a3fbd --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/J/sieve-of-eratosthenes-15.j @@ -0,0 +1,2 @@ + sieve 100 +2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 diff --git a/Task/Sieve-of-Eratosthenes/J/sieve-of-eratosthenes-16.j b/Task/Sieve-of-Eratosthenes/J/sieve-of-eratosthenes-16.j new file mode 100644 index 0000000000..2b6426987b --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/J/sieve-of-eratosthenes-16.j @@ -0,0 +1,34 @@ +label=:dyad def 'echo x,":y' + +sieve=:verb define + 'seq ' label seq=: 2+i.y-1 NB. 2 thru y + 'n ' label n=. 2 + 'l ' label l=. #seq + whilst. -.seq-:prev do. + prev=. seq + 'mask ' label mask=. l{.1-(0{.~n-1),1}.l$n{.1 + 'seq ' label seq=. seq * mask + 'n ' label n=. {.((n-1)}.seq)-.0 + end. + seq -. 0 +) + +seq 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 +n 2 +l 59 +mask 1 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 +seq 2 3 0 5 0 7 0 9 0 11 0 13 0 15 0 17 0 19 0 21 0 23 0 25 0 27 0 29 0 31 0 33 0 35 0 37 0 39 0 41 0 43 0 45 0 47 0 49 0 51 0 53 0 55 0 57 0 59 0 +n 3 +mask 1 1 1 1 0 1 1 0 1 1 0 1 1 0 1 1 0 1 1 0 1 1 0 1 1 0 1 1 0 1 1 0 1 1 0 1 1 0 1 1 0 1 1 0 1 1 0 1 1 0 1 1 0 1 1 0 1 1 0 +seq 2 3 0 5 0 7 0 0 0 11 0 13 0 0 0 17 0 19 0 0 0 23 0 25 0 0 0 29 0 31 0 0 0 35 0 37 0 0 0 41 0 43 0 0 0 47 0 49 0 0 0 53 0 55 0 0 0 59 0 +n 5 +mask 1 1 1 1 1 1 1 1 0 1 1 1 1 0 1 1 1 1 0 1 1 1 1 0 1 1 1 1 0 1 1 1 1 0 1 1 1 1 0 1 1 1 1 0 1 1 1 1 0 1 1 1 1 0 1 1 1 1 0 +seq 2 3 0 5 0 7 0 0 0 11 0 13 0 0 0 17 0 19 0 0 0 23 0 0 0 0 0 29 0 31 0 0 0 0 0 37 0 0 0 41 0 43 0 0 0 47 0 49 0 0 0 53 0 0 0 0 0 59 0 +n 7 +mask 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 0 1 1 1 1 1 1 0 1 1 1 1 1 1 0 1 1 1 1 1 1 0 1 1 1 1 1 1 0 1 1 1 1 1 1 0 1 1 1 1 +seq 2 3 0 5 0 7 0 0 0 11 0 13 0 0 0 17 0 19 0 0 0 23 0 0 0 0 0 29 0 31 0 0 0 0 0 37 0 0 0 41 0 43 0 0 0 47 0 0 0 0 0 53 0 0 0 0 0 59 0 +n 11 +mask 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1 1 +seq 2 3 0 5 0 7 0 0 0 11 0 13 0 0 0 17 0 19 0 0 0 23 0 0 0 0 0 29 0 31 0 0 0 0 0 37 0 0 0 41 0 43 0 0 0 47 0 0 0 0 0 53 0 0 0 0 0 59 0 +n 13 +2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 diff --git a/Task/Sieve-of-Eratosthenes/J/sieve-of-eratosthenes-17.j b/Task/Sieve-of-Eratosthenes/J/sieve-of-eratosthenes-17.j new file mode 100644 index 0000000000..d298b028e8 --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/J/sieve-of-eratosthenes-17.j @@ -0,0 +1,12 @@ +sieve=:verb define + seq=: 2+i.y-1 NB. 2 thru y + n=. 1 + l=. #seq + whilst. -.seq-:prev do. + prev=. seq + n=. 1+n+1 i.~ * (n-1)}.seq + inds=. (2*n)+n*i.(<.l%n)-1 + seq=. 0 inds} seq + end. + seq -. 0 +) diff --git a/Task/Sieve-of-Eratosthenes/Julia/sieve-of-eratosthenes.julia b/Task/Sieve-of-Eratosthenes/Julia/sieve-of-eratosthenes-1.julia similarity index 100% rename from Task/Sieve-of-Eratosthenes/Julia/sieve-of-eratosthenes.julia rename to Task/Sieve-of-Eratosthenes/Julia/sieve-of-eratosthenes-1.julia diff --git a/Task/Sieve-of-Eratosthenes/Julia/sieve-of-eratosthenes-2.julia b/Task/Sieve-of-Eratosthenes/Julia/sieve-of-eratosthenes-2.julia new file mode 100644 index 0000000000..914078eb45 --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/Julia/sieve-of-eratosthenes-2.julia @@ -0,0 +1,14 @@ +function sieve(n :: Int) + a = trues(n) + a[1] = false + for i = 1:n + if a[i] + j = i * i + if j > n + return find(a) + else + a[j:i:n] = false + end + end + end +end diff --git a/Task/Sieve-of-Eratosthenes/Kotlin/sieve-of-eratosthenes-1.kotlin b/Task/Sieve-of-Eratosthenes/Kotlin/sieve-of-eratosthenes-1.kotlin new file mode 100644 index 0000000000..a3d773f380 --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/Kotlin/sieve-of-eratosthenes-1.kotlin @@ -0,0 +1,30 @@ +fun sieve(limit: Int): List { + val primes = mutableListOf() + + if (limit >= 2) { + val numbers = Array(limit + 1) { true } + val sqrtLimit = Math.sqrt(limit.toDouble()).toInt() + + for (factor in 2..sqrtLimit) { + if (numbers[factor]) { + for (multiple in (factor * factor)..limit step factor) { + numbers[multiple] = false + } + } + } + + numbers.forEachIndexed { number, isPrime -> + if (number >= 2) { + if (isPrime) { + primes.add(number) + } + } + } + } + + return primes +} + +fun main(args: Array) { + println(sieve(100)) +} diff --git a/Task/Sieve-of-Eratosthenes/Kotlin/sieve-of-eratosthenes-2.kotlin b/Task/Sieve-of-Eratosthenes/Kotlin/sieve-of-eratosthenes-2.kotlin new file mode 100644 index 0000000000..8863814507 --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/Kotlin/sieve-of-eratosthenes-2.kotlin @@ -0,0 +1,40 @@ +fun primesOdds(rng: Int): Iterable { + val topi = (rng - 3) shr 1 + val lstw = topi shr 5 + val sqrtndx = (Math.sqrt(rng.toDouble()).toInt() - 3) shr 1 + val cmpsts = IntArray(lstw + 1) + tailrec fun testloop(i: Int) { + if (i <= sqrtndx) { + if (cmpsts[i shr 5] and (1 shl (i and 31)) == 0) { + val p = i + i + 3 + tailrec fun cullp(j: Int) { + if (j <= topi) { + cmpsts[j shr 5] = cmpsts[j shr 5] or (1 shl (j and 31)) + cullp(j + p) + } + } + cullp((p * p - 3) shr 1) + } + testloop(i + 1) + } + } + testloop(0) + tailrec fun test(i : Int): Int { + return if (i <= topi && cmpsts[i shr 5] and (1 shl (i and 31)) != 0) { + test(i + 1) } else { i } + } + val iter = object : IntIterator() { + var i = -1 + override fun nextInt(): Int { + val oi = i; i = test(i + 1) + if (oi < 0) { return 2 } else { return oi + oi + 3 } } + override fun hasNext() = if (i < topi) { true } else { false } + } + return Iterable { -> iter } +} + +fun main(args: Array) { + primesOdds(100).forEach { print("$it ") } + println() + println(primesOdds(1000000).count()) +} diff --git a/Task/Sieve-of-Eratosthenes/Kotlin/sieve-of-eratosthenes-3.kotlin b/Task/Sieve-of-Eratosthenes/Kotlin/sieve-of-eratosthenes-3.kotlin new file mode 100644 index 0000000000..2509795ec4 --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/Kotlin/sieve-of-eratosthenes-3.kotlin @@ -0,0 +1,15 @@ +fun primesOdds(rng: Int): Iterable { + val topi = (rng - 3) / 2 //convert to nearest index + val size = topi / 32 + 1 //word size to include index + val sqrtndx = (Math.sqrt(rng.toDouble()).toInt() - 3) / 2 + val cmpsts = IntArray(size) + fun is_p(i: Int) = if (cmpsts[i shr 5] and (1 shl (i and 0x1F)) == 0) + { true } else { false } + fun cull(i: Int) { cmpsts[i shr 5] = cmpsts[i shr 5] or + (1 shl (i and 0x1F)) } + fun cullp(p: Int) = ((p * p - 3) / 2 .. topi step(p)).forEach { cull(it) } + (0 .. sqrtndx).filter { is_p(it) }.forEach { cullp(it + it + 3) } + fun i2p(i: Int) = if (i < 0) { 2 } else { i + i + 3 } + val orng = (-1 .. topi).filter { it < 0 || is_p(it) }.map { i2p(it) } + return Iterable { -> orng.iterator() } +} diff --git a/Task/Sieve-of-Eratosthenes/Kotlin/sieve-of-eratosthenes-4.kotlin b/Task/Sieve-of-Eratosthenes/Kotlin/sieve-of-eratosthenes-4.kotlin new file mode 100644 index 0000000000..2bbc1adad7 --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/Kotlin/sieve-of-eratosthenes-4.kotlin @@ -0,0 +1,17 @@ +fun primesOdds(rng: Int): Iterable { + val topi = (rng - 3) / 2 //convert to nearest index + val size = topi / 32 + 1 //word size to include index + val sqrtndx = (Math.sqrt(rng.toDouble()).toInt() - 3) / 2 + val cmpsts = IntArray(size) + fun is_p(i: Int) = if (cmpsts[i shr 5] and (1 shl (i and 0x1F)) == 0) + { true } else { false } + fun cull(i: Int) { cmpsts[i shr 5] = cmpsts[i shr 5] or + (1 shl (i and 0x1F)) } + fun iseq(high: Int, low: Int = 0, stp: Int = 1) = + Sequence { (low .. high step(stp)).iterator() } + fun cullp(p: Int) = iseq(topi, (p * p - 3) / 2, p).forEach { cull(it) } + iseq(sqrtndx).filter { is_p(it) }.forEach { cullp(it + it + 3) } + fun i2p(i: Int) = if (i < 0) { 2 } else { i + i + 3 } + val oseq = iseq(topi, -1).filter { it < 0 || is_p(it) }.map { i2p(it) } + return Iterable { -> oseq.iterator() } +} diff --git a/Task/Sieve-of-Eratosthenes/Perl-6/sieve-of-eratosthenes-1.pl6 b/Task/Sieve-of-Eratosthenes/Perl-6/sieve-of-eratosthenes-1.pl6 index 2df2490d5f..831b916254 100644 --- a/Task/Sieve-of-Eratosthenes/Perl-6/sieve-of-eratosthenes-1.pl6 +++ b/Task/Sieve-of-Eratosthenes/Perl-6/sieve-of-eratosthenes-1.pl6 @@ -4,7 +4,9 @@ sub sieve( Int $limit ) { gather for @is-prime.kv -> $number, $is-prime { if $is-prime { take $number; - @is-prime[$_] = False if $_ %% $number for $number**2 .. $limit; + loop (my $s = $number**2; $s <= $limit; $s += $number) { + @is-prime[$s] = False; + } } } } diff --git a/Task/Sieve-of-Eratosthenes/Perl-6/sieve-of-eratosthenes-2.pl6 b/Task/Sieve-of-Eratosthenes/Perl-6/sieve-of-eratosthenes-2.pl6 index 3769d61e13..5155558baa 100644 --- a/Task/Sieve-of-Eratosthenes/Perl-6/sieve-of-eratosthenes-2.pl6 +++ b/Task/Sieve-of-Eratosthenes/Perl-6/sieve-of-eratosthenes-2.pl6 @@ -1,5 +1,12 @@ -multi erat(Int $N) { erat 2 .. $N } -multi erat(@a where @a[0] > sqrt @a[*-1]) { @a } -multi erat(@a) { @a[0], erat(@a.grep: * % @a[0]) } -  -say erat 100; +sub eratsieve($n) { + # Requires n(1 - 1/(log(n-1))) storage + my $multiples = set(); + lazy gather for 2..$n -> $i { + unless $i (&) $multiples { # is subset + take $i; + $multiples (+)= set($i**2, *+$i ... (* > $n)); # union + } + } +} + +say flat eratsieve(100); diff --git a/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-1.pro b/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-1.pro index 85f34ef187..50b2ae4b1b 100644 --- a/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-1.pro +++ b/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-1.pro @@ -1,35 +1,14 @@ -% %sieve( +N, -Primes ) is true if Primes is the list of consecutive primes -% that are less than or equal to N -sieve( N, [2|Rest]) :- - retractall( composite(_) ), - sieve( N, 2, Rest ) -> true. % only one solution +primes(N, L) :- numlist(2, N, Xs), + sieve(Xs, L). -% sieve P, find the next non-prime, and then recurse: -sieve( N, P, [I|Rest] ) :- - sieve_once(P, N), - (P = 2 -> P2 is P+1; P2 is P+2), - between(P2, N, I), - (composite(I) -> fail; sieve( N, I, Rest )). +sieve([H|T], [H|X]) :- H2 is H + H, + filter(H, H2, T, R), + sieve(R, X). +sieve([], []). -% It is OK if there are no more primes less than or equal to N: -sieve( N, P, [] ). - -sieve_once(P, N) :- - forall( between(P, N, P, IP), - (composite(IP) -> true ; assertz( composite(IP) )) ). - - -% To avoid division, we use the iterator -% between(+Min, +Max, +By, -I) -% where we assume that By > 0 -% This is like "for(I=Min; I <= Max; I+=By)" in C. -between(Min, Max, By, I) :- - Min =< Max, - A is Min + By, - (I = Min; between(A, Max, By, I) ). - - -% Some Prolog implementations require the dynamic predicates be -% declared: - -:- dynamic( composite/1 ). +filter(_, _, [], []). +filter(H, H2, [H1|T], R) :- + ( H1 < H2 -> R = [H1|R1], filter(H, H2, T, R1) + ; H3 is H2 + H, + ( H1 =:= H2 -> filter(H, H3, T, R) + ; filter(H, H3, [H1|T], R) ) ). diff --git a/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-10.pro b/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-10.pro new file mode 100644 index 0000000000..dac25fcae5 --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-10.pro @@ -0,0 +1,7 @@ +%% stdout copy +[9592, 99991] +[78498, 999983] + +%% stderr copy +% 293,176 inferences, 0.14 CPU in 0.14 seconds (101% CPU, 2094114 Lips) +% 3,122,303 inferences, 1.63 CPU in 1.67 seconds (97% CPU, 1915523 Lips) diff --git a/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-11.pro b/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-11.pro new file mode 100644 index 0000000000..3405beff59 --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-11.pro @@ -0,0 +1,26 @@ +?- use_module(library(heaps)). + +prime(2). +prime(N) :- prime_heap(N, _). + +prime_heap(3, H) :- list_to_heap([9-6], H). +prime_heap(N, H) :- + prime_heap(M, H0), N0 is M + 2, + next_prime(N0, H0, N, H). + +next_prime(N0, H0, N, H) :- + \+ min_of_heap(H0, N0, _), + N = N0, Composite is N*N, Skip is N+N, + add_to_heap(H0, Composite, Skip, H). +next_prime(N0, H0, N, H) :- + min_of_heap(H0, N0, _), + adjust_heap(H0, N0, H1), N1 is N0 + 2, + next_prime(N1, H1, N, H). + +adjust_heap(H0, N, H) :- + min_of_heap(H0, N, _), + get_from_heap(H0, N, Skip, H1), + Composite is N + Skip, add_to_heap(H1, Composite, Skip, H2), + adjust_heap(H2, N, H). +adjust_heap(H, N, H) :- + \+ min_of_heap(H, N, _). diff --git a/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-2.pro b/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-2.pro index 20589c0335..3c198e08af 100644 --- a/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-2.pro +++ b/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-2.pro @@ -1,7 +1,14 @@ -% SWI-Prolog: +primes(X, PS) :- X > 1, range(2, X, R), sieve(R, PS). -?- time( (sieve(100000,P), length(P,N), writeln(N), last(P, LP), writeln(LP) )). -% 1,323,159 inferences, 0.862 CPU in 0.921 seconds (94% CPU, 1534724 Lips) -P = [2, 3, 5, 7, 11, 13, 17, 19, 23|...], -N = 9592, -LP = 99991. +range(X, X, [X]) :- !. +range(X, Y, [X | R]) :- X < Y, X1 is X + 1, range(X1, Y, R). + +mult(A, B, C) :- C is A*B. + +sieve([X], [X]) :- !. +sieve([H | T], [H | S]) :- maplist( mult(H), [H | T], MS), + remove(MS, T, R), sieve(R, S). + +remove( _, [], [] ) :- !. +remove( [H | X], [H | Y], R ) :- !, remove(X, Y, R). +remove( X, [H | Y], [H | R]) :- remove(X, Y, R). diff --git a/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-3.pro b/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-3.pro index 59fbc049d2..0a9582a54b 100644 --- a/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-3.pro +++ b/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-3.pro @@ -1,30 +1,5 @@ -sieve(N, [2|PS]) :- % PS is list of odd primes up to N - retractall(mult(_)), - sieve_O(3,N,PS). +primes(X, PS) :- X > 1, range(2, X, R), sieve(X, R, PS). -sieve_O(I,N,PS) :- % sieve odds from I up to N to get PS - I =< N, !, I1 is I+2, - ( mult(I) -> sieve_O(I1,N,PS) - ; ( I =< N / I -> - ISq is I*I, DI is 2*I, add_mults(DI,ISq,N) - ; true - ), - PS = [I|T], - sieve_O(I1,N,T) - ). -sieve_O(I,N,[]) :- I > N. - -add_mults(DI,I,N) :- - I =< N, !, - ( mult(I) -> true ; assert(mult(I)) ), - I1 is I+DI, - add_mults(DI,I1,N). -add_mults(_,I,N) :- I > N. - -main(N) :- current_prolog_flag(verbose,F), - set_prolog_flag(verbose,normal), - time( sieve( N,P)), length(P,Len), last(P, LP), writeln([Len,LP]), - set_prolog_flag(verbose,F). - -:- dynamic( mult/1 ). -:- main(100000), main(1000000). +sieve(X, [H | T], [H | T]) :- H*H > X, !. +sieve(X, [H | T], [H | S]) :- maplist( mult(H), [H | T], MS), + remove(MS, T, R), sieve(X, R, S). diff --git a/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-4.pro b/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-4.pro index dac25fcae5..e0edd7661f 100644 --- a/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-4.pro +++ b/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-4.pro @@ -1,7 +1,16 @@ -%% stdout copy -[9592, 99991] -[78498, 999983] +primes(X, PS) :- X > 1, range(2, X, R), sieve(X, R, PS). -%% stderr copy -% 293,176 inferences, 0.14 CPU in 0.14 seconds (101% CPU, 2094114 Lips) -% 3,122,303 inferences, 1.63 CPU in 1.67 seconds (97% CPU, 1915523 Lips) +range(X, X, [X]) :- !. +range(X, Y, [X | R]) :- X < Y, X1 is X + 1, range(X1, Y, R). + +sieve(X, [H | T], [H | T]) :- H*H > X, !. +sieve(X, [H | T], [H | S]) :- mults( H, X, MS), remove(MS, T, R), sieve(X, R, S). + +mults( H, Lim, MS):- M is H*H, mults( H, M, Lim, MS). +mults( _, M, Lim, []):- M > Lim, !. +mults( H, M, Lim, [M|MS]):- M2 is M+H, mults( H, M2, Lim, MS). + +remove( _, [], [] ) :- !. +remove( [H | X], [H | Y], R ) :- !, remove(X, Y, R). +remove( [H | X], [G | Y], R ) :- H < G, !, remove(X, [G | Y], R). +remove( X, [H | Y], [H | R]) :- remove(X, Y, R). diff --git a/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-5.pro b/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-5.pro index 3405beff59..d30ed5e2c2 100644 --- a/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-5.pro +++ b/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-5.pro @@ -1,26 +1,11 @@ -?- use_module(library(heaps)). +primes(PS):- count(2, 1, NS), sieve(NS, PS). -prime(2). -prime(N) :- prime_heap(N, _). +count(N, D, [N|T]):- freeze(T, (N2 is N+D, count(N2, D, T))). -prime_heap(3, H) :- list_to_heap([9-6], H). -prime_heap(N, H) :- - prime_heap(M, H0), N0 is M + 2, - next_prime(N0, H0, N, H). +sieve([N|NS],[N|PS]):- N2 is N*N, count(N2,N,A), remove(A,NS,B), freeze(PS, sieve(B,PS)). -next_prime(N0, H0, N, H) :- - \+ min_of_heap(H0, N0, _), - N = N0, Composite is N*N, Skip is N+N, - add_to_heap(H0, Composite, Skip, H). -next_prime(N0, H0, N, H) :- - min_of_heap(H0, N0, _), - adjust_heap(H0, N0, H1), N1 is N0 + 2, - next_prime(N1, H1, N, H). +take(N, X, A):- length(A, N), append(A, _, X). -adjust_heap(H0, N, H) :- - min_of_heap(H0, N, _), - get_from_heap(H0, N, Skip, H1), - Composite is N + Skip, add_to_heap(H1, Composite, Skip, H2), - adjust_heap(H2, N, H). -adjust_heap(H, N, H) :- - \+ min_of_heap(H, N, _). +remove([A|T],[B|S],R):- A < B -> remove(T,[B|S],R) ; + A=:=B -> remove(T,S,R) ; + R = [B|R2], freeze(R2, remove([A|T], S, R2)). diff --git a/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-6.pro b/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-6.pro new file mode 100644 index 0000000000..49328e207f --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-6.pro @@ -0,0 +1,7 @@ +primes([2|PS]):- + freeze(PS, (primes(BPS), count(3, 1, NS), sieve(NS, BPS, 4, PS))). + +sieve([N|NS], BPS, Q, PS):- + N < Q -> PS = [N|PS2], freeze(PS2, sieve(NS, BPS, Q, PS2)) + ; BPS = [BP,BP2|BPS2], Q2 is BP2*BP2, count(Q, BP, MS), + remove(MS, NS, R), sieve(R, [BP2|BPS2], Q2, PS). diff --git a/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-7.pro b/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-7.pro new file mode 100644 index 0000000000..85f34ef187 --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-7.pro @@ -0,0 +1,35 @@ +% %sieve( +N, -Primes ) is true if Primes is the list of consecutive primes +% that are less than or equal to N +sieve( N, [2|Rest]) :- + retractall( composite(_) ), + sieve( N, 2, Rest ) -> true. % only one solution + +% sieve P, find the next non-prime, and then recurse: +sieve( N, P, [I|Rest] ) :- + sieve_once(P, N), + (P = 2 -> P2 is P+1; P2 is P+2), + between(P2, N, I), + (composite(I) -> fail; sieve( N, I, Rest )). + +% It is OK if there are no more primes less than or equal to N: +sieve( N, P, [] ). + +sieve_once(P, N) :- + forall( between(P, N, P, IP), + (composite(IP) -> true ; assertz( composite(IP) )) ). + + +% To avoid division, we use the iterator +% between(+Min, +Max, +By, -I) +% where we assume that By > 0 +% This is like "for(I=Min; I <= Max; I+=By)" in C. +between(Min, Max, By, I) :- + Min =< Max, + A is Min + By, + (I = Min; between(A, Max, By, I) ). + + +% Some Prolog implementations require the dynamic predicates be +% declared: + +:- dynamic( composite/1 ). diff --git a/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-8.pro b/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-8.pro new file mode 100644 index 0000000000..20589c0335 --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-8.pro @@ -0,0 +1,7 @@ +% SWI-Prolog: + +?- time( (sieve(100000,P), length(P,N), writeln(N), last(P, LP), writeln(LP) )). +% 1,323,159 inferences, 0.862 CPU in 0.921 seconds (94% CPU, 1534724 Lips) +P = [2, 3, 5, 7, 11, 13, 17, 19, 23|...], +N = 9592, +LP = 99991. diff --git a/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-9.pro b/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-9.pro new file mode 100644 index 0000000000..59fbc049d2 --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/Prolog/sieve-of-eratosthenes-9.pro @@ -0,0 +1,30 @@ +sieve(N, [2|PS]) :- % PS is list of odd primes up to N + retractall(mult(_)), + sieve_O(3,N,PS). + +sieve_O(I,N,PS) :- % sieve odds from I up to N to get PS + I =< N, !, I1 is I+2, + ( mult(I) -> sieve_O(I1,N,PS) + ; ( I =< N / I -> + ISq is I*I, DI is 2*I, add_mults(DI,ISq,N) + ; true + ), + PS = [I|T], + sieve_O(I1,N,T) + ). +sieve_O(I,N,[]) :- I > N. + +add_mults(DI,I,N) :- + I =< N, !, + ( mult(I) -> true ; assert(mult(I)) ), + I1 is I+DI, + add_mults(DI,I1,N). +add_mults(_,I,N) :- I > N. + +main(N) :- current_prolog_flag(verbose,F), + set_prolog_flag(verbose,normal), + time( sieve( N,P)), length(P,Len), last(P, LP), writeln([Len,LP]), + set_prolog_flag(verbose,F). + +:- dynamic( mult/1 ). +:- main(100000), main(1000000). diff --git a/Task/Sieve-of-Eratosthenes/REXX/sieve-of-eratosthenes-1.rexx b/Task/Sieve-of-Eratosthenes/REXX/sieve-of-eratosthenes-1.rexx index f3a56675ea..0b5a49059e 100644 --- a/Task/Sieve-of-Eratosthenes/REXX/sieve-of-eratosthenes-1.rexx +++ b/Task/Sieve-of-Eratosthenes/REXX/sieve-of-eratosthenes-1.rexx @@ -1,13 +1,12 @@ -/*REXX program generates primes via the sieve of Eratosthenes algorithm.*/ -parse arg H .; if H=='' then H=200 /*was the high limit specified? */ -w=length(H); @prime=right('prime',20) /*W is used for formatting output*/ -@.=. /*assume all numbers are prime. */ -#=0 /*number of primes found so far. */ - do j=2 for H-1 /*all integers up to H inclusive.*/ - if @.j=='' then iterate /*Composite? Then skip this num.*/ - #=#+1 /*bump the prime number counter. */ - say @prime right(#,w) " ───► " right(j,w) /*show the prime.*/ - do m=j*j to H by j; @.m=; end /*strike all multiples as ¬ prime*/ - end /*j*/ /* ─── */ - /*stick a fork in it, we're done.*/ -say; say right(#,w+length(@prime)+1) 'primes found.' +/*REXX program generates primes via the sieve of Eratosthenes algorithm. */ +parse arg H .; if H=='' | H=="," then H=200 /*optain optional argument from the CL.*/ +w=length(H); @prime=right('prime', 20) /*W: is used for aligning the output.*/ +@.=. /*assume all the numbers are prime. */ +#=0 /*number of primes found (so far). */ + do j=2 for H-1; if @.j=='' then iterate /*all prime integers up to H inclusive.*/ + #=#+1 /*bump the prime number counter. */ + say @prime right(#,w) " ───► " right(j,w) /*display the prime to the terminal. */ + do m=j*j to H by j; @.m=; end /*m*/ /*strike all multiples as being ¬ prime*/ + end /*j*/ /* ─── */ +say +say right(#,w+length(@prime)+1) 'primes found.' /*stick a fork in it, we're all done. */ diff --git a/Task/Sieve-of-Eratosthenes/REXX/sieve-of-eratosthenes-2.rexx b/Task/Sieve-of-Eratosthenes/REXX/sieve-of-eratosthenes-2.rexx index 214d0da7b7..e342949433 100644 --- a/Task/Sieve-of-Eratosthenes/REXX/sieve-of-eratosthenes-2.rexx +++ b/Task/Sieve-of-Eratosthenes/REXX/sieve-of-eratosthenes-2.rexx @@ -1,22 +1,22 @@ -/*REXX pgm gens primes via a wheeled sieve of Eratosthenes algorithm.*/ -parse arg H .; if H=='' then H=200 /*let the highest # be specified.*/ -tell=h>0; H=abs(H); w=length(H) /*neg H suppresses prime listing.*/ -if 2<=H & tell then say right(1,w+20)'st prime ───► ' right(2,w) -#= w<=H /*number of primes found so far. */ -@.=. /*assume all numbers are prime. */ -!=0 /*skips top part of sieve marking*/ - do j=3 by 2 for (H-2)%2 /*odd integers up to H inclusive.*/ - if @.j=='' then iterate /*composite? Then skip this num.*/ - #=#+1 /*bump the prime number counter. */ - if tell then say right(#,w+20)th(#) 'prime ───► ' right(j,w) - if ! then iterate /*should the top part be skipped?*/ - jj=j*j /*compute the square of J. __ */ - if jj>H then !=1 /*indicate skipping if j > √ H.*/ - do m=jj to H by j+j; @.m=; end /*strike odd multiples as ¬ prime*/ - end /*j*/ /* ─── */ +/*REXX program generates primes via a wheeled sieve of Eratosthenes algorithm. */ +parse arg H .; if H=='' | H=="," then H=200 /*obtain the optional argument from CL.*/ +tell=h>0; H=abs(H); w=length(H) /*negative H suppresses prime listing.*/ +if 2<=H & tell then say right(1, w+20)'st prime ───► ' right(2, w) +#= 2<=H /*the number of primes found (so far).*/ +@.=. /*assume all the numbers are prime */ +!=0 /*skips the top part of sieve marking.*/ + do j=3 by 2 for (H-2)%2 /*the odd integers up to H inclusive.*/ + if @.j=='' then iterate /*Is composite? Then skip this number.*/ + #=#+1 /*bump the prime number counter. */ + if tell then say right(#, w+20)th(#) 'prime ───► ' right(j, w) + if ! then iterate /*should the top part be skipped ? */ + jj=j*j /*compute the square of J. ___ */ + if jj>H then !=1 /*indicate skipping if j > √ H */ + do m=jj to H by j+j; @.m=; end /*m*/ /*strike odd multiples as not prime. */ + end /*j*/ /* ─── */ say -say right(#,w+20) 'prime's(#) "found." -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────one─liner subroutines────────────────────────────────────────*/ -s: if arg(1)==1 then return arg(3); return word(arg(2) 's',1) /*pluralizer.*/ -th: procedure; parse arg x; x=abs(x); return word('th st nd rd',1+x//10*(x//100%10\==1)*(x//10<4)) +say right(#, w+20) 'prime's(#) "found." /*display the count of primes found. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +s: if arg(1)==1 then return arg(3); return word(arg(2) 's', 1) /*pluralizer.*/ +th: procedure; x=arg(1); return word('th st nd rd', 1+ x//10*(x//100%10\==1) * (x//10<4)) diff --git a/Task/Sieve-of-Eratosthenes/REXX/sieve-of-eratosthenes-3.rexx b/Task/Sieve-of-Eratosthenes/REXX/sieve-of-eratosthenes-3.rexx index a6d8f95bd1..7e26e462a4 100644 --- a/Task/Sieve-of-Eratosthenes/REXX/sieve-of-eratosthenes-3.rexx +++ b/Task/Sieve-of-Eratosthenes/REXX/sieve-of-eratosthenes-3.rexx @@ -1,18 +1,18 @@ -/*REXX pgm gens primes via a wheeled sieve of Eratosthenes algorithm.*/ -parse arg H .; if H=='' then H=200 /*high# can be specified on C.L. */ -w=length(H); @prime=right('prime', 20) /*W is used for formatting output*/ -if 2<=H then say @prime right(1,w) " ───► " right(2,w) -#= 2<=H /*number of primes found so far. */ -@.=. /*assume all numbers are prime. */ -!=0 /*skips top part of sieve marking*/ - do j=3 by 2 for (H-2)%2 /*odd integers up to H inclusive.*/ - if @.j=='' then iterate /*composite? Then skip this num.*/ - #=#+1 /*bump the prime number counter. */ - say @prime right(#,w) " ───► " right(j,w) /*show the prime.*/ - if ! then iterate /*should the top part be skipped?*/ - jj=j*j /*compute the square of J. __ */ - if jj>H then !=1 /*indicate skipping if j > √ H.*/ - do m=jj to H by j+j; @.m=; end /*strike odd multiples as ¬ prime*/ - end /*j*/ /* ─── */ -say /*stick a fork in it, we're done.*/ -say right(#, w+length(@prime)+1) 'primes found.' +/*REXX program generates primes via a wheeled sieve of Eratosthenes algorithm. */ +parse arg H .; if H=='' | H=="," then H=200 /*obtain the optional argument from CL.*/ +w=length(H); @prime=right('prime', 20) /*w: is used for aligning the output. */ +if 2<=H then say @prime right(1, w) " ───► " right(2, w) +#= 2<=H /*the number of primes found (so far).*/ +@.=. /*assume all the numbers are prime */ +!=0 /*skips the top part of sieve marking.*/ + do j=3 by 2 for (H-2)%2 /*the odd integers up to H inclusive.*/ + if @.j=='' then iterate /*Is composite? Then skip this number.*/ + #=#+1 /*bump the prime number counter. */ + say @prime right(#,w) " ───► " right(j,w) /*display the prime to the terminal. */ + if ! then iterate /*should the top part be skipped ? */ + jj=j*j /*compute the square of j. ___ */ + if jj>H then !=1 /*indicate skipping if j > √ H */ + do m=jj to H by j+j; @.m=; end /*m*/ /*strike odd multiples as not prime. */ + end /*j*/ /* ─── */ +say +say right(#, w+length(@prime)+1) 'primes found.' /*stick a fork in it, we're all done. */ diff --git a/Task/Sieve-of-Eratosthenes/Rust/sieve-of-eratosthenes.rust b/Task/Sieve-of-Eratosthenes/Rust/sieve-of-eratosthenes-1.rust similarity index 100% rename from Task/Sieve-of-Eratosthenes/Rust/sieve-of-eratosthenes.rust rename to Task/Sieve-of-Eratosthenes/Rust/sieve-of-eratosthenes-1.rust diff --git a/Task/Sieve-of-Eratosthenes/Rust/sieve-of-eratosthenes-2.rust b/Task/Sieve-of-Eratosthenes/Rust/sieve-of-eratosthenes-2.rust new file mode 100644 index 0000000000..4f72ea42a0 --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/Rust/sieve-of-eratosthenes-2.rust @@ -0,0 +1,45 @@ +use std::iter::{empty, once}; +use std::time::Instant; + +fn basic_sieve(limit: usize) -> Box> { + if limit < 2 { return Box::new(empty()) } + + let mut is_prime = vec![true; limit+1]; + is_prime[0] = false; + if limit >= 1 { is_prime[1] = false } + let sqrtlmt = (limit as f64).sqrt() as usize + 1; + + for num in 2..sqrtlmt { + if is_prime[num] { + let mut multiple = num * num; + while multiple <= limit { + is_prime[multiple] = false; + multiple += num; + } + } + } + + Box::new(is_prime.into_iter().enumerate() + .filter_map(|(p, is_prm)| if is_prm { Some(p) } else { None })) + +} + +fn main() { + let n = 1000000; + let vrslt = basic_sieve(100).collect::>(); + println!("{:?}", vrslt); + let strt = Instant::now(); + + // do it 1000 times to get a reasonable execution time span... + let rslt = (1..1000).map(|_| basic_sieve(n)).last().unwrap(); + + let elpsd = strt.elapsed(); + + let count = rslt.count(); + println!("{}", count); + + let secs = elpsd.as_secs(); + let millis = (elpsd.subsec_nanos() / 1000000) as u64; + let dur = secs * 1000 + millis; + println!("Culling composites took {} milliseconds.", dur); +} diff --git a/Task/Sieve-of-Eratosthenes/Rust/sieve-of-eratosthenes-3.rust b/Task/Sieve-of-Eratosthenes/Rust/sieve-of-eratosthenes-3.rust new file mode 100644 index 0000000000..bf0059582f --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/Rust/sieve-of-eratosthenes-3.rust @@ -0,0 +1,31 @@ +fn optimized_sieve(limit: usize) -> Box> { + if limit < 3 { + return if limit < 2 { Box::new(empty()) } else { Box::new(once(2)) } + } + + let ndxlmt = (limit - 3) / 2 + 1; + let bfsz = ((limit - 3) / 2) / 32 + 1; + let mut cmpsts = vec![0u32; bfsz]; + let sqrtndxlmt = ((limit as f64).sqrt() as usize - 3) / 2 + 1; + + for ndx in 0..sqrtndxlmt { + if (cmpsts[ndx >> 5] & (1u32 << (ndx & 31))) == 0 { + let p = ndx + ndx + 3; + let mut cullpos = (p * p - 3) / 2; + while cullpos < ndxlmt { + unsafe { // avoids array bounds check, which is already done above + let cptr = cmpsts.get_unchecked_mut(cullpos >> 5); + *cptr |= 1u32 << (cullpos & 31); + } +// cmpsts[cullpos >> 5] |= 1u32 << (cullpos & 31); // with bounds check + cullpos += p; + } + } + } + + Box::new((-1 .. ndxlmt as isize).into_iter().filter_map(move |i| { + if i < 0 { Some(2) } else { + if cmpsts[i as usize >> 5] & (1u32 << (i & 31)) == 0 { + Some((i + i + 3) as usize) } else { None } } + })) +} diff --git a/Task/Sieve-of-Eratosthenes/Rust/sieve-of-eratosthenes-4.rust b/Task/Sieve-of-Eratosthenes/Rust/sieve-of-eratosthenes-4.rust new file mode 100644 index 0000000000..2a06aa7591 --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/Rust/sieve-of-eratosthenes-4.rust @@ -0,0 +1,175 @@ +use std::iter::{empty, once}; +use std::rc::Rc; +use std::cell::RefCell; +use std::time::Instant; + +const RANGE: u64 = 1000000000; +const SZ_PAGE_BTS: u64 = (1 << 14) * 8; // this should be the size of the CPU L1 cache +const SZ_BASE_BTS: u64 = (1 << 7) * 8; +static CLUT: [u8; 256] = [ + 8, 7, 7, 6, 7, 6, 6, 5, 7, 6, 6, 5, 6, 5, 5, 4, 7, 6, 6, 5, 6, 5, 5, 4, 6, 5, 5, 4, 5, 4, 4, 3, + 7, 6, 6, 5, 6, 5, 5, 4, 6, 5, 5, 4, 5, 4, 4, 3, 6, 5, 5, 4, 5, 4, 4, 3, 5, 4, 4, 3, 4, 3, 3, 2, + 7, 6, 6, 5, 6, 5, 5, 4, 6, 5, 5, 4, 5, 4, 4, 3, 6, 5, 5, 4, 5, 4, 4, 3, 5, 4, 4, 3, 4, 3, 3, 2, + 6, 5, 5, 4, 5, 4, 4, 3, 5, 4, 4, 3, 4, 3, 3, 2, 5, 4, 4, 3, 4, 3, 3, 2, 4, 3, 3, 2, 3, 2, 2, 1, + 7, 6, 6, 5, 6, 5, 5, 4, 6, 5, 5, 4, 5, 4, 4, 3, 6, 5, 5, 4, 5, 4, 4, 3, 5, 4, 4, 3, 4, 3, 3, 2, + 6, 5, 5, 4, 5, 4, 4, 3, 5, 4, 4, 3, 4, 3, 3, 2, 5, 4, 4, 3, 4, 3, 3, 2, 4, 3, 3, 2, 3, 2, 2, 1, + 6, 5, 5, 4, 5, 4, 4, 3, 5, 4, 4, 3, 4, 3, 3, 2, 5, 4, 4, 3, 4, 3, 3, 2, 4, 3, 3, 2, 3, 2, 2, 1, + 5, 4, 4, 3, 4, 3, 3, 2, 4, 3, 3, 2, 3, 2, 2, 1, 4, 3, 3, 2, 3, 2, 2, 1, 3, 2, 2, 1, 2, 1, 1, 0 ]; + +fn count_page(lmti: usize, pg: &[u32]) -> i64 { + let pgsz = pg.len(); let pgbts = pgsz * 32; + let (lmt, icnt) = if lmti >= pgbts { (pgsz, 0) } else { + let lstw = lmti / 32; + let msk = 0xFFFFFFFEu32 << (lmti & 31); + let v = (msk | pg[lstw]) as usize; + (lstw, (CLUT[v & 0xFF] + CLUT[(v >> 8) & 0xFF] + + CLUT[(v >> 16) & 0xFF] + CLUT[v >> 24]) as u32) + }; + let mut count = 0u32; + for i in 0 .. lmt { + let v = pg[i] as usize; + count += (CLUT[v & 0xFF] + CLUT[(v >> 8) & 0xFF] + + CLUT[(v >> 16) & 0xFF] + CLUT[v >> 24]) as u32; + } + (icnt + count) as i64 +} + +fn primes_pages() -> Box)>> { + // a memoized iterable enclosing a Vec that grows as needed from an Iterator... + type Bpasi = Box)>>; // (lwi, base cmpsts page) + type Bpas = Rc<(RefCell, RefCell>>)>; // interior mutables + struct Bps(Bpas); // iterable wrapper for base primes array state + struct Bpsi<'a>(usize, &'a Bpas); // iterator with current pos, state ref's + impl<'a> Iterator for Bpsi<'a> { + type Item = &'a Vec; + fn next(&mut self) -> Option { + let n = self.0; let bpas = self.1; + while n >= bpas.1.borrow().len() { // not thread safe + let nbpg = match bpas.0.borrow_mut().next() { + Some(v) => v, _ => (0, vec!()) }; + if nbpg.1.is_empty() { return None } // end if no source iter + bpas.1.borrow_mut().push(cnvrt2bppg(nbpg)); + } + self.0 += 1; // unsafe pointer extends interior -> exterior lifetime + // multi-threading might drop following Vec while reading - protect + let ptr = &bpas.1.borrow()[n] as *const Vec; + unsafe { Some(&(*ptr)) } + } + } + impl<'a> IntoIterator for &'a Bps { + type Item = &'a Vec; + type IntoIter = Bpsi<'a>; + fn into_iter(self) -> Self::IntoIter { + Bpsi(0, &self.0) + } + } + fn make_page(lwi: u64, szbts: u64, bppgs: &Bpas) + -> (u64, Vec) { + let nxti = lwi + szbts; + let pbts = szbts as usize; + let mut cmpsts = vec!(0u32; pbts / 32); + 'outer: for bpg in Bps(bppgs.clone()).into_iter() { // in the inner tight loop... + let pgsz = bpg.len(); + for i in 0 .. pgsz { + let p = bpg[i] as u64; let pc = p as usize; + let s = (p * p - 3) / 2; + if s >= nxti { break 'outer; } else { // page start address: + let mut cp = if s >= lwi { (s - lwi) as usize } else { + let r = ((lwi - s) % p) as usize; + if r == 0 { 0 } else { pc - r } + } + while cp < pbts { + unsafe { // avoids array bounds check, which is already done above + let cptr = cmpsts.get_unchecked_mut(cp >> 5); + *cptr |= 1u32 << (cp & 31); // about as fast as it gets... + } +// cmpsts[cp >> 5] |= 1u32 << (cp & 31); + cp += pc; + } + } + } + } + (lwi, cmpsts) + } + fn pages_from(lwi: u64, szbts: u64, bpas: Bpas) + -> Box)>> { + struct Gen(u64, u64); + impl Iterator for Gen { + type Item = (u64, u64); + #[inline] + fn next(&mut self) -> Option<(u64, u64)> { + let v = self.0; let inc = self.1; // calculate variable size here + self.0 = v + inc; + Some((v, inc)) + } + } + Box::new(Gen(lwi, szbts) + .map(move |(lwi, szbts)| make_page(lwi, szbts, &bpas))) + } + fn cnvrt2bppg(cmpsts: (u64, Vec)) -> Vec { + let (lwi, pg) = cmpsts; + let pgbts = pg.len() * 32; + let cnt = count_page(pgbts, &pg) as usize; + let mut bpv = vec!(0u32; cnt); + let mut j = 0; let bsp = (lwi + lwi + 3) as usize; + for i in 0 .. pgbts { + if (pg[i >> 5] & (1u32 << (i & 0x1F))) == 0u32 { + bpv[j] = (bsp + i + i) as u32; j += 1; + } + } + bpv + } + // recursive Rc/RefCell variable bpas - used only for init, then fixed ... + // start with just enough base primes to init the first base primes page... + let base_base_prms = vec!(3u32,5u32,7u32); + let rcvv = RefCell::new(vec!(base_base_prms)); + let bpas: Bpas = Rc::new((RefCell::new(Box::new(empty())), rcvv)); + let initpg = make_page(0, 32, &bpas); // small base primes page for SZ_BASE_BTS = 2^7 * 8 + *bpas.1.borrow_mut() = vec!(cnvrt2bppg(initpg)); // use for first page + let frstpg = make_page(0, SZ_BASE_BTS, &bpas); // init bpas for first base prime page + *bpas.0.borrow_mut() = pages_from(SZ_BASE_BTS, SZ_BASE_BTS, bpas.clone()); // recurse bpas + *bpas.1.borrow_mut() = vec!(cnvrt2bppg(frstpg)); // fixed for subsequent pages + pages_from(0, SZ_PAGE_BTS, bpas) // and bpas also used here for main pages +} + +fn primes_paged() -> Box> { + fn list_paged_primes(cmpstpgs: Box)>>) + -> Box> { + Box::new(cmpstpgs.flat_map(move |(lwi, cmpsts)| { + let pgbts = (cmpsts.len() * 32) as usize; + (0..pgbts).filter_map(move |i| { + if cmpsts[i >> 5] & (1u32 << (i & 31)) == 0 { + Some((lwi + i as u64) * 2 + 3) } else { None } }) })) + } + Box::new(once(2u64).chain(list_paged_primes(primes_pages()))) +} + +fn count_primes_paged(top: u64) -> i64 { + if top < 3 { if top < 2 { return 0i64 } else { return 1i64 } } + let topi = (top - 3u64) / 2; + primes_pages().take_while(|&(lwi, _)| lwi <= topi) + .map(|(lwi, pg)| { count_page((topi - lwi) as usize, &pg) }) + .sum::() + 1 +} + +fn main() { + let n = 262146; + let vrslt = primes_paged() + .take_while(|&p| p <= 100) + .collect::>(); + println!("{:?}", vrslt); + + let strt = Instant::now(); + +// let count = primes_paged().take_while(|&p| p <= RANGE).count(); // slow way to count + let count = count_primes_paged(RANGE); // fast way to count + + let elpsd = strt.elapsed(); + + println!("{}", count); + + let secs = elpsd.as_secs(); + let millis = (elpsd.subsec_nanos() / 1000000) as u64; + let dur = secs * 1000 + millis; + println!("Culling composites took {} milliseconds.", dur); +} diff --git a/Task/Sieve-of-Eratosthenes/Scheme/sieve-of-eratosthenes-10.ss b/Task/Sieve-of-Eratosthenes/Scheme/sieve-of-eratosthenes-10.ss index b5da14b8b4..62c768a7bd 100644 --- a/Task/Sieve-of-Eratosthenes/Scheme/sieve-of-eratosthenes-10.ss +++ b/Task/Sieve-of-Eratosthenes/Scheme/sieve-of-eratosthenes-10.ss @@ -1,11 +1,12 @@ (define (primes-stream-ala-Bird) - (define (mults p) (from-By (* p p) (* 2 p))) - (define odd-primes ;; primes are - (s-cons 3 (s-diff (from-By 5 2) ;; odds, without - (s-linear-join (s-map mults odd-primes))))) ;; multiples of primes - (s-cons 2 odd-primes)) + (define (mults p) (from-By (* p p) p)) + (define primes ;; primes are + (s-cons 2 (s-diff (from-By 3 1) ;; numbers > 1, without + (s-linear-join (s-map mults primes))))) ;; multiples of primes + primes) ;;;; join streams using linear structure (define (s-linear-join sts) - (s-cons (head (head sts)) (s-union (tail (head sts)) - (s-linear-join (tail sts))))) + (s-cons (head (head sts)) + (s-union (tail (head sts)) + (s-linear-join (tail sts))))) diff --git a/Task/Sieve-of-Eratosthenes/Scheme/sieve-of-eratosthenes-13.ss b/Task/Sieve-of-Eratosthenes/Scheme/sieve-of-eratosthenes-13.ss new file mode 100644 index 0000000000..c9e4708c98 --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/Scheme/sieve-of-eratosthenes-13.ss @@ -0,0 +1,23 @@ + ;;;; all primes' multiples are removed, merged through a tree of unions + ;;;; runs in ~ n^1.15 run time in producing n = 100K .. 1M primes + (define (primes-stream) + (define (mults p) (from-By (* p p) (* 2 p))) + (define (no-mults-From from) + (s-diff (from-By from 2) + (s-tree-join (s-map mults odd-primes)))) + (define odd-primes + (s-cons 3 (no-mults-From 5))) ;; inner feedback loop + (s-cons 2 (no-mults-From 3))) ;; result stream + + ;;;; join an ordered stream of streams (here, of primes' multiples) + ;;;; into one ordered stream, via an infinite right-deepening tree + (define (s-tree-join sts) + (s-cons (head (head sts)) + (s-union (tail (head sts)) + (s-tree-join (pairs (tail sts)))))) + + (define (pairs sts) ;; {a.(b.t)} -> (a+b).{t} + (s-cons (s-cons (head (head sts)) + (s-union (tail (head sts)) + (head (tail sts)))) + (pairs (tail (tail sts))))) diff --git a/Task/Sieve-of-Eratosthenes/Scheme/sieve-of-eratosthenes-14.ss b/Task/Sieve-of-Eratosthenes/Scheme/sieve-of-eratosthenes-14.ss new file mode 100644 index 0000000000..b22e3fc6a4 --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/Scheme/sieve-of-eratosthenes-14.ss @@ -0,0 +1,27 @@ +(define (treemergePrimes) + (define (mltpls p) + (define pm2 (* p 2)) + (let nxtmltpl ((cmpst (* p p))) + (cons cmpst (lambda () (nxtmltpl (+ cmpst pm2)))))) + (define (allmltpls ps) + (cons (mltpls (car ps)) (lambda () (allmltpls ((cdr ps)))))) + (define (merge xs ys) + (let ((x (car xs)) (xt (cdr xs)) (y (car ys)) (yt (cdr ys))) + (cond ((< x y) (cons x (lambda () (merge (xt) ys)))) + ((> x y) (cons y (lambda () (merge xs (yt))))) + (else (cons x (lambda () (merge (xt) (yt)))))))) + (define (pairs mltplss) + (let ((tl ((cdr mltplss)))) + (cons (merge (car mltplss) (car tl)) + (lambda () (pairs ((cdr tl))))))) + (define (mrgmltpls mltplss) + (cons (car (car mltplss)) + (lambda () (merge ((cdr (car mltplss))) + (mrgmltpls (pairs ((cdr mltplss)))))))) + (define (minusstrtat n cmps) + (if (< n (car cmps)) + (cons n (lambda () (minusstrtat (+ n 2) cmps))) + (minusstrtat (+ n 2) ((cdr cmps))))) + (define (cmpsts) (mrgmltpls (allmltpls (oddprms)))) ;; internal define's are mutually recursive + (define (oddprms) (cons 3 (lambda () (minusstrtat 5 (cmpsts))))) + (cons 2 (lambda () (oddprms)))) diff --git a/Task/Sieve-of-Eratosthenes/Scheme/sieve-of-eratosthenes-15.ss b/Task/Sieve-of-Eratosthenes/Scheme/sieve-of-eratosthenes-15.ss new file mode 100644 index 0000000000..40dc62f26d --- /dev/null +++ b/Task/Sieve-of-Eratosthenes/Scheme/sieve-of-eratosthenes-15.ss @@ -0,0 +1,25 @@ +(define (integers n) + (lambda () + (let ((ans n)) + (set! n (+ n 1)) + ans))) + +(define natural-numbers (integers 0)) + +(define (remove-multiples g n) + (letrec ((m (+ n n)) + (self + (lambda () + (let loop ((x (g))) + (cond ((< x m) x) + ((= x m) (set! m (+ m n)) (self)) + (else (set! m (+ m n)) (loop x))))))) + self)) + +(define (sieve g) + (lambda () + (let ((x (g))) + (set! g (remove-multiples g x)) + x))) + +(define primes (sieve (integers 2))) diff --git a/Task/Sieve-of-Eratosthenes/Scheme/sieve-of-eratosthenes-8.ss b/Task/Sieve-of-Eratosthenes/Scheme/sieve-of-eratosthenes-8.ss index c9e4708c98..2f8f49543a 100644 --- a/Task/Sieve-of-Eratosthenes/Scheme/sieve-of-eratosthenes-8.ss +++ b/Task/Sieve-of-Eratosthenes/Scheme/sieve-of-eratosthenes-8.ss @@ -1,23 +1,5 @@ - ;;;; all primes' multiples are removed, merged through a tree of unions - ;;;; runs in ~ n^1.15 run time in producing n = 100K .. 1M primes - (define (primes-stream) - (define (mults p) (from-By (* p p) (* 2 p))) - (define (no-mults-From from) - (s-diff (from-By from 2) - (s-tree-join (s-map mults odd-primes)))) - (define odd-primes - (s-cons 3 (no-mults-From 5))) ;; inner feedback loop - (s-cons 2 (no-mults-From 3))) ;; result stream - - ;;;; join an ordered stream of streams (here, of primes' multiples) - ;;;; into one ordered stream, via an infinite right-deepening tree - (define (s-tree-join sts) - (s-cons (head (head sts)) - (s-union (tail (head sts)) - (s-tree-join (pairs (tail sts)))))) - - (define (pairs sts) ;; {a.(b.t)} -> (a+b).{t} - (s-cons (s-cons (head (head sts)) - (s-union (tail (head sts)) - (head (tail sts)))) - (pairs (tail (tail sts))))) + (define (sieve s) + (let ((p (head s))) + (s-cons p + (sieve (s-diff (tail s) (from-By (+ p p) p)))))) + (define primes (sieve (from-By 2 1))) diff --git a/Task/Sieve-of-Eratosthenes/Scheme/sieve-of-eratosthenes-9.ss b/Task/Sieve-of-Eratosthenes/Scheme/sieve-of-eratosthenes-9.ss index b22e3fc6a4..3b1a770acc 100644 --- a/Task/Sieve-of-Eratosthenes/Scheme/sieve-of-eratosthenes-9.ss +++ b/Task/Sieve-of-Eratosthenes/Scheme/sieve-of-eratosthenes-9.ss @@ -1,27 +1,7 @@ -(define (treemergePrimes) - (define (mltpls p) - (define pm2 (* p 2)) - (let nxtmltpl ((cmpst (* p p))) - (cons cmpst (lambda () (nxtmltpl (+ cmpst pm2)))))) - (define (allmltpls ps) - (cons (mltpls (car ps)) (lambda () (allmltpls ((cdr ps)))))) - (define (merge xs ys) - (let ((x (car xs)) (xt (cdr xs)) (y (car ys)) (yt (cdr ys))) - (cond ((< x y) (cons x (lambda () (merge (xt) ys)))) - ((> x y) (cons y (lambda () (merge xs (yt))))) - (else (cons x (lambda () (merge (xt) (yt)))))))) - (define (pairs mltplss) - (let ((tl ((cdr mltplss)))) - (cons (merge (car mltplss) (car tl)) - (lambda () (pairs ((cdr tl))))))) - (define (mrgmltpls mltplss) - (cons (car (car mltplss)) - (lambda () (merge ((cdr (car mltplss))) - (mrgmltpls (pairs ((cdr mltplss)))))))) - (define (minusstrtat n cmps) - (if (< n (car cmps)) - (cons n (lambda () (minusstrtat (+ n 2) cmps))) - (minusstrtat (+ n 2) ((cdr cmps))))) - (define (cmpsts) (mrgmltpls (allmltpls (oddprms)))) ;; internal define's are mutually recursive - (define (oddprms) (cons 3 (lambda () (minusstrtat 5 (cmpsts))))) - (cons 2 (lambda () (oddprms)))) + (define (primes-To m) + (define (sieve s) + (let ((p (head s))) + (cond ((> (* p p) m) s) + (else (s-cons p + (sieve (s-diff (tail s) (from-By (* p p) p)))))))) + (sieve (from-By 2 1))) diff --git a/Task/Simple-database/00DESCRIPTION b/Task/Simple-database/00DESCRIPTION index 788d8989df..a5e5dd8660 100644 --- a/Task/Simple-database/00DESCRIPTION +++ b/Task/Simple-database/00DESCRIPTION @@ -1,8 +1,12 @@ +;Task: Write a simple tool to track a small set of data. -The tool should have a commandline interface to enter at least two different values. + +The tool should have a command-line interface to enter at least two different values. + The entered data should be stored in a structured format and saved to disk. -It does not matter what kind of data is being tracked. It could be your CD collection, your friends birthdays, or diary. +It does not matter what kind of data is being tracked.   It could be a collection (CDs, coins, baseball cards, books), a diary, an electronic organizer (birthdays/anniversaries/phone numbers/addresses), etc. + You should track the following details: * A description of the item. (e.g., title, name) @@ -10,14 +14,23 @@ You should track the following details: * A date (either the date when the entry was made or some other date that is meaningful, like the birthday); the date may be generated or entered manually * Other optional fields +
    The command should support the following [[Command-line arguments]] to run: * Add a new entry * Print the latest entry * Print the latest entry for each category * Print all entries sorted by a date +
    The category may be realized as a tag or as structure (by making all entries in that category subitems) -The file format on disk should be human readable, but it need not be standardized. A natively available format that doesn't need an external library is preferred. Avoid developing your own format however if you can use an already existing one. If there is no existing format available pick one of: [[JSON]], [[S-Expressions]], [[YAML]], or [[wp:Comparison_of_data_serialization_formats|others]]. +The file format on disk should be human readable, but it need not be standardized.   A natively available format that doesn't need an external library is preferred.   Avoid developing your own format if you can use an already existing one.   If there is no existing format available, pick one of: +:::*   [[JSON]] +:::*   [[S-Expressions]] +:::*   [[YAML]] +:::*   [[wp:Comparison_of_data_serialization_formats|others]] -See also [[Take notes on the command line]] for a related task. + +;Related task: +*   [[Take notes on the command line]] +

    diff --git a/Task/Simple-database/PowerShell/simple-database-1.psh b/Task/Simple-database/PowerShell/simple-database-1.psh new file mode 100644 index 0000000000..9b6e16c9d3 --- /dev/null +++ b/Task/Simple-database/PowerShell/simple-database-1.psh @@ -0,0 +1,81 @@ +function db +{ + [CmdletBinding(DefaultParameterSetName="None")] + [OutputType([PSCustomObject])] + Param + ( + [Parameter(Mandatory=$false, + Position=0, + ParameterSetName="Add a new entry")] + [string] + $Path = ".\SimpleDatabase.csv", + + [Parameter(Mandatory=$true, + ParameterSetName="Add a new entry")] + [string] + $Name, + + [Parameter(Mandatory=$true, + ParameterSetName="Add a new entry")] + [string] + $Category, + + [Parameter(Mandatory=$true, + ParameterSetName="Add a new entry")] + [datetime] + $Birthday, + + [Parameter(ParameterSetName="Print the latest entry")] + [switch] + $Latest, + + [Parameter(ParameterSetName="Print the latest entry for each category")] + [switch] + $LatestByCategory, + + [Parameter(ParameterSetName="Print all entries sorted by a date")] + [switch] + $SortedByDate + ) + + if (-not (Test-Path -Path $Path)) + { + '"Name","Category","Birthday"' | Out-File -FilePath $Path + } + + $db = Import-Csv -Path $Path | Foreach-Object { + $_.Birthday = $_.Birthday -as [datetime] + $_ + } + + switch ($PSCmdlet.ParameterSetName) + { + "Add a new entry" + { + [PSCustomObject]@{Name=$Name; Category=$Category; Birthday=$Birthday} | Export-Csv -Path $Path -Append + } + "Print the latest entry" + { + $db[-1] + } + "Print the latest entry for each category" + { + ($db | Group-Object -Property Category).Name | ForEach-Object {($db | Where-Object -Property Category -Contains $_)[-1]} + } + "Print all entries sorted by a date" + { + $db | Sort-Object -Property Birthday + } + Default + { + $db + } + } +} + +db -Name Bev -Category friend -Birthday 3/3/1983 +db -Name Bob -Category family -Birthday 7/19/1987 +db -Name Gill -Category friend -Birthday 12/9/1986 +db -Name Gail -Category family -Birthday 2/11/1986 +db -Name Vince -Category family -Birthday 3/10/1960 +db -Name Wayne -Category coworker -Birthday 5/29/1962 diff --git a/Task/Simple-database/PowerShell/simple-database-2.psh b/Task/Simple-database/PowerShell/simple-database-2.psh new file mode 100644 index 0000000000..65eef93d69 --- /dev/null +++ b/Task/Simple-database/PowerShell/simple-database-2.psh @@ -0,0 +1 @@ +db diff --git a/Task/Simple-database/PowerShell/simple-database-3.psh b/Task/Simple-database/PowerShell/simple-database-3.psh new file mode 100644 index 0000000000..de8c930615 --- /dev/null +++ b/Task/Simple-database/PowerShell/simple-database-3.psh @@ -0,0 +1 @@ +db -Latest diff --git a/Task/Simple-database/PowerShell/simple-database-4.psh b/Task/Simple-database/PowerShell/simple-database-4.psh new file mode 100644 index 0000000000..b40d3d5452 --- /dev/null +++ b/Task/Simple-database/PowerShell/simple-database-4.psh @@ -0,0 +1 @@ +db -LatestByCategory diff --git a/Task/Simple-database/PowerShell/simple-database-5.psh b/Task/Simple-database/PowerShell/simple-database-5.psh new file mode 100644 index 0000000000..b4de8647f6 --- /dev/null +++ b/Task/Simple-database/PowerShell/simple-database-5.psh @@ -0,0 +1 @@ +db -SortedByDate diff --git a/Task/Simple-windowed-application/00DESCRIPTION b/Task/Simple-windowed-application/00DESCRIPTION index 7c687d9dc4..1ff80c31ce 100644 --- a/Task/Simple-windowed-application/00DESCRIPTION +++ b/Task/Simple-windowed-application/00DESCRIPTION @@ -1,2 +1,8 @@ -This task asks to create a window with a label that says "There have been no clicks yet" and a button that says "click me". +;Task: +Create a window that has: +::#   a label that says   "There have been no clicks yet" +::#   a button that says   "click me" + + Upon clicking the button with the mouse, the label should change and show the number of times the button has been clicked. +

    diff --git a/Task/Simple-windowed-application/AutoIt/simple-windowed-application.autoit b/Task/Simple-windowed-application/AutoIt/simple-windowed-application.autoit new file mode 100644 index 0000000000..896519bb2c --- /dev/null +++ b/Task/Simple-windowed-application/AutoIt/simple-windowed-application.autoit @@ -0,0 +1,24 @@ +#include +#include +#include +#include +#Region ### START Koda GUI section ### +Local $GUI = GUICreate("Clicks", 280, 50, (@DesktopWidth - 280) / 2, (@DesktopHeight - 50) / 2) +Local $lblClicks = GUICtrlCreateLabel("There have been no clicks yet", 0, 0, 278, 20, $SS_CENTER) +Local $btnClicks = GUICtrlCreateButton("CLICK ME", 104, 25, 75, 25) +GUISetState(@SW_SHOW) +#EndRegion ### END Koda GUI section ### + +Local $counter = 0 + +While 1 + $nMsg = GUIGetMsg() + Switch $nMsg + Case $GUI_EVENT_CLOSE + Exit + + Case $btnClicks + $counter += 1 + GUICtrlSetData($lblClicks, "Times clicked: " & $counter) + EndSwitch +WEnd diff --git a/Task/Simple-windowed-application/Go/simple-windowed-application.go b/Task/Simple-windowed-application/Go/simple-windowed-application.go index d5d5555714..fcc4cb27da 100644 --- a/Task/Simple-windowed-application/Go/simple-windowed-application.go +++ b/Task/Simple-windowed-application/Go/simple-windowed-application.go @@ -1,33 +1,33 @@ package main import ( - "fmt" - "github.com/mattn/go-gtk/gtk" + "fmt" + "github.com/mattn/go-gtk/gtk" ) func main() { - gtk.Init(nil) - window := gtk.Window(gtk.GTK_WINDOW_TOPLEVEL) - window.SetTitle("Click me") - label := gtk.Label("There have been no clicks yet") - var clicks int - button := gtk.ButtonWithLabel("click me") - button.Clicked(func() { - clicks++ - if clicks == 1 { - label.SetLabel("Button clicked 1 time") - } else { - label.SetLabel(fmt.Sprintf("Button clicked %d times", - clicks)) - } - }) - vbox := gtk.VBox(false, 1) - vbox.Add(label) - vbox.Add(button) - window.Add(vbox) - window.Connect("destroy", func() { - gtk.MainQuit() - }) - window.ShowAll() - gtk.Main() + gtk.Init(nil) + window := gtk.NewWindow(gtk.WINDOW_TOPLEVEL) + window.SetTitle("Click me") + label := gtk.NewLabel("There have been no clicks yet") + var clicks int + button := gtk.NewButtonWithLabel("click me") + button.Clicked(func() { + clicks++ + if clicks == 1 { + label.SetLabel("Button clicked 1 time") + } else { + label.SetLabel(fmt.Sprintf("Button clicked %d times", + clicks)) + } + }) + vbox := gtk.NewVBox(false, 1) + vbox.Add(label) + vbox.Add(button) + window.Add(vbox) + window.Connect("destroy", func() { + gtk.MainQuit() + }) + window.ShowAll() + gtk.Main() } diff --git a/Task/Simple-windowed-application/PowerShell/simple-windowed-application-1.psh b/Task/Simple-windowed-application/PowerShell/simple-windowed-application-1.psh new file mode 100644 index 0000000000..6e9eee80f9 --- /dev/null +++ b/Task/Simple-windowed-application/PowerShell/simple-windowed-application-1.psh @@ -0,0 +1,20 @@ +$Label1 = [System.Windows.Forms.Label]@{ + Text = 'There have been no clicks yet' + Size = '200, 20' } +$Button1 = [System.Windows.Forms.Button]@{ + Text = 'Click me' + Location = '0, 20' } + +$Button1.Add_Click( + { + $Script:Clicks++ + If ( $Clicks -eq 1 ) { $Label1.Text = "There has been 1 click" } + Else { $Label1.Text = "There have been $Clicks clicks" } + } ) + +$Form1 = New-Object System.Windows.Forms.Form +$Form1.Controls.AddRange( @( $Label1, $Button1 ) ) + +$Clicks = 0 + +$Result = $Form1.ShowDialog() diff --git a/Task/Simple-windowed-application/PowerShell/simple-windowed-application-2.psh b/Task/Simple-windowed-application/PowerShell/simple-windowed-application-2.psh new file mode 100644 index 0000000000..75c42bc50b --- /dev/null +++ b/Task/Simple-windowed-application/PowerShell/simple-windowed-application-2.psh @@ -0,0 +1,23 @@ +Add-Type -AssemblyName System.Windows.Forms + +$Label1 = New-Object System.Windows.Forms.Label +$Label1.Text = 'There have been no clicks yet' +$Label1.Size = '200, 20' + +$Button1 = New-Object System.Windows.Forms.Button +$Button1.Text = 'Click me' +$Button1.Location = '0, 20' + +$Button1.Add_Click( + { + $Script:Clicks++ + If ( $Clicks -eq 1 ) { $Label1.Text = "There has been 1 click" } + Else { $Label1.Text = "There have been $Clicks clicks" } + } ) + +$Form1 = New-Object System.Windows.Forms.Form +$Form1.Controls.AddRange( @( $Label1, $Button1 ) ) + +$Clicks = 0 + +$Result = $Form1.ShowDialog() diff --git a/Task/Simple-windowed-application/PowerShell/simple-windowed-application-3.psh b/Task/Simple-windowed-application/PowerShell/simple-windowed-application-3.psh new file mode 100644 index 0000000000..3f3ed52bdb --- /dev/null +++ b/Task/Simple-windowed-application/PowerShell/simple-windowed-application-3.psh @@ -0,0 +1,38 @@ +[xml]$Xaml = @" + + +
    +Note that the zeros represent the available squares, not the pennies. + Extra credit is available for other interesting examples. * [[Solve a Hidato puzzle]] * [[Solve a Hopido puzzle]] * [[Solve a Numbrix puzzle]] +* [[Solve the no connection puzzle]] * [[Knight's tour]] diff --git a/Task/Solve-a-Holy-Knights-tour/ALGOL-68/solve-a-holy-knights-tour.alg b/Task/Solve-a-Holy-Knights-tour/ALGOL-68/solve-a-holy-knights-tour.alg new file mode 100644 index 0000000000..a128187549 --- /dev/null +++ b/Task/Solve-a-Holy-Knights-tour/ALGOL-68/solve-a-holy-knights-tour.alg @@ -0,0 +1,177 @@ +# directions for moves # +INT nne = 1, ne = 2, se = 3, sse = 4; +INT ssw = 5, sw = 6, nw = 7, nnw = 8; + +INT lowest move = nne; +INT highest move = nnw; + +# the vertical position changes of the moves # +[]INT offset v = ( -2, -1, 1, 2, 2, 1, -1, -2 ); +# the horizontal position changes of the moves # +[]INT offset h = ( 1, 2, 2, 1, -1, -2, -2, -1 ); + +MODE SQUARE = STRUCT( INT move # the number of the move that caused # + # the knight to reach this square # + , INT direction # the direction of the move that # + # brought the knight here - one of # + # nne, ne, se, sse, ssw, sw, nw or # + # nnw # + ); +# get the size of the board - must be between 4 and 8 # +INT board size = 8; +# the board # +[ board size, board size ]SQUARE board; +# starting position # +INT start row := 1; +INT start col := 1; +# the tour will be complete when we have made as many moves # +# as there are free squares in the initial board # +INT final move := 0; + +# initialise the board setting the free squares from the supplied pttern # +# the pattern has the rows in revers order # +PROC initialise board = ( []STRING pattern )VOID: + BEGIN + INT pattern row := UPB board; + FOR row FROM 1 LWB board TO 1 UPB board + DO + FOR col FROM 2 LWB board TO 2 UPB board + DO + IF pattern[ pattern row ][ col ] = "-" + THEN + # can't use this square # + board[ row, col ] := ( -1, -1 ) + ELSE + # available square # + board[ row, col ] := ( 0, 0 ); + final move +:= 1; + IF pattern[ pattern row ][ col ] = "1" + THEN + # have the start position # + start row := row; + start col := col + FI + FI + OD; + pattern row -:= 1 + OD + END; # initialise board # +# statistics # +INT iterations := 0; +INT backtracks := 0; + +# prints the board # +PROC print tour = VOID: +BEGIN + # format "number" into at least two characters # + PROC n2 = ( INT number )STRING: + IF number < 0 + THEN + " -" + ELIF number < 10 AND number >= 0 + THEN + " " + whole( number, 0 ) + ELSE + whole( number, 0 ) + FI; # n2 # + print( ( " a b c d e f g h", newline ) ); + print( ( " ________________________", newline ) ); + FOR row FROM 1 UPB board BY -1 TO 1 LWB board + DO + print( ( n2( row ) ) ); + print( ( "|" ) ); + + FOR col FROM 2 LWB board TO 2 UPB board + DO + print( ( " " ) ); + print( ( n2( move OF board[ row, col ] ) ) ) + OD; + print( ( newline ) ) + OD +END; # print tour # + +# update the board to the first knight's tour found starting from # +# "start row" and "start col". # +# return TRUE if one was found, FALSE otherwise # +PROC find tour = BOOL: +BEGIN + + BOOL result := TRUE; + INT move number := 1; + INT row := start row; + INT col := start col; + INT direction := lowest move - 1; + # the first move is to place the knight on the starting square # + board[ row, col ] := ( move number, lowest move - 1 ); + # attempt to find a sequence of moves that will reach each square once # + WHILE + move number < final move AND result + DO + IF direction < highest move + THEN + # try the next move from this position # + direction +:= 1; + INT new row = row + offset v[ direction ]; + INT new col = col + offset h[ direction ]; + IF new row <= 1 UPB board + AND new row >= 1 LWB board + AND new col <= 2 UPB board + AND new col >= 2 LWB board + THEN + # the move is legal, check the new square is unused # + IF move OF board[ new row, new col ] = 0 + THEN + # can move here # + iterations +:= 1; + row := new row; + col := new col; + move number +:= 1; + board[ row, col ] := ( move number, direction ); + direction := lowest move - 1 + FI + FI + ELSE + # no more moves from this position - backtrack # + IF move number = 1 + THEN + # at the starting position - no solution # + result := FALSE + ELSE + # not at the starting position - undo the latest move # + backtracks +:= 1; + move number -:= 1; + INT curr row := row; + INT curr col := col; + row -:= offset v[ direction OF board[ curr row, curr col ] ]; + col -:= offset h[ direction OF board[ curr row, curr col ] ]; + # determine which direction to try next # + direction := direction OF board[ curr row, curr col ]; + # reset the square we just backtracked from # + board[ curr row, curr col ] := ( 0, 0 ) + FI + FI + OD; + result +END; # find tour # + +main:( + initialise board( ( "-000----" + , "-0-00---" + , "-0000000" + , "000--0-0" + , "0-0--000" + , "1000000-" + , "--00-0--" + , "---000--" + ) + ); + IF find tour + THEN + # found a solution # + print tour + ELSE + # couldn't find a solution # + print( ( "Solution not found", newline ) ) + FI; + print( ( iterations, " iterations, ", backtracks, " backtracks", newline ) ) +) diff --git a/Task/Solve-a-Holy-Knights-tour/Elixir/solve-a-holy-knights-tour.elixir b/Task/Solve-a-Holy-Knights-tour/Elixir/solve-a-holy-knights-tour.elixir new file mode 100644 index 0000000000..fd44ea4752 --- /dev/null +++ b/Task/Solve-a-Holy-Knights-tour/Elixir/solve-a-holy-knights-tour.elixir @@ -0,0 +1,32 @@ +# require HLPsolver + +adjacent = [{-1,-2},{-2,-1},{-2,1},{-1,2},{1,2},{2,1},{2,-1},{1,-2}] + +""" +. . 0 0 0 +. . 0 . 0 0 +. 0 0 0 0 0 0 0 +0 0 0 . . 0 . 0 +0 . 0 . . 0 0 0 +1 0 0 0 0 0 0 +. . 0 0 . 0 +. . . 0 0 0 +""" +|> HLPsolver.solve(adjacent) + +""" + _ _ _ _ _ 1 _ 0 + _ _ _ _ _ 0 _ 0 + _ _ _ _ 0 0 0 0 0 + _ _ _ _ _ 0 0 0 + _ _ 0 _ _ 0 _ 0 _ _ 0 + 0 0 0 0 0 _ _ _ 0 0 0 0 0 + _ _ 0 0 _ _ _ _ _ 0 0 + 0 0 0 0 0 _ _ _ 0 0 0 0 0 + _ _ 0 _ _ 0 _ 0 _ _ 0 + _ _ _ _ _ 0 0 0 + _ _ _ _ 0 0 0 0 0 + _ _ _ _ _ 0 _ 0 + _ _ _ _ _ 0 _ 0 +""" +|> HLPsolver.solve(adjacent) diff --git a/Task/Solve-a-Holy-Knights-tour/Java/solve-a-holy-knights-tour.java b/Task/Solve-a-Holy-Knights-tour/Java/solve-a-holy-knights-tour.java new file mode 100644 index 0000000000..cf2cd017cd --- /dev/null +++ b/Task/Solve-a-Holy-Knights-tour/Java/solve-a-holy-knights-tour.java @@ -0,0 +1,104 @@ +import java.util.*; + +public class HolyKnightsTour { + + final static String[] board = { + " xxx ", + " x xx ", + " xxxxxxx", + "xxx x x", + "x x xxx", + "1xxxxxx ", + " xx x ", + " xxx "}; + + private final static int base = 12; + private final static int[][] moves = {{1, -2}, {2, -1}, {2, 1}, {1, 2}, + {-1, 2}, {-2, 1}, {-2, -1}, {-1, -2}}; + private static int[][] grid; + private static int total = 2; + + public static void main(String[] args) { + int row = 0, col = 0; + + grid = new int[base][base]; + + for (int r = 0; r < base; r++) { + Arrays.fill(grid[r], -1); + for (int c = 2; c < base - 2; c++) { + if (r >= 2 && r < base - 2) { + if (board[r - 2].charAt(c - 2) == 'x') { + grid[r][c] = 0; + total++; + } + if (board[r - 2].charAt(c - 2) == '1') { + row = r; + col = c; + } + } + } + } + + grid[row][col] = 1; + + if (solve(row, col, 2)) + printResult(); + } + + private static boolean solve(int r, int c, int count) { + if (count == total) + return true; + + List nbrs = neighbors(r, c); + + if (nbrs.isEmpty() && count != total) + return false; + + Collections.sort(nbrs, (a, b) -> a[2] - b[2]); + + for (int[] nb : nbrs) { + r = nb[0]; + c = nb[1]; + grid[r][c] = count; + if (solve(r, c, count + 1)) + return true; + grid[r][c] = 0; + } + + return false; + } + + private static List neighbors(int r, int c) { + List nbrs = new ArrayList<>(); + + for (int[] m : moves) { + int x = m[0]; + int y = m[1]; + if (grid[r + y][c + x] == 0) { + int num = countNeighbors(r + y, c + x) - 1; + nbrs.add(new int[]{r + y, c + x, num}); + } + } + return nbrs; + } + + private static int countNeighbors(int r, int c) { + int num = 0; + for (int[] m : moves) + if (grid[r + m[1]][c + m[0]] == 0) + num++; + return num; + } + + private static void printResult() { + for (int[] row : grid) { + for (int i : row) { + if (i == -1) + System.out.printf("%2s ", ' '); + else + System.out.printf("%2d ", i); + } + System.out.println(); + } + } +} diff --git a/Task/Solve-a-Holy-Knights-tour/Perl/solve-a-holy-knights-tour.pl b/Task/Solve-a-Holy-Knights-tour/Perl/solve-a-holy-knights-tour.pl new file mode 100644 index 0000000000..98c547d66c --- /dev/null +++ b/Task/Solve-a-Holy-Knights-tour/Perl/solve-a-holy-knights-tour.pl @@ -0,0 +1,254 @@ +package KT_Locations; +# A sequence of locations on a 2-D board whose order might or might not +# matter. Suitable for representing a partial tour, a complete tour, or the +# required locations to visit. +use strict; +use overload '""' => "as_string"; +use English; +# 'locations' must be a reference to an array of 2-element array references, +# where the first element is the rank index and the second is the file index. +use Class::Tiny qw(N locations); +use List::Util qw(all); + +sub BUILD { + my $self = shift; + $self->{N} //= 8; + $self->{N} >= 3 or die "N must be at least 3"; + all {ref($ARG) eq 'ARRAY' && scalar(@{$ARG}) == 2} @{$self->{locations}} + or die "At least one element of 'locations' is invalid"; + return; +} + +sub as_string { + my $self = shift; + my %idxs; + my $idx = 1; + foreach my $loc (@{$self->locations}) { + $idxs{join(q{K},@{$loc})} = $idx++; + } + my $str; + { + my $w = int(log(scalar(@{$self->locations}))/log(10.)) + 2; + my $fmt = "%${w}d"; + my $N = $self->N; + my $non_tour = q{ } x ($w-1) . q{-}; + for (my $r=0; $r<$N; $r++) { + for (my $f=0; $f<$N; $f++) { + my $k = join(q{K}, $r, $f); + $str .= exists($idxs{$k}) ? sprintf($fmt, $idxs{$k}) : $non_tour; + } + $str .= "\n"; + } + } + return $str; +} + +sub as_idx_hash { + my $self = shift; + my $N = $self->N; + my $result; + foreach my $pair (@{$self->locations}) { + my ($r, $f) = @{$pair}; + $result->{$r * $N + $f}++; + } + return $result; +} + +package KnightsTour; +use strict; +# If supplied, 'str' is parsed to set 'N', 'start_location', and +# 'locations_to_visit'. 'legal_move_idxs' is for improving performance. +use Class::Tiny qw( N start_location locations_to_visit str legal_move_idxs ); +use English; +use Parallel::ForkManager; +use Time::HiRes qw( gettimeofday tv_interval ); + +sub BUILD { + my $self = shift; + if ($self->{str}) { + my ($n, $sl, $ltv) = _parse_input_string($self->{str}); + $self->{N} = $n; + $self->{start_location} = $sl; + $self->{locations_to_visit} = $ltv; + } + $self->{N} //= 8; + $self->{N} >= 3 or die "N must be at least 3"; + exists($self->{start_location}) or die "Must supply start_location"; + die "start_location is invalid" + if ref($self->{start_location}) ne 'ARRAY' || + scalar(@{$self->{start_location}}) != 2; + exists($self->{locations_to_visit}) or die "Must supply locations_to_visit"; + ref($self->{locations_to_visit}) eq 'KT_Locations' + or die "locations_to_visit must be a KT_Locations instance"; + $self->{N} == $self->{locations_to_visit}->N + or die "locations_to_visit has mismatched board size"; + $self->precompute_legal_moves(); + return; +} + +sub _parse_input_string { + my @rows = split(/[\r\n]+/s, shift); + my $N = scalar(@rows); + my ($start_location, @to_visit); + for (my $r=0; $r<$N; $r++) { + my $row_r = $rows[$r]; + for (my $f=0; $f<$N; $f++) { + my $c = substr($row_r, $f, 1); + if ($c eq '1') { $start_location = [$r, $f]; } + elsif ($c eq '0') { push @to_visit, [$r, $f]; } + } + } + $start_location or die "No starting location provided"; + return ($N, + $start_location, + KT_Locations->new(N => $N, locations => \@to_visit)); +} + +sub precompute_legal_moves { + my $self = shift; + my $N = $self->{N}; + my $ktl_ixs = $self->{locations_to_visit}->as_idx_hash(); + for (my $r=0; $r<$N; $r++) { + for (my $f=0; $f<$N; $f++) { + my $k = $r * $N + $f; + $self->{legal_move_idxs}->{$k} = + _precompute_legal_move_idxs($r, $f, $N, $ktl_ixs); + } + } + return; +} + +sub _precompute_legal_move_idxs { + my ($r, $f, $N, $ktl_ixs) = @ARG; + my $r_plus_1 = $r + 1; my $r_plus_2 = $r + 2; + my $r_minus_1 = $r - 1; my $r_minus_2 = $r - 2; + my $f_plus_1 = $f + 1; my $f_plus_2 = $f + 2; + my $f_minus_1 = $f - 1; my $f_minus_2 = $f - 2; + my @result = grep { exists($ktl_ixs->{$ARG}) } + map { $ARG->[0] * $N + $ARG->[1] } + grep {$ARG->[0] >= 0 && $ARG->[0] < $N && + $ARG->[1] >= 0 && $ARG->[1] < $N} + ([$r_plus_2, $f_minus_1], [$r_plus_2, $f_plus_1], + [$r_minus_2, $f_minus_1], [$r_minus_2, $f_plus_1], + [$r_plus_1, $f_plus_2], [$r_plus_1, $f_minus_2], + [$r_minus_1, $f_plus_2], [$r_minus_1, $f_minus_2]); + return \@result; +} + +sub find_tour { + my $self = shift; + my $num_to_visit = scalar(@{$self->locations_to_visit->locations}); + my $N = $self->N; + my $start_loc_idx = + $self->start_location->[0] * $N + $self->start_location->[1]; + my $visited; for (my $i=0; $i<$N*$N; $i++) { vec($visited, $i, 1) = 0; } + vec($visited, $start_loc_idx, 1) = 1; + # We unwind the search by one level and use Parallel::ForkManager to search + # the top-level sub-trees concurrently, assuming there are enough cores. + my @next_loc_idxs = @{$self->legal_move_idxs->{$start_loc_idx}}; + my $pm = new Parallel::ForkManager(scalar(@next_loc_idxs)); + foreach my $next_loc_idx (@next_loc_idxs) { + $pm->start and next; # Do the fork + my $t0 = [gettimeofday]; + vec($visited, $next_loc_idx, 1) = 1; # (The fork cloned $visited.) + my $tour = _find_tour_helper($N, + $num_to_visit - 1, + $next_loc_idx, + $visited, + $self->legal_move_idxs); + my $elapsed = tv_interval($t0); + my ($r, $f) = _idx_to_rank_and_file($next_loc_idx, $N); + if (defined $tour) { + my @tour_locs = + map { [_idx_to_rank_and_file($ARG, $N)] } + ($start_loc_idx, $next_loc_idx, split(/\s+/s, $tour)); + my $kt_locs = KT_Locations->new(N => $N, locations => \@tour_locs); + print "Found a tour after first move ($r, $f) ", + "in $elapsed seconds:\n", $kt_locs, "\n"; + } + else { + print "No tour found after first move ($r, $f). ", + "Took $elapsed seconds.\n"; + } + $pm->finish; # Do the exit in the child process + } + $pm->wait_all_children; + return; +} + +sub _idx_to_rank_and_file { + my ($idx, $N) = @ARG; + my $f = $idx % $N; + my $r = ($idx - $f) / $N; + return ($r, $f); +} + +sub _find_tour_helper { + my ($N, $num_to_visit, $current_loc_idx, $visited, $legal_move_idxs) = @ARG; + + # The performance hot spot. + local *inner_helper = sub { + my ($num_to_visit, $current_loc_idx, $visited) = @ARG; + if ($num_to_visit == 0) { + return q{ }; # Solution found. + } + my @next_loc_idxs = @{$legal_move_idxs->{$current_loc_idx}}; + my $num_to_visit2 = $num_to_visit - 1; + foreach my $loc_idx2 (@next_loc_idxs) { + next if vec($visited, $loc_idx2, 1); + my $visited2 = $visited; + vec($visited2, $loc_idx2, 1) = 1; + my $recursion = inner_helper($num_to_visit2, $loc_idx2, $visited2); + return $loc_idx2 . q{ } . $recursion if defined $recursion; + } + return; + }; + + return inner_helper($num_to_visit, $current_loc_idx, $visited); +} + +package main; +use strict; + +solve_size_8_problem(); +solve_size_13_problem(); +exit 0; + +sub solve_size_8_problem { + my $problem = <<"END_SIZE_8_PROBLEM"; +--000--- +--0-00-- +-0000000 +000--0-0 +0-0--000 +1000000- +--00-0-- +---000-- +END_SIZE_8_PROBLEM + my $kt = KnightsTour->new(str => $problem); + print "Finding a tour for an 8x8 problem...\n"; + $kt->find_tour(); + return; +} + +sub solve_size_13_problem { + my $problem = <<"END_SIZE_13_PROBLEM"; +-----1-0----- +-----0-0----- +----00000---- +-----000----- +--0--0-0--0-- +00000---00000 +--00-----00-- +00000---00000 +--0--0-0--0-- +-----000----- +----00000---- +-----0-0----- +-----0-0----- +END_SIZE_13_PROBLEM + my $kt = KnightsTour->new(str => $problem); + print "Finding a tour for a 13x13 problem...\n"; + $kt->find_tour(); + return; +} diff --git a/Task/Solve-a-Holy-Knights-tour/REXX/solve-a-holy-knights-tour.rexx b/Task/Solve-a-Holy-Knights-tour/REXX/solve-a-holy-knights-tour.rexx index 341eda5714..f5f7dbd31b 100644 --- a/Task/Solve-a-Holy-Knights-tour/REXX/solve-a-holy-knights-tour.rexx +++ b/Task/Solve-a-Holy-Knights-tour/REXX/solve-a-holy-knights-tour.rexx @@ -1,62 +1,64 @@ -/*REXX pgm solves the holy knight's tour problem for a NxN chessboard.*/ -blank=pos('//',space(arg(1),0))\==0 /*see if pennies are to be shown.*/ -parse arg ops '/' cent /*obtain the options and pennies.*/ -parse var ops N sRank sFile . /*boardsize, starting pos, pennys*/ -if N=='' | N==',' then N=8 /*Boardsize specified? Default. */ -if sRank=='' | sRank==',' then sRank=N /*starting rank given? Default. */ -if sFile=='' | sFile==',' then sFile=1 /* " file " " */ -NN=N**2; NxN='a ' N"x"N ' chessboard' /*[↓ ↓] r f = Rank and File.*/ +/*REXX program solves the holy knight's tour problem for a (general) NxN chessboard.*/ +blank=pos('//', space(arg(1), 0))\==0 /*see if the pennies are to be shown. */ +parse arg ops '/' cent /*obtain the options and the pennies. */ +parse var ops N sRank sFile . /*boardsize, starting position, pennys*/ +if N=='' | N=="," then N=8 /*no boardsize specified? Use default.*/ +if sRank=='' | sRank=="," then sRank=N /*starting rank given? " " */ +if sFile=='' | sFile=="," then sFile=1 /* " file " " " */ +NN=N**2; NxN='a ' N"x"N ' chessboard' /*file [↓] [↓] r=rank */ @.=; do r=1 for N; do f=1 for N; @.r.f=.; end /*f*/; end /*r*/ - /*[↑] blank the NxN chessboard.*/ -cent=space(translate(cent,,',')) /*allow use of comma (,) for sep.*/ -cents=0 /*number of pennies on chessboard*/ - do while cent\='' /* [↓] possibly place pennies. */ - parse var cent cr cf x '/' cent /*extract where to place pennies.*/ - if x='' then x=1 /*if # not specified, use 1 penny*/ - if cr='' then iterate /*support the "blanking" option. */ - do cf=cf for x /*now, place X pennies on board*/ - @.cr.cf='¢' /*mark board position with penny.*/ - end /*cf*/ /* [↑] places X pennies on board*/ - end /*while cent¬='' */ /* [↑] allows of placing X ¢s.*/ - /* [↓] traipse through the board*/ + /*[↑] create an empty NxN chessboard.*/ +cent=space(translate(cent, , ',')) /*allow use of comma (,) for separater.*/ +cents=0 /*number of pennies on the chessboard. */ + do while cent\='' /* [↓] possibly place the pennies. */ + parse var cent cr cf x '/' cent /*extract where to place the pennies. */ + if x='' then x=1 /*if number not specified, use 1 penny.*/ + if cr='' then iterate /*support the "blanking" option. */ + do cf=cf for x /*now, place X pennies on chessboard.*/ + @.cr.cf='¢' /*mark chessboard position with a penny*/ + end /*cf*/ /* [↑] places X pennies on chessboard.*/ + end /*while*/ /* [↑] allows of the placing of X ¢s*/ + /* [↓] traipse through the chessboard.*/ do r=1 for N; do f=1 for N; cents=cents+(@.r.f=='¢'); end; end - /* [↑] count number of pennies. */ + /* [↑] count the number of pennies. */ if cents\==0 then say cents 'pennies placed on chessboard.' -target=NN-cents /*use this as the number of moves*/ - /*[↑] create the NxN chessboard.*/ - Kr = '2 1 -1 -2 -2 -1 1 2' /*legal "rank" move for a knight.*/ - Kf = '1 2 2 1 -1 -2 -2 -1' /* " "file" " " " " */ -parse var Kr Kr.1 Kr.2 Kr.3 Kr.4 Kr.5 Kr.6 Kr.7 Kr.8 /*parse by hand.*/ -parse var Kf Kf.1 Kf.2 Kf.3 Kf.4 Kf.5 Kf.6 Kf.7 Kf.8 /* " " " */ -if @.sRank.sFile==. then @.sRank.sFile=1 /*knight's starting pos.*/ -if @.sRank.sFile\==1 then do sRank=1 for N /*find a starting rank.*/ - do sFile=1 for N /* " " " file.*/ - if @.sRank.sFile\==. then iterate - @.sRank.sFile=1 - leave sRank /*got a spot, so leave. */ - end /*sRank*/ - end /*sFile*/ -if \move(2,sRank,sFile) & \(N==1), - then say "No holy knight's tour solution for" NxN'.' - else say "A solution for the holy knight's tour on" NxN':' - /*show chessboard with moves & ¢.*/ -!=left('', 9*(n<18)) /*used for indentation of board. */ +target=NN-cents /*use this as the number of moves left.*/ +beg='-1-' /*[↑] create the NxN chessboard. */ + Kr = '2 1 -1 -2 -2 -1 1 2' /*the legal "rank" moves for a knight.*/ + Kf = '1 2 2 1 -1 -2 -2 -1' /* " " "file" " " " " */ +parse var Kr Kr.1 Kr.2 Kr.3 Kr.4 Kr.5 Kr.6 Kr.7 Kr.8 /*parse the legal moves by hand.*/ +parse var Kf Kf.1 Kf.2 Kf.3 Kf.4 Kf.5 Kf.6 Kf.7 Kf.8 /* " " " " " " */ +if @.sRank.sFile==. then @.sRank.sFile=beg /*the knight's starting position. */ + +if @.sRank.sFile\==beg then do sRank=1 for N /*find starting rank for the knight.*/ + do sFile=1 for N /* " " file " " " */ + if @.sRank.sFile\==. then iterate + @.sRank.sFile=beg /*the knight's starting position. */ + leave sRank /*we have a spot, so leave all this.*/ + end /*sRank*/ + end /*sFile*/ +@hkt= "holy knight's tour" /*a handy-dandy literal for the SAYs. */ +if \move(2,sRank,sFile) & \(N==1) then say 'No' @hkt "solution for" NxN'.' + else say 'A solution for the' @hkt "on" NxN':' + + /*show chessboard with moves & pennies.*/ +!=left('', 9*(n<18)) /*used for indentation of chessboard. */ _=substr(copies("┼───",N),2); say; say ! translate('┌'_"┐", '┬', "┼") - do r=N for N by -1; if r\==N then say ! '├'_"┤"; L=@. - do f=1 for N; L=L'│'centre(@.r.f,3) /*preserve squareness.*/ + do r=N for N by -1; if r\==N then say ! '├'_"┤"; L=@. + do f=1 for N; ?=@.r.f; if ?==target then ?='end'; L=L'│'center(?,3) /*"end"?*/ end /*f*/ - if blank then L=translate(L,,'¢') /*blank out the pennies ? */ - say ! translate(L'│', , .) /*show a rank of the chessboard.*/ - end /*r*/ /*80 cols can view 19x19 chessbrd*/ -say ! translate('└'_"┘", '┴', "┼") /*show the last rank of the board*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────MOVE subroutine─────────────────────*/ -move: procedure expose @. Kr. Kf. target; parse arg #,rank,file - do t=1 for 8; nr=rank+Kr.t; nf=file+Kf.t - if @.nr.nf==. then do; @.nr.nf=# /*Kn move.*/ - if #==target then return 1 /*last mv?*/ - if move(#+1,nr,nf) then return 1 - @.nr.nf=. /*undo the above move. */ - end /*try different move. */ - end /*t*/ -return 0 /*the tour not possible.*/ + if blank then L=translate(L,,'¢') /*blank out the pennies on chessboard ?*/ + say ! translate(L'│', , .) /*display a rank of the chessboard. */ + end /*r*/ /*19x19 chessboard can be shown 80 cols*/ +say ! translate('└'_"┘", '┴', "┼") /*display the last rank of chessboard. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +move: procedure expose @. Kr. Kf. target; parse arg #,rank,file /*obtain move,rank,file.*/ + do t=1 for 8; nr=rank+Kr.t; nf=file+Kf.t /*position of the knight*/ + if @.nr.nf==. then do; @.nr.nf=# /*Empty? Knight can move*/ + if #==target then return 1 /*is this the last move?*/ + if move(#+1,nr,nf) then return 1 /* " " " " " */ + @.nr.nf=. /*undo the above move. */ + end /*try different move. */ + end /*t*/ /* [↑] all moves tried.*/ +return 0 /*tour is not possible. */ diff --git a/Task/Solve-a-Hopido-puzzle/00DESCRIPTION b/Task/Solve-a-Hopido-puzzle/00DESCRIPTION index a7f8b03db8..c69f162fb6 100644 --- a/Task/Solve-a-Hopido-puzzle/00DESCRIPTION +++ b/Task/Solve-a-Hopido-puzzle/00DESCRIPTION @@ -2,7 +2,7 @@ Hopido puzzles are similar to [[Solve a Hidato puzzle | Hidato]]. The most impor "Big puzzles represented another problem. Up until quite late in the project our puzzle solver was painfully slow with most puzzles above 7×7 tiles. Testing the solution from each starting point could take hours. If the tile layout was changed even a little, the whole puzzle had to be tested again. We were just about to give up the biggest puzzles entirely when our programmer suddenly came up with a magical algorithm that cut the testing process down to only minutes. Hooray!" -Knowing the kindness in the heart of every contributor to Rosetta Code I know that we shall feel that as an act of humanity we must solve these puzzles for them in let's say milliseconds. +Knowing the kindness in the heart of every contributor to Rosetta Code, I know that we shall feel that as an act of humanity we must solve these puzzles for them in let's say milliseconds. Example: @@ -15,8 +15,9 @@ Example: Extra credits are available for other interesting designs. -Realated Tasks: +Related Tasks: * [[Solve a Hidato puzzle]] * [[Solve a Holy Knight's tour]] * [[Solve a Numbrix puzzle]] +* [[Solve the no connection puzzle]] * [[Knight's tour]] diff --git a/Task/Solve-a-Hopido-puzzle/D/solve-a-hopido-puzzle.d b/Task/Solve-a-Hopido-puzzle/D/solve-a-hopido-puzzle.d new file mode 100644 index 0000000000..f1b9bdaf4a --- /dev/null +++ b/Task/Solve-a-Hopido-puzzle/D/solve-a-hopido-puzzle.d @@ -0,0 +1,114 @@ +import std.stdio, std.conv, std.string, std.range, std.algorithm, std.typecons; + + +struct HopidoPuzzle { + private alias InputCellBaseType = char; + private enum InputCell : InputCellBaseType { available = '#', unavailable = '.' } + private alias Cell = uint; + private enum : Cell { unknownCell = 0, unavailableCell = Cell.max } // Special Cell values. + + // Neighbors, [shift row, shift column]. + private static immutable int[2][8] shifts = [[-2, -2], [2, -2], [-2, 2], [2, 2], + [ 0, -3], [0, 3], [-3, 0], [3, 0]]; + + private immutable size_t gridWidth, gridHeight; + private immutable Cell nAvailableCells; + private /*immutable*/ const InputCell[] flatPuzzle; + private Cell[] grid; // Flattened mutable game grid. + + @disable this(); + + + this(in string[] rawPuzzle) pure @safe + in { + assert(!rawPuzzle.empty); + assert(!rawPuzzle[0].empty); + assert(rawPuzzle.all!(row => row.length == rawPuzzle[0].length)); // Is rectangular. + + // Has at least one start point. + assert(rawPuzzle.join.representation.canFind(InputCell.available)); + } body { + //immutable puzzle = rawPuzzle.to!(InputCell[][]); + immutable puzzle = rawPuzzle.map!representation.array.to!(InputCell[][]); + + gridWidth = puzzle[0].length; + gridHeight = puzzle.length; + flatPuzzle = puzzle.join; + nAvailableCells = flatPuzzle.representation.count!(ic => ic == InputCell.available); + + grid = flatPuzzle + .representation + .map!(ic => ic == InputCell.available ? unknownCell : unavailableCell) + .array; + } + + + Nullable!(string[][]) solve() pure /*nothrow*/ @safe + out(result) { + if (!result.isNull) + assert(!grid.canFind(unknownCell)); + } body { + // Try all possible start positions. + foreach (immutable r; 0 .. gridHeight) { + foreach (immutable c; 0 .. gridWidth) { + immutable pos = r * gridWidth + c; + if (grid[pos] == unknownCell) { + immutable Cell startCell = 1; // To lay the first cell value. + grid[pos] = startCell; // Try. + if (search(r, c, startCell + 1)) { + auto result = zip(flatPuzzle, grid) + //.map!({p, c} => ... + .map!(pc => (pc[0] == InputCell.available) ? + pc[1].text : + InputCellBaseType(pc[0]).text) + .array + .chunks(gridWidth) + .array; + return typeof(return)(result); + } + grid[pos] = unknownCell; // Restore. + } + } + } + + return typeof(return)(); + } + + + private bool search(in size_t r, in size_t c, in Cell cell) pure nothrow @safe @nogc { + if (cell > nAvailableCells) + return true; // One solution found. + + foreach (immutable sh; shifts) { + immutable r2 = r + sh[0], + c2 = c + sh[1], + pos = r2 * gridWidth + c2; + // No need to test for >= 0 because uint wraps around. + if (c2 < gridWidth && r2 < gridHeight && grid[pos] == unknownCell) { + grid[pos] = cell; // Try. + if (search(r2, c2, cell + 1)) + return true; + grid[pos] = unknownCell; // Restore. + } + } + + return false; + } +} + + +void main() @safe { + // enum HopidoPuzzle to catch malformed puzzles at compile-time. + enum puzzle = ".##.##. + ####### + ####### + .#####. + ..###.. + ...#...".split.HopidoPuzzle; + + immutable solution = puzzle.solve; // Solved at run-time. + if (solution.isNull) + writeln("No solution found."); + else + writefln("One solution:\n%(%-(%2s %)\n%)", solution); +} diff --git a/Task/Solve-a-Hopido-puzzle/Elixir/solve-a-hopido-puzzle-1.elixir b/Task/Solve-a-Hopido-puzzle/Elixir/solve-a-hopido-puzzle-1.elixir new file mode 100644 index 0000000000..a977209d61 --- /dev/null +++ b/Task/Solve-a-Hopido-puzzle/Elixir/solve-a-hopido-puzzle-1.elixir @@ -0,0 +1,13 @@ +# require HLPsolver + +adjacent = [{-3, 0}, {0, -3}, {0, 3}, {3, 0}, {-2, -2}, {-2, 2}, {2, -2}, {2, 2}] + +board = """ +. 0 0 . 0 0 . +0 0 0 0 0 0 0 +0 0 0 0 0 0 0 +. 0 0 0 0 0 . +. . 0 0 0 . . +. . . 1 . . . +""" +HLPsolver.solve(board, adjacent) diff --git a/Task/Solve-a-Hopido-puzzle/Elixir/solve-a-hopido-puzzle-2.elixir b/Task/Solve-a-Hopido-puzzle/Elixir/solve-a-hopido-puzzle-2.elixir new file mode 100644 index 0000000000..8b9f27784c --- /dev/null +++ b/Task/Solve-a-Hopido-puzzle/Elixir/solve-a-hopido-puzzle-2.elixir @@ -0,0 +1,98 @@ +global nCells, cMap, best +record Pos(r,c) + +procedure main(A) + puzzle := showPuzzle("Input",readPuzzle()) + QMouse(puzzle,findStart(puzzle),&null,0) + showPuzzle("Output", solvePuzzle(puzzle)) | write("No solution!") +end + +procedure readPuzzle() + # Start with a reduced puzzle space + p := [[-1],[-1]] + nCells := maxCols := 0 + every line := !&input do { + put(p,[: -1 | -1 | gencells(line) | -1 | -1 :]) + maxCols <:= *p[-1] + } + every put(p, [-1]|[-1]) + # Now normalize all rows to the same length + every i := 1 to *p do p[i] := [: !p[i] | (|-1\(maxCols - *p[i])) :] + return p +end + +procedure gencells(s) + static WS, NWS + initial { + NWS := ~(WS := " \t") + cMap := table() # Map to/from internal model + cMap["#"] := -1; cMap["_"] := 0 + cMap[-1] := " "; cMap[0] := "_" + } + + s ? while not pos(0) do { + w := (tab(many(WS))|"", tab(many(NWS))) | break + w := numeric(\cMap[w]|w) + if -1 ~= w then nCells +:= 1 + suspend w + } +end + +procedure showPuzzle(label, p) + write(label," with ",nCells," cells:") + every r := !p do { + every c := !r do writes(right((\cMap[c]|c),*nCells+1)) + write() + } + return p +end + +procedure findStart(p) + if \p[r := !*p][c := !*p[r]] = 1 then return Pos(r,c) +end + +procedure solvePuzzle(puzzle) + if path := \best then { + repeat { + loc := path.getLoc() + puzzle[loc.r][loc.c] := path.getVal() + path := \path.getParent() | break + } + return puzzle + } +end + +class QMouse(puzzle, loc, parent, val) + + method getVal(); return val; end + method getLoc(); return loc; end + method getParent(); return parent; end + method atEnd(); return nCells = val; end + + method visit(r,c) + if /best & validPos(r,c) then return Pos(r,c) + end + + method validPos(r,c) + v := val+1 + xv := (0 <= puzzle[r][c]) | fail + if xv = (v|0) then { # make sure this path hasn't already gone there + ancestor := self + while xl := (ancestor := \ancestor.getParent()).getLoc() do + if (xl.r = r) & (xl.c = c) then fail + return + } + end + +initially + val := val+1 + if atEnd() then return best := self + QMouse(puzzle, visit(loc.r-3,loc.c), self, val) + QMouse(puzzle, visit(loc.r-2,loc.c-2), self, val) + QMouse(puzzle, visit(loc.r, loc.c-3), self, val) + QMouse(puzzle, visit(loc.r+2,loc.c-2), self, val) + QMouse(puzzle, visit(loc.r+3,loc.c), self, val) + QMouse(puzzle, visit(loc.r+2,loc.c+2), self, val) + QMouse(puzzle, visit(loc.r, loc.c+3), self, val) + QMouse(puzzle, visit(loc.r-2,loc.c+2), self, val) +end diff --git a/Task/Solve-a-Hopido-puzzle/Java/solve-a-hopido-puzzle.java b/Task/Solve-a-Hopido-puzzle/Java/solve-a-hopido-puzzle.java new file mode 100644 index 0000000000..d5a2cab3a3 --- /dev/null +++ b/Task/Solve-a-Hopido-puzzle/Java/solve-a-hopido-puzzle.java @@ -0,0 +1,109 @@ +import java.util.*; + +public class Hopido { + + final static String[] board = { + ".00.00.", + "0000000", + "0000000", + ".00000.", + "..000..", + "...0..."}; + + final static int[][] moves = {{-3, 0}, {0, 3}, {3, 0}, {0, -3}, + {2, 2}, {2, -2}, {-2, 2}, {-2, -2}}; + static int[][] grid; + static int totalToFill; + + public static void main(String[] args) { + int nRows = board.length + 6; + int nCols = board[0].length() + 6; + + grid = new int[nRows][nCols]; + + for (int r = 0; r < nRows; r++) { + Arrays.fill(grid[r], -1); + for (int c = 3; c < nCols - 3; c++) + if (r >= 3 && r < nRows - 3) { + if (board[r - 3].charAt(c - 3) == '0') { + grid[r][c] = 0; + totalToFill++; + } + } + } + + int pos = -1, r, c; + do { + do { + pos++; + r = pos / nCols; + c = pos % nCols; + } while (grid[r][c] == -1); + + grid[r][c] = 1; + if (solve(r, c, 2)) + break; + grid[r][c] = 0; + + } while (pos < nRows * nCols); + + printResult(); + } + + static boolean solve(int r, int c, int count) { + if (count > totalToFill) + return true; + + List nbrs = neighbors(r, c); + + if (nbrs.isEmpty() && count != totalToFill) + return false; + + Collections.sort(nbrs, (a, b) -> a[2] - b[2]); + + for (int[] nb : nbrs) { + r = nb[0]; + c = nb[1]; + grid[r][c] = count; + if (solve(r, c, count + 1)) + return true; + grid[r][c] = 0; + } + + return false; + } + + static List neighbors(int r, int c) { + List nbrs = new ArrayList<>(); + + for (int[] m : moves) { + int x = m[0]; + int y = m[1]; + if (grid[r + y][c + x] == 0) { + int num = countNeighbors(r + y, c + x) - 1; + nbrs.add(new int[]{r + y, c + x, num}); + } + } + return nbrs; + } + + static int countNeighbors(int r, int c) { + int num = 0; + for (int[] m : moves) + if (grid[r + m[1]][c + m[0]] == 0) + num++; + return num; + } + + static void printResult() { + for (int[] row : grid) { + for (int i : row) { + if (i == -1) + System.out.printf("%2s ", ' '); + else + System.out.printf("%2d ", i); + } + System.out.println(); + } + } +} diff --git a/Task/Solve-a-Hopido-puzzle/Perl-6/solve-a-hopido-puzzle.pl6 b/Task/Solve-a-Hopido-puzzle/Perl-6/solve-a-hopido-puzzle.pl6 index 238f52c2f9..254e140c40 100644 --- a/Task/Solve-a-Hopido-puzzle/Perl-6/solve-a-hopido-puzzle.pl6 +++ b/Task/Solve-a-Hopido-puzzle/Perl-6/solve-a-hopido-puzzle.pl6 @@ -5,10 +5,10 @@ my @adjacent = [3, 0], [-3, 0]; solveboard q:to/END/; - . 0 0 . 0 0 . - 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 - . 0 0 0 0 0 . - . . 0 0 0 . . + . _ _ . _ _ . + _ _ _ _ _ _ _ + _ _ _ _ _ _ _ + . _ _ _ _ _ . + . . _ _ _ . . . . . 1 . . . END diff --git a/Task/Solve-a-Hopido-puzzle/REXX/solve-a-hopido-puzzle.rexx b/Task/Solve-a-Hopido-puzzle/REXX/solve-a-hopido-puzzle.rexx index c85870294c..43573bae76 100644 --- a/Task/Solve-a-Hopido-puzzle/REXX/solve-a-hopido-puzzle.rexx +++ b/Task/Solve-a-Hopido-puzzle/REXX/solve-a-hopido-puzzle.rexx @@ -1,57 +1,56 @@ -/*REXX program solves a Hopido puzzle, displays puzzle and the solution.*/ -call time 'Reset' /*reset the REXX elapsed timer. */ -maxr=0; maxc=0; maxx=0; minr=9e9; minc=9e9; minx=9e9; cells=0; @.= -parse arg xxx; /*get cell definitions from C.L. */ -xxx=translate(xxx, , "/\;:_", ',') /*also allow other chars as comma*/ +/*REXX program solves a Hopido puzzle, it also displays the puzzle and the solution. */ +call time 'Reset' /*reset the REXX elapsed timer to zero.*/ +maxR=0; maxC=0; maxX=0; minR=9e9; minC=9e9; minX=9e9; cells=0; @.= +parse arg xxx /*get the cell definitions from the CL.*/ +xxx=translate(xxx, , "/\;:_", ',') /*also allow other characters as comma.*/ - do while xxx\=''; parse var xxx r c marks ',' xxx - do while marks\=''; _=@.r.c + do while xxx\=''; parse var xxx r c marks ',' xxx + do while marks\=''; _=@.r.c parse var marks x marks - if datatype(x,'N') then x=x/1 /*normalize X*/ - minr=min(minr,r); maxr=max(maxr,r) - minc=min(minc,c); maxc=max(maxc,c) - if x==1 then do; !r=r; !c=c; end /*start cell.*/ - if _\=='' then call err "cell at" r c 'is already occupied with:' _ - @.r.c=x; c=c+1; cells=cells+1 /*assign mark*/ - if x==. then iterate /*hole? Skip.*/ + if datatype(x,'N') then x=x/1 /*normalize X. */ + minR=min(minR,r); maxR=max(maxR,r); minC=min(minC,c); maxC=max(maxC,c) + if x==1 then do; !r=r; !c=c; end /*the START cell. */ + if _\=='' then call err "cell at" r c 'is already occupied with:' _ + @.r.c=x; c=c+1; cells=cells+1 /*assign a mark. */ + if x==. then iterate /*is a hole? Skip*/ if \datatype(x,'W') then call err 'illegal marker specified:' x - minx=min(minx,x); maxx=max(maxx,x) /*min & max X*/ + minX=min(minX,x); maxX=max(maxX,x) /*min and max X. */ end /*while marks¬='' */ end /*while xxx ¬='' */ -call showGrid /* [↓] used for making fast moves*/ -Nr = '0 3 0 -3 -2 2 2 -2' /*possible row for the next move.*/ -Nc = '3 0 -3 0 2 -2 2 -2' /* " col " " " " */ -pMoves=words(Nr) /*the number of possible moves. */ - do i=1 for pMoves; Nr.i=word(Nr,i); Nc.i=word(Nc,i); end /*fast moves*/ -if \next(2,!r,!c) then call err 'No solution possible for this Hopido puzzle.' -say 'A solution for the Hopido exists.'; say; call showGrid -et=format(time('Elapsed'),,2) /*get REXX elapsed time (in secs)*/ -if et<.1 then say 'and took less than 1/10 of a second.' - else say 'and took' et "seconds." -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────ERR subroutine──────────────────────*/ -err: say; say '***error!*** (from Hopido): ' arg(1); say; exit 13 -/*──────────────────────────────────NEXT subroutine─────────────────────*/ +call show /* [↓] is used for making fast moves. */ +Nr = '0 3 0 -3 -2 2 2 -2' /*possible row for the next move. */ +Nc = '3 0 -3 0 2 -2 2 -2' /* " column " " " " */ +pMoves=words(Nr) /*the number of possible moves. */ + do i=1 for pMoves; Nr.i=word(Nr, i); Nc.i=word(Nc,i); end /*i*/ +if \next(2,!r,!c) then call err 'No solution possible for this Hopido puzzle.' +say 'A solution for the Hopido exists.'; say; call show +etime= format(time('Elapsed'), , 2) /*obtain the elapsed time (in seconds).*/ +if etime<.1 then say 'and took less than 1/10 of a second.' + else say 'and took' etime "seconds." +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +err: say; say '***error*** (from Hopido): ' arg(1); say; exit 13 +/*──────────────────────────────────────────────────────────────────────────────────────*/ next: procedure expose @. Nr. Nc. cells pMoves; parse arg #,r,c; ##=#+1 - do t=1 for pMoves /* [↓] try some moves.*/ - parse value r+Nr.t c+Nc.t with nr nc /*next move coördinates*/ - if @.nr.nc==. then do; @.nr.nc=# /*a move.*/ - if #==cells then leave /*last 1?*/ - if next(##,nr,nc) then return 1 - @.nr.nc=. /*undo the above move. */ - iterate /*go & try another move*/ - end - if @.nr.nc==# then do /*is this a fill-in ? */ - if #==cells then return 1 /*last 1.*/ - if next(##,nr,nc) then return 1 /*fill-in*/ - end - end /*t*/ -return 0 /*This ain't working. */ -/*──────────────────────────────────SHOWGRID subroutine─────────────────*/ -showGrid: if maxr<1 | maxc<1 then call err 'no legal cell was specified.' -if minx<1 then call err 'no 1 was specified for the puzzle start' -w=length(cells); do r=maxr to minr by -1; _= - do c=minc to maxc; _=_ right(@.r.c,w); end /*c*/ - say _ - end /*r*/ -say; return + do t=1 for pMoves /* [↓] try some moves. */ + parse value r+Nr.t c+Nc.t with nr nc /*next move coördinates*/ + if @.nr.nc==. then do; @.nr.nc=# /*let's try this move. */ + if #==cells then leave /*is this the last move?*/ + if next(##,nr,nc) then return 1 + @.nr.nc=. /*undo the above move. */ + iterate /*go & try another move.*/ + end + if @.nr.nc==# then do /*this a fill-in move ? */ + if #==cells then return 1 /*this is the last move.*/ + if next(##,nr,nc) then return 1 /*a fill-in move. */ + end + end /*t*/ +return 0 /*This ain't working. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +show: if maxR<1 | maxC<1 then call err 'no legal cell was specified.' + if minX<1 then call err 'no 1 was specified for the puzzle start' + w=max(2,length(cells)); do r=maxR to minR by -1; _= + do c=minC to maxC; _=_ right(@.r.c,w); end /*c*/ + say _ + end /*r*/ + say; return diff --git a/Task/Solve-a-Numbrix-puzzle/00DESCRIPTION b/Task/Solve-a-Numbrix-puzzle/00DESCRIPTION index 30ce54d3fd..8b6ac25cfa 100644 --- a/Task/Solve-a-Numbrix-puzzle/00DESCRIPTION +++ b/Task/Solve-a-Numbrix-puzzle/00DESCRIPTION @@ -62,4 +62,6 @@ Related Tasks: * [[Solve a Hidato puzzle]] * [[Solve a Holy Knight's tour]] * [[Solve a Hopido puzzle]] +* [[Solve the no connection puzzle]] * [[Knight's tour]] +

    diff --git a/Task/Solve-a-Numbrix-puzzle/D/solve-a-numbrix-puzzle.d b/Task/Solve-a-Numbrix-puzzle/D/solve-a-numbrix-puzzle.d new file mode 100644 index 0000000000..473a5bd2fd --- /dev/null +++ b/Task/Solve-a-Numbrix-puzzle/D/solve-a-numbrix-puzzle.d @@ -0,0 +1,209 @@ +import std.stdio, std.conv, std.string, std.range, std.array, std.typecons, std.algorithm; + +struct { + alias BitSet8 = ubyte; // A set of 8 bits. + alias Cell = uint; + enum : string { unavailableInCell = "#", availableInCell = "." } + enum : Cell { unavailableCell = Cell.max, availableCell = 0 } + + this(in string inPuzzle) pure @safe { + const rawPuzzle = inPuzzle.splitLines.map!(row => row.split).array; + assert(!rawPuzzle.empty); + assert(!rawPuzzle[0].empty); + assert(rawPuzzle.all!(row => row.length == rawPuzzle[0].length)); // Is rectangular. + + gridWidth = rawPuzzle[0].length; + gridHeight = rawPuzzle.length; + immutable nMaxCells = gridWidth * gridHeight; + grid = new Cell[nMaxCells]; + auto knownMutable = new bool[nMaxCells + 1]; + uint nAvailableMutable = nMaxCells; + bool[Cell] seenCells; // To avoid duplicate input numbers. + + uint i = 0; + foreach (const piece; rawPuzzle.join) { + if (piece == unavailableInCell) { + nAvailableMutable--; + grid[i++] = unavailableCell; + continue; + } else if (piece == availableInCell) { + grid[i] = availableCell; + } else { + immutable cell = piece.to!Cell; + assert(cell > 0 && cell <= nMaxCells); + assert(cell !in seenCells); + seenCells[cell] = true; + knownMutable[cell] = true; + grid[i] = cell; + } + + i++; + } + + known = knownMutable.idup; + nAvailable = nAvailableMutable; + } + + @disable this(); + + + auto solve() pure nothrow @safe @nogc + out(result) { + if (!result.isNull) { + // Can't verify 'result' here because it's const. + // assert(!result.get.join.canFind(availableCell.text)); + + assert(!grid.canFind(availableCell)); + auto values = grid.filter!(c => c != unavailableCell); + auto interval = iota(reduce!min(values.front, values.dropOne), + reduce!max(values.front, values.dropOne) + 1); + assert(values.walkLength == interval.length); + assert(interval.all!(c => values.count(c) == 1)); // Quadratic. + } + } body { + auto result = grid + .map!(c => (c == unavailableCell) ? unavailableInCell : c.text) + .chunks(gridWidth); + alias OutRange = Nullable!(typeof(result)); + + const start = findStart; + if (start.isNull) + return OutRange(); + + search(start.r, start.c, start.cell + 1, 1); + if (start.cell > 1) { + immutable direction = -1; + search(start.r, start.c, start.cell + direction, direction); + } + + if (grid.any!(c => c == availableCell)) + return OutRange(); + else + return OutRange(result); + } + + private: + + + bool search(in uint r, in uint c, in Cell cell, in int direction) + pure nothrow @safe @nogc { + if ((cell > nAvailable && direction > 0) || (cell == 0 && direction < 0) || + (cell == nAvailable && known[cell])) + return true; // One solution found. + + immutable neighbors = getNeighbors(r, c); + + if (known[cell]) { + foreach (immutable i, immutable rc; shifts) { + if (neighbors & (1u << i)) { + immutable c2 = c + rc[0], + r2 = r + rc[1]; + if (grid[r2 * gridWidth + c2] == cell) + if (search(r2, c2, cell + direction, direction)) + return true; + } + } + return false; + } + + foreach (immutable i, immutable rc; shifts) { + if (neighbors & (1u << i)) { + immutable c2 = c + rc[0], + r2 = r + rc[1], + pos = r2 * gridWidth + c2; + if (grid[pos] == availableCell) { + grid[pos] = cell; // Try. + if (search(r2, c2, cell + direction, direction)) + return true; + grid[pos] = availableCell; // Restore. + } + } + } + return false; + } + + + BitSet8 getNeighbors(in uint r, in uint c) const pure nothrow @safe @nogc { + typeof(return) usable = 0; + + foreach (immutable i, immutable rc; shifts) { + immutable c2 = c + rc[0], + r2 = r + rc[1]; + if (c2 >= gridWidth || r2 >= gridHeight) + continue; + if (grid[r2 * gridWidth + c2] != unavailableCell) + usable |= (1u << i); + } + + return usable; + } + + + auto findStart() const pure nothrow @safe @nogc { + alias Triple = Tuple!(uint,"r", uint,"c", Cell,"cell"); + Nullable!Triple result; + + auto cell = Cell.max; + foreach (immutable r; 0 .. gridHeight) { + foreach (immutable c; 0 .. gridWidth) { + immutable pos = gridWidth * r + c; + if (grid[pos] != availableCell && + grid[pos] != unavailableCell && grid[pos] < cell) { + cell = grid[pos]; + result = Triple(r, c, cell); + } + } + } + + return result; + } + + static immutable int[2][4] shifts = [[0, -1], [0, 1], [-1, 0], [1, 0]]; + immutable uint gridWidth, gridHeight; + immutable int nAvailable; + immutable bool[] known; // Given known cells of the puzzle. + Cell[] grid; // Flattened mutable game grid. +} + + +void main() { + // enum NumbrixPuzzle to catch malformed puzzles at compile-time. + enum puzzle1 = ". . . . . . . . . + . . 46 45 . 55 74 . . + . 38 . . 43 . . 78 . + . 35 . . . . . 71 . + . . 33 . . . 59 . . + . 17 . . . . . 67 . + . 18 . . 11 . . 64 . + . . 24 21 . 1 2 . . + . . . . . . . . .".NumbrixPuzzle; + + enum puzzle2 = ". . . . . . . . . + . 11 12 15 18 21 62 61 . + . 6 . . . . . 60 . + . 33 . . . . . 57 . + . 32 . . . . . 56 . + . 37 . 1 . . . 73 . + . 38 . . . . . 72 . + . 43 44 47 48 51 76 77 . + . . . . . . . . .".NumbrixPuzzle; + + enum puzzle3 = "17 . . . 11 . . . 59 + . 15 . . 6 . . 61 . + . . 3 . . . 63 . . + . . . . 66 . . . . + 23 24 . 68 67 78 . 54 55 + . . . . 72 . . . . + . . 35 . . . 49 . . + . 29 . . 40 . . 47 . + 31 . . . 39 . . . 45".NumbrixPuzzle; + + + foreach (puzzle; [puzzle1, puzzle2, puzzle3]) { + auto solution = puzzle.solve; // Solved at run-time. + if (solution.isNull) + writeln("No solution found for puzzle.\n"); + else + writefln("One solution:\n%(%-(%2s %)\n%)\n", solution); + } +} diff --git a/Task/Solve-a-Numbrix-puzzle/Elixir/solve-a-numbrix-puzzle-1.elixir b/Task/Solve-a-Numbrix-puzzle/Elixir/solve-a-numbrix-puzzle-1.elixir new file mode 100644 index 0000000000..a32dba3b70 --- /dev/null +++ b/Task/Solve-a-Numbrix-puzzle/Elixir/solve-a-numbrix-puzzle-1.elixir @@ -0,0 +1,29 @@ +# require HLPsolver + +adjacent = [{-1, 0}, {0, -1}, {0, 1}, {1, 0}] + +board1 = """ + 0 0 0 0 0 0 0 0 0 + 0 0 46 45 0 55 74 0 0 + 0 38 0 0 43 0 0 78 0 + 0 35 0 0 0 0 0 71 0 + 0 0 33 0 0 0 59 0 0 + 0 17 0 0 0 0 0 67 0 + 0 18 0 0 11 0 0 64 0 + 0 0 24 21 0 1 2 0 0 + 0 0 0 0 0 0 0 0 0 +""" +HLPsolver.solve(board1, adjacent) + +board2 = """ + 0 0 0 0 0 0 0 0 0 + 0 11 12 15 18 21 62 61 0 + 0 6 0 0 0 0 0 60 0 + 0 33 0 0 0 0 0 57 0 + 0 32 0 0 0 0 0 56 0 + 0 37 0 1 0 0 0 73 0 + 0 38 0 0 0 0 0 72 0 + 0 43 44 47 48 51 76 77 0 + 0 0 0 0 0 0 0 0 0 +""" +HLPsolver.solve(board2, adjacent) diff --git a/Task/Solve-a-Numbrix-puzzle/Elixir/solve-a-numbrix-puzzle-2.elixir b/Task/Solve-a-Numbrix-puzzle/Elixir/solve-a-numbrix-puzzle-2.elixir new file mode 100644 index 0000000000..c2e2906849 --- /dev/null +++ b/Task/Solve-a-Numbrix-puzzle/Elixir/solve-a-numbrix-puzzle-2.elixir @@ -0,0 +1,90 @@ +global nCells, cMap, best +record Pos(r,c) + +procedure main(A) + puzzle := showPuzzle("Input",readPuzzle()) + QMouse(puzzle,findStart(puzzle),&null,0) + showPuzzle("Output", solvePuzzle(puzzle)) | write("No solution!") +end + +procedure readPuzzle() + # Start with a reduced puzzle space + p := [] + nCells := maxCols := 0 + every line := !&input do { + put(p,[: gencells(line) :]) + maxCols <:= *p[-1] + } + # Now normalize all rows to the same length + every i := 1 to *p do p[i] := [: !p[i] | (|-1\(maxCols - *p[i])) :] + return p +end + +procedure gencells(s) + static WS, NWS + initial { + NWS := ~(WS := " \t") + cMap := table() # Map to/from internal model + cMap["_"] := 0; cMap[0] := "_" + } + + s ? while not pos(0) do { + w := (tab(many(WS))|"", tab(many(NWS))) | break + w := numeric(\cMap[w]|w) + if -1 ~= w then nCells +:= 1 + suspend w + } +end + +procedure showPuzzle(label, p) + write(label," with ",nCells," cells:") + every r := !p do { + every c := !r do writes(right((\cMap[c]|c),*nCells+1)) + write() + } + return p +end + +procedure findStart(p) + if \p[r := !*p][c := !*p[r]] = 1 then return Pos(r,c) +end + +procedure solvePuzzle(puzzle) + if path := \best then { + repeat { + loc := path.getLoc() + puzzle[loc.r][loc.c] := path.getVal() + path := \path.getParent() | break + } + return puzzle + } +end + +class QMouse(puzzle, loc, parent, val) + + method getVal(); return val; end + method getLoc(); return loc; end + method getParent(); return parent; end + method atEnd(); return (nCells = val, puzzle[loc.r,loc.c] = (val|0)); end + method visit(r,c); return (/best, validPos(r,c), Pos(r,c)); end + + method validPos(r,c) + v := val+1 # number we're looking for + xv := puzzle[r,c] | fail + if (xv ~= 0) & (xv != v) then fail + if xv = (0|v) then { + ancestor := self + while xl := (ancestor := \ancestor.getParent()).getLoc() do + if (xl.r = r) & (xl.c = c) then fail + return + } + end + +initially + val := val+1 + if atEnd() then return best := self + QMouse(puzzle, visit(loc.r-1,loc.c) , self, val) # North + QMouse(puzzle, visit(loc.r, loc.c+1), self, val) # East + QMouse(puzzle, visit(loc.r+1,loc.c), self, val) # South + QMouse(puzzle, visit(loc.r, loc.c-1), self, val) # West +end diff --git a/Task/Solve-a-Numbrix-puzzle/Java/solve-a-numbrix-puzzle.java b/Task/Solve-a-Numbrix-puzzle/Java/solve-a-numbrix-puzzle.java new file mode 100644 index 0000000000..607b378aae --- /dev/null +++ b/Task/Solve-a-Numbrix-puzzle/Java/solve-a-numbrix-puzzle.java @@ -0,0 +1,91 @@ +import java.util.*; + +public class Numbrix { + + final static String[] board = { + "00,00,00,00,00,00,00,00,00", + "00,00,46,45,00,55,74,00,00", + "00,38,00,00,43,00,00,78,00", + "00,35,00,00,00,00,00,71,00", + "00,00,33,00,00,00,59,00,00", + "00,17,00,00,00,00,00,67,00", + "00,18,00,00,11,00,00,64,00", + "00,00,24,21,00,01,02,00,00", + "00,00,00,00,00,00,00,00,00"}; + + final static int[][] moves = {{1, 0}, {0, 1}, {-1, 0}, {0, -1}}; + + static int[][] grid; + static int[] clues; + static int totalToFill; + + public static void main(String[] args) { + int nRows = board.length + 2; + int nCols = board[0].split(",").length + 2; + int startRow = 0, startCol = 0; + + grid = new int[nRows][nCols]; + totalToFill = (nRows - 2) * (nCols - 2); + List lst = new ArrayList<>(); + + for (int r = 0; r < nRows; r++) { + Arrays.fill(grid[r], -1); + + if (r >= 1 && r < nRows - 1) { + + String[] row = board[r - 1].split(","); + + for (int c = 1; c < nCols - 1; c++) { + int val = Integer.parseInt(row[c - 1]); + if (val > 0) + lst.add(val); + if (val == 1) { + startRow = r; + startCol = c; + } + grid[r][c] = val; + } + } + } + + clues = lst.stream().sorted().mapToInt(i -> i).toArray(); + + if (solve(startRow, startCol, 1, 0)) + printResult(); + } + + static boolean solve(int r, int c, int count, int nextClue) { + if (count > totalToFill) + return true; + + if (grid[r][c] != 0 && grid[r][c] != count) + return false; + + if (grid[r][c] == 0 && nextClue < clues.length) + if (clues[nextClue] == count) + return false; + + int back = grid[r][c]; + if (back == count) + nextClue++; + + grid[r][c] = count; + for (int[] move : moves) + if (solve(r + move[1], c + move[0], count + 1, nextClue)) + return true; + + grid[r][c] = back; + return false; + } + + static void printResult() { + for (int[] row : grid) { + for (int i : row) { + if (i == -1) + continue; + System.out.printf("%2d ", i); + } + System.out.println(); + } + } +} diff --git a/Task/Solve-a-Numbrix-puzzle/REXX/solve-a-numbrix-puzzle.rexx b/Task/Solve-a-Numbrix-puzzle/REXX/solve-a-numbrix-puzzle.rexx index bedd38c55a..4f34d9549c 100644 --- a/Task/Solve-a-Numbrix-puzzle/REXX/solve-a-numbrix-puzzle.rexx +++ b/Task/Solve-a-Numbrix-puzzle/REXX/solve-a-numbrix-puzzle.rexx @@ -1,53 +1,52 @@ -/*REXX program solves a Numbrix (R) puzzle, displays puzzle & solution.*/ -maxr=0; maxc=0; maxx=0; minr=9e9; minc=9e9; minx=9e9; cells=0; @.= -parse arg xxx; PZ='Numbrix puzzle' /*get cell definitions from C.L. */ -xxx=translate(xxx, , "/\;:_", ',') /*also allow other chars as comma*/ +/*REXX program solves a Numbrix (R) puzzle, it also displays the puzzle and solution. */ +maxR=0; maxC=0; maxX=0; minR=9e9; minC=9e9; minX=9e9; cells=0; @.= +parse arg xxx; PZ='Numbrix puzzle' /*get the cell definitions from the CL.*/ +xxx=translate(xxx, , "/\;:_", ',') /*also allow other characters as comma.*/ - do while xxx\=''; parse var xxx r c marks ',' xxx - do while marks\=''; _=@.r.c + do while xxx\=''; parse var xxx r c marks ',' xxx + do while marks\=''; _=@.r.c parse var marks x marks - if datatype(x,'N') then x=abs(x/1) /*normalize X*/ - minr=min(minr,r); maxr=max(maxr,r) - minc=min(minc,c); maxc=max(maxc,c) - if x==1 then do; !r=r; !c=c; end /*start cell.*/ - if _\=='' then call err "cell at" r c 'is already occupied with:' _ - @.r.c=x; c=c+1; cells=cells+1 /*assign mark*/ - if x==. then iterate /*hole? Skip.*/ + if datatype(x,'N') then x=abs(x)/1 /*normalize │x│ */ + minR=min(minR,r); maxR=max(maxR,r); minC=min(minC,c); maxC=max(maxC,c) + if x==1 then do; !r=r; !c=c; end /*the START cell. */ + if _\=='' then call err "cell at" r c 'is already occupied with:' _ + @.r.c=x; c=c+1; cells=cells+1 /*assign a mark. */ + if x==. then iterate /*is a hole? Skip*/ if \datatype(x,'W') then call err 'illegal marker specified:' x - minx=min(minx,x); maxx=max(maxx,x) /*min & max X*/ + minX=min(minX,x); maxX=max(maxX,x) /*min and max X. */ end /*while marks¬='' */ end /*while xxx ¬='' */ -call showGrid /* [↓] used for making fast moves*/ -Nr = '0 1 0 -1 -1 1 1 -1' /*possible row for the next move.*/ -Nc = '1 0 -1 0 1 -1 1 -1' /* " col " " " " */ -pMoves=words(Nr) -4*(left(PZ,1)=='N') /*is this to be a Numbrix puzzle?*/ - do i=1 for pMoves; Nr.i=word(Nr,i); Nc.i=word(Nc,i); end /*fast moves*/ +call show /* [↓] is used for making fast moves. */ +Nr = '0 1 0 -1 -1 1 1 -1' /*possible row for the next move. */ +Nc = '1 0 -1 0 1 -1 1 -1' /* " column " " " " */ +pMoves=words(Nr) -4*(left(PZ,1)=='N') /*is this to be a Numbrix puzzle ? */ + do i=1 for pMoves; Nr.i=word(Nr,i); Nc.i=word(Nc,i); end /*for fast moves. */ if \next(2,!r,!c) then call err 'No solution possible for this' PZ"." -say; say 'A solution for the' PZ "exists."; say; call showGrid -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────ERR subroutine──────────────────────*/ -err: say; say '***error!*** (from' PZ"): " arg(1); say; exit 13 -/*──────────────────────────────────NEXT subroutine─────────────────────*/ +say; say 'A solution for the' PZ "exists."; say; call show +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +err: say; say '***error*** (from' PZ"): " arg(1); say; exit 13 +/*──────────────────────────────────────────────────────────────────────────────────────*/ next: procedure expose @. Nr. Nc. cells pMoves; parse arg #,r,c; ##=#+1 - do t=1 for pMoves /* [↓] try some moves.*/ - parse value r+Nr.t c+Nc.t with nr nc /*next move coördinates*/ - if @.nr.nc==. then do; @.nr.nc=# /*a move.*/ - if #==cells then return 1 /*last 1?*/ - if next(##,nr,nc) then return 1 - @.nr.nc=. /*undo the above move. */ - iterate /*go & try another move*/ - end - if @.nr.nc==# then do /*is this a fill-in ? */ - if #==cells then return 1 /*last 1.*/ - if next(##,nr,nc) then return 1 /*fill-in*/ - end - end /*t*/ -return 0 /*This ain't working. */ -/*──────────────────────────────────SHOWGRID subroutine─────────────────*/ -showGrid: if maxr<1 | maxc<1 then call err 'no legal cell was specified.' -if minx<1 then call err 'no 1 was specified for the puzzle start' -w=length(cells); do r=maxr to minr by -1; _= - do c=minc to maxc; _=_ right(@.r.c,w); end /*c*/ - say _ - end /*r*/ -say; return + do t=1 for pMoves /* [↓] try some moves. */ + parse value r+Nr.t c+Nc.t with nr nc /*next move coördinates.*/ + if @.nr.nc==. then do; @.nr.nc=# /*let's try this move. */ + if #==cells then return 1 /*is this the last move?*/ + if next(##,nr,nc) then return 1 + @.nr.nc=. /*undo the above move. */ + iterate /*go & try another move.*/ + end + if @.nr.nc==# then do /*this a fill-in move ? */ + if #==cells then return 1 /*this is the last move.*/ + if next(##,nr,nc) then return 1 /*a fill-in move. */ + end + end /*t*/ + return 0 /*this ain't working. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +show: if maxR<1 | maxC<1 then call err 'no legal cell was specified.' + if minX<1 then call err 'no 1 was specified for the puzzle start' + w=max(2,length(cells)); do r=maxR to minR by -1; _= + do c=minC to maxC; _=_ right(@.r.c,w); end /*c*/ + say _ + end /*r*/ + say; return diff --git a/Task/Solve-the-no-connection-puzzle/00DESCRIPTION b/Task/Solve-the-no-connection-puzzle/00DESCRIPTION index c7abbf9da4..f23e8ff124 100644 --- a/Task/Solve-the-no-connection-puzzle/00DESCRIPTION +++ b/Task/Solve-the-no-connection-puzzle/00DESCRIPTION @@ -1,7 +1,6 @@ You are given a box with eight holes labelled A-to-H, connected by fifteen straight lines in the pattern as shown - '''A''' '''B''' /|\ /|\ / | X | \ @@ -30,13 +29,19 @@ For example, in this attempt: Note that 7 and 6 are connected and have a difference of 1 so it is ''not'' a solution. -The task is to produce and show here ''one'' solution to the puzzle. -;Reference: -[https://www.youtube.com/watch?v=AECElyEyZBQ No Connection Puzzle] (Video). -;Related Tasks: +;Task +Produce and show here ''one'' solution to the puzzle. + + +;Related tasks: * [[Solve a Hidato puzzle]] * [[Solve a Hopido puzzle]] * [[Solve a Holy Knight's tour]] * [[Solve a Numbrix puzzle]] * [[Knight's tour]] + + +;See also +[https://www.youtube.com/watch?v=AECElyEyZBQ No Connection Puzzle] (youtube). +

    diff --git a/Task/Solve-the-no-connection-puzzle/Elixir/solve-the-no-connection-puzzle.elixir b/Task/Solve-the-no-connection-puzzle/Elixir/solve-the-no-connection-puzzle.elixir new file mode 100644 index 0000000000..6f47d40dc2 --- /dev/null +++ b/Task/Solve-the-no-connection-puzzle/Elixir/solve-the-no-connection-puzzle.elixir @@ -0,0 +1,26 @@ +# It solved if connected A and B, connected G and H (according to the video). + +# require HLPsolver + +adjacent = for i <- -2..2, j <- -2..2, not(i in -1..1 and j in -1..1), do: {i,j} +layout = ~S""" + A - B + /|\ /|\ + / | X | \ + / |/ \| \ + C - D - E - F + \ |\ /| / + \ | X | / + \|/ \|/ + G - H +""" +board = """ + . 0 0 . + 0 1 0 0 + . 0 0 . +""" +HLPsolver.solve(board, adjacent, false) +|> Enum.sort |> Enum.map(fn {_,cell} -> cell.value end) +|> Enum.zip(~w[A B C D E F G H]) +|> Enum.reduce(layout, fn {n,c},acc -> String.replace(acc, c, to_string(n)) end) +|> IO.puts diff --git a/Task/Solve-the-no-connection-puzzle/J/solve-the-no-connection-puzzle-4.j b/Task/Solve-the-no-connection-puzzle/J/solve-the-no-connection-puzzle-4.j new file mode 100644 index 0000000000..3bf2d49ba8 --- /dev/null +++ b/Task/Solve-the-no-connection-puzzle/J/solve-the-no-connection-puzzle-4.j @@ -0,0 +1,5 @@ + (#~ 1 vals = range(1, 9).mapToObj(i -> i).collect(toList()); + do { + Collections.shuffle(vals); + for (int i = 0; i < pegs.length; i++) + pegs[i] = vals.get(i); + + } while (!solved()); + + printResult(); + } + + static boolean solved() { + for (int i = 0; i < links.length; i++) + for (int peg : links[i]) + if (abs(pegs[i] - peg) == 1) + return false; + return true; + } + + static void printResult() { + System.out.printf(" %s %s%n", pegs[0], pegs[1]); + System.out.printf("%s %s %s %s%n", pegs[2], pegs[3], pegs[4], pegs[5]); + System.out.printf(" %s %s%n", pegs[6], pegs[7]); + } +} diff --git a/Task/Solve-the-no-connection-puzzle/REXX/solve-the-no-connection-puzzle-1.rexx b/Task/Solve-the-no-connection-puzzle/REXX/solve-the-no-connection-puzzle-1.rexx index 5732d65365..e2cba728c8 100644 --- a/Task/Solve-the-no-connection-puzzle/REXX/solve-the-no-connection-puzzle-1.rexx +++ b/Task/Solve-the-no-connection-puzzle/REXX/solve-the-no-connection-puzzle-1.rexx @@ -1,37 +1,37 @@ -/*REXX program solves the "no-connection" puzzle (with eight pegs). */ -parse arg limit . /*# solutions*/ /* ╔═══════════════════════════╗ */ -if limit=='' then limit=1 /* ║ A B ║ */ - /* ║ /│\ /│\ ║ */ -@. = /* ║ / │ \/ │ \ ║ */ -@.1 = 'A C D E' /* ║ / │ /\ │ \ ║ */ -@.2 = 'B D E F' /* ║ / │/ \│ \ ║ */ -@.3 = 'C A D G' /* ║ C────D────E────F ║ */ -@.4 = 'D A B C E G' /* ║ \ │\ /│ / ║ */ -@.5 = 'E A B D F H' /* ║ \ │ \/ │ / ║ */ -@.6 = 'F B E G' /* ║ \ │ /\ │ / ║ */ -@.7 = 'G C D E' /* ║ \│/ \│/ ║ */ -@.8 = 'H D E F' /* ║ G H ║ */ -cnt=0 /* ╚═══════════════════════════╝ */ - do nodes=1 while @.nodes\==''; _=word(@.nodes,1) - subs=0 /* [↓] create list of node paths*/ - do #=1 for words(@.nodes)-1 - __=word(@.nodes,#+1); if __>_ then iterate - subs=subs+1; !._.subs=__ - end /*#*/ - !._.0=subs /*assign the number of node paths*/ - end /*nodes*/ -pegs=nodes-1 /*number of pegs to be seated. */ -_=' ' /*_ is used for padding output.*/ - do a=1 for pegs; if ?('A') then iterate - do b=1 for pegs; if ?('B') then iterate - do c=1 for pegs; if ?('C') then iterate - do d=1 for pegs; if ?('D') then iterate - do e=1 for pegs; if ?('E') then iterate - do f=1 for pegs; if ?('F') then iterate - do g=1 for pegs; if ?('G') then iterate - do h=1 for pegs; if ?('H') then iterate - say _ 'a='a _ 'b='||b _ 'c='c _ 'd='d _ 'e='e _ 'f='f _ 'g='g _ 'h='h - cnt=cnt+1; if cnt==limit then leave a +/*REXX program solves the "no-connection" puzzle (the puzzle has eight pegs). */ +parse arg limit . /*number of solutions wanted.*/ /* ╔═══════════════════════════╗ */ +if limit=='' | limit=="." then limit=1 /* ║ A B ║ */ + /* ║ /│\ /│\ ║ */ +@. = /* ║ / │ \/ │ \ ║ */ +@.1 = 'A C D E' /* ║ / │ /\ │ \ ║ */ +@.2 = 'B D E F' /* ║ / │/ \│ \ ║ */ +@.3 = 'C A D G' /* ║ C────D────E────F ║ */ +@.4 = 'D A B C E G' /* ║ \ │\ /│ / ║ */ +@.5 = 'E A B D F H' /* ║ \ │ \/ │ / ║ */ +@.6 = 'F B E G' /* ║ \ │ /\ │ / ║ */ +@.7 = 'G C D E' /* ║ \│/ \│/ ║ */ +@.8 = 'H D E F' /* ║ G H ║ */ +cnt=0 /* ╚═══════════════════════════╝ */ + do nodes=1 while @.nodes\==''; _=word(@.nodes,1) + subs=0 + do #=1 for words(@.nodes)-1 /*create list of node paths.*/ + __=word(@.nodes,#+1); if __>_ then iterate + subs=subs + 1; !._.subs=__ + end /*#*/ + !._.0=subs /*assign the number of the node paths. */ + end /*nodes*/ +pegs=nodes-1 /*the number of pegs to be seated. */ +_=' ' /*_ is used for indenting the output.*/ + do a=1 for pegs; if ?('A') then iterate + do b=1 for pegs; if ?('B') then iterate + do c=1 for pegs; if ?('C') then iterate + do d=1 for pegs; if ?('D') then iterate + do e=1 for pegs; if ?('E') then iterate + do f=1 for pegs; if ?('F') then iterate + do g=1 for pegs; if ?('G') then iterate + do h=1 for pegs; if ?('H') then iterate + say _ 'a='a _ 'b='||b _ 'c='c _ 'd='d _ 'e='e _ 'f='f _ 'g='g _ 'h='h + cnt=cnt+1; if cnt==limit then leave a end /*h*/ end /*g*/ end /*f*/ @@ -40,16 +40,18 @@ _=' ' /*_ is used for padding output.*/ end /*c*/ end /*b*/ end /*a*/ -say /*display a blank line to screen.*/ -s=left('s',cnt\==1) /*handle case of plurals (or not)*/ -say 'found ' cnt " solution"s'.' /*display the number of solutions*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────? subroutine────────────────────────*/ -?: parse arg node; nn=value(node); nL=nn-1; nH=nn+1 - do cn=c2d('A') to c2d(node)-1; if value(d2c(cn))==nn then return 1; end - /* [↑] see if any are duplicates*/ - do ch=1 for !.node.0 /* [↓] see if any ¬ = ±1 value*/ - $=!.node.ch; fn=value($) /*node name and its current peg#.*/ - if nL==fn | nH==fn then return 1 /*if ≡ ±1, then it can't be used.*/ - end /*ch*/ /* [↑] looking for suitable num.*/ -return 0 /*the sub arg value passed is OK.*/ +say /*display a blank line to the terminal.*/ +s=left('s',cnt\==1) /*handle the case of plurals (or not).*/ +say 'found ' cnt " solution"s'.' /*display the number of solutions found*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +?: parse arg node; nn=value(node) + nH=nn+1 + do cn=c2d('A') to c2d(node)-1; if value( d2c(cn) )==nn then return 1 + end /*cn*/ /* [↑] see if there any are duplicates.*/ + nL=nn-1 + do ch=1 for !.node.0 /* [↓] see if there any ¬= ±1 values.*/ + $=!.node.ch; fn=value($) /*the node name and its current peg #.*/ + if nL==fn | nH==fn then return 1 /*if ≡ ±1, then the node can't be used.*/ + end /*ch*/ /* [↑] looking for suitable number. */ + return 0 /*the subroutine arg value passed is OK.*/ diff --git a/Task/Solve-the-no-connection-puzzle/REXX/solve-the-no-connection-puzzle-2.rexx b/Task/Solve-the-no-connection-puzzle/REXX/solve-the-no-connection-puzzle-2.rexx index 6f960d8dda..2d71ea225f 100644 --- a/Task/Solve-the-no-connection-puzzle/REXX/solve-the-no-connection-puzzle-2.rexx +++ b/Task/Solve-the-no-connection-puzzle/REXX/solve-the-no-connection-puzzle-2.rexx @@ -1,76 +1,78 @@ -/*REXX program solves the "no-connection" puzzle (with eight pegs). */ +/*REXX program solves the "no-connection" puzzle (the puzzle has eight pegs). */ @abc='ABCDEFGHIJKLMNOPQRSTUVWXYZ' -parse arg limit . /*# solutions*/ /* ╔═══════════════════════════╗ */ -if limit=='' then limit=1 /* ║ A B ║ */ -oLimit=limit; limit=abs(limit) /* ║ /│\ /│\ ║ */ -@. = /* ║ / │ \/ │ \ ║ */ -@.1 = 'A C D E' /* ║ / │ /\ │ \ ║ */ -@.2 = 'B D E F' /* ║ / │/ \│ \ ║ */ -@.3 = 'C A D G' /* ║ C────D────E────F ║ */ -@.4 = 'D A B C E G' /* ║ \ │\ /│ / ║ */ -@.5 = 'E A B D F H' /* ║ \ │ \/ │ / ║ */ -@.6 = 'F B E G' /* ║ \ │ /\ │ / ║ */ -@.7 = 'G C D E' /* ║ \│/ \│/ ║ */ -@.8 = 'H D E F' /* ║ G H ║ */ -cnt=0 /* ╚═══════════════════════════╝ */ - do nodes=1 while @.nodes\==''; _=word(@.nodes,1) - subs=0 /* [↓] create list of node paths*/ - do #=1 for words(@.nodes)-1 - __=word(@.nodes,#+1); if __>_ then iterate - subs=subs+1; !._.subs=__ - end /*#*/ - !._.0=subs /*assign the number of node paths*/ - end /*nodes*/ -pegs=nodes-1 /*number of pegs to be seated. */ - do a=1 for pegs; if ?('A') then iterate - do b=1 for pegs; if ?('B') then iterate - do c=1 for pegs; if ?('C') then iterate - do d=1 for pegs; if ?('D') then iterate - do e=1 for pegs; if ?('E') then iterate - do f=1 for pegs; if ?('F') then iterate - do g=1 for pegs; if ?('G') then iterate - do h=1 for pegs; if ?('H') then iterate - call showNodes - cnt=cnt+1; if cnt==limit then leave a - end /*h*/ - end /*g*/ - end /*f*/ - end /*e*/ - end /*d*/ - end /*c*/ - end /*b*/ - end /*a*/ -say /*display a blank line to screen.*/ -s=left('s',cnt\==1) /*handle case of plurals (or not)*/ -say 'found ' cnt " solution"s'.' /*display the number of solutions*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────? subroutine────────────────────────*/ -?: parse arg node; nn=value(node); nL=nn-1; nH=nn+1 - do cn=c2d('A') to c2d(node)-1; if value(d2c(cn))==nn then return 1; end - /* [↑] see if any are duplicates*/ - do ch=1 for !.node.0 /* [↓] see if any ¬ = ±1 value*/ - $=!.node.ch; fn=value($) /*node name and its current peg#.*/ - if nL==fn | nH==fn then return 1 /*if ≡ ±1, then it can't be used.*/ - end /*ch*/ /* [↑] looking for suitable num.*/ -return 0 /*the sub arg value passed is OK.*/ -/*──────────────────────────────────SHOWNODES subroutine────────────────*/ -showNodes: _=' ' /*_ is used for padding output.*/ -show=0 /*indicates graph not found yet. */ - - do box=1 for sourceline() while oLimit<0 /*Negative? Then show it*/ - xw=sourceline(box) /*get a line of this REXX program*/ - p2=lastpos('*',xw) /*position of last asterisk.*/ - p1=lastpos('*',xw,max(1,p2-1)) /* " " penultimate " */ - if pos('╔', xw)\==0 then show=1 /*Found the top-left box corner? */ - if \show then iterate /*Not found? Then skip this line*/ - xb=substr(xw, p1+1, p2-p1-2) /*extract the "box" part of line.*/ - xt=xb /*get a working copy of the box. */ - do jx=1 for pegs /*do a substitution for all pegs.*/ - aa=substr(@abc,jx,1) /*get the name of the peg (A──►Z)*/ - xt=translate(xt,value(aa),aa) /*substitute peg name with value.*/ - end /*jx*/ /* [↑] graph limited to 26 nodes*/ - say _ xb _ _ xt /*display one line of the graph. */ - if pos('╝',xw)\==0 then return /*Last line of graph? Then stop.*/ - end /*box*/ - /* [↓] show a simple solution. */ -say _ 'a='a _ 'b='||b _ 'c='c _ 'd='d _ 'e='e _ 'f='f _ 'g='g _ 'h='h +parse arg limit . /*number of solutions wanted.*/ /* ╔═══════════════════════════╗ */ +if limit=='' | limit=="." then limit=1 /* ║ A B ║ */ +oLimit=limit; limit=abs(limit) /* ║ /│\ /│\ ║ */ +@. = /* ║ / │ \/ │ \ ║ */ +@.1 = 'A C D E' /* ║ / │ /\ │ \ ║ */ +@.2 = 'B D E F' /* ║ / │/ \│ \ ║ */ +@.3 = 'C A D G' /* ║ C────D────E────F ║ */ +@.4 = 'D A B C E G' /* ║ \ │\ /│ / ║ */ +@.5 = 'E A B D F H' /* ║ \ │ \/ │ / ║ */ +@.6 = 'F B E G' /* ║ \ │ /\ │ / ║ */ +@.7 = 'G C D E' /* ║ \│/ \│/ ║ */ +@.8 = 'H D E F' /* ║ G H ║ */ +cnt=0 /* ╚═══════════════════════════╝ */ + do nodes=1 while @.nodes\==''; _=word(@.nodes,1) + subs=0 + do #=1 for words(@.nodes)-1 /*create list of node paths.*/ + __=word(@.nodes,#+1); if __>_ then iterate + subs=subs + 1; !._.subs=__ + end /*#*/ + !._.0=subs /*assign the number of the node paths. */ + end /*nodes*/ +pegs=nodes-1 /*the number of pegs to be seated. */ +_=' ' /*_ is used for indenting the output. */ + do a=1 for pegs; if ?('A') then iterate + do b=1 for pegs; if ?('B') then iterate + do c=1 for pegs; if ?('C') then iterate + do d=1 for pegs; if ?('D') then iterate + do e=1 for pegs; if ?('E') then iterate + do f=1 for pegs; if ?('F') then iterate + do g=1 for pegs; if ?('G') then iterate + do h=1 for pegs; if ?('H') then iterate + call showNodes + cnt=cnt+1; if cnt==limit then leave a + end /*h*/ + end /*g*/ + end /*f*/ + end /*e*/ + end /*d*/ + end /*c*/ + end /*b*/ + end /*a*/ +say /*display a blank line to the terminal.*/ +s=left('s',cnt\==1) /*handle the case of plurals (or not).*/ +say 'found ' cnt " solution"s'.' /*display the number of solutions found*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +?: parse arg node; nn=value(node) + nH=nn+1 + do cn=c2d('A') to c2d(node)-1; if value( d2c(cn) )==nn then return 1 + end /*cn*/ /* [↑] see if there're any duplicates.*/ + nL=nn-1 + do ch=1 for !.node.0 /* [↓] see if there any ¬= ±1 values.*/ + $=!.node.ch; fn=value($) /*the node name and its current peg #.*/ + if nL==fn | nH==fn then return 1 /*if ≡ ±1, then the node can't be used.*/ + end /*ch*/ /* [↑] looking for suitable number. */ + return 0 /*the subroutine arg value passed is OK*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +showNodes: _=left('', 5) /*_ is used for padding the output. */ +show=0 /*indicates no graph has been found yet*/ + do box=1 for sourceline() while oLimit<0 /*Negative? Then display the diagram. */ + xw=sourceline(box) /*get a source line of this program. */ + p2=lastpos('*', xw) /*the position of last asterisk.*/ + p1=lastpos('*', xw, max(1, p2-1) ) /* " " " penultimate " */ + if pos('╔', xw)\==0 then show=1 /*Have found the top-left box corner ? */ + if \show then iterate /*Not found? Then skip this line. */ + xb=substr(xw, p1+1, p2-p1-2) /*extract the "box" part of line. */ + xt=xb /*get a working copy of the box. */ + do jx=1 for pegs /*do a substitution for all the pegs. */ + @=substr(@abc, jx, 1) /*get the name of the peg (A ──► Z). */ + xt=translate(xt,value(@),@) /*substitute the peg name with a value.*/ + end /*jx*/ /* [↑] graph is limited to 26 nodes.*/ + say _ xb _ _ xt /*display one line of the graph. */ + if pos('╝', xw)\==0 then return /*Is this last line of graph? Then stop*/ + end /*box*/ +say _ 'a='a _ 'b='||b _ 'c='c _ 'd='d _ ' e='e _ 'f='f _ 'g='g _ 'h='h +return diff --git a/Task/Sort-an-array-of-composite-structures/00DESCRIPTION b/Task/Sort-an-array-of-composite-structures/00DESCRIPTION index 97849fb1fb..52dc7a2f45 100644 --- a/Task/Sort-an-array-of-composite-structures/00DESCRIPTION +++ b/Task/Sort-an-array-of-composite-structures/00DESCRIPTION @@ -1,4 +1,7 @@ -Sort an array of composite structures by a key. For example, if you define a composite structure that presents a name-value pair (in pseudocode): +Sort an array of composite structures by a key. + + +For example, if you define a composite structure that presents a name-value pair (in pseudo-code): Define structure pair such that: name as a string @@ -11,3 +14,4 @@ and an array of such pairs: then define a sort routine that sorts the array ''x'' by the key ''name''. This task can always be accomplished with [[Sorting Using a Custom Comparator]]. If your language is not listed here, please see the other article. +

    diff --git a/Task/Sort-an-array-of-composite-structures/Babel/sort-an-array-of-composite-structures-1.pb b/Task/Sort-an-array-of-composite-structures/Babel/sort-an-array-of-composite-structures-1.pb new file mode 100644 index 0000000000..c9c3142e19 --- /dev/null +++ b/Task/Sort-an-array-of-composite-structures/Babel/sort-an-array-of-composite-structures-1.pb @@ -0,0 +1,4 @@ +babel> baz ([map "foo" 3 "bar" 17] [map "foo" 4 "bar" 18] [map "foo" 5 "bar" 19] [map "foo" 0 "bar" 20]) < +babel> bop baz { <- "foo" lumap ! -> "foo" lumap ! lt? } lssort ! < +babel> bop {"foo" lumap !} over ! lsnum ! +( 0 3 4 5 ) diff --git a/Task/Sort-an-array-of-composite-structures/Babel/sort-an-array-of-composite-structures-2.pb b/Task/Sort-an-array-of-composite-structures/Babel/sort-an-array-of-composite-structures-2.pb new file mode 100644 index 0000000000..9ee2ab6f79 --- /dev/null +++ b/Task/Sort-an-array-of-composite-structures/Babel/sort-an-array-of-composite-structures-2.pb @@ -0,0 +1,24 @@ +babel> 20 lsrange ! {1 randlf 2 rem} lssort ! 2 group ! --> this creates a shuffled list of pairs +babel> dup {lsnum !} ... --> display the shuffled list, pair-by-pair +( 11 10 ) +( 15 13 ) +( 12 16 ) +( 17 3 ) +( 14 5 ) +( 4 19 ) +( 18 9 ) +( 1 7 ) +( 8 6 ) +( 0 2 ) +babel> {<- car -> car lt? } lssort ! --> sort the list by first element of each pair +babel> dup {lsnum !} ... --> display the sorted list, pair-by-pair +( 0 2 ) +( 1 7 ) +( 4 19 ) +( 8 6 ) +( 11 10 ) +( 12 16 ) +( 14 5 ) +( 15 13 ) +( 17 3 ) +( 18 9 ) diff --git a/Task/Sort-an-array-of-composite-structures/Babel/sort-an-array-of-composite-structures-3.pb b/Task/Sort-an-array-of-composite-structures/Babel/sort-an-array-of-composite-structures-3.pb new file mode 100644 index 0000000000..a59b421318 --- /dev/null +++ b/Task/Sort-an-array-of-composite-structures/Babel/sort-an-array-of-composite-structures-3.pb @@ -0,0 +1,12 @@ +babel> gpsort ! +babel> dup {lsnum !} ... +( 0 2 ) +( 1 7 ) +( 4 19 ) +( 8 6 ) +( 11 10 ) +( 12 16 ) +( 14 5 ) +( 15 13 ) +( 17 3 ) +( 18 9 ) diff --git a/Task/Sort-an-array-of-composite-structures/Babel/sort-an-array-of-composite-structures-4.pb b/Task/Sort-an-array-of-composite-structures/Babel/sort-an-array-of-composite-structures-4.pb new file mode 100644 index 0000000000..74cb9ae494 --- /dev/null +++ b/Task/Sort-an-array-of-composite-structures/Babel/sort-an-array-of-composite-structures-4.pb @@ -0,0 +1,23 @@ +babel> dup {lsnum !} ... --> display the shuffled list of pairs and triples +( 7 2 ) +( 6 4 ) +( 8 9 ) +( 0 5 ) +( 5 14 0 ) +( 3 1 ) +( 9 6 10 ) +( 1 12 4 ) +( 11 13 7 ) +( 8 2 3 ) +babel> gpsort ! --> sort the list +babel> dup {lsnum !} ... --> display the result +( 0 5 ) +( 3 1 ) +( 6 4 ) +( 7 2 ) +( 8 9 ) +( 1 12 4 ) +( 5 14 0 ) +( 8 2 3 ) +( 9 6 10 ) +( 11 13 7 ) diff --git a/Task/Sort-an-array-of-composite-structures/Elena/sort-an-array-of-composite-structures.elena b/Task/Sort-an-array-of-composite-structures/Elena/sort-an-array-of-composite-structures.elena new file mode 100644 index 0000000000..56ba283676 --- /dev/null +++ b/Task/Sort-an-array-of-composite-structures/Elena/sort-an-array-of-composite-structures.elena @@ -0,0 +1,21 @@ +#import system. +#import system'routines. +#import extensions. + +#symbol program = +[ + #var elements := ( + KeyValue new &key:"Krypton" &object:83.798r, + KeyValue new &key:"Beryllium" &object:9.012182r, + KeyValue new &key:"Silicon" &object:28.0855r, + KeyValue new &key:"Cobalt" &object:58.933195r, + KeyValue new &key:"Selenium" &object:78.96r, + KeyValue new &key:"Germanium" &object:72.64r). + + #var sorted := elements sort:(:former:later) [ former key < later key ]. + + sorted run &each:element + [ + console writeLine:(element key):" - ":element. + ]. +]. diff --git a/Task/Sort-an-array-of-composite-structures/Perl-6/sort-an-array-of-composite-structures.pl6 b/Task/Sort-an-array-of-composite-structures/Perl-6/sort-an-array-of-composite-structures.pl6 index b5f06d289d..a2797ac389 100644 --- a/Task/Sort-an-array-of-composite-structures/Perl-6/sort-an-array-of-composite-structures.pl6 +++ b/Task/Sort-an-array-of-composite-structures/Perl-6/sort-an-array-of-composite-structures.pl6 @@ -1,6 +1,6 @@ my class Employee { has Str $.name; - has Num $.wage; + has Rat $.wage; } my $boss = Employee.new( name => "Frank Myers" , wage => 6755.85 ); diff --git a/Task/Sort-an-array-of-composite-structures/REXX/sort-an-array-of-composite-structures.rexx b/Task/Sort-an-array-of-composite-structures/REXX/sort-an-array-of-composite-structures.rexx new file mode 100644 index 0000000000..7058365c8d --- /dev/null +++ b/Task/Sort-an-array-of-composite-structures/REXX/sort-an-array-of-composite-structures.rexx @@ -0,0 +1,34 @@ +/*REXX program sorts an array of composite structures (which has two classes of data).*/ +#=0 /*number elements in structure (so far)*/ +name='tan' ; value= 0; call add name,value /*tan peanut M&M's are 0% of total*/ +name='orange'; value=10; call add name,value /*orange " " " 10% " " */ +name='yellow'; value=20; call add name,value /*yellow " " " 20% " " */ +name='green' ; value=20; call add name,value /*green " " " 20% " " */ +name='red' ; value=20; call add name,value /*red " " " 20% " " */ +name='brown' ; value=30; call add name,value /*brown " " " 30% " " */ +call show 'before sort', # +say copies('▒', 70) +call xSort # +call show ' after sort', # +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +add: procedure expose # @.; #=#+1 /*bump the number of structure entries.*/ + @.#.color=arg(1); @.#.pc=arg(2) /*construct a entry of the structure. */ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +show: procedure expose @.; do j=1 for arg(2) /*2nd arg≡number of structure elements.*/ + say right(arg(1),30) right(@.j.color,9) right(@.j.pc,4)'%' + end /*j*/ /* [↑] display what, name, value. */ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +xSort: procedure expose @.; parse arg N; h=N + do while h>1; h=h%2 + do i=1 for N-h; j=i; k=h+i + do while @.k.color<@.j.color /*swap elements.*/ + _=@.j.color; @.j.color=@.k.color; @.k.color=_ + _=@.j.pc; @.j.pc =@.k.pc; @.k.pc =_ + if h>=j then leave; j=j-h; k=k-h + end /*while @.k.color ···*/ + end /*i*/ + end /*while h>1*/ + return diff --git a/Task/Sort-an-integer-array/00DESCRIPTION b/Task/Sort-an-integer-array/00DESCRIPTION index 6bf7c7e9ce..78ba63894e 100644 --- a/Task/Sort-an-integer-array/00DESCRIPTION +++ b/Task/Sort-an-integer-array/00DESCRIPTION @@ -1 +1,5 @@ -Sort an array (or list) of integers in ascending numerical order. Use a sorting facility provided by the language/library if possible. +Sort an array (or list) of integers in ascending numerical order. + +;Task: +Use a sorting facility provided by the language/library if possible. +

    diff --git a/Task/Sort-an-integer-array/AppleScript/sort-an-integer-array.applescript b/Task/Sort-an-integer-array/AppleScript/sort-an-integer-array.applescript new file mode 100644 index 0000000000..22405d5116 --- /dev/null +++ b/Task/Sort-an-integer-array/AppleScript/sort-an-integer-array.applescript @@ -0,0 +1,34 @@ +use framework "Foundation" +use scripting additions + +on sort:lst + tell current application + return ((its (NSArray's arrayWithArray:lst))'s ¬ + sortedArrayUsingDescriptors:{its (NSSortDescriptor's ¬ + sortDescriptorWithKey:"self" ascending:true selector:"compare:")}) as list + end tell +end sort: + +on run + + map(sort_, [[9, 1, 8, 2, 8, 3, 7, 0, 4, 6, 5], ¬ + ["alpha", "beta", "gamma", "delta", "epsilon", "zeta", "eta", "theta", "iota", "kappa", "lambda", "mu"]]) + +end run + + +-- GENERIC FUNCTION FOR THE TEST + +-- map :: (a -> b) -> [a] -> [b] +on map(f, xs) + script mf + property lambda : f + end script + + set lng to length of xs + set lst to {} + repeat with i from 1 to lng + set end of lst to mf's lambda(item i of xs, i, xs) + end repeat + return lst +end map diff --git a/Task/Sort-an-integer-array/Babel/sort-an-integer-array-1.pb b/Task/Sort-an-integer-array/Babel/sort-an-integer-array-1.pb new file mode 100644 index 0000000000..c936137109 --- /dev/null +++ b/Task/Sort-an-integer-array/Babel/sort-an-integer-array-1.pb @@ -0,0 +1,6 @@ +babel> nil { zap {1 randlf 100 rem} 20 times collect ! } nest dup lsnum ! --> Create a list of random numbers +( 20 47 69 71 18 10 92 9 56 68 71 92 45 92 12 7 59 55 54 24 ) +babel> ls2lf --> Convert list to array for sorting +babel> dup {fnord} merge_sort --> The internal sort operator +babel> ar2ls lsnum ! --> Display the results +( 7 9 10 12 18 20 24 45 47 54 55 56 59 68 69 71 71 92 92 92 ) diff --git a/Task/Sort-an-integer-array/Babel/sort-an-integer-array-2.pb b/Task/Sort-an-integer-array/Babel/sort-an-integer-array-2.pb new file mode 100644 index 0000000000..e482541cd1 --- /dev/null +++ b/Task/Sort-an-integer-array/Babel/sort-an-integer-array-2.pb @@ -0,0 +1,3 @@ +babel> ( 68 73 63 83 54 67 46 53 88 86 49 75 89 83 28 9 34 21 20 90 ) +babel> {lt?} lssort ! lsnum ! +( 9 20 21 28 34 46 49 53 54 63 67 68 73 75 83 83 86 88 89 90 ) diff --git a/Task/Sort-an-integer-array/Babel/sort-an-integer-array-3.pb b/Task/Sort-an-integer-array/Babel/sort-an-integer-array-3.pb new file mode 100644 index 0000000000..96635f9514 --- /dev/null +++ b/Task/Sort-an-integer-array/Babel/sort-an-integer-array-3.pb @@ -0,0 +1,2 @@ +babel> ( 68 73 63 83 54 67 46 53 88 86 49 75 89 83 28 9 34 21 20 90 ) {gt?} lssort ! lsnum ! +( 90 89 88 86 83 83 75 73 68 67 63 54 53 49 46 34 28 21 20 9 ) diff --git a/Task/Sort-an-integer-array/Elena/sort-an-integer-array.elena b/Task/Sort-an-integer-array/Elena/sort-an-integer-array.elena new file mode 100644 index 0000000000..8e480bea0c --- /dev/null +++ b/Task/Sort-an-integer-array/Elena/sort-an-integer-array.elena @@ -0,0 +1,12 @@ +#import system. +#import system'routines. +#import extensions. + +#symbol program = +[ + #var unsorted := (6, 2, 7, 8, 3, 1, 10, 5, 4, 9). + + unsorted sort:ifOrdered. + + console writeLine:unsorted. +]. diff --git a/Task/Sort-an-integer-array/Perl-6/sort-an-integer-array-2.pl6 b/Task/Sort-an-integer-array/Perl-6/sort-an-integer-array-2.pl6 index a5bc02cb4d..f748a59c49 100644 --- a/Task/Sort-an-integer-array/Perl-6/sort-an-integer-array-2.pl6 +++ b/Task/Sort-an-integer-array/Perl-6/sort-an-integer-array-2.pl6 @@ -1 +1 @@ -my @sorted = sort +*, @a; +@a .= sort; diff --git a/Task/Sort-an-integer-array/REXX/sort-an-integer-array-1.rexx b/Task/Sort-an-integer-array/REXX/sort-an-integer-array-1.rexx index bfe0b35540..ac10cc29af 100644 --- a/Task/Sort-an-integer-array/REXX/sort-an-integer-array-1.rexx +++ b/Task/Sort-an-integer-array/REXX/sort-an-integer-array-1.rexx @@ -1,37 +1,37 @@ -/*REXX program sorts (E-sort) an arra y (which contains integers). */ -numeric digits 30 /*handle larger Euler numbers. */ - @. = 0 /*default for all Euler numbers. */ - @.1= 1 - @.3= -1 - @.5= 5 - @.7= -61 - @.9= 1385 - @.11= -50521 - @.13= 2702765 - @.15= -199360981 - @.17= 19391512145 - @.19= -2404879675441 - @.21= 370371188237525 -size=21 /*indicate there are 21 Euler #'s*/ -call tell 'un-sorted' /*display the array before sort. */ -call esort size /*sort the array of Euler numbers*/ -call tell ' sorted' /*display the array after sort. */ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────ESORT subroutine────────────────────*/ -esort: procedure expose @.; parse arg N; h=N - do while h>1; h=h%2 - do i=1 for N-h; j=i; k=h+i - do while @.k<@.j - parse value @.j @.k with @.k @.j /*swap two elements.*/ - if h>=j then leave; j=j-h; k=k-h - end /*while @.k<@.j*/ - end /*i*/ - end /*while h>1*/ -return -/*──────────────────────────────────TELL subroutine─────────────────────*/ -tell: say center(arg(1),50,'─') - do j=1 for size - say arg(1) 'array element' right(j,length(size))'='right(@.j,20) - end /*j*/ -say -return +/*REXX program sorts an array (using E-sort), in this case, the array contains integers.*/ +numeric digits 30 /*enables handling larger Euler numbers*/ + @. = 0 /*the default for all Euler numbers. */ + @.1 = 1 + @.3 = -1 + @.5 = 5 + @.7 = -61 + @.9 = 1385 + @.11= -50521 + @.13= 2702765 + @.15= -199360981 + @.17= 19391512145 + @.19= -2404879675441 + @.21= 370371188237525 +size=21 /*indicate that there're 21 Euler #s.*/ +call tell 'un-sorted' /*display the array before the eSsort. */ +call eSort size /*sort the array of some Euler numbers.*/ +call tell ' sorted' /*display the array after the sort. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +eSort: procedure expose @.; parse arg N; h=N + do while h>1; h=h%2 + do i=1 for N-h; j=i; k=h+i + do while @.k<@.j + parse value @.j @.k with @.k @.j /*swap two array elements.*/ + if h>=j then leave; j=j-h; k=k-h + end /*while @.k<@.j*/ + end /*i*/ + end /*while h>1*/ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +tell: say center(arg(1), 50, '─') + do j=1 for size + say arg(1) 'array element' right(j, length(size))'='right(@.j, 20) + end /*j*/ + say + return diff --git a/Task/Sort-an-integer-array/REXX/sort-an-integer-array-2.rexx b/Task/Sort-an-integer-array/REXX/sort-an-integer-array-2.rexx index 031e18dcd1..105caaab3c 100644 --- a/Task/Sort-an-integer-array/REXX/sort-an-integer-array-2.rexx +++ b/Task/Sort-an-integer-array/REXX/sort-an-integer-array-2.rexx @@ -1,29 +1,28 @@ -/*REXX program sorts (using E-sort) a list of some interesting integers.*/ -/* [↓] quotes aren't needed if all elements in a list are non-negative.*/ -bell= 1 1 2 5 15 52 203 877 4140 21147 115975 /*some Bell numbers.*/ -bern= '1 -1 1 0 -1 0 1 0 -1 0 5 0 -691 0 7 0 -3617' /*some Bernoulli num*/ -perrin= 3 0 2 3 2 5 5 7 10 12 17 22 29 39 51 68 90 /*some Perrin nums. */ -list=bell bern perrin /*throw 'em───►a pot*/ -say 'unsorted =' list /*an announcement···*/ -size=words(list) /*nice to have SIZE.*/ - do j=1 for size /*build an array, 1 */ - @.j=word(list,j) /*element at a time.*/ - end /*j*/ -call esort size /*sort the stuff. */ -bList= /*list: null so far.*/ - do k=1 for size /*build a list. */ - bList=strip(bList @.k) /*append it to list.*/ - end /*k*/ -say ' sorted =' bList /*show & tell time. */ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────ESORT subroutine────────────────────*/ -esort: procedure expose @.; parse arg N; h=N /*get the item count*/ - do while h>1; h=h%2 /*partition array. */ - do i=1 for N-h; j=i; k=h+i - do while @.k<@.j - parse value @.j @.k with @.k @.j /*swap two elements.*/ - if h>=j then leave; j=j-h; k=k-h - end /*while @.k<@.j*/ - end /*i*/ - end /*while h>1*/ -return +/*REXX program sorts (using E─sort) and displays a list of some interesting integers. */ + Bell= 1 1 2 5 15 52 203 877 4140 21147 115975 /*a few Bell " */ + Bern= '1 -1 1 0 -1 0 1 0 -1 0 5 0 -691 0 7 0 -3617' /*" " Bernoulli " */ +Perrin= 3 0 2 3 2 5 5 7 10 12 17 22 29 39 51 68 90 /*" " Perrin " */ +list=Bell Bern Perrin /*throw them all ───► a pot. */ +say 'unsorted =' list /*display what's being shown.*/ +size=words(list) /*nice to have # of elements.*/ + do j=1 for size /*build an array, a single */ + @.j=word(list,j) /* ··· element at a time.*/ + end /*j*/ +call eSort size /*sort the collection of #s. */ +$= /*list: define as null so far*/ + do k=1 for size /*build a list from the array*/ + $=$ @.k /*append a number to the list*/ + end /*k*/ +say ' sorted =' space($) /*display the sorted list. */ +exit /*stick a fork in it, we're all done.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +eSort: procedure expose @.; parse arg N; h=N /*get item count for array. */ + do while h>1; h=h%2 /*partition the array. */ + do i=1 for N-h; j=i; k=h+i + do while @.k<@.j /*keep swapping while less. */ + parse value @.j @.k with @.k @.j /*swap two array elements. */ + if h>=j then leave; j=j-h; k=k-h + end /*while @.k<@.j*/ + end /*i*/ + end /*while h>1*/ + return diff --git a/Task/Sort-disjoint-sublist/APL/sort-disjoint-sublist.apl b/Task/Sort-disjoint-sublist/APL/sort-disjoint-sublist.apl new file mode 100644 index 0000000000..c14b10ccc0 --- /dev/null +++ b/Task/Sort-disjoint-sublist/APL/sort-disjoint-sublist.apl @@ -0,0 +1,6 @@ + ∇SDS[⎕]∇ + ∇ +[0] Z←I SDS L +[1] L[I[⍋I]]←Z[⍋Z←L[I←∪I]] +[2] Z←L + ∇ diff --git a/Task/Sort-disjoint-sublist/AppleScript/sort-disjoint-sublist-1.applescript b/Task/Sort-disjoint-sublist/AppleScript/sort-disjoint-sublist-1.applescript new file mode 100644 index 0000000000..9740101c59 --- /dev/null +++ b/Task/Sort-disjoint-sublist/AppleScript/sort-disjoint-sublist-1.applescript @@ -0,0 +1,87 @@ +use framework "Foundation" -- for basic NSArray sort + +-- disjointSort :: [a] -> [Int] -> [a] +on disjointSort(xs, indices) + + -- Sequence of indices discarded + set indicesSorted to my sort(indices) + + -- valueByIndex :: Int -> a + script valueByIndex + on lambda(i) + item i of xs + end lambda + end script + + set subsetSorted to ¬ + sort(map(valueByIndex, indicesSorted)) + + -- staticOrSorted :: a -> Int -> a + script staticOrSorted + on lambda(x, i) + set iIndex to elemIndex(i, indicesSorted) + if iIndex is missing value then + x + else + item iIndex of subsetSorted + end if + end lambda + end script + + -- Sorted subset re-stitched into unsorted remainder of list + map(staticOrSorted, xs) + +end disjointSort + + +--TEST + +on run + -- The indexing of AppleScript lists is 1-based + -- so we use {7,2,8} in place of {6,1,7} + + disjointSort({7, 6, 5, 4, 3, 2, 1, 0}, {7, 2, 8}) +end run + + + +-- GENERIC FUNCTIONS + +-- sort :: [a] -> [a] +on sort(lst) + ((current application's NSArray's arrayWithArray:lst)'s ¬ + sortedArrayUsingSelector:"compare:") as list +end sort + +-- elemIndex :: a -> [a] -> Maybe Int +on elemIndex(x, xs) + set lng to length of xs + repeat with i from 1 to lng + if x = (item i of xs) then return i + end repeat + return missing value +end elemIndex + +-- 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 + +-- 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 diff --git a/Task/Sort-disjoint-sublist/AppleScript/sort-disjoint-sublist-2.applescript b/Task/Sort-disjoint-sublist/AppleScript/sort-disjoint-sublist-2.applescript new file mode 100644 index 0000000000..f8a5dd94bc --- /dev/null +++ b/Task/Sort-disjoint-sublist/AppleScript/sort-disjoint-sublist-2.applescript @@ -0,0 +1 @@ +{7, 0, 5, 4, 3, 2, 1, 6} diff --git a/Task/Sort-disjoint-sublist/Elixir/sort-disjoint-sublist.elixir b/Task/Sort-disjoint-sublist/Elixir/sort-disjoint-sublist.elixir index 6cb80d02b9..eb7a86c42e 100644 --- a/Task/Sort-disjoint-sublist/Elixir/sort-disjoint-sublist.elixir +++ b/Task/Sort-disjoint-sublist/Elixir/sort-disjoint-sublist.elixir @@ -1,18 +1,17 @@ defmodule Sort_disjoint do def sublist(values, indices) when is_list(values) and is_list(indices) do indices2 = Enum.sort(indices) - selected = select(Enum.with_index(values), indices2, []) - replace(Enum.with_index(values), Enum.zip(indices2, selected), []) + selected = select(values, indices2, 0, []) |> Enum.sort + replace(values, Enum.zip(indices2, selected), 0, []) end - defp select(_, [], selected), do: Enum.sort(selected) - defp select([{val,i}|t], [idx|rest], selected) when i==idx, do: select(t, rest, [val|selected]) - defp select([_|t], indices, selected), do: select(t, indices, selected) + defp select(_, [], _, selected), do: selected + defp select([val|t], [i|rest], i, selected), do: select(t, rest, i+1, [val|selected]) + defp select([_|t], indices, i, selected), do: select(t, indices, i+1, selected) - defp replace([], [], list), do: Enum.reverse(list) - defp replace([{val,_}|t], [], list), do: replace(t, [], [val|list]) - defp replace([{_,idx}|t], [{i,v}|rest], list) when idx==i, do: replace(t, rest, [v|list]) - defp replace([{val,_}|t], indices, list), do: replace(t, indices, [val|list]) + defp replace(values, [], _, list), do: Enum.reverse(list, values) + defp replace([_|t], [{i,v}|rest], i, list), do: replace(t, rest, i+1, [v|list]) + defp replace([val|t], indices, i, list), do: replace(t, indices, i+1, [val|list]) end values = [7, 6, 5, 4, 3, 2, 1, 0] diff --git a/Task/Sort-disjoint-sublist/Io/sort-disjoint-sublist.io b/Task/Sort-disjoint-sublist/Io/sort-disjoint-sublist.io new file mode 100644 index 0000000000..645d2ed2f0 --- /dev/null +++ b/Task/Sort-disjoint-sublist/Io/sort-disjoint-sublist.io @@ -0,0 +1,8 @@ +List disjointSort := method(indices, + sortedIndices := indices unique sortInPlace + sortedValues := sortedIndices map(idx,at(idx)) sortInPlace + sortedValues foreach(i,v,atPut(sortedIndices at(i),v)) + self +) + +list(7,6,5,4,3,2,1,0) disjointSort(list(6,1,7)) println diff --git a/Task/Sort-disjoint-sublist/JavaScript/sort-disjoint-sublist.js b/Task/Sort-disjoint-sublist/JavaScript/sort-disjoint-sublist-1.js similarity index 100% rename from Task/Sort-disjoint-sublist/JavaScript/sort-disjoint-sublist.js rename to Task/Sort-disjoint-sublist/JavaScript/sort-disjoint-sublist-1.js diff --git a/Task/Sort-disjoint-sublist/JavaScript/sort-disjoint-sublist-2.js b/Task/Sort-disjoint-sublist/JavaScript/sort-disjoint-sublist-2.js new file mode 100644 index 0000000000..f85861e89e --- /dev/null +++ b/Task/Sort-disjoint-sublist/JavaScript/sort-disjoint-sublist-2.js @@ -0,0 +1,27 @@ +(function () { + 'use strict'; + + // disjointSort :: [a] -> [Int] -> [a] + function disjointSort(xs, indices) { + + // Sequence of indices discarded + var indicesSorted = indices.sort(), + subsetSorted = indicesSorted + .map(function (i) { + return xs[i]; + }) + .sort(); + + return xs + .map(function (x, i) { + var iIndex = indicesSorted.indexOf(i); + + return iIndex !== -1 ? ( + subsetSorted[iIndex] + ) : x; + }); + } + + return disjointSort([7, 6, 5, 4, 3, 2, 1, 0], [6, 1, 7]) + +})(); diff --git a/Task/Sort-stability/00DESCRIPTION b/Task/Sort-stability/00DESCRIPTION index 031855accf..a83eb6eab9 100644 --- a/Task/Sort-stability/00DESCRIPTION +++ b/Task/Sort-stability/00DESCRIPTION @@ -11,4 +11,6 @@ Similarly, stable sorting on just the first column would generate “UK London #Indicate if an in-built routine is supplied #If supplied, indicate whether or not the in-built routine is stable. +
    (This [[wp:Stable_sort#Comparison_of_algorithms|Wikipedia table]] shows the stability of some common sort routines). +

    diff --git a/Task/Sort-stability/REXX/sort-stability.rexx b/Task/Sort-stability/REXX/sort-stability.rexx index a271c27591..d75d75eb96 100644 --- a/Task/Sort-stability/REXX/sort-stability.rexx +++ b/Task/Sort-stability/REXX/sort-stability.rexx @@ -1,39 +1,24 @@ -/*REXX program sorts an array using a (stable) bubble-sort algorithm.*/ -call gen@ /*generate the array elements. */ -call show@ 'before sort' /*show the before array elements.*/ -call bubbleSort # /*invoke the bubble sort. */ -call show@ ' after sort' /*show the after array elements.*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────BUBBLESORT subroutine───────────────*/ -bubbleSort: procedure expose @.; parse arg n /*N: number of items.*/ - /*diminish # items each time. */ - do until done /*sort until it's done. */ - done=1 /*assume it's done (1 ≡ true). */ - do j=1 for n-1 /*sort M items this time around. */ - k=j+1 /*point to the next item. */ - if @.j>@.k then do /*is it out of order? */ - _=@.j /*assign to a temp variable. */ - @.j=@.k /*swap current item with next ···*/ - @.k=_ /* ··· and the next with _ */ - done=0 /*indicate it's not done, whereas*/ - end /* [↑] 1≡true 0≡false */ - end /*j*/ - end /*until*/ -return -/*──────────────────────────────────GEN@ subroutine─────────────────────*/ -gen@: @. = /*assign default value to all @. */ - @.1 = 'UK London' - @.2 = 'US New York' - @.3 = 'US Birmingham' - @.4 = 'UK Birmingham' - - do #=1 while @.# \=='' /*find how many entries in list. */ - end /*#*/ -#=#-1 /*adjust because of DO increment.*/ -return -/*──────────────────────────────────SHOW@ subroutine────────────────────*/ -show@: do j=1 for # /* [↓] display all list elements*/ - say ' element' right(j,length(#)) arg(1)':' @.j - end /*j*/ -say copies('■',50) /*show a separator line. */ -return +/*REXX program sorts a (stemmed) array using a (stable) bubble─sort algorithm. */ +call gen@ /*generate the array elements (strings)*/ +call show 'before sort' /*show the before array elements. */ + say copies('▒', 50) /*show a separator line between shows. */ +call bubbleSort # /*invoke the bubble sort. */ +call show ' after sort' /*show the after array elements. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +bubbleSort: procedure expose @.; parse arg n; m=n-1 /*N: number of array elements. */ + do m=m for m by -1 until ok; ok=1 /*keep sorting array until done.*/ + do j=1 for m; k=j+1; if @.j<=@.k then iterate /*Not out─of─order?*/ + _=@.j; @.j=@.k; @.k=_; ok=0 /*swap 2 elements; flag as ¬done*/ + end /*j*/ + end /*m*/ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +gen@: @.=; @.1 = 'UK London' + @.2 = 'US New York' + @.3 = 'US Birmingham' + @.4 = 'UK Birmingham' + do #=1 while @.#\==''; end; #=#-1 /*determine how many entries in list. */ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +show: do j=1 for #; say ' element' right(j,length(#)) arg(1)":" @.j; end; return diff --git a/Task/Sort-using-a-custom-comparator/00DESCRIPTION b/Task/Sort-using-a-custom-comparator/00DESCRIPTION index ba874d5a10..b47199edea 100644 --- a/Task/Sort-using-a-custom-comparator/00DESCRIPTION +++ b/Task/Sort-using-a-custom-comparator/00DESCRIPTION @@ -1,4 +1,10 @@ {{omit from|BBC BASIC}} -Sort an array (or list) of strings in order of descending length, and in ascending lexicographic order for strings of equal length. Use a sorting facility provided by the language/library, combined with your own callback comparison function. -'''Note:''' Lexicographic order is case-insensitive. +;Task: +Sort an array (or list) of strings in order of descending length, and in ascending lexicographic order for strings of equal length. + +Use a sorting facility provided by the language/library, combined with your own callback comparison function. + + +'''Note:'''   Lexicographic order is case-insensitive. +

    diff --git a/Task/Sort-using-a-custom-comparator/Babel/sort-using-a-custom-comparator-1.pb b/Task/Sort-using-a-custom-comparator/Babel/sort-using-a-custom-comparator-1.pb new file mode 100644 index 0000000000..a322db67b3 --- /dev/null +++ b/Task/Sort-using-a-custom-comparator/Babel/sort-using-a-custom-comparator-1.pb @@ -0,0 +1,4 @@ +babel> ("Here" "are" "some" "sample" "strings" "to" "be" "sorted") strsort ! lsstr ! +( "Here" "are" "be" "sample" "some" "sorted" "strings" "to" ) +babel> ("Here" "are" "some" "sample" "strings" "to" "be" "sorted") lexsort ! lsstr ! +( "be" "to" "are" "Here" "some" "sample" "sorted" "strings" ) diff --git a/Task/Sort-using-a-custom-comparator/Babel/sort-using-a-custom-comparator-2.pb b/Task/Sort-using-a-custom-comparator/Babel/sort-using-a-custom-comparator-2.pb new file mode 100644 index 0000000000..5a791c3bd4 --- /dev/null +++ b/Task/Sort-using-a-custom-comparator/Babel/sort-using-a-custom-comparator-2.pb @@ -0,0 +1,4 @@ +babel> ("Here" "are" "some" "sample" "strings" "to" "be" "sorted") {str2ar} over ! {strcmp 0 lt?} lssort ! {ar2str} over ! lsstr ! +( "Here" "are" "be" "some" "sample" "sorted" "strings" "to" ) +babel> ("Here" "are" "some" "sample" "strings" "to" "be" "sorted") {str2ar} over ! {arcmp 0 lt?} lssort ! {ar2str} over ! lsstr ! +( "be" "to" "are" "Here" "some" "sample" "sorted" "strings" ) diff --git a/Task/Sort-using-a-custom-comparator/Babel/sort-using-a-custom-comparator-3.pb b/Task/Sort-using-a-custom-comparator/Babel/sort-using-a-custom-comparator-3.pb new file mode 100644 index 0000000000..16192dcefd --- /dev/null +++ b/Task/Sort-using-a-custom-comparator/Babel/sort-using-a-custom-comparator-3.pb @@ -0,0 +1,2 @@ +babel> ( 5 6 8 4 5 3 9 9 4 9 ) {lt?} lssort ! lsnum ! +( 3 4 4 5 5 6 8 9 9 9 ) diff --git a/Task/Sort-using-a-custom-comparator/Babel/sort-using-a-custom-comparator-4.pb b/Task/Sort-using-a-custom-comparator/Babel/sort-using-a-custom-comparator-4.pb new file mode 100644 index 0000000000..ec1eaaf19c --- /dev/null +++ b/Task/Sort-using-a-custom-comparator/Babel/sort-using-a-custom-comparator-4.pb @@ -0,0 +1,2 @@ +babel> (1 2 3 4 5 6 7 8 9) {1 randlf 2 rem} lssort ! lsnum ! +( 7 5 9 6 2 4 3 1 8 ) diff --git a/Task/Sort-using-a-custom-comparator/Babel/sort-using-a-custom-comparator-5.pb b/Task/Sort-using-a-custom-comparator/Babel/sort-using-a-custom-comparator-5.pb new file mode 100644 index 0000000000..9ee2ab6f79 --- /dev/null +++ b/Task/Sort-using-a-custom-comparator/Babel/sort-using-a-custom-comparator-5.pb @@ -0,0 +1,24 @@ +babel> 20 lsrange ! {1 randlf 2 rem} lssort ! 2 group ! --> this creates a shuffled list of pairs +babel> dup {lsnum !} ... --> display the shuffled list, pair-by-pair +( 11 10 ) +( 15 13 ) +( 12 16 ) +( 17 3 ) +( 14 5 ) +( 4 19 ) +( 18 9 ) +( 1 7 ) +( 8 6 ) +( 0 2 ) +babel> {<- car -> car lt? } lssort ! --> sort the list by first element of each pair +babel> dup {lsnum !} ... --> display the sorted list, pair-by-pair +( 0 2 ) +( 1 7 ) +( 4 19 ) +( 8 6 ) +( 11 10 ) +( 12 16 ) +( 14 5 ) +( 15 13 ) +( 17 3 ) +( 18 9 ) diff --git a/Task/Sort-using-a-custom-comparator/Common-Lisp/sort-using-a-custom-comparator-1.lisp b/Task/Sort-using-a-custom-comparator/Common-Lisp/sort-using-a-custom-comparator-1.lisp index 77e6ae6111..374da878d9 100644 --- a/Task/Sort-using-a-custom-comparator/Common-Lisp/sort-using-a-custom-comparator-1.lisp +++ b/Task/Sort-using-a-custom-comparator/Common-Lisp/sort-using-a-custom-comparator-1.lisp @@ -1,5 +1,5 @@ CL-USER> (defvar *strings* - '("Cat" "apple" "Adam" "zero" "Xmas" "quit" "Level" "add" "Actor" "base" "butter")) + (list "Cat" "apple" "Adam" "zero" "Xmas" "quit" "Level" "add" "Actor" "base" "butter")) *STRINGS* CL-USER> (sort *strings* #'string-lessp) ("Actor" "Adam" "add" "apple" "base" "butter" "Cat" "Level" "quit" "Xmas" diff --git a/Task/Sort-using-a-custom-comparator/Common-Lisp/sort-using-a-custom-comparator-2.lisp b/Task/Sort-using-a-custom-comparator/Common-Lisp/sort-using-a-custom-comparator-2.lisp index 4a00687f6c..98b0b2d6fb 100644 --- a/Task/Sort-using-a-custom-comparator/Common-Lisp/sort-using-a-custom-comparator-2.lisp +++ b/Task/Sort-using-a-custom-comparator/Common-Lisp/sort-using-a-custom-comparator-2.lisp @@ -1,5 +1,5 @@ CL-USER> (defvar *strings* - '("Cat" "apple" "Adam" "zero" "Xmas" "quit" "Level" "add" "Actor" "base" "butter")) + (list "Cat" "apple" "Adam" "zero" "Xmas" "quit" "Level" "add" "Actor" "base" "butter")) *STRINGS* CL-USER> (sort *strings* #'> :key #'length) ("butter" "apple" "Level" "Actor" "Adam" "zero" "Xmas" "quit" "base" diff --git a/Task/Sort-using-a-custom-comparator/Elixir/sort-using-a-custom-comparator.elixir b/Task/Sort-using-a-custom-comparator/Elixir/sort-using-a-custom-comparator.elixir new file mode 100644 index 0000000000..cce8930eaa --- /dev/null +++ b/Task/Sort-using-a-custom-comparator/Elixir/sort-using-a-custom-comparator.elixir @@ -0,0 +1,9 @@ +strs = ~w[this is a set of strings to sort This Is A Set Of Strings To Sort] + +comparator = fn s1,s2 -> if String.length(s1)==String.length(s2), + do: String.downcase(s1) <= String.downcase(s2), + else: String.length(s1) >= String.length(s2) end +IO.inspect Enum.sort(strs, comparator) + +# or +IO.inspect Enum.sort_by(strs, fn str -> {-String.length(str), String.downcase(str)} end) diff --git a/Task/Sort-using-a-custom-comparator/Kotlin/sort-using-a-custom-comparator.kotlin b/Task/Sort-using-a-custom-comparator/Kotlin/sort-using-a-custom-comparator.kotlin new file mode 100644 index 0000000000..7644b4a8b1 --- /dev/null +++ b/Task/Sort-using-a-custom-comparator/Kotlin/sort-using-a-custom-comparator.kotlin @@ -0,0 +1,22 @@ +import java.util.Arrays + +fun main(args: Array) { + val strings = arrayOf("Here", "are", "some", "sample", "strings", "to", "be", "sorted") + + fun printArray(message: String, array: Array) = with(array) { + print("$message [") + forEachIndexed { index, string -> + print(if (index == lastIndex) string else "$string, ") + } + println("]") + } + + printArray("Unsorted:", strings) + + Arrays.sort(strings) { first, second -> + val lengthDifference = second.length - first.length + if (lengthDifference == 0) first.compareTo(second, true) else lengthDifference + } + + printArray("Sorted:", strings) +} diff --git a/Task/Sorting-algorithms-Bead-sort/00DESCRIPTION b/Task/Sorting-algorithms-Bead-sort/00DESCRIPTION index 8d8f32597a..aa3b977b24 100644 --- a/Task/Sorting-algorithms-Bead-sort/00DESCRIPTION +++ b/Task/Sorting-algorithms-Bead-sort/00DESCRIPTION @@ -1,5 +1,10 @@ {{Sorting Algorithm}} -In this task, the goal is to sort an array of positive integers using the [[wp:Bead_sort|Bead Sort Algorithm]]. -Algorithm has O(S), where S is the sum of the integers in the input set: Each bead is moved individually. +;Task: +Sort an array of positive integers using the [[wp:Bead_sort|Bead Sort Algorithm]]. + + +Algorithm has   O(S),   where   S   is the sum of the integers in the input set:   Each bead is moved individually. + This is the case when bead sort is implemented without a mechanism to assist in finding empty spaces below the beads, such as in software implementations. +

    diff --git a/Task/Sorting-algorithms-Bead-sort/360-Assembly/sorting-algorithms-bead-sort.360 b/Task/Sorting-algorithms-Bead-sort/360-Assembly/sorting-algorithms-bead-sort.360 new file mode 100644 index 0000000000..ba3de1c2c4 --- /dev/null +++ b/Task/Sorting-algorithms-Bead-sort/360-Assembly/sorting-algorithms-bead-sort.360 @@ -0,0 +1,99 @@ +* Bead Sort 11/05/2016 +BEADSORT CSECT + USING BEADSORT,R13 base register +SAVEAR B STM-SAVEAR(R15) skip savearea + DC 17F'0' savearea +STM STM R14,R12,12(R13) prolog + ST R13,4(R15) " + ST R15,8(R13) " + LR R13,R15 " + LA R6,1 i=1 +LOOPI1 CH R6,=AL2(N) do i=1 to hbound(z) + BH ELOOPI1 leave i + LR R1,R6 i + SLA R1,1 <<1 + LH R2,Z-2(R1) z(i) + CH R2,LO if z(i)hi + BNH EIHHI then + STH R2,HI hi=z(i) +EIHHI LA R6,1(R6) iterate i + B LOOPI1 next i +ELOOPI1 LA R9,1 1 + SH R9,LO -lo+1 + LA R6,1 i=1 +LOOPI2 CH R6,=AL2(N) do i=1 to hbound(z) + BH ELOOPI2 leave i + LR R1,R6 i + SLA R1,1 <<1 + LH R3,Z-2(R1) z(i) + AR R3,R9 z(i)+o + IC R2,BEADS-1(R3) beads(l) + LA R2,1(R2) beads(l)+1 + STC R2,BEADS-1(R3) beads(l)=beads(l)+1 + LA R6,1(R6) iterate i + B LOOPI2 next i +ELOOPI2 SR R8,R8 k=0 + LH R6,LO i=lo +LOOPI3 CH R6,HI do i=lo to hi + BH ELOOPI3 leave i + LA R7,1 j=1 + SR R10,R10 clear r10 + LR R1,R6 i + AR R1,R9 i+o + IC R10,BEADS-1(R1) beads(i+o) +LOOPJ3 CR R7,R10 do j=1 to beads(i+o) + BH ELOOPJ3 leave j + LA R8,1(R8) k=k+1 + LR R1,R8 k + SLA R1,1 <<1 + STH R6,S-2(R1) s(k)=i + LA R7,1(R7) iterate j + B LOOPJ3 next j +ELOOPJ3 AH R6,=H'1' iterate i + B LOOPI3 next i +ELOOPI3 LA R7,1 j=1 +LOOPJ4 CH R7,=H'2' do j=1 to 2 + BH ELOOPJ4 leave j + CH R7,=H'1' if j<>1 + BE ONE then + MVC PG(7),=C'sorted:' zap +ONE LA R10,PG+7 pgi=@pg+7 + LA R6,1 i=1 +LOOPI4 CH R6,=AL2(N) do i=1 to hbound(z) + BH ELOOPI4 leave i + CH R7,=H'1' if j=1 + BNE TWO then + LR R1,R6 i + SLA R1,1 <<1 + LH R11,Z-2(R1) zs=z(i) + B XDECO else +TWO LR R1,R6 i + SLA R1,1 <<1 + LH R11,S-2(R1) zs=s(i) +XDECO XDECO R11,XDEC edit zs + MVC 0(6,R10),XDEC+6 output zs + LA R10,6(R10) pgi=pgi+6 + LA R6,1(R6) iterate i + B LOOPI4 next i +ELOOPI4 XPRNT PG,80 print buffer + LA R7,1(R7) iterate j + B LOOPJ4 next j +ELOOPJ4 L R13,4(0,R13) epilog + LM R14,R12,12(R13) " + XR R15,R15 " + BR R14 " + LTORG literal table +N EQU (S-Z)/2 number of items +Z DC H'5',H'3',H'1',H'7',H'-1',H'4',H'9',H'-12' + DC H'2001',H'-2010',H'17',H'0' +S DS (N)H s same size as z +LO DC H'32767' 2**31-1 +HI DC H'-32768' -2**31 +PG DC CL80' raw:' buffer +XDEC DS CL12 temp +BEADS DC 4096X'00' beads + YREGS + END BEADSORT diff --git a/Task/Sorting-algorithms-Bead-sort/COBOL/sorting-algorithms-bead-sort.cobol b/Task/Sorting-algorithms-Bead-sort/COBOL/sorting-algorithms-bead-sort.cobol new file mode 100644 index 0000000000..0b95bcd41d --- /dev/null +++ b/Task/Sorting-algorithms-Bead-sort/COBOL/sorting-algorithms-bead-sort.cobol @@ -0,0 +1,98 @@ + >>SOURCE FORMAT FREE +*> This code is dedicated to the public domain +*> This is GNUCOBOL 2.0 +identification division. +program-id. beadsort. +environment division. +configuration section. +repository. function all intrinsic. +data division. +working-storage section. +01 filler. + 03 row occurs 9 pic x(9). + 03 r pic 99. + 03 r1 pic 99. + 03 r2 pic 99. + 03 pole pic 99. + 03 a-lim pic 99 value 9. + 03 a pic 99. + 03 array occurs 9 pic 9. +01 NL pic x value x'0A'. +procedure division. +start-beadsort. + + *> fill the array + compute a = random(seconds-past-midnight) + perform varying a from 1 by 1 until a > a-lim + compute array(a) = random() * 10 + end-perform + + perform display-array + display space 'initial array' + + *> distribute the beads + perform varying r from 1 by 1 until r > a-lim + move all '.' to row(r) + perform varying pole from 1 by 1 until pole > array(r) + move 'o' to row(r)(pole:1) + end-perform + end-perform + display NL 'initial beads' + perform display-beads + + *> drop the beads + perform varying pole from 1 by 1 until pole > a-lim + move a-lim to r2 + perform find-opening + compute r1 = r2 - 1 + perform find-bead + perform until r1 = 0 *> no bead or no opening + *> drop the bead + move '.' to row(r1)(pole:1) + move 'o' to row(r2)(pole:1) + *> continue up the pole + compute r2 = r2 - 1 + perform find-opening + compute r1 = r2 - 1 + perform find-bead + end-perform + end-perform + display NL 'dropped beads' + perform display-beads + + *> count the beads in each row + perform varying r from 1 by 1 until r > a-lim + move 0 to array(r) + inspect row(r) tallying array(r) + for all 'o' before initial '.' + end-perform + + perform display-array + display space 'sorted array' + + stop run + . +find-opening. + perform varying r2 from r2 by -1 + until r2 = 1 or row(r2)(pole:1) = '.' + continue + end-perform + . +find-bead. + perform varying r1 from r1 by -1 + until r1 = 0 or row(r1)(pole:1) = 'o' + continue + end-perform + . +display-array. + display space + perform varying a from 1 by 1 until a > a-lim + display space array(a) with no advancing + end-perform + . +display-beads. + perform varying r from 1 by 1 until r > a-lim + display row(r) + end-perform + . +end program beadsort. diff --git a/Task/Sorting-algorithms-Bead-sort/Lua/sorting-algorithms-bead-sort.lua b/Task/Sorting-algorithms-Bead-sort/Lua/sorting-algorithms-bead-sort.lua new file mode 100644 index 0000000000..b89d7e3d32 --- /dev/null +++ b/Task/Sorting-algorithms-Bead-sort/Lua/sorting-algorithms-bead-sort.lua @@ -0,0 +1,37 @@ +-- Display message followed by all values of a table in one line +function show (msg, t) + io.write(msg .. ":\t") + for _, v in pairs(t) do io.write(v .. " ") end + print() +end + +-- Return a table of random numbers +function randList (length, lo, hi) + local t = {} + for i = 1, length do table.insert(t, math.random(lo, hi)) end + return t +end + +-- Count instances of numbers that appear in counting to each list value +function tally (list) + local tal = {} + for k, v in pairs(list) do + for i = 1, v do + if tal[i] then tal[i] = tal[i] + 1 else tal[i] = 1 end + end + end + return tal +end + +-- Sort a table of positive integers into descending order +function beadSort (numList) + show("Before sort", numList) + local abacus = tally(numList) + show("Tally list", abacus) + local sorted = tally(abacus) + show("After sort", sorted) +end + +-- Main procedure +math.randomseed(os.time()) +beadSort(randList(10, 1, 10)) diff --git a/Task/Sorting-algorithms-Bead-sort/Perl-6/sorting-algorithms-bead-sort-1.pl6 b/Task/Sorting-algorithms-Bead-sort/Perl-6/sorting-algorithms-bead-sort-1.pl6 index 253f609287..e9b328d7c2 100644 --- a/Task/Sorting-algorithms-Bead-sort/Perl-6/sorting-algorithms-bead-sort-1.pl6 +++ b/Task/Sorting-algorithms-Bead-sort/Perl-6/sorting-algorithms-bead-sort-1.pl6 @@ -1,4 +1,15 @@ -use List::Utils; +# routine cribbed from List::Utils; +sub transpose(@list is copy) { + gather { + while @list { + my @heads; + if @list[0] !~~ Positional { @heads = @list.shift; } + else { @heads = @list.map({$_.shift unless $_ ~~ []}); } + @list = @list.map({$_ unless $_ ~~ []}); + take [@heads]; + } + } +} sub beadsort(@l) { (transpose(transpose(map {[1 xx $_]}, @l))).map(*.elems); diff --git a/Task/Sorting-algorithms-Bead-sort/Perl-6/sorting-algorithms-bead-sort-2.pl6 b/Task/Sorting-algorithms-Bead-sort/Perl-6/sorting-algorithms-bead-sort-2.pl6 index ba0fab6fc9..3098de81f2 100644 --- a/Task/Sorting-algorithms-Bead-sort/Perl-6/sorting-algorithms-bead-sort-2.pl6 +++ b/Task/Sorting-algorithms-Bead-sort/Perl-6/sorting-algorithms-bead-sort-2.pl6 @@ -1,6 +1,6 @@ sub beadsort(*@list) { my @rods; - for ^«@list -> $x { @rods[$x].push(1) } + for words ^«@list -> $x { @rods[$x].push(1) } gather for ^@rods[0] -> $y { take [+] @rods.map: { .[$y] // last } } diff --git a/Task/Sorting-algorithms-Bead-sort/REXX/sorting-algorithms-bead-sort.rexx b/Task/Sorting-algorithms-Bead-sort/REXX/sorting-algorithms-bead-sort.rexx index a3b495889d..43ff05770e 100644 --- a/Task/Sorting-algorithms-Bead-sort/REXX/sorting-algorithms-bead-sort.rexx +++ b/Task/Sorting-algorithms-Bead-sort/REXX/sorting-algorithms-bead-sort.rexx @@ -1,46 +1,44 @@ -/*REXX program sorts a list of integers using a bead sort algorithm.*/ -grasshopper=, /*get 2 dozen grasshopper numbers*/ -1 4 10 12 22 26 30 46 54 62 66 78 94 110 126 134 138 158 162 186 190 222 254 270 +/*REXX program sorts a list of integers using the bead sort algorithm. */ +grasshopper=, /*define two dozen grasshopper numbers.*/ + 1 4 10 12 22 26 30 46 54 62 66 78 94 110 126 134 138 158 162 186 190 222 254 270 - /*Green Grocer numbers are also */ -greenGrocer=, /*called hexagonal pyramidal nums*/ -0 4 16 40 80 140 224 336 480 660 880 1144 1456 1820 2240 2720 3264 3876 4560 + /*Green Grocer numbers are also called hexagonal pyramidal numbers.*/ +greenGrocer= 0 4 16 40 80 140 224 336 480 660 880 1144 1456 1820 2240 2720 3264 3876 4560 - /*get 23 Bernoulli numerator nums*/ -bernN='1 -1 1 0 -1 0 1 0 -1 0 5 0 -691 0 7 0 -3617 0 43867 0 -174611 0 854513' + /*define 23 Bernoulli numerator numbers*/ +bernN= '1 -1 1 0 -1 0 1 0 -1 0 5 0 -691 0 7 0 -3617 0 43867 0 -174611 0 854513' - /*Psi is also called the Reduced Totient function, and is*/ -psi=, /*also called Carmichale lambda, or the LAMBDA function.*/ -1 1 2 2 4 2 6 2 6 4 10 2 12 6 4 4 16 6 18 4 6 10 22 2 20 12 18 6 28 4 30 8 10 16 + /*Psi is also called the Reduced Totient function, and is*/ +psi=, /*also called Carmichael lambda, or the LAMBDA function.*/ + 1 1 2 2 4 2 6 2 6 4 10 2 12 6 4 4 16 6 18 4 6 10 22 2 20 12 18 6 28 4 30 8 10 16 -#s=grasshopper greenGrocer bernN psi /*combine the four lists into one*/ -call show 'before sort', #s /*show the list before sorting.*/ -call show ' after sort', beadSort(#s) /*show the list after sorting.*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────SHOW@ subroutine────────────────────*/ -beadSort: procedure; parse arg low . 1 high . 1 z,$ /*$: the list to be*/ -@.=0 /*set all beads (@.) to zero. */ - do j=1 until z==''; parse var z x z /*pick the meat off the bone.*/ - if \datatype(x,'W') then do; say '*** error! ***' - say 'element' j "in list isn't numeric:" x - say; exit 13 - end /* [↑] exit program with RC=13. */ - x=x/1 /*normalize X: 4. 004 +4 .4e0 ···*/ - @.x=@.x+1 /*indicate this bead has a number*/ - low=min(low,x); high=max(high,x) /*track the lowest & highest num.*/ - end /*j*/ - /* [↓] now, collect the beads and*/ - do m=low to high /*let them fall (to zero). */ - if @.m\==0 then do n=1 for @.m /*have we found a bead here? */ - $=$ m /*add it to the sorted list. */ - end /*n*/ /* [↑] let beads fall to zero. */ - end /*m*/ +#= grasshopper greenGrocer bernN psi /*combine the four lists into one list.*/ +call show 'before sort', # /*display the list before sorting. */ +call show ' after sort', beadSort(#) /* " " " after " */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +beadSort: procedure; parse arg low . 1 high . 1 z,$ /*$: the list to be sorted. */ + @.=0 /*set all beads (@.) to zero.*/ + do j=1 until z==''; parse var z x z /*pick the meat off the bone.*/ + if \datatype(x, 'W') then do; say '***error***' + say 'element' j "in list isn't numeric:" x + say; exit 13 + end /* [↑] exit pgm with RC=13. */ + x=x/1 /*normalize: 4. 004 +4 .4e0 */ + @.x=@.x+1 /*indicate this bead has a #.*/ + low=min(low,x); high=max(high,x) /*track lowest and highest #.*/ + end /*j*/ + /* [↓] now, collect beads and*/ + do m=low to high /*let them fall (to zero). */ + if @.m\==0 then do n=1 for @.m; $=$ m /*have we found a bead here? */ + end /*n*/ /* [↑] add it to sorted list*/ + end /*m*/ -return $ -/*──────────────────────────────────SHOW subroutine─────────────────────*/ + return $ +/*──────────────────────────────────────────────────────────────────────────────────────*/ show: parse arg txt,y; _=left('', 20) -w=length(words(y)); do k=1 for words(y) /* [↑] twenty blanks.*/ - say _ 'element' right(k,w) txt":" right(word(y,k),9) - end /*k*/ -say copies('─',70) /*show a long separator line. */ -return + w=length(words(y)); do k=1 for words(y) /* [↑] twenty pad blanks. */ + say _ 'element' right(k, w) txt":" right(word(y, k), 9) + end /*k*/ + say copies('─', 70) /*show a long separator line.*/ + return diff --git a/Task/Sorting-algorithms-Bogosort/00DESCRIPTION b/Task/Sorting-algorithms-Bogosort/00DESCRIPTION index 7d540766c6..9647faf54c 100644 --- a/Task/Sorting-algorithms-Bogosort/00DESCRIPTION +++ b/Task/Sorting-algorithms-Bogosort/00DESCRIPTION @@ -1,13 +1,23 @@ {{Sorting Algorithm}} + +;Task: [[wp:Bogosort|Bogosort]] a list of numbers. + + Bogosort simply shuffles a collection randomly until it is sorted. "Bogosort" is a perversely inefficient algorithm only used as an in-joke. -Its average run-time is O(n!) because the chance that any given shuffle of a set will end up in sorted order is about one in ''n'' factorial, and the worst case is infinite since there's no guarantee that a random shuffling will ever produce a sorted sequence. Its best case is O(n) since a single pass through the elements may suffice to order them. + +Its average run-time is   O(n!)   because the chance that any given shuffle of a set will end up in sorted order is about one in   ''n''   factorial,   and the worst case is infinite since there's no guarantee that a random shuffling will ever produce a sorted sequence. + +Its best case is   O(n)   since a single pass through the elements may suffice to order them. + Pseudocode: '''while not''' InOrder(list) '''do''' Shuffle(list) '''done''' +
    The [[Knuth shuffle]] may be used to implement the shuffle part of this algorithm. +

    diff --git a/Task/Sorting-algorithms-Bogosort/COBOL/sorting-algorithms-bogosort.cobol b/Task/Sorting-algorithms-Bogosort/COBOL/sorting-algorithms-bogosort.cobol new file mode 100644 index 0000000000..5a8e971e8a --- /dev/null +++ b/Task/Sorting-algorithms-Bogosort/COBOL/sorting-algorithms-bogosort.cobol @@ -0,0 +1,65 @@ +identification division. +program-id. bogo-sort-program. +data division. +working-storage section. +01 array-to-sort. + 05 item-table. + 10 item pic 999 + occurs 10 times. +01 randomization. + 05 random-seed pic 9(8). + 05 random-index pic 9. +01 flags-counters-etc. + 05 array-index pic 99. + 05 adjusted-index pic 99. + 05 temporary-storage pic 999. + 05 shuffles pic 9(8) + value zero. + 05 sorted pic 9. +01 numbers-without-leading-zeros. + 05 item-no-zeros pic z(4). + 05 shuffles-no-zeros pic z(8). +procedure division. +control-paragraph. + accept random-seed from time. + move function random(random-seed) to item(1). + perform random-item-paragraph varying array-index from 2 by 1 + until array-index is greater than 10. + display 'BEFORE SORT:' with no advancing. + perform show-array-paragraph varying array-index from 1 by 1 + until array-index is greater than 10. + display ''. + perform shuffle-paragraph through is-it-sorted-paragraph + until sorted is equal to 1. + display 'AFTER SORT: ' with no advancing. + perform show-array-paragraph varying array-index from 1 by 1 + until array-index is greater than 10. + display ''. + move shuffles to shuffles-no-zeros. + display shuffles-no-zeros ' SHUFFLES PERFORMED.' + stop run. +random-item-paragraph. + move function random to item(array-index). +show-array-paragraph. + move item(array-index) to item-no-zeros. + display item-no-zeros with no advancing. +shuffle-paragraph. + perform shuffle-items-paragraph, + varying array-index from 1 by 1 + until array-index is greater than 10. + add 1 to shuffles. +is-it-sorted-paragraph. + move 1 to sorted. + perform item-in-order-paragraph varying array-index from 1 by 1, + until sorted is equal to zero + or array-index is equal to 10. +shuffle-items-paragraph. + move function random to random-index. + add 1 to random-index giving adjusted-index. + move item(array-index) to temporary-storage. + move item(adjusted-index) to item(array-index). + move temporary-storage to item(adjusted-index). +item-in-order-paragraph. + add 1 to array-index giving adjusted-index. + if item(array-index) is greater than item(adjusted-index) + then move zero to sorted. diff --git a/Task/Sorting-algorithms-Bogosort/R/sorting-algorithms-bogosort.r b/Task/Sorting-algorithms-Bogosort/R/sorting-algorithms-bogosort.r index 8887b22d26..f6ab4450ea 100644 --- a/Task/Sorting-algorithms-Bogosort/R/sorting-algorithms-bogosort.r +++ b/Task/Sorting-algorithms-Bogosort/R/sorting-algorithms-bogosort.r @@ -1,9 +1,7 @@ -bogosort <- function(x) -{ - is.sorted <- function(x) all(diff(x) >= 0) - while(!is.sorted(x)) x <- sample(x) +bogosort <- function(x) { + while(is.unsorted(x)) x <- sample(x) x } n <- c(1, 10, 9, 7, 3, 0) -print(bogosort(n)) +bogosort(n) diff --git a/Task/Sorting-algorithms-Bogosort/Rust/sorting-algorithms-bogosort.rust b/Task/Sorting-algorithms-Bogosort/Rust/sorting-algorithms-bogosort.rust new file mode 100644 index 0000000000..7c58adea57 --- /dev/null +++ b/Task/Sorting-algorithms-Bogosort/Rust/sorting-algorithms-bogosort.rust @@ -0,0 +1,24 @@ +extern crate rand; + +use rand::{thread_rng, Rng}; +use std::vec::Vec; + +fn sorted(curlist: &Vec) -> bool { + let mut sortedlist = curlist.clone(); + sortedlist.sort(); + curlist.iter().eq(sortedlist.iter()) +} + +fn sort(curlist: &Vec) -> Vec { + let mut result = curlist.clone(); + while !sorted(&result) { + let mut rng = thread_rng(); + rng.shuffle(&mut result); + } + result +} + +fn main() { + let mut testlist = vec![1,55,88,24,990876,312,67,0,854,13,4,7]; + println!("{:?}", sort(&mut testlist)) +} diff --git a/Task/Sorting-algorithms-Bubble-sort/00DESCRIPTION b/Task/Sorting-algorithms-Bubble-sort/00DESCRIPTION index 2406e612a1..bd0feca745 100644 --- a/Task/Sorting-algorithms-Bubble-sort/00DESCRIPTION +++ b/Task/Sorting-algorithms-Bubble-sort/00DESCRIPTION @@ -1,15 +1,19 @@ {{Sorting Algorithm}} -In this task, the goal is to sort an array of elements using the bubble sort algorithm. The elements must have a total order and the index of the array can be of any discrete type. For languages where this is not possible, sort an array of integers. + +;Task: +Sort an array of elements using the bubble sort algorithm.   The elements must have a total order and the index of the array can be of any discrete type.   For languages where this is not possible, sort an array of integers. The bubble sort is generally considered to be the simplest sorting algorithm. + Because of its simplicity and ease of visualization, it is often taught in introductory computer science courses. + Because of its abysmal O(n2) performance, it is not used often for large (or even medium-sized) datasets. -The bubble sort works by passing sequentially over a list, comparing each value to the one immediately after it. If the first value is greater than the second, their positions are switched. Over a number of passes, at most equal to the number of elements in the list, all of the values drift into their correct positions (large values "bubble" rapidly toward the end, pushing others down around them). -Because each pass finds the maximum item and puts it at the end, the portion of the list to be sorted can be reduced at each pass. +The bubble sort works by passing sequentially over a list, comparing each value to the one immediately after it.   If the first value is greater than the second, their positions are switched.   Over a number of passes, at most equal to the number of elements in the list, all of the values drift into their correct positions (large values "bubble" rapidly toward the end, pushing others down around them).   +Because each pass finds the maximum item and puts it at the end, the portion of the list to be sorted can be reduced at each pass.   A boolean variable is used to track whether any changes have been made in the current pass; when a pass completes without changing anything, the algorithm exits. -This can be expressed in pseudocode as follows (assuming 1-based indexing): +This can be expressed in pseudo-code as follows (assuming 1-based indexing): '''repeat''' hasChanged := false '''decrement''' itemCount @@ -19,6 +23,8 @@ This can be expressed in pseudocode as follows (assuming 1-based indexing): hasChanged := true '''until''' hasChanged = '''false''' + ;References: * The article on [[wp:Bubble_sort|Wikipedia]]. * Dance [http://www.youtube.com/watch?v=lyZQPjUT5B4&feature=youtu.be interpretation]. +

    diff --git a/Task/Sorting-algorithms-Bubble-sort/360-Assembly/sorting-algorithms-bubble-sort.360 b/Task/Sorting-algorithms-Bubble-sort/360-Assembly/sorting-algorithms-bubble-sort.360 index 851ce1fd54..45b205db90 100644 --- a/Task/Sorting-algorithms-Bubble-sort/360-Assembly/sorting-algorithms-bubble-sort.360 +++ b/Task/Sorting-algorithms-Bubble-sort/360-Assembly/sorting-algorithms-bubble-sort.360 @@ -1,83 +1,59 @@ -* Bubble Sort +* Bubble Sort 01/11/2014 & 23/06/2016 BUBBLE CSECT - USING BUBBLE,R13,R12 -SAVEAREA B STM-SAVEAREA(R15) skip savearea - DC 17F'0' - DC CL8'BUBBLE' -STM STM R14,R12,12(R13) save calling context - ST R13,4(R15) - ST R15,8(R13) - LR R13,R15 set addessability - LA R12,4095(R13) - LA R12,1(R12) -MORE EQU * - LA R8,0 R8=no more - LA R1,A R1=Addr(A(I)) - LA R2,2(R1) R2=Addr(A(I+1)) - LA R4,0 to start at 1 - LA R6,1 increment - L R7,N R7=N - BCTR R7,0 R7=N-1 -LOOP BXH R4,R6,ENDLOOP for R4=1 to N-1 - LH R3,0(R1) R3=A(I) - CH R3,0(R2) A(I)::A(I+1) - BNH NOSWAP if A(I)<=A(I+1) then goto NOSWAP - LH R9,0(R1) R9=A(I) - LH R3,0(R2) R3=A(I+1) - STH R3,0(R1) A(I)=R3 - STH R9,0(R2) A(I+1)=R9 - LA R8,1 R8=more -NOSWAP EQU * - LA R1,2(R1) next A(I) - LA R2,2(R2) next A(I+1) - B LOOP -ENDLOOP EQU * - LTR R8,R8 - BNZ MORE - LA R3,A R3=Addr(A(I)) - LA R4,0 to start at 1 - LA R6,1 increment - L R7,N -PRNT BXH R4,R6,ENDPRNT for R4=1 to N - LH R5,0(R3) R5=A(I) - CVD R4,P Store I to packed P - UNPK Z,P Z=P - MVC C,Z C=Z - OI C+L'C-1,X'F0' ZAP SIGN - MVC BUFFER(4),C+12 - CVD R5,P Store A(I) to packed P - UNPK Z,P Z=P - MVC C,Z C=Z - OI C+L'C-1,X'F0' ZAP SIGN - MVC BUFFER+10(6),C+10 - WTO MF=(E,WTOMSG) - LA R3,2(R3) next A(I) - B PRNT -ENDPRNT EQU * - CNOP 0,4 - L R13,4(0,R13) - LM R14,R12,12(R13) restore context - XR R15,R15 set return code to 0 - BR R14 return to caller -N DC A((AEND-A)/2) number of items in A, so N=F'80' -A DC H'223',H'356',H'018',H'820',H'664',H'845',H'927',H'198' 8 - DC H'261',H'802',H'523',H'982',H'242',H'192',H'913',H'230' 16 - DC H'353',H'565',H'195',H'174',H'665',H'807',H'050',H'539' 24 - DC H'436',H'249',H'848',H'010',H'006',H'794',H'100',H'433' 32 - DC H'782',H'728',H'259',H'358',H'206',H'081',H'701',H'997' 40 - DC H'880',H'520',H'780',H'293',H'861',H'942',H'735',H'091' 48 - DC H'503',H'582',H'716',H'836',H'135',H'653',H'856',H'142' 56 - DC H'919',H'498',H'303',H'894',H'536',H'211',H'539',H'986' 64 - DC H'356',H'796',H'644',H'552',H'771',H'443',H'035',H'780' 72 - DC H'474',H'278',H'332',H'949',H'351',H'282',H'558',H'904' 80 -AEND EQU * -P DS PL8 packed -Z DS ZL16 zoned -C DS CL16 character -WTOMSG CNOP 0,4 - DC H'80' length of WTO buffer - DC H'0' must be binary zeroes -BUFFER DC 80C' ' + USING BUBBLE,R13,R12 establish base registers +SAVEAREA B STM-SAVEAREA(R15) skip savearea + DC 17F'0' my savearea +STM STM R14,R12,12(R13) save calling context + ST R13,4(R15) link mySA->prevSA + ST R15,8(R13) link prevSA->mySA + LR R13,R15 set mySA & set 4K addessability + LA R12,2048(R13) . + LA R12,2048(R12) set 8K addessability + L RN,N n + BCTR RN,0 n-1 + DO UNTIL=(LTR,RM,Z,RM) repeat ------------------------+ + LA RM,0 more=false | + LA R1,A @a(i) | + LA R2,4(R1) @a(i+1) | + LA RI,1 i=1 | + DO WHILE=(CR,RI,LE,RN) for i=1 to n-1 ------------+ | + L R3,0(R1) a(i) | | + IF C,R3,GT,0(R2) if a(i)>a(i+1) then ---+ | | + L R9,0(R1) r9=a(i) | | | + L R3,0(R2) r3=a(i+1) | | | + ST R3,0(R1) a(i)=r3 | | | + ST R9,0(R2) a(i+1)=r9 | | | + LA RM,1 more=true | | | + ENDIF , end if <---------------+ | | + LA RI,1(RI) i=i+1 | | + LA R1,4(R1) next a(i) | | + LA R2,4(R2) next a(i+1) | | + ENDDO , end for <------------------+ | + ENDDO , until not more <---------------+ + LA R3,PG pgi=0 + LA RI,1 i=1 + DO WHILE=(C,RI,LE,N) do i=1 to n -------+ + LR R1,RI i | + SLA R1,2 . | + L R2,A-4(R1) a(i) | + XDECO R2,XDEC edit a(i) | + MVC 0(4,R3),XDEC+8 output a(i) | + LA R3,4(R3) pgi=pgi+4 | + LA RI,1(RI) i=i+1 | + ENDDO , end do <-----------+ + XPRNT PG,L'PG print buffer + L R13,4(0,R13) restore caller savearea + LM R14,R12,12(R13) restore context + XR R15,R15 set return code to 0 + BR R14 return to caller +A DC F'4',F'65',F'2',F'-31',F'0',F'99',F'2',F'83',F'782',F'1' + DC F'45',F'82',F'69',F'82',F'104',F'58',F'88',F'112',F'89',F'74' +N DC A((N-A)/L'A) number of items of a * +PG DC CL80' ' +XDEC DS CL12 LTORG YREGS +RI EQU 6 i +RN EQU 7 n-1 +RM EQU 8 more END BUBBLE diff --git a/Task/Sorting-algorithms-Bubble-sort/Julia/sorting-algorithms-bubble-sort.julia b/Task/Sorting-algorithms-Bubble-sort/Julia/sorting-algorithms-bubble-sort.julia index 3f6ec381fa..30f2b0b92b 100644 --- a/Task/Sorting-algorithms-Bubble-sort/Julia/sorting-algorithms-bubble-sort.julia +++ b/Task/Sorting-algorithms-Bubble-sort/Julia/sorting-algorithms-bubble-sort.julia @@ -1,25 +1,22 @@ -function bubblesort{T}(a::AbstractArray{T,1}) - b = copy(a) - isordered = false - span = length(b) - while !isordered && span > 1 - isordered = true - for i in 2:span - if b[i] < b[i-1] - t = b[i] - b[i] = b[i-1] - b[i-1] = t - isordered = false - end - end - span -= 1 +function bubblesort!{T}(x::AbstractArray{T}) + + for i in 2:length(x) + for j in 1:length(x)-1 + if x[j] > x[j+1] + tmp = x[j] + x[j] = x[j+1] + x[j+1] = tmp + end end - return b + end + + return x end + a = [rand(-100:100) for i in 1:20] println("Before bubblesort:") println(a) -a = bubblesort(a) +a = bubblesort!(a) println("\nAfter bubblesort:") println(a) diff --git a/Task/Sorting-algorithms-Bubble-sort/PHP/sorting-algorithms-bubble-sort.php b/Task/Sorting-algorithms-Bubble-sort/PHP/sorting-algorithms-bubble-sort.php index d007ea2603..caafc1d218 100644 --- a/Task/Sorting-algorithms-Bubble-sort/PHP/sorting-algorithms-bubble-sort.php +++ b/Task/Sorting-algorithms-Bubble-sort/PHP/sorting-algorithms-bubble-sort.php @@ -1,17 +1,13 @@ -function bubbleSort( array &$array ) -{ - do - { - $swapped = false; - for( $i = 0, $c = count( $array ) - 1; $i < $c; $i++ ) - { - if( $array[$i] > $array[$i + 1] ) - { - list( $array[$i + 1], $array[$i] ) = - array( $array[$i], $array[$i + 1] ); - $swapped = true; - } - } - } - while( $swapped ); +function bubbleSort(array &$array) { + $c = count($array) - 1; + do { + $swapped = false; + for ($i = 0; $i < $c; ++$i) { + if ($array[$i] > $array[$i + 1]) { + list($array[$i + 1], $array[$i]) = + array($array[$i], $array[$i + 1]); + $swapped = true; + } + } + } while ($swapped); } diff --git a/Task/Sorting-algorithms-Bubble-sort/Perl-6/sorting-algorithms-bubble-sort.pl6 b/Task/Sorting-algorithms-Bubble-sort/Perl-6/sorting-algorithms-bubble-sort.pl6 index fc265f8d86..22f2e98dc2 100644 --- a/Task/Sorting-algorithms-Bubble-sort/Perl-6/sorting-algorithms-bubble-sort.pl6 +++ b/Task/Sorting-algorithms-Bubble-sort/Perl-6/sorting-algorithms-bubble-sort.pl6 @@ -1,4 +1,4 @@ -sub bubble_sort (@a is rw) { +sub bubble_sort (@a) { for ^@a -> $i { for $i ^..^ @a -> $j { @a[$j] < @a[$i] and @a[$i, $j] = @a[$j, $i]; diff --git a/Task/Sorting-algorithms-Bubble-sort/Python/sorting-algorithms-bubble-sort.py b/Task/Sorting-algorithms-Bubble-sort/Python/sorting-algorithms-bubble-sort.py index 5030daa77d..35052aa608 100644 --- a/Task/Sorting-algorithms-Bubble-sort/Python/sorting-algorithms-bubble-sort.py +++ b/Task/Sorting-algorithms-Bubble-sort/Python/sorting-algorithms-bubble-sort.py @@ -11,7 +11,7 @@ def bubble_sort(seq): if seq[i] > seq[i+1]: seq[i], seq[i+1] = seq[i+1], seq[i] changed = True - return None + return seq if __name__ == "__main__": """Sample usage and simple test suite""" diff --git a/Task/Sorting-algorithms-Bubble-sort/REXX/sorting-algorithms-bubble-sort.rexx b/Task/Sorting-algorithms-Bubble-sort/REXX/sorting-algorithms-bubble-sort.rexx index e67a6477ba..10651f7809 100644 --- a/Task/Sorting-algorithms-Bubble-sort/REXX/sorting-algorithms-bubble-sort.rexx +++ b/Task/Sorting-algorithms-Bubble-sort/REXX/sorting-algorithms-bubble-sort.rexx @@ -1,39 +1,32 @@ -/*REXX program sorts an array (of any items) using the bubble-sort algorithm.*/ -call gen /*generate the array elements (items).*/ -call show 'before sort' /*show the before array elements. */ - say copies('─',79) /*show a separator line (before/after).*/ -call bubbleSort # /*invoke the bubble sort with # items.*/ -call show ' after sort' /*show the after array elements. */ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -bubbleSort: procedure expose @.; parse arg n /*N: number of array elements.*/ -m=n-1 /*use this as a handy variable for sort*/ - do until done; done=1 /*keep sorting the array until done. */ - do j=1 for m; k=j+1 /*search for an element out─of─order. */ - if @.j>@.k then do; _=@.j /*Out of order? Then swap two elements*/ - @.j=@.k /*swap current element with the next···*/ - @.k=_ /* ··· and the next with _ */ - done=0 /*indicate that the sorting isn't done,*/ - end /* (1≡true, 0≡false). */ - end /*j*/ - end /*until ··· */ -return -/*────────────────────────────────────────────────────────────────────────────*/ -gen: @. = /*assign a default value to all of @. */ - @.1 = '---letters of the Hebrew alphabet---' ; @.13 = 'kaph [kaf]' - @.2 = '====================================' ; @.14 = 'lamed' - @.3 = 'aleph [alef]' ; @.15 = 'mem' - @.4 = 'beth [bet]' ; @.16 = 'nun' - @.5 = 'gimel' ; @.17 = 'samekh' - @.6 = 'daleth [dalet]' ; @.18 = 'ayin' - @.7 = 'he' ; @.19 = 'pe' - @.8 = 'waw [vav]' ; @.20 = 'sadhe [tsadi]' - @.9 = 'zayin' ; @.21 = 'qoph [qof]' - @.10 = 'heth [het]' ; @.22 = 'resh' - @.11 = 'teth [tet]' ; @.23 = 'shin' - @.12 = 'yod' ; @.24 = 'taw [tav]' - do #=1 while @.#\==''; end; #=#-1 /*find how many elements in list.*/ - w=length(#) /*the maximum width of any index.*/ +/*REXX program sorts an array (of any kind of items) using the bubble─sort algorithm.*/ +call gen /*generate the array elements (items).*/ +call show 'before sort' /*show the before array elements. */ + say copies('─', 79) /*show a separator line (before/after).*/ +call bubbleSort # /*invoke the bubble sort with # items.*/ +call show ' after sort' /*show the after array elements. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +bubbleSort: procedure expose @.; parse arg n; m=n-1 /*N: number of array elements. */ + do m=m for m by -1 until ok; ok=1 /*keep sorting array until done.*/ + do j=1 for m; k=j+1; if @.j<=@.k then iterate /*Not out─of─order?*/ + _=@.j; @.j=@.k; @.k=_; ok=0 /*swap 2 elements; flag as ¬done*/ + end /*j*/ + end /*m*/ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +gen: @.=; @.1 = '---letters of the Hebrew alphabet---' ; @.13= "kaph [kaf]" + @.2 = '====================================' ; @.14= "lamed" + @.3 = 'aleph [alef]' ; @.15= "mem" + @.4 = 'beth [bet]' ; @.16= "nun" + @.5 = 'gimel' ; @.17= "samekh" + @.6 = 'daleth [dalet]' ; @.18= "ayin" + @.7 = 'he' ; @.19= "pe" + @.8 = 'waw [vav]' ; @.20= "sadhe [tsadi]" + @.9 = 'zayin' ; @.21= "qoph [qof]" + @.10= 'heth [het]' ; @.22= "resh" + @.11= 'teth [tet]' ; @.23= "shin" + @.12= 'yod' ; @.24= "taw [tav]" + do #=1 while @.#\==''; end; #=#-1 /*determine #elements in list; adjust #*/ return -/*────────────────────────────────────────────────────────────────────────────*/ -show: do j=1 for #; say 'element' right(j,w) arg(1)":" @.j; end; return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +show: w=length(#); do j=1 for #; say 'element' right(j,w) arg(1)":" @.j; end; return diff --git a/Task/Sorting-algorithms-Cocktail-sort/360-Assembly/sorting-algorithms-cocktail-sort.360 b/Task/Sorting-algorithms-Cocktail-sort/360-Assembly/sorting-algorithms-cocktail-sort.360 new file mode 100644 index 0000000000..ecb4083f2a --- /dev/null +++ b/Task/Sorting-algorithms-Cocktail-sort/360-Assembly/sorting-algorithms-cocktail-sort.360 @@ -0,0 +1,71 @@ +* Cocktail sort 25/06/2016 +COCKTSRT CSECT + USING COCKTSRT,R13 base register + B 72(R15) skip savearea + DC 17F'0' savearea + STM R14,R12,12(R13) prolog + ST R13,4(R15) " + ST R15,8(R13) " + LR R13,R15 " + L R2,N n + BCTR R2,0 n-1 + ST R2,NM1 nm1=n-1 + DO UNTIL=(CLI,STABLE,EQ,X'01') repeat + MVI STABLE,X'01' stable=true + LA RI,1 i=1 + DO WHILE=(C,RI,LE,NM1) do i=1 to n-1 + LR R1,RI i + SLA R1,2 . + LA R2,A-4(R1) @a(i) + LA R3,A(R1) @a(i+1) + L R4,0(R2) r4=a(i) + L R5,0(R3) r5=a(i+1) + IF CR,R4,GT,R5 THEN if a(i)>a(i+1) then + MVI STABLE,X'00' stable=false + ST R5,0(R2) a(i)=r5 + ST R4,0(R3) a(i+1)=r4 + ENDIF , end if + LA RI,1(RI) i=i+1 + ENDDO , end do + L RI,NM1 i=n-1 + DO WHILE=(C,RI,GE,=F'1') do i=n-1 to 1 by -1 + LR R1,RI i + SLA R1,2 . + LA R2,A-4(R1) @a(i) + LA R3,A(R1) @a(i+1) + L R4,0(R2) r4=a(i) + L R5,0(R3) r5=a(i+1) + IF CR,R4,GT,R5 THEN if a(i)>a(i+1) then + MVI STABLE,X'00' stable=false + ST R5,0(R2) a(i)=r5 + ST R4,0(R3) a(i+1)=r4 + ENDIF , end if + BCTR RI,0 i=i-1 + ENDDO , end do + ENDDO , until stable + LA R3,PG pgi=0 + LA RI,1 i=1 + DO WHILE=(C,RI,LE,N) do i=1 to n + LR R1,RI i + SLA R1,2 . + L R2,A-4(R1) a(i) + XDECO R2,XDEC edit a(i) + MVC 0(4,R3),XDEC+8 output a(i) + LA R3,4(R3) pgi=pgi+4 + LA RI,1(RI) i=i+1 + ENDDO , end do + XPRNT PG,L'PG print buffer + L R13,4(0,R13) epilog + LM R14,R12,12(R13) " + XR R15,R15 " + BR R14 exit +A DC F'4',F'65',F'2',F'-31',F'0',F'99',F'2',F'83',F'782',F'1' + DC F'45',F'82',F'69',F'82',F'104',F'58',F'88',F'112',F'89',F'74' +N DC A((N-A)/L'A) number of items of a +NM1 DS F n-1 +PG DC CL80' ' buffer +XDEC DS CL12 temp for xdeco +STABLE DS X stable + YREGS +RI EQU 6 i + END COCKTSRT diff --git a/Task/Sorting-algorithms-Cocktail-sort/C/sorting-algorithms-cocktail-sort-1.c b/Task/Sorting-algorithms-Cocktail-sort/C/sorting-algorithms-cocktail-sort-1.c new file mode 100644 index 0000000000..36f941cfe4 --- /dev/null +++ b/Task/Sorting-algorithms-Cocktail-sort/C/sorting-algorithms-cocktail-sort-1.c @@ -0,0 +1,39 @@ +#include + +// can be any swap function. This swap is optimized for numbers. +void swap(int *x, int *y) { + if(x == y) + return; + *x ^= *y; + *y ^= *x; + *x ^= *y; +} +void cocktailsort(int *a, size_t n) { + while(1) { + // packing two similar loops into one + char flag; + size_t start[2] = {1, n - 1}, + end[2] = {n, 0}, + inc[2] = {1, -1}; + for(int it = 0; it < 2; ++it) { + flag = 1; + for(int i = start[it]; i != end[it]; i += inc[it]) + if(a[i - 1] > a[i]) { + swap(a + i - 1, a + i); + flag = 0; + } + if(flag) + return; + } + } +} + +int main(void) { + int a[] = { 5, -1, 101, -4, 0, 1, 8, 6, 2, 3 }; + size_t n = sizeof(a)/sizeof(a[0]); + + cocktailsort(a, n); + for (size_t i = 0; i < n; ++i) + printf("%d ", a[i]); + return 0; +} diff --git a/Task/Sorting-algorithms-Cocktail-sort/C/sorting-algorithms-cocktail-sort-2.c b/Task/Sorting-algorithms-Cocktail-sort/C/sorting-algorithms-cocktail-sort-2.c new file mode 100644 index 0000000000..bd8395748f --- /dev/null +++ b/Task/Sorting-algorithms-Cocktail-sort/C/sorting-algorithms-cocktail-sort-2.c @@ -0,0 +1 @@ +-4 -1 0 1 2 3 5 6 8 101 diff --git a/Task/Sorting-algorithms-Cocktail-sort/C/sorting-algorithms-cocktail-sort.c b/Task/Sorting-algorithms-Cocktail-sort/C/sorting-algorithms-cocktail-sort.c deleted file mode 100644 index d917b09b1a..0000000000 --- a/Task/Sorting-algorithms-Cocktail-sort/C/sorting-algorithms-cocktail-sort.c +++ /dev/null @@ -1,26 +0,0 @@ -#include - -#define try_swap { if (a[i] < a[i - 1])\ - { t = a[i]; a[i] = a[i - 1]; a[i - 1] = t; t = 0;} } - -void cocktailsort(int *a, size_t len) -{ - size_t i; - int t = 0; - while (!t) { - for (i = 1, t = 1; i < len; i++) try_swap; - if (t) break; - for (i = len - 1, t = 1; i; i--) try_swap; - } -} - -int main() -{ - int x[] = { 5, -1, 101, -4, 0, 1, 8, 6, 2, 3 }; - size_t i, len = sizeof(x)/sizeof(x[0]); - - cocktailsort(x, len); - for (i = 0; i < len; i++) - printf("%d\n", x[i]); - return 0; -} diff --git a/Task/Sorting-algorithms-Cocktail-sort/JavaScript/sorting-algorithms-cocktail-sort.js b/Task/Sorting-algorithms-Cocktail-sort/JavaScript/sorting-algorithms-cocktail-sort.js new file mode 100644 index 0000000000..40fbf2f390 --- /dev/null +++ b/Task/Sorting-algorithms-Cocktail-sort/JavaScript/sorting-algorithms-cocktail-sort.js @@ -0,0 +1,34 @@ + // Node 5.4.1 tested implementation (ES6) +"use strict"; + +let arr = [4, 9, 0, 3, 1, 5]; +let isSorted = true; +while (isSorted){ + for (let i = 0; i< arr.length - 1;i++){ + if (arr[i] > arr[i + 1]) + { + let temp = arr[i]; + arr[i] = arr[i + 1]; + arr[i+1] = temp; + isSorted = true; + } + } + + if (!isSorted) + break; + + isSorted = false; + + for (let j = arr.length - 1; j > 0; j--){ + if (arr[j-1] > arr[j]) + { + let temp = arr[j]; + arr[j] = arr[j - 1]; + arr[j - 1] = temp; + isSorted = true; + } + } +} +console.log(arr); + +} diff --git a/Task/Sorting-algorithms-Cocktail-sort/Python/sorting-algorithms-cocktail-sort-3.py b/Task/Sorting-algorithms-Cocktail-sort/Python/sorting-algorithms-cocktail-sort-3.py new file mode 100644 index 0000000000..2f61a13d1f --- /dev/null +++ b/Task/Sorting-algorithms-Cocktail-sort/Python/sorting-algorithms-cocktail-sort-3.py @@ -0,0 +1,16 @@ +def cocktail(a): + for i in range(len(a)//2): + swap = False + for j in range(1+i, len(a)-i): + if a[j] < a[j-1]: + a[j], a[j-1] = a[j-1], a[j] + swap = True + if not swap: + break + swap = False + for j in range(len(a)-i-1, i, -1): + if a[j] < a[j-1]: + a[j], a[j-1] = a[j-1], a[j] + swap = True + if not swap: + break diff --git a/Task/Sorting-algorithms-Comb-sort/00DESCRIPTION b/Task/Sorting-algorithms-Comb-sort/00DESCRIPTION index 858f441a35..40f2198203 100644 --- a/Task/Sorting-algorithms-Comb-sort/00DESCRIPTION +++ b/Task/Sorting-algorithms-Comb-sort/00DESCRIPTION @@ -1,10 +1,28 @@ {{Sorting Algorithm}} -The '''Comb Sort''' is a variant of the [[Bubble Sort]]. Like the [[Shell sort]], the Comb Sort increases the gap used in comparisons and exchanges (dividing the gap by (1-e^{-\varphi})^{-1} \approx 1.247330950103979 works best, but 1.3 may be more practical). Some implementations use the insertion sort once the gap is less than a certain amount. See the [[wp:Comb sort|article on Wikipedia]]. -Variants: -*Combsort11 makes sure the gap ends in (11, 8, 6, 4, 3, 2, 1), which is significantly faster than the other two possible endings -*Combsort with different endings changes to a more efficient sort when the data is almost sorted (when the gap is small). Comb sort with a low gap isn't much better than the Bubble Sort. +;Task: +Implement a   ''comb sort''. + +The '''Comb Sort''' is a variant of the [[Bubble Sort]]. + +Like the [[Shell sort]], the Comb Sort increases the gap used in comparisons and exchanges. + +Dividing the gap by   (1-e^{-\varphi})^{-1} \approx 1.247330950103979   works best, but   1.3   may be more practical. + + +Some implementations use the insertion sort once the gap is less than a certain amount. + + +;Also see: +*   the Wikipedia article:   [[wp:Comb sort|Comb sort]]. + + +Variants: +* Combsort11 makes sure the gap ends in (11, 8, 6, 4, 3, 2, 1), which is significantly faster than the other two possible endings. +* Combsort with different endings changes to a more efficient sort when the data is almost sorted (when the gap is small).   Comb sort with a low gap isn't much better than the Bubble Sort. + +
    Pseudocode: '''function''' combsort('''array''' input) gap := input'''.size''' ''//initialize gap size'' @@ -28,3 +46,4 @@ Pseudocode: '''end loop''' '''end loop''' '''end function''' +

    diff --git a/Task/Sorting-algorithms-Comb-sort/360-Assembly/sorting-algorithms-comb-sort.360 b/Task/Sorting-algorithms-Comb-sort/360-Assembly/sorting-algorithms-comb-sort.360 new file mode 100644 index 0000000000..1586d9e243 --- /dev/null +++ b/Task/Sorting-algorithms-Comb-sort/360-Assembly/sorting-algorithms-comb-sort.360 @@ -0,0 +1,68 @@ +* Comb sort 23/06/2016 +COMBSORT CSECT + USING COMBSORT,R13 base register + B 72(R15) skip savearea + DC 17F'0' savearea + STM R14,R12,12(R13) prolog + ST R13,4(R15) " + ST R15,8(R13) " + LR R13,R15 " + L R2,N n + BCTR R2,0 n-1 + ST R2,GAP gap=n-1 + DO UNTIL=(CLC,GAP,EQ,=F'1',AND,CLI,SWAPS,EQ,X'00') repeat + L R4,GAP gap | + MH R4,=H'100' gap*100 | + SRDA R4,32 . | + D R4,=F'125' /125 | + ST R5,GAP gap=int(gap/1.25) | + IF CLC,GAP,LT,=F'1' if gap<1 then -----------+ | + MVC GAP,=F'1' gap=1 | | + ENDIF , end if <-----------------+ | + MVI SWAPS,X'00' swaps=false | + LA RI,1 i=1 | + DO UNTIL=(C,R3,GT,N) do i=1 by 1 until i+gap>n ---+ | + LR R7,RI i | | + SLA R7,2 . | | + LA R7,A-4(R7) r7=@a(i) | | + LR R8,RI i | | + A R8,GAP i+gap | | + SLA R8,2 . | | + LA R8,A-4(R8) r8=@a(i+gap) | | + L R2,0(R7) temp=a(i) | | + IF C,R2,GT,0(R8) if a(i)>a(i+gap) then ---+ | | + MVC 0(4,R7),0(R8) a(i)=a(i+gap) | | | + ST R2,0(R8) a(i+gap)=temp | | | + MVI SWAPS,X'01' swaps=true | | | + ENDIF , end if <-----------------+ | | + LA RI,1(RI) i=i+1 | | + LR R3,RI i | | + A R3,GAP i+gap | | + ENDDO , end do <---------------------+ | + ENDDO , until gap=1 and not swaps <------+ + LA R3,PG pgi=0 + LA RI,1 i=1 + DO WHILE=(C,RI,LE,N) do i=1 to n -------+ + LR R1,RI i | + SLA R1,2 . | + L R2,A-4(R1) a(i) | + XDECO R2,XDEC edit a(i) | + MVC 0(4,R3),XDEC+8 output a(i) | + LA R3,4(R3) pgi=pgi+4 | + LA RI,1(RI) i=i+1 | + ENDDO , end do <-----------+ + XPRNT PG,L'PG print buffer + L R13,4(0,R13) epilog + LM R14,R12,12(R13) " + XR R15,R15 " + BR R14 exit +A DC F'4',F'65',F'2',F'-31',F'0',F'99',F'2',F'83',F'782',F'1' + DC F'45',F'82',F'69',F'82',F'104',F'58',F'88',F'112',F'89',F'74' +N DC A((N-A)/L'A) number of items of a +GAP DS F gap +SWAPS DS X flag for swaps +PG DS CL80 output buffer +XDEC DS CL12 temp for edit + YREGS +RI EQU 6 i + END COMBSORT diff --git a/Task/Sorting-algorithms-Comb-sort/Elixir/sorting-algorithms-comb-sort.elixir b/Task/Sorting-algorithms-Comb-sort/Elixir/sorting-algorithms-comb-sort.elixir new file mode 100644 index 0000000000..729f7ba4fd --- /dev/null +++ b/Task/Sorting-algorithms-Comb-sort/Elixir/sorting-algorithms-comb-sort.elixir @@ -0,0 +1,21 @@ +defmodule Sort do + def comb_sort([]), do: [] + def comb_sort(input) do + comb_sort(List.to_tuple(input), length(input), 0) |> Tuple.to_list + end + + defp comb_sort(output, 1, 0), do: output + defp comb_sort(input, gap, _) do + gap = max(trunc(gap / 1.25), 1) + {output,swaps} = Enum.reduce(0..tuple_size(input)-gap-1, {input,0}, fn i,{acc,swap} -> + if (x = elem(acc,i)) > (y = elem(acc,i+gap)) do + {acc |> put_elem(i,y) |> put_elem(i+gap,x), 1} + else + {acc,swap} + end + end) + comb_sort(output, gap, swaps) + end +end + +(for _ <- 1..20, do: :rand.uniform(20)) |> IO.inspect |> Sort.comb_sort |> IO.inspect diff --git a/Task/Sorting-algorithms-Comb-sort/JavaScript/sorting-algorithms-comb-sort.js b/Task/Sorting-algorithms-Comb-sort/JavaScript/sorting-algorithms-comb-sort.js new file mode 100644 index 0000000000..2eaa716b80 --- /dev/null +++ b/Task/Sorting-algorithms-Comb-sort/JavaScript/sorting-algorithms-comb-sort.js @@ -0,0 +1,47 @@ + // Node 5.4.1 tested implementation (ES6) + function is_array_sorted(arr) { + var sorted = true; + for (var i = 0; i < arr.length - 1; i++) { + if (arr[i] > arr[i + 1]) { + sorted = false; + break; + } + } + return sorted; + } + + // Array to sort + var arr = [4, 9, 0, 3, 1, 5]; + + var iteration_count = 0; + var gap = arr.length - 2; + var decrease_factor = 1.25; + + // Until array is not sorted, repeat iterations + while (!is_array_sorted(arr)) { + // If not first gap + if (iteration_count > 0) + // Calculate gap + gap = (gap == 1) ? gap : Math.floor(gap / decrease_factor); + + // Set front and back elements and increment to a gap + var front = 0; + var back = gap; + while (back <= arr.length - 1) { + // If elements are not ordered swap them + if (arr[front] > arr[back]) { + var temp = arr[front]; + arr[front] = arr[back]; + arr[back] = temp; + } + + // Increment and re-run swapping + front += 1; + back += 1; + } + iteration_count += 1; + } + + // Print the sorted array + console.log(arr); +} diff --git a/Task/Sorting-algorithms-Comb-sort/R/sorting-algorithms-comb-sort.r b/Task/Sorting-algorithms-Comb-sort/R/sorting-algorithms-comb-sort.r new file mode 100644 index 0000000000..33036b3855 --- /dev/null +++ b/Task/Sorting-algorithms-Comb-sort/R/sorting-algorithms-comb-sort.r @@ -0,0 +1,20 @@ +comb.sort<-function(a){ + gap<-length(a) + swaps<-1 + while(gap>1 & swaps==1){ + gap=floor(gap/1.3) + if(gap<1){ + gap=1 + } + swaps=0 + i=1 + while(i+gap<=length(a)){ + if(a[i]>a[i+gap]){ + a[c(i,i+gap)] <- a[c(i+gap,i)] + swaps=1 + } + i<-i+1 + } + } + return(a) +} diff --git a/Task/Sorting-algorithms-Comb-sort/REXX/sorting-algorithms-comb-sort.rexx b/Task/Sorting-algorithms-Comb-sort/REXX/sorting-algorithms-comb-sort.rexx index 3703ad567c..26e163fcaa 100644 --- a/Task/Sorting-algorithms-Comb-sort/REXX/sorting-algorithms-comb-sort.rexx +++ b/Task/Sorting-algorithms-Comb-sort/REXX/sorting-algorithms-comb-sort.rexx @@ -1,34 +1,34 @@ -/*REXX program sorts a stemmed array using the comb sort algorithm. */ -call gen; w=length(#) /*generate the @ array elements. */ -call show 'before sort' /*display the before array elements. */ -say copies('▒',60) /*display a separator line (a fence). */ -call combSort # /*invoke the comb sort. */ -call show ' after sort' /*display the after array elements. */ -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────COMBSORT subroutine───────────────────────*/ -combSort: procedure expose @.; parse arg N /*N: is number of @ elements. */ -s=N-1 /*S: is the spread between COMBs.*/ - do until s<=1 & done; done=1 /*assume sort is done (so far). */ - s=trunc(s*.8) /* ÷ is slow, * is better.*/ - do j=1 until js>=N; js=j+s - if @.j>@.js then do; _=@.j; @.j=@.js; @.js=_; done=0; end - end /*j*/ - end /*until*/ -return -/*──────────────────────────────────GEN subroutine────────────────────────────*/ -gen: @. = ; @.12 = 'dodecagon 12' - @.1 = '----polygon--- sides' ; @.13 = 'tridecagon 13' - @.2 = '============== =======' ; @.14 = 'tetradecagon 14' - @.3 = 'triangle 3' ; @.15 = 'pentadecagon 15' - @.4 = 'quadrilateral 4' ; @.16 = 'hexadecagon 16' - @.5 = 'pentagon 5' ; @.17 = 'heptadecagon 17' - @.6 = 'hexagon 6' ; @.18 = 'octadecagon 18' - @.7 = 'heptagon 7' ; @.19 = 'enneadecagon 19' - @.8 = 'octagon 8' ; @.20 = 'icosagon 20' - @.9 = 'nonagon 9' ; @.21 = 'hectogon 100' - @.10 = 'decagon 10' ; @.22 = 'chiliagon 1000' - @.11 = 'hendecagon 11' ; @.23 = 'myriagon 10000' - do #=1 while @.#\==''; end; #=#-1 /*determine how many entries in @ array*/ -return -/*──────────────────────────────────SHOW subroutine───────────────────────────*/ -show: do j=1 for #; say ' element' right(j,w) arg(1)":" @.j; end; return +/*REXX program sorts and displays a stemmed array using the comb sort algorithm. */ +call gen; w=length(#) /*generate the @ array elements. */ +call show 'before sort' /*display the before array elements. */ + say copies('▒', 60) /*display a separator line (a fence). */ +call combSort # /*invoke the comb sort (with # entries)*/ +call show ' after sort' /*display the after array elements. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +combSort: procedure expose @.; parse arg N /*N: is the number of @ elements. */ + s=N-1 /*S: is the spread between COMBs. */ + do until s<=1 & done; done=1 /*assume sort is done (so far). */ + s=trunc(s*0.8) /*Note: ÷ is slow, * is better.*/ + do j=1 until js>=N; js=j+s + if @.j>@.js then do; _=@.j; @.j=@.js; @.js=_; done=0; end + end /*j*/ + end /*until*/ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +gen: @. = ; @.12 = "dodecagon 12" + @.1 = '----polygon--- sides' ; @.13 = "tridecagon 13" + @.2 = '============== =======' ; @.14 = "tetradecagon 14" + @.3 = 'triangle 3' ; @.15 = "pentadecagon 15" + @.4 = 'quadrilateral 4' ; @.16 = "hexadecagon 16" + @.5 = 'pentagon 5' ; @.17 = "heptadecagon 17" + @.6 = 'hexagon 6' ; @.18 = "octadecagon 18" + @.7 = 'heptagon 7' ; @.19 = "enneadecagon 19" + @.8 = 'octagon 8' ; @.20 = "icosagon 20" + @.9 = 'nonagon 9' ; @.21 = "hectogon 100" + @.10 = 'decagon 10' ; @.22 = "chiliagon 1000" + @.11 = 'hendecagon 11' ; @.23 = "myriagon 10000" + do #=1 while @.#\==''; end; #=#-1 /*find how many elements in @*/ + return /* [↑] adjust # because of the DO loop*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +show: do j=1 for #; say ' element' right(j,w) arg(1)":" @.j; end; return diff --git a/Task/Sorting-algorithms-Counting-sort/Elixir/sorting-algorithms-counting-sort.elixir b/Task/Sorting-algorithms-Counting-sort/Elixir/sorting-algorithms-counting-sort.elixir index 8d98e5f580..b8ca2fbf1b 100644 --- a/Task/Sorting-algorithms-Counting-sort/Elixir/sorting-algorithms-counting-sort.elixir +++ b/Task/Sorting-algorithms-Counting-sort/Elixir/sorting-algorithms-counting-sort.elixir @@ -1,24 +1,14 @@ defmodule Sort do def counting_sort([]), do: [] def counting_sort(list) do - {min, max} = minmax(list) - count = List.to_tuple(for _ <- min..max, do: 0) + {min, max} = Enum.min_max(list) + count = Tuple.duplicate(0, max - min + 1) counted = Enum.reduce(list, count, fn x,acc -> i = x - min put_elem(acc, i, elem(acc, i) + 1) end) - Enum.reduce(max..min, [], fn n,acc -> - m = elem(counted, n - min) - List.duplicate(n, m) ++ acc - end) + Enum.flat_map(min..max, &List.duplicate(&1, elem(counted, &1 - min))) end - - defp minmax([h|t]), do: minmax(t, h, h) - - defp minmax([], min, max), do: {min, max} - defp minmax([h|t], min, max) when h + arr(n - min) += 1 + arr + }.zipWithIndex.reverse.foldLeft(List[Int]()) { + case (lst, (cnt, ndx)) => List.fill(cnt)(ndx + min) ::: lst + } diff --git a/Task/Sorting-algorithms-Gnome-sort/Elixir/sorting-algorithms-gnome-sort.elixir b/Task/Sorting-algorithms-Gnome-sort/Elixir/sorting-algorithms-gnome-sort.elixir index f1ae80df7c..4b5349357c 100644 --- a/Task/Sorting-algorithms-Gnome-sort/Elixir/sorting-algorithms-gnome-sort.elixir +++ b/Task/Sorting-algorithms-Gnome-sort/Elixir/sorting-algorithms-gnome-sort.elixir @@ -1,9 +1,9 @@ defmodule Sort do - def gnome_sort(list) when length(list) <= 1, do: list + def gnome_sort([]), do: [] def gnome_sort([h|t]), do: gnome_sort([h], t) defp gnome_sort(list, []), do: list - defp gnome_sort([prev|p], [next|n]) when next > prev, do: gnome_sort(p, [next|[prev|n]]) + defp gnome_sort([prev|p], [next|n]) when next > prev, do: gnome_sort(p, [next,prev|n]) defp gnome_sort(p, [next|n]), do: gnome_sort([next|p], n) end diff --git a/Task/Sorting-algorithms-Gnome-sort/Perl-6/sorting-algorithms-gnome-sort.pl6 b/Task/Sorting-algorithms-Gnome-sort/Perl-6/sorting-algorithms-gnome-sort.pl6 index 581fa2fc1a..8e9a8b2347 100644 --- a/Task/Sorting-algorithms-Gnome-sort/Perl-6/sorting-algorithms-gnome-sort.pl6 +++ b/Task/Sorting-algorithms-Gnome-sort/Perl-6/sorting-algorithms-gnome-sort.pl6 @@ -1,4 +1,4 @@ -sub gnome_sort (@a is rw) { +sub gnome_sort (@a) { my ($i, $j) = 1, 2; while $i < @a { if @a[$i - 1] <= @a[$i] { @@ -6,7 +6,8 @@ sub gnome_sort (@a is rw) { } else { (@a[$i - 1], @a[$i]) = @a[$i], @a[$i - 1]; - --$i or ($i, $j) = $j, $j + 1; + $i--; + ($i, $j) = $j, $j + 1 if $i == 0; } } } diff --git a/Task/Sorting-algorithms-Gnome-sort/REXX/sorting-algorithms-gnome-sort-1.rexx b/Task/Sorting-algorithms-Gnome-sort/REXX/sorting-algorithms-gnome-sort-1.rexx index fb5e89fe88..e2eabebebd 100644 --- a/Task/Sorting-algorithms-Gnome-sort/REXX/sorting-algorithms-gnome-sort-1.rexx +++ b/Task/Sorting-algorithms-Gnome-sort/REXX/sorting-algorithms-gnome-sort-1.rexx @@ -1,25 +1,25 @@ -/*REXX program sorts a stemmed array using the gnome sort algorithm. */ -call gen; w=length(#) /*generate @ array; W is width of #.*/ -call show 'before sort' /*display the "before" array elements.*/ -say copies('▒',60) /*show a separator line between sorts. */ -call gnomeSort # /*invoke the well─known gnome sort. */ -call show ' after sort' /*display the "after" array elements.*/ -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────GNOMESORT subroutine──────────────────────*/ -gnomeSort: procedure expose @.; parse arg n; k=2 /*N: is number items.*/ - do j=3 while k<=n; p=k-1 /*P: is previous item*/ - if @.p<<=@.k then do; k=j; iterate; end /*array is OK so far.*/ - _=@.p; @.p=@.k; @.k=_ /*swap two @ entries.*/ - k=k-1; if k==1 then k=j; else j=j-1 /*test for 1st index.*/ - end /*j*/ -return -/*──────────────────────────────────GEN subroutine────────────────────────────*/ -gen: @.=; @.1 = '---the seven virtues---' ; @.5 = 'Charity [Love]' - @.2 = '=======================' ; @.6 = 'Fortitude' - @.3 = 'Faith' ; @.7 = 'Justice' - @.4 = 'Hope' ; @.8 = 'Prudence' - @.9 = 'Temperance' - do #=1 while @.#\==''; end; #=#-1 /*determine number of items in @ array.*/ -return -/*──────────────────────────────────SHOW subroutine───────────────────────────*/ -show: do j=1 for #; say ' element' right(j,w) arg(1)":" @.j; end; return +/*REXX program sorts an array using the gnome sort algorithm (elements contain blanks). */ +call gen /*generate the @ stemmed array. */ +call show 'before sort' /*display the before array elements.*/ +say copies('▒', 60) /*show a separator line between sorts. */ +call gnomeSort # /*invoke the well─known gnome sort. */ +call show ' after sort' /*display the after array elements.*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +gnomeSort: procedure expose @.; parse arg n; k=2 /*N: is number items. */ + do j=3 while k<=n; p=k-1 /*P: is previous item.*/ + if @.p<<=@.k then do; k=j; iterate; end /*order is OK so far. */ + _=@.p; @.p=@.k; @.k=_ /*swap two @ entries. */ + k=k-1; if k==1 then k=j; else j=j-1 /*test for 1st index. */ + end /*j*/ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +gen: @.=; @.1 = '---the seven virtues---' ; @.5 = "Charity [Love]" + @.2 = '=======================' ; @.6 = "Fortitude" + @.3 = 'Faith' ; @.7 = "Justice" + @.4 = 'Hope' ; @.8 = "Prudence" + @.9 = "Temperance" + do #=1 while @.#\==''; end; #=#-1; w=length(#) /*find # of items.*/ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +show: do j=1 for #; say ' element' right(j,w) arg(1)":" @.j; end; return diff --git a/Task/Sorting-algorithms-Heapsort/00DESCRIPTION b/Task/Sorting-algorithms-Heapsort/00DESCRIPTION index 3482da4f4c..6c391bde36 100644 --- a/Task/Sorting-algorithms-Heapsort/00DESCRIPTION +++ b/Task/Sorting-algorithms-Heapsort/00DESCRIPTION @@ -1,8 +1,13 @@ {{Sorting Algorithm}} {{wikipedia|Heapsort}} {{omit from|GUISS}} -[[wp:Heapsort|Heapsort]] is an in-place sorting algorithm with worst case and average complexity of O(''n'' log''n''). + +
    +[[wp:Heapsort|Heapsort]] is an in-place sorting algorithm with worst case and average complexity of   O(''n'' log''n''). + The basic idea is to turn the array into a binary heap structure, which has the property that it allows efficient retrieval and removal of the maximal element. + We repeatedly "remove" the maximal element from the heap, thus building the sorted list from back to front. + Heapsort requires random access, so can only be used on an array-like data structure. Pseudocode: @@ -50,4 +55,7 @@ Pseudocode: root := child ''(repeat to continue sifting down the child now)'' '''else''' '''return''' + +
    Write a function to sort a collection of integers using heapsort. +

    diff --git a/Task/Sorting-algorithms-Heapsort/360-Assembly/sorting-algorithms-heapsort.360 b/Task/Sorting-algorithms-Heapsort/360-Assembly/sorting-algorithms-heapsort.360 new file mode 100644 index 0000000000..fa4d74482d --- /dev/null +++ b/Task/Sorting-algorithms-Heapsort/360-Assembly/sorting-algorithms-heapsort.360 @@ -0,0 +1,135 @@ +* Heap sort 22/06/2016 +HEAPS CSECT + USING HEAPS,R13 base register + B 72(R15) skip savearea + DC 17F'0' savearea + STM R14,R12,12(R13) prolog + ST R13,4(R15) " + ST R15,8(R13) " + LR R13,R15 " + L R1,N n + BAL R14,HEAPSORT call heapsort(n) + LA R3,PG pgi=0 + LA R6,1 i=1 + DO WHILE=(C,R6,LE,N) for i=1 to n + LR R1,R6 i + SLA R1,2 . + L R2,A-4(R1) a(i) + XDECO R2,XDEC edit a(i) + MVC 0(4,R3),XDEC+8 output a(i) + LA R3,4(R3) pgi=pgi+4 + LA R6,1(R6) i=i+1 + ENDDO , end for + XPRNT PG,80 print buffer + L R13,4(0,R13) epilog + LM R14,R12,12(R13) " + XR R15,R15 " + BR R14 exit +PG DC CL80' ' local data +XDEC DS CL12 " +*------- heapsort(icount)---------------------------------------------- +HEAPSORT ST R14,SAVEHPSR save return addr + ST R1,ICOUNT icount + BAL R14,HEAPIFY call heapify(icount) + MVC IEND,ICOUNT iend=icount + DO WHILE=(CLC,IEND,GT,=F'1') while iend>1 + L R1,IEND iend + LA R2,1 1 + BAL R14,SWAP call swap(iend,1) + LA R1,1 1 + L R2,IEND iend + BCTR R2,0 -1 + ST R2,IEND iend=iend-1 + BAL R14,SIFTDOWN call siftdown(1,iend) + ENDDO , end while + L R14,SAVEHPSR restore return addr + BR R14 return to caller +SAVEHPSR DS A local data +ICOUNT DS F " +IEND DS F " +*------- heapify(count)------------------------------------------------ +HEAPIFY ST R14,SAVEHPFY save return addr + ST R1,COUNT count + SRA R1,1 /2 + ST R1,ISTART istart=count/2 + DO WHILE=(C,R1,GE,=F'1') while istart>=1 + L R1,ISTART istart + L R2,COUNT count + BAL R14,SIFTDOWN call siftdown(istart,count) + L R1,ISTART istart + BCTR R1,0 -1 + ST R1,ISTART istart=istart-1 + ENDDO , end while + L R14,SAVEHPFY restore return addr + BR R14 return to caller +SAVEHPFY DS A local data +COUNT DS F " +ISTART DS F " +*------- siftdown(jstart,jend)----------------------------------------- +SIFTDOWN ST R14,SAVESFDW save return addr + ST R1,JSTART jstart + ST R2,JEND jend + ST R1,ROOT root=jstart + LR R3,R1 root + SLA R3,1 root*2 + DO WHILE=(C,R3,LE,JEND) while root*2<=jend + ST R3,CHILD child=root*2 + MVC SW,ROOT sw=root + L R1,SW sw + SLA R1,2 . + L R2,A-4(R1) a(sw) + L R1,CHILD child + SLA R1,2 . + L R3,A-4(R1) a(child) + IF CR,R2,LT,R3 THEN if a(sw) -#include -#define ValType double -#define IS_LESS(v1, v2) (v1 < v2) - -void siftDown( ValType *a, int start, int count); - -#define SWAP(r,s) do{ValType t=r; r=s; s=t; } while(0) - -void heapsort( ValType *a, int count) -{ - int start, end; - - /* heapify */ - for (start = (count-2)/2; start >=0; start--) { - siftDown( a, start, count); +int max (int *a, int n, int i, int j, int k) { + int m = i; + if (j < n && a[j] > a[m]) { + m = j; } + if (k < n && a[k] > a[m]) { + m = k; + } + return m; +} - for (end=count-1; end > 0; end--) { - SWAP(a[end],a[0]); - siftDown(a, 0, end); +void downheap (int *a, int n, int i) { + while (1) { + int j = max(a, n, i, 2 * i + 1, 2 * i + 2); + if (j == i) { + break; + } + int t = a[i]; + a[i] = a[j]; + a[j] = t; + i = j; } } -void siftDown( ValType *a, int start, int end) -{ - int root = start; - - while ( root*2+1 < end ) { - int child = 2*root + 1; - if ((child + 1 < end) && IS_LESS(a[child],a[child+1])) { - child += 1; - } - if (IS_LESS(a[root], a[child])) { - SWAP( a[child], a[root] ); - root = child; - } - else - return; +void heapsort (int *a, int n) { + int i; + for (i = (n - 2) / 2; i >= 0; i--) { + downheap(a, n, i); + } + for (i = 0; i < n; i++) { + int t = a[n - i - 1]; + a[n - i - 1] = a[0]; + a[0] = t; + downheap(a, n - i - 1, 0); } } - -int main() -{ - int ix; - double valsToSort[] = { - 1.4, 50.2, 5.11, -1.55, 301.521, 0.3301, 40.17, - -18.0, 88.1, 30.44, -37.2, 3012.0, 49.2}; -#define VSIZE (sizeof(valsToSort)/sizeof(valsToSort[0])) - - heapsort(valsToSort, VSIZE); - printf("{"); - for (ix=0; ix>SOURCE FORMAT FREE +*> This code is dedicated to the public domain +*> This is GNUCOBOL 2.0 +identification division. +program-id. heapsort. +environment division. +configuration section. +repository. function all intrinsic. +data division. +working-storage section. +01 filler. + 03 a pic 99. + 03 a-start pic 99. + 03 a-end pic 99. + 03 a-parent pic 99. + 03 a-child pic 99. + 03 a-sibling pic 99. + 03 a-lim pic 99 value 10. + 03 array-swap pic 99. + 03 array occurs 10 pic 99. +procedure division. +start-heapsort. + + *> fill the array + compute a = random(seconds-past-midnight) + perform varying a from 1 by 1 until a > a-lim + compute array(a) = random() * 100 + end-perform + + perform display-array + display space 'initial array' + + *>heapify the array + move a-lim to a-end + compute a-start = (a-lim + 1) / 2 + perform sift-down varying a-start from a-start by -1 until a-start = 0 + + perform display-array + display space 'heapified' + + *> sort the array + move 1 to a-start + move a-lim to a-end + perform until a-end = a-start + move array(a-end) to array-swap + move array(a-start) to array(a-end) + move array-swap to array(a-start) + subtract 1 from a-end + perform sift-down + end-perform + + perform display-array + display space 'sorted' + + stop run + . +sift-down. + move a-start to a-parent + perform until a-parent * 2 > a-end + compute a-child = a-parent * 2 + compute a-sibling = a-child + 1 + if a-sibling <= a-end and array(a-child) < array(a-sibling) + *> take the greater of the two + move a-sibling to a-child + end-if + if a-child <= a-end and array(a-parent) < array(a-child) + *> the child is greater than the parent + move array(a-child) to array-swap + move array(a-parent) to array(a-child) + move array-swap to array(a-parent) + end-if + *> continue down the tree + move a-child to a-parent + end-perform + . +display-array. + perform varying a from 1 by 1 until a > a-lim + display space array(a) with no advancing + end-perform + . +end program heapsort. diff --git a/Task/Sorting-algorithms-Heapsort/Elixir/sorting-algorithms-heapsort.elixir b/Task/Sorting-algorithms-Heapsort/Elixir/sorting-algorithms-heapsort.elixir new file mode 100644 index 0000000000..e83f6bbddc --- /dev/null +++ b/Task/Sorting-algorithms-Heapsort/Elixir/sorting-algorithms-heapsort.elixir @@ -0,0 +1,37 @@ +defmodule Sort do + def heapSort(list) do + len = length(list) + heapify(List.to_tuple(list), div(len - 2, 2)) + |> heapSort(len-1) + |> Tuple.to_list + end + + defp heapSort(a, finish) when finish > 0 do + swap(a, 0, finish) + |> siftDown(0, finish-1) + |> heapSort(finish-1) + end + defp heapSort(a, _), do: a + + defp heapify(a, start) when start >= 0 do + siftDown(a, start, tuple_size(a)-1) + |> heapify(start-1) + end + defp heapify(a, _), do: a + + defp siftDown(a, root, finish) when root * 2 + 1 <= finish do + child = root * 2 + 1 + if child + 1 <= finish and elem(a,child) < elem(a,child + 1), do: child = child + 1 + if elem(a,root) < elem(a,child), + do: swap(a, root, child) |> siftDown(child, finish), + else: a + end + defp siftDown(a, _root, _finish), do: a + + defp swap(a, i, j) do + {vi, vj} = {elem(a,i), elem(a,j)} + a |> put_elem(i, vj) |> put_elem(j, vi) + end +end + +(for _ <- 1..20, do: :rand.uniform(20)) |> IO.inspect |> Sort.heapSort |> IO.inspect diff --git a/Task/Sorting-algorithms-Heapsort/Perl-6/sorting-algorithms-heapsort.pl6 b/Task/Sorting-algorithms-Heapsort/Perl-6/sorting-algorithms-heapsort.pl6 index fd1ed6e83c..ee78527e06 100644 --- a/Task/Sorting-algorithms-Heapsort/Perl-6/sorting-algorithms-heapsort.pl6 +++ b/Task/Sorting-algorithms-Heapsort/Perl-6/sorting-algorithms-heapsort.pl6 @@ -1,4 +1,4 @@ -sub heap_sort ( @list is rw ) { +sub heap_sort ( @list ) { for ( 0 ..^ +@list div 2 ).reverse -> $start { _sift_down $start, @list.end, @list; } @@ -9,7 +9,7 @@ sub heap_sort ( @list is rw ) { } } -sub _sift_down ( $start, $end, @list is rw ) { +sub _sift_down ( $start, $end, @list ) { my $root = $start; while ( my $child = $root * 2 + 1 ) <= $end { $child++ if $child + 1 <= $end and [<] @list[ $child, $child+1 ]; diff --git a/Task/Sorting-algorithms-Heapsort/Perl/sorting-algorithms-heapsort.pl b/Task/Sorting-algorithms-Heapsort/Perl/sorting-algorithms-heapsort.pl index eceaf71aaa..49ddcbce29 100644 --- a/Task/Sorting-algorithms-Heapsort/Perl/sorting-algorithms-heapsort.pl +++ b/Task/Sorting-algorithms-Heapsort/Perl/sorting-algorithms-heapsort.pl @@ -1,45 +1,40 @@ -my @my_list = (2,3,6,23,13,5,7,3,4,5); -heap_sort(\@my_list); -print "@my_list\n"; -exit; +#!/usr/bin/perl -sub heap_sort -{ - my($list) = @_; - my $count = scalar @$list; - heapify($count,$list); +my @a = (4, 65, 2, -31, 0, 99, 2, 83, 782, 1); +print "@a\n"; +heap_sort(\@a); +print "@a\n"; - my $end = $count - 1; - while($end > 0) - { - @$list[0,$end] = @$list[$end,0]; - sift_down(0,$end-1,$list); - $end--; - } +sub heap_sort { + my ($a) = @_; + my $n = @$a; + for (my $i = ($n - 2) / 2; $i >= 0; $i--) { + down_heap($a, $n, $i); + } + for (my $i = 0; $i < $n; $i++) { + my $t = $a->[$n - $i - 1]; + $a->[$n - $i - 1] = $a->[0]; + $a->[0] = $t; + down_heap($a, $n - $i - 1, 0); + } } -sub heapify -{ - my ($count,$list) = @_; - my $start = ($count - 2) / 2; - while($start >= 0) - { - sift_down($start,$count-1,$list); - $start--; - } -} -sub sift_down -{ - my($start,$end,$list) = @_; - my $root = $start; - while($root * 2 + 1 <= $end) - { - my $child = $root * 2 + 1; - $child++ if($child + 1 <= $end && $list->[$child] < $list->[$child+1]); - if($list->[$root] < $list->[$child]) - { - @$list[$root,$child] = @$list[$child,$root]; - $root = $child; - }else{ return } - } +sub down_heap { + my ($a, $n, $i) = @_; + while (1) { + my $j = max($a, $n, $i, 2 * $i + 1, 2 * $i + 2); + last if $j == $i; + my $t = $a->[$i]; + $a->[$i] = $a->[$j]; + $a->[$j] = $t; + $i = $j; + } +} + +sub max { + my ($a, $n, $i, $j, $k) = @_; + my $m = $i; + $m = $j if $j < $n && $a->[$j] > $a->[$m]; + $m = $k if $k < $n && $a->[$k] > $a->[$m]; + return $m; } diff --git a/Task/Sorting-algorithms-Heapsort/REXX/sorting-algorithms-heapsort-1.rexx b/Task/Sorting-algorithms-Heapsort/REXX/sorting-algorithms-heapsort-1.rexx index 1a2c1b509a..8e8a10d709 100644 --- a/Task/Sorting-algorithms-Heapsort/REXX/sorting-algorithms-heapsort-1.rexx +++ b/Task/Sorting-algorithms-Heapsort/REXX/sorting-algorithms-heapsort-1.rexx @@ -1,29 +1,25 @@ -/*REXX pgm sorts an array (modern Greek alphabet) using a heapsort algorithm. */ -@.=; @.1='alpha' ; @.6 ='zeta' ; @.11='lambda' ; @.16='pi' ; @.21='phi' - @.2='beta' ; @.7 ='eta' ; @.12='mu' ; @.17='rho' ; @.22='chi' - @.3='gamma' ; @.8 ='theta'; @.13='nu' ; @.18='sigma' ; @.23='psi' - @.4='delta' ; @.9 ='iota' ; @.14='xi' ; @.19='tau' ; @.24='omega' - @.5='epsilon'; @.10='kappa'; @.15='omicron'; @.20='upsilon' - do #=1 while @.#\==''; end; #=#-1 /*find # entries*/ +/*REXX program sorts an array (names of modern Greek letters) using a heapsort algorithm*/ +@.=; @.1='alpha' ; @.6 ="zeta" ; @.11='lambda' ; @.16="pi" ; @.21='phi' + @.2='beta' ; @.7 ="eta" ; @.12='mu' ; @.17="rho" ; @.22='chi' + @.3='gamma' ; @.8 ="theta"; @.13='nu' ; @.18="sigma" ; @.23='psi' + @.4='delta' ; @.9 ="iota" ; @.14='xi' ; @.19="tau" ; @.24='omega' + @.5='epsilon'; @.10="kappa"; @.15='omicron'; @.20="upsilon" + do #=1 while @.#\==''; end; #=#-1 /*find # entries.*/ call show "before sort:" -call heapSort #; say copies('▒',40) /*sort; show sep*/ +call heapSort #; say copies('▒', 40) /*sort; show sep.*/ call show " after sort:" -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -heapSort: procedure expose @.; parse arg n; do j=n%2 by -1 to 1 - call shuffle j,n - end /*j*/ - do n=n by -1 to 2 - _=@.1; @.1=@.n; @.n=_; call shuffle 1,n-1 /*swap and shuffle.*/ - end /*n*/ -return -/*────────────────────────────────────────────────────────────────────────────*/ -shuffle: procedure expose @.; parse arg i,n; $=@.i /*obtain the parent*/ - do while i+i<=n; j=i+i; k=j+1 - if k<=n then if @.k>@.j then j=k - if $>=@.j then leave - @.i=@.j; i=j - end /*while*/ -@.i=$; return -/*────────────────────────────────────────────────────────────────────────────*/ -show: do e=1 for #; say ' element' right(e,length(#)) arg(1) @.e; end; return +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +heapSort: procedure expose @.; arg n; do j=n%2 by -1 to 1; call shuffle j,n; end /*j*/ + do n=n by -1 to 2; _=@.1; @.1=@.n; @.n=_; call shuffle 1,n-1 + end /*n*/ /* [↑] swap two elements; and shuffle.*/ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +shuffle: procedure expose @.; parse arg i,n; $=@.i /*obtain parent. */ + do while i+i<=n; j=i+i; k=j+1 + if k<=n then if @.k>@.j then j=k + if $>=@.j then leave; @.i=@.j; i=j + end /*while*/ + @.i=$; return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +show: do e=1 for #; say ' element' right(e,length(#)) arg(1) @.e; end; return diff --git a/Task/Sorting-algorithms-Heapsort/REXX/sorting-algorithms-heapsort-2.rexx b/Task/Sorting-algorithms-Heapsort/REXX/sorting-algorithms-heapsort-2.rexx index ef69424436..33a834eb6c 100644 --- a/Task/Sorting-algorithms-Heapsort/REXX/sorting-algorithms-heapsort-2.rexx +++ b/Task/Sorting-algorithms-Heapsort/REXX/sorting-algorithms-heapsort-2.rexx @@ -1,26 +1,23 @@ -/*REXX pgm sorts an array (modern Greek alphabet) using a heapsort algorithm. */ -g = 'alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu nu xi', - "omicron pi rho sigma tau upsilon phi chi psi omega" /*adjust # [↓] */ - do #=1 for words(g); @.#=word(g,#); end; #=#-1 +/*REXX program sorts a list (names of modern Greek letters) using a heapsort algorithm.*/ +parse arg g /*obtain optional argument from the CL.*/ +if g='' then g= 'alpha beta gamma delta epsilon zeta eta theta iota kappa lambda mu nu', + "xi omicron pi rho sigma tau upsilon phi chi psi omega" /*adjust # [↓] */ + do #=1 for words(g); @.#=word(g,#); end; #=#-1 call show "before sort:" -call heapSort #; say copies('▒',40) /*sort; show sep*/ +call heapSort #; say copies('▒', 40) /*sort; show sep*/ call show " after sort:" -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -heapSort: procedure expose @.; parse arg n; do j=n%2 by -1 to 1 - call shuffle j,n - end /*j*/ - do n=n by -1 to 2 - _=@.1; @.1=@.n; @.n=_; call shuffle 1,n-1 /*swap and shuffle.*/ - end /*n*/ -return -/*────────────────────────────────────────────────────────────────────────────*/ -shuffle: procedure expose @.; parse arg i,n; $=@.i /*obtain the parent*/ - do while i+i<=n; j=i+i; k=j+1 - if k<=n then if @.k>@.j then j=k - if $>=@.j then leave - @.i=@.j; i=j - end /*while*/ -@.i=$; return -/*────────────────────────────────────────────────────────────────────────────*/ -show: do e=1 for #; say ' element' right(e,length(#)) arg(1) @.e; end; return +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +heapSort: procedure expose @.; arg n; do j=n%2 by -1 to 1; call shuffle j,n; end /*j*/ + do n=n by -1 to 2; _=@.1; @.1=@.n; @.n=_; call shuffle 1,n-1 + end /*n*/ /* [↑] swap two elements; and shuffle.*/ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +shuffle: procedure expose @.; parse arg i,n; $=@.i /*obtain parent. */ + do while i+i<=n; j=i+i; k=j+1 + if k<=n then if @.k>@.j then j=k + if $>=@.j then leave; @.i=@.j; i=j + end /*while*/ + @.i=$; return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +show: do e=1 for #; say ' element' right(e,length(#)) arg(1) @.e; end; return diff --git a/Task/Sorting-algorithms-Insertion-sort/00DESCRIPTION b/Task/Sorting-algorithms-Insertion-sort/00DESCRIPTION index 4cf82f29aa..85baf59cc6 100644 --- a/Task/Sorting-algorithms-Insertion-sort/00DESCRIPTION +++ b/Task/Sorting-algorithms-Insertion-sort/00DESCRIPTION @@ -1,6 +1,8 @@ {{Sorting Algorithm}} {{wikipedia|Insertion sort}} {{omit from|GUISS}} + +
    An [[O]](''n''2) sorting algorithm which moves elements one at a time into the correct position. The algorithm consists of inserting one element at a time into the previously sorted part of the array, moving higher ranked elements up as necessary. To start off, the first (or smallest, or any arbitrary) element of the unsorted array is considered to be the sorted part. @@ -22,3 +24,4 @@ The algorithm is as follows (from [[wp:Insertion_sort#Algorithm|wikipedia]]): '''done''' Writing the algorithm for integers will suffice. +

    diff --git a/Task/Sorting-algorithms-Insertion-sort/360-Assembly/sorting-algorithms-insertion-sort-1.360 b/Task/Sorting-algorithms-Insertion-sort/360-Assembly/sorting-algorithms-insertion-sort-1.360 new file mode 100644 index 0000000000..d3d2b9a87f --- /dev/null +++ b/Task/Sorting-algorithms-Insertion-sort/360-Assembly/sorting-algorithms-insertion-sort-1.360 @@ -0,0 +1,57 @@ +* Insertion sort 16/06/2016 +INSSORT CSECT + USING INSSORT,R13 base register + B 72(R15) skip savearea + DC 17F'0' savearea + STM R14,R12,12(R13) prolog + ST R13,4(R15) " + ST R15,8(R13) " + LR R13,R15 " + LA R6,2 i=2 + LA R9,A+L'A @a(2) +LOOPI C R6,N do i=2 to n + BH ELOOPI leave i + L R2,0(R9) a(i) + ST R2,V v=a(i) + LR R7,R6 j=i + BCTR R7,0 j=i-1 + LR R8,R9 @a(i) + S R8,=A(L'A) @a(j) +LOOPJ LTR R7,R7 do j=i-1 to 1 by -1 while j>0 + BNH ELOOPJ leave j + L R2,0(R8) a(j) + C R2,V a(j)>v + BNH ELOOPJ leave j + MVC L'A(L'A,R8),0(R8) a(j+1)=a(j) + BCTR R7,0 j=j-1 + S R8,=A(L'A) @a(j) + B LOOPJ next j +ELOOPJ MVC L'A(L'A,R8),V a(j+1)=v; + LA R6,1(R6) i=i+1 + LA R9,L'A(R9) @a(i) + B LOOPI next i +ELOOPI LA R9,PG pgi=0 + LA R6,1 i=1 + LA R8,A @a(1) +LOOPXI C R6,N do i=1 to n + BH ELOOPXI leave i + L R1,0(R8) a(i) + XDECO R1,XDEC edit a(i) + MVC 0(4,R9),XDEC+8 output a(i) + LA R9,4(R9) pgi=pgi+1 + LA R6,1(R6) i=i+1 + LA R8,L'A(R8) @a(i) + B LOOPXI next i +ELOOPXI XPRNT PG,L'PG print buffer + L R13,4(0,R13) epilog + LM R14,R12,12(R13) " + XR R15,R15 " + BR R14 exit +A DC F'4',F'65',F'2',F'-31',F'0',F'99',F'2',F'83',F'782',F'1' + DC F'45',F'82',F'69',F'82',F'104',F'58',F'88',F'112',F'89',F'74' +V DS F variable +N DC A((V-A)/L'A) n=hbound(a) +PG DC CL80' ' buffer +XDEC DS CL12 for xdeco + YREGS symbolics for registers + END INSSORT diff --git a/Task/Sorting-algorithms-Insertion-sort/360-Assembly/sorting-algorithms-insertion-sort-2.360 b/Task/Sorting-algorithms-Insertion-sort/360-Assembly/sorting-algorithms-insertion-sort-2.360 new file mode 100644 index 0000000000..cfc3120e5e --- /dev/null +++ b/Task/Sorting-algorithms-Insertion-sort/360-Assembly/sorting-algorithms-insertion-sort-2.360 @@ -0,0 +1,53 @@ +* Insertion sort 16/06/2016 +INSSORTS CSECT + USING INSSORTS,R13 base register + B 72(R15) skip savearea + DC 17F'0' savearea + STM R14,R12,12(R13) prolog + ST R13,4(R15) " + ST R15,8(R13) " + LR R13,R15 " + LA R6,2 i=2 + LA R9,A+L'A @a(2) + DO WHILE=(C,R6,LE,N) do while i<=n + L R2,0(R9) a(i) + ST R2,V v=a(i) + LR R7,R6 j=i + BCTR R7,0 j=i-1 + LR R8,R9 @a(i) + S R8,=A(L'A) @a(j) + L R2,0(R8) a(j) + DO WHILE=(C,R7,GT,0,AND,C,R2,GT,V) do while j>0 & a(j)>v + MVC L'A(L'A,R8),0(R8) a(j+1)=a(j) + BCTR R7,0 j=j-1 + S R8,=A(L'A) @a(j) + L R2,0(R8) a(j) + ENDDO , next j + MVC L'A(L'A,R8),V a(j+1)=v; + LA R6,1(R6) i=i+1 + LA R9,L'A(R9) @a(i) + ENDDO , next i + LA R9,PG pgi=0 + LA R6,1 i=1 + LA R8,A @a(1) + DO WHILE=(C,R6,LE,N) do while i<=n + L R1,0(R8) a(i) + XDECO R1,XDEC edit a(i) + MVC 0(4,R9),XDEC+8 output a(i) + LA R9,4(R9) pgi=pgi+1 + LA R6,1(R6) i=i+1 + LA R8,L'A(R8) @a(i) + ENDDO , next i + XPRNT PG,L'PG print buffer + L R13,4(0,R13) epilog + LM R14,R12,12(R13) " + XR R15,R15 " + BR R14 exit +A DC F'4',F'65',F'2',F'-31',F'0',F'99',F'2',F'83',F'782',F'1' + DC F'45',F'82',F'69',F'82',F'104',F'58',F'88',F'112',F'89',F'74' +V DS F variable +N DC A((V-A)/L'A) n=hbound(a) +PG DC CL80' ' buffer +XDEC DS CL12 for xdeco + YREGS symbolics for registers + END INSSORTS diff --git a/Task/Sorting-algorithms-Insertion-sort/C/sorting-algorithms-insertion-sort.c b/Task/Sorting-algorithms-Insertion-sort/C/sorting-algorithms-insertion-sort.c index 725ef7f776..772f851e58 100644 --- a/Task/Sorting-algorithms-Insertion-sort/C/sorting-algorithms-insertion-sort.c +++ b/Task/Sorting-algorithms-Insertion-sort/C/sorting-algorithms-insertion-sort.c @@ -1,14 +1,15 @@ #include -void insertion_sort (int *a, int n) { - int i, j, t; - for (i = 1; i < n; i++) { - t = a[i]; - for (j = i; j > 0 && t < a[j - 1]; j--) { - a[j] = a[j - 1]; - } - a[j] = t; - } +void insertion_sort(int *a, int n) { + for(size_t i = 1; i < n; ++i) { + int tmp = a[i]; + size_t j = i; + while(j > 0 && tmp < a[j - 1]) { + a[j] = a[j - 1]; + --j; + } + a[j] = tmp; + } } int main () { diff --git a/Task/Sorting-algorithms-Insertion-sort/COBOL/sorting-algorithms-insertion-sort.cobol b/Task/Sorting-algorithms-Insertion-sort/COBOL/sorting-algorithms-insertion-sort-1.cobol similarity index 100% rename from Task/Sorting-algorithms-Insertion-sort/COBOL/sorting-algorithms-insertion-sort.cobol rename to Task/Sorting-algorithms-Insertion-sort/COBOL/sorting-algorithms-insertion-sort-1.cobol diff --git a/Task/Sorting-algorithms-Insertion-sort/COBOL/sorting-algorithms-insertion-sort-2.cobol b/Task/Sorting-algorithms-Insertion-sort/COBOL/sorting-algorithms-insertion-sort-2.cobol new file mode 100644 index 0000000000..ab1eecd2df --- /dev/null +++ b/Task/Sorting-algorithms-Insertion-sort/COBOL/sorting-algorithms-insertion-sort-2.cobol @@ -0,0 +1,70 @@ + >>SOURCE FORMAT FREE +*> This code is dedicated to the public domain +*> This is GNUCOBOL 2.0 +identification division. +program-id. insertionsort. +environment division. +configuration section. +repository. function all intrinsic. +data division. +working-storage section. +01 filler. + 03 a pic 99. + 03 a-lim pic 99 value 10. + 03 array occurs 10 pic 99. + +01 filler. + 03 s pic 99. + 03 o pic 99. + 03 o1 pic 99. + 03 sorted-len pic 99. + 03 sorted-lim pic 99 value 10. + 03 sorted-array occurs 10 pic 99. + +procedure division. +start-insertionsort. + + *> fill the array + compute a = random(seconds-past-midnight) + perform varying a from 1 by 1 until a > a-lim + compute array(a) = random() * 100 + end-perform + + *> display the array + perform varying a from 1 by 1 until a > a-lim + display space array(a) with no advancing + end-perform + display space 'initial array' + + *> sort the array + move 0 to sorted-len + perform varying a from 1 by 1 until a > a-lim + *> find the insertion point + perform varying s from 1 by 1 + until s > sorted-len + or array(a) <= sorted-array(s) + continue + end-perform + + *>open the insertion point + perform varying o from sorted-len by -1 + until o < s + compute o1 = o + 1 + move sorted-array(o) to sorted-array(o1) + end-perform + + *> move the array-entry to the insertion point + move array(a) to sorted-array(s) + + add 1 to sorted-len + end-perform + + *> display the sorted array + perform varying s from 1 by 1 until s > sorted-lim + display space sorted-array(s) with no advancing + end-perform + display space 'sorted array' + + stop run + . +end program insertionsort. diff --git a/Task/Sorting-algorithms-Insertion-sort/Clojure/sorting-algorithms-insertion-sort-1.clj b/Task/Sorting-algorithms-Insertion-sort/Clojure/sorting-algorithms-insertion-sort-1.clj new file mode 100644 index 0000000000..1f5b8d3416 --- /dev/null +++ b/Task/Sorting-algorithms-Insertion-sort/Clojure/sorting-algorithms-insertion-sort-1.clj @@ -0,0 +1,6 @@ +(defn insertion-sort [coll] + (reduce (fn [result input] + (let [[less more] (split-with #(< % input) result)] + (concat less [input] more))) + [] + coll)) diff --git a/Task/Sorting-algorithms-Insertion-sort/Clojure/sorting-algorithms-insertion-sort.clj b/Task/Sorting-algorithms-Insertion-sort/Clojure/sorting-algorithms-insertion-sort-2.clj similarity index 100% rename from Task/Sorting-algorithms-Insertion-sort/Clojure/sorting-algorithms-insertion-sort.clj rename to Task/Sorting-algorithms-Insertion-sort/Clojure/sorting-algorithms-insertion-sort-2.clj diff --git a/Task/Sorting-algorithms-Insertion-sort/Kotlin/sorting-algorithms-insertion-sort.kotlin b/Task/Sorting-algorithms-Insertion-sort/Kotlin/sorting-algorithms-insertion-sort.kotlin new file mode 100644 index 0000000000..b40ceb38d7 --- /dev/null +++ b/Task/Sorting-algorithms-Insertion-sort/Kotlin/sorting-algorithms-insertion-sort.kotlin @@ -0,0 +1,27 @@ +fun insertionSort(array: IntArray) { + for (index in 1 until array.size) { + val value = array[index] + var subIndex = index - 1 + while (subIndex >= 0 && array[subIndex] > value) { + array[subIndex + 1] = array[subIndex] + subIndex-- + } + array[subIndex + 1] = value + } +} + +fun main(args: Array) { + val numbers = intArrayOf(5, 2, 3, 17, 12, 1, 8, 3, 4, 9, 7) + + fun printArray(message: String, array: IntArray) = with(array) { + print("$message [") + forEachIndexed { index, number -> + print(if (index == lastIndex) number else "$number, ") + } + println("]") + } + + printArray("Unsorted:", numbers) + insertionSort(numbers) + printArray("Sorted:", numbers) +} diff --git a/Task/Sorting-algorithms-Insertion-sort/PL-I/sorting-algorithms-insertion-sort.pli b/Task/Sorting-algorithms-Insertion-sort/PL-I/sorting-algorithms-insertion-sort.pli index 86cf34574b..a1bfc3ec4a 100644 --- a/Task/Sorting-algorithms-Insertion-sort/PL-I/sorting-algorithms-insertion-sort.pli +++ b/Task/Sorting-algorithms-Insertion-sort/PL-I/sorting-algorithms-insertion-sort.pli @@ -1,14 +1,12 @@ -INSSORT: PROCEDURE (A); - DCL A(*) FIXED BIN(31); - DCL (I, J, V, N) FIXED BIN(31); +INSSORT: PROC(A); + DCL A(*) FIXED BIN(31); + DCL (I,J,V,N,M) FIXED BIN(31); N = HBOUND(A,1); M = LBOUND(A,1); DO I=M+1 TO N; V=A(I); - J=I-1; - DO WHILE (J > M-1); - if A(J) <= V then leave; - A(J+1)=A(J); J=J-1; + DO J=I-1 BY -1 WHILE (J>M-1 & A(J)>V); + A(J+1)=A(J); END; A(J+1)=V; END; diff --git a/Task/Sorting-algorithms-Insertion-sort/REBOL/sorting-algorithms-insertion-sort.rebol b/Task/Sorting-algorithms-Insertion-sort/REBOL/sorting-algorithms-insertion-sort.rebol new file mode 100644 index 0000000000..d3dcd7a077 --- /dev/null +++ b/Task/Sorting-algorithms-Insertion-sort/REBOL/sorting-algorithms-insertion-sort.rebol @@ -0,0 +1,39 @@ +; This program works with REBOL version R2 and R3, to make it work with Red +; change the word func to function +insertion-sort: func [ + a [block!] + /local i [integer!] j [integer!] n [integer!] + value [integer! string! date!] +][ + i: 2 + n: length? a + + while [i <= n][ + value: a/:i + j: i + while [ all [ 1 < j + value < a/(j - 1) ]][ + + a/:j: a/(j - 1) + j: j - 1 + ] + a/:j: value + i: i + 1 + ] + a +] + +probe insertion-sort [4 2 1 6 9 3 8 7] + +probe insertion-sort [ "---Monday's Child Is Fair of Face (by Mother Goose)---" + "Monday's child is fair of face;" + "Tuesday's child is full of grace;" + "Wednesday's child is full of woe;" + "Thursday's child has far to go;" + "Friday's child is loving and giving;" + "Saturday's child works hard for a living;" + "But the child that is born on the Sabbath day" + "Is blithe and bonny, good and gay."] + +; just by adding the date! type to the local variable value the same function can sort dates. +probe insertion-sort [12-Jan-2015 11-Jan-2015 11-Jan-2016 12-Jan-2014] diff --git a/Task/Sorting-algorithms-Insertion-sort/REXX/sorting-algorithms-insertion-sort.rexx b/Task/Sorting-algorithms-Insertion-sort/REXX/sorting-algorithms-insertion-sort.rexx index 7b0a13986d..e77740586d 100644 --- a/Task/Sorting-algorithms-Insertion-sort/REXX/sorting-algorithms-insertion-sort.rexx +++ b/Task/Sorting-algorithms-Insertion-sort/REXX/sorting-algorithms-insertion-sort.rexx @@ -1,30 +1,30 @@ -/*REXX program sorts a stemmed array using the insertion sort algorithm. */ -call gen /*generate the array's elements. */ -call show 'before sort' /*display the before array elements. */ -say copies('▒',79) /*display a separator line (a fence). */ -call insertionSort # /*invoke the insertion sort. */ -call show ' after sort' /*display the after array elements. */ -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────GEN subroutine────────────────────────────*/ -gen: @.=; @.1 = "---Monday's Child Is Fair of Face (by Mother Goose)---" - @.2 = "Monday's child is fair of face;" - @.3 = "Tuesday's child is full of grace;" - @.4 = "Wednesday's child is full of woe;" - @.5 = "Thursday's child has far to go;" - @.6 = "Friday's child is loving and giving;" - @.7 = "Saturday's child works hard for a living;" - @.8 = "But the child that is born on the Sabbath day" - @.9 = "Is blithe and bonny, good and gay." - do #=1 while @.#\==''; end; #=#-1 /*determine how many entries in @ array*/ -return -/*──────────────────────────────────INSERTIONSORT subroutine──────────────────*/ -insertionSort: procedure expose @.; parse arg # - do i=2 to #; $=@.i - do j=i-1 by -1 while j\==0 & @.j>$ - _=j+1; @._=@.j - end /*j*/ - _=j+1; @._=$ - end /*i*/ -return -/*──────────────────────────────────SHOW subroutine───────────────────────────*/ -show: do j=1 for #; say 'element' right(j,length(#)) arg(1)': ' @.j; end; return +/*REXX program sorts a stemmed array (has characters) using the insertion sort algorithm*/ +call gen /*generate the array's (data) elements.*/ +call show 'before sort' /*display the before array elements. */ +say copies('▒', 85) /*display a separator line (a fence). */ +call insertionSort # /*invoke the insertion sort. */ +call show ' after sort' /*display the after array elements. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +gen: @.=; @.1 = "---Monday's Child Is Fair of Face (by Mother Goose)---" + @.2 = "=======================================================" + @.3 = "Monday's child is fair of face;" + @.4 = "Tuesday's child is full of grace;" + @.5 = "Wednesday's child is full of woe;" + @.6 = "Thursday's child has far to go;" + @.7 = "Friday's child is loving and giving;" + @.8 = "Saturday's child works hard for a living;" + @.9 = "But the child that is born on the Sabbath day" + @.10 = "Is blithe and bonny, good and gay." + do #=1 while @.#\==''; end; #=#-1 /*determine how many entries in @ array*/ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +insertionSort: procedure expose @.; parse arg # + do i=2 to #; $=@.i; do j=i-1 by -1 to 1 while @.j>$ + _=j+1; @._=@.j + end /*j*/ + _=j+1; @._=$ + end /*i*/ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +show: do j=1 for #; say ' element' right(j,length(#)) arg(1)": " @.j; end; return diff --git a/Task/Sorting-algorithms-Insertion-sort/Racket/sorting-algorithms-insertion-sort.rkt b/Task/Sorting-algorithms-Insertion-sort/Racket/sorting-algorithms-insertion-sort.rkt index 1156fcf505..0186c243e3 100644 --- a/Task/Sorting-algorithms-Insertion-sort/Racket/sorting-algorithms-insertion-sort.rkt +++ b/Task/Sorting-algorithms-Insertion-sort/Racket/sorting-algorithms-insertion-sort.rkt @@ -1,9 +1,9 @@ #lang racket (define (sort < l) - (define (insert x y) - (match* (x y) - [(x '()) (list x)] - [(x (cons y ys)) (cond [(< x y) (list* x y ys)] - [else (cons y (insert x ys))])])) + (define (insert x ys) + (match ys + [(list) (list x)] + [(cons y rst) (cond [(< x y) (cons x ys)] + [else (cons y (insert x rst))])])) (foldl insert '() l)) diff --git a/Task/Sorting-algorithms-Merge-sort/00DESCRIPTION b/Task/Sorting-algorithms-Merge-sort/00DESCRIPTION index a23fa523ed..ea1e7d6807 100644 --- a/Task/Sorting-algorithms-Merge-sort/00DESCRIPTION +++ b/Task/Sorting-algorithms-Merge-sort/00DESCRIPTION @@ -1,11 +1,25 @@ -{{Sorting Algorithm}}[[Category:Recursion]]The '''merge sort''' is a recursive sort of order n*log(n). -It is notable for having a worst case and average complexity of ''O(n*log(n))'', and a best case complexity of ''O(n)'' (for pre-sorted input). -The basic idea is to split the collection into smaller groups by halving it until the groups only have one element or no elements (which are both entirely sorted groups). -Then merge the groups back together so that their elements are in order. -This is how the algorithm gets its "divide and conquer" description. +{{Sorting Algorithm}} +[[Category:Recursion]] +The   '''merge sort'''   is a recursive sort of order   n*log(n). + +It is notable for having a worst case and average complexity of   ''O(n*log(n))'',   and a best case complexity of   ''O(n)''   (for pre-sorted input). + +The basic idea is to split the collection into smaller groups by halving it until the groups only have one element or no elements   (which are both entirely sorted groups). + +Then merge the groups back together so that their elements are in order. + +This is how the algorithm gets its   ''divide and conquer''   description. + + +;Task: Write a function to sort a collection of integers using the merge sort. -The merge sort algorithm comes in two parts: a sort function and a merge function. + + +The merge sort algorithm comes in two parts: + a sort function and + a merge function + The functions in pseudocode look like this: '''function''' ''mergesort''(m) '''var''' list left, right, result @@ -40,6 +54,10 @@ The functions in pseudocode look like this: '''append''' rest(right) '''to''' result '''return''' result -For more information see [[wp:Merge_sort|Wikipedia]] -Note: better performance can be expected if, rather than recursing until length(m) ≤ 1, an insertion sort is used for length(m) smaller than some threshold larger than 1. However, this complicates example code, so is not shown here. +;See also: +*   the Wikipedia entry:   [[wp:Merge_sort| merge sort]] + + +Note:   better performance can be expected if, rather than recursing until   length(m) ≤ 1,   an insertion sort is used for   length(m)   smaller than some threshold larger than   '''1'''.   However, this complicates the example code, so it is not shown here. +

    diff --git a/Task/Sorting-algorithms-Merge-sort/360-Assembly/sorting-algorithms-merge-sort.360 b/Task/Sorting-algorithms-Merge-sort/360-Assembly/sorting-algorithms-merge-sort.360 new file mode 100644 index 0000000000..6e8ef22e75 --- /dev/null +++ b/Task/Sorting-algorithms-Merge-sort/360-Assembly/sorting-algorithms-merge-sort.360 @@ -0,0 +1,164 @@ +* Merge sort 19/06/2016 +MAIN CSECT + STM R14,R12,12(R13) save caller's registers + LR R12,R15 set R12 as base register + USING MAIN,R12 notify assembler + LA R11,SAVEXA get the address of my savearea + ST R13,4(R11) save caller's save area pointer + ST R11,8(R13) save my save area pointer + LR R13,R11 set R13 to point to my save area + LA R1,1 1 + LA R2,NN hbound(a) + BAL R14,SPLIT call split(1,hbound(a)) + LA RPGI,PG pgi=0 + LA RI,1 i=1 + DO WHILE=(C,RI,LE,=A(NN)) do i=1 to hbound(a) + LR R1,RI i + SLA R1,2 . + L R2,A-4(R1) a(i) + XDECO R2,XDEC edit a(i) + MVC 0(4,RPGI),XDEC+8 output a(i) + LA RPGI,4(RPGI) pgi=pgi+4 + LA RI,1(RI) i=i+1 + ENDDO , end do + XPRNT PG,80 print buffer + L R13,SAVEXA+4 restore caller's savearea address + LM R14,R12,12(R13) restore caller's registers + XR R15,R15 set return code to 0 + BR R14 return to caller +* split(istart,iend) ------recursive--------------------- +SPLIT STM R14,R12,12(R13) save all registers + LR R9,R1 save R1 + LA R1,72 amount of storage required + GETMAIN RU,LV=(R1) allocate storage for stack + USING STACK,R10 make storage addressable + LR R10,R1 establish stack addressability + LA R11,SAVEXB get the address of my savearea + ST R13,4(R11) save caller's save area pointer + ST R11,8(R13) save my save area pointer + LR R13,R11 set R13 to point to my save area + LR R1,R9 restore R1 + LR RSTART,R1 istart=R1 + LR REND,R2 iend=R2 + IF CR,REND,EQ,RSTART THEN if iend=istart + B RETURN return + ENDIF , end if + BCTR R2,0 iend-1 + IF C,R2,EQ,RSTART THEN if iend-istart=1 + LR R1,REND iend + SLA R1,2 . + L R2,A-4(R1) a(iend) + LR R1,RSTART istart + SLA R1,2 . + L R3,A-4(R1) a(istart) + IF CR,R2,LT,R3 THEN if a(iend)jend + LR R1,RI i + SLA R1,2 . + L R4,B-4(R1) r4=b(i) + LR R1,RJ j + SLA R1,2 . + L R3,A-4(R1) r3=a(j) + LR R9,RK k + SLA R9,2 r9 for a(k) + IF CR,R4,LE,R3 THEN if b(i)<=a(j) + ST R4,A-4(R9) a(k)=b(i) + LA RI,1(RI) i=i+1 + ELSE , else + ST R3,A-4(R9) a(k)=a(j) + LA RJ,1(RJ) j=j+1 + ENDIF , end if + LA RK,1(RK) k=k+1 + ENDDO , end do + DO WHILE=(CR,RI,LT,RBS) do while i m(List, erlang:system_info(schedulers)). + +m([L],_) -> [L]; +m(L, N) when N > 1 -> + {L1,L2} = lists:split(length(L) div 2, L), + {Parent, Ref} = {self(), make_ref()}, + spawn(fun()-> Parent ! {l1, Ref, m(L1, N-2)} end), + spawn(fun()-> Parent ! {l2, Ref, m(L2, N-2)} end), + {L1R, L2R} = receive_results(Ref, undefined, undefined), + lists:merge(L1R, L2R); +m(L, _) -> {L1,L2} = lists:split(length(L) div 2, L), lists:merge(m(L1, 0), m(L2, 0)). + +receive_results(Ref, L1, L2) -> + receive + {l1, Ref, L1R} when L2 == undefined -> receive_results(Ref, L1R, L2); + {l2, Ref, L2R} when L1 == undefined -> receive_results(Ref, L1, L2R); + {l1, Ref, L1R} -> {L1R, L2}; + {l2, Ref, L2R} -> {L1, L2R} + after 5000 -> receive_results(Ref, L1, L2) + end. diff --git a/Task/Sorting-algorithms-Merge-sort/JavaScript/sorting-algorithms-merge-sort.js b/Task/Sorting-algorithms-Merge-sort/JavaScript/sorting-algorithms-merge-sort.js index 08bc244205..b71f580071 100644 --- a/Task/Sorting-algorithms-Merge-sort/JavaScript/sorting-algorithms-merge-sort.js +++ b/Task/Sorting-algorithms-Merge-sort/JavaScript/sorting-algorithms-merge-sort.js @@ -12,21 +12,19 @@ function merge(left, right, arr) { } } -function mSort(arr, tmp, len) { +function mergeSort(arr) { + var len = arr.length; + if (len === 1) { return; } - var m = Math.floor(len / 2), - tmp_l = tmp.slice(0, m), - tmp_r = tmp.slice(m); + var mid = Math.floor(len / 2), + left = arr.slice(0, mid), + right = arr.slice(mid); - mSort(tmp_l, arr.slice(0, m), m); - mSort(tmp_r, arr.slice(m), len - m); - merge(tmp_l, tmp_r, arr); -} - -function merge_sort(arr) { - mSort(arr, arr.slice(), arr.length); + mergeSort(left); + mergeSort(right); + merge(left, right, arr); } var arr = [1, 5, 2, 7, 3, 9, 4, 6, 8]; -merge_sort(arr); // arr will now: 1, 2, 3, 4, 5, 6, 7, 8, 9 +mergeSort(arr); // arr will now: 1, 2, 3, 4, 5, 6, 7, 8, 9 diff --git a/Task/Sorting-algorithms-Merge-sort/Kotlin/sorting-algorithms-merge-sort.kotlin b/Task/Sorting-algorithms-Merge-sort/Kotlin/sorting-algorithms-merge-sort.kotlin new file mode 100644 index 0000000000..34e609a422 --- /dev/null +++ b/Task/Sorting-algorithms-Merge-sort/Kotlin/sorting-algorithms-merge-sort.kotlin @@ -0,0 +1,50 @@ +fun mergeSort(list: List): List { + if (list.size <= 1) { + return list + } + + val left = mutableListOf() + val right = mutableListOf() + + val middle = list.size / 2 + list.forEachIndexed { index, number -> + if (index < middle) { + left.add(number) + } else { + right.add(number) + } + } + + fun merge(left: List, right: List): List = mutableListOf().apply { + var indexLeft = 0 + var indexRight = 0 + + while (indexLeft < left.size && indexRight < right.size) { + if (left[indexLeft] <= right[indexRight]) { + add(left[indexLeft]) + indexLeft++ + } else { + add(right[indexRight]) + indexRight++ + } + } + + while (indexLeft < left.size) { + add(left[indexLeft]) + indexLeft++ + } + + while (indexRight < right.size) { + add(right[indexRight]) + indexRight++ + } + } + + return merge(mergeSort(left), mergeSort(right)) +} + +fun main(args: Array) { + val numbers = listOf(5, 2, 3, 17, 12, 1, 8, 3, 4, 9, 7) + println("Unsorted: $numbers") + println("Sorted: ${mergeSort(numbers)}") +} diff --git a/Task/Sorting-algorithms-Merge-sort/Lua/sorting-algorithms-merge-sort.lua b/Task/Sorting-algorithms-Merge-sort/Lua/sorting-algorithms-merge-sort.lua new file mode 100644 index 0000000000..0e33729756 --- /dev/null +++ b/Task/Sorting-algorithms-Merge-sort/Lua/sorting-algorithms-merge-sort.lua @@ -0,0 +1,22 @@ +function getLower(a,b) + local i,j=1,1 + return function() + if not b[j] or a[i] and a[i]@.h then do; _=@.h; @.h=@.L; @.L=_; end - return - end -m=n%2 /*cut N in half (integer div.)*/ -call mergeTo@ L+m,n-m /*divide items to the left ···*/ -call mergeTo! L,m,1 /* " " " " right ···*/ -i=1; j=L+m; do k=L while k@.h then do; q=_; _=q+1; end - !._=@.L; !.q=@.h - return /*done with special case of N=2.*/ - end -m=n%2 /*cut N in half (integer div).*/ -call mergeTo@ L,m /*divide items to the left ···*/ -call mergeTo! L+m,n-m,m+_ /* " " " " right ···*/ -i=L; j=m+_; do k=_ while k@.h then do; _=@.h; @.h=@.L; @.L=_; end; return; end + m=n%2 /* [↑] handle case of two items.*/ + call mergeTo@ L+m,n-m /*divide items to the left ···*/ + call mergeTo! L,m,1 /* " " " " right ···*/ + i=1; j=L+m; do k=L while k(x1: &[T], x2: &[T], y: &mut [T]) { + assert_eq!(x1.len() + x2.len(), y.len()); + let mut i = 0; + let mut j = 0; + let mut k = 0; + while i < x1.len() && j < x2.len() { + if x1[i] < x2[j] { + y[k] = x1[i]; + k += 1; + i += 1; + } else { + y[k] = x2[j]; + k += 1; + j += 1; + } + } + if i < x1.len() { + y[k..].copy_from_slice(&x1[i..]); + } + if j < x2.len() { + y[k..].copy_from_slice(&x2[j..]); + } +} diff --git a/Task/Sorting-algorithms-Merge-sort/Rust/sorting-algorithms-merge-sort-2.rust b/Task/Sorting-algorithms-Merge-sort/Rust/sorting-algorithms-merge-sort-2.rust new file mode 100644 index 0000000000..b59c8d4aec --- /dev/null +++ b/Task/Sorting-algorithms-Merge-sort/Rust/sorting-algorithms-merge-sort-2.rust @@ -0,0 +1,17 @@ +fn merge_sort_rec(x: &mut [T]) { + let n = x.len(); + let m = n / 2; + + if n <= 1 { + return; + } + + merge_sort_rec(&mut x[0..m]); + merge_sort_rec(&mut x[m..n]); + + let mut y: Vec = x.to_vec(); + + merge(&x[0..m], &x[m..n], &mut y[..]); + + x.copy_from_slice(&y); +} diff --git a/Task/Sorting-algorithms-Merge-sort/Rust/sorting-algorithms-merge-sort-3.rust b/Task/Sorting-algorithms-Merge-sort/Rust/sorting-algorithms-merge-sort-3.rust new file mode 100644 index 0000000000..3fa928a3cb --- /dev/null +++ b/Task/Sorting-algorithms-Merge-sort/Rust/sorting-algorithms-merge-sort-3.rust @@ -0,0 +1,35 @@ +fn merge_sort(x: &mut [T]) { + let n = x.len(); + let mut y = x.to_vec(); + let mut len = 1; + while len < n { + let mut i = 0; + while i < n { + if i + len >= n { + y[i..].copy_from_slice(&x[i..]); + } else if i + 2 * len > n { + merge(&x[i..i+len], &x[i+len..], &mut y[i..]); + } else { + merge(&x[i..i+len], &x[i+len..i+2*len], &mut y[i..i+2*len]); + } + i += 2 * len; + } + len *= 2; + if len >= n { + x.copy_from_slice(&y); + return; + } + i = 0; + while i < n { + if i + len >= n { + x[i..].copy_from_slice(&y[i..]); + } else if i + 2 * len > n { + merge(&y[i..i+len], &y[i+len..], &mut x[i..]); + } else { + merge(&y[i..i+len], &y[i+len..i+2*len], &mut x[i..i+2*len]); + } + i += 2 * len; + } + len *= 2; + } +} diff --git a/Task/Sorting-algorithms-Pancake-sort/00DESCRIPTION b/Task/Sorting-algorithms-Pancake-sort/00DESCRIPTION index a0a87c3b6a..d3d3d66782 100644 --- a/Task/Sorting-algorithms-Pancake-sort/00DESCRIPTION +++ b/Task/Sorting-algorithms-Pancake-sort/00DESCRIPTION @@ -1,5 +1,9 @@ {{Sorting Algorithm}} -Sort an array of integers (of any convenient size) into ascending order using [[wp:Pancake sorting|Pancake sorting]]. In short, instead of individual elements being sorted, the only operation allowed is to "flip" one end of the list, like so: + +;Task: +Sort an array of integers (of any convenient size) into ascending order using [[wp:Pancake sorting|Pancake sorting]]. + +In short, instead of individual elements being sorted, the only operation allowed is to "flip" one end of the list, like so: Before: '''6 7 8 9''' 2 5 3 4 1 After: @@ -14,3 +18,4 @@ For more information on pancake sorting, see [[wp:Pancake sorting|the Wikipedia See also: * [[Number reversal game]] * [[Topswops]] +

    diff --git a/Task/Sorting-algorithms-Pancake-sort/Lua/sorting-algorithms-pancake-sort.lua b/Task/Sorting-algorithms-Pancake-sort/Lua/sorting-algorithms-pancake-sort.lua new file mode 100644 index 0000000000..90b7372499 --- /dev/null +++ b/Task/Sorting-algorithms-Pancake-sort/Lua/sorting-algorithms-pancake-sort.lua @@ -0,0 +1,65 @@ +-- Initialisation +math.randomseed(os.time()) +numList = {step = 0, sorted = 0} + +-- Create list of n random values +function numList:build (n) + self.values = {} + for i = 1, n do self.values[i] = math.random(-100, 100) end +end + +-- Return boolean indicating whether the list is in order +function numList:isSorted () + for i = 2, #self.values do + if self.values[i] < self.values[i - 1] then return false end + end + print("Finished!") + return true +end + +-- Display list of numbers on one line +function numList:show () + if self.step == 0 then + io.write("Initial state:\t") + else + io.write("After step " .. self.step .. ":\t") + end + for _, v in ipairs(self.values) do io.write(v .. " ") end + print() +end + +-- Reverse n values from the left +function numList:reverse (n) + local flipped = {} + for i, v in ipairs(self.values) do + if i > n then + flipped[i] = v + else + flipped[i] = self.values[n + 1 - i] + end + end + self.values = flipped +end + +-- Perform one flip of a pancake sort +function numList:pancake () + local maxPos = 1 + for i = 1, #self.values - self.sorted do + if self.values[i] > self.values[maxPos] then maxPos = i end + end + if maxPos == 1 then + numList:reverse(#self.values - self.sorted) + self.sorted = self.sorted + 1 + else + numList:reverse(maxPos) + end + self.step = self.step + 1 +end + +-- Main procedure +numList:build(10) +numList:show() +repeat + numList:pancake() + numList:show() +until numList:isSorted() diff --git a/Task/Sorting-algorithms-Pancake-sort/REXX/sorting-algorithms-pancake-sort.rexx b/Task/Sorting-algorithms-Pancake-sort/REXX/sorting-algorithms-pancake-sort.rexx index 4ffabd0047..4a3f3e76a9 100644 --- a/Task/Sorting-algorithms-Pancake-sort/REXX/sorting-algorithms-pancake-sort.rexx +++ b/Task/Sorting-algorithms-Pancake-sort/REXX/sorting-algorithms-pancake-sort.rexx @@ -1,35 +1,32 @@ -/*REXX program sorts and displays an array using the pancake sort algorithm.*/ -call gen /*generate elements in the @. array.*/ -call show 'before sort' /*display the BEFORE array elements.*/ -say copies('▒',40) /*display a separator line for eyeballs*/ -call pancakeSort # /*invoke the pancake sort. Yummy. */ -call show ' after sort' /*display the AFTER array elements. */ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -flip: procedure expose @.; parse arg y - do i=1 for (y+1)%2; ymp=y-i+1; _=@.i; @.i=@.ymp; @.ymp=_ - end /*i*/ -return -/*────────────────────────────────────────────────────────────────────────────*/ -gen: fibs= '-55 -21 -1 -8 -8 -21 -55 0 0' /*some non─positive Fibonacci numbers, most of which are repeated. */ - /* ┌───◄ a few sorted bread primes which are primes of the form: (p-3)÷2 and 2∙p+3 */ - /* ↓ where p is a prime. Bread primes are related to sandwich and meat primes.*/ -bp=2 17 5 29 7 37 13 61 43 181 47 197 67 277 97 397 113 461 137 557 167 677 173 701 797 1117 307 1237 1597 463 1861 467 -$=bp fibs; #=words($) /*combine the two lists; get # of items*/ - /* [↓] populate the @. array with #s*/ - do j=1 for #; @.j=word($,j); end /*◄─── obtain a number from the $ list.*/ -return -/*────────────────────────────────────────────────────────────────────────────*/ +/*REXX program sorts and displays an array using the pancake sort algorithm. */ +call gen /*generate elements in the @. array.*/ +call show 'before sort' /*display the BEFORE array elements.*/ +say copies('▒', 60) /*display a separator line for eyeballs*/ +call pancakeSort # /*invoke the pancake sort. Yummy. */ +call show ' after sort' /*display the AFTER array elements. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +flip: parse arg y; do i=1 for (y+1)%2; yyy=y-i+1; _=@.i; @.i=@.yyy; @.yyy=_; end + return /*swap: ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑ */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +gen: fibs= '-55 -21 -1 -8 -8 -21 -55 0 0' /*some non─positive Fibonacci numbers, */ + @element=right('element',21) /* most of which are repeated. + ┌◄─┬──◄─ some paired bread primes which are of the form: (p-3)÷2 and 2∙p+3 + │ │ where p is a prime. Bread primes are related to sandwich & meat primes. + ↓ ↓ ──── ──── ───── ────── ────── ────── ────── ─────── ─────── ─────── ──────*/ + bp=2 17 5 29 7 37 13 61 43 181 47 197 67 277 97 397 113 461 137 557 167 677 173 701, + 797 1117 307 1237 1597 463 1861 467 + $=bp fibs; #=words($) /*combine the two lists; get # of items*/ + do j=1 for #; @.j=word($,j); end /*◄─── obtain a number from the $ list.*/ + return /* [↑] populate the @. array with #s*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ pancakeSort: procedure expose @.; parse arg N - - do N=N by -1 for N-1 - !=@.1; ?=1; do j=2 to N; if @.j<=! then iterate - !=@.j; ?=j - end /*j*/ - call flip ?; call flip N - end /*N*/ -return -/*────────────────────────────────────────────────────────────────────────────*/ -show: w=length(#) /* [↓] display elements of @. array.*/ - do k=1 for #; say ' element' right(k,w) arg(1)':' right(@.k,9); end -return + do N=N by -1 for N-1 + !=@.1; ?=1; do j=2 to N; if @.j<=! then iterate + !=@.j; ?=j + end /*j*/ + call flip ?; call flip N + end /*N*/ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +show: do k=1 for #; say @element right(k,length(#)) arg(1)':' right(@.k,9); end; return diff --git a/Task/Sorting-algorithms-Permutation-sort/00DESCRIPTION b/Task/Sorting-algorithms-Permutation-sort/00DESCRIPTION index f8fbab014b..e531382c55 100644 --- a/Task/Sorting-algorithms-Permutation-sort/00DESCRIPTION +++ b/Task/Sorting-algorithms-Permutation-sort/00DESCRIPTION @@ -1,9 +1,12 @@ {{Sorting Algorithm}} {{omit from|GUISS}} -Permutation sort, which proceeds by generating the possible permutations + +;Task: +Implement a permutation sort, which proceeds by generating the possible permutations of the input array/list until discovering the sorted one. Pseudocode: '''while not''' InOrder(list) '''do''' nextPermutation(list) '''done''' +

    diff --git a/Task/Sorting-algorithms-Permutation-sort/Elixir/sorting-algorithms-permutation-sort.elixir b/Task/Sorting-algorithms-Permutation-sort/Elixir/sorting-algorithms-permutation-sort.elixir new file mode 100644 index 0000000000..2cc27d8b90 --- /dev/null +++ b/Task/Sorting-algorithms-Permutation-sort/Elixir/sorting-algorithms-permutation-sort.elixir @@ -0,0 +1,18 @@ +defmodule Sort do + def permutation_sort([]), do: [] + def permutation_sort(list) do + Enum.find(permutation(list), fn [h|t] -> in_order?(t, h) end) + end + + defp permutation([]), do: [[]] + defp permutation(list) do + for x <- list, y <- permutation(list -- [x]), do: [x|y] + end + + defp in_order?([], _), do: true + defp in_order?([h|_], pre) when h +The best pivot creates partitions of equal length (or lengths differing by   '''1'''). + +The worst pivot creates an empty partition (for example, if the pivot is the first or last element of a sorted array). + +The run-time of Quicksort ranges from   ''[[O]](n ''log'' n)''   with the best pivots, to   ''[[O]](n2)''   with the worst pivots, where   ''n''   is the number of elements in the array. -The best pivot creates partitions of equal length (or lengths differing by 1). The worst pivot creates an empty partition (for example, if the pivot is the first or last element of a sorted array). The runtime of Quicksort ranges from ''[[O]](n ''log'' n)'' with the best pivots, to ''[[O]](n2)'' with the worst pivots, where ''n'' is the number of elements in the array. This is a simple quicksort algorithm, adapted from Wikipedia. @@ -48,7 +61,7 @@ A better quicksort algorithm works in place, by swapping elements within the arr quicksort(array '''from first index to''' right) quicksort(array '''from''' left '''to last index''') -Quicksort has a reputation as the fastest sort. Optimized variants of quicksort are common features of many languages and libraries. One often contrasts quicksort with [[../Merge sort|merge sort]], because both sorts have an average time of ''[[O]](n ''log'' n)''. +Quicksort has a reputation as the fastest sort. Optimized variants of quicksort are common features of many languages and libraries. One often contrasts quicksort with   [[../Merge sort|merge sort]],   because both sorts have an average time of   ''[[O]](n ''log'' n)''. : ''"On average, mergesort does fewer comparisons than quicksort, so it may be better when complicated comparison routines are used. Mergesort also takes advantage of pre-existing order, so it would be favored for using sort() to merge several sorted arrays. On the other hand, quicksort is often faster for small arrays, and on arrays of a few distinct values, repeated many times."'' — http://perldoc.perl.org/sort.html @@ -57,6 +70,8 @@ Quicksort is at one end of the spectrum of divide-and-conquer algorithms, with m * Quicksort is a conquer-then-divide algorithm, which does most of the work during the partitioning and the recursive calls. The subsequent reassembly of the sorted partitions involves trivial effort. * Merge sort is a divide-then-conquer algorithm. The partioning happens in a trivial way, by splitting the input array in half. Most of the work happens during the recursive calls and the merge phase. +
    With quicksort, every element in the first partition is less than or equal to every element in the second partition. Therefore, the merge phase of quicksort is so trivial that it needs no mention! This task has not specified whether to allocate new arrays, or sort in place. This task also has not specified how to choose the pivot element. (Common ways to are to choose the first element, the middle element, or the median of three elements.) Thus there is a variety among the following implementations. +

    diff --git a/Task/Sorting-algorithms-Quicksort/360-Assembly/sorting-algorithms-quicksort.360 b/Task/Sorting-algorithms-Quicksort/360-Assembly/sorting-algorithms-quicksort.360 index 02478bd0e8..615c7ad23e 100644 --- a/Task/Sorting-algorithms-Quicksort/360-Assembly/sorting-algorithms-quicksort.360 +++ b/Task/Sorting-algorithms-Quicksort/360-Assembly/sorting-algorithms-quicksort.360 @@ -1,11 +1,16 @@ -* quicksort 14/09/2015 +* Quicksort 14/09/2015 & 23/06/2016 QUICKSOR CSECT - USING QUICKSOR,R15 set base register -BEGIN MVC A,=F'1' a(1)=1 - MVC B,=A((A-T)/4) b(1)=hbound(t) + USING QUICKSOR,R13 base register + B 72(R15) skip savearea + DC 17F'0' savearea + STM R14,R12,12(R13) prolog + ST R13,4(R15) " + ST R15,8(R13) " + LR R13,R15 " + MVC A,=A(1) a(1)=1 + MVC B,=A(NN) b(1)=hbound(t) L R6,=F'1' k=1 -WHILEK LTR R6,R6 do while k^=0 - BZ EWHILEK + DO WHILE=(LTR,R6,NZ,R6) do while k<>0 ================== LR R1,R6 k SLA R1,2 ~ L R10,A-4(R1) l=a(k) @@ -15,7 +20,7 @@ WHILEK LTR R6,R6 do while k^=0 BCTR R6,0 k=k-1 LR R4,R11 m C R4,=F'2' if m<2 - BL WHILEK then iterate + BL ITERATE then iterate LR R2,R10 l AR R2,R11 +m BCTR R2,0 -1 @@ -33,74 +38,72 @@ WHILEK LTR R6,R6 do while k^=0 LR R1,R10 l SLA R1,2 ~ L R3,T-4(R1) r3=t(l) -IF CR R4,R3 if t(x)t(l) - BNH IFXELIF - LR R7,R3 p=t(l) - B EIFX -IFXELIF LR R7,R5 p=t(y) - L R1,Y y - SLA R1,2 ~ - ST R3,T-4(R1) t(y)=t(l) -EIFX B ENDIF -ELSE CR R5,R3 if t(y)t(x) - BNH IFYELIF - LR R7,R4 p=t(x) - L R1,X x - SLA R1,2 ~ - ST R3,T-4(R1) t(x)=t(l) - B ENDIF -IFYELIF LR R7,R5 p=t(y) - L R1,Y y - SLA R1,2 ~ - ST R3,T-4(R1) t(y)=t(l) -ENDIF LA R8,1(R10) i=l+1 + IF CR,R4,LT,R3 if t(x)t(l) | + LR R7,R3 p=t(l) | + ELSE , else | + LR R7,R5 p=t(y) | + L R1,Y y | + SLA R1,2 ~ | + ST R3,T-4(R1) t(y)=t(l) | + ENDIF , end if | + ELSE , else | + IF CR,R5,LT,R3 if t(y)t(x) | + LR R7,R4 p=t(x) | + L R1,X x | + SLA R1,2 ~ | + ST R3,T-4(R1) t(x)=t(l) | + ELSE , else | + LR R7,R5 p=t(y) | + L R1,Y y | + SLA R1,2 ~ | + ST R3,T-4(R1) t(y)=t(l) | + ENDIF , end if | + ENDIF , end if ---+ + LA R8,1(R10) i=l+1 L R9,X j=x -FOREVER EQU * -LOOPWI CR R8,R9 i<=j - BH ELOOPWI - LR R1,R8 i - SLA R1,2 ~ - L R2,T-4(R1) t(i) - CR R2,R7 t(i)<=p - BH ELOOPWI - LA R8,1(R8) i=i+1 - B LOOPWI -ELOOPWI EQU * -LOOPWJ CR R8,R9 i=p - BL ELOOPWJ - BCTR R9,0 j=j-1 - B LOOPWJ -ELOOPWJ CR R8,R9 if i>=j - BNL EFOREVER then leave segment finished - LR R1,R8 i - SLA R1,2 ~ - LA R2,T-4(R1) @t(i) - LR R1,R9 j - SLA R1,2 ~ - LA R3,T-4(R1) @t(j) - L R0,0(R2) w=t(i) - MVC 0(4,R2),0(R3) t(i)=t(j) swap t(i),t(j) - ST R0,0(R3) t(j)=w - B FOREVER -EFOREVER LR R9,R8 j=i +FOREVER EQU * do forever --------------------+ + LR R1,R8 i | + SLA R1,2 ~ | + LA R2,T-4(R1) @t(i) | + L R0,0(R2) t(i) | + DO WHILE=(CR,R8,LE,R9,AND, while i<=j and ---+ | X + CR,R0,LE,R7) t(i)<=p | | + AH R8,=H'1' i=i+1 | | + AH R2,=H'4' @t(i) | | + L R0,0(R2) t(i) | | + ENDDO , end while ---+ | + LR R1,R9 j | + SLA R1,2 ~ | + LA R2,T-4(R1) @t(j) | + L R0,0(R2) t(j) | + DO WHILE=(CR,R8,LT,R9,AND, while i=p | | + SH R9,=H'1' j=j-1 | | + SH R2,=H'4' @t(j) | | + L R0,0(R2) t(j) | | + ENDDO , end while ---+ | + CR R8,R9 if i>=j | + BNL LEAVE then leave (segment finished) | + LR R1,R8 i | + SLA R1,2 ~ | + LA R2,T-4(R1) @t(i) | + LR R1,R9 j | + SLA R1,2 ~ | + LA R3,T-4(R1) @t(j) | + L R0,0(R2) w=t(i) + | + MVC 0(4,R2),0(R3) t(i)=t(j) |swap t(i),t(j) | + ST R0,0(R3) t(j)=w + | + B FOREVER end do forever ----------------+ +LEAVE EQU * + LR R9,R8 j=i BCTR R9,0 j=i-1 LR R1,R9 j SLA R1,2 ~ @@ -115,47 +118,52 @@ EFOREVER LR R9,R8 j=i SLA R1,2 ~ LA R4,A-4(R1) r4=@a(k) LA R5,B-4(R1) r5=@b(k) - C R8,Y if i<=y - BH IFIHY - ST R8,0(R4) a(k)=i - L R2,X x - SR R2,R8 -i - LA R2,1(R2) +1 - ST R2,0(R5) b(k)=x-i+1 - LA R6,1(R6) k=k+1 - ST R10,4(R4) a(k)=l - LR R2,R9 j - SR R2,R10 -l - ST R2,4(R5) b(k)=j-l - B EIFIHY -IFIHY ST R10,4(R4) a(k)=l - LR R2,R9 j - SR R2,R10 -l - ST R2,0(R5) b(k)=j-l - LA R6,1(R6) k=k+1 - ST R8,4(R4) a(k)=i - L R2,X x - SR R2,R8 -i - LA R2,1(R2) +1 - ST R2,4(R5) b(k)=x-i+1 -EIFIHY B WHILEK -EWHILEK LA R3,PG ibuffer + IF C,R8,LE,Y if i<=y ----+ + ST R8,0(R4) a(k)=i | + L R2,X x | + SR R2,R8 -i | + LA R2,1(R2) +1 | + ST R2,0(R5) b(k)=x-i+1 | + LA R6,1(R6) k=k+1 | + ST R10,4(R4) a(k)=l | + LR R2,R9 j | + SR R2,R10 -l | + ST R2,4(R5) b(k)=j-l | + ELSE , else | + ST R10,4(R4) a(k)=l | + LR R2,R9 j | + SR R2,R10 -l | + ST R2,0(R5) b(k)=j-l | + LA R6,1(R6) k=k+1 | + ST R8,4(R4) a(k)=i | + L R2,X x | + SR R2,R8 -i | + LA R2,1(R2) +1 | + ST R2,4(R5) b(k)=x-i+1 | + ENDIF , end if ----+ +ITERATE EQU * + ENDDO , end while ===================== +* *** ********* print sorted table + LA R3,PG ibuffer LA R4,T @t(i) -LOOPI C R4,=A(A) do i=1 to hbound(t) - BH ELOOPI - L R2,0(R4) t(i) - XDECO R2,XD edit t(i) - MVC 0(4,R3),XD+8 put in buffer - LA R3,4(R3) ibuffer=ibuffer+1 - LA R4,4(R4) i=i+1 - B LOOPI -ELOOPI XPRNT PG,80 print bufffer -RETURN XR R15,R15 set return code - BR R14 return to caller + DO WHILE=(C,R4,LE,=A(TEND)) do i=1 to hbound(t) + L R2,0(R4) t(i) + XDECO R2,XD edit t(i) + MVC 0(4,R3),XD+8 put in buffer + LA R3,4(R3) ibuffer=ibuffer+1 + LA R4,4(R4) i=i+1 + ENDDO , end do + XPRNT PG,80 print buffer + L R13,4(0,R13) epilog + LM R14,R12,12(R13) " + XR R15,R15 " + BR R14 exit T DC F'10',F'9',F'9',F'6',F'7',F'16',F'1',F'16',F'17',F'15' DC F'1',F'9',F'18',F'16',F'8',F'20',F'18',F'2',F'19',F'8' -A DS ((A-T)/4)F same size as T -B DS ((A-T)/4)F same size as T +TEND DS 0F +NN EQU (TEND-T)/4) +A DS (NN)F same size as T +B DS (NN)F same size as T X DS F Y DS F PG DS CL80 diff --git a/Task/Sorting-algorithms-Quicksort/AppleScript/sorting-algorithms-quicksort-1.applescript b/Task/Sorting-algorithms-Quicksort/AppleScript/sorting-algorithms-quicksort-1.applescript new file mode 100644 index 0000000000..a41d0374a2 --- /dev/null +++ b/Task/Sorting-algorithms-Quicksort/AppleScript/sorting-algorithms-quicksort-1.applescript @@ -0,0 +1,67 @@ +-- quickSort :: (Ord a) => [a] -> [a] +on quickSort(xs) + if length of xs > 1 then + set {h, t} to uncons(xs) + + -- lessOrEqual :: a -> Bool + script lessOrEqual + on lambda(x) + x ≤ h + end lambda + end script + + set {less, more} to partition(lessOrEqual, t) + + quickSort(less) & h & quickSort(more) + else + xs + end if +end quickSort + + +-- TEST +on run + + quickSort([11.8, 14.1, 21.3, 8.5, 16.7, 5.7]) + + --> {5.7, 8.5, 11.8, 14.1, 16.7, 21.3} + +end run + + + +-- GENERIC FUNCTIONS + +-- partition :: predicate -> List -> (Matches, nonMatches) +-- partition :: (a -> Bool) -> [a] -> ([a], [a]) +on partition(f, xs) + tell mReturn(f) + set lst to {{}, {}} + repeat with x in xs + set v to contents of x + set end of item ((lambda(v) as integer) + 1) of lst to v + end repeat + return {item 2 of lst, item 1 of lst} + end tell +end partition + +-- uncons :: [a] -> Maybe (a, [a]) +on uncons(xs) + if length of xs > 0 then + {item 1 of xs, rest of xs} + else + missing value + end if +end uncons + +-- 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 diff --git a/Task/Sorting-algorithms-Quicksort/AppleScript/sorting-algorithms-quicksort-2.applescript b/Task/Sorting-algorithms-Quicksort/AppleScript/sorting-algorithms-quicksort-2.applescript new file mode 100644 index 0000000000..3b6fb269d6 --- /dev/null +++ b/Task/Sorting-algorithms-Quicksort/AppleScript/sorting-algorithms-quicksort-2.applescript @@ -0,0 +1 @@ +{5.7, 8.5, 11.8, 14.1, 16.7, 21.3} diff --git a/Task/Sorting-algorithms-Quicksort/Erlang/sorting-algorithms-quicksort.erl b/Task/Sorting-algorithms-Quicksort/Erlang/sorting-algorithms-quicksort-1.erl similarity index 100% rename from Task/Sorting-algorithms-Quicksort/Erlang/sorting-algorithms-quicksort.erl rename to Task/Sorting-algorithms-Quicksort/Erlang/sorting-algorithms-quicksort-1.erl diff --git a/Task/Sorting-algorithms-Quicksort/Erlang/sorting-algorithms-quicksort-2.erl b/Task/Sorting-algorithms-Quicksort/Erlang/sorting-algorithms-quicksort-2.erl new file mode 100644 index 0000000000..30e96cf910 --- /dev/null +++ b/Task/Sorting-algorithms-Quicksort/Erlang/sorting-algorithms-quicksort-2.erl @@ -0,0 +1,20 @@ +quick_sort(L) -> qs(L, erlang:system_info(schedulers)). + +qs([],_) -> []; +qs([H|T], N) when N > 1 -> + {Parent, Ref} = {self(), make_ref()}, + spawn(fun()-> Parent ! {l1, Ref, qs([E||E<-T, E Parent ! {l2, Ref, qs([E||E<-T, H =< E], N-2)} end), + {L1, L2} = receive_results(Ref, undefined, undefined), + L1 ++ [H] ++ L2; +qs([H|T],_) -> + qs([E||E<-T, E + receive + {l1, Ref, L1R} when L2 == undefined -> receive_results(Ref, L1R, L2); + {l2, Ref, L2R} when L1 == undefined -> receive_results(Ref, L1, L2R); + {l1, Ref, L1R} -> {L1R, L2}; + {l2, Ref, L2R} -> {L1, L2R} + after 5000 -> receive_results(Ref, L1, L2) + end. diff --git a/Task/Sorting-algorithms-Quicksort/JavaScript/sorting-algorithms-quicksort-1.js b/Task/Sorting-algorithms-Quicksort/JavaScript/sorting-algorithms-quicksort-1.js index 713ba6f034..4700feba27 100644 --- a/Task/Sorting-algorithms-Quicksort/JavaScript/sorting-algorithms-quicksort-1.js +++ b/Task/Sorting-algorithms-Quicksort/JavaScript/sorting-algorithms-quicksort-1.js @@ -9,15 +9,15 @@ function sort(array, less) { function quicksort(left, right) { if (left < right) { - var pivot = array[(left + right) / 1], + var pivot = array[left + Math.floor((right - right) / 2)], left_new = left, right_new = right; do { - while (less(array[left_new], pivot) { + while (less(array[left_new], pivot)) { left_new += 1; } - while (less(pivot, array[right_new]) { + while (less(pivot, array[right_new])) { right_new -= 1; } if (left_new <= right_new) { diff --git a/Task/Sorting-algorithms-Quicksort/JavaScript/sorting-algorithms-quicksort-2.js b/Task/Sorting-algorithms-Quicksort/JavaScript/sorting-algorithms-quicksort-2.js index a5c8c97c33..ae08d32b5f 100644 --- a/Task/Sorting-algorithms-Quicksort/JavaScript/sorting-algorithms-quicksort-2.js +++ b/Task/Sorting-algorithms-Quicksort/JavaScript/sorting-algorithms-quicksort-2.js @@ -1,10 +1,2 @@ -Array.prototype.quick_sort = function () { - if (this.length < 2) { return this; } - - var pivot = this[Math.round(this.length / 2)]; - - return this.filter(x => x < pivot) - .quick_sort() - .concat(this.filter(x => x == pivot)) - .concat(this.filter(x => x > pivot).quick_sort()); -}; +var test_array = [10, 3, 11, 15, 19, 1]; +var sorted_array = sort(test_array, function(a,b) { return a [a] -> [a] + function quickSort(xs) { + + if (xs.length) { + var h = xs[0], + t = xs.slice(1), + + lessMore = partition(function (x) { + return x <= h; + }, t), + less = lessMore[0], + more = lessMore[1]; + + return [].concat.apply( + [], [quickSort(less), h, quickSort(more)] + ); + + } else return []; + } + + + // partition :: Predicate -> List -> (Matches, nonMatches) + // partition :: (a -> Bool) -> [a] -> ([a], [a]) + function partition(p, xs) { + return xs.reduce(function (a, x) { + return ( + a[p(x) ? 0 : 1].push(x), + a + ); + }, [[], []]); + } + + return quickSort([11.8, 14.1, 21.3, 8.5, 16.7, 5.7]) + +})(); diff --git a/Task/Sorting-algorithms-Quicksort/JavaScript/sorting-algorithms-quicksort-5.js b/Task/Sorting-algorithms-Quicksort/JavaScript/sorting-algorithms-quicksort-5.js new file mode 100644 index 0000000000..a5c8c97c33 --- /dev/null +++ b/Task/Sorting-algorithms-Quicksort/JavaScript/sorting-algorithms-quicksort-5.js @@ -0,0 +1,10 @@ +Array.prototype.quick_sort = function () { + if (this.length < 2) { return this; } + + var pivot = this[Math.round(this.length / 2)]; + + return this.filter(x => x < pivot) + .quick_sort() + .concat(this.filter(x => x == pivot)) + .concat(this.filter(x => x > pivot).quick_sort()); +}; diff --git a/Task/Sorting-algorithms-Quicksort/JavaScript/sorting-algorithms-quicksort-6.js b/Task/Sorting-algorithms-Quicksort/JavaScript/sorting-algorithms-quicksort-6.js new file mode 100644 index 0000000000..263f2970ce --- /dev/null +++ b/Task/Sorting-algorithms-Quicksort/JavaScript/sorting-algorithms-quicksort-6.js @@ -0,0 +1,33 @@ +(function () { + 'use strict'; + + // quickSort :: (Ord a) => [a] -> [a] + function quickSort(xs) { + + if (xs.length) { + var h = xs[0], + [less, more] = partition( + x => x <= h, + xs.slice(1) + ); + + return [].concat.apply( + [], [quickSort(less), h, quickSort(more)] + ); + + } else return []; + } + + + // partition :: Predicate -> List -> (Matches, nonMatches) + // partition :: (a -> Bool) -> [a] -> ([a], [a]) + function partition(p, xs) { + return xs.reduce((a, x) => ( + a[p(x) ? 0 : 1].push(x), + a + ), [[], []]); + } + + return quickSort([11.8, 14.1, 21.3, 8.5, 16.7, 5.7]); + +})(); diff --git a/Task/Sorting-algorithms-Quicksort/Kotlin/sorting-algorithms-quicksort.kotlin b/Task/Sorting-algorithms-Quicksort/Kotlin/sorting-algorithms-quicksort-1.kotlin similarity index 100% rename from Task/Sorting-algorithms-Quicksort/Kotlin/sorting-algorithms-quicksort.kotlin rename to Task/Sorting-algorithms-Quicksort/Kotlin/sorting-algorithms-quicksort-1.kotlin diff --git a/Task/Sorting-algorithms-Quicksort/Kotlin/sorting-algorithms-quicksort-2.kotlin b/Task/Sorting-algorithms-Quicksort/Kotlin/sorting-algorithms-quicksort-2.kotlin new file mode 100644 index 0000000000..fee3bb609a --- /dev/null +++ b/Task/Sorting-algorithms-Quicksort/Kotlin/sorting-algorithms-quicksort-2.kotlin @@ -0,0 +1,18 @@ +fun quicksort(list: List): List { + if (list.size == 0) { + return listOf() + } else { + val head = list.first() + val tail = list.takeLast(list.size - 1) + + val less = quicksort(tail.filter { it < head }) + val high = quicksort(tail.filter { it >= head }) + + return less + head + high + } +} + +fun main(args: Array) { + val nums = listOf(9, 7, 9, 8, 1, 2, 3, 4, 1, 9, 8, 9, 2, 4, 2, 4, 6, 3) + println(quicksort(nums)) +} diff --git a/Task/Sorting-algorithms-Quicksort/Lua/sorting-algorithms-quicksort.lua b/Task/Sorting-algorithms-Quicksort/Lua/sorting-algorithms-quicksort-1.lua similarity index 73% rename from Task/Sorting-algorithms-Quicksort/Lua/sorting-algorithms-quicksort.lua rename to Task/Sorting-algorithms-Quicksort/Lua/sorting-algorithms-quicksort-1.lua index e1dbd12f18..a48e70b600 100644 --- a/Task/Sorting-algorithms-Quicksort/Lua/sorting-algorithms-quicksort.lua +++ b/Task/Sorting-algorithms-Quicksort/Lua/sorting-algorithms-quicksort-1.lua @@ -6,13 +6,10 @@ function quicksort(t, start, endi) local pivot = start for i = start + 1, endi do if t[i] <= t[pivot] then - local temp = t[pivot + 1] - t[pivot + 1] = t[pivot] - if(i == pivot + 1) then - t[pivot] = temp + if i == pivot + 1 then + t[pivot],t[pivot+1] = t[pivot+1],t[pivot] else - t[pivot] = t[i] - t[i] = temp + t[pivot],t[pivot+1],t[i] = t[i],t[pivot],t[pivot+1] end pivot = pivot + 1 end diff --git a/Task/Sorting-algorithms-Quicksort/Lua/sorting-algorithms-quicksort-2.lua b/Task/Sorting-algorithms-Quicksort/Lua/sorting-algorithms-quicksort-2.lua new file mode 100644 index 0000000000..7ce0321356 --- /dev/null +++ b/Task/Sorting-algorithms-Quicksort/Lua/sorting-algorithms-quicksort-2.lua @@ -0,0 +1,16 @@ +function quicksort(t) + if #t<2 then return t end + local pivot=t[1] + local a,b,c={},{},{} + for _,v in ipairs(t) do + if vpivot then c[#c+1]=v + else b[#b+1]=v + end + end + a=quicksort(a) + c=quicksort(c) + for _,v in ipairs(b) do a[#a+1]=v end + for _,v in ipairs(c) do a[#a+1]=v end + return a +end diff --git a/Task/Sorting-algorithms-Quicksort/PHP/sorting-algorithms-quicksort.php b/Task/Sorting-algorithms-Quicksort/PHP/sorting-algorithms-quicksort-1.php similarity index 100% rename from Task/Sorting-algorithms-Quicksort/PHP/sorting-algorithms-quicksort.php rename to Task/Sorting-algorithms-Quicksort/PHP/sorting-algorithms-quicksort-1.php diff --git a/Task/Sorting-algorithms-Quicksort/PHP/sorting-algorithms-quicksort-2.php b/Task/Sorting-algorithms-Quicksort/PHP/sorting-algorithms-quicksort-2.php new file mode 100644 index 0000000000..17e14d30d2 --- /dev/null +++ b/Task/Sorting-algorithms-Quicksort/PHP/sorting-algorithms-quicksort-2.php @@ -0,0 +1,18 @@ +function quickSort(array $array) { + // base case + if (empty($array)) { + return $array; + } + $head = array_shift($array); + $tail = $array; + $lesser = array_filter($tail, function ($item) use ($head) { + return $item <= $head; + }); + $bigger = array_filter($tail, function ($item) use ($head) { + return $item > $head; + }); + return array_merge(quickSort($lesser), [$head], quickSort($bigger)); +} +$testCase = [1, 4, 8, 2, 8, 0, 2, 8]; +$result = quickSort($testCase); +echo sprintf("[%s] ==> [%s]\n", implode(', ', $testCase), implode(', ', $result)); diff --git a/Task/Sorting-algorithms-Quicksort/REXX/sorting-algorithms-quicksort-1.rexx b/Task/Sorting-algorithms-Quicksort/REXX/sorting-algorithms-quicksort-1.rexx index 5541edf79a..a52482c1d0 100644 --- a/Task/Sorting-algorithms-Quicksort/REXX/sorting-algorithms-quicksort-1.rexx +++ b/Task/Sorting-algorithms-Quicksort/REXX/sorting-algorithms-quicksort-1.rexx @@ -1,41 +1,41 @@ -/*REXX program sorts a stemmed array using the quicksort algorithm.*/ -call gen@ /*generate the array elements. */ -call show@ 'before sort' /*show before array elements.*/ -call quickSort # /*invoke the quicksort routine.*/ -call show@ ' after sort' /*show after array elements.*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────QUICKSORT subroutine────────────────*/ -quickSort: procedure expose @. /*access the caller's local var. */ -a.1=1; b.1=arg(1); $=1 - - do while $\==0; L=a.$; t=b.$; $=$-1; if t<2 then iterate - h=L+t-1 - ?=L+t%2 - if @.h<@.L then if @.?<@.h then do; p=@.h; @.h=@.L; end - else if @.?>@.L then p=@.L - else do; p=@.?; @.?=@.L; end - else if @.?<@.l then p=@.L - else if @.?>@.h then do; p=@.h; @.h=@.L; end - else do; p=@.?; @.?=@.L; end - j=L+1 - k=h - do forever - do j=j while j<=k & @.j<=p; end /*a tinie-tiny loop*/ - do k=k by -1 while j =p; end /*another " " */ - if j>=k then leave /*segment finished?*/ - _=@.j; @.j=@.k; @.k=_ /*swap j&k elements*/ - end /*forever*/ - - k=j-1; @.L=@.k; @.k=p; $=$+1 - if j<=? then do; a.$=j; b.$=h-j+1; $=$+1; a.$=L; b.$=k-L; end - eLse do; a.$=L; b.$=k-L; $=$+1; a.$=j; b.$=h-j+1; end - end /*whiLe $¬==0*/ - -return -/*──────────────────────────────────GEN@ subroutine─────────────────────*/ -gen@: @.=; maxL=0 /*assign default value for array.*/ -@.1 = " Rivers that form part of a (USA) state's border " /*this value is adjusted later to include a prefix & suffix.*/ -@.2 = '=' /*this value is expanded later. */ +/*REXX program sorts a stemmed array using the quicksort algorithm. */ +call gen@ /*generate the elements for the array. */ +call show@ 'before sort' /*show the before array elements. */ +call qSort # /*invoke the quicksort subroutine. */ +call show@ ' after sort' /*show the after array elements. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +qSort: procedure expose @.; a.1=1; b.1=arg(1) /*access the caller's local variable. */ + $=1 + do while $\==0; L=a.$; t=b.$; $=$-1; if t<2 then iterate + h=L+t-1; ?=L+t%2 + if @.h<@.L then if @.?<@.h then do; p=@.h; @.h=@.L; end + else if @.?>@.L then p=@.L + else do; p=@.?; @.?=@.L; end + else if @.?<@.l then p=@.L + else if @.?>@.h then do; p=@.h; @.h=@.L; end + else do; p=@.?; @.?=@.L; end + j=L+1; k=h + do forever + do j=j while j<=k & @.j<=p; end /*a tinie-tiny loop.*/ + do k=k by -1 while j =p; end /*another " " */ + if j>=k then leave /*segment finished? */ + _=@.j; @.j=@.k; @.k=_ /*swap J&K elements.*/ + end /*forever*/ + $=$+1 + k=j-1; @.L=@.k; @.k=p + if j<=? then do; a.$=j; b.$=h-j+1; $=$+1; a.$=L; b.$=k-L; end + eLse do; a.$=L; b.$=k-L; $=$+1; a.$=j; b.$=h-j+1; end + end /*whiLe $¬==0*/ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +show@: w=length(#); do j=1 for #; say 'element' right(j,w) arg(1)":" @.j; end + say copies('▒', maxL + w + 22) /*display a separator (between outputs)*/ + return +/*──────────────────────────────────GEN@ subroutine──────────────────────────────────────────────────────────────────────────────────────────────────────*/ +gen@: @.=; maxL=0 /*assign default value for array.*/ +@.1 = " Rivers that form part of a (USA) state's border " /*this value is adjusted later to include a prefix & suffix.*/ +@.2 = '=' /*this value is expanded later. */ @.3 = "Perdido River Alabama, Florida" @.4 = "Chattahoochee River Alabama, Georgia" @.5 = "Tennessee River Alabama, Kentucky, Mississippi, Tennessee" @@ -98,17 +98,10 @@ gen@: @.=; maxL=0 /*assign default value for array.*/ @.62 = "Blackwater River North Carolina, Virginia" @.63 = "Columbia River Oregon, Washington" - do #=1 while @.#\=='' /*find how many entries, and also*/ - maxL=max(maxL, length(@.#)) /* find the maximum width entry.*/ - end /*#*/ -#=#-1 /*adjust the highest element #. */ -@.1=centre(@.1, maxL, '-') /*adjust the header information. */ -@.2=copies(@.2, maxL) /*adjust the header separator. */ -return -/*──────────────────────────────────SHOW@ subroutine────────────────────*/ -show@: widthH=length(#) /*maximum width of any line. */ - do j=1 for # /*display each item in the array.*/ - say 'element' right(j,widthH) arg(1)':' @.j - end /*j*/ -say copies('▒', maxL + widthH + 22) /*display a separator line. */ + do #=1 while @.#\=='' /*find how many entries in array, and */ + maxL=max(maxL, length(@.#)) /* also find the maximum width entry.*/ + end /*#*/ +#=#-1 /*adjust the highest element number. */ +@.1=center(@.1, maxL, '-') /* " " header information. */ +@.2=copies(@.2, maxL) /* " " " separator. */ return diff --git a/Task/Sorting-algorithms-Quicksort/Rust/sorting-algorithms-quicksort.rust b/Task/Sorting-algorithms-Quicksort/Rust/sorting-algorithms-quicksort.rust index 7186e10b87..87b3e0c836 100644 --- a/Task/Sorting-algorithms-Quicksort/Rust/sorting-algorithms-quicksort.rust +++ b/Task/Sorting-algorithms-Quicksort/Rust/sorting-algorithms-quicksort.rust @@ -1,4 +1,4 @@ -// Type alias for function that returns true if arguments are in the correct order +// Type alias for function that returns true if arguments should be swapped type OrderFunc = Fn(&T, &T) -> bool; fn main() { @@ -6,25 +6,24 @@ fn main() { let mut numbers = [4, 65, 2, -31, 0, 99, 2, 83, 782, 1]; println!("Before: {:?}", numbers); - quick_sort(&mut numbers, &f); + quick_sort(&mut numbers, &is_less); println!("After: {:?}", numbers); // Sort strings let mut strings = ["beach", "hotel", "airplane", "car", "house", "art"]; println!("Before: {:?}", strings); - quick_sort(&mut strings, &f); + quick_sort(&mut strings, &is_less); println!("After: {:?}", strings); } + // Example OrderFunc which is used to order items from least to greatest -#[inline] -fn f(x: &T, y: &T) -> bool { +#[inline(always)] +fn is_less(x: &T, y: &T) -> bool { x < y } -// We use in place quick sort -// For details see http://en.wikipedia.org/wiki/Quicksort#In-place_version fn quick_sort(v: &mut [T], f: &OrderFunc) { let len = v.len(); @@ -41,9 +40,6 @@ fn quick_sort(v: &mut [T], f: &OrderFunc) { quick_sort(&mut v[pivot_index + 1..len], f); } -// Reorders the slice with values lower than the pivot at the left side, -// and values bigger than it at the right side. -// Also returns the store index. fn partition(v: &mut [T], f: &OrderFunc) -> usize { let len = v.len(); let pivot_index = len / 2; diff --git a/Task/Sorting-algorithms-Quicksort/Scala/sorting-algorithms-quicksort-1.scala b/Task/Sorting-algorithms-Quicksort/Scala/sorting-algorithms-quicksort-1.scala index 56f0ab8fff..2c64a84289 100644 --- a/Task/Sorting-algorithms-Quicksort/Scala/sorting-algorithms-quicksort-1.scala +++ b/Task/Sorting-algorithms-Quicksort/Scala/sorting-algorithms-quicksort-1.scala @@ -1,7 +1,11 @@ -def quicksortInt(coll: List[Int]): List[Int] = - if (coll.isEmpty) { - coll - } else { - val (smaller, bigger) = coll.tail partition (_ < coll.head) - quicksortInt(smaller) ::: coll.head :: quicksortInt(bigger) + def sort(xs: List[Int]): List[Int] = { + xs match { + case Nil => Nil + case x :: xx => { + // Arbitrarily partition list in two + val (lo, hi) = xx.partition(_ < x) + // Sort each half + sort(lo) ++ (x :: sort(hi)) + } + } } diff --git a/Task/Sorting-algorithms-Quicksort/Scala/sorting-algorithms-quicksort-2.scala b/Task/Sorting-algorithms-Quicksort/Scala/sorting-algorithms-quicksort-2.scala index 6e6f4d60bd..7e14349b53 100644 --- a/Task/Sorting-algorithms-Quicksort/Scala/sorting-algorithms-quicksort-2.scala +++ b/Task/Sorting-algorithms-Quicksort/Scala/sorting-algorithms-quicksort-2.scala @@ -1,7 +1,9 @@ -def quicksortFunc[T](coll: List[T], lessThan: (T, T) => Boolean): List[T] = - if (coll.isEmpty) { - coll - } else { - val (smaller, bigger) = coll.tail partition (lessThan(_, coll.head)) - quicksortFunc(smaller, lessThan) ::: coll.head :: quicksortFunc(bigger, lessThan) + def sort[T](xs: List[T], lessThan: (T, T) => Boolean): List[T] = { + xs match { + case Nil => Nil + case x :: xx => { + val (lo, hi) = xx.partition(lessThan(_, x)) + sort(lo, lessThan) ++ (x :: sort(hi, lessThan)) + } + } } diff --git a/Task/Sorting-algorithms-Quicksort/Scala/sorting-algorithms-quicksort-3.scala b/Task/Sorting-algorithms-Quicksort/Scala/sorting-algorithms-quicksort-3.scala index 7044d1793c..d9852a8808 100644 --- a/Task/Sorting-algorithms-Quicksort/Scala/sorting-algorithms-quicksort-3.scala +++ b/Task/Sorting-algorithms-Quicksort/Scala/sorting-algorithms-quicksort-3.scala @@ -1,7 +1,9 @@ -def quicksortOrd[T <% Ordered[T]](coll: List[T]): List[T] = - if (coll.isEmpty) { - coll - } else { - val (smaller, bigger) = coll.tail partition (_ < coll.head) - quicksortOrd(smaller) ::: coll.head :: quicksortOrd(bigger) + def sort[T](xs: List[T])(implicit ord: Ordering[T]): List[T] = { + xs match { + case Nil => Nil + case x :: xx => { + val (lo, hi) = xx.partition(ord.lt(_, x)) + sort[T](lo) ++ (x :: sort[T](hi)) + } + } } diff --git a/Task/Sorting-algorithms-Quicksort/Scala/sorting-algorithms-quicksort-4.scala b/Task/Sorting-algorithms-Quicksort/Scala/sorting-algorithms-quicksort-4.scala index 330d4ba3b4..9566964a80 100644 --- a/Task/Sorting-algorithms-Quicksort/Scala/sorting-algorithms-quicksort-4.scala +++ b/Task/Sorting-algorithms-Quicksort/Scala/sorting-algorithms-quicksort-4.scala @@ -1,11 +1,9 @@ -def quicksort - [T, CC[X] <: Seq[X] with SeqLike[X, CC[X]]] // My type parameters - (coll: CC[T]) // My explicit parameter - (implicit o: T => Ordered[T], cbf: CanBuildFrom[CC[T], T, CC[T]]) // My implicit parameters - : CC[T] = // My return type - if (coll.isEmpty) { - coll - } else { - val (smaller, bigger) = coll.tail partition (_ < coll.head) - quicksort(smaller) ++ (coll.head +: quicksort(bigger)) + def sort[T <: Ordered[T]](xs: List[T]): List[T] = { + xs match { + case Nil => Nil + case x :: xx => { + val (lo, hi) = xx.partition(_ < x) + sort(lo) ++ (x :: sort(hi)) + } + } } diff --git a/Task/Sorting-algorithms-Quicksort/Scala/sorting-algorithms-quicksort-5.scala b/Task/Sorting-algorithms-Quicksort/Scala/sorting-algorithms-quicksort-5.scala index 037306b269..7324e24f7c 100644 --- a/Task/Sorting-algorithms-Quicksort/Scala/sorting-algorithms-quicksort-5.scala +++ b/Task/Sorting-algorithms-Quicksort/Scala/sorting-algorithms-quicksort-5.scala @@ -1,7 +1,17 @@ -def quicksortInt(list: List[Int]): List[Int] = list match { - case List(head) => list - case head :: tail => - val (smaller, bigger) = tail partition (_ < head) - quicksortInt(smaller) ::: head :: quicksortInt(bigger) - case _ => list + def sort[T, C[T] <: scala.collection.TraversableLike[T, C[T]]] + (xs: C[T]) + (implicit ord: scala.math.Ordering[T], + cbf: scala.collection.generic.CanBuildFrom[C[T], T, C[T]]): C[T] = { + // Some collection types can't pattern match + if (xs.isEmpty) { + xs + } else { + val (lo, hi) = xs.tail.partition(ord.lt(_, xs.head)) + val b = cbf() + b.sizeHint(xs.size) + b ++= sort(lo) + b += xs.head + b ++= sort(hi) + b.result() + } } diff --git a/Task/Sorting-algorithms-Quicksort/Standard-ML/sorting-algorithms-quicksort.ml b/Task/Sorting-algorithms-Quicksort/Standard-ML/sorting-algorithms-quicksort.ml index c222db7c74..277efbe60e 100644 --- a/Task/Sorting-algorithms-Quicksort/Standard-ML/sorting-algorithms-quicksort.ml +++ b/Task/Sorting-algorithms-Quicksort/Standard-ML/sorting-algorithms-quicksort.ml @@ -5,3 +5,26 @@ fun quicksort [] = [] in quicksort left @ [x] @ quicksort right end + +------------------------------------------------------------ + +Solution 2: + +Without using List.partition + +fun par_helper([], x, l, r) = (l, r) | + par_helper(h::t, x, l, r) = + if h <= x then + par_helper(t, x, l @ [h], r) + else + par_helper(t, x, l, r @ [h]); + +fun par(l, x) = par_helper(l, x, [], []); + +fun quicksort [] = [] + | quicksort (h::t) = + let + val (left, right) = par(t, h) + in + quicksort left @ [h] @ quicksort right + end; diff --git a/Task/Sorting-algorithms-Radix-sort/00DESCRIPTION b/Task/Sorting-algorithms-Radix-sort/00DESCRIPTION index 0dff29f3ec..671c697250 100644 --- a/Task/Sorting-algorithms-Radix-sort/00DESCRIPTION +++ b/Task/Sorting-algorithms-Radix-sort/00DESCRIPTION @@ -1,2 +1,8 @@ {{Sorting Algorithm}} -In this task, the goal is to sort an integer array with the [[wp:Radix sort|radix sort algorithm]]. The primary purpose is to complete the characterization of sort algorithms task. + + +;Task: +Sort an integer array with the   [[wp:Radix sort|radix sort algorithm]]. + +The primary purpose is to complete the characterization of sort algorithms task. +

    diff --git a/Task/Sorting-algorithms-Radix-sort/Perl-6/sorting-algorithms-radix-sort.pl6 b/Task/Sorting-algorithms-Radix-sort/Perl-6/sorting-algorithms-radix-sort.pl6 index da1424f9fc..a4eb14319d 100644 --- a/Task/Sorting-algorithms-Radix-sort/Perl-6/sorting-algorithms-radix-sort.pl6 +++ b/Task/Sorting-algorithms-Radix-sort/Perl-6/sorting-algorithms-radix-sort.pl6 @@ -5,7 +5,7 @@ sub radsort (@ints) { for reverse ^$maxlen -> $r { my @buckets = @list.classify( *.substr($r,1) ).sort: *.key; if !$r and @buckets[0].key eq '-' { @buckets[0].value .= reverse } - @list = map *.value.values, @buckets; + @list = flat map *.value.values, @buckets; } @list».Int; } diff --git a/Task/Sorting-algorithms-Selection-sort/00DESCRIPTION b/Task/Sorting-algorithms-Selection-sort/00DESCRIPTION index 6d2a50816b..85e4eb852d 100644 --- a/Task/Sorting-algorithms-Selection-sort/00DESCRIPTION +++ b/Task/Sorting-algorithms-Selection-sort/00DESCRIPTION @@ -1,8 +1,21 @@ {{Sorting Algorithm}} -In this task, the goal is to sort an [[array]] (or list) of elements using the Selection sort algorithm. It works as follows: + +;Task: +Sort an [[array]] (or list) of elements using the Selection sort algorithm. + + +It works as follows: First find the smallest element in the array and exchange it with the element in the first position, then find the second smallest element and exchange it with the element in the second position, and continue in this way until the entire array is sorted. -Its asymptotic complexity is [[O]](n2) making it inefficient on large arrays. Its primary purpose is for when writing data is very expensive (slow) when compared to reading, eg. writing to flash memory or EEPROM. + + +Its asymptotic complexity is   [[O]](n2)   making it inefficient on large arrays. + +Its primary purpose is for when writing data is very expensive (slow) when compared to reading, eg. writing to flash memory or EEPROM. + No other sorting algorithm has less data movement. -For more information see the article on [[wp:Selection_sort|Wikipedia]]. + +;Reference: +* Wikipedia:   [[wp:Selection_sort|Selection sort]] +

    diff --git a/Task/Sorting-algorithms-Selection-sort/360-Assembly/sorting-algorithms-selection-sort.360 b/Task/Sorting-algorithms-Selection-sort/360-Assembly/sorting-algorithms-selection-sort.360 new file mode 100644 index 0000000000..7595f86626 --- /dev/null +++ b/Task/Sorting-algorithms-Selection-sort/360-Assembly/sorting-algorithms-selection-sort.360 @@ -0,0 +1,61 @@ +* Selection sort 26/06/2016 +SELECSRT CSECT + USING SELECSRT,R13 base register + B 72(R15) skip savearea + DC 17F'0' savearea + STM R14,R12,12(R13) prolog + ST R13,4(R15) " + ST R15,8(R13) " + LR R13,R15 " + LA RJ,1 j=1 + DO WHILE=(C,RJ,LE,N) do j=1 to n + LR RK,RJ k=j + LR R1,RJ j + SLA R1,2 . + LA R3,A-4(R1) @a(j) + L RT,0(R3) temp=a(j) + LA RI,1(RJ) i=j+1 + DO WHILE=(C,RI,LE,N) do i=j+1 to n + LR R1,RI i + SLA R1,2 . + L R2,A-4(R1) a(i) + IF CR,RT,GT,R2 THEN if temp>a(i) then + LR RT,R2 temp=a(i) + LR RK,RI k=i + ENDIF , end if + LA RI,1(RI) i=i+1 + ENDDO , end do + L R0,0(R3) a(j) + LR R1,RK k + SLA R1,2 . + ST R0,A-4(R1) a(k)=a(j) + ST RT,0(R3) a(j)=temp; + LA RJ,1(RJ) j=j+1 + ENDDO , end do + LA R3,PG pgi=0 + LA RI,1 i=1 + DO WHILE=(C,RI,LE,N) do i=1 to n + LR R1,RI i + SLA R1,2 . + L R2,A-4(R1) a(i) + XDECO R2,XDEC edit a(i) + MVC 0(4,R3),XDEC+8 output a(i) + LA R3,4(R3) pgi=pgi+4 + LA RI,1(RI) i=i+1 + ENDDO , end do + XPRNT PG,L'PG print buffer + L R13,4(0,R13) epilog + LM R14,R12,12(R13) " + XR R15,R15 " + BR R14 exit +A DC F'4',F'65',F'2',F'-31',F'0',F'99',F'2',F'83',F'782',F'1' + DC F'45',F'82',F'69',F'82',F'104',F'58',F'88',F'112',F'89',F'74' +N DC A((N-A)/L'A) number of items of a +PG DC CL80' ' buffer +XDEC DS CL12 temp for xdeco + YREGS +RI EQU 6 i +RJ EQU 7 j +RK EQU 8 k +RT EQU 9 temp + END SELECSRT diff --git a/Task/Sorting-algorithms-Selection-sort/Haskell/sorting-algorithms-selection-sort.hs b/Task/Sorting-algorithms-Selection-sort/Haskell/sorting-algorithms-selection-sort.hs index c126b5add5..a1f6fc9567 100644 --- a/Task/Sorting-algorithms-Selection-sort/Haskell/sorting-algorithms-selection-sort.hs +++ b/Task/Sorting-algorithms-Selection-sort/Haskell/sorting-algorithms-selection-sort.hs @@ -1,7 +1,6 @@ +import Data.List (delete) + selSort :: (Ord a) => [a] -> [a] selSort [] = [] -selSort xs = let x = maximum xs in selSort (remove x xs) ++ [x] - where remove _ [] = [] - remove a (x:xs) - | x == a = xs - | otherwise = x : remove a xs +selSort xs = selSort (delete x xs) ++ [x] + where x = maximum xs diff --git a/Task/Sorting-algorithms-Selection-sort/JavaScript/sorting-algorithms-selection-sort.js b/Task/Sorting-algorithms-Selection-sort/JavaScript/sorting-algorithms-selection-sort.js new file mode 100644 index 0000000000..7cbb9fe171 --- /dev/null +++ b/Task/Sorting-algorithms-Selection-sort/JavaScript/sorting-algorithms-selection-sort.js @@ -0,0 +1,17 @@ +function selectionSort(nums) { + var len = nums.length; + for(var i = 0; i < len; i++) { + var minAt = i; + for(var j = i + 1; j < len; j++) { + if(nums[j] < nums[minAt]) + minAt = j; + } + + if(minAt != i) { + var temp = nums[i]; + nums[i] = nums[minAt]; + nums[minAt] = temp; + } + } + return nums; +} diff --git a/Task/Sorting-algorithms-Selection-sort/Kotlin/sorting-algorithms-selection-sort.kotlin b/Task/Sorting-algorithms-Selection-sort/Kotlin/sorting-algorithms-selection-sort.kotlin new file mode 100644 index 0000000000..ff8ce6d950 --- /dev/null +++ b/Task/Sorting-algorithms-Selection-sort/Kotlin/sorting-algorithms-selection-sort.kotlin @@ -0,0 +1,28 @@ +fun > Array.selection_sort() { + for (i in 0..size - 2) { + var k = i + for (j in i + 1..size - 1) + if (this[j] < this[k]) + k = j + + if (k != i) { + val tmp = this[i] + this[i] = this[k] + this[k] = tmp + } + } +} + +fun main(args: Array) { + val i = arrayOf(4, 9, 3, -2, 0, 7, -5, 1, 6, 8) + i.selection_sort() + println(i.joinToString()) + + val s = Array(i.size, { -i[it].toShort() }) + s.selection_sort() + println(s.joinToString()) + + val c = arrayOf('z', 'h', 'd', 'c', 'a') + c.selection_sort() + println(c.joinToString()) +} diff --git a/Task/Sorting-algorithms-Selection-sort/Perl-6/sorting-algorithms-selection-sort.pl6 b/Task/Sorting-algorithms-Selection-sort/Perl-6/sorting-algorithms-selection-sort-1.pl6 similarity index 100% rename from Task/Sorting-algorithms-Selection-sort/Perl-6/sorting-algorithms-selection-sort.pl6 rename to Task/Sorting-algorithms-Selection-sort/Perl-6/sorting-algorithms-selection-sort-1.pl6 diff --git a/Task/Sorting-algorithms-Selection-sort/Perl-6/sorting-algorithms-selection-sort-2.pl6 b/Task/Sorting-algorithms-Selection-sort/Perl-6/sorting-algorithms-selection-sort-2.pl6 new file mode 100644 index 0000000000..168184e8f7 --- /dev/null +++ b/Task/Sorting-algorithms-Selection-sort/Perl-6/sorting-algorithms-selection-sort-2.pl6 @@ -0,0 +1,6 @@ +sub selectionSort(@tmp) { + for ^@tmp -> $i { + my $min = $i; @tmp[$i, $_] = @tmp[$_, $i] if @tmp[$min] > @tmp[$_] for $i^..^@tmp; + } + return @tmp; +} diff --git a/Task/Sorting-algorithms-Selection-sort/REXX/sorting-algorithms-selection-sort.rexx b/Task/Sorting-algorithms-Selection-sort/REXX/sorting-algorithms-selection-sort.rexx index 3ffe26c8fc..2092864b0b 100644 --- a/Task/Sorting-algorithms-Selection-sort/REXX/sorting-algorithms-selection-sort.rexx +++ b/Task/Sorting-algorithms-Selection-sort/REXX/sorting-algorithms-selection-sort.rexx @@ -1,35 +1,29 @@ -/*REXX program sorts a stemmed array using the selection-sort algorithm.*/ -@. = /*assign a default value to stem.*/ -@.1 = '---The seven hills of Rome:---' -@.2 = '==============================' -@.3 = 'Caelian' -@.4 = 'Palatine' -@.5 = 'Capitoline' -@.6 = 'Virminal' -@.7 = 'Esquiline' -@.8 = 'Quirinal' -@.9 = 'Aventine' - do k=1 until @.k=='' /*find the number of array items.*/ - end /*k*/ /* [↑] find the "null" item. */ -items=k-1 /*adjust the # of items slightly.*/ -call show@ 'before sort' /*show the before array elements,*/ -call selectionSort items /*invoke the selection sort. */ -call show@ ' after sort' /*show the after array elements.*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────SELECTIONSORT subroutine────────────*/ +/*REXX program sorts a stemmed array using the selection-sort algorithm. */ +@.=; @.1 = '---The seven hills of Rome:---' + @.2 = '==============================' + @.3 = 'Caelian' + @.4 = 'Palatine' + @.5 = 'Capitoline' + @.6 = 'Virminal' + @.7 = 'Esquiline' + @.8 = 'Quirinal' + @.9 = 'Aventine' + do #=1 until @.#==''; end; #=#-1 /*find the number of items in the array*/ + /* [↑] adjust # ('cause of DO index)*/ +call show 'before sort' /*show the before array elements. */ +say copies('▒', 65) /*show a nice separator line (fence). */ +call selectionSort # /*invoke selection sort (and # items). */ +call show ' after sort' /*show the after array elements. */ +exit /*stick a fork in it, we're a;; done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ selectionSort: procedure expose @.; parse arg n - - do j=1 for n-1 - _=@.j; p=j; do k=j+1 to n - if @.k<_ then do; _=@.k; p=k; end - end /*k*/ - if p==j then iterate /*if the same, order of items OK.*/ - _=@.j; @.j=@.p; @.p=_ /*swap two items out-of-sequence.*/ - end /*j*/ -return -/*──────────────────────────────────SHOW@ subroutine────────────────────*/ -show@: w=length(items); do i=1 for items - say 'element' right(i,w) arg(1)":" @.i - end /*i*/ -say copies('─',79) /*show a nice separator line. */ -return + do j=1 for n-1 + _=@.j; p=j; do k=j+1 to n + if @.k<_ then do; _=@.k; p=k; end + end /*k*/ + if p==j then iterate /*if the same, the order of items OK. */ + _=@.j; @.j=@.p; @.p=_ /*swap 2 items that're out-of-sequence.*/ + end /*j*/ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +show: do i=1 for #; say ' element' right(i,length(#)) arg(1)":" @.i; end; return diff --git a/Task/Sorting-algorithms-Selection-sort/Scala/sorting-algorithms-selection-sort-3.scala b/Task/Sorting-algorithms-Selection-sort/Scala/sorting-algorithms-selection-sort-3.scala new file mode 100644 index 0000000000..cbce99016a --- /dev/null +++ b/Task/Sorting-algorithms-Selection-sort/Scala/sorting-algorithms-selection-sort-3.scala @@ -0,0 +1,15 @@ +def selectionSort[T <% Ordered[T]](list: List[T]): List[T] = { + def remove(e: T, list: List[T]): List[T] = + list match { + case Nil => Nil + case x :: xs if x == e => xs + case x :: xs => x :: remove(e, xs) + } + + list match { + case Nil => Nil + case _ => + val min = list.min + min :: selectionSort(remove(min, list)) + } +} diff --git a/Task/Sorting-algorithms-Shell-sort/00DESCRIPTION b/Task/Sorting-algorithms-Shell-sort/00DESCRIPTION index 7e8bde9ccb..8a5e3a8463 100644 --- a/Task/Sorting-algorithms-Shell-sort/00DESCRIPTION +++ b/Task/Sorting-algorithms-Shell-sort/00DESCRIPTION @@ -1,8 +1,19 @@ {{Sorting Algorithm}} -In this task, the goal is to sort an array of elements using the [[wp:Shell sort|Shell sort]] algorithm, a diminishing increment sort. -The Shell sort is named after its inventor, Donald Shell, who published the algorithm in 1959. -Shellsort is a sequence of interleaved insertion sorts based on an increment sequence. + +;Task: +Sort an array of elements using the [[wp:Shell sort|Shell sort]] algorithm, a diminishing increment sort. + +The Shell sort   (also known as Shellsort or Shell's method)   is named after its inventor, Donald Shell, who published the algorithm in 1959. + +Shell sort is a sequence of interleaved insertion sorts based on an increment sequence. The increment size is reduced after each pass until the increment size is 1. + With an increment size of 1, the sort is a basic insertion sort, but by this time the data is guaranteed to be almost sorted, which is insertion sort's "best case". -Any sequence will sort the data as long as it ends in 1, but some work better than others. Empirical studies have shown a geometric increment sequence with a ratio of about 2.2 work well in practice. -[http://www.cs.princeton.edu/~rs/shell/] Other good sequences are found at the [https://oeis.org/search?q=shell+sort On-Line Encyclopedia of Integer Sequences]. + +Any sequence will sort the data as long as it ends in 1, but some work better than others. + +Empirical studies have shown a geometric increment sequence with a ratio of about 2.2 work well in practice. +[http://www.cs.princeton.edu/~rs/shell/] + +Other good sequences are found at the [https://oeis.org/search?q=shell+sort On-Line Encyclopedia of Integer Sequences]. +

    diff --git a/Task/Sorting-algorithms-Shell-sort/360-Assembly/sorting-algorithms-shell-sort.360 b/Task/Sorting-algorithms-Shell-sort/360-Assembly/sorting-algorithms-shell-sort.360 new file mode 100644 index 0000000000..c76fa9afb7 --- /dev/null +++ b/Task/Sorting-algorithms-Shell-sort/360-Assembly/sorting-algorithms-shell-sort.360 @@ -0,0 +1,76 @@ +* Shell sort 24/06/2016 +SHELLSRT CSECT + USING SHELLSRT,R13 base register + B 72(R15) skip savearea + DC 17F'0' savearea + STM R14,R12,12(R13) prolog + ST R13,4(R15) " + ST R15,8(R13) " + LR R13,R15 " + L RK,N incr=n + SRA RK,1 incr=n/2 + DO WHILE=(LTR,RK,P,RK) do while(incr>0) + LA RI,1(RK) i=1+incr + DO WHILE=(C,RI,LE,N) do i=1+incr to n + LR RJ,RI j=i + LR R1,RI i + SLA R1,2 . + L RT,A-4(R1) temp=a(i) + LR R2,RK incr + LA R2,1(R2) r2=incr+1 + LR R3,RJ j + SR R3,RK j-incr + SLA R3,2 *. + LA R3,A-4(R3) r3=@a(j-incr) + LR R4,RK incr + SLA R4,2 r4=incr*4 + LR R5,RJ j + SLA R5,2 . + LA R5,A-4(R5) @a(j) +* do while j-incr>=1 and a(j-incr)>temp + DO WHILE=(CR,RJ,GE,R2,AND,C,RT,LT,0(R3)) + L R0,0(R3) a(j-incr) + ST R0,0(R5) a(j)=a(j-incr) + SR RJ,RK j=j-incr + LR R5,R3 @a(j) + SR R3,R4 @a(j-incr)=@a(j-incr)-incr*4 + ENDDO , end do + ST RT,0(R5) a(j)=temp + LA RI,1(RI) i=i+1 + ENDDO , end do + IF C,RK,EQ,=F'2' if incr=2 + LA RK,1 incr=1 + ELSE , else + LR R5,RK incr + M R4,=F'5' *5 + D R4,=F'11' /11 + LR RK,R5 incr=incr*5/11 + ENDIF , end if + ENDDO , end do + LA R3,PG pgi=0 + LA RI,1 i=1 + DO WHILE=(C,RI,LE,N) do i=1 to n + LR R1,RI i + SLA R1,2 . + L R2,A-4(R1) a(i) + XDECO R2,XDEC edit a(i) + MVC 0(4,R3),XDEC+8 output a(i) + LA R3,4(R3) pgi=pgi+4 + LA RI,1(RI) i=i+1 + ENDDO , end do + XPRNT PG,L'PG print buffer + L R13,4(0,R13) epilog + LM R14,R12,12(R13) " + XR R15,R15 " + BR R14 exit +A DC F'4',F'65',F'2',F'-31',F'0',F'99',F'2',F'83',F'782',F'1' + DC F'45',F'82',F'69',F'82',F'104',F'58',F'88',F'112',F'89',F'74' +N DC A((N-A)/L'A) number of items of a +PG DC CL80' ' buffer +XDEC DS CL12 temp for xdeco + YREGS +RI EQU 6 i +RJ EQU 7 j +RK EQU 8 incr +RT EQU 9 temp + END SHELLSRT diff --git a/Task/Sorting-algorithms-Shell-sort/Elixir/sorting-algorithms-shell-sort.elixir b/Task/Sorting-algorithms-Shell-sort/Elixir/sorting-algorithms-shell-sort.elixir new file mode 100644 index 0000000000..17080bb569 --- /dev/null +++ b/Task/Sorting-algorithms-Shell-sort/Elixir/sorting-algorithms-shell-sort.elixir @@ -0,0 +1,37 @@ +defmodule Sort do + def shell_sort(list) when length(list)<=1, do: list + def shell_sort(list), do: shell_sort(list, div(length(list),2)) + + defp shell_sort(list, inc) do + gb = Enum.with_index(list) |> Enum.group_by(fn {_,i} -> rem(i,inc) end) + wk = Enum.map(0..inc-1, fn i -> + Enum.map(gb[i], fn {x,_} -> x end) |> insert_sort([]) + end) + |> merge + if sorted?(wk), do: wk, else: shell_sort( wk, max(trunc(inc / 2.2), 1) ) + end + + defp merge(lists) do + len = length(hd(lists)) + Enum.map(lists, fn list -> if length(list) List.zip + |> Enum.flat_map(fn tuple -> Tuple.to_list(tuple) end) + |> Enum.filter(&(&1)) # remove nil + end + + defp sorted?(list) do + Enum.chunk(list,2,1) |> Enum.all?(fn [a,b] -> a <= b end) + end + + defp insert_sort(list), do: insert_sort(list, []) + + defp insert_sort([], sorted), do: sorted + defp insert_sort([h | t], sorted), do: insert_sort(t, insert(h, sorted)) + + defp insert(x, []), do: [x] + defp insert(x, sorted) when x < hd(sorted), do: [x | sorted] + defp insert(x, [h | t]), do: [h | insert(x, t)] +end + +list = [0, 14, 11, 8, 13, 15, 5, 7, 16, 17, 1, 6, 12, 2, 10, 4, 19, 9, 18, 3] +IO.inspect Sort.shell_sort(list) diff --git a/Task/Sorting-algorithms-Shell-sort/Mathematica/sorting-algorithms-shell-sort.math b/Task/Sorting-algorithms-Shell-sort/Mathematica/sorting-algorithms-shell-sort.math index b601493700..7e51fd12ca 100644 --- a/Task/Sorting-algorithms-Shell-sort/Mathematica/sorting-algorithms-shell-sort.math +++ b/Task/Sorting-algorithms-Shell-sort/Mathematica/sorting-algorithms-shell-sort.math @@ -2,7 +2,7 @@ shellSort[ lst_ ] := Module[ {list = lst, incr, temp, i, j}, incr = Round[Length[list]/2]; While[incr > 0, - For[i = incr + 1, i < Length[list], i++, + For[i = incr + 1, i <= Length[list], i++, temp = list[[i]]; j = i; diff --git a/Task/Sorting-algorithms-Shell-sort/REXX/sorting-algorithms-shell-sort.rexx b/Task/Sorting-algorithms-Shell-sort/REXX/sorting-algorithms-shell-sort.rexx index f8749fe19c..0a29a5390a 100644 --- a/Task/Sorting-algorithms-Shell-sort/REXX/sorting-algorithms-shell-sort.rexx +++ b/Task/Sorting-algorithms-Shell-sort/REXX/sorting-algorithms-shell-sort.rexx @@ -1,48 +1,48 @@ -/*REXX program sorts a stemmed array using the shell sort algorithm. */ -call gen /*generate the array elements. */ -call show 'before sort' /*display the before array elements. */ -say copies('▒',75) /*displat a separator line (a fence). */ -call shellSort # /*invoke the shell sort. */ -call show ' after sort' /*display the after array elements. */ -exit /*stick a fork in it, we're all done. */ -/*──────────────────────────────────GEN subroutine────────────────────────────*/ -gen: @.= /*assign a default value to stem array.*/ - @.1='3 character abbreviations for states of the USA' /*predates ZIP code.*/ - @.2='===============================================' - @.3='RHO Rhode Island and Providence Plantations' ; @.36='NMX New Mexico' - @.4='CAL California' ; @.20='NEV Nevada' ; @.37='IND Indiana' - @.5='KAN Kansas' ; @.21='TEX Texas' ; @.38='MOE Missouri' - @.6='MAS Massachusetts' ; @.22='VGI Virginia' ; @.39='COL Colorado' - @.7='WAS Washington' ; @.23='OHI Ohio' ; @.40='CON Connecticut' - @.8='HAW Hawaii' ; @.24='NHM New Hampshire'; @.41='MON Montana' - @.9='NCR North Carolina'; @.25='MAE Maine' ; @.42='LOU Louisiana' -@.10='SCR South Carolina'; @.26='MIC Michigan' ; @.43='IOW Iowa' -@.11='IDA Idaho' ; @.27='MIN Minnesota' ; @.44='ORE Oregon' -@.12='NDK North Dakota' ; @.28='MIS Mississippi' ; @.45='ARK Arkansas' -@.13='SDK South Dakota' ; @.29='WIS Wisconsin' ; @.46='ARZ Arizona' -@.14='NEB Nebraska' ; @.30='OKA Oklahoma' ; @.47='UTH Utah' -@.15='DEL Delaware' ; @.31='ALA Alabama' ; @.48='KTY Kentucky' -@.16='PEN Pennsylvania' ; @.32='FLA Florida' ; @.49='WVG West Virginia' -@.17='TEN Tennessee' ; @.33='MLD Maryland' ; @.50='NWJ New Jersey' -@.18='GEO Georgia' ; @.34='ALK Alaska' ; @.51='NYK New York' -@.19='VER Vermont' ; @.35='ILL Illinois' ; @.52='WYO Wyoming' - do #=1 while @.#\==''; end; #=#-1 /*determine number of entries in array.*/ -return -/*──────────────────────────────────SHELLSORT subroutine──────────────────────*/ -shellSort: procedure expose @.; parse arg N -i=N%2 /*% is integer division in REXX. */ - do while i\==0 - do j=i+1 to N; k=j; p=k-i /*P: previous item*/ - _=@.j - do while k>=i+1 & @.p>_; @.k=@.p - k=k-i; p=k-i - end /*while k≥i+1*/ - @.k=_ - end /*j*/ +/*REXX program sorts a stemmed array using the shell sort (shellsort) algorithm. */ +call gen /*generate the array elements. */ +call show 'before sort' /*display the before array elements. */ +say copies('▒', 75) /*displat a separator line (a fence). */ +call shellSort # /*invoke the shell sort. */ +call show ' after sort' /*display the after array elements. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +gen: @.= /*assign a default value to stem array.*/ + @.1='3 character abbreviations for states of the USA' /*predates ZIP code.*/ + @.2='===============================================' + @.3='RHO Rhode Island and Providence Plantations' ; @.36='NMX New Mexico' + @.4='CAL California' ; @.20='NEV Nevada' ; @.37='IND Indiana' + @.5='KAN Kansas' ; @.21='TEX Texas' ; @.38='MOE Missouri' + @.6='MAS Massachusetts' ; @.22='VGI Virginia' ; @.39='COL Colorado' + @.7='WAS Washington' ; @.23='OHI Ohio' ; @.40='CON Connecticut' + @.8='HAW Hawaii' ; @.24='NHM New Hampshire'; @.41='MON Montana' + @.9='NCR North Carolina'; @.25='MAE Maine' ; @.42='LOU Louisiana' + @.10='SCR South Carolina'; @.26='MIC Michigan' ; @.43='IOW Iowa' + @.11='IDA Idaho' ; @.27='MIN Minnesota' ; @.44='ORE Oregon' + @.12='NDK North Dakota' ; @.28='MIS Mississippi' ; @.45='ARK Arkansas' + @.13='SDK South Dakota' ; @.29='WIS Wisconsin' ; @.46='ARZ Arizona' + @.14='NEB Nebraska' ; @.30='OKA Oklahoma' ; @.47='UTH Utah' + @.15='DEL Delaware' ; @.31='ALA Alabama' ; @.48='KTY Kentucky' + @.16='PEN Pennsylvania' ; @.32='FLA Florida' ; @.49='WVG West Virginia' + @.17='TEN Tennessee' ; @.33='MLD Maryland' ; @.50='NWJ New Jersey' + @.18='GEO Georgia' ; @.34='ALK Alaska' ; @.51='NYK New York' + @.19='VER Vermont' ; @.35='ILL Illinois' ; @.52='WYO Wyoming' + do #=1 while @.#\==''; end; #=#-1 /*determine number of entries in array.*/ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +shellSort: procedure expose @.; parse arg N /*obtain the N from the argument list*/ + i=N%2 /*% is integer division in REXX. */ + do while i\==0 + do j=i+1 to N; k=j; p=k-i /*P: previous item*/ + _=@.j + do while k>=i+1 & @.p>_; @.k=@.p + k=k-i; p=k-i + end /*while k≥i+1*/ + @.k=_ + end /*j*/ - if i==2 then i=1 - else i=i*5%11 - end /*while i¬==0*/ -return -/*──────────────────────────────────SHOW subroutine───────-───────────────────*/ -show: do j=1 for #; say 'element' right(j,length(#)) arg(1)': ' @.j; end; return + if i==2 then i=1 + else i=i*5 % 11 + end /*while i¬==0*/ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +show: do j=1 for #; say 'element' right(j,length(#)) arg(1)": " @.j; end; return diff --git a/Task/Sorting-algorithms-Sleep-sort/D/sorting-algorithms-sleep-sort.d b/Task/Sorting-algorithms-Sleep-sort/D/sorting-algorithms-sleep-sort.d index 57d89a40e9..a5f9adbe8b 100644 --- a/Task/Sorting-algorithms-Sleep-sort/D/sorting-algorithms-sleep-sort.d +++ b/Task/Sorting-algorithms-Sleep-sort/D/sorting-algorithms-sleep-sort.d @@ -1,21 +1,16 @@ -import std.stdio, std.conv, std.datetime, std.array, core.thread; +import core.thread, std.concurrency, std.datetime, + std.stdio, std.algorithm, std.conv; -final class SleepSorter: Thread { - private immutable uint val; +void main(string[] args) +{ + if (!args.length) + return; - this(in uint n) /*pure nothrow @safe*/ { - super(&run); - val = n; - } + foreach (number; args[1 .. $].map!(to!uint)) + spawn((uint num) { + Thread.sleep(dur!"msecs"(10 * num)); + writef("%d ", num); + }, number); - private void run() { - Thread.sleep(dur!"msecs"(1000 * val)); - writef("%d ", val); - } -} - -void main(in string[] args) { - if (!args.empty) - foreach (const arg; args[1 .. $]) - new SleepSorter(arg.to!uint).start; + thread_joinAll(); } diff --git a/Task/Sorting-algorithms-Sleep-sort/Elixir/sorting-algorithms-sleep-sort.elixir b/Task/Sorting-algorithms-Sleep-sort/Elixir/sorting-algorithms-sleep-sort.elixir new file mode 100644 index 0000000000..6de58de1b8 --- /dev/null +++ b/Task/Sorting-algorithms-Sleep-sort/Elixir/sorting-algorithms-sleep-sort.elixir @@ -0,0 +1,16 @@ +defmodule Sort do + def sleep_sort(args) do + Enum.each(args, fn(arg) -> Process.send_after(self, arg, 5 * arg) end) + loop(length(args)) + end + + defp loop(0), do: :ok + defp loop(n) do + receive do + num -> IO.puts num + loop(n - 1) + end + end +end + +Sort.sleep_sort [2, 4, 8, 12, 35, 2, 12, 1] diff --git a/Task/Sorting-algorithms-Stooge-sort/00DESCRIPTION b/Task/Sorting-algorithms-Stooge-sort/00DESCRIPTION index ee953c4a31..98fd521f87 100644 --- a/Task/Sorting-algorithms-Stooge-sort/00DESCRIPTION +++ b/Task/Sorting-algorithms-Stooge-sort/00DESCRIPTION @@ -1,6 +1,11 @@ -{{sorting Algorithm}}{{wikipedia|Stooge sort}} +{{sorting Algorithm}} +{{wikipedia|Stooge sort}} {{omit from|GUISS}} -Show the [[wp:Stooge sort|Stooge Sort]] for an array of integers. + + +;Task: +Show the   [[wp:Stooge sort|Stooge Sort]]   for an array of integers. + The Stooge Sort algorithm is as follows: algorithm stoogesort(array L, i = 0, j = length(L)-1) @@ -12,3 +17,4 @@ The Stooge Sort algorithm is as follows: stoogesort(L, i+t, j ) stoogesort(L, i , j-t) return L +

    diff --git a/Task/Sorting-algorithms-Stooge-sort/ALGOL-68/sorting-algorithms-stooge-sort.alg b/Task/Sorting-algorithms-Stooge-sort/ALGOL-68/sorting-algorithms-stooge-sort.alg new file mode 100644 index 0000000000..638bed8d1e --- /dev/null +++ b/Task/Sorting-algorithms-Stooge-sort/ALGOL-68/sorting-algorithms-stooge-sort.alg @@ -0,0 +1,27 @@ +# swaps the values of the two REF INTs # +PRIO =:= = 1; +OP =:= = ( REF INT a, b )VOID: ( INT t := a; a := b; b := t ); + +# returns the array of INTs sorted via the stooge sort algorithm # +PROC stooge sort = ( []INT array )[]INT: + BEGIN + PROC stooge sort segment = ( REF[]INT l, INT i, j )VOID: + BEGIN + IF l[j] < l[i] THEN l[ i ] =:= l[ j ] FI; + IF j - i > 1 + THEN + INT t := (j - i + 1) OVER 3; + stooge sort segment( l, i, j - t ); + stooge sort segment( l, i + t, j ); + stooge sort segment( l, i, j - t ) + FI + END # stooge sort segment # ; + + [ LWB array : UPB array ]INT result := array; + stooge sort segment( result, LWB result, UPB result ); + result + END # stooge sort # ; + +# test the stooge sort # +[]INT data = ( 67, -201, 0, 9, 9, 231, 4 ); +print( ( "before: ", data, newline, "after: ", stooge sort( data ), newline ) ) diff --git a/Task/Sorting-algorithms-Stooge-sort/Elixir/sorting-algorithms-stooge-sort.elixir b/Task/Sorting-algorithms-Stooge-sort/Elixir/sorting-algorithms-stooge-sort.elixir new file mode 100644 index 0000000000..45563959b4 --- /dev/null +++ b/Task/Sorting-algorithms-Stooge-sort/Elixir/sorting-algorithms-stooge-sort.elixir @@ -0,0 +1,23 @@ +defmodule Sort do + def stooge_sort(list) do + stooge_sort(List.to_tuple(list), 0, length(list)-1) |> Tuple.to_list + end + + defp stooge_sort(tuple, i, j) do + if (vj = elem(tuple, j)) < (vi = elem(tuple, i)) do + tuple = put_elem(tuple,i,vj) |> put_elem(j,vi) + end + if j - i > 1 do + t = div(j - i + 1, 3) + tuple + |> stooge_sort(i, j-t) + |> stooge_sort(i+t, j) + |> stooge_sort(i, j-t) + else + tuple + end + end +end + +(for _ <- 1..20, do: :rand.uniform(20)) |> IO.inspect +|> Sort.stooge_sort |> IO.inspect diff --git a/Task/Sorting-algorithms-Stooge-sort/JavaScript/sorting-algorithms-stooge-sort-1.js b/Task/Sorting-algorithms-Stooge-sort/JavaScript/sorting-algorithms-stooge-sort-1.js new file mode 100644 index 0000000000..99bab4bff0 --- /dev/null +++ b/Task/Sorting-algorithms-Stooge-sort/JavaScript/sorting-algorithms-stooge-sort-1.js @@ -0,0 +1,22 @@ +function stoogeSort (array, i, j) { + if (j === undefined) { + j = array.length - 1; + } + + if (i === undefined) { + i = 0; + } + + if (array[j] < array[i]) { + var aux = array[i]; + array[i] = array[j]; + array[j] = aux; + } + + if (j - i > 1) { + var t = Math.floor((j - i + 1) / 3); + stoogeSort(array, i, j-t); + stoogeSort(array, i+t, j); + stoogeSort(array, i, j-t); + } +}; diff --git a/Task/Sorting-algorithms-Stooge-sort/JavaScript/sorting-algorithms-stooge-sort-2.js b/Task/Sorting-algorithms-Stooge-sort/JavaScript/sorting-algorithms-stooge-sort-2.js new file mode 100644 index 0000000000..6fef783d34 --- /dev/null +++ b/Task/Sorting-algorithms-Stooge-sort/JavaScript/sorting-algorithms-stooge-sort-2.js @@ -0,0 +1,3 @@ +arr = [9,1,3,10,13,4,2]; +stoogeSort(arr); +console.log(arr); diff --git a/Task/Sorting-algorithms-Stooge-sort/Perl-6/sorting-algorithms-stooge-sort.pl6 b/Task/Sorting-algorithms-Stooge-sort/Perl-6/sorting-algorithms-stooge-sort.pl6 index 317ce1011a..12addbf646 100644 --- a/Task/Sorting-algorithms-Stooge-sort/Perl-6/sorting-algorithms-stooge-sort.pl6 +++ b/Task/Sorting-algorithms-Stooge-sort/Perl-6/sorting-algorithms-stooge-sort.pl6 @@ -1,4 +1,4 @@ -sub stoogesort( @L is rw, $i = 0, $j = @L.end ) { +sub stoogesort( @L, $i = 0, $j = @L.end ) { @L[$j,$i] = @L[$i,$j] if @L[$i] > @L[$j]; my $interval = $j - $i; diff --git a/Task/Sorting-algorithms-Stooge-sort/R/sorting-algorithms-stooge-sort.r b/Task/Sorting-algorithms-Stooge-sort/R/sorting-algorithms-stooge-sort.r new file mode 100644 index 0000000000..d24cbe6f87 --- /dev/null +++ b/Task/Sorting-algorithms-Stooge-sort/R/sorting-algorithms-stooge-sort.r @@ -0,0 +1,17 @@ +stoogesort = function(vect) { + i = 1 + j = length(vect) + if(vect[j] < vect[i]) vect[c(j, i)] = vect[c(i, j)] + if(j - i > 1) { + t = (j - i + 1) %/% 3 + vect[i:(j - t)] = stoogesort(vect[i:(j - t)]) + vect[(i + t):j] = stoogesort(vect[(i + t):j]) + vect[i:(j - t)] = stoogesort(vect[i:(j - t)]) + } + vect +} + +v = sample(21, 20) +k = stoogesort(v) +v +k diff --git a/Task/Sorting-algorithms-Stooge-sort/REXX/sorting-algorithms-stooge-sort.rexx b/Task/Sorting-algorithms-Stooge-sort/REXX/sorting-algorithms-stooge-sort.rexx index 9352a30531..86406b0501 100644 --- a/Task/Sorting-algorithms-Stooge-sort/REXX/sorting-algorithms-stooge-sort.rexx +++ b/Task/Sorting-algorithms-Stooge-sort/REXX/sorting-algorithms-stooge-sort.rexx @@ -1,35 +1,25 @@ -/*REXX program to sort an integer array L [elements start at zero]. */ -highItem=19 /*define 0 ──► 19 elements. */ -widthH=length(highItem) /*width of biggest element number*/ -widthL=0 /*width of largest element value.*/ - - do k=0 to highItem /*populate the array with stuff. */ - L.k=2*k + (k * -1**k) /*kinda generate randomish nums. */ - if L.k==0 then L.k=-100-k /*if zero, make a negative number*/ - widthL=max(widthL,length(L.k)) /*compute maximum width so far. */ - end /*k*/ - -call showL 'before sort' /*show the before array elements.*/ -call stoogeSort 0,highItem /*invoke the Stooge Sort. */ -call showL ' after sort' /*show the after array elements.*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────SHOWL subroutine────────────────────*/ -showL: sepLength=22+widthH+widthL /*compute separator width. */ -say copies('-',sepLength) /*show the 1st separator line. */ - - do j=0 to highItem - say 'element' right(j,widthH) arg(1)":" right(L.j,widthL) - end /*j*/ - -say copies('=', sepLength) /*show the 2nd separator line. */ -return -/*──────────────────────────────────STOOGESORT subroutine───────────────*/ -stoogeSort: procedure expose L.; parse arg i,j /*sort from I ──> J.*/ -if L.j1 then do - t=(j-i+1) % 3 /* % is REXX integer division. */ - call stoogesort i , j-t - call stoogesort i+t, j - call stoogesort i , j-t - end -return +/*REXX program sorts an integer array @. [the first element starts at index zero].*/ +parse arg N . /*obtain an optional argument from C.L.*/ +if N=='' | N=="," then N=19 /*Not specified? Then use the default.*/ +wV=0 /*width of the largest value, so far.*/ + do k=0 to N; @.k=k*2 + k*-1**k /*generate some kinda scattered numbers*/ + if @.k//7==0 then @.k= -100 -k /*Multiple of 7? Then make a negative#*/ + wV=max(wV, length(@.k)) /*find maximum width of values, so far.*/ + end /*k*/ /* [↑] // is REXX division remainder.*/ +wN=length(N) /*width of the largest element number.*/ +call show 'before sort' /*show the before array elements. */ +say copies('▒', wN+wV+ 50) /*show a separator line (between shows)*/ +call stoogeSort 0, N /*invoke the Stooge Sort. */ +call show ' after sort' /*show the after array elements. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +show: do j=0 to N; say right('element',22) right(j,wN) arg(1)":" right(@.j,wV); end;return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +stoogeSort: procedure expose @.; parse arg i,j /*sort from I ───► J. */ + if @.j<@.i then parse value @.i @.j with @.j @.i /*swap @.i with @.j */ + if j-i>1 then do; t=(j-i+1) % 3 /*%: integer division.*/ + call stoogeSort i , j-t /*invoke recursively. */ + call stoogeSort i+t, j /* " " */ + call stoogeSort i , j-t /* " " */ + end + return diff --git a/Task/Sorting-algorithms-Stooge-sort/Rust/sorting-algorithms-stooge-sort.rust b/Task/Sorting-algorithms-Stooge-sort/Rust/sorting-algorithms-stooge-sort.rust new file mode 100644 index 0000000000..fdf75398bc --- /dev/null +++ b/Task/Sorting-algorithms-Stooge-sort/Rust/sorting-algorithms-stooge-sort.rust @@ -0,0 +1,22 @@ +fn stoogesort(a: &mut [E]) + where E: PartialOrd +{ + let len = a.len(); + + if a.first().unwrap() > a.last().unwrap() { + a.swap(0, len - 1); + } + if len - 1 > 1 { + let t = len / 3; + stoogesort(&mut a[..len - 1]); + stoogesort(&mut a[t..]); + stoogesort(&mut a[..len - 1]); + } +} + +fn main() { + let mut numbers = vec![1_i32, 9, 4, 7, 6, 5, 3, 2, 8]; + println!("Before: {:?}", &numbers); + stoogesort(&mut numbers); + println!("After: {:?}", &numbers); +} diff --git a/Task/Sorting-algorithms-Strand-sort/00DESCRIPTION b/Task/Sorting-algorithms-Strand-sort/00DESCRIPTION index 371a72a1a0..0350c0a57e 100644 --- a/Task/Sorting-algorithms-Strand-sort/00DESCRIPTION +++ b/Task/Sorting-algorithms-Strand-sort/00DESCRIPTION @@ -1,3 +1,9 @@ {{Sorting Algorithm}} {{Wikipedia|Strand sort}} -Implement the [[wp:Strand sort|Strand sort]]. This is a way of sorting numbers by extracting shorter sequences of already sorted numbers from an unsorted list. + +
    +;Task: +Implement the [[wp:Strand sort|Strand sort]]. + +This is a way of sorting numbers by extracting shorter sequences of already sorted numbers from an unsorted list. +

    diff --git a/Task/Sorting-algorithms-Strand-sort/Elixir/sorting-algorithms-strand-sort.elixir b/Task/Sorting-algorithms-Strand-sort/Elixir/sorting-algorithms-strand-sort.elixir new file mode 100644 index 0000000000..1cb46ea33a --- /dev/null +++ b/Task/Sorting-algorithms-Strand-sort/Elixir/sorting-algorithms-strand-sort.elixir @@ -0,0 +1,14 @@ +defmodule Sort do + def strand_sort(args), do: strand_sort(args, []) + + defp strand_sort([], result), do: result + defp strand_sort(a, result) do + {_, sublist, b} = Enum.reduce(a, {hd(a),[],[]}, fn val,{v,l1,l2} -> + if v <= val, do: {val, [val | l1], l2}, + else: {v, l1, [val | l2]} + end) + strand_sort(b, :lists.merge(Enum.reverse(sublist), result)) + end +end + +IO.inspect Sort.strand_sort [7, 17, 6, 20, 20, 12, 1, 1, 9] diff --git a/Task/Sorting-algorithms-Strand-sort/REXX/sorting-algorithms-strand-sort.rexx b/Task/Sorting-algorithms-Strand-sort/REXX/sorting-algorithms-strand-sort.rexx index 7bb4c0afac..b5059aaedd 100644 --- a/Task/Sorting-algorithms-Strand-sort/REXX/sorting-algorithms-strand-sort.rexx +++ b/Task/Sorting-algorithms-Strand-sort/REXX/sorting-algorithms-strand-sort.rexx @@ -1,32 +1,31 @@ -/*REXX pgm sorts a random list of words using the strand sort algorithm.*/ -parse arg size minv maxv,old /*get options from command line. */ -if size=='' then size=20 /*no size? Then use the default.*/ -if minv=='' then minv=0 /*no minV? " " " " */ -if maxv=='' then maxv=size /*no maxV? " " " " */ - do i=1 for size /*generate random # list*/ - old=old random(0,maxv-minv)+minv - end /*i*/ -old=space(old) /*remove any extraneous blanks. */ -say center('unsorted list',length(old),"─"); say old; say -new=strand_sort(old) /*sort the list of random numbers*/ -say center('sorted list' ,length(new),"─"); say new -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────STRAND_SORT subroutine──────────────*/ -strand_sort: procedure; parse arg x; y= - do while words(x)\==0; w=words(x) - do j=1 for w-1 /*any number | word out of order?*/ - if word(x,j)>word(x,j+1) then do; w=j; leave; end - end /*j*/ - y=merge(y,subword(x,1,w)); x=subword(x,w+1) - end /*while*/ -return y -/*──────────────────────────────────MERGE subroutine────────────────────*/ -merge: procedure; parse arg a.1,a.2; p= - do forever /*keep at it while 2 lists exist.*/ - do i=1 for 2; w.i=words(a.i); end /*find number of entries in lists*/ - if w.1*w.2==0 then leave /*if any list is empty, then stop*/ - if word(a.1,w.1) <= word(a.2,1) then leave /*lists are now sorted?*/ - if word(a.2,w.2) <= word(a.1,1) then return space(p a.2 a.1) - #=1+(word(a.1,1) >= word(a.2,1)); p=p word(a.#,1); a.#=subword(a.#,2) - end /*forever*/ -return space(p a.1 a.2) +/*REXX program sorts a random list of words (or numbers) using the strand sort algorithm*/ +parse arg size minv maxv old /*obtain optional arguments from the CL*/ +if size=='' | size=="," then size=20 /*Not specified? Then use the default.*/ +if minv=='' | minv=="," then minv= 0 /*Not specified? Then use the default.*/ +if maxv=='' | maxv=="," then maxv=size /*Not specified? Then use the default.*/ + do i=1 for size /*generate a list of random numbers. */ + old=old random(0,maxv-minv)+minv /*append a random number to a list. */ + end /*i*/ +old=space(old) /*elide extraneous blanks from the list*/ + say center('unsorted list', length(old), "─"); say old +new=strand_sort(old) /*sort the list of the random numbers. */ +say; say center('sorted list' , length(new), "─"); say new +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +strand_sort: procedure; parse arg x; y= + do while words(x)\==0; w=words(x) + do j=1 for w-1 /*anything out of order?*/ + if word(x,j)>word(x,j+1) then do; w=j; leave; end + end /*j*/ + y=merge(y,subword(x,1,w)); x=subword(x,w+1) + end /*while*/ + return y +/*──────────────────────────────────────────────────────────────────────────────────────*/ +merge: procedure; parse arg a.1,a.2; p= + do forever; w1=words(a.1); w2=words(a.2) /*do while 2 lists exist*/ + if w1==0 | if w2==0 then leave /*Any list empty? Stop.*/ + if word(a.1,w1) <= word(a.2,1) then leave /*lists are now sorted? */ + if word(a.2,w2) <= word(a.1,1) then return space(p a.2 a.1) + #=1+(word(a.1,1) >= word(a.2,1)); p=p word(a.#,1); a.#=subword(a.#,2) + end /*forever*/ + return space(p a.1 a.2) diff --git a/Task/Soundex/00DESCRIPTION b/Task/Soundex/00DESCRIPTION index 7369dc29ce..22be35559e 100644 --- a/Task/Soundex/00DESCRIPTION +++ b/Task/Soundex/00DESCRIPTION @@ -1,2 +1,11 @@ Soundex is an algorithm for creating indices for words based on their pronunciation. + + +;Task: The goal is for homophones to be encoded to the same representation so that they can be matched despite minor differences in spelling (from [[wp:soundex|the WP article]]). +

    + +;Caution: +There is a major issue in many of the implementations concerning the separation of two consonants that have the same soundex code! According to the official Rules [[https://www.archives.gov/research/census/soundex.html]]. So check for instance if '''Ashcraft''' is coded to '''A-261'''. +* If a vowel (A, E, I, O, U) separates two consonants that have the same soundex code, the consonant to the right of the vowel is coded. Tymczak is coded as T-522 (T, 5 for the M, 2 for the C, Z ignored (see "Side-by-Side" rule above), 2 for the K). Since the vowel "A" separates the Z and K, the K is coded. +* If "H" or "W" separate two consonants that have the same soundex code, the consonant to the right of the vowel is not coded. Example: Ashcraft is coded A-261 (A, 2 for the S, C ignored, 6 for the R, 1 for the F). It is not coded A-226. diff --git a/Task/Soundex/Elixir/soundex.elixir b/Task/Soundex/Elixir/soundex.elixir new file mode 100644 index 0000000000..bfd15ede2b --- /dev/null +++ b/Task/Soundex/Elixir/soundex.elixir @@ -0,0 +1,39 @@ +defmodule Soundex do + def soundex([]), do: [] + def soundex(str) do + [head|tail] = String.upcase(str) |> to_char_list + [head | isoundex(tail, [], todigit(head))] + end + + defp isoundex([], acc, _) do + case length(acc) do + n when n == 3 -> Enum.reverse(acc) + n when n < 3 -> isoundex([], [?0 | acc], :ignore) + n when n > 3 -> isoundex([], Enum.slice(acc, n-3, n), :ignore) + end + end + defp isoundex([head|tail], acc, lastn) do + dig = todigit(head) + if dig != ?0 and dig != lastn do + isoundex(tail, [dig | acc], dig) + else + case head do + ?H -> isoundex(tail, acc, lastn) + ?W -> isoundex(tail, acc, lastn) + n when n in ?A..?Z -> isoundex(tail, acc, dig) + _ -> isoundex(tail, acc, lastn) # This clause handles non alpha characters + end + end + end + + @digits '01230120022455012623010202' + defp todigit(chr) do + if chr in ?A..?Z, do: Enum.at(@digits, chr - ?A), + else: ?0 # Treat non alpha characters as a vowel + end +end + +IO.puts Soundex.soundex("Soundex") +IO.puts Soundex.soundex("Example") +IO.puts Soundex.soundex("Sownteks") +IO.puts Soundex.soundex("Ekzampul") diff --git a/Task/Soundex/JavaScript/soundex.js b/Task/Soundex/JavaScript/soundex-1.js similarity index 100% rename from Task/Soundex/JavaScript/soundex.js rename to Task/Soundex/JavaScript/soundex-1.js diff --git a/Task/Soundex/JavaScript/soundex-2.js b/Task/Soundex/JavaScript/soundex-2.js new file mode 100644 index 0000000000..f6d9e667c7 --- /dev/null +++ b/Task/Soundex/JavaScript/soundex-2.js @@ -0,0 +1,42 @@ +function soundex(t) { + t = t.toUpperCase().replace(/[^A-Z]/g, ''); + return (t[0] || '0') + t.replace(/[HW]/g, '') + .replace(/[BFPV]/g, '1') + .replace(/[CGJKQSXZ]/g, '2') + .replace(/[DT]/g, '3') + .replace(/[L]/g, '4') + .replace(/[MN]/g, '5') + .replace(/[R]/g, '6') + .replace(/(.)\1+/g, '$1') + .substr(1) + .replace(/[AEOIUHWY]/g, '') + .concat('000') + .substr(0, 3); +} + +// tests +[ ["Example", "E251"], ["Sownteks", "S532"], ["Lloyd", "L300"], ["12346", "0000"], + ["4-H", "H000"], ["Ashcraft", "A261"], ["Ashcroft", "A261"], ["auerbach", "A612"], + ["bar", "B600"], ["barre", "B600"], ["Baragwanath", "B625"], ["Burroughs", "B620"], + ["Burrows", "B620"], ["C.I.A.", "C000"], ["coöp", "C100"], ["D-day", "D000"], + ["d jay", "D200"], ["de la Rosa", "D462"], ["Donnell", "D540"], ["Dracula", "D624"], + ["Drakula", "D624"], ["Du Pont", "D153"], ["Ekzampul", "E251"], ["example", "E251"], + ["Ellery", "E460"], ["Euler", "E460"], ["F.B.I.", "F000"], ["Gauss", "G200"], + ["Ghosh", "G200"], ["Gutierrez", "G362"], ["he", "H000"], ["Heilbronn", "H416"], + ["Hilbert", "H416"], ["Jackson", "J250"], ["Johnny", "J500"], ["Jonny", "J500"], + ["Kant", "K530"], ["Knuth", "K530"], ["Ladd", "L300"], ["Lloyd", "L300"], + ["Lee", "L000"], ["Lissajous", "L222"], ["Lukasiewicz", "L222"], ["naïve", "N100"], + ["Miller", "M460"], ["Moses", "M220"], ["Moskowitz", "M232"], ["Moskovitz", "M213"], + ["O'Conner", "O256"], ["O'Connor", "O256"], ["O'Hara", "O600"], ["O'Mally", "O540"], + ["Peters", "P362"], ["Peterson", "P362"], ["Pfister", "P236"], ["R2-D2", "R300"], + ["rÄ≈sumÅ∙", "R250"], ["Robert", "R163"], ["Rupert", "R163"], ["Rubin", "R150"], + ["Soundex", "S532"], ["sownteks", "S532"], ["Swhgler", "S460"], ["'til", "T400"], + ["Tymczak", "T522"], ["Uhrbach", "U612"], ["Van de Graaff", "V532"], + ["VanDeusen", "V532"], ["Washington", "W252"], ["Wheaton", "W350"], + ["Williams", "W452"], ["Woolcock", "W422"] +].forEach(function(v) { + var a = v[0], t = v[1], d = soundex(a); + if (d !== t) { + console.log('soundex("' + a + '") was ' + d + ' should be ' + t); + } +}); diff --git a/Task/Soundex/JavaScript/soundex-3.js b/Task/Soundex/JavaScript/soundex-3.js new file mode 100644 index 0000000000..670d3ebddf --- /dev/null +++ b/Task/Soundex/JavaScript/soundex-3.js @@ -0,0 +1,129 @@ +(() => { + 'use strict'; + + // Simple Soundex or NARA Soundex (if blnNara = true) + + // soundex :: Bool -> String -> String + const soundex = (blnNara, name) => { + + // code :: Char -> Char + const code = c => ['AEIOU', 'BFPV', 'CGJKQSXZ', 'DT', 'L', 'MN', 'R', 'HW'] + .reduce((a, x, i) => + a ? a : (x.indexOf(c) !== -1 ? i.toString() : a), ''); + + // isAlpha :: Char -> Boolean + const isAlpha = c => { + const d = c.charCodeAt(0); + return d > 64 && d < 91; + }; + + const s = name.toUpperCase() + .split('') + .filter(isAlpha); + + return (s[0] || '0') + + s.map(code) + .join('') + .replace(/7/g, blnNara ? '' : '7') + .replace(/(.)\1+/g, '$1') + .substr(1) + .replace(/[07]/g, '') + .concat('000') + .substr(0, 3); + }; + + // curry :: ((a, b) -> c) -> a -> b -> c + const curry = f => a => b => f(a, b), + [simpleSoundex, naraSoundex] = [false, true] + .map(bln => curry(soundex)(bln)); + + // TEST + return [ + ["Example", "E251"], + ["Sownteks", "S532"], + ["Lloyd", "L300"], + ["12346", "0000"], + ["4-H", "H000"], + ["Ashcraft", "A261"], + ["Ashcroft", "A261"], + ["auerbach", "A612"], + ["bar", "B600"], + ["barre", "B600"], + ["Baragwanath", "B625"], + ["Burroughs", "B620"], + ["Burrows", "B620"], + ["C.I.A.", "C000"], + ["coöp", "C100"], + ["D-day", "D000"], + ["d jay", "D200"], + ["de la Rosa", "D462"], + ["Donnell", "D540"], + ["Dracula", "D624"], + ["Drakula", "D624"], + ["Du Pont", "D153"], + ["Ekzampul", "E251"], + ["example", "E251"], + ["Ellery", "E460"], + ["Euler", "E460"], + ["F.B.I.", "F000"], + ["Gauss", "G200"], + ["Ghosh", "G200"], + ["Gutierrez", "G362"], + ["he", "H000"], + ["Heilbronn", "H416"], + ["Hilbert", "H416"], + ["Jackson", "J250"], + ["Johnny", "J500"], + ["Jonny", "J500"], + ["Kant", "K530"], + ["Knuth", "K530"], + ["Ladd", "L300"], + ["Lloyd", "L300"], + ["Lee", "L000"], + ["Lissajous", "L222"], + ["Lukasiewicz", "L222"], + ["naïve", "N100"], + ["Miller", "M460"], + ["Moses", "M220"], + ["Moskowitz", "M232"], + ["Moskovitz", "M213"], + ["O'Conner", "O256"], + ["O'Connor", "O256"], + ["O'Hara", "O600"], + ["O'Mally", "O540"], + ["Peters", "P362"], + ["Peterson", "P362"], + ["Pfister", "P236"], + ["R2-D2", "R300"], + ["rÄ≈sumÅ∙", "R250"], + ["Robert", "R163"], + ["Rupert", "R163"], + ["Rubin", "R150"], + ["Soundex", "S532"], + ["sownteks", "S532"], + ["Swhgler", "S460"], + ["'til", "T400"], + ["Tymczak", "T522"], + ["Uhrbach", "U612"], + ["Van de Graaff", "V532"], + ["VanDeusen", "V532"], + ["Washington", "W252"], + ["Wheaton", "W350"], + ["Williams", "W452"], + ["Woolcock", "W422"] + ].reduce((a, [name, naraCode]) => { + const naraTest = naraSoundex(name), + simpleTest = simpleSoundex(name); + + const logNara = naraTest !== naraCode ? ( + `${name} was ${naraTest} should be ${naraCode}` + ) : '', + logDelta = (naraTest !== simpleTest ? ( + `${name} -> NARA: ${naraTest} vs Simple: ${simpleTest}` + ) : ''); + + return logNara.length || logDelta.length ? ( + a + [logNara, logDelta].join('\n') + ) : a; + }, ''); +})(); diff --git a/Task/Soundex/Prolog/soundex.pro b/Task/Soundex/Prolog/soundex.pro new file mode 100644 index 0000000000..f2993b5a74 --- /dev/null +++ b/Task/Soundex/Prolog/soundex.pro @@ -0,0 +1,75 @@ +%____________________________________________________________________ +% Implements the American soundex algorithm +% as described at https://en.wikipedia.org/wiki/Soundex +% In SWI Prolog, a 'string' is specified in 'single quotes', +% while a "list of codes" may be specified in "double quotes". +% So, "abc" is equivalent to [97, 98, 99], while +% 'abc' = abc (an atom), and 'Abc' is also an atom. There are +% conversion methods that can produce lists of characters: +% ?- atom_chars('Abc', X). +% X = ['A', b, c]. +% or lists of codes (mapping to unicode code points): +% ?- atom_codes('Abc', X). +% X = [65, 98, 99]. +% and the conversion predicates are bidirectional. +% ?- atom_codes(A, [65, 98, 99]). +% A = 'Abc'. +% A single character code may be specified as 0'C, where C is the +% character you want to convert to a code. +%~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +% Relates groups of consonants to representative digits +creplace(Ch, 0'1) :- member(Ch, "bfpv"). +creplace(Ch, 0'2) :- member(Ch, "cgjkqsxz"). +creplace(Ch, 0'3) :- member(Ch, "dt"). +creplace(0'l, 0'4). +creplace(Ch, 0'5) :- member(Ch, "mn"). +creplace(0'r, 0'6). + +% strips elements contained in from a string +strip(Set, [H|T], Tr) :- memberchk(H, Set), !, strip(Set, T, Tr). +strip(Set, [H|T], [H|Tr]) :- !, strip(Set, T, Tr). +strip(_, [], []). + +% Replace consonants with appropriate digits +consonants([H|T], [Ch|Tr]) :- creplace(H, Ch), !, consonants(T, Tr). +consonants([H|T], [H|Tr]) :- !, consonants(T, Tr). +consonants([], []). + +% Replace adjacent digits with single digit +adjacent([Ch, Ch|T], [Ch|Tr]) :- between(0'0, 0'9, Ch), !, adjacent(T, Tr). +adjacent([H|T], [H|Tr]) :- !, adjacent(T, Tr). +adjacent([], []). + +% Replace first character with original one if its a digit +chk_digit([H,D|T], [H|T]) :- between(0'0, 0'9, D), !. +chk_digit([_,H|T], [H|T]). + +% Faithul representation of soundex rules: +% 1: Save 1st letter, strip "hw" +% 2: Replace consonants with appropriate digits +% 3: Replace adjacent digits with single occurrence +% 4: Remove vowels except 1st letter +% 5: If 1st symbol is a digit, replace it with saved 1st letter +% 6: Ensure trailing zeroes +do_soundex([H|T], Res) :- + strip("hw", T, Ts), consonants([H|Ts], Tc), + adjacent(Tc, [C|Ta]), strip("aeiouy", Ta, Tv), + chk_digit([H,C|Tv], Td), append(Td, "0000", Tr), + atom_codes(Tf, Tr), sub_string(Tf, 0, 4, _, Res). + +% Prepare string, convert to lower case and do the soundex alogorithm +soundex(Text, Res) :- + downcase_atom(Text, Lower), atom_codes(Lower, T), + do_soundex(T, Res). + +% Perform tests to check that the right values are produced +test(S,V) :- not(soundex(S,V)), writef('%w failed\n', [S]). +test :- test('Robert', 'r163'), !, fail. +test :- test('Rupert', 'r163'), !, fail. +test :- test('Rubin', 'r150'), !, fail. +test :- test('Ashcroft', 'a261'), !, fail. +test :- test('Ashcraft', 'a261'), !, fail. +test :- test('Tymczak', 't522'), !, fail. +test :- test('Pfister', 'p236'), !, fail. +test. % Succeeds only if all the tests succeed diff --git a/Task/Soundex/REXX/soundex.rexx b/Task/Soundex/REXX/soundex.rexx index b33472ae4c..52935c7e9c 100644 --- a/Task/Soundex/REXX/soundex.rexx +++ b/Task/Soundex/REXX/soundex.rexx @@ -1,100 +1,99 @@ -/*REXX program demonstrates Soundex codes from some words | commandLine.*/ -_=; @.= /*set a couple of vars to "null".*/ -parse arg @.0 . /*allow input from command line. */ - @.1 = "12346" ; #.1 = '0000' - @.4 = "4-H" ; #.4 = 'H000' - @.11 = "Ashcraft" ; #.11 = 'A261' - @.12 = "Ashcroft" ; #.12 = 'A261' - @.18 = "auerbach" ; #.18 = 'A612' - @.20 = "Baragwanath" ; #.20 = 'B625' - @.22 = "bar" ; #.22 = 'B600' - @.23 = "barre" ; #.23 = 'B600' - @.20 = "Baragwanath" ; #.20 = 'B625' - @.28 = "Burroughs" ; #.28 = 'B620' - @.29 = "Burrows" ; #.29 = 'B620' - @.30 = "C.I.A." ; #.30 = 'C000' - @.37 = "coöp" ; #.37 = 'C100' - @.43 = "D-day" ; #.43 = 'D000' - @.44 = "d jay" ; #.44 = 'D200' - @.45 = "de la Rosa" ; #.45 = 'D462' - @.46 = "Donnell" ; #.46 = 'D540' - @.47 = "Dracula" ; #.47 = 'D624' - @.48 = "Drakula" ; #.48 = 'D624' - @.49 = "Du Pont" ; #.49 = 'D153' - @.50 = "Ekzampul" ; #.50 = 'E251' - @.51 = "example" ; #.51 = 'E251' - @.55 = "Ellery" ; #.55 = 'E460' - @.59 = "Euler" ; #.59 = 'E460' - @.60 = "F.B.I." ; #.60 = 'F000' - @.70 = "Gauss" ; #.70 = 'G200' - @.71 = "Ghosh" ; #.71 = 'G200' - @.72 = "Gutierrez" ; #.72 = 'G362' - @.80 = "he" ; #.80 = 'H000' - @.81 = "Heilbronn" ; #.81 = 'H416' - @.84 = "Hilbert" ; #.84 = 'H416' - @.100 = "Jackson" ; #.100 = 'J250' - @.104 = "Johnny" ; #.104 = 'J500' - @.105 = "Jonny" ; #.105 = 'J500' - @.110 = "Kant" ; #.110 = 'K530' - @.116 = "Knuth" ; #.116 = 'K530' - @.120 = "Ladd" ; #.120 = 'L300' - @.124 = "Llyod" ; #.124 = 'L300' - @.125 = "Lee" ; #.125 = 'L000' - @.126 = "Lissajous" ; #.126 = 'L222' - @.128 = "Lukasiewicz" ; #.128 = 'L222' - @.130 = "naïve" ; #.130 = 'N100' - @.141 = "Miller" ; #.141 = 'M460' - @.143 = "Moses" ; #.143 = 'M220' - @.146 = "Moskowitz" ; #.146 = 'M232' - @.147 = "Moskovitz" ; #.147 = 'M213' - @.150 = "O'Conner" ; #.150 = 'O256' - @.151 = "O'Connor" ; #.151 = 'O256' - @.152 = "O'Hara" ; #.152 = 'O600' - @.153 = "O'Mally" ; #.153 = 'O540' - @.161 = "Peters" ; #.161 = 'P362' - @.162 = "Peterson" ; #.162 = 'P362' - @.165 = "Pfister" ; #.165 = 'P236' - @.180 = "R2-D2" ; #.180 = 'R300' - @.182 = "rÄ≈sumÅ∙" ; #.182 = 'R250' - @.184 = "Robert" ; #.184 = 'R163' - @.185 = "Rupert" ; #.185 = 'R163' - @.187 = "Rubin" ; #.187 = 'R150' - @.191 = "Soundex" ; #.191 = 'S532' - @.192 = "sownteks" ; #.192 = 'S532' - @.199 = "Swhgler" ; #.199 = 'S460' - @.202 = "'til" ; #.202 = 'T400' - @.208 = "Tymczak" ; #.208 = 'T522' - @.216 = "Uhrbach" ; #.216 = 'U612' - @.221 = "Van de Graaff" ; #.221 = 'V532' - @.222 = "VanDeusen" ; #.222 = 'V532' - @.230 = "Washington" ; #.230 = 'W252' - @.233 = "Wheaton" ; #.233 = 'W350' - @.234 = "Williams" ; #.234 = 'W452' - @.236 = "Woolcock" ; #.236 = 'W422' +/*REXX program demonstrates Soundex codes from some words or from the command line.*/ +_=; @.= /*set a couple of vars to "null".*/ +parse arg @.0 . /*allow input from command line. */ + @.1 = "12346" ; #.1 = '0000' + @.4 = "4-H" ; #.4 = 'H000' + @.11 = "Ashcraft" ; #.11 = 'A261' + @.12 = "Ashcroft" ; #.12 = 'A261' + @.18 = "auerbach" ; #.18 = 'A612' + @.20 = "Baragwanath" ; #.20 = 'B625' + @.22 = "bar" ; #.22 = 'B600' + @.23 = "barre" ; #.23 = 'B600' + @.20 = "Baragwanath" ; #.20 = 'B625' + @.28 = "Burroughs" ; #.28 = 'B620' + @.29 = "Burrows" ; #.29 = 'B620' + @.30 = "C.I.A." ; #.30 = 'C000' + @.37 = "coöp" ; #.37 = 'C100' + @.43 = "D-day" ; #.43 = 'D000' + @.44 = "d jay" ; #.44 = 'D200' + @.45 = "de la Rosa" ; #.45 = 'D462' + @.46 = "Donnell" ; #.46 = 'D540' + @.47 = "Dracula" ; #.47 = 'D624' + @.48 = "Drakula" ; #.48 = 'D624' + @.49 = "Du Pont" ; #.49 = 'D153' + @.50 = "Ekzampul" ; #.50 = 'E251' + @.51 = "example" ; #.51 = 'E251' + @.55 = "Ellery" ; #.55 = 'E460' + @.59 = "Euler" ; #.59 = 'E460' + @.60 = "F.B.I." ; #.60 = 'F000' + @.70 = "Gauss" ; #.70 = 'G200' + @.71 = "Ghosh" ; #.71 = 'G200' + @.72 = "Gutierrez" ; #.72 = 'G362' + @.80 = "he" ; #.80 = 'H000' + @.81 = "Heilbronn" ; #.81 = 'H416' + @.84 = "Hilbert" ; #.84 = 'H416' + @.100 = "Jackson" ; #.100 = 'J250' + @.104 = "Johnny" ; #.104 = 'J500' + @.105 = "Jonny" ; #.105 = 'J500' + @.110 = "Kant" ; #.110 = 'K530' + @.116 = "Knuth" ; #.116 = 'K530' + @.120 = "Ladd" ; #.120 = 'L300' + @.124 = "Llyod" ; #.124 = 'L300' + @.125 = "Lee" ; #.125 = 'L000' + @.126 = "Lissajous" ; #.126 = 'L222' + @.128 = "Lukasiewicz" ; #.128 = 'L222' + @.130 = "naïve" ; #.130 = 'N100' + @.141 = "Miller" ; #.141 = 'M460' + @.143 = "Moses" ; #.143 = 'M220' + @.146 = "Moskowitz" ; #.146 = 'M232' + @.147 = "Moskovitz" ; #.147 = 'M213' + @.150 = "O'Conner" ; #.150 = 'O256' + @.151 = "O'Connor" ; #.151 = 'O256' + @.152 = "O'Hara" ; #.152 = 'O600' + @.153 = "O'Mally" ; #.153 = 'O540' + @.161 = "Peters" ; #.161 = 'P362' + @.162 = "Peterson" ; #.162 = 'P362' + @.165 = "Pfister" ; #.165 = 'P236' + @.180 = "R2-D2" ; #.180 = 'R300' + @.182 = "rÄ≈sumÅ∙" ; #.182 = 'R250' + @.184 = "Robert" ; #.184 = 'R163' + @.185 = "Rupert" ; #.185 = 'R163' + @.187 = "Rubin" ; #.187 = 'R150' + @.191 = "Soundex" ; #.191 = 'S532' + @.192 = "sownteks" ; #.192 = 'S532' + @.199 = "Swhgler" ; #.199 = 'S460' + @.202 = "'til" ; #.202 = 'T400' + @.208 = "Tymczak" ; #.208 = 'T522' + @.216 = "Uhrbach" ; #.216 = 'U612' + @.221 = "Van de Graaff" ; #.221 = 'V532' + @.222 = "VanDeusen" ; #.222 = 'V532' + @.230 = "Washington" ; #.230 = 'W252' + @.233 = "Wheaton" ; #.233 = 'W350' + @.234 = "Williams" ; #.234 = 'W452' + @.236 = "Woolcock" ; #.236 = 'W422' - do k=0 for 300; if @.k=='' then iterate; $=soundex(@.k) - say word('nope [ok]',1+($==#.k | k==0)) _ $ 'is the Soundex for' @.k + do k=0 for 300; if @.k=='' then iterate; $=soundex(@.k) + say word('nope [ok]', 1 +($==#.k | k==0)) _ $ "is the Soundex for" @.k if k==0 then leave end /*k*/ -exit /*stick a fork in it, we're done.*/ -/*───────────────────────────────────SOUNDEX subroutine─────────────────*/ -soundex: procedure; arg thing /*ARG automatically uppercases it*/ -old_alphabet = 'AEIOUYHWBFPVCGJKQSXZDTLMNR' -new_alphabet = '@@@@@@**111122222222334556' -word= - do i=1 for length(thing) /*handle special chars: - ' _ etc*/ - _=substr(thing, i, 1) - if datatype(_,'M') then word=word || _ /*it's a letter, then OK*/ - end /*i*/ +exit /*stick a fork in it, we're done.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +soundex: procedure; arg x /*ARG uppercases the var X. */ + old_alphabet= 'AEIOUYHWBFPVCGJKQSXZDTLMNR' + new_alphabet= '@@@@@@**111122222222334556' + word= /* [+] exclude non-letters. */ + do i=1 for length(x); _=substr(x, i, 1) /*obtain a character from word*/ + if datatype(_,'M') then word=word || _ /*Upper/lower letter? Then OK*/ + end /*i*/ -value=strip(left(word, 1)) /*first character is left alone. */ -word=translate(word, new_alphabet, old_alphabet) -prev=translate(value,new_alphabet, old_alphabet) /*the previous code.*/ + value=strip(left(word, 1)) /*1st character is left alone.*/ + word=translate(word, new_alphabet, old_alphabet) /*define the current word. */ + prev=translate(value,new_alphabet, old_alphabet) /* " " previous " */ - do j=2 to length(word) /*process remainder of the word. */ - ?=substr(word, j, 1) - if ?\==prev & datatype(?,'W') then do; value=value || ?; prev=?; end - else if ?=='@' then prev=? - end /*j*/ + do j=2 to length(word) /*process remainder of word. */ + ?=substr(word, j, 1) + if ?\==prev & datatype(?,'W') then do; value=value || ?; prev=?; end + else if ?=='@' then prev=? + end /*j*/ -return left(value,4,0) /*return padded value with zeroes*/ + return left(value,4,0) /*padded value with zeroes. */ diff --git a/Task/Soundex/TXR/soundex-2.txr b/Task/Soundex/TXR/soundex-2.txr index 7f2bcf958b..eec7386557 100644 --- a/Task/Soundex/TXR/soundex-2.txr +++ b/Task/Soundex/TXR/soundex-2.txr @@ -11,13 +11,13 @@ (if (zerop (length s)) "" (let* ((su (upcase-str s)) - (o (chr-str su 0))) + (o [su 0])) (for ((i 1) (l (length su)) cp cg) - ((< i l) (sub-str (cat-str ^(,o "000") nil) 0 4)) + ((< i l) [`@{o}000` 0 4]) ((inc i) (set cp cg)) - (set cg (get-code (chr-str su i))) - (if (and cg (null (eql cg cp))) - (set o (cat-str ^(,o ,cg) nil)))))))) + (set cg (get-code [su i])) + (if (and cg (not (eql cg cp))) + (set o `@o@cg`))))))) @(next :args) @(repeat) @arg diff --git a/Task/Soundex/UNIX-Shell/soundex-1.sh b/Task/Soundex/UNIX-Shell/soundex-1.sh new file mode 100644 index 0000000000..def5fc6f05 --- /dev/null +++ b/Task/Soundex/UNIX-Shell/soundex-1.sh @@ -0,0 +1,8 @@ +declare -A value=( + [B]=1 [F]=1 [P]=1 [V]=1 + [C]=2 [G]=2 [J]=2 [K]=2 [Q]=2 [S]=2 [X]=2 [Z]=2 + [D]=3 [T]=3 + [L]=4 + [M]=5 [N]=5 + [R]=6 +) diff --git a/Task/Soundex/UNIX-Shell/soundex-2.sh b/Task/Soundex/UNIX-Shell/soundex-2.sh new file mode 100644 index 0000000000..b9615f2701 --- /dev/null +++ b/Task/Soundex/UNIX-Shell/soundex-2.sh @@ -0,0 +1,36 @@ +soundex() { + local -u word=${1//[^[:alpha:]]/.} + local letter=${word:0:1} + local soundex=$letter + local previous=$letter + + word=${word:1} + word=${word//[AEIOUY]/.} + word=${word//[WH]/=} + + while [[ ${#soundex} -lt 4 && -n $word ]]; do + letter=${word:0:1} + + if [[ $letter == "." ]]; then + previous="" + + elif [[ $letter == "=" ]]; then + if [[ $previous == [A-Z] && ${word:1:1} == [A-Z] ]] && + [[ ${value[$previous]} -eq ${value[${word:1:1}]} ]] + then + word=${word:1} + fi + + elif [[ -z $previous ]] || + [[ $letter != $previous && ${value[$letter]} -ne ${value[$previous]} ]] + then + previous=$letter + soundex+=${value[$letter]} + fi + + word=${word:1} + done + # right pad with zeros + soundex+="000" + echo "${soundex:0:4}" +} diff --git a/Task/Soundex/UNIX-Shell/soundex-3.sh b/Task/Soundex/UNIX-Shell/soundex-3.sh new file mode 100644 index 0000000000..97f04d96b0 --- /dev/null +++ b/Task/Soundex/UNIX-Shell/soundex-3.sh @@ -0,0 +1,44 @@ +soundex2() { + local -u word=${1//[^[:alpha:]]/} + + # 1. Save the first letter. Remove all occurrences of 'h' and 'w' except first letter. + local first=${word:0:1} + word=${word:1} + word=$first${word//[HW]/} + + # 2. Replace all consonants (include the first letter) with digits as in [2.] above. + local consonants=$(IFS=; echo "${!value[*]}") + local tmp letter + local -i i + for ((i=0; i < ${#word}; i++)); do + letter=${word:i:1} + if [[ $consonants == *$letter* ]]; then + tmp+=${value[$letter]} + else + tmp+=$letter + fi + done + word=$tmp + + # 3. Replace all adjacent same digits with one digit. + local char + tmp=${word:0:1} + local previous=${word:0:1} + for ((i=1; i < ${#word}; i++)); do + char=${word:i:1} + [[ $char != [[:digit:]] || $char != $previous ]] && tmp+=$char + previous=$char + done + word=$tmp + + # 4. Remove all occurrences of a, e, i, o, u, y except first letter. + tmp=${word:1} + word=${word:0:1}${tmp//[AEIOUY]/} + + # 5. If first symbol is a digit replace it with letter saved on step 1. + [[ $word == [[:digit:]]* ]] && word=$first${word:1} + + # 6. right pad with zeros + word+="000" + echo "${word:0:4}" +} diff --git a/Task/Soundex/UNIX-Shell/soundex-4.sh b/Task/Soundex/UNIX-Shell/soundex-4.sh new file mode 100644 index 0000000000..2d76e3dd97 --- /dev/null +++ b/Task/Soundex/UNIX-Shell/soundex-4.sh @@ -0,0 +1,21 @@ +soundex3() { + local -u word=${1//[^[:alpha:]]/} + + # 1. Save the first letter. Remove all occurrences of 'h' and 'w' except first letter. + local first=${word:0:1} + word=$first$( tr -d "HW" <<< "${word:1}" ) + + # 2. Replace all consonants (include the first letter) with digits as in [2.] above. + # 3. Replace all adjacent same digits with one digit. + local consonants=$( IFS=; echo "${!value[*]}" ) + local values=$( IFS=; echo "${value[*]}" ) + word=$( tr -s "$consonants" "$values" <<< "$word" ) + + # 4. Remove all occurrences of a, e, i, o, u, y except first letter. + # 5. If first symbol is a digit replace it with letter saved on step 1. + word=$first$( tr -d "AEIOUY" <<< "${word:1}" ) + + # 6. right pad with zeros + word+="000" + echo "${word:0:4}" +} diff --git a/Task/Soundex/UNIX-Shell/soundex-5.sh b/Task/Soundex/UNIX-Shell/soundex-5.sh new file mode 100644 index 0000000000..bc3cbcf062 --- /dev/null +++ b/Task/Soundex/UNIX-Shell/soundex-5.sh @@ -0,0 +1,28 @@ +declare -A tests=( + [Soundex]=S532 [Example]=E251 [Sownteks]=S532 [Ekzampul]=E251 + [Euler]=E460 [Gauss]=G200 [Hilbert]=H416 [Knuth]=K530 + [Lloyd]=L300 [Lukasiewicz]=L222 [Ellery]=E460 [Ghosh]=G200 + [Heilbronn]=H416 [Kant]=K530 [Ladd]=L300 [Lissajous]=L222 + [Wheaton]=W350 [Burroughs]=B620 [Burrows]=B620 ["O'Hara"]=O600 + [Washington]=W252 [Lee]=L000 [Gutierrez]=G362 [Pfister]=P236 + [Jackson]=J250 [Tymczak]=T522 [VanDeusen]=V532 [Ashcraft]=A261 +) + +run_tests() { + local func=$1 + echo "Testing with function $func" + local -i all=0 fail=0 + for name in "${!tests[@]}"; do + s=$($func "$name") + if [[ $s != "${tests[$name]}" ]]; then + echo "FAIL - $s - $name -- EXPECTING ${tests[$name]}" + ((fail++)) + fi + ((all++)) + done + echo "$fail out of $all failures" +} + +run_tests soundex +run_tests soundex2 +run_tests soundex3 diff --git a/Task/Sparkline-in-unicode/00DESCRIPTION b/Task/Sparkline-in-unicode/00DESCRIPTION index 40e71b8f36..30fc23d6e8 100644 --- a/Task/Sparkline-in-unicode/00DESCRIPTION +++ b/Task/Sparkline-in-unicode/00DESCRIPTION @@ -1,6 +1,8 @@ A [[wp:Sparkline|sparkline]] is a graph of successive values laid out horizontally where the height of the line is proportional to the values in succession. + +;Task: Use the following series of Unicode characters to create a program that takes a series of numbers separated by one or more whitespace or comma characters and generates a sparkline-type bar graph of the values on a single line of output. @@ -17,3 +19,4 @@ here on this page: ;Notes: * A space is not part of the generated sparkline. * The sparkline may be accompanied by simple statistics of the data such as its range. +

    diff --git a/Task/Sparkline-in-unicode/AppleScript/sparkline-in-unicode.applescript b/Task/Sparkline-in-unicode/AppleScript/sparkline-in-unicode.applescript new file mode 100644 index 0000000000..1fbf56758d --- /dev/null +++ b/Task/Sparkline-in-unicode/AppleScript/sparkline-in-unicode.applescript @@ -0,0 +1,194 @@ +use framework "Foundation" -- Yosemite onwards – for splitting by regex + +-- sparkLine :: [Num] -> String +on sparkLine(xs) + set min to minimumBy(my numericOrdering, xs) + set max to maximumBy(my numericOrdering, xs) + set dataRange to max - min + + -- scale :: Num -> Num + script scale + on lambda(x) + ((x - min) * 7) / dataRange + end lambda + end script + + -- bucket :: Num -> String + script bucket + on lambda(n) + if n ≥ 0 and n < 8 then + item (n + 1 as integer) of "▁▂▃▄▅▆▇█" + else + missing value + end if + end lambda + end script + + intercalate("", map(bucket, map(scale, xs))) +end sparkLine + +-- numericOrdering :: Num -> Num -> (-1 | 0 | 1) +on numericOrdering(a, b) + if a < b then + -1 + else + if a > b then + 1 + else + 0 + end if + end if +end numericOrdering + + +-- TEST +on run + + -- splitNumbers :: String -> [Real] + script splitNumbers + script asReal + on lambda(x) + x as real + end lambda + end script + + on lambda(s) + map(asReal, splitRegex("[\\s,]+", s)) + end lambda + end script + + map(sparkLine, map(splitNumbers, ["1 2 3 4 5 6 7 8 7 6 5 4 3 2 1", ¬ + "1.5, 0.5 3.5, 2.5 5.5, 4.5 7.5, 6.5", ¬ + "3 2 1 0 -1 -2 -3 -4 -3 -2 -1 0 1 2 3", ¬ + "-1000 100 1000 500 200 -400 -700 621 -189 3"])) + + -- {"▁▂▃▄▅▆▇█▇▆▅▄▃▂▁","▂▁▄▃▆▅█▇","█▇▆▅▄▃▂▁▂▃▄▅▆▇█","▁▅█▆▅▃▂▇▄▅"} +end run + + + + +-- GENERIC LIBRARY FUNCTIONS + +-- 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 + +-- 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 + +-- maximumBy :: (a -> a -> Ordering) -> [a] -> a +on maximumBy(f, xs) + script max + property cmp : f + on lambda(a, b) + if a is missing value or cmp(a, b) < 0 then + b + else + a + end if + end lambda + end script + + foldl(max, missing value, xs) +end maximumBy + +-- minimumBy :: (a -> a -> Ordering) -> [a] -> a +on minimumBy(f, xs) + script min + property cmp : f + on lambda(a, b) + if a is missing value or cmp(a, b) > 0 then + b + else + a + end if + end lambda + end script + + foldl(min, missing value, xs) +end minimumBy + +-- splitRegex :: RegexPattern -> String -> [String] +on splitRegex(strRegex, str) + set lstMatches to regexMatches(strRegex, str) + if length of lstMatches > 0 then + script preceding + on lambda(a, x) + set iFrom to start of a + set iLocn to (location of x) + + if iLocn > iFrom then + set strPart to text (iFrom + 1) thru iLocn of str + else + set strPart to "" + end if + {parts:parts of a & strPart, start:iLocn + (length of x) - 1} + end lambda + end script + + set recLast to foldl(preceding, {parts:[], start:0}, lstMatches) + + set iFinal to start of recLast + if iFinal < length of str then + parts of recLast & text (iFinal + 1) thru -1 of str + else + parts of recLast & "" + end if + else + {str} + end if +end splitRegex + +-- regexMatches :: RegexPattern -> String -> [{location:Int, length:Int}] +on regexMatches(strRegex, str) + set ca to current application + set oRgx to ca's NSRegularExpression's regularExpressionWithPattern:strRegex ¬ + options:((ca's NSRegularExpressionAnchorsMatchLines as integer)) |error|:(missing value) + set oString to ca's NSString's stringWithString:str + set oMatches to oRgx's matchesInString:oString options:0 range:{location:0, |length|:oString's |length|()} + + set lstMatches to {} + set lng to count of oMatches + repeat with i from 1 to lng + set end of lstMatches to range() of item i of oMatches + end repeat + lstMatches +end regexMatches + +-- intercalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate + +-- 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 diff --git a/Task/Sparkline-in-unicode/Elixir/sparkline-in-unicode-1.elixir b/Task/Sparkline-in-unicode/Elixir/sparkline-in-unicode-1.elixir index 244fd1b8ff..074bb86cb7 100644 --- a/Task/Sparkline-in-unicode/Elixir/sparkline-in-unicode-1.elixir +++ b/Task/Sparkline-in-unicode/Elixir/sparkline-in-unicode-1.elixir @@ -1,8 +1,8 @@ defmodule RC do def sparkline(str) do values = str |> String.split(~r/(,| )+/) - |> Enum.map(&(elem(Float.parse(&1), 0))) - {min, max} = {Enum.min(values), Enum.max(values)} + |> Enum.map(&elem(Float.parse(&1), 0)) + {min, max} = Enum.min_max(values) IO.puts Enum.map(values, &(round((&1 - min) / (max - min) * 7 + 0x2581))) end end diff --git a/Task/Sparkline-in-unicode/JavaScript/sparkline-in-unicode.js b/Task/Sparkline-in-unicode/JavaScript/sparkline-in-unicode.js new file mode 100644 index 0000000000..bdf1b9e553 --- /dev/null +++ b/Task/Sparkline-in-unicode/JavaScript/sparkline-in-unicode.js @@ -0,0 +1,49 @@ +(() => { + 'use strict'; + + // sparkLine :: [Num] -> String + let sparkLine = xs => { + let min = minimumBy(numericOrdering, xs), + max = maximumBy(numericOrdering, xs), + range = max - min; + + return xs.map(x => ((x - min) * 7) / range) + .map( + n => (n >= 0 && n < 8) ? '▁▂▃▄▅▆▇█' + .split('')[Math.round(n)] : undefined + ).join(''); + }, + + // maximumBy :: (a -> a -> Ordering) -> [a] -> a + maximumBy = (f, xs) => + xs.reduce((a, x) => + a === undefined ? x : ( + f(x, a) > 0 ? x : a + ), + undefined + ), + + + // minimumBy :: (a -> a -> Ordering) -> [a] -> a + minimumBy = (f, xs) => + xs.reduce((a, x) => + a === undefined ? x : ( + f(x, a) < 0 ? x : a + ), + undefined + ), + + numericOrdering = (a, b) => a < b ? -1 : (a > b ? 1 : 0); + + // TEST + + return ["1 2 3 4 5 6 7 8 7 6 5 4 3 2 1", + "1.5, 0.5 3.5, 2.5 5.5, 4.5 7.5, 6.5", + "3 2 1 0 -1 -2 -3 -4 -3 -2 -1 0 1 2 3", + "-1000 100 1000 500 200 -400 -700 621 -189 3" + ].map( + s => s.split(/[,\s]+/) + .map(x => parseFloat(x, 10)) + ).map(sparkLine); + +})(); diff --git a/Task/Sparkline-in-unicode/Kotlin/sparkline-in-unicode.kotlin b/Task/Sparkline-in-unicode/Kotlin/sparkline-in-unicode.kotlin new file mode 100644 index 0000000000..5b4f3615ce --- /dev/null +++ b/Task/Sparkline-in-unicode/Kotlin/sparkline-in-unicode.kotlin @@ -0,0 +1,22 @@ +internal val bars = "▁▂▃▄▅▆▇█" +internal val n = bars.length - 1 + +fun Iterable.toSparkline(): String { + var min = Double.MAX_VALUE + var max = Double.MIN_VALUE + val doubles = map { it.toDouble() } + doubles.forEach { i -> when { i < min -> min = i; i > max -> max = i } } + val range = max - min + return doubles.fold("") { line, d -> line + bars[Math.ceil((d - min) / range * n).toInt()] } +} + +fun String.toSparkline() = replace(",", "").split(" ").map { it.toFloat() }.toSparkline() + +fun main(args: Array) { + val s1 = "1 2 3 4 5 6 7 8 7 6 5 4 3 2 1" + println(s1) + println(s1.toSparkline()) + val s2 = "1.5, 0.5 3.5, 2.5 5.5, 4.5 7.5, 6.5" + println(s2) + println(s2.toSparkline()) +} diff --git a/Task/Sparkline-in-unicode/PicoLisp/sparkline-in-unicode-1.l b/Task/Sparkline-in-unicode/PicoLisp/sparkline-in-unicode-1.l new file mode 100644 index 0000000000..50d5874cd3 --- /dev/null +++ b/Task/Sparkline-in-unicode/PicoLisp/sparkline-in-unicode-1.l @@ -0,0 +1,6 @@ +(de sparkLine (Lst) + (let (Min (apply min Lst) Max (apply max Lst) Rng (- Max Min)) + (for N Lst + (prin + (char (+ 9601 (*/ (- N Min) 7 Rng)) ) ) ) + (prinl) ) ) diff --git a/Task/Sparkline-in-unicode/PicoLisp/sparkline-in-unicode-2.l b/Task/Sparkline-in-unicode/PicoLisp/sparkline-in-unicode-2.l new file mode 100644 index 0000000000..85312b7d0d --- /dev/null +++ b/Task/Sparkline-in-unicode/PicoLisp/sparkline-in-unicode-2.l @@ -0,0 +1,2 @@ +(sparkLine (str "1 2 3 4 5 6 7 8 7 6 5 4 3 2 1")) +(sparkLine (scl 1 (str "1.5, 0.5 3.5, 2.5 5.5, 4.5 7.5, 6.5"))) diff --git a/Task/Special-characters/00DESCRIPTION b/Task/Special-characters/00DESCRIPTION index da7de69eb4..2d2c484c0c 100644 --- a/Task/Special-characters/00DESCRIPTION +++ b/Task/Special-characters/00DESCRIPTION @@ -1,5 +1,10 @@ -Special characters are symbols (single characters or sequences of characters) that have a "special" built-in meaning in the language and typically cannot be used in identifiers. Escape sequences are methods that the language uses to remove the special meaning from the symbol, enabling it to be used as a normal character, or sequence of characters when this can be done. +Special characters are symbols (single characters or sequences of characters) that have a "special" built-in meaning in the language and typically cannot be used in identifiers. +Escape sequences are methods that the language uses to remove the special meaning from the symbol, enabling it to be used as a normal character, or sequence of characters when this can be done. + + +;Task: List the special characters and show escape sequences in the language. See also: [[Quotes]] +

    diff --git a/Task/Special-variables/00DESCRIPTION b/Task/Special-variables/00DESCRIPTION index 6f0da90a05..890d9e40ac 100644 --- a/Task/Special-variables/00DESCRIPTION +++ b/Task/Special-variables/00DESCRIPTION @@ -1 +1,6 @@ -Special variables have a predefined meaning within the programming language. The task is to list the special variables used within the language. +Special variables have a predefined meaning within a computer programming language. + + +;Task: +List the special variables used within the language. +

    diff --git a/Task/Special-variables/PowerShell/special-variables-1.psh b/Task/Special-variables/PowerShell/special-variables-1.psh new file mode 100644 index 0000000000..44a7dd9e01 --- /dev/null +++ b/Task/Special-variables/PowerShell/special-variables-1.psh @@ -0,0 +1,40 @@ +<# + $$ + $? + $^ + $_ + $Args + $ConsoleFileName + $Error + $Event + $EventSubscriber + $ExecutionContext + $False + $ForEach + $Home + $Host + $Input + $LastExitCode + $Matches + $MyInvocation + $NestedPromptLevel + $NULL + $PID + $Profile + $PSBoundParameters + $PsCmdlet + $PsCulture + $PSDebugContext + $PsHome + $PSitem + $PSScriptRoot + $PsUICulture + $PsVersionTable + $Pwd + $Sender + $ShellID + $SourceArgs + $SourceEventArgs + $This + $True +#> diff --git a/Task/Special-variables/PowerShell/special-variables-2.psh b/Task/Special-variables/PowerShell/special-variables-2.psh new file mode 100644 index 0000000000..335b86e89d --- /dev/null +++ b/Task/Special-variables/PowerShell/special-variables-2.psh @@ -0,0 +1 @@ +help about_automatic_variables diff --git a/Task/Speech-synthesis/00DESCRIPTION b/Task/Speech-synthesis/00DESCRIPTION index 03a462c190..7baec648f6 100644 --- a/Task/Speech-synthesis/00DESCRIPTION +++ b/Task/Speech-synthesis/00DESCRIPTION @@ -1,2 +1,6 @@ -[[Category:Speech synthesis]][[Category:Temporal media]] -Render the text “This is an example of speech synthesis.” as speech. + +[[Category:Speech synthesis]] +[[Category:Temporal media]] + +Render the text       '''This is an example of speech synthesis'''      as speech. +

    diff --git a/Task/Speech-synthesis/Go/speech-synthesis.go b/Task/Speech-synthesis/Go/speech-synthesis.go new file mode 100644 index 0000000000..13691a4487 --- /dev/null +++ b/Task/Speech-synthesis/Go/speech-synthesis.go @@ -0,0 +1,28 @@ +package main + +import ( + "go/build" + "log" + "path/filepath" + + "github.com/unixpickle/gospeech" + "github.com/unixpickle/wav" +) + +const pkgPath = "github.com/unixpickle/gospeech" +const input = "This is an example of speech synthesis." + +func main() { + p, err := build.Import(pkgPath, ".", build.FindOnly) + if err != nil { + log.Fatal(err) + } + d := filepath.Join(p.Dir, "dict/cmudict-IPA.txt") + dict, err := gospeech.LoadDictionary(d) + if err != nil { + log.Fatal(err) + } + phonetics := dict.TranslateToIPA(input) + synthesized := gospeech.DefaultVoice.Synthesize(phonetics) + wav.WriteFile(synthesized, "output.wav") +} diff --git a/Task/Speech-synthesis/PARI-GP/speech-synthesis-1.pari b/Task/Speech-synthesis/PARI-GP/speech-synthesis-1.pari new file mode 100644 index 0000000000..81d0bfeb8b --- /dev/null +++ b/Task/Speech-synthesis/PARI-GP/speech-synthesis-1.pari @@ -0,0 +1 @@ +speak(txt,opt="")=extern(concat(["espeak ",opt," \"",txt,"\""])); diff --git a/Task/Speech-synthesis/PARI-GP/speech-synthesis-2.pari b/Task/Speech-synthesis/PARI-GP/speech-synthesis-2.pari new file mode 100644 index 0000000000..4c4aa163d2 --- /dev/null +++ b/Task/Speech-synthesis/PARI-GP/speech-synthesis-2.pari @@ -0,0 +1 @@ +speak("This is an example of speech synthesis") diff --git a/Task/Speech-synthesis/PARI-GP/speech-synthesis-3.pari b/Task/Speech-synthesis/PARI-GP/speech-synthesis-3.pari new file mode 100644 index 0000000000..014c59a80d --- /dev/null +++ b/Task/Speech-synthesis/PARI-GP/speech-synthesis-3.pari @@ -0,0 +1 @@ +speak("The seething sea ceaseth and thus the seething sea sufficeth us.","-p10 -s100") diff --git a/Task/Speech-synthesis/PARI-GP/speech-synthesis-4.pari b/Task/Speech-synthesis/PARI-GP/speech-synthesis-4.pari new file mode 100644 index 0000000000..6e608c91f8 --- /dev/null +++ b/Task/Speech-synthesis/PARI-GP/speech-synthesis-4.pari @@ -0,0 +1 @@ +speak("Fischers Fritz fischt frische Fische.","-vmb/mb-de2 -s130") diff --git a/Task/Speech-synthesis/PowerShell/speech-synthesis.psh b/Task/Speech-synthesis/PowerShell/speech-synthesis.psh new file mode 100644 index 0000000000..4aeaa91897 --- /dev/null +++ b/Task/Speech-synthesis/PowerShell/speech-synthesis.psh @@ -0,0 +1,6 @@ +Add-Type -AssemblyName System.Speech + +$anna = New-Object System.Speech.Synthesis.SpeechSynthesizer + +$anna.Speak("I'm sorry Dave, I'm afraid I can't do that.") +$anna.Dispose() diff --git a/Task/Speech-synthesis/Python/speech-synthesis.py b/Task/Speech-synthesis/Python/speech-synthesis.py new file mode 100644 index 0000000000..2a5a200956 --- /dev/null +++ b/Task/Speech-synthesis/Python/speech-synthesis.py @@ -0,0 +1,5 @@ +import pyttsx + +engine = pyttsx.init() +engine.say("It was all a dream.") +engine.runAndWait() diff --git a/Task/Spiral-matrix/00DESCRIPTION b/Task/Spiral-matrix/00DESCRIPTION index 432de2cc81..40ace51b38 100644 --- a/Task/Spiral-matrix/00DESCRIPTION +++ b/Task/Spiral-matrix/00DESCRIPTION @@ -1,10 +1,12 @@ -Produce a spiral array.
    -A spiral array is a square arrangement of the -first N2 natural numbers, -where the numbers increase sequentially -as you go around the edges of the array spiralling inwards. +;Task: +Produce a spiral array. -For example, given 5, produce this array: + +A   ''spiral array''   is a square arrangement of the first   N2   natural numbers,   where the +
    numbers increase sequentially as you go around the edges of the array spiraling inwards. + + +For example, given   '''5''',   produce this array:
      0  1  2  3  4
     15 16 17 18  5
    @@ -13,4 +15,9 @@ For example, given 5, produce this array:
     12 11 10  9  8
     
    -;See also [[Zig-zag matrix]] and [[Ulam_spiral_(for_primes)]] + +;Related tasks: +*   [[Zig-zag matrix]] +*   [[Identity_matrix]] +*   [[Ulam_spiral_(for_primes)]] +

    diff --git a/Task/Spiral-matrix/AppleScript/spiral-matrix.applescript b/Task/Spiral-matrix/AppleScript/spiral-matrix.applescript new file mode 100644 index 0000000000..d1a7f282ce --- /dev/null +++ b/Task/Spiral-matrix/AppleScript/spiral-matrix.applescript @@ -0,0 +1,128 @@ +-- Int -> Int -> Int -> [[Int]] +on spiral(lngRows, lngCols, nStart) + if lngRows > 0 then + {range(nStart, (nStart + lngCols) - 1)} & ¬ + map(my _reverse, ¬ + transpose(spiral(lngCols, lngRows - 1, nStart + lngCols))) + else + {{}} + end if +end spiral + + +-- TEST +on run + set n to 5 + set lstSpiral to spiral(n, n, 0) + + -- {{0, 1, 2, 3, 4}, {15, 16, 17, 18, 5}, {14, 23, 24, 19, 6}, + -- {13, 22, 21, 20, 7}, {12, 11, 10, 9, 8}} + + wikiTable(lstSpiral, ¬ + false, ¬ + "text-align:center;width:12em;height:12em;table-layout:fixed;") +end run + + +-- WIKI TABLE FORMAT + +-- wikiTable :: [Text] -> Bool -> Text -> Text +on wikiTable(lstRows, blnHdr, strStyle) + script fWikiRows + on lambda(lstRow, iRow) + set strDelim to cond(blnHdr and (iRow = 0), "!", "|") + set strDbl to strDelim & strDelim + linefeed & "|-" & linefeed & strDelim & space & ¬ + intercalate(space & strDbl & space, lstRow) + end lambda + end script + + linefeed & "{| class=\"wikitable\" " & ¬ + cond(strStyle ≠ "", "style=\"" & strStyle & "\"", "") & ¬ + intercalate("", ¬ + map(fWikiRows, lstRows)) & linefeed & "|}" & linefeed +end wikiTable + + +-- GENERIC LIBRARY FUNCTIONS + +-- 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 + +-- transpose :: [[a]] -> [[a]] +on transpose(xss) + script column + on lambda(_, iCol) + script row + on lambda(xs) + item iCol of xs + end lambda + end script + + map(row, xss) + end lambda + end script + + map(column, item 1 of xss) +end transpose + +-- _reverse :: [a] -> [a] +on _reverse(xs) + if class of xs is text then + (reverse of characters of xs) as text + else + reverse of xs + end if +end _reverse + +-- Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate + +-- range :: Int -> Int -> [Int] +on range(m, n) + if n < m then + set d to -1 + else + set d to 1 + end if + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range + +-- cond :: Bool -> (a -> b) -> (a -> b) -> (a -> b) +on cond(bool, f, g) + if bool then + f + else + g + end if +end cond + +-- 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 diff --git a/Task/Spiral-matrix/Elixir/spiral-matrix-1.elixir b/Task/Spiral-matrix/Elixir/spiral-matrix-1.elixir new file mode 100644 index 0000000000..ef70cc39f1 --- /dev/null +++ b/Task/Spiral-matrix/Elixir/spiral-matrix-1.elixir @@ -0,0 +1,19 @@ +defmodule RC do + def spiral_matrix(n) do + wide = length(to_char_list(n*n-1)) + fmt = String.duplicate("~#{wide}w ", n) <> "~n" + runs = Enum.flat_map(n..1, &[&1,&1]) |> tl + delta = Stream.cycle([{0,1},{1,0},{0,-1},{-1,0}]) + running(Enum.zip(runs,delta),0,-1,[]) + |> Enum.with_index |> Enum.sort |> Enum.chunk(n) + |> Enum.each(fn row -> :io.format fmt, (for {_,i} <- row, do: i) end) + end + + defp running([{run,{dx,dy}}|rest], x, y, track) do + new_track = Enum.reduce(1..run, track, fn i,acc -> [{x+i*dx, y+i*dy} | acc] end) + running(rest, x+run*dx, y+run*dy, new_track) + end + defp running([],_,_,track), do: track |> Enum.reverse +end + +RC.spiral_matrix(5) diff --git a/Task/Spiral-matrix/Elixir/spiral-matrix-2.elixir b/Task/Spiral-matrix/Elixir/spiral-matrix-2.elixir new file mode 100644 index 0000000000..f137d5d9a3 --- /dev/null +++ b/Task/Spiral-matrix/Elixir/spiral-matrix-2.elixir @@ -0,0 +1,30 @@ +defmodule RC do + def spiral_matrix(n) do + wide = String.length(to_string(n*n-1)) + fmt = String.duplicate("~#{wide}w ", n) <> "~n" + right(n,n-1,0,[]) |> Enum.reverse |> Enum.with_index |> Enum.sort |> Enum.chunk(n) |> + Enum.each(fn row -> + :io.format fmt, (for {_,i} <- row, do: i) + end) + end + + def right(n, side, i, coordinates) do + down(n, side, i, Enum.reduce(0..side, coordinates, fn j,acc -> [{i, i+j} | acc] end)) + end + + def down(_, 0, _, coordinates), do: coordinates + def down(n, side, i, coordinates) do + left(n, side-1, i, Enum.reduce(1..side, coordinates, fn j,acc -> [{i+j, n-1-i} | acc] end)) + end + + def left(n, side, i, coordinates) do + up(n, side, i, Enum.reduce(side..0, coordinates, fn j,acc -> [{n-1-i, i+j} | acc] end)) + end + + def up(_, 0, _, coordinates), do: coordinates + def up(n, side, i, coordinates) do + right(n, side-1, i+1, Enum.reduce(side..1, coordinates, fn j,acc -> [{i+j, i} | acc] end)) + end +end + +RC.spiral_matrix(5) diff --git a/Task/Spiral-matrix/Elixir/spiral-matrix-3.elixir b/Task/Spiral-matrix/Elixir/spiral-matrix-3.elixir new file mode 100644 index 0000000000..75ab8606f4 --- /dev/null +++ b/Task/Spiral-matrix/Elixir/spiral-matrix-3.elixir @@ -0,0 +1,19 @@ +defmodule RC do + def spiral_matrix(n) do + fmt = String.duplicate("~#{length(to_char_list(n*n-1))}w ", n) <> "~n" + Enum.flat_map(n..1, &[&1, &1]) + |> tl + |> Enum.reduce({{0,-1},{0,1},[]}, fn run,{{x,y},{dx,dy},acc} -> + side = for i <- 1..run, do: {x+i*dx, y+i*dy} + {{x+run*dx, y+run*dy}, {dy, -dx}, acc++side} + end) + |> elem(2) + |> Enum.with_index + |> Enum.sort + |> Enum.map(fn {_,i} -> i end) + |> Enum.chunk(n) + |> Enum.each(fn row -> :io.format fmt, row end) + end +end + +RC.spiral_matrix(5) diff --git a/Task/Spiral-matrix/Elixir/spiral-matrix.elixir b/Task/Spiral-matrix/Elixir/spiral-matrix.elixir deleted file mode 100644 index 5feb85aa20..0000000000 --- a/Task/Spiral-matrix/Elixir/spiral-matrix.elixir +++ /dev/null @@ -1,33 +0,0 @@ -defmodule RC do - def spiral_matrix(n) do - right(n,n-1,0,[]) |> Enum.with_index |> Enum.sort |> Enum.with_index |> - Enum.each(fn {{_,x},i} -> - :io.format("~2w ", [x]) - if( rem(i+1,n)==0, do: IO.puts "") - end) - end - - def right(n,side,i,coordinates) do - coord = for j <- 0..side, do: {i, i+j} - down(n,side,i,coordinates++coord) - end - - def down(_,0,_,coordinates), do: coordinates - def down(n,side,i,coordinates) do - coord = for j <- 1..side, do: {i+j, n-1-i} - left(n,side-1,i,coordinates++coord) - end - - def left(n,side,i,coordinates) do - coord = for j <- 0..side, do: {n-1-i, i+side-j} - up(n,side,i,coordinates++coord) - end - - def up(_,0,_,coordinates), do: coordinates - def up(n,side,i,coordinates) do - coord = for j <- 1..side, do: {i+side-j+1, i} - right(n,side-1,i+1,coordinates++coord) - end -end - -RC.spiral_matrix(5) diff --git a/Task/Spiral-matrix/Haskell/spiral-matrix-3.hs b/Task/Spiral-matrix/Haskell/spiral-matrix-3.hs index 5f5542bf28..97ff54bd0d 100644 --- a/Task/Spiral-matrix/Haskell/spiral-matrix-3.hs +++ b/Task/Spiral-matrix/Haskell/spiral-matrix-3.hs @@ -3,7 +3,7 @@ import Text.Printf (printf) -- spiral is the first row plus a smaller spiral rotated 90 deg spiral 0 _ _ = [[]] -spiral h w s = [[s .. s+w-1]] ++ rot90 (spiral w (h-1) (s+w)) +spiral h w s = [s .. s+w-1] : rot90 (spiral w (h-1) (s+w)) where rot90 = (map reverse).transpose -- this is sort of hideous, someone may want to fix it diff --git a/Task/Spiral-matrix/JavaScript/spiral-matrix-4.js b/Task/Spiral-matrix/JavaScript/spiral-matrix-4.js new file mode 100644 index 0000000000..ef438ea65f --- /dev/null +++ b/Task/Spiral-matrix/JavaScript/spiral-matrix-4.js @@ -0,0 +1,67 @@ +(n => { + + // spiral :: the first row plus a smaller spiral rotated 90 degrees clockwise + // spiral :: Int -> Int -> Int -> [[Int]] + function spiral(lngRows, lngCols, nStart) { + return lngRows ? [range(nStart, (nStart + lngCols) - 1)] + .concat( + transpose( + spiral(lngCols, lngRows - 1, nStart + lngCols) + ) + .map(reverse) + ) : [[]]; + } + + // transpose :: [[a]] -> [[a]] + function transpose(xs) { + return xs[0] + .map((_, iCol) => xs + .map((row) => row[iCol])); + } + + // reverse :: [a] -> [a] + function reverse(xs) { + return xs.slice(0) + .reverse(); + } + + // range(intFrom, intTo, optional intStep) + // Int -> Int -> Maybe Int -> [Int] + function range(m, n, step) { + let d = (step || 1) * (n >= m ? 1 : -1); + + return Array.from({ + length: Math.floor((n - m) / d) + 1 + }, (_, i) => m + (i * d)); + } + + + + // TESTING + + // replicate :: Int -> String -> String + function replicate(n, a) { + var v = [a], + o = ''; + + if (n < 1) return o; + while (n > 1) { + if (n & 1) o = o + v; + n >>= 1; + v = v + v; + } + return o + v; + } + + + return spiral(n, n, 0) + .map( + xs => xs.map(x => { + let s = `${x}`; + return replicate(4 - s.length, ' ') + s; + }) + .join('') + ) + .join('\n'); + +})(5); diff --git a/Task/Spiral-matrix/PARI-GP/spiral-matrix.pari b/Task/Spiral-matrix/PARI-GP/spiral-matrix.pari new file mode 100644 index 0000000000..8e0138bab9 --- /dev/null +++ b/Task/Spiral-matrix/PARI-GP/spiral-matrix.pari @@ -0,0 +1,9 @@ +spiral(dim) = { + my (M = matrix(dim, dim), p = s = 1, q = i = 0); + for (n=1, dim, + for (b=1, dim-n+1, M[p,q+=s] = i; i++); + for (b=1, dim-n, M[p+=s,q] = i; i++); + s = -s; + ); + M +} diff --git a/Task/Spiral-matrix/PowerShell/spiral-matrix.psh b/Task/Spiral-matrix/PowerShell/spiral-matrix.psh new file mode 100644 index 0000000000..3798502bd8 --- /dev/null +++ b/Task/Spiral-matrix/PowerShell/spiral-matrix.psh @@ -0,0 +1,36 @@ +function Spiral-Matrix ( [int]$N ) + { + # Initialize variables + $X = 0 + $Y = -1 + $i = 0 + $Sign = 1 + + # Intialize array + $A = New-Object 'int[,]' $N, $N + + # Set top row + 1..$N | ForEach { $Y += $Sign; $A[$X,$Y] = ++$i } + + # For each remaining half spiral... + ForEach ( $M in ($N-1)..1 ) + { + # Set the vertical quarter spiral + 1..$M | ForEach { $X += $Sign; $A[$X,$Y] = ++$i } + + # Curve the spiral + $Sign = -$Sign + + # Set the horizontal quarter spiral + 1..$M | ForEach { $Y += $Sign; $A[$X,$Y] = ++$i } + } + + # Convert the array to text output + $Spiral = ForEach ( $X in 1..$N ) { ( 1..$N | ForEach { $A[($X-1),($_-1)] } ) -join "`t" } + + return $Spiral + } + +Spiral-Matrix 5 +"" +Spiral-Matrix 7 diff --git a/Task/Spiral-matrix/Python/spiral-matrix-6.py b/Task/Spiral-matrix/Python/spiral-matrix-6.py index 808efedb51..c046f7bcb5 100644 --- a/Task/Spiral-matrix/Python/spiral-matrix-6.py +++ b/Task/Spiral-matrix/Python/spiral-matrix-6.py @@ -1,11 +1,12 @@ -n = 5 -dx, dy = [0, 1, 0, -1], [1, 0, -1, 0] -x, y, c = 0, -1, 1 -m = [[0 for i in range(n)] for j in range(n)] -for i in range(n + n - 1): - for j in range((n + n - i) // 2): - x += dx[i % 4] - y += dy[i % 4] - m[x][y] = c - c += 1 -print('\n'.join([' '.join([str(v) for v in r]) for r in m])) +def spiral_matrix(n): + m = [[0] * n for i in range(n)] + dx, dy = [0, 1, 0, -1], [1, 0, -1, 0] + x, y, c = 0, -1, 1 + for i in range(n + n - 1): + for j in range((n + n - i) // 2): + x += dx[i % 4] + y += dy[i % 4] + m[x][y] = c + c += 1 + return m +for i in spiral_matrix(5): print(*i) diff --git a/Task/Spiral-matrix/Python/spiral-matrix-7.py b/Task/Spiral-matrix/Python/spiral-matrix-7.py new file mode 100644 index 0000000000..d05f0fe336 --- /dev/null +++ b/Task/Spiral-matrix/Python/spiral-matrix-7.py @@ -0,0 +1,5 @@ +1 2 3 4 5 +16 17 18 19 6 +15 24 25 20 7 +14 23 22 21 8 +13 12 11 10 9 diff --git a/Task/Spiral-matrix/R/spiral-matrix-1.r b/Task/Spiral-matrix/R/spiral-matrix-1.r index c09c940dd4..27e4f616fa 100644 --- a/Task/Spiral-matrix/R/spiral-matrix-1.r +++ b/Task/Spiral-matrix/R/spiral-matrix-1.r @@ -1,32 +1,11 @@ -runsum <- function(v) { - rs <- c() - for(i in 1:length(v)) { - rs <- c(rs, sum(v[1:i])) - } - rs +spiral_matrix <- function(n) { + stopifnot(is.numeric(n)) + stopifnot(n > 0) + steps <- c(1, n, -1, -n) + reps <- n - seq_len(n * 2 - 1L) %/% 2 + indicies <- rep(rep_len(steps, length(reps)), reps) + indicies <- cumsum(indicies) + values <- integer(length(indicies)) + values[indicies] <- seq_along(indicies) + matrix(values, n, n, byrow = TRUE) } - -grade <- function(v) { - g <- vector("numeric", length(v)) - for(i in 1:length(v)) { - g[v[i]] <- i-1 - } - g -} - -makespiral <- function(spirald) { - series <- vector("numeric", spirald^2) - series[] <- 1 - l <- spirald-1; p <- spirald+1 - s <- 1 - while(l > 0) { - series[p:(p+l-1)] <- series[p:(p+l-1)] * spirald*s - series[(p+l):(p+l*2-1)] <- -s*series[(p+l):(p+l*2-1)] - p <- p + l*2 - l <- l - 1; s <- -s - } - matrix(grade(runsum(series)), spirald, spirald, byrow=TRUE) - -} - -print(makespiral(5)) diff --git a/Task/Spiral-matrix/R/spiral-matrix-2.r b/Task/Spiral-matrix/R/spiral-matrix-2.r index 68574c2a75..2654746684 100644 --- a/Task/Spiral-matrix/R/spiral-matrix-2.r +++ b/Task/Spiral-matrix/R/spiral-matrix-2.r @@ -1,13 +1,15 @@ -#more general function, v is assumed to be a vector -spiralv<-function(v){ - n<-sqrt(length(v)) - if(n!=floor(n)) stop(simpleError("length of v should be a square of an integer")) - if(n==0) stop(simpleError("v should be of positive length")) - if(n==1) M<-matrix(v,1,1) - else M<-rbind(v[1:n],cbind(spiralv(v[(2*n):(n^2)])[(n-1):1,(n-1):1],v[(n+1):(2*n-1)])) - M -} -#wrapper -spiral<-function(n){spiralv(0:(n^2-1))} -#check: -spiral(5) +> spiral_matrix(5) + [,1] [,2] [,3] [,4] [,5] +[1,] 1 2 3 4 5 +[2,] 16 17 18 19 6 +[3,] 15 24 25 20 7 +[4,] 14 23 22 21 8 +[5,] 13 12 11 10 9 + +> t(spiral_matrix(5)) + [,1] [,2] [,3] [,4] [,5] +[1,] 1 16 15 14 13 +[2,] 2 17 24 23 12 +[3,] 3 18 25 22 11 +[4,] 4 19 20 21 10 +[5,] 5 6 7 8 9 diff --git a/Task/Spiral-matrix/R/spiral-matrix-3.r b/Task/Spiral-matrix/R/spiral-matrix-3.r new file mode 100644 index 0000000000..2986ea859d --- /dev/null +++ b/Task/Spiral-matrix/R/spiral-matrix-3.r @@ -0,0 +1,15 @@ +spiral_matrix <- function(n) { + spiralv <- function(v) { + n <- sqrt(length(v)) + if (n != floor(n)) + stop("length of v should be a square of an integer") + if (n == 0) + stop("v should be of positive length") + if (n == 1) + m <- matrix(v, 1, 1) + else + m <- rbind(v[1:n], cbind(spiralv(v[(2 * n):(n^2)])[(n - 1):1, (n - 1):1], v[(n + 1):(2 * n - 1)])) + m + } + spiralv(1:(n^2)) +} diff --git a/Task/Spiral-matrix/REXX/spiral-matrix-1.rexx b/Task/Spiral-matrix/REXX/spiral-matrix-1.rexx index 5aaf573bef..f1779a0a8e 100644 --- a/Task/Spiral-matrix/REXX/spiral-matrix-1.rexx +++ b/Task/Spiral-matrix/REXX/spiral-matrix-1.rexx @@ -1,22 +1,21 @@ -/*REXX program displays a spiral in a square array (of any size). */ -parse arg size . /*get the array size from the CL.*/ -if size=='' then size=5 /*No argument? Then use default.*/ -tot=size**2 /*total # of elements in spiral.*/ -k=size /*K is the counter for the spiral*/ -row=1; col=0; start=0 /*start at row 1, col 0, with 0.*/ -/*──────────────────────────────────────────────construct the spiral #s.*/ - do n=start for k; col=col+1; @.col.row=n; end; if k==0 then exit - /* [↑] build first row of spiral*/ - do until n>=tot /*spiral matrix.*/ - do one=1 to -1 by -2 until n>=tot; k=k-1 /*perform twice.*/ - do n=n for k; row=row+one; @.col.row=n; end /*for the row···*/ - do n=n for k; col=col-one; @.col.row=n; end /* " " col···*/ - end /*one*/ /* ↑↓ direction.*/ - end /*until n≥tot*/ /* [↑] done with matrix spiral.*/ -/*──────────────────────────────────────────────display spiral to screen*/ - do row=1 for size; _= /*construct display row by row.*/ - do col=1 for size /*construct a line col by col.*/ - _=_ right(@.col.row, length(tot)) /*construct a line for display. */ - end /*col*/ /* [↑] line has an extra blank.*/ - say substr(_,2) /*SUBSTR ignores the first blank.*/ - end /*row*/ /*stick a fork in it, we're done.*/ +/*REXX program displays a spiral in a square array (of any size) from a start number.*/ +parse arg size . /*obtain optional arguments from the CL*/ +if size=='' | size=="," then size=5 /*Not specified? Then use the default.*/ +tot=size**2; L=length(tot) /*total number of elements in spiral. */ +k=size /*K: is the counter for the spiral. */ +row=1; col=0; start=0 /*start spiral at row 1, column 0. */ + /* [↓] construct the numbered spiral. */ + do n=start for k; col=col+1; @.col.row=n; end; if k==0 then exit + /* [↑] build the first row of spiral. */ + do until n>=tot /*spiral matrix.*/ + do one=1 to -1 by -2 until n>=tot; k=k-1 /*perform twice.*/ + do n=n for k; row=row+one; @.col.row=n; end /*for the row···*/ + do n=n for k; col=col-one; @.col.row=n; end /* " " col···*/ + end /*one*/ /* ↑↓ direction.*/ + end /*until n≥tot*/ /* [↑] done with the matrix spiral. */ + /* [↓] display spiral to the screen. */ + do r=1 for size; _= right(@.1.r, L) /*construct display row by row. */ + do c=2 for size-1; _=_ right(@.c.r, L) /*construct a line for the display. */ + end /*col*/ /* [↑] line has an extra leading blank*/ + say _ /*display a line (row) of the sprial. */ + end /*row*/ /*stick a fork in it, we're all done. */ diff --git a/Task/Spiral-matrix/REXX/spiral-matrix-2.rexx b/Task/Spiral-matrix/REXX/spiral-matrix-2.rexx index 5e2382bf7a..f7b5673e23 100644 --- a/Task/Spiral-matrix/REXX/spiral-matrix-2.rexx +++ b/Task/Spiral-matrix/REXX/spiral-matrix-2.rexx @@ -1,25 +1,25 @@ -/*REXX program displays a spiral in a square array (of any size). */ -parse arg size . /*get the array size from the CL.*/ -if size=='' then size=5 /*No argument? Then use default.*/ -tot=size**2 /*total # of elements in spiral.*/ -k=size /*K is the counter for the spiral*/ -row=1; col=0; start=0 /*start at row 1, col 0, with 0.*/ -/*──────────────────────────────────────────────construct the spiral #s.*/ - do n=start for k; col=col+1; @.col.row=n; end; if k==0 then exit - /* [↑] build first row of spiral*/ - do until n>=tot /*spiral matrix.*/ - do one=1 to -1 by -2 until n>=tot; k=k-1 /*perform twice.*/ - do n=n for k; row=row+one; @.col.row=n; end /*for the row···*/ - do n=n for k; col=col-one; @.col.row=n; end /* " " col···*/ - end /*one*/ /* ↑↓ direction.*/ - end /*until n≥tot*/ /* [↑] done with matrix spiral.*/ -/*──────────────────────────────────────────────display spiral to screen*/ - do twice=0 for 2; if \twice then !.=0 /*1st time? Find max col width.*/ - do row=1 for size; _= /*construct display row by row. */ - do col=1 for size; x=@.col.row /*construct a line col by col. */ - if twice then _=_ right(x,!.col) /*construct a line for display.*/ - else !.col=max(!.col,length(x)) /*find width of column*/ - end /*col*/ /* [↓] line has an extra blank.*/ - if twice then say substr(_,2) /*SUBSTR ignores the 1st blank. */ - end /*row*/ /*stick a fork in it, we're done*/ - end /*twice*/ +/*REXX program displays a spiral in a square array (of any size) from a start number.*/ +parse arg size . /*obtain optional arguments from the CL*/ +if size=='' | size=="," then size=5 /*Not specified? Then use the default.*/ +tot=size**2; L=length(tot) /*total number of elements in spiral. */ +k=size /*K: is the counter for the spiral. */ +row=1; col=0; start=0 /*start spiral at row 1, column 0. */ + /* [↓] construct the numbered spiral. */ + do n=start for k; col=col+1; @.col.row=n; end; if k==0 then exit + /* [↑] build the first row of spiral. */ + do until n>=tot /*spiral matrix.*/ + do one=1 to -1 by -2 until n>=tot; k=k-1 /*perform twice.*/ + do n=n for k; row=row+one; @.col.row=n; end /*for the row···*/ + do n=n for k; col=col-one; @.col.row=n; end /* " " col···*/ + end /*one*/ /* ↑↓ direction.*/ + end /*until n≥tot*/ /* [↑] done with the matrix spiral. */ +!.=0 /* [↓] display spiral to the screen. */ + do two=0 for 2 /*1st time? Find max column and width.*/ + do r=1 for size; _= /*construct display row by row. */ + do c=1 for size; x=@.c.r /*construct a line column by column. */ + if two then _=_ right(x, !.c) /*construct a line for the display. */ + else !.c=max(!.c, length(x)) /*find the maximum width of the column.*/ + end /*c*/ /* [↓] line has an extra leading blank*/ + if two then say substr(_,2) /*this SUBSTR ignores the first blank. */ + end /*r*/ + end /*two*/ /*stick a fork in it, we're all done. */ diff --git a/Task/Stable-marriage-problem/00DESCRIPTION b/Task/Stable-marriage-problem/00DESCRIPTION index 28d111a6ba..c55a7498b1 100644 --- a/Task/Stable-marriage-problem/00DESCRIPTION +++ b/Task/Stable-marriage-problem/00DESCRIPTION @@ -1,12 +1,14 @@ Solve the [[wp:Stable marriage problem|Stable marriage problem]] using the Gale/Shapley algorithm. -'''Problem description'''
    -Given an equal number of men and women to be paired for marriage, each man ranks all the women in order of his preference and each women ranks all the men in order of her preference. -A stable set of engagements for marriage is one where no man prefers a women over the one he is engaged to, where that other woman ''also'' prefers that man over the one she is engaged to. I.e. with consulting marriages, there would be no reason for the engagements between the people to change. +'''Problem description'''
    +Given an equal number of men and women to be paired for marriage, each man ranks all the women in order of his preference and each woman ranks all the men in order of her preference. + +A stable set of engagements for marriage is one where no man prefers a woman over the one he is engaged to, where that other woman ''also'' prefers that man over the one she is engaged to. I.e. with consulting marriages, there would be no reason for the engagements between the people to change. Gale and Shapley proved that there is a stable set of engagements for any set of preferences and the first link above gives their algorithm for finding a set of stable engagements. + '''Task Specifics'''
    Given ten males: abe, bob, col, dan, ed, fred, gav, hal, ian, jon @@ -39,6 +41,7 @@ And a complete list of ranked preferences, where the most liked is to the left: # Use the Gale Shapley algorithm to find a stable set of engagements # Perturb this set of engagements to form an unstable set of engagements then check this new set for stability. + '''References''' # [http://www.cs.columbia.edu/~evs/intro/stable/writeup.html The Stable Marriage Problem]. (Eloquent description and background information). # [http://sephlietz.com/gale-shapley/ Gale-Shapley Algorithm Demonstration]. @@ -46,3 +49,4 @@ And a complete list of ranked preferences, where the most liked is to the left: # [https://www.youtube.com/watch?v=Qcv1IqHWAzg Stable Marriage Problem - Numberphile] (Video). # [https://www.youtube.com/watch?v=LtTV6rIxhdo Stable Marriage Problem (the math bit)] (Video). # [http://www.ams.org/samplings/feature-column/fc-2015-03 The Stable Marriage Problem and School Choice]. (Excellent exposition) +

    diff --git a/Task/Stable-marriage-problem/Haskell/stable-marriage-problem-1.hs b/Task/Stable-marriage-problem/Haskell/stable-marriage-problem-1.hs new file mode 100644 index 0000000000..cfc8600201 --- /dev/null +++ b/Task/Stable-marriage-problem/Haskell/stable-marriage-problem-1.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE TemplateHaskell #-} +import Lens.Micro +import Lens.Micro.TH +import Data.List (union, delete) + +type Preferences a = (a, [a]) +type Couple a = (a,a) +data State a = State { _freeGuys :: [a] + , _guys :: [Preferences a] + , _girls :: [Preferences a]} + +makeLenses ''State diff --git a/Task/Stable-marriage-problem/Haskell/stable-marriage-problem-2.hs b/Task/Stable-marriage-problem/Haskell/stable-marriage-problem-2.hs new file mode 100644 index 0000000000..dca1254983 --- /dev/null +++ b/Task/Stable-marriage-problem/Haskell/stable-marriage-problem-2.hs @@ -0,0 +1,7 @@ +name n = lens get set + where get = head . dropWhile ((/= n).fst) + set assoc (_,v) = let (prev, _:post) = break ((== n).fst) assoc + in prev ++ (n, v):post + +fianceesOf n = guys.name n._2 +fiancesOf n = girls.name n._2 diff --git a/Task/Stable-marriage-problem/Haskell/stable-marriage-problem-3.hs b/Task/Stable-marriage-problem/Haskell/stable-marriage-problem-3.hs new file mode 100644 index 0000000000..3156e03b57 --- /dev/null +++ b/Task/Stable-marriage-problem/Haskell/stable-marriage-problem-3.hs @@ -0,0 +1,32 @@ +stableMatching :: Eq a => State a -> [Couple a] +stableMatching = getPairs . iterateUntil (null._freeGuys) step + where + iterateUntil p f = head . dropWhile (not . p) . iterate f + getPairs s = map (_2 %~ head) $ s^.guys + +step :: Eq a => State a -> State a +step s = foldl propose s (s^.freeGuys) + where + propose s guy = + let girl = s^.fianceesOf guy & head + bestGuy : otherGuys = s^.fiancesOf girl + modify + | guy == bestGuy = freeGuys %~ delete guy + | guy `elem` otherGuys = (fiancesOf girl %~ dropWhile (/= guy)) . + (freeGuys %~ guy `replaceBy` bestGuy) + | otherwise = fianceesOf guy %~ tail + in modify s + + replaceBy x y [] = [] + replaceBy x y (h:t) | h == x = y:t + | otherwise = h:replaceBy x y t + +unstablePairs :: Eq a => State a -> [Couple a] -> [(Couple a, Couple a)] +unstablePairs s pairs = + [ ((m1, w1), (m2,w2)) | (m1, w1) <- pairs + , (m2,w2) <- pairs + , m1 /= m2 + , let fm = s^.fianceesOf m1 + , elemIndex w2 fm < elemIndex w1 fm + , let fw = s^.fiancesOf w2 + , elemIndex m2 fw < elemIndex m1 fw ] diff --git a/Task/Stable-marriage-problem/Haskell/stable-marriage-problem-4.hs b/Task/Stable-marriage-problem/Haskell/stable-marriage-problem-4.hs new file mode 100644 index 0000000000..6bd91cb8b1 --- /dev/null +++ b/Task/Stable-marriage-problem/Haskell/stable-marriage-problem-4.hs @@ -0,0 +1,23 @@ +guys0 = + [("abe", ["abi", "eve", "cath", "ivy", "jan", "dee", "fay", "bea", "hope", "gay"]), + ("bob", ["cath", "hope", "abi", "dee", "eve", "fay", "bea", "jan", "ivy", "gay"]), + ("col", ["hope", "eve", "abi", "dee", "bea", "fay", "ivy", "gay", "cath", "jan"]), + ("dan", ["ivy", "fay", "dee", "gay", "hope", "eve", "jan", "bea", "cath", "abi"]), + ("ed", ["jan", "dee", "bea", "cath", "fay", "eve", "abi", "ivy", "hope", "gay"]), + ("fred",["bea", "abi", "dee", "gay", "eve", "ivy", "cath", "jan", "hope", "fay"]), + ("gav", ["gay", "eve", "ivy", "bea", "cath", "abi", "dee", "hope", "jan", "fay"]), + ("hal", ["abi", "eve", "hope", "fay", "ivy", "cath", "jan", "bea", "gay", "dee"]), + ("ian", ["hope", "cath", "dee", "gay", "bea", "abi", "fay", "ivy", "jan", "eve"]), + ("jon", ["abi", "fay", "jan", "gay", "eve", "bea", "dee", "cath", "ivy", "hope"])] + +girls0 = + [("abi", ["bob", "fred", "jon", "gav", "ian", "abe", "dan", "ed", "col", "hal"]), + ("bea", ["bob", "abe", "col", "fred", "gav", "dan", "ian", "ed", "jon", "hal"]), + ("cath", ["fred", "bob", "ed", "gav", "hal", "col", "ian", "abe", "dan", "jon"]), + ("dee", ["fred", "jon", "col", "abe", "ian", "hal", "gav", "dan", "bob", "ed"]), + ("eve", ["jon", "hal", "fred", "dan", "abe", "gav", "col", "ed", "ian", "bob"]), + ("fay", ["bob", "abe", "ed", "ian", "jon", "dan", "fred", "gav", "col", "hal"]), + ("gay", ["jon", "gav", "hal", "fred", "bob", "abe", "col", "ed", "dan", "ian"]), + ("hope", ["gav", "jon", "bob", "abe", "ian", "dan", "hal", "ed", "col", "fred"]), + ("ivy", ["ian", "col", "hal", "gav", "fred", "bob", "abe", "ed", "jon", "dan"]), + ("jan", ["ed", "hal", "gav", "abe", "bob", "jon", "col", "ian", "fred", "dan"])] diff --git a/Task/Stable-marriage-problem/Haskell/stable-marriage-problem-5.hs b/Task/Stable-marriage-problem/Haskell/stable-marriage-problem-5.hs new file mode 100644 index 0000000000..ab0e65ba57 --- /dev/null +++ b/Task/Stable-marriage-problem/Haskell/stable-marriage-problem-5.hs @@ -0,0 +1 @@ +s0 = State (fst <$> guys0) guys0 ((_2 %~ reverse) <$> girls0) diff --git a/Task/Stable-marriage-problem/Haskell/stable-marriage-problem.hs b/Task/Stable-marriage-problem/Haskell/stable-marriage-problem.hs deleted file mode 100644 index e0ea2d13be..0000000000 --- a/Task/Stable-marriage-problem/Haskell/stable-marriage-problem.hs +++ /dev/null @@ -1,99 +0,0 @@ -import Data.List -import Control.Monad -import Control.Arrow -import Data.Maybe - -mp = map ((head &&& tail). splitNames) - ["abe: abi, eve, cath, ivy, jan, dee, fay, bea, hope, gay", - "bob: cath, hope, abi, dee, eve, fay, bea, jan, ivy, gay", - "col: hope, eve, abi, dee, bea, fay, ivy, gay, cath, jan", - "dan: ivy, fay, dee, gay, hope, eve, jan, bea, cath, abi", - "ed: jan, dee, bea, cath, fay, eve, abi, ivy, hope, gay", - "fred: bea, abi, dee, gay, eve, ivy, cath, jan, hope, fay", - "gav: gay, eve, ivy, bea, cath, abi, dee, hope, jan, fay", - "hal: abi, eve, hope, fay, ivy, cath, jan, bea, gay, dee", - "ian: hope, cath, dee, gay, bea, abi, fay, ivy, jan, eve", - "jon: abi, fay, jan, gay, eve, bea, dee, cath, ivy, hope"] - -fp = map ((head &&& tail). splitNames) - ["abi: bob, fred, jon, gav, ian, abe, dan, ed, col, hal", - "bea: bob, abe, col, fred, gav, dan, ian, ed, jon, hal", - "cath: fred, bob, ed, gav, hal, col, ian, abe, dan, jon", - "dee: fred, jon, col, abe, ian, hal, gav, dan, bob, ed", - "eve: jon, hal, fred, dan, abe, gav, col, ed, ian, bob", - "fay: bob, abe, ed, ian, jon, dan, fred, gav, col, hal", - "gay: jon, gav, hal, fred, bob, abe, col, ed, dan, ian", - "hope: gav, jon, bob, abe, ian, dan, hal, ed, col, fred", - "ivy: ian, col, hal, gav, fred, bob, abe, ed, jon, dan", - "jan: ed, hal, gav, abe, bob, jon, col, ian, fred, dan"] - -splitNames = map (takeWhile(`notElem`",:")). words - -pref x y xs = fromJust (elemIndex x xs) < fromJust (elemIndex y xs) - -task ms fs = do - let - jos = fst $ unzip ms - - runGS es js ms = do - let (m:js') = js - (v:vm') = case lookup m ms of - Just xs -> xs - _ -> [] - vv = fromJust $ lookup v fs - m2 = case lookup v es of - Just e -> e - _ -> "" - ms1 = insert (m,vm') $ delete (m,v:vm') ms - - if null js then do - putStrLn "" - putStrLn "=== Couples ===" - return es - - else if null m2 then - do putStrLn $ v ++ " with " ++ m - runGS ( insert (v,m) es ) js' ms1 - - else if pref m m2 vv then - do putStrLn $ v ++ " dumped " ++ m2 ++ " for " ++ m - runGS ( insert (v,m) $ delete (v,m2) es ) (if not $ null vm' then js'++[m2] else js') ms1 - - else runGS es (if not $ null js' then js'++[m] else js') ms1 - - cs <- runGS [] jos ms - - mapM_ (\(f,m) -> putStrLn $ f ++ " with " ++ m ) cs - putStrLn "" - checkStab cs - - putStrLn "" - putStrLn "Introducing error: " - let [r1@(a,b), r2@(p,q)] = take 2 cs - r3 = (a,q) - r4 = (p,b) - errcs = insert r4. insert r3. delete r2 $ delete r1 cs - putStrLn $ "\tSwapping partners of " ++ a ++ " and " ++ p - putStrLn $ (\((a,b),(p,q)) -> "\t" ++ a ++ " is now with " ++ b ++ " and " ++ p ++ " with " ++ q) (r3,r4) - putStrLn "" - checkStab errcs - -checkStab es = do - let - fmt (a,b,c,d) = a ++ " and " ++ b ++ " like each other better than their current partners " ++ c ++ " and " ++ d - ies = uncurry(flip zip) $ unzip es -- es = [(fem,m)] & ies = [(m,fem)] - slb = map (\(f,m)-> (f,m, map (id &&& fromJust. flip lookup ies). fst.break(==m). fromJust $ lookup f fp) ) es - hlb = map (\(f,m)-> (m,f, map (id &&& fromJust. flip lookup es ). fst.break(==f). fromJust $ lookup m mp) ) es - tslb = concatMap (filter snd. (\(f,m,ls) -> - map (\(m2,f2) -> - ((f,m2,f2,m), pref f f2 $ fromJust $ lookup m2 mp)) ls)) slb - thlb = concatMap (filter snd. (\(m,f,ls) -> - map (\(f2,m2) -> - ((m,f2,m2,f), pref m m2 $ fromJust $ lookup f2 fp)) ls)) hlb - res = tslb ++ thlb - - if not $ null res then do - putStrLn "Marriages are unstable, e.g.:" - putStrLn.fmt.fst $ head res - - else putStrLn "Marriages are stable" diff --git a/Task/Stable-marriage-problem/J/stable-marriage-problem-3.j b/Task/Stable-marriage-problem/J/stable-marriage-problem-3.j index dc63ead7fe..8b1afed23b 100644 --- a/Task/Stable-marriage-problem/J/stable-marriage-problem-3.j +++ b/Task/Stable-marriage-problem/J/stable-marriage-problem-3.j @@ -1,19 +1 @@ - 0 105 A."_1 matchMake '' NB. swap abi and bea -┌───┬────┬───┬───┬───┬────┬───┬───┬────┬───┐ -│abe│bob │col│dan│ed │fred│gav│hal│ian │jon│ -├───┼────┼───┼───┼───┼────┼───┼───┼────┼───┤ -│ivy│cath│dee│fay│jan│abi │gay│eve│hope│bea│ -└───┴────┴───┴───┴───┴────┴───┴───┴────┴───┘ - checkStable 0 105 A."_1 matchMake '' -Engagements preferred by both members to their current ones: -┌────┬───┐ -│fred│bea│ -├────┼───┤ -│jon │fay│ -├────┼───┤ -│jon │gay│ -├────┼───┤ -│jon │eve│ -└────┴───┘ -|assertion failure: assert -| assert-.bad + checkStable matchMake'' diff --git a/Task/Stable-marriage-problem/J/stable-marriage-problem-4.j b/Task/Stable-marriage-problem/J/stable-marriage-problem-4.j new file mode 100644 index 0000000000..dc63ead7fe --- /dev/null +++ b/Task/Stable-marriage-problem/J/stable-marriage-problem-4.j @@ -0,0 +1,19 @@ + 0 105 A."_1 matchMake '' NB. swap abi and bea +┌───┬────┬───┬───┬───┬────┬───┬───┬────┬───┐ +│abe│bob │col│dan│ed │fred│gav│hal│ian │jon│ +├───┼────┼───┼───┼───┼────┼───┼───┼────┼───┤ +│ivy│cath│dee│fay│jan│abi │gay│eve│hope│bea│ +└───┴────┴───┴───┴───┴────┴───┴───┴────┴───┘ + checkStable 0 105 A."_1 matchMake '' +Engagements preferred by both members to their current ones: +┌────┬───┐ +│fred│bea│ +├────┼───┤ +│jon │fay│ +├────┼───┤ +│jon │gay│ +├────┼───┤ +│jon │eve│ +└────┴───┘ +|assertion failure: assert +| assert-.bad diff --git a/Task/Stable-marriage-problem/Kotlin/stable-marriage-problem.kotlin b/Task/Stable-marriage-problem/Kotlin/stable-marriage-problem.kotlin new file mode 100644 index 0000000000..b6924ae46b --- /dev/null +++ b/Task/Stable-marriage-problem/Kotlin/stable-marriage-problem.kotlin @@ -0,0 +1,122 @@ +import java.util.* + +class People(val map: Map>) { + operator fun get(name: String) = map[name] + + val names: List by lazy { map.keys.toList() } + + fun preferences(k: String, v: String): List { + val prefers = get(k)!! + return ArrayList(prefers.slice(0..prefers.indexOf(v))) + } +} + +class EngagementRegistry() : TreeMap() { + constructor(guys: People, girls: People) : this() { + val freeGuys = guys.names.toMutableList() + while (freeGuys.any()) { + val guy = freeGuys.removeAt(0) // get a load of THIS guy + val guy_p = guys[guy]!! + for (girl in guy_p) + if (this[girl] == null) { + this[girl] = guy // girl is free + break + } else { + val other = this[girl]!! + val girl_p = girls[girl]!! + if (girl_p.indexOf(guy) < girl_p.indexOf(other)) { + this[girl] = guy // this girl prefers this guy to the guy she's engaged to + freeGuys += other + break + } // else no change... keep looking for this guy + } + } + } + + override fun toString(): String { + val s = StringBuilder() + for ((k, v) in this) s.append("$k is engaged to $v\n") + return s.toString() + } + + fun analyse(guys: People, girls: People) { + if (check(guys, girls)) + println("Marriages are stable") + else + println("Marriages are unstable") + } + + fun swap(girls: People, i: Int, j: Int) { + val n1 = girls.names[i] + val n2 = girls.names[j] + val g0 = this[n1]!! + val g1 = this[n2]!! + this[n1] = g1 + this[n2] = g0 + println("$n1 and $n2 have switched partners") + } + + private fun check(guys: People, girls: People): Boolean { + val guy_names = guys.names + val girl_names = girls.names + if (!keys.containsAll(girl_names) or !values.containsAll(guy_names)) + return false + + val invertedMatches = TreeMap() + for ((k, v) in this) invertedMatches[v] = k + + for ((k, v) in this) { + val sheLikesBetter = girls.preferences(k, v) + val heLikesBetter = guys.preferences(v, k) + for (guy in sheLikesBetter) { + val fiance = invertedMatches[guy] + val guy_p = guys[guy]!! + if (guy_p.indexOf(fiance) > guy_p.indexOf(k)) { + println("$k likes $guy better than $v and $guy likes $k better than their current partner") + return false + } + } + + for (girl in heLikesBetter) { + val fiance = get(girl) + val girl_p = girls[girl]!! + if (girl_p.indexOf(fiance) > girl_p.indexOf(v)) { + println("$v likes $girl better than $k and $girl likes $v better than their current partner") + return false + } + } + } + return true + } +} + +fun main(args: Array) { + val guys = People(mapOf("abe" to arrayOf("abi", "eve", "cath", "ivy", "jan", "dee", "fay", "bea", "hope", "gay"), + "bob" to arrayOf("cath", "hope", "abi", "dee", "eve", "fay", "bea", "jan", "ivy", "gay"), + "col" to arrayOf("hope", "eve", "abi", "dee", "bea", "fay", "ivy", "gay", "cath", "jan"), + "dan" to arrayOf("ivy", "fay", "dee", "gay", "hope", "eve", "jan", "bea", "cath", "abi"), + "ed" to arrayOf("jan", "dee", "bea", "cath", "fay", "eve", "abi", "ivy", "hope", "gay"), + "fred" to arrayOf("bea", "abi", "dee", "gay", "eve", "ivy", "cath", "jan", "hope", "fay"), + "gav" to arrayOf("gay", "eve", "ivy", "bea", "cath", "abi", "dee", "hope", "jan", "fay"), + "hal" to arrayOf("abi", "eve", "hope", "fay", "ivy", "cath", "jan", "bea", "gay", "dee"), + "ian" to arrayOf("hope", "cath", "dee", "gay", "bea", "abi", "fay", "ivy", "jan", "eve"), + "jon" to arrayOf("abi", "fay", "jan", "gay", "eve", "bea", "dee", "cath", "ivy", "hope"))) + + val girls = People(mapOf("abi" to arrayOf("bob", "fred", "jon", "gav", "ian", "abe", "dan", "ed", "col", "hal"), + "bea" to arrayOf("bob", "abe", "col", "fred", "gav", "dan", "ian", "ed", "jon", "hal"), + "cath" to arrayOf("fred", "bob", "ed", "gav", "hal", "col", "ian", "abe", "dan", "jon"), + "dee" to arrayOf("fred", "jon", "col", "abe", "ian", "hal", "gav", "dan", "bob", "ed"), + "eve" to arrayOf("jon", "hal", "fred", "dan", "abe", "gav", "col", "ed", "ian", "bob"), + "fay" to arrayOf("bob", "abe", "ed", "ian", "jon", "dan", "fred", "gav", "col", "hal"), + "gay" to arrayOf("jon", "gav", "hal", "fred", "bob", "abe", "col", "ed", "dan", "ian"), + "hope" to arrayOf("gav", "jon", "bob", "abe", "ian", "dan", "hal", "ed", "col", "fred"), + "ivy" to arrayOf("ian", "col", "hal", "gav", "fred", "bob", "abe", "ed", "jon", "dan"), + "jan" to arrayOf("ed", "hal", "gav", "abe", "bob", "jon", "col", "ian", "fred", "dan"))) + + with(EngagementRegistry(guys, girls)) { + print(this) + analyse(guys, girls) + swap(girls, 0, 1) + analyse(guys, girls) + } +} diff --git a/Task/Stable-marriage-problem/Perl-6/stable-marriage-problem.pl6 b/Task/Stable-marriage-problem/Perl-6/stable-marriage-problem.pl6 index ec095679ce..1f7e289e13 100644 --- a/Task/Stable-marriage-problem/Perl-6/stable-marriage-problem.pl6 +++ b/Task/Stable-marriage-problem/Perl-6/stable-marriage-problem.pl6 @@ -24,9 +24,6 @@ my %she-likes = jan => < ed hal gav abe bob jon col ian fred dan >, ; -my \guys = %he-likes.keys; -my \gals = %she-likes.keys; - my %fiancé; my %fiancée; my %proposed; @@ -59,7 +56,7 @@ sub match'em { #' } sub check-stability { - my @instabilities = gather for guys X gals -> $m, $w { + my @instabilities = gather for flat %he-likes.keys X %she-likes.keys -> $m, $w { if he-prefers($m, $w) and she-prefers($w, $m) { take "\t$w prefers $m to %fiancé{$w} and $m prefers $w to %fiancée{$m}"; } @@ -74,7 +71,7 @@ sub check-stability { } } -sub unmatched-guy { guys.first: { not %fiancée{$_} } } +sub unmatched-guy { %he-likes.keys.first: { not %fiancée{$_} } } sub preferred-choice($guy) { %he-likes{$guy}.first: { not %proposed{"$guy $_" } } } diff --git a/Task/Stable-marriage-problem/REXX/stable-marriage-problem.rexx b/Task/Stable-marriage-problem/REXX/stable-marriage-problem.rexx new file mode 100644 index 0000000000..4fdeed5026 --- /dev/null +++ b/Task/Stable-marriage-problem/REXX/stable-marriage-problem.rexx @@ -0,0 +1,205 @@ +/*- REXX -------------------------------------------------------------- +* pref.b Preferences of boy b +* pref.g Preferences of girl g +* boys List of boys +* girls List of girls +* plist List of proposals +* mlist List of (current) matches +* glist List of girls to be matched +* glist.b List of girls that proposed to boy b +* blen maximum length of boys' names +* glen maximum length of girls' names +---------------------------------------------------------------------*/ + +pref.Charlotte=translate('Bingley Darcy Collins Wickham ') +pref.Elisabeth=translate('Wickham Darcy Bingley Collins ') +pref.Jane =translate('Bingley Wickham Darcy Collins ') +pref.Lydia =translate('Bingley Wickham Darcy Collins ') + +pref.Bingley =translate('Jane Elisabeth Lydia Charlotte') +pref.Collins =translate('Jane Elisabeth Lydia Charlotte') +pref.Darcy =translate('Elisabeth Jane Charlotte Lydia') +pref.Wickham =translate('Lydia Jane Elisabeth Charlotte') + +pref.ABE='ABI EVE CATH IVY JAN DEE FAY BEA HOPE GAY' +pref.BOB='CATH HOPE ABI DEE EVE FAY BEA JAN IVY GAY' +pref.COL='HOPE EVE ABI DEE BEA FAY IVY GAY CATH JAN' +pref.DAN='IVY FAY DEE GAY HOPE EVE JAN BEA CATH ABI' +pref.ED='JAN DEE BEA CATH FAY EVE ABI IVY HOPE GAY' +pref.FRED='BEA ABI DEE GAY EVE IVY CATH JAN HOPE FAY' +pref.GAV='GAY EVE IVY BEA CATH ABI DEE HOPE JAN FAY' +pref.HAL='ABI EVE HOPE FAY IVY CATH JAN BEA GAY DEE' +pref.IAN='HOPE CATH DEE GAY BEA ABI FAY IVY JAN EVE' +pref.JON='ABI FAY JAN GAY EVE BEA DEE CATH IVY HOPE' + +pref.ABI='BOB FRED JON GAV IAN ABE DAN ED COL HAL' +pref.BEA='BOB ABE COL FRED GAV DAN IAN ED JON HAL' +pref.CATH='FRED BOB ED GAV HAL COL IAN ABE DAN JON' +pref.DEE='FRED JON COL ABE IAN HAL GAV DAN BOB ED' +pref.EVE='JON HAL FRED DAN ABE GAV COL ED IAN BOB' +pref.FAY='BOB ABE ED IAN JON DAN FRED GAV COL HAL' +pref.GAY='JON GAV HAL FRED BOB ABE COL ED DAN IAN' +pref.HOPE='GAV JON BOB ABE IAN DAN HAL ED COL FRED' +pref.IVY='IAN COL HAL GAV FRED BOB ABE ED JON DAN' +pref.JAN='ED HAL GAV ABE BOB JON COL IAN FRED DAN' + +If arg(1)>'' Then Do + Say 'Input from task description' + boys='ABE BOB COL DAN ED FRED GAV HAL IAN JON' + girls='ABI BEA CATH DEE EVE FAY GAY HOPE IVY JAN' + End +Else Do + Say 'Input from link' + girls=translate('Charlotte Elisabeth Jane Lydia') + boys =translate('Bingley Collins Darcy Wickham') + End + +debug=0 +blen=0 +Do i=1 To words(boys) + blen=max(blen,length(word(boys,i))) + End +glen=0 +Do i=1 To words(girls) + glen=max(glen,length(word(girls,i))) + End +glist=girls +mlist='' +Do ri=1 By 1 Until glist='' /* as long as there are girls */ + Call dbg 'Round' ri + plist='' /* no proposals in this round */ + glist.='' + Do gi=1 To words(glist) /* loop over free girls */ + gg=word(glist,gi) /* an unmathed girl */ + b=word(pref.gg,1) /* her preferred boy */ + plist=plist gg'-'||b /* remember this proposal */ + glist.b=glist.b gg /* add girl to the boy's list */ + Call dbg left(gg,glen) 'proposes to' b /* tell the user */ + End + Do bi=1 To words(boys) /* loop over all boys */ + b=word(boys,bi) /* one of them */ + If glist.b>'' Then /* if he's got proposals */ + Call dbg b 'has these proposals' glist.b /* show them */ + End + Do bi=1 To words(boys) /* loop over all boys */ + b=word(boys,bi) /* one of them */ + bm=pos(b'*',mlist) /* has he been matched yet? */ + Select + When words(glist.b)=1 Then Do /* one girl proposed for him */ + gg=word(glist.b,1) /* the proposing girl */ + If bm=0 Then Do /* no, he hasn't */ + Call dbg b 'accepts' gg /* is accepted */ + Call set_mlist 'A',mlist b||'*'||gg /* add match to mlist */ + Call set_glist 'A',remove(gg,glist) /* remove gg from glist*/ + pref.gg=remove(b,pref.gg) /* remove b from gg's preflist*/ + End + Else Do /* boy has been matched */ + Parse Var mlist =(bm) '*' go ' ' /* to girl go */ + If wordpos(gg,pref.b)1 Then + Call pick_1 + Otherwise Nop + End + End + Call dbg 'Matches :' mlist + Call dbg 'free girls:' glist + Call check 'L' + End +Say 'Success at round' (ri-1) +Do While mlist>'' + Parse Var mlist boy '*' girl mlist + Say left(boy,blen) 'matches' girl + End +Exit + +pick_1: + If bm>0 Then Do /* boy has been matched */ + Parse Var mlist =(bm) '*' go ' ' /* to girl go */ + pmin=wordpos(go,pref.b) + End + Else Do + go='' + pmin=99 + End + Do gi=1 To words(glist.b) + gt=word(glist.b,gi) + gp=wordpos(gt,pref.b) + If gpgo Then Do + Call set_mlist 'B',repl(mlist,b||'*'||gg,b||'*'||go) + Call dbg b 'releases' go + Call dbg b 'accepts ' gg + Call set_glist 'B',glist go /* add go to list of girls */ + Call set_glist 'C',remove(gg,glist) /* and remove gg */ + pref.gg=remove(b,pref.gg) /* remove b from gg's preflist*/ + End + End + Return + +remove: + Parse Arg needle,haystack + pp=pos(needle,haystack) + If pp>0 Then + res=left(haystack,pp-1) substr(haystack,pp+length(needle)) + Else + res=haystack + Return space(res) + +set_mlist: + Parse Arg where,new_mlist + Call dbg 'set_mlist' where':' mlist + mlist=space(new_mlist) + Call dbg 'set_mlist ->' mlist + Call dbg '' + Return + +set_glist: + Parse Arg where,new_glist + Call dbg 'set_glist' where':' glist + glist=new_glist + Call dbg 'set_glist ->' glist + Call dbg '' + Return + +check: + If words(mlist)+words(glist)<>words(boys) Then Do + Call dbg 'FEHLER bei' arg(1) (words(mlist)+words(glist))'<>10' + say 'match='mlist'<' + say ' glist='glist'<' + End + Return + +dbg: + If debug Then + Call dbg arg(1) + Return +repl: Procedure + Parse Arg s,new,old + Do i=1 To 100 Until p=0 + p=pos(old,s) + If p>0 Then + s=left(s,p-1)||new||substr(s,p+length(old)) + End + Return s diff --git a/Task/Stable-marriage-problem/Scala/stable-marriage-problem.scala b/Task/Stable-marriage-problem/Scala/stable-marriage-problem.scala new file mode 100644 index 0000000000..8cb2dd66c3 --- /dev/null +++ b/Task/Stable-marriage-problem/Scala/stable-marriage-problem.scala @@ -0,0 +1,121 @@ +import java.util._ +import scala.collection.JavaConversions._ + +object SMP extends App { + def run() { + Seq("abe" -> Array("abi", "eve", "cath", "ivy", "jan", "dee", "fay", "bea", "hope", "gay"), + "bob" -> Array("cath", "hope", "abi", "dee", "eve", "fay", "bea", "jan", "ivy", "gay"), + "col" -> Array("hope", "eve", "abi", "dee", "bea", "fay", "ivy", "gay", "cath", "jan"), + "dan" -> Array("ivy", "fay", "dee", "gay", "hope", "eve", "jan", "bea", "cath", "abi"), + "ed" -> Array("jan", "dee", "bea", "cath", "fay", "eve", "abi", "ivy", "hope", "gay"), + "fred" -> Array("bea", "abi", "dee", "gay", "eve", "ivy", "cath", "jan", "hope", "fay"), + "gav" -> Array("gay", "eve", "ivy", "bea", "cath", "abi", "dee", "hope", "jan", "fay"), + "hal" -> Array("abi", "eve", "hope", "fay", "ivy", "cath", "jan", "bea", "gay", "dee"), + "ian" -> Array("hope", "cath", "dee", "gay", "bea", "abi", "fay", "ivy", "jan", "eve"), + "jon" -> Array("abi", "fay", "jan", "gay", "eve", "bea", "dee", "cath", "ivy", "hope")) + .foreach { e => guyPrefers.put(e._1, e._2.toList) } + + Seq("abi" -> Array("bob", "fred", "jon", "gav", "ian", "abe", "dan", "ed", "col", "hal"), + "bea" -> Array("bob", "abe", "col", "fred", "gav", "dan", "ian", "ed", "jon", "hal"), + "cath" -> Array("fred", "bob", "ed", "gav", "hal", "col", "ian", "abe", "dan", "jon"), + "dee" -> Array("fred", "jon", "col", "abe", "ian", "hal", "gav", "dan", "bob", "ed"), + "eve" -> Array("jon", "hal", "fred", "dan", "abe", "gav", "col", "ed", "ian", "bob"), + "fay" -> Array("bob", "abe", "ed", "ian", "jon", "dan", "fred", "gav", "col", "hal"), + "gay" -> Array("jon", "gav", "hal", "fred", "bob", "abe", "col", "ed", "dan", "ian"), + "hope" -> Array("gav", "jon", "bob", "abe", "ian", "dan", "hal", "ed", "col", "fred"), + "ivy" -> Array("ian", "col", "hal", "gav", "fred", "bob", "abe", "ed", "jon", "dan"), + "jan" -> Array("ed", "hal", "gav", "abe", "bob", "jon", "col", "ian", "fred", "dan")) + .foreach { e => girlPrefers.put(e._1, e._2.toList) } + + val matches = matching(guys, guyPrefers, girlPrefers) + matches.foreach { e => println(s"${e._1} is engaged to ${e._2}") } + if (checkMatches(guys, girls, matches, guyPrefers, girlPrefers)) + println("Marriages are stable") + else + println("Marriages are unstable") + + val tmp = matches(girls(0)) + matches += girls(0) -> matches(girls(1)) + matches += girls(1) -> tmp + println(girls(0) + " and " + girls(1) + " have switched partners") + if (checkMatches(guys, girls, matches, guyPrefers, girlPrefers)) + println("Marriages are stable") + else + println("Marriages are unstable") + } + + private def matching(guys: Iterable[String], + guyPrefers: Map[String, List[String]], + girlPrefers: Map[String, List[String]]): Map[String, String] = { + val engagements = new TreeMap[String, String] + val freeGuys = new LinkedList[String](guys) + while (!freeGuys.isEmpty) { + val guy = freeGuys.remove(0) + val guy_p = guyPrefers(guy) + var break = false + for (girl <- guy_p) + if (!break) + if (!engagements.containsKey(girl)) { + engagements += girl -> guy + break = true + } + else { + val other_guy = engagements(girl) + val girl_p = girlPrefers(girl) + if (girl_p.indexOf(guy) < girl_p.indexOf(other_guy)) { + engagements += girl -> guy + freeGuys += other_guy + break = true + } + } + } + + engagements + } + + private def checkMatches(guys: Iterable[String], girls: Iterable[String], + matches: Map[String, String], + guyPrefers: Map[String, List[String]], + girlPrefers: Map[String, List[String]]): Boolean = { + if (!matches.keySet.containsAll(girls) || !matches.values.containsAll(guys)) + return false + + val invertedMatches = new TreeMap[String, String] + matches.foreach { invertedMatches += _.swap } + + for ((k, v) <- matches) { + val shePrefers = girlPrefers(k) + val sheLikesBetter = new LinkedList[String] + sheLikesBetter.addAll(shePrefers.subList(0, shePrefers.indexOf(v))) + val hePrefers = guyPrefers(v) + val heLikesBetter = new LinkedList[String] + heLikesBetter.addAll(hePrefers.subList(0, hePrefers.indexOf(k))) + + for (guy <- sheLikesBetter) { + val fiance = invertedMatches(guy) + val guy_p = guyPrefers(guy) + if (guy_p.indexOf(fiance) > guy_p.indexOf(k)) { + println(s"$k likes $guy better than $v and $guy likes $k better than their current partner") + return false + } + } + + for (girl <- heLikesBetter) { + val fiance = matches(girl) + val girl_p = girlPrefers(girl) + if (girl_p.indexOf(fiance) > girl_p.indexOf(v)) { + println(s"$v likes $girl better than $k and $girl likes $v better than their current partner") + return false + } + } + } + true + } + + private val guys = "abe" :: "bob" :: "col" :: "dan" :: "ed" :: "fred" :: "gav" :: "hal" :: "ian" :: "jon" :: Nil + private val girls = "abi" :: "bea" :: "cath" :: "dee" :: "eve" :: "fay" :: "gay" :: "hope" :: "ivy" :: "jan" :: Nil + private val guyPrefers = new HashMap[String, List[String]] + private val girlPrefers = new HashMap[String, List[String]] + + run() +} diff --git a/Task/Stable-marriage-problem/UNIX-Shell/stable-marriage-problem.sh b/Task/Stable-marriage-problem/UNIX-Shell/stable-marriage-problem.sh new file mode 100644 index 0000000000..8fc371f973 --- /dev/null +++ b/Task/Stable-marriage-problem/UNIX-Shell/stable-marriage-problem.sh @@ -0,0 +1,167 @@ +#!/usr/bin/env bash +main() { + # Our ten males: + local males=(abe bob col dan ed fred gav hal ian jon) + + # And ten females: + local females=(abi bea cath dee eve fay gay hope ivy jan) + + # Everyone's preferences, ranked most to least desirable: + local abe=( abi eve cath ivy jan dee fay bea hope gay ) + local abi=( bob fred jon gav ian abe dan ed col hal ) + local bea=( bob abe col fred gav dan ian ed jon hal ) + local bob=(cath hope abi dee eve fay bea jan ivy gay ) + local cath=(fred bob ed gav hal col ian abe dan jon ) + local col=(hope eve abi dee bea fay ivy gay cath jan ) + local dan=( ivy fay dee gay hope eve jan bea cath abi ) + local dee=(fred jon col abe ian hal gav dan bob ed ) + local ed=( jan dee bea cath fay eve abi ivy hope gay ) + local eve=( jon hal fred dan abe gav col ed ian bob ) + local fay=( bob abe ed ian jon dan fred gav col hal ) + local fred=( bea abi dee gay eve ivy cath jan hope fay ) + local gav=( gay eve ivy bea cath abi dee hope jan fay ) + local gay=( jon gav hal fred bob abe col ed dan ian ) + local hal=( abi eve hope fay ivy cath jan bea gay dee ) + local hope=( gav jon bob abe ian dan hal ed col fred) + local ian=(hope cath dee gay bea abi fay ivy jan eve ) + local ivy=( ian col hal gav fred bob abe ed jon dan ) + local jan=( ed hal gav abe bob jon col ian fred dan ) + local jon=( abi fay jan gay eve bea dee cath ivy hope) + + # A place to store the engagements: + local -A engagements=() + + # Our list of free males, initially comprised of all of them: + local freemales=( "${males[@]}" ) + + # Now we use the Gale-Shapley algorithm to find a stable set of engagements + + # Loop over the free males. Note that we can't use for..in because the body + # of the loop may modify the array we're looping over + local -i m=0 + while (( m < ${#freemales[@]} )); do + local male=${freemales[m]} + let m+=1 + + # This guy's preferences + eval 'local his=("${'"$male"'[@]}")' + + # Starting with his favorite + local -i f=0 + local female=${his[f]} + + # Find her preferences + eval 'local hers=("${'"$female"'[@]}")' + + # And her current fiancé, if any + local fiance=${engagements[$female]} + + # If she has a fiancé and prefers him to this guy, look for this guy's next + # best choice + while [[ -n $fiance ]] && + (( $(index "$male" "${hers[@]}") > $(index "$fiance" "${hers[@]}") )); do + let f+=1 + female=${his[f]} + eval 'hers=("${'"$female"'[@]}")' + fiance=${engagements[$female]} + done + + # If we're still on someone who's engaged, it means she prefers this guy + # to her current fiancé. Dump him and put him at the end of the free list. + if [[ -n $fiance ]]; then + freemales+=("$fiance") + printf '%-4s rejected %-4s\n' "$female" "$fiance" + fi + + # We found a match! Record it + engagements[$female]=$male + printf '%-4s accepted %-4s\n' "$female" "$male" + done + + # Display the final result, which should be stable + print_couples engagements + + # Verify its stability + print_stable engagements "${females[@]}" + + # Try a swap + printf '\nWhat if cath and ivy swap partners?\n' + local temp=${engagements[cath]} + engagements[cath]=${engagements[ivy]} + engagements[ivy]=$temp + + # Display the new result, which should be unstable + print_couples engagements + + # Verify its instability + print_stable engagements "${females[@]}" +} + +# utility function - get index of an item in an array +index() { + local needle=$1 + shift + local haystack=("$@") + local -i i + for i in "${!haystack[@]}"; do + if [[ ${haystack[i]} == $needle ]]; then + printf '%d\n' "$i" + return 0 + fi + done + return 1 +} + +# print the couples from the engagement array; takes name of array as argument +print_couples() { + printf '\nCouples:\n' + local keys + mapfile -t keys < <(eval 'printf '\''%s\n'\'' "${!'"$1"'[@]}"' | sort) + local female + for female in "${keys[@]}"; do + eval 'local male=${'"$1"'["'"$female"'"]}' + printf '%-4s is engaged to %-4s\n' "$female" "$male" + done + printf '\n' +} + +# print whether a set of engagements is stable; takes name of engagement array +# followed by the list of females +print_stable() { + if stable "$@"; then + printf 'These couples are stable.\n' + else + printf 'These couples are not stable.\n' + fi +} + +# determine if a set of engagements is stable; takes name of engagement array +# followed by the list of females +stable() { + local dict=$1 + shift + eval 'local shes=("${!'"$dict"'[@]}")' + eval 'local hes=("${'"$dict"'[@]}")' + local -i i + local -i result=0 + for (( i=0; i<${#shes[@]}; ++i )); do + local she=${shes[i]} he=${hes[i]} + eval 'local his=("${'"$he"'[@]}")' + local alt + for alt in "$@"; do + eval 'local fiance=${'"$dict"'["'"$alt"'"]}' + eval 'local hers=("${'"$alt"'[@]}")' + if (( $(index "$she" "${his[@]}") > $(index "$alt" "${his[@]}") + && $(index "$fiance" "${hers[@]}") > $(index "$he" "${hers[@]}") )) + then + printf '%-4s is engaged to %-4s but prefers %4s, ' "$he" "$she" "$alt" + printf 'while %-4s is engaged to %-4s but prefers %4s.\n' "$alt" "$fiance" "$he" + result=1 + fi + done + done + if (( result )); then printf '\n'; fi + return $result +} + +main "$@" diff --git a/Task/Stable-marriage-problem/VBA/stable-marriage-problem-1.vba b/Task/Stable-marriage-problem/VBA/stable-marriage-problem-1.vba new file mode 100644 index 0000000000..e82c2be906 --- /dev/null +++ b/Task/Stable-marriage-problem/VBA/stable-marriage-problem-1.vba @@ -0,0 +1,44 @@ +Sub M_snb() + c00 = "_abe abi eve cath ivy jan dee fay bea hope gay " & _ + "_bob cath hope abi dee eve fay bea jan ivy gay " & _ + "_col hope eve abi dee bea fay ivy gay cath jan " & _ + "_dan ivy fay dee gay hope eve jan bea cath abi " & _ + "_ed jan dee bea cath fay eve abi ivy hope gay " & _ + "_fred bea abi dee gay eve ivy cath jan hope fay " & _ + "_gav gay eve ivy bea cath abi dee hope jan fay " & _ + "_hal abi eve hope fay ivy cath jan bea gay dee " & _ + "_ian hope cath dee gay bea abi fay ivy jan eve " & _ + "_jon abi fay jan gay eve bea dee cath ivy hope " & _ + "_abi bob fred jon gav ian abe dan ed col hal " & _ + "_bea bob abe col fred gav dan ian ed jon hal " & _ + "_cath fred bob ed gav hal col ian abe dan jon " & _ + "_dee fred jon col abe ian hal gav dan bob ed " & _ + "_eve jon hal fred dan abe gav col ed ian bob " & _ + "_fay bob abe ed ian jon dan fred gav col hal " & _ + "_gay jon gav hal fred bob abe col ed dan ian " & _ + "_hope gav jon bob abe ian dan hal ed col fred " & _ + "_ivy ian col hal gav fred bob abe ed jon dan " & _ + "_jan ed hal gav abe bob jon col ian fred dan " + + sn = Filter(Filter(Split(c00), "_"), "-", 0) + Do + c01 = Mid(c00, InStr(c00, sn(0) & " ")) + st = Split(Left(c01, InStr(Mid(c01, 2), "_"))) + For j = 1 To UBound(st) - 1 + If InStr(c00, "_" & st(j) & " ") > 0 Then + c00 = Replace(Replace(c00, sn(0), sn(0) & "-" & st(j)), "_" & st(j), "_" & st(j) & "." & Mid(sn(0), 2)) + Exit For + Else + c02 = Filter(Split(c00, "_"), st(j) & ".")(0) + c03 = Split(Split(c02)(0), ".")(1) + If InStr(c02, " " & Mid(sn(0), 2) & " ") < InStr(c02, " " & c03 & " ") Then + c00 = Replace(Replace(Replace(c00, c03 & "-" & st(j), c03), sn(0), sn(0) & "-" & st(j)), "_" & st(j), "_" & st(j) & "." & Mid(sn(0), 2)) + Exit For + End If + End If + Next + sn = Filter(Filter(Filter(Split(c00), "_"), "-", 0), ".", 0) + Loop Until UBound(sn) = -1 + + MsgBox Replace(Join(Filter(Split(c00), "-"), vbLf), "_", "") +End Sub diff --git a/Task/Stable-marriage-problem/VBA/stable-marriage-problem-2.vba b/Task/Stable-marriage-problem/VBA/stable-marriage-problem-2.vba new file mode 100644 index 0000000000..0d69724d86 --- /dev/null +++ b/Task/Stable-marriage-problem/VBA/stable-marriage-problem-2.vba @@ -0,0 +1,56 @@ +Sub M_snb() + Set d_00 = CreateObject("scripting.dictionary") + Set d_01 = CreateObject("scripting.dictionary") + Set d_02 = CreateObject("scripting.dictionary") + + sn = Split("abe abi eve cath ivy jan dee fay bea hope gay _" & _ + "bob cath hope abi dee eve fay bea jan ivy gay _" & _ + "col hope eve abi dee bea fay ivy gay cath jan _" & _ + "dan ivy fay dee gay hope eve jan bea cath abi _" & _ + "ed jan dee bea cath fay eve abi ivy hope gay _" & _ + "fred bea abi dee gay eve ivy cath jan hope fay _" & _ + "gav gay eve ivy bea cath abi dee hope jan fay _" & _ + "hal abi eve hope fay ivy cath jan bea gay dee _" & _ + "ian hope cath dee gay bea abi fay ivy jan eve _" & _ + "jon abi fay jan gay eve bea dee cath ivy hope ", "_") + + sp = Split("abi bob fred jon gav ian abe dan ed col hal _" & _ + "bea bob abe col fred gav dan ian ed jon hal _" & _ + "cath fred bob ed gav hal col ian abe dan jon _" & _ + "dee fred jon col abe ian hal gav dan bob ed _" & _ + "eve jon hal fred dan abe gav col ed ian bob _" & _ + "fay bob abe ed ian jon dan fred gav col hal _" & _ + "gay jon gav hal fred bob abe col ed dan ian _" & _ + "hope gav jon bob abe ian dan hal ed col fred _" & _ + "ivy ian col hal gav fred bob abe ed jon dan _" & _ + "jan ed hal gav abe bob jon col ian fred dan ", "_") + + For j = 0 To UBound(sn) + d_00(Split(sn(j))(0)) = "" + d_01(Split(sp(j))(0)) = "" + d_02(Split(sn(j))(0)) = sn(j) + d_02(Split(sp(j))(0)) = sp(j) + Next + + Do + For Each it In d_00.keys + If d_00.Item(it) = "" Then + st = Split(d_02.Item(it)) + For jj = 1 To UBound(st) + If d_01(st(jj)) = "" Then + d_00(st(0)) = st(0) & vbTab & st(jj) + d_01(st(jj)) = st(0) + Exit For + ElseIf InStr(d_02.Item(st(jj)), " " & st(0) & " ") < InStr(d_02.Item(st(jj)), " " & d_01(st(jj)) & " ") Then + d_00(d_01(st(jj))) = "" + d_00(st(0)) = st(0) & vbTab & st(jj) + d_01(st(jj)) = st(0) + Exit For + End If + Next + End If + Next + Loop Until UBound(Filter(d_00.items, vbTab)) = d_00.Count - 1 + + MsgBox Join(d_00.items, vbLf) +End Sub diff --git a/Task/Stack-traces/00DESCRIPTION b/Task/Stack-traces/00DESCRIPTION index b32491d6e0..78c3b07053 100644 --- a/Task/Stack-traces/00DESCRIPTION +++ b/Task/Stack-traces/00DESCRIPTION @@ -1,6 +1,14 @@ Many programming languages allow for introspection of the current call stack environment. This can be for a variety of purposes such as enforcing security checks, debugging, or for getting access to the stack frame of callers. -This task calls for you to print out (in a manner considered suitable for the platform) the current call stack. The amount of information printed for each frame on the call stack is not constrained, but should include at least the name of the function or method at that level of the stack frame. You may explicitly add a call to produce the stack trace to the (example) code being instrumented for examination. -The task should allow the program to continue after generating the stack trace. The task report here must include the trace from a sample program. -
    +;Task: +Print out (in a manner considered suitable for the platform) the current call stack. + +The amount of information printed for each frame on the call stack is not constrained, but should include at least the name of the function or method at that level of the stack frame. + +You may explicitly add a call to produce the stack trace to the (example) code being instrumented for examination. + +The task should allow the program to continue after generating the stack trace. + +The task report here must include the trace from a sample program. +

    diff --git a/Task/Stack-traces/Elixir/stack-traces.elixir b/Task/Stack-traces/Elixir/stack-traces.elixir new file mode 100644 index 0000000000..e0037605da --- /dev/null +++ b/Task/Stack-traces/Elixir/stack-traces.elixir @@ -0,0 +1,25 @@ +defmodule Stack_traces do + def main do + {:ok, a} = outer + IO.inspect a + end + + defp outer do + {:ok, a} = middle + {:ok, a} + end + + defp middle do + {:ok, a} = inner + {:ok, a} + end + + defp inner do + try do + throw(42) + catch 42 -> {:ok, :erlang.get_stacktrace} + end + end +end + +Stack_traces.main diff --git a/Task/Stack/00DESCRIPTION b/Task/Stack/00DESCRIPTION index 3b32ab4375..ba5c887c82 100644 --- a/Task/Stack/00DESCRIPTION +++ b/Task/Stack/00DESCRIPTION @@ -1,23 +1,39 @@ {{data structure}}[[Category:Classic CS problems and programs]] -A '''stack''' is a container of elements with last in, first out access policy. -Sometimes it also called '''LIFO'''. The stack is accessed through its '''top'''. + +A '''stack''' is a container of elements with   last in, first out   access policy.   Sometimes it also called '''LIFO'''. + +The stack is accessed through its '''top'''. + The basic stack operations are: -* ''push'' stores a new element onto the stack top; -* ''pop'' returns the last pushed stack element, while removing it from the stack; -* ''empty'' tests if the stack contains no elements. +*   ''push''   stores a new element onto the stack top; +*   ''pop''   returns the last pushed stack element, while removing it from the stack; +*   ''empty''   tests if the stack contains no elements. +
    Sometimes the last pushed stack element is made accessible for immutable access (for read) or mutable access (for write): -* ''top'' (sometimes called ''peek'' to keep with the ''p'' theme) returns the topmost element without modifying the stack. +*   ''top''   (sometimes called ''peek'' to keep with the ''p'' theme) returns the topmost element without modifying the stack. +
    Stacks allow a very simple hardware implementation. -They are common in almost all processors. In programming stacks are also very popular for their way ('''LIFO''') of resource management, usually memory. + +They are common in almost all processors. + +In programming, stacks are also very popular for their way ('''LIFO''') of resource management, usually memory. + Nested scopes of language objects are naturally implemented by a stack (sometimes by multiple stacks). -This is a classical way to implement local variables of a reentrant or recursive subprogram. Stacks are also used to describe a formal computational framework. + +This is a classical way to implement local variables of a re-entrant or recursive subprogram. Stacks are also used to describe a formal computational framework. + See [[wp:Stack_automaton|stack machine]]. + Many algorithms in pattern matching, compiler construction (e.g. [[wp:Recursive_descent|recursive descent parsers]]), and machine learning (e.g. based on [[wp:Tree_traversal|tree traversal]]) have a natural representation in terms of stacks. + +;Task: Create a stack supporting the basic operations: push, pop, empty. + {{Template:See also lists}} +

    diff --git a/Task/Stack/Elena/stack.elena b/Task/Stack/Elena/stack.elena new file mode 100644 index 0000000000..5cbadda7fe --- /dev/null +++ b/Task/Stack/Elena/stack.elena @@ -0,0 +1,9 @@ + #var stack := system'collections'Stack new. + + stack push:2. + + #var isEmpty := stack length == 0. + + #var item := stack peek. // Peek without Popping. + + item := stack pop. diff --git a/Task/Stack/K/stack.k b/Task/Stack/K/stack.k new file mode 100644 index 0000000000..c3cfc668e5 --- /dev/null +++ b/Task/Stack/K/stack.k @@ -0,0 +1,25 @@ +stack:() +push:{stack::x,stack} +pop:{r:*stack;stack::1_ stack;r} +empty:{0=#stack} + +/example: +stack:() + push 3 + stack +,3 + push 5 + stack +5 3 + pop[] +5 + stack +,3 + empty[] +0 + pop[] +3 + stack +!0 + empty[] +1 diff --git a/Task/Stack/Oberon-2/stack-1.oberon-2 b/Task/Stack/Oberon-2/stack-1.oberon-2 new file mode 100644 index 0000000000..16b6f3d830 --- /dev/null +++ b/Task/Stack/Oberon-2/stack-1.oberon-2 @@ -0,0 +1,66 @@ +MODULE Stacks; +IMPORT + Object, + Object:Boxed, + Out := NPCT:Console; + +TYPE + Pool(E: Object.Object) = POINTER TO ARRAY OF E; + Stack*(E: Object.Object) = POINTER TO StackDesc(E); + StackDesc*(E: Object.Object) = RECORD + pool: Pool(E); + cap-,top: LONGINT; + END; + + PROCEDURE (s: Stack(E)) INIT*(cap: LONGINT); + BEGIN + NEW(s.pool,cap);s.cap := cap;s.top := -1 + END INIT; + + PROCEDURE (s: Stack(E)) Top*(): E; + BEGIN + RETURN s.pool[s.top] + END Top; + + PROCEDURE (s: Stack(E)) Push*(e: E); + BEGIN + INC(s.top); + ASSERT(s.top < s.cap); + s.pool[s.top] := e; + END Push; + + PROCEDURE (s: Stack(E)) Pop*(): E; + VAR + resp: E; + BEGIN + ASSERT(s.top >= 0); + resp := s.pool[s.top];DEC(s.top); + RETURN resp + END Pop; + + PROCEDURE (s: Stack(E)) IsEmpty(): BOOLEAN; + BEGIN + RETURN s.top < 0 + END IsEmpty; + + PROCEDURE (s: Stack(E)) Size*(): LONGINT; + BEGIN + RETURN s.top + 1 + END Size; + + PROCEDURE Test; + VAR + s: Stack(Boxed.LongInt); + BEGIN + s := NEW(Stack(Boxed.LongInt),100); + s.Push(NEW(Boxed.LongInt,10)); + s.Push(NEW(Boxed.LongInt,100)); + Out.String("size: ");Out.Int(s.Size(),0);Out.Ln; + Out.String("pop: ");Out.Object(s.Pop());Out.Ln; + Out.String("top: ");Out.Object(s.Top());Out.Ln; + Out.String("size: ");Out.Int(s.Size(),0);Out.Ln + END Test; + +BEGIN + Test +END Stacks. diff --git a/Task/Stack/Oberon-2/stack-2.oberon-2 b/Task/Stack/Oberon-2/stack-2.oberon-2 new file mode 100644 index 0000000000..417cf6c506 --- /dev/null +++ b/Task/Stack/Oberon-2/stack-2.oberon-2 @@ -0,0 +1,83 @@ +MODULE Stacks; (** AUTHOR ""; PURPOSE ""; *) + +IMPORT + Out := KernelLog; + +TYPE + Object = OBJECT + END Object; + + Stack* = OBJECT + VAR + top-,capacity-: LONGINT; + pool: POINTER TO ARRAY OF Object; + + PROCEDURE & InitStack*(capacity: LONGINT); + BEGIN + SELF.capacity := capacity; + SELF.top := -1; + NEW(SELF.pool,capacity) + END InitStack; + + PROCEDURE Push*(a:Object); + BEGIN + INC(SELF.top); + ASSERT(SELF.top < SELF.capacity,100); + SELF.pool[SELF.top] := a + END Push; + + PROCEDURE Pop*(): Object; + VAR + r: Object; + BEGIN + ASSERT(SELF.top >= 0); + r := SELF.pool[SELF.top]; + DEC(SELF.top);RETURN r + END Pop; + + PROCEDURE Top*(): Object; + BEGIN + ASSERT(SELF.top >= 0); + RETURN SELF.pool[SELF.top] + END Top; + + PROCEDURE IsEmpty*(): BOOLEAN; + BEGIN + RETURN SELF.top < 0 + END IsEmpty; + + END Stack; + + BoxedInt = OBJECT + (Object) + VAR + val-: LONGINT; + + PROCEDURE & InitBoxedInt*(CONST val: LONGINT); + BEGIN + SELF.val := val + END InitBoxedInt; + + END BoxedInt; + + PROCEDURE Test*; + VAR + s: Stack; + bi: BoxedInt; + obj: Object; + BEGIN + NEW(s,10); (* A new stack of ten objects *) + NEW(bi,100);s.Push(bi); + NEW(bi,102);s.Push(bi); + NEW(bi,104);s.Push(bi); + Out.Ln; + Out.String("Capacity:> ");Out.Int(s.capacity,0);Out.Ln; + Out.String("Size:> ");Out.Int(s.top + 1,0);Out.Ln; + obj := s.Pop(); obj := s.Pop(); + WITH obj: BoxedInt DO + Out.String("obj:> ");Out.Int(obj.val,0);Out.Ln + ELSE + Out.String("Unknown object...");Out.Ln; + END (* with *) + END Test; +END Stacks. diff --git a/Task/Stack/PowerShell/stack-1.psh b/Task/Stack/PowerShell/stack-1.psh new file mode 100644 index 0000000000..f83362b615 --- /dev/null +++ b/Task/Stack/PowerShell/stack-1.psh @@ -0,0 +1,3 @@ +$stack = New-Object -TypeName System.Collections.Stack +# or +$stack = [System.Collections.Stack] @() diff --git a/Task/Stack/PowerShell/stack-2.psh b/Task/Stack/PowerShell/stack-2.psh new file mode 100644 index 0000000000..dbbecf2bf8 --- /dev/null +++ b/Task/Stack/PowerShell/stack-2.psh @@ -0,0 +1 @@ +1, 2, 3, 4 | ForEach-Object {$stack.Push($_)} diff --git a/Task/Stack/PowerShell/stack-3.psh b/Task/Stack/PowerShell/stack-3.psh new file mode 100644 index 0000000000..961f99291f --- /dev/null +++ b/Task/Stack/PowerShell/stack-3.psh @@ -0,0 +1 @@ +$stack -join ", " diff --git a/Task/Stack/PowerShell/stack-4.psh b/Task/Stack/PowerShell/stack-4.psh new file mode 100644 index 0000000000..ae007a839e --- /dev/null +++ b/Task/Stack/PowerShell/stack-4.psh @@ -0,0 +1 @@ +$stack.Pop() diff --git a/Task/Stack/PowerShell/stack-5.psh b/Task/Stack/PowerShell/stack-5.psh new file mode 100644 index 0000000000..961f99291f --- /dev/null +++ b/Task/Stack/PowerShell/stack-5.psh @@ -0,0 +1 @@ +$stack -join ", " diff --git a/Task/Stack/PowerShell/stack-6.psh b/Task/Stack/PowerShell/stack-6.psh new file mode 100644 index 0000000000..2bc6e4e5b1 --- /dev/null +++ b/Task/Stack/PowerShell/stack-6.psh @@ -0,0 +1 @@ +$stack.Peek() diff --git a/Task/Stack/PowerShell/stack-7.psh b/Task/Stack/PowerShell/stack-7.psh new file mode 100644 index 0000000000..a9af01c052 --- /dev/null +++ b/Task/Stack/PowerShell/stack-7.psh @@ -0,0 +1 @@ +$stack diff --git a/Task/Stack/Rust/stack-1.rust b/Task/Stack/Rust/stack-1.rust new file mode 100644 index 0000000000..6a65ae0a11 --- /dev/null +++ b/Task/Stack/Rust/stack-1.rust @@ -0,0 +1,12 @@ +fn main() { + let mut stack = Vec::new(); + stack.push("Element1"); + stack.push("Element2"); + stack.push("Element3"); + + assert_eq!(Some(&"Element3"), stack.last()); + assert_eq!(Some("Element3"), stack.pop()); + assert_eq!(Some("Element2"), stack.pop()); + assert_eq!(Some("Element1"), stack.pop()); + assert_eq!(None, stack.pop()); +} diff --git a/Task/Stack/Rust/stack-2.rust b/Task/Stack/Rust/stack-2.rust new file mode 100644 index 0000000000..1aa93c62dc --- /dev/null +++ b/Task/Stack/Rust/stack-2.rust @@ -0,0 +1,109 @@ +type Link = Option>>; + +pub struct Stack { + head: Link, +} +struct Frame { + elem: T, + next: Link, +} + +/// Iterate by value (consumes list) +pub struct IntoIter(Stack); +impl Iterator for IntoIter { + type Item = T; + fn next(&mut self) -> Option { + self.0.pop() + } +} + +/// Iterate by immutable reference +pub struct Iter<'a, T: 'a> { + next: Option<&'a Frame>, +} +impl<'a, T> Iterator for Iter<'a, T> { // Iterate by immutable reference + type Item = &'a T; + fn next(&mut self) -> Option { + self.next.take().map(|frame| { + self.next = frame.next.as_ref().map(|frame| &**frame); + &frame.elem + }) + } +} + +/// Iterate by mutable reference +pub struct IterMut<'a, T: 'a> { + next: Option<&'a mut Frame>, +} +impl<'a, T> Iterator for IterMut<'a, T> { + type Item = &'a mut T; + fn next(&mut self) -> Option { + self.next.take().map(|frame| { + self.next = frame.next.as_mut().map(|frame| &mut **frame); + &mut frame.elem + }) + } +} + + +impl Stack { + /// Return new, empty stack + pub fn new() -> Self { + Stack { head: None } + } + + /// Add element to top of the stack + pub fn push(&mut self, elem: T) { + let new_frame = Box::new(Frame { + elem: elem, + next: self.head.take(), + }); + self.head = Some(new_frame); + } + + /// Remove element from top of stack, returning the value + pub fn pop(&mut self) -> Option { + self.head.take().map(|frame| { + let frame = *frame; + self.head = frame.next; + frame.elem + }) + } + + /// Get immutable reference to top element of the stack + pub fn peek(&self) -> Option<&T> { + self.head.as_ref().map(|frame| &frame.elem) + } + + /// Get mutable reference to top element on the stack + pub fn peek_mut(&mut self) -> Option<&mut T> { + self.head.as_mut().map(|frame| &mut frame.elem) + } + + /// Iterate over stack elements by value + pub fn into_iter(self) -> IntoIter { + IntoIter(self) + } + + /// Iterate over stack elements by immutable reference + pub fn iter<'a>(&'a self) -> Iter<'a,T> { + Iter { next: self.head.as_ref().map(|frame| &**frame) } + } + + /// Iterate over stack elements by mutable reference + pub fn iter_mut(&mut self) -> IterMut { + IterMut { next: self.head.as_mut().map(|frame| &mut **frame) } + } +} + +// The Drop trait tells the compiler how to free an object after it goes out of scope. +// By default, the compiler would do this recursively which *could* blow the stack for +// extraordinarily long lists. This simply tells it to do it iteratively. +impl Drop for Stack { + fn drop(&mut self) { + let mut cur_link = self.head.take(); + while let Some(mut boxed_frame) = cur_link { + cur_link = boxed_frame.next.take(); + } + } +} diff --git a/Task/Stack/Standard-ML/stack-1.ml b/Task/Stack/Standard-ML/stack-1.ml new file mode 100644 index 0000000000..d0852e78a7 --- /dev/null +++ b/Task/Stack/Standard-ML/stack-1.ml @@ -0,0 +1,16 @@ +signature STACK = +sig + type 'a stack + exception EmptyStack + + val empty : 'a stack + val isEmpty : 'a stack -> bool + + val push : ('a * 'a stack) -> 'a stack + val pop : 'a stack -> 'a stack + val top : 'a stack -> 'a + val popTop : 'a stack -> 'a stack * 'a + + val map : ('a -> 'b) -> 'a stack -> 'b stack + val app : ('a -> unit) -> 'a stack -> unit +end diff --git a/Task/Stack/Standard-ML/stack-2.ml b/Task/Stack/Standard-ML/stack-2.ml new file mode 100644 index 0000000000..bce2090c6f --- /dev/null +++ b/Task/Stack/Standard-ML/stack-2.ml @@ -0,0 +1,22 @@ +structure Stack :> STACK = +struct + type 'a stack = 'a list + exception EmptyStack + + val empty = [] + + fun isEmpty st = null st + + fun push (x, st) = x::st + + fun pop [] = raise EmptyStack + | pop (x::st) = st + + fun top [] = raise EmptyStack + | top (x::st) = x + + fun popTop st = (pop st, top st) + + fun map f st = List.map f st + fun app f st = List.app f st +end diff --git a/Task/Stair-climbing-puzzle/00DESCRIPTION b/Task/Stair-climbing-puzzle/00DESCRIPTION index 2531df1021..5506ab2110 100644 --- a/Task/Stair-climbing-puzzle/00DESCRIPTION +++ b/Task/Stair-climbing-puzzle/00DESCRIPTION @@ -1,8 +1,10 @@ From [http://lambda-the-ultimate.org/node/1872 Chung-Chieh Shan] (LtU): -Your stair-climbing robot has a very simple low-level API: the "step" function takes no argument and attempts to climb one step as a side effect. Unfortunately, sometimes the attempt fails and the robot clumsily falls one step instead. The "step" function detects what happens and returns a boolean flag: true on success, false on failure. Write a function "step_up" that climbs one step up [from the initial position] (by repeating "step" attempts if necessary). Assume that the robot is not already at the top of the stairs, and neither does it ever reach the bottom of the stairs. How small can you make "step_up"? Can you avoid using variables (even immutable ones) and numbers? +Your stair-climbing robot has a very simple low-level API: the "step" function takes no argument and attempts to climb one step as a side effect. Unfortunately, sometimes the attempt fails and the robot clumsily falls one step instead. The "step" function detects what happens and returns a boolean flag: true on success, false on failure. -Here's a pseudocode of a simple recursive solution without using variables: +Write a function "step_up" that climbs one step up [from the initial position] (by repeating "step" attempts if necessary). Assume that the robot is not already at the top of the stairs, and neither does it ever reach the bottom of the stairs. How small can you make "step_up"? Can you avoid using variables (even immutable ones) and numbers? + +Here's a pseudo-code of a simple recursive solution without using variables:
     func step_up()
     {
    @@ -16,6 +18,7 @@ Inductive proof that step_up() steps up one step, if it terminates:
     * Base case (if the step() call returns true): it stepped up one step. QED
     * Inductive case (if the step() call returns false): Assume that recursive calls to step_up() step up one step. It stepped down one step (because step() returned false), but now we step up two steps using two step_up() calls. QED
     
    +
    The second (tail) recursion above can be turned into an iteration, as follows:
     func step_up()
    diff --git a/Task/Stair-climbing-puzzle/Elixir/stair-climbing-puzzle.elixir b/Task/Stair-climbing-puzzle/Elixir/stair-climbing-puzzle.elixir
    new file mode 100644
    index 0000000000..42e5f15c5a
    --- /dev/null
    +++ b/Task/Stair-climbing-puzzle/Elixir/stair-climbing-puzzle.elixir
    @@ -0,0 +1,13 @@
    +defmodule Stair_climbing do
    +  defp step, do: 1 == :rand.uniform(2)
    +
    +  defp step_up(true), do: :ok
    +  defp step_up(false) do
    +    step_up(step)
    +    step_up(step)
    +  end
    +
    +  def step_up, do: step_up(step)
    +end
    +
    +IO.inspect Stair_climbing.step_up
    diff --git a/Task/Stair-climbing-puzzle/PowerShell/stair-climbing-puzzle.psh b/Task/Stair-climbing-puzzle/PowerShell/stair-climbing-puzzle.psh
    new file mode 100644
    index 0000000000..f41bd6a8d3
    --- /dev/null
    +++ b/Task/Stair-climbing-puzzle/PowerShell/stair-climbing-puzzle.psh
    @@ -0,0 +1,28 @@
    +function StepUp
    +    {
    +    If ( -not ( Step ) )
    +        {
    +        StepUp
    +        StepUp
    +        }
    +    }
    +
    +#  Step simulator for testing
    +function Step
    +    {
    +    If ( Get-Random 0,1 )
    +        {
    +        $Success = $True
    +        Write-Verbose "Up one step"
    +        }
    +    Else
    +        {
    +        $Success = $False
    +        Write-Verbose "Fell one step"
    +        }
    +    return $Success
    +    }
    +
    +#  Test
    +$VerbosePreference = 'Continue'
    +StepUp
    diff --git a/Task/Stair-climbing-puzzle/REXX/stair-climbing-puzzle.rexx b/Task/Stair-climbing-puzzle/REXX/stair-climbing-puzzle.rexx
    index f7fa7345d7..a23ccc8e4a 100644
    --- a/Task/Stair-climbing-puzzle/REXX/stair-climbing-puzzle.rexx
    +++ b/Task/Stair-climbing-puzzle/REXX/stair-climbing-puzzle.rexx
    @@ -1,2 +1,3 @@
    -step_up:  do  while \step();  call step_up;  end
    -return
    +step_up:           do  while \step();   call step_up
    +                   end
    +          return
    diff --git a/Task/Start-from-a-main-routine/00DESCRIPTION b/Task/Start-from-a-main-routine/00DESCRIPTION
    index c2558af192..5f829d9170 100644
    --- a/Task/Start-from-a-main-routine/00DESCRIPTION
    +++ b/Task/Start-from-a-main-routine/00DESCRIPTION
    @@ -1,6 +1,10 @@
     {{omit from|BBC BASIC}}
    -Some languages (like Gambas and Visual Basic) support two startup modes. Applications written in these languages start with an open window that waits for events, and it is necessary to do some trickery to cause a main procedure to run instead. Data driven or event driven languages may also require similar trickery to force a startup procedure to run.
     
    -The task is to demonstrate the steps involved in causing the application to run a main procedure, rather than an event driven window at startup.
    +Some languages (like Gambas and Visual Basic) support two startup modes.   Applications written in these languages start with an open window that waits for events, and it is necessary to do some trickery to cause a main procedure to run instead.   Data driven or event driven languages may also require similar trickery to force a startup procedure to run.
    +
    +
    +;Task:
    +Demonstrate the steps involved in causing the application to run a main procedure, rather than an event driven window at startup.
     
     Languages that always run from main() can be omitted from this task.
    +

    diff --git a/Task/State-name-puzzle/C++/state-name-puzzle.cpp b/Task/State-name-puzzle/C++/state-name-puzzle.cpp index d56266119c..694c42d290 100644 --- a/Task/State-name-puzzle/C++/state-name-puzzle.cpp +++ b/Task/State-name-puzzle/C++/state-name-puzzle.cpp @@ -1,105 +1,99 @@ -#include -#include -#include -#include #include #include -using namespace std; +#include +#include +#include -// some common code -template C_ Unique(const C_& src, const LT_& less) +template +T unique(T&& src) { - C_ retval(src); - std::sort(retval.begin(), retval.end(), less); - retval.erase(unique(retval.begin(), retval.end()), retval.end()); - return retval; -} -template C_ Unique(const C_& src) -{ - return Unique(src, std::less()); + T retval(std::move(src)); + std::sort(retval.begin(), retval.end(), std::less()); + retval.erase(std::unique(retval.begin(), retval.end()), retval.end()); + return retval; } #define USE_FAKES 1 -vector states = Unique(vector({ +auto states = unique(std::vector({ #if USE_FAKES - "Slender Dragon", "Abalamara", + "Slender Dragon", "Abalamara", #endif - "Alabama", "Alaska", "Arizona", "Arkansas", - "California", "Colorado", "Connecticut", - "Delaware", - "Florida", "Georgia", "Hawaii", - "Idaho", "Illinois", "Indiana", "Iowa", - "Kansas", "Kentucky", "Louisiana", - "Maine", "Maryland", "Massachusetts", "Michigan", - "Minnesota", "Mississippi", "Missouri", "Montana", - "Nebraska", "Nevada", "New Hampshire", "New Jersey", - "New Mexico", "New York", "North Carolina", "North Dakota", - "Ohio", "Oklahoma", "Oregon", - "Pennsylvania", "Rhode Island", - "South Carolina", "South Dakota", "Tennessee", "Texas", - "Utah", "Vermont", "Virginia", - "Washington", "West Virginia", "Wisconsin", "Wyoming" + "Alabama", "Alaska", "Arizona", "Arkansas", + "California", "Colorado", "Connecticut", + "Delaware", + "Florida", "Georgia", "Hawaii", + "Idaho", "Illinois", "Indiana", "Iowa", + "Kansas", "Kentucky", "Louisiana", + "Maine", "Maryland", "Massachusetts", "Michigan", + "Minnesota", "Mississippi", "Missouri", "Montana", + "Nebraska", "Nevada", "New Hampshire", "New Jersey", + "New Mexico", "New York", "North Carolina", "North Dakota", + "Ohio", "Oklahoma", "Oregon", + "Pennsylvania", "Rhode Island", + "South Carolina", "South Dakota", "Tennessee", "Texas", + "Utah", "Vermont", "Virginia", + "Washington", "West Virginia", "Wisconsin", "Wyoming" })); -struct CountedPair_ +struct counted_pair { - string name_; - vector count_; + std::string name; + std::array count{}; - void Add(const string& s) - { - for (auto c : s) - { - if (c >= 'a' && c <= 'z') ++count_[c - 'a']; - if (c >= 'A' && c <= 'Z') ++count_[c - 'A']; - } - } + void count_characters(const std::string& s) + { + for (auto&& c : s) { + if (c >= 'a' && c <= 'z') count[c - 'a']++; + if (c >= 'A' && c <= 'Z') count[c - 'A']++; + } + } - CountedPair_(const string& s1, const string& s2) : name_(s1 + " + " + s2), count_(26, 0u) - { - Add(s1); Add(s2); - } + counted_pair(const std::string& s1, const std::string& s2) + : name(s1 + " + " + s2) + { + count_characters(s1); + count_characters(s2); + } }; -bool operator<(const CountedPair_& lhs, const CountedPair_& rhs) +bool operator<(const counted_pair& lhs, const counted_pair& rhs) { - const int s1 = lhs.name_.size(), s2 = rhs.name_.size(); - return s1 == s2 - ? lexicographical_compare(lhs.count_.begin(), lhs.count_.end(), rhs.count_.begin(), rhs.count_.end()) - : s1 < s2; + auto lhs_size = lhs.name.size(); + auto rhs_size = rhs.name.size(); + return lhs_size == rhs_size + ? std::lexicographical_compare(lhs.count.begin(), + lhs.count.end(), + rhs.count.begin(), + rhs.count.end()) + : lhs_size < rhs_size; } -bool operator==(const CountedPair_& lhs, const CountedPair_& rhs) +bool operator==(const counted_pair& lhs, const counted_pair& rhs) { - return lhs.name_.size() == rhs.name_.size() - && lhs.count_ == rhs.count_; + return lhs.name.size() == rhs.name.size() && lhs.count == rhs.count; } -void FindPairs() +int main() { - const int n_states = states.size(); + const int n_states = states.size(); - vector pairs; - for (int i = 0; i < n_states; i++) - for (int j = 0; j < i; j++) - pairs.emplace_back(states[i], states[j]); - sort(pairs.begin(), pairs.end()); + std::vector pairs; + for (int i = 0; i < n_states; i++) { + for (int j = 0; j < i; j++) { + pairs.emplace_back(counted_pair(states[i], states[j])); + } + } + std::sort(pairs.begin(), pairs.end()); - auto start = pairs.begin(); - for (;;) - { - auto match = adjacent_find(start, pairs.end()); - if (match == pairs.end()) - break; - auto next = match + 1; - cout << match->name_ << " => " << next->name_ << "\n"; - start = next; - } -} - -int main(void) -{ - FindPairs(); - return 0; + auto start = pairs.begin(); + while (true) { + auto match = std::adjacent_find(start, pairs.end()); + if (match == pairs.end()) { + break; + } + auto next = match + 1; + std::cout << match->name << " => " << next->name << "\n"; + start = next; + } } diff --git a/Task/State-name-puzzle/Java/state-name-puzzle.java b/Task/State-name-puzzle/Java/state-name-puzzle.java index bac068d2b7..e4f06cba56 100644 --- a/Task/State-name-puzzle/Java/state-name-puzzle.java +++ b/Task/State-name-puzzle/Java/state-name-puzzle.java @@ -34,9 +34,7 @@ public class StateNamePuzzle { String s = pair0 + pair[1]; String key = Arrays.toString(s.chars().sorted().toArray()); - List val; - if ((val = map.get(key)) == null) - val = new ArrayList<>(); + List val = map.getOrDefault(key, new ArrayList<>()); val.add(pair); map.put(key, val); } diff --git a/Task/State-name-puzzle/Perl-6/state-name-puzzle.pl6 b/Task/State-name-puzzle/Perl-6/state-name-puzzle.pl6 index 85a9fed9f6..5b4dedfc8b 100644 --- a/Task/State-name-puzzle/Perl-6/state-name-puzzle.pl6 +++ b/Task/State-name-puzzle/Perl-6/state-name-puzzle.pl6 @@ -23,13 +23,13 @@ sub anastates (*@states) { } } - my $equivs = hash @pairs.classify: *.lc.comb.sort.join.trim; + my $equivs = hash @pairs.classify: *.lc.comb.sort.join; gather for $equivs.values -> @c { for ^@c -> $i { for $i ^..^ @c -> $j { my $set = set @c[$i].list, @c[$j].list; - take $set.join(', ') if $set == 4; + take $set.keys.join(', ') if $set == 4; } } } diff --git a/Task/State-name-puzzle/REXX/state-name-puzzle.rexx b/Task/State-name-puzzle/REXX/state-name-puzzle.rexx index e05cedc049..7014d287f7 100644 --- a/Task/State-name-puzzle/REXX/state-name-puzzle.rexx +++ b/Task/State-name-puzzle/REXX/state-name-puzzle.rexx @@ -1,88 +1,86 @@ -/*REXX pgm (state name puzzle) rearranges two state's names ──► two new states*/ +/*REXX program (state name puzzle) rearranges two state's names ──► two new states. */ !='Alabama, Alaska, Arizona, Arkansas, California, Colorado, Connecticut, Delaware, Florida, Georgia,', 'Hawaii, Idaho, Illinois, Indiana, Iowa, Kansas, Kentucky, Louisiana, Maine, Maryland, Massachusetts, ', 'Michigan, Minnesota, Mississippi, Missouri, Montana, Nebraska, Nevada, New Hampshire, New Jersey, New Mexico,', 'New York, North Carolina, North Dakota, Ohio, Oklahoma, Oregon, Pennsylvania, Rhode Island, South Carolina,', 'South Dakota, Tennessee, Texas, Utah, Vermont, Virginia, Washington, West Virginia, Wisconsin, Wyoming' -parse arg xtra; !=! ',' xtra /*add optional (fictitious) names.*/ -@abcU='ABCDEFGHIJKLMNOPQRSTUVWXYZ'; !=space(!) /*ABCs; the state list.*/ -deads=0; dups=0; L.=0; !orig=!; z=0; @@.= /*initialize some vars. */ +parse arg xtra; !=! ',' xtra /*add optional (fictitious) names.*/ +@abcU='ABCDEFGHIJKLMNOPQRSTUVWXYZ'; !=space(!) /*!: the state list, no extra blanks*/ +deads=0; dups=0; L.=0; !orig=!; z=0; @@.= /*initialize some REXX variables. */ - do de=0 for 2; !=!orig; @.= /*use original state list for each. */ + do de=0 for 2; !=!orig; @.= /*use original state list for each. */ - do states=0 until !=='' /*parse until the cows come home. */ - parse var ! x ',' !; x=space(x) /*remove all blanks from state name.*/ - if @.x\=='' then do /*was state was already specified? */ - if de then iterate /*don't tell error if doing 2nd pass*/ - dups=dups+1 /*bump the duplicate counter. */ + do states=0 until !=='' /*parse until the cows come home. */ + parse var ! x ',' !; x=space(x) /*remove all blanks from state name.*/ + if @.x\=='' then do /*was state was already specified? */ + if de then iterate /*don't tell error if doing 2nd pass*/ + dups=dups+1 /*bump the duplicate counter. */ say 'ignoring the 2nd naming of the state: ' x iterate end - @.x=x /*indicate this state name exists. */ - y=space(x,0); upper y; yLen=length(y) /*get upper name with no spaces; Len*/ + @.x=x /*indicate this state name exists. */ + y=space(x,0); upper y; yLen=length(y) /*get upper name with no spaces; Len*/ - if de then do /*Is the 1st pass? Then process. */ - do j=1 for yLen /*see if it's a dead─end state name.*/ - _=substr(y,j,1) /* _: is some state name character.*/ - if L._\==1 then iterate /*Count ¬1? Then state name is O.K.*/ - say 'removing dead─end state [which has the letter ' _"]: " x - deads=deads+1 /*bump number of dead─ends states. */ - iterate states /*go and process another state name.*/ - end /*j*/ - z=z+1 /*bump counter of the state names. */ - #.z=y; ##.z=x /*assign state name; and original. */ - end - else do k=1 for yLen /*inventorize state name's letters. */ - _=substr(y,k,1); L._=L._+1 /*count each letter in state name. */ - end /*k*/ + if de then do /*Is the firstt pass? Then process.*/ + do j=1 for yLen /*see if it's a dead─end state name.*/ + _=substr(y,j,1) /* _: is some state name character.*/ + if L._\==1 then iterate /*Count ¬ 1? Then state name is OK.*/ + say 'removing dead─end state [which has the letter ' _"]: " x + deads=deads+1 /*bump number of dead─ends states. */ + iterate states /*go and process another state name.*/ + end /*j*/ + z=z+1 /*bump counter of the state names. */ + #.z=y; ##.z=x /*assign state name; and original. */ + end + else do k=1 for yLen /*inventorize state name's letters. */ + _=substr(y,k,1); L._=L._+1 /*count each letter in state name. */ + end /*k*/ end /*states*/ end /*de*/ -say; do i=1 for z /*list state names in order given. */ - say right(i,9) ##.i /*show the index number, state name.*/ +say; do i=1 for z /*list state names in order given. */ + say right(i,9) ##.i /*show the index number, state name.*/ end /*i*/ - say; say z 'state name's(z) "are useable." -if dups \==0 then say dups 'duplicate of a state's(dups) 'ignored.' -if deads\==0 then say deads 'dead─end state's(deads) 'deleted.' + say; say z 'state name's(z) "are useable." +if dups \==0 then say dups 'duplicate of a state's(dups) 'ignored.' +if deads\==0 then say deads 'dead─end state's(deads) 'deleted.' say -sols=0 /*number of solutions found (so far)*/ +sols=0 /*number of solutions found (so far)*/ - do j=1 for z /*◄─────────────────────────────────────────────────────┐ */ - /*look for mix and match states. │ */ - do k=j+1 to z /* ◄─── state K, state J ►───────┘ */ - if #.j<<#.k then JK=#.j || #.k /*is in proper order?*/ - else JK=#.k || #.j /*use new state name.*/ + do j=1 for z /*◄───────────────────────────────────────────────────────────────┐ */ + /*look for mix and match states. │ */ + do k=j+1 to z /* ◄─── state K, state J ►───────┘ */ + if #.j<<#.k then JK=#.j || #.k /*is the state in the proper order? */ + else JK=#.k || #.j /*No, then use the new state name. */ - do m=1 for z; if m==j | m==k then iterate /*no overlaps allowed*/ - if verify(#.m,jk)\==0 then iterate /*is this possible? */ - nJK=elider(JK,#.m) /*new JK, after eliding #.m characters.*/ + do m=1 for z; if m==j | m==k then iterate /*no state overlaps are allowed. */ + if verify(#.m,jk)\==0 then iterate /*is this state name even possible? */ + nJK=elider(JK,#.m) /*a new JK, after eliding #.m chars.*/ - do n=m+1 to z; if n==j | n==k then iterate /*no overlaps allowed*/ - if verify(#.n,nJK)\==0 then iterate /*is it possible? */ - if elider(nJK,#.n)\=='' then iterate /*leftovers letters? */ - if #.m<<#.n then MN=#.m || #.n /*is in proper order?*/ - else MN=#.n || #.m /*a new state name. */ - if @@.JK.MN\=='' | @@.MN.JK\=='' then iterate /*was it done before?*/ - say 'found: ' ##.j',' ##.k " ───► " ##.m',' ##.n - @@.JK.MN=1 /*indicate this solution as being found*/ - sols=sols+1 /*bump the number of solutions found. */ + do n=m+1 to z; if n==j | n==k then iterate /*no overlaps are allowed. */ + if verify(#.n,nJK)\==0 then iterate /*is it possible? */ + if elider(nJK,#.n)\=='' then iterate /*any leftovers letters? */ + if #.m<<#.n then MN=#.m || #.n /*is it in the proper order?*/ + else MN=#.n || #.m /*we found a new state name.*/ + if @@.JK.MN\=='' | @@.MN.JK\=="" then iterate /*was it done before? */ + say 'found: ' ##.j',' ##.k " ───► " ##.m',' ##.n + @@.JK.MN=1 /*indicate this solution as being found*/ + sols=sols+1 /*bump the number of solutions found. */ end /*n*/ end /*m*/ end /*k*/ end /*j*/ -say /*show a blank line for easier reading.*/ -if sols==0 then sols='No' /*use mucher gooder (sic) Englishings. */ -say sols 'solution's(sols) "found." /*display the number of solutions found*/ -exit /*stick a fork in it, we're all done. */ -/*───────────────────────────────────ELIDER───────────────────────────────────*/ -elider: parse arg hay,pins /*remove letters (pins) from haystack. */ - - do e=1 for length(pins); p=pos(substr(pins,e,1), hay) - if p==0 then iterate ; hay=overlay(' ',hay,p) - end /*e*/ /* [↑] remove a letter.*/ -return space(hay,0) /*remove blanks from hay*/ -/*──────────────────────────────────S subroutine──────────────────────────────*/ -s: if arg(1)==1 then return arg(3);return word(arg(2) 's',1) /*pluralizer.*/ +say /*show a blank line for easier reading.*/ +if sols==0 then sols='No' /*use mucher gooder (sic) Englishings. */ +say sols 'solution's(sols) "found." /*display the number of solutions found*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +elider: parse arg hay,pins /*remove letters (pins) from haystack. */ + do e=1 for length(pins); p=pos(substr(pins,e,1), hay) + if p==0 then iterate ; hay=overlay(' ',hay,p) + end /*e*/ /* [↑] remove a letter from haystack. */ + return space(hay,0) /*remove blanks from the haystack. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ diff --git a/Task/Statistics-Basic/00DESCRIPTION b/Task/Statistics-Basic/00DESCRIPTION index cecff76faf..22247af399 100644 --- a/Task/Statistics-Basic/00DESCRIPTION +++ b/Task/Statistics-Basic/00DESCRIPTION @@ -1,4 +1,4 @@ -Statistics is all about large groups of numbers. +[[Statistics|Statistics]] is all about large groups of numbers. When talking about a set of sampled data, most frequently used is their [[wp:Mean|mean value]] and [[wp:Standard_deviation|standard deviation (stddev)]]. If you have set of data x_i where i = 1, 2, \ldots, n\,\!, the mean is \bar{x}\equiv {1\over n}\sum_i x_i, while the stddev is \sigma\equiv\sqrt{{1\over n}\sum_i \left(x_i - \bar x \right)^2}. @@ -23,3 +23,11 @@ Or, more verbosely: : \frac{1}{N}\sum_{i=1}^N(x_i-\overline{x})^2 = \frac{1}{N} \left(\sum_{i=1}^N x_i^2\right) - \overline{x}^2. + +{{task heading|See also}} + +* [[Statistics/Normal_distribution|Statistics/Normal distribution]] + +{{Related tasks/Statistical measures}} + +

    diff --git a/Task/Statistics-Basic/C++/statistics-basic.cpp b/Task/Statistics-Basic/C++/statistics-basic.cpp new file mode 100644 index 0000000000..7dd2da1a18 --- /dev/null +++ b/Task/Statistics-Basic/C++/statistics-basic.cpp @@ -0,0 +1,48 @@ +#include +#include +#include +#include +#include +#include + +void printStars ( int number ) { + if ( number > 0 ) { + for ( int i = 0 ; i < number + 1 ; i++ ) + std::cout << '*' ; + } + std::cout << '\n' ; +} + +int main( int argc , char *argv[] ) { + const int numberOfRandoms = std::atoi( argv[1] ) ; + std::random_device rd ; + std::mt19937 gen( rd( ) ) ; + std::uniform_real_distribution<> distri( 0.0 , 1.0 ) ; + std::vector randoms ; + for ( int i = 0 ; i < numberOfRandoms + 1 ; i++ ) + randoms.push_back ( distri( gen ) ) ; + std::sort ( randoms.begin( ) , randoms.end( ) ) ; + double start = 0.0 ; + for ( int i = 0 ; i < 9 ; i++ ) { + double to = start + 0.1 ; + int howmany = std::count_if ( randoms.begin( ) , randoms.end( ), + [&start , &to] ( double c ) { return c >= start + && c < to ; } ) ; + if ( start == 0.0 ) //double 0.0 output as 0 + std::cout << "0.0" << " - " << to << ": " ; + else + std::cout << start << " - " << to << ": " ; + if ( howmany > 50 ) //scales big interval numbers to printable length + howmany = howmany / ( howmany / 50 ) ; + printStars ( howmany ) ; + start += 0.1 ; + } + double mean = std::accumulate( randoms.begin( ) , randoms.end( ) , 0.0 ) / randoms.size( ) ; + double sum = 0.0 ; + for ( double num : randoms ) + sum += std::pow( num - mean , 2 ) ; + double stddev = std::pow( sum / randoms.size( ) , 0.5 ) ; + std::cout << "The mean is " << mean << " !" << std::endl ; + std::cout << "Standard deviation is " << stddev << " !" << std::endl ; + return 0 ; +} diff --git a/Task/Statistics-Basic/Elixir/statistics-basic.elixir b/Task/Statistics-Basic/Elixir/statistics-basic.elixir new file mode 100644 index 0000000000..427b223e55 --- /dev/null +++ b/Task/Statistics-Basic/Elixir/statistics-basic.elixir @@ -0,0 +1,27 @@ +defmodule Statistics do + def basic(n) do + {sum, sum2, hist} = generate(n) + mean = sum / n + stddev = :math.sqrt(sum2 / n - mean*mean) + + IO.puts "size: #{n}" + IO.puts "mean: #{mean}" + IO.puts "stddev: #{stddev}" + Enum.each(0..9, fn i -> + :io.fwrite "~.1f:~s~n", [0.1*i, String.duplicate("=", trunc(500 * hist[i] / n))] + end) + IO.puts "" + end + + defp generate(n) do + hist = for i <- 0..9, into: %{}, do: {i,0} + Enum.reduce(1..n, {0, 0, hist}, fn _,{sum, sum2, h} -> + r = :rand.uniform + {sum+r, sum2+r*r, Map.update!(h, trunc(10*r), &(&1+1))} + end) + end +end + +Enum.each([100,1000,10000], fn n -> + Statistics.basic(n) +end) diff --git a/Task/Statistics-Basic/Haskell/statistics-basic.hs b/Task/Statistics-Basic/Haskell/statistics-basic.hs new file mode 100644 index 0000000000..326bc0ea17 --- /dev/null +++ b/Task/Statistics-Basic/Haskell/statistics-basic.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE BangPatterns #-} + +import Data.Foldable +import System.Random +import System.Environment (getArgs) + +intervals :: [(Double,Double)] +intervals = map conv [0..9] + where xs = [0.0,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1.0] + conv s = let { [h,l] = take 2 $ drop s xs } in (h,l) + +count :: [Double] -> [Int] +count rands = map (\iv -> foldl' (loop iv) 0 rands) intervals + where loop :: (Double,Double) -> Int -> Double -> Int + loop (lo,hi) n x | lo <= x && x < hi = n+1 + | otherwise = n + -- ^ fuses length and filter within (lo,hi) + +data Pair a b = Pair !a !b + +-- accumulate sum and length in one fold +sumLen :: [Double] -> Pair Double Double +sumLen = fion2 . foldl' (\(Pair s l) x -> Pair (s+x) (l+1)) (Pair 0.0 0) + where fion2 :: Pair Double Int -> Pair Double Double + fion2 (Pair s l) = Pair s (fromIntegral l) + +-- safe division on pairs +divl :: Pair Double Double -> Double +divl (Pair _ 0.0) = 0.0 +divl (Pair s l) = s / l + +-- sumLen and divl are separate for stddev below +mean :: [Double] -> Double +mean = divl . sumLen + +stddev :: [Double] -> Double +stddev xs = sqrt $ foldl' (\s x -> s+(x-m)^2) 0 xs / l + where p@(Pair s l) = sumLen xs + m = divl p + +main = do nr <- read.head <$> getArgs + rands <- take nr . randomRs (0.0,1.0) <$> newStdGen + putStrLn $ "The mean is " ++ show (mean rands) ++ " !" + putStrLn $ "The standard deviation is " ++ show (stddev rands) ++ " !" + zipWithM_ (\iv fq -> putStrLn $ ivstr iv ++ ": " ++ fqstr fq) intervals (count rands) + where + fqstr i = replicate (if i > 50 then div i (div i 50) else i) '*' + ivstr (lo,hi) = show lo ++ " - " ++ show hi diff --git a/Task/Statistics-Basic/J/statistics-basic-1.j b/Task/Statistics-Basic/J/statistics-basic-1.j index ff67505f77..251f8d8ce2 100644 --- a/Task/Statistics-Basic/J/statistics-basic-1.j +++ b/Task/Statistics-Basic/J/statistics-basic-1.j @@ -1,7 +1,7 @@ - require'statfns' - (mean,stddev) ?1000#0 + require 'stats' + (mean,stddev) 1000 ?@$ 0 0.484669 0.287482 - (mean,stddev) ?10000#0 + (mean,stddev) 10000 ?@$ 0 0.503642 0.290777 - (mean,stddev) ?100000#0 + (mean,stddev) 100000 ?@$ 0 0.499677 0.288726 diff --git a/Task/Statistics-Basic/J/statistics-basic-2.j b/Task/Statistics-Basic/J/statistics-basic-2.j index fea7ade0c2..a84245cc0b 100644 --- a/Task/Statistics-Basic/J/statistics-basic-2.j +++ b/Task/Statistics-Basic/J/statistics-basic-2.j @@ -1,3 +1,3 @@ histogram=: <: @ (#/.~) @ (i.@#@[ , I.) require'plot' -plot ((%*1+i.)100) ([;histogram) ?10000#0 +plot ((% * 1 + i.)100) ([;histogram) 10000 ?@$ 0 diff --git a/Task/Statistics-Basic/J/statistics-basic-3.j b/Task/Statistics-Basic/J/statistics-basic-3.j index e919e8043f..a97e0e8919 100644 --- a/Task/Statistics-Basic/J/statistics-basic-3.j +++ b/Task/Statistics-Basic/J/statistics-basic-3.j @@ -1,23 +1,24 @@ histogram=: <: @ (#/.~) @ (i.@#@[ , I.) -meanstddevP=:3 :0 +meanstddevP=: 3 :0 NB. compute mean and std dev of y random numbers NB. picked from even distribution between 0 and 1 NB. and display a normalized ascii histogram for this sample - NB. note: should use population mean, not sample mean, for stddev + NB. note: uses population mean (0.5), not sample mean, for stddev NB. given the equation specified for this task. h=.s=.t=. 0 - buckets=. (%~1+i.)10 - for_n.i.<.y%1e6 do. - data=. ?1e6#0 - h=.h+ buckets histogram data - s=.s+ +/ data - t=.t+ +/(data-0.5)^2 + chunk=. 1e6 + bins=. (%~ 1 + i.) 10 + for. i. <.y%chunk do. + data=. chunk ?@$ 0 + h=. h+ bins histogram data + s=. s+ +/ data + t=. t+ +/ *: data-0.5 end. - data=. ?(1e6|y)#0 - h=.h+ buckets histogram data - s=.s+ +/ data - t=.t++/(data-0.5)^2 - smoutput (<.300*h%y)#"0'#' - (s%y),%:t%y + data=. (chunk|y) ?@$ 0 + h=. h+ bins histogram data + s=. s+ +/ data + t=. t+ +/ *: data - 0.5 + smoutput (<.300*h%y) #"0 '#' + (s%y) , %:t%y ) diff --git a/Task/Statistics-Basic/Java/statistics-basic.java b/Task/Statistics-Basic/Java/statistics-basic.java new file mode 100644 index 0000000000..f8d9d5a924 --- /dev/null +++ b/Task/Statistics-Basic/Java/statistics-basic.java @@ -0,0 +1,52 @@ +import static java.lang.Math.pow; +import static java.util.Arrays.stream; +import static java.util.stream.Collectors.joining; +import static java.util.stream.IntStream.range; + +public class Test { + static double[] meanStdDev(double[] numbers) { + if (numbers.length == 0) + return new double[]{0.0, 0.0}; + + double sx = 0.0, sxx = 0.0; + long n = 0; + for (double x : numbers) { + sx += x; + sxx += pow(x, 2); + n++; + } + return new double[]{sx / n, pow((n * sxx - pow(sx, 2)), 0.5) / n}; + } + + static String replicate(int n, String s) { + return range(0, n + 1).mapToObj(i -> s).collect(joining()); + } + + static void showHistogram01(double[] numbers) { + final int maxWidth = 50; + long[] bins = new long[10]; + + for (double x : numbers) + bins[(int) (x * bins.length)]++; + + double maxFreq = stream(bins).max().getAsLong(); + + for (int i = 0; i < bins.length; i++) + System.out.printf(" %3.1f: %s%n", i / (double) bins.length, + replicate((int) (bins[i] / maxFreq * maxWidth), "*")); + System.out.println(); + } + + public static void main(String[] a) { + Locale.setDefault(Locale.US); + for (int p = 1; p < 7; p++) { + double[] n = range(0, (int) pow(10, p)) + .mapToDouble(i -> Math.random()).toArray(); + + System.out.println((int)pow(10, p) + " numbers:"); + double[] res = meanStdDev(n); + System.out.printf(" Mean: %8.6f, SD: %8.6f%n", res[0], res[1]); + showHistogram01(n); + } + } +} diff --git a/Task/Statistics-Basic/Lua/statistics-basic.lua b/Task/Statistics-Basic/Lua/statistics-basic.lua index 10739d4e7c..c92b51567c 100644 --- a/Task/Statistics-Basic/Lua/statistics-basic.lua +++ b/Task/Statistics-Basic/Lua/statistics-basic.lua @@ -1,5 +1,4 @@ math.randomseed(os.time()) -math.random() -- First number after seeding not random - throw one away function randList (n) -- Build table of size n local numbers = {} diff --git a/Task/Statistics-Basic/Maple/statistics-basic-1.maple b/Task/Statistics-Basic/Maple/statistics-basic-1.maple new file mode 100644 index 0000000000..9521cc8918 --- /dev/null +++ b/Task/Statistics-Basic/Maple/statistics-basic-1.maple @@ -0,0 +1,5 @@ +with(Statistics): +X_100 := Sample( Uniform(0,1), 100 ); +Mean( X_100 ); +StandardDeviation( X_100 ); +Histogram( X_100 ); diff --git a/Task/Statistics-Basic/Maple/statistics-basic-2.maple b/Task/Statistics-Basic/Maple/statistics-basic-2.maple new file mode 100644 index 0000000000..88031329e3 --- /dev/null +++ b/Task/Statistics-Basic/Maple/statistics-basic-2.maple @@ -0,0 +1,9 @@ +sample := proc( n ) + local data; + data := Sample( Uniform(0,1), n ); + printf( "Mean: %.4f\nStandard Deviation: %.4f", + Statistics:-Mean( data ), + Statistics:-StandardDeviation( data ) ); + return Statistics:-Histogram( data ); +end proc: +sample( 1000 ); diff --git a/Task/Statistics-Basic/REXX/statistics-basic.rexx b/Task/Statistics-Basic/REXX/statistics-basic.rexx index efd799b40e..fed60dfbf3 100644 --- a/Task/Statistics-Basic/REXX/statistics-basic.rexx +++ b/Task/Statistics-Basic/REXX/statistics-basic.rexx @@ -1,35 +1,34 @@ -/*REXX pgm gens some random numbers, shows bin histogram, finds mean & stdDev.*/ -numeric digits 20 /*use twenty decimal digits precision, */ -showDigs=digits()%2 /* ··· but only show ten decimal digits*/ -parse arg size seed . /*allow specification: size, and seed.*/ -if size=='' | size==',' then size=100 /*Not specified? Then use the default.*/ -if datatype(seed,'W') then call random ,,seed /*allow a seed for RAND BIF.*/ -#.=0 /*count of the numbers in each bin. */ - do j=1 for size /*generate some random numbers. */ - @.j=random(0,99999)/100000 /*express it as a fraction. */ - _=substr(@.j'00',3,1) /*determine which bin the number is in,*/ - #._=#._+1 /* ··· and bump its count. */ +/*REXX program generates some random numbers, shows bin histogram, finds mean & stdDev. */ +numeric digits 20 /*use twenty decimal digits precision, */ +showDigs=digits()%2 /* ··· but only show ten decimal digits*/ +parse arg size seed . /*allow specification: size, and seed.*/ +if size=='' | size=="," then size=100 /*Not specified? Then use the default.*/ +if datatype(seed,'W') then call random ,,seed /*allow a seed for the RANDOM BIF. */ +#.=0 /*count of the numbers in each bin. */ + do j=1 for size /*generate some random numbers. */ + @.j=random(0, 99999) / 100000 /*express random number as a fraction. */ + _=substr(@.j'00', 3, 1) /*determine which bin the number is in,*/ + #._=#._+1 /* ··· and bump its count. */ end /*j*/ - do k=0 for 10 /*show a histogram of the bins. */ - lr='0.'k ; if k==0 then lr='0 ' /*adjust for the low range.*/ - hr='0.'||(k+1); if k==9 then hr='1 ' /* " " " high range.*/ - range=lr"──►"hr' ' /*construct the range. */ - barPC=right(strip(left(format(100*#.k/size,,2),5)),5) /*comp %.*/ - say range barPC copies('─',format(barPC*1,,0)) /*histo. */ + do k=0 for 10 /*show a histogram of the bins. */ + lr='0.'k ; if k==0 then lr="0 " /*adjust for the low range. */ + hr='0.'||(k+1); if k==9 then hr="1 " /* " " " high range. */ + range=lr"──►"hr' ' /*construct the range. */ + barPC=right(strip(left(format(100*#.k/size, , 2), 5)) ,5) /*compute the %. */ + say range barPC copies('─', format(barPC*1, , 0)) /*display histogram*/ end /*k*/ say -say 'sample size = ' size; say -avg=mean(size) ; say ' mean = ' format(avg,,showDigs) -std=stdDev(size); say ' stdDev = ' format(std,,showDigs) -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -mean: parse arg N; $=0; do m=1 for N; $=$+@.m; end; return $/n -stdDev: parse arg N; $=0; do s=1 for N; $=$+(@.s-avg)**2; end; return sqrt($/n) -/*────────────────────────────────────────────────────────────────────────────*/ -sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); i=; m.=9 - numeric digits 9; numeric form; h=d+6; if x<0 then do; x=-x; i='i'; end - parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_%2 - do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ - do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ - numeric digits d; return (g/1)i /*make complex if X < 0.*/ +say 'sample size = ' size; say +avg= mean(size) ; say ' mean = ' format(avg, , showDigs) +std=stdDev(size) ; say ' stdDev = ' format(std, , showDigs) +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +mean: parse arg N; $=0; do m=1 for N; $=$+@.m; end; return $/n +stdDev: parse arg N; $=0; do s=1 for N; $=$+(@.s-avg)**2; end; return sqrt($/n) +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); m.=9; numeric form; h=d+6 + numeric digits; parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_ % 2 + do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ + do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ + return g/1 diff --git a/Task/Statistics-Basic/Run-BASIC/statistics-basic.run b/Task/Statistics-Basic/Run-BASIC/statistics-basic.run new file mode 100644 index 0000000000..47ef63e134 --- /dev/null +++ b/Task/Statistics-Basic/Run-BASIC/statistics-basic.run @@ -0,0 +1,42 @@ +call sample 100 +call sample 1000 +call sample 10000 + +end + +sub sample n + dim samp(n) + for i =1 to n + samp(i) =rnd(1) + next i + + ' calculate mean, standard deviation + sum = 0 + sumSq = 0 + for i = 1 to n + sum = sum + samp(i) + sumSq = sumSq + samp(i)^2 + next i + print n; " Samples used." + + mean = sum / n + print "Mean = "; mean + + print "Std Dev = "; (sumSq /n -mean^2)^0.5 + + '------- Show histogram + bins = 10 + dim bins(bins) + for i = 1 to n + z = int(bins * samp(i)) + bins(z) = bins(z) +1 + next i + for b = 0 to bins -1 + print b;" "; + for j = 1 to int(bins *bins(b)) /n *70 + print "*"; + next j + print + next b + print +end sub diff --git a/Task/Statistics-Basic/Rust/statistics-basic.rust b/Task/Statistics-Basic/Rust/statistics-basic.rust new file mode 100644 index 0000000000..123ddf7c8b --- /dev/null +++ b/Task/Statistics-Basic/Rust/statistics-basic.rust @@ -0,0 +1,70 @@ +#![feature(iter_arith)] +extern crate rand; + +use rand::distributions::{IndependentSample, Range}; + +pub fn mean(data: &[f32]) -> Option { + if data.is_empty() { + None + } else { + let sum: f32 = data.iter().sum(); + Some(sum / data.len() as f32) + } +} + +pub fn variance(data: &[f32]) -> Option { + if data.is_empty() { + None + } else { + let mean = mean(data).unwrap(); + let mut sum = 0f32; + for &x in data { + sum += (x - mean).powi(2); + } + Some(sum / data.len() as f32) + } +} + +pub fn standard_deviation(data: &[f32]) -> Option { + if data.is_empty() { + None + } else { + let variance = variance(data).unwrap(); + Some(variance.sqrt()) + } +} + +fn print_histogram(width: u32, data: &[f32]) { + let mut histogram = [0; 10]; + let len = histogram.len() as f32; + for &x in data { + histogram[(x * len) as usize] += 1; + } + let max_frequency = *histogram.iter().max().unwrap() as f32; + for (i, &frequency) in histogram.iter().enumerate() { + let bar_width = frequency as f32 * width as f32 / max_frequency; + print!("{:3.1}: ", i as f32 / len); + for _ in 0..bar_width as usize { + print!("*"); + } + println!(""); + } +} + +fn main() { + let range = Range::new(0f32, 1f32); + let mut rng = rand::thread_rng(); + + for &number_of_samples in [1000, 10_000, 1_000_000].iter() { + let mut data = vec![]; + for _ in 0..number_of_samples { + let x = range.ind_sample(&mut rng); + data.push(x); + } + println!(" Statistics for sample size {}", number_of_samples); + println!("Mean: {:?}", mean(&data)); + println!("Variance: {:?}", variance(&data)); + println!("Standard deviation: {:?}", standard_deviation(&data)); + print_histogram(40, &data); + } +} diff --git a/Task/Stem-and-leaf-plot/00DESCRIPTION b/Task/Stem-and-leaf-plot/00DESCRIPTION index 03476ccdd3..2b6f5d2f24 100644 --- a/Task/Stem-and-leaf-plot/00DESCRIPTION +++ b/Task/Stem-and-leaf-plot/00DESCRIPTION @@ -1,9 +1,12 @@ Create a well-formatted [[wp:Stem-and-leaf_plot|stem-and-leaf plot]] from the following data set, where the leaves are the last digits: -
    12 127 28 42 39 113 42 18 44 118 44 37 113 124 37 48 127 36 29 31 125 139 131 115 105 132 104 123 35 113 122 42 117 119 58 109 23 105 63 27 44 105 99 41 128 121 116 125 32 61 37 127 29 113 121 58 114 126 53 114 96 25 109 7 31 141 46 13 27 43 117 116 27 7 68 40 31 115 124 42 128 52 71 118 117 38 27 106 33 117 116 111 40 119 47 105 57 122 109 124 115 43 120 43 27 27 18 28 48 125 107 114 34 133 45 120 30 127 31 116 146
    +
    12 127 28 42 39 113 42 18 44 118 44 37 113 124 37 48 127 36 29 31 125 139 131 115 105 132 104 123 35 113 122 42 117 119 58 109 23 105 63 27 44 105 99 41 128 121 116 125 32 61 37 127 29 113 121 58 114 126 53 114 96 25 109 7 31 141 46 13 27 43 117 116 27 7 68 40 31 115 124 42 128 52 71 118 117 38 27 106 33 117 116 111 40 119 47 105 57 122 109 124 115 43 120 43 27 27 18 28 48 125 107 114 34 133 45 120 30 127 31 116 146
    + The primary intent of this task is the presentation of information. It is acceptable to hardcode the data set or characteristics of it (such as what the stems are) in the example, insofar as it is impractical to make the example generic to any data set. For example, in a computation-less language like HTML the data set may be entirely prearranged within the example; the interesting characteristics are how the proper visual formatting is arranged. If possible, the output should not be a bitmap image. Monospaced plain text is acceptable, but do better if you can. It may be a window, i.e. not a file. + '''Note:''' If you wish to try multiple data sets, you might try [[Stem-and-leaf plot/Data generator|this generator]]. +

    diff --git a/Task/Stem-and-leaf-plot/Elixir/stem-and-leaf-plot.elixir b/Task/Stem-and-leaf-plot/Elixir/stem-and-leaf-plot.elixir index e985b20d32..adf1dff56f 100644 --- a/Task/Stem-and-leaf-plot/Elixir/stem-and-leaf-plot.elixir +++ b/Task/Stem-and-leaf-plot/Elixir/stem-and-leaf-plot.elixir @@ -2,19 +2,17 @@ defmodule Stem_and_leaf do def plot(data, leaf_digits\\1) do multiplier = Enum.reduce(1..leaf_digits, 1, fn _,acc -> acc*10 end) Enum.group_by(data, fn x -> div(x, multiplier) end) - |> Enum.into(Map.new, fn {k,v} -> - {k, Enum.map(v, fn val -> rem(val, multiplier) end) |> Enum.sort} - end) + |> Map.new(fn {k,v} -> {k, Enum.map(v, &rem(&1, multiplier)) |> Enum.sort} end) |> print(leaf_digits) end - def print(plot_data, leaf_digits) do - {min, max} = Dict.keys(plot_data) |> Enum.min_max(keys) - stem_width = length(to_char_list(max)) + defp print(plot_data, leaf_digits) do + {min, max} = Map.keys(plot_data) |> Enum.min_max + stem_width = length(to_charlist(max)) fmt = "~#{stem_width}w | ~s~n" Enum.each(min..max, fn stem -> - leaves = Enum.map_join(Dict.get(plot_data, stem, []), " ", fn leaf -> - to_string(leaf) |> String.rjust(leaf_digits) + leaves = Enum.map_join(Map.get(plot_data, stem, []), " ", fn leaf -> + to_string(leaf) |> String.pad_leading(leaf_digits) end) :io.format fmt, [stem, leaves] end) diff --git a/Task/Stem-and-leaf-plot/Perl-6/stem-and-leaf-plot.pl6 b/Task/Stem-and-leaf-plot/Perl-6/stem-and-leaf-plot.pl6 index 517318dc0c..9befb2437f 100644 --- a/Task/Stem-and-leaf-plot/Perl-6/stem-and-leaf-plot.pl6 +++ b/Task/Stem-and-leaf-plot/Perl-6/stem-and-leaf-plot.pl6 @@ -16,7 +16,7 @@ my Int $stem_unit = 10; my %h = @data.classify: * div $stem_unit; my $range = [minmax] %h.keys».Int; -my $stem_format = "%{$range.from.chars max $range.to.chars}d"; +my $stem_format = "%{$range.min.chars max $range.max.chars}d"; for $range.list -> $stem { my $leafs = %h{$stem} // []; diff --git a/Task/Stem-and-leaf-plot/PowerShell/stem-and-leaf-plot.psh b/Task/Stem-and-leaf-plot/PowerShell/stem-and-leaf-plot.psh new file mode 100644 index 0000000000..263bced4d5 --- /dev/null +++ b/Task/Stem-and-leaf-plot/PowerShell/stem-and-leaf-plot.psh @@ -0,0 +1,10 @@ +$Set = -split '12 127 28 42 39 113 42 18 44 118 44 37 113 124 37 48 127 36 29 31 125 139 131 115 105 132 104 123 35 113 122 42 117 119 58 109 23 105 63 27 44 105 99 41 128 121 116 125 32 61 37 127 29 113 121 58 114 126 53 114 96 25 109 7 31 141 46 13 27 43 117 116 27 7 68 40 31 115 124 42 128 52 71 118 117 38 27 106 33 117 116 111 40 119 47 105 57 122 109 124 115 43 120 43 27 27 18 28 48 125 107 114 34 133 45 120 30 127 31 116 146' + +$Data = $Set | Select @{ Label = 'Stem'; Expression = { [string][int]$_.Substring( 0, $_.Length - 1 ) } }, @{ Label = 'Leaf'; Expression = { [string]$_[-1] } } + +$StemStats = $Data | Measure-Object -Property Stem -Minimum -Maximum + +ForEach ( $Stem in $StemStats.Minimum..$StemStats.Maximum ) + { + @( $Stem.ToString().PadLeft( 2, " " ), '|' ) + ( ( $Data | Where Stem -eq $Stem ).Leaf | Sort ) -join " " + } diff --git a/Task/Stem-and-leaf-plot/REXX/stem-and-leaf-plot-1.rexx b/Task/Stem-and-leaf-plot/REXX/stem-and-leaf-plot-1.rexx new file mode 100644 index 0000000000..7cde4bb0c4 --- /dev/null +++ b/Task/Stem-and-leaf-plot/REXX/stem-and-leaf-plot-1.rexx @@ -0,0 +1,26 @@ +/*REXX program displays a stem and leaf plot of any non-negative numbers [can include 0]*/ +parse arg @ /* [↑] Not specified? Then use default*/ +if @='' then @=12 127 28 42 39 113 42 18 44 118 44 37 113 124 37 48 127 36 29 31 125 139, + 131 115 105 132 104 123 35 113 122 42 117 119 58 109 23 105 63 27 44 105 99 41 128 121, + 116 125 32 61 37 127 29 113 121 58 114 126 53 114 96 25 109 7 31 141 46 13 27 43 117, + 116 27 7 68 40 31 115 124 42 128 52 71 118 117 38 27 106 33 117 116 111 40 119 47 105, + 57 122 109 124 115 43 120 43 27 27 18 28 48 125 107 114 34 133 45 120 30 127 31 116 146 +#.=; bot=.; top=. /* [↑] define all #. elements as null.*/ + do j=1 for words(@); y=word(@, j) /*◄─── process each number in the list.*/ + if \datatype(y,"N") then do; say '***error*** item' j "isn't numeric:" y; exit; end + if y<0 then do; say '***error*** item' j "is negative:" y; exit; end + n=format(y, , 0) / 1 /*normalize the numbers (not malformed)*/ + stem=word(left(n, length(n) -1) 0, 1) /*obtain stem (1st digits) from number.*/ + parse var n '' -1 leaf; _=stem * sign(n) /* " leaf (last digit) " " */ + if bot==. then do; bot=_; top=_; end /*handle the first case for TOP and BOT*/ + bot=min(bot, _); top=max(top, _) /*obtain the minimum and maximum so far*/ + #.stem.leaf= #.stem.leaf leaf /*construct sorted stem-and-leaf entry.*/ + end /*j*/ + +w=max(length(min), length(max) ) + 1 /*W: used to right justify the output.*/ + /* [↓] display the stem-and-leaf plot.*/ + do k=bot to top; $= /*$: is the output string, a plot line*/ + do m=0 for 10; $=$ #.k.m /*build a line for the stem─&─leaf plot*/ + end /*m*/ + say right(k, w) '║' space($) /*display a line of stem─and─leaf plot.*/ + end /*k*/ /*stick a fork in it, we're all done. */ diff --git a/Task/Stem-and-leaf-plot/REXX/stem-and-leaf-plot-2.rexx b/Task/Stem-and-leaf-plot/REXX/stem-and-leaf-plot-2.rexx new file mode 100644 index 0000000000..3a1ac3779d --- /dev/null +++ b/Task/Stem-and-leaf-plot/REXX/stem-and-leaf-plot-2.rexx @@ -0,0 +1,31 @@ +/*REXX program displays a stem─and─leaf plot of any real numbers [can be: neg, 0, pos].*/ +parse arg @ /*obtain optional arguments from the CL*/ +if @='' then @='15 14 3 2 1 0 -1 -2 -3 -14 -15' /*Not specified? Then use the default.*/ +#.=; bot=.; top=.; z=. /* [↑] define all #. elements as null.*/ + do j=1 for words(@); y=word(@, j) /*◄─── process each number in the list.*/ + if \datatype(y,"N") then do; say '***error*** item' j "isn't numeric:" y; exit; end + n=format(y,,0)/1; an=abs(n); s=sign(n) /*normalize the numbers (not malformed)*/ + stem=left(an, length(an) -1) + if stem=='' then if s>=0 then stem=0 /*handle case of one-digit positive #. */ + else stem='-0' /* " " " " " negative " */ + else stem=s * stem /* " " " a multi-digit number.*/ + parse var n '' -1 leaf /*obtain the leaf (the last digit) of #*/ + if bot==. then do; bot=stem; top=bot; end /*handle the first case for TOP and BOT*/ + bot=min(bot, stem); top=max(top, stem) /*obtain the minimum and maximum so far*/ + if stem=='-0' then z=0 /*use Z as a flag to show negative 0.*/ + #.stem.leaf= #.stem.leaf leaf /*construct sorted stem-and-leaf entry.*/ + end /*j*/ + +w=max(length(min), length(max) ) + 1 /*W: used to right─justify the output.*/ +!='-0' /* [↓] display the stem-and-leaf plot.*/ + do k=bot to top; $= /*$: is the output string, a plot line*/ + if k==z then do /*handle a special case for negative 0.*/ + do s=0 for 10; $=$ #.!.s /*build a line for the stem─&─leaf plot*/ + end /*s*/ /* [↑] address special case of -zero.*/ + say right(!, w) '║' space($) /*display a line of stem─and─leaf plot.*/ + end /* [↑] handles special case of -zero.*/ + $= /*a new plot line (of output). */ + do m=0 for 10; $=$ #.k.m /*build a line for the stem─&─leaf plot*/ + end /*m*/ + say right(k, w) '║' space($) /*display a line of stem─and─leaf plot.*/ + end /*k*/ /*stick a fork in it, we're all done. */ diff --git a/Task/Stem-and-leaf-plot/REXX/stem-and-leaf-plot.rexx b/Task/Stem-and-leaf-plot/REXX/stem-and-leaf-plot.rexx deleted file mode 100644 index 5f230465d3..0000000000 --- a/Task/Stem-and-leaf-plot/REXX/stem-and-leaf-plot.rexx +++ /dev/null @@ -1,26 +0,0 @@ -/*REXX program displays a stem─and─leaf plot of any real numbers [-, 0, +]. */ -parse arg data /* [↓] Not specified? Then use default*/ -if data='' then data=12 127 28 42 39 113 42 18 44 118 44 37 113 124 37 48 127 36 29 31 125 , - 139 131 115 105 132 104 123 35 113 122 42 117 119 58 109 23 105 63 27 44 105 99 41 128 , - 121 116 125 32 61 37 127 29 113 121 58 114 126 53 114 96 25 109 7 31 141 46 13 27 43 117, - 116 27 7 68 40 31 115 124 42 128 52 71 118 117 38 27 106 33 117 116 111 40 119 47 105 57, - 122 109 124 115 43 120 43 27 27 18 28 48 125 107 114 34 133 45 120 30 127 31 116 146 -parse var data bot . 1 top . '' @. /*define MIN & MAX as the first number.*/ - /* [↑] define all @. elements as null.*/ - do j=1 for words(data) /*◄─── process each number in the list.*/ - _=format(word(data,j),,0)/1 /*normalize the numbers (not malformed)*/ - stem=left(_, max(1, length(_)-1)) /*obtain stem (1st digit) from number.*/ - parse var _ '' -1 leaf /* " leaf (last " ) " " */ - if length(_)==1 then stem=0 /*special case: single─digit leaves. */ - bot=min(bot, stem*sign(_)) /*obtain the minimum number (so far). */ - top=max(top, stem*sign(_)) /* " " maximum " " " */ - @.stem.leaf=@.stem.leaf leaf /*construct sorted stem-and-leaf entry.*/ - end /*j*/ - -w=max(length(min), length(max)) + 1 /*W: used to right─justify the output.*/ - /* [↓] display the stem-and-leaf plot.*/ - do k=bot to top; $= /*$: is the output string, a plot line*/ - do m=0 for 10; $=$ @.k.m /*build a line for the stem─&─leaf plot*/ - end /*m*/ - say right(k,w) '║' space($) /*display a line of stem─and─leaf plot.*/ - end /*k*/ /*stick a fork in it, we're all done. */ diff --git a/Task/Stern-Brocot-sequence/00DESCRIPTION b/Task/Stern-Brocot-sequence/00DESCRIPTION index 6a4d0e7346..02fbd22531 100644 --- a/Task/Stern-Brocot-sequence/00DESCRIPTION +++ b/Task/Stern-Brocot-sequence/00DESCRIPTION @@ -1,35 +1,40 @@ For this task, the Stern-Brocot sequence is to be generated by an algorithm similar to that employed in generating the [[Fibonacci sequence]]. # The first and second members of the sequence are both 1: -#* 1, 1 +#*     1, 1 # Start by considering the second member of the sequence # Sum the considered member of the sequence and its precedent, (1 + 1) = 2, and append it to the end of the sequence: -#* 1, 1, 2 +#*     1, 1, 2 # Append the considered member of the sequence to the end of the sequence: -#* 1, 1, 2, 1 +#*     1, 1, 2, 1 # Consider the next member of the series, (the third member i.e. 2) # GOTO 3 +#* +#*         ─── Expanding another loop we get: ─── +#* +# Sum the considered member of the sequence and its precedent, (2 + 1) = 3, and append it to the end of the sequence: +#*     1, 1, 2, 1, 3 +# Append the considered member of the sequence to the end of the sequence: +#*     1, 1, 2, 1, 3, 2 +# Consider the next member of the series, (the fourth member i.e. 1) -Expanding another loop we get: - -7. Sum the considered member of the sequence and its precedent, (2 + 1) = 3, and append it to the end of the sequence: -* 1, 1, 2, 1, 3 -8. Append the considered member of the sequence to the end of the sequence: -* 1, 1, 2, 1, 3, 2 -9. Consider the next member of the series, (the fourth member i.e. 1) ;The task is to: -# Create a function/method/subroutine/procedure/... to generate the Stern-Brocot sequence of integers using the method outlined above. -# Show the first fifteen members of the sequence. (This should be: 1, 1, 2, 1, 3, 2, 3, 1, 4, 3, 5, 2, 5, 3, 4) -# Show the (1-based) index of where the numbers 1-to-10 first appears in the sequence. -# Show the (1-based) index of where the number 100 first appears in the sequence. -# Check that the greatest common divisor of all the two consecutive members of the series up to the 1000th member, is always one. -Show your output on the page. +* Create a function/method/subroutine/procedure/... to generate the Stern-Brocot sequence of integers using the method outlined above. +* Show the first fifteen members of the sequence. (This should be: 1, 1, 2, 1, 3, 2, 3, 1, 4, 3, 5, 2, 5, 3, 4) +* Show the (1-based) index of where the numbers 1-to-10 first appears in the sequence. +* Show the (1-based) index of where the number 100 first appears in the sequence. +* Check that the greatest common divisor of all the two consecutive members of the series up to the 1000th member, is always one. + +
    Show your output on this page. + ;Ref: * [https://www.youtube.com/watch?v=DpwUVExX27E Infinite Fractions - Numberphile] (Video). * [http://www.ams.org/samplings/feature-column/fcarc-stern-brocot Trees, Teeth, and Time: The mathematics of clock making]. * [https://oeis.org/A002487 A002487] The On-Line Encyclopedia of Integer Sequences. + ;Related Tasks: * [[Continued fraction/Arithmetic]] +

    diff --git a/Task/Stern-Brocot-sequence/AutoHotkey/stern-brocot-sequence.ahk b/Task/Stern-Brocot-sequence/AutoHotkey/stern-brocot-sequence.ahk new file mode 100644 index 0000000000..9c744af2cf --- /dev/null +++ b/Task/Stern-Brocot-sequence/AutoHotkey/stern-brocot-sequence.ahk @@ -0,0 +1,77 @@ +Found := FindOneToX(100), FoundList := "" +Loop, 10 + FoundList .= "First " A_Index " found at " Found[A_Index] "`n" +MsgBox, 64, Stern-Brocot Sequence + , % "First 15: " FirstX(15) "`n" + . FoundList + . "First 100 found at " Found[100] "`n" + . "GCDs of all two consecutive members are " (GCDsUpToXAreOne(1000) ? "" : "not ") "one." +return + +class SternBrocot +{ + __New() + { + this[1] := 1 + this[2] := 1 + this.Consider := 2 + } + + InsertPair() + { + n := this.Consider + this.Push(this[n] + this[n - 1], this[n]) + this.Consider++ + } +} + +; Show the first fifteen members of the sequence. (This should be: 1, 1, 2, 1, 3, 2, 3, 1, 4, 3, +; 5, 2, 5, 3, 4) +FirstX(x) +{ + SB := new SternBrocot() + while SB.MaxIndex() < x + SB.InsertPair() + Loop, % x + Out .= SB[A_Index] ", " + return RTrim(Out, " ,") +} + +; Show the (1-based) index of where the numbers 1-to-10 first appears in the sequence. +; Show the (1-based) index of where the number 100 first appears in the sequence. +FindOneToX(x) +{ + SB := new SternBrocot(), xRequired := x, Found := [] + while xRequired > 0 ; While the count of numbers yet to be found is > 0. + { + Loop, 2 ; Consider the second last member and then the last member. + { + n := SB[i := SB.MaxIndex() - 2 + A_Index] + ; If number (n) has not been found yet, and it is less than the maximum number to + ; find (x), record the index (i) and decrement the count of numbers yet to be found. + if (Found[n] = "" && n <= x) + Found[n] := i, xRequired-- + } + SB.InsertPair() ; Insert the two members that will be checked next. + } + return Found +} + +; Check that the greatest common divisor of all the two consecutive members of the series up to +; the 1000th member, is always one. +GCDsUpToXAreOne(x) +{ + SB := new SternBrocot() + while SB.MaxIndex() < x + SB.InsertPair() + Loop, % x - 1 + if GCD(SB[A_Index], SB[A_Index + 1]) > 1 + return 0 + return 1 +} + +GCD(a, b) { + while b + b := Mod(a | 0x0, a := b) + return a +} diff --git a/Task/Stern-Brocot-sequence/Clojure/stern-brocot-sequence.clj b/Task/Stern-Brocot-sequence/Clojure/stern-brocot-sequence-1.clj similarity index 100% rename from Task/Stern-Brocot-sequence/Clojure/stern-brocot-sequence.clj rename to Task/Stern-Brocot-sequence/Clojure/stern-brocot-sequence-1.clj diff --git a/Task/Stern-Brocot-sequence/Clojure/stern-brocot-sequence-2.clj b/Task/Stern-Brocot-sequence/Clojure/stern-brocot-sequence-2.clj new file mode 100644 index 0000000000..bc7003fd58 --- /dev/null +++ b/Task/Stern-Brocot-sequence/Clojure/stern-brocot-sequence-2.clj @@ -0,0 +1,32 @@ +(ns test-p.core) +(defn gcd + "(gcd a b) computes the greatest common divisor of a and b." + [a b] + (if (zero? b) + a + (recur b (mod a b)))) + +(defn stern-brocat-next [p] + " p is the block of the sequence we are using to compute the next block + This routine computes the next block " + (into [] (concat (rest p) [(+ (first p) (second p))] [(second p)]))) + +(defn seq-stern-brocat + ([] (seq-stern-brocat [1 1])) + ([p] (lazy-seq (cons (first p) + (seq-stern-brocat (stern-brocat-next p)))))) + +; First 15 elements +(println (take 15 (seq-stern-brocat))) + +; Where numbers 1 to 10 first appear +(doseq [n (concat (range 1 11) [100])] + (println "The first appearnce of" n "is at index" (some (fn [[i k]] (when (= k n) (inc i))) + (map-indexed vector (seq-stern-brocat))))) + +;; Check that gcd between 1st 1000 consecutive elements equals 1 +; Create cosecutive pairs of 1st 1000 elements +(def one-thousand-pairs (take 1000 (partition 2 1 (seq-stern-brocat)))) +; Check every pair has a gcd = 1 +(println (every? (fn [[ith ith-plus-1]] (= (gcd ith ith-plus-1) 1)) + one-thousand-pairs)) diff --git a/Task/Stern-Brocot-sequence/Elixir/stern-brocot-sequence.elixir b/Task/Stern-Brocot-sequence/Elixir/stern-brocot-sequence.elixir new file mode 100644 index 0000000000..ccb499c69b --- /dev/null +++ b/Task/Stern-Brocot-sequence/Elixir/stern-brocot-sequence.elixir @@ -0,0 +1,28 @@ +defmodule SternBrocot do + def sequence do + Stream.unfold({0,{1,1}}, fn {i,acc} -> + a = elem(acc, i) + b = elem(acc, i+1) + {a, {i+1, Tuple.append(acc, a+b) |> Tuple.append(b)}} + end) + end + + def task do + IO.write "First fifteen members of the sequence:\n " + IO.inspect Enum.take(sequence, 15) + Enum.each(Enum.concat(1..10, [100]), fn n -> + i = Enum.find_index(sequence, &(&1==n)) + 1 + IO.puts "#{n} first appears at #{i}" + end) + Enum.take(sequence, 1000) + |> Enum.chunk(2,1) + |> Enum.all?(fn [a,b] -> gcd(a,b) == 1 end) + |> if(do: "All GCD's are 1", else: "Whoops, not all GCD's are 1!") + |> IO.puts + end + + defp gcd(a,0), do: abs(a) + defp gcd(a,b), do: gcd(b, rem(a,b)) +end + +SternBrocot.task diff --git a/Task/Stern-Brocot-sequence/Java/stern-brocot-sequence.java b/Task/Stern-Brocot-sequence/Java/stern-brocot-sequence-1.java similarity index 100% rename from Task/Stern-Brocot-sequence/Java/stern-brocot-sequence.java rename to Task/Stern-Brocot-sequence/Java/stern-brocot-sequence-1.java diff --git a/Task/Stern-Brocot-sequence/Java/stern-brocot-sequence-2.java b/Task/Stern-Brocot-sequence/Java/stern-brocot-sequence-2.java new file mode 100644 index 0000000000..0c71fb259b --- /dev/null +++ b/Task/Stern-Brocot-sequence/Java/stern-brocot-sequence-2.java @@ -0,0 +1,63 @@ +import java.awt.*; +import javax.swing.*; + +public class SternBrocot extends JPanel { + + public SternBrocot() { + setPreferredSize(new Dimension(800, 500)); + setFont(new Font("Arial", Font.PLAIN, 18)); + setBackground(Color.white); + } + + private void drawTree(int n1, int d1, int n2, int d2, + int x, int y, int gap, int lvl, Graphics2D g) { + + if (lvl == 0) + return; + + // mediant + int numer = n1 + n2; + int denom = d1 + d2; + + if (lvl > 1) { + g.drawLine(x + 5, y + 4, x - gap + 5, y + 124); + g.drawLine(x + 5, y + 4, x + gap + 5, y + 124); + } + + g.setColor(getBackground()); + g.fillRect(x - 10, y - 15, 35, 40); + + g.setColor(getForeground()); + g.drawString(String.valueOf(numer), x, y); + g.drawString("_", x, y + 2); + g.drawString(String.valueOf(denom), x, y + 22); + + drawTree(n1, d1, numer, denom, x - gap, y + 120, gap / 2, lvl - 1, g); + drawTree(numer, denom, n2, d2, x + gap, y + 120, gap / 2, lvl - 1, g); + } + + @Override + public void paintComponent(Graphics gg) { + super.paintComponent(gg); + Graphics2D g = (Graphics2D) gg; + g.setRenderingHint(RenderingHints.KEY_ANTIALIASING, + RenderingHints.VALUE_ANTIALIAS_ON); + + int w = getWidth(); + + drawTree(0, 1, 1, 0, w / 2, 50, w / 4, 4, g); + } + + public static void main(String[] args) { + SwingUtilities.invokeLater(() -> { + JFrame f = new JFrame(); + f.setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE); + f.setTitle("Stern-Brocot Tree"); + f.setResizable(false); + f.add(new SternBrocot(), BorderLayout.CENTER); + f.pack(); + f.setLocationRelativeTo(null); + f.setVisible(true); + }); + } +} diff --git a/Task/Stern-Brocot-sequence/Lua/stern-brocot-sequence.lua b/Task/Stern-Brocot-sequence/Lua/stern-brocot-sequence.lua new file mode 100644 index 0000000000..a79b03dbd0 --- /dev/null +++ b/Task/Stern-Brocot-sequence/Lua/stern-brocot-sequence.lua @@ -0,0 +1,49 @@ +-- Task 1 +function sternBrocot (n) + local sbList, pos, c = {1, 1}, 2 + repeat + c = sbList[pos] + table.insert(sbList, c + sbList[pos - 1]) + table.insert(sbList, c) + pos = pos + 1 + until #sbList >= n + return sbList +end + +-- Return index in table 't' of first value matching 'v' +function findFirst (t, v) + for key, value in pairs(t) do + if v then + if value == v then return key end + else + if value ~= 0 then return key end + end + end + return nil +end + +-- Return greatest common divisor of 'x' and 'y' +function gcd (x, y) + if y == 0 then + return math.abs(x) + else + return gcd(y, x % y) + end +end + +-- Check GCD of adjacent values in 't' up to 1000 is always 1 +function task5 (t) + for pos = 1, 1000 do + if gcd(t[pos], t[pos + 1]) ~= 1 then return "FAIL" end + end + return "PASS" +end + +-- Main procedure +local sb = sternBrocot(10000) +io.write("Task 2: ") +for n = 1, 15 do io.write(sb[n] .. " ") end +print("\n\nTask 3:") +for i = 1, 10 do print("\t" .. i, findFirst(sb, i)) end +print("\nTask 4: " .. findFirst(sb, 100)) +print("\nTask 5: " .. task5(sb)) diff --git a/Task/Stern-Brocot-sequence/PARI-GP/stern-brocot-sequence.pari b/Task/Stern-Brocot-sequence/PARI-GP/stern-brocot-sequence.pari new file mode 100644 index 0000000000..6a11069b64 --- /dev/null +++ b/Task/Stern-Brocot-sequence/PARI-GP/stern-brocot-sequence.pari @@ -0,0 +1,27 @@ +\\ Stern-Brocot sequence +\\ 5/27/16 aev +SternBrocot(n)={ +my(L=List([1,1]),k=2); if(n<3,return(L)); +for(i=2,n, listput(L,L[i]+L[i-1]); if(k++>=n, break); listput(L,L[i]);if(k++>=n, break)); +return(Vec(L)); +} +\\ Find the first item in any list starting with sind index (return 0 or index). +\\ 9/11/2015 aev +findinlist(list, item, sind=1)={ +my(idx=0, ln=#list); if(ln==0 || sind<1 || sind>ln, return(0)); +for(i=sind, ln, if(list[i]==item, idx=i; break;)); return(idx); +} +{ +\\ Required tests: +my(v,j); +v=SternBrocot(15); +print1("The first 15: "); print(v); +v=SternBrocot(1200); +print1("The first i@n: "); \\print(v); +for(i=1,10, if(j=findinlist(v,i), print1(i,"@",j,", "))); +if(j=findinlist(v,100), print(100,"@",j)); +v=SternBrocot(10000); +print1("All GCDs=1?: "); +j=1; for(i=2,10000, j*=gcd(v[i-1],v[i])); +if(j==1, print("Yes"), print("No")); +} diff --git a/Task/Stern-Brocot-sequence/Pascal/stern-brocot-sequence.pascal b/Task/Stern-Brocot-sequence/Pascal/stern-brocot-sequence.pascal new file mode 100644 index 0000000000..ea83954b30 --- /dev/null +++ b/Task/Stern-Brocot-sequence/Pascal/stern-brocot-sequence.pascal @@ -0,0 +1,87 @@ +program StrnBrCt; +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} +const + MaxCnt = 10835282;{ seq[i] < 65536 = high(Word) } +//MaxCnt = 500*1000*1000;{ 2Gbyte -> real 0.85 s user 0.31 } +type + tSeqdata = word;//cardinal LongWord + pSeqdata = pWord;//pcardinal pLongWord + tseq = array of tSeqdata; + +function SternBrocotCreate(size:NativeInt):tseq; +var + pSeq,pIns : pSeqdata; + PosIns : NativeInt; + sum : tSeqdata; +Begin + setlength(result,Size+1); + dec(Size); //== High(result) + pIns := @result[size];// set at end + PosIns := -size+2; // negative index campare to 0 + pSeq := @result[0]; + + sum := 1; + pSeq[0]:= sum;pSeq[1]:= sum; + repeat + pIns[PosIns+1] := sum;//append copy of considered + inc(sum,pSeq[0]); + pIns[PosIns ] := sum; + inc(pSeq); + inc(PosIns,2);sum := pSeq[1];//aka considered + until PosIns>= 0; + setlength(result,length(result)-1); +end; + +function FindIndex(const s:tSeq;value:tSeqdata):NativeInt; +Begin + result := 0; + while result <= High(s) do + Begin + if s[result] = value then + EXIT(result+1); + inc(result); + end; +end; + +function gcd_iterative(u, v: NativeInt): NativeInt; +//http://rosettacode.org/wiki/Greatest_common_divisor#Pascal_.2F_Delphi_.2F_Free_Pascal +var + t: NativeInt; +begin + while v <> 0 do begin + t := u;u := v;v := t mod v; + end; + gcd_iterative := abs(u); +end; + +var + seq : tSeq; + i : nativeInt; +Begin + seq:= SternBrocotCreate(MaxCnt); +// Show the first fifteen members of the sequence. + For i := 0 to 13 do write(seq[i],',');writeln(seq[14]); +//Show the (1-based) index of where the numbers 1-to-10 first appears in the + For i := 1 to 10 do + write(i,' @ ',FindIndex(seq,i),','); + writeln(#8#32); +//Show the (1-based) index of where the number 100 first appears in the sequence. + writeln(100,' @ ',FindIndex(seq,100)); +//Check that the greatest common divisor of all the two consecutive members of the series up to the 1000th member, is always one. + i := 999; + if i > High(seq) then + i := High(seq); + Repeat + IF gcd_iterative(seq[i],seq[i+1]) <>1 then + Begin + writeln(' failure at ',i+1,' ',seq[i],' ',seq[i+1]); + BREAK; + end; + dec(i); + until i <0; + IF i< 0 then + writeln('GCD-test is O.K.'); + setlength(seq,0); +end. diff --git a/Task/Stern-Brocot-sequence/Perl-6/stern-brocot-sequence.pl6 b/Task/Stern-Brocot-sequence/Perl-6/stern-brocot-sequence.pl6 index 31aff75f51..0823bc6893 100644 --- a/Task/Stern-Brocot-sequence/Perl-6/stern-brocot-sequence.pl6 +++ b/Task/Stern-Brocot-sequence/Perl-6/stern-brocot-sequence.pl6 @@ -6,7 +6,7 @@ constant Stern-Brocot = flat say Stern-Brocot[^15]; for 1 .. 10, 100 -> $ix { - say "first occurrence of $ix is at index : ", 1 + Stern-Brocot.first-index($ix); + say "first occurrence of $ix is at index : ", 1 + Stern-Brocot.first($ix, :k); } say so 1 == all map ^1000: { [gcd] Stern-Brocot[$_, $_ + 1] } diff --git a/Task/Stern-Brocot-sequence/PowerShell/stern-brocot-sequence.psh b/Task/Stern-Brocot-sequence/PowerShell/stern-brocot-sequence.psh new file mode 100644 index 0000000000..fee4cfee48 --- /dev/null +++ b/Task/Stern-Brocot-sequence/PowerShell/stern-brocot-sequence.psh @@ -0,0 +1,28 @@ +# An iterative approach +function iter_sb($count = 2000) +{ + # Taken from RosettaCode GCD challenge + function Get-GCD ($x, $y) + { + if ($y -eq 0) { $x } else { Get-GCD $y ($x%$y) } + } + + $answer = @(1,1) + $index = 1 + while ($answer.Length -le $count) + { + $answer += $answer[$index] + $answer[$index - 1] + $answer += $answer[$index] + $index++ + } + + 0..14 | foreach {$answer[$_]} + + 1..10 | foreach {'Index of {0}: {1}' -f $_, ($answer.IndexOf($_) + 1)} + + 'Index of 100: {0}' -f ($answer.IndexOf(100) + 1) + + [bool] $gcd = $true + 1..999 | foreach {$gcd = $gcd -and ((Get-GCD $answer[$_] $answer[$_ - 1]) -eq 1)} + 'GCD = 1 for first 1000 members: {0}' -f $gcd +} diff --git a/Task/Stern-Brocot-sequence/REXX/stern-brocot-sequence.rexx b/Task/Stern-Brocot-sequence/REXX/stern-brocot-sequence.rexx index 5600fed28f..fed919c661 100644 --- a/Task/Stern-Brocot-sequence/REXX/stern-brocot-sequence.rexx +++ b/Task/Stern-Brocot-sequence/REXX/stern-brocot-sequence.rexx @@ -1,45 +1,44 @@ -/*REXX program gens/shows Stern─Brocot sequence, finds 1─based indices, GCDs. */ -parse arg N idx fix chk . /*get optional arguments from the C.L. */ -if N=='' | N==',' then N= 15 /* N defined? Then use the default. */ -if idx=='' | idx==',' then idx= 10 /*IDX " " " " " */ -if fix=='' | fix==',' then fix= 100 /*FIX " " " " " */ -if chk=='' | chk==',' then chk=1000 /*CHK " " " " " */ +/*REXX program generates & displays a Stern─Brocot sequence; finds 1─based indices; GCDs*/ +parse arg N idx fix chk . /*get optional arguments from the C.L. */ +if N=='' | N=="," then N= 15 /* N not defined? Then use default.*/ +if idx=='' | idx=="," then idx= 10 /*IDX " " " " " */ +if fix=='' | fix=="," then fix= 100 /*FIX " " " " " */ +if chk=='' | chk=="," then chk=1000 /*CHK " " " " " */ -say center('the first' N 'numbers in the Stern─Brocot sequence', 70, '═') -a=Stern_Brocot(N) /*invoke function to generate sequence.*/ -say a /*display the sequence to the terminal.*/ - -say; say center('the 1-based index for the first' idx "integers",70,'═') -a=Stern_Brocot(-idx) /*invoke function to generate sequence.*/ - do i=1 for idx - say 'for ' right(i,length(idx))", the index is: " wordpos(i,a) - end /*i*/ - -say; say center('the 1-based index for' fix,70,'═') -a=Stern_Brocot(-fix) /*invoke function to generate sequence.*/ +say center('the first' N "numbers in the Stern─Brocot sequence", 70, '═') +a=Stern_Brocot(N) /*invoke function to generate sequence.*/ +say a /*display the sequence to the terminal.*/ +say +say center('the 1-based index for the first' idx "integers", 70, '═') +a=Stern_Brocot(-idx) /*invoke function to generate sequence.*/ + do i=1 for idx + say 'for ' right(i,length(idx))", the index is: " wordpos(i,a) + end /*i*/ +say +say center('the 1-based index for' fix, 70, "═") +a=Stern_Brocot(-fix) /*invoke function to generate sequence.*/ say 'for ' fix", the index is: " wordpos(fix, a) +say +say center('checking if all two consecutive members have a GCD=1', 70, '═') +a=Stern_Brocot(chk) /*invoke function to generate sequence.*/ + do c=1 for chk-1; if gcd(subword(a,c,2))==1 then iterate + say 'GCD check failed at member' c"."; exit 13 + end /*c*/ -say; say center('checking if all two consecutive members have a GCD=1',70,'═') -a=Stern_Brocot(chk) /*invoke function to generate sequence.*/ - do c=1 for chk-1; if gcd(subword(a,c,2))==1 then iterate - say 'GCD check failed at member' c"."; exit 13 - end /*c*/ say '───── All ' chk " two consecutive members have a GCD of unity." -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -gcd: procedure; $=; do i=1 for arg(); $=$ arg(i); end /*arg list*/ -parse var $ x z .; if x=0 then x=z /*handle special 0 case.*/ -x=abs(x) - do j=2 to words($); y=abs(word($,j)); if y=0 then iterate - do until y==0; parse value x//y y with y x; end /*◄──heavy lifting*/ - end /*j*/ -return x -/*────────────────────────────────────────────────────────────────────────────*/ -Stern_Brocot: parse arg h 1 f; $=1 1; if h<0 then h=1e9 - else f=0; f=abs(f) - do k=2 until words($)>=h; _=word($,k); $=$ (_+word($,k-1)) _ - if f==0 then iterate; if wordpos(f,$)\==0 then leave - end /*until*/ - -if f==0 then return subword($,1,h) - return $ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +gcd: procedure; $=; do i=1 for arg(); $=$ arg(i); end /*i*/ /*arg list. */ + parse var $ x z .; if x=0 then x=z; x=abs(x) /*zero case?*/ + do j=2 to words($); y=abs(word($,j)); if y=0 then iterate /*ignore 0's*/ + do until y==0; parse value x//y y with y x; end /*heavy work*/ + end /*j*/ + return x /*return GCD*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +Stern_Brocot: parse arg h 1 f; $=1 1; if h<0 then h=1e9 + else f=0; f=abs(f) + do k=2 until words($)>=h | wordpos(f,$)\==0 + _=word($,k); $=$ (_+word($,k-1)) _; if f==0 then iterate + end /*until*/ + if f==0 then return subword($,1,h) + return $ diff --git a/Task/Stern-Brocot-sequence/Scala/stern-brocot-sequence.scala b/Task/Stern-Brocot-sequence/Scala/stern-brocot-sequence.scala new file mode 100644 index 0000000000..5041931018 --- /dev/null +++ b/Task/Stern-Brocot-sequence/Scala/stern-brocot-sequence.scala @@ -0,0 +1,18 @@ +lazy val sbSeq: Stream[BigInt] = { + BigInt("1") #:: + BigInt("1") #:: + (sbSeq zip sbSeq.tail zip sbSeq.tail). + flatMap{ case ((a,b),c) => List(a+b,c) } +} + +// Show the results +{ +println( s"First 15 members: ${(for( n <- 0 until 15 ) yield sbSeq(n)) mkString( "," )}" ) +println +for( n <- 1 to 10; pos = sbSeq.indexOf(n) + 1 ) println( s"Position of first $n is at $pos" ) +println +println( s"Position of first 100 is at ${sbSeq.indexOf(100) + 1}" ) +println +println( s"Greatest Common Divisor for first 1000 members is 1: " + + (sbSeq zip sbSeq.tail).take(1000).forall{ case (a,b) => a.gcd(b) == 1 } ) +} diff --git a/Task/String-append/00DESCRIPTION b/Task/String-append/00DESCRIPTION index a76f63c2cc..3220a6497c 100644 --- a/Task/String-append/00DESCRIPTION +++ b/Task/String-append/00DESCRIPTION @@ -1,6 +1,13 @@ -{{basic data operation}} [[Category:Simple]] +{{basic data operation}} +[[Category:Simple]] + Most languages provide a way to concatenate two string values, but some languages also provide a convenient way to append in-place to an existing string variable without referring to the variable twice. -For this task, create a string variable equal to any text value. + + +;Task: +Create a string variable equal to any text value. + Append the string variable with another string literal in the most idiomatic way, without double reference if your language supports it. Show the contents of the variable after the append operation. +

    diff --git a/Task/String-append/COBOL/string-append.cobol b/Task/String-append/COBOL/string-append.cobol new file mode 100644 index 0000000000..999aa42131 --- /dev/null +++ b/Task/String-append/COBOL/string-append.cobol @@ -0,0 +1,23 @@ + identification division. + program-id. string-append. + + data division. + working-storage section. + 01 some-string. + 05 elements pic x occurs 0 to 80 times depending on limiter. + 01 limiter usage index value 7. + 01 current usage index. + + procedure division. + append-main. + + move "Hello, " to some-string + + *> extend the limit and move using reference modification + set current to length of some-string + set limiter up by 5 + move "world" to some-string(current + 1:) + display some-string + + goback. + end program string-append. diff --git a/Task/String-append/CoffeeScript/string-append-1.coffee b/Task/String-append/CoffeeScript/string-append-1.coffee new file mode 100644 index 0000000000..636200c094 --- /dev/null +++ b/Task/String-append/CoffeeScript/string-append-1.coffee @@ -0,0 +1,5 @@ +a = "Hello, " +b = "World!" +c = a + b + +console.log c diff --git a/Task/String-append/CoffeeScript/string-append-2.coffee b/Task/String-append/CoffeeScript/string-append-2.coffee new file mode 100644 index 0000000000..6eb2d9be8b --- /dev/null +++ b/Task/String-append/CoffeeScript/string-append-2.coffee @@ -0,0 +1 @@ +console.log "Hello, ".concat "World!" diff --git a/Task/String-append/Kotlin/string-append.kotlin b/Task/String-append/Kotlin/string-append.kotlin new file mode 100644 index 0000000000..097e04def2 --- /dev/null +++ b/Task/String-append/Kotlin/string-append.kotlin @@ -0,0 +1,11 @@ +fun main(args: Array) { + var s = "a" + s += "b" + s += "c" + println(s) + println("a" + "b" + "c") + val a = "a" + val b = "b" + val c = "c" + println("$a$b$c") +} diff --git a/Task/String-append/Lua/string-append-1.lua b/Task/String-append/Lua/string-append-1.lua new file mode 100644 index 0000000000..2fee3df8a8 --- /dev/null +++ b/Task/String-append/Lua/string-append-1.lua @@ -0,0 +1,12 @@ +function string:show () + print(self) +end + +function string:append (s) + self = self .. s +end + +x = "Hi " +x:show() +x:append("there!") +x:show() diff --git a/Task/String-append/Lua/string-append-2.lua b/Task/String-append/Lua/string-append-2.lua new file mode 100644 index 0000000000..e0521cb874 --- /dev/null +++ b/Task/String-append/Lua/string-append-2.lua @@ -0,0 +1,3 @@ +x = "Hi " +x = x .. "there!" +print(x) diff --git a/Task/String-append/Maple/string-append.maple b/Task/String-append/Maple/string-append.maple new file mode 100644 index 0000000000..8c36e69be0 --- /dev/null +++ b/Task/String-append/Maple/string-append.maple @@ -0,0 +1,3 @@ +a := "Hello"; +b := cat(a, " World"); +c := `||`(a, " World"); diff --git a/Task/String-append/SNOBOL4/string-append.sno b/Task/String-append/SNOBOL4/string-append.sno new file mode 100644 index 0000000000..053e8cf718 --- /dev/null +++ b/Task/String-append/SNOBOL4/string-append.sno @@ -0,0 +1,4 @@ + s = "Hello" + s = s ", World!" + OUTPUT = s +END diff --git a/Task/String-case/00DESCRIPTION b/Task/String-case/00DESCRIPTION index 5c17e5da50..b6a37c1b40 100644 --- a/Task/String-case/00DESCRIPTION +++ b/Task/String-case/00DESCRIPTION @@ -1 +1,13 @@ -Take the string "alphaBETA", and demonstrate how to convert it to UPPER-CASE and lower-case. Use the default encoding of a string literal or plain ASCII if there is no string literal in your language. Show any additional case conversion functions (e.g. swapping case, capitalizing the first letter, etc.) that may be included in the library of your language. +;Task: +Take the string     '''alphaBETA'''     and demonstrate how to convert it to: +:::*   upper-case     and +:::*   lower-case + +
    +Use the default encoding of a string literal or plain ASCII if there is no string literal in your language. + +Show any additional case conversion functions   (e.g. swapping case, capitalizing the first letter, etc.)   that may be included in the library of your language. + + +{{Template:Strings}} +

    diff --git a/Task/String-case/Ada/string-case.ada b/Task/String-case/Ada/string-case.ada index 11ac1e10ec..52e0234392 100644 --- a/Task/String-case/Ada/string-case.ada +++ b/Task/String-case/Ada/string-case.ada @@ -1,9 +1,9 @@ -with Ada.Characters.Handling; use Ada.Characters.Handling; -with Ada.Text_Io; use Ada.Text_Io; +with Ada.Characters.Handling, Ada.Text_IO; +use Ada.Characters.Handling, Ada.Text_IO; procedure Upper_Case_String is - S : String := "alphaBETA"; + S : constant String := "alphaBETA"; begin - Put_Line(To_Upper(S)); - Put_Line(To_Lower(S)); + Put_Line (To_Upper (S)); + Put_Line (To_Lower (S)); end Upper_Case_String; diff --git a/Task/String-case/AppleScript/string-case-1.applescript b/Task/String-case/AppleScript/string-case-1.applescript new file mode 100644 index 0000000000..09daa5861b --- /dev/null +++ b/Task/String-case/AppleScript/string-case-1.applescript @@ -0,0 +1,63 @@ +use framework "Foundation" + +-- toUpperCase :: Text -> Text +on toUpperCase(str) + set ca to current application + ((ca's NSString's stringWithString:(str))'s ¬ + uppercaseStringWithLocale:(ca's NSLocale's currentLocale())) as text +end toUpperCase + +-- toLowerCase :: Text -> Text +on toLowerCase(str) + set ca to current application + ((ca's NSString's stringWithString:(str))'s ¬ + lowercaseStringWithLocale:(ca's NSLocale's currentLocale())) as text +end toLowerCase + +-- toCapitalized :: Text -> Text +on toCapitalized(str) + set ca to current application + ((ca's NSString's stringWithString:(str))'s ¬ + capitalizedStringWithLocale:(ca's NSLocale's currentLocale())) as text +end toCapitalized + + +-- TEST +on run + + -- testCase :: Handler -> String + script testCase + on lambda(f) + mReturn(f)'s lambda("alphaBETA αβγδΕΖΗΘ") + end lambda + end script + + map(testCase, {toUpperCase, toLowerCase, toCapitalized}) + +end run + + +-- GENERIC FUNCTIONS +-- 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 + +-- 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 diff --git a/Task/String-case/AppleScript/string-case-2.applescript b/Task/String-case/AppleScript/string-case-2.applescript new file mode 100644 index 0000000000..ffedee28bd --- /dev/null +++ b/Task/String-case/AppleScript/string-case-2.applescript @@ -0,0 +1 @@ +{"ALPHABETA ΑΒΓΔΕΖΗΘ", "alphabeta αβγδεζηθ", "Alphabeta Αβγδεζηθ"} diff --git a/Task/String-case/Fortran/string-case.f b/Task/String-case/Fortran/string-case-1.f similarity index 100% rename from Task/String-case/Fortran/string-case.f rename to Task/String-case/Fortran/string-case-1.f diff --git a/Task/String-case/Fortran/string-case-2.f b/Task/String-case/Fortran/string-case-2.f new file mode 100644 index 0000000000..60466b4376 --- /dev/null +++ b/Task/String-case/Fortran/string-case-2.f @@ -0,0 +1,8 @@ + SUBROUTINE UPCASE(TEXT) + CHARACTER*(*) TEXT + INTEGER I,C + DO I = 1,LEN(TEXT) + C = INDEX("abcdefghijklmnopqrstuvwxyz",TEXT(I:I)) + IF (C.GT.0) TEXT(I:I) = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"(C:C) + END DO + END diff --git a/Task/String-case/K/string-case.k b/Task/String-case/K/string-case.k new file mode 100644 index 0000000000..da3d32ba9e --- /dev/null +++ b/Task/String-case/K/string-case.k @@ -0,0 +1,7 @@ + s:"alphaBETA" + upper:{i:_ic x; :[96i; _ci i+32;_ci i]}' + upper s +"ALPHABETA" + lower s +"alphabeta" diff --git a/Task/String-case/Perl-6/string-case.pl6 b/Task/String-case/Perl-6/string-case.pl6 index 29b8127335..db8bba6ed1 100644 --- a/Task/String-case/Perl-6/string-case.pl6 +++ b/Task/String-case/Perl-6/string-case.pl6 @@ -5,5 +5,4 @@ say $word.uc; # all uppercase (method call) say $word.lc; # all lowercase say $word.tc; # first letter titlecase say $word.tclc; # first letter titlecase, rest lowercase -say $word.tcuc; # first letter titlecase, rest uppercase say $word.wordcase; # capitalize each word diff --git a/Task/String-case/PowerShell/string-case.psh b/Task/String-case/PowerShell/string-case.psh index 0dccfcfe52..94f82e072e 100644 --- a/Task/String-case/PowerShell/string-case.psh +++ b/Task/String-case/PowerShell/string-case.psh @@ -1,3 +1,6 @@ $string = 'alphaBETA' $lower = $string.ToLower() $upper = $string.ToUpper() +$title = (Get-Culture).TextInfo.ToTitleCase($string) + +$lower, $upper, $title diff --git a/Task/String-case/REXX/string-case-1.rexx b/Task/String-case/REXX/string-case-1.rexx index aef5b33588..7056abc335 100644 --- a/Task/String-case/REXX/string-case-1.rexx +++ b/Task/String-case/REXX/string-case-1.rexx @@ -1,6 +1,6 @@ -abc = "abcdefghijklmnopqrstuvwxyz" /*define all the lowercase letters*/ -abcU = translate(abc) /* " " " uppercase " */ +abc = "abcdefghijklmnopqrstuvwxyz" /*define all lowercase Latin letters.*/ +abcU = translate(abc) /* " " uppercase " " */ -x = 'alphaBETA' /*define string to a REXX variable*/ -y = translate(x) /*uppercase X and store it───► Y*/ -z = translate(x, abc, abcU) /*tran uppercase──►lowercase chars*/ +x = 'alphaBETA' /*define a string to a REXX variable. */ +y = translate(x) /*uppercase X and store it ───► Y */ +z = translate(x, abc, abcU) /*translate uppercase──►lowercase chars*/ diff --git a/Task/String-case/REXX/string-case-2.rexx b/Task/String-case/REXX/string-case-2.rexx index bf06db629c..45b52e76b1 100644 --- a/Task/String-case/REXX/string-case-2.rexx +++ b/Task/String-case/REXX/string-case-2.rexx @@ -1,5 +1,5 @@ -x = "alphaBETA" /*define string to a REXX variable*/ -parse upper var x y /*uppercase X and store it───► Y*/ -parse lower var x z /*lowercase X " " " ───► Z*/ +x = "alphaBETA" /*define a string to a REXX variable. */ +parse upper var x y /*uppercase X and store it ───► Y */ +parse lower var x z /*lowercase X " " " ───► Z */ - /*Some REXXes don't support the LOWER option for the PARSE command.*/ + /*Some REXXes don't support the LOWER option for the PARSE command.*/ diff --git a/Task/String-case/REXX/string-case-3.rexx b/Task/String-case/REXX/string-case-3.rexx index adc3e4f5f2..67c2df8321 100644 --- a/Task/String-case/REXX/string-case-3.rexx +++ b/Task/String-case/REXX/string-case-3.rexx @@ -1,6 +1,5 @@ -x = 'alphaBETA' /*define string to a REXX variable*/ -y = upper(x) /*uppercase X and store it───► Y*/ -z = lower(x) /*lowercase X " " " ───► Z*/ +x = 'alphaBETA' /*define a string to a REXX variable. */ +y = upper(x) /*uppercase X and store it ───► Y */ +z = lower(x) /*lowercase X " " " ───► Z */ - /*Some REXXes don't support the UPPER and */ - /* LOWER BIFs (built-in functions). */ + /*Some REXXes don't support the UPPER and LOWER BIFs (built-in functions).*/ diff --git a/Task/String-case/REXX/string-case-4.rexx b/Task/String-case/REXX/string-case-4.rexx index e5e3f5cd20..9b3a5b5a4a 100644 --- a/Task/String-case/REXX/string-case-4.rexx +++ b/Task/String-case/REXX/string-case-4.rexx @@ -1,5 +1,5 @@ -x = "alphaBETA" /*define string to a REXX variable*/ -y=x; upper y /*uppercase X and store it───► Y*/ -parse lower var x z /*lowercase Y " " " ───► Z*/ +x = "alphaBETA" /*define a string to a REXX variable. */ +y=x; upper y /*uppercase X and store it ───► Y */ +parse lower var x z /*lowercase Y " " " ───► Z */ - /*Some REXXes don't support the LOWER option for the PARSE command.*/ + /*Some REXXes don't support the LOWER option for the PARSE command.*/ diff --git a/Task/String-case/REXX/string-case-5.rexx b/Task/String-case/REXX/string-case-5.rexx index c65fe4a1b0..ddb16fa985 100644 --- a/Task/String-case/REXX/string-case-5.rexx +++ b/Task/String-case/REXX/string-case-5.rexx @@ -1,17 +1,18 @@ -/*REXX pgm capitalizes each word in string, maintains imbedded blanks.*/ +/*REXX program capitalizes each word in string, and maintains imbedded blanks. */ x= "alef bet gimel dalet he vav zayin het tet yod kaf lamed mem nun samekh", - "ayin pe tzadi qof resh shin tav." /*"old" spelling Hebrew letters. */ -y= capitalize(x) /*capitalize each word in string.*/ -say x /*show original string of words. */ -say y /*show the capitalized words. */ -exit /*stick a fork in it, we're done.*/ -/*───────────────────────────────────CAPITALIZE subroutine──────────────*/ -capitalize: procedure; parse arg z; $=' 'z /*prefix with a blank.*/ -abc = "abcdefghijklmnopqrstuvwxyz" /*define all lowercase letters. */ + "ayin pe tzadi qof resh shin tav." /*the "old" spelling of Hebrew letters.*/ +y= capitalize(x) /*capitalize each word in the string. */ +say x /*display the original string of words.*/ +say y /* " " capitalized words.*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +capitalize: procedure; parse arg z; $=' 'z /*prefix $ string with a blank. */ + abc = "abcdefghijklmnopqrstuvwxyz" /*define all Latin lowercase letters.*/ - do j=1 for 26 /*process each letter in alphabet*/ - _=' 'substr(abc,j,1); _U=_; upper _U /*get a lower and upper letter. */ - $ = changestr(_, $, _U) /*maybe capitalize some word(s). */ - end /*j*/ + do j=1 for 26 /*process each letter in the alphabet. */ + _=' 'substr(abc,j,1); _U=_ /*get a lowercase (Latin) letter. */ + upper _U /* " " uppercase " " */ + $=changestr(_, $, _U) /*maybe capitalize some word(s). */ + end /*j*/ -return substr($,2) /*capitalized words, -1st blank.*/ + return substr($, 2) /*return the capitalized words. */ diff --git a/Task/String-case/REXX/string-case-6.rexx b/Task/String-case/REXX/string-case-6.rexx index 4fa6939cb1..3e7fc78914 100644 --- a/Task/String-case/REXX/string-case-6.rexx +++ b/Task/String-case/REXX/string-case-6.rexx @@ -1,9 +1,9 @@ -/*REXX pgm swaps letter case of a string: lower──►upper & upper──►lower.*/ -abc = "abcdefghijklmnopqrstuvwxyz" /*define all the lowercase letters*/ -abcU = translate(abc) /* " " " uppercase " */ +/*REXX program swaps the letter case of a string: lower ──► upper & upper ──► lower.*/ +abc = "abcdefghijklmnopqrstuvwxyz" /*define all the lowercase letters. */ +abcU = translate(abc) /* " " " uppercase " */ -x = 'alphaBETA' /*define string to a REXX variable*/ -y = translate(x,abc||abcU,abcU||abc) /*swap case of X store it ───► Y*/ +x = 'alphaBETA' /*define a string to a REXX variable. */ +y = translate(x, abc || abcU, abcU || abc) /*swap case of X and store it ───► Y */ say x say y - /*stick a fork in it, we're done.*/ + /*stick a fork in it, we're all done. */ diff --git a/Task/String-comparison/00DESCRIPTION b/Task/String-comparison/00DESCRIPTION index 8586c1afca..4990ca8f66 100644 --- a/Task/String-comparison/00DESCRIPTION +++ b/Task/String-comparison/00DESCRIPTION @@ -8,11 +8,16 @@ The task should demonstrate: * Comparing two strings to see if one is lexically ordered after than the other * How to achieve both case sensitive comparisons and case insensitive comparisons within the language * How the language handles comparison of numeric strings if these are not treated lexically -* Demonstrate any other kinds of string comparisons that the language provides, particularly as it relates to your type system. For example, you might demonstrate the difference between generic/polymorphic comparison and coercive/allomorphic comparison if your language supports such a distinction. +* Demonstrate any other kinds of string comparisons that the language provides, particularly as it relates to your type system.   For example, you might demonstrate the difference between generic/polymorphic comparison and coercive/allomorphic comparison if your language supports such a distinction. -Here "generic/polymorphic" comparison means that the function or operator you're using doesn't always do string comparison, but bends the actual semantics of the comparison depending on the types one or both arguments; with such an operator, you achieve string comparison only if the arguments are sufficiently string-like in type or appearance. In contrast, a "coercive/allomorphic" comparison function or operator has fixed string-comparison semantics regardless of the argument type; instead of the operator bending, it's the arguments that are forced to bend instead and behave like strings if they can, and the operator simply fails if the arguments cannot be viewed somehow as strings. A language may have one or both of these kinds of operators; see the Perl 6 entry for an example of a language with both kinds of operators. +
    +Here "generic/polymorphic" comparison means that the function or operator you're using doesn't always do string comparison, but bends the actual semantics of the comparison depending on the types one or both arguments; with such an operator, you achieve string comparison only if the arguments are sufficiently string-like in type or appearance. -'''See also:''' -* [[Integer comparison]] -* [[String matching]] -* [[Compare a list of strings]] +In contrast, a "coercive/allomorphic" comparison function or operator has fixed string-comparison semantics regardless of the argument type;   instead of the operator bending, it's the arguments that are forced to bend instead and behave like strings if they can,   and the operator simply fails if the arguments cannot be viewed somehow as strings.   A language may have one or both of these kinds of operators;   see the Perl 6 entry for an example of a language with both kinds of operators. + + +;Related tasks: +*   [[Integer comparison]] +*   [[String matching]] +*   [[Compare a list of strings]] +

    diff --git a/Task/String-comparison/ALGOL-68/string-comparison.alg b/Task/String-comparison/ALGOL-68/string-comparison.alg new file mode 100644 index 0000000000..c2f5c69800 --- /dev/null +++ b/Task/String-comparison/ALGOL-68/string-comparison.alg @@ -0,0 +1,67 @@ +STRING a := "abc ", b := "ABC "; + +# when comparing strings, Algol 68 ignores trailing blanks # +# so e.g. "a" = "a " is true # + +# test procedure, prints message if condition is TRUE # +PROC test = ( BOOL condition, STRING message )VOID: + IF condition THEN print( ( message, newline ) ) FI; + +# equality? # +test( a = b, "a = b" ); +# inequality? # +test( a /= b, "a not = b" ); + +# lexically ordered before? # +test( a < b, "a < b" ); + +# lexically ordered after? # +test( a > b, "a > b" ); + +# Algol 68's builtin string comparison operators are case-sensitive. # +# To perform case insensitive comparisons, procedures or operators # +# would need to be written # +# e.g. # + +# compare two strings, ignoring case # +# Note the "to upper" PROC is an Algol 68G extension # +# It could be written in standard Algol 68 (assuming ASCII) as e.g. # +# PROC to upper = ( CHAR c )CHAR: # +# IF c < "a" OR c > "z" THEN c # +# ELSE REPR ( ( ABS c - ABS "a" ) + ABS "A" ) FI; # +PROC caseless comparison = ( STRING a, b )INT: + BEGIN + INT a max = UPB a, b max = UPB b; + INT a pos := LWB a, b pos := LWB b; + INT result := 0; + WHILE result = 0 + AND ( a pos <= a max OR b pos <= b max ) + DO + CHAR a char := to upper( IF a pos <= a max THEN a[ a pos ] ELSE " " FI ); + CHAR b char := to upper( IF b pos <= b max THEN b[ b pos ] ELSE " " FI ); + result := ABS a char - ABS b char; + a pos +:= 1; + b pos +:= 1 + OD; + IF result < 0 THEN -1 ELIF result > 0 THEN 1 ELSE 0 FI + END ; # caseless comparison # + +# compare two strings for equality, ignoring case # +PROC equal ignoring case = ( STRING a, b )BOOL: caseless comparison( a, b ) = 0; +# similar procedures for inequality and lexical ording ... # + +test( equal ignoring case( a, b ), "a = b (ignoring case)" ); + + +# Algol 68 is strongly typed - strings cannot be compared to e.g. integers # +# unless procedures or operators are written, e.g. # +# e.g. OP = = ( STRING a, INT b )BOOL: a = whole( b, 0 ); # +# OP = = ( INT a, STRING b )BOOL: b = a; # +# etc. # + +# Algol 68 also has <= and >= comparison operators for testing for # +# "lexically before or equal" and "lexically after or equal" # +test( a <= b, "a <= b" ); +test( a >= b, "a >= b" ); + +# there are no other forms of string comparison builtin to Algol 68 # diff --git a/Task/String-comparison/ALGOL-W/string-comparison.alg b/Task/String-comparison/ALGOL-W/string-comparison.alg new file mode 100644 index 0000000000..b16d3f7439 --- /dev/null +++ b/Task/String-comparison/ALGOL-W/string-comparison.alg @@ -0,0 +1,67 @@ +begin + string(10) a; + string(12) b; + + a := "abc"; + b := "ABC"; + + % when comparing strings, Algol W ignores trailing blanks % + % so e.g. "a" = "a " is true % + + % equality? % + if a = b then write( "a = b" ); + % inequality? % + if a not = b then write( "a not = b" ); + + % lexically ordered before? % + if a < b then write( "a < b" ); + + % lexically ordered after? % + if a > b then write( "a > b" ); + + % Algol W string comparisons are case-sensitive. To perform case % + % insensitive comparisons, procedures would need to be written % + % e.g. as in the following block (assuming the character set is ASCII) % + begin + + % convert a character to upper-case % + integer procedure toupper( integer value c ) ; + if c < decode( "a" ) or c > decode( "z" ) then c + else ( c - decode( "a" ) ) + decode( "A" ); + + % compare two strings, ignoring case % + % note that strings can be at most 256 characters long in Algol W % + integer procedure caselessComparison ( string(256) value a, b ) ; + begin + integer comparisonResult, pos; + comparisonResult := pos := 0; + while pos < 256 and comparisonResult = 0 do begin + comparisonResult := toupper( decode( a(pos//1) ) ) + - toupper( decode( b(pos//1) ) ); + pos := pos + 1 + end; + if comparisonResult < 0 then -1 + else if comparisonResult > 0 then 1 + else 0 + end caselessComparison ; + + % compare two strings for equality, ignoring case % + logical procedure equalIgnoringCase ( string(256) value a, b ) ; + ( caselessComparison( a, b ) = 0 ); + + % similar procedures for inequality and lexical ording ... % + + if equalIgnoringCase( a, b ) then write( "a = b (ignoring case)" ) + end caselessComparison ; + + % Algol W is strongly typed - strings cannot be compared to e.g. integers % + % e.g. "if a = 23 then ..." would be a syntax error % + + % Algol W also has <= and >= comparison operators for testing for % + % "lexically before or equal" and "lexically after or equal" % + if a <= b then write( "a <= b" ); + if a >= b then write( "a >= b" ); + + % there are no other forms of string comparison builtin to Algol W % + +end. diff --git a/Task/String-comparison/Ada/string-comparison.ada b/Task/String-comparison/Ada/string-comparison.ada index 47a855ef43..113476e6e2 100644 --- a/Task/String-comparison/Ada/string-comparison.ada +++ b/Task/String-comparison/Ada/string-comparison.ada @@ -2,28 +2,27 @@ with Ada.Text_IO, Ada.Strings.Equal_Case_Insensitive; procedure String_Compare is - procedure Print_Comparison (A, B: String) is - use Ada.Text_IO; - Function eq(Left, Right : String) return Boolean - renames Ada.Strings.Equal_Case_Insensitive; + procedure Print_Comparison (A, B : String) is begin - Put_Line - ( """" & A & """ and """ & B & """: " & - (if A = B then "equal, " elsif eq(A,B) - then "case-insensitive-equal, " else "not equal at all, ") & - (if A /= B then "/=, " else "") & - (if A < B then "before, " else "") & - (if A > B then "after, " else "") & - (if A <= B then "<=, " else "(not <=), ") & "and " & - (if A >= B then ">=. " else "(not >=).") ); + Ada.Text_IO.Put_Line + ("""" & A & """ and """ & B & """: " & + (if A = B then + "equal, " + elsif Ada.Strings.Equal_Case_Insensitive (A, B) then + "case-insensitive-equal, " + else "not equal at all, ") & + (if A /= B then "/=, " else "") & + (if A < B then "before, " else "") & + (if A > B then "after, " else "") & + (if A <= B then "<=, " else "(not <=), ") & + (if A >= B then ">=. " else "(not >=).")); end Print_Comparison; - begin - Print_Comparison("this", "that"); - Print_Comparison("that", "this"); - Print_Comparison("THAT", "That"); - Print_Comparison("this", "This"); - Print_Comparison("this", "this"); - Print_Comparison("the", "there"); - Print_Comparison("there", "the"); + Print_Comparison ("this", "that"); + Print_Comparison ("that", "this"); + Print_Comparison ("THAT", "That"); + Print_Comparison ("this", "This"); + Print_Comparison ("this", "this"); + Print_Comparison ("the", "there"); + Print_Comparison ("there", "the"); end String_Compare; diff --git a/Task/String-comparison/BBC-BASIC/string-comparison.bbc b/Task/String-comparison/BBC-BASIC/string-comparison.bbc new file mode 100644 index 0000000000..eab56bc618 --- /dev/null +++ b/Task/String-comparison/BBC-BASIC/string-comparison.bbc @@ -0,0 +1,29 @@ +REM >strcomp +shav$ = "Shaw, George Bernard" +shakes$ = "Shakespeare, William" +: +REM test equality +IF shav$ = shakes$ THEN PRINT "The two strings are equal" ELSE PRINT "The two strings are not equal" +: +REM test inequality +IF shav$ <> shakes$ THEN PRINT "The two strings are unequal" ELSE PRINT "The two strings are not unequal" +: +REM test lexical ordering +IF shav$ > shakes$ THEN PRINT shav$; " is lexically higher than "; shakes$ ELSE PRINT shav$; " is not lexically higher than "; shakes$ +IF shav$ < shakes$ THEN PRINT shav$; " is lexically lower than "; shakes$ ELSE PRINT shav$; " is not lexically lower than "; shakes$ +REM the >= and <= operators can also be used, & behave as expected +: +REM string comparison is case-sensitive by default, and BBC BASIC +REM does not provide built-in functions to convert to all upper +REM or all lower case; but it is easy enough to define one +: +IF FN_upper(shav$) = FN_upper(shakes$) THEN PRINT "The two strings are equal (disregarding case)" ELSE PRINT "The two strings are not equal (even disregarding case)" +END +: +DEF FN_upper(s$) +LOCAL i%, ns$ +ns$ = "" +FOR i% = 1 TO LEN s$ + IF ASC(MID$(s$, i%, 1)) >= ASC "a" AND ASC(MID$(s$, i%, 1)) <= ASC "z" THEN ns$ += CHR$(ASC(MID$(s$, i%, 1)) - &20) ELSE ns$ += MID$(s$, i%, 1) +NEXT += ns$ diff --git a/Task/String-comparison/PureBasic/string-comparison.purebasic b/Task/String-comparison/PureBasic/string-comparison.purebasic new file mode 100644 index 0000000000..5cfb9798c3 --- /dev/null +++ b/Task/String-comparison/PureBasic/string-comparison.purebasic @@ -0,0 +1,37 @@ +Macro StrTest(Check,tof) + Print("Test "+Check+#TAB$) + If tof=1 : PrintN("true") : Else : PrintN("false") : EndIf +EndMacro + +Procedure.b StrBool_eq(a$,b$) : ProcedureReturn Bool(a$=b$) : EndProcedure +Procedure.b StrBool_n_eq(a$,b$) : ProcedureReturn Bool(a$<>b$) : EndProcedure +Procedure.b StrBool_a(a$,b$) : ProcedureReturn Bool(a$>b$) : EndProcedure +Procedure.b StrBool_b(a$,b$) : ProcedureReturn Bool(a$Val(b$)) : EndProcedure +Procedure.b NumBool_a(a$,b$) : ProcedureReturn Bool(Val(a$)>Val(b$)) : EndProcedure +Procedure.b NumBool_b(a$,b$) : ProcedureReturn Bool(Val(a$)b ",StrBool_n_eq(a$,b$)) : Else : StrTest(" a<>b ",NumBool_n_eq(a$,b$)) : EndIf + If Not num : StrTest(" a>b ",StrBool_a(a$,b$)) : Else : StrTest(" a>b ",NumBool_a(a$,b$)) : EndIf + If Not num : StrTest(" a ", " +> "world" diff --git a/Task/String-concatenation/Kotlin/string-concatenation.kotlin b/Task/String-concatenation/Kotlin/string-concatenation.kotlin new file mode 100644 index 0000000000..10af45d83c --- /dev/null +++ b/Task/String-concatenation/Kotlin/string-concatenation.kotlin @@ -0,0 +1,8 @@ +fun main(args: Array) { + val s1 = "James" + val s2 = "Bond" + println(s1) + println(s2) + val s3 = s1 + " " + s2 + println(s3) +} diff --git a/Task/String-interpolation--included-/JavaScript/string-interpolation--included-.js b/Task/String-interpolation--included-/JavaScript/string-interpolation--included--1.js similarity index 100% rename from Task/String-interpolation--included-/JavaScript/string-interpolation--included-.js rename to Task/String-interpolation--included-/JavaScript/string-interpolation--included--1.js diff --git a/Task/String-interpolation--included-/JavaScript/string-interpolation--included--2.js b/Task/String-interpolation--included-/JavaScript/string-interpolation--included--2.js new file mode 100644 index 0000000000..440523490f --- /dev/null +++ b/Task/String-interpolation--included-/JavaScript/string-interpolation--included--2.js @@ -0,0 +1,3 @@ +// ECMAScript 6 +var X = "little"; +var replaced = `Mary had a ${X} lamb`; diff --git a/Task/String-interpolation--included-/Rust/string-interpolation--included-.rust b/Task/String-interpolation--included-/Rust/string-interpolation--included-.rust new file mode 100644 index 0000000000..53e6dcf99c --- /dev/null +++ b/Task/String-interpolation--included-/Rust/string-interpolation--included-.rust @@ -0,0 +1,7 @@ +fn main() { + println!("Mary had a {} lamb", "little"); + // You can specify order + println!("{1} had a {0} lamb", "little", "Mary"); + // Or named arguments if you prefer + println!("{name} had a {adj} lamb", adj="little", name="Mary"); +} diff --git a/Task/String-length/00DESCRIPTION b/Task/String-length/00DESCRIPTION index e2de335fec..56f68cdf9c 100644 --- a/Task/String-length/00DESCRIPTION +++ b/Task/String-length/00DESCRIPTION @@ -1,13 +1,25 @@ {{omit from|GUISS|Can use Microsoft Word document properties, but this might not be accurate}} {{omit from|Openscad}} -In this task, the goal is to find the character and byte length of a string. -This means encodings like [[UTF-8]] need to be handled properly, as there is not necessarily a one-to-one relationship between bytes and characters.
    + +;Task: +Find the character and byte length of a string. + +This means encodings like [[UTF-8]] need to be handled properly, as there is not necessarily a one-to-one relationship between bytes and characters. + By ''character'', we mean an individual Unicode ''code point'', not a user-visible ''grapheme'' containing combining characters. + For example, the character length of "møøse" is 5 but the byte length is 7 in UTF-8 and 10 in UTF-16. Non-BMP code points (those between 0x10000 and 0x10FFFF) must also be handled correctly: answers should produce actual character counts in code points, not in code unit counts. + Therefore a string like "𝔘𝔫𝔦𝔠𝔬𝔡𝔢" (consisting of the 7 Unicode characters U+1D518 U+1D52B U+1D526 U+1D520 U+1D52C U+1D521 U+1D522) is 7 characters long, '''not''' 14 UTF-16 code units; and it is 28 bytes long whether encoded in UTF-8 or in UTF-16. Please mark your examples with ===Character Length=== or ===Byte Length===. -If your language is capable of providing the string length in graphemes, mark those examples with ===Grapheme Length===.
    + +If your language is capable of providing the string length in graphemes, mark those examples with ===Grapheme Length===. + For example, the string "J̲o̲s̲é̲" ("J\x{332}o\x{332}s\x{332}e\x{301}\x{332}") has 4 user-visible graphemes, 9 characters (code points), and 14 bytes when encoded in UTF-8. +

    + +{{Template:Strings}} +

    diff --git a/Task/String-length/360-Assembly/string-length.360 b/Task/String-length/360-Assembly/string-length.360 new file mode 100644 index 0000000000..765c8d9cdc --- /dev/null +++ b/Task/String-length/360-Assembly/string-length.360 @@ -0,0 +1,25 @@ +* String length 06/07/2016 +LEN CSECT + USING LEN,15 base register + LA 1,L'C length of C + XDECO 1,PG + XPRNT PG,12 + LA 1,L'H length of H + XDECO 1,PG + XPRNT PG,12 + LA 1,L'F length of F + XDECO 1,PG + XPRNT PG,12 + LA 1,L'D length of D + XDECO 1,PG + XPRNT PG,12 + LA 1,L'PG length of PG + XDECO 1,PG + XPRNT PG,12 + BR 14 exit length +C DS C character 1 +H DS H half word 2 +F DS F full word 4 +D DS D double word 8 +PG DS CL12 string 12 + END LEN diff --git a/Task/String-length/Elena/string-length-1.elena b/Task/String-length/Elena/string-length-1.elena new file mode 100644 index 0000000000..731a372b4e --- /dev/null +++ b/Task/String-length/Elena/string-length-1.elena @@ -0,0 +1,6 @@ + #var s := "Hello, world!". // UTF-8 literal + #var ws := "Привет мир!"w. // UTF-16 literal + + #var s_length := s length. // Number of UTF-8 characters + #var ws_length := ws length. // Number of UTF-16 characters + #var u_length := ws toArray length. //Number of UTF-32 characters diff --git a/Task/String-length/Elena/string-length-2.elena b/Task/String-length/Elena/string-length-2.elena new file mode 100644 index 0000000000..d64f613219 --- /dev/null +++ b/Task/String-length/Elena/string-length-2.elena @@ -0,0 +1,2 @@ + #var s_byte_length := s toByteArray length. // Number of bytes + #var ws_byte_length := ws toByteArray length. // Number of bytes diff --git a/Task/String-length/MIPS-Assembly/string-length.mips b/Task/String-length/MIPS-Assembly/string-length.mips new file mode 100644 index 0000000000..79bc39d224 --- /dev/null +++ b/Task/String-length/MIPS-Assembly/string-length.mips @@ -0,0 +1,21 @@ +.data + #.asciiz automatically adds the NULL terminator character, \0 for us. + string: .asciiz "Nice string you got there!" + +.text +main: + la $a1,string #load the beginning address of the string. + +loop: + lb $a2,($a1) #load byte (i.e. the char) at $a1 into $a2 + addi $a1,$a1,1 #increment $a1 + beqz $a2,exit_procedure #see if we've hit the NULL char yet + addi $a0,$a0,1 #increment counter + j loop #back to start + +exit_procedure: + li $v0,1 #set syscall to print integer + syscall + + li $v0,10 #set syscall to cleanly exit EXIT_SUCCESS + syscall diff --git a/Task/String-length/REBOL/string-length-1.rebol b/Task/String-length/REBOL/string-length-1.rebol new file mode 100644 index 0000000000..0b5e813c21 --- /dev/null +++ b/Task/String-length/REBOL/string-length-1.rebol @@ -0,0 +1,5 @@ +;; r2 +length? "møøse" + +;; r3 +length? to-binary "møøse" diff --git a/Task/String-length/REBOL/string-length-2.rebol b/Task/String-length/REBOL/string-length-2.rebol new file mode 100644 index 0000000000..47fa893ed1 --- /dev/null +++ b/Task/String-length/REBOL/string-length-2.rebol @@ -0,0 +1,2 @@ +;; r3 +length? "møøse" diff --git a/Task/String-length/REBOL/string-length.rebol b/Task/String-length/REBOL/string-length.rebol deleted file mode 100644 index ca0a77c2a5..0000000000 --- a/Task/String-length/REBOL/string-length.rebol +++ /dev/null @@ -1,2 +0,0 @@ -text: "møøse" -print rejoin ["Byte length for '" text "': " length? text] diff --git a/Task/String-length/REXX/string-length.rexx b/Task/String-length/REXX/string-length.rexx index 90dd1d9b13..02440c18a7 100644 --- a/Task/String-length/REXX/string-length.rexx +++ b/Task/String-length/REXX/string-length.rexx @@ -1,10 +1,11 @@ -/*REXX program to show lengths (in bytes/characters) for various strings*/ - /* 1 */ /*a handy over/under scale.*/ +/*REXX program displays the lengths (in bytes/characters) for various strings. */ + /* 1 */ /*a handy-dandy over/under scale.*/ /* 123456789012345 */ -hello = 'Hello, world!' ; say 'length of HELLO is ' length(hello) -happy = 'Hello, world! ☺' ; say 'length of HAPPY is ' length(happy) -jose = 'José' ; say 'length of JOSE is ' length(jose) -nill = '' ; say 'length of NILL is ' length(nill) -null = ; say 'length of NULL is ' length(null) -sum = 5+1 ; say 'length of SUM is ' length(sum) - /*stick a fork in it, we're done.*/ +hello = 'Hello, world!' ; say 'the length of HELLO is ' length(hello) +happy = 'Hello, world! ☺' ; say 'the length of HAPPY is ' length(happy) +jose = 'José' ; say 'the length of JOSE is ' length(jose) +nill = '' ; say 'the length of NILL is ' length(nill) +null = ; say 'the length of NULL is ' length(null) +sum = 5+1 ; say 'the length of SUM is ' length(sum) + /* [↑] is, of course, 6. */ + /*stick a fork in it, we're done.*/ diff --git a/Task/String-matching/00DESCRIPTION b/Task/String-matching/00DESCRIPTION index 11d020457a..8728d703ab 100644 --- a/Task/String-matching/00DESCRIPTION +++ b/Task/String-matching/00DESCRIPTION @@ -1,11 +1,16 @@ - {{basic data operation}} -[[Category: String manipulation]] [[Category:Simple]] -Given two strings, demonstrate the following 3 types of matchings: +{{basic data operation}} +[[Category: String manipulation]] +[[Category:Simple]] -# Determining if the first string starts with second string -# Determining if the first string contains the second string at any location -# Determining if the first string ends with the second string +;Task: +Given two strings, demonstrate the following three types of string matching: +::#   Determining if the first string starts with second string +::#   Determining if the first string contains the second string at any location +::#   Determining if the first string ends with the second string + +
    Optional requirements: -# Print the location of the match for part 2 -# Handle multiple occurrences of a string for part 2. +::#   Print the location of the match for part 2 +::#   Handle multiple occurrences of a string for part 2. +

    diff --git a/Task/String-matching/Elixir/string-matching.elixir b/Task/String-matching/Elixir/string-matching.elixir index 1a1deaa6b7..360f4b60ec 100644 --- a/Task/String-matching/Elixir/string-matching.elixir +++ b/Task/String-matching/Elixir/string-matching.elixir @@ -7,12 +7,22 @@ String.starts_with?(s1, s3) String.starts_with?(s2, s3) # => false +String.contains?(s1, s3) +# => true +String.contains?(s2, s3) +# => true + String.ends_with?(s1, s3) # => false String.ends_with?(s2, s3) # => true -String.contains?(s1, s3) -# => true -String.contains?(s2, s3) -# => true + +# Optional requirements: +Regex.run(~r/#{s3}/, s1, return: :index) +# => [{0, 2}] +Regex.run(~r/#{s3}/, s2, return: :index) +# => [{2, 2}] + +Regex.scan(~r/#{s3}/, "abcabc", return: :index) +# => [[{0, 2}], [{3, 2}]] diff --git a/Task/String-matching/Julia/string-matching.julia b/Task/String-matching/Julia/string-matching.julia index 24e8098397..c7737954c6 100644 --- a/Task/String-matching/Julia/string-matching.julia +++ b/Task/String-matching/Julia/string-matching.julia @@ -1,6 +1,6 @@ -begins_with("abcd","ab") #returns true +startswith("abcd","ab") #returns true search("abcd","ab") #returns 1:2, indices range where string was found -ends_with("abcd","zn") #returns false +endswith("abcd","zn") #returns false ismatch(r"ab","abcd") #returns true where 1st arg is regex string julia>for r in each_match(r"ab","abab") println(r.offset) diff --git a/Task/String-matching/Perl-6/string-matching-1.pl6 b/Task/String-matching/Perl-6/string-matching-1.pl6 new file mode 100644 index 0000000000..ee5dab13f4 --- /dev/null +++ b/Task/String-matching/Perl-6/string-matching-1.pl6 @@ -0,0 +1,3 @@ +$haystack.starts-with($needle) # True if $haystack starts with $needle +$haystack.contains($needle) # True if $haystack contains $needle +$haystack.ends-with($needle) # True if $haystack ends with $needle diff --git a/Task/String-matching/Perl-6/string-matching-2.pl6 b/Task/String-matching/Perl-6/string-matching-2.pl6 new file mode 100644 index 0000000000..939b1b5ed5 --- /dev/null +++ b/Task/String-matching/Perl-6/string-matching-2.pl6 @@ -0,0 +1,3 @@ +so $haystack ~~ /^ $needle / # True if $haystack starts with $needle +so $haystack ~~ / $needle / # True if $haystack contains $needle +so $haystack ~~ / $needle $/ # True if $haystack ends with $needle diff --git a/Task/String-matching/Perl-6/string-matching-3.pl6 b/Task/String-matching/Perl-6/string-matching-3.pl6 new file mode 100644 index 0000000000..1aebee0fe8 --- /dev/null +++ b/Task/String-matching/Perl-6/string-matching-3.pl6 @@ -0,0 +1,2 @@ +substr($haystack, 0, $needle.chars) eq $needle # True if $haystack starts with $needle +substr($haystack, *-$needle.chars) eq $needle # True if $haystack ends with $needle diff --git a/Task/String-matching/Perl-6/string-matching-4.pl6 b/Task/String-matching/Perl-6/string-matching-4.pl6 new file mode 100644 index 0000000000..b62d3c66ad --- /dev/null +++ b/Task/String-matching/Perl-6/string-matching-4.pl6 @@ -0,0 +1 @@ +$haystack.match($needle, :g)».from; # List of all positions where $needle appears in $haystack diff --git a/Task/String-matching/Perl-6/string-matching.pl6 b/Task/String-matching/Perl-6/string-matching.pl6 deleted file mode 100644 index 9858792723..0000000000 --- a/Task/String-matching/Perl-6/string-matching.pl6 +++ /dev/null @@ -1,34 +0,0 @@ -my @subs = ( - # Regex-based: - sub R_contains ( Str $_, Str $s2 ) { ? m/ $s2 / }, - sub R_starts_with ( Str $_, Str $s2 ) { ? m/ ^ $s2 / }, - sub R_ends_with ( Str $_, Str $s2 ) { ? m/ $s2 $ / }, - - # Index-based: - sub I_contains ( Str $_, Str $s2 ) { .index( $s2) .defined }, - sub I_starts_with ( Str $_, Str $s2 ) { my $m = .index( $s2); $m.defined and $m == 0 }, - sub I_ends_with ( Str $_, Str $s2 ) { my $m = .rindex($s2); $m.defined and $m == .chars - $s2.chars }, - - # Substr-based: - sub S_starts_with ( Str $_, Str $s2 ) { .substr(0, $s2.chars) eq $s2 }, - sub S_ends_with ( Str $_, Str $s2 ) { .substr( *-$s2.chars) eq $s2 }, - - # Optional tasks: - sub R_find ( Str $_, Str $s2 ) { $/.from if /$s2/ }, - sub R_find_all ( Str $_, Str $s2 ) { - my @p = .match: /$s2/, :g; - @p».from if @p; - }, -); - -my $str1 = 'abcbcbcd'; -my @str2s = < ab bc cd zz >; - -say "'$str1' vs:".fmt('%15s '), @str2s.fmt('%-15s'); -for [1, 4, 6], [2, 5, 7], [0, 3], [8, 9] { - say(); - for @subs[.list] -> $sub { - say "{$sub.name}:".fmt('%15s '), - @str2s.map({ ~$sub.($str1, $_) }).fmt('%-15s'); - } -} diff --git a/Task/String-matching/REXX/string-matching.rexx b/Task/String-matching/REXX/string-matching.rexx index 380bb91287..06ff7ba45f 100644 --- a/Task/String-matching/REXX/string-matching.rexx +++ b/Task/String-matching/REXX/string-matching.rexx @@ -1,33 +1,28 @@ -/*REXX program demonstrates some basic character string testing. */ -parse arg a b /*obtain A and B from the C.L. */ -say 'string A = ' a /*display string A to terminal.*/ -say 'string B = ' b /* " " B " " */ +/*REXX program demonstrates some basic character string testing (for matching). */ +parse arg A B; LB=length(B) /*obtain A and B from the command line.*/ +say 'string A = ' A /*display string A to the terminal.*/ +say 'string B = ' B /* " " B " " " */ say -if left(A,length(b))==b then say 'string A starts with string B' - else say "string A doesn't start with string B" +if left(A, LB)==B then say 'string A starts with string B' + else say "string A doesn't start with string B" +say /* [↓] another method using COMPARE BIF*/ + /*╔══════════════════════════════════════════════════════════════════════════╗ + ║ if compare(A,B)==LB then say 'string A starts with string B' ║ + ║ else say "string A doesn't start with string B" ║ + ╚══════════════════════════════════════════════════════════════════════════╝*/ +p=pos(B, A) +if p==0 then say "string A doesn't contain string B" + else say 'string A contains string B (starting in position' p")" say - /*another method, however a wee bit obtuse. */ -/*¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬ -if compare(a,b)==length(b) then say 'string A starts with string B' - else say "string A doesn't start with string B" -¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬*/ - /* [↑] above is a big comment. */ -p=pos(b,a) -if p==0 then say "string A doesn't contain string B" - else say 'string A contains string B (starting in position' p")" +if right(A, LB)==b then say 'string A ends with string B' + else say "string A doesn't end with string B" say -if right(A,length(b))==b then say 'string A ends with string B' - else say "string A doesn't end with string B" -say -Ps=''; p=0; do until p==0 - p=pos(b, a, p+1) - if p\==0 then Ps = Ps',' p - end /*until ···*/ -Ps=space(strip(Ps, 'L', ",")) -times=words(Ps) -if times==0 then say "string A doesn't contain string B" - else say 'string A contains string B ', - times 'time'left('s',times>1), - "(at position"left('s', times>1) Ps')' - - /*stick a fork in it, we're done.*/ +$=; p=0; do until p==0; p=pos(B, A, p+1) + if p\==0 then $=$',' p + end /*until ···*/ +$=space(strip($,'L',",")) /*elide extra blanks and leading comma.*/ +#=words($) +if #==0 then say "string A doesn't contain string B" + else say 'string A contains string B ' # " time"left('s', #>1), + "(at position"left('s', #>1) $")" + /*stick a fork in it, we're all done. */ diff --git a/Task/String-matching/SNOBOL4/string-matching.sno b/Task/String-matching/SNOBOL4/string-matching.sno new file mode 100644 index 0000000000..f5e1eb2837 --- /dev/null +++ b/Task/String-matching/SNOBOL4/string-matching.sno @@ -0,0 +1,14 @@ + s1 = 'abcdabefgab' + s2 = 'ab' + s3 = 'xy' + OUTPUT = ?(s1 ? POS(0) s2) "1. " s2 " begins " s1 + OUTPUT = ?(s1 ? POS(0) s3) "1. " s3 " begins " s1 ;# fails + + n = 0 +again s1 POS(n) ARB s2 @a :F(p3) + OUTPUT = "2. " s2 " found at position " ++ a - SIZE(s2) " in " s1 + n = a :(again) + +p3 OUTPUT = ?(s1 ? s2 RPOS(0)) "3. " s2 " ends " s1 +END diff --git a/Task/String-matching/TXR/string-matching-1.txr b/Task/String-matching/TXR/string-matching-1.txr index 14770bd036..2826762e57 100644 --- a/Task/String-matching/TXR/string-matching-1.txr +++ b/Task/String-matching/TXR/string-matching-1.txr @@ -1,18 +1,17 @@ -@(do - (tree-case *args* - ((big small) - (cond - ((< (length big) (length small)) - (put-line `@big is shorter than @small`)) - ((str= big small) - (put-line `@big and @small are equal`)) - ((match-str big small) - (put-line `@small is a prefix of @big`)) - ((match-str big small -1) - (put-line `@small is a suffix of @big`)) - (t (let ((pos (search-str big small))) - (if pos - (put-line `@small occurs in @big at position @pos`) - (put-line `@small does not occur in @big`)))))) - (otherwise - (put-line `usage: @(ldiff *full-args* *args*) `)))) +(tree-case *args* + ((big small) + (cond + ((< (length big) (length small)) + (put-line `@big is shorter than @small`)) + ((str= big small) + (put-line `@big and @small are equal`)) + ((match-str big small) + (put-line `@small is a prefix of @big`)) + ((match-str big small -1) + (put-line `@small is a suffix of @big`)) + (t (let ((pos (search-str big small))) + (if pos + (put-line `@small occurs in @big at position @pos`) + (put-line `@small does not occur in @big`)))))) + (otherwise + (put-line `usage: @(ldiff *full-args* *args*) `))) diff --git a/Task/String-prepend/00DESCRIPTION b/Task/String-prepend/00DESCRIPTION index 6046bfb11e..16d57e96dc 100644 --- a/Task/String-prepend/00DESCRIPTION +++ b/Task/String-prepend/00DESCRIPTION @@ -1,9 +1,17 @@ - {{basic data operation}} -[[Category:String manipulation]] [[Category: String manipulation]] [[Category:Simple]] +{{basic data operation}} +[[Category:String manipulation]] +[[Category: String manipulation]] +[[Category:Simple]] {{omit from|bc|No string operations in bc}} {{omit from|dc|No string operations in dc}} + +;Task: Create a string variable equal to any text value. + Prepend the string variable with another string literal. + If your language supports any idiomatic ways to do this without referring to the variable twice in one expression, include such solutions. + To illustrate the operation, show the content of the variable. +

    diff --git a/Task/String-prepend/Ada/string-prepend.ada b/Task/String-prepend/Ada/string-prepend.ada new file mode 100644 index 0000000000..c4207896f8 --- /dev/null +++ b/Task/String-prepend/Ada/string-prepend.ada @@ -0,0 +1,8 @@ +with Ada.Text_IO; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; + +procedure Prepend_String is + S: Unbounded_String := To_Unbounded_String("World!"); +begin + S := "Hello " & S;-- this is the operation to prepend "Hello " to S. + Ada.Text_IO.Put_Line(To_String(S)); +end Prepend_String; diff --git a/Task/String-prepend/COBOL/string-prepend-1.cobol b/Task/String-prepend/COBOL/string-prepend-1.cobol new file mode 100644 index 0000000000..982b49e678 --- /dev/null +++ b/Task/String-prepend/COBOL/string-prepend-1.cobol @@ -0,0 +1,25 @@ + identification division. + program-id. prepend. + data division. + working-storage section. + 1 str pic x(30) value "World!". + 1 binary. + 2 len pic 9(4) value 0. + 2 scratch pic 9(4) value 0. + procedure division. + begin. + perform rev-sub-str + move function reverse ("Hello ") to str (len + 1:) + perform rev-sub-str + display str + stop run + . + + rev-sub-str. + move 0 to len scratch + inspect function reverse (str) + tallying scratch for leading spaces + len for characters after space + move function reverse (str (1:len)) to str + . + end program prepend. diff --git a/Task/String-prepend/COBOL/string-prepend.cobol b/Task/String-prepend/COBOL/string-prepend-2.cobol similarity index 100% rename from Task/String-prepend/COBOL/string-prepend.cobol rename to Task/String-prepend/COBOL/string-prepend-2.cobol diff --git a/Task/String-prepend/Forth/string-prepend.fth b/Task/String-prepend/Forth/string-prepend.fth new file mode 100644 index 0000000000..95c7432735 --- /dev/null +++ b/Task/String-prepend/Forth/string-prepend.fth @@ -0,0 +1,19 @@ +\ the following functions are commonly native to a Forth system. Shown for completeness + +: C+! ( n addr -- ) dup c@ rot + swap c! ; \ primitive: increment a byte at addr by n + +: +PLACE ( addr1 length addr2 -- ) \ Append addr1 length to addr2 + 2dup 2>r count + swap move 2r> c+! ; + +: PLACE ( addr1 len addr2 -- ) \ addr1 and length, placed at addr2 as counted string + 2dup 2>r 1+ swap move 2r> c! ; + +\ Example begins here +: PREPEND ( addr len addr2 -- addr2) + >R \ push addr2 to return stack + PAD PLACE \ place the 1st string in PAD + R@ count PAD +PLACE \ append PAD with addr2 string + PAD count R@ PLACE \ move the whole thing back into addr2 + R> ; \ leave a copy of addr2 on the data stack + +: writeln ( addr -- ) cr count type ; \ syntax sugar for testing diff --git a/Task/String-prepend/Fortran/string-prepend-1.f b/Task/String-prepend/Fortran/string-prepend-1.f new file mode 100644 index 0000000000..8b8fab4132 --- /dev/null +++ b/Task/String-prepend/Fortran/string-prepend-1.f @@ -0,0 +1,15 @@ + INTEGER*4 I,TEXT(66) + DATA TEXT(1),TEXT(2),TEXT(3)/"Wo","rl","d!"/ + + WRITE (6,1) (TEXT(I), I = 1,3) + 1 FORMAT ("Hello ",66A2) + + DO 2 I = 1,3 + 2 TEXT(I + 3) = TEXT(I) + TEXT(1) = "He" + TEXT(2) = "ll" + TEXT(3) = "o " + + WRITE (6,3) (TEXT(I), I = 1,6) + 3 FORMAT (66A2) + END diff --git a/Task/String-prepend/Fortran/string-prepend-2.f b/Task/String-prepend/Fortran/string-prepend-2.f new file mode 100644 index 0000000000..fa2eb24771 --- /dev/null +++ b/Task/String-prepend/Fortran/string-prepend-2.f @@ -0,0 +1,5 @@ + CHARACTER*66 TEXT + TEXT = "World!" + TEXT = "Hello "//TEXT + WRITE (6,*) TEXT + END diff --git a/Task/String-prepend/Maple/string-prepend.maple b/Task/String-prepend/Maple/string-prepend.maple new file mode 100644 index 0000000000..92c16923f1 --- /dev/null +++ b/Task/String-prepend/Maple/string-prepend.maple @@ -0,0 +1,4 @@ +l := " World"; +m := cat("Hello", l); +n := "Hello"||l; +o := `||`("Hello", l); diff --git a/Task/String-prepend/PlainTeX/string-prepend-1.tex b/Task/String-prepend/PlainTeX/string-prepend-1.tex new file mode 100644 index 0000000000..8bd52b2445 --- /dev/null +++ b/Task/String-prepend/PlainTeX/string-prepend-1.tex @@ -0,0 +1,11 @@ +\def\prepend#1#2{% #1=string #2=macro containing a string + \def\tempstring{#1}% + \expandafter\expandafter\expandafter + \def\expandafter\expandafter\expandafter + #2\expandafter\expandafter\expandafter + {\expandafter\tempstring#2}% +} +\def\mystring{world!} +\prepend{Hello }\mystring +Result : \mystring +\bye diff --git a/Task/String-prepend/PlainTeX/string-prepend-2.tex b/Task/String-prepend/PlainTeX/string-prepend-2.tex new file mode 100644 index 0000000000..d66e31650c --- /dev/null +++ b/Task/String-prepend/PlainTeX/string-prepend-2.tex @@ -0,0 +1,7 @@ +\def\prepend#1#2{% #1=string #2=macro containing a string + \edef#2{\unexpanded{#1}\unexpanded\expandafter{#2}}% +} +\def\mystring{world!} +\prepend{Hello }\mystring +Result : \mystring +\bye diff --git a/Task/String-prepend/SNOBOL4/string-prepend.sno b/Task/String-prepend/SNOBOL4/string-prepend.sno new file mode 100644 index 0000000000..410f47680f --- /dev/null +++ b/Task/String-prepend/SNOBOL4/string-prepend.sno @@ -0,0 +1,3 @@ + s = ', World!' + OUTPUT = s = 'Hello' s +END diff --git a/Task/Strip-a-set-of-characters-from-a-string/00DESCRIPTION b/Task/Strip-a-set-of-characters-from-a-string/00DESCRIPTION index c592357fbd..6f3bbebcd8 100644 --- a/Task/Strip-a-set-of-characters-from-a-string/00DESCRIPTION +++ b/Task/Strip-a-set-of-characters-from-a-string/00DESCRIPTION @@ -1,4 +1,13 @@ -The task is to create a function that strips a set of characters from a string. The function should take two arguments: the first argument being a string to stripped and the second, a string containing the set of characters to be stripped. The returned string should contain the first string, stripped of any characters in the second argument: +;Task: +Create a function that strips a set of characters from a string. + +The function should take two arguments: +:::#   a string to be stripped +:::#   a string containing the set of characters to be stripped + +
    +The returned string should contain the first string, stripped of any characters in the second argument: print stripchars("She was a soul stripper. She took my heart!","aei") Sh ws soul strppr. Sh took my hrt! +

    diff --git a/Task/Strip-a-set-of-characters-from-a-string/360-Assembly/strip-a-set-of-characters-from-a-string.360 b/Task/Strip-a-set-of-characters-from-a-string/360-Assembly/strip-a-set-of-characters-from-a-string.360 new file mode 100644 index 0000000000..43e3559e7f --- /dev/null +++ b/Task/Strip-a-set-of-characters-from-a-string/360-Assembly/strip-a-set-of-characters-from-a-string.360 @@ -0,0 +1,74 @@ +* Strip a set of characters from a string 07/07/2016 +STRIPCH CSECT + USING STRIPCH,R13 base register + B 72(R15) skip savearea + DC 17F'0' savearea + STM R14,R12,12(R13) prolog + ST R13,4(R15) " <- + ST R15,8(R13) " -> + LR R13,R15 " addressability + LA R1,PARMLIST parameter list + BAL R14,STRIPCHR c3=stripchr(c1,c2) + LA R2,PG @pg + LH R3,C3 length(c3) + LA R4,C3+2 @c3 + LR R5,R3 length(c3) + MVCL R2,R4 pg=c3 + XPRNT PG,80 print buffer + L R13,4(0,R13) epilog + LM R14,R12,12(R13) " restore + XR R15,R15 " rc=0 + BR R14 exit +PARMLIST DC A(C3) @c3 + DC A(C1) @c1 + DC A(C2) @c2 +C1 DC H'43',CL62'She was a soul stripper. She took my heart!' +C2 DC H'3',CL14'aei' c2 [varchar(14)] +C3 DS H,CL62 c3 [varchar(62)] +PG DC CL80' ' buffer [char(80)] +*------- stripchr ----------------------------------------------------- +STRIPCHR L R9,0(R1) @parm1 + L R2,4(R1) @parm2 + L R3,8(R1) @parm3 + MVC PHRASE(64),0(R2) phrase=parm2 + MVC REMOVE(16),0(R3) remove=parm3 + SR R8,R8 k=0 + LA R6,1 i=1 +LOOPI CH R6,PHRASE do i=1 to length(phrase) + BH ELOOPI " + LA R4,PHRASE+1 @phrase + AR R4,R6 +i + MVC CI(1),0(R4) ci=substr(phrase,i,1) + MVI OK,X'01' ok='1'B + LA R7,1 j=1 +LOOPJ CH R7,REMOVE do j=1 to length(remove) + BH ELOOPJ " + LA R4,REMOVE+1 @remove + AR R4,R7 +j + MVC CJ,0(R4) cj=substr(remove,j,1) + CLC CI,CJ if ci=cj + BNE CINECJ then + MVI OK,X'00' ok='0'B + B ELOOPJ leave j +CINECJ LA R7,1(R7) j=j+1 + B LOOPJ end do j +ELOOPJ CLI OK,X'01' if ok + BNE NOTOK then + LA R8,1(R8) k=k+1 + LA R4,RESULT+1 @result + AR R4,R8 +k + MVC 0(1,R4),CI substr(result,k,1)=ci +NOTOK LA R6,1(R6) i=i+1 + B LOOPI end do i +ELOOPI STH R8,RESULT length(result)=k + MVC 0(64,R9),RESULT return(result) + BR R14 return to caller +CI DS CL1 ci [char(1)] +CJ DS CL1 cj [char(1)] +OK DS X ok [boolean] +PHRASE DS H,CL62 phrase [varchar(62)] +REMOVE DS H,CL14 remove [varchar(14)] +RESULT DS H,CL62 result [varchar(62)] +* ---- ------------------------------------------------------- + YREGS + END STRIPCH diff --git a/Task/Strip-a-set-of-characters-from-a-string/AppleScript/strip-a-set-of-characters-from-a-string-1.applescript b/Task/Strip-a-set-of-characters-from-a-string/AppleScript/strip-a-set-of-characters-from-a-string-1.applescript new file mode 100644 index 0000000000..0f2c614a07 --- /dev/null +++ b/Task/Strip-a-set-of-characters-from-a-string/AppleScript/strip-a-set-of-characters-from-a-string-1.applescript @@ -0,0 +1,13 @@ +stripChar("She was a soul stripper. She took my heart!", "aei") + +on stripChar(str, chrs) + tell AppleScript + set oldTIDs to text item delimiters + set text item delimiters to characters of chrs + set TIs to text items of str + set text item delimiters to "" + set str to TIs as string + set text item delimiters to oldTIDs + end tell + return str +end stripChar diff --git a/Task/Strip-a-set-of-characters-from-a-string/AppleScript/strip-a-set-of-characters-from-a-string-2.applescript b/Task/Strip-a-set-of-characters-from-a-string/AppleScript/strip-a-set-of-characters-from-a-string-2.applescript new file mode 100644 index 0000000000..26a5e087ff --- /dev/null +++ b/Task/Strip-a-set-of-characters-from-a-string/AppleScript/strip-a-set-of-characters-from-a-string-2.applescript @@ -0,0 +1,61 @@ +-- stripChars :: String -> String -> String +on stripChars(strNeedles, strHaystack) + script notNeedles + on lambda(x) + notElem(x, strNeedles) + end lambda + end script + + intercalate("", filter(notNeedles, strHaystack)) +end stripChars + + +-- TEST +on run + + stripChars("aei", "She was a soul stripper. She took my heart!") + + --> "Sh ws soul strppr. Sh took my hrt!" +end run + + + +-- GENERIC LIBRARY FUNCTIONS + +-- 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 + +-- notElem :: Eq a => a -> [a] -> Bool +on notElem(x, xs) + xs does not contain x +end notElem + +-- intercalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate + +-- 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 diff --git a/Task/Strip-a-set-of-characters-from-a-string/AppleScript/strip-a-set-of-characters-from-a-string-3.applescript b/Task/Strip-a-set-of-characters-from-a-string/AppleScript/strip-a-set-of-characters-from-a-string-3.applescript new file mode 100644 index 0000000000..04651c5aab --- /dev/null +++ b/Task/Strip-a-set-of-characters-from-a-string/AppleScript/strip-a-set-of-characters-from-a-string-3.applescript @@ -0,0 +1,101 @@ +use framework "Foundation" + + +-- stripChars :: String -> String -> String +on stripChars(strNeedles, strHaystack) + + intercalate("", splitRegex("[" & strNeedles & "]", strHaystack)) + +end stripChars + + +-- TEST +on run + + stripChars("aei", "She was a soul stripper. She took my heart!") + + --> "Sh ws soul strppr. Sh took my hrt!" +end run + + + +-- GENERIC LIBRARY FUNCTIONS + +-- splitRegex :: RegexPattern -> String -> [String] +on splitRegex(strRegex, str) + set lstMatches to regexMatches(strRegex, str) + if length of lstMatches > 0 then + script preceding + on lambda(a, x) + set iFrom to start of a + set iLocn to (location of x) + + if iLocn > iFrom then + set strPart to text (iFrom + 1) thru iLocn of str + else + set strPart to "" + end if + {parts:parts of a & strPart, start:iLocn + (length of x) - 1} + end lambda + end script + + set recLast to foldl(preceding, {parts:[], start:0}, lstMatches) + + set iFinal to start of recLast + if iFinal < length of str then + parts of recLast & text (iFinal + 1) thru -1 of str + else + parts of recLast & "" + end if + else + {str} + end if +end splitRegex + +-- regexMatches :: RegexPattern -> String -> [{location:Int, length:Int}] +on regexMatches(strRegex, str) + set ca to current application + set oRgx to ca's NSRegularExpression's regularExpressionWithPattern:strRegex ¬ + options:((ca's NSRegularExpressionAnchorsMatchLines as integer)) |error|:(missing value) + set oString to ca's NSString's stringWithString:str + set oMatches to oRgx's matchesInString:oString options:0 range:{location:0, |length|:oString's |length|()} + + set lstMatches to {} + set lng to count of oMatches + repeat with i from 1 to lng + set end of lstMatches to range() of item i of oMatches + end repeat + lstMatches +end regexMatches + +-- 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 + +-- intercalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate + +-- 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 diff --git a/Task/Strip-a-set-of-characters-from-a-string/AppleScript/strip-a-set-of-characters-from-a-string.applescript b/Task/Strip-a-set-of-characters-from-a-string/AppleScript/strip-a-set-of-characters-from-a-string.applescript deleted file mode 100644 index de818d4072..0000000000 --- a/Task/Strip-a-set-of-characters-from-a-string/AppleScript/strip-a-set-of-characters-from-a-string.applescript +++ /dev/null @@ -1,13 +0,0 @@ -stripChar("She was a soul stripper. She took my heart!", "aei") - -on stripChar(str, chrs) - tell AppleScript - set oldTIDs to text item delimiters - set text item delimiters to characters of chrs - set TIs to text items of str - set text item delimiters to "" - set str to TIs as string - set text item delimiters to oldTIDs - end tell - return str -end stripChar diff --git a/Task/Strip-a-set-of-characters-from-a-string/Elixir/strip-a-set-of-characters-from-a-string-1.elixir b/Task/Strip-a-set-of-characters-from-a-string/Elixir/strip-a-set-of-characters-from-a-string-1.elixir index 815803a0ce..b88d46895a 100644 --- a/Task/Strip-a-set-of-characters-from-a-string/Elixir/strip-a-set-of-characters-from-a-string-1.elixir +++ b/Task/Strip-a-set-of-characters-from-a-string/Elixir/strip-a-set-of-characters-from-a-string-1.elixir @@ -1,3 +1,3 @@ str = "She was a soul stripper. She took my heart!" -String.replace(str, ~r/a|e|i/, "") +String.replace(str, ~r/[aei]/, "") # => Sh ws soul strppr. Sh took my hrt! diff --git a/Task/Strip-a-set-of-characters-from-a-string/Elixir/strip-a-set-of-characters-from-a-string-2.elixir b/Task/Strip-a-set-of-characters-from-a-string/Elixir/strip-a-set-of-characters-from-a-string-2.elixir index 5218b98a2b..f895f4ad9e 100644 --- a/Task/Strip-a-set-of-characters-from-a-string/Elixir/strip-a-set-of-characters-from-a-string-2.elixir +++ b/Task/Strip-a-set-of-characters-from-a-string/Elixir/strip-a-set-of-characters-from-a-string-2.elixir @@ -1,10 +1,9 @@ defmodule RC do def stripchars(str, chars) do - String.replace(str, ~r/#{Enum.join(String.split(chars, ""), "|")}/, "") + String.replace(str, ~r/[#{chars}]/, "") end end str = "She was a soul stripper. She took my heart!" - RC.stripchars(str, "aei") # => Sh ws soul strppr. Sh took my hrt! diff --git a/Task/Strip-a-set-of-characters-from-a-string/Forth/strip-a-set-of-characters-from-a-string-1.fth b/Task/Strip-a-set-of-characters-from-a-string/Forth/strip-a-set-of-characters-from-a-string-1.fth index 2c1f72237c..7c614e23e8 100644 --- a/Task/Strip-a-set-of-characters-from-a-string/Forth/strip-a-set-of-characters-from-a-string-1.fth +++ b/Task/Strip-a-set-of-characters-from-a-string/Forth/strip-a-set-of-characters-from-a-string-1.fth @@ -1,39 +1,15 @@ -\ rosetta Code strip chars from a string -\ Forth is a low level language that is extended to solve your problem -\ Using the Forth parser, primitive memory operations and the stack -\ for data transfer between functions, we create high level functionality -\ STRIPCHARS here has 1st Argument as the chars. If you don't like it -\ reverse the arguments with SWAP. :) +: append-char ( char str -- ) dup >r count dup 1+ r> c! + c! ; \ append char to a counted string +: strippers ( -- addr len) s" aeiAEI" ; \ a string literal returns addr and length -create buffer1 256 allot \ temp buffer, returns its address to the stack - -\ extend the language a little -: STRING, ( addr len -- ) \ compile a string at the next available memory (called 'HERE') - here over 1+ allot place ; - -: APPEND-CHAR ( char string -- ) \ append char to a counted string - dup >r count dup 1+ r> c! + c! ; - -: ," [CHAR] " PARSE STRING, ; \ Parse input stream until '"' and compile into memory - -: ="" ( cstring -- ) 0 swap c! ; \ empty a counted string by setting count to zero - -: writestr ( cstring -- ) \ print a counted string from the stack with new line - count type cr ; - - -\ use our language extensions -create "aei" ," aei" -create input ," She was a soul stripper. She took my heart!" - -: stripchars ( str1 str2 -- str3 ) \ chars are 1st argument, str2 is the input string - buffer1 ="" \ clear the buffer - count bounds \ calc loop limits for str2 +: stripchars ( addr1 len1 addr2 len2 -- PAD len ) + 0 PAD c! \ clear the PAD buffer + bounds \ calc loop limits for addr2 DO - dup count I C@ scan 0= \ scan for char in str1, test for zero - IF \ if NOT found - I c@ buffer1 append-char \ append the str2 char to buffer1 - THEN \ ... and then ... continue the loop + 2dup I C@ ( -- addr1 len1 addr1 len1 char) + scan nip 0= \ scan for char in addr1, test for zero + IF \ if stack = true (ie. NOT found) + I c@ PAD append-char \ fetch addr2 char, append to PAD + THEN \ ...then ... continue the loop LOOP - drop \ we don't need str1 now - buffer1 ; \ addr of buffer1 put on stack as the output + 2drop \ we don't need STRIPPERS now + PAD count ; \ return PAD address and length diff --git a/Task/Strip-a-set-of-characters-from-a-string/Forth/strip-a-set-of-characters-from-a-string-2.fth b/Task/Strip-a-set-of-characters-from-a-string/Forth/strip-a-set-of-characters-from-a-string-2.fth index 79b3cb406c..09d0725217 100644 --- a/Task/Strip-a-set-of-characters-from-a-string/Forth/strip-a-set-of-characters-from-a-string-2.fth +++ b/Task/Strip-a-set-of-characters-from-a-string/Forth/strip-a-set-of-characters-from-a-string-2.fth @@ -3,4 +3,5 @@ : stripchars ( a1 u1 a2 u2 -- ) bounds ?do 2dup i c@ .stripped loop 2drop ; : "aei" s" aei" ; -"aei" s" She was a soul stripper. She took my heart!" stripchars + +\ usage: "aei" s" She was a soul stripper. She took my heart!" stripchars diff --git a/Task/Strip-a-set-of-characters-from-a-string/Icon/strip-a-set-of-characters-from-a-string.icon b/Task/Strip-a-set-of-characters-from-a-string/Icon/strip-a-set-of-characters-from-a-string.icon index 2def163fee..6411d30dfa 100644 --- a/Task/Strip-a-set-of-characters-from-a-string/Icon/strip-a-set-of-characters-from-a-string.icon +++ b/Task/Strip-a-set-of-characters-from-a-string/Icon/strip-a-set-of-characters-from-a-string.icon @@ -5,6 +5,6 @@ end procedure stripChars(s,cs) ns := "" - s ? while ns ||:= (not pos(0), tab(upto(cs)|0)) do tab(many(cs))) + s ? while ns ||:= (not pos(0), tab(upto(cs)|0)) do tab(many(cs)) return ns end diff --git a/Task/Strip-a-set-of-characters-from-a-string/SNOBOL4/strip-a-set-of-characters-from-a-string.sno b/Task/Strip-a-set-of-characters-from-a-string/SNOBOL4/strip-a-set-of-characters-from-a-string.sno new file mode 100644 index 0000000000..4839b71fb9 --- /dev/null +++ b/Task/Strip-a-set-of-characters-from-a-string/SNOBOL4/strip-a-set-of-characters-from-a-string.sno @@ -0,0 +1,9 @@ + DEFINE("strip(strip,c)") :(strip_end) +strip strip ANY(c) = :S(strip)F(RETURN) +strip_end + + chars = HOST(2, HOST(3)) ;* Get command line argument + chars = IDENT(chars) "aei" +again line = INPUT :F(END) + OUTPUT = strip(line, chars) :(again) +END diff --git a/Task/Strip-a-set-of-characters-from-a-string/TXR/strip-a-set-of-characters-from-a-string-1.txr b/Task/Strip-a-set-of-characters-from-a-string/TXR/strip-a-set-of-characters-from-a-string-1.txr index dbea457ac7..fa33717fd5 100644 --- a/Task/Strip-a-set-of-characters-from-a-string/TXR/strip-a-set-of-characters-from-a-string-1.txr +++ b/Task/Strip-a-set-of-characters-from-a-string/TXR/strip-a-set-of-characters-from-a-string-1.txr @@ -1,14 +1,13 @@ -@(do - (defun strip-chars (str set) - (let* ((regex-ast ^(set ,*(list-str set))) - (regex-obj (regex-compile regex-ast))) - (regsub regex-obj "" str))) +(defun strip-chars (str set) + (let* ((regex-ast ^(set ,*(list-str set))) + (regex-obj (regex-compile regex-ast))) + (regsub regex-obj "" str))) - (defun usage () - (pprinl `usage: @{(ldiff *full-args* *args*) " "} `) - (exit 1)) +(defun usage () + (pprinl `usage: @{(ldiff *full-args* *args*) " "} `) + (exit 1)) - (tree-case *args* - ((str set extra) (usage)) - ((str set . junk) (pprinl (strip-chars str set))) - (else (usage)))) +(tree-case *args* + ((str set extra) (usage)) + ((str set . junk) (pprinl (strip-chars str set))) + (else (usage))) diff --git a/Task/Strip-block-comments/00DESCRIPTION b/Task/Strip-block-comments/00DESCRIPTION index daa68f2de3..a653073741 100644 --- a/Task/Strip-block-comments/00DESCRIPTION +++ b/Task/Strip-block-comments/00DESCRIPTION @@ -1,6 +1,15 @@ -A block comment begins with a ''beginning delimiter'' and ends with a ''ending delimiter'', including the delimiters. These delimiters are often multi-character sequences. +A block comment begins with a   ''beginning delimiter''   and ends with a   ''ending delimiter'',   including the delimiters.   These delimiters are often multi-character sequences. + + +;Task: +Strip block comments from program text (of a programming language much like classic [[C]]). + +Your demos should at least handle simple, non-nested and multi-line block comment delimiters. + +The block comment delimiters are the two-character sequence: +:::*     '''/*'''     (beginning delimiter) +:::*     '''*/'''     (ending delimiter) -'''Task:''' Strip block comments from program text (of a programming language much like classic [[C]]). Your demos should at least handle simple, non-nested and multiline block comment delimiters. The beginning delimiter is the two-character sequence “/*” and the ending delimiter is “*/”. Sample text for stripping:
    @@ -22,6 +31,10 @@ Sample text for stripping:
         }
     
    -'''Extra credit:''' Ensure that the stripping code is not hard-coded to the particular delimiters described above, but instead allows the caller to specify them. (If your language supports them, [[Optional parameters|optional parameters]] may be useful for this.) +;Extra credit: +Ensure that the stripping code is not hard-coded to the particular delimiters described above, but instead allows the caller to specify them.   (If your language supports them,   [[Optional parameters|optional parameters]]   may be useful for this.) -C.f: [[Strip comments from a string]] + +;Related task: +*   [[Strip comments from a string]] +

    diff --git a/Task/Strip-block-comments/Fortran/strip-block-comments.f b/Task/Strip-block-comments/Fortran/strip-block-comments.f new file mode 100644 index 0000000000..3917d29a64 --- /dev/null +++ b/Task/Strip-block-comments/Fortran/strip-block-comments.f @@ -0,0 +1,83 @@ + SUBROUTINE UNBLOCK(THIS,THAT) !Removes block comments bounded by THIS and THAT. +Copies from file INF to file OUT, record by record, except skipping null output records. + CHARACTER*(*) THIS,THAT !Starting and ending markers. + INTEGER LOTS !How long is a piece of string? + PARAMETER (LOTS = 6666) !This should do. + CHARACTER*(LOTS) ACARD,ALINE !Scratchpads. + INTEGER LC,LL,L !Lengths. + INTEGER L1,L2 !Scan fingers. + INTEGER NC,NL !Might as well count records read and written. + LOGICAL BLAH !A state: in or out of a block comment. + INTEGER MSG,KBD,INF,OUT !I/O unit numbers. + COMMON /IODEV/MSG,KBD,INF,OUT !Thus. + NC = 0 !No cards read in. + NL = 0 !No lines written out. + BLAH = .FALSE. !And we're not within a comment. +Chug through the input. + 10 READ(INF,11,END = 100) LC,ACARD(1:MIN(LC,LOTS)) !Yum. + 11 FORMAT (Q,A) !Sez: how much remains (Q), then, characters (A). + NC = NC + 1 !A card has been read. + IF (LC.GT.LOTS) THEN !Paranoia. + WRITE (MSG,12) NC,LC,LOTS !Scream. + 12 FORMAT ("Record ",I0," has length ",I0,"! My limit is ",I0) + LC = LOTS !Stay calm, and carry on. + END IF !None of this should happen. +Chew through ACARD according to mood. + LL = 0 !No output yet. + L2 = 0 !Syncopation. Where the previous sniff ended. + 20 L1 = L2 + 1 !The start of what we're looking at. + IF (L1.LE.LC) THEN !Anything left? + L2 = L1 !Yes. This is the probe. + IF (BLAH) THEN !So, what's our mood? + 21 IF (L2 + LEN(THAT) - 1 .LE. LC) THEN !We're skipping stuff. + IF (ACARD(L2:L2 + LEN(THAT) - 1).EQ.THAT) THEN !An ender yet? + BLAH = .FALSE. !Yes! + L2 = L2 + LEN(THAT) - 1 !Finger its final character. + GO TO 20 !And start a new advance. + END IF !But if that wasn't an ender, + L2 = L2 + 1 !Advance one. + GO TO 21 !And try again. + END IF !By here, insufficient text remains to match THAT, so we're finished with ACARD. + ELSE !Otherwise, if we're not in a comment, we're looking at grist. + 22 IF (L2 + LEN(THIS) - 1 .LE. LC) THEN !Enough text to match a comment starter? + IF (ACARD(L2:L2 + LEN(THIS) - 1).EQ.THIS) THEN !Yes. Does it? + BLAH = .TRUE. !Yes! + L = L2 - L1 !Recalling where this state started. + ALINE(LL + 1:LL + L) = ACARD(L1:L2 - 1) !Copy the non-BLAH text. + LL = LL + L !L2 fingers the first of THIS. + L2 = L2 + LEN(THIS) - 1 !Finger the last matching THIS. + GO TO 20 !And resume. + END IF !But if that wasn't a comment starter, + L2 = L2 + 1 !Advance one. + GO TO 22 !And try again. + END IF !But if there remains insufficient to match THIS + L = LC - L1 + 1 !Then the remainder of the line is grist. + ALINE(LL + 1:LL + L) = ACARD(L1:LC) !So grab it. + LL = LL + L !And count it in. + END IF !By here, we're finished witrh ACARD. + END IF !So much for ACARD. +Cast forth some output. + IF (LL.GT.0) THEN !If there is any. + WRITE (OUT,23) ALINE(1:LL) !There is. + 23 FORMAT (">",A,"<") !Just text, but with added bounds. + NL = NL + 1 !Count a line. + END IF !So much for output. + GO TO 10 !Perhaps there is some more input. +Completed. + 100 WRITE (MSG,101) NC,NL !Be polite. + 101 FORMAT (I0," read, ",I0," written.") + END !No attention to context, such as quoted strings. + + PROGRAM TEST + INTEGER MSG,KBD,INF,OUT + COMMON /IODEV/MSG,KBD,INF,OUT + KBD = 5 + MSG = 6 + INF = 10 + OUT = 11 + OPEN (INF,FILE="Source.txt",STATUS="OLD",ACTION="READ") + OPEN (OUT,FILE="Src.txt",STATUS="REPLACE",ACTION="WRITE") + + CALL UNBLOCK("/*","*/") + + END !All open files are closed on exit.. diff --git a/Task/Strip-comments-from-a-string/00DESCRIPTION b/Task/Strip-comments-from-a-string/00DESCRIPTION index 5c1187161e..df39ecb33e 100644 --- a/Task/Strip-comments-from-a-string/00DESCRIPTION +++ b/Task/Strip-comments-from-a-string/00DESCRIPTION @@ -1,16 +1,27 @@ The task is to remove text that follow any of a set of comment markers, (in these examples either a hash or a semicolon) from a string or input line. -'''Whitespace debacle:''' There is some confusion about whether to remove any whitespace from the input line. As of [http://rosettacode.org/mw/index.php?title=Strip_comments_from_a_string&oldid=119409 2 September 2011], at least 8 languages (C, C++, Java, Perl, Python, Ruby, sed, UNIX Shell) were incorrect, out of 36 total languages, because they did not trim whitespace by 29 March 2011 rules. Some other languages might be incorrect for the same reason. '''Please discuss this issue at [[{{TALKPAGENAME}}]].''' + +'''Whitespace debacle:'''   There is some confusion about whether to remove any whitespace from the input line. + +As of [http://rosettacode.org/mw/index.php?title=Strip_comments_from_a_string&oldid=119409 2 September 2011], at least 8 languages (C, C++, Java, Perl, Python, Ruby, sed, UNIX Shell) were incorrect, out of 36 total languages, because they did not trim whitespace by 29 March 2011 rules. Some other languages might be incorrect for the same reason. + +'''Please discuss this issue at [[{{TALKPAGENAME}}]].''' * From [http://rosettacode.org/mw/index.php?title=Strip_comments_from_a_string&oldid=103978 29 March 2011], this task required that: ''"The comment marker and any whitespace at the beginning or ends of the resultant line should be removed. A line without comments should be trimmed of any leading or trailing whitespace before being produced as a result."'' The task had 28 languages, which did not all meet this new requirement. * From [http://rosettacode.org/mw/index.php?title=Strip_comments_from_a_string&oldid=103978 28 March 2011], this task required that: ''"Whitespace before the comment marker should be removed."'' * From [http://rosettacode.org/mw/index.php?title=Strip_comments_from_a_string&offset=20101206204307&action=history 30 October 2010], this task did not specify whether or not to remove whitespace. -The following examples will be truncated to either "apples, pears " or "apples, pears". (This example has flipped between "apples, pears " and "apples, pears" in the past.) +
    +The following examples will be truncated to either "apples, pears " or "apples, pears". + +(This example has flipped between "apples, pears " and "apples, pears" in the past.)
     apples, pears # and bananas
     apples, pears ; and bananas
     
    -Cf. [[Strip block comments]] + +;Related task: +*   [[Strip block comments]] +

    diff --git a/Task/Strip-comments-from-a-string/Applesoft-BASIC/strip-comments-from-a-string.applesoft b/Task/Strip-comments-from-a-string/Applesoft-BASIC/strip-comments-from-a-string.applesoft new file mode 100644 index 0000000000..7ad69564e8 --- /dev/null +++ b/Task/Strip-comments-from-a-string/Applesoft-BASIC/strip-comments-from-a-string.applesoft @@ -0,0 +1,26 @@ +10 LET C$ = ";#" +20 S$(1)="APPLES, PEARS # AND BANANAS" +30 S$(2)="APPLES, PEARS ; AND BANANAS" +40 FOR Q = 1 TO 2 +50 LET S$ = S$(Q) +60 GOSUB 100"STRIP COMMENTS +70 PRINT S$ +80 NEXT Q +90 END + +100 IF S$ = "" THEN RETURN +110 FOR I = 1 TO LEN(S$) +120 LET A$ = MID$(S$, I, 1) +130 FOR J = 1 TO LEN(C$) +140 LET F$ = MID$(C$, J, 1) +150 IF A$ <> F$ THEN NEXT J +160 IF A$ = F$ THEN 200 +170 NEXT I +200 LET I = I - 1 +210 GOSUB 260"STRIP +220 IF S$ = "" THEN RETURN +230 FOR I = I TO 0 STEP -1 +240 LET A$ = MID$(S$, I, 1) +250 IF A$ = " " THEN NEXT I +260 LET S$ = MID$(S$, 1, I) +270 RETURN diff --git a/Task/Strip-comments-from-a-string/REXX/strip-comments-from-a-string-1.rexx b/Task/Strip-comments-from-a-string/REXX/strip-comments-from-a-string-1.rexx index 75c90b3ef5..788abe83cd 100644 --- a/Task/Strip-comments-from-a-string/REXX/strip-comments-from-a-string-1.rexx +++ b/Task/Strip-comments-from-a-string/REXX/strip-comments-from-a-string-1.rexx @@ -1,41 +1,41 @@ -/*REXX program strips a string delineated by a hash (#) or a semicolon (;). */ -old1=' apples, pears # and bananas' ; say ' old ───►'old1"◄───" -new1=stripCom1(old1) ; say '1st version new ───►'new1"◄───" -new2=stripCom2(old1) ; say '2nd version new ───►'new2"◄───" -new3=stripCom3(old1) ; say '3rd version new ───►'new3"◄───" -new4=stripCom4(old1) ; say '4th version new ───►'new4"◄───" - say copies('═',55) -old2=' apples, pears ; and bananas' ; say ' old ───►'old2"◄───" -new1=stripCom1(old2) ; say '1st version new ───►'new1"◄───" -new2=stripCom2(old2) ; say '2nd version new ───►'new2"◄───" -new3=stripCom3(old2) ; say '3rd version new ───►'new3"◄───" -new4=stripCom4(old2) ; say '4th version new ───►'new4"◄───" -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -stripCom1: procedure; parse arg x /*obtain the argument (the X string).*/ -x=translate(x, '#', ";") /*translate semicolons to a hash (#). */ -parse var x x '#' /*parse the X string, ending in hash. */ -return strip(x) /*return the striped shortened string. */ -/*────────────────────────────────────────────────────────────────────────────*/ -stripCom2: procedure; parse arg x /*obtain the argument (the X string).*/ -d = ';#' /*this is the delimiter list to be used*/ -d1=left(d,1) /*get the first character in delimiter.*/ -x=translate(x,copies(d1,length(d)),d) /*translates delimiters ──► 1st delim.*/ -parse var x x (d1) /*parse the string, ending in a hash. */ -return strip(x) /*return the striped shortened string. */ -/*────────────────────────────────────────────────────────────────────────────*/ -stripCom3: procedure; parse arg x /*obtain the argument (the X string).*/ -d = ';#' /*this is the delimiter list to be used*/ - do j=1 for length(d) /*process each of the delimiters singly*/ - _=substr(d,j,1) /*use only one delimiter at a time. */ - parse var x x (_) /*parse the X string for each delim. */ - end /*j*/ /* [↑] (_) means stop parsing at _ */ -return strip(x) /*return the striped shortened string. */ -/*────────────────────────────────────────────────────────────────────────────*/ -stripCom4: procedure; parse arg x /*obtain the argument (the X string).*/ -d = ';#' /*this is the delimiter list to be used*/ - do k=1 for length(d) /*process each of the delimiters singly*/ - p=pos(substr(d,k,1), x) /*see if a delimiter is in the X string*/ - if p\==0 then x=left(x,p-1) /*shorten the X string by one character*/ - end /*k*/ /* [↑] If p==0, then char wasn't found*/ -return strip(x) /*return the striped shortened string. */ +/*REXX program strips a string delineated by a hash (#) or a semicolon (;). */ +old1= ' apples, pears # and bananas' ; say ' old ───►'old1"◄───" +new1= stripCom1(old1) ; say ' 1st version new ───►'new1"◄───" +new2= stripCom2(old1) ; say ' 2nd version new ───►'new2"◄───" +new3= stripCom3(old1) ; say ' 3rd version new ───►'new3"◄───" +new4= stripCom4(old1) ; say ' 4th version new ───►'new4"◄───" + say copies('▒', 62) +old2= ' apples, pears ; and bananas' ; say ' old ───►'old2"◄───" +new1= stripCom1(old2) ; say ' 1st version new ───►'new1"◄───" +new2= stripCom2(old2) ; say ' 2nd version new ───►'new2"◄───" +new3= stripCom3(old2) ; say ' 3rd version new ───►'new3"◄───" +new4= stripCom4(old2) ; say ' 4th version new ───►'new4"◄───" +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +stripCom1: procedure; parse arg x /*obtain the argument (the X string).*/ + x=translate(x, '#', ";") /*translate semicolons to a hash (#). */ + parse var x x '#' /*parse the X string, ending in hash. */ + return strip(x) /*return the stripped shortened string.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +stripCom2: procedure; parse arg x /*obtain the argument (the X string).*/ + d= ';#' /*this is the delimiter list to be used*/ + d1=left(d,1) /*get the first character in delimiter.*/ + x=translate(x,copies(d1,length(d)),d) /*translates delimiters ──► 1st delim.*/ + parse var x x (d1) /*parse the string, ending in a hash. */ + return strip(x) /*return the stripped shortened string.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +stripCom3: procedure; parse arg x /*obtain the argument (the X string).*/ + d= ';#' /*this is the delimiter list to be used*/ + do j=1 for length(d) /*process each of the delimiters singly*/ + _=substr(d,j,1) /*use only one delimiter at a time. */ + parse var x x (_) /*parse the X string for each delim. */ + end /*j*/ /* [↑] (_) means stop parsing at _ */ + return strip(x) /*return the stripped shortened string.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +stripCom4: procedure; parse arg x /*obtain the argument (the X string).*/ + d= ';#' /*this is the delimiter list to be used*/ + do k=1 for length(d) /*process each of the delimiters singly*/ + p=pos(substr(d,k,1), x) /*see if a delimiter is in the X string*/ + if p\==0 then x=left(x,p-1) /*shorten the X string by one character*/ + end /*k*/ /* [↑] If p==0, then char wasn't found*/ + return strip(x) /*return the stripped shortened string.*/ diff --git a/Task/Strip-control-codes-and-extended-characters-from-a-string/ALGOL-68/strip-control-codes-and-extended-characters-from-a-string.alg b/Task/Strip-control-codes-and-extended-characters-from-a-string/ALGOL-68/strip-control-codes-and-extended-characters-from-a-string.alg new file mode 100644 index 0000000000..4a53b5a49a --- /dev/null +++ b/Task/Strip-control-codes-and-extended-characters-from-a-string/ALGOL-68/strip-control-codes-and-extended-characters-from-a-string.alg @@ -0,0 +1,30 @@ +# remove control characters and optionally extended characters from the string text # +# assums ASCII is the character set # +PROC strip characters = ( STRING text, BOOL strip extended )STRING: + BEGIN + # we build the result in a []CHAR and convert back to a string at the end # + INT text start = LWB text; + INT text max = UPB text; + [ text start : text max ]CHAR result; + INT result pos := text start; + FOR text pos FROM text start TO text max DO + INT ch := ABS text[ text pos ]; + IF ( ch >= 0 AND ch <= 31 ) OR ch = 127 THEN + # control character # + SKIP + ELIF strip extended AND ( ch > 126 OR ch < 0 ) THEN + # extened character and we don't want them # + SKIP + ELSE + # include this character # + result[ result pos ] := REPR ch; + result pos +:= 1 + FI + OD; + result[ text start : result pos - 1 ] + END # strip characters # ; + +# test the control/extended character stripping procedure # +STRING t = REPR 2 + "abc" + REPR 10 + REPR 160 + "def~" + REPR 127 + REPR 10 + REPR 150 + REPR 152 + "!"; +print( ( "<<" + t + ">> - without control characters: <<" + strip characters( t, FALSE ) + ">>", newline ) ); +print( ( "<<" + t + ">> - without control or extended characters: <<" + strip characters( t, TRUE ) + ">>", newline ) ) diff --git a/Task/Strip-control-codes-and-extended-characters-from-a-string/JavaScript/strip-control-codes-and-extended-characters-from-a-string-1.js b/Task/Strip-control-codes-and-extended-characters-from-a-string/JavaScript/strip-control-codes-and-extended-characters-from-a-string-1.js new file mode 100644 index 0000000000..d3f72622e0 --- /dev/null +++ b/Task/Strip-control-codes-and-extended-characters-from-a-string/JavaScript/strip-control-codes-and-extended-characters-from-a-string-1.js @@ -0,0 +1,14 @@ +(function (strTest) { + + // s -> s + function strip(s) { + return s.split('').filter(function (x) { + var n = x.charCodeAt(0); + + return 31 < n && 127 > n; + }).join(''); + } + + return strip(strTest); + +})("\ba\x00b\n\rc\fd\xc3"); diff --git a/Task/Strip-control-codes-and-extended-characters-from-a-string/JavaScript/strip-control-codes-and-extended-characters-from-a-string-2.js b/Task/Strip-control-codes-and-extended-characters-from-a-string/JavaScript/strip-control-codes-and-extended-characters-from-a-string-2.js new file mode 100644 index 0000000000..b54d1763ed --- /dev/null +++ b/Task/Strip-control-codes-and-extended-characters-from-a-string/JavaScript/strip-control-codes-and-extended-characters-from-a-string-2.js @@ -0,0 +1 @@ +"abcd" diff --git a/Task/Strip-control-codes-and-extended-characters-from-a-string/REXX/strip-control-codes-and-extended-characters-from-a-string-1.rexx b/Task/Strip-control-codes-and-extended-characters-from-a-string/REXX/strip-control-codes-and-extended-characters-from-a-string-1.rexx index b0c143410d..8447a19895 100644 --- a/Task/Strip-control-codes-and-extended-characters-from-a-string/REXX/strip-control-codes-and-extended-characters-from-a-string-1.rexx +++ b/Task/Strip-control-codes-and-extended-characters-from-a-string/REXX/strip-control-codes-and-extended-characters-from-a-string-1.rexx @@ -1,18 +1,18 @@ -/*REXX program to strip all "control codes" from a string (ASCII|EBCDIC)*/ -xxx='string of ☺☻♥♦⌂, may include control characters and other ilk.♫☼§►↔◄' - /*in EBCDIC, digit 1 is 'f1'x,*/ - /*in ASCII, digit 1 is '31'x.*/ -ebcdic= 1=='f1'x /*is this an EBCDIC computer?*/ - /*generate a string of chars from*/ - /*'00'x ──► [1 just before blank]*/ -ccChars = xrange(,d2c(c2d(' ') -1)) /*generate a range of characters.*/ -if \ebcdic then ccChars=ccChars'7f'x /*add the ASCII '7f'X char. */ -say 'hex ccChars =' c2x(ccChars) /*might as well do a show & tell.*/ -ccCharsX = ccChars'ff'x /*add a "stop" char for ccCharsX.*/ -/*══════════════════════════════════════════════════════════════════════*/ -_stop = substr(ccCharsX, verify(ccCharsX, xxx), 1) /*find a stop char.*/ -yyy = translate(space(translate(xxx, _stop, " "ccChars), 0), , _stop) -/*══════════════════════════════════════════════════════════════════════*/ -say 'old = >>>'xxx"<<<" /*add fence before&after old text*/ -say 'new = >>>'yyy"<<<" /* " " " " new text*/ - /*stick a fork in it, we're done.*/ +/*REXX program strips all "control codes" from a character string (ASCII or EBCDIC). */ +xxx= 'string of ☺☻♥♦⌂, may include control characters and other ilk.♫☼§►↔◄' + /*in EBCDIC, the digit 1 is 'f1'x, */ + /* " ASCII, " " " " 31'x. */ +ebcdic= (1=='f1'x) /*is this an EBCDIC computer ? */ + /*generate a string of characters from */ + /*'00'x ──► [1 just before the blank].*/ +ccChars = xrange(,d2c(c2d(' ') -1)) /*generate a range of characters. */ +if \ebcdic then ccChars=ccChars'7f'x /*add the ASCII '7f'X character. */ +say 'hex ccChars =' c2x(ccChars) /*might as well do a display of ccChars*/ +ccCharsX = ccChars'ff'x /*add a "stop" character for ccCharsX*/ + +_stop= substr(ccCharsX,verify(ccCharsX, xxx), 1) /*find a "stop" character. */ +yyy = translate(space(translate(xxx, _stop, " "ccChars), 0), , _stop) + +say 'old = »»»'xxx"«««" /*add ««fence»» before & after old text*/ +say 'new = »»»'yyy"«««" /* " " " " " new " */ + /*stick a fork in it, we're all done. */ diff --git a/Task/Strip-control-codes-and-extended-characters-from-a-string/REXX/strip-control-codes-and-extended-characters-from-a-string-2.rexx b/Task/Strip-control-codes-and-extended-characters-from-a-string/REXX/strip-control-codes-and-extended-characters-from-a-string-2.rexx index 7763b47b29..8b1c8aaa11 100644 --- a/Task/Strip-control-codes-and-extended-characters-from-a-string/REXX/strip-control-codes-and-extended-characters-from-a-string-2.rexx +++ b/Task/Strip-control-codes-and-extended-characters-from-a-string/REXX/strip-control-codes-and-extended-characters-from-a-string-2.rexx @@ -1,22 +1,20 @@ -/*REXX program to strip all "control codes" from a string (ASCII|EBCDIC)*/ -xxx='string of ☺☻♥♦⌂, may include control characters and other ilk.♫☼§►↔◄' - /*in EBCDIC, digit 1 is 'f1'x,*/ - /*in ASCII, digit 1 is '31'x.*/ -ascii= '31'x==1 /*is this an ASCII computer? */ - /* (if you are ASCII-centric.) */ - /*generate a string of chars from*/ - /*'00'x --> [1 just before blank]*/ -ccChars=xrange(, d2c(c2d(' ') -1)) /*generate a range of characters.*/ -if ascii then ccChars = ccChars'7f'x /*add the ASCII '7f'X char. */ -say 'hex ccChars =' c2x(ccChars) /*might as well do a show & tell.*/ -/*══════════════════════════════════════════════════════════════════════*/ -yyy='' /*start with a clean slate. */ - do j=1 for length(xxx) /*build new str, 1 byte at a time*/ - _ = substr(xxx,j,1) /*get next char in the old string*/ - if pos(_,ccChars)\==0 then iterate /*skip this char, it's a no-no. */ - yyy = yyy || _ /*we found a good & decent fellow*/ - end -/*══════════════════════════════════════════════════════════════════════*/ -say 'old = >>>'xxx"<<<" /*add fence before&after old text*/ -say 'new = >>>'yyy"<<<" /* " " " " new text*/ - /*stick a fork in it, we're done.*/ +/*REXX program strips all "control codes" from a character string (ASCII or EBCDIC). */ +xxx= 'string of ☺☻♥♦⌂, may include control characters and other ilk.♫☼§►↔◄' + /*in EBCDIC, the digit 1 is 'f1'x, */ + /* " ASCII, " " " " 31'x. */ +ascii= ('31'x==1) /*is this an ASCII computer? */ + /*generate a string of characters from */ + /*'00'x ──► [1 just before the blank].*/ +ccChars = xrange(, d2c(c2d(' ') -1) ) /*generate a range of characters. */ +if ascii then ccChars=ccChars'7f'x /*add the ASCII '7f'X character. */ +say 'hex ccChars =' c2x(ccChars) /*might as well do a display of ccChars*/ +yyy= /*start with a clean slate. */ + do j=1 for length(xxx) /*build a new string, 1 byte at a time.*/ + _=substr(xxx, j, 1) /*get next character in the old string.*/ + if pos(_, ccChars)\==0 then iterate /*skip this character, it's a no-no. */ + yyy = yyy || _ /*we found a good and decent character.*/ + end + +say 'old = »»»'xxx"«««" /*add ««fence»» before & after old text*/ +say 'new = »»»'yyy"«««" /* " " " " " new " */ + /*stick a fork in it, we're all done. */ diff --git a/Task/Strip-control-codes-and-extended-characters-from-a-string/TXR/strip-control-codes-and-extended-characters-from-a-string.txr b/Task/Strip-control-codes-and-extended-characters-from-a-string/TXR/strip-control-codes-and-extended-characters-from-a-string.txr index a5e53d76a8..d1474282e3 100644 --- a/Task/Strip-control-codes-and-extended-characters-from-a-string/TXR/strip-control-codes-and-extended-characters-from-a-string.txr +++ b/Task/Strip-control-codes-and-extended-characters-from-a-string/TXR/strip-control-codes-and-extended-characters-from-a-string.txr @@ -1,6 +1,5 @@ -@(do - (defun strip-controls (str) - (regsub #/[\x0-\x1F\x7F]+/ "" str)) +(defun strip-controls (str) + (regsub #/[\x0-\x1F\x7F]+/ "" str)) - (defun strip-controls-and-extended (str) - (regsub #/[^\x20-\x7F]+/ "" str))) +(defun strip-controls-and-extended (str) + (regsub #/[^\x20-\x7F]+/ "" str)) diff --git a/Task/Strip-whitespace-from-a-string-Top-and-tail/00DESCRIPTION b/Task/Strip-whitespace-from-a-string-Top-and-tail/00DESCRIPTION index d7119b8a49..fd19915e90 100644 --- a/Task/Strip-whitespace-from-a-string-Top-and-tail/00DESCRIPTION +++ b/Task/Strip-whitespace-from-a-string-Top-and-tail/00DESCRIPTION @@ -1,7 +1,12 @@ -The task is to demonstrate how to strip leading and trailing whitespace from a string. The solution should demonstrate how to achieve the following three results: +;Task: +Demonstrate how to strip leading and trailing whitespace from a string. + +The solution should demonstrate how to achieve the following three results: * String with leading whitespace removed * String with trailing whitespace removed * String with both leading and trailing whitespace removed +
    For the purposes of this task whitespace includes non printable characters such as the space character, the tab character, and other such characters that have no corresponding graphical representation. +

    diff --git a/Task/Strip-whitespace-from-a-string-Top-and-tail/ALGOL-68/strip-whitespace-from-a-string-top-and-tail.alg b/Task/Strip-whitespace-from-a-string-Top-and-tail/ALGOL-68/strip-whitespace-from-a-string-top-and-tail-1.alg similarity index 100% rename from Task/Strip-whitespace-from-a-string-Top-and-tail/ALGOL-68/strip-whitespace-from-a-string-top-and-tail.alg rename to Task/Strip-whitespace-from-a-string-Top-and-tail/ALGOL-68/strip-whitespace-from-a-string-top-and-tail-1.alg diff --git a/Task/Strip-whitespace-from-a-string-Top-and-tail/ALGOL-68/strip-whitespace-from-a-string-top-and-tail-2.alg b/Task/Strip-whitespace-from-a-string-Top-and-tail/ALGOL-68/strip-whitespace-from-a-string-top-and-tail-2.alg new file mode 100644 index 0000000000..db2bb3ab8b --- /dev/null +++ b/Task/Strip-whitespace-from-a-string-Top-and-tail/ALGOL-68/strip-whitespace-from-a-string-top-and-tail-2.alg @@ -0,0 +1,29 @@ +# + string_trim + Trim leading and trailing whitespace from string. + + @param str A string. + @return A string trimmed of leading and trailing white space. +# +PROC string_trim = (STRING str) STRING: ( + INT i := 1, j := 0; + WHILE str[i] = blank DO + i +:= 1 + OD; + WHILE str[UPB str - j] = blank DO + j +:= 1 + OD; + str[i:UPB str - j] +); + +test: ( + IF string_trim(" foobar") /= "foobar" THEN + print(("string_trim(' foobar'): expected 'foobar'; actual: " + + string_trim(" foobar"), newline)) FI; + IF string_trim("foobar ") /= "foobar" THEN + print(("string_trim('foobar '): expected 'foobar'; actual: " + + string_trim("foobar "), newline)) FI; + IF string_trim(" foobar ") /= "foobar" THEN + print(("string_trim(' foobar '): expected 'foobar'; actual: " + + string_trim(" foobar "), newline)) FI +) diff --git a/Task/Strip-whitespace-from-a-string-Top-and-tail/AppleScript/strip-whitespace-from-a-string-top-and-tail-1.applescript b/Task/Strip-whitespace-from-a-string-Top-and-tail/AppleScript/strip-whitespace-from-a-string-top-and-tail-1.applescript new file mode 100644 index 0000000000..c00802af58 --- /dev/null +++ b/Task/Strip-whitespace-from-a-string-Top-and-tail/AppleScript/strip-whitespace-from-a-string-top-and-tail-1.applescript @@ -0,0 +1,117 @@ +use framework "Foundation" -- "OS X" Yosemite onwards, for NSRegularExpression + + +-- isSpace :: Char -> Bool +on isSpace(c) + ((length of c) = 1) and regexTest("\\s", c) +end isSpace + + +-- stripStart :: Text -> Text +on stripStart(s) + dropWhile(isSpace, s) as text +end stripStart + +-- stripEnd :: Text -> Text +on stripEnd(s) + dropWhileEnd(isSpace, s) as text +end stripEnd + +-- strip :: Text -> Text +on strip(s) + dropAround(isSpace, s) as text +end strip + + +-- TEST +on run + set strText to " \t\t \n \r Much Ado About Nothing \t \n \r " + + script arrowed + on lambda(x) + "-->" & x & "<--" + end lambda + end script + + map(arrowed, [stripStart(strText), stripEnd(strText), strip(strText)]) + + -- {"-->Much Ado About Nothing + -- + -- <--", "--> + -- + -- Much Ado About Nothing<--", "-->Much Ado About Nothing<--"} +end run + + + +-- GENERIC FUNCTIONS + +-- dropWhile :: (a -> Bool) -> [a] -> [a] +on dropWhile(p, xs) + tell mReturn(p) + set lng to length of xs + set i to 1 + repeat while i ≤ lng and lambda(item i of xs) + set i to i + 1 + end repeat + end tell + if i ≤ lng then + items i thru lng of xs + else + {} + end if +end dropWhile + +-- dropWhileEnd :: (a -> Bool) -> [a] -> [a] +on dropWhileEnd(p, xs) + tell mReturn(p) + set i to length of xs + repeat while i > 0 and lambda(item i of xs) + set i to i - 1 + end repeat + end tell + if i > 0 then + items 1 thru i of xs + else + {} + end if +end dropWhileEnd + +-- dropAround :: (Char -> Bool) -> [a] -> [a] +on dropAround(p, xs) + dropWhile(p, dropWhileEnd(p, xs)) +end dropAround + +-- regexTest :: RegexPattern -> String -> Bool +on regexTest(strRegex, str) + set ca to current application + set oString to ca's NSString's stringWithString:str + ((ca's NSRegularExpression's regularExpressionWithPattern:strRegex ¬ + options:((ca's NSRegularExpressionAnchorsMatchLines as integer)) ¬ + |error|:(missing value))'s firstMatchInString:oString options:0 ¬ + range:{location:0, |length|:oString's |length|()}) is not missing value +end regexTest + +-- 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 + +-- 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 diff --git a/Task/Strip-whitespace-from-a-string-Top-and-tail/AppleScript/strip-whitespace-from-a-string-top-and-tail-2.applescript b/Task/Strip-whitespace-from-a-string-Top-and-tail/AppleScript/strip-whitespace-from-a-string-top-and-tail-2.applescript new file mode 100644 index 0000000000..03239e7edc --- /dev/null +++ b/Task/Strip-whitespace-from-a-string-Top-and-tail/AppleScript/strip-whitespace-from-a-string-top-and-tail-2.applescript @@ -0,0 +1,5 @@ +{"-->Much Ado About Nothing + + <--", "--> + + Much Ado About Nothing<--", "-->Much Ado About Nothing<--"} diff --git a/Task/Strip-whitespace-from-a-string-Top-and-tail/Elixir/strip-whitespace-from-a-string-top-and-tail.elixir b/Task/Strip-whitespace-from-a-string-Top-and-tail/Elixir/strip-whitespace-from-a-string-top-and-tail.elixir index 015de1bf66..769fed0f0f 100644 --- a/Task/Strip-whitespace-from-a-string-Top-and-tail/Elixir/strip-whitespace-from-a-string-top-and-tail.elixir +++ b/Task/Strip-whitespace-from-a-string-Top-and-tail/Elixir/strip-whitespace-from-a-string-top-and-tail.elixir @@ -1,4 +1,4 @@ -str = "\n \t foo bar \t \n" +str = "\n \t foo \n\t bar \t \n" IO.inspect String.strip(str) IO.inspect String.rstrip(str) IO.inspect String.lstrip(str) diff --git a/Task/Strip-whitespace-from-a-string-Top-and-tail/Forth/strip-whitespace-from-a-string-top-and-tail.fth b/Task/Strip-whitespace-from-a-string-Top-and-tail/Forth/strip-whitespace-from-a-string-top-and-tail-1.fth similarity index 100% rename from Task/Strip-whitespace-from-a-string-Top-and-tail/Forth/strip-whitespace-from-a-string-top-and-tail.fth rename to Task/Strip-whitespace-from-a-string-Top-and-tail/Forth/strip-whitespace-from-a-string-top-and-tail-1.fth diff --git a/Task/Strip-whitespace-from-a-string-Top-and-tail/Forth/strip-whitespace-from-a-string-top-and-tail-2.fth b/Task/Strip-whitespace-from-a-string-Top-and-tail/Forth/strip-whitespace-from-a-string-top-and-tail-2.fth new file mode 100644 index 0000000000..435f173a54 --- /dev/null +++ b/Task/Strip-whitespace-from-a-string-Top-and-tail/Forth/strip-whitespace-from-a-string-top-and-tail-2.fth @@ -0,0 +1 @@ + : trim ( addr len -- addr' len') -leading -trailing ; diff --git a/Task/Strip-whitespace-from-a-string-Top-and-tail/REXX/strip-whitespace-from-a-string-top-and-tail-1.rexx b/Task/Strip-whitespace-from-a-string-Top-and-tail/REXX/strip-whitespace-from-a-string-top-and-tail-1.rexx index e2b3250b87..62df314808 100644 --- a/Task/Strip-whitespace-from-a-string-Top-and-tail/REXX/strip-whitespace-from-a-string-top-and-tail-1.rexx +++ b/Task/Strip-whitespace-from-a-string-Top-and-tail/REXX/strip-whitespace-from-a-string-top-and-tail-1.rexx @@ -1,36 +1,28 @@ -/*REXX program to show how to strip leading and/or trailing spaces. */ +/*REXX program demonstrates how to strip leading and/or trailing spaces (blanks). */ +yyy=" this is a string that has leading/embedded/trailing blanks, fur shure. " +say 'YYY──►'yyy"◄──" /*display the original string + fence. */ + /*white space also includes tabs (VT, HT), among other characters.*/ -yyy=" this is a string that has leading/embedded/trailing blanks, fur shure. " + /*all examples in each group are equivalent, only the opton's 1st */ + /*character is examined. */ +noL=strip(yyy,'L') /*elide any leading white space. */ +noL=strip(yyy,"l") /* (the same as the above statement.) */ +noL=strip(yyy,'leading') /* " " " " " " */ +say 'noL──►'noL"◄──" /*display the string with a title+fence*/ - /*white space also includes tabs (VT & HT),*/ - /*among other characters. */ +noT=strip(yyy,'T') /*elide any trailing white space. */ +noT=strip(yyy,"t") /* (the same as the above statement.) */ +noT=strip(yyy,'trailing') /* " " " " " " */ +say 'noT──►'noT"◄──" /*display the string with a title+fence*/ - /*all examples in each group are equivalent*/ - /*only the option's first char is examined.*/ +noB=strip(yyy) /*elide leading & trailing white space.*/ +noB=strip(yyy,) /* (the same as the above statement.) */ +noB=strip(yyy,'B') /* " " " " " " */ +noB=strip(yyy,"b") /* " " " " " " */ +noB=strip(yyy,'both') /* " " " " " " */ +say 'noB──►'noB"◄──" /*display the string with a title+fence*/ - /*───────────────────────just remove the leading white space. */ -noL=strip(yyy,'L') -noL=strip(yyy,"l") -noL=strip(yyy,'leading') -g="Listen, birds / those signs cost money / so roost a while / but don't get funny / Burma-shave" -noL=strip(yyy,g) /*a long way to go to fetch a pail of water.*/ - - /*───────────────────────just remove the trailing white space. */ -noT=strip(yyy,'T') -noT=strip(yyy,"t") -noT=strip(yyy,'trailing') -noT=strip(yyy,'trains ride the rails') -j="Toughest Whiskers / In the town / We hold 'em up / You mow 'em down / Burma-Shave" -noT=strip(yyy,j) - - /*───────────────────────remove leading and trailing white space. */ -noB=strip(yyy) -noB=strip(yyy,) -noB=strip(yyy,'B') -noB=strip(yyy,"b") -noB=strip(yyy,'both') -opt='Be a noble / Not a knave / Caesar uses / Burma-Shave' -noB=strip(yyy,opt) - - /*───────────────────────also remove all superfluous white space, */ -noX=space(yyy) /* including white space between words. */ + /*elide leading & trailing white space,*/ +noX=space(yyy) /* including white space between words.*/ +say 'nox──►'noX"◄──" /*display the string with a title+fence*/ + /*stick a fork in it, we're all done. */ diff --git a/Task/Strip-whitespace-from-a-string-Top-and-tail/SNOBOL4/strip-whitespace-from-a-string-top-and-tail.sno b/Task/Strip-whitespace-from-a-string-Top-and-tail/SNOBOL4/strip-whitespace-from-a-string-top-and-tail.sno new file mode 100644 index 0000000000..a7bed6c23b --- /dev/null +++ b/Task/Strip-whitespace-from-a-string-Top-and-tail/SNOBOL4/strip-whitespace-from-a-string-top-and-tail.sno @@ -0,0 +1,19 @@ + s1 = s2 = " Hello, people of earth! " + s2 = CHAR(3) s2 CHAR(134) + &ALPHABET TAB(33) . prechars + &ALPHABET POS(127) RTAB(0) . postchars + stripchars = " " prechars postchars + +* TRIM() removes final spaces and tabs: + OUTPUT = "Original: >" s1 "<" + OUTPUT = "With trim() >" REVERSE(TRIM(REVERSE(TRIM(s1)))) "<" + +* Remove all non-printing characters: + OUTPUT = "Original: >" s2 "<" + s1 POS(0) SPAN(stripchars) = + OUTPUT = "Leading: >" s1 "<" + s2 ARB . s2 SPAN(stripchars) RPOS(0) + OUTPUT = "Trailing: >" s2 "<" + s2 POS(0) SPAN(stripchars) = + OUTPUT = "Full trim: >" s2 "<" +END diff --git a/Task/Strip-whitespace-from-a-string-Top-and-tail/TXR/strip-whitespace-from-a-string-top-and-tail-4.txr b/Task/Strip-whitespace-from-a-string-Top-and-tail/TXR/strip-whitespace-from-a-string-top-and-tail-4.txr index 4d6f0abebe..7a57422048 100644 --- a/Task/Strip-whitespace-from-a-string-Top-and-tail/TXR/strip-whitespace-from-a-string-top-and-tail-4.txr +++ b/Task/Strip-whitespace-from-a-string-Top-and-tail/TXR/strip-whitespace-from-a-string-top-and-tail-4.txr @@ -1,10 +1,8 @@ -@(do - (defun trim-right (str) - (for () - ((and (> (length str) 0) (chr-isspace [str -1])) str) - ((del [str -1])))) - - (format t "{~a}\n" (trim-right " a a ")) - (format t "{~a}\n" (trim-right " ")) - (format t "{~a}\n" (trim-right "a ")) - (format t "{~a}\n" (trim-right ""))) +(defun trim-right (str) + (for () + ((and (> (length str) 0) (chr-isspace [str -1])) str) + ((del [str -1])))) +(format t "{~a}\n" (trim-right " a a ")) +(format t "{~a}\n" (trim-right " ")) +(format t "{~a}\n" (trim-right "a ")) +(format t "{~a}\n" (trim-right "")) diff --git a/Task/Substring-Top-and-tail/00DESCRIPTION b/Task/Substring-Top-and-tail/00DESCRIPTION index 0eee731225..465de69535 100644 --- a/Task/Substring-Top-and-tail/00DESCRIPTION +++ b/Task/Substring-Top-and-tail/00DESCRIPTION @@ -1,7 +1,15 @@ -The task is to demonstrate how to remove the first and last characters from a string. The solution should demonstrate how to obtain the following results: +The task is to demonstrate how to remove the first and last characters from a string. + +The solution should demonstrate how to obtain the following results: * String with first character removed * String with last character removed * String with both the first and last characters removed -If the program uses UTF-8 or UTF-16, it must work on any valid Unicode code point, whether in the Basic Multilingual Plane or above it. The program must reference logical characters (code points), not 8-bit code units for UTF-8 or 16-bit code units for UTF-16. Programs for other encodings (such as 8-bit ASCII, or EUC-JP) are not required to handle all Unicode characters. +
    +If the program uses UTF-8 or UTF-16, it must work on any valid Unicode code point, whether in the Basic Multilingual Plane or above it. + +The program must reference logical characters (code points), not 8-bit code units for UTF-8 or 16-bit code units for UTF-16. + +Programs for other encodings (such as 8-bit ASCII, or EUC-JP) are not required to handle all Unicode characters. +

    diff --git a/Task/Substring-Top-and-tail/REXX/substring-top-and-tail-1.rexx b/Task/Substring-Top-and-tail/REXX/substring-top-and-tail-1.rexx index a1d3705b0c..9e337ea986 100644 --- a/Task/Substring-Top-and-tail/REXX/substring-top-and-tail-1.rexx +++ b/Task/Substring-Top-and-tail/REXX/substring-top-and-tail-1.rexx @@ -1,13 +1,11 @@ -/*REXX program demonstrates removal of 1st/last/1st&last chars from a string. */ +/*REXX program demonstrates removal of 1st/last/1st-and-last characters from a string.*/ @ = 'abcdefghijk' say ' the original string =' @ -say 'string first character removed =' substr(@,2) -say 'string last character removed =' left(@,length(@)-1) -say 'string first & last character removed =' substr(@,2,length(@)-2) - /*stick a fork in it, we're all done. */ - - /* ╔═══════════════════════════════════════════════════════╗ - ║ However, the original string may be null or exactly ║ - ║ one byte in length which will cause the BIFs to ║ - ║ fail because of either zero or a negative length. ║ - ╚═══════════════════════════════════════════════════════╝ */ +say 'string first character removed =' substr(@, 2) +say 'string last character removed =' left(@, length(@) -1) +say 'string first & last character removed =' substr(@, 2, length(@) -2) + /*stick a fork in it, we're all done. */ + /* ╔═══════════════════════════════════════════════════════════════════════════════╗ + ║ However, the original string may be null or exactly one byte in length which ║ + ║ will cause the BIFs to fail because of either zero or a negative length. ║ + ╚═══════════════════════════════════════════════════════════════════════════════╝ */ diff --git a/Task/Substring-Top-and-tail/REXX/substring-top-and-tail-2.rexx b/Task/Substring-Top-and-tail/REXX/substring-top-and-tail-2.rexx index c536dcb34a..0400b297bf 100644 --- a/Task/Substring-Top-and-tail/REXX/substring-top-and-tail-2.rexx +++ b/Task/Substring-Top-and-tail/REXX/substring-top-and-tail-2.rexx @@ -1,15 +1,15 @@ -/*REXX program demonstrates removal of 1st/last/1st&last chars from a string. */ +/*REXX program demonstrates removal of 1st/last/1st-and-last characters from a string.*/ @ = 'abcdefghijk' say ' the original string =' @ -say 'string first character removed =' substr(@,2) -say 'string last character removed =' left(@,max(0,length(@)-1)) -say 'string first & last character removed =' substr(@,2,max(0,length(@)-2)) -exit /*stick a fork in it, we're all done. */ +say 'string first character removed =' substr(@, 2) +say 'string last character removed =' left(@, max(0, length(@) -1)) +say 'string first & last character removed =' substr(@, 2, max(0, length(@) -2)) +exit /*stick a fork in it, we're all done. */ - /* [↓] an easier to read version using a length variable.*/ + /* [↓] an easier to read version using a length variable.*/ @ = 'abcdefghijk' L=length(@) say ' the original string =' @ -say 'string first character removed =' substr(@,2) -say 'string last character removed =' left(@,max(0,L-1)) -say 'string first & last character removed =' substr(@,2,max(0,L-2)) +say 'string first character removed =' substr(@, 2) +say 'string last character removed =' left(@, max(0, L-1) ) +say 'string first & last character removed =' substr(@, 2, max(0, L-2) ) diff --git a/Task/Substring-Top-and-tail/REXX/substring-top-and-tail-3.rexx b/Task/Substring-Top-and-tail/REXX/substring-top-and-tail-3.rexx index 766b217fc0..cf43b85863 100644 --- a/Task/Substring-Top-and-tail/REXX/substring-top-and-tail-3.rexx +++ b/Task/Substring-Top-and-tail/REXX/substring-top-and-tail-3.rexx @@ -1,16 +1,15 @@ -/*REXX program demonstrates removal of 1st/last/1st&last chars from a string. */ +/*REXX program demonstrates removal of 1st/last/1st-and-last characters from a string.*/ @ = 'abcdefghijk' say ' the original string =' @ parse var @ 2 z say 'string first character removed =' z -m=length(@)-1 +m=length(@) - 1 parse var @ z +(m) say 'string last character removed =' z -n=length(@)-2 +n=length(@) - 2 parse var @ 2 z +(n) -if n==0 then z= /*handle special case of a length of 2.*/ -say 'string first & last character removed =' z - /*stick a fork in it, we're all done. */ +if n==0 then z= /*handle special case of a length of 2.*/ +say 'string first & last character removed =' z /*stick a fork in it, we're all done. */ diff --git a/Task/Substring-Top-and-tail/Smalltalk/substring-top-and-tail.st b/Task/Substring-Top-and-tail/Smalltalk/substring-top-and-tail.st new file mode 100644 index 0000000000..a412a6a2cb --- /dev/null +++ b/Task/Substring-Top-and-tail/Smalltalk/substring-top-and-tail.st @@ -0,0 +1,5 @@ +s := 'upraisers'. +Transcript show: 'Top: ', s allButLast; nl. +Transcript show: 'Tail: ', s allButFirst; nl. +Transcript show: 'Without both: ', s allButFirst allButLast; nl. +Transcript show: 'Without both using substring method: ', (s copyFrom: 2 to: s size - 1); nl. diff --git a/Task/Substring-Top-and-tail/ZX-Spectrum-Basic/substring-top-and-tail.zx b/Task/Substring-Top-and-tail/ZX-Spectrum-Basic/substring-top-and-tail.zx index d51cae28ab..61073a3740 100644 --- a/Task/Substring-Top-and-tail/ZX-Spectrum-Basic/substring-top-and-tail.zx +++ b/Task/Substring-Top-and-tail/ZX-Spectrum-Basic/substring-top-and-tail.zx @@ -1,4 +1,4 @@ -10 PRINT FN f$("knight"): REM strip the first letter +10 PRINT FN f$("knight"): REM strip the first letter. You can also write PRINT "knight"(2 TO) 20 PRINT FN l$("socks"): REM strip the last letter 30 PRINT FN b$("brooms"): REM strip both the first and last letter 100 STOP diff --git a/Task/Substring/00DESCRIPTION b/Task/Substring/00DESCRIPTION index 8465f453d9..7f1f27f4b1 100644 --- a/Task/Substring/00DESCRIPTION +++ b/Task/Substring/00DESCRIPTION @@ -8,6 +8,11 @@ In this task display a substring: * starting from a known character within the string and of m length; * starting from a known substring within the string and of m length. +
    If the program uses UTF-8 or UTF-16, it must work on any valid Unicode code point, whether in the Basic Multilingual Plane or above it. -The program must reference logical characters (code points), not 8-bit code units for UTF-8 or 16-bit code units for UTF-16. Programs for other encodings (such as 8-bit ASCII, or EUC-JP) are not required to handle all Unicode characters. + +The program must reference logical characters (code points), not 8-bit code units for UTF-8 or 16-bit code units for UTF-16. + +Programs for other encodings (such as 8-bit ASCII, or EUC-JP) are not required to handle all Unicode characters. +

    diff --git a/Task/Substring/AppleScript/substring.applescript b/Task/Substring/AppleScript/substring.applescript new file mode 100644 index 0000000000..527df36daf --- /dev/null +++ b/Task/Substring/AppleScript/substring.applescript @@ -0,0 +1,101 @@ +-- SUBSTRING PRIMITIVES + +-- take :: Int -> Text -> Text +on take(n, s) + text 1 thru n of s +end take + +-- drop :: Int -> Text -> Text +on drop(n, s) + text (n + 1) thru -1 of s +end drop + +-- breakOn :: Text -> Text -> (Text, Text) +on breakOn(strPattern, s) + set {dlm, my text item delimiters} to {my text item delimiters, strPattern} + set lstParts to text items of s + set my text item delimiters to dlm + {item 1 of lstParts, strPattern & (item 2 of lstParts)} +end breakOn + +-- init :: Text -> Text +on init(s) + if length of s > 0 then + text 1 thru -2 of s + else + missing value + end if +end init + + +-- TEST + +on run + set str to "一二三四五六七八九十" + + set legends to {¬ + "from n in, of n length", ¬ + "from n in, up to end", ¬ + "all but last", ¬ + "from matching char, of m length", ¬ + "from matching string, of m length"} + + set parts to {¬ + take(3, drop(4, str)), ¬ + drop(3, str), ¬ + init(str), ¬ + take(3, item 2 of breakOn("五", str)), ¬ + take(4, item 2 of breakOn("六七", str))} + + script tabulate + property strPad : " " + + on lambda(l, r) + l & drop(length of l, strPad) & r + end lambda + end script + + linefeed & intercalate(linefeed, ¬ + zipWith(tabulate, ¬ + legends, parts)) & linefeed +end run + + + +-- GENERIC LIBRARY FUNCTIONS – FOR FORMATTING RESULTS + +-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] +on zipWith(f, xs, ys) + set lng to length of xs + if lng is not length of ys then + missing value + else + tell mReturn(f) + set lst to {} + 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 + +-- intercalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate + +-- 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 diff --git a/Task/Substring/BASIC/substring-3.basic b/Task/Substring/BASIC/substring-3.basic new file mode 100644 index 0000000000..7132d2c04e --- /dev/null +++ b/Task/Substring/BASIC/substring-3.basic @@ -0,0 +1,12 @@ +10 LET A$="abcdefghijklmnopqrstuvwxyz": LET la=LEN A$ +20 LET n=10: LET m=7 +30 PRINT A$(n TO n+m-1) +40 PRINT A$(n TO ) +50 PRINT A$( TO la-1) +60 FOR i=1 TO la +70 IF A$(i)="g" THEN PRINT A$(i TO i+m-1): LET i=la +80 NEXT i +90 LET B$="ijk": LET lb=LEN b$ +100 FOR i=1 TO la-lb+1 +110 IF A$(i TO i+lb-1)=B$ THEN PRINT A$(i TO i+m-1): LET i=la-lb+1 +120 NEXT i diff --git a/Task/Substring/COBOL/substring.cobol b/Task/Substring/COBOL/substring.cobol new file mode 100644 index 0000000000..6f2eb7327a --- /dev/null +++ b/Task/Substring/COBOL/substring.cobol @@ -0,0 +1,56 @@ + identification division. + program-id. substring. + + environment division. + configuration section. + repository. + function all intrinsic. + + data division. + working-storage section. + 01 original. + 05 value "this is a string". + 01 starting pic 99 value 3. + 01 width pic 99 value 8. + 01 pos pic 99. + 01 ender pic 99. + 01 looking pic 99. + 01 indicator pic x. + 88 found value high-value when set to false is low-value. + 01 look-for pic x(8). + + procedure division. + substring-main. + + display "Original |" original "|, n = " starting " m = " width + display original(starting : width) + display original(starting :) + display original(1 : length(original) - 1) + + move "a" to look-for + move 1 to looking + perform find-position + if found + display original(pos : width) + end-if + + move "is a st" to look-for + move length(trim(look-for)) to looking + perform find-position + if found + display original(pos : width) + end-if + goback. + + find-position. + set found to false + compute ender = length(original) - looking + perform varying pos from 1 by 1 until pos > ender + if original(pos : looking) equal look-for then + set found to true + exit perform + end-if + end-perform + . + + end program substring. diff --git a/Task/Substring/Elena/substring.elena b/Task/Substring/Elena/substring.elena new file mode 100644 index 0000000000..cf8667b7dd --- /dev/null +++ b/Task/Substring/Elena/substring.elena @@ -0,0 +1,17 @@ +#import system. +#import extensions. + +#symbol program = +[ + #var s := "0123456789". + #var n := 3. + #var m := 2. + #var c := #51. + #var z := "345". + + console writeLine:(s Substring:m &at:n). + console writeLine:(s Substring:(s length - n) &at:n). + console writeLine:(s Substring:(s length - 1) &at:0). + console writeLine:(s Substring:m &at:(s indexOf:c &at:0)). + console writeLine:(s Substring:m &at:(s indexOf:z &at:0)). +]. diff --git a/Task/Substring/Elixir/substring.elixir b/Task/Substring/Elixir/substring.elixir index 0072f1fa81..8c64366382 100644 --- a/Task/Substring/Elixir/substring.elixir +++ b/Task/Substring/Elixir/substring.elixir @@ -3,3 +3,10 @@ String.slice(s, 2, 3) #=> "cde" String.slice(s, 1..3) #=> "bcd" String.slice(s, -3, 2) #=> "fg" String.slice(s, 3..-1) #=> "defgh" + +# UTF-8 +s = "αβγδεζηθ" +String.slice(s, 2, 3) #=> "γδε" +String.slice(s, 1..3) #=> "βγδ" +String.slice(s, -3, 2) #=> "ζη" +String.slice(s, 3..-1) #=> "δεζηθ" diff --git a/Task/Substring/JavaScript/substring.js b/Task/Substring/JavaScript/substring-1.js similarity index 100% rename from Task/Substring/JavaScript/substring.js rename to Task/Substring/JavaScript/substring-1.js diff --git a/Task/Substring/JavaScript/substring-2.js b/Task/Substring/JavaScript/substring-2.js new file mode 100644 index 0000000000..4cc091cc4d --- /dev/null +++ b/Task/Substring/JavaScript/substring-2.js @@ -0,0 +1,57 @@ +(function () { + 'use strict'; + + // take :: Int -> Text -> Text + function take(n, s) { + return s.substr(0, n); + } + + // drop :: Int -> Text -> Text + function drop(n, s) { + return s.substr(n); + } + + + // init :: Text -> Text + function init(s) { + var n = s.length; + return (n > 0 ? s.substr(0, n - 1) : undefined); + } + + // breakOn :: Text -> Text -> (Text, Text) + function breakOn(strPattern, s) { + var i = s.indexOf(strPattern); + return i === -1 ? [strPattern, ''] : [s.substr(0, i), s.substr(i)]; + } + + + var str = '一二三四五六七八九十'; + + + return JSON.stringify({ + + 'from n in, of m length': (function (n, m) { + return take(m, drop(n, str)); + })(4, 3), + + + 'from n in, up to end' :(function (n) { + return drop(n, str); + })(3), + + + 'all but last' : init(str), + + + 'from matching char, of m length' : (function (pattern, s, n) { + return take(n, breakOn(pattern, s)[1]); + })('五', str, 3), + + + 'from matching string, of m length':(function (pattern, s, n) { + return take(n, breakOn(pattern, s)[1]); + })('六七', str, 4) + + }, null, 2); + +})(); diff --git a/Task/Substring/JavaScript/substring-3.js b/Task/Substring/JavaScript/substring-3.js new file mode 100644 index 0000000000..e05332e01a --- /dev/null +++ b/Task/Substring/JavaScript/substring-3.js @@ -0,0 +1,7 @@ +{ + "from n in, of m length": "五六七", + "from n in, up to end": "四五六七八九十", + "all but last": "一二三四五六七八九", + "from matching char, of m length": "五六七", + "from matching string, of m length": "六七八九" +} diff --git a/Task/Substring/PARI-GP/substring.pari b/Task/Substring/PARI-GP/substring.pari new file mode 100644 index 0000000000..f9de004306 --- /dev/null +++ b/Task/Substring/PARI-GP/substring.pari @@ -0,0 +1,23 @@ +\\ Returns the substring of string str specified by the start position s and length n. +\\ If n=0 then to the end of str. +\\ ssubstr() 3/5/16 aev +ssubstr(str,s=1,n=0)={ +my(vt=Vecsmall(str),ve,vr,vtn=#str,n1); +if(vtn==0,return("")); +if(s<1||s>vtn,return(str)); +n1=vtn-s+1; if(n==0,n=n1); if(n>n1,n=n1); +ve=vector(n,z,z-1+s); vr=vecextract(vt,ve); return(Strchr(vr)); +} + +{\\ TEST +my(s="ABCDEFG",ns=#s); +print(" *** Testing ssubstr():"); +print("1.",ssubstr(s,2,3)); +print("2.",ssubstr(s)); +print("3.",ssubstr(s,,ns-1)); +print("4.",ssubstr(s,2)); +print("5.",ssubstr(s,,4)); +print("6.",ssubstr(s,0,4)); +print("7.",ssubstr(s,3,7)); +print("8.|",ssubstr("",1,4),"|"); +} diff --git a/Task/Substring/REXX/substring.rexx b/Task/Substring/REXX/substring.rexx index 58369e5bdf..932a32c763 100644 --- a/Task/Substring/REXX/substring.rexx +++ b/Task/Substring/REXX/substring.rexx @@ -1,37 +1,32 @@ -/*REXX program demonstrates various ways to extract substrings from a string of characters. */ -s='abcdefghijk'; n=4; m=3 /*define some REXX constants (string, index, length of string).*/ -say 'original string='s /* [↑] M can be zero (which indicates a null string). */ - say '──────────────────────────────────────────────────────────1' - -u=substr(s,n,m) /*starting from N characters in and of M length. */ +/*REXX program demonstrates various ways to extract substrings from a string of characters.*/ +$='abcdefghijk'; n=4; m=3 /*define some constants: string, index, length of string. */ +say 'original string='$ /* [↑] M can be zero (which indicates a null string).*/ +L=length($) /*the length of the $ string (in bytes or characters).*/ + say center(1,30,'═') /*show a centered title for the 1st task requirement. */ +u=substr($, n, m) /*start from N characters in and of M length. */ say u -parse var s =(n) a +(m) /*another way of doing the above by using the PARSE instruction*/ +parse var $ =(n) a +(m) /*an alternate method by using the PARSE instruction. */ say a - say '──────────────────────────────────────────────────────────2' - -u=substr(s,n) /*starting from N characters in, up to the end-of-string. */ + say center(2,30,'═') /*show a centered title for the 2nd task requirement. */ +u=substr($,n) /*start from N characters in, up to the end-of-string. */ say u -parse var s =(n) a /*another way of doing the above by using the PARSE instruction*/ +parse var $ =(n) a /*an alternate method by using the PARSE instruction. */ say a - say '──────────────────────────────────────────────────────────3' - -u=substr(s,1,length(s)-1) /*OK: the whole string except the last character. */ + say center(3,30,'═') /*show a centered title for the 3rd task requirement. */ +u=substr($, 1, L-1) /*OK: the entire string except the last character. */ say u -v=substr(s,1,max(0,length(s)-1)) /*better: this version handles the case of a null string. */ +v=substr($, 1, max(0, L-1) ) /*better: this version handles the case of a null string. */ say v -L=length(s) - 1 -parse var s a +(L) /*another way of doing the above by using the PARSE instruction*/ +lm=L-1 +parse var $ a +(lm) /*an alternate method by using the PARSE instruction. */ say a - say '──────────────────────────────────────────────────────────4' - -u=substr(s,pos('g',s),m) /*starting from a known char within the string & of M length.*/ + say center(4,30,'═') /*show a centered title for the 4th task requirement. */ +u=substr($,pos('g',$), m) /*start from a known char within the string of length M. */ say u -parse var s 'g' a +(m) /*another way of doing the above by using the PARSE instruction*/ +parse var $ 'g' a +(m) /*an alternate method by using the PARSE instruction. */ say a - say '──────────────────────────────────────────────────────────5' - -u=substr(s,pos('def',s),m) /*starting from a known substr within the string & of M length.*/ + say center(5,30,'═') /*show a centered title for the 5th task requirement. */ +u=substr($,pos('def',$),m) /*start from a known substr within the string of length M.*/ say u -parse var s 'def' a +(m) /*another way of doing the above by using the PARSE instruction*/ -say a - /*stick a fork in it sir, we're all done and Bob's your uncle. */ +parse var $ 'def' a +(m) /*an alternate method by using the PARSE instruction. */ +say a /*stick a fork in it, we're all done and Bob's your uncle.*/ diff --git a/Task/Subtractive-generator/00DESCRIPTION b/Task/Subtractive-generator/00DESCRIPTION index 6b0d9780fa..9515ee5b48 100644 --- a/Task/Subtractive-generator/00DESCRIPTION +++ b/Task/Subtractive-generator/00DESCRIPTION @@ -1,34 +1,35 @@ A ''subtractive generator'' calculates a sequence of [[random number generator|random numbers]], where each number is congruent to the subtraction of two previous numbers from the sequence.
    The formula is -* r_n = r_{(n - i)} - r_{(n - j)} \pmod m +* r_n = r_{(n - i)} - r_{(n - j)} \pmod m -for some fixed values of i, j and m, all positive integers. Supposing that i > j, then the state of this generator is the list of the previous numbers from r_{n - i} to r_{n - 1}. Many states generate uniform random integers from 0 to m - 1, but some states are bad. A state, filled with zeros, generates only zeros. If m is even, then a state, filled with even numbers, generates only even numbers. More generally, if f is a factor of m, then a state, filled with multiples of f, generates only multiples of f. +for some fixed values of i, j and m, all positive integers. Supposing that i > j, then the state of this generator is the list of the previous numbers from r_{n - i} to r_{n - 1}. Many states generate uniform random integers from 0 to m - 1, but some states are bad. A state, filled with zeros, generates only zeros. If m is even, then a state, filled with even numbers, generates only even numbers. More generally, if f is a factor of m, then a state, filled with multiples of f, generates only multiples of f. -All subtractive generators have some weaknesses. The formula correlates r_n, r_{(n - i)} and r_{(n - j)}; these three numbers are not independent, as true random numbers would be. Anyone who observes i consecutive numbers can predict the next numbers, so the generator is not cryptographically secure. The authors of ''Freeciv'' ([http://svn.gna.org/viewcvs/freeciv/trunk/utility/rand.c?view=markup utility/rand.c]) and ''xpat2'' (src/testit2.c) knew another problem: the low bits are less random than the high bits. +All subtractive generators have some weaknesses. The formula correlates r_n, r_{(n - i)} and r_{(n - j)}; these three numbers are not independent, as true random numbers would be. Anyone who observes i consecutive numbers can predict the next numbers, so the generator is not cryptographically secure. The authors of ''Freeciv'' ([http://svn.gna.org/viewcvs/freeciv/trunk/utility/rand.c?view=markup utility/rand.c]) and ''xpat2'' (src/testit2.c) knew another problem: the low bits are less random than the high bits. -The subtractive generator has a better reputation than the [[linear congruential generator]], perhaps because it holds more state. A subtractive generator might never multiply numbers: this helps where multiplication is slow. A subtractive generator might also avoid division: the value of r_{(n - i)} - r_{(n - j)} is always between -m and m, so a program only needs to add m to negative numbers. +The subtractive generator has a better reputation than the [[linear congruential generator]], perhaps because it holds more state. A subtractive generator might never multiply numbers: this helps where multiplication is slow. A subtractive generator might also avoid division: the value of r_{(n - i)} - r_{(n - j)} is always between -m and m, so a program only needs to add m to negative numbers. -The choice of i and j affects the period of the generator. A popular choice is i = 55 and j = 24, so the formula is +The choice of i and j affects the period of the generator. A popular choice is i = 55 and j = 24, so the formula is -* r_n = r_{(n - 55)} - r_{(n - 24)} \pmod m +* r_n = r_{(n - 55)} - r_{(n - 24)} \pmod m The subtractive generator from ''xpat2'' uses -* r_n = r_{(n - 55)} - r_{(n - 24)} \pmod{10^9} +* r_n = r_{(n - 55)} - r_{(n - 24)} \pmod{10^9} The implementation is by J. Bentley and comes from program_tools/universal.c of [ftp://dimacs.rutgers.edu/pub/netflow/ the DIMACS (netflow) archive] at Rutgers University. It credits Knuth, [[wp:The Art of Computer Programming|''TAOCP'']], Volume 2, Section 3.2.2 (Algorithm A). Bentley uses this clever algorithm to seed the generator. -# Start with a single seed in range 0 to 10^9 - 1. -# Set s_0 = seed and s_1 = 1. The inclusion of s_1 = 1 avoids some bad states (like all zeros, or all multiples of 10). -# Compute s_2, s_3, ..., s_{54} using the subtractive formula s_n = s_{(n - 2)} - s_{(n - 1)} \pmod{10^9}. -# Reorder these 55 values so r_0 = s_{34}, r_1 = s_{13}, r_2 = s_{47}, ..., r_n = s_{(34 * (n + 1) \pmod{55})}. -#* This is the same order as s_0 = r_{54}, s_1 = r_{33}, s_2 = r_{12}, ..., s_n = r_{((34 * n) - 1 \pmod{55})}. +# Start with a single seed in range 0 to 10^9 - 1. +# Set s_0 = seed and s_1 = 1. The inclusion of s_1 = 1 avoids some bad states (like all zeros, or all multiples of 10). +# Compute s_2, s_3, ..., s_{54} using the subtractive formula s_n = s_{(n - 2)} - s_{(n - 1)} \pmod{10^9}. +# Reorder these 55 values so r_0 = s_{34}, r_1 = s_{13}, r_2 = s_{47}, ..., r_n = s_{(34 * (n + 1) \pmod{55})}. +#* This is the same order as s_0 = r_{54}, s_1 = r_{33}, s_2 = r_{12}, ..., s_n = r_{((34 * n) - 1 \pmod{55})}. #* This rearrangement exploits how 34 and 55 are relatively prime. -# Compute the next 165 values r_{55} to r_{219}. Store the last 55 values. +# Compute the next 165 values r_{55} to r_{219}. Store the last 55 values. -This generator yields the sequence r_{220}, r_{221}, r_{222} and so on. For example, if the seed is 292929, then the sequence begins with r_{220} = 467478574, r_{221} = 512932792, r_{222} = 539453717. By starting at r_{220}, this generator avoids a bias from the first numbers of the sequence. This generator must store the last 55 numbers of the sequence, so to compute the next r_n. Any array or list would work; a [[ring buffer]] is ideal but not necessary. +This generator yields the sequence r_{220}, r_{221}, r_{222} and so on. For example, if the seed is 292929, then the sequence begins with r_{220} = 467478574, r_{221} = 512932792, r_{222} = 539453717. By starting at r_{220}, this generator avoids a bias from the first numbers of the sequence. This generator must store the last 55 numbers of the sequence, so to compute the next r_n. Any array or list would work; a [[ring buffer]] is ideal but not necessary. Implement a subtractive generator that replicates the sequences from ''xpat2''. +

    diff --git a/Task/Subtractive-generator/Elixir/subtractive-generator.elixir b/Task/Subtractive-generator/Elixir/subtractive-generator.elixir new file mode 100644 index 0000000000..2897fc3b10 --- /dev/null +++ b/Task/Subtractive-generator/Elixir/subtractive-generator.elixir @@ -0,0 +1,20 @@ +defmodule Subtractive do + def new(seed) when seed in 0..999_999_999 do + s = Enum.reduce(1..53, [1, seed], fn _,[a,b|_]=acc -> [b-a | acc] end) + |> Enum.reverse + |> List.to_tuple + state = for i <- 1..55, do: elem(s, rem(34*i, 55)) + {:ok, _pid} = Agent.start_link(fn -> state end, name: :Subtractive) + Enum.each(1..220, fn _ -> rand end) # Discard first 220 elements of sequence. + end + + def rand do + state = Agent.get(:Subtractive, &(&1)) + n = rem(Enum.at(state, -55) - Enum.at(state, -24) + 1_000_000_000, 1_000_000_000) + :ok = Agent.update(:Subtractive, fn _ -> tl(state) ++ [n] end) + hd(state) + end +end + +Subtractive.new(292929) +for _ <- 1..10, do: IO.puts Subtractive.rand diff --git a/Task/Subtractive-generator/Java/subtractive-generator.java b/Task/Subtractive-generator/Java/subtractive-generator.java new file mode 100644 index 0000000000..886716c51a --- /dev/null +++ b/Task/Subtractive-generator/Java/subtractive-generator.java @@ -0,0 +1,53 @@ +import java.util.function.IntSupplier; +import static java.util.stream.IntStream.generate; + +public class SubtractiveGenerator implements IntSupplier { + static final int MOD = 1_000_000_000; + private int[] state = new int[55]; + private int si, sj; + + public SubtractiveGenerator(int p1) { + subrandSeed(p1); + } + + void subrandSeed(int p1) { + int p2 = 1; + + state[0] = p1 % MOD; + for (int i = 1, j = 21; i < 55; i++, j += 21) { + if (j >= 55) + j -= 55; + state[j] = p2; + if ((p2 = p1 - p2) < 0) + p2 += MOD; + p1 = state[j]; + } + + si = 0; + sj = 24; + for (int i = 0; i < 165; i++) + getAsInt(); + } + + @Override + public int getAsInt() { + if (si == sj) + subrandSeed(0); + + if (si-- == 0) + si = 54; + if (sj-- == 0) + sj = 54; + + int x = state[si] - state[sj]; + if (x < 0) + x += MOD; + + return state[si] = x; + } + + public static void main(String[] args) { + generate(new SubtractiveGenerator(292_929)).limit(10) + .forEach(System.out::println); + } +} diff --git a/Task/Subtractive-generator/PowerShell/subtractive-generator.psh b/Task/Subtractive-generator/PowerShell/subtractive-generator.psh new file mode 100644 index 0000000000..6c0823b634 --- /dev/null +++ b/Task/Subtractive-generator/PowerShell/subtractive-generator.psh @@ -0,0 +1,46 @@ +function Get-SubtractiveRandom ( [int]$Seed ) + { + function Mod ( [int]$X, [int]$M = 1000000000 ) { ( $X % $M + $M ) % $M } + + If ( $Seed ) + { + $R = New-Object int[] 55 + + $N1 = 55 - 1 + $N2 = ( $N1 + 34 ) % 55 + + $R[$N1] = $Seed + $R[$N2] = 1 + + ForEach ( $x in 2..(55-1) ) + { + $N0, $N1, $N2 = $N1, $N2, ( ( $N2 + 34 ) % 55 ) + $R[$N2] = Mod ( $R[$N0] - $R[$N1] ) + } + + $i = -55 - 1 + $j = -24 - 1 + + ForEach ( $x in 55..219 ) + { + $i = ++$i % 55 + $j = ++$j % 55 + $R[$i] = Mod ( $R[$i] - $R[$j] ) + } + + $Script:RandomRing = $R + $Script:RandomIndex = $i + } + + $i = $Script:RandomIndex = ++$Script:RandomIndex % 55 + $j = ( $i + 55 - 24 ) % 55 + + return ( $Script:RandomRing[$i] = Mod ( $Script:RandomRing[$i] - $Script:RandomRing[$j] ) ) + } + + +Get-SubtractiveRandom 292929 +Get-SubtractiveRandom +Get-SubtractiveRandom +Get-SubtractiveRandom +Get-SubtractiveRandom diff --git a/Task/Subtractive-generator/REXX/subtractive-generator.rexx b/Task/Subtractive-generator/REXX/subtractive-generator.rexx index 4189269151..7c3575d3f2 100644 --- a/Task/Subtractive-generator/REXX/subtractive-generator.rexx +++ b/Task/Subtractive-generator/REXX/subtractive-generator.rexx @@ -1,23 +1,24 @@ -/*REXX pgm uses a subtractive generator, creates a sequence of random numbers.*/ -numeric digits 20; s.0=292929; s.1=1; billion=10**9 -cI=55; cJ=24; cP=34; billion=1e9 /* [↑] same*/ - do i=2 to cI-1 - s.i=mod(s(i-2) - s(i-1), billion) - end /*i*/ - do j=0 to cI-1 - r.j=s(mod(cP*(j+1), cI)) - end /*j*/ -m=219 - do k=cI to m; x=k//cI - r.x=mod(r(mod(k-cI, cI)) - r(mod(k-cJ, cI)), billion) - end /*m*/ +/*REXX program uses a subtractive generator, and creates a sequence of random numbers. */ +s.0=292929; s.1=1; billion=10**9 /* ◄────────┐ */ +numeric digits 20; billion=1e9 /*same as─►─┘ */ +cI=55; do i=2 to cI-1 + s.i=mod(s(i-2) - s(i-1), billion) + end /*i*/ +Cp=34 + do j=0 to cI-1 + r.j=s(mod(cP*(j+1), cI)) + end /*j*/ +m=219; Cj=24 + do k=cI to m; _=k//cI + r._=mod(r(mod(k-cI, cI)) - r(mod(k-cJ, cI)), billion) + end /*m*/ t=235 - do n=m+1 to t; y=n//cI - r.y=mod(r(mod(n-cI, cI)) - r(mod(n-cJ, cI)), billion) - say right(r.y, 40) - end /*n*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -mod: procedure; parse arg a,b; return ((a // b) + b) // b -r: parse arg _; return r._ -s: parse arg _; return s._ + do n=m+1 to t; _=n//cI + r._=mod(r(mod(n-cI, cI)) - r(mod(n-cJ, cI)), billion) + say right(r._, 40) + end /*n*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +mod: procedure; parse arg a,b; return ((a // b) + b) // b +r: parse arg #; return r.# +s: parse arg #; return s.# diff --git a/Task/Sudoku/00DESCRIPTION b/Task/Sudoku/00DESCRIPTION index 0246fc119a..9c9ce65af2 100644 --- a/Task/Sudoku/00DESCRIPTION +++ b/Task/Sudoku/00DESCRIPTION @@ -1,2 +1,6 @@ -Solve a partially filled-in normal 9x9 [[wp:Sudoku|Sudoku]] grid and display the result in a human-readable format. -[[wp:Algorithmics_of_sudoku|Algorithmics of Sudoku]] may help implement this. +;Task: +Solve a partially filled-in normal   9x9   [[wp:Sudoku|Sudoku]] grid   and display the result in a human-readable format. + + +[[wp:Algorithmics_of_sudoku|Algorithmics of Sudoku]]   may help implement this. +

    diff --git a/Task/Sudoku/BCPL/sudoku.bcpl b/Task/Sudoku/BCPL/sudoku.bcpl index 7971c0c8a7..0fb3c43cb9 100644 --- a/Task/Sudoku/BCPL/sudoku.bcpl +++ b/Task/Sudoku/BCPL/sudoku.bcpl @@ -1,6 +1,7 @@ // This can be run using Cintcode BCPL freely available from www.cl.cam.ac.uk/users/mr10. +// Implemented by Martin Richards. -// This is a really naive program to solve Su Doku problems. Even so it is usually quite fast. +// This is a really naive program to solve SuDoku problems. Even so it is usually quite fast. // SuDoku consists of a 9x9 grid of cells. Each cell should contain // a digit in the range 1..9. Every row, column and major 3x3 diff --git a/Task/Sudoku/Elixir/sudoku.elixir b/Task/Sudoku/Elixir/sudoku.elixir index 6107053262..94c7beb122 100644 --- a/Task/Sudoku/Elixir/sudoku.elixir +++ b/Task/Sudoku/Elixir/sudoku.elixir @@ -1,33 +1,21 @@ defmodule Sudoku do def display( grid ), do: ( for y <- 1..9, do: display_row(y, grid) ) - def start( knowns ), do: :dict.from_list( knowns ) + def start( knowns ), do: Enum.into( knowns, Map.new ) def solve( grid ) do sure = solve_all_sure( grid ) solve_unsure( potentials(sure), sure ) end - def task do - simple = [{{1, 1}, 3}, {{2, 1}, 9}, {{3, 1},4}, {{6, 1}, 2}, {{7, 1}, 6}, {{8, 1}, 7}, - {{4, 2}, 3}, {{7, 2}, 4}, - {{1, 3}, 5}, {{4, 3}, 6}, {{5, 3}, 9}, {{8, 3}, 2}, - {{2, 4}, 4}, {{3, 4}, 5}, {{7, 4}, 9}, - {{1, 5}, 6}, {{9, 5}, 7}, - {{3, 6}, 7}, {{7, 6}, 5}, {{8, 6}, 8}, - {{2, 7}, 1}, {{5, 7}, 6}, {{6, 7}, 7}, {{9, 7}, 8}, - {{3, 8}, 9}, {{6, 8}, 8}, - {{2, 9}, 2}, {{3, 9}, 6}, {{4, 9}, 4}, {{7, 9}, 7}, {{8, 9}, 3}, {{9, 9}, 5}] - task( simple ) - difficult = [{{6, 2}, 3}, {{8, 2}, 8}, {{9, 2}, 5}, - {{3, 3}, 1}, {{5, 3}, 2}, - {{4, 4}, 5}, {{6, 4}, 7}, - {{3, 5}, 4}, {{7, 5}, 1}, - {{2, 6}, 9}, - {{1, 7}, 5}, {{8, 7}, 7}, {{9, 7}, 3}, - {{3, 8}, 2}, {{5, 8}, 1}, - {{5, 9}, 4}, {{9, 9}, 9}] - task( difficult ) + def task( knowns ) do + IO.puts "start" + start = start( knowns ) + display( start ) + IO.puts "solved" + solved = solve( start ) + display( solved ) + IO.puts "" end defp bt( grid ), do: bt_reject( is_not_allowed(grid), grid ) @@ -35,7 +23,7 @@ defmodule Sudoku do defp bt_accept( true, board ), do: throw( {:ok, board} ) defp bt_accept( false, grid ), do: bt_loop( potentials_one_position(grid), grid ) - defp bt_loop( {position, values}, grid ), do: ( for x <- values, do: bt( :dict.store(position, x, grid) ) ) + defp bt_loop( {position, values}, grid ), do: ( for x <- values, do: bt( Map.put(grid, position, x) ) ) defp bt_reject( true, _grid ), do: :backtrack defp bt_reject( false, grid ), do: bt_accept( is_all_correct(grid), grid ) @@ -46,99 +34,96 @@ defmodule Sudoku do end defp display_row_group( start, row, grid ) do - for x <- [start, start+1, start+2], do: :io.fwrite(" ~c", [display_value(x, row, grid)]) - IO.write( " " ) + Enum.each(start..start+2, &IO.write " #{Map.get( grid, {&1, row}, ".")}") + IO.write " " end - defp display_row_nl( n ) when n == 3 or n == 6 or n == 9, do: IO.puts "\n" - defp display_row_nl( _N ), do: IO.puts "" + defp display_row_nl( n ) when n in [3,6,9], do: IO.puts "\n" + defp display_row_nl( _n ), do: IO.puts "" - defp display_value( x, y, grid ), do: display_value( :dict.find({x, y}, grid) ) - - defp display_value( :error ), do: ?. - defp display_value( {:ok, value} ), do: value + ?0 - - defp is_all_correct( grid ), do: :dict.size( grid ) == 81 + defp is_all_correct( grid ), do: map_size( grid ) == 81 defp is_not_allowed( grid ) do is_not_allowed_rows( grid ) or is_not_allowed_columns( grid ) or is_not_allowed_groups( grid ) end - defp is_not_allowed_columns( grid ), do: Enum.any?( values_all_columns(grid), fn x-> is_not_allowed_values(x) end) + defp is_not_allowed_columns( grid ), do: values_all_columns(grid) |> Enum.any?(&is_not_allowed_values/1) - defp is_not_allowed_groups( grid ), do: Enum.any?( values_all_groups(grid), fn x-> is_not_allowed_values(x) end) + defp is_not_allowed_groups( grid ), do: values_all_groups(grid) |> Enum.any?(&is_not_allowed_values/1) - defp is_not_allowed_rows( grid ), do: Enum.any?( values_all_rows(grid), fn x-> is_not_allowed_values(x) end) + defp is_not_allowed_rows( grid ), do: values_all_rows(grid) |> Enum.any?(&is_not_allowed_values/1) defp is_not_allowed_values( values ), do: length( values ) != length( Enum.uniq(values) ) - defp group_positions( {x, y} ), do: ( for colum <- group_positions_close(x), row <- group_positions_close(y), do: {colum, row} ) + defp group_positions( {x, y} ) do + for colum <- group_positions_close(x), row <- group_positions_close(y), do: {colum, row} + end defp group_positions_close( n ) when n < 4, do: [1,2,3] defp group_positions_close( n ) when n < 7, do: [4,5,6] defp group_positions_close( _n ) , do: [7,8,9] defp positions_not_in_grid( grid ) do - keys = :dict.fetch_keys( grid ) - for x <- 1..9, y <- 1..9, not Enum.member?(keys, {x, y}), do: {x, y} + keys = Map.keys( grid ) + for x <- 1..9, y <- 1..9, not {x, y} in keys, do: {x, y} end defp potentials_one_position( grid ) do - [{_shortest, position, values} | _t] = Enum.sort( for {position, values} <- potentials( grid ), do: {length(values), position, values} ) - {position, values} + Enum.min_by( potentials( grid ), fn {_position, values} -> length(values) end ) end defp potentials( grid ), do: List.flatten( for x <- positions_not_in_grid(grid), do: potentials(x, grid) ) defp potentials( position, grid ) do useds = potentials_used_values( position, grid ) - {position, (for value <- :lists.seq(1, 9) -- useds, do: value) } + {position, Enum.to_list(1..9) -- useds } end defp potentials_used_values( {x, y}, grid ) do row_values = (for row <- 1..9, row != x, do: {row, y}) |> potentials_values( grid ) column_values = (for column <- 1..9, column != y, do: {x, column}) |> potentials_values( grid ) - group_values = List.delete( group_positions({x, y}), {x, y} ) |> potentials_values( grid ) + group_values = group_positions({x, y}) -- [ {x, y} ] |> potentials_values( grid ) row_values ++ column_values ++ group_values end defp potentials_values( keys, grid ) do - row_values_unfiltered = for x <- keys, do: :dict.find(x, grid) - for {:ok, value} <- row_values_unfiltered, do: value + for x <- keys, val = grid[x], do: val end - defp values_all_columns( grid ), do: ( for x <- 1..9, do: values_all_columns(x, grid) ) - - defp values_all_columns( x, grid ) do - ( for y <- 1..9, do: {x, y} ) |> potentials_values( grid ) + defp values_all_columns( grid ) do + for x <- 1..9, do: + ( for y <- 1..9, do: {x, y} ) |> potentials_values( grid ) end defp values_all_groups( grid ) do - [[g1,g2,g3], [g4,g5,g6], [g7,g8,g9]] = for x <- [1, 4, 7], do: values_all_groups(x, grid) + [[g1,g2,g3], [g4,g5,g6], [g7,g8,g9]] = for x <- [1,4,7], do: values_all_groups(x, grid) [g1,g2,g3,g4,g5,g6,g7,g8,g9] end - defp values_all_groups( x, grid ), do: ( for x_offset <- [x, x+1, x+2], do: values_all_groups(x, x_offset, grid) ) + defp values_all_groups( x, grid ) do + for x_offset <- x..x+2, do: values_all_groups(x, x_offset, grid) + end defp values_all_groups( _x, x_offset, grid ) do ( for y_offset <- group_positions_close(x_offset), do: {x_offset, y_offset} ) |> potentials_values( grid ) end - defp values_all_rows( grid ), do: ( for y <- 1..9, do: values_all_rows(y, grid) ) - - defp values_all_rows( y, grid ) do - ( for x <- 1..9, do: {x, y} ) |> potentials_values( grid ) + defp values_all_rows( grid ) do + for y <- 1..9, do: + ( for x <- 1..9, do: {x, y} ) |> potentials_values( grid ) end defp solve_all_sure( grid ), do: solve_all_sure( solve_all_sure_values(grid), grid ) defp solve_all_sure( [], grid ), do: grid - defp solve_all_sure( sures, grid ), do: solve_all_sure( List.foldl(sures, grid, fn(x,acc)-> solve_all_sure_store(x,acc) end) ) + defp solve_all_sure( sures, grid ) do + solve_all_sure( Enum.reduce(sures, grid, &solve_all_sure_store/2) ) + end defp solve_all_sure_values( grid ), do: (for{position, [value]} <- potentials(grid), do: {position, value} ) - defp solve_all_sure_store( {position, value}, acc ), do: :dict.store( position, value, acc ) + defp solve_all_sure_store( {position, value}, acc ), do: Map.put( acc, position, value ) defp solve_unsure( [], grid ), do: grid defp solve_unsure( _potentials, grid ) do @@ -148,16 +133,25 @@ defmodule Sudoku do {:ok, board} -> board end end - - defp task( knowns ) do - IO.puts "start" - start = start( knowns ) - display( start ) - IO.puts "solved" - solved = solve( start ) - display( solved ) - IO.puts "" - end end -Sudoku.task +simple = [{{1, 1}, 3}, {{2, 1}, 9}, {{3, 1},4}, {{6, 1}, 2}, {{7, 1}, 6}, {{8, 1}, 7}, + {{4, 2}, 3}, {{7, 2}, 4}, + {{1, 3}, 5}, {{4, 3}, 6}, {{5, 3}, 9}, {{8, 3}, 2}, + {{2, 4}, 4}, {{3, 4}, 5}, {{7, 4}, 9}, + {{1, 5}, 6}, {{9, 5}, 7}, + {{3, 6}, 7}, {{7, 6}, 5}, {{8, 6}, 8}, + {{2, 7}, 1}, {{5, 7}, 6}, {{6, 7}, 7}, {{9, 7}, 8}, + {{3, 8}, 9}, {{6, 8}, 8}, + {{2, 9}, 2}, {{3, 9}, 6}, {{4, 9}, 4}, {{7, 9}, 7}, {{8, 9}, 3}, {{9, 9}, 5}] +Sudoku.task( simple ) + +difficult = [{{6, 2}, 3}, {{8, 2}, 8}, {{9, 2}, 5}, + {{3, 3}, 1}, {{5, 3}, 2}, + {{4, 4}, 5}, {{6, 4}, 7}, + {{3, 5}, 4}, {{7, 5}, 1}, + {{2, 6}, 9}, + {{1, 7}, 5}, {{8, 7}, 7}, {{9, 7}, 3}, + {{3, 8}, 2}, {{5, 8}, 1}, + {{5, 9}, 4}, {{9, 9}, 9}] +Sudoku.task( difficult ) diff --git a/Task/Sudoku/Groovy/sudoku-2.groovy b/Task/Sudoku/Groovy/sudoku-2.groovy index ed25949184..a1ee24ad47 100644 --- a/Task/Sudoku/Groovy/sudoku-2.groovy +++ b/Task/Sudoku/Groovy/sudoku-2.groovy @@ -8,7 +8,7 @@ def sudokus = [ //Used in Fortran solution: ~ 0.1 seconds '..3.2.6..9..3.5..1..18.64....81.29..7.......8..67.82....26.95..8..2.3..9..5.1.3..', - //Used in many other solutions, notably Ada: ~ 0.1 seconds + //Used in many other solutions, notably Algol 68: ~ 0.1 seconds '394..267....3..4..5..69..2..45...9..6.......7..7...58..1..67..8..9..8....264..735', //Used in C# solution: ~ 0.2 seconds diff --git a/Task/Sudoku/PARI-GP/sudoku-1.pari b/Task/Sudoku/PARI-GP/sudoku-1.pari new file mode 100644 index 0000000000..47041a5aab --- /dev/null +++ b/Task/Sudoku/PARI-GP/sudoku-1.pari @@ -0,0 +1,70 @@ +#include + +typedef int SUDOKU [9][9]; + +static inline int check_num(SUDOKU s, int row, int col, int num) +{ + int i, r = (row/3)*3, c = (col/3)*3; + + for (i = 0; i < 9; i++) + if (s[row][i] == num || s[i][col] == num || s[i%3 + r][i/3 + c] == num) + return 0; + + return 1; +} + +static int sudoku_solve(SUDOKU s, int row, int col) +{ + int num; + + if (row < 9 && col < 9) { + if (s[row][col]) { + if (col < 8) + return sudoku_solve(s, row, col+1); + if (row < 8) + return sudoku_solve(s, row+1, 0); + return 1; + } + else + for (num = 1; num < 10; num++) + if (check_num(s, row, col, num)) { + s[row][col] = num; + if (sudoku_solve(s, row, col)) + return 1; + else + s[row][col] = 0; + } + return 0; + } + return 1; +} + +GEN plug_sudoku(GEN M) +{ + SUDOKU s; + GEN S; + int i, k; + + if (typ(M) != t_MAT) + pari_err(e_MISC, "parameter not matrix"); + + S = matsize(M); + + if (itos(gel(S, 1)) < 9 || itos(gel(S, 2)) < 9) + pari_err(e_MISC, "parameter not 9x9 matrix"); + + for (i = 0; i < 9; i++) + for (k = 0; k < 9; k++) + s[i][k] = itos(gcoeff(M, i+1, k+1)); /* get sudoku */ + + if (sudoku_solve(s, 0, 0)) { /* solve sudoku */ + S = cgetg(10, t_MAT); + for (k = 0; k < 9; k++) { /* create 9x9 matrix */ + gel(S, k+1) = cgetg(10, t_COL); + for (i = 0; i < 9; i++) + gcoeff(S, i+1, k+1) = stoi(s[i][k]); /* fill in elements */ + } + return S; + } + return gen_0; /* no solution */ +} diff --git a/Task/Sudoku/PARI-GP/sudoku-2.pari b/Task/Sudoku/PARI-GP/sudoku-2.pari new file mode 100644 index 0000000000..610b7ecad3 --- /dev/null +++ b/Task/Sudoku/PARI-GP/sudoku-2.pari @@ -0,0 +1 @@ +install("plug_sudoku", "G", "sudoku", "~/libsudoku.so") diff --git a/Task/Sudoku/PHP/sudoku.php b/Task/Sudoku/PHP/sudoku.php new file mode 100644 index 0000000000..41391faa1b --- /dev/null +++ b/Task/Sudoku/PHP/sudoku.php @@ -0,0 +1,125 @@ + class SudokuSolver { + protected $grid = []; + protected $emptySymbol; + public static function parseString($str, $emptySymbol = '0') + { + $grid = str_split($str); + foreach($grid as &$v) + { + if($v == $emptySymbol) + { + $v = 0; + } + else + { + $v = (int)$v; + } + } + return $grid; + } + + public function __construct($str, $emptySymbol = '0') { + if(strlen($str) !== 81) + { + throw new \Exception('Error sudoku'); + } + $this->grid = static::parseString($str, $emptySymbol); + $this->emptySymbol = $emptySymbol; + } + + public function solve() + { + try + { + $this->placeNumber(0); + return false; + } + catch(\Exception $e) + { + return true; + } + } + + protected function placeNumber($pos) + { + if($pos == 81) + { + throw new \Exception('Finish'); + } + if($this->grid[$pos] > 0) + { + $this->placeNumber($pos+1); + return; + } + for($n = 1; $n <= 9; $n++) + { + if($this->checkValidity($n, $pos%9, floor($pos/9))) + { + $this->grid[$pos] = $n; + $this->placeNumber($pos+1); + $this->grid[$pos] = 0; + } + } + } + + protected function checkValidity($val, $x, $y) + { + for($i = 0; $i < 9; $i++) + { + if(($this->grid[$y*9+$i] == $val) || ($this->grid[$i*9+$x] == $val)) + { + return false; + } + } + $startX = (int) ((int)($x/3)*3); + $startY = (int) ((int)($y/3)*3); + + for($i = $startY; $i<$startY+3;$i++) + { + for($j = $startX; $j<$startX+3;$j++) + { + if($this->grid[$i*9+$j] == $val) + { + return false; + } + } + } + return true; + } + + public function display() { + $str = ''; + for($i = 0; $i<9; $i++) + { + for($j = 0; $j<9;$j++) + { + $str .= $this->grid[$i*9+$j]; + $str .= " "; + if($j == 2 || $j == 5) + { + $str .= "| "; + } + } + $str .= PHP_EOL; + if($i == 2 || $i == 5) + { + $str .= "------+-------+------".PHP_EOL; + } + } + echo $str; + } + + public function __toString() { + foreach ($this->grid as &$item) + { + if($item == 0) + { + $item = $this->emptySymbol; + } + } + return implode('', $this->grid); + } + } + $solver = new SudokuSolver('009170000020600001800200000200006053000051009005040080040000700006000320700003900'); + $solver->solve(); + $solver->display(); diff --git a/Task/Sudoku/Pascal/sudoku.pascal b/Task/Sudoku/Pascal/sudoku.pascal new file mode 100644 index 0000000000..912d9cbf7c --- /dev/null +++ b/Task/Sudoku/Pascal/sudoku.pascal @@ -0,0 +1,257 @@ +Program soduko; +{$IFDEF FPC} + {$CODEALIGN proc=16,loop=8} +{$ENDIF} +uses + sysutils,crt; +const + carreeSize = 3; + maxCoor = carreeSize*carreeSize; + maxValue = maxCoor; + maxMask = 1 shl (maxCoor+1)-1; +type + tLimit = 0..maxCoor-1; + tValue = 0..maxCoor; + tSteps = 0..maxCoor*maxCoor; + tValField = array[tLimit,tLimit] of NativeInt;//tValue; + tBitrepr = 0..maxMask; + tcol = array[tLimit] of NativeInt;// tBitrepr; + trow = array[tLimit] of NativeInt;// tBitrepr; + tcar = array[tLimit] of NativeInt;// tBitrepr; + tpValue = ^NativeInt;//^tValue; + tpLimit = ^tLimit; + tpBitrepr= ^NativeInt;//^tBitrepr; + tchgVal = record + cvCol, + cvRow, + cvCar : tpBitrepr; + cvVal : tpValue; + end; + tpChgVal = ^tchgVal; + tchgList = array[tSteps] of tchgVal; + + tField = record + fdChgList: tchgList; + fdCol : tcol; + fdRow : trow; + fdcar : tcar; + fdVal : tValField; + fdChgIdx : tSteps; + + end; +const + Expl0:tValField = ((9,0,7,0,0,0,3,0,0), + (0,0,0,1,0,0,2,0,0), + (6,0,0,0,0,8,0,0,0), + (0,0,5,0,3,0,0,0,0), + (0,0,0,0,0,0,0,8,4), + (0,0,0,0,0,0,0,6,0), + (0,0,0,2,7,0,0,0,0), + (8,4,0,0,0,0,0,0,0), + (0,6,0,0,0,0,0,0,0)); + Expl1:tValField=((0,0,0,1,0,0,0,3,8), + (2,0,0,0,0,5,0,0,0), + (0,0,0,0,0,0,0,0,0), + (0,5,0,0,0,0,4,0,0), + (4,0,0,0,3,0,0,0,0), + (0,0,0,7,0,0,0,0,6), + (0,0,1,0,0,0,0,5,0), + (0,0,0,0,6,0,2,0,0), + (0,6,0,0,0,4,0,0,0)); + +var + F, + solF : TField; + solCnt, + callCnt: NativeUint; + solFound : Boolean; + +procedure OutField(const F:tField); +var + rw,cl : tLimit; + rowS: AnsiString; +Begin + GotoXy(1,1); + For rw := low(tLimit) to High(tLimit) do + Begin + rowS := ' '; + For cl := low(tLimit) to High(tLimit) do + RowS :=RowS+IntToStr(F.fdVal[rw,cl]); + writeln(RowS); + end; +end; + +function CarIdx(rw,cl: NativeInt):NativeInt; +begin + CarIdx:= (rw DIV carreeSize)*carreeSize +cl DIV carreeSize; +end; +function InsertTest(const F:tField;rw,cl:tLimit;value:tValue):boolean; +var + msk: tBitrepr; +Begin + result := (Value = 0); + IF result then + EXIT; + msk := 1 shl (value-1); + with F do + Begin + result := fdRow[rw] AND msk = 0; + result := result AND (fdCol[cl] AND msk = 0); + rw :=CarIdx(rw,cl); + result := result AND (fdCar[rw] AND msk = 0); + end; +end; + +function InitField(var F:tField;const InFd:tValField;DoReverse:boolean):boolean; +var + TmpchgVal:tchgVal; + rw,cl, + value, + msk : NativeInt; + leftSteps:tSteps; +Begin + Fillchar(F,SizeOf(F),#0); + leftSteps := High(tSteps)-1; + //unknown fields inserted from end + For rw := low(tLimit) to High(tLimit) do + For cl := low(tLimit) to High(tLimit) do + Begin + value := InFd[rw,cl]; + IF InsertTest(F,rw,cl,value) then + Begin + with F do + Begin + if value > 0 then + Begin + msk := 1 shl (value-1); + //given state + //use pointer to the relevant places and mark as occupied + with fdChgList[fdChgIdx] do + begin + cvCol := @fdCol[cl]; + cvCol^ +=Msk; + cvRow := @fdRow[rw]; + cvRow^ +=Msk; + cvCar := @fdCar[CarIdx(rw,cl)]; + cvCar^ +=Msk; + cvVal := @fdVal[rw,cl]; + cvVal^ := value; + end; + inc(fdChgIdx); + end + else + Begin + //use pointer to the relevant places + with fdChgList[leftSteps] do + begin + cvCol := @fdCol[cl]; + cvRow := @fdRow[rw]; + cvCar := @fdCar[CarIdx(rw,cl)]; + cvVal := @fdVal[rw,cl]; + end; + dec(leftSteps); + end; + end + end + else + Begin + writeln(rw:10,cl:10,value:10); + Writeln(' not solvable SuDoKu '); + delay(2000); + result := false; + EXIT; + end; + end; + //reverse direction of left over + IF DoReverse then + Begin + leftSteps := High(tSteps)-1; + rw := F.fdChgIdx; + repeat + TmpchgVal:= F.fdChgList[leftSteps]; + F.fdChgList[leftSteps]:= F.fdChgList[rw]; + F.fdChgList[rw] :=TmpchgVal; + dec(leftSteps); + inc(rw); + until rw>=leftSteps; + end; + //OutField(F); + solFound := false; + result := true; +end; +procedure SolIsFound; +begin + solF := F; + inc(solCnt); + solFound := True; +end; + +procedure TryCell(var ChgVal:tpchgVal); +var + value :NativeInt; + poss,msk: NativeInt; +Begin + IF solFound then EXIT; + with ChgVal^ do + poss:= (cvRow^ OR cvCol^ OR cvCar^) XOR maxMask; + IF Poss = 0 then + EXIT; + + value := 1; + msk := 1; + + repeat + IF Poss AND MSK <>0 then + Begin + inc(callCnt); + //insert test value + with ChgVal^ do + Begin + cvCol^ := cvCol^ OR msk; + cvRow^ := cvRow^ OR msk; + cvCar^ := cvCar^ OR msk; + cvVAl^ := value; + end; + //try next in list, if beyond last + inc(ChgVal); + + IF ChgVal^.cvCol <> NIL then + TryCell(ChgVal) + else + SolIsFound; + //remove test value + dec(ChgVal); + with ChgVal^ do + Begin + cvCol^ := cvCol^ XOR msk; + cvRow^ := cvRow^ XOR msk; + cvCar^ := cvCar^ XOR msk; + cvVAl^ := 0; + end; + end; + inc(msk,msk); + inc(value); + until value> maxValue; +end; + +var + ChangeBegin : tpChgVal; + k : NativeInt; + T1,T0: TDateTime; +begin + randomize; + ClrScr; + solCnt := 0; + callCnt:= 0; + T0 := time; + k := 0; + repeat + InitField(F,Expl1,FALSE); + ChangeBegin := @F.fdChgList[F.fdChgIdx]; + TryCell(ChangeBegin); + inc(k); + until k >= 5; + T1 := time; + Outfield(solF); + writeln(86400*1000*(T1-T0)/k:10:3,' ms Test calls :',callCnt/k:8:0); +end. diff --git a/Task/Sudoku/Perl-6/sudoku-2.pl6 b/Task/Sudoku/Perl-6/sudoku-2.pl6 index 687997ca38..d9d3495681 100644 --- a/Task/Sudoku/Perl-6/sudoku-2.pl6 +++ b/Task/Sudoku/Perl-6/sudoku-2.pl6 @@ -28,7 +28,7 @@ use v6; # # keep a list with all the cells, handy for traversal -my @cells = do for 0..8 X 0..8 -> $x, $y { [ $x, $y ] }; +my @cells = do for (flat 0..8 X 0..8) -> $x, $y { [ $x, $y ] }; # # Try to solve this puzzle and return the resolved puzzle if it is at @@ -129,7 +129,7 @@ sub solution-complexity-factor($sudoku, Int $x, Int $y) { } # the number of possible values should take precedence my Int $f = 1000 * count-values($sudoku[$x][$y]); - for 0..2 X 0..2 -> $lx, $ly { + for (flat 0..2 X 0..2) -> $lx, $ly { $f += count-values($sudoku[$lx+$bx*3][$ly+$by*3]) } for 0..^($by*3), (($by+1)*3)..8 -> $ly { @@ -152,7 +152,7 @@ sub matches-in-competing-cells($sudoku, Int $x, Int $y, Int $val) { return $cell.grep({ $val == $_ }) ?? 1 !! 0; } my Int $c = 0; - for 0..2 X 0..2 -> $lx, $ly { + for (flat 0..2 X 0..2) -> $lx, $ly { $c += cell-matching($sudoku[$lx+$bx*3][$ly+$by*3]) } for 0..^($by*3), (($by+1)*3)..8 -> $ly { @@ -208,7 +208,7 @@ sub trace(Int $level, Str $message) { sub clone-sudoku($sudoku) { my $clone; - for 0..8 X 0..8 -> $x, $y { + for (flat 0..8 X 0..8) -> $x, $y { $clone[$x][$y] = $sudoku[$x][$y]; } return $clone; diff --git a/Task/Sudoku/Ruby/sudoku.rb b/Task/Sudoku/Ruby/sudoku.rb index 8f955aaf77..48f20a5c4b 100644 --- a/Task/Sudoku/Ruby/sudoku.rb +++ b/Task/Sudoku/Ruby/sudoku.rb @@ -1,26 +1,19 @@ def read_matrix(data) - lines = data.each_line.to_a # ver 2.0 later data.lines + lines = data.lines 9.times.collect { |i| 9.times.collect { |j| lines[i][j].to_i } } end def permissible(matrix, i, j) ok = [nil, *1..9] + check = ->(x,y) { ok[matrix[x][y]] = nil if matrix[x][y].nonzero? } # Same as another in the column isn't permissible... - 9.times do |i2| - ok[matrix[i2][j]] = nil if matrix[i2][j].nonzero? - end + 9.times { |x| check[x, j] } # Same as another in the row isn't permissible... - 9.times do |j2| - ok[matrix[i][j2]] = nil if matrix[i][j2].nonzero? - end + 9.times { |y| check[i, y] } # Same as another in the 3x3 block isn't permissible... - irange = (ig = (i / 3) * 3) .. ig + 2 - jrange = (jg = (j / 3) * 3) .. jg + 2 - irange.each do |i2| - jrange.each do |j2| - ok[matrix[i2][j2]] = nil if matrix[i2][j2].nonzero? - end - end + xary = [ *(x = (i / 3) * 3) .. x + 2 ] #=> [0,1,2], [3,4,5] or [6,7,8] + yary = [ *(y = (j / 3) * 3) .. y + 2 ] + xary.product(yary).each { |x, y| check[x, y] } # Gathering only permitted one ok.compact end diff --git a/Task/Sudoku/SAS/sudoku.sas b/Task/Sudoku/SAS/sudoku.sas new file mode 100644 index 0000000000..af4bfeea08 --- /dev/null +++ b/Task/Sudoku/SAS/sudoku.sas @@ -0,0 +1,47 @@ +/* define SAS data set */ +data Indata; + input C1-C9; + datalines; +. . 5 . . 7 . . 1 +. 7 . . 9 . . 3 . +. . . 6 . . . . . +. . 3 . . 1 . . 5 +. 9 . . 8 . . 2 . +1 . . 2 . . 4 . . +. . 2 . . 6 . . 9 +. . . . 4 . . 8 . +8 . . 1 . . 5 . . +; + +/* call OPTMODEL procedure in SAS/OR */ +proc optmodel; + /* declare variables */ + set ROWS = 1..9; + set COLS = ROWS; + var X {ROWS, COLS} >= 1 <= 9 integer; + + /* declare nine row constraints */ + con RowCon {i in ROWS}: + alldiff({j in COLS} X[i,j]); + + /* declare nine column constraints */ + con ColCon {j in COLS}: + alldiff({i in ROWS} X[i,j]); + + /* declare nine 3x3 block constraints */ + con BlockCon {s in 0..2, t in 0..2}: + alldiff({i in 3*s+1..3*s+3, j in 3*t+1..3*t+3} X[i,j]); + + /* fix variables to cell values */ + /* X[i,j] = c[i,j] if c[i,j] is not missing */ + num c {ROWS, COLS}; + read data indata into [_N_] {j in COLS} ; + for {i in ROWS, j in COLS: c[i,j] ne .} + fix X[i,j] = c[i,j]; + + /* call CLP solver */ + solve; + + /* print solution */ + print X; +quit; diff --git a/Task/Sum-and-product-of-an-array/AppleScript/sum-and-product-of-an-array.applescript b/Task/Sum-and-product-of-an-array/AppleScript/sum-and-product-of-an-array-1.applescript similarity index 100% rename from Task/Sum-and-product-of-an-array/AppleScript/sum-and-product-of-an-array.applescript rename to Task/Sum-and-product-of-an-array/AppleScript/sum-and-product-of-an-array-1.applescript diff --git a/Task/Sum-and-product-of-an-array/AppleScript/sum-and-product-of-an-array-2.applescript b/Task/Sum-and-product-of-an-array/AppleScript/sum-and-product-of-an-array-2.applescript new file mode 100644 index 0000000000..bb48ef62a4 --- /dev/null +++ b/Task/Sum-and-product-of-an-array/AppleScript/sum-and-product-of-an-array-2.applescript @@ -0,0 +1,38 @@ +on run + + set lstRange to {1, 2, 3, 4, 5, 6, 7, 8, 9, 10} + + {{sum:reduce(summed, 0, lstRange)}, ¬ + {product:reduce(product, 1, lstRange)}} + +end run + +on summed(a, b) + a + b +end summed + +on product(a, b) + a * b +end product + + + +-- GENERIC LIBRARY FUNCTION + +-- list, function, initial accumulator value +-- the arguments available to the function f(a, x, i, l) are +-- v: current accumulator value +-- x: current item in list +-- i: [ 1-based index in list ] optional +-- l: [ a reference to the list itself ] optional +on reduce(f, initialValue, xs) + script mf + property lambda : f + end script + + set v to initialValue + repeat with i from 1 to length of xs + set v to mf's lambda(v, item i of xs, i, xs) + end repeat + return v +end reduce diff --git a/Task/Sum-and-product-of-an-array/AppleScript/sum-and-product-of-an-array-3.applescript b/Task/Sum-and-product-of-an-array/AppleScript/sum-and-product-of-an-array-3.applescript new file mode 100644 index 0000000000..482cbb252c --- /dev/null +++ b/Task/Sum-and-product-of-an-array/AppleScript/sum-and-product-of-an-array-3.applescript @@ -0,0 +1 @@ +{{sum:55}, {product:3628800}} diff --git a/Task/Sum-and-product-of-an-array/Elena/sum-and-product-of-an-array.elena b/Task/Sum-and-product-of-an-array/Elena/sum-and-product-of-an-array.elena new file mode 100644 index 0000000000..3a1d7bad32 --- /dev/null +++ b/Task/Sum-and-product-of-an-array/Elena/sum-and-product-of-an-array.elena @@ -0,0 +1,11 @@ +#import system. +#import system'routines. +#import extensions. + +#symbol program = +[ + #var list := (1, 2, 3, 4, 5 ). + + #var sum := list summarize:(Integer new). + #var product := list accumulate:(Integer new:1) &with:(:var:val) [ var * val ]. +]. diff --git a/Task/Sum-and-product-of-an-array/K/sum-and-product-of-an-array.k b/Task/Sum-and-product-of-an-array/K/sum-and-product-of-an-array.k new file mode 100644 index 0000000000..a845eb8aa8 --- /dev/null +++ b/Task/Sum-and-product-of-an-array/K/sum-and-product-of-an-array.k @@ -0,0 +1,7 @@ + sum: {+/}x + product: {*/}x + a: 1 3 5 7 9 11 13 + sum a +49 + product a +135135 diff --git a/Task/Sum-and-product-of-an-array/Maple/sum-and-product-of-an-array.maple b/Task/Sum-and-product-of-an-array/Maple/sum-and-product-of-an-array.maple new file mode 100644 index 0000000000..2d5bd4accd --- /dev/null +++ b/Task/Sum-and-product-of-an-array/Maple/sum-and-product-of-an-array.maple @@ -0,0 +1,3 @@ +a := Array([1, 2, 3, 4, 5, 6]); + add(a); + mul(a); diff --git a/Task/Sum-and-product-of-an-array/PARI-GP/sum-and-product-of-an-array.pari b/Task/Sum-and-product-of-an-array/PARI-GP/sum-and-product-of-an-array.pari index cab3a612fd..8c10ff42bd 100644 --- a/Task/Sum-and-product-of-an-array/PARI-GP/sum-and-product-of-an-array.pari +++ b/Task/Sum-and-product-of-an-array/PARI-GP/sum-and-product-of-an-array.pari @@ -1,4 +1,4 @@ -vecsum(v)={ +vecsum1(v)={ sum(i=1,#v,v[i]) }; vecprod(v)={ diff --git a/Task/Sum-and-product-of-an-array/Ruby/sum-and-product-of-an-array-4.rb b/Task/Sum-and-product-of-an-array/Ruby/sum-and-product-of-an-array-4.rb new file mode 100644 index 0000000000..67b501f6d7 --- /dev/null +++ b/Task/Sum-and-product-of-an-array/Ruby/sum-and-product-of-an-array-4.rb @@ -0,0 +1,3 @@ +arr = [1,2,3,4,5] +p sum = arr.sum #=> 15 +p [].sum #=> 0 diff --git a/Task/Sum-and-product-of-an-array/S-lang/sum-and-product-of-an-array-1.slang b/Task/Sum-and-product-of-an-array/S-lang/sum-and-product-of-an-array-1.slang new file mode 100644 index 0000000000..488cccbe79 --- /dev/null +++ b/Task/Sum-and-product-of-an-array/S-lang/sum-and-product-of-an-array-1.slang @@ -0,0 +1 @@ +variable a = [5, -2, 3, 4, 666, 7]; diff --git a/Task/Sum-and-product-of-an-array/S-lang/sum-and-product-of-an-array-2.slang b/Task/Sum-and-product-of-an-array/S-lang/sum-and-product-of-an-array-2.slang new file mode 100644 index 0000000000..ef9b701119 --- /dev/null +++ b/Task/Sum-and-product-of-an-array/S-lang/sum-and-product-of-an-array-2.slang @@ -0,0 +1 @@ +print(sum(a)); diff --git a/Task/Sum-and-product-of-an-array/S-lang/sum-and-product-of-an-array-3.slang b/Task/Sum-and-product-of-an-array/S-lang/sum-and-product-of-an-array-3.slang new file mode 100644 index 0000000000..3b30876b01 --- /dev/null +++ b/Task/Sum-and-product-of-an-array/S-lang/sum-and-product-of-an-array-3.slang @@ -0,0 +1,10 @@ +variable prod = a[0]; + +% Skipping the loop variable causes the val to be placed on the stack. +% Also note that the double-brackets ARE required. The inner one creates +% a "range array" based on the length of a. +foreach (a[[1:]]) + % () pops it off. + prod *= (); + +print(prod); diff --git a/Task/Sum-digits-of-an-integer/00DESCRIPTION b/Task/Sum-digits-of-an-integer/00DESCRIPTION index ec72247229..a00ab859bd 100644 --- a/Task/Sum-digits-of-an-integer/00DESCRIPTION +++ b/Task/Sum-digits-of-an-integer/00DESCRIPTION @@ -1,5 +1,7 @@ -This task is to take a [[wp:Natural_number|Natural Number]] in a given Base and return the sum of its digits: -:110 sums to 1; -:123410 sums to 10; -:fe16 sums to 29; -:f0e16 sums to 29. +;Task: +Take a   [[wp:Natural_number|Natural Number]]   in a given base and return the sum of its digits: +:*   '''1'''10         sums to   '''1''' +:*   '''1234'''10   sums to   '''10''' +:*   '''fe'''16       sums to   '''29''' +:*   '''f0e'''16     sums to   '''29''' +

    diff --git a/Task/Sum-digits-of-an-integer/360-Assembly/sum-digits-of-an-integer.360 b/Task/Sum-digits-of-an-integer/360-Assembly/sum-digits-of-an-integer.360 new file mode 100644 index 0000000000..e7076c11be --- /dev/null +++ b/Task/Sum-digits-of-an-integer/360-Assembly/sum-digits-of-an-integer.360 @@ -0,0 +1,56 @@ +* Sum digits of an integer 08/07/2016 +SUMDIGIN CSECT + USING SUMDIGIN,R13 base register + B 72(R15) skip savearea + DC 17F'0' savearea + STM R14,R12,12(R13) prolog + ST R13,4(R15) " <- + ST R15,8(R13) " -> + LR R13,R15 " addressability + LA R11,NUMBERS @numbers + LA R8,1 k=1 +LOOPK CH R8,=H'4' do k=1 to hbound(numbers) + BH ELOOPK " + SR R10,R10 sum=0 + LA R7,1 j=1 +LOOPJ CH R7,=H'8' do j=1 to length(number) + BH ELOOPJ " + LR R4,R11 @number + BCTR R4,0 -1 + AR R4,R7 +j + MVC D,0(R4) d=substr(number,j,1) + SR R9,R9 ii=0 + SR R6,R6 i=0 +LOOPI CH R6,=H'15' do i=0 to 15 + BH ELOOPI " + LA R4,DIGITS @digits + AR R4,R6 i + MVC C,0(R4) c=substr(digits,i+1,1) + CLC D,C if d=c + BNE NOTEQ then + LR R9,R6 ii=i + B ELOOPI leave i +NOTEQ LA R6,1(R6) i=i+1 + B LOOPI end do i +ELOOPI AR R10,R9 sum=sum+ii + LA R7,1(R7) j=j+1 + B LOOPJ end do j +ELOOPJ MVC PG(8),0(R11) number + XDECO R10,XDEC edit sum + MVC PG+8(8),XDEC+4 output sum + XPRNT PG,L'PG print buffer + LA R11,8(R11) @number=@number+8 + LA R8,1(R8) k=k+1 + B LOOPK end do k +ELOOPK L R13,4(0,R13) epilog + LM R14,R12,12(R13) " restore + XR R15,R15 " rc=0 + BR R14 exit +DIGITS DC CL16'0123456789ABCDEF' +NUMBERS DC CL8'1',CL8'1234',CL8'FE',CL8'F0E' +C DS CL1 +D DS CL1 +PG DC CL16' ' buffer +XDEC DS CL12 temp + YREGS + END SUMDIGIN diff --git a/Task/Sum-digits-of-an-integer/ALGOL-68/sum-digits-of-an-integer.alg b/Task/Sum-digits-of-an-integer/ALGOL-68/sum-digits-of-an-integer-1.alg similarity index 100% rename from Task/Sum-digits-of-an-integer/ALGOL-68/sum-digits-of-an-integer.alg rename to Task/Sum-digits-of-an-integer/ALGOL-68/sum-digits-of-an-integer-1.alg diff --git a/Task/Sum-digits-of-an-integer/ALGOL-68/sum-digits-of-an-integer-2.alg b/Task/Sum-digits-of-an-integer/ALGOL-68/sum-digits-of-an-integer-2.alg new file mode 100644 index 0000000000..3dadc8c11e --- /dev/null +++ b/Task/Sum-digits-of-an-integer/ALGOL-68/sum-digits-of-an-integer-2.alg @@ -0,0 +1,104 @@ +-- digitsSummed :: (Int | String) -> Int +on digitsSummed(n) + + -- digitAdded :: Int -> String -> Int + script digitAdded + + -- Numeric values of known glyphs: 0-9 A-Z a-z + -- digitValue :: String -> Int + on digitValue(s) + set i to id of s + if i > 47 and i < 123 then -- 0-z + if i < 58 then -- 0-9 + i - 48 + else if i > 96 then -- a-z + i - 87 + else if i > 64 and i < 91 then -- A-Z + i - 55 + else -- unknown glyph + 0 + end if + else -- unknown glyph + 0 + end if + end digitValue + + on lambda(accumulator, strDigit) + accumulator + digitValue(strDigit) + end lambda + end script + + foldl(digitAdded, 0, splitOn("", n as string)) +end digitsSummed + + +-- TEST + +-- showDigitSum :: Int -> String +on showDigitSum(n) + (n as string) & " -> " & digitsSummed(n) +end showDigitSum + + +on run + + intercalate(linefeed, ¬ + map(showDigitSum, [1, 12345, "254", "fe", "f0e", "999ABCXYZ"])) + +end run + + + +-- GENERIC FUNCTIONS + +-- 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 + +-- 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 + +-- 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 + +-- splitOn :: Text -> Text -> [Text] +on splitOn(strDelim, strMain) + set {dlm, my text item delimiters} to {my text item delimiters, strDelim} + set xs to text items of strMain + set my text item delimiters to dlm + return xs +end splitOn + +-- intercalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate diff --git a/Task/Sum-digits-of-an-integer/Elixir/sum-digits-of-an-integer.elixir b/Task/Sum-digits-of-an-integer/Elixir/sum-digits-of-an-integer.elixir index 5537a94604..7e7d6a32a3 100644 --- a/Task/Sum-digits-of-an-integer/Elixir/sum-digits-of-an-integer.elixir +++ b/Task/Sum-digits-of-an-integer/Elixir/sum-digits-of-an-integer.elixir @@ -1,16 +1,17 @@ defmodule RC do - def sumDigits(n), do: sumDigits(n, 10) - + def sumDigits(n, base\\10) def sumDigits(n, base) when is_integer(n) do - sumDigits(Integer.to_string(n, base), base) + Integer.digits(n, base) |> Enum.sum end - - def sumDigits(n, base) when is_bitstring(n) do - String.split(n, "", trim: true) |> Enum.map(&(String.to_integer(&1, base))) - |> Enum.sum + def sumDigits(n, base) when is_binary(n) do + String.codepoints(n) |> Enum.map(&String.to_integer(&1, base)) |> Enum.sum end end -Enum.each([1, 1234], fn n -> IO.puts "#{n}: #{ RC.sumDigits(n) }" end) -base = 16 -Enum.each(["fe", "f0e"], fn n -> IO.puts "#{n}(#{base}): #{ RC.sumDigits(n,base) }" end) +Enum.each([{1, 10}, {1234, 10}, {0xfe, 16}, {0xf0e, 16}], fn {n,base} -> + IO.puts "#{Integer.to_string(n,base)}(#{base}) sums to #{ RC.sumDigits(n,base) }" +end) +IO.puts "" +Enum.each([{"1", 10}, {"1234", 10}, {"fe", 16}, {"f0e", 16}], fn {n,base} -> + IO.puts "#{n}(#{base}) sums to #{ RC.sumDigits(n,base) }" +end) diff --git a/Task/Sum-digits-of-an-integer/JavaScript/sum-digits-of-an-integer-1.js b/Task/Sum-digits-of-an-integer/JavaScript/sum-digits-of-an-integer-1.js new file mode 100644 index 0000000000..9be0a25ae5 --- /dev/null +++ b/Task/Sum-digits-of-an-integer/JavaScript/sum-digits-of-an-integer-1.js @@ -0,0 +1,6 @@ +function sumDigits(n) { + n += '' + for (var s=0, i=0, e=n.length; i') diff --git a/Task/Sum-digits-of-an-integer/JavaScript/sum-digits-of-an-integer-2.js b/Task/Sum-digits-of-an-integer/JavaScript/sum-digits-of-an-integer-2.js new file mode 100644 index 0000000000..6b74fae9f1 --- /dev/null +++ b/Task/Sum-digits-of-an-integer/JavaScript/sum-digits-of-an-integer-2.js @@ -0,0 +1,27 @@ +(function () { + 'use strict'; + + // digitsSummed :: (Int | String) -> Int + function digitsSummed(number) { + + // 10 digits + 26 alphabetics + // give us glyphs for up to base 36 + var intMaxBase = 36; + + return number + .toString() + .split('') + .reduce(function (a, digit) { + return a + parseInt(digit, intMaxBase); + }, 0); + } + + // TEST + + return [1, 12345, 0xfe, 'fe', 'f0e', '999ABCXYZ'] + .map(function (x) { + return x + ' -> ' + digitsSummed(x); + }) + .join('\n'); + +})(); diff --git a/Task/Sum-digits-of-an-integer/Maple/sum-digits-of-an-integer.maple b/Task/Sum-digits-of-an-integer/Maple/sum-digits-of-an-integer.maple new file mode 100644 index 0000000000..7f2fba65c1 --- /dev/null +++ b/Task/Sum-digits-of-an-integer/Maple/sum-digits-of-an-integer.maple @@ -0,0 +1,8 @@ +sumDigits := proc( num ) + local digits, number_to_string, i; + number_to_string := convert( num, string ); + digits := [ seq( convert( h, decimal, hex ), h in seq( parse( i ) , i in number_to_string ) ) ]; + return add( digits ); +end proc: +sumDigits( 1234 ); +sumDigits( "fe" ); diff --git a/Task/Sum-digits-of-an-integer/Perl/sum-digits-of-an-integer-1.pl b/Task/Sum-digits-of-an-integer/Perl/sum-digits-of-an-integer-1.pl new file mode 100644 index 0000000000..5e060b574d --- /dev/null +++ b/Task/Sum-digits-of-an-integer/Perl/sum-digits-of-an-integer-1.pl @@ -0,0 +1,17 @@ +#!/usr/bin/perl +use strict; +use warnings; + +my %letval = map { $_ => $_ } 0 .. 9; +$letval{$_} = ord($_) - ord('a') + 10 for 'a' .. 'z'; +$letval{$_} = ord($_) - ord('A') + 10 for 'A' .. 'Z'; + +sub sumdigits { + my $number = shift; + my $sum = 0; + $sum += $letval{$_} for (split //, $number); + $sum; +} + +print "$_ sums to " . sumdigits($_) . "\n" + for (qw/1 1234 1020304 fe f0e DEADBEEF/); diff --git a/Task/Sum-digits-of-an-integer/Perl/sum-digits-of-an-integer-2.pl b/Task/Sum-digits-of-an-integer/Perl/sum-digits-of-an-integer-2.pl new file mode 100644 index 0000000000..ed5ce81b54 --- /dev/null +++ b/Task/Sum-digits-of-an-integer/Perl/sum-digits-of-an-integer-2.pl @@ -0,0 +1,2 @@ +use ntheory "sumdigits"; +say sumdigits($_,36) for (qw/1 1234 1020304 fe f0e DEADBEEF/); diff --git a/Task/Sum-digits-of-an-integer/Perl/sum-digits-of-an-integer.pl b/Task/Sum-digits-of-an-integer/Perl/sum-digits-of-an-integer.pl deleted file mode 100644 index 70712fc58d..0000000000 --- a/Task/Sum-digits-of-an-integer/Perl/sum-digits-of-an-integer.pl +++ /dev/null @@ -1,23 +0,0 @@ -#!/usr/bin/perl -use strict ; -use warnings ; - -#whatever the number base, a number stands for itself, and the letters start -#at number 10 ! - -sub sumdigits { - my $number = shift ; - my $hashref = shift ; - my $sum = 0 ; - map { if ( /\d/ ) { $sum += $_ } else { $sum += ${$hashref}{ $_ } } } - split( // , $number ) ; - return $sum ; -} - -my %lettervals ; -my $base = 10 ; -for my $letter ( 'a'..'z' ) { - $lettervals{ $letter } = $base++ ; -} -map { print "$_ sums to " . sumdigits( $_ , \%lettervals) . " !\n" } - ( 1 , 1234 , 'fe' , 'f0e' ) ; diff --git a/Task/Sum-digits-of-an-integer/PowerShell/sum-digits-of-an-integer.psh b/Task/Sum-digits-of-an-integer/PowerShell/sum-digits-of-an-integer.psh index 7a7a47c07b..1a10bdb220 100644 --- a/Task/Sum-digits-of-an-integer/PowerShell/sum-digits-of-an-integer.psh +++ b/Task/Sum-digits-of-an-integer/PowerShell/sum-digits-of-an-integer.psh @@ -1,7 +1,14 @@ -function Get-DigitalSum ($n) +function Get-DigitalSum ([string] $number, $base = 10) { - if ($n -lt 10) {$n} - else { - ($n % 10) + (Get-DigitalSum ([math]::Floor($n / 10))) + if ($number.ToCharArray().Length -le 1) { [Convert]::ToInt32($number, $base) } + else + { + $result = 0 + foreach ($character in $number.ToCharArray()) + { + $digit = [Convert]::ToInt32(([string]$character), $base) + $result += $digit + } + return $result } } diff --git a/Task/Sum-digits-of-an-integer/PureBasic/sum-digits-of-an-integer.purebasic b/Task/Sum-digits-of-an-integer/PureBasic/sum-digits-of-an-integer.purebasic new file mode 100644 index 0000000000..291f660605 --- /dev/null +++ b/Task/Sum-digits-of-an-integer/PureBasic/sum-digits-of-an-integer.purebasic @@ -0,0 +1,25 @@ +EnableExplicit + +Procedure.i SumDigits(Number.q, Base) + If Number < 0 : Number = -Number : EndIf; convert negative numbers to positive + If Base < 2 : Base = 2 : EndIf ; base can't be less than 2 + Protected sum = 0 + While Number > 0 + sum + Number % Base + Number / Base + Wend + ProcedureReturn sum +EndProcedure + +If OpenConsole() + PrintN("The sums of the digits are:") + PrintN("") + PrintN("1 base 10 : " + SumDigits(1, 10)) + PrintN("1234 base 10 : " + SumDigits(1234, 10)) + PrintN("fe base 16 : " + SumDigits($fe, 16)) + PrintN("f0e base 16 : " + SumDigits($f0e, 16)) + PrintN("") + PrintN("Press any key to close the console") + Repeat: Delay(10) : Until Inkey() <> "" + CloseConsole() +EndIf diff --git a/Task/Sum-digits-of-an-integer/REXX/sum-digits-of-an-integer-2.rexx b/Task/Sum-digits-of-an-integer/REXX/sum-digits-of-an-integer-2.rexx index d03a222389..a2018f4e00 100644 --- a/Task/Sum-digits-of-an-integer/REXX/sum-digits-of-an-integer-2.rexx +++ b/Task/Sum-digits-of-an-integer/REXX/sum-digits-of-an-integer-2.rexx @@ -1,12 +1,11 @@ -/*REXX pgm sums the digits of natural numbers in any base up to base 36.*/ -parse arg z /*get optional #s or use default.*/ -if z='' then z='1 1234 fe f0e +F0E -666.00 11111112222222333333344444449' - do j=1 for words(z); _=word(z,j) - say right(sumDigs(_),9) ' is the sum of the digits for the number ' _ - end /*j*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────SUMDIGS subroutine──────────────────*/ -sumDigs: procedure; arg x; @=123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ -s=0; do k=1 for length(x); s=s+pos(substr(x,k,1),@) - end /*k*/ -return s +/*REXX program sums the decimal digits of natural numbers in any base up to base 36.*/ +parse arg z /*obtain optional argument from the CL.*/ +if z='' | z="," then z= '1 1234 fe f0e +F0E -666.00 11111112222222333333344444449' + do j=1 for words(z); _=word(z, j) /*obtain a number from the list. */ + say right(sumDigs(_), 9) ' is the sum of the digits for the number ' _ + end /*j*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sumDigs: procedure; arg x; @=123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ; $=0 + do k=1 to length(x); $=$ + pos( substr(x, k, 1), @); end /*k*/ + return $ diff --git a/Task/Sum-digits-of-an-integer/REXX/sum-digits-of-an-integer-3.rexx b/Task/Sum-digits-of-an-integer/REXX/sum-digits-of-an-integer-3.rexx index 6e9ca936d4..33045eec52 100644 --- a/Task/Sum-digits-of-an-integer/REXX/sum-digits-of-an-integer-3.rexx +++ b/Task/Sum-digits-of-an-integer/REXX/sum-digits-of-an-integer-3.rexx @@ -1,13 +1,13 @@ -/*REXX program sums the decimal digits of integers expressed in base ten*/ -parse arg z /*get optional #s or use default.*/ -if z='' then z=copies(7, 108) /*let's generate a pretty huge #.*/ -numeric digits 1+max(length(z)) /*enable use of gigantic numbers.*/ +/*REXX program sums the decimal digits of integers expressed in base ten. */ +parse arg z /*obtain optional argument from the CL.*/ +if z='' | z="," then z=copies(7, 108) /*let's generate a pretty huge integer.*/ +numeric digits 1 + max( length(z) ) /*enable use of gigantic numbers. */ - do j=1 for words(z); _=abs(word(z,j)) /*ignore sign, if any.*/ - say sumDigs(_) ' is the sum of the digits for the number ' _ + do j=1 for words(z); _=abs(word(z, j)) /*ignore any leading sign, if present.*/ + say sumDigs(_) ' is the sum of the digits for the number ' _ end /*j*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────SUMDIGS subroutine──────────────────*/ -sumDigs: procedure; parse arg N 1 s 2 ? /*use first dig for S (sum),*/ - do while ?\==''; parse var ? _ 2 ?; s=s+_; end /*k*/ -return s +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sumDigs: procedure; parse arg N 1 $ 2 ? /*use first decimal digit for the sum. */ + do while ?\==''; parse var ? _ 2 ?; $=$+_; end /*while*/ + return $ diff --git a/Task/Sum-multiples-of-3-and-5/00DESCRIPTION b/Task/Sum-multiples-of-3-and-5/00DESCRIPTION index 12e6194065..54f547fdcf 100644 --- a/Task/Sum-multiples-of-3-and-5/00DESCRIPTION +++ b/Task/Sum-multiples-of-3-and-5/00DESCRIPTION @@ -1,9 +1,8 @@ -The objective is to write a function that finds the sum of all positive multiples of 3 or 5 below ''n''. Show output for ''n'' = 1000. +;Task: +The objective is to write a function that finds the sum of all positive multiples of 3 or 5 below ''n''. + +Show output for ''n'' = 1000. + '''Extra credit:''' do this efficiently for ''n'' = 1e20 or higher. - -== {{header|APL}} == -⎕IO←0 -{+/((0=3|a)∨0=5|a)/a←⍳⍵} 1000[http://ngn.github.io/apl/web/index.html#code=%7B+/%28%280%3D3%7Ca%29%u22280%3D5%7Ca%29/a%u2190%u2373%u2375%7D%201000,run=1 run] -{{out}} -
    233168
    +

    diff --git a/Task/Sum-multiples-of-3-and-5/ALGOL-68/sum-multiples-of-3-and-5-1.alg b/Task/Sum-multiples-of-3-and-5/ALGOL-68/sum-multiples-of-3-and-5-1.alg new file mode 100644 index 0000000000..edfd28687c --- /dev/null +++ b/Task/Sum-multiples-of-3-and-5/ALGOL-68/sum-multiples-of-3-and-5-1.alg @@ -0,0 +1,26 @@ +# returns the sum of the multiples of 3 and 5 below n # +PROC sum of multiples of 3 and 5 below = ( LONG LONG INT n )LONG LONG INT: + BEGIN + # calculate the sum of the multiples of 3 below n # + LONG LONG INT multiples of 3 = ( n - 1 ) OVER 3; + LONG LONG INT multiples of 5 = ( n - 1 ) OVER 5; + LONG LONG INT multiples of 15 = ( n - 1 ) OVER 15; + ( # twice the sum of multiples of 3 # + ( 3 * multiples of 3 * ( multiples of 3 + 1 ) ) + # plus twice the sum of multiples of 5 # + + ( 5 * multiples of 5 * ( multiples of 5 + 1 ) ) + # less twice the sum of multiples of 15 # + - ( 15 * multiples of 15 * ( multiples of 15 + 1 ) ) + ) OVER 2 + END # sum of multiples of 3 and 5 below # ; + +print( ( "Sum of multiples of 3 and 5 below 1000: " + , whole( sum of multiples of 3 and 5 below( 1000 ), 0 ) + , newline + ) + ); +print( ( "Sum of multiples of 3 and 5 below 1e20: " + , whole( sum of multiples of 3 and 5 below( 100 000 000 000 000 000 000 ), 0 ) + , newline + ) + ) diff --git a/Task/Sum-multiples-of-3-and-5/ALGOL-68/sum-multiples-of-3-and-5-2.alg b/Task/Sum-multiples-of-3-and-5/ALGOL-68/sum-multiples-of-3-and-5-2.alg new file mode 100644 index 0000000000..514455fc6b --- /dev/null +++ b/Task/Sum-multiples-of-3-and-5/ALGOL-68/sum-multiples-of-3-and-5-2.alg @@ -0,0 +1,2 @@ +⎕IO←0 +{+/((0=3|a)∨0=5|a)/a←⍳⍵} 1000 diff --git a/Task/Sum-multiples-of-3-and-5/ALGOL-68/sum-multiples-of-3-and-5-3.alg b/Task/Sum-multiples-of-3-and-5/ALGOL-68/sum-multiples-of-3-and-5-3.alg new file mode 100644 index 0000000000..df3ed962b3 --- /dev/null +++ b/Task/Sum-multiples-of-3-and-5/ALGOL-68/sum-multiples-of-3-and-5-3.alg @@ -0,0 +1,77 @@ +-- sum35 :: Int -> Int +on sum35(n) + sumMults(n, 3) + sumMults(n, 5) - sumMults(n, 15) +end sum35 + +-- Area under straight line between first multiple and last: + +-- sumMults :: Int -> Int -> Int +on sumMults(n, f) + set n1 to (n - 1) div f + + f * n1 * (n1 + 1) div 2 +end sumMults + + +-- TEST +on run + -- sums of all multiples of 3 or 5 below or equal to N + -- for N = 10 to N = 10E8 (limit of AS integers) + + -- sum35Result :: String -> Int -> Int -> String + script sum35Result + on lambda(a, x, i) + a & "10" & i & " -> " & ¬ + sum35(10 ^ x) & "
    " + end lambda + end script + + foldl(sum35Result, "", range(1, 8)) +end run + + + +-- GENERIC LIBRARY FUNCTIONS + +-- 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 + +-- range :: Int -> Int -> [Int] +on range(m, n) + set d to cond(n < m, -1, 1) + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range + +-- cond :: Bool -> (a -> b) -> (a -> b) -> (a -> b) +on cond(bool, f, g) + if bool then + f + else + g + end if +end cond diff --git a/Task/Sum-multiples-of-3-and-5/Go/sum-multiples-of-3-and-5-1.go b/Task/Sum-multiples-of-3-and-5/Go/sum-multiples-of-3-and-5-1.go index 9926ac1d87..f2f871caf6 100644 --- a/Task/Sum-multiples-of-3-and-5/Go/sum-multiples-of-3-and-5-1.go +++ b/Task/Sum-multiples-of-3-and-5/Go/sum-multiples-of-3-and-5-1.go @@ -6,11 +6,10 @@ func main() { fmt.Println(s35(1000)) } -func s35(i int) int { - i-- - sum2 := func(d int) int { - n := i / d - return d * n * (n + 1) - } - return (sum2(3) + sum2(5) - sum2(15)) / 2 +func s35(n int) int { + n-- + threes := math.Floor(float64(n / 3)) + fives := math.Floor(float64(n / 5)) + fifteen := math.Floor(float64(n / 15)) + return int((3*threes*(threes+1) + 5*fives*(fives+1) - 15*fifteen*(fifteen+1)) / 2) } diff --git a/Task/Sum-multiples-of-3-and-5/JavaScript/sum-multiples-of-3-and-5-4.js b/Task/Sum-multiples-of-3-and-5/JavaScript/sum-multiples-of-3-and-5-4.js new file mode 100644 index 0000000000..8c6d854234 --- /dev/null +++ b/Task/Sum-multiples-of-3-and-5/JavaScript/sum-multiples-of-3-and-5-4.js @@ -0,0 +1,5 @@ +function sm35(n){ + var s=0, inc=[3,2,1,3,1,2,3] + for (var j=6, i=0; i', i, ' ', sm35(n), '
    ') +} diff --git a/Task/Sum-multiples-of-3-and-5/JavaScript/sum-multiples-of-3-and-5-7.js b/Task/Sum-multiples-of-3-and-5/JavaScript/sum-multiples-of-3-and-5-7.js new file mode 100644 index 0000000000..3e55c89901 --- /dev/null +++ b/Task/Sum-multiples-of-3-and-5/JavaScript/sum-multiples-of-3-and-5-7.js @@ -0,0 +1,35 @@ +(() => { + + // Area under straight line + // between first multiple and last + let sumMults = (n, factor) => { + let n1 = Math.floor((n - 1) / factor); + + return Math.floor(factor * n1 * (n1 + 1) / 2); + }, + + sum35 = (n) => sumMults(n, 3) + sumMults(n, 5) - sumMults(n, 15); + + + // TEST + + // range(intFrom, intTo, optional intStep) + // Int -> Int -> Maybe Int -> [Int] + let range = (m, n, step) => { + let d = (step || 1) * (n >= m ? 1 : -1); + + return Array.from({ + length: Math.floor((n - m) / d) + 1 + }, (_, i) => m + (i * d)); + } + + // Sums for 10^1 thru 10^8 + + return range(1, 8) + .map(n => Math.pow(10, n)) + .reduce((a, x) => ( + a[x.toString()] = sum35(x), + a + ), {}); + +})(); diff --git a/Task/Sum-multiples-of-3-and-5/JavaScript/sum-multiples-of-3-and-5-8.js b/Task/Sum-multiples-of-3-and-5/JavaScript/sum-multiples-of-3-and-5-8.js new file mode 100644 index 0000000000..c02c71fb5d --- /dev/null +++ b/Task/Sum-multiples-of-3-and-5/JavaScript/sum-multiples-of-3-and-5-8.js @@ -0,0 +1,3 @@ +{"10":23, "100":2318, "1000":233168, "10000":23331668, +"100000":2333316668, "1000000":233333166668, "10000000":23333331666668, +"100000000":2333333316666668} diff --git a/Task/Sum-multiples-of-3-and-5/PowerShell/sum-multiples-of-3-and-5-1.psh b/Task/Sum-multiples-of-3-and-5/PowerShell/sum-multiples-of-3-and-5-1.psh new file mode 100644 index 0000000000..26ef1734ab --- /dev/null +++ b/Task/Sum-multiples-of-3-and-5/PowerShell/sum-multiples-of-3-and-5-1.psh @@ -0,0 +1,9 @@ +function SumMultiples ( [int]$Base, [int]$Upto ) + { + $X = ( $Upto - ( $Upto % $Base ) ) / $Base + $Sum = ( $X * $X + $X ) * $Base / 2 + Return $Sum + } + +# Calculate the sum of the multiples of 3 and 5 up to 1000 +( SumMultiples -Base 3 -Upto 1000 ) + ( SumMultiples -Base 5 -Upto 1000 ) - ( SumMultiples -Base 15 -Upto 1000 ) diff --git a/Task/Sum-multiples-of-3-and-5/PowerShell/sum-multiples-of-3-and-5-2.psh b/Task/Sum-multiples-of-3-and-5/PowerShell/sum-multiples-of-3-and-5-2.psh new file mode 100644 index 0000000000..31db4fcf7b --- /dev/null +++ b/Task/Sum-multiples-of-3-and-5/PowerShell/sum-multiples-of-3-and-5-2.psh @@ -0,0 +1,10 @@ +function SumMultiples ( [bigint]$Base, [bigint]$Upto ) + { + $X = ( $Upto - ( $Upto % $Base ) ) / $Base + $Sum = ( $X * $X + $X ) * $Base / 2 + Return $Sum + } + +# Calculate the sum of the multiples of 3 and 5 up to 10 ^ 210 +$Upto = [bigint]::Pow( 10, 210 ) +( SumMultiples -Base 3 -Upto $Upto ) + ( SumMultiples -Base 5 -Upto $Upto ) - ( SumMultiples -Base 15 -Upto $Upto ) diff --git a/Task/Sum-multiples-of-3-and-5/PowerShell/sum-multiples-of-3-and-5.psh b/Task/Sum-multiples-of-3-and-5/PowerShell/sum-multiples-of-3-and-5-3.psh similarity index 100% rename from Task/Sum-multiples-of-3-and-5/PowerShell/sum-multiples-of-3-and-5.psh rename to Task/Sum-multiples-of-3-and-5/PowerShell/sum-multiples-of-3-and-5-3.psh diff --git a/Task/Sum-multiples-of-3-and-5/PureBasic/sum-multiples-of-3-and-5.purebasic b/Task/Sum-multiples-of-3-and-5/PureBasic/sum-multiples-of-3-and-5.purebasic new file mode 100644 index 0000000000..e7ec558fa2 --- /dev/null +++ b/Task/Sum-multiples-of-3-and-5/PureBasic/sum-multiples-of-3-and-5.purebasic @@ -0,0 +1,20 @@ +EnableExplicit + +Procedure.q SumMultiples(Limit.q) + If Limit < 0 : Limit = -Limit : EndIf; convert negative numbers to positive + Protected.q i, sum = 0 + For i = 3 To Limit - 1 + If i % 3 = 0 Or i % 5 = 0 + sum + i + EndIf + Next + ProcedureReturn sum +EndProcedure + +If OpenConsole() + PrintN("Sum of numbers below 1000 which are multiples of 3 or 5 is : " + SumMultiples(1000)) + PrintN("") + PrintN("Press any key to close the console") + Repeat: Delay(10) : Until Inkey() <> "" + CloseConsole() +EndIf diff --git a/Task/Sum-multiples-of-3-and-5/REXX/sum-multiples-of-3-and-5-3.rexx b/Task/Sum-multiples-of-3-and-5/REXX/sum-multiples-of-3-and-5-3.rexx index 0764a288e5..28419b4178 100644 --- a/Task/Sum-multiples-of-3-and-5/REXX/sum-multiples-of-3-and-5-3.rexx +++ b/Task/Sum-multiples-of-3-and-5/REXX/sum-multiples-of-3-and-5-3.rexx @@ -1,14 +1,16 @@ -/*REXX pgm counts all integers from 1 ──► N─1 that are multiples of 3 or 5.*/ -parse arg N t .; if N=='' then N=1000; if t=='' then t=1 /*use defaults?*/ -numeric digits 1000; w=2+length(t) /*W: used for formatting 'e' part of Y.*/ +/*REXX program counts all integers from 1 ──► N─1 that are multiples of 3 or 5. */ +parse arg N t . /*obtain optional arguments from the CL*/ +if N=='' | N=="," then N=1000 /*Not specified? Then use the default.*/ +if t=='' | t=="," then t= 1 /* " " " " " " */ +numeric digits 1000; w=2+length(t) /*W: used for formatting 'e' part of Y.*/ say 'The sum of all positive integers that are a multiple of 3 and 5 are:' -say /* [↓] change the format/look of nE+nn*/ - do t; parse value format(N,2,1,,0) 'E0' with m 'E' _ .; _=_+0; z=n-1 - y=right((m/1)'e'_, w)"-1" /*this fixes a bug in a certain REXX. */ - if t==1 then y=z /*handle a special case of a one─timer.*/ - say 'integers from 1 ──►' y " is " sumDiv(z,3)+sumDiv(z,5)-sumDiv(z,3*5) - N=N'0' /*fast *10 multiply for next iteration.*/ +say /* [↓] change the format/look of nE+nn*/ + do t; parse value format(N,2,1,,0) 'E0' with m 'E' _ . /*get the exponent.*/ + y=right((m/1)'e' || (_+0), w)"-1" /*this fixes a bug in a certain REXX. */ + z=n-1; if t==1 then y=z /*handle a special case of a one─timer.*/ + say 'integers from 1 ──►' y " is " sumDiv(z,3) + sumDiv(z,5) - sumDiv(z,3*5) + N=N'0' /*fast *10 multiply for next iteration.*/ end /*t*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -sumDiv: procedure; parse arg x,d; $=x % d; return d * $ * ($+1) % 2 +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sumDiv: procedure; parse arg x,d; $=x % d; return d * $ * ($+1) % 2 diff --git a/Task/Sum-of-a-series/00DESCRIPTION b/Task/Sum-of-a-series/00DESCRIPTION index 9c2e94c85a..61fd029db2 100644 --- a/Task/Sum-of-a-series/00DESCRIPTION +++ b/Task/Sum-of-a-series/00DESCRIPTION @@ -1,13 +1,17 @@ -Compute the ''n''-th term of a [[wp:Series (mathematics)|series]], i.e. the sum of the ''n'' first terms of the corresponding [[wp:sequence|sequence]]. Informally this value, or its limit when n tends to infinity, is also called the ''sum of the series'', thus the title of this task. +Compute the   '''n'''th   term of a [[wp:Series (mathematics)|series]],   i.e. the sum of the   '''n'''   first terms of the corresponding [[wp:sequence|sequence]]. + +Informally this value, or its limit when   '''n'''   tends to infinity, is also called the ''sum of the series'', thus the title of this task. For this task, use: +:::::: S_n = \sum_{k=1}^n \frac{1}{k^2} -S_n = \sum_{k=1}^n \frac{1}{k^2} +
    +:: and compute   S_{1000} -and compute S_{1000}. -This approximates the [[wp:Riemann zeta function|zeta function]] for s=2, whose exact value +This approximates the   [[wp:Riemann zeta function|zeta function]]   for   S=2,   whose exact value -\zeta(2) = {\pi^2\over 6} +:::::: \zeta(2) = {\pi^2\over 6} is the solution of the [[wp:Basel problem|Basel problem]]. +

    diff --git a/Task/Sum-of-a-series/AppleScript/sum-of-a-series-1.applescript b/Task/Sum-of-a-series/AppleScript/sum-of-a-series-1.applescript new file mode 100644 index 0000000000..8797288b51 --- /dev/null +++ b/Task/Sum-of-a-series/AppleScript/sum-of-a-series-1.applescript @@ -0,0 +1,69 @@ +-- TEST --------------------------------------------------------- + +on inverseSquare(x) + 1 / (x ^ 2) +end inverseSquare + +on run + + seriesSum(inverseSquare, range(1, 1000)) + + --> 1.643934566682 +end run + + +-- SUM OF SERIES ---------------------------------------------- + +-- seriesSum :: Num a => (a -> a) -> [a] -> a +on seriesSum(f, xs) + set mf to mReturn(f) + script + on lambda(a, x) + a + (mf's lambda(x)) + end lambda + end script + + foldl(result, 0, xs) +end seriesSum + + + +-- GENERIC FUNCTIONS ------------------------------------------ + +-- 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 + +-- range :: Int -> Int -> [Int] +on range(m, n) + if n < m then + set d to -1 + else + set d to 1 + end if + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range diff --git a/Task/Sum-of-a-series/AppleScript/sum-of-a-series-2.applescript b/Task/Sum-of-a-series/AppleScript/sum-of-a-series-2.applescript new file mode 100644 index 0000000000..a72e40b97d --- /dev/null +++ b/Task/Sum-of-a-series/AppleScript/sum-of-a-series-2.applescript @@ -0,0 +1 @@ +1.643934566682 diff --git a/Task/Sum-of-a-series/Haskell/sum-of-a-series-4.hs b/Task/Sum-of-a-series/Haskell/sum-of-a-series-4.hs new file mode 100644 index 0000000000..ded8ffa0fa --- /dev/null +++ b/Task/Sum-of-a-series/Haskell/sum-of-a-series-4.hs @@ -0,0 +1,8 @@ +import Data.List (foldl') + +seriesSum :: Num a => (a -> a) -> [a] -> a +seriesSum f xs = foldl' (\a x -> a + (f x)) 0 xs + +main :: IO() +main = putStrLn $ show $ + seriesSum (\x -> 1 / x ^ 2) [1..1000] diff --git a/Task/Sum-of-a-series/JavaScript/sum-of-a-series-2.js b/Task/Sum-of-a-series/JavaScript/sum-of-a-series-2.js index 329aa022e8..32061ecfab 100644 --- a/Task/Sum-of-a-series/JavaScript/sum-of-a-series-2.js +++ b/Task/Sum-of-a-series/JavaScript/sum-of-a-series-2.js @@ -1,17 +1,25 @@ -sum(function (x) { return 1 / (x * x) }, range(1, 1000)); +(function () { -function sum(fn, lstRange) { - return lstRange.reduce( - function (lngSum, x) { - return lngSum + fn(x); - }, 0 - ); -} + function sum(fn, lstRange) { + return lstRange.reduce( + function (lngSum, x) { + return lngSum + fn(x); + }, 0 + ); + } -function range(m, n) { - return Array.apply(null, Array(n - m + 1)).map( - function (x, i) { + function range(m, n) { + return Array.apply(null, Array(n - m + 1)).map(function (x, i) { return m + i; - } + }); + } + + + return sum( + function (x) { + return 1 / (x * x); + }, + range(1, 1000) ); -} + +})(); diff --git a/Task/Sum-of-a-series/JavaScript/sum-of-a-series-3.js b/Task/Sum-of-a-series/JavaScript/sum-of-a-series-3.js new file mode 100644 index 0000000000..48786cb6fb --- /dev/null +++ b/Task/Sum-of-a-series/JavaScript/sum-of-a-series-3.js @@ -0,0 +1 @@ +1.6439345666815615 diff --git a/Task/Sum-of-a-series/JavaScript/sum-of-a-series-4.js b/Task/Sum-of-a-series/JavaScript/sum-of-a-series-4.js new file mode 100644 index 0000000000..0bed4ec680 --- /dev/null +++ b/Task/Sum-of-a-series/JavaScript/sum-of-a-series-4.js @@ -0,0 +1,20 @@ +(() => { + 'use strict'; + + // seriesSum :: Num a => (a -> a) -> [a] -> a + const seriesSum = (f, xs) => + xs.reduce((a, x) => a + f(x), 0); + + + // GENERIC ------------------------------------------ + + // range :: Int -> Int -> [Int] + const range = (m, n) => + Array.from({ + length: Math.floor(n - m) + 1 + }, (_, i) => m + i); + + // TEST ---------------------------------------------- + + return seriesSum(x => 1 / (x * x), range(1, 1000)); +})(); diff --git a/Task/Sum-of-a-series/JavaScript/sum-of-a-series-5.js b/Task/Sum-of-a-series/JavaScript/sum-of-a-series-5.js new file mode 100644 index 0000000000..48786cb6fb --- /dev/null +++ b/Task/Sum-of-a-series/JavaScript/sum-of-a-series-5.js @@ -0,0 +1 @@ +1.6439345666815615 diff --git a/Task/Sum-of-a-series/Pascal/sum-of-a-series.pascal b/Task/Sum-of-a-series/Pascal/sum-of-a-series.pascal index 8cf410556e..268d80ec01 100644 --- a/Task/Sum-of-a-series/Pascal/sum-of-a-series.pascal +++ b/Task/Sum-of-a-series/Pascal/sum-of-a-series.pascal @@ -1,18 +1,24 @@ Program SumSeries; +type + tOutput = double;//extended; + tmyFunc = function(number: LongInt): tOutput; -var - S: double; - i: integer; - -function f(number: integer): double; +function f(number: LongInt): tOutput; begin - f := 1/(number*number); + f := 1/sqr(tOutput(number)); end; +function Sum(from,upto: LongInt;func:tmyFunc):tOutput; +var + res: tOutput; begin - S := 0; - for i := 1 to 1000 do - S := S + f(i); - writeln('The sum of 1/x^2 from 1 to 1000 is: ', S:10:8); + res := 0.0; +// for from:= from to upto do res := res + f(from); + for upTo := upto downto from do res := res + f(upTo); + Sum := res; +end; + +BEGIN + writeln('The sum of 1/x^2 from 1 to 1000 is: ', Sum(1,1000,@f)); writeln('Whereas pi^2/6 is: ', pi*pi/6:10:8); end. diff --git a/Task/Sum-of-a-series/REXX/sum-of-a-series-1.rexx b/Task/Sum-of-a-series/REXX/sum-of-a-series-1.rexx index 553c8a8f78..90fc1a650b 100644 --- a/Task/Sum-of-a-series/REXX/sum-of-a-series-1.rexx +++ b/Task/Sum-of-a-series/REXX/sum-of-a-series-1.rexx @@ -1,11 +1,11 @@ -/*REXX program sums the first N terms of 1/(k**2), k=1 ──► N. */ -parse arg N D . /*obtain optional arguments from C.L. */ -if N=='' | N==',' then N=1000 /*Not specified? Then use the default.*/ -if D=='' | D==',' then D= 60 /* " " " " " " */ -numeric digits D /*use D digits (nine is the default)*/ -$=0 /*initialize the sum to zero. */ - do k=1 for N /* [↓] compute for N terms. */ - $=$ + 1/k**2 /*add a squared reciprocal to the sum. */ +/*REXX program sums the first N terms of 1/(k**2), k=1 ──► N. */ +parse arg N D . /*obtain optional arguments from the CL*/ +if N=='' | N=="," then N=1000 /*Not specified? Then use the default.*/ +if D=='' | D=="," then D= 60 /* " " " " " " */ +numeric digits D /*use D digits (9 is the REXX default).*/ +$=0 /*initialize the sum to zero. */ + do k=1 for N /* [↓] compute for N terms. */ + $=$ + 1/k**2 /*add a squared reciprocal to the sum. */ end /*k*/ -say 'The sum of' N "terms is:" $ /*stick a fork in it, we're all done. */ +say 'The sum of' N "terms is:" $ /*stick a fork in it, we're all done. */ diff --git a/Task/Sum-of-a-series/REXX/sum-of-a-series-2.rexx b/Task/Sum-of-a-series/REXX/sum-of-a-series-2.rexx index a017a9fe76..5c4b0dc596 100644 --- a/Task/Sum-of-a-series/REXX/sum-of-a-series-2.rexx +++ b/Task/Sum-of-a-series/REXX/sum-of-a-series-2.rexx @@ -1,16 +1,19 @@ -/*REXX program sums the first N terms of 1/(k**2), k=1 ──► N. */ -parse arg N D . /*obtain optional arguments from C.L. */ -if N=='' | N==',' then N=1000 /*Not specified? Then use the default.*/ -if D=='' | D==',' then D= 60 /* " " " " " " */ -numeric digits D /*use D digits (nine is the default)*/ -w=length(N) /*max width for the formatted output. */ -$=0 /*initialize the sum to zero. */ - do k=1 for N /* [↓] compute for N terms. */ - $=$ + 1/k**2 /*add a squared reciprocal to the sum. */ - parse var k s 2 m '' -1 e /*obtain the start and end decimal digs*/ - if e\==0 then iterate /*does K end with the dec digit 0 ? */ - if s\==1 then iterate /* " " start " " " " 1 ? */ - if m\=0 then iterate /* " " middle contain any non-zero ?*/ - say 'The sum of' right(k,w) "terms is:" $ /*display running sum.*/ +/*REXX program sums the first N terms o f 1/(k**2), k=1 ──► N. */ +parse arg N D . /*obtain optional arguments from the CL*/ +if N=='' | N=="," then N=1000 /*Not specified? Then use the default.*/ +if D=='' | D=="," then D= 60 /* " " " " " " */ +numeric digits D /*use D digits (9 is the REXX default).*/ +w=length(N) /*W is used for aligning the output. */ +$=0 /*initialize the sum to zero. */ + do k=1 for N /* [↓] compute for N terms. */ + $=$ + 1/k**2 /*add a squared reciprocal to the sum. */ + parse var k s 2 m '' -1 e /*obtain the start and end decimal digs*/ + if e\==0 then iterate /*does K end with the dec digit 0 ? */ + if s\==1 then iterate /* " " start " " " " 1 ? */ + if m\=0 then iterate /* " " middle contain any non-zero ?*/ + if k==N then iterate /* " " equal N, then skip running sum*/ + say 'The sum of' right(k,w) "terms is:" $ /*display a running sum.*/ end /*k*/ - /*stick a fork in it, we're all done. */ +say /*a blank line for sep. */ +say 'The sum of' right(k-1,w) "terms is:" $ /*display the final sum.*/ + /*stick a fork in it, we're all done. */ diff --git a/Task/Sum-of-a-series/REXX/sum-of-a-series-3.rexx b/Task/Sum-of-a-series/REXX/sum-of-a-series-3.rexx index ae02d361a1..003b66c434 100644 --- a/Task/Sum-of-a-series/REXX/sum-of-a-series-3.rexx +++ b/Task/Sum-of-a-series/REXX/sum-of-a-series-3.rexx @@ -1,22 +1,21 @@ -/*REXX program sums the first N terms of 1/(k**2), k=1 ──► N. */ -parse arg N D . /*obtain optional arguments from C.L. */ -if N=='' | N==',' then N=1000 /*Not specified? Then use the default.*/ -if D=='' | D==',' then D= 60 /* " " " " " " */ -numeric digits D /*use D digits (nine is the default)*/ -w=length(N) /*max width for the formatted output. */ -$=0 /*initialize the sum to zero. */ -old=1 /*the new sum to compared to the old. */ -p=0 /*significant decimal precision so far.*/ - do k=1 for N /* [↓] compute for N terms. */ - $=$ + 1/k**2 /*add a squared reciprocal to the sum. */ - c=compare($,old) /*see how we're doing with precision. */ - if c>p then do /*Got another significant decimal dig? */ - say 'The significant sum of' right(k,w) "terms is:" left($,c) - p=c /*use the new significant precision. */ - end /* [↑] display significant part of sum*/ - old=$ /*use "old" sum for the next compare. */ +/*REXX program sums the first N terms of 1/(k**2), k=1 ──► N. */ +parse arg N D . /*obtain optional arguments from the CL*/ +if N=='' | N=="," then N=1000 /*Not specified? Then use the default.*/ +if D=='' | D=="," then D= 60 /* " " " " " " */ +numeric digits D /*use D digits (9 is the REXX default).*/ +w=length(N) /*W is used for aligning the output. */ +$=0 /*initialize the sum to zero. */ +old=1 /*the new sum to compared to the old. */ +p=0 /*significant decimal precision so far.*/ + do k=1 for N /* [↓] compute for N terms. */ + $=$ + 1/k**2 /*add a squared reciprocal to the sum. */ + c=compare($,old) /*see how we're doing with precision. */ + if c>p then do /*Got another significant decimal dig? */ + say 'The significant sum of' right(k,w) "terms is:" left($,c) + p=c /*use the new significant precision. */ + end /* [↑] display significant part of sum*/ + old=$ /*use "old" sum for the next compare. */ end /*k*/ -say /*display blank line for sep.*/ -say 'The sum of' right(N,w) "terms is:" /*display the sum's preamble.*/ -say $ /*display the sum on its own line. */ - /*stick a fork in it, we're all done. */ +say /*display blank line for the separator.*/ +say 'The sum of' right(N,w) "terms is:" /*display the sum's preamble line. */ +say $ /*stick a fork in it, we're all done. */ diff --git a/Task/Sum-of-a-series/Rust/sum-of-a-series.rust b/Task/Sum-of-a-series/Rust/sum-of-a-series.rust index 36286bd506..4d985b2d3c 100644 --- a/Task/Sum-of-a-series/Rust/sum-of-a-series.rust +++ b/Task/Sum-of-a-series/Rust/sum-of-a-series.rust @@ -1,4 +1,12 @@ +const LOWER: i32 = 1; +const UPPER: i32 = 1000; + +// Because the rule for our series is simply adding one, the number of terms are the number of +// digits between LOWER and UPPER +const NUMBER_OF_TERMS: i32 = (UPPER + 1) - LOWER; fn main() { - let sum: f64 = (1u64..1000+1).fold(0.,|sum, num| sum + 1./(num*num) as f64); - println!("{}", sum); + // Formulaic method + println!("{}", (NUMBER_OF_TERMS * (LOWER + UPPER)) / 2); + // Naive method + println!("{}", (LOWER..UPPER + 1).fold(0, |sum, x| sum + x)); } diff --git a/Task/Sum-of-squares/00DESCRIPTION b/Task/Sum-of-squares/00DESCRIPTION index ba1d9faf46..8eefedbf75 100644 --- a/Task/Sum-of-squares/00DESCRIPTION +++ b/Task/Sum-of-squares/00DESCRIPTION @@ -1,4 +1,9 @@ -Write a program to find the sum of squares of a numeric vector.
    -The program should work on a zero-length vector (with an answer of 0). +;Task: +Write a program to find the sum of squares of a numeric vector. -See also [[Mean]]. +The program should work on a zero-length vector (with an answer of   '''0'''). + + +;Related task: +*   [[Mean]] +

    diff --git a/Task/Sum-of-squares/REXX/sum-of-squares-1.rexx b/Task/Sum-of-squares/REXX/sum-of-squares-1.rexx new file mode 100644 index 0000000000..f365ec8e7b --- /dev/null +++ b/Task/Sum-of-squares/REXX/sum-of-squares-1.rexx @@ -0,0 +1,9 @@ +numeric digits 100 /*allow 100─digit numbers; default is 9*/ +v= -100 9 8 7 6 0 3 4 5 2 1 .5 10 11 12 /*define a vector with fifteen numbers.*/ +#=words(v) /*obtain number of words in the V list.*/ +$= 0 /*initialize the sum ($) to zero. */ + do k=1 for # /*process each number in the V vector. */ + $=$ + word(v,k)**2 /*add a squared element to the ($) sum.*/ + end /*k*/ /* [↑] if vector is empty, then sum=0.*/ + /*stick a fork in it, we're all done. */ +say 'The sum of ' # " squared elements for the V vector is: " $ diff --git a/Task/Sum-of-squares/REXX/sum-of-squares-2.rexx b/Task/Sum-of-squares/REXX/sum-of-squares-2.rexx new file mode 100644 index 0000000000..af9beb5372 --- /dev/null +++ b/Task/Sum-of-squares/REXX/sum-of-squares-2.rexx @@ -0,0 +1,12 @@ +/*REXX program sums the squares of the numbers in a (numeric) vector of 15 numbers. */ +numeric digits 100 /*allow 100─digit numbers; default is 9*/ +parse arg v /*get optional numbers from the C.L. */ +if v='' then v= -100 9 8 7 6 0 3 4 5 2 1 .5 10 11 12 /*Not specified? Use default*/ +#=words(v) /*obtain number of words in V*/ +say 'The vector of ' # " elements is: " space(v) /*display the vector numbers.*/ +$= 0 /*initialize the sum ($) to zero. */ + do until v==''; parse var v x v /*process each number in the V vector. */ + $=$ + x**2 /*add a squared element to the ($) sum.*/ + end /*until*/ /* [↑] if vector is empty, then sum=0.*/ +say /*stick a fork in it, we're all done. */ +say 'The sum of ' # " squared elements for the V vector is: " $ diff --git a/Task/Sum-of-squares/REXX/sum-of-squares.rexx b/Task/Sum-of-squares/REXX/sum-of-squares.rexx deleted file mode 100644 index 039fca4e31..0000000000 --- a/Task/Sum-of-squares/REXX/sum-of-squares.rexx +++ /dev/null @@ -1,10 +0,0 @@ -/*REXX program sums the squares of the numbers in a (numeric) vector of 15 #s.*/ -numeric digits 100 /*allow 100─digit numbers; default is 9*/ -v=-100 9 8 7 6 0 3 4 5 2 1 .5 10 11 12 /*define a vector with fifteen numbers.*/ -$=0 /*initialize the sum ($) to zero. */ - do k=1 for words(v) /*process each number in the V vector.*/ - $=$ + word(v,k)**2 /*add squared element (#) to the sum. */ - end /*k*/ /* [↑] if vector is empty, then sum=0.*/ - -say 'The sum of ' words(v) " squared elements for the V vector is: " $ - /*stick a fork in it, we're all done. */ diff --git a/Task/Sum-of-squares/Ruby/sum-of-squares-1.rb b/Task/Sum-of-squares/Ruby/sum-of-squares-1.rb index 69d7c2ee8a..1121b35eaf 100644 --- a/Task/Sum-of-squares/Ruby/sum-of-squares-1.rb +++ b/Task/Sum-of-squares/Ruby/sum-of-squares-1.rb @@ -1 +1 @@ -[3,1,4,1,5,9].inject(0) { |sum,x| sum += x**2 } +[3,1,4,1,5,9].reduce(0){|sum,x| sum + x*x} diff --git a/Task/Sum-of-squares/Ruby/sum-of-squares-2.rb b/Task/Sum-of-squares/Ruby/sum-of-squares-2.rb index 8a87a51388..267f9b331c 100644 --- a/Task/Sum-of-squares/Ruby/sum-of-squares-2.rb +++ b/Task/Sum-of-squares/Ruby/sum-of-squares-2.rb @@ -1 +1 @@ -[3,1,4,1,5,9].map { |x| x**2 }.reduce(0, :+) +[3,1,4,1,5,9].map{|x| x*x}.reduce :+ diff --git a/Task/Sutherland-Hodgman-polygon-clipping/00DESCRIPTION b/Task/Sutherland-Hodgman-polygon-clipping/00DESCRIPTION index 1db06522bd..f1f715c021 100644 --- a/Task/Sutherland-Hodgman-polygon-clipping/00DESCRIPTION +++ b/Task/Sutherland-Hodgman-polygon-clipping/00DESCRIPTION @@ -1,10 +1,19 @@ -The [[wp:Sutherland-Hodgman clipping algorithm|Sutherland-Hodgman clipping algorithm]] finds the polygon that is the intersection between an arbitrary polygon (the “subject polygon”) and a convex polygon (the “clip polygon”). It is used in computer graphics (especially 2D graphics) to reduce the complexity of a scene being displayed by eliminating parts of a polygon that do not need to be displayed. +The   [[wp:Sutherland-Hodgman clipping algorithm|Sutherland-Hodgman clipping algorithm]]   finds the polygon that is the intersection between an arbitrary polygon (the “subject polygon”) and a convex polygon (the “clip polygon”). -For this task, take the closed polygon defined by the points: -: [(50, 150), (200, 50), (350, 150), (350, 300), (250, 300), (200, 250), (150, 350), (100, 250), (100, 200)] +It is used in computer graphics (especially 2D graphics) to reduce the complexity of a scene being displayed by eliminating parts of a polygon that do not need to be displayed. + + +;Task: +Take the closed polygon defined by the points: +: [(50, 150), (200, 50), (350, 150), (350, 300), (250, 300), (200, 250), (150, 350), (100, 250), (100, 200)] and clip it by the rectangle defined by the points: -: [(100, 100), (300, 100), (300, 300), (100, 300)] +: [(100, 100), (300, 100), (300, 300), (100, 300)] Print the sequence of points that define the resulting clipped polygon. -'''Extra credit:''' Display all three polygons on a graphical surface, using a different color for each polygon and filling the resulting polygon. (When displaying you may use either a north-west or a south-west origin, whichever is more convenient for your display mechanism.) + +;Extra credit: +Display all three polygons on a graphical surface, using a different color for each polygon and filling the resulting polygon. + +(When displaying you may use either a north-west or a south-west origin, whichever is more convenient for your display mechanism.) +

    diff --git a/Task/Sutherland-Hodgman-polygon-clipping/Elixir/sutherland-hodgman-polygon-clipping.elixir b/Task/Sutherland-Hodgman-polygon-clipping/Elixir/sutherland-hodgman-polygon-clipping.elixir new file mode 100644 index 0000000000..6598da657b --- /dev/null +++ b/Task/Sutherland-Hodgman-polygon-clipping/Elixir/sutherland-hodgman-polygon-clipping.elixir @@ -0,0 +1,38 @@ +defmodule SutherlandHodgman do + defp inside(cp1, cp2, p), do: (cp2.x-cp1.x)*(p.y-cp1.y) > (cp2.y-cp1.y)*(p.x-cp1.x) + + defp intersection(cp1, cp2, s, e) do + {dcx, dcy} = {cp1.x-cp2.x, cp1.y-cp2.y} + {dpx, dpy} = {s.x-e.x, s.y-e.y} + n1 = cp1.x*cp2.y - cp1.y*cp2.x + n2 = s.x*e.y - s.y*e.x + n3 = 1.0 / (dcx*dpy - dcy*dpx) + %{x: (n1*dpx - n2*dcx) * n3, y: (n1*dpy - n2*dcy) * n3} + end + + def polygon_clipping(subjectPolygon, clipPolygon) do + Enum.chunk([List.last(clipPolygon) | clipPolygon], 2, 1) + |> Enum.reduce(subjectPolygon, fn [cp1,cp2],acc -> + Enum.chunk([List.last(acc) | acc], 2, 1) + |> Enum.reduce([], fn [s,e],outputList -> + case {inside(cp1, cp2, e), inside(cp1, cp2, s)} do + {true, true} -> [e | outputList] + {true, false} -> [e, intersection(cp1,cp2,s,e) | outputList] + {false, true} -> [intersection(cp1,cp2,s,e) | outputList] + _ -> outputList + end + end) + |> Enum.reverse + end) + end +end + +subjectPolygon = [[50, 150], [200, 50], [350, 150], [350, 300], [250, 300], + [200, 250], [150, 350], [100, 250], [100, 200]] + |> Enum.map(fn [x,y] -> %{x: x, y: y} end) + +clipPolygon = [[100, 100], [300, 100], [300, 300], [100, 300]] + |> Enum.map(fn [x,y] -> %{x: x, y: y} end) + +SutherlandHodgman.polygon_clipping(subjectPolygon, clipPolygon) +|> Enum.each(&IO.inspect/1) diff --git a/Task/Sutherland-Hodgman-polygon-clipping/PHP/sutherland-hodgman-polygon-clipping.php b/Task/Sutherland-Hodgman-polygon-clipping/PHP/sutherland-hodgman-polygon-clipping.php new file mode 100644 index 0000000000..5ef26f434b --- /dev/null +++ b/Task/Sutherland-Hodgman-polygon-clipping/PHP/sutherland-hodgman-polygon-clipping.php @@ -0,0 +1,47 @@ + ($cp2[1]-$cp1[1])*($p[0]-$cp1[0]); + } + + function intersection ($cp1, $cp2, $e, $s) { + $dc = [ $cp1[0] - $cp2[0], $cp1[1] - $cp2[1] ]; + $dp = [ $s[0] - $e[0], $s[1] - $e[1] ]; + $n1 = $cp1[0] * $cp2[1] - $cp1[1] * $cp2[0]; + $n2 = $s[0] * $e[1] - $s[1] * $e[0]; + $n3 = 1.0 / ($dc[0] * $dp[1] - $dc[1] * $dp[0]); + + return [($n1*$dp[0] - $n2*$dc[0]) * $n3, ($n1*$dp[1] - $n2*$dc[1]) * $n3]; + } + + $outputList = $subjectPolygon; + $cp1 = end($clipPolygon); + foreach ($clipPolygon as $cp2) { + $inputList = $outputList; + $outputList = []; + $s = end($inputList); + foreach ($inputList as $e) { + if (inside($e, $cp1, $cp2)) { + if (!inside($s, $cp1, $cp2)) { + $outputList[] = intersection($cp1, $cp2, $e, $s); + } + $outputList[] = $e; + } + else if (inside($s, $cp1, $cp2)) { + $outputList[] = intersection($cp1, $cp2, $e, $s); + } + $s = $e; + } + $cp1 = $cp2; + } + return $outputList; +} + +$subjectPolygon = [[50, 150], [200, 50], [350, 150], [350, 300], [250, 300], [200, 250], [150, 350], [100, 250], [100, 200]]; +$clipPolygon = [[100, 100], [300, 100], [300, 300], [100, 300]]; +$clippedPolygon = clip($subjectPolygon, $clipPolygon); + +echo json_encode($clippedPolygon); +echo "\n"; +?> diff --git a/Task/Symmetric-difference/00DESCRIPTION b/Task/Symmetric-difference/00DESCRIPTION index a8ba5d384f..c3b819e229 100644 --- a/Task/Symmetric-difference/00DESCRIPTION +++ b/Task/Symmetric-difference/00DESCRIPTION @@ -1,20 +1,5 @@ -Given two [[set]]s ''A'' and ''B'', where ''A'' contains: - -* John -* Bob -* Mary -* Serena - -and ''B'' contains: - -* Jim -* Mary -* John -* Bob - -compute - -:(A \setminus B) \cup (B \setminus A). +;Task +Given two [[set]]s ''A'' and ''B'', compute (A \setminus B) \cup (B \setminus A). That is, enumerate the items that are in ''A'' or ''B'' but not both. This set is called the [[wp:Symmetric difference|symmetric difference]] of ''A'' and ''B''. @@ -22,6 +7,13 @@ In other words: (A \cup B) \setminus (A \cap B) (the set of items t Optionally, give the individual differences (A \setminus B and B \setminus A) as well. + +;Test cases + A = {John, Bob, Mary, Serena} + B = {Jim, Mary, John, Bob} + + ;Notes # If your code uses lists of items to represent sets then ensure duplicate items in lists are correctly handled. For example two lists representing sets of a = ["John", "Serena", "Bob", "Mary", "Serena"] and b = ["Jim", "Mary", "John", "Jim", "Bob"] should produce the result of just two strings: ["Serena", "Jim"], in any order. # In the mathematical notation above A \ B gives the set of items in A that are not in B; A ∪ B gives the set of items in both A and B, (their ''union''); and A ∩ B gives the set of items that are in both A and B (their ''intersection''). +

    diff --git a/Task/Symmetric-difference/AppleScript/symmetric-difference-1.applescript b/Task/Symmetric-difference/AppleScript/symmetric-difference-1.applescript new file mode 100644 index 0000000000..ed381f5809 --- /dev/null +++ b/Task/Symmetric-difference/AppleScript/symmetric-difference-1.applescript @@ -0,0 +1,111 @@ +-- UNION AND DIFFERENCE + +-- union :: [a] -> [a] -> [a] +on union(xs, ys) + nub(xs & ys) +end union + +-- difference :: [a] -> [a] -> [a] +on difference(xs, ys) + script except + on lambda(a, y) + if a contains y then + |delete|(y, a) + else + a + end if + end lambda + end script + + foldl(except, xs, ys) +end difference + + +-- TEST + +on run + + set a to ["John", "Serena", "Bob", "Mary", "Serena"] + set b to ["Jim", "Mary", "John", "Jim", "Bob"] + + + -- 'Symmetric difference' + + union(difference(a, b), difference(b, a)) + + --> {"Serena", "Jim"} + +end run + + +-- GENERIC LIBRARY FUNCTIONS + +-- 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 + +-- unique set of members of xs +-- nub :: [a] -> [a] +on nub(xs) + if (length of xs) > 1 then + set x to item 1 of xs + [x] & nub(|delete|(x, items 2 thru -1 of xs)) + else + xs + end if +end nub + +-- uncons :: [a] -> Maybe (a, [a]) +on uncons(xs) + if length of xs > 0 then + {item 1 of xs, rest of xs} + else + missing value + end if +end uncons + +-- deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a] +on deleteBy(fnEq, x, xs) + if length of xs > 0 then + set {h, t} to uncons(xs) + if lambda(x, h) of mReturn(fnEq) then + t + else + {h} & deleteBy(fnEq, x, t) + end if + else + {} + end if +end deleteBy + +-- delete :: a -> [a] -> [a] +on |delete|(x, xs) + script Eq + on lambda(a, b) + a = b + end lambda + end script + + deleteBy(Eq, x, xs) +end |delete| + + +-- 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 diff --git a/Task/Symmetric-difference/AppleScript/symmetric-difference-2.applescript b/Task/Symmetric-difference/AppleScript/symmetric-difference-2.applescript new file mode 100644 index 0000000000..30296ca661 --- /dev/null +++ b/Task/Symmetric-difference/AppleScript/symmetric-difference-2.applescript @@ -0,0 +1 @@ +{"Serena", "Jim"} diff --git a/Task/Symmetric-difference/Elixir/symmetric-difference.elixir b/Task/Symmetric-difference/Elixir/symmetric-difference.elixir index 756bcdfcf1..6e5a88e4fb 100644 --- a/Task/Symmetric-difference/Elixir/symmetric-difference.elixir +++ b/Task/Symmetric-difference/Elixir/symmetric-difference.elixir @@ -1,8 +1,8 @@ -iex(1)> a = Enum.into(~w(John Bob Mary Serena), HashSet.new) -#HashSet<["Mary", "Serena", "John", "Bob"]> -iex(2)> b = Enum.into(~w(Jim Mary John Bob), HashSet.new) -#HashSet<["Mary", "Jim", "John", "Bob"]> -iex(3)> sym_dif = fn(a,b) -> Set.difference(Set.union(a,b), Set.intersection(a,b)) end -#Function<12.90072148/2 in :erl_eval.expr/5> +iex(1)> a = ~w[John Bob Mary Serena] |> MapSet.new +#MapSet<["Bob", "John", "Mary", "Serena"]> +iex(2)> b = ~w[Jim Mary John Bob] |> MapSet.new +#MapSet<["Bob", "Jim", "John", "Mary"]> +iex(3)> sym_dif = fn(a,b) -> MapSet.difference(MapSet.union(a,b), MapSet.intersection(a,b)) end +#Function<12.54118792/2 in :erl_eval.expr/5> iex(4)> sym_dif.(a,b) -#HashSet<["Serena", "Jim"]> +#MapSet<["Jim", "Serena"]> diff --git a/Task/Symmetric-difference/JavaScript/symmetric-difference-3.js b/Task/Symmetric-difference/JavaScript/symmetric-difference-3.js new file mode 100644 index 0000000000..b2c3ce7014 --- /dev/null +++ b/Task/Symmetric-difference/JavaScript/symmetric-difference-3.js @@ -0,0 +1,66 @@ +((a, b) => { + 'use strict'; + + + let // UNION AND DIFFERENCE + + // union :: [a] -> [a] -> [a] + union = (xs, ys) => unionBy((a, b) => a === b, xs, ys), + + // difference :: [a] -> [a] -> [a] + difference = (xs, ys) => + ys.reduce((a, y) => + a.indexOf(y) !== -1 ? ( + delete_(y, a) + ) : a.concat(y), xs), + + + + // GENERAL PRIMITIVES + + // unionBy :: (a -> a -> Bool) -> [a] -> [a] -> [a] + unionBy = (f, xs, ys) => { + let sx = nubBy(f, xs), + sy = nubBy(f, ys); + + return sx.concat( + sx + .reduce( + (a, x) => deleteBy(f, x, a), + sy + ) + ) + }, + + // deleteBy :: (a -> a -> Bool) -> a -> [a] -> [a] + deleteBy = (f, x, xs) => + xs.reduce((a, y) => f(x, y) ? a : a.concat(y), []), + + // delete_ :: a -> [a] -> [a] + delete_ = (x, xs) => + deleteBy((a, b) => a === b, x, xs), + + // nubBy :: (a -> a -> Bool) -> [a] -> [a] + nubBy = (f, xs) => { + let x = (xs.length ? xs[0] : undefined); + + return x !== undefined ? [x].concat( + nubBy(f, xs.slice(1) + .filter(y => !f(x, y)) + ) + ) : []; + }; + + + + // 'SYMMETRIC DIFFERENCE' + + return union( + difference(a, b), + difference(b, a) + ); + +})( + ["John", "Serena", "Bob", "Mary", "Serena"], + ["Jim", "Mary", "John", "Jim", "Bob"] +); diff --git a/Task/Symmetric-difference/JavaScript/symmetric-difference-4.js b/Task/Symmetric-difference/JavaScript/symmetric-difference-4.js new file mode 100644 index 0000000000..b293d69973 --- /dev/null +++ b/Task/Symmetric-difference/JavaScript/symmetric-difference-4.js @@ -0,0 +1 @@ +["Serena", "Jim"] diff --git a/Task/Symmetric-difference/Perl-6/symmetric-difference.pl6 b/Task/Symmetric-difference/Perl-6/symmetric-difference.pl6 index 124866a530..da2420cd62 100644 --- a/Task/Symmetric-difference/Perl-6/symmetric-difference.pl6 +++ b/Task/Symmetric-difference/Perl-6/symmetric-difference.pl6 @@ -1,4 +1,6 @@ -my $A = set ; -my $B = set ; +my \A = set ; +my \B = set ; -say $A (^) $B; +say A ∖ B; # Set subtraction +say B ∖ A; # Set subtraction +say A ⊖ B; # Symmetric difference diff --git a/Task/Symmetric-difference/PowerShell/symmetric-difference.psh b/Task/Symmetric-difference/PowerShell/symmetric-difference.psh new file mode 100644 index 0000000000..ee72324cec --- /dev/null +++ b/Task/Symmetric-difference/PowerShell/symmetric-difference.psh @@ -0,0 +1,21 @@ +$A = @( "John" + "Bob" + "Mary" + "Serena" ) + +$B = @( "Jim" + "Mary" + "John" + "Bob" ) + +# Full commandlet name and full parameter names +Compare-Object -ReferenceObject $A -DifferenceObject $B + +# Same commandlet using an alias and positional parameters +Compare $A $B + +# A - B +Compare $A $B | Where SideIndicator -eq "<=" | Select -ExpandProperty InputObject + +# B - A +Compare $A $B | Where SideIndicator -eq "=>" | Select -ExpandProperty InputObject diff --git a/Task/Synchronous-concurrency/Elixir/synchronous-concurrency.elixir b/Task/Synchronous-concurrency/Elixir/synchronous-concurrency.elixir new file mode 100644 index 0000000000..57c9ff605c --- /dev/null +++ b/Task/Synchronous-concurrency/Elixir/synchronous-concurrency.elixir @@ -0,0 +1,31 @@ +defmodule RC do + def start do + my_pid = self + pid = spawn( fn -> reader(my_pid, 0) end ) + File.open( "input.txt", [:read], fn io -> + process( IO.gets(io, ""), io, pid ) + end ) + end + + defp process( :eof, _io, pid ) do + send( pid, :count ) + receive do + i -> IO.puts "Count:#{i}" + end + end + defp process( any, io, pid ) do + send( pid, any ) + process( IO.gets(io, ""), io, pid ) + end + + defp reader( pid, c ) do + receive do + :count -> send( pid, c ) + any -> + IO.write any + reader( pid, c+1 ) + end + end +end + +RC.start diff --git a/Task/Synchronous-concurrency/Erlang/synchronous-concurrency.erl b/Task/Synchronous-concurrency/Erlang/synchronous-concurrency.erl index 9d1e889a6e..6c07d70ae8 100644 --- a/Task/Synchronous-concurrency/Erlang/synchronous-concurrency.erl +++ b/Task/Synchronous-concurrency/Erlang/synchronous-concurrency.erl @@ -9,8 +9,6 @@ start() -> process( io:get_line(IO, ""), IO, Pid ), file:close( IO ). - - process( eof, _IO, Pid ) -> Pid ! count, receive diff --git a/Task/Synchronous-concurrency/Go/synchronous-concurrency.go b/Task/Synchronous-concurrency/Go/synchronous-concurrency.go index afb025dcde..80249c2961 100644 --- a/Task/Synchronous-concurrency/Go/synchronous-concurrency.go +++ b/Task/Synchronous-concurrency/Go/synchronous-concurrency.go @@ -1,54 +1,32 @@ package main import ( - "bufio" - "fmt" - "io" - "os" + "bufio" + "fmt" + "log" + "os" ) -// main, one of two goroutines used, will function as the "reading unit" func main() { - // get file open first - f, err := os.Open("input.txt") - if err != nil { - fmt.Println(err) - return - } - defer f.Close() - lr := bufio.NewReader(f) + lines := make(chan string) + count := make(chan int) + go func() { + c := 0 + for l := range lines { + fmt.Println(l) + c++ + } + count <- c + }() - // that went ok, now create communication channels, - // and start second goroutine as the "printing unit" - lines := make(chan string) - count := make(chan int) - go printer(lines, count) - - for { - switch line, err := lr.ReadString('\n'); err { - case nil: - lines <- line - continue - case io.EOF: - default: - fmt.Println(err) - } - break - } - - // this represents the request for the printer to send the count - close(lines) - // wait for the count from the printer, then print it, then exit - fmt.Println("Number of lines:", <-count) -} - -func printer(in <-chan string, count chan<- int) { - c := 0 - // loop as long as in channel stays open - for s := range in { - fmt.Print(s) - c++ - } - // make count available on count channel, then return (terminate goroutine) - count <- c + f, err := os.Open("input.txt") + if err != nil { + log.Fatal(err) + } + for s := bufio.NewScanner(f); s.Scan(); { + lines <- s.Text() + } + f.Close() + close(lines) + fmt.Println("Number of lines:", <-count) } diff --git a/Task/Synchronous-concurrency/TXR/synchronous-concurrency.txr b/Task/Synchronous-concurrency/TXR/synchronous-concurrency.txr new file mode 100644 index 0000000000..d6f3ee7b8b --- /dev/null +++ b/Task/Synchronous-concurrency/TXR/synchronous-concurrency.txr @@ -0,0 +1,33 @@ +(defstruct thread nil + suspended + cont + (:method resume (self) + [self.cont]) + (:method give (self item) + [self.cont item]) + (:method get (self) + (yield-from run nil)) + (:method start (self) + (set self.cont (obtain self.(run))) + (unless self.suspended + self.(resume))) + (:postinit (self) + self.(start))) + +(defstruct consumer thread + (count 0) + (:method run (self) + (whilet ((item self.(get))) + (prinl item) + (inc self.count)))) + +(defstruct producer thread + consumer + (:method run (self) + (whilet ((line (get-line))) + self.consumer.(give line)))) + +(let* ((con (new consumer)) + (pro (new producer suspended t consumer con))) + pro.(resume) + (put-line `count = @{con.count}`)) diff --git a/Task/System-time/00DESCRIPTION b/Task/System-time/00DESCRIPTION index 84064d3a76..6adb4f1f1c 100644 --- a/Task/System-time/00DESCRIPTION +++ b/Task/System-time/00DESCRIPTION @@ -1,8 +1,13 @@ {{omit from|ML/I}} {{omit from|ZX Spectrum Basic|Does not have a real time clock.}} -Output the system '''time''' (any units will do as long as they are noted) either by a [[Execute a System Command|system command]] or one built into the language. + +;Task: +Output the system '''time'''   (any units will do as long as they are noted) either by a [[Execute a System Command|system command]] or one built into the language. + The system time can be used for debugging, network information, random number seeds, or something as simple as program performance. -'''See Also''' -* [[Date format]] -* [[wp:System time#Retrieving system time|Retrieving system time (wiki)]] + +;See also: +*   [[Date format]] +*   [[wp:System time#Retrieving system time|Retrieving system time (wiki)]] +

    diff --git a/Task/Table-creation-Postal-addresses/00DESCRIPTION b/Task/Table-creation-Postal-addresses/00DESCRIPTION index 113ef2a598..d0d6db6b03 100644 --- a/Task/Table-creation-Postal-addresses/00DESCRIPTION +++ b/Task/Table-creation-Postal-addresses/00DESCRIPTION @@ -1,3 +1,7 @@ -In this task, the goal is to create a table to store addresses. You may assume that all the addresses to be stored will be located in the USA. As such, you will need (in addition to a field holding a unique identifier) a field holding the street address, a field holding the city, a field holding the state code, and a field holding the zipcode. Choose appropriate types for each field. +;Task: +Create a table to store addresses. + +You may assume that all the addresses to be stored will be located in the USA.   As such, you will need (in addition to a field holding a unique identifier) a field holding the street address, a field holding the city, a field holding the state code, and a field holding the zipcode.   Choose appropriate types for each field. For non-database languages, show how you would open a connection to a database (your choice of which) and create an address table in it. You should follow the existing models here for how you would structure the table. +

    diff --git a/Task/Table-creation-Postal-addresses/PowerShell/table-creation-postal-addresses.psh b/Task/Table-creation-Postal-addresses/PowerShell/table-creation-postal-addresses.psh new file mode 100644 index 0000000000..1d1b00f39e --- /dev/null +++ b/Task/Table-creation-Postal-addresses/PowerShell/table-creation-postal-addresses.psh @@ -0,0 +1,33 @@ +Import-Module -Name PSSQLite + + +## Create a database and a table +$dataSource = ".\Addresses.db" +$query = "CREATE TABLE SSADDRESS (Id INTEGER PRIMARY KEY AUTOINCREMENT, + LastName TEXT NOT NULL, + FirstName TEXT NOT NULL, + Address TEXT NOT NULL, + City TEXT NOT NULL, + State CHAR(2) NOT NULL, + Zip CHAR(5) NOT NULL +)" + +Invoke-SqliteQuery -Query $Query -DataSource $DataSource + + +## Insert some data +$query = "INSERT INTO SSADDRESS ( FirstName, LastName, Address, City, State, Zip) + VALUES (@FirstName, @LastName, @Address, @City, @State, @Zip)" + +Invoke-SqliteQuery -DataSource $DataSource -Query $query -SqlParameters @{ + LastName = "Monster" + FirstName = "Cookie" + Address = "666 Sesame St" + City = "Holywood" + State = "CA" + Zip = "90013" +} + + +## View the data +Invoke-SqliteQuery -DataSource $DataSource -Query "SELECT * FROM SSADDRESS" | FormatTable -AutoSize diff --git a/Task/Table-creation-Postal-addresses/REXX/table-creation-postal-addresses-1.rexx b/Task/Table-creation-Postal-addresses/REXX/table-creation-postal-addresses-1.rexx index a5809da825..4df4074703 100644 --- a/Task/Table-creation-Postal-addresses/REXX/table-creation-postal-addresses-1.rexx +++ b/Task/Table-creation-Postal-addresses/REXX/table-creation-postal-addresses-1.rexx @@ -1,37 +1,37 @@ -╔════════════════════════════════════════════════════════════════════════════════╗ -╟───── Format of an entry in the USA address/city/state/zip code structure:──────╣ -║ ║ -║ The "structure" name can be any legal variable name, but here the name will be ║ -║ shortened to make these comments (and program) easier to read; its name will ║ -║ be @USA (in any letter case). In addition, the following variable names║ -║ (stemmed array tails) will need to be kept uninitialized (that is, not used ║ -║ for any variable name). To that end, each of these variable names will have an║ -║ underscore in the beginning of each name. Other possibilities are to have a ║ -║ trailing underscore (or both leading and trailing), or some other special eye─ ║ -║ catching character such as: ! @ # $ ? ║ -║ ║ -║ Any field not specified will have a value of "null" (which has a length of 0).║ -║ ║ -║ Any field can contain any number of characters, this can be limited by the ║ -║ restrictions imposed by the standards or the USA legal definitions. ║ -║ Any number of fields could be added (with invalid field testing). ║ -╟────────────────────────────────────────────────────────────────────────────────╣ -║ @USA.0 the number of entries in the @USA stemmed array. ║ -║ ║ -║ nnn is some positive integer of any length (no leading zeroes).║ -╟────────────────────────────────────────────────────────────────────────────────╣ -║ @USA.nnn._name is the name of person, business, or a lot description. ║ -╟────────────────────────────────────────────────────────────────────────────────╣ -║ @USA.nnn._addr is the 1st street address ║ -║ @USA.nnn._addr2 is the 2nd street address ║ -║ @USA.nnn._addr3 is the 3rd street address ║ -║ @USA.nnn._addrNN ··· (any number, but in sequential order). ║ -╟────────────────────────────────────────────────────────────────────────────────╣ -║ @USA.nnn._state is the USA postal code for the state, terrority, etc. ║ -╟────────────────────────────────────────────────────────────────────────────────╣ -║ @USA.nnn._city is the official city name, it may include any character. ║ -╟────────────────────────────────────────────────────────────────────────────────╣ -║ @USA.nnn._zip is the USA postal zip code, five or ten digit format. ║ -╟────────────────────────────────────────────────────────────────────────────────╣ -║ @USA.nnn._upHist is the update history (who, date and timestamp). ║ -╚════════════════════════════════════════════════════════════════════════════════╝ +/*REXX program creates, builds, and displays a table of given U.S.A. postal addresses.*/ +@usa.=; @usa.0=0 /*initialize stemmed array & 1st value.*/ +@usa.0=@usa.0+1 /*bump the unique number for usage. */ + call USA '_city' , 'Boston' + call USA '_state' , 'MA' + call USA '_addr' , "51 Franklin Street" + call USA '_name' , "FSF Inc." + call USA '_zip' , '02110-1301' +@usa.0=@usa.0+1 /*bump the unique number for usage. */ + call USA '_city' , 'Washington' + call USA '_state' , 'DC' + call USA '_addr' , "The Oval Office" + call USA '_addr2' , "1600 Pennsylvania Avenue NW" + call USA '_name' , "The White House" + call USA '_zip' , 20500 + call USA 'list' +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +list: call tell '_name' + call tell '_addr' + do j=2 until $==''; call tell "_addr"j; end /*j*/ + call tell '_city' + call tell '_state' + call tell '_zip' + say copies('─', 40) + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +tell: $=value('@USA.'#"."arg(1));if $\='' then say right(translate(arg(1),,'_'),6) "──►" $ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +USA: procedure expose @USA.; parse arg what,txt; arg ?; @='@USA.' + if ?=='LIST' then do #=1 for @usa.0; call list; end /*#*/ + else do + call value @ || @usa.0 || . || what , txt + call value @ || @usa.0 || . || 'upHist', userid() date() time() + end + return diff --git a/Task/Table-creation-Postal-addresses/REXX/table-creation-postal-addresses-2.rexx b/Task/Table-creation-Postal-addresses/REXX/table-creation-postal-addresses-2.rexx index 186c4a578d..e33e9020ab 100644 --- a/Task/Table-creation-Postal-addresses/REXX/table-creation-postal-addresses-2.rexx +++ b/Task/Table-creation-Postal-addresses/REXX/table-creation-postal-addresses-2.rexx @@ -1,38 +1,35 @@ -/*REXX program creates, builds, and lists a table of U.S.A. postal addresses.*/ -@usa.=; @usa.0=0 /*initialize stemmed array & 1st value.*/ -@usa.0=@usa.0+1 /*bump the unique number for usage. */ - call USA '_city' , 'Boston' - call USA '_state' , 'MA' - call USA '_addr' , "51 Franklin Street" - call USA '_name' , "FSF Inc." - call USA '_zip' , '02110-1301' -@usa.0=@usa.0+1 /*bump the unique number for usage. */ - call USA '_city' , 'Washington' - call USA '_state' , 'DC' - call USA '_addr' , "The Oval Office" - call USA '_addr2' , "1600 Pennsylvania Avenue NW" - call USA '_name' , "The White House" - call USA '_zip' , 20500 - call USA 'list' -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -USA: procedure expose @USA.; parse arg what,txt; arg ?; nn=@usa.0 -if ?=='LIST' then do nn=1 for @usa.0; call lister; end /*nn*/ - else do - call value '@USA.'nn"."what , txt - call value '@USA.'nn".upHist", userid() date() time() - end -return -/*────────────────────────────────────────────────────────────────────────────*/ -tell: _=value('@USA.'nn"."arg(1)) - if _\=='' then say right(translate(arg(1), , '_'), 6) "──►" _ - return -/*────────────────────────────────────────────────────────────────────────────*/ -lister: call tell '_name' - call tell '_addr' - do j=2 until _==''; call tell '_addr'j; end /*j*/ - call tell '_city' - call tell '_state' - call tell '_zip' - say copies('─', 40) - return +/* REXX *************************************************************** +* 17.05.2013 Walter Pachl +* should work with every REXX. +* I use 0xxx for the tail because this can't be modified +**********************************************************************/ +USA.=''; USA.0=0 +Call add_usa 'Boston','MA','51 Franklin Street',,'FSF Inc.',, + '02110-1301' +Call add_usa 'Washington','DC','The Oval Office',, + '1600 Pennsylvania Avenue NW','The White House',20500 +call list_usa +Exit + +add_usa: +z=usa.0+1 +Parse Arg usa.z.0city,, + usa.z.0state,, + usa.z.0addr,, + usa.z.0addr2,, + usa.z.0name,, + usa.z.0zip +usa.0=z +Return + +list_usa: +Do z=1 To usa.0 + Say ' name -->' usa.z.0name + Say ' addr -->' usa.z.0addr + If usa.z.0addr2<>'' Then Say ' addr2 -->' usa.z.0addr2 + Say ' city -->' usa.z.0city + Say ' state -->' usa.z.0state + Say ' zip -->' usa.z.0zip + Say copies('-',40) + End +Return diff --git a/Task/Take-notes-on-the-command-line/AppleScript/take-notes-on-the-command-line.applescript b/Task/Take-notes-on-the-command-line/AppleScript/take-notes-on-the-command-line.applescript new file mode 100644 index 0000000000..bc481c946f --- /dev/null +++ b/Task/Take-notes-on-the-command-line/AppleScript/take-notes-on-the-command-line.applescript @@ -0,0 +1,83 @@ +#!/usr/bin/osascript + +-- format a number as a string with leading zero if needed +to format(aNumber) + set resultString to aNumber as text + if length of resultString < 2 + set resultString to "0" & resultString + end if + return resultString +end format + +-- join a list with a delimiter +to concatenation of aList given delimiter:aDelimiter + set tid to AppleScript's text item delimiters + set AppleScript's text item delimiters to { aDelimiter } + set resultString to aList as text + set AppleScript's text item delimiters to tid + return resultString +end join + +-- apply a handler to every item in a list, returning +-- a list of the results +to mapping of aList given function:aHandler + set resultList to {} + global h + set h to aHandler + repeat with anItem in aList + set resultList to resultList & h(anItem) + end repeat + return resultList +end mapping + +-- return an ISO-8601-formatted string representing the current date and time +-- in UTC +to iso8601() + set { year:y, month:m, day:d, ¬ + hours:hr, minutes:min, seconds:sec } to ¬ + (current date) - (time to GMT) + set ymdList to the mapping of { y, m as integer, d } given function:format + set ymd to the concatenation of ymdList given delimiter:"-" + set hmsList to the mapping of { hr, min, sec } given function:format + set hms to the concatenation of hmsList given delimiter:":" + set dateTime to the concatenation of {ymd, hms} given delimiter:"T" + return dateTime & "Z" +end iso8601 + +to exists(filePath) + try + filePath as alias + return true + on error + return false + end try +end exists + +on run argv + set curDir to (do shell script "pwd") + set notesFile to POSIX file (curDir & "/NOTES.TXT") + + if (count argv) is 0 then + if exists(notesFile) then + set text item delimiters to {linefeed} + return paragraphs of (read notesFile) as text + else + log "No notes here." + return + end if + else + try + set fd to open for access notesFile with write permission + write (iso8601() & linefeed & tab) to fd starting at eof + set AppleScript's text item delimiters to {" "} + write ((argv as text) & linefeed) to fd starting at eof + close access fd + return true + on error errMsg number errNum + try + close access fd + end try + return "unable to open " & notesFile & ": " & errMsg + end try + end if +end run diff --git a/Task/Take-notes-on-the-command-line/Elixir/take-notes-on-the-command-line.elixir b/Task/Take-notes-on-the-command-line/Elixir/take-notes-on-the-command-line.elixir new file mode 100644 index 0000000000..efd869e235 --- /dev/null +++ b/Task/Take-notes-on-the-command-line/Elixir/take-notes-on-the-command-line.elixir @@ -0,0 +1,15 @@ +defmodule Take_notes do + @filename "NOTES.TXT" + + def main( [] ), do: display_notes + def main( arguments ), do: save_notes( arguments ) + + def display_notes, do: IO.puts File.read!(@filename) + + def save_notes( arguments ) do + notes = "#{inspect :calendar.local_time}\n\t" <> Enum.join(arguments, " ") + File.open!(@filename, [:append], fn(file) -> IO.puts(file, notes) end) + end +end + +Take_notes.main(System.argv) diff --git a/Task/Take-notes-on-the-command-line/REXX/take-notes-on-the-command-line.rexx b/Task/Take-notes-on-the-command-line/REXX/take-notes-on-the-command-line.rexx index 6410c9f087..2c5b2268c7 100644 --- a/Task/Take-notes-on-the-command-line/REXX/take-notes-on-the-command-line.rexx +++ b/Task/Take-notes-on-the-command-line/REXX/take-notes-on-the-command-line.rexx @@ -1,15 +1,15 @@ -/*REXX program implements the "NOTES" command (append text to a file).*/ -timestamp=right(date(),11,0) time() date('W') /*create date/time stamp.*/ -nFID = 'NOTES.TXT' /*the fileID of the "notes" file.*/ +/*REXX program implements the "NOTES" command (append text to a file from the C.L.).*/ +timestamp=right(date(),11,0) time() date('W') /*create a (current) date & time stamp.*/ +nFID = 'NOTES.TXT' /*the fileID of the "notes" file. */ -if 'f0'x==0 then tab='05'x /*this is an EBCDIC system. */ - else tab='09'x /* " " " ASCII " */ +if 'f2'x==2 then tab="05"x /*this is an EBCDIC system. */ + else tab="09"x /* " " " ASCII " */ -if arg()==0 then do while lines(nFID) /*No args? Then show the file. */ - say linein(Nfid) /*show a line of file ──► screen.*/ +if arg()==0 then do while lines(nFID) /*No arguments? Then display the file.*/ + say linein(Nfid) /*display a line of file ──► screen. */ end /*while*/ else do - call lineout nFID,timestamp /*append the timestamp. */ - call lineout nFID,tab||arg(1) /*append the "note" text*/ + call lineout nFID,timestamp /*append the timestamp to "notes" file.*/ + call lineout nFID,tab||arg(1) /* " " text " " " */ end - /*stick a fork in it, we're done.*/ + /*stick a fork in it, we're all done. */ diff --git a/Task/Temperature-conversion/00DESCRIPTION b/Task/Temperature-conversion/00DESCRIPTION index fb0dfdcd92..721cbb36bc 100644 --- a/Task/Temperature-conversion/00DESCRIPTION +++ b/Task/Temperature-conversion/00DESCRIPTION @@ -1,25 +1,26 @@ {{omit from|Lilypond}} -There are quite a number of temperature scales.
    -For this task we will concentrate on 4 of the perhaps best-known ones: [[wp:Kelvin|Kelvin]], [[wp:Degree Celsius|Celsius]], [[wp:Fahrenheit|Fahrenheit]] and [[wp:Degree Rankine|Rankine]]. +There are quite a number of temperature scales. For this task we will concentrate on four of the perhaps best-known ones: +[[wp:Kelvin|Kelvin]], [[wp:Degree Celsius|Celsius]], [[wp:Fahrenheit|Fahrenheit]], and [[wp:Degree Rankine|Rankine]]. The Celsius and Kelvin scales have the same magnitude, but different null points. -:0 degrees Celsius corresponds to '''273.15''' kelvin. -:0 kelvin is absolute zero. +: 0 degrees Celsius corresponds to 273.15 kelvin. +: 0 kelvin is absolute zero. -The Fahrenheit and Rankine scales also have the same magnitude, -but different null points. +The Fahrenheit and Rankine scales also have the same magnitude, but different null points. -:0 degrees Fahrenheit corresponds to '''459.67''' degrees Rankine. -:0 degrees Rankine is absolute zero. +: 0 degrees Fahrenheit corresponds to 459.67 degrees Rankine. +: 0 degrees Rankine is absolute zero. -The Celsius/Kelvin and Fahrenheit/Rankine scales have a ratio of '''5 : 9'''. +The Celsius/Kelvin and Fahrenheit/Rankine scales have a ratio of 5 : 9. -Write code that accepts a value of kelvin, converts it -to values on the three other scales and prints the result. -For instance: +;Task +Write code that accepts a value of kelvin, converts it to values of the three other scales, and prints the result. + + +;Example:
     K  21.00
     
    @@ -29,3 +30,4 @@ F  -421.87
     
     R  37.80
     
    +

    diff --git a/Task/Temperature-conversion/APL/temperature-conversion-1.apl b/Task/Temperature-conversion/APL/temperature-conversion-1.apl new file mode 100644 index 0000000000..ac88eaaf2d --- /dev/null +++ b/Task/Temperature-conversion/APL/temperature-conversion-1.apl @@ -0,0 +1 @@ + CONVERT←{⍵,(⍵-273.15),(R-459.67),(R←⍵×9÷5)} diff --git a/Task/Temperature-conversion/APL/temperature-conversion-2.apl b/Task/Temperature-conversion/APL/temperature-conversion-2.apl new file mode 100644 index 0000000000..53d19ee3b7 --- /dev/null +++ b/Task/Temperature-conversion/APL/temperature-conversion-2.apl @@ -0,0 +1,2 @@ + CONVERT 21 +21 ¯252.15 ¯421.87 37.8 diff --git a/Task/Temperature-conversion/AWK/temperature-conversion-1.awk b/Task/Temperature-conversion/AWK/temperature-conversion-1.awk index 6a074f45eb..3cfa2000ee 100644 --- a/Task/Temperature-conversion/AWK/temperature-conversion-1.awk +++ b/Task/Temperature-conversion/AWK/temperature-conversion-1.awk @@ -7,7 +7,7 @@ BEGIN { break } if (K < 0) { - print("K must be > 0") + print("K must be >= 0") continue } printf("K = %.2f\n",K) diff --git a/Task/Temperature-conversion/AppleScript/temperature-conversion.applescript b/Task/Temperature-conversion/AppleScript/temperature-conversion.applescript new file mode 100644 index 0000000000..97d852707a --- /dev/null +++ b/Task/Temperature-conversion/AppleScript/temperature-conversion.applescript @@ -0,0 +1,116 @@ +use framework "Foundation" -- Yosemite onwards, for the toLowerCase() function + +-- Kelvin to other scale + +-- kelvinAs :: ScaleName -> Num -> Num +on kelvinAs(strOtherScale, n) + heatBabel(n, "Kelvin", strOtherScale) +end kelvinAs + + +-- More general conversion + +-- heatBabel :: n -> ScaleName -> ScaleName -> Num +on heatBabel(n, strFromScale, strToScale) + set ratio to 9 / 5 + set cels to 273.15 + set fahr to 459.67 + + script reading + on lambda(x, strFrom) + if strFrom = "k" then + x as real + else if strFrom = "c" then + x + cels + else if strFrom = "f" then + (fahr + x) * ratio + else + x / ratio + end if + end lambda + end script + + script writing + on lambda(x, strTo) + if strTo = "k" then + x + else if strTo = "c" then + x - cels + else if strTo = "f" then + (x * ratio) - fahr + else + x * ratio + end if + end lambda + end script + + writing's lambda(reading's lambda(n, ¬ + toLowerCase(text 1 of strFromScale)), ¬ + toLowerCase(text 1 of strToScale)) +end heatBabel + + +-- TEST + +on kelvinTranslations(n) + script translations + on lambda(x) + {x, kelvinAs(x, n)} + end lambda + end script + + map(translations, {"K", "C", "F", "R"}) +end kelvinTranslations + +on run + script tabbed + on lambda(x) + intercalate(tab, x) + end lambda + end script + + intercalate(linefeed, map(tabbed, kelvinTranslations(21))) +end run + + + +-- GENERIC LIBRARY FUNCTIONS + +-- toLowerCase :: String -> String +on toLowerCase(str) + set ca to current application + ((ca's NSString's stringWithString:(str))'s ¬ + lowercaseStringWithLocale:(ca's NSLocale's currentLocale())) as text +end toLowerCase + +-- intercalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate + +-- 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 + +-- 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 diff --git a/Task/Temperature-conversion/Haskell/temperature-conversion-1.hs b/Task/Temperature-conversion/Haskell/temperature-conversion-1.hs new file mode 100644 index 0000000000..8a58b20708 --- /dev/null +++ b/Task/Temperature-conversion/Haskell/temperature-conversion-1.hs @@ -0,0 +1,16 @@ +import System.Exit (die) +import Control.Monad (mapM_) + +main = do + putStrLn "Please enter temperature in kelvin: " + input <- getLine + let kelvin = read input + if kelvin < 0.0 + then die "Temp cannot be negative" + else mapM_ putStrLn $ convert kelvin + +convert :: Double -> [String] +convert n = zipWith (++) labels nums + where labels = ["kelvin: ", "celcius: ", "farenheit: ", "rankine: "] + conversions = [id, subtract 273, subtract 459.67 . (1.8 *), (*1.8)] + nums = (show . ($n)) <$> conversions diff --git a/Task/Temperature-conversion/Haskell/temperature-conversion-2.hs b/Task/Temperature-conversion/Haskell/temperature-conversion-2.hs new file mode 100644 index 0000000000..08d44b61b1 --- /dev/null +++ b/Task/Temperature-conversion/Haskell/temperature-conversion-2.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE LambdaCase #-} + +import System.Exit (die) +import Control.Monad (mapM_) +import Control.Error.Safe (tryAssert, tryRead) +import Control.Monad.Trans (liftIO) +import Control.Monad.Trans.Except + +main = putStrLn "Please enter temperature in kelvin: " >> + runExceptT getTemp >>= + \case Right x -> mapM_ putStrLn $ convert x + Left err -> die err + +convert :: Double -> [String] +convert n = zipWith (++) labels nums + where labels = ["kelvin: ", "celcius: ", "farenheit: ", "rankine: "] + conversions = [id, subtract 273, subtract 459.67 . (1.8 *), (1.8 *)] + nums = (show . ($ n)) <$> conversions + +getTemp :: ExceptT String IO Double +getTemp = do + t <- liftIO getLine >>= tryRead "Could not read temp" + tryAssert "Temp cannot be negative" (t>=0) + return t diff --git a/Task/Temperature-conversion/Haskell/temperature-conversion.hs b/Task/Temperature-conversion/Haskell/temperature-conversion.hs deleted file mode 100644 index c66c9e513f..0000000000 --- a/Task/Temperature-conversion/Haskell/temperature-conversion.hs +++ /dev/null @@ -1,18 +0,0 @@ -main = do - putStrLn "Please enter temperature in kelvin: " - input <- getLine - let kelvin = read input :: Double - if - kelvin < 0.0 - then - putStrLn "error" - else - let - celsius = kelvin - 273.15 - fahrenheit = kelvin * 1.8 - 459.67 - rankine = kelvin * 1.8 - in do - putStrLn ("kelvin: " ++ show kelvin) - putStrLn ("celsius: " ++ show celsius) - putStrLn ("fahrenheit: " ++ show fahrenheit) - putStrLn ("rankine: " ++ show rankine) diff --git a/Task/Temperature-conversion/JavaScript/temperature-conversion.js b/Task/Temperature-conversion/JavaScript/temperature-conversion-1.js similarity index 100% rename from Task/Temperature-conversion/JavaScript/temperature-conversion.js rename to Task/Temperature-conversion/JavaScript/temperature-conversion-1.js diff --git a/Task/Temperature-conversion/JavaScript/temperature-conversion-2.js b/Task/Temperature-conversion/JavaScript/temperature-conversion-2.js new file mode 100644 index 0000000000..725acc3aed --- /dev/null +++ b/Task/Temperature-conversion/JavaScript/temperature-conversion-2.js @@ -0,0 +1,38 @@ +(() => { + 'use strict'; + + let kelvinTranslations = k => ['K', 'C', 'F', 'R'] + .map(x => [x, heatBabel(k, 'K', x)]); + + // heatBabel :: Num -> ScaleName -> ScaleName -> Num + let heatBabel = (n, strFromScale, strToScale) => { + let ratio = 9 / 5, + cels = 273.15, + fahr = 459.67, + id = x => x, + readK = { + k: id, + c: x => cels + x, + f: x => (fahr + x) * ratio, + r: x => x / ratio + }, + writeK = { + k: id, + c: x => x - cels, + f: x => (x * ratio) - fahr, + r: x => ratio * x + }; + + return writeK[strToScale.charAt(0).toLowerCase()]( + readK[strFromScale.charAt(0).toLowerCase()](n) + ).toFixed(2); + }; + + + // TEST + return kelvinTranslations(21) + .map(([s, n]) => s + (' ' + n) + .slice(-10)) + .join('\n'); + +})(); diff --git a/Task/Temperature-conversion/Maple/temperature-conversion.maple b/Task/Temperature-conversion/Maple/temperature-conversion.maple new file mode 100644 index 0000000000..0f776c285f --- /dev/null +++ b/Task/Temperature-conversion/Maple/temperature-conversion.maple @@ -0,0 +1,6 @@ +tempConvert := proc(k) + seq(printf("%c: %.2f\n", StringTools[UpperCase](substring(i, 1)), convert(k, temperature, kelvin, i)), i in [kelvin, Celsius, Fahrenheit, Rankine]); + return NULL; +end proc: + +tempConvert(21); diff --git a/Task/Temperature-conversion/Perl-6/temperature-conversion-1.pl6 b/Task/Temperature-conversion/Perl-6/temperature-conversion-1.pl6 new file mode 100644 index 0000000000..248912a3b8 --- /dev/null +++ b/Task/Temperature-conversion/Perl-6/temperature-conversion-1.pl6 @@ -0,0 +1,12 @@ +my %scale = + Celcius => { factor => 1 , offset => -273.15 }, + Rankine => { factor => 1.8, offset => 0 }, + Fahrenheit => { factor => 1.8, offset => -459.67 }, +; + +my $kelvin = +prompt "Enter a temperature in Kelvin: "; +die "No such temperature!" if $kelvin < 0; + +for %scale.sort { + printf "%12s: %7.2f\n", .key, $kelvin * .value + .value; +} diff --git a/Task/Temperature-conversion/Perl-6/temperature-conversion.pl6 b/Task/Temperature-conversion/Perl-6/temperature-conversion-2.pl6 similarity index 100% rename from Task/Temperature-conversion/Perl-6/temperature-conversion.pl6 rename to Task/Temperature-conversion/Perl-6/temperature-conversion-2.pl6 diff --git a/Task/Temperature-conversion/PowerShell/temperature-conversion.psh b/Task/Temperature-conversion/PowerShell/temperature-conversion-1.psh similarity index 100% rename from Task/Temperature-conversion/PowerShell/temperature-conversion.psh rename to Task/Temperature-conversion/PowerShell/temperature-conversion-1.psh diff --git a/Task/Temperature-conversion/PowerShell/temperature-conversion-2.psh b/Task/Temperature-conversion/PowerShell/temperature-conversion-2.psh new file mode 100644 index 0000000000..8c3f7acce3 --- /dev/null +++ b/Task/Temperature-conversion/PowerShell/temperature-conversion-2.psh @@ -0,0 +1,27 @@ +function Convert-Kelvin +{ + [CmdletBinding()] + [OutputType([PSCustomObject])] + Param + ( + [Parameter(Mandatory=$true, + ValueFromPipeline=$true, + ValueFromPipelineByPropertyName=$true, + Position=0)] + [double] + $InputObject + ) + + Process + { + foreach ($kelvin in $InputObject) + { + [PSCustomObject]@{ + Kelvin = $kelvin + Celsius = $kelvin - 273.15 + Fahrenheit = $kelvin * 1.8 - 459.67 + Rankine = $kelvin * 1.8 + } + } + } +} diff --git a/Task/Temperature-conversion/PowerShell/temperature-conversion-3.psh b/Task/Temperature-conversion/PowerShell/temperature-conversion-3.psh new file mode 100644 index 0000000000..4fc84598e3 --- /dev/null +++ b/Task/Temperature-conversion/PowerShell/temperature-conversion-3.psh @@ -0,0 +1 @@ +21, 100 | Convert-Kelvin diff --git a/Task/Temperature-conversion/REXX/temperature-conversion.rexx b/Task/Temperature-conversion/REXX/temperature-conversion.rexx index 295bfd0805..612eeba65e 100644 --- a/Task/Temperature-conversion/REXX/temperature-conversion.rexx +++ b/Task/Temperature-conversion/REXX/temperature-conversion.rexx @@ -1,117 +1,116 @@ -/*REXX program converts temperatures for a number of temperature scales.*/ -numeric digits 120 /*be able to support huge numbers*/ -parse arg tList /*get specified temperature lists*/ +/*REXX program converts temperatures for a number (8) of temperature scales. */ +numeric digits 120 /*be able to support some huge numbers.*/ +parse arg tList /*get the specified temperature list. */ - do until tList='' /*process a list of temperatures.*/ - parse var tList x ',' tList /*temps are separated by commas. */ - x=translate(x,'((',"[{") /*support other grouping symbols.*/ - x=space(x); parse var x z '(' /*handle any comments (if any). */ - parse upper var z z ' TO ' ! . /*separate the TO option from #*/ - if !=='' then !='ALL'; all=!=='ALL' /*allow specification of "TO" opt*/ - if z=='' then call serr 'no arguments were specified.' - _=verify(z, '+-.0123456789') /*a list of valid number thingys.*/ + do until tList='' /*process the list of temperatures. */ + parse var tList x ',' tList /*temps are separated by commas. */ + x=translate(x,'((',"[{") /*support other grouping symbols. */ + x=space(x); parse var x z '(' /*handle any comments (if any). */ + parse upper var z z ' TO ' ! . /*separate the TO option from number.*/ + if !=='' then !='ALL'; all=!=='ALL' /*allow specification of "TO" opt*/ + if z=='' then call serr "no arguments were specified." /*oops-ay. */ + _=verify(z, '+-.0123456789') /*list of valid numeral/number thingys.*/ n=z if _\==0 then do if _==1 then call serr 'illegal temperature:' z - n=left(z, _-1) /*pick off the number (hopefully)*/ - u=strip(substr(z, _)) /*pick off the temperature unit. */ + n=left(z, _-1) /*pick off the number (hopefully). */ + u=strip(substr(z, _)) /*pick off the temperature unit. */ end - else u='k' /*assume kelvin as per task req.*/ + else u='k' /*assume kelvin as per task requirement*/ - if \datatype(n,'N') then call serr 'illegal number:' n - if \all then do /*there is a TO ααα scale.*/ - call name ! /*process the TO abbreviation*/ - !=sn /*assign the full name to ! */ - end /* ! now contains scale full name*/ - call name u /*allow alternate scale spellings*/ + if \datatype(n, 'N') then call serr 'illegal number:' n + if \all then do /*is there is a TO ααα scale? */ + call name ! /*process the TO abbreviation. */ + !=sn /*assign the full name to ! */ + end /*!: now contains temperature full name*/ + call name u /*allow alternate scale (miss)spellings*/ - select /*convert ──► °F temperatures. */ + select /*convert ──► °Fahrenheit temperatures.*/ when sn=='CELSIUS' then F=n * 9/5 + 32 when sn=='DELISLE' then F=212 -(n * 6/5) - when sn=='DELISLE' then F=212 -(n * 6/5) when sn=='FAHRENHEIT' then F=n when sn=='KELVIN' then F=n * 9/5 - 459.67 when sn=='NEWTON' then F=n * 60/11 + 32 - when sn=='RANKINE' then F=n - 459.67 /*a single R is taken as Rankine.*/ + when sn=='RANKINE' then F=n - 459.67 /*a single R is taken as Rankine.*/ when sn=='REAUMUR' then F=n * 9/4 + 32 when sn=='ROMER' then F=(n-7.5) * 27/4 + 32 otherwise call serr 'illegal temperature scale: ' u end /*select*/ - K = (F + 459.67) * 5/9 /*compute temperature to kelvins.*/ - say right(' ' x, 79, "─") /*show original value &scale,sep.*/ + K = (F + 459.67) * 5/9 /*compute temperature to kelvins. */ + say right(' ' x, 79, "─") /*show the original value, scale, sep. */ if all | !=='CELSIUS' then say $( ( F - 32 ) * 5/9 ) 'Celsius' if all | !=='DELISLE' then say $( ( 212 - F ) * 5/6 ) 'Delisle' if all | !=='FAHRENHEIT' then say $( F ) 'Fahrenheit' if all | !=='KELVIN' then say $( K ) 'kelvin's(K) if all | !=='NEWTON' then say $( ( F - 32 ) * 11/60 ) 'Newton' - if all | !=='RANKINE' then say $( F + 349.67 ) 'Rankine' + if all | !=='RANKINE' then say $( F + 459.67 ) 'Rankine' if all | !=='REAUMUR' then say $( ( F - 32 ) * 4/9 ) 'Reaumur' - if all | !=='ROMER' then say $( ( F - 32 ) * 7/24 + 7.5 ) 'Romer' + if all | !=='ROMER' then say $( ( F - 32 ) * 4/27 + 7.5 ) 'Romer' end /*until*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────$ subroutine────────────────────────*/ -$: procedure; showDig=8 /*only show 8 significant digits.*/ -_=format(arg(1), , showDig)/1 /*format # 8 digs past dec point.*/ -p=pos(.,_) /*find position of decimal point.*/ - /* [↓] align integers with FP #s.*/ -if p==0 then _=_ || left('',5+showDig+1) /*no decimal point.*/ - else _=_ || left('',5+showDig-length(_)+p) /*has " " */ -return right(_,50) /*return the re-formatted arg. */ -/*──────────────────────────────────name subroutine─────────────────────*/ -name: parse arg y /*abbreviations ──► shortname. */ -yU=translate(y,'eE',"éÉ"); upper yU /*uppercase version of temp unit.*/ -if left(yU,7)=='DEGREES' then yU=substr(yU,8) /*redundant "degrees"? */ -if left(yU,6)=='DEGREE' then yU=substr(yU,7) /* " "degree" ? */ -yU=strip(yU) /*elide blanks at ends.*/ -_=length(yU) /*obtain the yU length.*/ -if right(yU,1)=='S' & _>1 then yU=left(yU,_-1) /*elide trailing plural*/ - select /*abbreviations ──► shortname. */ - when abbrev('CENTIGRADE' , yU) |, - abbrev('CENTRIGRADE', yU) |, /* 50% misspelled.*/ - abbrev('CETIGRADE' , yU) |, /* 50% misspelled.*/ - abbrev('CENTINGRADE', yU) |, - abbrev('CENTESIMAL' , yU) |, - abbrev('CELCIU' , yU) |, /* 82% misspelled.*/ - abbrev('CELCIOU' , yU) |, /* 4% misspelled.*/ - abbrev('CELCUI' , yU) |, /* 4% misspelled.*/ - abbrev('CELSUI' , yU) |, /* 2% misspelled.*/ - abbrev('CELCEU' , yU) |, /* 2% misspelled.*/ - abbrev('CELCU' , yU) |, /* 2% misspelled.*/ - abbrev('CELISU' , yU) |, /* 1% misspelled.*/ - abbrev('CELSU' , yU) |, /* 1% misspelled.*/ - abbrev('CELSIU' , yU) then sn='CELSIUS' - when abbrev('DELISLE' , yU,2) then sn='DELISLE' - when abbrev('FARENHEIT' , yU) |, /* 39% misspelled.*/ - abbrev('FARENHEIGHT', yU) |, /* 15% misspelled.*/ - abbrev('FARENHITE' , yU) |, /* 6% misspelled.*/ - abbrev('FARENHIET' , yU) |, /* 3% misspelled.*/ - abbrev('FARHENHEIT' , yU) |, /* 3% misspelled.*/ - abbrev('FARINHEIGHT', yU) |, /* 2% misspelled.*/ - abbrev('FARENHIGHT' , yU) |, /* 2% misspelled.*/ - abbrev('FAHRENHIET' , yU) |, /* 2% misspelled.*/ - abbrev('FERENHEIGHT', yU) |, /* 2% misspelled.*/ - abbrev('FEHRENHEIT' , yU) |, /* 2% misspelled.*/ - abbrev('FERENHEIT' , yU) |, /* 2% misspelled.*/ - abbrev('FERINHEIGHT', yU) |, /* 1% misspelled.*/ - abbrev('FARIENHEIT' , yU) |, /* 1% misspelled.*/ - abbrev('FARINHEIT' , yU) |, /* 1% misspelled.*/ - abbrev('FARANHITE' , yU) |, /* 1% misspelled.*/ - abbrev('FAHRENHEIT' , yU) then sn='FAHRENHEIT' - when abbrev('KALVIN' , yU) |, /* 27% misspelled.*/ - abbrev('KERLIN' , yU) |, /* 18% misspelled.*/ - abbrev('KEVEN' , yU) |, /* 9% misspelled.*/ - abbrev('KELVIN' , yU) then sn='KELVIN' - when abbrev('NEUTON' , yU) |, /*100% misspelled.*/ - abbrev('NEWTON' , yU) then sn='NEWTON' - when abbrev('RANKINE' , yU, 1) then sn='RANKINE' - when abbrev('REAUMUR' , yU, 2) then sn='REAUMUR' - when abbrev('ROEMER' , yU, 2) |, - abbrev('ROMER' , yU, 2) then sn='ROMER' - otherwise call serr 'illegal temperature scale:' y - end /*select*/ -return -/*──────────────────────────────────one─liner subroutines───────────────*/ -s: if arg(1)==1 then return arg(3); return word(arg(2) 's',1) -serr: say; say '***error!***'; say; say arg(1); say; exit 13 +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +s: if arg(1)==1 then return arg(3); return word(arg(2) 's',1) +serr: say; say '***error!***'; say; say arg(1); say; exit 13 +/*──────────────────────────────────────────────────────────────────────────────────────*/ +$: procedure; showDig=8 /*only show eight significant digits.*/ + _=format(arg(1), , showDig) / 1 /*format number 8 digs past dec, point.*/ + p=pos(., _); L=length(_) /*find position of the decimal point. */ + /* [↓] align integers with FP numbers.*/ + if p==0 then _=_ || left('',5+showDig+1) /*the number has no decimal point. */ + else _=_ || left('',5+showDig-L+p) /* " " " a " " */ + return right(_, 50) /*return the re-formatted number (arg).*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +name: parse arg y /*abbreviations ──► shortname.*/ + yU=translate(y, 'eE', "éÉ"); upper yU /*uppercase the temperature unit*/ + if left(yU, 7)=='DEGREES' then yU=substr(yU, 8) /*redundant "degrees" after #? */ + if left(yU, 6)=='DEGREE' then yU=substr(yU, 7) /* " "degree" " " */ + yU=strip(yU) /*elide blanks at front and back*/ + _=length(yU) /*obtain the yU length. */ + if right(yU, 1)=='S' & _>1 then yU=left(yU, _ -1) /*elide trailing plural, if any.*/ + select /*abbreviations ──► shortname.*/ + when abbrev('CENTIGRADE' , yU) |, + abbrev('CENTRIGRADE', yU) |, /* 50% misspelled.*/ + abbrev('CETIGRADE' , yU) |, /* 50% misspelled.*/ + abbrev('CENTINGRADE', yU) |, + abbrev('CENTESIMAL' , yU) |, + abbrev('CELCIU' , yU) |, /* 82% misspelled.*/ + abbrev('CELCIOU' , yU) |, /* 4% misspelled.*/ + abbrev('CELCUI' , yU) |, /* 4% misspelled.*/ + abbrev('CELSUI' , yU) |, /* 2% misspelled.*/ + abbrev('CELCEU' , yU) |, /* 2% misspelled.*/ + abbrev('CELCU' , yU) |, /* 2% misspelled.*/ + abbrev('CELISU' , yU) |, /* 1% misspelled.*/ + abbrev('CELSU' , yU) |, /* 1% misspelled.*/ + abbrev('CELSIU' , yU) then sn='CELSIUS' + when abbrev('DELISLE' , yU,2) then sn='DELISLE' + when abbrev('FARENHEIT' , yU) |, /* 39% misspelled.*/ + abbrev('FARENHEIGHT', yU) |, /* 15% misspelled.*/ + abbrev('FARENHITE' , yU) |, /* 6% misspelled.*/ + abbrev('FARENHIET' , yU) |, /* 3% misspelled.*/ + abbrev('FARHENHEIT' , yU) |, /* 3% misspelled.*/ + abbrev('FARINHEIGHT', yU) |, /* 2% misspelled.*/ + abbrev('FARENHIGHT' , yU) |, /* 2% misspelled.*/ + abbrev('FAHRENHIET' , yU) |, /* 2% misspelled.*/ + abbrev('FERENHEIGHT', yU) |, /* 2% misspelled.*/ + abbrev('FEHRENHEIT' , yU) |, /* 2% misspelled.*/ + abbrev('FERENHEIT' , yU) |, /* 2% misspelled.*/ + abbrev('FERINHEIGHT', yU) |, /* 1% misspelled.*/ + abbrev('FARIENHEIT' , yU) |, /* 1% misspelled.*/ + abbrev('FARINHEIT' , yU) |, /* 1% misspelled.*/ + abbrev('FARANHITE' , yU) |, /* 1% misspelled.*/ + abbrev('FAHRENHEIT' , yU) then sn='FAHRENHEIT' + when abbrev('KALVIN' , yU) |, /* 27% misspelled.*/ + abbrev('KERLIN' , yU) |, /* 18% misspelled.*/ + abbrev('KEVEN' , yU) |, /* 9% misspelled.*/ + abbrev('KELVIN' , yU) then sn='KELVIN' + when abbrev('NEUTON' , yU) |, /*100% misspelled.*/ + abbrev('NEWTON' , yU) then sn='NEWTON' + when abbrev('RANKINE' , yU, 1) then sn='RANKINE' + when abbrev('REAUMUR' , yU, 2) then sn='REAUMUR' + when abbrev('ROEMER' , yU, 2) |, + abbrev('ROMER' , yU, 2) then sn='ROMER' + otherwise call serr 'illegal temperature scale:' y + end /*select*/ + return diff --git a/Task/Terminal-control-Clear-the-screen/C/terminal-control-clear-the-screen-1.c b/Task/Terminal-control-Clear-the-screen/C/terminal-control-clear-the-screen-1.c index 211458b66a..e5f17b6d75 100644 --- a/Task/Terminal-control-Clear-the-screen/C/terminal-control-clear-the-screen-1.c +++ b/Task/Terminal-control-Clear-the-screen/C/terminal-control-clear-the-screen-1.c @@ -1,4 +1,3 @@ void cls(void) { - int printf(char*,...); - printf("%c[2J",27); + printf("\33[2J"); } diff --git a/Task/Terminal-control-Clear-the-screen/C/terminal-control-clear-the-screen-2.c b/Task/Terminal-control-Clear-the-screen/C/terminal-control-clear-the-screen-2.c index 9743125f95..ec7cdec14d 100644 --- a/Task/Terminal-control-Clear-the-screen/C/terminal-control-clear-the-screen-2.c +++ b/Task/Terminal-control-Clear-the-screen/C/terminal-control-clear-the-screen-2.c @@ -1,9 +1,8 @@ #include #include -void main() -{ - printf ("clearing screen"); - getchar(); - System("cls"); +void main() { + printf ("clearing screen"); + getchar(); + system("cls"); } diff --git a/Task/Terminal-control-Clear-the-screen/Fortran/terminal-control-clear-the-screen-1.f b/Task/Terminal-control-Clear-the-screen/Fortran/terminal-control-clear-the-screen-1.f new file mode 100644 index 0000000000..028b18e590 --- /dev/null +++ b/Task/Terminal-control-Clear-the-screen/Fortran/terminal-control-clear-the-screen-1.f @@ -0,0 +1,5 @@ +program clear + character(len=:), allocatable :: clear_command + clear_command = "clear" !"cls" on Windows, "clear" on Linux and alike + call execute_command_line(clear_command) +end program diff --git a/Task/Terminal-control-Clear-the-screen/Fortran/terminal-control-clear-the-screen-2.f b/Task/Terminal-control-Clear-the-screen/Fortran/terminal-control-clear-the-screen-2.f new file mode 100644 index 0000000000..b6d8fcd560 --- /dev/null +++ b/Task/Terminal-control-Clear-the-screen/Fortran/terminal-control-clear-the-screen-2.f @@ -0,0 +1,28 @@ +program clear + use kernel32 + implicit none + integer(HANDLE) :: hStdout + hStdout = GetStdHandle(STD_OUTPUT_HANDLE) + call clear_console(hStdout) +contains + subroutine clear_console(hConsole) + integer(HANDLE) :: hConsole + type(T_COORD) :: coordScreen = T_COORD(0, 0) + integer(DWORD) :: cCharsWritten + type(T_CONSOLE_SCREEN_BUFFER_INFO) :: csbi + integer(DWORD) :: dwConSize + + if (GetConsoleScreenBufferInfo(hConsole, csbi) == 0) return + dwConSize = csbi%dwSize%X * csbi%dwSize%Y + + if (FillConsoleOutputCharacter(hConsole, SCHAR_" ", dwConSize, & + coordScreen, loc(cCharsWritten)) == 0) return + + if (GetConsoleScreenBufferInfo(hConsole, csbi) == 0) return + + if (FillConsoleOutputAttribute(hConsole, csbi%wAttributes, & + dwConSize, coordScreen, loc(cCharsWritten)) == 0) return + + if (SetConsoleCursorPosition(hConsole, coordScreen) == 0) return + end subroutine +end program diff --git a/Task/Terminal-control-Clear-the-screen/Fortran/terminal-control-clear-the-screen-3.f b/Task/Terminal-control-Clear-the-screen/Fortran/terminal-control-clear-the-screen-3.f new file mode 100644 index 0000000000..6afef05bd8 --- /dev/null +++ b/Task/Terminal-control-Clear-the-screen/Fortran/terminal-control-clear-the-screen-3.f @@ -0,0 +1,96 @@ +module kernel32 + use iso_c_binding + implicit none + integer, parameter :: HANDLE = C_INTPTR_T + integer, parameter :: PVOID = C_INTPTR_T + integer, parameter :: LPDWORD = C_INTPTR_T + integer, parameter :: BOOL = C_INT + integer, parameter :: SHORT = C_INT16_T + integer, parameter :: WORD = C_INT16_T + integer, parameter :: DWORD = C_INT32_T + integer, parameter :: SCHAR = C_CHAR + integer(DWORD), parameter :: STD_INPUT_HANDLE = -10 + integer(DWORD), parameter :: STD_OUTPUT_HANDLE = -11 + integer(DWORD), parameter :: STD_ERROR_HANDLE = -12 + + type, bind(C) :: T_COORD + integer(SHORT) :: X, Y + end type + + type, bind(C) :: T_SMALL_RECT + integer(SHORT) :: Left + integer(SHORT) :: Top + integer(SHORT) :: Right + integer(SHORT) :: Bottom + end type + + type, bind(C) :: T_CONSOLE_SCREEN_BUFFER_INFO + type(T_COORD) :: dwSize + type(T_COORD) :: dwCursorPosition + integer(WORD) :: wAttributes + type(T_SMALL_RECT) :: srWindow + type(T_COORD) :: dwMaximumWindowSize + end type + + interface + function FillConsoleOutputCharacter(hConsoleOutput, cCharacter, & + nLength, dwWriteCoord, lpNumberOfCharsWritten) & + bind(C, name="FillConsoleOutputCharacterA") + import BOOL, C_CHAR, SCHAR, HANDLE, DWORD, T_COORD, LPDWORD + !GCC$ ATTRIBUTES STDCALL :: FillConsoleOutputCharacter + integer(BOOL) :: FillConsoleOutputCharacter + integer(HANDLE), value :: hConsoleOutput + character(kind=SCHAR), value :: cCharacter + integer(DWORD), value :: nLength + type(T_COORD), value :: dwWriteCoord + integer(LPDWORD), value :: lpNumberOfCharsWritten + end function + end interface + + interface + function FillConsoleOutputAttribute(hConsoleOutput, wAttribute, & + nLength, dwWriteCoord, lpNumberOfAttrsWritten) & + bind(C, name="FillConsoleOutputAttribute") + import BOOL, HANDLE, WORD, DWORD, T_COORD, LPDWORD + !GCC$ ATTRIBUTES STDCALL :: FillConsoleOutputAttribute + integer(BOOL) :: FillConsoleOutputAttribute + integer(HANDLE), value :: hConsoleOutput + integer(WORD), value :: wAttribute + integer(DWORD), value :: nLength + type(T_COORD), value :: dwWriteCoord + integer(LPDWORD), value :: lpNumberOfAttrsWritten + end function + end interface + + interface + function GetConsoleScreenBufferInfo(hConsoleOutput, & + lpConsoleScreenBufferInfo) & + bind(C, name="GetConsoleScreenBufferInfo") + import BOOL, HANDLE, T_CONSOLE_SCREEN_BUFFER_INFO + !GCC$ ATTRIBUTES STDCALL :: GetConsoleScreenBufferInfo + integer(BOOL) :: GetConsoleScreenBufferInfo + integer(HANDLE), value :: hConsoleOutput + type(T_CONSOLE_SCREEN_BUFFER_INFO) :: lpConsoleScreenBufferInfo + end function + end interface + + interface + function SetConsoleCursorPosition(hConsoleOutput, dwCursorPosition) & + bind(C, name="SetConsoleCursorPosition") + import BOOL, HANDLE, T_COORD + !GCC$ ATTRIBUTES STDCALL :: SetConsoleCursorPosition + integer(BOOL) :: SetConsoleCursorPosition + integer(HANDLE), value :: hConsoleOutput + type(T_COORD), value :: dwCursorPosition + end function + end interface + + interface + function GetStdHandle(nStdHandle) bind(C, name="GetStdHandle") + import HANDLE, DWORD + !GCC$ ATTRIBUTES STDCALL :: GetStdHandle + integer(HANDLE) :: GetStdHandle + integer(DWORD), value :: nStdHandle + end function + end interface +end module diff --git a/Task/Terminal-control-Clear-the-screen/Fortran/terminal-control-clear-the-screen.f b/Task/Terminal-control-Clear-the-screen/Fortran/terminal-control-clear-the-screen.f deleted file mode 100644 index 2c4c7507ee..0000000000 --- a/Task/Terminal-control-Clear-the-screen/Fortran/terminal-control-clear-the-screen.f +++ /dev/null @@ -1 +0,0 @@ -call execute_command_line('clear') diff --git a/Task/Terminal-control-Clear-the-screen/Python/terminal-control-clear-the-screen-1.py b/Task/Terminal-control-Clear-the-screen/Python/terminal-control-clear-the-screen-1.py index c2c486c6fb..d80484eabe 100644 --- a/Task/Terminal-control-Clear-the-screen/Python/terminal-control-clear-the-screen-1.py +++ b/Task/Terminal-control-Clear-the-screen/Python/terminal-control-clear-the-screen-1.py @@ -1,2 +1,2 @@ import os -os.system('clear') +os.system("clear") diff --git a/Task/Terminal-control-Clear-the-screen/Python/terminal-control-clear-the-screen-2.py b/Task/Terminal-control-Clear-the-screen/Python/terminal-control-clear-the-screen-2.py index e2fb7cb5e9..701751a53c 100644 --- a/Task/Terminal-control-Clear-the-screen/Python/terminal-control-clear-the-screen-2.py +++ b/Task/Terminal-control-Clear-the-screen/Python/terminal-control-clear-the-screen-2.py @@ -1 +1 @@ -print "%c[2J" % (27) +print "\33[2J" diff --git a/Task/Terminal-control-Clear-the-screen/Python/terminal-control-clear-the-screen-3.py b/Task/Terminal-control-Clear-the-screen/Python/terminal-control-clear-the-screen-3.py new file mode 100644 index 0000000000..7969fb09df --- /dev/null +++ b/Task/Terminal-control-Clear-the-screen/Python/terminal-control-clear-the-screen-3.py @@ -0,0 +1,38 @@ +from ctypes import * + +STD_OUTPUT_HANDLE = -11 + +class COORD(Structure): + pass + +COORD._fields_ = [("X", c_short), ("Y", c_short)] + +class SMALL_RECT(Structure): + pass + +SMALL_RECT._fields_ = [("Left", c_short), ("Top", c_short), ("Right", c_short), ("Bottom", c_short)] + +class CONSOLE_SCREEN_BUFFER_INFO(Structure): + pass + +CONSOLE_SCREEN_BUFFER_INFO._fields_ = [ + ("dwSize", COORD), + ("dwCursorPosition", COORD), + ("wAttributes", c_ushort), + ("srWindow", SMALL_RECT), + ("dwMaximumWindowSize", COORD) +] + +def clear_console(): + h = windll.kernel32.GetStdHandle(STD_OUTPUT_HANDLE) + + csbi = CONSOLE_SCREEN_BUFFER_INFO() + windll.kernel32.GetConsoleScreenBufferInfo(h, pointer(csbi)) + dwConSize = csbi.dwSize.X * csbi.dwSize.Y + + scr = COORD(0, 0) + windll.kernel32.FillConsoleOutputCharacterA(h, c_char(b" "), dwConSize, scr, pointer(c_ulong())) + windll.kernel32.FillConsoleOutputAttribute(h, csbi.wAttributes, dwConSize, scr, pointer(c_ulong())) + windll.kernel32.SetConsoleCursorPosition(h, scr) + +clear_console() diff --git a/Task/Terminal-control-Coloured-text/Fortran/terminal-control-coloured-text.f b/Task/Terminal-control-Coloured-text/Fortran/terminal-control-coloured-text.f new file mode 100644 index 0000000000..1b08f4a305 --- /dev/null +++ b/Task/Terminal-control-Coloured-text/Fortran/terminal-control-coloured-text.f @@ -0,0 +1,20 @@ +program textcolor + use kernel32 + implicit none + integer(HANDLE) :: hConsole + integer(BOOL) :: q + type(T_CONSOLE_SCREEN_BUFFER_INFO) :: csbi + + hConsole = GetStdHandle(STD_OUTPUT_HANDLE) + + if (GetConsoleScreenBufferInfo(hConsole, csbi) == 0) then + error stop "GetConsoleScreenBufferInfo failed." + end if + + q = SetConsoleTextAttribute(hConsole, int(FOREGROUND_RED .or. & + FOREGROUND_INTENSITY .or. & + BACKGROUND_BLUE .or. & + BACKGROUND_RED, WORD)) + print "(A)", "This is a red string." + q = SetConsoleTextAttribute(hConsole, csbi%wAttributes) +end program diff --git a/Task/Terminal-control-Coloured-text/PARI-GP/terminal-control-coloured-text.pari b/Task/Terminal-control-Coloured-text/PARI-GP/terminal-control-coloured-text.pari new file mode 100644 index 0000000000..08d189cff8 --- /dev/null +++ b/Task/Terminal-control-Coloured-text/PARI-GP/terminal-control-coloured-text.pari @@ -0,0 +1 @@ +for(b=40, 47, for(c=30, 37, printf("\e[%d;%d;1mRosetta Code\e[0m\n", c, b))) diff --git a/Task/Terminal-control-Coloured-text/Perl-6/terminal-control-coloured-text.pl6 b/Task/Terminal-control-Coloured-text/Perl-6/terminal-control-coloured-text.pl6 index dd4c223310..f6a9518499 100644 --- a/Task/Terminal-control-Coloured-text/Perl-6/terminal-control-coloured-text.pl6 +++ b/Task/Terminal-control-Coloured-text/Perl-6/terminal-control-coloured-text.pl6 @@ -1,4 +1,4 @@ -use Term::ANSIColor; +use Terminal::ANSIColor; say colored('RED ON WHITE', 'bold red on_white'); say colored('GREEN', 'bold green'); diff --git a/Task/Terminal-control-Coloured-text/PowerShell/terminal-control-coloured-text.psh b/Task/Terminal-control-Coloured-text/PowerShell/terminal-control-coloured-text.psh new file mode 100644 index 0000000000..3a74a1ffaf --- /dev/null +++ b/Task/Terminal-control-Coloured-text/PowerShell/terminal-control-coloured-text.psh @@ -0,0 +1 @@ +foreach ($color in [enum]::GetValues([System.ConsoleColor])) {Write-Host "$color color." -ForegroundColor $color} diff --git a/Task/Terminal-control-Coloured-text/XPL0/terminal-control-coloured-text.xpl0 b/Task/Terminal-control-Coloured-text/XPL0/terminal-control-coloured-text.xpl0 new file mode 100644 index 0000000000..d30d1a0167 --- /dev/null +++ b/Task/Terminal-control-Coloured-text/XPL0/terminal-control-coloured-text.xpl0 @@ -0,0 +1,15 @@ +code ChOut=8, Attrib=69; +def Black, Blue, Green, Cyan, Red, Magenta, Brown, White, \attribute colors + Gray, LBlue, LGreen, LCyan, LRed, LMagenta, Yellow, BWhite; \EGA palette +[ChOut(6,^C); \default white on black background +Attrib(Red<<4+White); \white on red +ChOut(6,^o); +Attrib(Green<<4+Red); \red on green +ChOut(6,^l); +Attrib(Blue<<4+LGreen); \light green on blue +ChOut(6,^o); +Attrib(LRed<<4+White); \flashing white on (standard/dim) red +ChOut(6,^u); +Attrib(Cyan<<4+Black); \black on cyan +ChOut(6,^r); +] diff --git a/Task/Terminal-control-Cursor-movement/00DESCRIPTION b/Task/Terminal-control-Cursor-movement/00DESCRIPTION index 7797fd3ebf..df883f05c5 100644 --- a/Task/Terminal-control-Cursor-movement/00DESCRIPTION +++ b/Task/Terminal-control-Cursor-movement/00DESCRIPTION @@ -1,16 +1,18 @@ -The task is to demonstrate how to achieve movement of the terminal cursor: - -* Demonstrate how to move the cursor one position to the left -* Demonstrate how to move the cursor one position to the right -* Demonstrate how to move the cursor up one line (without affecting its horizontal position) -* Demonstrate how to move the cursor down one line (without affecting its horizontal position) -* Demonstrate how to move the cursor to the beginning of the line -* Demonstrate how to move the cursor to the end of the line -* Demonstrate how to move the cursor to the top left corner of the screen -* Demonstrate how to move the cursor to the bottom right corner of the screen +;Task: +Demonstrate how to achieve movement of the terminal cursor: +:* how to move the cursor one position to the left +:* how to move the cursor one position to the right +:* how to move the cursor up one line (without affecting its horizontal position) +:* how to move the cursor down one line (without affecting its horizontal position) +:* how to move the cursor to the beginning of the line +:* how to move the cursor to the end of the line +:* how to move the cursor to the top left corner of the screen +:* how to move the cursor to the bottom right corner of the screen +
    For the purpose of this task, it is not permitted to overwrite any characters or attributes on any part of the screen (so outputting a space is not a suitable solution to achieve a movement to the right). -;Handling of out of bounds locomotion -This task has no specific requirements to trap or correct cursor movement beyond the terminal boundaries, so the implementer should decide what behaviour fits best in terms of the chosen language. Explanatory notes may be added to clarify how an out of bounds action would behave and the generation of error messages relating to an out of bounds cursor position is permitted. +;Handling of out of bounds locomotion +This task has no specific requirements to trap or correct cursor movement beyond the terminal boundaries, so the implementer should decide what behavior fits best in terms of the chosen language.   Explanatory notes may be added to clarify how an out of bounds action would behave and the generation of error messages relating to an out of bounds cursor position is permitted. +

    diff --git a/Task/Terminal-control-Cursor-positioning/C/terminal-control-cursor-positioning.c b/Task/Terminal-control-Cursor-positioning/C/terminal-control-cursor-positioning-1.c similarity index 100% rename from Task/Terminal-control-Cursor-positioning/C/terminal-control-cursor-positioning.c rename to Task/Terminal-control-Cursor-positioning/C/terminal-control-cursor-positioning-1.c diff --git a/Task/Terminal-control-Cursor-positioning/C/terminal-control-cursor-positioning-2.c b/Task/Terminal-control-Cursor-positioning/C/terminal-control-cursor-positioning-2.c new file mode 100644 index 0000000000..ca7d453a90 --- /dev/null +++ b/Task/Terminal-control-Cursor-positioning/C/terminal-control-cursor-positioning-2.c @@ -0,0 +1,9 @@ +#include + +int main() { + HANDLE hConsole = GetStdHandle(STD_OUTPUT_HANDLE); + COORD pos = {3, 6}; + SetConsoleCursorPosition(hConsole, pos); + WriteConsole(hConsole, "Hello", 5, NULL, NULL); + return 0; +} diff --git a/Task/Terminal-control-Cursor-positioning/Fortran/terminal-control-cursor-positioning.f b/Task/Terminal-control-Cursor-positioning/Fortran/terminal-control-cursor-positioning.f new file mode 100644 index 0000000000..547ac012d5 --- /dev/null +++ b/Task/Terminal-control-Cursor-positioning/Fortran/terminal-control-cursor-positioning.f @@ -0,0 +1,10 @@ +program textposition + use kernel32 + implicit none + integer(HANDLE) :: hConsole + integer(BOOL) :: q + + hConsole = GetStdHandle(STD_OUTPUT_HANDLE) + q = SetConsoleCursorPosition(hConsole, T_COORD(3, 6)) + q = WriteConsole(hConsole, loc("Hello"), 5, NULL, NULL) +end program diff --git a/Task/Terminal-control-Cursor-positioning/Icon/terminal-control-cursor-positioning.icon b/Task/Terminal-control-Cursor-positioning/Icon/terminal-control-cursor-positioning.icon new file mode 100644 index 0000000000..f679655bdf --- /dev/null +++ b/Task/Terminal-control-Cursor-positioning/Icon/terminal-control-cursor-positioning.icon @@ -0,0 +1,8 @@ +procedure main() + writes(CUP(6,3), "Hello") +end + +procedure CUP(i,j) + writes("\^[[",i,";",j,"H") + return +end diff --git a/Task/Terminal-control-Cursor-positioning/Python/terminal-control-cursor-positioning.py b/Task/Terminal-control-Cursor-positioning/Python/terminal-control-cursor-positioning-1.py similarity index 100% rename from Task/Terminal-control-Cursor-positioning/Python/terminal-control-cursor-positioning.py rename to Task/Terminal-control-Cursor-positioning/Python/terminal-control-cursor-positioning-1.py diff --git a/Task/Terminal-control-Cursor-positioning/Python/terminal-control-cursor-positioning-2.py b/Task/Terminal-control-Cursor-positioning/Python/terminal-control-cursor-positioning-2.py new file mode 100644 index 0000000000..85f3ebcab7 --- /dev/null +++ b/Task/Terminal-control-Cursor-positioning/Python/terminal-control-cursor-positioning-2.py @@ -0,0 +1,17 @@ +from ctypes import * + +STD_OUTPUT_HANDLE = -11 + +class COORD(Structure): + pass + +COORD._fields_ = [("X", c_short), ("Y", c_short)] + +def print_at(r, c, s): + h = windll.kernel32.GetStdHandle(STD_OUTPUT_HANDLE) + windll.kernel32.SetConsoleCursorPosition(h, COORD(c, r)) + + c = s.encode("windows-1252") + windll.kernel32.WriteConsoleA(h, c_char_p(c), len(c), None, None) + +print_at(6, 3, "Hello") diff --git a/Task/Terminal-control-Display-an-extended-character/00DESCRIPTION b/Task/Terminal-control-Display-an-extended-character/00DESCRIPTION index 71c5339d81..aeebf76c56 100644 --- a/Task/Terminal-control-Display-an-extended-character/00DESCRIPTION +++ b/Task/Terminal-control-Display-an-extended-character/00DESCRIPTION @@ -1 +1,5 @@ -The task is to display an extended (non ASCII) character onto the terminal. For this task, we will display a £ (GBP currency sign). +;Task: +Display an extended (non ASCII) character onto the terminal. + +Specifically, display a   £   (GBP currency sign). +

    diff --git a/Task/Terminal-control-Positional-read/BASIC/terminal-control-positional-read-1.basic b/Task/Terminal-control-Positional-read/BASIC/terminal-control-positional-read-1.basic index 2e2512a000..3f9e6e57dd 100644 --- a/Task/Terminal-control-Positional-read/BASIC/terminal-control-positional-read-1.basic +++ b/Task/Terminal-control-Positional-read/BASIC/terminal-control-positional-read-1.basic @@ -1,2 +1,2 @@ -10 LOCATE 3,6 -20 a$=COPYCHR$(#0) + 10 DEF FN C(H) = SCRN( H - 1,(V - 1) * 2) + SCRN( H - 1,(V - 1) * 2 + 1) * 16 + 20 LET V = 6:C$ = CHR$ ( FN C(3)) diff --git a/Task/Terminal-control-Positional-read/BASIC/terminal-control-positional-read-2.basic b/Task/Terminal-control-Positional-read/BASIC/terminal-control-positional-read-2.basic index 5cafcc3c19..2e2512a000 100644 --- a/Task/Terminal-control-Positional-read/BASIC/terminal-control-positional-read-2.basic +++ b/Task/Terminal-control-Positional-read/BASIC/terminal-control-positional-read-2.basic @@ -1 +1,2 @@ -c$ = CHR$(SCREEN(6, 3)) +10 LOCATE 3,6 +20 a$=COPYCHR$(#0) diff --git a/Task/Terminal-control-Positional-read/BASIC/terminal-control-positional-read-3.basic b/Task/Terminal-control-Positional-read/BASIC/terminal-control-positional-read-3.basic index 0606843ce8..5cafcc3c19 100644 --- a/Task/Terminal-control-Positional-read/BASIC/terminal-control-positional-read-3.basic +++ b/Task/Terminal-control-Positional-read/BASIC/terminal-control-positional-read-3.basic @@ -1,3 +1 @@ - 10 REM The top left corner is at position 0,0 - 20 REM So we subtract one from the coordinates - 30 LET c$ = SCREEN$(5,2) +c$ = CHR$(SCREEN(6, 3)) diff --git a/Task/Terminal-control-Positional-read/BASIC/terminal-control-positional-read-4.basic b/Task/Terminal-control-Positional-read/BASIC/terminal-control-positional-read-4.basic new file mode 100644 index 0000000000..0606843ce8 --- /dev/null +++ b/Task/Terminal-control-Positional-read/BASIC/terminal-control-positional-read-4.basic @@ -0,0 +1,3 @@ + 10 REM The top left corner is at position 0,0 + 20 REM So we subtract one from the coordinates + 30 LET c$ = SCREEN$(5,2) diff --git a/Task/Terminal-control-Preserve-screen/00DESCRIPTION b/Task/Terminal-control-Preserve-screen/00DESCRIPTION index c9c903ff8a..b3cb480e46 100644 --- a/Task/Terminal-control-Preserve-screen/00DESCRIPTION +++ b/Task/Terminal-control-Preserve-screen/00DESCRIPTION @@ -1,2 +1,8 @@ [[Terminal Control::task| ]] -The task is to clear the screen, output something on the display, and then restore the screen to the preserved state that it was in before the task was carried out. There is no requirement to change the font or kerning in this task, however character decorations and attributes are expected to be preserved. If the implementer decides to change the font or kerning during the display of the temporary screen, then these settings need to be restored prior to exit. + + +;Task: +Clear the screen, output something on the display, and then restore the screen to the preserved state that it was in before the task was carried out. + +There is no requirement to change the font or kerning in this task, however character decorations and attributes are expected to be preserved.   If the implementer decides to change the font or kerning during the display of the temporary screen, then these settings need to be restored prior to exit. +

    diff --git a/Task/Terminal-control-Preserve-screen/Applesoft-BASIC/terminal-control-preserve-screen.applesoft b/Task/Terminal-control-Preserve-screen/Applesoft-BASIC/terminal-control-preserve-screen.applesoft new file mode 100644 index 0000000000..f6f7f7ed2c --- /dev/null +++ b/Task/Terminal-control-Preserve-screen/Applesoft-BASIC/terminal-control-preserve-screen.applesoft @@ -0,0 +1,50 @@ + 10 LET FF = 255:FE = FF - 1 + 11 LET FD = 253:FC = FD - 1 + 12 POKE FC, 0 : POKE FE, 0 + 13 LET R = 768:H = PEEK (116) + 14 IF PEEK (R) = 162 GOTO 40 + + 15 LET L = PEEK (115) > 0 + 16 LET H = H - 4 - L + 17 HIMEM:H*256 + 18 LET A = 10:B = 11:C = 12 + 19 LET D = 13:E = 14:Z = 256 + 20 POKE R + 0,162: REMLDX + 21 POKE R + 1,004: REM #$04 + 22 POKE R + 2,160: REMLDY + 23 POKE R + 3,000: REM #$00 + 24 LET L = R + 4: REMLOOP + 25 POKE L + 0,177: REMLDA + 26 POKE L + 1,FC:: REM($FC),Y + 27 POKE L + 2,145: REMSTA + 28 POKE L + 3,FE:: REM($FE),Y + 29 POKE L + 4,200: REMINY + 30 POKE L + 5,208: REMBNE + 31 POKE L + 6,Z - 7: REMLOOP + 32 POKE L + 7,230: REMINC + 33 POKE L + 8,FD:: REM $FD + 34 POKE L + 9,230: REMINC + 35 POKE L + A,FF:: REM $FF + 36 POKE L + B,202: REMDEX + 37 POKE L + C,208: REMBNE + 38 POKE L + D,Z - E: REMLOOP + 39 POKE L + E,096: REMRTS + + 40 POKE FD, 4 : POKE FF, H + 41 CALL R : S = PEEK(241) + 42 LET V = PEEK(37) + 43 LET C = PEEK(36) + 44 LET M = PEEK(50) + 45 LET F = PEEK(243) + + 50 HOME : INVERSE + 51 PRINT "ALTERNATE BUFFER" + 52 FLASH : SPEED = 125 + 53 FOR I = 5 TO 1 STEP -1 + 54 PRINT "GOING BACK IN: "I + 55 NEXT I + + 60 POKE FD, H : POKE FF, 4 + 61 CALL R : POKE 241, S + 62 VTAB V + 1 : HTAB C + 1 + 63 POKE 50, M : POKE 243, F diff --git a/Task/Terminal-control-Ringing-the-terminal-bell/00DESCRIPTION b/Task/Terminal-control-Ringing-the-terminal-bell/00DESCRIPTION index 60edde54fb..bbb9a014ef 100644 --- a/Task/Terminal-control-Ringing-the-terminal-bell/00DESCRIPTION +++ b/Task/Terminal-control-Ringing-the-terminal-bell/00DESCRIPTION @@ -1,4 +1,10 @@ [[Terminal Control::task| ]] -Make the terminal running the program ring its "bell". On modern terminal emulators, this may be done by playing some other sound which might or might not be configurable, or by flashing the title bar or inverting the colors of the screen, but was classically a physical bell within the terminal. It is usually used to indicate a problem where a wrong character has been typed. -In most terminals, if the [[wp:Bell character|Bell character]] (ASCII code 7, \a in C) is printed by the program, it will cause the terminal to ring its bell. This is a function of the terminal, and is independent of the programming language of the program, other than the ability to print a particular character to standard out. +;Task: +Make the terminal running the program ring its "bell". + + +On modern terminal emulators, this may be done by playing some other sound which might or might not be configurable, or by flashing the title bar or inverting the colors of the screen, but was classically a physical bell within the terminal.   It is usually used to indicate a problem where a wrong character has been typed. + +In most terminals, if the   [[wp:Bell character|Bell character]]   (ASCII code '''7''',   \a in C)   is printed by the program, it will cause the terminal to ring its bell.   This is a function of the terminal, and is independent of the programming language of the program, other than the ability to print a particular character to standard out. +

    diff --git a/Task/Terminal-control-Ringing-the-terminal-bell/PARI-GP/terminal-control-ringing-the-terminal-bell-1.pari b/Task/Terminal-control-Ringing-the-terminal-bell/PARI-GP/terminal-control-ringing-the-terminal-bell-1.pari new file mode 100644 index 0000000000..ff71a8d828 --- /dev/null +++ b/Task/Terminal-control-Ringing-the-terminal-bell/PARI-GP/terminal-control-ringing-the-terminal-bell-1.pari @@ -0,0 +1,3 @@ +\\ Ringing the terminal bell. +\\ 8/14/2016 aev +Strchr(7) \\ press diff --git a/Task/Terminal-control-Ringing-the-terminal-bell/PARI-GP/terminal-control-ringing-the-terminal-bell-2.pari b/Task/Terminal-control-Ringing-the-terminal-bell/PARI-GP/terminal-control-ringing-the-terminal-bell-2.pari new file mode 100644 index 0000000000..7534add6d7 --- /dev/null +++ b/Task/Terminal-control-Ringing-the-terminal-bell/PARI-GP/terminal-control-ringing-the-terminal-bell-2.pari @@ -0,0 +1 @@ +print(Strchr(7)); \\ press diff --git a/Task/Terminal-control-Unicode-output/Python/terminal-control-unicode-output.py b/Task/Terminal-control-Unicode-output/Python/terminal-control-unicode-output.py new file mode 100644 index 0000000000..5c73c1d43e --- /dev/null +++ b/Task/Terminal-control-Unicode-output/Python/terminal-control-unicode-output.py @@ -0,0 +1,6 @@ +import sys + +if "UTF-8" in sys.stdout.encoding: + print("△") +else: + raise Exception("Terminal can't handle UTF-8") diff --git a/Task/Ternary-logic/00DESCRIPTION b/Task/Ternary-logic/00DESCRIPTION index 543fab21fc..bfac35bd51 100644 --- a/Task/Ternary-logic/00DESCRIPTION +++ b/Task/Ternary-logic/00DESCRIPTION @@ -1,6 +1,12 @@ {{wikipedia|Ternary logic}} + +
    In [[wp:logic|logic]], a '''three-valued logic''' (also '''trivalent''', '''ternary''', or '''trinary logic''', sometimes abbreviated '''3VL''') is any of several [[wp:many-valued logic|many-valued logic]] systems in which there are three [[wp:truth value|truth value]]s indicating ''true'', ''false'' and some indeterminate third value. -This is contrasted with the more commonly known [[wp:Principle of bivalence|bivalent]] logics (such as classical sentential or [[wp:boolean logic|boolean logic]]) which provide only for ''true'' and ''false''. Conceptual form and basic ideas were initially created by [[wp:Jan Łukasiewicz|Łukasiewicz]], [[wp:C. I. Lewis|Lewis]] and [[wp:Sulski|Sulski]]. + +This is contrasted with the more commonly known [[wp:Principle of bivalence|bivalent]] logics (such as classical sentential or [[wp:boolean logic|boolean logic]]) which provide only for ''true'' and ''false''. + +Conceptual form and basic ideas were initially created by [[wp:Jan Łukasiewicz|Łukasiewicz]], [[wp:C. I. Lewis|Lewis]] and [[wp:Sulski|Sulski]]. + These were then re-formulated by [[wp:Grigore Moisil|Grigore Moisil]] in an axiomatic algebraic form, and also extended to ''n''-valued logics in 1945. {| |+'''Example ''Ternary Logic Operators'' in ''Truth Tables'':''' @@ -74,9 +80,14 @@ These were then re-formulated by [[wp:Grigore Moisil|Grigore Moisil]] in an axio | False || False || Maybe || True |} |} -'''Task:''' + + +;Task: * Define a new type that emulates ''ternary logic'' by storing data '''trits'''. * Given all the binary logic operators of the original programming language, reimplement these operators for the new ''Ternary logic'' type '''trit'''. * Generate a sampling of results using '''trit''' variables. * [[wp:Kudos|Kudos]] for actually thinking up a test case algorithm where ''ternary logic'' is intrinsically useful, optimises the test case algorithm and is preferable to binary logic. -Note: '''[[wp:Setun|Setun]]''' (Сетунь) was a [[wp:balanced ternary|balanced ternary]] computer developed in 1958 at [[wp:Moscow State University|Moscow State University]]. The device was built under the lead of [[wp:Sergei Sobolev|Sergei Sobolev]] and [[wp:Nikolay Brusentsov|Nikolay Brusentsov]]. It was the only modern [[wp:ternary computer|ternary computer]], using three-valued [[wp:ternary logic|ternary logic]] + +
    +Note:   '''[[wp:Setun|Setun]]'''   (Сетунь) was a   [[wp:balanced ternary|balanced ternary]]   computer developed in 1958 at   [[wp:Moscow State University|Moscow State University]].   The device was built under the lead of   [[wp:Sergei Sobolev|Sergei Sobolev]]   and   [[wp:Nikolay Brusentsov|Nikolay Brusentsov]].   It was the only modern   [[wp:ternary computer|ternary computer]],   using three-valued [[wp:ternary logic|ternary logic]] +

    diff --git a/Task/Ternary-logic/JavaScript/ternary-logic-1.js b/Task/Ternary-logic/JavaScript/ternary-logic-1.js new file mode 100644 index 0000000000..fc7e4487aa --- /dev/null +++ b/Task/Ternary-logic/JavaScript/ternary-logic-1.js @@ -0,0 +1,33 @@ +var L3 = new Object(); + +L3.not = function(a) { + if (typeof a == "boolean") return !a; + if (a == undefined) return undefined; + throw("Invalid Ternary Expression."); +} + +L3.and = function(a, b) { + if (typeof a == "boolean" && typeof b == "boolean") return a && b; + if ((a == true && b == undefined) || (a == undefined && b == true)) return undefined; + if ((a == false && b == undefined) || (a == undefined && b == false)) return false; + if (a == undefined && b == undefined) return undefined; + throw("Invalid Ternary Expression."); +} + +L3.or = function(a, b) { + if (typeof a == "boolean" && typeof b == "boolean") return a || b; + if ((a == true && b == undefined) || (a == undefined && b == true)) return true; + if ((a == false && b == undefined) || (a == undefined && b == false)) return undefined; + if (a == undefined && b == undefined) return undefined; + throw("Invalid Ternary Expression."); +} + +// A -> B is equivalent to -A or B +L3.ifThen = function(a, b) { + return L3.or(L3.not(a), b); +} + +// A <=> B is equivalent to (A -> B) and (B -> A) +L3.iff = function(a, b) { + return L3.and(L3.ifThen(a, b), L3.ifThen(b, a)); +} diff --git a/Task/Ternary-logic/JavaScript/ternary-logic-2.js b/Task/Ternary-logic/JavaScript/ternary-logic-2.js new file mode 100644 index 0000000000..6c6856a52b --- /dev/null +++ b/Task/Ternary-logic/JavaScript/ternary-logic-2.js @@ -0,0 +1,10 @@ +L3.not(true) // false +L3.not(var a) // undefined + +L3.and(true, a) // undefined + +L3.or(a, 2 == 3) // false + +L3.ifThen(true, a) // undefined + +L3.iff(a, 2 == 2) // undefined diff --git a/Task/Ternary-logic/Perl-6/ternary-logic-1.pl6 b/Task/Ternary-logic/Perl-6/ternary-logic-1.pl6 index 46d8839701..7e124f570d 100644 --- a/Task/Ternary-logic/Perl-6/ternary-logic-1.pl6 +++ b/Task/Ternary-logic/Perl-6/ternary-logic-1.pl6 @@ -2,8 +2,8 @@ enum Trit ; sub prefix:<¬> (Trit $a) { Trit(1-($a-1)) } -sub infix:<∧> is equiv(&infix:<*>) (Trit $a, Trit $b) { $a min $b } -sub infix:<∨> is equiv(&infix:<+>) (Trit $a, Trit $b) { $a max $b } +sub infix:<∧> (Trit $a, Trit $b) is equiv(&infix:<*>) { $a min $b } +sub infix:<∨> (Trit $a, Trit $b) is equiv(&infix:<+>) { $a max $b } -sub infix:<⇒> is equiv(&infix:<..>) (Trit $a, Trit $b) { ¬$a max $b } -sub infix:<≡> is equiv(&infix:) (Trit $a, Trit $b) { Trit(1 + ($a-1) * ($b-1)) } +sub infix:<⇒> (Trit $a, Trit $b) is equiv(&infix:<..>) { ¬$a max $b } +sub infix:<≡> (Trit $a, Trit $b) is equiv(&infix:) { Trit(1 + ($a-1) * ($b-1)) } diff --git a/Task/Ternary-logic/REXX/ternary-logic.rexx b/Task/Ternary-logic/REXX/ternary-logic.rexx index 3c6aa10bb0..77db328a42 100644 --- a/Task/Ternary-logic/REXX/ternary-logic.rexx +++ b/Task/Ternary-logic/REXX/ternary-logic.rexx @@ -1,196 +1,195 @@ -/*REXX program displays a ternary truth table [true, false, maybe] */ -/* for the variables and one or more expressions. */ -/*Infix notation is supported with one character propositional constants*/ -/*variables (propositional constants) allowed: A──►Z, a──►z except u. */ -/*All propositional constants are case insensative (except lowercase v).*/ +/*REXX program displays a ternary truth table [true, false, maybe] for the variables */ +/*──── and one or more expressions. */ +/*──── Infix notation is supported with one character propositional constants. */ +/*──── Variables (propositional constants) allowed: A ──► Z, a ──► z except u.*/ +/*──── All propositional constants are case insensative (except lowercase v). */ +parse arg $express /*obtain optional argument from the CL.*/ +if $express\='' then do /*Got one? Then show user's expression*/ + call truthTable $express /*display the user's truth table──►term*/ + exit /*we're all done with the truth table. */ + end -parse arg expression /*get expression from the C. L. */ -if expression\='' then do /*Got one? Then show user's stuff*/ - call truthTable expression /*show and tell T.T.*/ - exit /*we're all done with truth table*/ - end +call truthTable "a & b ; AND" +call truthTable "a | b ; OR" +call truthTable "a ^ b ; XOR" +call truthTable "a ! b ; NOR" +call truthTable "a ¡ b ; NAND" +call truthTable "a xnor b ; XNOR" /*XNOR is the same as NXOR. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +truthTable: procedure; parse arg $ ';' comm 1 $o; $o=strip($o) + $=translate(strip($), '|', "v"); $u=$; upper $u + $u=translate($u, '()()()', "[]{}«»"); $$.=0; PCs=; hdrPCs= + @abc= 'abcdefghijklmnopqrstuvwxyz'; @abcU=@abc; upper @abcU + @= 'ff'x /*─────────infix operators───────*/ + op.= /*a single quote (') wasn't */ + /* implemented for negation. */ + op.0 = 'false boolFALSE' /*unconditionally FALSE */ + op.1 = 'and and & *' /* AND, conjunction */ + op.2 = 'naimpb NaIMPb' /*not A implies B */ + op.3 = 'boolb boolB' /*B (value of) */ + op.4 = 'nbimpa NbIMPa' /*not B implies A */ + op.5 = 'boola boolA' /*A (value of) */ + op.6 = 'xor xor && % ^' /* XOR, exclusive OR */ + op.7 = 'or or | + v' /* OR, disjunction */ + op.8 = 'nor nor ! ↓' /* NOR, not OR, Pierce operator */ + op.9 = 'xnor xnor nxor' /*NXOR, not exclusive OR, not XOR*/ + op.10 = 'notb notB' /*not B (value of) */ + op.11 = 'bimpa bIMPa' /* B implies A */ + op.12 = 'nota notA' /*not A (value of) */ + op.13 = 'aimpb aIMPb' /* A implies B */ + op.14 = 'nand nand ¡ ↑' /*NAND, not AND, Sheffer operator*/ + op.15 = 'true boolTRUE' /*unconditionally TRUE */ + /*alphabetic names need changing.*/ + op.16 = '\ NOT ~ ─ . ¬' /* NOT, negation */ + op.17 = '> GT' /*conditional greater than */ + op.18 = '>= GE ─> => ──> ==>' "1a"x /*conditional greater than or eq.*/ + op.19 = '< LT' /*conditional less than */ + op.20 = '<= LE <─ <= <── <==' /*conditional less then or equal */ + op.21 = '\= NE ~= ─= .= ¬=' /*conditional not equal to */ + op.22 = '= EQ EQUAL EQUALS =' "1b"x /*biconditional (equals) */ + op.23 = '0 boolTRUE' /*TRUEness */ + op.24 = '1 boolFALSE' /*FALSEness */ -call truthTable "a & b ; AND" -call truthTable "a | b ; OR" -call truthTable "a ^ b ; XOR" -call truthTable "a ! b ; NOR" -call truthTable "a ¡ b ; NAND" -call truthTable "a xnor b ; XNOR" /*XNOR is the same as NXOR. */ -exit /*stick a fork in it, we're done.*/ -/*─────────────────────────────────────truthTable subroutine────────────*/ -truthTable: procedure; parse arg $ ';' comm 1 $o; $o=strip($o) -$=translate(strip($),'|',"v"); $u=$; upper $u -$u=translate($u,'()()()',"[]{}«»"); $$.=0; PCs=; hdrPCs= -@abc='abcdefghijklmnopqrstuvwxyz'; @abcU=@abc; upper @abcU + op.25 = 'NOT NOT NEG' /*not, neg (negative) */ -@='ff'x /*─────────infix operators───────*/ -op.= /*a single quote (') wasn't */ - /* implemented for negation. */ -op.0 ='false boolFALSE' /*unconditionally FALSE */ -op.1 ='and and & *' /* AND, conjunction */ -op.2 ='naimpb NaIMPb' /*not A implies B */ -op.3 ='boolb boolB' /*B (value of) */ -op.4 ='nbimpa NbIMPa' /*not B implies A */ -op.5 ='boola boolA' /*A (value of) */ -op.6 ='xor xor && % ^' /* XOR, exclusive OR */ -op.7 ='or or | + v' /* OR, disjunction */ -op.8 ='nor nor ! ↓' /* NOR, not OR, Pierce operator */ -op.9 ='xnor xnor nxor' /*NXOR, not exclusive OR, not XOR*/ -op.10='notb notB' /*not B (value of) */ -op.11='bimpa bIMPa' /* B implies A */ -op.12='nota notA' /*not A (value of) */ -op.13='aimpb aIMPb' /* A implies B */ -op.14='nand nand ¡ ↑' /*NAND, not AND, Sheffer operator*/ -op.15='true boolTRUE' /*unconditionally TRUE */ - /*alphabetic names need changing.*/ -op.16='\ NOT ~ ─ . ¬' /* NOT, negation */ -op.17='> GT' /*conditional */ -op.18='>= GE ─> => ──> ==>' "1a"x /*conditional */ -op.19='< LT' /*conditional */ -op.20='<= LE <─ <= <── <==' /*conditional */ -op.21='\= NE ~= ─= .= ¬=' /*conditional */ -op.22='= EQ EQUAL EQUALS =' "1b"x /*biconditional */ -op.23='0 boolTRUE' /*TRUEness */ -op.24='1 boolFALSE' /*FALSEness */ + do jj=0 while op.jj\=='' | jj<16 /*change opers──►what REXX likes.*/ + new=word(op.jj,1) + do kk=2 to words(op.jj) /*handle each token separately. */ + _=word(op.jj, kk); upper _ + if wordpos(_, $u)==0 then iterate /*no such animal in this string. */ + if datatype(new, 'm') then new!=@ /*expresion needs transcribing. */ + else new!=new + $u=changestr(_, $u, new!) /*transcribe the function (maybe)*/ + if new!==@ then $u=changeFunc($u, @, new) /*use the internal boolean name. */ + end /*kk*/ + end /*jj*/ -op.25='NOT NOT NEG' /*not, neg */ + $u=translate($u, '()', "{}") /*finish cleaning up transcribing*/ + do jj=1 for length(@abcU) /*see what variables are used. */ + _=substr(@abcU, jj, 1) /*use available upercase alphabet*/ + if pos(_,$u)==0 then iterate /*found one? No, keep looking. */ + $$.jj=2 /*found: set upper bound for it.*/ + PCs=PCs _ /*also, add to propositional cons*/ + hdrPCs=hdrPCS center(_, length('false')) /*build a propositional cons hdr.*/ + end /*jj*/ + $u=PCs '('$u")" /*sep prop. cons. from expression*/ + ptr='_────►_' /*a pointer for the truth table. */ + hdrPCs=substr(hdrPCs,2) /*create a header for prop. cons.*/ + say hdrPCs left('', length(ptr) -1) $o /*show prop cons hdr +expression.*/ + say copies('───── ', words(PCs)) left('', length(ptr)-2) copies('─', length($o)) + /*Note: "true"s: right─justified*/ + do a=0 to $$.1 + do b=0 to $$.2 + do c=0 to $$.3 + do d=0 to $$.4 + do e=0 to $$.5 + do f=0 to $$.6 + do g=0 to $$.7 + do h=0 to $$.8 + do i=0 to $$.9 + do j=0 to $$.10 + do k=0 to $$.11 + do l=0 to $$.12 + do m=0 to $$.13 + do n=0 to $$.14 + do o=0 to $$.15 + do p=0 to $$.16 + do q=0 to $$.17 + do r=0 to $$.18 + do s=0 to $$.19 + do t=0 to $$.20 + do u=0 to $$.21 + do !=0 to $$.22 + do w=0 to $$.23 + do x=0 to $$.24 + do y=0 to $$.25 + do z=0 to $$.26 + interpret '_=' $u /*evaluate truth T.*/ + _=changestr(0, _, 'false') /*convert 0──►false*/ + _=changestr(1, _, '_true') /*convert 1──►_true*/ + _=changestr(2, _, 'maybe') /*convert 2──►maybe*/ + _=insert(ptr, _, wordindex(_, words(_)) -1) /*──►*/ + say translate(_, , '_') /*display truth tab*/ + end /*z*/ + end /*y*/ + end /*x*/ + end /*w*/ + end /*v*/ + end /*u*/ + end /*t*/ + end /*s*/ + end /*r*/ + end /*q*/ + end /*p*/ + end /*o*/ + end /*n*/ + end /*m*/ + end /*l*/ + end /*k*/ + end /*j*/ + end /*i*/ + end /*h*/ + end /*g*/ + end /*f*/ + end /*e*/ + end /*d*/ + end /*c*/ + end /*b*/ + end /*a*/ + say + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +scan: procedure; parse arg x,at; L=length(x); t=L; lp=0; apost=0; quote=0 + if at<0 then do; t=1; x=translate(x, '()', ")("); end - do jj=0 while op.jj\=='' | jj<16 /*change opers──►what REXX likes.*/ - new=word(op.jj,1) - do kk=2 to words(op.jj) /*handle each token separately. */ - _=word(op.jj,kk); upper _ - if wordpos(_,$u)==0 then iterate /*no such animal in this string. */ - if datatype(new,'m') then new!=@ /*expresion needs transcribing. */ - else new!=new - $u=changestr(_,$u,new!) /*transcribe the function (maybe)*/ - if new!==@ then $u=changeFunc($u,@,new) /*use internal bool name.*/ - end /*kk*/ - end /*jj*/ - -$u=translate($u, '()', "{}") /*finish cleaning up transcribing*/ - do jj=1 for length(@abcU) /*see what variables are used. */ - _=substr(@abcU,jj,1) /*use available upercase alphabet*/ - if pos(_,$u)==0 then iterate /*found one? No, keep looking. */ - $$.jj=2 /*found: set upper bound for it.*/ - PCs=PCs _ /*also, add to propositional cons*/ - hdrPCs=hdrPCS center(_,length('false')) /*build a PC header.*/ - end /*jj*/ -$u=PCs '('$u")" /*separate PCs from expression. */ -ptr='_────►_' /*a pointer for the truth table. */ -hdrPCs=substr(hdrPCs,2) /*create a header for the PCs. */ -say hdrPCs left('',length(ptr)-1) $o /*display PC header + expression.*/ -say copies('───── ',words(PCs)) left('',length(ptr)-2) copies('─',length($o)) - /*Note: "true"s: right─justified*/ - do a=0 to $$.1 - do b=0 to $$.2 - do c=0 to $$.3 - do d=0 to $$.4 - do e=0 to $$.5 - do f=0 to $$.6 - do g=0 to $$.7 - do h=0 to $$.8 - do i=0 to $$.9 - do j=0 to $$.10 - do k=0 to $$.11 - do l=0 to $$.12 - do m=0 to $$.13 - do n=0 to $$.14 - do o=0 to $$.15 - do p=0 to $$.16 - do q=0 to $$.17 - do r=0 to $$.18 - do s=0 to $$.19 - do t=0 to $$.20 - do u=0 to $$.21 - do !=0 to $$.22 - do w=0 to $$.23 - do x=0 to $$.24 - do y=0 to $$.25 - do z=0 to $$.26 - interpret '_=' $u /*evaluate truth T.*/ - _=changestr(0,_,'false') /*convert 0──►false*/ - _=changestr(1,_,'_true') /*convert 1──►_true*/ - _=changestr(2,_,'maybe') /*convert 2──►maybe*/ - _=insert(ptr,_,wordindex(_,words(_))-1) /*──►*/ - say translate(_,,'_') /*display truth tab*/ - end /*z*/ - end /*y*/ - end /*x*/ - end /*w*/ - end /*v*/ - end /*u*/ - end /*t*/ - end /*s*/ - end /*r*/ - end /*q*/ - end /*p*/ - end /*o*/ - end /*n*/ - end /*m*/ - end /*l*/ - end /*k*/ - end /*j*/ - end /*i*/ - end /*h*/ - end /*g*/ - end /*f*/ - end /*e*/ - end /*d*/ - end /*c*/ - end /*b*/ - end /*a*/ - -say; return -/*─────────────────────────────────────SCAN subroutine──────────────────*/ -scan: procedure; parse arg x,at; L=length(x); t=L; lp=0; apost=0; quote=0 -if at<0 then do; t=1; x=translate(x,'()',")("); end - do j=abs(at) to t by sign(at); _=substr(x,j,1); __=substr(x,j,2) - if quote then do; if _\=='"' then iterate - if __=='""' then do; j=j+1; iterate; end - quote=0; iterate - end - if apost then do; if _\=="'" then iterate - if __=="''" then do; j=j+1; iterate; end - apost=0; iterate - end - if _=='"' then do; quote=1; iterate; end - if _=="'" then do; apost=1; iterate; end - if _==' ' then iterate - if _=='(' then do; lp=lp+1; iterate; end - if lp\==0 then do; if _==')' then lp=lp-1; iterate; end - if datatype(_,'U') then return j-(at<0) - if at<0 then return j+1 - end /*j*/ -return min(j,L) -/*─────────────────────────────────────changeFunc subroutine────────────*/ + do j=abs(at) to t by sign(at); _=substr(x,j,1); __=substr(x,j,2) + if quote then do; if _\=='"' then iterate + if __=='""' then do; j=j+1; iterate; end + quote=0; iterate + end + if apost then do; if _\=="'" then iterate + if __=="''" then do; j=j+1; iterate; end + apost=0; iterate + end + if _=='"' then do; quote=1; iterate; end + if _=="'" then do; apost=1; iterate; end + if _==' ' then iterate + if _=='(' then do; lp=lp+1; iterate; end + if lp\==0 then do; if _==')' then lp=lp-1; iterate; end + if datatype(_,'U') then return j - (at<0) + if at<0 then return j + 1 + end /*j*/ + return min(j,L) +/*──────────────────────────────────────────────────────────────────────────────────────*/ changeFunc: procedure; parse arg z,fC,newF; funcPos=0 do forever - funcPos=pos(fC,z,funcPos+1); if funcPos==0 then return z + funcPos=pos(fC, z, funcPos + 1); if funcPos==0 then return z origPos=funcPos - z=changestr(fC,z,",'"newF"',") - funcPos=funcPos+length(newF)+4 - where=scan(z, funcPos) ; z=insert( '}', z, where) - where=scan(z, 1-origPos) ; z=insert('trit{', z, where) + z=changestr(fC, z, ",'"newF"',") + funcPos=funcPos + length(newF) + 4 + where=scan(z, funcPos) ; z=insert( '}', z, where) + where=scan(z, 1 - origPos) ; z=insert('trit{', z, where) end /*forever*/ -/*─────────────────────────────────────TRIT subroutine──────────────────*/ -trit: procedure; arg a,$,b; v=\(a==2|b==2); o= a==1|b==1; z= a==0|b==0 - select - when $=='FALSE' then return 0 - when $=='AND' then if v then return a & b; else return 2 - when $=='NAIMPB' then if v then return \(\a & \b); else return 2 - when $=='BOOLB' then return b - when $=='NBIMPA' then if v then return \(\b & \a); else return 2 - when $=='BOOLA' then return a - when $=='XOR' then if v then return a && b ; else return 2 - when $=='OR' then if v then return a | b ; else - if o then return 1; else return 2 - when $=='NOR' then if v then return \(a | b) ; else return 2 - when $=='XNOR' then if v then return \(a && b) ; else return 2 - when $=='NOTB' then if v then return \b ; else return 2 - when $=='NOTA' then if v then return \a ; else return 2 - when $=='AIMPB' then if v then return \(a & \b) ; else return 2 - when $=='NAND' then if v then return \(a & b) ; else - if z then return 1; else return 2 - when $=='TRUE' then return 1 - otherwise return -13 /*error, unknown function.*/ - end /*select*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +trit: procedure; arg a,$,b; v=\(a==2 | b==2); o= a==1 | b==1; z= a==0 | b==0 + select + when $=='FALSE' then return 0 + when $=='AND' then if v then return a & b; else return 2 + when $=='NAIMPB' then if v then return \(\a & \b); else return 2 + when $=='BOOLB' then return b + when $=='NBIMPA' then if v then return \(\b & \a); else return 2 + when $=='BOOLA' then return a + when $=='XOR' then if v then return a && b ; else return 2 + when $=='OR' then if v then return a | b ; else if o then return 1 + else return 2 + when $=='NOR' then if v then return \(a | b) ; else return 2 + when $=='XNOR' then if v then return \(a && b) ; else return 2 + when $=='NOTB' then if v then return \b ; else return 2 + when $=='NOTA' then if v then return \a ; else return 2 + when $=='AIMPB' then if v then return \(a & \b) ; else return 2 + when $=='NAND' then if v then return \(a & b) ; else if z then return 1 + else return 2 + when $=='TRUE' then return 1 + otherwise return -13 /*error, unknown function.*/ + end /*select*/ diff --git a/Task/Text-processing-2/00DESCRIPTION b/Task/Text-processing-2/00DESCRIPTION index 9212d70bb7..e27ccc4042 100644 --- a/Task/Text-processing-2/00DESCRIPTION +++ b/Task/Text-processing-2/00DESCRIPTION @@ -5,7 +5,7 @@ The fields (from the left) are: i.e. a datestamp followed by twenty-four repetitions of a floating-point instrument value and that instrument's associated integer flag. Flag values are >= 1 if the instrument is working and < 1 if there is some problem with it, in which case that instrument's value should be ignored. A sample from the full data file [http://rosettacode.org/resources/readings.zip readings.txt], which is also used in the [[Data Munging]] task, follows: -
    +
     1991-03-30	10.000	1	10.000	1	10.000	1	10.000	1	10.000	1	10.000	1	10.000	1	10.000	1	10.000	1	10.000	1	10.000	1	10.000	1	10.000	1	10.000	1	10.000	1	10.000	1	10.000	1	10.000	1	10.000	1	10.000	1	10.000	1	10.000	1	10.000	1	10.000	1
     1991-03-31	10.000	1	10.000	1	10.000	1	10.000	1	10.000	1	10.000	1	10.000	1	20.000	1	20.000	1	20.000	1	35.000	1	50.000	1	60.000	1	40.000	1	30.000	1	30.000	1	30.000	1	25.000	1	20.000	1	20.000	1	20.000	1	20.000	1	20.000	1	35.000	1
     1991-03-31	40.000	1	0.000	-2	0.000	-2	0.000	-2	0.000	-2	0.000	-2	0.000	-2	0.000	-2	0.000	-2	0.000	-2	0.000	-2	0.000	-2	0.000	-2	0.000	-2	0.000	-2	0.000	-2	0.000	-2	0.000	-2	0.000	-2	0.000	-2	0.000	-2	0.000	-2	0.000	-2	0.000	-2
    @@ -14,7 +14,8 @@ A sample from the full data file [http://rosettacode.org/resources/readings.zip
     1991-04-03	10.000	1	9.000	1	10.000	1	10.000	1	9.000	1	10.000	1	15.000	1	24.000	1	28.000	1	24.000	1	18.000	1	14.000	1	12.000	1	13.000	1	14.000	1	15.000	1	14.000	1	15.000	1	13.000	1	13.000	1	13.000	1	12.000	1	10.000	1	10.000	1
     
    -The task: +;Task: # Confirm the general field format of the file. # Identify any DATESTAMPs that are duplicated. # Report the number of records that have good readings for all instruments. +

    diff --git a/Task/Text-processing-2/OCaml/text-processing-2.ocaml b/Task/Text-processing-2/OCaml/text-processing-2.ocaml index 38fba2b270..bb49ed2e78 100644 --- a/Task/Text-processing-2/OCaml/text-processing-2.ocaml +++ b/Task/Text-processing-2/OCaml/text-processing-2.ocaml @@ -2,8 +2,8 @@ open Str let strip_cr str = - let last = pred(String.length str) in - if str.[last] <> '\r' then (str) else (String.sub str 0 last) + let last = pred (String.length str) in + if str.[last] <> '\r' then str else String.sub str 0 last let map_records = let rec aux acc = function @@ -11,7 +11,7 @@ let map_records = let e = (float_of_string value, int_of_string flag) in aux (e::acc) tail | [_] -> invalid_arg "invalid data" - | [] -> (List.rev acc) + | [] -> List.rev acc in aux [] ;; @@ -24,17 +24,17 @@ let duplicated_dates = | _::tl -> aux acc tl | [] -> - (List.rev acc) + List.rev acc in aux [] ;; let record_ok (_,record) = - let is_ok (_,v) = (v >= 1) in + let is_ok (_,v) = v >= 1 in let sum_ok = List.fold_left (fun sum this -> if is_ok this then succ sum else sum) 0 record in - (sum_ok = 24) + sum_ok = 24 let num_good_records = List.fold_left (fun sum record -> @@ -43,18 +43,18 @@ let num_good_records = let parse_line line = let li = split (regexp "[ \t]+") line in let records = map_records (List.tl li) - and date = (List.hd li) in + and date = List.hd li in (date, records) let () = let ic = open_in "readings.txt" in let rec read_loop acc = - try - let line = strip_cr(input_line ic) in - read_loop ((parse_line line) :: acc) - with End_of_file -> - close_in ic; - (List.rev acc) + let line_opt = try Some (strip_cr (input_line ic)) + with End_of_file -> None + in + match line_opt with + None -> close_in ic; List.rev acc + | Some line -> read_loop (parse_line line :: acc) in let inputs = read_loop [] in diff --git a/Task/Text-processing-Max-licenses-in-use/00DESCRIPTION b/Task/Text-processing-Max-licenses-in-use/00DESCRIPTION index 204c76b532..0555c02ab1 100644 --- a/Task/Text-processing-Max-licenses-in-use/00DESCRIPTION +++ b/Task/Text-processing-Max-licenses-in-use/00DESCRIPTION @@ -1,9 +1,13 @@ -A company currently pays a fixed sum for the use of a particular licensed software package. In determining if it has a good deal it decides to calculate its maximum use of the software from its license management log file. +A company currently pays a fixed sum for the use of a particular licensed software package.   In determining if it has a good deal it decides to calculate its maximum use of the software from its license management log file. -Assume the software's licensing daemon faithfully records a checkout event when a copy of the software starts and a checkin event when the software finishes to its log file. An example of checkout and checkin events are: +Assume the software's licensing daemon faithfully records a checkout event when a copy of the software starts and a checkin event when the software finishes to its log file. + +An example of checkout and checkin events are: License OUT @ 2008/10/03_23:51:05 for job 4974 ... License IN @ 2008/10/04_00:18:22 for job 4974 -Save the 10,000 line log file from [http://rosettacode.org/resources/mlijobs.txt here] into a local file then write a program to scan the file extracting both the maximum licenses that were out at any time, and the time(s) at which this occurs. +;Task: +Save the 10,000 line log file from   [http://rosettacode.org/resources/mlijobs.txt here]   into a local file, then write a program to scan the file extracting both the maximum licenses that were out at any time, and the time(s) at which this occurs. +

    diff --git a/Task/Text-processing-Max-licenses-in-use/PowerShell/text-processing-max-licenses-in-use.psh b/Task/Text-processing-Max-licenses-in-use/PowerShell/text-processing-max-licenses-in-use.psh new file mode 100644 index 0000000000..8a9e7ea4f3 --- /dev/null +++ b/Task/Text-processing-Max-licenses-in-use/PowerShell/text-processing-max-licenses-in-use.psh @@ -0,0 +1,45 @@ +[int]$count = 0 +[int]$maxCount = 0 +[datetime[]]$times = @() + +$jobs = Get-Content -Path ".\mlijobs.txt" | ForEach-Object { + [string[]]$fields = $_.Split(" ",[StringSplitOptions]::RemoveEmptyEntries) + [datetime]$datetime = Get-Date $fields[3].Replace("_"," ") + [PSCustomObject]@{ + State = $fields[1] + Date = $datetime + Job = $fields[6] + } +} + +foreach ($job in $jobs) +{ + switch ($job.State) + { + "IN" + { + $count-- + } + "OUT" + { + $count++ + + if ($count -gt $maxCount) + { + $maxCount = $count + $times = @() + $times+= $job.Date + } + elseif ($count -eq $maxCount) + { + $times+= $job.Date + } + } + } +} + +[PSCustomObject]@{ + LicensesOut = $maxCount + StartTime = $times[0] + EndTime = $times[1] +} diff --git a/Task/Textonyms/00DESCRIPTION b/Task/Textonyms/00DESCRIPTION index 153a1b6dbf..095c5e057d 100644 --- a/Task/Textonyms/00DESCRIPTION +++ b/Task/Textonyms/00DESCRIPTION @@ -10,7 +10,11 @@ Assuming the digit keys are mapped to letters as follows: 8 -> TUV 9 -> WXYZ -The task is to write a program that finds textonyms in a list of words such as [[Textonyms/wordlist]] or [http://www.puzzlers.org/pub/wordlists/unixdict.txt]. + +;Task: +Write a program that finds textonyms in a list of words such as   +[[Textonyms/wordlist]]   or   +[http://www.puzzlers.org/pub/wordlists/unixdict.txt unixdict.txt]. The task should produce a report: @@ -24,10 +28,13 @@ Where: #{2} is the number of digit combinations required to represent the words in #{0}. #{3} is the number of #{2} which represent more than one word. -At your discretion show a couple of examples of your solution displaying Textonys. e.g. +At your discretion show a couple of examples of your solution displaying Textonys. + +E.G.: 2748424767 -> "Briticisms", "criticisms" -Extra credit: +;Extra credit: Use a word list and keypad mapping other than English. +

    diff --git a/Task/Textonyms/ALGOL-68/textonyms.alg b/Task/Textonyms/ALGOL-68/textonyms.alg new file mode 100644 index 0000000000..eece425ee1 --- /dev/null +++ b/Task/Textonyms/ALGOL-68/textonyms.alg @@ -0,0 +1,136 @@ +# find textonyms in a list of words # +# use the associative array in the Associate array/iteration task # +PR read "aArray.a68" PR + +# returns the number of occurances of ch in text # +PROC count = ( STRING text, CHAR ch )INT: + BEGIN + INT result := 0; + FOR c FROM LWB text TO UPB text DO IF text[ c ] = ch THEN result +:= 1 FI OD; + result + END # count # ; + +CHAR invalid char = "*"; + +# returns text with the characters replaced by their text digits # +PROC to text = ( STRING text )STRING: + BEGIN + STRING result := text; + FOR pos FROM LWB result TO UPB result DO + CHAR c = to upper( result[ pos ] ); + IF c = "A" OR c = "B" OR c = "C" THEN result[ pos ] := "2" + ELIF c = "D" OR c = "E" OR c = "F" THEN result[ pos ] := "3" + ELIF c = "G" OR c = "H" OR c = "I" THEN result[ pos ] := "4" + ELIF c = "J" OR c = "K" OR c = "L" THEN result[ pos ] := "5" + ELIF c = "M" OR c = "N" OR c = "O" THEN result[ pos ] := "6" + ELIF c = "P" OR c = "Q" OR c = "R" OR c = "S" THEN result[ pos ] := "7" + ELIF c = "T" OR c = "U" OR c = "V" THEN result[ pos ] := "8" + ELIF c = "W" OR c = "X" OR c = "Y" OR c = "Z" THEN result[ pos ] := "9" + ELSE # not a character that can be encoded # result[ pos ] := invalid char + FI + OD; + result + END # to text # ; + +# read the list of words and store in an associative array # + +CHAR separator = "/"; # character that will separate the textonyms # + +IF FILE input file; + STRING file name = "unixdict.txt"; + open( input file, file name, stand in channel ) /= 0 +THEN + # failed to open the file # + print( ( "Unable to open """ + file name + """", newline ) ) +ELSE + # file opened OK # + BOOL at eof := FALSE; + # set the EOF handler for the file # + on logical file end( input file, ( REF FILE f )BOOL: + BEGIN + # note that we reached EOF on the # + # latest read # + at eof := TRUE; + # return TRUE so processing can continue # + TRUE + END + ); + REF AARRAY words := INIT LOC AARRAY; + INT word count := 0; + INT combinations := 0; + INT multiple count := 0; + INT max length := 0; + WHILE STRING word; + get( input file, ( word, newline ) ); + NOT at eof + DO + STRING text word = to text( word ); + IF count( text word, invalid char ) = 0 THEN + # the word can be fully encoded # + word count +:= 1; + INT length := ( UPB word - LWB word ) + 1; + IF length > max length THEN + # this word is longer than the maximum length found so far # + max length := length + FI; + IF ( words // text word ) = "" THEN + # first occurance of this encoding # + combinations +:= 1; + words // text word := word + ELSE + # this encoding has already been used # + IF count( words // text word, separator ) = 0 + THEN + # this is the second time this encoding is used # + multiple count +:= 1 + FI; + words // text word +:= separator + word + FI + FI + OD; + # close the file # + close( input file ); + + # find the maximum number of textonyms # + + INT max textonyms := 0; + + REF AAELEMENT e := FIRST words; + WHILE e ISNT nil element DO + INT textonyms := count( value OF e, separator ); + IF textonyms > max textonyms + THEN + max textonyms := textonyms + FI; + e := NEXT words + OD; + + print( ( "There are ", whole( word count, 0 ), " words in ", file name, " which can be represented by the digit key mapping.", newline ) ); + print( ( "They require ", whole( combinations, 0 ), " digit combinations to represent them.", newline ) ); + print( ( whole( multiple count, 0 ), " combinations represent Textonyms.", newline ) ); + + # show the textonyms with the maximum number # + print( ( "The maximum number of textonyms for a particular digit key mapping is ", whole( max textonyms + 1, 0 ), " as follows:", newline ) ); + e := FIRST words; + WHILE e ISNT nil element DO + IF INT textonyms := count( value OF e, separator ); + textonyms = max textonyms + THEN + print( ( " ", key OF e, " encodes ", value OF e, newline ) ) + FI; + e := NEXT words + OD; + + # show the textonyms with the maximum length # + print( ( "The longest words are ", whole( max length, 0 ), " chracters long", newline ) ); + print( ( "Encodings with this length are:", newline ) ); + e := FIRST words; + WHILE e ISNT nil element DO + IF max length = ( UPB key OF e - LWB key OF e ) + 1 + THEN + print( ( " ", key OF e, " encodes ", value OF e, newline ) ) + FI; + e := NEXT words + OD; + +FI diff --git a/Task/Textonyms/Io/textonyms.io b/Task/Textonyms/Io/textonyms.io new file mode 100644 index 0000000000..27bd24774a --- /dev/null +++ b/Task/Textonyms/Io/textonyms.io @@ -0,0 +1,104 @@ +main := method( + setupLetterToDigitMapping + + file := File clone openForReading("./unixdict.txt") + words := file readLines + file close + + wordCount := 0 + textonymCount := 0 + dict := Map clone + words foreach(word, + (key := word asPhoneDigits) ifNonNil( + wordCount = wordCount+1 + value := dict atIfAbsentPut(key,list()) + value append(word) + if(value size == 2,textonymCount = textonymCount+1) + ) + ) + write("There are ",wordCount," words in ",file name) + writeln(" which can be represented by the digit key mapping.") + writeln("They require ",dict size," digit combinations to represent them.") + writeln(textonymCount," digit combinations represent Textonyms.") + + samplers := list(maxAmbiquitySampler, noMatchingCharsSampler) + dict foreach(key,value, + if(value size == 1, continue) + samplers foreach(sampler,sampler examine(key,value)) + ) + samplers foreach(sampler,sampler report) +) + +setupLetterToDigitMapping := method( + fromChars := Sequence clone + toChars := Sequence clone + list( + list("ABC", "2"), list("DEF", "3"), list("GHI", "4"), + list("JKL", "5"), list("MNO", "6"), list("PQRS","7"), + list("TUV", "8"), list("WXYZ","9") + ) foreach( map, + fromChars appendSeq(map at(0), map at(0) asLowercase) + toChars alignLeftInPlace(fromChars size, map at(1)) + ) + + Sequence asPhoneDigits := block( + str := call target asMutable translate(fromChars,toChars) + if( str contains(0), nil, str ) + ) setIsActivatable(true) +) + +maxAmbiquitySampler := Object clone do( + max := list() + samples := list() + examine := method(key,textonyms, + i := key size - 1 + if(i > max size - 1, + max setSize(i+1) + samples setSize(i+1) + ) + nw := textonyms size + nwmax := max at(i) + if( nwmax isNil or nw > nwmax, + max atPut(i,nw) + samples atPut(i,list(key,textonyms)) + ) + ) + report := method( + writeln("\nExamples of maximum ambiquity for each word length:") + samples foreach(sample, + sample ifNonNil( + writeln(" ",sample at(0)," -> ",sample at(1) join(" ")) + ) + ) + ) +) + +noMatchingCharsSampler := Object clone do( + samples := list() + examine := method(key,textonyms, + for(i,0,textonyms size - 2 , + for(j,i+1,textonyms size - 1, + if( _noMatchingChars(textonyms at(i), textonyms at(j)), + samples append(list(textonyms at(i),textonyms at(j))) + ) + ) + ) + ) + _noMatchingChars := method(t1,t2, + t1 foreach(i,ich, + if(ich == t2 at(i), return false) + ) + true + ) + report := method( + write("\nThere are ",samples size," textonym pairs which ") + writeln("differ at each character position.") + if(samples size > 10, writeln("The ten largest are:")) + samples sortInPlace(at(0) size negate) + if(samples size > 10,samples slice(0,10),samples) foreach(sample, + writeln(" ",sample join(" ")," -> ",sample at(0) asPhoneDigits) + ) + ) +) + +main diff --git a/Task/Textonyms/Lua/textonyms.lua b/Task/Textonyms/Lua/textonyms.lua new file mode 100644 index 0000000000..c3a3b6e761 --- /dev/null +++ b/Task/Textonyms/Lua/textonyms.lua @@ -0,0 +1,55 @@ +-- Global variables +http = require("socket.http") +keys = {"VOICEMAIL", "abc", "def", "ghi", "jkl", "mno", "pqrs", "tuv", "wxyz"} +dictFile = "http://www.puzzlers.org/pub/wordlists/unixdict.txt" + +-- Return the sequence of keys required to type a given word +function keySequence (str) + local sequence, noMatch, letter = "" + for pos = 1, #str do + letter = str:sub(pos, pos) + for i, chars in pairs(keys) do + noMatch = true + if chars:match(letter) then + sequence = sequence .. tostring(i) + noMatch = false + break + end + end + if noMatch then return nil end + end + return tonumber(sequence) +end + +-- Generate table of words grouped by key sequence +function textonyms (dict) + local combTable, keySeq = {} + for word in dict:gmatch("%S+") do + keySeq = keySequence(word) + if keySeq then + if combTable[keySeq] then + table.insert(combTable[keySeq], word) + else + combTable[keySeq] = {word} + end + end + end + return combTable +end + +-- Analyse sequence table and print details +function showReport (keySeqs) + local wordCount, seqCount, tCount = 0, 0, 0 + for seq, wordList in pairs(keySeqs) do + wordCount = wordCount + #wordList + seqCount = seqCount + 1 + if #wordList > 1 then tCount = tCount + 1 end + end + print("There are " .. wordCount .. " words in " .. dictFile) + print("which can be represented by the digit key mapping.") + print("They require " .. seqCount .. " digit combinations to represent them.") + print(tCount .. " digit combinations represent Textonyms.") +end + +-- Main procedure +showReport(textonyms(http.request(dictFile))) diff --git a/Task/Textonyms/PowerShell/textonyms.psh b/Task/Textonyms/PowerShell/textonyms.psh new file mode 100644 index 0000000000..73e5643602 --- /dev/null +++ b/Task/Textonyms/PowerShell/textonyms.psh @@ -0,0 +1,45 @@ +$url = "http://www.puzzlers.org/pub/wordlists/unixdict.txt" +$file = "$env:TEMP\unixdict.txt" +(New-Object System.Net.WebClient).DownloadFile($url, $file) +$unixdict = Get-Content -Path $file + +[string]$alpha = "abcdefghijklmnopqrstuvwxyz" +[string]$digit = "22233344455566677778889999" + +$table = [ordered]@{} + +for ($i = 0; $i -lt $alpha.Length; $i++) +{ + $table.Add($alpha[$i], $digit[$i]) +} + +$words = foreach ($word in $unixdict) +{ + if ($word -match "^[a-z]*$") + { + [PSCustomObject]@{ + Word = $word + Number = ($word.ToCharArray() | ForEach-Object {$table.$_}) -join "" + } + } +} + +$digitCombinations = $words | Group-Object -Property Number + +$textonyms = $digitCombinations | Where-Object -Property Count -GT 1 | Sort-Object -Property Count -Descending + +Write-Host ("There are {0} words in {1} which can be represented by the digit key mapping." -f $words.Count, $url) +Write-Host ("They require {0} digit combinations to represent them." -f $digitCombinations.Count) +Write-Host ("{0} digit combinations represent Textonyms.`n" -f $textonyms.Count) + +Write-Host "Top 5 in ambiguity:" +$textonyms | Select-Object -First 5 -Property Count, + @{Name="Textonym"; Expression={$_.Name}}, + @{Name="Words" ; Expression={$_.Group.Word -join ", "}} | Format-Table -AutoSize +Write-Host "Top 5 in length:" +$textonyms | Sort-Object {$_.Name.Length} -Descending | + Select-Object -First 5 -Property @{Name="Length" ; Expression={$_.Name.Length}}, + @{Name="Textonym"; Expression={$_.Name}}, + @{Name="Words" ; Expression={$_.Group.Word -join ", "}} | Format-Table -AutoSize + +Remove-Item -Path $file -Force -ErrorAction SilentlyContinue diff --git a/Task/Textonyms/REXX/textonyms.rexx b/Task/Textonyms/REXX/textonyms.rexx index 2189a4e39d..7e2ca77ca8 100644 --- a/Task/Textonyms/REXX/textonyms.rexx +++ b/Task/Textonyms/REXX/textonyms.rexx @@ -1,47 +1,49 @@ -/*REXX program counts the number of textonyms are in a file (dictionary)*/ -parse arg iFID . /*get optional fileID of the file*/ -if iFID=='' then iFID='UNIXDICT.TXT' /*filename of the word dictionary*/ -@.=0 /*digit combinations placeholder.*/ -!.=; $.= /*sparse array of textonyms;words*/ -alphabet='ABCDEFGHIJKLMNOPQRSTUVWXYZ' /*supported alphabet to be used. */ -digitKey= 22233344455566677778889999 /*translated alphabet to dig key.*/ -digKey=0; wordCount=0 /*# digit combinations; wordCount*/ -ills=0; dups=0; longest=0; mostus=0 /*illegals; duplicate words; lit.*/ -first=0; last=0; long=0; most=0 /*for: first, last, longest, ··· */ -call linein iFID, 1, 0 /*point to the first char in dict*/ -#=0 /*number of textonyms in the file*/ - /* [↑] ───in case file is open.*/ - do j=1 while lines(iFID)\==0 /*keep reading until exhausted. */ - x=linein(iFID); y=x; upper x /*get a word and uppercase it. */ - if \datatype(x,'U') then do; ills=ills+1; iterate; end /*illegal? */ - if $.x\=='' then do; dups=dups+1; iterate; end /*duplicate?*/ - else $.x=. /*indicate it's a righteous word.*/ - wordCount=wordCount+1 /*bump the word count (for file).*/ - z=translate(x, digitKey, alphabet) /*build translated digit key word*/ - @.z=@.z+1 /*flag the digit key word exists.*/ - !.z=!.z y; _=words(!.z) /*build a list of same digit key.*/ - if _>most then do; mostus=z; most=_; end /*remember mostus digKeys.*/ - if @.z==2 then do; #=#+1 /*bump the count of the textonyms*/ - if first==0 then first=z /*the first textonym found*/ - last=z /* " last " " */ - _=length(!.z) /*length of the digit key.*/ - if _>longest then long=z /*is this the longest ? */ - longest=max(_, longest) /*now, shoot for this len.*/ - end /* [↑] discretionary stuff*/ - if @.z\==1 then iterate /*Does it already exist? Skip it*/ - digKey=digKey+1 /*bump count of digit key words. */ +/*REXX program counts and displays the number of textonyms that are in a dictionary file*/ +parse arg iFID . /*obtain optional fileID from the C.L. */ +if iFID=='' then iFID='UNIXDICT.TXT' /*Not specified? Then use the default.*/ +@.=0 /*the placeholder of digit combinations*/ +!.=; $.= /*sparse array of textonyms; words. */ +alphabet= 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' /*the supported alphabet to be used. */ +digitKey= 22233344455566677778889999 /*translated alphabet to digit keys. */ +digKey=0; wordCount=0 /*number digit combinations; wordCount.*/ +ills=0; dups=0; longest=0; mostus=0 /*illegals; duplicated words; longest..*/ +first=0; last=0; long=0; most=0 /*first, last, longest, most counts. */ +call linein iFID, 1, 0 /*point to the first char in dictionary*/ +#=0 /*number of textonyms in file (so far).*/ + + do j=1 while lines(iFID)\==0 /*keep reading the file until exhausted*/ + x=linein(iFID); y=x; upper x /*get a word; save a copy; uppercase it*/ + if \datatype(x,'U') then do; ills=ills+1; iterate; end /*is it illegal? */ + if $.x\=='' then do; dups=dups+1; iterate; end /*is it duplicate?*/ + else $.x=. /*indicate that it's a righteous word. */ + wordCount=wordCount+1 /*bump the word count (for the file). */ + z=translate(x, digitKey, alphabet) /*build a translated digit key word. */ + @.z=@.z+1 /*flag that the digit key word exists. */ + !.z=!.z y; _=words(!.z) /*build list of equivalent digit key(s)*/ + if _>most then do; mostus=z; most=_; end /*remember the "mostus" digit keys. */ + if @.z==2 then do; #=#+1 /*bump the count of the textonyms. */ + if first==0 then first=z /*the first textonym found. */ + last=z /* " last " " */ + _=length(!.z) /*the length (# chars) of the digit key*/ + if _>longest then long=z /*is this the longest textonym ? */ + longest=max(_, longest) /*now, use this length as a target/goal*/ + end /* [↑] discretionary (extra credit). */ + if @.z\==1 then iterate /*Does it already exist? Then Skip it.*/ + digKey=digKey+1 /*bump the count of digit key words. */ end /*j*/ - @@=' which can be represented by the digit key mapping.' -say wordCount 'is the number of words in file "'iFID'"' @@ -if ills\==0 then say ills 'word's(ills) "contained illegal characters." -if dups\==0 then say dups "duplicate word"s(dups) 'detected.' -say 'They require' digKey "combination"s(digKey) 'to represent them.' -say # 'digit combination's(#) "represent Textonyms." + @whichCan...= 'which can be represented by digit key mapping.' + @Ta = 'There are ' +say 'The dictionary file being used is: ' iFID +say @Ta wordCount ' words in the file' @whichCan... +if ills\==0 then say @Ta ills ' word's(ills) "contained illegal characters." +if dups\==0 then say @Ta dups " duplicate word"s(dups) 'in the dictionary detected.' +say 'The textonyms require ' digKey " combination"s(digKey) 'to represent them.' +say @Ta # ' digit combination's(#) " that can represent Textonyms." say -if first\==0 then say ' first digit key=' !.first -if last\==0 then say ' last digit key=' !.last -if long\==0 then say ' longest digit key=' !.long -if most\==0 then say ' numerous digit key=' !.mostus ' ('most "words)" -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────S subroutine────────────────────────*/ -s: if arg(1)==1 then return ''; return 's' /*a simple pluralizer.*/ +if first\==0 then say ' first digit key=' !.first +if last\==0 then say ' last digit key=' !.last +if long\==0 then say ' longest digit key=' !.long +if most\==0 then say ' numerous digit key=' !.mostus ' ('most "words)" +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +s: if arg(1)==1 then return ''; return "s" /*a simple pluralizer.*/ diff --git a/Task/The-ISAAC-Cipher/00DESCRIPTION b/Task/The-ISAAC-Cipher/00DESCRIPTION index 5d334e0623..1b45b79775 100644 --- a/Task/The-ISAAC-Cipher/00DESCRIPTION +++ b/Task/The-ISAAC-Cipher/00DESCRIPTION @@ -5,14 +5,16 @@ ISAAC stands for "Indirection, Shift, Accumulate, Add, and Count" which are the To date - and that's after more than 20 years of existence - ISAAC has not been broken (unless GCHQ or NSA did it, but they wouldn't be telling). ISAAC thus deserves a lot more attention than it has hitherto received and it would be salutary to see it more universally implemented. -Your task, should you choose to accept it, is to translate ISAAC's reference -C or Pascal code into your language of choice. + +;Task: +Translate ISAAC's reference C or Pascal code into your language of choice. + The RNG should then be seeded with the string "this is my secret key" and finally the message "a Top Secret secret" should be encrypted on that key. -Your program's output ciphertext will be a string of hexadecimal digits. +Your program's output cipher-text will be a string of hexadecimal digits. Optional: Include a decryption check by re-initializing ISAAC and performing -the same encryption pass on the ciphertext. +the same encryption pass on the cipher-text. Please use the C or Pascal as a reference guide to these operations. @@ -54,3 +56,4 @@ RandInit(true); ISAAC can of course also be initialized with a single 32-bit unsigned integer in the manner of traditional RNGs, and indeed used as such for research and gaming purposes. But building a strong and simple ISAAC-based stream cipher - replacing the irreparably broken RC4 - is our goal here: ISAAC's intended purpose. +

    diff --git a/Task/The-ISAAC-Cipher/Common-Lisp/the-isaac-cipher.lisp b/Task/The-ISAAC-Cipher/Common-Lisp/the-isaac-cipher.lisp new file mode 100644 index 0000000000..2cc668479c --- /dev/null +++ b/Task/The-ISAAC-Cipher/Common-Lisp/the-isaac-cipher.lisp @@ -0,0 +1,243 @@ +(defpackage isaac + (:use cl)) + +(in-package isaac) + +(deftype uint32 () '(unsigned-byte 32)) +(deftype arru32 () '(simple-array uint32)) + +(defstruct state + (randrsl (make-array 256 :element-type 'uint32) :type arru32) + (randcnt 0 :type uint32) + (mm (make-array 256 :element-type 'uint32) :type arru32) + (aa 0 :type uint32) + (bb 0 :type uint32) + (cc 0 :type uint32)) + +(defparameter *global-state* (make-state)) + +;; Some helper functions to force 32-bit arithmetic. +;; COERCE32 will be used to ensure the 32-bit results from +;; the given operations. +(declaim (inline lsh32 rsh32 add32 mod32 xor32)) + +(defmacro coerce32 (thing) + `(ldb (byte 32 0) ,thing)) + +;; ASH is split into lsh32 and rsh32 to satisfy the compiler and +;; allow inlining. +(declaim (ftype (function (uint32 (unsigned-byte 6)) uint32) lsh32)) +(defun lsh32 (integer count) + (declare (optimize (speed 3) (safety 0) (space 0) (debug 0))) + (coerce32 (ash integer count))) + +(declaim (ftype (function (uint32 uint32) uint32) rsh32 add32 mod32 xor32)) +(defun rsh32 (integer count) + (declare (optimize (speed 3) (safety 0) (space 0) (debug 0))) + (coerce32 (ash integer (- count)))) + +(defun add32 (x y) + (declare (optimize (speed 3) (safety 0) (space 0) (debug 0))) + (coerce32 (+ x y))) + +(defun mod32 (number divisor) + (declare (optimize (speed 3) (safety 0) (space 0) (debug 0))) + (coerce32 (mod number divisor))) + +(defun xor32 (x y) + (declare (optimize (speed 3) (safety 0) (space 0) (debug 0))) + (coerce32 (logxor x y))) + +(defmacro incf32 (place &optional (delta 1)) + `(setf ,place (add32 ,place ,delta))) + +(defun isaac (&optional (state *global-state*)) + "The ISAAC function." + (declare (optimize (speed 3) (safety 0) (space 0) (debug 0)) + (type state state)) + (with-slots (randrsl randcnt mm aa bb cc) state + (incf32 cc) + (incf32 bb cc) + (dotimes (i 256) + (let ((x (aref mm i))) + (setf aa (add32 (aref mm (mod32 (add32 i 128) 256)) + (xor32 aa + (ecase (mod32 i 4) + (0 (lsh32 aa 13)) + (1 (rsh32 aa 6)) + (2 (lsh32 aa 2)) + (3 (rsh32 aa 16)))))) + (let ((y (add32 (aref mm (mod32 (rsh32 x 2) 256)) + (add32 aa + bb)))) + (setf (aref mm i) y) + (setf bb (add32 (aref mm (mod32 (rsh32 y 10) 256)) + x)) + (setf (aref randrsl i) bb)))) + (setf randcnt 0) + (values))) + +(defmacro mix (&rest places) + "The magic mixer that spits out code to mix the given places." + (let ((len (length places)) + (kernel '#0=(11 -2 8 -16 10 -4 8 -9 . #0#))) + (rplacd (last places) places) + `(progn + ,@(loop + for i from 0 + for n in kernel + until (= i len) + append + (destructuring-bind (a b c d . rest) places + (declare (ignore rest)) + (pop places) + `((setf ,a (xor32 ,a ,(if (> n 0) `(lsh32 ,b ,n) `(rsh32 ,b ,(- n))))) + (incf32 ,d ,a) + (incf32 ,b ,c))))))) + +(defun replace-tree (value replacement tree) + "Replace all of the values in the given expression with the replacement." + (if (atom tree) + (if (equal tree value) + replacement + tree) + (cons (replace-tree value replacement (car tree)) + (if (null (cdr tree)) + nil + (replace-tree value replacement (cdr tree)))))) + +(defmacro unroller (index-name place-name places &body body) + "A helper for unrolling a section of a loop's index with the given places." + `(progn ,@(loop + for place in places + for i from 0 below (length places) append + `(,@(if (= i 0) + (replace-tree place-name place body) + (replace-tree index-name `(add32 ,index-name ,i) + (replace-tree place-name place body))))))) + +(defun randinit (flag &optional (state *global-state*)) + "Initialize the given state." + (declare (optimize (speed 3) (safety 0) (space 0) (debug 0)) + (type state state)) + (with-slots (randrsl randcnt mm aa bb cc) state + (let* ((a #x9e3779b9) (b a) (c a) (d a) (e a) (f a) (g a) (h a)) + (setf aa 0) + (setf bb 0) + (setf cc 0) + (loop repeat 4 do + (mix a b c d e f g h)) + (loop for idx from 0 below 256 by 8 do + (when flag + (unroller idx place (a b c d e f g h) + (incf32 place (aref randrsl idx)))) + (mix a b c d e f g h) + (unroller idx place (a b c d e f g h) + (setf (aref mm idx) place))) + (when flag + (loop for idx from 0 below 256 by 8 do + (unroller idx place (a b c d e f g h) + (incf32 place (aref mm idx))) + (mix a b c d e f g h) + (unroller idx place (a b c d e f g h) + (setf (aref mm idx) place))))) + (isaac state) + (setf randcnt 0) + (values))) + +(defun i-random (&optional (state *global-state*)) + "Get a random integer from the given state." + (declare (optimize (speed 3) (safety 0) (space 0) (debug 0)) + (type state state)) + (with-slots (randrsl randcnt) state + (prog1 (aref randrsl randcnt) + (incf32 randcnt) + (when (> randcnt 255) + (isaac state) + (setf randcnt 0))))) + +(defun i-rand-a (&optional (state *global-state*)) + "Get a random printable character from the given state." + (declare (optimize (speed 3) (safety 0) (space 0) (debug 0)) + (type state state)) + (add32 (mod32 (i-random state) 95) 32)) + +(defun i-seed (seed flag &optional (state *global-state*)) + "Seed the given state with a string of up to 256 characters." + (declare (optimize (speed 3) (safety 0) (space 0) (debug 0)) + (type state state) + (type string seed)) + (with-slots (randrsl mm) state + (dotimes (i 256) + (setf (aref mm i) 0)) + (let ((m (length seed))) + (dotimes (i 256) + (setf (aref randrsl i) + (if (>= i m) + 0 + (char-code (char seed i)))))) + (randinit flag state) + (values))) + +(defun vernam (msg &optional (state *global-state*)) + "Vernam encode MSG with STATE." + (declare (optimize (speed 3) (safety 0) (space 0) (debug 0)) + (type state state) + (type string msg)) + (let* ((l (length msg)) + (v (make-string l))) + (dotimes (i l) + (setf (aref v i) (code-char (logxor (i-rand-a state) (char-code (char msg i)))))) + v)) + +;; Cipher modes: encipher, decipher, none +(defconstant +mod+ 95) +(defconstant +start+ 32) + +(defun caesar (mode char shift modulo start) + "Caesar encode the given character." + (declare (optimize (speed 3) (safety 0) (space 0) (debug 0)) + (type uint32 char shift modulo start)) + (when (eq mode 'decipher) + (setf shift (- shift))) + (let ((n (mod (+ (- char start) shift) modulo))) + (when (< n 0) + (incf n modulo)) + (+ start n))) + +(defun caesar-str (mode msg modulo start &optional (state *global-state*)) + "Caesar encode or decode MSG with STATE." + (declare (optimize (speed 3) (safety 0) (space 0) (debug 0)) + (type string msg) + (type fixnum modulo start) + (type state state)) + (let* ((l (length msg)) + (c (make-string l))) + (dotimes (i l) + (setf (aref c i) (code-char (caesar mode (char-code (char msg i)) (i-rand-a state) modulo start)))) + c)) + +(defun print-hex (string) + (loop for c across string do (format t "~2,'0x" (char-code c)))) + +(defun main-test () + (let ((state (make-state)) + (msg "a Top Secret secret") + (key "this is my secret key")) + (i-seed key t state) + (let ((vctx (vernam msg state)) + (cctx (caesar-str 'encipher msg +mod+ +start+ state))) + (i-seed key t state) + (let ((vptx (vernam vctx state)) + (cptx (caesar-str 'decipher cctx +mod+ +start+ state))) + (format t "Message: ~a~%" msg) + (format t "Key : ~a~%" key) + (format t "XOR : ") + (print-hex vctx) + (terpri) + (format t "XOR dcr: ~a~%" vptx) + (format t "MOD : ") + (print-hex cctx) + (terpri) + (format t "MOD dcr: ~a~%" cptx)))) + (values)) diff --git a/Task/The-Twelve-Days-of-Christmas/ALGOL-68/the-twelve-days-of-christmas.alg b/Task/The-Twelve-Days-of-Christmas/ALGOL-68/the-twelve-days-of-christmas.alg new file mode 100644 index 0000000000..3610987968 --- /dev/null +++ b/Task/The-Twelve-Days-of-Christmas/ALGOL-68/the-twelve-days-of-christmas.alg @@ -0,0 +1,26 @@ +BEGIN + []STRING labels = ("first", "second", "third", "fourth", + "fifth", "sixth", "seventh", "eighth", + "ninth", "tenth", "eleventh", "twelfth"); + + []STRING gifts = ("A partridge in a pear tree.", + "Two turtle doves, and", + "Three French hens,", + "Four calling birds,", + "Five gold rings,", + "Six geese a-laying,", + "Seven swans a-swimming,", + "Eight maids a-milking,", + "Nine ladies dancing,", + "Ten lords a-leaping,", + "Eleven pipers piping,", + "Twelve drummers drumming,"); + FOR day TO 12 DO + print(("On the ", labels[day], + " day of Christmas, my true love sent to me:", newline)); + FOR gift FROM day BY -1 TO 1 DO + print((gifts[gift], newline)) + OD; + print(newline) + OD +END diff --git a/Task/The-Twelve-Days-of-Christmas/AppleScript/the-twelve-days-of-christmas-1.applescript b/Task/The-Twelve-Days-of-Christmas/AppleScript/the-twelve-days-of-christmas-1.applescript new file mode 100644 index 0000000000..7239e82fdf --- /dev/null +++ b/Task/The-Twelve-Days-of-Christmas/AppleScript/the-twelve-days-of-christmas-1.applescript @@ -0,0 +1,17 @@ +set gifts to {"A partridge in a pear tree.", "Two turtle doves, and", ¬ + "Three French hens,", "Four calling birds,", ¬ + "Five gold rings,", "Six geese a-laying,", ¬ + "Seven swans a-swimming,", "Eight maids a-milking,", ¬ + "Nine ladies dancing,", "Ten lords a-leaping,", ¬ + "Eleven pipers piping,", "Twelve drummers drumming"} + +set labels to {"first", "second", "third", "fourth", "fifth", "sixth", ¬ + "seventh", "eighth", "ninth", "tenth", "eleventh", "twelfth"} + +repeat with day from 1 to 12 + log "On the " & item day of labels & " day of Christmas, my true love sent to me:" + repeat with gift from day to 1 by -1 + log item gift of gifts + end repeat + log "" +end repeat diff --git a/Task/The-Twelve-Days-of-Christmas/AppleScript/the-twelve-days-of-christmas-2.applescript b/Task/The-Twelve-Days-of-Christmas/AppleScript/the-twelve-days-of-christmas-2.applescript new file mode 100644 index 0000000000..882ee21957 --- /dev/null +++ b/Task/The-Twelve-Days-of-Christmas/AppleScript/the-twelve-days-of-christmas-2.applescript @@ -0,0 +1,130 @@ +use framework "Foundation" + +property pstrGifts : "A partridge in a pear tree, Two turtle doves, Three French hens, " & ¬ + "Four calling birds, Five golden rings, Six geese a-laying, " & ¬ + "Seven swans a-swimming, Eight maids a-milking, Nine ladies dancing, " & ¬ + "Ten lords a-leaping, Eleven pipers piping, Twelve drummers drumming" + +property pstrOrdinals : "first, second, third, fourth, fifth, " & ¬ + "sixth, seventh, eighth, ninth, tenth, eleventh, twelfth" + +on daysOfXmas() + + -- csv :: String -> [String] + script csv + on lambda(str) + splitOn(", ", str) + end lambda + end script + + set {gifts, ordinals} to map(csv, [pstrGifts, pstrOrdinals]) + + -- verseOfTheDay :: Int -> String + script verseOfTheDay + + -- dayGift :: Int -> String + script dayGift + on lambda(n, i) + set strGift to item n of gifts + if n = 1 then + set strFirst to strGift & " !" + if i is not 1 then + "And " & toLowerCase(text 1 of strFirst) & text 2 thru -1 of strFirst + else + strFirst + end if + else if n = 5 then + toUpperCase(strGift) + else + strGift + end if + end lambda + end script + + on lambda(intDay) + "On the " & item intDay of ordinals & " day of Xmas, my true love gave to me ..." & ¬ + linefeed & intercalate("," & linefeed, ¬ + map(dayGift, range(intDay, 1))) + + end lambda + end script + + intercalate(linefeed & linefeed, ¬ + map(verseOfTheDay, range(1, length of ordinals))) + +end daysOfXmas + +-- TEST +on run + + daysOfXmas() + +end run + + +-- GENERIC FUNCTIONS + +-- splitOn :: Text -> Text -> [Text] +on splitOn(strDelim, strMain) + set {dlm, my text item delimiters} to {my text item delimiters, strDelim} + set lstParts to text items of strMain + set my text item delimiters to dlm + return lstParts +end splitOn + +-- 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 + +-- intercalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate + +-- range :: Int -> Int -> [Int] +on range(m, n) + set d to 1 + if n < m then set d to -1 + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range + +-- Text -> Text +on toLowerCase(str) + set ca to current application + ((ca's NSString's stringWithString:(str))'s ¬ + lowercaseStringWithLocale:(ca's NSLocale's currentLocale())) as text +end toLowerCase + +-- Text -> Text +on toUpperCase(str) + set ca to current application + ((ca's NSString's stringWithString:(str))'s ¬ + uppercaseStringWithLocale:(ca's NSLocale's currentLocale())) as text +end toUpperCase + +-- 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 diff --git a/Task/The-Twelve-Days-of-Christmas/Clojure/the-twelve-days-of-christmas.clj b/Task/The-Twelve-Days-of-Christmas/Clojure/the-twelve-days-of-christmas.clj index 01cf1836ac..86e5b177a2 100644 --- a/Task/The-Twelve-Days-of-Christmas/Clojure/the-twelve-days-of-christmas.clj +++ b/Task/The-Twelve-Days-of-Christmas/Clojure/the-twelve-days-of-christmas.clj @@ -5,7 +5,7 @@ "Seven swans a-swimming", "Eight maids a-miling", "Nine ladies dancing", "Ten lords a-leaping", "Eleven pipers piping", "Twelve drummers drumming"] - day (fn [n] (printf "On the %s day of Christmas, my true love gave to me\n" (nth numbers n)))] + day (fn [n] (printf "On the %s day of Christmas, my true love sent to me\n" (nth numbers n)))] (day 0) (println (clojure.string/replace (first gifts) "And a" "A")) diff --git a/Task/The-Twelve-Days-of-Christmas/Common-Lisp/the-twelve-days-of-christmas.lisp b/Task/The-Twelve-Days-of-Christmas/Common-Lisp/the-twelve-days-of-christmas.lisp new file mode 100644 index 0000000000..60f56c162b --- /dev/null +++ b/Task/The-Twelve-Days-of-Christmas/Common-Lisp/the-twelve-days-of-christmas.lisp @@ -0,0 +1,11 @@ +(let + ((names '(first second third fourth fifth sixth seventh eighth ninth tenth eleventh twelfth)) + (gifts '( "A partridge in a pear tree." "Two turtle doves and" "Three French hens," + "Four calling birds," "Five gold rings," "Six geese a-laying," + "Seven swans a-swimming," "Eight maids a-milking," "Nine ladies dancing," + "Ten lords a-leaping," "Eleven pipers piping," "Twelve drummers drumming," ))) + + (loop for day in names for i from 0 doing + (format t "On the ~a day of Christmas, my true love sent to me:" (string-downcase day)) + (loop for g from i downto 0 doing (format t "~a~%" (nth g gifts))) + (format t "~%~%"))) diff --git a/Task/The-Twelve-Days-of-Christmas/Erlang/the-twelve-days-of-christmas.erl b/Task/The-Twelve-Days-of-Christmas/Erlang/the-twelve-days-of-christmas.erl new file mode 100644 index 0000000000..c1917b7155 --- /dev/null +++ b/Task/The-Twelve-Days-of-Christmas/Erlang/the-twelve-days-of-christmas.erl @@ -0,0 +1,20 @@ +-module(twelve_days). +-export([gifts_for_day/1]). + +names(N) -> lists:nth(N, + ["first", "second", "third", "fourth", "fifth", "sixth", + "seventh", "eighth", "ninth", "tenth", "eleventh", "twelfth" ]). + +gifts() -> [ "A partridge in a pear tree.", "Two turtle doves and", + "Three French hens,", "Four calling birds,", + "Five gold rings,", "Six geese a-laying,", + "Seven swans a-swimming,", "Eight maids a-milking,", + "Nine ladies dancing,", "Ten lords a-leaping,", + "Eleven pipers piping,", "Twelve drummers drumming," ]. + +gifts_for_day(N) -> + "On the " ++ names(N) ++ " day of Christmas, my true love sent to me:\n" ++ + string:join(lists:reverse(lists:sublist(gifts(), N)), "\n"). + +main(_) -> lists:map(fun(N) -> io:fwrite("~s~n~n", [gifts_for_day(N)]) end, + lists:seq(1,12)). diff --git a/Task/The-Twelve-Days-of-Christmas/Forth/the-twelve-days-of-christmas.fth b/Task/The-Twelve-Days-of-Christmas/Forth/the-twelve-days-of-christmas.fth new file mode 100644 index 0000000000..b5068adb6e --- /dev/null +++ b/Task/The-Twelve-Days-of-Christmas/Forth/the-twelve-days-of-christmas.fth @@ -0,0 +1,36 @@ +create ordinals s" first" 2, s" second" 2, s" third" 2, s" fourth" 2, + s" fifth" 2, s" sixth" 2, s" seventh" 2, s" eighth" 2, + s" ninth" 2, s" tenth" 2, s" eleventh" 2, s" twelfth" 2, +: ordinal ordinals swap 2 * cells + 2@ ; + +create gifts s" A partridge in a pear tree." 2, + s" Two turtle doves and" 2, + s" Three French hens," 2, + s" Four calling birds," 2, + s" Five gold rings," 2, + s" Six geese a-laying," 2, + s" Seven swans a-swimming," 2, + s" Eight maids a-milking," 2, + s" Nine ladies dancing," 2, + s" Ten lords a-leaping," 2, + s" Eleven pipers piping," 2, + s" Twelve drummers drumming," 2, +: gift gifts swap 2 * cells + 2@ ; + +: day + s" On the " type + dup ordinal type + s" day of Christmas, my true love sent to me:" type + cr + -1 swap -do + i gift type cr + 1 -loop + cr + ; + +: main + 12 0 do i day loop +; + +main +bye diff --git a/Task/The-Twelve-Days-of-Christmas/Fortran/the-twelve-days-of-christmas.f b/Task/The-Twelve-Days-of-Christmas/Fortran/the-twelve-days-of-christmas.f new file mode 100644 index 0000000000..ac292d7e52 --- /dev/null +++ b/Task/The-Twelve-Days-of-Christmas/Fortran/the-twelve-days-of-christmas.f @@ -0,0 +1,32 @@ + program twelve_days + + character days(12)*8 + data days/'first', 'second', 'third', 'fourth', + c 'fifth', 'sixth', 'seventh', 'eighth', + c 'ninth', 'tenth', 'eleventh', 'twelfth'/ + + character gifts(12)*27 + data gifts/'A partridge in a pear tree.', + c 'Two turtle doves and', + c 'Three French hens,', + c 'Four calling birds,', + c 'Five gold rings,', + c 'Six geese a-laying,', + c 'Seven swans a-swimming,', + c 'Eight maids a-milking,', + c 'Nine ladies dancing,', + c 'Ten lords a-leaping,', + c 'Eleven pipers piping,', + c 'Twelve drummers drumming,'/ + + integer day, gift + + do 10 day=1,12 + write (*,*) 'On the ', trim(days(day)), + c ' day of Christmas, my true love sent to me:' + do 20 gift=day,1,-1 + write (*,*) trim(gifts(gift)) + 20 continue + write(*,*) + 10 continue + end diff --git a/Task/The-Twelve-Days-of-Christmas/Go/the-twelve-days-of-christmas.go b/Task/The-Twelve-Days-of-Christmas/Go/the-twelve-days-of-christmas.go index 43916090b8..847d87c44c 100644 --- a/Task/The-Twelve-Days-of-Christmas/Go/the-twelve-days-of-christmas.go +++ b/Task/The-Twelve-Days-of-Christmas/Go/the-twelve-days-of-christmas.go @@ -18,7 +18,7 @@ func main() { "Eleven pipers piping", "Twelve drummers drumming"} day := func(n int) { - fmt.Printf("On the %s day of Christams, my true love gave to me\n", numbers[n]) + fmt.Printf("On the %s day of Christams, my true love sent to me\n", numbers[n]) } day(0) diff --git a/Task/The-Twelve-Days-of-Christmas/Kotlin/the-twelve-days-of-christmas.kotlin b/Task/The-Twelve-Days-of-Christmas/Kotlin/the-twelve-days-of-christmas.kotlin new file mode 100644 index 0000000000..e7cc317cd7 --- /dev/null +++ b/Task/The-Twelve-Days-of-Christmas/Kotlin/the-twelve-days-of-christmas.kotlin @@ -0,0 +1,21 @@ +enum class Day { + first, second, third, fourth, fifth, sixth, seventh, eighth, ninth, tenth, eleventh, twelfth; + val header = "On the " + this + " day of Christmas, my true love sent to me\n\t" +} + +fun main(x: Array) { + val gifts = listOf("A partridge in a pear tree", + "Two turtle doves and", + "Three french hens", + "Four calling birds", + "Five golden rings", + "Six geese a-laying", + "Seven swans a-swimming", + "Eight maids a-milking", + "Nine ladies dancing", + "Ten lords a-leaping", + "Eleven pipers piping", + "Twelve drummers drumming") + + Day.values().forEachIndexed { i, d -> println(d.header + gifts.slice(0..i).asReversed().joinToString("\n\t")) } +} diff --git a/Task/The-Twelve-Days-of-Christmas/LOLCODE/the-twelve-days-of-christmas.lol b/Task/The-Twelve-Days-of-Christmas/LOLCODE/the-twelve-days-of-christmas.lol index 7852e63404..ecca81d40f 100644 --- a/Task/The-Twelve-Days-of-Christmas/LOLCODE/the-twelve-days-of-christmas.lol +++ b/Task/The-Twelve-Days-of-Christmas/LOLCODE/the-twelve-days-of-christmas.lol @@ -33,7 +33,7 @@ IM IN YR Outer UPPIN YR i WILE DIFFRINT i AN 12 I HAS A Day ITZ SUM OF i AN 1 VISIBLE "On the " ! VISIBLE Dayz'Z SRS Day ! - VISIBLE " day of Christmas, my true love gave to me" + VISIBLE " day of Christmas, my true love sent to me" IM IN YR Inner UPPIN YR j WILE DIFFRINT j AN Day I HAS A Count ITZ DIFFERENCE OF Day AN j VISIBLE Prezents'Z SRS Count diff --git a/Task/The-Twelve-Days-of-Christmas/Logo/the-twelve-days-of-christmas.logo b/Task/The-Twelve-Days-of-Christmas/Logo/the-twelve-days-of-christmas.logo index 8dff0fd13c..2d04c95a51 100644 --- a/Task/The-Twelve-Days-of-Christmas/Logo/the-twelve-days-of-christmas.logo +++ b/Task/The-Twelve-Days-of-Christmas/Logo/the-twelve-days-of-christmas.logo @@ -5,7 +5,7 @@ make "gifts [[And a partridge in a pear tree] [Two turtle doves] [Three Fr [Ten lords a-leaping] [Eleven pipers piping] [Twelve drummers drumming]] to nth :n - print (sentence [On the] (item :n :numbers) [day of Christmas, my true love gave to me]) + print (sentence [On the] (item :n :numbers) [day of Christmas, my true love sent to me]) end nth 1 diff --git a/Task/The-Twelve-Days-of-Christmas/Maple/the-twelve-days-of-christmas.maple b/Task/The-Twelve-Days-of-Christmas/Maple/the-twelve-days-of-christmas.maple new file mode 100644 index 0000000000..6f11e9d52b --- /dev/null +++ b/Task/The-Twelve-Days-of-Christmas/Maple/the-twelve-days-of-christmas.maple @@ -0,0 +1,15 @@ +gifts := ["Twelve drummers drumming", + "Eleven pipers piping", "Ten lords a-leaping", + "Nine ladies dancing", "Eight maids a-milking", + "Seven swans a-swimming", "Six geese a-laying", + "Five golden rings", "Four calling birds", + "Three french hens", "Two turtle doves and", "A partridge in a pear tree"]: +days := ["first", "second", "third", "fourth", "fifth", "sixth", + "seventh", "eighth", "ninth", "tenth", "eleventh", "twelfth"]: +for i to 12 do + printf("On the %s day of Christmas\nMy true love gave to me:\n", days[i]); + for j from 13-i to 12 do + printf("%s\n", gifts[j]); + end do; + printf("\n"); +end do; diff --git a/Task/The-Twelve-Days-of-Christmas/Mathematica/the-twelve-days-of-christmas.math b/Task/The-Twelve-Days-of-Christmas/Mathematica/the-twelve-days-of-christmas.math index 8756f3b5ee..b466267803 100644 --- a/Task/The-Twelve-Days-of-Christmas/Mathematica/the-twelve-days-of-christmas.math +++ b/Task/The-Twelve-Days-of-Christmas/Mathematica/the-twelve-days-of-christmas.math @@ -1,16 +1,13 @@ daysarray = {"first", "second", "third", "fourth", "fifth", "sixth", "seventh", "eighth", "ninth", "tenth", "eleventh", "twelfth"}; -giftsarray = {"And a partridge in a pear tree.", "Two turtle doves,", - "Three french hens,", "Four calling birds,", "FIVE GOLDEN RINGS,", - "Six geese a-laying,", "Seven swans a-swimming,", - "Eight maids a-milking,", "Nine ladies dancing,", - "Ten lords a-leaping,", "Eleven pipers piping,", - "Twelve drummers drumming,"}; -Do[ - Print["On the " <> daysarray[[i]] <> - " day of Christmas, my true love gave to me: "] - Do [ - Print[If[i == 1, "A partridge in a pear tree.", giftsarray[[j]]]] - , {j, i, 1, -1}] - Print[] - , {i, 1, 12}] +giftsarray = {"And a partridge in a pear tree.", "Two turtle doves", + "Three french hens", "Four calling birds", "FIVE GOLDEN RINGS", + "Six geese a-laying", "Seven swans a-swimming,", + "Eight maids a-milking", "Nine ladies dancing", + "Ten lords a-leaping", "Eleven pipers piping", + "Twelve drummers drumming"}; +Do[Print[StringForm[ + "On the `1` day of Christmas, my true love gave to me: `2`", + daysarray[[i]], + If[i == 1, "A partridge in a pear tree.", + Row[Reverse[Take[giftsarray, i]], ","]]]], {i, 1, 12}] diff --git a/Task/The-Twelve-Days-of-Christmas/PARI-GP/the-twelve-days-of-christmas.pari b/Task/The-Twelve-Days-of-Christmas/PARI-GP/the-twelve-days-of-christmas.pari new file mode 100644 index 0000000000..5737e0afa1 --- /dev/null +++ b/Task/The-Twelve-Days-of-Christmas/PARI-GP/the-twelve-days-of-christmas.pari @@ -0,0 +1,9 @@ +days=["first","second","third","fourth","fifth","sixth","seventh","eighth","ninth","tenth","eleventh","twelfth"]; +gifts=["And a partridge in a pear tree.", "Two turtle doves", "Three french hens", "Four calling birds", "Five golden rings", "Six geese a-laying", "Seven swans a-swimming", "Eight maids a-milking", "Nine ladies dancing", "Ten lords a-leaping", "Eleven pipers piping", "Twelve drummers drumming"]; +{ +for(i=1,#days, + print("On the "days[i]" day of Christmas, my true love gave to me:"); + forstep(j=i,2,-1,print("\t"gifts[j]", ")); + print(if(i==1,"\tA partridge in a pear tree.",Str("\t",gifts[1]))) +) +} diff --git a/Task/The-Twelve-Days-of-Christmas/Pascal/the-twelve-days-of-christmas-1.pascal b/Task/The-Twelve-Days-of-Christmas/Pascal/the-twelve-days-of-christmas-1.pascal new file mode 100644 index 0000000000..f860f31c20 --- /dev/null +++ b/Task/The-Twelve-Days-of-Christmas/Pascal/the-twelve-days-of-christmas-1.pascal @@ -0,0 +1,32 @@ +program twelve_days(output); + +const + days: array[1..12] of string = + ( 'first', 'second', 'third', 'fourth', 'fifth', 'sixth', + 'seventh', 'eighth', 'ninth', 'tenth', 'eleventh', 'twelfth' ); + + gifts: array[1..12] of string = + ( 'A partridge in a pear tree.', + 'Two turtle doves and', + 'Three French hens,', + 'Four calling birds,', + 'Five gold rings,', + 'Six geese a-laying,', + 'Seven swans a-swimming,', + 'Eight maids a-milking,', + 'Nine ladies dancing,', + 'Ten lords a-leaping,', + 'Eleven pipers piping,', + 'Twelve drummers drumming,' ); + +var + day, gift: integer; + +begin + for day := 1 to 12 do begin + writeln('On the ', days[day], ' day of Christmas, my true love sent to me:'); + for gift := day downto 1 do + writeln(gifts[gift]); + writeln + end +end. diff --git a/Task/The-Twelve-Days-of-Christmas/Pascal/the-twelve-days-of-christmas-2.pascal b/Task/The-Twelve-Days-of-Christmas/Pascal/the-twelve-days-of-christmas-2.pascal new file mode 100644 index 0000000000..30f1cb51be --- /dev/null +++ b/Task/The-Twelve-Days-of-Christmas/Pascal/the-twelve-days-of-christmas-2.pascal @@ -0,0 +1,33 @@ +program twelve_days_iso(output); + +const + days: array[1..12, 1..8] of char = + ( 'first ', 'second ', 'third ', 'fourth ', + 'fifth ', 'sixth ', 'seventh ', 'eighth ', + 'ninth ', 'tenth ', 'eleventh', 'twelfth ' ); + + gifts: array[1..12, 1..27] of char = + ( 'A partridge in a pear tree.', + 'Two turtle doves and ', + 'Three French hens, ', + 'Four calling birds, ', + 'Five gold rings, ', + 'Six geese a-laying, ', + 'Seven swans a-swimming, ', + 'Eight maids a-milking, ', + 'Nine ladies dancing, ', + 'Ten lords a-leaping, ', + 'Eleven pipers piping, ', + 'Twelve drummers drumming, ' ); + +var + day, gift: integer; + +begin + for day := 1 to 12 do begin + writeln('On the ', days[day], ' day of Christmas, my true love gave to me:'); + for gift := day downto 1 do + writeln(gifts[gift]); + writeln + end +end. diff --git a/Task/The-Twelve-Days-of-Christmas/Prolog/the-twelve-days-of-christmas.pro b/Task/The-Twelve-Days-of-Christmas/Prolog/the-twelve-days-of-christmas.pro new file mode 100644 index 0000000000..eba7e46fe4 --- /dev/null +++ b/Task/The-Twelve-Days-of-Christmas/Prolog/the-twelve-days-of-christmas.pro @@ -0,0 +1,42 @@ +day(1, 'first'). +day(2, 'second'). +day(3, 'third'). +day(4, 'fourth'). +day(5, 'fifth'). +day(6, 'sixth'). +day(7, 'seventh'). +day(8, 'eighth'). +day(9, 'ninth'). +day(10, 'tenth'). +day(11, 'eleventh'). +day(12, 'twelfth'). + +gift(1, 'A partridge in a pear tree.'). +gift(2, 'Two turtle doves and'). +gift(3, 'Three French hens,'). +gift(4, 'Four calling birds,'). +gift(5, 'Five gold rings,'). +gift(6, 'Six geese a-laying,'). +gift(7, 'Seven swans a-swimming,'). +gift(8, 'Eight maids a-milking,'). +gift(9, 'Nine ladies dancing,'). +gift(10, 'Ten lords a-leaping,'). +gift(11, 'Eleven pipers piping,'). +gift(12, 'Twelve drummers drumming,'). + +giftsFor(0, []) :- !. +giftsFor(N, [H|T]) :- gift(N, H), M is N-1, giftsFor(M,T). + +writeln(S) :- write(S), write('\n'). + +writeList([]) :- writeln(''), !. +writeList([H|T]) :- writeln(H), writeList(T). + +writeGifts(N) :- day(N, Nth), write('On the '), write(Nth), + writeln(' day of Christmas, my true love sent to me:'), + giftsFor(N,L), writeList(L). + +writeLoop(0) :- !. +writeLoop(N) :- Day is 13 - N, writeGifts(Day), M is N - 1, writeLoop(M). + +main :- writeLoop(12), halt. diff --git a/Task/The-Twelve-Days-of-Christmas/Run-BASIC/the-twelve-days-of-christmas.run b/Task/The-Twelve-Days-of-Christmas/Run-BASIC/the-twelve-days-of-christmas.run new file mode 100644 index 0000000000..0ee84196c2 --- /dev/null +++ b/Task/The-Twelve-Days-of-Christmas/Run-BASIC/the-twelve-days-of-christmas.run @@ -0,0 +1,25 @@ +gifts$ = " +A partridge in a pear tree., +Two turtle doves, +Three french hens, +Four calling birds, +Five golden rings, +Six geese a-laying, +Seven swans a-swimming, +Eight maids a-milking, +Nine ladies dancing, +Ten lords a-leaping, +Eleven pipers piping, +Twelve drummers drumming" + +days$ = "first second third fourth fifth sixth seventh eighth ninth tenth eleventh twelfth" + +for i = 1 to 12 + print "On the ";word$(days$,i," ");" day of Christmas" + print "My true love gave to me:" + for j = i to 1 step -1 + if i > 1 and j = 1 then print "and "; + print mid$(word$(gifts$,j,","),2) + next j + print +next i diff --git a/Task/The-Twelve-Days-of-Christmas/SQL/the-twelve-days-of-christmas.sql b/Task/The-Twelve-Days-of-Christmas/SQL/the-twelve-days-of-christmas.sql index 30320a2c1a..9af29bfb74 100644 --- a/Task/The-Twelve-Days-of-Christmas/SQL/the-twelve-days-of-christmas.sql +++ b/Task/The-Twelve-Days-of-Christmas/SQL/the-twelve-days-of-christmas.sql @@ -13,33 +13,20 @@ begin case when d >= x then nl (g) end; end v; select 'On the ' - || case level - when 1 then 'first' - when 2 then 'second' - when 3 then 'third' - when 4 then 'fourth' - when 5 then 'fifth' - when 6 then 'sixth' - when 7 then 'seventh' - when 8 then 'eighth' - when 9 then 'ninth' - when 10 then 'tenth' - when 11 then 'eleventh' - when 12 then 'twelfth' - end - || ' of Christmas,' - || nl( 'My true love gave to me:') - || v ( level, 12, 'Twelve drummers drumming' ) - || v ( level, 11, 'Eleven pipers piping' ) - || v ( level, 10, 'Ten lords a-leaping' ) - || v ( level, 9, 'Nine ladies dancing' ) - || v ( level, 8, 'Eight maids a-milking' ) - || v ( level, 7, 'Seven swans a-swimming' ) - || v ( level, 6, 'Six geese a-laying' ) + || to_char(to_date(level,'j'),'jspth' ) + || ' day of Christmas,' + || nl( 'my true love sent to me:') + || v ( level, 12, 'Twelve drummers drumming,' ) + || v ( level, 11, 'Eleven pipers piping,' ) + || v ( level, 10, 'Ten lords a-leaping,' ) + || v ( level, 9, 'Nine ladies dancing,' ) + || v ( level, 8, 'Eight maids a-milking,' ) + || v ( level, 7, 'Seven swans a-swimming,' ) + || v ( level, 6, 'Six geese a-laying,' ) || v ( level, 5, 'Five golden rings!' ) - || v ( level, 4, 'Four calling birds' ) - || v ( level, 3, 'Three French hens' ) - || v ( level, 2, 'Two turtle doves' ) + || v ( level, 4, 'Four calling birds,' ) + || v ( level, 3, 'Three French hens,' ) + || v ( level, 2, 'Two turtle doves,' ) || v ( level, 1, case level when 1 then 'A' else 'And a' end || ' partridge in a pear tree.' ) || nl(null) "The Twelve Days of Christmas" diff --git a/Task/The-Twelve-Days-of-Christmas/Scala/the-twelve-days-of-christmas.scala b/Task/The-Twelve-Days-of-Christmas/Scala/the-twelve-days-of-christmas.scala new file mode 100644 index 0000000000..596b44daf8 --- /dev/null +++ b/Task/The-Twelve-Days-of-Christmas/Scala/the-twelve-days-of-christmas.scala @@ -0,0 +1,25 @@ +val gifts = Array( + "A partridge in a pear tree.", + "Two turtle doves and", + "Three French hens,", + "Four calling birds,", + "Five gold rings,", + "Six geese a-laying,", + "Seven swans a-swimming,", + "Eight maids a-milking,", + "Nine ladies dancing,", + "Ten lords a-leaping,", + "Eleven pipers piping,", + "Twelve drummers drumming," + ) + +val days = Array( + "first", "second", "third", "fourth", "fifth", "sixth", + "seventh", "eighth", "ninth", "tenth", "eleventh", "twelfth" + ) + +val giftsForDay = (day: Int) => + "On the %s day of Christmas, my true love gave to me:\n".format(days(day)) + + gifts.take(day+1).reverse.mkString("\n") + "\n" + +(0 until 12).map(giftsForDay andThen println) diff --git a/Task/The-Twelve-Days-of-Christmas/Simula/the-twelve-days-of-christmas.simula b/Task/The-Twelve-Days-of-Christmas/Simula/the-twelve-days-of-christmas.simula new file mode 100644 index 0000000000..aa6c8b8c4f --- /dev/null +++ b/Task/The-Twelve-Days-of-Christmas/Simula/the-twelve-days-of-christmas.simula @@ -0,0 +1,40 @@ +Begin + Text Array days(1:12), gifts(1:12); + Integer day, gift; + + days(1) :- "first"; + days(2) :- "second"; + days(3) :- "third"; + days(4) :- "fourth"; + days(5) :- "fifth"; + days(6) :- "sixth"; + days(7) :- "seventh"; + days(8) :- "eighth"; + days(9) :- "ninth"; + days(10) :- "tenth"; + days(11) :- "eleventh"; + days(12) :- "twelfth"; + + + gifts(1) :- "A partridge in a pear tree."; + gifts(2) :- "Two turtle doves and"; + gifts(3) :- "Three French hens,"; + gifts(4) :- "Four calling birds,"; + gifts(5) :- "Five gold rings,"; + gifts(6) :- "Six geese a-laying,"; + gifts(7) :- "Seven swans a-swimming,"; + gifts(8) :- "Eight maids a-milking,"; + gifts(9) :- "Nine ladies dancing,"; + gifts(10) :- "Ten lords a-leaping,"; + gifts(11) :- "Eleven pipers piping,"; + gifts(12) :- "Twelve drummers drumming,"; + + For day := 1 Step 1 Until 12 Do Begin + outtext("On the "); outtext(days(day)); + outtext(" day of Christmas, my true love sent to me:"); outimage; + For gift := day Step -1 Until 1 Do Begin + outtext(gifts(gift)); outimage + End; + outimage + End +End diff --git a/Task/The-Twelve-Days-of-Christmas/Smalltalk/the-twelve-days-of-christmas.st b/Task/The-Twelve-Days-of-Christmas/Smalltalk/the-twelve-days-of-christmas.st new file mode 100644 index 0000000000..7b04dcde98 --- /dev/null +++ b/Task/The-Twelve-Days-of-Christmas/Smalltalk/the-twelve-days-of-christmas.st @@ -0,0 +1,27 @@ +Object subclass: TwelveDays [ + Ordinals := #('first' 'second' 'third' 'fourth' 'fifth' 'sixth' + 'seventh' 'eighth' 'ninth' 'tenth' 'eleventh' 'twelfth'). + + Gifts := #( 'A partridge in a pear tree.' 'Two turtle doves and' + 'Three French hens,' 'Four calling birds,' + 'Five gold rings,' 'Six geese a-laying,' + 'Seven swans a-swimming,' 'Eight maids a-milking,' + 'Nine ladies dancing,' 'Ten lords a-leaping,' + 'Eleven pipers piping,' 'Twelve drummers drumming,' ). +] + +TwelveDays class extend [ + giftsFor: day [ + |newLine ordinal giftList| + newLine := $<10> asString. + ordinal := Ordinals at: day. + giftList := (Gifts first: day) reverse. + + ^'On the ', ordinal, ' day of Christmas, my true love sent to me:', + newLine, (giftList join: newLine), newLine. + ] +] + +1 to: 12 do: [:i | + Transcript show: (TwelveDays giftsFor: i); cr. +]. diff --git a/Task/The-Twelve-Days-of-Christmas/Snobol/the-twelve-days-of-christmas.sno b/Task/The-Twelve-Days-of-Christmas/Snobol/the-twelve-days-of-christmas.sno new file mode 100644 index 0000000000..f872865280 --- /dev/null +++ b/Task/The-Twelve-Days-of-Christmas/Snobol/the-twelve-days-of-christmas.sno @@ -0,0 +1,40 @@ + DAYS = ARRAY('12') + DAYS<1> = 'first' + DAYS<2> = 'second' + DAYS<3> = 'third' + DAYS<4> = 'fourth' + DAYS<5> = 'fifth' + DAYS<6> = 'sixth' + DAYS<7> = 'seventh' + DAYS<8> = 'eighth' + DAYS<9> = 'ninth' + DAYS<10> = 'tenth' + DAYS<11> = 'eleventh' + DAYS<12> = 'twelfth' + + GIFTS = ARRAY('12') + GIFTS<1> = 'A partridge in a pear tree.' + GIFTS<2> = 'Two turtle doves and' + GIFTS<3> = 'Three French hens,' + GIFTS<4> = 'Four calling birds,' + GIFTS<5> = 'Five gold rings,' + GIFTS<6> = 'Six geese a-laying,' + GIFTS<7> = 'Seven swans a-swimming,' + GIFTS<8> = 'Eight maids a-milking,' + GIFTS<9> = 'Nine ladies dancing,' + GIFTS<10> = 'Ten lords a-leaping,' + GIFTS<11> = 'Eleven pipers piping,' + GIFTS<12> = 'Twelve drummers drumming,' + + DAY = 1 +OUTER LE(DAY,12) :F(END) + INTRO = 'On the NTH day of Christmas, my true love sent to me:' + INTRO 'NTH' = DAYS + OUTPUT = INTRO + GIFT = DAY +INNER GE(GIFT,1) :F(NEXT) + OUTPUT = GIFTS + GIFT = GIFT - 1 :(INNER) +NEXT OUTPUT = '' + DAY = DAY + 1 :(OUTER) +END diff --git a/Task/The-Twelve-Days-of-Christmas/UNIX-Shell/the-twelve-days-of-christmas-1.sh b/Task/The-Twelve-Days-of-Christmas/UNIX-Shell/the-twelve-days-of-christmas-1.sh new file mode 100644 index 0000000000..259bbeefd9 --- /dev/null +++ b/Task/The-Twelve-Days-of-Christmas/UNIX-Shell/the-twelve-days-of-christmas-1.sh @@ -0,0 +1,23 @@ +#!/usr/bin/env bash +ordinals=(first second third fourth fifth sixth + seventh eighth ninth tenth eleventh twelfth) + +gifts=( "A partridge in a pear tree." "Two turtle doves and" + "Three French hens," "Four calling birds," + "Five gold rings," "Six geese a-laying," + "Seven swans a-swimming," "Eight maids a-milking," + "Nine ladies dancing," "Ten lords a-leaping," + "Eleven pipers piping," "Twelve drummers drumming," ) + +echo_gifts() { + local i day=$1 + echo "On the ${ordinals[day]} day of Christmas, my true love sent to me:" + for (( i=day; i >=0; --i )); do + echo "${gifts[i]}" + done + echo +} + +for (( day=0; day < 12; ++day )); do + echo_gifts $day +done diff --git a/Task/The-Twelve-Days-of-Christmas/UNIX-Shell/the-twelve-days-of-christmas-2.sh b/Task/The-Twelve-Days-of-Christmas/UNIX-Shell/the-twelve-days-of-christmas-2.sh new file mode 100644 index 0000000000..ec3ac42f78 --- /dev/null +++ b/Task/The-Twelve-Days-of-Christmas/UNIX-Shell/the-twelve-days-of-christmas-2.sh @@ -0,0 +1,33 @@ +#!/bin/sh +ordinal() { + n=$1 + set first second third fourth fifth sixth \ + seventh eighth ninth tenth eleventh twelfth + shift $n + echo $1 +} + +gift() { + n=$1 + set "A partridge in a pear tree." "Two turtle doves and" \ + "Three French hens," "Four calling birds," \ + "Five gold rings," "Six geese a-laying," \ + "Seven swans a-swimming," "Eight maids a-milking," \ + "Nine ladies dancing," "Ten lords a-leaping," \ + "Eleven pipers piping," "Twelve drummers drumming," + shift $n + echo "$1" +} + +echo_gifts() { + day=$1 + echo "On the `ordinal $day` day of Christmas, my true love sent to me:" + for i in `seq $day 0`; do + gift $i + done + echo +} + +for day in `seq 0 11`; do + echo_gifts $day +done diff --git a/Task/Thieles-interpolation-formula/00DESCRIPTION b/Task/Thieles-interpolation-formula/00DESCRIPTION index 4a36a42157..faa6b1d330 100644 --- a/Task/Thieles-interpolation-formula/00DESCRIPTION +++ b/Task/Thieles-interpolation-formula/00DESCRIPTION @@ -1,20 +1,26 @@ {{Wikipedia|Thiele's interpolation formula}} -'''[[wp:Thiele's_interpolation_formula|Thiele's interpolation formula]]''' is an interpolation formula for a function ''f''(•) of a single variable. It is expressed as a [[continued fraction]]: -: f(x) = f(x_1) + \cfrac{x-x_1}{\rho_1(x_1,x_2) + \cfrac{x-x_2}{\rho_2(x_1,x_2,x_3) - f(x_1) + \cfrac{x-x_3}{\rho_3(x_1,x_2,x_3,x_4) - \rho_1(x_1,x_2) + \cdots}}} +
    +'''[[wp:Thiele's_interpolation_formula|Thiele's interpolation formula]]''' is an interpolation formula for a function ''f''(•) of a single variable.   It is expressed as a [[continued fraction]]: -ρ represents the [[wp:reciprocal difference|reciprocal difference]], demonstrated here for reference: +:: f(x) = f(x_1) + \cfrac{x-x_1}{\rho_1(x_1,x_2) + \cfrac{x-x_2}{\rho_2(x_1,x_2,x_3) - f(x_1) + \cfrac{x-x_3}{\rho_3(x_1,x_2,x_3,x_4) - \rho_1(x_1,x_2) + \cdots}}} -:\rho_1(x_0, x_1) = \frac{x_0 - x_1}{f(x_0) - f(x_1)} +\rho   represents the   [[wp:reciprocal difference|reciprocal difference]],   demonstrated here for reference: -:\rho_2(x_0, x_1, x_2) = \frac{x_0 - x_2}{\rho_1(x_0, x_1) - \rho_1(x_1, x_2)} + f(x_1) +:: \rho_1(x_0, x_1) = \frac{x_0 - x_1}{f(x_0) - f(x_1)} -:\rho_n(x_0,x_1,\ldots,x_n)=\frac{x_0-x_n}{\rho_{n-1}(x_0,x_1,\ldots,x_{n-1})-\rho_{n-1}(x_1,x_2,\ldots,x_n)}+\rho_{n-2}(x_1,\ldots,x_{n-1}) +:: \rho_2(x_0, x_1, x_2) = \frac{x_0 - x_2}{\rho_1(x_0, x_1) - \rho_1(x_1, x_2)} + f(x_1) + +:: \rho_n(x_0,x_1,\ldots,x_n)=\frac{x_0-x_n}{\rho_{n-1}(x_0,x_1,\ldots,x_{n-1})-\rho_{n-1}(x_1,x_2,\ldots,x_n)}+\rho_{n-2}(x_1,\ldots,x_{n-1}) Demonstrate Thiele's interpolation function by: -# Building a 32 row ''trig table'' of values of the trig functions ''sin'', ''cos'' and ''tan''. e.g. '''for''' x '''from''' 0 '''by''' 0.05 '''to''' 1.55... +# Building a   '''32'''   row ''trig table'' of values   for   x   from   '''0'''   by   '''0.05'''   to   '''1.55'''   of the trig functions: +#*   '''sin''' +#*   '''cos''' +#*   '''tan''' # Using columns from this table define an inverse - using Thiele's interpolation - for each trig function; # Finally: demonstrate the following well known trigonometric identities: -#* 6 × sin-1 ½ = π -#* 3 × cos-1 ½ = π -#* 4 × tan-1 1 = π +#*   6 × sin-1 ½ = \pi +#*   3 × cos-1 ½ = \pi +#*   4 × tan-1 1 = \pi +

    diff --git a/Task/Thieles-interpolation-formula/Java/thieles-interpolation-formula.java b/Task/Thieles-interpolation-formula/Java/thieles-interpolation-formula.java new file mode 100644 index 0000000000..2e30ff2741 --- /dev/null +++ b/Task/Thieles-interpolation-formula/Java/thieles-interpolation-formula.java @@ -0,0 +1,55 @@ +import static java.lang.Math.*; + +public class Test { + final static int N = 32; + final static int N2 = (N * (N - 1) / 2); + final static double STEP = 0.05; + + static double[] xval = new double[N]; + static double[] t_sin = new double[N]; + static double[] t_cos = new double[N]; + static double[] t_tan = new double[N]; + + static double[] r_sin = new double[N2]; + static double[] r_cos = new double[N2]; + static double[] r_tan = new double[N2]; + + static double rho(double[] x, double[] y, double[] r, int i, int n) { + if (n < 0) + return 0; + + if (n == 0) + return y[i]; + + int idx = (N - 1 - n) * (N - n) / 2 + i; + if (r[idx] != r[idx]) + r[idx] = (x[i] - x[i + n]) + / (rho(x, y, r, i, n - 1) - rho(x, y, r, i + 1, n - 1)) + + rho(x, y, r, i + 1, n - 2); + + return r[idx]; + } + + static double thiele(double[] x, double[] y, double[] r, double xin, int n) { + if (n > N - 1) + return 1; + return rho(x, y, r, 0, n) - rho(x, y, r, 0, n - 2) + + (xin - x[n]) / thiele(x, y, r, xin, n + 1); + } + + public static void main(String[] args) { + for (int i = 0; i < N; i++) { + xval[i] = i * STEP; + t_sin[i] = sin(xval[i]); + t_cos[i] = cos(xval[i]); + t_tan[i] = t_sin[i] / t_cos[i]; + } + + for (int i = 0; i < N2; i++) + r_sin[i] = r_cos[i] = r_tan[i] = Double.NaN; + + System.out.printf("%16.14f%n", 6 * thiele(t_sin, xval, r_sin, 0.5, 0)); + System.out.printf("%16.14f%n", 3 * thiele(t_cos, xval, r_cos, 0.5, 0)); + System.out.printf("%16.14f%n", 4 * thiele(t_tan, xval, r_tan, 1.0, 0)); + } +} diff --git a/Task/Thieles-interpolation-formula/Perl-6/thieles-interpolation-formula.pl6 b/Task/Thieles-interpolation-formula/Perl-6/thieles-interpolation-formula.pl6 index d8ed6f4512..0c21746564 100644 --- a/Task/Thieles-interpolation-formula/Perl-6/thieles-interpolation-formula.pl6 +++ b/Task/Thieles-interpolation-formula/Perl-6/thieles-interpolation-formula.pl6 @@ -33,7 +33,7 @@ sub mk-inv(&fn, $d, $lim) { return %h; } -sub MAIN($tblsz) { +sub MAIN($tblsz = 12) { my %invsin = mk-inv(&sin, 0.05, $tblsz); my %invcos = mk-inv(&cos, 0.05, $tblsz); my %invtan = mk-inv(&tan, 0.05, $tblsz); diff --git a/Task/Tic-tac-toe/00DESCRIPTION b/Task/Tic-tac-toe/00DESCRIPTION index 85f47898b8..d6d9a86cfa 100644 --- a/Task/Tic-tac-toe/00DESCRIPTION +++ b/Task/Tic-tac-toe/00DESCRIPTION @@ -1,2 +1,12 @@ -Play a game of [[wp:Tic-tac-toe|tic-tac-toe]]. +[[File:Tic_tac_toe.jpg|500px||right]] + +;Task: +Play a game of   [[wp:Tic-tac-toe|tic-tac-toe]]. + + Ensure that legal moves are played and that a winning position is notified. + + +;See: +*   [[http://mathworld.wolfram.com/Tic-Tac-Toe.html Mathworld™, Tic-Tac-Toe game]]. +

    diff --git a/Task/Tic-tac-toe/AWK/tic-tac-toe.awk b/Task/Tic-tac-toe/AWK/tic-tac-toe.awk new file mode 100644 index 0000000000..266891fbd8 --- /dev/null +++ b/Task/Tic-tac-toe/AWK/tic-tac-toe.awk @@ -0,0 +1,113 @@ +# syntax: GAWK -f TIC-TAC-TOE.AWK +BEGIN { + move[12] = "3 7 4 6 8"; move[13] = "2 8 6 4 7"; move[14] = "7 3 2 8 6" + move[16] = "8 2 3 7 4"; move[17] = "4 6 8 2 3"; move[18] = "6 4 7 3 2" + move[19] = "8 2 3 7 4"; move[23] = "1 9 6 4 8"; move[24] = "1 9 3 7 8" + move[25] = "8 3 7 4 0"; move[26] = "3 7 1 9 8"; move[27] = "6 4 1 9 8" + move[28] = "1 9 7 3 4"; move[29] = "4 6 3 7 8"; move[35] = "7 4 6 8 2" + move[45] = "6 7 3 2 0"; move[56] = "4 7 3 2 8"; move[57] = "3 2 8 4 6" + move[58] = "2 3 7 4 6"; move[59] = "3 2 8 4 6" + split("7 4 1 8 5 2 9 6 3",rotate) + n = split("253 280 457 254 257 350 452 453 570 590",special) + i = 0 + while (i < 9) { s[++i] = " " } + print("") + print("You move first, use the keypad:") + board = "\n7 * 8 * 9\n*********\n4 * 5 * 6\n*********\n1 * 2 * 3\n\n? " + printf(board) +} +state < 7 { + x = $0 + if (s[x] != " ") { + printf("? ") + next + } + s[x] = "X" + ++state + print("") + if (state > 1) { + for (i=0; i2 && x!=5; ++r) { x = rotate[x] } + k = x + if (x == 5) { d = 1 } else { d = 5 } +} +state == 2 { + c = 5.5 * (k + x) - 4.5 * abs(k - x) + split(move[c],t) + d = t[1] + e = t[2] + f = t[3] + g = t[4] + h = t[5] +} +state == 3 { + k = x / 2. + c = c * 10 + d = f + if (abs(c-350) == 100) { + if (x != 9) { d = 10 - x } + if (int(k) == k) { g = f } + h = 10 - g + if (x+0 == e+0) { + h = g + g = 9 + } + } + else if (x+0 != e+0) { + d = e + state = 6 + } +} +state == 4 { + if (x+0 == g+0) { + d = h + } + else { + d = g + state = 6 + } + x = 6 + for (i=1; i<=n; ++i) { + b = special[i] + if (b == 254) { x = 4 } + if (k+0 == abs(b-c-k)) { state = x } + } +} +state < 7 { + if (state != 5) { + for (i=0; i<4-r; ++i) { d = rotate[d] } + s[d] = "O" + } + for (b=7; b>0; b-=5) { + printf("%s * %s * %s\n",s[b++],s[b++],s[b]) + if (b > 3) { print("*********") } + } + print("") +} +state < 5 { + printf("? ") +} +state == 5 { + printf("tie game") + state = 7 +} +state == 6 { + printf("you lost") + state = 7 +} +state == 7 { + printf(", play again? ") + ++state + next +} +state == 8 { + if ($1 !~ /^[yY]$/) { exit(0) } + i = 0 + while (i < 9) { s[++i] = " " } + printf(board) + state = 0 +} +function abs(x) { if (x >= 0) { return x } else { return -x } } diff --git a/Task/Tic-tac-toe/BASIC/tic-tac-toe-1.basic b/Task/Tic-tac-toe/BASIC/tic-tac-toe-1.basic new file mode 100644 index 0000000000..8c54c3891c --- /dev/null +++ b/Task/Tic-tac-toe/BASIC/tic-tac-toe-1.basic @@ -0,0 +1,144 @@ +place1 = 1 +place2 = 2 +place3 = 3 +place4 = 4 +place5 = 5 +place6 = 6 +place7 = 7 +place8 = 8 +place9 = 9 +symbol1 = "X" +symbol2 = "O" +reset: +TextWindow.Clear() +TextWindow.Write(place1 + " ") +TextWindow.Write(place2 + " ") +TextWindow.WriteLine(place3 + " ") +TextWindow.Write(place4 + " ") +TextWindow.Write(place5 + " ") +TextWindow.WriteLine(place6 + " ") +TextWindow.Write(place7 + " ") +TextWindow.Write(place8 + " ") +TextWindow.WriteLine(place9 + " ") +TextWindow.WriteLine("Where would you like to go to (choose a number from 1 to 9 and press enter)?") +n = TextWindow.Read() +If n = 1 then + If place1 = symbol1 or place1 = symbol2 then + Goto ai + Else + place1 = symbol1 + EndIf +ElseIf n = 2 then + If place2 = symbol1 or place2 = symbol2 then + Goto ai + Else + place2 = symbol1 + EndIf +ElseIf n = 3 then + If place3 = symbol1 or place3 = symbol2 then + Goto ai + Else + place3 = symbol1 + EndIf +ElseIf n = 4 then + If place4 = symbol1 or place4 = symbol2 then + Goto ai + Else + place4 = symbol1 + EndIf +ElseIf n = 5 then + If place5 = symbol1 or place5 = symbol2 then + Goto ai + Else + place5 = symbol1 + EndIf +ElseIf n = 6 then + If place6 = symbol1 or place6 = symbol2 then + Goto ai + Else + place6 = symbol1 + EndIf +ElseIf n = 7 then + If place8 = symbol1 or place7 = symbol2 then + Goto ai + Else + place7 = symbol1 + EndIf +ElseIf n = 8 then + If place8 = symbol1 or place8 = symbol2 then + Goto ai + Else + place8 = symbol1 + EndIf +ElseIf n = 9 then + If place9 = symbol1 or place9 = symbol2 then + Goto ai + Else + place9 = symbol1 + EndIf +EndIf +Goto ai +ai: +n = Math.GetRandomNumber(9) +If n = 1 then + If place1 = symbol1 or place1 = symbol2 then + Goto ai + Else + place1 = symbol2 + EndIf +ElseIf n = 2 then + If place2 = symbol1 or place2 = symbol2 then + Goto ai + Else + place2 = symbol2 + EndIf +ElseIf n = 3 then + If place3 = symbol1 or place3 = symbol2 then + Goto ai + Else + place3 = symbol2 + EndIf +ElseIf n = 4 then + If place4 = symbol1 or place4 = symbol2 then + Goto ai + Else + place4 = symbol2 + EndIf +ElseIf n = 5 then + If place5 = symbol1 or place5 = symbol2 then + Goto ai + Else + place5 = symbol2 + EndIf +ElseIf n = 6 then + If place6 = symbol1 or place6 = symbol2 then + Goto ai + Else + place6 = symbol2 + EndIf +ElseIf n = 7 then + If place7 = symbol1 or place7 = symbol2 then + Goto ai + Else + place7 = symbol2 + EndIf +ElseIf n = 8 then + If place8 = symbol1 or place8 = symbol2 then + Goto ai + Else + place8 = symbol2 + EndIf +ElseIf n = 9 then + If place9 = symbol1 or place9 = symbol2 then + Goto ai + Else + place9 = symbol2 + EndIf +EndIf +If place1 = symbol1 and place2 = symbol1 and place3 = symbol1 or place4 = symbol1 and place5 = symbol1 and place6 = symbol1 or place7 = symbol1 and place8 = symbol1 and place9 = symbol1 or place1 = symbol1 and place4 = symbol1 and place7 = symbol1 or place2 = symbol1 and place5 = symbol1 and place8 = symbol1 or place3 = symbol1 and place6 = symbol1 and place9 = symbol1 or place1 = symbol1 and place5 = symbol1 and place9 = symbol1 or place3 = symbol1 and place5 = symbol1 and place7 = symbol1 then + TextWindow.WriteLine("Player 1 (" + symbol1 + ") wins!") +ElseIf place1 = symbol2 and place2 = symbol2 and place3 = symbol2 or place4 = symbol2 and place5 = symbol2 and place6 = symbol2 or place7 = symbol2 and place8 = symbol2 and place9 = symbol2 or place1 = symbol2 and place4 = symbol2 and place7 = symbol2 or place2 = symbol2 and place5 = symbol2 and place8 = symbol2 or place3 = symbol2 and place6 = symbol2 and place9 = symbol2 or place1 = symbol2 and place5 = symbol2 and place8 = symbol2 or place3 = symbol2 and place5 = symbol2 and place7 = symbol2 then + TextWindow.WriteLine("Player 2 (" + symbol2 + ") wins!") +Else + Goto reset +EndIf diff --git a/Task/Tic-tac-toe/BASIC/tic-tac-toe-2.basic b/Task/Tic-tac-toe/BASIC/tic-tac-toe-2.basic new file mode 100644 index 0000000000..e69de29bb2 diff --git a/Task/Tic-tac-toe/Batch-File/tic-tac-toe-1.bat b/Task/Tic-tac-toe/Batch-File/tic-tac-toe-1.bat new file mode 100644 index 0000000000..d57a226d33 --- /dev/null +++ b/Task/Tic-tac-toe/Batch-File/tic-tac-toe-1.bat @@ -0,0 +1,48 @@ +@echo off +setlocal enabledelayedexpansion +:newgame +set a1=1 +set a2=2 +set a3=3 +set a4=4 +set a5=5 +set a6=6 +set a7=7 +set a8=8 +set a9=9 +set ll=X +set /a zz=0 +:display1 +cls +echo Player: %ll% +echo %a7%_%a8%_%a9% +echo %a4%_%a5%_%a6% +echo %a1%_%a2%_%a3% +set /p myt=Where would you like to go (choose a number from 1-9 and press enter)? +if !a%myt%! equ %myt% ( +set a%myt%=%ll% +goto check +) +goto display1 +:check +set /a zz=%zz%+1 +if %zz% geq 9 goto newgame +if %a7%+%a8%+%a9% equ %ll%+%ll%+%ll% goto win +if %a4%+%a5%+%a6% equ %ll%+%ll%+%ll% goto win +if %a1%+%a2%+%a3% equ %ll%+%ll%+%ll% goto win +if %a7%+%a5%+%a3% equ %ll%+%ll%+%ll% goto win +if %a1%+%a5%+%a9% equ %ll%+%ll%+%ll% goto win +if %a7%+%a4%+%a1% equ %ll%+%ll%+%ll% goto win +if %a8%+%a5%+%a2% equ %ll%+%ll%+%ll% goto win +if %a9%+%a6%+%a3% equ %ll%+%ll%+%ll% goto win +goto %ll% +:X +set ll=O +goto display1 +:O +set ll=X +goto display1 +:win +echo %ll% wins! +pause +goto newgame diff --git a/Task/Tic-tac-toe/Batch-File/tic-tac-toe-2.bat b/Task/Tic-tac-toe/Batch-File/tic-tac-toe-2.bat new file mode 100644 index 0000000000..153ca65e69 --- /dev/null +++ b/Task/Tic-tac-toe/Batch-File/tic-tac-toe-2.bat @@ -0,0 +1,321 @@ +@ECHO OFF +:BEGIN + REM Skill level + set sl= + cls + echo Tic Tac Toe (Q to quit) + echo. + echo. + echo Pick your skill level (press a number) + echo. + echo (1) Children under 6 + echo (2) Average Mental Case + echo (3) Oversized Ego + CHOICE /c:123q /n > nul + if errorlevel 4 goto end + if errorlevel 3 set sl=3 + if errorlevel 3 goto layout + if errorlevel 2 set sl=2 + if errorlevel 2 goto layout + set sl=1 + +:LAYOUT + REM Player turn ("x" or "o") + set pt= + REM Game winner ("x" or "o") + set gw= + REM No moves + set nm= + REM Set to one blank space after equal sign (check with cursor end) + set t1= + set t2= + set t3= + set t4= + set t5= + set t6= + set t7= + set t8= + set t9= + +:UPDATE + cls + echo (S to set skill level) Tic Tac Toe (Q to quit) + echo. + echo You are the X player. + echo Press the number where you want to put an X. + echo. + echo Skill level %sl% 7 8 9 + echo 4 5 6 + echo 1 2 3 + echo. + echo : : + echo %t1% : %t2% : %t3% + echo ....:...:.... + echo %t4% : %t5% : %t6% + echo ....:...:.... + echo %t7% : %t8% : %t9% + echo : : + if "%gw%"=="x" goto winx2 + if "%gw%"=="o" goto wino2 + if "%nm%"=="0" goto nomoves + +:PLAYER + set pt=x + REM Layout is for keypad. Change CHOICE to "/c:123456789sq /n > nul" + REM for numbers to start at top left (also change user layout above). + CHOICE /c:789456123sq /n > nul + if errorlevel 11 goto end + if errorlevel 10 goto begin + if errorlevel 9 goto 9 + if errorlevel 8 goto 8 + if errorlevel 7 goto 7 + if errorlevel 6 goto 6 + if errorlevel 5 goto 5 + if errorlevel 4 goto 4 + if errorlevel 3 goto 3 + if errorlevel 2 goto 2 + goto 1 + +:1 + REM Check if "x" or "o" already in square. + if "%t1%"=="x" goto player + if "%t1%"=="o" goto player + set t1=x + goto check +:2 + if "%t2%"=="x" goto player + if "%t2%"=="o" goto player + set t2=x + goto check +:3 + if "%t3%"=="x" goto player + if "%t3%"=="o" goto player + set t3=x + goto check +:4 + if "%t4%"=="x" goto player + if "%t4%"=="o" goto player + set t4=x + goto check +:5 + if "%t5%"=="x" goto player + if "%t5%"=="o" goto player + set t5=x + goto check +:6 + if "%t6%"=="x" goto player + if "%t6%"=="o" goto player + set t6=x + goto check +:7 + if "%t7%"=="x" goto player + if "%t7%"=="o" goto player + set t7=x + goto check +:8 + if "%t8%"=="x" goto player + if "%t8%"=="o" goto player + set t8=x + goto check +:9 + if "%t9%"=="x" goto player + if "%t9%"=="o" goto player + set t9=x + goto check + +:COMPUTER + set pt=o + if "%sl%"=="1" goto skill1 + REM (win corner to corner) + if "%t1%"=="o" if "%t3%"=="o" if not "%t2%"=="x" if not "%t2%"=="o" goto c2 + if "%t1%"=="o" if "%t9%"=="o" if not "%t5%"=="x" if not "%t5%"=="o" goto c5 + if "%t1%"=="o" if "%t7%"=="o" if not "%t4%"=="x" if not "%t4%"=="o" goto c4 + if "%t3%"=="o" if "%t7%"=="o" if not "%t5%"=="x" if not "%t5%"=="o" goto c5 + if "%t3%"=="o" if "%t9%"=="o" if not "%t6%"=="x" if not "%t6%"=="o" goto c6 + if "%t9%"=="o" if "%t7%"=="o" if not "%t8%"=="x" if not "%t8%"=="o" goto c8 + REM (win outside middle to outside middle) + if "%t2%"=="o" if "%t8%"=="o" if not "%t5%"=="x" if not "%t5%"=="o" goto c5 + if "%t4%"=="o" if "%t6%"=="o" if not "%t5%"=="x" if not "%t5%"=="o" goto c5 + REM (win all others) + if "%t1%"=="o" if "%t2%"=="o" if not "%t3%"=="x" if not "%t3%"=="o" goto c3 + if "%t1%"=="o" if "%t5%"=="o" if not "%t9%"=="x" if not "%t9%"=="o" goto c9 + if "%t1%"=="o" if "%t4%"=="o" if not "%t7%"=="x" if not "%t7%"=="o" goto c7 + if "%t2%"=="o" if "%t5%"=="o" if not "%t8%"=="x" if not "%t8%"=="o" goto c8 + if "%t3%"=="o" if "%t2%"=="o" if not "%t1%"=="x" if not "%t1%"=="o" goto c1 + if "%t3%"=="o" if "%t5%"=="o" if not "%t7%"=="x" if not "%t7%"=="o" goto c7 + if "%t3%"=="o" if "%t6%"=="o" if not "%t9%"=="x" if not "%t9%"=="o" goto c9 + if "%t4%"=="o" if "%t5%"=="o" if not "%t6%"=="x" if not "%t6%"=="o" goto c6 + if "%t6%"=="o" if "%t5%"=="o" if not "%t4%"=="x" if not "%t4%"=="o" goto c4 + if "%t7%"=="o" if "%t4%"=="o" if not "%t1%"=="x" if not "%t1%"=="o" goto c1 + if "%t7%"=="o" if "%t5%"=="o" if not "%t3%"=="x" if not "%t3%"=="o" goto c3 + if "%t7%"=="o" if "%t8%"=="o" if not "%t9%"=="x" if not "%t9%"=="o" goto c9 + if "%t8%"=="o" if "%t5%"=="o" if not "%t2%"=="x" if not "%t2%"=="o" goto c2 + if "%t9%"=="o" if "%t8%"=="o" if not "%t7%"=="x" if not "%t7%"=="o" goto c7 + if "%t9%"=="o" if "%t5%"=="o" if not "%t1%"=="x" if not "%t1%"=="o" goto c1 + if "%t9%"=="o" if "%t6%"=="o" if not "%t3%"=="x" if not "%t3%"=="o" goto c3 + REM (block general attempts) ----------------------------------------------- + if "%t1%"=="x" if "%t2%"=="x" if not "%t3%"=="x" if not "%t3%"=="o" goto c3 + if "%t1%"=="x" if "%t5%"=="x" if not "%t9%"=="x" if not "%t9%"=="o" goto c9 + if "%t1%"=="x" if "%t4%"=="x" if not "%t7%"=="x" if not "%t7%"=="o" goto c7 + if "%t2%"=="x" if "%t5%"=="x" if not "%t8%"=="x" if not "%t8%"=="o" goto c8 + if "%t3%"=="x" if "%t2%"=="x" if not "%t1%"=="x" if not "%t1%"=="o" goto c1 + if "%t3%"=="x" if "%t5%"=="x" if not "%t7%"=="x" if not "%t7%"=="o" goto c7 + if "%t3%"=="x" if "%t6%"=="x" if not "%t9%"=="x" if not "%t9%"=="o" goto c9 + if "%t4%"=="x" if "%t5%"=="x" if not "%t6%"=="x" if not "%t6%"=="o" goto c6 + if "%t6%"=="x" if "%t5%"=="x" if not "%t4%"=="x" if not "%t4%"=="o" goto c4 + if "%t7%"=="x" if "%t4%"=="x" if not "%t1%"=="x" if not "%t1%"=="o" goto c1 + if "%t7%"=="x" if "%t5%"=="x" if not "%t3%"=="x" if not "%t3%"=="o" goto c3 + if "%t7%"=="x" if "%t8%"=="x" if not "%t9%"=="x" if not "%t9%"=="o" goto c9 + if "%t8%"=="x" if "%t5%"=="x" if not "%t2%"=="x" if not "%t2%"=="o" goto c2 + if "%t9%"=="x" if "%t8%"=="x" if not "%t7%"=="x" if not "%t7%"=="o" goto c7 + if "%t9%"=="x" if "%t5%"=="x" if not "%t1%"=="x" if not "%t1%"=="o" goto c1 + if "%t9%"=="x" if "%t6%"=="x" if not "%t3%"=="x" if not "%t3%"=="o" goto c3 + REM (block obvious corner to corner) + if "%t1%"=="x" if "%t3%"=="x" if not "%t2%"=="x" if not "%t2%"=="o" goto c2 + if "%t1%"=="x" if "%t9%"=="x" if not "%t5%"=="x" if not "%t5%"=="o" goto c5 + if "%t1%"=="x" if "%t7%"=="x" if not "%t4%"=="x" if not "%t4%"=="o" goto c4 + if "%t3%"=="x" if "%t7%"=="x" if not "%t5%"=="x" if not "%t5%"=="o" goto c5 + if "%t3%"=="x" if "%t9%"=="x" if not "%t6%"=="x" if not "%t6%"=="o" goto c6 + if "%t9%"=="x" if "%t7%"=="x" if not "%t8%"=="x" if not "%t8%"=="o" goto c8 + if "%sl%"=="2" goto skill2 + REM (block sneaky corner to corner 2-4, 2-6, etc.) + if "%t2%"=="x" if "%t4%"=="x" if not "%t1%"=="x" if not "%t1%"=="o" goto c1 + if "%t2%"=="x" if "%t6%"=="x" if not "%t3%"=="x" if not "%t3%"=="o" goto c3 + if "%t8%"=="x" if "%t4%"=="x" if not "%t7%"=="x" if not "%t7%"=="o" goto c7 + if "%t8%"=="x" if "%t6%"=="x" if not "%t9%"=="x" if not "%t9%"=="o" goto c9 + REM (block offset corner trap 1-8, 1-6, etc.) + if "%t1%"=="x" if "%t6%"=="x" if not "%t8%"=="x" if not "%t8%"=="o" goto c8 + if "%t1%"=="x" if "%t8%"=="x" if not "%t6%"=="x" if not "%t6%"=="o" goto c6 + if "%t3%"=="x" if "%t8%"=="x" if not "%t4%"=="x" if not "%t4%"=="o" goto c4 + if "%t3%"=="x" if "%t4%"=="x" if not "%t8%"=="x" if not "%t8%"=="o" goto c8 + if "%t9%"=="x" if "%t4%"=="x" if not "%t2%"=="x" if not "%t2%"=="o" goto c2 + if "%t9%"=="x" if "%t2%"=="x" if not "%t4%"=="x" if not "%t4%"=="o" goto c4 + if "%t7%"=="x" if "%t2%"=="x" if not "%t6%"=="x" if not "%t6%"=="o" goto c6 + if "%t7%"=="x" if "%t6%"=="x" if not "%t2%"=="x" if not "%t2%"=="o" goto c2 + +:SKILL2 + REM (block outside middle to outside middle) + if "%t2%"=="x" if "%t8%"=="x" if not "%t5%"=="x" if not "%t5%"=="o" goto c5 + if "%t4%"=="x" if "%t6%"=="x" if not "%t5%"=="x" if not "%t5%"=="o" goto c5 + REM (block 3 corner trap) + if "%t1%"=="x" if "%t9%"=="x" if not "%t2%"=="x" if not "%t2%"=="o" goto c2 + if "%t3%"=="x" if "%t7%"=="x" if not "%t2%"=="x" if not "%t2%"=="o" goto c2 + if "%t1%"=="x" if "%t9%"=="x" if not "%t4%"=="x" if not "%t4%"=="o" goto c4 + if "%t3%"=="x" if "%t7%"=="x" if not "%t4%"=="x" if not "%t4%"=="o" goto c4 + if "%t1%"=="x" if "%t9%"=="x" if not "%t6%"=="x" if not "%t6%"=="o" goto c6 + if "%t3%"=="x" if "%t7%"=="x" if not "%t6%"=="x" if not "%t6%"=="o" goto c6 + if "%t1%"=="x" if "%t9%"=="x" if not "%t8%"=="x" if not "%t8%"=="o" goto c8 + if "%t3%"=="x" if "%t7%"=="x" if not "%t8%"=="x" if not "%t8%"=="o" goto c8 +:SKILL1 + REM (just take a turn) + if not "%t5%"=="x" if not "%t5%"=="o" goto c5 + if not "%t1%"=="x" if not "%t1%"=="o" goto c1 + if not "%t3%"=="x" if not "%t3%"=="o" goto c3 + if not "%t7%"=="x" if not "%t7%"=="o" goto c7 + if not "%t9%"=="x" if not "%t9%"=="o" goto c9 + if not "%t2%"=="x" if not "%t2%"=="o" goto c2 + if not "%t4%"=="x" if not "%t4%"=="o" goto c4 + if not "%t6%"=="x" if not "%t6%"=="o" goto c6 + if not "%t8%"=="x" if not "%t8%"=="o" goto c8 + set nm=0 + goto update + +:C1 + set t1=o + goto check +:C2 + set t2=o + goto check +:C3 + set t3=o + goto check +:C4 + set t4=o + goto check +:C5 + set t5=o + goto check +:C6 + set t6=o + goto check +:C7 + set t7=o + goto check +:C8 + set t8=o + goto check +:C9 + set t9=o + goto check + +:CHECK + if "%t1%"=="x" if "%t2%"=="x" if "%t3%"=="x" goto winx + if "%t4%"=="x" if "%t5%"=="x" if "%t6%"=="x" goto winx + if "%t7%"=="x" if "%t8%"=="x" if "%t9%"=="x" goto winx + if "%t1%"=="x" if "%t4%"=="x" if "%t7%"=="x" goto winx + if "%t2%"=="x" if "%t5%"=="x" if "%t8%"=="x" goto winx + if "%t3%"=="x" if "%t6%"=="x" if "%t9%"=="x" goto winx + if "%t1%"=="x" if "%t5%"=="x" if "%t9%"=="x" goto winx + if "%t3%"=="x" if "%t5%"=="x" if "%t7%"=="x" goto winx + if "%t1%"=="o" if "%t2%"=="o" if "%t3%"=="o" goto wino + if "%t4%"=="o" if "%t5%"=="o" if "%t6%"=="o" goto wino + if "%t7%"=="o" if "%t8%"=="o" if "%t9%"=="o" goto wino + if "%t1%"=="o" if "%t4%"=="o" if "%t7%"=="o" goto wino + if "%t2%"=="o" if "%t5%"=="o" if "%t8%"=="o" goto wino + if "%t3%"=="o" if "%t6%"=="o" if "%t9%"=="o" goto wino + if "%t1%"=="o" if "%t5%"=="o" if "%t9%"=="o" goto wino + if "%t3%"=="o" if "%t5%"=="o" if "%t7%"=="o" goto wino + if "%pt%"=="x" goto computer + if "%pt%"=="o" goto update + +:WINX + set gw=x + goto update +:WINX2 + echo You win! + echo Play again (Y,N)? + CHOICE /c:ynsq /n > nul + if errorlevel 4 goto end + if errorlevel 3 goto begin + if errorlevel 2 goto end + goto layout + +:WINO + set gw=o + goto update +:WINO2 + echo Sorry, You lose. + echo Play again (Y,N)? + CHOICE /c:ynsq /n > nul + if errorlevel 4 goto end + if errorlevel 3 goto begin + if errorlevel 2 goto end + goto layout + +:NOMOVES + echo There are no more moves left! + echo Play again (Y,N)? + CHOICE /c:ynsq /n > nul + if errorlevel 4 goto end + if errorlevel 3 goto begin + if errorlevel 2 goto end + goto layout + +:END + cls + echo Tic Tac Toe + echo. + REM Clear all variables (no spaces after equal sign). + set gw= + set nm= + set sl= + set pt= + set t1= + set t2= + set t3= + set t4= + set t5= + set t6= + set t7= + set t8= + set t9= diff --git a/Task/Tic-tac-toe/Batch-File/tic-tac-toe.bat b/Task/Tic-tac-toe/Batch-File/tic-tac-toe.bat deleted file mode 100644 index 0734d289da..0000000000 --- a/Task/Tic-tac-toe/Batch-File/tic-tac-toe.bat +++ /dev/null @@ -1,136 +0,0 @@ -:: -::Tic-Tac-Toe Task from Rosetta Code Wiki -::Batch File Implementation -:: -::Directly OPEN the Batch File to play. -:: - -@echo off -title Sample TicTacToe Game -mode con cols=50 lines=21 -setlocal enabledelayedexpansion - -set win=a1a2a3 a4a5a6 a7a8a9 a1a4a7 a2a5a8 a3a6a9 a1a5a9 a3a5a7 - -:begin -set blanks=123456789&set numblanks=9 -for /l %%. in (1,1,9) do set "a%%.= " - -set /a rnd=%random%%%2 -if %rnd%==1 set msg=YOU will move first.&goto :youmove -set msg=CPU will move first.&goto :rndmove - -:youmove -cls -call :display -echo Your Turn: -set "move=" -for /F "usebackq delims=" %%L in (`xcopy /L /w "%~f0" "%~f0" 2^>NUL`) do ( - if not defined move set "move=%%L" -) -set move=!move:~-1! -for /l %%. in (1,1,9) do if "!move!"=="%%." goto :preproc -if /i "!move!"=="n" goto :begin -if /i "!move!"=="o" exit -set msg=Invalid Input. -goto youmove - -:preproc -if "!a%move%!"=="X" (set msg=An X is already There.&goto youmove) -if "!a%move%!"=="O" (set msg=An O is already There.&goto youmove) - -set a%move%=O -set /a numblanks-=1&set blanks=!blanks:%move%=! -call :ifdraw - -for %%. in (%win%) do ( - set comb=%%. - call :mainproc1 -) -set block=0 -for %%. in (%win%) do ( - if !block!==0 ( - set comb=%%. - call :mainproc2 - ) -) -if %block%==1 ( - set /a numblanks-=1&set blanks=!blanks:%remove%=! - set msg=CPU Puts an X on Grid %remove%. - call :ifdraw - goto youmove -) -goto rndmove - - -:mainproc1 -if "!%comb:~0,2%!!%comb:~2,2%!!%comb:~4,2%!"=="OOO" (set msg=You Win^^!&goto res) - -if "!%comb:~0,2%!!%comb:~2,2%!!%comb:~4,2%!"=="XX " ( - set %comb:~4,2%=X&set msg=CPU Wins^^! - goto res -) -if "!%comb:~0,2%!!%comb:~2,2%!!%comb:~4,2%!"=="X X" ( - set %comb:~2,2%=X&set msg=CPU Wins^^! - goto res -) -if "!%comb:~0,2%!!%comb:~2,2%!!%comb:~4,2%!"==" XX" ( - set %comb:~0,2%=X&set msg=CPU Wins^^! - goto res -) -goto :EOF - -:mainproc2 -if "!%comb:~0,2%!!%comb:~2,2%!!%comb:~4,2%!"=="OO " ( - set %comb:~4,2%=X&set remove=%comb:~5,1% - set block=1 -) -if "!%comb:~0,2%!!%comb:~2,2%!!%comb:~4,2%!"=="O O" ( - set %comb:~2,2%=X&set remove=%comb:~3,1% - set block=1 -) -if "!%comb:~0,2%!!%comb:~2,2%!!%comb:~4,2%!"==" OO" ( - set %comb:~0,2%=X&set remove=%comb:~1,1% - set block=1 -) -goto :EOF - -:ifdraw -if %numblanks%==0 (set msg=Game Draw.&goto res) -goto :EOF - -:rndmove -set /a rnd=(%random%%%%numblanks%) -set bla=!blanks:~%rnd%,1! -set a%bla%=X -set /a numblanks-=1&set blanks=!blanks:%bla%=! -if not %numblanks%==8 (set msg=CPU Puts an X on Grid %bla%.) -call :ifdraw -goto youmove - -:res -cls -call :display -echo Press any char key to play again. -pause>nul -goto begin - -:display -echo. -echo Tic-Tac-Toe (Man VS CPU) -echo Batch File Implementation -echo. -echo. -echo Gameboard Press: -echo. -echo +---+---+---+ N - New Game -echo 1-3 ^| %a1% ^| %a2% ^| %a3% ^| O - Exit -echo +---+---+---+ -echo 4-6 ^| %a4% ^| %a5% ^| %a6% ^| -echo +---+---+---+ You - O -echo 7-9 ^| %a7% ^| %a8% ^| %a9% ^| CPU - X -echo +---+---+---+ -echo. -echo Message: !msg! -echo. -goto :EOF diff --git a/Task/Tic-tac-toe/REXX/tic-tac-toe.rexx b/Task/Tic-tac-toe/REXX/tic-tac-toe.rexx index f2d0f5a992..0ba522c693 100644 --- a/Task/Tic-tac-toe/REXX/tic-tac-toe.rexx +++ b/Task/Tic-tac-toe/REXX/tic-tac-toe.rexx @@ -1,105 +1,111 @@ -/*REXX program plays (with a human) the tic-tac-toe game on an NxN grid.*/ -$=copies('─',9) /*eyecatcher literal for messages*/ -oops =$ '***error!*** '; cell# ='cell number' /*a couple of literals*/ -sing='│─┼'; jam='║'; bar='═'; junc='╬'; dbl=jam || bar || junc -sw=linesize()-1 /*get the width of the terminal. */ -parse arg N hm cm .,@.; if N=='' then N=3; oN=N /*specifying some args?*/ -N=abs(N); NN=N*N; middle=NN%2+N%2 /*if N < 0, computer goes first.*/ -if N<2 then do; say oops 'tic-tac-toe grid is too small: ' N; exit; end -pad=copies(left('',sw%NN),1+(N<5)) /*display padding: 6x6 in 80 cols*/ -if hm=='' then hm='X'; if cm=='' then cm='O' /*markers: Human, Computer*/ -hm=aChar(hm,'human'); cm=aChar(cm,'computer') /*process the markers.*/ -if hm==cm then cm='X' /*Human wants the "O"? Sheesh! */ -if oN<0 then call Hmove middle /*comp moves 1st? Choose middling*/ - else call showGrid /*···also checks for wins & draws*/ - do forever /*'til the cows come home, by gum*/ - call CBLF /*do carbon-based lifeform's move*/ - call Hal /*figure Hal the computer's move.*/ - end /*forever····showGrid does wins & draws*/ -/*──────────────────────────────────ACHAR subroutine────────────────────*/ -aChar: parse arg x; L=length(x) /*process markers.*/ -if L==1 then return x /*1 char, as is. */ -if L==2 & datatype(x,'X') then return x2c(x) /*2 chars, hex. */ -if L==3 & datatype(x,'W') then return d2c(x) /*3 chars, decimal*/ -say oops 'illegal character or character code for' arg(2) "marker: " x -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────CBLF subroutine─────────────────────*/ -CBLF: prompt='Please enter a' cell# "to place your next marker ["hm'] (or Quit):' - do forever; say $ prompt; parse pull x 1 ux 1 ox; upper ux - if datatype(ox,'W') then ox=ox/1 /*maybe normalize cell#: +0007. */ - select - when abbrev('QUIT',ux,1) then call tell 'quitting.' - when x='' then iterate /*Nada? Try again.*/ - when words(x)\==1 then say oops "too many" cell# 'specified:' x - when \datatype(x,'N') then say oops cell# "isn't numeric: " x - when \datatype(x,'W') then say oops cell# "isn't an integer: " x - when x=0 then say oops cell# "can't be zero: " x - when x<0 then say oops cell# "can't be negative: " x - when x>NN then say oops cell# "can't exceed " NN - when @.ox\=='' then say oops cell# "is already occupied: " x - otherwise leave /*do forever*/ - end /*select*/ - end /*forever*/ -@.ox=hm /*place a marker for the human.*/ -call showGrid /*and show the tic-tac-toe grid.*/ -return -/*──────────────────────────────────Hal subroutine──────────────────────*/ -Hal: select /*Hal will try various moves. */ - when win(cm,N-1) then call Hmove ,ec /* winning move? */ - when win(hm,N-1) then call Hmove ,ec /* blocking move? */ - when @.middle=='' then call Hmove middle /* center move. */ - when @.N.N=='' then call Hmove ,N N /*bR corner move. */ - when @.N.1=='' then call Hmove ,N 1 /*bL corner move. */ - when @.1.N=='' then call Hmove ,1 N /*tR corner move. */ - when @.1.1=='' then call Hmove ,1 1 /*tL corner move. */ - otherwise call Hmove ,ac /*some blank cell.*/ - end /*select*/ -return -/*──────────────────────────────────HMOVE subroutine────────────────────*/ -Hmove: parse arg Hplace,dr dc; if Hplace=='' then Hplace = (dr-1)*N + dc -@.Hplace=cm /*put marker for Hal the computer*/ -say; say $ 'computer places a marker ['cm"] at cell number " Hplace -call showGrid -return -/*──────────────────────────────────SHOWGRID subroutine─────────────────*/ -showGrid: _=0; open=0; cW=5; cH=3 /*cell width, cell height.*/ -do r=1 for N; do c=1 for N; _=_+1; @.r.c=@._; open=open|@._==''; end; end -say; z=0 /* [↑] create grid coörds.*/ - do j=1 for N /* [↓] show grids&markers.*/ - do t=1 for cH; _=; __= /*mk is a marker in a cell*/ - do k=1 for N; if t==2 then z=z+1; mk=; c#= - if t==2 then do; mk=@.z; c#=z; end /*c# is cell#*/ - _= _||jam||center(mk,cW); __= __||jam||center(c#,cW) - end /*k*/ - say pad substr(_,2) pad translate(substr(__,2), sing,dbl) - end /*t*/ - if j==N then leave; _= - do b=1 for N; _=_||junc||copies(bar,cW); end /*b*/ - say pad substr(_,2) pad translate(substr(_,2),sing,dbl) - end /*j*/ -say -if win(hm) then call tell 'You ('hm") won!" -if win(cm) then call tell 'The computer ('cm") won." -if \open then call tell 'This tic-tac-toe is a draw.' -return -/*──────────────────────────────────TELL subroutine─────────────────────*/ -tell: do 4; say; end; say center(' 'arg(1)" ",sw,'─'); do 5; say; end -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────WIN subroutine──────────────────────*/ -win: parse arg wm,w; if w=='' then w=N /*see if there are W # of markers*/ -ac=; do r=1 for N; _=0; ec= /*see if any rows are a winner.*/ - do c=1 for N; _=_+ (@.r.c==wm); if @.r.c=='' then ec=r c; end - if ec\=='' then @c=ec; if _==N | (_>=w & ec\=='') then return 1 - end /*r*/ /*if w=N-1, checking for near win*/ - do c=1 for N; _=0; ec= /*see if any cols are a winner.*/ - do r=1 for N; _=_+ (@.r.c==wm); if @.r.c=='' then ec=r c; end - if ec\=='' then @c=ec; if _==N | (_>=w & ec\=='') then return 1 - end /*r*/ /*EC is a r,c version of cell #*/ -_=0; ec= /*see if winning descending diag.*/ - do d=1 for N; _=_+ (@.d.d==wm); if @.d.d=='' then ec=d d; end -if _==N | (_>=w & ec\=='') then return 1 -_=0; ec=; r=0 /*see if winning ascending diag.*/ - do c=N for N by -1; r=r+1; _=_+ (@.r.c==wm); if @.r.c=='' then ec=r c - end /*r*/ -if _==N | (_>=w & ec\=='') then return 1 -return 0 +/*REXX program plays (with a human) the tic─tac─toe game on an NxN grid. */ +$=copies('─', 9) /*eyecatcher literal for error messages*/ +oops =$ '***error*** '; cell@ ="cell number" /*a couple of literals for some SAYs. */ +sing='│─┼'; jam="║"; bar='═'; junc="╬"; dbl=jam || bar || junc +sw=linesize() - 1 /*obtain width of the terminal (less 1)*/ +parse arg N hm cm .,@. /*obtain optional arguments from the CL*/ +if N=='' | N=="," then N=3; oN=N /*N not specified? Then use default.*/ +N=abs(N); NN=N*N; middle=NN%2+N%2 /*if N < 0, then computer goes first. */ +if N<2 then do; say oops 'tic─tac─toe grid is too small: ' N; exit; end +pad=left('', sw%NN) /*display padding: 6x6 in 80 columns.*/ +if hm=='' then hm="X"; if cm=='' then cm="O" /*define the markers: Human, computer*/ +hm=aChar(hm,'human'); cm=aChar(cm,'computer') /*process/define markers for players. */ +parse upper value hm cm with uh uc /*use uppercase values is markers: X x*/ +if uh==uc then cm=word('O X', 1 + (uh=="O") ) /*The human wants Hal's marker? Swap. */ +if oN<0 then call Hmove middle /*Hal moves first? Then choose middling*/ + else call showGrid /*showGrid also checks for wins & draws*/ + do forever /*'til the cows come home (or QUIT). */ + call CBLF /*process carbon-based lifeform's move.*/ + call Hal /*determine Hal's (the computer) move.*/ + end /*forever*/ /*showGrid subroutine does wins & draws*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +ab: parse arg bx; if bx\==' ' then return bx /*test if the marker isn't a blank.*/ + say oops 'character code for' whoseX "marker can't be a blank." + exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +aChar: parse arg x,whoseX; L=length(x) /*process markers.*/ + if L==1 then return ab(x) /*1 char, as is. */ + if L==2 & datatype(x,'X') then return ab(x2c(x)) /*2 chars, hex. */ + if L==3 & datatype(x,'W') then return ab(d2c(x)) /*3 chars, decimal*/ + say oops 'illegal character or character code for' whoseX "marker: " x + exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +CBLF : prompt='Please enter a' cell@ "to place your next marker ["hm'] (or Quit):' + do forever; say $ prompt; parse pull x 1 ux 1 ox; upper ux + if datatype(ox,'W') then ox=ox/1 /*maybe normalize cell number: +0007. */ + select + when abbrev('QUIT',ux,1) then call tell 'quitting.' + when x='' then iterate /*Nada? Try again.*/ + when words(x)\==1 then say oops "too many" cell# 'specified:' x + when \datatype(x,'N') then say oops cell@ "isn't numeric: " x + when \datatype(x,'W') then say oops cell@ "isn't an integer: " x + when x=0 then say oops cell@ "can't be zero: " x + when x<0 then say oops cell@ "can't be negative: " x + when x>NN then say oops cell@ "can't exceed " NN + when @.ox\=='' then say oops cell@ "is already occupied: " x + otherwise leave /*forever*/ + end /*select*/ + end /*forever*/ + @.ox=hm /*place a marker for the human (CLBF). */ + call showGrid /*and display the tic─tac─toe grid. */ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +Hal: select /*Hal tries various moves. */ + when win(cm,N-1) then call Hmove , ec /*is this the winning move?*/ + when win(hm,N-1) then call Hmove , ec /* " " a blocking " */ + when @.middle=='' then call Hmove middle /*pick the center move. */ + when @.N.N=='' then call Hmove , N N /*bottom right corner move.*/ + when @.N.1=='' then call Hmove , N 1 /* " left " " */ + when @.1.N=='' then call Hmove , 1 N /* top right " " */ + when @.1.1=='' then call Hmove , 1 1 /* " left " " */ + otherwise call Hmove , ac /*pick a blank cell " */ + end /*select*/ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +Hmove: parse arg Hplace,dr dc; if Hplace=='' then Hplace = (dr-1)*N + dc + @.Hplace=cm /*place computer's marker. */ + say; say $ 'computer places a marker ['cm"] at" cell@ ' ' Hplace + call showGrid + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +showGrid: _=0; open=0; cW=5; cH=3 /*cell width, cell height.*/ + do r=1 for N; do c=1 for N; _=_+1; @.r.c=@._; open=open|@._==''; end + end /*r*/ + say /* [↑] create grid coörds.*/ + z=0; do j=1 for N /* [↓] show grids&markers.*/ + do t=1 for cH; _=; __= /*MK is a marker in a cell.*/ + do k=1 for N; if t==2 then z=z+1; mk=; c#= + if t==2 then do; mk=@.z; c#=z; end /*c# is cell number*/ + _= _||jam||center(mk,cW); __= __ || jam || center(c#, cW) + end /*k*/ + say pad substr(_,2) pad translate(substr(__,2), sing,dbl) + end /*t*/ + if j==N then leave; _= + do b=1 for N; _=_ || junc || copies(bar, cW); end /*b*/ + say pad substr(_,2) pad translate(substr(_,2), sing, dbl) + end /*j*/ + say + if win(hm) then call tell 'You ('hm") won!" + if win(cm) then call tell 'The computer ('cm") won." + if \open then call tell 'This tic─tac─toe game is a draw.' + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +tell: do 4; say; end; say center(' 'arg(1)" ", sw, '─'); do 5; say; end; exit +/*──────────────────────────────────────────────────────────────────────────────────────*/ +win: parse arg wm,w; if w=='' then w=N /*see if there are W of markers*/ + ac=; do r=1 for N; _=0; ec= /*see if any rows are a winner*/ + do c=1 for N; _=_+ (@.r.c==wm); if @.r.c=='' then ec=r c; end + if ec\=='' then ac=ec; if _==N | (_>=w & ec\=='') then return 1 + end /*r*/ /*w=N-1? Checking for near win*/ + do c=1 for N; _=0; ec= /*see if any cols are a winner*/ + do r=1 for N; _=_+ (@.r.c==wm); if @.r.c=='' then ec=r c; end + if ec\=='' then ac=ec; if _==N | (_>=w & ec\=='') then return 1 + end /*r*/ /*EC is a R,C version of cell #*/ + _=0; ec= /*A winning descending diag. ? */ + do d=1 for N; _=_+ (@.d.d==wm); if @.d.d=='' then ec=d d; end + if _==N | (_>=w & ec\=='') then return 1 + _=0; ec=; r=0 /*A winning ascending diagonal?*/ + do c=N for N by -1; r=r+1; _=_+ (@.r.c==wm); if @.r.c=='' then ec=r c + end /*r*/ + if _==N | (_>=w & ec\=='') then return 1 + return 0 diff --git a/Task/Time-a-function/00DESCRIPTION b/Task/Time-a-function/00DESCRIPTION index 293e8a978c..7842202d62 100644 --- a/Task/Time-a-function/00DESCRIPTION +++ b/Task/Time-a-function/00DESCRIPTION @@ -2,6 +2,7 @@ {{omit from|GUISS}} {{omit from|ML/I}} +;Task: Write a program which uses a timer (with the least granularity available on your system) to time how long a function takes to execute. @@ -11,3 +12,4 @@ between start and finish, which could include time used by other processes on the computer. This task is intended as a subtask for [[Measure relative performance of sorting algorithms implementations]]. +

    diff --git a/Task/Time-a-function/Batch-File/time-a-function.bat b/Task/Time-a-function/Batch-File/time-a-function.bat new file mode 100644 index 0000000000..8ed80f1a11 --- /dev/null +++ b/Task/Time-a-function/Batch-File/time-a-function.bat @@ -0,0 +1,22 @@ +@echo off +Setlocal EnableDelayedExpansion + +call :clock + +::timed function:fibonacci series..................................... +set /a a=0 ,b=1,c=1 +:loop +if %c% lss 2000000000 echo %c% & set /a c=a+b,a=b, b=c & goto loop +::.................................................................... + +call :clock + +echo Function executed in %timed% hundredths of second +goto:eof + +:clock +if not defined timed set timed=0 +for /F "tokens=1-4 delims=:.," %%a in ("%time%") do ( +set /A timed = "(((1%%a - 100) * 60 + (1%%b - 100)) * 60 + (1%%c - 100)) * 100 + (1%%d - 100)- %timed%" +) +goto:eof diff --git a/Task/Time-a-function/Go/time-a-function-3.go b/Task/Time-a-function/Go/time-a-function-3.go index 465bffd2f5..6ebb340b32 100644 --- a/Task/Time-a-function/Go/time-a-function-3.go +++ b/Task/Time-a-function/Go/time-a-function-3.go @@ -2,24 +2,30 @@ package main import ( "fmt" - "time" + "testing" ) -func from(t0 time.Time) { - fmt.Println(time.Now().Sub(t0)) -} - -func empty() { - defer from(time.Now()) -} +func empty() {} func count() { - defer from(time.Now()) for i := 0; i < 1e6; i++ { } } func main() { - empty() - count() + e := testing.Benchmark(func(b *testing.B) { + for i := 0; i < b.N; i++ { + empty() + } + }) + c := testing.Benchmark(func(b *testing.B) { + for i := 0; i < b.N; i++ { + count() + } + }) + fmt.Println("Empty function: ", e) + fmt.Println("Count to a million:", c) + fmt.Println() + fmt.Printf("Empty: %12.4f\n", float64(e.T.Nanoseconds())/float64(e.N)) + fmt.Printf("Count: %12.4f\n", float64(c.T.Nanoseconds())/float64(c.N)) } diff --git a/Task/Time-a-function/Go/time-a-function-4.go b/Task/Time-a-function/Go/time-a-function-4.go new file mode 100644 index 0000000000..465bffd2f5 --- /dev/null +++ b/Task/Time-a-function/Go/time-a-function-4.go @@ -0,0 +1,25 @@ +package main + +import ( + "fmt" + "time" +) + +func from(t0 time.Time) { + fmt.Println(time.Now().Sub(t0)) +} + +func empty() { + defer from(time.Now()) +} + +func count() { + defer from(time.Now()) + for i := 0; i < 1e6; i++ { + } +} + +func main() { + empty() + count() +} diff --git a/Task/Time-a-function/J/time-a-function.j b/Task/Time-a-function/J/time-a-function.j index 11c732ef6f..a09ab52b6d 100644 --- a/Task/Time-a-function/J/time-a-function.j +++ b/Task/Time-a-function/J/time-a-function.j @@ -1,2 +1,4 @@ - (6!:2,7!:2) '|: 50 50 50 $ i. 50^3' -0.00387912 1.57414e6 + (6!:2 , 7!:2) '|: 50 50 50 $ i. 50^3' +0.00488008 3.14829e6 + timespacex '|: 50 50 50 $ i. 50^3' +0.00388519 3.14829e6 diff --git a/Task/Time-a-function/Maple/time-a-function-1.maple b/Task/Time-a-function/Maple/time-a-function-1.maple new file mode 100644 index 0000000000..f0e2742ddf --- /dev/null +++ b/Task/Time-a-function/Maple/time-a-function-1.maple @@ -0,0 +1 @@ +CodeTools:-Usage(ifactor(32!+1), output = realtime, quiet); diff --git a/Task/Time-a-function/Maple/time-a-function-2.maple b/Task/Time-a-function/Maple/time-a-function-2.maple new file mode 100644 index 0000000000..9bd7e8f6df --- /dev/null +++ b/Task/Time-a-function/Maple/time-a-function-2.maple @@ -0,0 +1 @@ +CodeTools:-Usage(ifactor(32!+1), output = cputime, quiet); diff --git a/Task/Time-a-function/PARI-GP/time-a-function.pari b/Task/Time-a-function/PARI-GP/time-a-function-1.pari similarity index 58% rename from Task/Time-a-function/PARI-GP/time-a-function.pari rename to Task/Time-a-function/PARI-GP/time-a-function-1.pari index 832479f868..cefd30b46a 100644 --- a/Task/Time-a-function/PARI-GP/time-a-function.pari +++ b/Task/Time-a-function/PARI-GP/time-a-function-1.pari @@ -1,4 +1,4 @@ time(foo)={ foo(); - gettime() -}; + gettime(); +} diff --git a/Task/Time-a-function/PARI-GP/time-a-function-2.pari b/Task/Time-a-function/PARI-GP/time-a-function-2.pari new file mode 100644 index 0000000000..f349b45904 --- /dev/null +++ b/Task/Time-a-function/PARI-GP/time-a-function-2.pari @@ -0,0 +1,5 @@ +time(foo)={ + my(start=getabstime()); + foo(); + getabstime()-start; +} diff --git a/Task/Time-a-function/REXX/time-a-function-1.rexx b/Task/Time-a-function/REXX/time-a-function-1.rexx index 60171daeeb..0e752fd011 100644 --- a/Task/Time-a-function/REXX/time-a-function-1.rexx +++ b/Task/Time-a-function/REXX/time-a-function-1.rexx @@ -1,31 +1,27 @@ -/*REXX program to show the elapsed time for a function (or subroutine). */ -arg times . /*get the arg from command line. */ -if times=='' then times=100000 /*any specified? No, use default*/ +/*REXX program displays the elapsed time for a REXX function (or subroutine). */ +arg reps . /*obtain an optional argument from C.L.*/ +if reps=='' then reps=100000 /*Not specified? No, then use default.*/ +call time 'Reset' /*only the 1st character is examined. */ +junk = silly(reps) /*invoke the SILLY function (below). */ + /*───► CALL SILLY REPS also works.*/ -call time 'R' /*only 1st character is examined.*/ -call time 'reset' /*this verbose version also works*/ -call time 'rompishness' /*and yet another example. */ - -junk = silly(times) /*invoke the SILLY function. */ - /* CALL SILLY TIMES also works.*/ - - /*The E is for elapsed time.*/ - /* │ */ - /* ┌────────┘ */ - /* │ */ - /* ↓ */ -say 'function SILLY took' format(time("E"),,2) 'seconds for' times "iterations." - /* ↑ */ - /* │ */ - /* ┌────────────────┘ */ - /* │ */ - /* The above 2 for the FORMAT function displays the time */ - /* with 2 decimal digits (past the decimal point). Using */ - /* a 0 (zero) would round the time to whole seconds. */ -exit -/*──────────────────────────────────SILLY subroutine────────────────────*/ -silly: procedure /*chew up some CPU time doing some silly stuff.*/ - do j=1 for arg(1) /*wash, apply, lather, rinse, repeat. ... */ - a.j=random() date() time() digits() fuzz() form() xrange() queued() - end /*j*/ -return j-1 + /* The E is for elapsed time.*/ + /* │ ─ */ + /* ┌────◄───┘ */ + /* │ */ + /* ↓ */ +say 'function SILLY took' format(time("E"),,2) 'seconds for' reps "iterations." + /* ↑ */ + /* │ */ + /* ┌────────►───────┘ */ + /* │ */ + /* The above 2 for the FORMAT function displays the time with*/ + /* two decimal digits (rounded) past the decimal point). Using */ + /* a 0 (zero) would round the time to whole seconds. */ +exit /*stick a fork in it, we're all done. */ +/*────────────────────────────────────────────────────────────────────────────*/ +silly: procedure /*chew up some CPU time doing some silly stuff.*/ + do j=1 for arg(1) /*wash, apply, lather, rinse, repeat. ··· */ + @.j=random() date() time() digits() fuzz() form() xrange() queued() + end /*j*/ + return j-1 diff --git a/Task/Time-a-function/REXX/time-a-function-2.rexx b/Task/Time-a-function/REXX/time-a-function-2.rexx index e857af69b7..4d8817660a 100644 --- a/Task/Time-a-function/REXX/time-a-function-2.rexx +++ b/Task/Time-a-function/REXX/time-a-function-2.rexx @@ -1,26 +1,27 @@ -/*REXX program shows the CPU time used for a REXX pgm since it started. */ -arg times . /*get the arg from command line. */ -if times=='' then times=100000 /*any specified? No, use default*/ -junk = silly(times) /*invoke the SILLY function. */ - /* CALL SILLY TIMES also works.*/ +/*REXX program displays the elapsed time for a REXX function (or subroutine). */ +arg reps . /*obtain an optional argument from C.L.*/ +if reps=='' then reps=100000 /*Not specified? No, then use default.*/ +call time 'Reset' /*only the 1st character is examined. */ +junk = silly(reps) /*invoke the SILLY function (below). */ + /*───► CALL SILLY REPS also works.*/ - /*The J is for time used by */ - /* │ the REXX program */ - /* ┌────────┘ since it started, */ - /* │ this is a Regina extension. */ - /* ↓ */ -say 'function SILLY took' format(time("J"),,2) 'seconds for' times "iterations." - /* ↑ */ - /* │ */ - /* ┌────────────────┘ */ - /* │ */ - /* The above 2 for the FORMAT function displays the time */ - /* with 2 decimal digits (past the decimal point). Using */ - /* a 0 (zero) would round the time to whole seconds. */ -exit -/*──────────────────────────────────SILLY subroutine────────────────────*/ -silly: procedure /*chew up some CPU time doing some silly stuff.*/ - do j=1 for arg(1) /*wash, apply, lather, rinse, repeat. ... */ - a.j=random() date() time() digits() fuzz() form() xrange() queued() - end /*j*/ -return j-1 + /* The J is for the CPU time used */ + /* │ by the REXX program since */ + /* ┌───────┘ since the time was RESET. */ + /* │ This is a Regina extension.*/ + /* ↓ */ +say 'function SILLY took' format(time("J"),,2) 'seconds for' reps "iterations." + /* ↑ */ + /* │ */ + /* ┌────────►───────┘ */ + /* │ */ + /* The above 2 for the FORMAT function displays the time with*/ + /* two decimal digits (rounded) past the decimal point). Using */ + /* a 0 (zero) would round the time to whole seconds. */ +exit /*stick a fork in it, we're all done. */ +/*────────────────────────────────────────────────────────────────────────────*/ +silly: procedure /*chew up some CPU time doing some silly stuff.*/ + do j=1 for arg(1) /*wash, apply, lather, rinse, repeat. ··· */ + @.j=random() date() time() digits() fuzz() form() xrange() queued() + end /*j*/ + return j-1 diff --git a/Task/Tokenize-a-string/00DESCRIPTION b/Task/Tokenize-a-string/00DESCRIPTION index 83b4048a35..fb0bf9d541 100644 --- a/Task/Tokenize-a-string/00DESCRIPTION +++ b/Task/Tokenize-a-string/00DESCRIPTION @@ -1,5 +1,6 @@ Separate the string "Hello,How,Are,You,Today" by commas into an array (or list) so that each element of it stores a different word. -Display the words to the 'user', in the simplest manner possible, separated by a period. +Display the words to the 'user', in the simplest manner possible, +separated by a period. To simplify, you may display a trailing period. '''''Related tasks:''''' diff --git a/Task/Tokenize-a-string/00META.yaml b/Task/Tokenize-a-string/00META.yaml index ae625822b7..5b111c2df1 100644 --- a/Task/Tokenize-a-string/00META.yaml +++ b/Task/Tokenize-a-string/00META.yaml @@ -1,2 +1,4 @@ --- +category: +- Simple note: String manipulation diff --git a/Task/Tokenize-a-string/AppleScript/tokenize-a-string.applescript b/Task/Tokenize-a-string/AppleScript/tokenize-a-string.applescript new file mode 100644 index 0000000000..9d635360b9 --- /dev/null +++ b/Task/Tokenize-a-string/AppleScript/tokenize-a-string.applescript @@ -0,0 +1,20 @@ +on run {} + intercalate(".", splitOn(",", "Hello,How,Are,You,Today")) +end run + + +-- splitOn :: String -> String -> [String] +on splitOn(strDelim, strMain) + set {dlm, my text item delimiters} to {my text item delimiters, strDelim} + set lstParts to text items of strMain + set my text item delimiters to dlm + return lstParts +end splitOn + +-- intercalate :: String -> [String] -> String +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate diff --git a/Task/Tokenize-a-string/COBOL/tokenize-a-string.cobol b/Task/Tokenize-a-string/COBOL/tokenize-a-string.cobol new file mode 100644 index 0000000000..6fec3a503f --- /dev/null +++ b/Task/Tokenize-a-string/COBOL/tokenize-a-string.cobol @@ -0,0 +1,30 @@ + identification division. + program-id. tokenize. + + environment division. + configuration section. + repository. + function all intrinsic. + + data division. + working-storage section. + 01 period constant as ".". + 01 cmma constant as ",". + + 01 start-with. + 05 value "Hello,How,Are,You,Today". + + 01 items. + 05 item pic x(6) occurs 5 times. + + procedure division. + tokenize-main. + unstring start-with delimited by cmma + into item(1) item(2) item(3) item(4) item(5) + + display trim(item(1)) period trim(item(2)) period + trim(item(3)) period trim(item(4)) period + trim(item(5)) + + goback. + end program tokenize. diff --git a/Task/Tokenize-a-string/Elena/tokenize-a-string.elena b/Task/Tokenize-a-string/Elena/tokenize-a-string.elena new file mode 100644 index 0000000000..6a2958ba75 --- /dev/null +++ b/Task/Tokenize-a-string/Elena/tokenize-a-string.elena @@ -0,0 +1,12 @@ +#import system. +#import system'routines. + +#symbol program = +[ + #var string := "Hello,How,Are,You,Today". + + string split &by:"," run &each:s + [ + console writeLiteral:(s + "."). + ]. +]. diff --git a/Task/Tokenize-a-string/Haskell/tokenize-a-string-1.hs b/Task/Tokenize-a-string/Haskell/tokenize-a-string-1.hs index 19c33eab79..098255529f 100644 --- a/Task/Tokenize-a-string/Haskell/tokenize-a-string-1.hs +++ b/Task/Tokenize-a-string/Haskell/tokenize-a-string-1.hs @@ -1,16 +1,5 @@ -splitBy :: (a -> Bool) -> [a] -> [[a]] -splitBy _ [] = [] -splitBy f list = first : splitBy f (dropWhile f rest) where - (first, rest) = break f list +{-# OPTIONS_GHC -XOverloadedStrings #-} +import Data.Text (splitOn,intercalate) +import qualified Data.Text.IO as T (putStrLn) -splitRegex :: Regex -> String -> [String] - -joinWith :: [a] -> [[a]] -> [a] -joinWith d xs = concat $ List.intersperse d xs --- "concat $ intersperse" can be replaced with "intercalate" from the Data.List in GHC 6.8 and later - -putStrLn $ joinWith "." $ splitBy (== ',') $ "Hello,How,Are,You,Today" - --- using regular expression to split: -import Text.Regex -putStrLn $ joinWith "." $ splitRegex (mkRegex ",") $ "Hello,How,Are,You,Today" +main = T.putStrLn . intercalate "." $ splitOn "," "Hello,How,Are,You,Today" diff --git a/Task/Tokenize-a-string/Haskell/tokenize-a-string-2.hs b/Task/Tokenize-a-string/Haskell/tokenize-a-string-2.hs index 0ef04fa56d..19c33eab79 100644 --- a/Task/Tokenize-a-string/Haskell/tokenize-a-string-2.hs +++ b/Task/Tokenize-a-string/Haskell/tokenize-a-string-2.hs @@ -1,6 +1,16 @@ -*Main> mapM_ putStrLn $ takeWhile (not.null) $ unfoldr (Just . second(drop 1). break (==',')) "Hello,How,Are,You,Today" -Hello -How -Are -You -Today +splitBy :: (a -> Bool) -> [a] -> [[a]] +splitBy _ [] = [] +splitBy f list = first : splitBy f (dropWhile f rest) where + (first, rest) = break f list + +splitRegex :: Regex -> String -> [String] + +joinWith :: [a] -> [[a]] -> [a] +joinWith d xs = concat $ List.intersperse d xs +-- "concat $ intersperse" can be replaced with "intercalate" from the Data.List in GHC 6.8 and later + +putStrLn $ joinWith "." $ splitBy (== ',') $ "Hello,How,Are,You,Today" + +-- using regular expression to split: +import Text.Regex +putStrLn $ joinWith "." $ splitRegex (mkRegex ",") $ "Hello,How,Are,You,Today" diff --git a/Task/Tokenize-a-string/Haskell/tokenize-a-string-3.hs b/Task/Tokenize-a-string/Haskell/tokenize-a-string-3.hs new file mode 100644 index 0000000000..0ef04fa56d --- /dev/null +++ b/Task/Tokenize-a-string/Haskell/tokenize-a-string-3.hs @@ -0,0 +1,6 @@ +*Main> mapM_ putStrLn $ takeWhile (not.null) $ unfoldr (Just . second(drop 1). break (==',')) "Hello,How,Are,You,Today" +Hello +How +Are +You +Today diff --git a/Task/Tokenize-a-string/Kotlin/tokenize-a-string.kotlin b/Task/Tokenize-a-string/Kotlin/tokenize-a-string.kotlin index 8fd8f1e797..1a38922ae3 100644 --- a/Task/Tokenize-a-string/Kotlin/tokenize-a-string.kotlin +++ b/Task/Tokenize-a-string/Kotlin/tokenize-a-string.kotlin @@ -1,2 +1,2 @@ val input = "Hello,How,Are,You,Today" -println(input.splitBy(",").join(".")) +println(input.split(',').join(".")) diff --git a/Task/Tokenize-a-string/Lua/tokenize-a-string.lua b/Task/Tokenize-a-string/Lua/tokenize-a-string.lua new file mode 100644 index 0000000000..9d6faaf1d9 --- /dev/null +++ b/Task/Tokenize-a-string/Lua/tokenize-a-string.lua @@ -0,0 +1,9 @@ +function string:split (sep) + local sep, fields = sep or ":", {} + local pattern = string.format("([^%s]+)", sep) + self:gsub(pattern, function(c) fields[#fields+1] = c end) + return fields +end + +local str = "Hello,How,Are,You,Today" +print(table.concat(str:split(","), ".")) diff --git a/Task/Tokenize-a-string/OCaml/tokenize-a-string-1.ocaml b/Task/Tokenize-a-string/OCaml/tokenize-a-string-1.ocaml index 30642eda82..8ca973b69d 100644 --- a/Task/Tokenize-a-string/OCaml/tokenize-a-string-1.ocaml +++ b/Task/Tokenize-a-string/OCaml/tokenize-a-string-1.ocaml @@ -1,7 +1,2 @@ -let rec split_char sep str = - try - let i = String.index str sep in - String.sub str 0 i :: - split_char sep (String.sub str (i+1) (String.length str - i - 1)) - with Not_found -> - [str] +let words = String.split_on_char ',' "Hello,How,Are,You,Today" in +String.concat "." words diff --git a/Task/Tokenize-a-string/OCaml/tokenize-a-string-2.ocaml b/Task/Tokenize-a-string/OCaml/tokenize-a-string-2.ocaml index 129aaaa54b..e9e18dd38e 100644 --- a/Task/Tokenize-a-string/OCaml/tokenize-a-string-2.ocaml +++ b/Task/Tokenize-a-string/OCaml/tokenize-a-string-2.ocaml @@ -1,18 +1,10 @@ -(* [try .. with] structures break tail-recursion, - so we externalise it in a sub-function *) -let string_index str c = - try Some(String.index str c) - with Not_found -> None - -let split_char sep str = - let rec aux acc str = - match string_index str sep with - | Some i -> - let this = String.sub str 0 i - and next = String.sub str (i+1) (String.length str - i - 1) in - aux (this::acc) next - | None -> - List.rev(str::acc) - in - aux [] str -;; +let split_on_char sep s = + let r = ref [] in + let j = ref (String.length s) in + for i = String.length s - 1 downto 0 do + if s.[i] = sep then begin + r := String.sub s (i + 1) (!j - i - 1) :: !r; + j := i + end + done; + String.sub s 0 !j :: !r diff --git a/Task/Tokenize-a-string/Objeck/tokenize-a-string.objeck b/Task/Tokenize-a-string/Objeck/tokenize-a-string.objeck index 4dcd14c9bc..2c35a49a48 100644 --- a/Task/Tokenize-a-string/Objeck/tokenize-a-string.objeck +++ b/Task/Tokenize-a-string/Objeck/tokenize-a-string.objeck @@ -1,10 +1,8 @@ -bundle Default { - class Parse { - function : Main(args : String[]) ~ Nil { - tokens := "Hello,How,Are,You,Today"->Split(","); - each(i : tokens) { - tokens[i]->PrintLine(); - }; - } +class Parse { + function : Main(args : String[]) ~ Nil { + tokens := "Hello,How,Are,You,Today"->Split(","); + each(i : tokens) { + tokens[i]->PrintLine(); + }; } } diff --git a/Task/Tokenize-a-string/PARI-GP/tokenize-a-string-1.pari b/Task/Tokenize-a-string/PARI-GP/tokenize-a-string-1.pari new file mode 100644 index 0000000000..41477170d5 --- /dev/null +++ b/Task/Tokenize-a-string/PARI-GP/tokenize-a-string-1.pari @@ -0,0 +1,17 @@ +\\ Tokenize a string str according to 1 character delimiter d. Return a list of tokens. +\\ Using ssubstr() from http://rosettacode.org/wiki/Substring#PARI.2FGP +\\ tokenize() 3/5/16 aev +tokenize(str,d)={ +my(str=Str(str,d),vt=Vecsmall(str),d1=sasc(d),Lr=List(),sn=#str,v1,p1=1); +for(i=p1,sn, v1=vt[i]; if(v1==d1, listput(Lr,ssubstr(str,p1,i-p1)); p1=i+1)); +return(Lr); +} + +{ +\\ TEST +print(" *** Testing tokenize from Version #1:"); +print("1.", tokenize("Hello,How,Are,You,Today",",")); +\\ BOTH 2 & 3 are NOT OK!! +print("2.",tokenize("Hello,How,Are,You,Today,",",")); +print("3.",tokenize(",Hello,,How,Are,You,Today",",")); +} diff --git a/Task/Tokenize-a-string/PARI-GP/tokenize-a-string-2.pari b/Task/Tokenize-a-string/PARI-GP/tokenize-a-string-2.pari new file mode 100644 index 0000000000..f558254026 --- /dev/null +++ b/Task/Tokenize-a-string/PARI-GP/tokenize-a-string-2.pari @@ -0,0 +1,28 @@ +\\ Tokenize a string str according to 1 character delimiter d. Return a list of tokens. +\\ Using ssubstr() from http://rosettacode.org/wiki/Substring#PARI.2FGP +\\ stok() 3/5/16 aev +stok(str,d)={ +my(d1c=ssubstr(d,1,1),str=Str(str,d1c),vt=Vecsmall(str),d1=sasc(d1c), + Lr=List(),sn=#str,v1,p1=1,vo=32); +if(sn==1, return(List(""))); if(vt[sn-1]==d1,sn--); +for(i=1,sn, v1=vt[i]; + if(v1!=d1, vo=v1; next); + if(vo==d1||i==1, listput(Lr,""); p1=i+1; vo=v1; next); + if(i-p1>0, listput(Lr,ssubstr(str,p1,i-p1)); p1=i+1); + vo=v1; + ); +return(Lr); +} + +{ +\\ TEST +print(" *** Testing stok from Version #2:"); +\\ pp - positional parameter(s) +print("1. 5 pp: ", stok("Hello,How,Are,You,Today",",")); +print("2. 5 pp: ", stok("Hello,How,Are,You,Today,",",")); +print("3. 9 pp: ", stok(",,Hello,,,How,Are,You,Today",",")); +print("4. 6 pp: ", stok(",,,,,,",",")); +print("5. 1 pp: ", stok(",",",")); +print("6. 1 pp: ", stok("Hello-o-o??",",")); +print("7. 0 pp: ", stok("",",")); +} diff --git a/Task/Tokenize-a-string/PowerShell/tokenize-a-string-3.psh b/Task/Tokenize-a-string/PowerShell/tokenize-a-string-3.psh new file mode 100644 index 0000000000..0c7bb57dc0 --- /dev/null +++ b/Task/Tokenize-a-string/PowerShell/tokenize-a-string-3.psh @@ -0,0 +1 @@ +"Hello,How,Are,You,Today", ",,Hello,,Goodbye,," | ForEach-Object {($_.Split(',',[StringSplitOptions]::RemoveEmptyEntries)) -join "."} diff --git a/Task/Tokenize-a-string/REXX/tokenize-a-string-1.rexx b/Task/Tokenize-a-string/REXX/tokenize-a-string-1.rexx index 377e0f9985..514043844c 100644 --- a/Task/Tokenize-a-string/REXX/tokenize-a-string-1.rexx +++ b/Task/Tokenize-a-string/REXX/tokenize-a-string-1.rexx @@ -1,4 +1,4 @@ -/*REXX program seperates a string of comma-delimited words, and echoes. */ +/*REXX program separates a string of comma-delimited words, and echoes. */ sss = 'Hello,How,Are,You,Today' /*words seperated by commas (,). */ say 'input string =' sss /*display the original string. */ new=sss /*make a copy of the string. */ diff --git a/Task/Tokenize-a-string/Rust/tokenize-a-string.rust b/Task/Tokenize-a-string/Rust/tokenize-a-string.rust new file mode 100644 index 0000000000..372dab3f50 --- /dev/null +++ b/Task/Tokenize-a-string/Rust/tokenize-a-string.rust @@ -0,0 +1,5 @@ +fn main() { + let s = "Hello,How,Are,You,Today"; + let tokens: Vec<&str> = s.split(",").collect(); + println!("{}", tokens.join(".")); +} diff --git a/Task/Tokenize-a-string/S-lang/tokenize-a-string.slang b/Task/Tokenize-a-string/S-lang/tokenize-a-string.slang new file mode 100644 index 0000000000..c06b8aa6ba --- /dev/null +++ b/Task/Tokenize-a-string/S-lang/tokenize-a-string.slang @@ -0,0 +1,2 @@ +variable a = strchop("Hello,How,Are,You,Today", ',', 0); +print(strjoin(a, ".")); diff --git a/Task/Tokenize-a-string/UNIX-Shell/tokenize-a-string-4.sh b/Task/Tokenize-a-string/UNIX-Shell/tokenize-a-string-4.sh new file mode 100644 index 0000000000..c5448ed5a6 --- /dev/null +++ b/Task/Tokenize-a-string/UNIX-Shell/tokenize-a-string-4.sh @@ -0,0 +1,13 @@ +string1="Hello,How,Are,You,Today" +elements_quantity=$(echo $string1|tr "," "\n"|wc -l) + +present_element=1 +while [ $present_element -le $elements_quantity ];do +echo $string1|cut -d "," -f $present_element|tr -d "\n" +if [ $present_element -lt $elements_quantity ];then echo -n ".";fi +present_element=$(expr $present_element + 1) +done +echo + +# or to cheat +echo "Hello,How,Are,You,Today"|tr "," "." diff --git a/Task/Top-rank-per-group/00DESCRIPTION b/Task/Top-rank-per-group/00DESCRIPTION index a21463aebe..155cb2c3ef 100644 --- a/Task/Top-rank-per-group/00DESCRIPTION +++ b/Task/Top-rank-per-group/00DESCRIPTION @@ -1,7 +1,9 @@ -Find the top ''N'' salaries in each department, where ''N'' is provided as a parameter. +;Task: +Find the top   ''N''   salaries in each department,   where   ''N''   is provided as a parameter. Use this data as a formatted internal data structure (adapt it to your language-native idioms, rather than parse at runtime), or identify your external data source: -
    Employee Name,Employee ID,Salary,Department
    +
    +Employee Name,Employee ID,Salary,Department
     Tyler Bennett,E10297,32000,D101
     John Rappl,E21437,47000,D050
     George Woltman,E00127,53500,D101
    @@ -14,4 +16,6 @@ Richard Potter,E43128,15900,D101
     David Motsinger,E27002,19250,D202
     Tim Sampair,E03033,27000,D101
     Kim Arlich,E10001,57000,D190
    -Timothy Grove,E16398,29900,D190
    +Timothy Grove,E16398,29900,D190 +
    +
    diff --git a/Task/Top-rank-per-group/AWK/top-rank-per-group.awk b/Task/Top-rank-per-group/AWK/top-rank-per-group.awk new file mode 100644 index 0000000000..2196c73c92 --- /dev/null +++ b/Task/Top-rank-per-group/AWK/top-rank-per-group.awk @@ -0,0 +1,45 @@ +# syntax: GAWK -f TOP_RANK_PER_GROUP.AWK [n] +# +# sorting: +# PROCINFO["sorted_in"] is used by GAWK +# SORTTYPE is used by Thompson Automation's TAWK +# +BEGIN { + arrA[++n] = "Employee Name,Employee ID,Salary,Department" # raw data + arrA[++n] = "Tyler Bennett,E10297,32000,D101" + arrA[++n] = "John Rappl,E21437,47000,D050" + arrA[++n] = "George Woltman,E00127,53500,D101" + arrA[++n] = "Adam Smith,E63535,18000,D202" + arrA[++n] = "Claire Buckman,E39876,27800,D202" + arrA[++n] = "David McClellan,E04242,41500,D101" + arrA[++n] = "Rich Holcomb,E01234,49500,D202" + arrA[++n] = "Nathan Adams,E41298,21900,D050" + arrA[++n] = "Richard Potter,E43128,15900,D101" + arrA[++n] = "David Motsinger,E27002,19250,D202" + arrA[++n] = "Tim Sampair,E03033,27000,D101" + arrA[++n] = "Kim Arlich,E10001,57000,D190" + arrA[++n] = "Timothy Grove,E16398,29900,D190" + for (i=2; i<=n; i++) { # build internal structure + split(arrA[i],arrB,",") + arrC[arrB[4]][arrB[3]][arrB[2] " " arrB[1]] # I.E. arrC[dept][salary][id " " name] + } + show = (ARGV[1] == "") ? 1 : ARGV[1] # employees to show per department + printf("DEPT SALARY EMPID NAME\n\n") # produce report + PROCINFO["sorted_in"] = "@ind_str_asc" ; SORTTYPE = 1 + for (i in arrC) { + PROCINFO["sorted_in"] = "@ind_str_desc" ; SORTTYPE = 9 + shown = 0 + for (j in arrC[i]) { + PROCINFO["sorted_in"] = "@ind_str_asc" ; SORTTYPE = 1 + for (k in arrC[i][j]) { + if (shown++ < show) { + printf("%-4s %6s %s\n",i,j,k) + printed++ + } + } + } + if (printed > 0) { print("") } + printed = 0 + } + exit(0) +} diff --git a/Task/Top-rank-per-group/Elena/top-rank-per-group.elena b/Task/Top-rank-per-group/Elena/top-rank-per-group.elena new file mode 100644 index 0000000000..ac07bbf953 --- /dev/null +++ b/Task/Top-rank-per-group/Elena/top-rank-per-group.elena @@ -0,0 +1,80 @@ +#import system. +#import system'collections. +#import system'routines. +#import extensions. +#import extensions'routines. +#import extensions'text. + +#class Employee +{ + #field theName. + #field theID. + #field theSalary. + #field theDepartment. + + #constructor new &name:name &id:id &salary:salary &department:department + [ + theName := name. + theID := id. + theSalary := salary. + theDepartment := department. + ] + + #method Name = theName. + + #method Salary = theSalary. + + #method Department = theDepartment. + + #method literal + = StringWriter new + write:theName &paddingRight:25 + write:theID &paddingRight:12 + write:theSalary &paddingRight:12 + write:theDepartment. +} + +#class(extension)reportOp +{ + #method topNPerDepartment &n:n + = self group &by:x [ x Department ] select &each: x + [ + ^ { + Department = x key. + + Employees + = x order &by:(:f:l)[ f Salary > l Salary ] top:n summarize:(ArrayList new). + }. + ]. +} + +#symbol program = +[ + #var employees := + ( + Employee new &name:"Tyler Bennett" &id:"E10297" &salary:32000 &department:"D101", + Employee new &name:"John Rappl" &id:"E21437" &salary:47000 &department:"D050", + Employee new &name:"George Woltman" &id:"E00127" &salary:53500 &department:"D101", + Employee new &name:"Adam Smith" &id:"E63535" &salary:18000 &department:"D202", + Employee new &name:"Claire Buckman" &id:"E39876" &salary:27800 &department:"D202", + Employee new &name:"David McClellan" &id:"E04242" &salary:41500 &department:"D101", + Employee new &name:"Rich Holcomb" &id:"E01234" &salary:49500 &department:"D202", + Employee new &name:"Nathan Adams" &id:"E41298" &salary:21900 &department:"D050", + Employee new &name:"Richard Potter" &id:"E43128" &salary:15900 &department:"D101", + Employee new &name:"David Motsinger" &id:"E27002" &salary:19250 &department:"D202", + Employee new &name:"Tim Sampair" &id:"E03033" &salary:27000 &department:"D101", + Employee new &name:"Kim Arlich" &id:"E10001" &salary:57000 &department:"D190", + Employee new &name:"Timothy Grove" &id:"E16398" &salary:29900 &department:"D190" + ). + + employees topNPerDepartment &n:2 run &each:info + [ + console writeLine:"Department: ":(info Department). + + info Employees run &each:printingLn. + + console writeLine:"---------------------------------------------". + ]. + + console readChar. +]. diff --git a/Task/Top-rank-per-group/Elixir/top-rank-per-group.elixir b/Task/Top-rank-per-group/Elixir/top-rank-per-group.elixir index 154795ac22..700fc0fa69 100644 --- a/Task/Top-rank-per-group/Elixir/top-rank-per-group.elixir +++ b/Task/Top-rank-per-group/Elixir/top-rank-per-group.elixir @@ -1,4 +1,24 @@ -data = "Employee Name,Employee ID,Salary,Department +defmodule TopRank do + def per_groupe(data, n) do + String.split(data, ~r/(\n|\r\n|\r)/, trim: true) + |> Enum.drop(1) + |> Enum.map(fn person -> String.split(person,",") end) + |> Enum.group_by(fn person -> department(person) end) + |> Enum.each(fn {department,group} -> + IO.puts "Department: #{department}" + Enum.sort_by(group, fn person -> -salary(person) end) + |> Enum.take(n) + |> Enum.each(fn person -> IO.puts str_format(person) end) + end) + end + + defp salary([_,_,x,_]), do: String.to_integer(x) + defp department([_,_,_,x]), do: x + defp str_format([a,b,c,_]), do: " #{a} - #{b} - #{c} annual salary" +end + +data = """ +Employee Name,Employee ID,Salary,Department Tyler Bennett,E10297,32000,D101 John Rappl,E21437,47000,D050 George Woltman,E00127,53500,D101 @@ -11,20 +31,6 @@ Richard Potter,E43128,15900,D101 David Motsinger,E27002,19250,D202 Tim Sampair,E03033,27000,D101 Kim Arlich,E10001,57000,D190 -Timothy Grove,E16398,29900,D190" - -salary = fn [_,_,x,_] -> String.to_integer(x) end -department = fn [_,_,_,x] -> x end -str_format = fn [a,b,c,d] -> "Department #{d}: #{a} - #{b} - #{c} annual salary" end - -data - |> String.split(~r/(\n|\r\n|\r)/,trim: true) - |> Enum.map(fn n -> String.split(n,",") end) - |> Enum.drop(1) - |> Enum.group_by(fn m -> department.(m) end) - |> Dict.values - |> Enum.map(fn n -> - Enum.sort_by(n, fn m -> -salary.(m) end) - |> Enum.take(3) - |> Enum.map(fn q -> IO.puts str_format.(q) end) - end) +Timothy Grove,E16398,29900,D190 +""" +TopRank.per_groupe(data, 3) diff --git a/Task/Top-rank-per-group/REXX/top-rank-per-group-1.rexx b/Task/Top-rank-per-group/REXX/top-rank-per-group-1.rexx index 8b23b12369..ddf1077277 100644 --- a/Task/Top-rank-per-group/REXX/top-rank-per-group-1.rexx +++ b/Task/Top-rank-per-group/REXX/top-rank-per-group-1.rexx @@ -1,7 +1,7 @@ -/*REXX program displays the top N salaries in each department (internal table)*/ -parse arg topN . /*get optional # for the top N salaries*/ -if topN=='' then topN=1 /*Not specified? Then use the default.*/ -say 'Finding the top ' topN ' salaries in each department.'; say +/*REXX program displays the top N salaries in each department (internal table). */ +parse arg topN . /*get optional # for the top N salaries*/ +if topN=='' | topN=="," then topN=1 /*Not specified? Then use the default.*/ +say 'Finding the top ' topN " salaries in each department."; say @.= /*════════ employee name ID salary dept. ═══════ */ @.1 = "Tyler Bennett ,E10297, 32000, D101" @.2 = "John Rappl ,E21437, 47000, D050" @@ -17,26 +17,24 @@ say 'Finding the top ' topN ' salaries in each department.'; say @.12 = "Kim Arlich ,E10001, 57000, D190" @.13 = "Timothy Grove ,E16398, 29900, D190" depts= - do j=1 until @.j=='' /*build database elements from @ array.*/ - parse var @.j name.j ',' id.j "," sal.j ',' dept.j . - if wordpos(dept.j,depts)==0 then depts=depts dept.j - end /*j*/ -employees=j-1 -#d=words(depts) -say 'There are ' employees 'employees, ' #d "departments: " depts + do j=1 until @.j=='' /*build database elements from @ array.*/ + parse var @.j name.j ',' id.j "," sal.j ',' dept.j . + if wordpos(dept.j,depts)==0 then depts=depts dept.j /*a new DEPT?*/ + end /*j*/ +employees=j-1 /*adjust for the DO loop index bump.*/ +say 'There are ' employees "employees, " words(depts) 'departments: ' depts say - do dep=1 for #d; say /*process each of the departments. */ - Xdept=word(depts,dep) /*current department being processed. */ - do topN; highSal=0 /*process the top N salaries. */ - h=0 /*point to the highest paid employee. */ - do e=1 for employees /*process each employee in department. */ - if dept.e\==Xdept | sal.etrue, :header_converters=>:symbol) + groups = table.group_by{|emp| emp[:department]}.sort groups.each do |dept, emps| puts dept - # sort by salary descending - emps.sort_by {|emp| -emp[:salary].to_i}.first(n).each do |e| + # max by salary + emps.max_by(n) {|emp| emp[:salary].to_i}.each do |e| puts " %-16s %6s %7d" % [e[:employee_name], e[:employee_id], e[:salary]] end puts end end -table = CSV.parse(data, :headers=>true, :header_converters=>:symbol) -groups = table.group_by{|emp| emp[:department]}.sort - -show_top_salaries_per_group(groups, 3) +show_top_salaries_per_group(data, 3) diff --git a/Task/Topic-variable/Go/topic-variable.go b/Task/Topic-variable/Go/topic-variable.go new file mode 100644 index 0000000000..6d32f76268 --- /dev/null +++ b/Task/Topic-variable/Go/topic-variable.go @@ -0,0 +1,33 @@ +package main + +import ( + "math" + "os" + "strconv" + "text/template" +) + +func sqr(x string) string { + f, err := strconv.ParseFloat(x, 64) + if err != nil { + return "NA" + } + return strconv.FormatFloat(f*f, 'f', -1, 64) +} + +func sqrt(x string) string { + f, err := strconv.ParseFloat(x, 64) + if err != nil { + return "NA" + } + return strconv.FormatFloat(math.Sqrt(f), 'f', -1, 64) +} + +func main() { + f := template.FuncMap{"sqr": sqr, "sqrt": sqrt} + t := template.Must(template.New("").Funcs(f).Parse(`. = {{.}} +square: {{sqr .}} +square root: {{sqrt .}} +`)) + t.Execute(os.Stdout, "3") +} diff --git a/Task/Topic-variable/PowerShell/topic-variable-1.psh b/Task/Topic-variable/PowerShell/topic-variable-1.psh new file mode 100644 index 0000000000..51fc67086e --- /dev/null +++ b/Task/Topic-variable/PowerShell/topic-variable-1.psh @@ -0,0 +1,2 @@ +65..67 | ForEach-Object {$_ * 2} # Multiply the numbers by 2 +65..67 | ForEach-Object {[char]$_ } # ASCII values of the numbers diff --git a/Task/Topic-variable/PowerShell/topic-variable-2.psh b/Task/Topic-variable/PowerShell/topic-variable-2.psh new file mode 100644 index 0000000000..c985efde80 --- /dev/null +++ b/Task/Topic-variable/PowerShell/topic-variable-2.psh @@ -0,0 +1 @@ +65..67 | Where-Object {$_ % 2} diff --git a/Task/Topic-variable/PowerShell/topic-variable-3.psh b/Task/Topic-variable/PowerShell/topic-variable-3.psh new file mode 100644 index 0000000000..29a86b8b2b --- /dev/null +++ b/Task/Topic-variable/PowerShell/topic-variable-3.psh @@ -0,0 +1 @@ +65..70 | Format-Wide {$_} -Column 3 -Force diff --git a/Task/Topological-sort/00DESCRIPTION b/Task/Topological-sort/00DESCRIPTION index c6a1b62aba..b67acc39ad 100644 --- a/Task/Topological-sort/00DESCRIPTION +++ b/Task/Topological-sort/00DESCRIPTION @@ -1,14 +1,19 @@ Given a mapping between items, and items they depend on, a [[wp:Topological sorting|topological sort]] orders items so that no item precedes an item it depends upon. The compiling of a library in the [[wp:VHDL|VHDL]] language has the constraint that a library must be compiled after any library it depends on. + A tool exists that extracts library dependencies. -The task is to '''write a function that will return a valid compile order of VHDL libraries from their dependencies.''' + + +;Task; +Write a function that will return a valid compile order of VHDL libraries from their dependencies. * Assume library names are single words. -* Items mentioned as only dependants, (sic), have no dependants of their own, but their order of compiling must be given. +* Items mentioned as only dependents, (sic), have no dependents of their own, but their order of compiling must be given. * Any self dependencies should be ignored. * Any un-orderable dependencies should be flagged. +
    Use the following data as an example:
     LIBRARY          LIBRARY DEPENDENCIES
    @@ -25,12 +30,17 @@ dware            ieee dware
     gtech            ieee gtech
     ramlib           std ieee
     std_cell_lib     ieee std_cell_lib
    -synopsys         
    +synopsys +
    +
    Note: the above data would be un-orderable if, for example, dw04 is added to the list of dependencies of dw01. -C.f: [[Topological sort/Extracted top item]]. +;C.f.: +* [[Topological sort/Extracted top item]]. + +
    There are two popular algorithms for topological sorting: Kahn's 1962 topological sort, and depth-first search. @@ -39,3 +49,4 @@ Kahn's 1962 topological sort, and depth-first search. Jason Sachs [http://www.embeddedrelated.com/showarticle/799.php "Ten little algorithms, part 4: topological sort"]. +

    diff --git a/Task/Topological-sort/Elixir/topological-sort.elixir b/Task/Topological-sort/Elixir/topological-sort.elixir new file mode 100644 index 0000000000..d1c2f49d16 --- /dev/null +++ b/Task/Topological-sort/Elixir/topological-sort.elixir @@ -0,0 +1,46 @@ +defmodule Topological do + def sort(library) do + g = :digraph.new + Enum.each(library, fn {l,deps} -> + :digraph.add_vertex(g,l) # noop if library already added + Enum.each(deps, fn d -> add_dependency(g,l,d) end) + end) + if t = :digraph_utils.topsort(g) do + print_path(t) + else + IO.puts "Unsortable contains circular dependencies:" + Enum.each(:digraph.vertices(g), fn v -> + if vs = :digraph.get_short_cycle(g,v), do: print_path(vs) + end) + end + end + + defp print_path(l), do: IO.puts Enum.join(l, " -> ") + + defp add_dependency(_g,l,l), do: :ok + defp add_dependency(g,l,d) do + :digraph.add_vertex(g,d) # noop if dependency already added + :digraph.add_edge(g,d,l) # Dependencies represented as an edge d -> l + end +end + +libraries = [ + des_system_lib: ~w[std synopsys std_cell_lib des_system_lib dw02 dw01 ramlib ieee]a, + dw01: ~w[ieee dw01 dware gtech]a, + dw02: ~w[ieee dw02 dware]a, + dw03: ~w[std synopsys dware dw03 dw02 dw01 ieee gtech]a, + dw04: ~w[dw04 ieee dw01 dware gtech]a, + dw05: ~w[dw05 ieee dware]a, + dw06: ~w[dw06 ieee dware]a, + dw07: ~w[ieee dware]a, + dware: ~w[ieee dware]a, + gtech: ~w[ieee gtech]a, + ramlib: ~w[std ieee]a, + std_cell_lib: ~w[ieee std_cell_lib]a, + synopsys: [] +] +Topological.sort(libraries) + +IO.puts "" +bad_libraries = Keyword.update!(libraries, :dw01, &[:dw04 | &1]) +Topological.sort(bad_libraries) diff --git a/Task/Topological-sort/Forth/topological-sort.fth b/Task/Topological-sort/Forth/topological-sort.fth new file mode 100644 index 0000000000..c931c7a288 --- /dev/null +++ b/Task/Topological-sort/Forth/topological-sort.fth @@ -0,0 +1,71 @@ +variable nodes 0 nodes ! \ linked list of nodes + +: node. ( body -- ) + body> >name name>string type ; + +: nodeps ( body -- ) + \ the word referenced by body has no (more) dependencies to resolve + ['] drop over ! node. space ; + +: processing ( body1 ... bodyn body -- body1 ... bodyn ) + \ the word referenced by body is in the middle of resolving dependencies + 2dup <> if \ unless it is a self-reference (see task description) + ['] drop over ! + ." (cycle: " dup node. >r 1 begin \ print the cycle + dup pick dup r@ <> while + space node. 1+ repeat + ." ) " 2drop r> + then drop ; + +: >processing ( body -- body ) + ['] processing over ! ; + +: node ( "name" -- ) + \ define node "name" and initialize it to having no dependences + create + ['] nodeps , \ on definition, a node has no dependencies + nodes @ , lastxt nodes ! \ linked list of nodes + does> ( -- ) + dup @ execute ; \ perform xt associated with node + +: define-nodes ( "names" -- ) + \ define all the names that don't exist yet as nodes + begin + parse-name dup while + 2dup find-name 0= if + 2dup nextname node then + 2drop repeat + 2drop ; + +: deps ( "name" "deps" -- ) + \ name is after deps. Implementation: Define missing nodes, then + \ define a colon definition for + >in @ define-nodes >in ! + ' :noname ]] >processing [[ source >in @ /string evaluate ]] nodeps ; [[ + swap >body ! 0 parse 2drop ; + +: all-nodes ( -- ) + \ call all nodes, and they then print their dependences and themselves + nodes begin + @ dup while + dup execute + >body cell+ repeat + drop ; + +deps des_system_lib std synopsys std_cell_lib des_system_lib dw02 dw01 ramlib ieee +deps dw01 ieee dw01 dware gtech +deps dw02 ieee dw02 dware +deps dw03 std synopsys dware dw03 dw02 dw01 ieee gtech +deps dw04 dw04 ieee dw01 dware gtech +deps dw05 dw05 ieee dware +deps dw06 dw06 ieee dware +deps dw07 ieee dware +deps dware ieee dware +deps gtech ieee gtech +deps ramlib std ieee +deps std_cell_lib ieee std_cell_lib +deps synopsys +\ to test the cycle recognition (overwrites dependences for dw1 above) +deps dw01 ieee dw01 dware gtech dw04 + +all-nodes diff --git a/Task/Topological-sort/Java/topological-sort.java b/Task/Topological-sort/Java/topological-sort.java index 6641d7f7c5..a81c90b4f0 100644 --- a/Task/Topological-sort/Java/topological-sort.java +++ b/Task/Topological-sort/Java/topological-sort.java @@ -1,26 +1,77 @@ -import java.util.ArrayList; -import java.util.TreeMap; +import java.util.*; public class TopologicalSort { - public static void main(String[] args) throws Exception { - TreeMap> mp = new TreeMap>(); - String[] data, input = new String[] { - "des_system_lib: std synopsys std_cell_lib des_system_lib dw02 dw01 ramlib ieee", - "dw01: ieee dw01 dware gtech", "dw02: ieee dw02 dware", - "dw03: std synopsys dware dw03 dw02 dw01 ieee gtech", - "dw04: dw04 ieee dw01 dware gtech", "dw05: dw05 ieee dware", - "dw06: dw06 ieee dware", "dw07: ieee dware", - "dware: ieee dware", "gtech: ieee gtech", "ramlib: std ieee", - "std_cell_lib: ieee std_cell_lib", "synopsys:" }; - for (String str : input) - mp.put((data = str.split(":"))[0], Utils.aList(// - data.length < 2 || data[1].trim().equals("")// - ? null : data[1].trim().split("\\s+"))); + public static void main(String[] args) { + String s = "std, ieee, des_system_lib, dw01, dw02, dw03, dw04, dw05," + + "dw06, dw07, dware, gtech, ramlib, std_cell_lib, synopsys"; - Utils.tSortFix(mp); - System.out.println(Utils.tSort(mp)); - mp.put("dw01", Utils.aList("dw04")); - System.out.println(Utils.tSort(mp)); - } + Graph g = new Graph(s, new int[][]{ + {2, 0}, {2, 14}, {2, 13}, {2, 4}, {2, 3}, {2, 12}, {2, 1}, + {3, 1}, {3, 10}, {3, 11}, + {4, 1}, {4, 10}, + {5, 0}, {5, 14}, {5, 10}, {5, 4}, {5, 3}, {5, 1}, {5, 11}, + {6, 1}, {6, 3}, {6, 10}, {6, 11}, + {7, 1}, {7, 10}, + {8, 1}, {8, 10}, + {9, 1}, {9, 10}, + {10, 1}, + {11, 1}, {11, 10}, + {12, 0}, {12, 1}, + {13, 1} + }); + + System.out.println("Topologically sorted order: "); + System.out.println(g.topoSort()); + } +} + +class Graph { + String[] vertices; + boolean[][] adjacency; + int numVertices; + + public Graph(String s, int[][] edges) { + vertices = s.split(","); + numVertices = vertices.length; + adjacency = new boolean[numVertices][numVertices]; + + for (int[] edge : edges) + adjacency[edge[0]][edge[1]] = true; + } + + List topoSort() { + List result = new ArrayList<>(); + List todo = new LinkedList<>(); + + for (int i = 0; i < numVertices; i++) + todo.add(i); + + try { + outer: + while (!todo.isEmpty()) { + for (Integer r : todo) { + if (!hasDependency(r, todo)) { + todo.remove(r); + result.add(vertices[r]); + // no need to worry about concurrent modification + continue outer; + } + } + throw new Exception("Graph has cycles"); + } + } catch (Exception e) { + System.out.println(e); + return null; + } + return result; + } + + boolean hasDependency(Integer r, List todo) { + for (Integer c : todo) { + if (adjacency[r][c]) + return true; + } + return false; + } } diff --git a/Task/Topological-sort/Perl-6/topological-sort.pl6 b/Task/Topological-sort/Perl-6/topological-sort.pl6 index 48ad75095d..718674cec9 100644 --- a/Task/Topological-sort/Perl-6/topological-sort.pl6 +++ b/Task/Topological-sort/Perl-6/topological-sort.pl6 @@ -33,5 +33,5 @@ my %deps = synopsys => < >; print_topo_sort(%deps); -%deps.push: 'dw04'; # Add unresolvable dependency +%deps = ; # Add unresolvable dependency print_topo_sort(%deps); diff --git a/Task/Topological-sort/REXX/topological-sort.rexx b/Task/Topological-sort/REXX/topological-sort.rexx new file mode 100644 index 0000000000..319a61f2b7 --- /dev/null +++ b/Task/Topological-sort/REXX/topological-sort.rexx @@ -0,0 +1,62 @@ +/*REXX pgm does a topological sort (orders such that no item precedes a dependent item).*/ +idep.=0; ipos.=0; iord.=0 /*initialize some stemmed arrays to 0.*/ +label= 'DES_SYSTEM_LIB DW01 DW02 DW03 DW04 DW05 DW06 DW07 DWARE GTECH RAMLIB', + 'STD_CELL_LIB SYNOPSYS STD IEEE' + +icode=1 14 13 12 1 3 2 11 15 0 2 15 2 9 10 0 3 15 3 9 0 4 14 213 9 4 3 2 15 10 0 5 5 15 2, + 9 10 0 6 6 15 9 0 7 7 15 9 0 8 15 9 0 39 15 9 0 10 15 10 0 11 14 15 0 12 15 12 0 0 + +idep.=0; ipos.=0; iord.=0 /*initialize some stemmed arrays to 0.*/ +nl=15; nd=44; nc=69; j=0; i=0 /* " " "parms" and indices.*/ + +10: i=i+1 + il=word(icode, i) + if il==0 then signal 30 +20: i=i+1 + ir=word(icode, i) + if ir==0 then signal 10 + j=j+1 + idep.j.1=il + idep.j.2=ir + signal 20 +30: call tsort + say '═══compile order═══' + q=0; do o=no by -1 for no; q=q+1 + say word(label, iord.o) + end /*o*/ + if q==0 then q='no' + say ' ('q "libraries found.)" + say + say '═══unordered libraries═══' + q=0; do u=no+1 to nl; q=q+1 + say word(label, iord.u) + end /*u*/ + if q==0 then q='no' + say ' ('q "unordered libraries found.)" +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +tSort: procedure expose nl nd idep. iord. ipos. no + do i=1 for nl + iord.i=i + ipos.i=i + end /*i*/ + k=1 + do forever + j=k + k=nl+1 + do i=1 for nd + il=idep.i.1 + ir=ipos.il + ipl=ipos.il + ipr=ipos.ir + if il==ir | ipl>.k | ipl [2, 4, 1, 3] # Initial shuffle + +Assume you have a particular permutation of a set of   n   cards numbered   1..n   on both of their faces, for example the arrangement of four cards given by   [2, 4, 1, 3]   where the leftmost card is on top. + +A round is composed of reversing the first   m   cards where   m   is the value of the topmost card. + +Rounds are repeated until the topmost card is the number   1   and the number of swaps is recorded. + + +For our example the swaps produce: +
    +    [2, 4, 1, 3]    # Initial shuffle
         [4, 2, 1, 3]
         [3, 1, 2, 4]
         [2, 1, 3, 4]
    -    [1, 2, 3, 4]
    -For a total of four swaps from the initial ordering to produce the terminating case where 1 is on top. + [1, 2, 3, 4] +
    + +For a total of four swaps from the initial ordering to produce the terminating case where   1   is on top. -For a particular number n of cards, topswops(n) is the maximum swaps needed for any starting permutation of the n cards. +For a particular number   n   of cards,   topswops(n)   is the maximum swaps needed for any starting permutation of the   n   cards. + ;Task: -The task is to generate and show here a table of n vs topswops(n) for n in the range 1..10 inclusive. +The task is to generate and show here a table of   n   vs   topswops(n)   for   n   in the range   1..10   inclusive. + ;Note: -[[oeis:A000375|Topswops]] is also known as [http://www.haskell.org/haskellwiki/Shootout/Fannkuch Fannkuch] from the German Pfannkuchen meaning [http://youtu.be/3biN6nQYqZY pancake]. +[[oeis:A000375|Topswops]] is also known as   [http://www.haskell.org/haskellwiki/Shootout/Fannkuch Fannkuch]   from the German Pfannkuchen meaning   [http://youtu.be/3biN6nQYqZY pancake]. -;Cf. + +;Related tasks: * [[Number reversal game]] * [[Sorting algorithms/Pancake sort]] +

    diff --git a/Task/Topswops/360-Assembly/topswops.360 b/Task/Topswops/360-Assembly/topswops.360 new file mode 100644 index 0000000000..3342c68064 --- /dev/null +++ b/Task/Topswops/360-Assembly/topswops.360 @@ -0,0 +1,121 @@ +* Topswops optimized 12/07/2016 +TOPSWOPS CSECT + USING TOPSWOPS,R13 base register + B 72(R15) skip savearea + DC 17F'0' savearea + STM R14,R12,12(R13) prolog + ST R13,4(R15) " <- + ST R15,8(R13) " -> + LR R13,R15 " addressability + MVC N,=F'1' n=1 +LOOPN L R4,N n; do n=1 to 10 ===-------------==* + C R4,=F'10' " * + BH ELOOPN . * + MVC P(40),PINIT p=pinit + MVC COUNTM,=F'0' countm=0 +REPEAT MVC CARDS(40),P cards=p -------------------------+ + SR R11,R11 count=0 | +WHILE CLC CARDS,=F'1' do while cards(1)^=1 ---------+ + BE EWHILE . | + MVC M,CARDS m=cards(1) + L R2,M m + SRA R2,1 m/2 + ST R2,MD2 md2=m/2 + L R3,M @card(mm)=m + SLA R3,2 *4 + LA R3,CARDS-4(R3) @card(mm) + LA R2,CARDS @card(i)=0 + LA R6,1 i=1 +LOOPI C R6,MD2 do i=1 to m/2 -------------+ + BH ELOOPI . | + L R0,0(R2) swap r0=cards(i) + MVC 0(4,R2),0(R3) swap cards(i)=cards(mm) + ST R0,0(R3) swap cards(mm)=r0 + AH R2,=H'4' @card(i)=@card(i)+4 + SH R3,=H'4' @card(mm)=@card(mm)-4 + LA R6,1(R6) i=i+1 | + B LOOPI ----------------------------+ +ELOOPI LA R11,1(R11) count=count+1 | + B WHILE -------------------------------+ +EWHILE C R11,COUNTM if count>countm + BNH NOTGT then + ST R11,COUNTM countm=count +NOTGT BAL R14,NEXTPERM call nextperm + LTR R0,R0 until nextperm=0 | + BNZ REPEAT ---------------------------------+ + L R1,N n + XDECO R1,XDEC edit n + MVC PG(2),XDEC+10 output n + MVI PG+2,C':' output ':' + L R1,COUNTM countm + XDECO R1,XDEC edit countm + MVC PG+3(4),XDEC+8 output countm + XPRNT PG,L'PG print buffer + L R1,N n * + LA R1,1(R1) +1 * + ST R1,N n=n+1 * + B LOOPN ===------------------------------==* +ELOOPN L R13,4(0,R13) epilog + LM R14,R12,12(R13) " restore + XR R15,R15 " rc=0 + BR R14 exit +PINIT DC F'1',F'2',F'3',F'4',F'5',F'6',F'7',F'8',F'9',F'10' +CARDS DS 10F cards +P DS 10F p +COUNTM DS F countm +M DS F m +N DS F n +MD2 DS F m/2 +PG DC CL20' ' buffer +XDEC DS CL12 temp +*------- ---- nextperm ----------{----------------------------------- +NEXTPERM L R9,N nn=n + SR R8,R8 jj=0 + LR R7,R9 nn + BCTR R7,0 j=nn-1 + LTR R7,R7 if j=0 + BZ ELOOPJ1 then skip do loop +LOOPJ1 LR R1,R7 do j=nn-1 to 1 by -1; j ----+ + SLA R1,2 . | + L R2,P-4(R1) p(j) + C R2,P(R1) if p(j) {n, permute(Enum.to_list(1..n))} end) + |> Enum.map(fn {n, n_permutations} -> {n, get_1_first_many(n_permutations)} end) + |> Enum.map(fn {n, n_swops} -> {n, Enum.max(n_swops)} end) + |> Enum.each(fn {n, max} -> IO.puts "#{n}\t#{max}" end) + end + + def get_1_first_many( n_permutations ), do: (for x <- n_permutations, do: get_1_first(x)) + + defp permute([]), do: [[]] + defp permute(list), do: for x <- list, y <- permute(list -- [x]), do: [x|y] +end + +Topswops.task diff --git a/Task/Topswops/Lua/topswops.lua b/Task/Topswops/Lua/topswops.lua new file mode 100644 index 0000000000..68d0c4913c --- /dev/null +++ b/Task/Topswops/Lua/topswops.lua @@ -0,0 +1,43 @@ +-- Return an iterator to produce every permutation of list +function permute (list) + local function perm (list, n) + if n == 0 then coroutine.yield(list) end + for i = 1, n do + list[i], list[n] = list[n], list[i] + perm(list, n - 1) + list[i], list[n] = list[n], list[i] + end + end + return coroutine.wrap(function() perm(list, #list) end) +end + +-- Perform one topswop round on table t +function swap (t) + local new, limit = {}, t[1] + for i = 1, #t do + if i <= limit then + new[i] = t[limit - i + 1] + else + new[i] = t[i] + end + end + return new +end + +-- Find the most swaps needed for any starting permutation of n cards +function topswops (n) + local numTab, highest, count = {}, 0 + for i = 1, n do numTab[i] = i end + for numList in permute(numTab) do + count = 0 + while numList[1] ~= 1 do + numList = swap(numList) + count = count + 1 + end + if count > highest then highest = count end + end + return highest +end + +-- Main procedure +for i = 1, 10 do print(i, topswops(i)) end diff --git a/Task/Topswops/PARI-GP/topswops.pari b/Task/Topswops/PARI-GP/topswops.pari new file mode 100644 index 0000000000..2eca13f0f1 --- /dev/null +++ b/Task/Topswops/PARI-GP/topswops.pari @@ -0,0 +1,14 @@ +flip(v:vec)={ + my(t=v[1]+1); + if (t==2, return(0)); + for(i=1,t\2, [v[t-i],v[i]]=[v[i],v[t-i]]); + 1+flip(v) +} +topswops(n)={ + my(mx); + for(i=0,n!-1, + mx=max(flip(Vecsmall(numtoperm(n,i))),mx) + ); + mx; +} +vector(10,n,topswops(n)) diff --git a/Task/Topswops/Perl-6/topswops.pl6 b/Task/Topswops/Perl-6/topswops.pl6 index e774edfbec..5b6e6aad2c 100644 --- a/Task/Topswops/Perl-6/topswops.pl6 +++ b/Task/Topswops/Perl-6/topswops.pl6 @@ -1,11 +1,3 @@ -sub postfix:(@a) { - @a == 1 - ?? [@a] - !! do for @a -> $a { - [ $a, @$_ ] for @a.grep(* != $a)! - } -} - sub swops(@a is copy) { my $count = 0; until @a[0] == 1 { @@ -14,6 +6,7 @@ sub swops(@a is copy) { } return $count; } -sub topswops($n) { [max] map &swops, (1 .. $n)! } + +sub topswops($n) { (sort map &swops, (1..$n).permutations)[*-1] } say "$_ {topswops $_}" for 1 .. 10; diff --git a/Task/Topswops/PicoLisp/topswops.l b/Task/Topswops/PicoLisp/topswops.l new file mode 100644 index 0000000000..ad393ea4b0 --- /dev/null +++ b/Task/Topswops/PicoLisp/topswops.l @@ -0,0 +1,15 @@ +(de fannkuch (N) + (let (Lst (range 1 N) L Lst Max) + (recur (L) # Permute + (if (cdr L) + (do (length L) + (recurse (cdr L)) + (rot L) ) + (zero N) # For each permutation + (for (P (copy Lst) (> (car P) 1) (flip P (car P))) + (inc 'N) ) + (setq Max (max N Max)) ) ) + Max ) ) + +(for I 10 + (println I (fannkuch I)) ) diff --git a/Task/Total-circles-area/00DESCRIPTION b/Task/Total-circles-area/00DESCRIPTION index d3c2d91309..472005cdab 100644 --- a/Task/Total-circles-area/00DESCRIPTION +++ b/Task/Total-circles-area/00DESCRIPTION @@ -1,12 +1,11 @@ +[[File:total_circles_area_full.png|200px|thumb|right|Example circles]] +[[File:total_circles_area_filtered.png|200px|thumb|right|Example circles filtered]] + Given some partially overlapping circles on the plane, compute and show the total area covered by them, with four or six (or a little more) decimal digits of precision. The area covered by two or more disks needs to be counted only once. One point of this Task is also to compare and discuss the relative merits of various solution strategies, their performance, precision and simplicity. This means keeping both slower and faster solutions for a language (like C) is welcome. -To allow a better comparison of the different implementations, solve the problem with this standard dataset, each line contains the x and y coordinates of the centers of the disks and their radii (11 disks are fully contained inside other disks): - -[[File:total_circles_area_full.png|200px|thumb|right|Example circles]] -[[File:total_circles_area_filtered.png|200px|thumb|right|Example circles filtered]] - +To allow a better comparison of the different implementations, solve the problem with this standard dataset, each line contains the '''x''' and '''y''' coordinates of the centers of the disks and their radii   (11 disks are fully contained inside other disks):
           xc             yc        radius
      1.6417233788  1.6121789534 0.0848270516
    @@ -33,12 +32,13 @@ To allow a better comparison of the different implementations, solve the problem
     -0.6311979224  0.7184578971 0.2491045282
      1.4685857879 -0.8347049536 1.3670667538
     -0.6855727502  1.6465021616 1.0593087096
    - 0.0152957411  0.0638919221 0.9771215985
    + 0.0152957411 0.0638919221 0.9771215985 +
    The result is 21.56503660... . -;See also +;See also: * http://www.reddit.com/r/dailyprogrammer/comments/zff9o/9062012_challenge_96_difficult_water_droplets/ - * http://stackoverflow.com/a/1667789/10562 +

    diff --git a/Task/Total-circles-area/Java/total-circles-area.java b/Task/Total-circles-area/Java/total-circles-area.java new file mode 100644 index 0000000000..d43f93d54e --- /dev/null +++ b/Task/Total-circles-area/Java/total-circles-area.java @@ -0,0 +1,125 @@ +public class CirclesTotalArea { + + /* Solution by ilkka.kokkarinen@gmail.com + * Rectangles are given as 4-element arrays [tx, ty, w, h]. + * Circles are given as 3-element arrays [cx, cy, r]. + */ + + private static double distSq(double x1, double y1, double x2, double y2) { + return (x2 - x1) * (x2 - x1) + (y2 - y1) * (y2 - y1); + } + + private static boolean rectangleFullyInsideCircle(double[] rect, double[] circ) { + double r2 = circ[2] * circ[2]; + // Every corner point of rectangle must be inside the circle. + return distSq(rect[0], rect[1], circ[0], circ[1]) <= r2 && + distSq(rect[0] + rect[2], rect[1], circ[0], circ[1]) <= r2 && + distSq(rect[0], rect[1] - rect[3], circ[0], circ[1]) <= r2 && + distSq(rect[0] + rect[2], rect[1] - rect[3], circ[0], circ[1]) <= r2; + } + + private static boolean rectangleSurelyOutsideCircle(double[] rect, double[] circ) { + // Circle center point inside rectangle? + if(rect[0] <= circ[0] && circ[0] <= rect[0] + rect[2] && + rect[1] - rect[3] <= circ[1] && circ[1] <= rect[1]) { return false; } + // Otherwise, check that each corner is at least (r + Max(w, h)) away from circle center. + double r2 = circ[2] + Math.max(rect[2], rect[3]); + r2 = r2 * r2; + return distSq(rect[0], rect[1], circ[0], circ[1]) >= r2 && + distSq(rect[0] + rect[2], rect[1], circ[0], circ[1]) >= r2 && + distSq(rect[0], rect[1] - rect[3], circ[0], circ[1]) >= r2 && + distSq(rect[0] + rect[2], rect[1] - rect[3], circ[0], circ[1]) >= r2; + } + + private static boolean[] surelyOutside; + + private static double totalArea(double[] rect, double[][] circs, int d) { + // Check if we can get a quick certain answer. + int surelyOutsideCount = 0; + for(int i = 0; i < circs.length; i++) { + if(rectangleFullyInsideCircle(rect, circs[i])) { return rect[2] * rect[3]; } + if(rectangleSurelyOutsideCircle(rect, circs[i])) { + surelyOutside[i] = true; + surelyOutsideCount++; + } + else { surelyOutside[i] = false; } + } + // Is this rectangle surely outside all circles? + if(surelyOutsideCount == circs.length) { return 0; } + // Are we deep enough in the recursion? + if(d < 1) { + return rect[2] * rect[3] / 3; // Best guess for overlapping portion + } + // Throw out all circles that are surely outside this rectangle. + if(surelyOutsideCount > 0) { + double[][] newCircs = new double[circs.length - surelyOutsideCount][3]; + int loc = 0; + for(int i = 0; i < circs.length; i++) { + if(!surelyOutside[i]) { newCircs[loc++] = circs[i]; } + } + circs = newCircs; + } + // Subdivide this rectangle recursively and add up the recursively computed areas. + double w = rect[2] / 2; // New width + double h = rect[3] / 2; // New height + double[][] pieces = { + { rect[0], rect[1], w, h }, // NW + { rect[0] + w, rect[1], w, h }, // NE + { rect[0], rect[1] - h, w, h }, // SW + { rect[0] + w, rect[1] - h, w, h } // SE + }; + double total = 0; + for(double[] piece: pieces) { total += totalArea(piece, circs, d - 1); } + return total; + } + + public static double totalArea(double[][] circs, int d) { + double maxx = Double.NEGATIVE_INFINITY; + double minx = Double.POSITIVE_INFINITY; + double maxy = Double.NEGATIVE_INFINITY; + double miny = Double.POSITIVE_INFINITY; + // Find the extremes of x and y for this set of circles. + for(double[] circ: circs) { + if(circ[0] + circ[2] > maxx) { maxx = circ[0] + circ[2]; } + if(circ[0] - circ[2] < minx) { minx = circ[0] - circ[2]; } + if(circ[1] + circ[2] > maxy) { maxy = circ[1] + circ[2]; } + if(circ[1] - circ[2] < miny) { miny = circ[1] - circ[2]; } + } + double[] rect = { minx, maxy, maxx - minx, maxy - miny }; + surelyOutside = new boolean[circs.length]; + return totalArea(rect, circs, d); + } + + public static void main(String[] args) { + double[][] circs = { + { 1.6417233788, 1.6121789534, 0.0848270516 }, + {-1.4944608174, 1.2077959613, 1.1039549836 }, + { 0.6110294452, -0.6907087527, 0.9089162485 }, + { 0.3844862411, 0.2923344616, 0.2375743054 }, + {-0.2495892950, -0.3832854473, 1.0845181219 }, + {1.7813504266, 1.6178237031, 0.8162655711 }, + {-0.1985249206, -0.8343333301, 0.0538864941 }, + {-1.7011985145, -0.1263820964, 0.4776976918 }, + {-0.4319462812, 1.4104420482, 0.7886291537 }, + {0.2178372997, -0.9499557344, 0.0357871187 }, + {-0.6294854565, -1.3078893852, 0.7653357688 }, + {1.7952608455, 0.6281269104, 0.2727652452 }, + {1.4168575317, 1.0683357171, 1.1016025378 }, + {1.4637371396, 0.9463877418, 1.1846214562 }, + {-0.5263668798, 1.7315156631, 1.4428514068 }, + {-1.2197352481, 0.9144146579, 1.0727263474 }, + {-0.1389358881, 0.1092805780, 0.7350208828 }, + {1.5293954595, 0.0030278255, 1.2472867347 }, + {-0.5258728625, 1.3782633069, 1.3495508831 }, + {-0.1403562064, 0.2437382535, 1.3804956588 }, + {0.8055826339, -0.0482092025, 0.3327165165 }, + {-0.6311979224, 0.7184578971, 0.2491045282 }, + {1.4685857879, -0.8347049536, 1.3670667538 }, + {-0.6855727502, 1.6465021616, 1.0593087096 }, + {0.0152957411, 0.0638919221, 0.9771215985 } + }; + double ans = totalArea(circs, 24); + System.out.println("Approx. area is " + ans); + System.out.println("Error is " + Math.abs(21.56503660 - ans)); + } +} diff --git a/Task/Total-circles-area/REXX/total-circles-area-1.rexx b/Task/Total-circles-area/REXX/total-circles-area-1.rexx index 49ad8b483e..eec8950bbc 100644 --- a/Task/Total-circles-area/REXX/total-circles-area-1.rexx +++ b/Task/Total-circles-area/REXX/total-circles-area-1.rexx @@ -1,7 +1,7 @@ -/*REXX pgm calculates the total area of (possibly overlapping) circles. */ -parse arg box . /*obtain possible #boxes from CL.*/ -if box=='' then box=500 /*allow specification of # boxes.*/ -numeric digits 15 /*ensure enough digits for points*/ +/*REXX program calculates the total area of (possibly overlapping) circles. */ +parse arg box dig . /*obtain optional argument from the CL.*/ +if box=='' | box==',' then box= 500 /*Not specified? Then use the default.*/ +if dig=='' | dig==',' then dig= 12 /* " " " " " " */ data = ' 1.6417233788 1.6121789534 0.0848270516', '-1.4944608174 1.2077959613 1.1039549836', ' 0.6110294452 -0.6907087527 0.9089162485', @@ -28,8 +28,8 @@ numeric digits 15 /*ensure enough digits for points*/ '-0.6855727502 1.6465021616 1.0593087096', ' 0.0152957411 0.0638919221 0.9771215985' circles=words(data)%3 /* ══x══ ══y══ ══radius══ */ -parse var data minX minY . 1 maxX maxY . /*assign some min & max vals.*/ - do j=1 for circles; _=j*3-2 /*assign circles with datam. */ +parse var data minX minY . 1 maxX maxY . /*assign minimum & maximum values.*/ + do j=1 for circles; _=j*3-2 /*assign some circles with datum. */ @x.j=word(data,_); @y.j=word(data,_+1) @r.j=word(data,_+2); @rr.j=@r.j**2 minX=min(minX, @x.j-@r.j); maxX=max(maxX, @x.j+@r.j) @@ -37,13 +37,14 @@ parse var data minX minY . 1 maxX maxY . /*assign some min & max vals.*/ end /*j*/ dx=(maxX-minX) / box dy=(maxY-minY) / box -#=0 /*count of sample points. */ - do row=0 to box; y=minY+row*dy /*process the grid rows. */ - do col=0 to box; x=minX+col*dx /*process the grid cols. */ - do k=1 for circles /*now process each circle. */ - if (x-@x.k)**2+(y-@y.k)**2 <= @rr.k then do; #=#+1; leave; end +#=0 /*count of sample points (so far).*/ + do row=0 to box; y=minY+row*dy /*process each of the grid rows. */ + do col=0 to box; x=minX+col*dx /* " " " " " column.*/ + do k=1 for circles /*now process each new circle. */ + if (x-@x.k)**2+(y-@y.k)**2 <= @rr.k then do; #=#+1; leave; end end /*k*/ end /*col*/ end /*row*/ - /*stick a fork in it, we're done.*/ -say 'The approximate area is: ' #*dx*dy " using" box**2 "points." + /*stick a fork in it, we're done. */ +say 'Using ' box " boxes (which have " box**2 ' points) and ' dig " decimal digits," +say 'the approximate area is: ' #*dx*dy diff --git a/Task/Total-circles-area/REXX/total-circles-area-2.rexx b/Task/Total-circles-area/REXX/total-circles-area-2.rexx index 452073d723..06cbd85748 100644 --- a/Task/Total-circles-area/REXX/total-circles-area-2.rexx +++ b/Task/Total-circles-area/REXX/total-circles-area-2.rexx @@ -1,83 +1,68 @@ -/*REXX pgm calculates the total area of (possibly overlapping) circles. */ -parse arg box . /*obtain possible #boxes from CL.*/ -if box=='' then box=-500 /*allow specification of # boxes,*/ -verbose= box<0 /*set a flag if in verbose mode. */ -box=abs(box); boxen=box+1 /*use |box| value from here on.*/ -numeric digits 15 /*ensure enough digits for points*/ - data = ' 1.6417233788 1.6121789534 0.0848270516', - '-1.4944608174 1.2077959613 1.1039549836', - ' 0.6110294452 -0.6907087527 0.9089162485', - ' 0.3844862411 0.2923344616 0.2375743054', - '-0.2495892950 -0.3832854473 1.0845181219', - ' 1.7813504266 1.6178237031 0.8162655711', - '-0.1985249206 -0.8343333301 0.0538864941', - '-1.7011985145 -0.1263820964 0.4776976918', - '-0.4319462812 1.4104420482 0.7886291537', - ' 0.2178372997 -0.9499557344 0.0357871187', - '-0.6294854565 -1.3078893852 0.7653357688', - ' 1.7952608455 0.6281269104 0.2727652452', - ' 1.4168575317 1.0683357171 1.1016025378', - ' 1.4637371396 0.9463877418 1.1846214562', - '-0.5263668798 1.7315156631 1.4428514068', - '-1.2197352481 0.9144146579 1.0727263474', - '-0.1389358881 0.1092805780 0.7350208828', - ' 1.5293954595 0.0030278255 1.2472867347', - '-0.5258728625 1.3782633069 1.3495508831', - '-0.1403562064 0.2437382535 1.3804956588', - ' 0.8055826339 -0.0482092025 0.3327165165', - '-0.6311979224 0.7184578971 0.2491045282', - ' 1.4685857879 -0.8347049536 1.3670667538', - '-0.6855727502 1.6465021616 1.0593087096', - ' 0.0152957411 0.0638919221 0.9771215985' -circles=words(data)%3 /* ══x══ ══y══ ══radius══ */ -if verbose then say 'There are' circles "circles." -parse var data minX minY . 1 maxX maxY . /*assign some min & max vals.*/ +/*REXX program calculates the total area of (possibly overlapping) circles. */ +parse arg box dig . /*obtain optional argument from the CL.*/ +if box=='' | box==',' then box= -500 /*Not specified? Then use the default.*/ +if dig=='' | dig==',' then dig= 12 /* " " " " " " */ +verbose= box<0; box=abs(box); boxen=box+1 /*set a flag if we're in verbose mode. */ +numeric digits dig /*have enough decimal digits for points*/ +/* ══════x══════ ══════y══════ ═══radius═══ ══════x══════ ══════y══════ ═══radius═══*/ +$=' 1.6417233788 1.6121789534 0.0848270516 -1.4944608174 1.2077959613 1.1039549836', + ' 0.6110294452 -0.6907087527 0.9089162485 0.3844862411 0.2923344616 0.2375743054', + '-0.2495892950 -0.3832854473 1.0845181219 1.7813504266 1.6178237031 0.8162655711', + '-0.1985249206 -0.8343333301 0.0538864941 -1.7011985145 -0.1263820964 0.4776976918', + '-0.4319462812 1.4104420482 0.7886291537 0.2178372997 -0.9499557344 0.0357871187', + '-0.6294854565 -1.3078893852 0.7653357688 1.7952608455 0.6281269104 0.2727652452', + ' 1.4168575317 1.0683357171 1.1016025378 1.4637371396 0.9463877418 1.1846214562', + '-0.5263668798 1.7315156631 1.4428514068 -1.2197352481 0.9144146579 1.0727263474', + '-0.1389358881 0.1092805780 0.7350208828 1.5293954595 0.0030278255 1.2472867347', + '-0.5258728625 1.3782633069 1.3495508831 -0.1403562064 0.2437382535 1.3804956588', + ' 0.8055826339 -0.0482092025 0.3327165165 -0.6311979224 0.7184578971 0.2491045282', + ' 1.4685857879 -0.8347049536 1.3670667538 -0.6855727502 1.6465021616 1.0593087096', + ' 0.0152957411 0.0638919221 0.9771215985 ' /*define circles with X, Y, and R.*/ +circles=words($) % 3 /*figure out how many circles. */ +if verbose then say 'There are' circles "circles." /*display the number of circles. */ +parse var $ minX minY . 1 maxX maxY . /*assign minimum & maximum values.*/ - do j=1 for circles; _=j*3-2 /*assign circles with datam. */ - @x.j=word(data,_); @y.j=word(data,_+1) - @r.j=word(data,_+2)/1; @rr.j=@r.j**2 - minX=min(minX, @x.j-@r.j); maxX=max(maxX, @x.j+@r.j) - minY=min(minY, @y.j-@r.j); maxY=max(maxY, @y.j+@r.j) - end /*j*/ + do j=1 for circles; _=j*3-2 /*assign some circles with datum. */ + @x.j=word($, _); @y.j=word($, _ + 1) + @r.j=word($, _ + 2)/1; @rr.j=@r.j**2 + minX=min(minX, @x.j - @r.j); maxX=max(maxX, @x.j + @r.j) + minY=min(minY, @y.j - @r.j); maxY=max(maxY, @y.j + @r.j) + end /*j*/ - do m=1 for circles /*sort the circles by radii. */ - do n=m+1 to circles /*sort by descending radii. */ + do m=1 for circles /*sort the circles by their radii.*/ + do n=m+1 to circles /* [↓] sort by descending radii.*/ if @r.n>@r.m then parse value @x.n @y.n @r.n @x.m @y.m @r.m with, @x.m @y.m @r.m @x.n @y.n @r.n - end /*n*/ /* [↑] Higher? Then swap.*/ + end /*n*/ /* [↑] Is it higher? Then swap.*/ end /*m*/ -dx=(maxX-minX) / box -dy=(maxY-minY) / box -w=length(circles); #in=0 /*#in►fully contained circles*/ -isIn@ = ' is contained in circle ' /* [↓] find contained circles*/ +dx=(maxX-minX) / box; dy=(maxY-minY) / box /*compute the DX and DY values*/ +w=length(circles) /*# in ►─ fully contained circles.*/ +#in=0 + do j=1 for circles /*traipse through the J circles.*/ + do k=1 for circles; if k==j | @r.j==0 then iterate /*ignore self and/or 0*/ + if k==j | @r.j==0 then iterate /*ignore self and/or zero radius.*/ + if @y.j+@r.j > @y.k+@r.k | @x.j-@r.j < @x.k-@r.k |, /*is J inside K?*/ + @y.j-@r.j < @y.k-@r.k | @x.j+@r.j > @x.k+@r.k then iterate + if verbose then say 'Circle ' right(j,w) ' is contained in circle ' right(k,w) + @r.j=0; #in=#in+1 /*elide this circle; and bump # in*/ + end /*k*/ + end /*j*/ /* [↑] elided overlapping circle.*/ - do j=1 for circles /*traipse through J circles*/ - do k=1 for circles /* " " K " */ - if k==j | @r.j==0 then iterate /*ignore self or zero radius.*/ - if @y.j+@r.j > @y.k+@r.k then iterate /*is cir J outside cir K?*/ - if @x.j-@r.j < @x.k-@r.k then iterate /* " " " " " " */ - if @y.j-@r.j < @y.k-@r.k then iterate /* " " " " " " */ - if @x.j+@r.j > @x.k+@r.k then iterate /* " " " " " " */ - if verbose then say 'Circle ' right(j,w) isIn@ right(k,w) - @r.j=0; #in=#in+1 /*elide this circle; bump #in*/ - end /*k*/ - end /*j*/ /* [↑] elided overlapping cir*/ - -if #in==0 then #in='no' /*use gooder English. (joke)*/ -if verbose then say #in "circles are fully contained within other circles." -nC=0 /*number of "new" circles. */ - do n=1 for circles; if @r.n==0 then iterate /*skip if 0.*/ +if #in==0 then #in= 'no' /*use gooder English. (humor). */ +if verbose then do; say; say #in " circles are fully contained within other circles.";end +nC=0 /*number of "new" circles. */ + do n=1 for circles; if @r.n==0 then iterate /*skip if zero.*/ nC=nC+1; @x.nC=@x.n; @y.nC=@y.n; @r.nC=@r.n; @rr.nC=@r.n**2 - end /*n*/ /* [↑] elide overlapping cir*/ -#=0 /*the count of sample points.*/ - do row=0 for boxen; y=minY+row*dy /*process each grid row. */ - do col=0 for boxen; x=minX+col*dx /* " " " column. */ - do k=1 for nC /*now process each new circle*/ - if (x-@x.k)**2+(y-@y.k)**2 <= @rr.k then do; #=#+1; leave; end - end /*k*/ - end /*col*/ - end /*row*/ -say -say 'The approximate area is: ' #*dx*dy " using" box**2 "points." - /*stick a fork in it, we're done.*/ + end /*n*/ /* [↑] elide overlapping circles.*/ +#=0 /*count of sample points (so far).*/ + do row=0 for boxen; y=minY + row*dy /*process each of the grid row. */ + do col=0 for boxen; x=minX + col*dx /* " " " " " column.*/ + do k=1 for nC /*now process each new circle. */ + if (x - @x.k)**2 + (y - @y.k)**2 <= @rr.k then do; #=#+1; leave; end + end /*k*/ + end /*col*/ + end /*row*/ +say /*stick a fork in it, we're done. */ +say 'Using ' box " boxes (which have " box**2 ' points) and ' dig " decimal digits," +say 'the approximate area is: ' #*dx*dy diff --git a/Task/Towers-of-Hanoi/00DESCRIPTION b/Task/Towers-of-Hanoi/00DESCRIPTION index dd0e7ca3e6..9bb3286a90 100644 --- a/Task/Towers-of-Hanoi/00DESCRIPTION +++ b/Task/Towers-of-Hanoi/00DESCRIPTION @@ -1 +1,3 @@ -In this task, the goal is to solve the [[wp:Towers_of_Hanoi|Towers of Hanoi]] problem with recursion. +;Task: +Solve the   [[wp:Towers_of_Hanoi|Towers of Hanoi]]   problem with recursion. +

    diff --git a/Task/Towers-of-Hanoi/AppleScript/towers-of-hanoi.applescript b/Task/Towers-of-Hanoi/AppleScript/towers-of-hanoi-1.applescript similarity index 100% rename from Task/Towers-of-Hanoi/AppleScript/towers-of-hanoi.applescript rename to Task/Towers-of-Hanoi/AppleScript/towers-of-hanoi-1.applescript diff --git a/Task/Towers-of-Hanoi/AppleScript/towers-of-hanoi-2.applescript b/Task/Towers-of-Hanoi/AppleScript/towers-of-hanoi-2.applescript new file mode 100644 index 0000000000..d6f61417fa --- /dev/null +++ b/Task/Towers-of-Hanoi/AppleScript/towers-of-hanoi-2.applescript @@ -0,0 +1,53 @@ +-- hanoi :: Int -> (String, String, String) -> [(String, String)] +on hanoi(n, {a, b, c}) + if n > 0 then + hanoi(n - 1, {a, c, b}) & {{a, b}} & hanoi(n - 1, {c, b, a}) + else + {} + end if +end hanoi + + +-- TEST + +-- arrow :: (String, String) -> String +on arrow(tuple) + item 1 of tuple & " -> " & item 2 of tuple +end arrow + +on run + + map(arrow, ¬ + hanoi(3, {"left", "right", "mid"})) + + --> {"left -> right", "left -> mid", "right -> mid", "left -> right", + -- "mid -> left", "mid -> right", "left -> right"} +end run + + + +-- LIBRARY FUNCTIONS + +-- 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 + +-- 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 diff --git a/Task/Towers-of-Hanoi/Ela/towers-of-hanoi.ela b/Task/Towers-of-Hanoi/Ela/towers-of-hanoi.ela new file mode 100644 index 0000000000..88ff3f6e92 --- /dev/null +++ b/Task/Towers-of-Hanoi/Ela/towers-of-hanoi.ela @@ -0,0 +1,17 @@ +open monad io +:::IO + +//Functional approach +hanoi 0 _ _ _ = [] +hanoi n a b c = hanoi (n - 1) a c b ++ [(a,b)] ++ hanoi (n - 1) c b a + +hanoiIO n = mapM_ f $ hanoi n 1 2 3 where + f (x,y) = putStrLn $ "Move " ++ show x ++ " to " ++ show y + +//Imperative approach using IO monad +hanoiM n = hanoiM' n 1 2 3 where + hanoiM' 0 _ _ _ = return () + hanoiM' n a b c = do + hanoiM' (n - 1) a c b + putStrLn $ "Move " ++ show a ++ " to " ++ show b + hanoiM' (n - 1) c b a diff --git a/Task/Towers-of-Hanoi/Inform-7/towers-of-hanoi.inf b/Task/Towers-of-Hanoi/Inform-7/towers-of-hanoi.inf index 3e3513ca61..81bbcce1b3 100644 --- a/Task/Towers-of-Hanoi/Inform-7/towers-of-hanoi.inf +++ b/Task/Towers-of-Hanoi/Inform-7/towers-of-hanoi.inf @@ -1,7 +1,5 @@ Hanoi is a room. -A disk is a kind of supporter. - A post is a kind of supporter. A post is always fixed in place. The left post, the middle post, and the right post are posts in Hanoi. diff --git a/Task/Towers-of-Hanoi/JavaScript/towers-of-hanoi.js b/Task/Towers-of-Hanoi/JavaScript/towers-of-hanoi-1.js similarity index 100% rename from Task/Towers-of-Hanoi/JavaScript/towers-of-hanoi.js rename to Task/Towers-of-Hanoi/JavaScript/towers-of-hanoi-1.js diff --git a/Task/Towers-of-Hanoi/JavaScript/towers-of-hanoi-2.js b/Task/Towers-of-Hanoi/JavaScript/towers-of-hanoi-2.js new file mode 100644 index 0000000000..384b0f8609 --- /dev/null +++ b/Task/Towers-of-Hanoi/JavaScript/towers-of-hanoi-2.js @@ -0,0 +1,15 @@ +(function () { + + // hanoi :: n -> s -> s -> s -> [[s, s]] + function hanoi(n, a, b, c) { + return n ? hanoi(n - 1, a, c, b).concat( + [[a, b]] + ).concat(hanoi(n - 1, c, b, a)) : []; + } + + return hanoi(3, 'left', 'right', 'mid') + .map(function (d) { + return d[0] + ' -> ' + d[1]; + }); + +})(); diff --git a/Task/Towers-of-Hanoi/JavaScript/towers-of-hanoi-3.js b/Task/Towers-of-Hanoi/JavaScript/towers-of-hanoi-3.js new file mode 100644 index 0000000000..c60b593487 --- /dev/null +++ b/Task/Towers-of-Hanoi/JavaScript/towers-of-hanoi-3.js @@ -0,0 +1,4 @@ +["left -> right", "left -> mid", + "right -> mid", "left -> right", + "mid -> left", "mid -> right", + "left -> right"] diff --git a/Task/Towers-of-Hanoi/Objeck/towers-of-hanoi.objeck b/Task/Towers-of-Hanoi/Objeck/towers-of-hanoi.objeck new file mode 100644 index 0000000000..049cd840bb --- /dev/null +++ b/Task/Towers-of-Hanoi/Objeck/towers-of-hanoi.objeck @@ -0,0 +1,16 @@ +class Hanoi { + function : Main(args : String[]) ~ Nil { + Move(4, 1, 2, 3); + } + + function: Move(n:Int, f:Int, t:Int, v:Int) ~ Nil { + if(n = 1) { + "Move disk from pole {$f} to pole {$t}"->PrintLine(); + } + else { + Move(n - 1, f, v, t); + Move(1, f, t, v); + Move(n - 1, v, t, f); + }; + } +} diff --git a/Task/Towers-of-Hanoi/PARI-GP/towers-of-hanoi.pari b/Task/Towers-of-Hanoi/PARI-GP/towers-of-hanoi.pari new file mode 100644 index 0000000000..b726ef67e5 --- /dev/null +++ b/Task/Towers-of-Hanoi/PARI-GP/towers-of-hanoi.pari @@ -0,0 +1,12 @@ +\\ Towers of Hanoi +\\ 8/19/2016 aev +\\ Where: n - number of disks, sp - start pole, ep - end pole. +HanoiTowers(n,sp,ep)={ + if(n!=0, + HanoiTowers(n-1,sp,6-sp-ep); + print("Move disk ", n, " from pole ", sp," to pole ", ep); + HanoiTowers(n-1,6-sp-ep,ep); + ); +} +\\ Testing n=3: +HanoiTowers(3,1,3); diff --git a/Task/Towers-of-Hanoi/Prolog/towers-of-hanoi.pro b/Task/Towers-of-Hanoi/Prolog/towers-of-hanoi-1.pro similarity index 100% rename from Task/Towers-of-Hanoi/Prolog/towers-of-hanoi.pro rename to Task/Towers-of-Hanoi/Prolog/towers-of-hanoi-1.pro diff --git a/Task/Towers-of-Hanoi/Prolog/towers-of-hanoi-2.pro b/Task/Towers-of-Hanoi/Prolog/towers-of-hanoi-2.pro new file mode 100644 index 0000000000..6f73176f0d --- /dev/null +++ b/Task/Towers-of-Hanoi/Prolog/towers-of-hanoi-2.pro @@ -0,0 +1,17 @@ +hanoi(N, Src, Aux, Dest, Moves-NMoves) :- + NMoves is 2^N - 1, + length(Moves, NMoves), + phrase(move(N, Src, Aux, Dest), Moves). + + +move(1, Src, _, Dest) --> !, + [Src->Dest]. + +move(2, Src, Aux, Dest) --> !, + [Src->Aux,Src->Dest,Aux->Dest]. + +move(N, Src, Aux, Dest) --> + { succ(N0, N) }, + move(N0, Src, Dest, Aux), + move(1, Src, Aux, Dest), + move(N0, Aux, Src, Dest). diff --git a/Task/Towers-of-Hanoi/REXX/towers-of-hanoi-1.rexx b/Task/Towers-of-Hanoi/REXX/towers-of-hanoi-1.rexx index 51a2cf2f24..b6063c114b 100644 --- a/Task/Towers-of-Hanoi/REXX/towers-of-hanoi-1.rexx +++ b/Task/Towers-of-Hanoi/REXX/towers-of-hanoi-1.rexx @@ -1,21 +1,21 @@ -/*REXX program shows the moves to solve the Tower of Hanoi (with N disks).*/ -parse arg N . /*get optional number of disks from CL.*/ -if N=='' then N=3 /*Not given? Then use default 3 towers*/ -#=0; z=2**N - 1 /*# disk moves so far; # of min moves.*/ -call mov 1, 3, N /*move the top disk, then recurse ··· */ +/*REXX program displays the moves to solve the Tower of Hanoi (with N disks). */ +parse arg N . /*get optional number of disks from CL.*/ +if N=='' | N=="," then N=3 /*Not specified? Then use the default.*/ +#=0 /*#: the number of disk moves (so far)*/ +z=2**N - 1 /*Z: " " " minimum # of moves.*/ +call mov 1, 3, N /*move the top disk, then recurse ··· */ say -say 'The minimum number of moves to solve a ' N"-disk Tower of Hanoi is " z -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -dsk: #=#+1 /*bump the (disk) move counter by one. */ - say 'step' right(#,length(z))": move disk on tower" arg(1) '───►' arg(2) - return /* [↑] display the move message (text)*/ -/*────────────────────────────────────────────────────────────────────────────*/ -mov: procedure expose # z; parse arg @1, @2, @3 +say 'The minimum number of moves to solve a ' N"-disk Tower of Hanoi is " z +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +dsk: #=#+1 /*bump the (disk) move counter by one. */ + say 'step' right(#, length(z))": move disk on tower" arg(1) '───►' arg(2) + return /* [↑] display the move message (text)*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +mov: procedure expose # z; parse arg @1, @2, @3 if @3==1 then call dsk @1, @2 - else do - call mov @1, 6-@1-@2, @3-1 - call mov @1, @2, 1 - call mov 6-@1-@2, @2, @3-1 + else do; call mov @1, 6-@1-@2, @3-1 + call mov @1, @2, 1 + call mov 6-@1-@2, @2, @3-1 end return diff --git a/Task/Towers-of-Hanoi/REXX/towers-of-hanoi-2.rexx b/Task/Towers-of-Hanoi/REXX/towers-of-hanoi-2.rexx index c6c818562d..1de5796929 100644 --- a/Task/Towers-of-Hanoi/REXX/towers-of-hanoi-2.rexx +++ b/Task/Towers-of-Hanoi/REXX/towers-of-hanoi-2.rexx @@ -1,69 +1,65 @@ -/*REXX program shows pictorial moves to solve Tower of Hanoi (with N disks).*/ -parse arg N .; if N=='' then N=3 /*Not given? Then use default 3 disks.*/ -sw=80; wp=sw%3-1; blanks=left('',wp) /*define some default REXX variables. */ -c.1=sw%3%2 /* [↑] SW: assume default Screen Width*/ -c.2=sw%2-1 -c.3=sw-1-c.1-1 -#=0; z=2**N-1; moveK=z /*#moves; min# of moves; where to move.*/ -@abc='abcdefghijklmnopqrstuvwxyN' /*dithering chars when many disks used.*/ -ebcdic= ('f0'x==0) /*determine if EBCDIC or ASCII machine.*/ +/*REXX program displays the moves to solve the Tower of Hanoi (with N disks). */ +parse arg N . /*get optional number of disks from CL.*/ +if N=='' | N=="," then N=3 /*Not specified? Then use the default.*/ +sw=80; wp=sw%3-1; blanks=left('', wp) /*define some default REXX variables. */ +c.1= sw % 3 % 2 /* [↑] SW: assume default Screen Width*/ +c.2= sw % 2 - 1 +c.3= sw - 1 - c.1 - 1 +#=0; z=2**N-1; moveK=z /*#moves; min# of moves; where to move.*/ +@abc='abcdefghijklmnopqrstuvwxyN' /*dithering chars when many disks used.*/ +ebcdic= ('f0'x==0) /*determine if EBCDIC or ASCII machine.*/ -if ebcdic then do; bar='bf'x; ar="df"x; boxen='db9f9caf'x; down="9a"x - tr='bc'x; bl="ab"x; br='bb'x; vert="fa"x; tl='ac'x +if ebcdic then do; bar= 'bf'x; ar= "df"x; boxen= 'db9f9caf'x; down= "9a"x + tr= 'bc'x; bl= "ab"x; br= 'bb'x; vert= "fa"x; tl= 'ac'x end - else do; bar='c4'x; ar="10"x; boxen='b0b1b2db'x; down="18"x - tr='bf'x; bl="c0"x; br='d9'x; vert="b3"x; tl='da'x + else do; bar= 'c4'x; ar= "10"x; boxen= 'b0b1b2db'x; down= "18"x + tr= 'bf'x; bl= "c0"x; br= 'd9'x; vert= "b3"x; tl= 'da'x end -verts= vert || vert; Tcorners= tl || tr -downs= down || down; Bcorners= bl || br -box = left(boxen,1); boxChars= boxen || @abc -$.=0; $.1=N; k=N; kk=k+k +verts= vert || vert; Tcorners= tl || tr +downs= down || down; Bcorners= bl || br +box = left(boxen, 1); boxChars= boxen || @abc +$.=0; $.1=N; k=N; kk=k+k - do j=1 for N; @.3.j=blanks; @.2.j=blanks; @.1.j=center(copies(box,kk),wp) - if N<=length(boxChars) then @.1.j=translate(@.1.j,,substr(boxChars,kk%2,1),box) - kk=kk-2 - end /*j*/ /*populate the tower of Hanoi spindles.*/ + do j=1 for N; @.3.j=blanks; @.2.j=blanks; @.1.j=center( copies( box, kk), wp) + if N<=length(boxChars) then @.1.j= translate(@.1.j, , substr( boxChars, kk%2, 1), box) + kk=kk - 2 + end /*j*/ /*populate the tower of Hanoi spindles.*/ -call showtowers; call mov 1,3,N; say -say 'The minimum number of moves to solve a ' N"-disk Tower of Hanoi is " z -exit -/*─────────────────────────────MOV subroutine─────────────────────────────────*/ +call showTowers; call mov 1,3,N; say +say 'The minimum number of moves to solve a ' N"-disk Tower of Hanoi is " z +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +dsk: parse arg from dest; #=#+1; pp= + if from==1 then do; pp=overlay(bl, pp, c.1) + pp=overlay(bar, pp, c.1+1, c.dest-c.1-1, bar) || tr + end + if from==2 then do + lpost=min(2, dest) + hpost=max(2, dest) + if dest==1 then do; pp=overlay(tl, pp, c.1) + pp=overlay(bar, pp, c.1+1, c.2-c.1-1, bar)||br + end + if dest==3 then do; pp=overlay(bl, pp, c.2) + pp=overlay(bar, pp, c.2+1, c.3-c.2-1, bar)||tr + end + end + if from==3 then do; pp=overlay(br, pp, c.3) + pp=overlay(bar, pp, c.dest+1, c.3-c.dest-1, bar) + pp=overlay(tl, pp, c.dest) + end + say translate(pp, downs, Bcorners || Tcorners || bar); say overlay(moveK,pp,1) + say translate(pp, verts, Tcorners || Bcorners || bar) + say translate(pp, downs, Tcorners || Bcorners || bar); moveK=moveK-1 + $.from=$.from-1; $.dest=$.dest+1; _f=$.from+1; _t=$.dest + @.dest._t=@.from._f; @.from._f=blanks; call showTowers + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ mov: if arg(3)==1 then call dsk arg(1) arg(2) else do; call mov arg(1), 6-arg(1)-arg(2), arg(3)-1 call mov arg(1), arg(2), 1 call mov 6-arg(1)-arg(2), arg(2), arg(3)-1 end -return -/*─────────────────────────────DSK subroutine─────────────────────────────────*/ -dsk: parse arg from dest; #=#+1; pp= -if from==1 then do - pp=overlay(bl, pp, c.1) - pp=overlay(bar, pp, c.1+1, c.dest-c.1-1, bar) || tr - end -if from==2 then do - lpost=min(2, dest) - hpost=max(2, dest) - if dest==1 then do - pp=overlay(tl, pp, c.1) - pp=overlay(bar, pp, c.1+1, c.2-c.1-1, bar)||br - end - if dest==3 then do - pp=overlay(bl, pp,c.2) - pp=overlay(bar, pp,c.2+1, c.3-c.2-1, bar) ||tr - end - end -if from==3 then do - pp=overlay(br, pp, c.3) - pp=overlay(bar, pp, c.dest+1, c.3-c.dest-1, bar) - pp=overlay(tl, pp, c.dest) - end -say translate(pp, downs, Bcorners || Tcorners || bar); say overlay(moveK,pp,1) -say translate(pp, verts, Tcorners || Bcorners || bar) -say translate(pp, downs, Tcorners || Bcorners || bar); moveK=moveK-1 -$.from=$.from-1; $.dest=$.dest+1; _f=$.from+1; _t=$.dest -@.dest._t=@.from._f; @.from._f=blanks; call showtowers -return -/*─────────────────────────────SHOWTOWERS subroutine──────────────────────────*/ -showtowers: do j=N by -1 for N; _=@.1.j @.2.j @.3.j; if _\='' then say _; end - return + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +showTowers: do j=N by -1 for N; _=@.1.j @.2.j @.3.j; if _\='' then say _; end; return diff --git a/Task/Trabb-Pardo-Knuth-algorithm/00DESCRIPTION b/Task/Trabb-Pardo-Knuth-algorithm/00DESCRIPTION index 2c882a9a18..8a21a17f6b 100644 --- a/Task/Trabb-Pardo-Knuth-algorithm/00DESCRIPTION +++ b/Task/Trabb-Pardo-Knuth-algorithm/00DESCRIPTION @@ -14,10 +14,11 @@ From the [[wp:Trabb Pardo–Knuth algorithm|wikipedia entry]]: '''print''' ''result'' The task is to implement the algorithm: -# Use the function f(x) = |x|^{0.5} + 5x^3 +# Use the function:     f(x) = |x|^{0.5} + 5x^3 # The overflow condition is an answer of greater than 400. # The 'user alert' should not stop processing of other items of the sequence. # Print a prompt before accepting '''eleven''', textual, numeric inputs. # You may optionally print the item as well as its associated result, but the results must be in reverse order of input. # The sequence S may be 'implied' and so not shown explicitly. # ''Print and show the program in action from a typical run here''. (If the output is graphical rather than text then either add a screendump or describe textually what is displayed). +

    diff --git a/Task/Trabb-Pardo-Knuth-algorithm/Ela/trabb-pardo-knuth-algorithm.ela b/Task/Trabb-Pardo-Knuth-algorithm/Ela/trabb-pardo-knuth-algorithm.ela index fd6005d602..f68e13881e 100644 --- a/Task/Trabb-Pardo-Knuth-algorithm/Ela/trabb-pardo-knuth-algorithm.ela +++ b/Task/Trabb-Pardo-Knuth-algorithm/Ela/trabb-pardo-knuth-algorithm.ela @@ -1,15 +1,24 @@ -open random number list console format read +open monad io number string -run () = - writen "Please enter 11 numbers:" $ - xs () |> iter - where xs () = [0..10] |> map (\_ -> readStr <| readn ()) - f x = sqrt (toSingle x) + 5.0 * (x ** 3.0) +:::IO + +take_numbers 0 xs = do + return $ iter xs + where f x = sqrt (toSingle x) + 5.0 * (x ** 3.0) p x = x < 400.0 - iter [] = () + iter [] = return () iter (x::xs) - | p res = printfn "f({0}) = {1}" x res $ iter xs - | else = printfn "f({0}) :: Overflow" x $ iter xs + | p res = do + putStrLn (format "f({0}) = {1}" x res) + iter xs + | else = do + putStrLn (format "f({0}) :: Overflow" x) + iter xs where res = f x +take_numbers n xs = do + x <- readAny + take_numbers (n - 1) (x::xs) -run () +do + putStrLn "Please enter 11 numbers:" + take_numbers 11 [] diff --git a/Task/Trabb-Pardo-Knuth-algorithm/Elixir/trabb-pardo-knuth-algorithm.elixir b/Task/Trabb-Pardo-Knuth-algorithm/Elixir/trabb-pardo-knuth-algorithm.elixir new file mode 100644 index 0000000000..f6a115d2d2 --- /dev/null +++ b/Task/Trabb-Pardo-Knuth-algorithm/Elixir/trabb-pardo-knuth-algorithm.elixir @@ -0,0 +1,24 @@ +defmodule Trabb_Pardo_Knuth do + def task do + Enum.reverse( get_11_numbers ) + |> Enum.each( fn x -> perform_operation( &function(&1), 400, x ) end ) + end + + defp alert( n ), do: IO.puts "Operation on #{n} overflowed" + + defp get_11_numbers do + ns = IO.gets( "Input 11 integers. Space delimited, please: " ) + |> String.split + |> Enum.map( &String.to_integer &1 ) + if 11 == length( ns ), do: ns, else: get_11_numbers + end + + defp function( x ), do: :math.sqrt( abs(x) ) + 5 * :math.pow( x, 3 ) + + defp perform_operation( fun, overflow, n ), do: perform_operation_check_overflow( n, fun.(n), overflow ) + + defp perform_operation_check_overflow( n, result, overflow ) when result > overflow, do: alert( n ) + defp perform_operation_check_overflow( n, result, _overflow ), do: IO.puts "f(#{n}) => #{result}" +end + +Trabb_Pardo_Knuth.task diff --git a/Task/Trabb-Pardo-Knuth-algorithm/Go/trabb-pardo-knuth-algorithm.go b/Task/Trabb-Pardo-Knuth-algorithm/Go/trabb-pardo-knuth-algorithm-1.go similarity index 86% rename from Task/Trabb-Pardo-Knuth-algorithm/Go/trabb-pardo-knuth-algorithm.go rename to Task/Trabb-Pardo-Knuth-algorithm/Go/trabb-pardo-knuth-algorithm-1.go index ba1977a161..35d90bbd16 100644 --- a/Task/Trabb-Pardo-Knuth-algorithm/Go/trabb-pardo-knuth-algorithm.go +++ b/Task/Trabb-Pardo-Knuth-algorithm/Go/trabb-pardo-knuth-algorithm-1.go @@ -12,7 +12,7 @@ func main() { // accept sequence var s [11]float64 for i := 0; i < 11; { - if _, err := fmt.Scanf("%f", &s[i]); err == nil { + if n, _ := fmt.Scan(&s[i]); n > 0 { i++ } } @@ -33,6 +33,6 @@ func main() { } func f(x float64) (float64, bool) { - result := math.Pow(math.Abs(x), .5) + 5*x*x*x + result := math.Sqrt(math.Abs(x)) + 5*x*x*x return result, result > 400 } diff --git a/Task/Trabb-Pardo-Knuth-algorithm/Go/trabb-pardo-knuth-algorithm-2.go b/Task/Trabb-Pardo-Knuth-algorithm/Go/trabb-pardo-knuth-algorithm-2.go new file mode 100644 index 0000000000..f049e8be26 --- /dev/null +++ b/Task/Trabb-Pardo-Knuth-algorithm/Go/trabb-pardo-knuth-algorithm-2.go @@ -0,0 +1,24 @@ +package main + +import ( + "fmt" + "math" +) + +func f(t float64) float64 { + return math.Sqrt(math.Abs(t)) + 5*math.Pow(t, 3) +} + +func main() { + var a [11]float64 + for i := range a { + fmt.Scan(&a[i]) + } + for i := len(a) - 1; i >= 0; i-- { + if y := f(a[i]); y > 400 { + fmt.Println(i, "TOO LARGE") + } else { + fmt.Println(i, y) + } + } +} diff --git a/Task/Trabb-Pardo-Knuth-algorithm/Lua/trabb-pardo-knuth-algorithm-1.lua b/Task/Trabb-Pardo-Knuth-algorithm/Lua/trabb-pardo-knuth-algorithm-1.lua new file mode 100644 index 0000000000..2d8f833b71 --- /dev/null +++ b/Task/Trabb-Pardo-Knuth-algorithm/Lua/trabb-pardo-knuth-algorithm-1.lua @@ -0,0 +1,18 @@ +function f (x) return math.abs(x)^0.5 + 5*x^3 end + +function reverse (t) + local rev = {} + for i, v in ipairs(t) do rev[#t - (i-1)] = v end + return rev +end + +local sequence, result = {} +print("Enter 11 numbers...") +for n = 1, 11 do + io.write(n .. ": ") + sequence[n] = io.read() +end +for _, x in ipairs(reverse(sequence)) do + result = f(x) + if result > 400 then print("Overflow!") else print(result) end +end diff --git a/Task/Trabb-Pardo-Knuth-algorithm/Lua/trabb-pardo-knuth-algorithm-2.lua b/Task/Trabb-Pardo-Knuth-algorithm/Lua/trabb-pardo-knuth-algorithm-2.lua new file mode 100644 index 0000000000..80ce62228c --- /dev/null +++ b/Task/Trabb-Pardo-Knuth-algorithm/Lua/trabb-pardo-knuth-algorithm-2.lua @@ -0,0 +1,10 @@ +local a, y = {} +function f (t) + return math.sqrt(math.abs(t)) + 5*t^3 +end +for i = 0, 10 do a[i] = io.read() end +for i = 10, 0, -1 do + y = f(a[i]) + if y > 400 then print(i, "TOO LARGE") + else print(i, y) end +end diff --git a/Task/Trabb-Pardo-Knuth-algorithm/REXX/trabb-pardo-knuth-algorithm.rexx b/Task/Trabb-Pardo-Knuth-algorithm/REXX/trabb-pardo-knuth-algorithm.rexx index 09fb34a819..fd38fa70f8 100644 --- a/Task/Trabb-Pardo-Knuth-algorithm/REXX/trabb-pardo-knuth-algorithm.rexx +++ b/Task/Trabb-Pardo-Knuth-algorithm/REXX/trabb-pardo-knuth-algorithm.rexx @@ -1,45 +1,50 @@ -/*REXX program to implement the Trabb─Pardo-Knuth algorithm for N numbers.*/ -N=11 /*N is the number of numbers to be used*/ -maxValue=400 /*the maximum value f(x) can have. */ -compDigs=200 /*compute with this many decimal digits*/ -showDigs=20 /* ··· but only show this many digits.*/ -numeric digits compDigs /*the number of digits precision to use*/ -say ' _____ ' /*vinculum.*/ +/*REXX program implements the Trabb─Pardo-Knuth algorithm for N numbers (default is 11).*/ +parse arg N .; if N=='' | N=="," then N=11 /*Not specified? Then use the default.*/ +maxValue=400 /*the maximum value f(x) can have. */ + wid= 20 /* ··· but only show this many digits.*/ + frac= 5 /* ··· show this # of fractional digs.*/ +numeric digits 200 /*the number of digits precision to use*/ +say ' _____ ' /* ◄───── display a vinculum.*/ say 'function: ƒ(x) ≡ √ │x│ + (5 * x^3)' -prompt= 'enter ' N " numbers for the Trabb─Pardo─Knuth algorithm: (or Quit)" +prompt= 'enter ' N " numbers for the Trabb─Pardo─Knuth algorithm: (or Quit)" + /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒ */ - do ask=0; say; say prompt; say; pull $; say /* ▒ */ - if abbrev('QUIT',$,1) then exit /*does the user want to QUIT this pgm? */ /* ▒ */ + do ask=0; say; say prompt; say; pull $; say /* ▒ */ + if abbrev('QUIT',$,1) then do; say 'quitting.'; exit 1; end /* ▒ */ ok=0 /* ▒ */ - select /*validate that there are N numbers. */ /* ▒ */ - when $='' then say 'no numbers entered' /* ▒ */ - when words($)N then say 'too many numbers entered' /* ▒ */ + select /*validate there're N numbers.*/ /* ▒ */ + when $='' then say "no numbers entered" /* ▒ */ + when words($)N then say "too many numbers entered" /* ▒ */ otherwise ok=1 /* ▒ */ end /*select*/ /* ▒ */ - if \ok then iterate /* [↓] is max width*/ /* ▒ */ + if \ok then iterate /* [↓] is max width.*/ /* ▒ */ w=0; do v=1 for N; _=word($,v); w=max(w,length(_)) /* ▒ */ - if datatype(_,'N') then iterate /*numeric ? */ /* ▒ */ + if datatype(_,'N') then iterate /*numeric ? */ /* ▒ */ say _ "isn't numeric"; iterate ask /* ▒ */ end /*v*/ /* ▒ */ leave /* ▒ */ end /*ask*/ /* ▒ */ -say 'numbers entered: ' $; say /* ▒ */ /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒ */ - do i=N by -1 to 1; #=word($,i)/1 /*process nums in reverse. */ - numeric digits compDigs; g=f(#) /*for func. ƒ, use big digs*/ - numeric digits showdigs; g=g/1 /*scale down output digits.*/ - gw=right('ƒ('#") ",w+7) /*nice formatted ƒ(number)*/ - if g>maxValue then say gw "is > " maxValue ' ['g"]" - else say gw " = " g /*display the (good) result*/ - end /*i*/ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -f: procedure; parse arg x; return sqrt(abs(x)) + 5 * x**3 -/*────────────────────────────────────────────────────────────────────────────*/ -sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); i=; m.=9 - numeric digits 9; numeric form; h=d+6; if x<0 then do; x=-x; i='i'; end - parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_%2 - do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ - do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ - numeric digits d; return (g/1)i /*make complex if X < 0.*/ + +say 'numbers entered: ' $ +say + do i=N by -1 to 1; #=word($,i)/1 /*process the numbers in reverse. */ + g = fmt( f( # ) ) /*invoke function ƒ with arg number.*/ + gw=right( 'ƒ('#") ", w+7) /*nicely formatted ƒ(number). */ + if g>maxValue then say gw "is > " maxValue ' ['space(g)"]" + else say gw " = " g + end /*i*/ /* [+] display the result to terminal.*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +f: procedure; parse arg x; return sqrt( abs(x) ) + 5 * x**3 +/*──────────────────────────────────────────────────────────────────────────────────────*/ +fmt: z=right(translate(format(arg(1),wid,frac),'e',"E"),wid) /*right adjust; use e*/ + if pos(.,z)\==0 then z=left(strip(strip(z,'T',0),"T",.),wid) /*strip trailing 0 &.*/ + return right(z,wid-4*(pos('e',z)==0)) /*adjust: no exponent*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); m.=9; numeric form; h=d+6 + numeric digits; parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g *.5'e'_ % 2 + do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/ + do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/ + return g diff --git a/Task/Tree-traversal/00DESCRIPTION b/Task/Tree-traversal/00DESCRIPTION index bc2bd2b9a4..b1d92ee315 100644 --- a/Task/Tree-traversal/00DESCRIPTION +++ b/Task/Tree-traversal/00DESCRIPTION @@ -1,4 +1,12 @@ -Implement a binary tree where each node carries an integer, and implement preoder, inorder, postorder and level-order [[wp:Tree traversal|traversal]]. Use those traversals to output the following tree: +;Task: +Implement a binary tree where each node carries an integer,   and implement: +:::*   pre-order, +:::*   in-order, +:::*   post-order,     and +:::*   level-order   [[wp:Tree traversal|traversal]]. + + +Use those traversals to output the following tree: 1 / \ / \ @@ -15,4 +23,7 @@ The correct output should look like this: postorder: 7 4 5 2 8 9 6 3 1 level-order: 1 2 3 4 5 6 7 8 9 -[[wp:Tree traversal|This article]] has more information on traversing trees. + +;See also: +*   Wikipedia article:   [[wp:Tree traversal|Tree traversal]]. +

    diff --git a/Task/Tree-traversal/AppleScript/tree-traversal-1.applescript b/Task/Tree-traversal/AppleScript/tree-traversal-1.applescript new file mode 100644 index 0000000000..aa3c8793c5 --- /dev/null +++ b/Task/Tree-traversal/AppleScript/tree-traversal-1.applescript @@ -0,0 +1,88 @@ +on run + set tree to {1, {2, {4, {7}, {}}, {5}}, {3, {6, {8}, {9}}, {}}} + + return {|pre-order|:¬ + traverse("pre-order", tree), |in-order|:¬ + traverse("in-order", tree), |post-order|:¬ + traverse("post-order", tree), |level-order|:¬ + traverse("level-order", tree)} + +end run + +-- traverse :: String -> Tree -> [Int] +on traverse(strOrderName, tree) + if strOrderName does not start with "level" then + set {v, l, r} to nodeParts(tree) + + if l is {} then + set lstLeft to [] + else + set lstLeft to traverse(strOrderName, l) + end if + + if r is {} then + set lstRight to [] + else + set lstRight to traverse(strOrderName, r) + end if + + -- PRE-ORDER + if strOrderName begins with "pre" then + v & lstLeft & lstRight + + -- IN-ORDER + else if strOrderName begins with "in" then + lstLeft & v & lstRight + + -- POST-ORDER + else if strOrderName begins with "post" then + lstLeft & lstRight & v + + end if + else + -- LEVEL-ORDER + levelOrder({tree}) + end if +end traverse + + +-- levelOrder :: [Tree] -> [Int] +on levelOrder(lstTree) + if length of lstTree > 0 then + set {head, tail} to uncons(lstTree) + + -- Take any value found in the head node + -- deferring any child nodes to the end of the tail + -- before recursing + + if head is not {} then + set {v, l, r} to nodeParts(head) + v & levelOrder(tail & {l, r}) + else + levelOrder(tail) + end if + else + {} + end if +end levelOrder + +-- nodeParts :: Tree -> (Int, Tree, Tree) +on nodeParts(tree) + if class of tree is list and length of tree = 3 then + tree + else + {tree} & {{}, {}} + end if +end nodeParts + + +-- GENERIC + +-- uncons :: [a] -> Maybe (a, [a]) +on uncons(xs) + if length of xs > 0 then + {item 1 of xs, rest of xs} + else + missing value + end if +end uncons diff --git a/Task/Tree-traversal/AppleScript/tree-traversal-2.applescript b/Task/Tree-traversal/AppleScript/tree-traversal-2.applescript new file mode 100644 index 0000000000..5fa83ddfec --- /dev/null +++ b/Task/Tree-traversal/AppleScript/tree-traversal-2.applescript @@ -0,0 +1,4 @@ +{|pre-order|:{1, 2, 4, 7, 5, 3, 6, 8, 9}, +|in-order|:{7, 4, 2, 5, 1, 8, 6, 9, 3}, +|post-order|:{7, 4, 5, 2, 8, 9, 6, 3, 1}, +|level-order|:{1, 2, 3, 4, 5, 6, 7, 8, 9}} diff --git a/Task/Tree-traversal/Elixir/tree-traversal.elixir b/Task/Tree-traversal/Elixir/tree-traversal.elixir new file mode 100644 index 0000000000..a747b5fa61 --- /dev/null +++ b/Task/Tree-traversal/Elixir/tree-traversal.elixir @@ -0,0 +1,56 @@ +defmodule Tree_Traversal do + defp tnode, do: {} + defp tnode(v), do: {:node, v, {}, {}} + defp tnode(v,l,r), do: {:node, v, l, r} + + defp preorder(_,{}), do: :ok + defp preorder(f,{:node,v,l,r}) do + f.(v) + preorder(f,l) + preorder(f,r) + end + + defp inorder(_,{}), do: :ok + defp inorder(f,{:node,v,l,r}) do + inorder(f,l) + f.(v) + inorder(f,r) + end + + defp postorder(_,{}), do: :ok + defp postorder(f,{:node,v,l,r}) do + postorder(f,l) + postorder(f,r) + f.(v) + end + + defp levelorder(_, []), do: [] + defp levelorder(f, [{}|t]), do: levelorder(f, t) + defp levelorder(f, [{:node,v,l,r}|t]) do + f.(v) + levelorder(f, t++[l,r]) + end + defp levelorder(f, x), do: levelorder(f, [x]) + + def main do + tree = tnode(1, + tnode(2, + tnode(4, tnode(7), tnode()), + tnode(5, tnode(), tnode())), + tnode(3, + tnode(6, tnode(8), tnode(9)), + tnode())) + f = fn x -> IO.write "#{x} " end + IO.write "preorder: " + preorder(f, tree) + IO.write "\ninorder: " + inorder(f, tree) + IO.write "\npostorder: " + postorder(f, tree) + IO.write "\nlevelorder: " + levelorder(f, tree) + IO.puts "" + end +end + +Tree_Traversal.main diff --git a/Task/Tree-traversal/Fortran/tree-traversal-1.f b/Task/Tree-traversal/Fortran/tree-traversal-1.f new file mode 100644 index 0000000000..baa739ff29 --- /dev/null +++ b/Task/Tree-traversal/Fortran/tree-traversal-1.f @@ -0,0 +1,5 @@ + IF (STYLE.EQ."PRE") CALL OUT(HAS) + IF (LINKL(HAS).GT.0) CALL TARZAN(LINKL(HAS),STYLE) + IF (STYLE.EQ."IN") CALL OUT(HAS) + IF (LINKR(HAS).GT.0) CALL TARZAN(LINKR(HAS),STYLE) + IF (STYLE.EQ."POST") CALL OUT(HAS) diff --git a/Task/Tree-traversal/Fortran/tree-traversal-2.f b/Task/Tree-traversal/Fortran/tree-traversal-2.f new file mode 100644 index 0000000000..555c2ac468 --- /dev/null +++ b/Task/Tree-traversal/Fortran/tree-traversal-2.f @@ -0,0 +1,3 @@ + DO GASP = 1,MAXLEVEL + CALL TARZAN(1,HOW) + END DO diff --git a/Task/Tree-traversal/Fortran/tree-traversal-3.f b/Task/Tree-traversal/Fortran/tree-traversal-3.f new file mode 100644 index 0000000000..cab50ac17e --- /dev/null +++ b/Task/Tree-traversal/Fortran/tree-traversal-3.f @@ -0,0 +1,202 @@ + MODULE ARAUCARIA !Cunning crosswords, also. + INTEGER ENUFF !To suit the set example. + PARAMETER (ENUFF = 9) !This will do. + INTEGER NODE(ENUFF),LINKL(ENUFF),LINKR(ENUFF) !The nodes, and their links. + DATA NODE/ 1,2,3,4,5,6,7,8,9/ !Value = index. A rather boring payload. + DATA LINKL/2,4,6,7,0,8,0,0,0/ !"Left" and "Right" are as looking at the page. + DATA LINKR/3,5,0,0,0,9,0,0,0/ !If one thinks within the tree, they're the other way around! +C 1 !Thus, looking from the "1", to the right is "2" and to the left is "3". +C / \ !But, looking at the scheme, to the left is "2" and to the right is "3". +C / \ !This latter seems to be the popular view from the outside, not within the data. +C / \ !Similarily, although called a "tree", the depiction is upside down! +C 2 3 !How can computers be expected to keep up with this contrariness? +C / \ / !Humm, no example of a rightwards link with no leftwards link. +C 4 5 6 !Topologically equivalent, but not so in usage. +C / / \ +C 7 8 9 + INTEGER N,LIST(ENUFF) !This is to be developed. + INTEGER LEVEL,MAXLEVEL !While these vary in various ways. + INTEGER GASP !Communication from JANE. + CONTAINS !No checks for invalid links, etc. + SUBROUTINE OUT(IS) !Append a value to a list. + INTEGER IS !The value. + N = N + 1 !The list's count so far. + LIST(N) = IS !Place. + END SUBROUTINE OUT !Eventually, the list can be written in one go. + + RECURSIVE SUBROUTINE TARZAN(HAS,STYLE) !Skilled at tree traversal, is he. + INTEGER HAS !The current position. + CHARACTER*(*) STYLE !Traversal type. + LEVEL = LEVEL + 1 !A leap is made. + IF (LEVEL.GT.MAXLEVEL) MAXLEVEL = LEVEL !Staring at the moon. + SELECT CASE(STYLE) !And, in what manner? + CASE ("PRE") !Declare the position first. + CALL OUT(HAS) !Thus. + IF (LINKL(HAS).GT.0) CALL TARZAN(LINKL(HAS),STYLE) + IF (LINKR(HAS).GT.0) CALL TARZAN(LINKR(HAS),STYLE) + CASE ("IN") !Or in the middle. + IF (LINKL(HAS).GT.0) CALL TARZAN(LINKL(HAS),STYLE) + CALL OUT(HAS) !Thus. + IF (LINKR(HAS).GT.0) CALL TARZAN(LINKR(HAS),STYLE) + CASE ("POST") !Or at the end. + IF (LINKL(HAS).GT.0) CALL TARZAN(LINKL(HAS),STYLE) + IF (LINKR(HAS).GT.0) CALL TARZAN(LINKR(HAS),STYLE) + CALL OUT(HAS) !Thus. + CASE ("LEVEL") !Or at specified levels. + IF (LEVEL.EQ.GASP) CALL OUT(HAS) !Such as this? + IF (LINKL(HAS).GT.0) CALL TARZAN(LINKL(HAS),STYLE) + IF (LINKR(HAS).GT.0) CALL TARZAN(LINKR(HAS),STYLE) + CASE DEFAULT !This shouldn't happen. + WRITE (6,*) "Unknown style ",STYLE !But, paranoia. + STOP "No can do!" !Rather than flounder about. + END SELECT !That was simple. + LEVEL = LEVEL - 1 !Sag back. + END SUBROUTINE TARZAN !Not like George of the Jungle. + + SUBROUTINE JANE(HOW) !Tells Tarzan what to do. + CHARACTER*(*) HOW !A single word suffices. + N = 0 !No positions trampled. + LEVEL = 0 !Starting on the ground. + MAXLEVEL = 0 !The ascent follows. + IF (HOW.NE."LEVEL") THEN !Ordinary styles? + CALL TARZAN(1,HOW) !Yes. From the root, go... + ELSE !But this is not tree-structured. + GASP = 0 !Instead, we ascend through the canopy in stages. + 1 GASP = GASP + 1 !Up one stage. + CALL TARZAN(1,HOW) !And do it all again. + IF (GASP.LT.MAXLEVEL) GO TO 1 !Are we there yet? + END IF !Don't know MAXLEVEL until after the first clamber. +Cast forth the list. + WRITE (6,10) HOW,NODE(LIST(1:N)) !Show spoor. + 10 FORMAT (A6,"-order:",66(1X,I0)) !Large enough. + WRITE (6,*) !Sigh. + END SUBROUTINE JANE !That was simple. + END MODULE ARAUCARIA !The monkeys are puzzled. + + PROGRAM GORILLA !No fancy stuff. Just brute force. + USE ARAUCARIA !This is for lightweight but cunning monkeys. + INTEGER IT !A finger. + INTEGER SP,STACK(ENUFF) !The tree may be slim. + INTEGER SLEVL(ENUFF) !So prepare for maximum usage. + INTEGER MIST(ENUFF,0:ENUFF) !Multiple lists. + +Chase the links preorder style: name the node, delve its left link, delve its right link. + N = 0 !No nodes have been visited. + SP = 0 !My stack is empty. + IT = 1 !I start at the root. + 10 N = N + 1 !Another node arrived at. + LIST(N) = IT !Finger it. + IF (LINKL(IT).GT.0) THEN !A left link? + IF (LINKR(IT).GT.0) THEN !Yes. A right link also? + SP = SP + 1 !Yes. Stack it up. + STACK(SP) = LINKR(IT) !For later investigation. + END IF !So much for the right link. + IT = LINKL(IT) !Fingered by the left link. + GO TO 10 !See what happens. + END IF !But if there is no left link, + IF (LINKR(IT).GT.0) THEN !There still might be a right link. + IT = LINKR(IT) !There is. + GO TO 10 !See what happens. + END IF !And if there are no links, + IF (SP.GT.0) THEN !Perhaps the stack has bottomed out too? + IT = STACK(SP) !No, this was deferred. + SP = SP - 1 !So, pick up where we left off. + GO TO 10 !And carry on. + END IF !So much for unstacking. + WRITE (6,12) "Preorder",NODE(LIST(1:N)) !I've got a little list! + 12 FORMAT (A12,":",66(1X,I0)) + CALL JANE("PRE") !Try it fancy style. + +Chase the links inorder style: delve left fully, name the node and try its right, then unstack. + N = 0 !No nodes have been visited. + SP = 0 !My stack is empty. + IT = 1 !I start at the root. + 20 SP = SP + 1 !I'm on the way down. + STACK(SP) = IT !So, save this position to later retreat to. + IF (LINKL(IT).GT.0) THEN !Can I delve further left? + IT = LINKL(IT) !Yes. + GO TO 20 !And see what happens. + END IF !So much for diving. + 21 IF (SP.GT.0) THEN !Can I retreat? + IT = STACK(SP) !Yes. + SP = SP - 1 !Go back to whence I had delved left. + N = N + 1 !This now counts as a place in order. + LIST(N) = IT !So list it. + IF (LINKR(IT).GT.0) THEN!Have I a rightwards path? + IT = LINKR(IT) !Yes. Take it. + GO TO 20 !And delve therefrom. + END IF !This node is now finished with. + GO TO 21 !So, try for another retreat. + END IF !So much for unstacking. + WRITE (6,12) "Inorder",NODE(LIST(1:N)) !I've got a little list! + CALL JANE("IN") !Try with more style. + +Chase the links postorder style: delve left fully, delve right, name the node, then unstack. + N = 0 !No nodes have been visited. + SP = 0 !My stack is empty. + IT = 1 !I start at the root. + 30 SP = SP + 1 !Action follows delving, + STACK(SP) = IT !So this node will be returned to. + IF (LINKL(IT).GT.0) THEN !Take any leftwards link straightaway. + IT = LINKL(IT) !Thus. + GO TO 30 !Thanks to the stack, we'll return to IT (as was). + END IF !But if there is no leftwards link to follow, + IF (LINKR(IT).GT.0) THEN !Perhaps there is a rightwards one? + STACK(SP) = -STACK(SP) !=-IT Mark the stacked finger as a rightwards lurch! + IT = LINKR(IT) !The rightwards link is now to be taken. + GO TO 30 !Thus start on a sub-tree. + END IF !But if there is no rightwards link either, + 31 IF (SP.GT.0) THEN !See if there is anywhere to retreat to. + IT = STACK(SP) !The same IT placed at 30 if we dropped into 31. + SP = SP - 1 !But now we're in a different mood. + IF (IT.LT.0) THEN !Returning to what had been a rightwards departure? + N = N + 1 !Yes! Then this node is post-interest. + LIST(N) = -IT !So, time to roll it forth at last. + GO TO 31 !And retreat some more. + END IF !But if we hadn't gone right from IT, + IF (LINKR(IT).LE.0) THEN!We had gone left. + N = N + 1 !And now there is nowhere rightwards. + LIST(N) = IT !So this node is post-interest. + GO TO 31 !And retreat some more. + END IF !But if there is a rightwards leap, + SP = SP + 1 !Prepare to return to it, + STACK(SP) = -IT !Marked as having gone rightwards. + IT = LINKR(IT) !The rightwards move. + GO TO 30 !Peruse a fresh sub-tree. + END IF !And if the stack is reduced, + WRITE (6,12) "Postorder",NODE(LIST(1:N)) !Results! + CALL JANE("POST") !The same again? + +Chase the nodes level style. + SP = 0 !My stack is empty. + IT = 1 !I start at the root. + LEVEL = 0 !On the ground. + MAXLEVEL = 0 !No ascent as yet. + MIST(:,0) = 0 !At all levels, nothing. + 40 LEVEL = LEVEL + 1 !Every arrival is one level up. + IF (LEVEL.GT.MAXLEVEL) MAXLEVEL = LEVEL !Note the most high. + MIST(LEVEL,0) = MIST(LEVEL,0) + 1 !The count at that level. + MIST(LEVEL,MIST(LEVEL,0)) = IT !Add to the level's list. + IF (LINKL(IT).GT.0) THEN !Righto, can we go left? + IF (LINKR(IT).GT.0) THEN !Yes. Rightwards as well? + SP = SP + 1 !Yes! This will have to wait. + STACK(SP) = LINKR(IT) !So remember it, + SLEVL(SP) = LEVEL !And what level we're at now. + END IF !I can only go one way at a time. + IT = LINKL(IT) !Accept the fingered leftwards lurch. + GO TO 40 !Go to IT. + END IF !But if there is no leftwards link, + IF (LINKR(IT).GT.0) THEN !Perhaps there is a rightwards one? + IT = LINKR(IT) !There is. + GO TO 40 !Go to IT. + END IF !And if there are no further links, + IF (SP.GT.0) THEN !Perhaps we can retreat to what was deferred. + IT = STACK(SP) !The finger. + LEVEL = SLEVL(SP) !The level. + SP = SP - 1 !Wind back the stack. + GO TO 40 !Go to IT. + END IF !So much for the stack. + WRITE (6,12) "Levelorder", !Roll the lists in ascending LEVEL order. + 1 (NODE(MIST(LEVEL,1:MIST(LEVEL,0))), LEVEL = 1,MAXLEVEL) + CALL JANE("LEVEL") !Alternatively... + END !So much for that. diff --git a/Task/Tree-traversal/JavaScript/tree-traversal-4.js b/Task/Tree-traversal/JavaScript/tree-traversal-4.js new file mode 100644 index 0000000000..16a4d6211e --- /dev/null +++ b/Task/Tree-traversal/JavaScript/tree-traversal-4.js @@ -0,0 +1,121 @@ +(function () { + 'use strict'; + + // 'preorder' | 'inorder' | 'postorder' | 'level-order' + + // traverse :: String -> Tree {value: a, nest: [Tree]} -> [a] + function traverse(strOrderName, dctTree) { + var strName = strOrderName.toLowerCase(); + + if (strName.startsWith('level')) { + + // LEVEL-ORDER + return levelOrder([dctTree]); + + } else if (strName.startsWith('in')) { + var lstNest = dctTree.nest; + + if ((lstNest ? lstNest.length : 0) < 3) { + var left = lstNest[0] || [], + right = lstNest[1] || [], + + lstLeft = left.nest ? ( + traverse(strName, left) + ) : (left.value || []), + lstRight = right.nest ? ( + traverse(strName, right) + ) : (right.value || []); + + return (lstLeft !== undefined && lstRight !== undefined) ? + + // IN-ORDER + (lstLeft instanceof Array ? lstLeft : [lstLeft]) + .concat(dctTree.value) + .concat(lstRight) : undefined; + + } else { // in-order only defined here for binary trees + return undefined; + } + + } else { + var lstTraversed = concatMap(function (x) { + return traverse(strName, x); + }, (dctTree.nest || [])); + + return ( + strName.startsWith('pre') ? ( + + // PRE-ORDER + [dctTree.value].concat(lstTraversed) + + ) : strName.startsWith('post') ? ( + + // POST-ORDER + lstTraversed.concat(dctTree.value) + + ) : [] + ); + } + } + + // levelOrder :: [Tree {value: a, nest: [Tree]}] -> [a] + function levelOrder(lstTree) { + var lngTree = lstTree.length, + head = lngTree ? lstTree[0] : undefined, + tail = lstTree.slice(1); + + // Recursively take any value found in the head node + // of the remaining tail, deferring any child nodes + // of that head to the end of the tail + return lngTree ? ( + head ? ( + [head.value].concat( + levelOrder( + tail + .concat(head.nest || []) + ) + ) + ) : levelOrder(tail) + ) : []; + } + + // concatMap :: (a -> [b]) -> [a] -> [b] + function concatMap(f, xs) { + return [].concat.apply([], xs.map(f)); + } + + var dctTree = { + value: 1, + nest: [{ + value: 2, + nest: [{ + value: 4, + nest: [{ + value: 7 + }] + }, { + value: 5 + }] + }, { + value: 3, + nest: [{ + value: 6, + nest: [{ + value: 8 + }, { + value: 9 + }] + }] + }] + }; + + + return ['preorder', 'inorder', 'postorder', 'level-order'] + .reduce(function (a, k) { + return ( + a[k] = traverse(k, dctTree), + a + ); + }, {}); + +})(); diff --git a/Task/Tree-traversal/JavaScript/tree-traversal-5.js b/Task/Tree-traversal/JavaScript/tree-traversal-5.js new file mode 100644 index 0000000000..9d18e3f12f --- /dev/null +++ b/Task/Tree-traversal/JavaScript/tree-traversal-5.js @@ -0,0 +1,4 @@ +{"preorder":[1, 2, 4, 7, 5, 3, 6, 8, 9], +"inorder":[7, 4, 2, 5, 1, 8, 6, 9, 3], +"postorder":[7, 4, 5, 2, 8, 9, 6, 3, 1], +"level-order":[1, 2, 3, 4, 5, 6, 7, 8, 9]} diff --git a/Task/Tree-traversal/Kotlin/tree-traversal-1.kotlin b/Task/Tree-traversal/Kotlin/tree-traversal-1.kotlin new file mode 100644 index 0000000000..78c508d097 --- /dev/null +++ b/Task/Tree-traversal/Kotlin/tree-traversal-1.kotlin @@ -0,0 +1,67 @@ +data class Node(val v: Int, var left: Node? = null, var right: Node? = null) { + override fun toString() = "$v" +} + +fun preOrder(n: Node?) { + n?.let { + print("$n ") + preOrder(n.left) + preOrder(n.right) + } +} + +fun inorder(n: Node?) { + n?.let { + inorder(n.left) + print("$n ") + inorder(n.right) + } +} + +fun postOrder(n: Node?) { + n?.let { + postOrder(n.left) + postOrder(n.right) + print("$n ") + } +} + +fun levelOrder(n: Node?) { + n?.let { + val queue = mutableListOf(n) + while (queue.isNotEmpty()) { + val node = queue.removeAt(0) + print("$node ") + node.left?.let { queue.add(it) } + node.right?.let { queue.add(it) } + } + } +} + +inline fun exec(name: String, n: Node?, f: (Node?) -> Unit) { + print(name) + f(n) + println() +} + +fun main(args: Array) { + val nodes = Array(10) { Node(it) } + + nodes[1].left = nodes[2] + nodes[1].right = nodes[3] + + nodes[2].left = nodes[4] + nodes[2].right = nodes[5] + + nodes[4].left = nodes[7] + + nodes[3].left = nodes[6] + + nodes[6].left = nodes[8] + nodes[6].right = nodes[9] + + exec(" preOrder: ", nodes[1], ::preOrder) + exec(" inorder: ", nodes[1], ::inorder) + exec(" postOrder: ", nodes[1], ::postOrder) + exec("level-order: ", nodes[1], ::levelOrder) +} diff --git a/Task/Tree-traversal/Kotlin/tree-traversal-2.kotlin b/Task/Tree-traversal/Kotlin/tree-traversal-2.kotlin new file mode 100644 index 0000000000..bfe9b061d3 --- /dev/null +++ b/Task/Tree-traversal/Kotlin/tree-traversal-2.kotlin @@ -0,0 +1,42 @@ +data class Node(val v: Int, var left: Node? = null, var right: Node? = null) { + override fun toString() = " $v" + + fun preOrder() { print(this); left?.preOrder(); right?.preOrder() } + fun inorder() { left?.inorder(); print(this); right?.inorder() } + fun postOrder() { left?.postOrder(); right?.postOrder(); print(this) } + + fun levelOrder() = with(mutableListOf(this)) { + do { + val node = removeAt(0) + print(node) + node.left?.let { add(it) } + node.right?.let { add(it) } + } while (any()) + } + + inline fun exec(name: String, f: (Node) -> Unit) { + print(name) + f(this) + println() + } +} + +fun main(args: Array) { + val nodes = Array(10) { Node(it) } + + nodes[1].left = nodes[2] + nodes[1].right = nodes[3] + nodes[2].left = nodes[4] + nodes[2].right = nodes[5] + nodes[4].left = nodes[7] + nodes[3].left = nodes[6] + nodes[6].left = nodes[8] + nodes[6].right = nodes[9] + + with(nodes[1]) { + exec(" preOrder:", Node::preOrder) + exec(" inorder:", Node::inorder) + exec(" postOrder:", Node::postOrder) + exec("level-order:", Node::levelOrder) + } +} diff --git a/Task/Tree-traversal/Perl-6/tree-traversal.pl6 b/Task/Tree-traversal/Perl-6/tree-traversal.pl6 index 0703516899..4c4c4a4faa 100644 --- a/Task/Tree-traversal/Perl-6/tree-traversal.pl6 +++ b/Task/Tree-traversal/Perl-6/tree-traversal.pl6 @@ -5,7 +5,7 @@ class TreeNode { has $.value; method pre-order { - gather { + flat gather { take $.value; take $.left.pre-order if $.left; take $.right.pre-order if $.right @@ -13,7 +13,7 @@ class TreeNode { } method in-order { - gather { + flat gather { take $.left.in-order if $.left; take $.value; take $.right.in-order if $.right; @@ -21,7 +21,7 @@ class TreeNode { } method post-order { - gather { + flat gather { take $.left.post-order if $.left; take $.right.post-order if $.right; take $.value; @@ -30,7 +30,7 @@ class TreeNode { method level-order { my TreeNode @queue = (self); - gather while @queue.elems { + flat gather while @queue.elems { my $n = @queue.shift; take $n.value; @queue.push($n.left) if $n.left; diff --git a/Task/Tree-traversal/Rust/tree-traversal.rust b/Task/Tree-traversal/Rust/tree-traversal.rust new file mode 100644 index 0000000000..3fece25e48 --- /dev/null +++ b/Task/Tree-traversal/Rust/tree-traversal.rust @@ -0,0 +1,175 @@ +#![feature(box_syntax, box_patterns)] + +use std::collections::VecDeque; + +#[derive(Debug)] +struct TreeNode { + value: T, + left: Option>>, + right: Option>>, +} + +enum TraversalMethod { + PreOrder, + InOrder, + PostOrder, + LevelOrder, +} + +impl TreeNode { + pub fn new(arr: &[[i8; 3]]) -> TreeNode { + + let l = match arr[0][1] { + -1 => None, + i @ _ => Some(Box::new(TreeNode::::new(&arr[(i - arr[0][0]) as usize..]))), + }; + let r = match arr[0][2] { + -1 => None, + i @ _ => Some(Box::new(TreeNode::::new(&arr[(i - arr[0][0]) as usize..]))), + }; + + TreeNode { + value: arr[0][0], + left: l, + right: r, + } + } + + pub fn traverse(&self, tr: &TraversalMethod) -> Vec<&TreeNode> { + match tr { + &TraversalMethod::PreOrder => self.iterative_preorder(), + &TraversalMethod::InOrder => self.iterative_inorder(), + &TraversalMethod::PostOrder => self.iterative_postorder(), + &TraversalMethod::LevelOrder => self.iterative_levelorder(), + } + } + + fn iterative_preorder(&self) -> Vec<&TreeNode> { + let mut stack: Vec<&TreeNode> = Vec::new(); + let mut res: Vec<&TreeNode> = Vec::new(); + + stack.push(self); + while !stack.is_empty() { + let node = stack.pop().unwrap(); + res.push(node); + match node.right { + None => {} + Some(box ref n) => stack.push(n), + } + match node.left { + None => {} + Some(box ref n) => stack.push(n), + } + } + res + } + + // Leftmost to rightmost + fn iterative_inorder(&self) -> Vec<&TreeNode> { + let mut stack: Vec<&TreeNode> = Vec::new(); + let mut res: Vec<&TreeNode> = Vec::new(); + let mut p = self; + + loop { + // Stack parents and right children while left-descending + loop { + match p.right { + None => {} + Some(box ref n) => stack.push(n), + } + stack.push(p); + match p.left { + None => break, + Some(box ref n) => p = n, + } + } + // Visit the nodes with no right child + p = stack.pop().unwrap(); + while !stack.is_empty() && p.right.is_none() { + res.push(p); + p = stack.pop().unwrap(); + } + // First node that can potentially have a right child: + res.push(p); + if stack.is_empty() { + break; + } else { + p = stack.pop().unwrap(); + } + } + res + } + + // Left-to-right postorder is same sequence as right-to-left preorder, reversed + fn iterative_postorder(&self) -> Vec<&TreeNode> { + let mut stack: Vec<&TreeNode> = Vec::new(); + let mut res: Vec<&TreeNode> = Vec::new(); + + stack.push(self); + while !stack.is_empty() { + let node = stack.pop().unwrap(); + res.push(node); + match node.left { + None => {} + Some(box ref n) => stack.push(n), + } + match node.right { + None => {} + Some(box ref n) => stack.push(n), + } + } + let rev_iter = res.iter().rev(); + let mut rev: Vec<&TreeNode> = Vec::new(); + for elem in rev_iter { + rev.push(elem); + } + rev + } + + fn iterative_levelorder(&self) -> Vec<&TreeNode> { + let mut queue: VecDeque<&TreeNode> = VecDeque::new(); + let mut res: Vec<&TreeNode> = Vec::new(); + + queue.push_back(self); + while !queue.is_empty() { + let node = queue.pop_front().unwrap(); + res.push(node); + match node.left { + None => {} + Some(box ref n) => queue.push_back(n), + } + match node.right { + None => {} + Some(box ref n) => queue.push_back(n), + } + } + res + } +} + +fn main() { + // Array representation of task tree + let arr_tree = [[1, 2, 3], + [2, 4, 5], + [3, 6, -1], + [4, 7, -1], + [5, -1, -1], + [6, 8, 9], + [7, -1, -1], + [8, -1, -1], + [9, -1, -1]]; + + let root = TreeNode::::new(&arr_tree); + + for method_label in [(TraversalMethod::PreOrder, "pre-order:"), + (TraversalMethod::InOrder, "in-order:"), + (TraversalMethod::PostOrder, "post-order:"), + (TraversalMethod::LevelOrder, "level-order:")] + .iter() { + print!("{}\t", method_label.1); + for n in root.traverse(&method_label.0) { + print!(" {}", n.value); + } + print!("\n"); + } +} diff --git a/Task/Trigonometric-functions/00DESCRIPTION b/Task/Trigonometric-functions/00DESCRIPTION index d12c72b69c..4fc2dfe0b6 100644 --- a/Task/Trigonometric-functions/00DESCRIPTION +++ b/Task/Trigonometric-functions/00DESCRIPTION @@ -1,7 +1,14 @@ -If your language has a library or built-in functions for trigonometry, show examples of sine, cosine, tangent, and their inverses using the same angle in radians and degrees. +;Task: +If your language has a library or built-in functions for trigonometry, show examples of: +::*   sine +::*   cosine +::*   tangent +::*   inverses   (of the above) +
    using the same angle in radians and degrees. -For the non-inverse functions, each radian/degree pair should use arguments that evaluate to the same angle (that is, it's not necessary to use the same angle for all three regular functions as long as the two sine calls use the same angle). +For the non-inverse functions,   each radian/degree pair should use arguments that evaluate to the same angle   (that is, it's not necessary to use the same angle for all three regular functions as long as the two sine calls use the same angle). -For the inverse functions, use the same number and convert its answer to radians and degrees. +For the inverse functions,   use the same number and convert its answer to radians and degrees. -If your language does not have trigonometric functions available or only has some available, write functions to calculate the functions based on any [[wp:List of trigonometric identities|known approximation or identity]]. +If your language does not have trigonometric functions available or only has some available,   write functions to calculate the functions based on any   [[wp:List of trigonometric identities|known approximation or identity]]. +

    diff --git a/Task/Trigonometric-functions/Elena/trigonometric-functions.elena b/Task/Trigonometric-functions/Elena/trigonometric-functions.elena new file mode 100644 index 0000000000..45970fe38d --- /dev/null +++ b/Task/Trigonometric-functions/Elena/trigonometric-functions.elena @@ -0,0 +1,23 @@ +#import system. +#import system'math. +#import extensions. + +#symbol program = +[ + console writeLine:"Radians:". + console writeLine:"sin(π/3) = ":((pi_value/3) sin). + console writeLine:"cos(π/3) = ":((pi_value/3) cos). + console writeLine:"tan(π/3) = ":((pi_value/3) tan). + console writeLine:"arcsin(1/2) = ":(0.5r arcsin). + console writeLine:"arccos(1/2) = ":(0.5r arccos). + console writeLine:"arctan(1/2) = ":(0.5r arctan). + console writeLine. + + console writeLine:"Degrees:". + console writeLine:"sin(60º) = ":(60.0r radian sin). + console writeLine:"cos(60º) = ":(60.0r radian cos). + console writeLine:"tan(60º) = ":(60.0r radian tan). + console writeLine:"arcsin(1/2) = ":(0.5r arcsin degree):"º". + console writeLine:"arccos(1/2) = ":(0.5r arccos degree):"º". + console writeLine:"arctan(1/2) = ":(0.5r arctan degree):"º". +]. diff --git a/Task/Trigonometric-functions/GAP/trigonometric-functions.gap b/Task/Trigonometric-functions/GAP/trigonometric-functions.gap index f7c879c64a..114bd320aa 100644 --- a/Task/Trigonometric-functions/GAP/trigonometric-functions.gap +++ b/Task/Trigonometric-functions/GAP/trigonometric-functions.gap @@ -2,6 +2,9 @@ Pi := Acos(-1.0); +# Or use the built-in constant: +Pi := FLOAT.PI; + r := Pi / 5.0; d := 36; diff --git a/Task/Trigonometric-functions/Perl-6/trigonometric-functions.pl6 b/Task/Trigonometric-functions/Perl-6/trigonometric-functions.pl6 index 6a27e394ad..5b46d51c28 100644 --- a/Task/Trigonometric-functions/Perl-6/trigonometric-functions.pl6 +++ b/Task/Trigonometric-functions/Perl-6/trigonometric-functions.pl6 @@ -1,7 +1,7 @@ -say sin(pi/3), ' ', sin 60, 'd'; # 'g' (gradians) and 1 (circles) -say cos(pi/4), ' ', cos 45, 'd'; # are also recognized. -say tan(pi/6), ' ', tan 30, 'd'; +say sin(pi/3); +say cos(pi/4); +say tan(pi/6); -say asin(sqrt(3)/2), ' ', asin sqrt(3)/2, 'd'; -say acos(1/sqrt 2), ' ', acos 1/sqrt(2), 'd'; -say atan(1/sqrt 3), ' ', atan 1/sqrt(3), 'd'; +say asin(sqrt(3)/2); +say acos(1/sqrt 2); +say atan(1/sqrt 3); diff --git a/Task/Truncatable-primes/00DESCRIPTION b/Task/Truncatable-primes/00DESCRIPTION index f9c2527e8a..ac054c6ab8 100644 --- a/Task/Truncatable-primes/00DESCRIPTION +++ b/Task/Truncatable-primes/00DESCRIPTION @@ -1,10 +1,15 @@ A truncatable prime is a prime number that when you successively remove digits from one end of the prime, you are left with a new prime number; for example, the number 997 is called a ''left-truncatable prime'' as the numbers 997, 97, and 7 are all prime. The number 7393 is a ''right-truncatable prime'' as the numbers 7393, 739, 73, and 7 formed by removing digits from its right are also prime. No zeroes are allowed in truncatable primes. + +;Task: The task is to find the largest left-truncatable and right-truncatable primes less than one million (base 10 is implied). + ;C.f: * [[Find largest left truncatable prime in a given base]] * [[Sieve of Eratosthenes]] * [http://mathworld.wolfram.com/TruncatablePrime.html Truncatable Prime] from Mathworld. -[[:Category:Prime_Numbers]] +
    +[[:Category: Prime_Numbers]] +

    diff --git a/Task/Truncatable-primes/Elena/truncatable-primes.elena b/Task/Truncatable-primes/Elena/truncatable-primes.elena new file mode 100644 index 0000000000..6bc504b9c1 --- /dev/null +++ b/Task/Truncatable-primes/Elena/truncatable-primes.elena @@ -0,0 +1,78 @@ +#import system. +#import extensions. + +#symbol MAXN = 1000000. + +#class(extension)mathOp +{ + #method is &prime + [ + #var(type:int)n := self int. + + (n < 2) ? [ ^ false. ]. + (n < 4) ? [ ^ true. ]. + (n mod:2 == 0) ? [ ^ false. ]. + (n < 9) ? [ ^ true. ]. + (n mod:3 == 0) ? [ ^ false. ]. + + #var(type:int)r := n sqrt. + #var(type:int)f := 5. + #loop (f <= r)? + [ + ((n mod:f == 0) || (n mod:(f + 2) == 0)) + ? [ ^ false. ]. + f := f + 6. + ]. + ^ true. + ] + + #method is &rightTruncatable + [ + #var(type:int)n := self int. + #loop (n != 0)? + [ + (n is &prime) + ! [ ^ false. ]. + n := n / 10. + ]. + ^ true. + ] + + #method is &leftTruncatable + [ + #var(type:int)n := self int. + #var(type:int)tens := 1. + #loop (tens < n) + ? [ tens := tens * 10. ]. + + #loop (n != 0)? + [ + (n is &prime) + ! [ ^ false. ]. + tens := tens / 10. + n := n - (n / tens * tens). + ]. + ^ true. + ] +} + +#symbol program = +[ + #var n := MAXN. + #var max_lt := 0. + #var max_rt := 0. + #loop ((max_lt == 0) || (max_rt == 0))? + [ + (n literal indexOf:"0" == -1) ? + [ + ((max_lt == 0) and:[ n is &leftTruncatable ]) + ? [ max_lt := n. ]. + ((max_rt == 0) and:[ n is &rightTruncatable ]) + ? [ max_rt := n. ]. + ]. + n := n - 1. + ]. + + console writeLine:"Largest truncable left is ":max_lt. + console writeLine:"Largest truncable right is ":max_rt. +]. diff --git a/Task/Truncatable-primes/Elixir/truncatable-primes.elixir b/Task/Truncatable-primes/Elixir/truncatable-primes.elixir new file mode 100644 index 0000000000..26fda1d7e3 --- /dev/null +++ b/Task/Truncatable-primes/Elixir/truncatable-primes.elixir @@ -0,0 +1,47 @@ +defmodule Prime do + defp left_truncatable?(n, prime) do + func = fn i when i<=9 -> 0 + i -> to_string(i) |> String.slice(1..-1) |> String.to_integer end + truncatable?(n, prime, func) + end + + defp right_truncatable?(n, prime) do + truncatable?(n, prime, fn i -> div(i, 10) end) + end + + defp truncatable?(n, prime, trunc_func) do + if to_string(n) |> String.match?(~r/0/), + do: false, + else: trunc_loop(trunc_func.(n), prime, trunc_func) + end + + defp trunc_loop(0, _prime, _trunc_func), do: true + defp trunc_loop(n, prime, trunc_func) do + if elem(prime,n), do: trunc_loop(trunc_func.(n), prime, trunc_func), else: false + end + + def eratosthenes(limit) do # descending order + Enum.to_list(2..limit) |> sieve(:math.sqrt(limit), []) + end + + defp sieve([h|_]=list, max, sieved) when h>max, do: Enum.reverse(list, sieved) + defp sieve([h | t], max, sieved) do + list = for x <- t, rem(x,h)>0, do: x + sieve(list, max, [h | sieved]) + end + + defp prime_table(_, [], list), do: [false, false | list] + defp prime_table(n, [n|t], list), do: prime_table(n-1, t, [true|list]) + defp prime_table(n, prime, list), do: prime_table(n-1, prime, [false|list]) + + def task(limit \\ 1000000) do + prime = eratosthenes(limit) + prime_tuple = prime_table(limit, prime, []) |> List.to_tuple + left = Enum.find(prime, fn n -> left_truncatable?(n, prime_tuple) end) + IO.puts "Largest left-truncatable prime : #{left}" + right = Enum.find(prime, fn n -> right_truncatable?(n, prime_tuple) end) + IO.puts "Largest right-truncatable prime: #{right}" + end +end + +Prime.task diff --git a/Task/Truncatable-primes/REXX/truncatable-primes.rexx b/Task/Truncatable-primes/REXX/truncatable-primes.rexx index ce5b347d55..19579c8ba5 100644 --- a/Task/Truncatable-primes/REXX/truncatable-primes.rexx +++ b/Task/Truncatable-primes/REXX/truncatable-primes.rexx @@ -1,41 +1,40 @@ -/*REXX pgm finds largest left- & right-truncatable primes ≤1m (or arg1).*/ -parse arg high .; if high=='' then high=1000000 /*assume 1 million.*/ -!.=0; Lp=0; Rp=0; w=length(high) /*placeholders for primes, Lp, Rp*/ -@.1=2; @.2=3; @.3=5; @.4=7; @.5=11; @.6=13; @.7=17 /*some low primes. */ -!.2=1; !.3=1; !.5=1; !.7=1; !.11=1; !.13=1; !.17=1 /*low prime flags. */ -#=7; s.#=@.#**2 /*number of primes so far, prime²*/ -/*───────────────────────────────────────generate more primes ≤ high. */ - do j=@.#+2 by 2 to high /*only find odd primes from here.*/ - if j//3 ==0 then iterate /*is J divisible by three? */ - if right(j,1)==5 then iterate /*is the right-most digit a "5" ?*/ - if j//7 ==0 then iterate /*is J divisible by seven? */ - if j//11 ==0 then iterate /*is J divisible by eleven? */ - if j//13 ==0 then iterate /*is J divisible by thirteen? */ - /*[↑] above five lines saves time*/ - do k=7 while s.k<=j /*divide by known odd primes. */ - if j//@.k==0 then iterate j /*Is J divisible by X? ¬ prime.*/ +/*REXX program finds largest left─ and right─truncatable primes ≤ 1m (or argument 1).*/ +parse arg high .; if high=='' then high=1000000 /*Not specified? Then use 1m*/ +!.=0; w=length(high) /*placeholders for primes; max width. */ +@.1=2; @.2=3; @.3=5; @.4=7; @.5=11; @.6=13; @.7=17 /*define some low primes. */ +!.2=1; !.3=1; !.5=1; !.7=1; !.11=1; !.13=1; !.17=1 /*set some low prime flags. */ +#=7; s.#=@.#**2 /*number of primes so far; prime². */ + /* [↓] generate more primes ≤ high.*/ + do j=@.#+2 by 2 to high /*only find odd primes from here on out*/ + if j// 3==0 then iterate /*is J divisible by three? */ + parse var j '' -1 _; if _==5 then iterate /* " " " " five? (right digit)*/ + if j// 7==0 then iterate /* " " " " seven? */ + if j//11==0 then iterate /* " " " " eleven? */ + if j//13==0 then iterate /* " " " " thirteen? */ + /* [↑] the above five lines saves time*/ + do k=7 while s.k<=j /* [↓] divide by the known odd primes.*/ + if j//@.k==0 then iterate j /*Is J divisible by X? Then not prime.*/ end /*k*/ - #=#+1 /*bump number of primes found. */ - @.#=j; s.#=j*j /*assign to sparse array; prime².*/ - !.j=1 /*indicate that J is a prime.*/ - end /*j*/ -/*─────────────────────────────────────find largest left truncatable P. */ - do L=# by -1 for #; if pos(0,@.L)\==0 then iterate - do k=1 for length(@.L)-1; _=right(@.L,k) /*L truncate #.*/ - if \!._ then iterate L /*Truncated # ¬prime? Skip it.*/ - end /*k*/ - leave /*leave the DO loop, we found one*/ - end /*L*/ -/*─────────────────────────────────────find largest right truncatable P.*/ - do R=# by -1 for #; if pos(0,@.R)\==0 then iterate - do k=1 for length(@.R)-1; _=left(@.R,k) /*R truncate #.*/ - if \!._ then iterate R /*Truncated # ¬prime? Skip it.*/ - end /*k*/ - leave /*leave the DO loop, we found one*/ - end /*R*/ -/*───────────────────────────────────────show largest left/right trunc P*/ -say 'The last prime found is ' @.# " (there are" # 'primes ≤' high")." -say copies('─',70) /*show a separator line. */ -say 'The largest left-truncatable prime ≤' high " is " right(@.L,w) -say 'The largest right-truncatable prime ≤' high " is " right(@.R,w) - /*stick a fork in it, we're done.*/ + #=#+1 /*bump the number of primes found. */ + @.#=j; s.#=j*j; !.j=1 /*assign next prime; prime²; prime #.*/ + end /*j*/ + /* [↓] find largest left truncatable P*/ + do L=# by -1 for #; digs=length(@.L) /*search from top end; get the length.*/ + do k=1 for digs; _=right(@.L, k) /*validate all left truncatable primes.*/ + if \!._ then iterate L /*Truncated number not prime? Skip it.*/ + end /*k*/ + leave /*egress, found left truncatable prime.*/ + end /*L*/ + /* [↓] find largest right truncated P.*/ + do R=# by -1 for #; digs=length(@.R) /*search from top end; get the length.*/ + do k=1 for digs; _=left(@.R, k) /*validate all right truncatable primes*/ + if \!._ then iterate R /*Truncated number not prime? Skip it.*/ + end /*k*/ + leave /*egress, found right truncatable prime*/ + end /*R*/ + /* [↓] show largest left/right trunc P*/ +say 'The last prime found is ' @.# " (there are" # 'primes ≤' high")." +say copies('─', 70) /*show a separator line for the output.*/ +say 'The largest left─truncatable prime ≤' high " is " right(@.L, w) +say 'The largest right─truncatable prime ≤' high " is " right(@.R, w) + /*stick a fork in it, we're all done. */ diff --git a/Task/Truncate-a-file/00DESCRIPTION b/Task/Truncate-a-file/00DESCRIPTION index e950d52c08..5a8b2c1e7f 100644 --- a/Task/Truncate-a-file/00DESCRIPTION +++ b/Task/Truncate-a-file/00DESCRIPTION @@ -1,5 +1,12 @@ -Truncate a file to a specific length. This should be implemented as a routine that takes two parameters: the filename and the required file length (in bytes). +;Task: +Truncate a file to a specific length.   This should be implemented as a routine that takes two parameters: the filename and the required file length (in bytes). -Truncation can be achieved using system or library calls intended for such a task, if such methods exist, or by creating a temporary file of a reduced size and renaming it, after first deleting the original file, if no other method is available. The file may contain non human readable binary data in an unspecified format, so the routine should be "binary safe", leaving the contents of the untruncated part of the file unchanged. -If the specified filename does not exist, or the provided length is not less than the current file length, then the routine should raise an appropriate error condition. On some systems, the provided file truncation facilities might not change the file or may extend the file, if the specified length is greater than the current length of the file. This task permits the use of such facilities. However, such behaviour should be noted, or optionally a warning message relating to an non change or increase in file size may be implemented. +Truncation can be achieved using system or library calls intended for such a task, if such methods exist, or by creating a temporary file of a reduced size and renaming it, after first deleting the original file, if no other method is available.   The file may contain non human readable binary data in an unspecified format, so the routine should be "binary safe", leaving the contents of the untruncated part of the file unchanged. + +If the specified filename does not exist, or the provided length is not less than the current file length, then the routine should raise an appropriate error condition. + +On some systems, the provided file truncation facilities might not change the file or may extend the file, if the specified length is greater than the current length of the file. + +This task permits the use of such facilities.   However, such behaviour should be noted, or optionally a warning message relating to an non change or increase in file size may be implemented. +

    diff --git a/Task/Truncate-a-file/Elena/truncate-a-file.elena b/Task/Truncate-a-file/Elena/truncate-a-file.elena new file mode 100644 index 0000000000..278b7d2153 --- /dev/null +++ b/Task/Truncate-a-file/Elena/truncate-a-file.elena @@ -0,0 +1,29 @@ +#import system. +#import system'io. +#import extensions. + +#class(extension:file_path)fileOp +{ + #method set &length:length + [ + #var(type:stream)stream := FileStream openForEdit &path:self. + + stream set &length:length. + + stream close. + ] +} + +#symbol program = +[ + ('program'arguments length != 3)? + [ console << "Please provide the path to the file and a new length". #throw AbortException new. ]. + + #var fileName := 'program'arguments@1. + #var length := ('program'arguments@2) toInt. + + (fileName file_path is &available) + ! [ console writeLine:"File ":fileName:" does not exist". #throw AbortException new. ]. + + fileName file_path set &length:length. +]. diff --git a/Task/Truncate-a-file/Fortran/truncate-a-file.f b/Task/Truncate-a-file/Fortran/truncate-a-file.f new file mode 100644 index 0000000000..91c77d31b6 --- /dev/null +++ b/Task/Truncate-a-file/Fortran/truncate-a-file.f @@ -0,0 +1,46 @@ + SUBROUTINE CROAK(GASP) !Something bad has happened. + CHARACTER*(*) GASP !As noted. + WRITE (6,*) "Oh dear. ",GASP !So, gasp away. + STOP "++ungood." !Farewell, cruel world. + END !No return from this. + + SUBROUTINE FILEHACK(FNAME,NB) + CHARACTER*(*) FNAME !Name for the file. + INTEGER NB !Number of bytes to survive. + INTEGER L !A counter for te length of the file. + INTEGER F,T !Mnemonics for file unit numbers. + PARAMETER (F=66,T=67) !These should do. + LOGICAL EXIST !Same as the mnemonic so left/right can be forgotten. + CHARACTER*1 B !The worker! + IF (FNAME.EQ."") CALL CROAK("Blank file name!") + IF (NB.LE.0) CALL CROAK("Chop must be positive!") + INQUIRE(FILE = FNAME, EXIST = EXIST) !This mishap is frequent, so attend to it. + IF (.NOT.EXIST) CALL CROAK("Can't find a file called "//FNAME) !Tough love. + OPEN (F,FILE=FNAME,STATUS="OLD",ACTION="READWRITE", !Grab the source file. + 1 FORM="UNFORMATTED",RECL=1,ACCESS="DIRECT") !Oh dear. + OPEN (T,STATUS="SCRATCH",FORM="UNFORMATTED",RECL=1) !Request a temporary file. + +Copy the desired "records" to the temporary file. + 10 DO L = 1,NB !Only up to a point. + READ (F,REC = L,ERR = 20) B !One whole byte! + WRITE (T) B !And, write it too! + END DO !Again. + 20 IF (L.LE.NB) CALL CROAK("Short file!") !Should end the loop with L = NB + 1. +Convert from input to output... + REWIND T !Not CLOSE! That would discard the file! + CLOSE(F) !The source file still exists. + OPEN (F,FILE=FNAME,FORM="FORMATTED", !But, + 1 ACTION="WRITE",STATUS="REPLACE") !This dooms it! +Copy from the temporary file. + DO L = 1,NB !A certain number only. + READ (T) B !One at at timne. + WRITE (F,"(A1,$)") B !The $, obviously, means no end-of-record appendage. + END DO !And again. +Completed. + 30 CLOSE(T) !Abandon the temporary file. + CLOSE(F) !Finished with the source file. + END !Done. + + PROGRAM CHOPPER + CALL FILEHACK("foobar.txt",12) + END diff --git a/Task/Truncate-a-file/Lua/truncate-a-file.lua b/Task/Truncate-a-file/Lua/truncate-a-file.lua new file mode 100644 index 0000000000..9cc4a64ec2 --- /dev/null +++ b/Task/Truncate-a-file/Lua/truncate-a-file.lua @@ -0,0 +1,14 @@ +function truncate (filename, length) + local inFile = io.open(filename, 'r') + if not inFile then + error("Specified filename does not exist") + end + local wholeFile = inFile:read("*all") + inFile:close() + if length >= wholeFile:len() then + error("Provided length is not less than current file length") + end + local outFile = io.open(filename, 'w') + outFile:write(wholeFile:sub(1, length)) + outFile:close() +end diff --git a/Task/Truncate-a-file/PARI-GP/truncate-a-file.pari b/Task/Truncate-a-file/PARI-GP/truncate-a-file.pari new file mode 100644 index 0000000000..3278783f92 --- /dev/null +++ b/Task/Truncate-a-file/PARI-GP/truncate-a-file.pari @@ -0,0 +1,3 @@ +install("truncate", "isL", "trunc") + +trunc("/tmp/test.file", 20) diff --git a/Task/Truncate-a-file/Perl-6/truncate-a-file.pl6 b/Task/Truncate-a-file/Perl-6/truncate-a-file.pl6 index 73b80d6752..2a0ca9bb7b 100644 --- a/Task/Truncate-a-file/Perl-6/truncate-a-file.pl6 +++ b/Task/Truncate-a-file/Perl-6/truncate-a-file.pl6 @@ -1,6 +1,6 @@ use NativeCall; -sub truncate(Str, Int --> int) is native {*} +sub truncate(Str, int32 --> int32) is native {*} sub MAIN (Str $file, Int $to) { given $file.IO { diff --git a/Task/Truncate-a-file/REXX/truncate-a-file-1.rexx b/Task/Truncate-a-file/REXX/truncate-a-file-1.rexx index 73e7f100ed..f89064fa6c 100644 --- a/Task/Truncate-a-file/REXX/truncate-a-file-1.rexx +++ b/Task/Truncate-a-file/REXX/truncate-a-file-1.rexx @@ -1,20 +1,20 @@ -/*REXX program truncates a file to a specified (smaller) number of bytes.*/ -parse arg siz FID /*get required arguments from the C.L. */ -FID=strip(FID) /*elide leading/trailing blanks from FID*/ +/*REXX program truncates a file to a specified (and smaller) number of bytes. */ +parse arg siz FID /*obtain required arguments from the CL*/ +FID=strip(FID) /*elide FID leading/trailing blanks. */ if siz=='' then call ser "No truncation size was specified (1st argument)." if FID=='' then call ser "No fileID was specified (2nd argument)." -if \datatype(siz,'W') then call ser "trunc size isn't an integer: " siz -if siz<1 then call ser "trunc size isn't a positive integer: " siz -_=charin(FID,1,siz+1) /*position file and read a wee bit more*/ -#=length(_) /*get the length of the part just read.*/ -if #==0 then call ser "the specified file doesn't exist: " FID +if \datatype(siz,'W') then call ser "trunc size isn't an integer: " siz +if siz<1 then call ser "trunc size isn't a positive integer: " siz +_=charin(FID,1,siz+1) /*position file and read a wee bit more*/ +#=length(_) /*get the length of the part just read.*/ +if #==0 then call ser "the specified file doesn't exist: " FID if #1. This is a numbered list of twelve statements. -2. Exactly 3 of the last 6 statements are true. -3. Exactly 2 of the even-numbered statements are true. -4. If statement 5 is true, then statements 6 and 7 are both true. -5. The 3 preceding statements are all false. -6. Exactly 4 of the odd-numbered statements are true. -7. Either statement 2 or 3 is true, but not both. -8. If statement 7 is true, then 5 and 6 are both true. -9. Exactly 3 of the first 6 statements are true. +
    + 1.  This is a numbered list of twelve statements.
    + 2.  Exactly 3 of the last 6 statements are true.
    + 3.  Exactly 2 of the even-numbered statements are true.
    + 4.  If statement 5 is true, then statements 6 and 7 are both true.
    + 5.  The 3 preceding statements are all false.
    + 6.  Exactly 4 of the odd-numbered statements are true.
    + 7.  Either statement 2 or 3 is true, but not both.
    + 8.  If statement 7 is true, then 5 and 6 are both true.
    + 9.  Exactly 3 of the first 6 statements are true.
     10.  The next two statements are both true.
     11.  Exactly 1 of statements 7, 8 and 9 are true.
    -12.  Exactly 4 of the preceding statements are true.
    +12. Exactly 4 of the preceding statements are true. + + +;Task: When you get tired of trying to figure it out in your head, write a program to solve it, and print the correct answer or answers. -Extra credit: also print out a table of near misses, that is, -solutions that are contradicted by only a single statement. + +;Extra credit: +Print out a table of near misses, that is, solutions that are contradicted by only a single statement. +

    diff --git a/Task/Twelve-statements/C++/twelve-statements.cpp b/Task/Twelve-statements/C++/twelve-statements.cpp new file mode 100644 index 0000000000..0a11ad018b --- /dev/null +++ b/Task/Twelve-statements/C++/twelve-statements.cpp @@ -0,0 +1,116 @@ +#include +#include +#include +#include + +using namespace std; + +// convert int (0 or 1) to string (F or T) +inline +string str(int n) +{ + return n ? "T": "F"; +} + +int main(void) +{ + int solution_list_number = 1; + vector st; + st = { + " 1. This is a numbered list of twelve statements.", + " 2. Exactly 3 of the last 6 statements are true.", + " 3. Exactly 2 of the even-numbered statements are true.", + " 4. If statement 5 is true, then statements 6 and 7 are both true.", + " 5. The 3 preceding statements are all false.", + " 6. Exactly 4 of the odd-numbered statements are true.", + " 7. Either statement 2 or 3 is true, but not both.", + " 8. If statement 7 is true, then 5 and 6 are both true.", + " 9. Exactly 3 of the first 6 statements are true.", + " 10. The next two statements are both true.", + " 11. Exactly 1 of statements 7, 8 and 9 are true.", + " 12. Exactly 4 of the preceding statements are true." + }; // Good solution is: 1 3 4 6 7 11 are true + + int n = 12; // Number of statements. + int nTemp = (int)pow(2, n); // Number of solutions to check. + for (int counter = 0; counter < nTemp; counter++) + { + vector s; + for (int k = 0; k < n; k++) + { + s.push_back((counter >> k) & 0x1); + } + vector test(12); + int sum = 0; + // check each of the nTemp solutions for match. + // 1. This is a numbered list of twelve statements. + test[0] = s[0]; + + // 2. Exactly 3 of the last 6 statements are true. + sum = s[6]+ s[7]+s[8]+s[9]+s[10]+s[11]; + test[1] = ((sum == 3) == s[1]); + + // 3. Exactly 2 of the even-numbered statements are true. + sum = s[1]+s[3]+s[5]+s[7]+s[9]+s[11]; + test[2] = ((sum == 2) == s[2]); + + // 4. If statement 5 is true, then statements 6 and 7 are both true. + test[3] = ((s[4] ? (s[5] && s[6]) : true) == s[3]); + + // 5. The 3 preceding statements are all false. + test[4] = (((s[1] + s[2] + s[3]) == 0) == s[4]); + + // 6. Exactly 4 of the odd-numbered statements are true. + sum = s[0] + s[2] + s[4] + s[6] + s[8] + s[10]; + test[5] = ((sum == 4) == s[5]); + + // 7. Either statement 2 or 3 is true, but not both. + test[6] = (((s[1] + s[2]) == 1) == s[6]); + + // 8. If statement 7 is true, then 5 and 6 are both true. + test[7] = ((s[6] ? (s[4] && s[5]) : true) == s[7]); + + // 9. Exactly 3 of the first 6 statements are true. + sum = s[0]+s[1]+s[2]+s[3]+s[4]+s[5]; + test[8] = ((sum == 3) == s[8]); + + // 10. The next two statements are both true. + test[9] = ((s[10] && s[11]) == s[9]); + + // 11. Exactly 1 of statements 7, 8 and 9 are true. + sum = s[6]+ s[7] + s[8]; + test[10] = ((sum == 1) == s[10]); + + // 12. Exactly 4 of the preceding statements are true. + sum = s[0]+s[1]+s[2]+s[3]+s[4]+s[5]+s[6]+s[7]+s[8]+s[9]+s[10]; + test[11] = ((sum == 4) == s[11]); + + // Check test results and print solution if 11 or 12 are true + int resultsTrue = 0; + for(unsigned int i = 0; i < test.size(); i++){ + resultsTrue += test[i]; + } + if(resultsTrue == 11 || resultsTrue == 12){ + cout << solution_list_number++ << ". " ; + string output = "1:"+str(s[0])+" 2:"+str(s[1])+" 3:"+str(s[2]) + +" 4:"+str(s[3])+" 5:"+str(s[4])+" 6:"+ str(s[5]) + +" 7:"+str(s[6])+" 8:"+str(s[7])+" 9:"+str(s[8]) + +" 10:"+str(s[9])+" 11:"+str(s[10])+" 12:"+ str(s[11]); + + if (resultsTrue == 12) { + cout << "Full Match, good solution!" << endl; + cout << "\t" << output << endl; + } + else if(resultsTrue == 11){ + int i; + for(i = 0; i < 12; i++){ + if(test[i] == 0){ + break; + } + } + cout << "Missed by one statement: " << st[i] << endl; + cout << "\t" << output << endl; + } + } + } +} diff --git a/Task/Twelve-statements/C-sharp/twelve-statements.cs b/Task/Twelve-statements/C-sharp/twelve-statements.cs new file mode 100644 index 0000000000..64c731d78a --- /dev/null +++ b/Task/Twelve-statements/C-sharp/twelve-statements.cs @@ -0,0 +1,63 @@ +using System; +using System.Collections.Generic; +using System.Linq; + +public static class TwelveStatements +{ + public static void Main() { + Func[] checks = { + st => st[1], + st => st[2] == (7.To(12).Count(i => st[i]) == 3), + st => st[3] == (2.To(12, by: 2).Count(i => st[i]) == 2), + st => st[4] == st[5].Implies(st[6] && st[7]), + st => st[5] == (!st[2] && !st[3] && !st[4]), + st => st[6] == (1.To(12, by: 2).Count(i => st[i]) == 4), + st => st[7] == (st[2] != st[3]), + st => st[8] == st[7].Implies(st[5] && st[6]), + st => st[9] == (1.To(6).Count(i => st[i]) == 3), + st => st[10] == (st[11] && st[12]), + st => st[11] == (7.To(9).Count(i => st[i]) == 1), + st => st[12] == (1.To(11).Count(i => st[i]) == 4) + }; + + for (Statements statements = new Statements(0); statements.Value < 4096; statements++) { + int count = 0; + int falseIndex = 0; + for (int i = 0; i < checks.Length; i++) { + if (checks[i](statements)) count++; + else falseIndex = i; + } + if (count == 0) Console.WriteLine($"{"All wrong:", -13}{statements}"); + else if (count == 11) Console.WriteLine($"{$"Wrong at {falseIndex + 1}:", -13}{statements}"); + else if (count == 12) Console.WriteLine($"{"All correct:", -13}{statements}"); + } + } + + struct Statements + { + public Statements(int value) : this() { Value = value; } + + public int Value { get; } + + public bool this[int index] => (Value & (1 << index - 1)) != 0; + + public static Statements operator ++(Statements statements) => new Statements(statements.Value + 1); + + public override string ToString() { + Statements copy = this; //Cannot access 'this' in anonymous method... + return string.Join(" ", from i in 1.To(12) select copy[i] ? "T" : "F"); + } + + } + + //Extension methods + static bool Implies(this bool x, bool y) => !x || y; + + static IEnumerable To(this int start, int end, int by = 1) { + while (start <= end) { + yield return start; + start += by; + } + } + +} diff --git a/Task/Twelve-statements/D/twelve-statements.d b/Task/Twelve-statements/D/twelve-statements.d index 0680efa8ca..db6797a0a4 100644 --- a/Task/Twelve-statements/D/twelve-statements.d +++ b/Task/Twelve-statements/D/twelve-statements.d @@ -14,7 +14,7 @@ immutable texts = [ "exactly 1 of statements 7, 8 and 9 are true", "exactly 4 of the preceding statements are true"]; -immutable pure @safe /*@nogc*/ bool function(in bool[])[12] predicates = [ +immutable pure @safe @nogc bool function(in bool[])[12] predicates = [ s => s.length == 12, s => s[$ - 6 .. $].sum == 3, s => s.dropOne.stride(2).sum == 2, @@ -28,7 +28,7 @@ immutable pure @safe /*@nogc*/ bool function(in bool[])[12] predicates = [ s => s[6 .. 9].sum == 1, s => s[0 .. 11].sum == 4]; -void main() { +void main() @safe { enum nStats = predicates.length; foreach (immutable n; 0 .. 2 ^^ nStats) { diff --git a/Task/Twelve-statements/Elena/twelve-statements.elena b/Task/Twelve-statements/Elena/twelve-statements.elena new file mode 100644 index 0000000000..1176804f92 --- /dev/null +++ b/Task/Twelve-statements/Elena/twelve-statements.elena @@ -0,0 +1,59 @@ +#import system. +#import system'routines. +#import extensions. + +#class(extension)op +{ + #method printSolution : bits + = self zip:bits &into: + (:s:b) [ s iif:"T":"F" + (s xor:b) iif:"* ":" " ] summarize:(String new). +} + +#symbol puzzle = +( + bits [ bits length == 12 ], + + bits [ bits last:6 select &each:x [ x iif:1:0 ] summarize == 3 ], + + bits [ bits zip:(RangeEnumerator new &from:1 &to:12) + &into:(:x:i) [ (i int is &even)and:x iif:1:0 ] summarize == 2 ], + + bits [ bits@4 iif:(bits@5 && bits@6):true ], + + bits [ (bits@1 || bits@2 || bits@3) not ], + + bits [ bits zip:(RangeEnumerator new &from:1 &to:12) + &into:(:x:i) [ (i int is &odd)and:x iif:1:0 ] summarize == 4 ], + + bits [ (bits@1) xor:(bits@2) ], + + bits [ bits@6 iif:(bits@5 && bits@4):true ], + + bits [ bits top:6 select &each:x [ x iif:1:0 ] summarize == 3 ], + + bits [ bits@10 && bits@11 ], + + bits [ ((bits@6) iif:1:0 + (bits@7) iif:1:0 + (bits@8) iif:1:0)==1 ], + + bits [ bits top:11 select &each:x [ x iif:1:0 ] summarize == 4 ] +). + +#symbol program = +[ + console writeLine:"". + + 0 till:(2 power &int:12) &doEach:n + [ + #var bits := BitArray32 new:n top:12 toArray. + #var results := puzzle select &each: r [ r eval:bits ] toArray. + + #var counts := bits zip:results &into:(:b:r) [ b xor:r iif:1:0 ] summarize. + + counts => + 0 ? [ console writeLine:"Total hit :":(results printSolution:bits). ] + 1 ? [ console writeLine:"Near miss :":(results printSolution:bits). ] + 12 ? [ console writeLine:"Total miss:":(results printSolution:bits). ]. + ]. + + console readChar. +]. diff --git a/Task/Twelve-statements/Perl-6/twelve-statements.pl6 b/Task/Twelve-statements/Perl-6/twelve-statements.pl6 index 98ffaa8cbf..df3d2bf1f0 100644 --- a/Task/Twelve-statements/Perl-6/twelve-statements.pl6 +++ b/Task/Twelve-statements/Perl-6/twelve-statements.pl6 @@ -1,6 +1,6 @@ -sub infix:<→> ($protasis,$apodosis) { !$protasis or $apodosis } +sub infix:<→> ($protasis, $apodosis) { !$protasis or $apodosis } -my @tests = { True }, # (there's no 0th statement) +my @tests = { .end == 12 and all(.[1..12]) === any(True, False) }, { 3 == [+] .[7..12] }, { 2 == [+] .[2,4...12] }, @@ -12,31 +12,24 @@ my @tests = { True }, # (there's no 0th statement) { 3 == [+] .[1..6] }, { all .[11,12] }, { one .[7,8,9] }, - { 4 == [+] .[1..11] }; + { 4 == [+] .[1..11] }, +; -my @good; -my @bad; -my @ugly; +my @solutions; +my @misses; -for reverse 0 ..^ 2**12 -> $i { - my @b = $i.fmt("%012b").comb; - my @assert = True, | @b.map: { 1 == $_ } - my @result = @tests.map: { .(@assert).so } - my @s = ( $_ if $_ and @assert[$_] for 1..12 ); - if @result eqv @assert { - push @good, "<{@s}> is consistent."; - } - else { - my @cons = gather for 1..12 { - if @assert[$_] !eqv @result[$_] { - take @result[$_] ?? $_ !! "¬$_"; - } - } - my $mess = "<{@s}> implies {@cons}."; - if @cons == 1 { push @bad, $mess } else { push @ugly, $mess } +for [X] (True, False) xx 12 { + my @assert = Nil, |$_; + my @result = Nil, |@tests.map({ ?.(@assert) }); + my @true = @assert.grep(?*, :k); + my @cons = (@assert Z=== @result).grep(!*, :k); + given @cons { + when 0 { push @solutions, "<{@true}> is consistent."; } + when 1 { push @misses, "<{@true}> implies { "¬" if !@result[~$_] }$_." } } } -.say for @good; -say "\nNear misses:"; -.say for @bad; +.say for @solutions; +say ""; +say "Near misses:"; +.say for @misses; diff --git a/Task/Twelve-statements/REXX/twelve-statements-1.rexx b/Task/Twelve-statements/REXX/twelve-statements-1.rexx index 34623b1143..eae84e32b0 100644 --- a/Task/Twelve-statements/REXX/twelve-statements-1.rexx +++ b/Task/Twelve-statements/REXX/twelve-statements-1.rexx @@ -1,32 +1,31 @@ -/*REXX program solves the "Twelve Statement Puzzle". */ -q=12; @stmt=right('statement',20) /*number of statements in puzzle.*/ -m=0 /*[↓] statement 1 is TRUE by fiat*/ - do pass=1 for 2 /*find the maximum number trues. */ - do e=0 for 2**(q-1); n = '1'right(x2b(d2x(e)), q-1, 0) - do b=1 for q /*define the various bits. */ - @.b=substr(n,b,1) /*define a particular @ bit. */ +/*REXX program solves the "Twelve Statement Puzzle". */ +q=12; @stmt=right('statement',20) /*number of statements in the puzzle. */ +m=0 /*[↓] statement one is TRUE by fiat.*/ + do pass=1 for 2 /*find the maximum number of "trues". */ + do e=0 for 2**(q-1); n = '1'right( x2b( d2x( e ) ), q-1, 0) + do b=1 for q /*define various bits in the number Q.*/ + @.b=substr(n, b, 1) /*define a particular @ bit (in Q).*/ end /*b*/ - if @.1 then if yeses(1,1) \==1 then iterate - if @.2 then if yeses(7,12) \==3 then iterate - if @.3 then if yeses(2,12,2) \==2 then iterate - if @.4 then if yeses(5,5) then if yeses(6,7) \==2 then iterate - if @.5 then if yeses(2,4) \==0 then iterate - if @.6 then if yeses(1,12,2) \==4 then iterate - if @.7 then if yeses(2,3) \==1 then iterate - if @.8 then if yeses(7,7) then if yeses(5,6) \==2 then iterate - if @.9 then if yeses(1,6) \==3 then iterate - if @.10 then if yeses(11,12) \==2 then iterate - if @.11 then if yeses(7,9) \==1 then iterate - if @.12 then if yeses(1,11) \==4 then iterate - _=yeses(1,12) - if pass==1 then do; m=max(m,_); iterate; end - else if _\==m then iterate - do j=1 for q; _=substr(n,j,1) - if _ then say @stmt right(j,2) " is " word('false true',1+_) + if @.1 then if yeses(1, 1) \==1 then iterate + if @.2 then if yeses(7, 12) \==3 then iterate + if @.3 then if yeses(2, 12,2) \==2 then iterate + if @.4 then if yeses(5, 5) then if yeses(6, 7) \==2 then iterate + if @.5 then if yeses(2, 4) \==0 then iterate + if @.6 then if yeses(1, 12,2) \==4 then iterate + if @.7 then if yeses(2, 3) \==1 then iterate + if @.8 then if yeses(7, 7) then if yeses(5,6) \==2 then iterate + if @.9 then if yeses(1, 6) \==3 then iterate + if @.10 then if yeses(11,12) \==2 then iterate + if @.11 then if yeses(7, 9) \==1 then iterate + if @.12 then if yeses(1, 11) \==4 then iterate + g=yeses(1, 12) + if pass==1 then do; m=max(m,g); iterate; end + else if g\==m then iterate + do j=1 for q; z=substr(n, j, 1) + if z then say @stmt right(j, 2) " is " word('false true', 1 + z) end /*tell*/ end /*e*/ end /*pass*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────YESES subroutine────────────────────*/ -yeses: parse arg L,H,B; #=0; do i=L to H by word(B 1,1); #=#+@.i; end - return # +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +yeses: parse arg L,H,B; #=0; do i=L to H by word(B 1, 1); #=#+@.i; end; return # diff --git a/Task/Twelve-statements/REXX/twelve-statements-2.rexx b/Task/Twelve-statements/REXX/twelve-statements-2.rexx index d32ccfbfc3..14a8bfd385 100644 --- a/Task/Twelve-statements/REXX/twelve-statements-2.rexx +++ b/Task/Twelve-statements/REXX/twelve-statements-2.rexx @@ -1,10 +1,10 @@ -/*REXX program solves the "Twelve Statement Puzzle". */ -q=12; @stmt=right('statement',20) /*number of statements in puzzle.*/ -m=0 /*[↓] statement 1 is TRUE by fiat*/ - do pass=1 for 2 /*find the maximum number trues. */ - do e=0 for 2**(q-1); n = '1'right(x2b(d2x(e)), q-1, 0) - do b=1 for q /*define the various bits. */ - @.b=substr(n,b,1) /*define a particular @ bit. */ +/*REXX program solves the "Twelve Statement Puzzle". */ +q=12; @stmt=right('statement',20) /*number of statements in the puzzle. */ +m=0 /*[↓] statement one is TRUE by fiat.*/ + do pass=1 for 2 /*find the maximum number of "trues". */ + do e=0 for 2**(q-1); n = '1'right( x2b( d2x( e ) ), q-1, 0) + do b=1 for q /*define various bits in the number Q.*/ + @.b=substr(n, b, 1) /*define a particular @ bit (in Q).*/ end /*b*/ if @.1 then if \ @.1 then iterate if @.2 then if @.7+@.8+@.9+@.10+@.11+@.12 \==3 then iterate @@ -17,14 +17,13 @@ m=0 /*[↓] statement 1 is TRUE by fiat*/ if @.9 then if @.1+@.2+@.3+@.4+@.5+@.6 \==3 then iterate if @.10 then if \ (@.11 & @.12) then iterate if @.11 then if @.7+@.8+@.9 \==1 then iterate - _=@.1+@.2+@.3+@.4+@.5+@.6+@.7+@.8+@.9+@.10+@.11 - if @.12 then if _ \==4 then iterate - _=_+@.12 - if pass==1 then do; m=max(m,_); iterate; end - else if _\==m then iterate - do j=1 for q - if @.j then say @stmt right(j,2) " is " word('false true',1+@.j) - end /*j*/ - end /*e*/ - end /*pass*/ - /*stick a fork in it, we're done.*/ + g=@.1 +@.2 +@.3 +@.4 +@.5 +@.6 +@.7 +@.8+ @.9 +@.10 +@.11 + if @.12 then if g \==4 then iterate + g=g + @.12 + if pass==1 then do; m=max(m,g); iterate; end + else if g\==m then iterate + do j=1 for q; z=substr(n, j, 1) + if z then say @stmt right(j, 2) " is " word('false true', 1+z) + end /*tell*/ + end /*e*/ + end /*pass*/ /*stick a fork in it, we're all done. */ diff --git a/Task/Twelve-statements/REXX/twelve-statements-3.rexx b/Task/Twelve-statements/REXX/twelve-statements-3.rexx index f30c09c5ce..875b33db68 100644 --- a/Task/Twelve-statements/REXX/twelve-statements-3.rexx +++ b/Task/Twelve-statements/REXX/twelve-statements-3.rexx @@ -1,10 +1,10 @@ -/*REXX program solves the "Twelve Statement Puzzle". */ -q=12; @stmt=right('statement',20) /*number of statements in puzzle.*/ -m=0 /*[↓] statement 1 is TRUE by fiat*/ - do pass=1 for 2 /*find the maximum number trues. */ - do e=0 for 2**(q-1); n = '1'right(x2b(d2x(e)), q-1, 0) - parse var n @1 2 @2 3 @3 4 @4 5 @5 6 @6 7 @7 8 @8 9 @9 10 @10 11 @11 12 @12 -/*███ if @1 then if \ @1 then iterate ███*/ +/*REXX program solves the "Twelve Statement Puzzle". */ +q=12; @stmt=right('statement',20) /*number of statements in the puzzle. */ +m=0 /*[↓] statement one is TRUE by fiat.*/ + do pass=1 for 2 /*find the maximum number of "trues". */ + do e=0 for 2**(q-1); n = '1'right( x2b( d2x( e ) ), q-1, 0) + parse var n @1 2 @2 3 @3 4 @4 5 @5 6 @6 7 @7 8 @8 9 @9 10 @10 11 @11 12 @12 +/*▒▒▒▒ if @1 then if \ @1 then iterate ▒▒▒▒*/ if @2 then if @7+@8+@9+@10+@11+@12 \==3 then iterate if @3 then if @2+@4+@6+@8+@10+@12 \==2 then iterate if @4 then if @5 then if \(@6 & @7) then iterate @@ -15,14 +15,13 @@ m=0 /*[↓] statement 1 is TRUE by fiat*/ if @9 then if @1+@2+@3+@4+@5+@6 \==3 then iterate if @10 then if \ (@11 & @12) then iterate if @11 then if @7+@8+@9 \==1 then iterate - _=@1+@2+@3+@4+@5+@6+@7+@8+@9+@10+@11 /*shortcut*/ - if @12 then if _ \==4 then iterate - _=_+@12 - if pass==1 then do; m=max(m,_); iterate; end - else if _\==m then iterate - do j=1 for q; _=substr(n,j,1) - if _ then say @stmt right(j,2) " is " word('false true',1+_) + g=@1 + @2 + @3 + @4 + @5 + @6 + @7 + @8 + @9 + @10 + @11 + if @12 then if g \==4 then iterate + g=g + @12 + if pass==1 then do; m=max(m,g); iterate; end + else if g\==m then iterate + do j=1 for q; z=substr(n, j, 1) + if z then say @stmt right(j, 2) " is " word('false true', 1+z) end /*j*/ end /*e*/ - end /*pass*/ - /*stick a fork in it, we're done.*/ + end /*pass*/ /*stick a fork in it, we're all done. */ diff --git a/Task/Twelve-statements/TXR/twelve-statements.txr b/Task/Twelve-statements/TXR/twelve-statements.txr index b9961ae5e8..13455d30ba 100644 --- a/Task/Twelve-statements/TXR/twelve-statements.txr +++ b/Task/Twelve-statements/TXR/twelve-statements.txr @@ -1,37 +1,36 @@ -@(do - (defmacro defconstraints (name size-name (var) . forms) - ^(progn (defvar ,size-name ,(length forms)) - (defun ,name (,var) - (list ,*forms)))) +(defmacro defconstraints (name size-name (var) . forms) + ^(progn (defvar ,size-name ,(length forms)) + (defun ,name (,var) + (list ,*forms)))) - (defconstraints con con-count (s) - (= (length s) con-count) ;; tautology - (= (countq t [s -6..t]) 3) - (= (countq t (mapcar (op if (evenp @1) @2) (range 1) s)) 2) - (if [s 4] (and [s 5] [s 6]) t) - (none [s 1..3]) - (= (countq t (mapcar (op if (oddp @1) @2) (range 1) s)) 4) - (and (or [s 1] [s 2]) (not (and [s 1] [s 2]))) - (if [s 6] (and [s 4] [s 5]) t) - (= (countq t [s 0..6]) 3) - (and [s 10] [s 11]) - (= (countq t [s 6..9]) 1) - (= (countq t [s 0..con-count]) 4)) +(defconstraints con con-count (s) + (= (length s) con-count) ;; tautology + (= (countq t [s -6..t]) 3) + (= (countq t (mapcar (op if (evenp @1) @2) (range 1) s)) 2) + (if [s 4] (and [s 5] [s 6]) t) + (none [s 1..3]) + (= (countq t (mapcar (op if (oddp @1) @2) (range 1) s)) 4) + (and (or [s 1] [s 2]) (not (and [s 1] [s 2]))) + (if [s 6] (and [s 4] [s 5]) t) + (= (countq t [s 0..6]) 3) + (and [s 10] [s 11]) + (= (countq t [s 6..9]) 1) + (= (countq t [s 0..con-count]) 4)) - (defun true-indices (truths) - (mappend (do if @1 ^(,@2)) truths (range 1))) +(defun true-indices (truths) + (mappend (do if @1 ^(,@2)) truths (range 1))) - (defvar results - (append-each ((truths (rperm '(nil t) con-count))) - (let* ((vals (con truths)) - (consist [mapcar eq truths vals]) - (wrong-count (countq nil consist)) - (pos-wrong (+ 1 (or (posq nil consist) -2)))) - (cond - ((zerop wrong-count) - ^((:----> ,*(true-indices truths)))) - ((= 1 wrong-count) - ^((:close ,*(true-indices truths) (:wrong ,pos-wrong)))))))) +(defvar results + (append-each ((truths (rperm '(nil t) con-count))) + (let* ((vals (con truths)) + (consist [mapcar eq truths vals]) + (wrong-count (countq nil consist)) + (pos-wrong (+ 1 (or (posq nil consist) -2)))) + (cond + ((zerop wrong-count) + ^((:----> ,*(true-indices truths)))) + ((= 1 wrong-count) + ^((:close ,*(true-indices truths) (:wrong ,pos-wrong)))))))) - (each ((r results)) - (put-line `@r`))) +(each ((r results)) + (put-line `@r`)) diff --git a/Task/URL-decoding/00DESCRIPTION b/Task/URL-decoding/00DESCRIPTION index f797aa4a5e..9e78b1613f 100644 --- a/Task/URL-decoding/00DESCRIPTION +++ b/Task/URL-decoding/00DESCRIPTION @@ -1,8 +1,9 @@ -This task (the reverse of [[URL encoding]] and distinct from [[URL parser]]) is to provide a function +This task   (the reverse of   [[URL encoding]]   and distinct from   [[URL parser]])   is to provide a function or mechanism to convert an URL-encoded string into its original unencoded form. -'''Test cases''' -*The encoded string "http%3A%2F%2Ffoo%20bar%2F" should be reverted to the unencoded form "http://foo bar/". +;Test cases: +*   The encoded string   "http%3A%2F%2Ffoo%20bar%2F"   should be reverted to the unencoded form   "http://foo bar/". -*The encoded string "google.com/search?q=%60Abdu%27l-Bah%C3%A1" should revert to the unencoded form "google.com/search?q=`Abdu'l-Bahá". +*   The encoded string   "google.com/search?q=%60Abdu%27l-Bah%C3%A1"   should revert to the unencoded form   "google.com/search?q=`Abdu'l-Bahá". +

    diff --git a/Task/URL-decoding/PowerShell/url-decoding.psh b/Task/URL-decoding/PowerShell/url-decoding.psh new file mode 100644 index 0000000000..a88d942461 --- /dev/null +++ b/Task/URL-decoding/PowerShell/url-decoding.psh @@ -0,0 +1 @@ +[System.Web.HttpUtility]::UrlDecode("http%3A%2F%2Ffoo%20bar%2F") diff --git a/Task/URL-encoding/00DESCRIPTION b/Task/URL-encoding/00DESCRIPTION index c7f4d67351..6cffe5d3e8 100644 --- a/Task/URL-encoding/00DESCRIPTION +++ b/Task/URL-encoding/00DESCRIPTION @@ -1,5 +1,5 @@ -The task is to provide a function or mechanism to convert a provided string -into URL encoding representation. +;Task: +Provide a function or mechanism to convert a provided string into URL encoding representation. In URL encoding, special characters, control characters and extended characters are converted into a percent symbol followed by a two digit hexadecimal code, @@ -7,28 +7,30 @@ So a space character encodes into %20 within the string. For the purposes of this task, every character except 0-9, A-Z and a-z requires conversion, so the following characters all require conversion by default: -*ASCII control codes (Character ranges 00-1F hex (0-31 decimal) and 7F (127 decimal). -*ASCII symbols (Character ranges 32-47 decimal (20-2F hex)) -*ASCII symbols (Character ranges 58-64 decimal (3A-40 hex)) -*ASCII symbols (Character ranges 91-96 decimal (5B-60 hex)) -*ASCII symbols (Character ranges 123-126 decimal (7B-7E hex)) -*Extended characters with character codes of 128 decimal (80 hex) and above. - -'''Example''' +* ASCII control codes (Character ranges 00-1F hex (0-31 decimal) and 7F (127 decimal). +* ASCII symbols (Character ranges 32-47 decimal (20-2F hex)) +* ASCII symbols (Character ranges 58-64 decimal (3A-40 hex)) +* ASCII symbols (Character ranges 91-96 decimal (5B-60 hex)) +* ASCII symbols (Character ranges 123-126 decimal (7B-7E hex)) +* Extended characters with character codes of 128 decimal (80 hex) and above. +
    +;Example: The string "http://foo bar/" would be encoded as "http%3A%2F%2Ffoo%20bar%2F". -'''Variations''' +;Variations: * Lowercase escapes are legal, as in "http%3a%2f%2ffoo%20bar%2f". * Some standards give different rules: RFC 3986, ''Uniform Resource Identifier (URI): Generic Syntax'', section 2.3, says that "-._~" should not be encoded. HTML 5, section [http://www.whatwg.org/specs/web-apps/current-work/multipage/association-of-controls-and-forms.html#url-encoded-form-data 4.10.22.5 URL-encoded form data], says to preserve "-._*", and to encode space " " to "+". The options below provide for utilization of an exception string, enabling preservation (non encoding) of particular characters to meet specific standards. -'''Options''' +;Options: It is permissible to use an exception string (containing a set of symbols that do not need to be converted). However, this is an optional feature and is not a requirement of this task. -;See also -[[URL decoding]] -[[URL parser]] + +;Related tasks: +*   [[URL decoding]] +*   [[URL parser]] +

    diff --git a/Task/URL-encoding/Elixir/url-encoding.elixir b/Task/URL-encoding/Elixir/url-encoding.elixir index 984c4ad90c..bd5eed7bc5 100644 --- a/Task/URL-encoding/Elixir/url-encoding.elixir +++ b/Task/URL-encoding/Elixir/url-encoding.elixir @@ -1,2 +1,2 @@ -iex(1)> URI.encode("http://foo bar/", &(URI.char_unreserved?/1)) +iex(1)> URI.encode("http://foo bar/", &URI.char_unreserved?/1) "http%3A%2F%2Ffoo%20bar%2F" diff --git a/Task/URL-encoding/REALbasic/url-encoding-2.realbasic b/Task/URL-encoding/REALbasic/url-encoding-2.realbasic index 3e95fe7632..8775223a1f 100644 --- a/Task/URL-encoding/REALbasic/url-encoding-2.realbasic +++ b/Task/URL-encoding/REALbasic/url-encoding-2.realbasic @@ -1,13 +1,21 @@ -Function URLEncode(URL As String, Exceptions As String = "") As String - For i As Integer = 0 To 255 - If InStr(Exceptions, Chr(i)) > 0 Then Continue For i - Dim char As String = Chr(127) + Right("00" + Hex(i), 2) - URL = ReplaceAll(URL, Chr(i), char) - If i = 47 Then i = 57 - If i = 64 Then i = 90 - If i = 96 Then i = 122 - If i = 126 Then i = 128 +Function URLEncode(Data As String, ParamArray Exceptions() As String) As String + Dim buf As String + For i As Integer = 1 To Data.Len + Dim char As String = Data.Mid(i, 1) + Select Case Asc(char) + Case 48 To 57, 65 To 90, 97 To 122, 45, 46, 95 + buf = buf + char + Else + If Exceptions.IndexOf(char) > -1 Then + buf = buf + char + Else + buf = buf + "%" + Left(Hex(Asc(char)) + "00", 2) + End If + End Select Next - URL = ReplaceAll(URL, Chr(127), "%") - Return URL + Return buf End Function + + 'usage + Dim s As String = URLEncode("http://foo bar/") ' no exceptions + Dim t As String = URLEncode("http://foo bar/", "!", "?", ",") ' with exceptions diff --git a/Task/Ulam-spiral--for-primes-/00DESCRIPTION b/Task/Ulam-spiral--for-primes-/00DESCRIPTION index 9d19e5624b..815b09059a 100644 --- a/Task/Ulam-spiral--for-primes-/00DESCRIPTION +++ b/Task/Ulam-spiral--for-primes-/00DESCRIPTION @@ -1,18 +1,31 @@ -An Ulam spiral (of primes numbers) is a method of visualizing prime numbers when expressed in a (normally counter-clockwise) outward spiral (usually starting at '''1'''), constructed on a square grid, starting at the "center". +An Ulam spiral (of primes numbers) is a method of visualizing prime numbers when expressed in a (normally counter-clockwise) outward spiral (usually starting at '''1'''),   constructed on a square grid, starting at the "center". -An Ulam spiral is also known as a ''prime spiral''. +An Ulam spiral is also known as a   ''prime spiral''. -The first grid (green) is shown with all numbers (primes and non-primes) shown, starting at '''1'''. +The first grid (green) is shown with all numbers (primes and non-primes) shown, starting at   '''1'''. -In an Ulam spiral of primes, only the primes are shown (usually indicated by some glyph such as a dot), and all non-primes as shown as a blank (or some other whitespace). Of course, the grid and border are not to be displayed (but they are displayed here when using these Wiki HTML tables). +In an Ulam spiral of primes, only the primes are shown (usually indicated by some glyph such as a dot or asterisk),   and all non-primes as shown as a blank   (or some other whitespace). -Normally, the spiral starts in the "center", and the 2nd number is to the viewer's right and the number spiral starts from there in a counter-clockwise direction. There are other geometric shapes that are used as well, including clock-wise spirals. Also, some spirals (for the 2nd number) is viewed upwards from the 1st number instead of to the right, but that is just a matter of orientation. +Of course, the grid and border are not to be displayed (but they are displayed here when using these Wiki HTML tables). + +Normally, the spiral starts in the "center",   and the   2nd   number is to the viewer's right and the number spiral starts from there in a counter-clockwise direction. + +There are other geometric shapes that are used as well, including clock-wise spirals. + +Also, some spirals (for the   2nd   number)   is viewed upwards from the   1st   number instead of to the right, but that is just a matter of orientation. Sometimes, the starting number can be specified to show more visual striking patterns (of prime densities). +[A larger than necessary grid (numbers wise) is shown here to illustrate the pattern of numbers on the diagonals   (which may be used by the method to orientate the direction of spiral-construction algorithm within the example computer programs)]. +Then, in the next phase in the transformation of the Ulam prime spiral,   the non-primes are translated to blanks. -{| class="wikitable" style="float:center;border: 4px solid blue; background:lightgreen; color:black; margin-left:auto;margin-right:auto;text-align:center;width:34em;height:34em;table-layout:fixed;font-size:125%" +In the orange grid below,   the primes are left intact,   and all non-primes are changed to blanks. + +Then, in the final transformation of the Ulam spiral (the yellow grid),   translate the primes to a glyph such as a     or some other suitable glyph. +
    + +{| class="wikitable" style="float:left;border: 2px solid black; background:lightgreen; color:black; margin-left:0;margin-right:auto;text-align:center;width:34em;height:34em;table-layout:fixed;font-size:70%" |- | '''65''' || '''64''' || '''63''' || '''62''' || '''61''' || '''60''' || '''59''' || '''58''' || '''57''' |-> @@ -33,15 +46,7 @@ Sometimes, the starting number can be specified to show more visual striking pat | '''73''' || '''74''' || '''75''' || '''76''' || '''77''' || '''78''' || '''79''' || '''80''' || '''81''' |} - -[A larger than necessary grid (numbers wise) is shown here to illustrate the pattern of numbers on the diagonals (which may be used by the method to orientate the direction of spiral-construction algorithm within the example computer programs)]. - - -Then, to show the Ulam prime spiral, a character (or glyph) is shown instead of each prime number, and a blank for all non-prime numbers. In the orange grid below, the prime numbers are left intact to see what numbers are to be changed to the character for viewing. - - - -{| class="wikitable" style="float:center;border: 4px solid blue; background:orange; color:black; margin-left:auto;margin-right:auto;text-align:center;width:34em;height:34em;table-layout:fixed;font-size:125%" +{| class="wikitable" style="float:left;border: 2px solid black; background:orange; color:black; margin-left:20px;margin-right:auto;text-align:center;width:34em;height:34em;table-layout:fixed;font-size:70%" |- | ''' ''' || ''' ''' || ''' ''' || ''' ''' || '''61''' || ''' ''' || '''59''' || ''' ''' || ''' ''' |- @@ -62,11 +67,7 @@ Then, to show the Ulam prime spiral, a character (or glyph) is shown instead of | '''73''' || ''' ''' || ''' ''' || ''' ''' || ''' ''' || ''' ''' || '''79''' || ''' ''' || ''' ''' |} - - -Then, in the final transformation of the Ulam spiral (the yellow grid), translate the primes to a glyph such as a or some other suitable glyph. - -{| class="wikitable" style="float:center;border: 4px solid blue; background:yellow; color:black; margin-left:auto;margin-right:auto;text-align:center;width:34em;height:34em;table-layout:fixed;font-size:125%" +{| class="wikitable" style="float:left;border: 2px solid black; background:yellow; color:black; margin-left:20px;margin-right:auto;text-align:center;width:34em;height:34em;table-layout:fixed;font-size:70%" |- | ''' ''' || ''' ''' || ''' ''' || ''' ''' || ''' ∙''' || ''' ''' || ''' ∙''' || ''' ''' || ''' ''' |- @@ -88,14 +89,23 @@ Then, in the final transformation of the Ulam spiral (the yellow grid), translat |} -;Task +
    +The Ulam spiral becomes more visually obvious as the grid increases in size. -For any sized '''N x N''' grid, construct and show an Ulam spiral (counter-clockwise) of primes starting at some specified initial number (the default would be '''1'''), with some suitably dotty representation to indicate primes, and the absence of dots to indicate non-primes. + +;Task +For any sized   '''N x N'''   grid,   construct and show an Ulam spiral (counter-clockwise) of primes starting at some specified initial number   (the default would be '''1'''),   with some suitably   ''dotty''   (glyph) representation to indicate primes,   and the absence of dots to indicate non-primes. You should demonstrate the generator by showing at Ulam prime spiral large enough to (almost) fill your terminal screen. -;Also see: -::* Wikipedia entry: [http://en.wikipedia.org/wiki/Ulam_spiral Ulam spiral]. -::* MathWorld™ entry: [http://mathworld.wolfram.com/PrimeSpiral.html Prime Spiral]. +;Related tasks: +*   [[Spiral matrix]] +*   [[Zig-zag matrix]] +*   [[Identity_matrix]] + + +;See also +* Wikipedia entry:   [http://en.wikipedia.org/wiki/Ulam_spiral Ulam spiral] +* MathWorld™ entry:   [http://mathworld.wolfram.com/PrimeSpiral.html Prime Spiral]

    diff --git a/Task/Ulam-spiral--for-primes-/360-Assembly/ulam-spiral--for-primes-.360 b/Task/Ulam-spiral--for-primes-/360-Assembly/ulam-spiral--for-primes-.360 new file mode 100644 index 0000000000..e4eb384557 --- /dev/null +++ b/Task/Ulam-spiral--for-primes-/360-Assembly/ulam-spiral--for-primes-.360 @@ -0,0 +1,145 @@ +* Ulam spiral 26/04/2016 +ULAM CSECT + USING ULAM,R13 set base register +SAVEAREA B STM-SAVEAREA(R15) skip savearea + DC 17F'0' savearea +STM STM R14,R12,12(R13) prolog + ST R13,4(R15) save previous SA + ST R15,8(R13) linkage in previous SA + LR R13,R15 establish addressability + LA R5,1 n=1 + LH R8,NSIZE x=nsize + SRA R8,1 + LA R8,1(R8) x=nsize/2+1 + LR R9,R8 y=x + LR R1,R5 n + BAL R14,ISPRIME + C R0,=F'1' if isprime(n) + BNE NPRMJ0 + BAL R14,SPIRALO spiral(x,y)=o +NPRMJ0 LA R5,1(R5) n=n+1 + LA R6,1 i=1 +LOOPI1 LH R2,NSIZE do i=1 to nsize-1 by 2 + BCTR R2,0 + CR R6,R2 if i>nsize-1 + BH ELOOPI1 + LR R7,R6 j=i; do j=1 to i +LOOPJ1 LA R8,1(R8) x=x+1 + LR R1,R5 n + BAL R14,ISPRIME + C R0,=F'1' if isprime(n) + BNE NPRMJ1 + BAL R14,SPIRALO spiral(x,y)=o +NPRMJ1 LA R5,1(R5) n=n+1 + BCT R7,LOOPJ1 next j +ELOOPJ1 LR R7,R6 j=i; do j=1 to i +LOOPJ2 BCTR R9,0 y=y-1 + LR R1,R5 n + BAL R14,ISPRIME + C R0,=F'1' if isprime(n) + BNE NPRMJ2 + BAL R14,SPIRALO spiral(x,y)=o +NPRMJ2 LA R5,1(R5) n=n+1 + BCT R7,LOOPJ2 next j +ELOOPJ2 LR R7,R6 j=i + LA R7,1(R7) j=i+1; do j=1 to i+1 +LOOPJ3 BCTR R8,0 x=x-1 + LR R1,R5 n + BAL R14,ISPRIME + C R0,=F'1' if isprime(n) + BNE NPRMJ3 + BAL R14,SPIRALO spiral(x,y)=o +NPRMJ3 LA R5,1(R5) n=n+1 + BCT R7,LOOPJ3 next j +ELOOPJ3 LR R7,R6 j=i + LA R7,1(R7) j=i+1; do j=1 to i+1 +LOOPJ4 LA R9,1(R9) y=y+1 + LR R1,R5 n + BAL R14,ISPRIME + C R0,=F'1' if isprime(n) + BNE NPRMJ4 + BAL R14,SPIRALO spiral(x,y)=o +NPRMJ4 LA R5,1(R5) n=n+1 + BCT R7,LOOPJ4 next j +ELOOPJ4 LA R6,2(R6) i=i+2 + B LOOPI1 +ELOOPI1 LH R7,NSIZE j=nsize + BCTR R7,0 j=nsize-1; do j=1 to nsize-1 +LOOPJ5 LA R8,1(R8) x=x+1 + LR R1,R5 n + BAL R14,ISPRIME + C R0,=F'1' if isprime(n) + BNE NPRMJ5 + BAL R14,SPIRALO spiral(x,y)=o +NPRMJ5 LA R5,1(R5) n=n+1 + BCT R7,LOOPJ5 next j +ELOOPJ5 LA R6,1 i=1 +LOOPI2 CH R6,NSIZE do i=1 to nsize + BH ELOOPI2 + LA R10,PG reset buffer + LA R7,1 j=1 +LOOPJ6 CH R7,NSIZE do j=1 to nsize + BH ELOOPJ6 + LR R1,R7 j + BCTR R1,0 (j-1) + MH R1,NSIZE (j-1)*nsize + AR R1,R6 r1=(j-1)*nsize+i + LA R14,SPIRAL-1(R1) @spiral(j,i) + MVC 0(1,R10),0(R14) output spiral(j,i) + LA R10,1(R10) pgi=pgi+1 + LA R7,1(R7) j=j+1 + B LOOPJ6 +ELOOPJ6 XPRNT PG,80 print + LA R6,1(R6) i=i+1 + B LOOPI2 +ELOOPI2 L R13,4(0,R13) reset previous SA + LM R14,R12,12(R13) restore previous env + XR R15,R15 set return code + BR R14 call back +ISPRIME CNOP 0,4 ---------- isprime function + C R1,=F'2' if nn=2 + BNE NOT2 + LA R0,1 rr=1 + B ELOOPII +NOT2 C R1,=F'2' if nn<2 + BL RRZERO + LR R2,R1 nn + LA R4,2 2 + SRDA R2,32 shift + DR R2,R4 nn/2 + C R2,=F'0' if nn//2=0 + BNE TAGII +RRZERO SR R0,R0 rr=0 + B ELOOPII +TAGII LA R0,1 rr=1 + LA R4,3 ii=3 +LOOPII LR R3,R4 ii + MR R2,R4 ii*ii + CR R3,R1 if ii*ii<=nn + BH ELOOPII + LR R3,R1 nn + LA R2,0 clear + DR R2,R4 nn/ii + LTR R2,R2 if nn//ii=0 + BNZ NEXTII + SR R0,R0 rr=0 + B ELOOPII +NEXTII LA R4,2(R4) ii=ii+2 + B LOOPII +ELOOPII BR R14 ---------- end isprime return rr +SPIRALO CNOP 0,4 ---------- spiralo subroutine + LR R1,R8 x + BCTR R1,0 x-1 + MH R1,NSIZE (x-1)*nsize + AR R1,R9 r1=(x-1)*nsize+y + LA R10,SPIRAL-1(R1) r10=@spiral(x,y) + MVC 0(1,R10),O spiral(x,y)=o + BR R14 ---------- end spiralo +NS EQU 79 4n+1 +NSIZE DC AL2(NS) =H'ns' +O DC CL1'*' if prime +PG DC CL80' ' buffer + LTORG +SPIRAL DC (NS*NS)CL1' ' + YREGS + END ULAM diff --git a/Task/Ulam-spiral--for-primes-/C++/ulam-spiral--for-primes-.cpp b/Task/Ulam-spiral--for-primes-/C++/ulam-spiral--for-primes--1.cpp similarity index 99% rename from Task/Ulam-spiral--for-primes-/C++/ulam-spiral--for-primes-.cpp rename to Task/Ulam-spiral--for-primes-/C++/ulam-spiral--for-primes--1.cpp index 1fe709a234..a05005bbbe 100644 --- a/Task/Ulam-spiral--for-primes-/C++/ulam-spiral--for-primes-.cpp +++ b/Task/Ulam-spiral--for-primes-/C++/ulam-spiral--for-primes--1.cpp @@ -1,4 +1,4 @@ -#include +#include #include #include #include diff --git a/Task/Ulam-spiral--for-primes-/C++/ulam-spiral--for-primes--2.cpp b/Task/Ulam-spiral--for-primes-/C++/ulam-spiral--for-primes--2.cpp new file mode 100644 index 0000000000..99eac864f8 --- /dev/null +++ b/Task/Ulam-spiral--for-primes-/C++/ulam-spiral--for-primes--2.cpp @@ -0,0 +1,65 @@ +#pragma once + +#include +#include +#include + +inline bool is_prime(unsigned a) { + if (a == 2) return true; + if (a <= 1 || a % 2 == 0) return false; + const unsigned max(std::sqrt(a)); + for (unsigned n = 3; n <= max; n += 2) if (a % n == 0) return false; + return true; +} + +enum direction { RIGHT, UP, LEFT, DOWN }; +const char* N = " ---"; + +template +class Ulam +{ +public: + Ulam(unsigned start = 1, const char c = '\0') { + direction dir = RIGHT; + unsigned y = SIZE / 2; + unsigned x = SIZE % 2 == 0 ? y - 1 : y; // shift left for even n's + for (unsigned j = start; j <= SIZE * SIZE - 1 + start; j++) { + if (is_prime(j)) { + std::ostringstream os(""); + if (c == '\0') os << std::setw(4) << j; + else os << " " << c << ' '; + s[y][x] = os.str(); + } + else s[y][x] = N; + + switch (dir) { + case RIGHT : if (x <= SIZE - 1 && s[y - 1][x].empty() && j > start) { dir = UP; }; break; + case UP : if (s[y][x - 1].empty()) { dir = LEFT; }; break; + case LEFT : if (x == 0 || s[y + 1][x].empty()) { dir = DOWN; }; break; + case DOWN : if (s[y][x + 1].empty()) { dir = RIGHT; }; break; + } + + switch (dir) { + case RIGHT : x += 1; break; + case UP : y -= 1; break; + case LEFT : x -= 1; break; + case DOWN : y += 1; break; + } + } + } + + template friend std::ostream& operator <<(std::ostream&, const Ulam&); + +private: + std::string s[SIZE][SIZE]; +}; + +template +std::ostream& operator <<(std::ostream& os, const Ulam& u) { + for (unsigned i = 0; i < SIZE; i++) { + os << '['; + for (unsigned j = 0; j < SIZE; j++) os << u.s[i][j]; + os << ']' << std::endl; + } + return os; +} diff --git a/Task/Ulam-spiral--for-primes-/C++/ulam-spiral--for-primes--3.cpp b/Task/Ulam-spiral--for-primes-/C++/ulam-spiral--for-primes--3.cpp new file mode 100644 index 0000000000..190a26cc24 --- /dev/null +++ b/Task/Ulam-spiral--for-primes-/C++/ulam-spiral--for-primes--3.cpp @@ -0,0 +1,13 @@ +#include +#include +#include "ulam.hpp" + +int main(const int argc, const char* argv[]) { + using namespace std; + + cout << Ulam<9>() << endl; + const Ulam<9> v(1, '*'); + cout << v << endl; + + return EXIT_SUCCESS; +} diff --git a/Task/Ulam-spiral--for-primes-/Fortran/ulam-spiral--for-primes--2.f b/Task/Ulam-spiral--for-primes-/Fortran/ulam-spiral--for-primes--2.f index 59642022ec..216e1bba02 100644 --- a/Task/Ulam-spiral--for-primes-/Fortran/ulam-spiral--for-primes--2.f +++ b/Task/Ulam-spiral--for-primes-/Fortran/ulam-spiral--for-primes--2.f @@ -3,6 +3,7 @@ Careful with phasing: each lunge's first number is the second placed along its d INTEGER START !Usually 1. INTEGER ORDER !MUST be an odd number, so there is a middle. INTEGER L,M,N !Counters. + INTEGER STEP,LUNGE !In some direction. COMPLEX WAY,PLACE !Just so. CHARACTER*1 SPLOT(0:1) !Tricks for output. PARAMETER (SPLOT = (/" ","*"/)) !Selected according to ISPRIME(n) diff --git a/Task/Ulam-spiral--for-primes-/Go/ulam-spiral--for-primes-.go b/Task/Ulam-spiral--for-primes-/Go/ulam-spiral--for-primes-.go new file mode 100644 index 0000000000..b399d6058e --- /dev/null +++ b/Task/Ulam-spiral--for-primes-/Go/ulam-spiral--for-primes-.go @@ -0,0 +1,60 @@ +package main + +import ( + "math" + "fmt" +) + +type Direction byte + +const ( + RIGHT Direction = iota + UP + LEFT + DOWN +) + +func generate(n,i int, c byte) { + s := make([][]string, n) + for i := 0; i < n; i++ { s[i] = make([]string, n) } + dir := RIGHT + y := n / 2 + var x int + if (n % 2 == 0) { x = y - 1 } else { x = y } // shift left for even n's + + for j := i; j <= n * n - 1 + i; j++ { + if (isPrime(j)) { + if (c == 0) { s[y][x] = fmt.Sprintf("%3d", j) } else { s[y][x] = fmt.Sprintf("%2c ", c) } + } else { s[y][x] = "---" } + + switch dir { + case RIGHT : if (x <= n - 1 && s[y - 1][x] == "" && j > i) { dir = UP } + case UP : if (s[y][x - 1] == "") { dir = LEFT } + case LEFT : if (x == 0 || s[y + 1][x] == "") { dir = DOWN } + case DOWN : if (s[y][x + 1] == "") { dir = RIGHT } + } + + switch dir { + case RIGHT : x += 1 + case UP : y -= 1 + case LEFT : x -= 1 + case DOWN : y += 1 + } + } + + for _, row := range s { fmt.Println(fmt.Sprintf("%v", row)) } + fmt.Println() +} + +func isPrime(a int) bool { + if (a == 2) { return true } + if (a <= 1 || a % 2 == 0) { return false } + max := int(math.Sqrt(float64(a))) + for n := 3; n <= max; n += 2 { if (a % n == 0) { return false } } + return true +} + +func main() { + generate(9, 1, 0) // with digits + generate(9, 1, '*') // with * +} diff --git a/Task/Ulam-spiral--for-primes-/Haskell/ulam-spiral--for-primes--1.hs b/Task/Ulam-spiral--for-primes-/Haskell/ulam-spiral--for-primes--1.hs new file mode 100644 index 0000000000..f07dc9e3d8 --- /dev/null +++ b/Task/Ulam-spiral--for-primes-/Haskell/ulam-spiral--for-primes--1.hs @@ -0,0 +1,4 @@ +import Data.List +import Data.Numbers.Primes + +ulam n representation = swirl n . map representation diff --git a/Task/Ulam-spiral--for-primes-/Haskell/ulam-spiral--for-primes--2.hs b/Task/Ulam-spiral--for-primes-/Haskell/ulam-spiral--for-primes--2.hs new file mode 100644 index 0000000000..dc22a4e91b --- /dev/null +++ b/Task/Ulam-spiral--for-primes-/Haskell/ulam-spiral--for-primes--2.hs @@ -0,0 +1,7 @@ +swirl n = spool . take (2*(n-1)+1) . chop 1 + +chop n lst = let (x,(y,z)) = splitAt n <$> splitAt n lst + in x:y:chop (n+1) z + +spool = foldl (\table piece -> piece : rotate table) [[]] + where rotate = reverse . transpose diff --git a/Task/Ulam-spiral--for-primes-/Haskell/ulam-spiral--for-primes--3.hs b/Task/Ulam-spiral--for-primes-/Haskell/ulam-spiral--for-primes--3.hs new file mode 100644 index 0000000000..d1f17c8386 --- /dev/null +++ b/Task/Ulam-spiral--for-primes-/Haskell/ulam-spiral--for-primes--3.hs @@ -0,0 +1,2 @@ +showTable w = foldMap (putStrLn . foldMap pad) + where pad s = take w $ s ++ repeat ' ' diff --git a/Task/Ulam-spiral--for-primes-/Haskell/ulam-spiral--for-primes--4.hs b/Task/Ulam-spiral--for-primes-/Haskell/ulam-spiral--for-primes--4.hs new file mode 100644 index 0000000000..6742141746 --- /dev/null +++ b/Task/Ulam-spiral--for-primes-/Haskell/ulam-spiral--for-primes--4.hs @@ -0,0 +1,8 @@ +import Diagrams.Prelude +import Diagrams.Backend.SVG.CmdLine + +drawTable tbl = foldl1 (===) $ map (foldl1 (|||)) tbl :: Diagram B + +dots x = (circle 1 # if isPrime x then fc black else fc white) :: Diagram B + +main = mainWith $ drawTable $ ulam 100 dots [1..] diff --git a/Task/Ulam-spiral--for-primes-/Haskell/ulam-spiral--for-primes-.hs b/Task/Ulam-spiral--for-primes-/Haskell/ulam-spiral--for-primes-.hs deleted file mode 100644 index 192ee48822..0000000000 --- a/Task/Ulam-spiral--for-primes-/Haskell/ulam-spiral--for-primes-.hs +++ /dev/null @@ -1,45 +0,0 @@ -import Data.List -import Data.Numbers.Primes - --- Add a row to existing spiral by rotating right and adding new row to top --- Results in spirals that turn in the wrong direction and must later be fixed. -addRow :: [[Int]] -> [[Int]] -addRow spiral = let height = length spiral - width = length $ head spiral - row = [height*width+1.. height*width+height] - in row : reverse (transpose spiral) - --- Generate spiral by adding two rows (vertical & horizontal) to smaller spiral -preSpiral :: Int => [[Int]] -preSpiral 1 = [[1]] -preSpiral n = addRow $ addRow $ preSpiral (n-1) - --- Make ulamSpiral; fix spiral direction by flipping preSpiral. -ulamSpiral :: Int => [[Int]] -ulamSpiral n | odd n = reverse $ preSpiral n - | otherwise = map reverse $ preSpiral n - --- Make and print ulamSpiral: - -- Use converter to change numbers to strings. - -- Change empty strings to dashes. - -- Pad strings out to correct length before printing. -prettyPrintSpiral :: Int -> (Int -> String) -> IO () -prettyPrintSpiral n converter = - let stringSpiral = map (map converter) (ulamSpiral n) - maxLen = maximum (map (maximum.map length) stringSpiral) - dashFunc s = if s == "" then replicate maxLen '-' else s - padFunc s = replicate (maxLen - length s) ' ' ++ s - padded = map (padFunc.dashFunc) - showRow = unwords.padded - in mapM_ (putStrLn.showRow) stringSpiral - - -main :: IO () -main = do - -- Display with converter that shows primes as Strings. - prettyPrintSpiral 10 (\n -> if isPrime n then show n else "") - - putStrLn "" - - -- Display with converter that shows primes as single dots. - prettyPrintSpiral 60 (\n -> if isPrime n then "*" else " ") diff --git a/Task/Ulam-spiral--for-primes-/Java/ulam-spiral--for-primes-.java b/Task/Ulam-spiral--for-primes-/Java/ulam-spiral--for-primes--1.java similarity index 100% rename from Task/Ulam-spiral--for-primes-/Java/ulam-spiral--for-primes-.java rename to Task/Ulam-spiral--for-primes-/Java/ulam-spiral--for-primes--1.java diff --git a/Task/Ulam-spiral--for-primes-/Java/ulam-spiral--for-primes--2.java b/Task/Ulam-spiral--for-primes-/Java/ulam-spiral--for-primes--2.java new file mode 100644 index 0000000000..3514973170 --- /dev/null +++ b/Task/Ulam-spiral--for-primes-/Java/ulam-spiral--for-primes--2.java @@ -0,0 +1,67 @@ +import java.awt.*; +import javax.swing.*; + +public class LargeUlamSpiral extends JPanel { + + public LargeUlamSpiral() { + setPreferredSize(new Dimension(605, 605)); + setBackground(Color.white); + } + + private boolean isPrime(int n) { + if (n <= 2 || n % 2 == 0) + return n == 2; + for (int i = 3; i * i <= n; i += 2) + if (n % i == 0) + return false; + return true; + } + + @Override + public void paintComponent(Graphics gg) { + super.paintComponent(gg); + Graphics2D g = (Graphics2D) gg; + g.setRenderingHint(RenderingHints.KEY_ANTIALIASING, + RenderingHints.VALUE_ANTIALIAS_ON); + + g.setColor(getForeground()); + + double angle = 0.0; + int x = 300, y = 300, dx = 1, dy = 0; + + for (int i = 1, step = 1, turn = 1; i < 40_000; i++) { + + if (isPrime(i)) + g.fillRect(x, y, 2, 2); + + x += dx * 3; + y += dy * 3; + + if (i == turn) { + + angle += 90.0; + + if ((dx == 0 && dy == -1) || (dx == 0 && dy == 1)) + step++; + + turn += step; + + dx = (int) Math.cos(Math.toRadians(angle)); + dy = (int) Math.sin(Math.toRadians(-angle)); + } + } + } + + public static void main(String[] args) { + SwingUtilities.invokeLater(() -> { + JFrame f = new JFrame(); + f.setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE); + f.setTitle("Large Ulam Spiral"); + f.setResizable(false); + f.add(new LargeUlamSpiral(), BorderLayout.CENTER); + f.pack(); + f.setLocationRelativeTo(null); + f.setVisible(true); + }); + } +} diff --git a/Task/Ulam-spiral--for-primes-/Java/ulam-spiral--for-primes--3.java b/Task/Ulam-spiral--for-primes-/Java/ulam-spiral--for-primes--3.java new file mode 100644 index 0000000000..16fc26e594 --- /dev/null +++ b/Task/Ulam-spiral--for-primes-/Java/ulam-spiral--for-primes--3.java @@ -0,0 +1,79 @@ +import java.awt.*; +import javax.swing.*; + +public class UlamSpiral extends JPanel { + + Font primeFont = new Font("Arial", Font.BOLD, 20); + Font compositeFont = new Font("Arial", Font.PLAIN, 16); + + public UlamSpiral() { + setPreferredSize(new Dimension(640, 640)); + setBackground(Color.white); + } + + private boolean isPrime(int n) { + if (n <= 2 || n % 2 == 0) + return n == 2; + for (int i = 3; i * i <= n; i += 2) + if (n % i == 0) + return false; + return true; + } + + @Override + public void paintComponent(Graphics gg) { + super.paintComponent(gg); + Graphics2D g = (Graphics2D) gg; + g.setRenderingHint(RenderingHints.KEY_ANTIALIASING, + RenderingHints.VALUE_ANTIALIAS_ON); + + g.setStroke(new BasicStroke(2)); + + double angle = 0.0; + int x = 280, y = 330, dx = 1, dy = 0; + + g.setColor(getForeground()); + g.drawLine(x, y - 5, x + 50, y - 5); + + for (int i = 1, step = 1, turn = 1; i < 100; i++) { + + g.setColor(getBackground()); + g.fillRect(x - 5, y - 20, 30, 30); + g.setColor(getForeground()); + g.setFont(isPrime(i) ? primeFont : compositeFont); + g.drawString(String.valueOf(i), x + (i < 10 ? 4 : 0), y); + + x += dx * 50; + y += dy * 50; + + if (i == turn) { + angle += 90.0; + + if ((dx == 0 && dy == -1) || (dx == 0 && dy == 1)) + step++; + + turn += step; + + dx = (int) Math.cos(Math.toRadians(angle)); + dy = (int) Math.sin(Math.toRadians(-angle)); + + g.translate(9, -5); + g.drawLine(x, y, x + dx * step * 50, y + dy * step * 50); + g.translate(-9, 5); + } + } + } + + public static void main(String[] args) { + SwingUtilities.invokeLater(() -> { + JFrame f = new JFrame(); + f.setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE); + f.setTitle("Ulam Spiral"); + f.setResizable(false); + f.add(new UlamSpiral(), BorderLayout.CENTER); + f.pack(); + f.setLocationRelativeTo(null); + f.setVisible(true); + }); + } +} diff --git a/Task/Ulam-spiral--for-primes-/Kotlin/ulam-spiral--for-primes-.kotlin b/Task/Ulam-spiral--for-primes-/Kotlin/ulam-spiral--for-primes-.kotlin new file mode 100644 index 0000000000..e90fd33998 --- /dev/null +++ b/Task/Ulam-spiral--for-primes-/Kotlin/ulam-spiral--for-primes-.kotlin @@ -0,0 +1,50 @@ +package ulam + +object Ulam { + fun generate(n: Int, i: Int = 1, c: Char = '*') { + require(n > 1) + val s = Array(n) { Array(n, { "" }) } + var dir = Direction.RIGHT + var y = n / 2 + var x = if (n % 2 == 0) y - 1 else y // shift left for even n's + for (j in i..n * n - 1 + i) { + s[y][x] = if (isPrime(j)) if (c.isDigit()) "%4d".format(j) else " $c " else " ---" + + when (dir) { + Direction.RIGHT -> if (x <= n - 1 && s[y - 1][x].none() && j > i) dir = Direction.UP + Direction.UP -> if (s[y][x - 1].none()) dir = Direction.LEFT + Direction.LEFT -> if (x == 0 || s[y + 1][x].none()) dir = Direction.DOWN + Direction.DOWN -> if (s[y][x + 1].none()) dir = Direction.RIGHT + } + + when (dir) { + Direction.RIGHT -> x++ + Direction.UP -> y-- + Direction.LEFT -> x-- + Direction.DOWN -> y++ + } + } + for (row in s) println("[" + row.joinToString("") + ']') + println() + } + + private enum class Direction { RIGHT, UP, LEFT, DOWN } + + private fun isPrime(a: Int): Boolean { + when { + a == 2 -> return true + a <= 1 || a % 2 == 0 -> return false + else -> { + val max = Math.sqrt(a.toDouble()).toInt() + for (n in 3..max step 2) + if (a % n == 0) return false + return true + } + } + } +} + +fun main(args: Array) { + Ulam.generate(9, c = '0') + Ulam.generate(9) +} diff --git a/Task/Ulam-spiral--for-primes-/PARI-GP/ulam-spiral--for-primes-.pari b/Task/Ulam-spiral--for-primes-/PARI-GP/ulam-spiral--for-primes-.pari new file mode 100644 index 0000000000..e1bb4b2166 --- /dev/null +++ b/Task/Ulam-spiral--for-primes-/PARI-GP/ulam-spiral--for-primes-.pari @@ -0,0 +1,30 @@ +\\ Ulam spiral (plotting/printing) +\\ 4/19/16 aev +plotulamspir(n,pflg=0)={ +my(n=if(n%2==0,n++,n),M=matrix(n,n),x,y,xmx,ymx,cnt,dir,n2=n*n,pch,sz=#Str(n2),pch2=srepeat(" ",sz)); +if(pflg<0||pflg>2,pflg=0); +print(" *** Ulam spiral: ",n,"x",n," matrix, p-flag=",pflg); +x=y=n\2+1; xmx=ymx=cnt=1; dir="R"; +for(i=1,n2, + if(isprime(i), if(!insm(M,x,y), break); if(pflg==2, M[y,x]=i, M[y,x]=1)); + if(dir=="R", if(xmx>0, x++;xmx--, dir="U";ymx=cnt;y--;ymx--); next); + if(dir=="U", if(ymx>0, y--;ymx--, dir="L";cnt++;xmx=cnt;x--;xmx--); next); + if(dir=="L", if(xmx>0, x--;xmx--, dir="D";ymx=cnt;y++;ymx--); next); + if(dir=="D", if(ymx>0, y++;ymx--, dir="R";cnt++;xmx=cnt;x++;xmx--); next); + );\\fend +\\Plot/Print according to the p-flag(0-real plot,1-"*",2-primes) +if(pflg==0, plotmat(M)); +if(pflg==1, for(i=1,n, + for(j=1,n, if(M[i,j]==1, pch="*", pch=" "); + print1(" ",pch)); print(" "))); +if(pflg==2, for(i=1,n, + for(j=1,n, if(M[i,j]==0, pch=pch2, pch=spad(Str(M[i,j]),sz,,1)); + print1(" ",pch)); print(" "))); +} + +{\\ Executing: +plotulamspir(9,1); \\ (see output) +plotulamspir(9,2); \\ (see output) +plotulamspir(100); \\ ULAMspiral1.png +plotulamspir(200); \\ ULAMspiral2.png +} diff --git a/Task/Ulam-spiral--for-primes-/PicoLisp/ulam-spiral--for-primes-.l b/Task/Ulam-spiral--for-primes-/PicoLisp/ulam-spiral--for-primes-.l new file mode 100644 index 0000000000..32ab95ac96 --- /dev/null +++ b/Task/Ulam-spiral--for-primes-/PicoLisp/ulam-spiral--for-primes-.l @@ -0,0 +1,46 @@ +(load "@lib/simul.l") + +(de ceil (A) + (/ (+ A 1) 2) ) + +(de prime? (N) + (or + (= N 2) + (and + (> N 1) + (bit? 1 N) + (let S (sqrt N) + (for (D 3 T (+ D 2)) + (T (> D S) T) + (T (=0 (% N D)) NIL) ) ) ) ) ) + +(de ulam (N) + (let + (G (grid N N) + D '(north west south east .) + M (ceil N) ) + (setq This + (intern + (pack + (char + (+ 96 (if (bit? 1 N) M (inc M))) ) + M ) ) ) + (=: V '_) + (with ((car D) This) + (for (X 2 (>= (* N N) X) (inc X)) + (=: V (if (prime? X) '. '_)) + (setq This + (or + (with ((cadr D) This) + (unless (: V) (pop 'D) This) ) + ((pop D) This) ) ) ) ) + G ) ) + +(mapc + '((L) + (for This L + (prin (align 3 (: V))) ) + (prinl) ) + (ulam 9) ) + +(bye) diff --git a/Task/Ulam-spiral--for-primes-/PowerShell/ulam-spiral--for-primes-.psh b/Task/Ulam-spiral--for-primes-/PowerShell/ulam-spiral--for-primes-.psh new file mode 100644 index 0000000000..344b1681d4 --- /dev/null +++ b/Task/Ulam-spiral--for-primes-/PowerShell/ulam-spiral--for-primes-.psh @@ -0,0 +1,40 @@ +function New-UlamSpiral ( [int]$N ) + { + # Generate list of primes + $Primes = @( 2 ) + For ( $X = 3; $X -le $N*$N; $X += 2 ) + { + If ( -not ( $Primes | Where { $X % $_ -eq 0 } | Select -First 1 ) ) { $Primes += $X } + } + + # Initialize variables + $X = 0 + $Y = -1 + $i = $N * $N + 1 + $Sign = 1 + + # Intialize array + $A = New-Object 'boolean[,]' $N, $N + + # Set top row + 1..$N | ForEach { $Y += $Sign; $A[$X,$Y] = --$i -in $Primes } + + # For each remaining half spiral... + ForEach ( $M in ($N-1)..1 ) + { + # Set the vertical quarter spiral + 1..$M | ForEach { $X += $Sign; $A[$X,$Y] = --$i -in $Primes } + + # Curve the spiral + $Sign = -$Sign + + # Set the horizontal quarter spiral + 1..$M | ForEach { $Y += $Sign; $A[$X,$Y] = --$i -in $Primes } + } + + # Convert the array of booleans to text output of dots and spaces + $Spiral = ForEach ( $X in 1..$N ) { ( 1..$N | ForEach { ( ' ', '.' )[$A[($X-1),($_-1)]] } ) -join '' } + return $Spiral + } + +New-UlamSpiral 100 diff --git a/Task/Ulam-spiral--for-primes-/REXX/ulam-spiral--for-primes--1.rexx b/Task/Ulam-spiral--for-primes-/REXX/ulam-spiral--for-primes--1.rexx index 1929f5eaad..7ae9751525 100644 --- a/Task/Ulam-spiral--for-primes-/REXX/ulam-spiral--for-primes--1.rexx +++ b/Task/Ulam-spiral--for-primes-/REXX/ulam-spiral--for-primes--1.rexx @@ -1,42 +1,49 @@ -/*REXX pgm shows cntr-clockwise Ulam spiral of primes in a square matrix*/ -parse arg size init char . /*get the matrix size from the CL*/ -if size=='' | size==',' then size=79 /*No size? Then use default of 79*/ -if init=='' | init==',' then init= 1 /*No init? Then use default of 1 */ -if char=='' then char='█' /*No char? Then use default of █ */ -tot=size**2; offset=init-1 /*numbers in spiral; start offset*/ -uR.=0; bR.=0 /*the upper/bottom right corners.*/ - do od=1 by 2 to tot; _=od**2+1+offset; uR._=1; _=_ + od; bR._=1; end -bL.=0; uL.=0 /*the bottom/upper left corners. */ - do ev=2 by 2 to tot; _=ev**2+1+offset; bL._=1; _=_ + ev; uL._=1; end -$.= -bigP=0; #p=0; app=1; inc=0; r=1; $=0; minR=1; maxR=1; $=0; !.= -/*──────────────────────────────────────────────construct the spiral #s.*/ - do i=init for tot; r=r+inc; minR=min(minR,r); maxR=max(maxR,r) - x=isPrime(i); if x then bigP=max(bigP,i); #p=#p+x /*bigP, #primes.*/ - if app then $.r=$.r || x /*append token.*/ - else $.r= x || $.r /*prepend token.*/ - if uR.i then do; app=1; inc=+1; iterate; end /*advance ↓ */ - if bL.i then do; app=0; inc=-1; iterate; end /* " ↑ */ - if bR.i then do; app=0; inc= 0; iterate; end /* " ► */ - if uL.i then do; app=1; inc= 0; iterate; end /* " ◄ */ - end /*i*/ +/*REXX program shows counter─clockwise Ulam spiral of primes shown in a square matrix.*/ +parse arg size init char . /*obtain optional arguments from the CL*/ +if size=='' | size=="," then size=79 /*Not specified? Then use the default.*/ +if init=='' | init=="," then init= 1 /* " " " " " " */ +if char=='' then char="█" /* " " " " " " */ +tot=size**2 /*the total number of numbers in spiral*/ + /*define the upper/bottom right corners*/ +uR.=0; bR.=0; do od=1 by 2 to tot; _=od**2+1; uR._=1; _=_+od; bR._=1; end /*od*/ + /*define the bottom/upper left corners.*/ +bL.=0; uL.=0; do ev=2 by 2 to tot; _=ev**2+1; bL._=1; _=_+ev; uL._=1; end /*ev*/ - do j=minR to maxR by 2; jp=j+1; $=$+1 /*fold two lines*/ - do k=1 for length($.j); top=substr($.j,k,1) /*the 1st line*/ - bot=word(substr($.jp,k,1) 0,1) /*2nd line*/ - if top then if bot then !.$=!.$'█' /*has top & bot.*/ - else !.$=!.$'▀' /*has top,¬ bot.*/ - else if bot then !.$=!.$'▄' /*¬ top, has bot*/ - else !.$=!.$' ' /*¬ top, ¬ bot.*/ - end /*k*/ - end /*j*/ /* [↓] show prime# spiral matrix*/ +app=1; bigP=0; #p=0; inc=0; minR=1; maxR=1; r=1; $=0; $.=; !.= + /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒ construct the spiral #s.*/ + do i=init for tot; r=r+inc; minR=min(minR,r); maxR=max(maxR,r) + x=isPrime(i); if x then bigP=max(bigP,i); #p=#p+x /*bigP, #primes.*/ + if app then $.r=$.r || x /*append token.*/ + else $.r= x || $.r /*prepend token.*/ + if uR.i then do; app=1; inc=+1; iterate /*i*/; end /*advance ↓ */ + if bL.i then do; app=0; inc=-1; iterate /*i*/; end /* " ↑ */ + if bR.i then do; app=0; inc= 0; iterate /*i*/; end /* " ► */ + if uL.i then do; app=1; inc= 0; iterate /*i*/; end /* " ◄ */ + end /*i*/ /* [↓] pack two */ + /*lines ──► one.*/ + do j=minR to maxR by 2; jp=j+1; $=$+1 /*fold two lines*/ + do k=1 for length($.j); top=substr($.j,k,1) /*the 1st line.*/ + bot=word(substr($.jp,k,1) 0,1) /*the 2nd line.*/ + if top then if bot then !.$= !.$'█' /*has top & bot.*/ + else !.$= !.$'▀' /*has top,¬ bot.*/ + else if bot then !.$= !.$'▄' /*¬ top, has bot*/ + else !.$= !.$' ' /*¬ top, ¬ bot*/ + end /*k*/ + end /*j*/ /* [↓] show the prime spiral matrix.*/ do m=1 for $; say !.m; end /*m*/ say; say init 'is the starting point,' , - tot 'numbers used,' #p "primes found, largest prime:" bigP -exit /*stick a fork in it, we're done.*/ -/*───────────────────────────────────ISPRIME subroutine──────────────────────────────*/ -isPrime: procedure; parse arg x; if x<2 then return 0 -if wordpos(x,'2 3 5 7')\==0 then return 1 -if x//2==0 then return 0; if x//3==0 then return 0 - do j=5 by 6 until j*j>x; if x//j==0 then return 0; if x//(j+2)==0 then return 0; end -return 1 + tot 'numbers used,' #p "primes found, largest prime:" bigP +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +isPrime: procedure; parse arg x; if wordpos(x,'2 3 5 7 11 13 17 19') \==0 then return 1 + if x<17 then return 0; if x// 2 ==0 then return 0 + if x// 3 ==0 then return 0 + /*get the last digit*/ parse var x '' -1 _; if _==5 then return 0 + if x// 7 ==0 then return 0 + if x//11 ==0 then return 0 + if x//13 ==0 then return 0 + + do j=17 by 6 until j*j > x; if x//j ==0 then return 0 + if x//(j+2) ==0 then return 0 + end /*j*/ + return 1 diff --git a/Task/Ulam-spiral--for-primes-/REXX/ulam-spiral--for-primes--2.rexx b/Task/Ulam-spiral--for-primes-/REXX/ulam-spiral--for-primes--2.rexx index 6919316532..4f03915ffa 100644 --- a/Task/Ulam-spiral--for-primes-/REXX/ulam-spiral--for-primes--2.rexx +++ b/Task/Ulam-spiral--for-primes-/REXX/ulam-spiral--for-primes--2.rexx @@ -1,42 +1,49 @@ -/*REXX pgm shows a clockwise Ulam spiral of primes in a square matrix. */ -parse arg size init char . /*get the matrix size from the CL*/ -if size=='' | size==',' then size=79 /*No size? Then use default of 79*/ -if init=='' | init==',' then init= 1 /*No init? Then use default of 1 */ -if char=='' then char='█' /*No char? Then use default of █ */ -tot=size**2; offset=init-1 /*numbers in spiral; start offset*/ -uR.=0; bR.=0 /*the upper/bottom right corners.*/ - do od=1 by 2 to tot; _=od**2+1+offset; uR._=1; _=_ + od; bR._=1; end -bL.=0; uL.=0 /*the bottom/upper left corners. */ - do ev=2 by 2 to tot; _=ev**2+1+offset; bL._=1; _=_ + ev; uL._=1; end -$.= -bigP=0; #p=0; app=1; inc=0; r=1; $=0; minR=1; maxR=1; $=0; !.= -/*──────────────────────────────────────────────construct the spiral #s.*/ - do i=init for tot; r=r+inc; minR=min(minR,r); maxR=max(maxR,r) - x=isPrime(i); if x then bigP=max(bigP,i); #p=#p+x /*bigP, #primes.*/ - if app then $.r=$.r || x /*append token.*/ - else $.r= x || $.r /*prepend token.*/ - if uR.i then do; app=1; inc=+1; iterate; end /*advance ↓ */ - if bL.i then do; app=0; inc=-1; iterate; end /* " ↑ */ - if bR.i then do; app=0; inc= 0; iterate; end /* " ► */ - if uL.i then do; app=1; inc= 0; iterate; end /* " ◄ */ - end /*i*/ +/*REXX program shows a clockwise Ulam spiral of primes shown in a square matrix.*/ +parse arg size init char . /*obtain optional arguments from the CL*/ +if size=='' | size=="," then size=79 /*Not specified? Then use the default.*/ +if init=='' | init=="," then init= 1 /* " " " " " " */ +if char=='' then char="█" /* " " " " " " */ +tot=size**2 /*the total number of numbers in spiral*/ + /*define the upper/bottom right corners*/ +uR.=0; bR.=0; do od=1 by 2 to tot; _=od**2+init; uR._=1; _=_+od; bR._=1; end /*od*/ + /*define the bottom/upper left corners.*/ +bL.=0; uL.=0; do ev=2 by 2 to tot; _=ev**2+init; bL._=1; _=_+ev; uL._=1; end /*ev*/ - do j=minR to maxR by 2; jp=j+1; $=$+1 /*fold two lines*/ - do k=1 for length($.j); top=substr($.j,k,1) /*the 1st line*/ - bot=word(substr($.jp,k,1) 0,1) /*2nd line*/ - if top then if bot then !.$=!.$'█' /*has top & bot.*/ - else !.$=!.$'▀' /*has top,¬ bot.*/ - else if bot then !.$=!.$'▄' /*¬ top, has bot*/ - else !.$=!.$' ' /*¬ top, ¬ bot*/ - end /*k*/ - end /*j*/ /* [↓] show prime# spiral matrix*/ +app=1; bigP=0; #p=0; inc=0; minR=1; maxR=1; r=1; $=0; $.=; !.= + /*▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒ construct the spiral #s.*/ + do i=init for tot; r=r+inc; minR=min(minR,r); maxR=max(maxR,r) + x=isPrime(i); if x then bigP=max(bigP,i); #p=#p+x /*bigP, #primes.*/ + if app then $.r=$.r || x /*append token.*/ + else $.r= x || $.r /*prepend token.*/ + if uR.i then do; app=1; inc=+1; iterate /*i*/; end /*advance ↓ */ + if bL.i then do; app=0; inc=-1; iterate /*i*/; end /* " ↑ */ + if bR.i then do; app=0; inc= 0; iterate /*i*/; end /* " ► */ + if uL.i then do; app=1; inc= 0; iterate /*i*/; end /* " ◄ */ + end /*i*/ /* [↓] pack two */ + /*lines ──► one.*/ + do j=minR to maxR by 2; jp=j+1; $=$+1 /*fold two lines*/ + do k=1 for length($.j); top=substr($.j,k,1) /*the 1st line.*/ + bot=word(substr($.jp,k,1) 0,1) /*the 2nd line.*/ + if top then if bot then !.$= !.$'█' /*has top & bot.*/ + else !.$= !.$'▀' /*has top,¬ bot.*/ + else if bot then !.$= !.$'▄' /*¬ top, has bot*/ + else !.$= !.$' ' /*¬ top, ¬ bot*/ + end /*k*/ + end /*j*/ /* [↓] show the prime spiral matrix.*/ do m=1 for $; say !.m; end /*m*/ say; say init 'is the starting point,' , - tot 'numbers used,' #p "primes found, largest prime:" bigP -exit /*stick a fork in it, we're done.*/ -/*───────────────────────────────────ISPRIME subroutine──────────────────────────────*/ -isPrime: procedure; parse arg x; if x<2 then return 0 -if wordpos(x,'2 3 5 7')\==0 then return 1 -if x//2==0 then return 0; if x//3==0 then return 0 - do j=5 by 6 until j*j>x; if x//j==0 then return 0; if x//(j+2)==0 then return 0; end -return 1 + tot 'numbers used,' #p "primes found, largest prime:" bigP +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +isPrime: procedure; parse arg x; if wordpos(x,'2 3 5 7 11 13 17 19') \==0 then return 1 + if x<17 then return 0; if x// 2 ==0 then return 0 + if x// 3 ==0 then return 0 + /*get the last digit*/ parse var x '' -1 _; if _==5 then return 0 + if x// 7 ==0 then return 0 + if x//11 ==0 then return 0 + if x//13 ==0 then return 0 + + do j=17 by 6 until j*j > x; if x//j ==0 then return 0 + if x//(j+2) ==0 then return 0 + end /*j*/ + return 1 diff --git a/Task/Ulam-spiral--for-primes-/Rust/ulam-spiral--for-primes--1.rust b/Task/Ulam-spiral--for-primes-/Rust/ulam-spiral--for-primes--1.rust new file mode 100644 index 0000000000..be62473076 --- /dev/null +++ b/Task/Ulam-spiral--for-primes-/Rust/ulam-spiral--for-primes--1.rust @@ -0,0 +1,58 @@ +use std::fmt; + +enum Direction { RIGHT, UP, LEFT, DOWN } +use ulam::Direction::*; + +/// Indicates whether an integer is a prime number or not. +fn is_prime(a: u32) -> bool { + match a { + 2 => true, + x if x <= 1 || x % 2 == 0 => false, + _ => { + let max = f64::sqrt(a as f64) as u32; + let mut x = 3; + while x <= max { + if a % x == 0 { return false; } + x += 2; + } + true + } + } +} + +pub struct Ulam { u : Vec> } + +impl Ulam { + /// Generates one `Ulam` object. + pub fn new(n: u32, s: u32, c: char) -> Ulam { + let mut spiral = vec![vec![String::new(); n as usize]; n as usize]; + let mut dir = RIGHT; + let mut y = (n / 2) as usize; + let mut x = if n % 2 == 0 { y - 1 } else { y }; // shift left for even n's + for j in s..n * n + s { + spiral[y][x] = if is_prime(j) { + if c == '\0' { format!("{:4}", j) } else { format!(" {} ", c) } + } + else { String::from(" ---") }; + + match dir { + RIGHT => if x as u32 <= n - 1 && spiral[y - 1][x].is_empty() && j > s { dir = UP; }, + UP => if spiral[y][x - 1].is_empty() { dir = LEFT; }, + LEFT => if x == 0 || spiral[y + 1][x].is_empty() { dir = DOWN; }, + DOWN => if spiral[y][x + 1].is_empty() { dir = RIGHT; } + }; + + match dir { RIGHT => x += 1, UP => y -= 1, LEFT => x -= 1, DOWN => y += 1 }; + } + Ulam { u: spiral } + } +} + +impl fmt::Display for Ulam { + fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result { + for row in &self.u { + writeln!(f, "{}", format!("{:?}", row).replace("\"", "").replace(", ", "")); + }; + writeln!(f, "") + } +} diff --git a/Task/Ulam-spiral--for-primes-/Rust/ulam-spiral--for-primes--2.rust b/Task/Ulam-spiral--for-primes-/Rust/ulam-spiral--for-primes--2.rust new file mode 100644 index 0000000000..5b73cc6ab7 --- /dev/null +++ b/Task/Ulam-spiral--for-primes-/Rust/ulam-spiral--for-primes--2.rust @@ -0,0 +1,8 @@ +mod ulam; +use ulam::*; + +// Program entry point. +fn main() { + print!("{}", Ulam::new(9, 1, '\0')); + print!("{}", Ulam::new(9, 1, '*')); +} diff --git a/Task/Ulam-spiral--for-primes-/Scala/ulam-spiral--for-primes-.scala b/Task/Ulam-spiral--for-primes-/Scala/ulam-spiral--for-primes-.scala new file mode 100644 index 0000000000..71e33760df --- /dev/null +++ b/Task/Ulam-spiral--for-primes-/Scala/ulam-spiral--for-primes-.scala @@ -0,0 +1,43 @@ +object Ulam extends App { + generate(9)() + generate(9)('*') + + private object Direction extends Enumeration { val RIGHT, UP, LEFT, DOWN = Value } + + private def generate(n: Int, i: Int = 1)(c: Char = 0) { + assert(n > 1, "n > 1") + val s = new Array[Array[String]](n).transform {_ => new Array[String](n) } + + import Direction._ + var dir = RIGHT + var y = n / 2 + var x = if (n % 2 == 0) y - 1 else y // shift left for even n's + for (j <- i to n * n - 1 + i) { + s(y)(x) = if (isPrime(j)) if (c == 0) "%4d".format(j) else s" $c " else " ---" + + dir match { + case RIGHT => if (x <= n - 1 && s(y - 1)(x) == null && j > i) dir = UP + case UP => if (s(y)(x - 1) == null) dir = LEFT + case LEFT => if (x == 0 || s(y + 1)(x) == null) dir = DOWN + case DOWN => if (s(y)(x + 1) == null) dir = RIGHT + } + + dir match { + case RIGHT => x += 1 + case UP => y -= 1 + case LEFT => x -= 1 + case DOWN => y += 1 + } + } + println("[" + s.map(_.mkString("")).reduceLeft(_ + "]\n[" + _) + "]\n") + } + + private def isPrime(a: Int): Boolean = { + if (a == 2) return true + if (a <= 1 || a % 2 == 0) return false + val max = Math.sqrt(a.toDouble).toInt + for (n <- 3 to max by 2) + if (a % n == 0) return false + true + } +} diff --git a/Task/Unbias-a-random-generator/00DESCRIPTION b/Task/Unbias-a-random-generator/00DESCRIPTION index 83740b4d6a..e40e929fac 100644 --- a/Task/Unbias-a-random-generator/00DESCRIPTION +++ b/Task/Unbias-a-random-generator/00DESCRIPTION @@ -1,10 +1,13 @@ Given a weighted one bit generator of random numbers where the probability of a one occuring, P_1, is not the same as P_0, the probability of a zero occuring, the probability of the occurrence of a one followed by a zero is P_1 × P_0. This is the same as the probability of a zero followed by a one: P_0 × P_1. -'''Task Details''' + +;Task details: * Use your language's random number generator to create a function/method/subroutine/... '''randN''' that returns a one or a zero, but with one occurring, on average, 1 out of N times, where N is an integer from the range 3 to 6 inclusive. * Create a function '''unbiased''' that uses only randN as its source of randomness to become an unbiased generator of random ones and zeroes. * For N over its range, generate and show counts of the outputs of randN and unbiased(randN). +
    The actual unbiasing should be done by generating two numbers at a time from randN and only returning a 1 or 0 if they are different. As long as you always return the first number or always return the second number, the probabilities discussed above should take over the biased probability of randN. This task is an implementation of [http://en.wikipedia.org/wiki/Randomness_extractor#Von_Neumann_extractor Von Neumann debiasing], first described in a 1951 paper. +

    diff --git a/Task/Unbias-a-random-generator/Elixir/unbias-a-random-generator.elixir b/Task/Unbias-a-random-generator/Elixir/unbias-a-random-generator.elixir index 4d6e5cb2f5..992508c4e6 100644 --- a/Task/Unbias-a-random-generator/Elixir/unbias-a-random-generator.elixir +++ b/Task/Unbias-a-random-generator/Elixir/unbias-a-random-generator.elixir @@ -1,9 +1,6 @@ defmodule Random do - def init() do - :random.seed(:erlang.now) - end def randN(n) do - if :random.uniform(n) == 1, do: 1, else: 0 + if :rand.uniform(n) == 1, do: 1, else: 0 end def unbiased(n) do {x, y} = {randN(n), randN(n)} @@ -12,9 +9,9 @@ defmodule Random do end IO.puts "N biased unbiased" -Random.init +m = 10000 for n <- 3..6 do - xs = for _ <- 1..10000, do: Random.randN(n) - ys = for _ <- 1..10000, do: Random.unbiased(n) - IO.puts "#{n} #{Enum.sum(xs) / Enum.count(xs)} #{Enum.sum(ys) / Enum.count(ys)}" + xs = for _ <- 1..m, do: Random.randN(n) + ys = for _ <- 1..m, do: Random.unbiased(n) + IO.puts "#{n} #{Enum.sum(xs) / m} #{Enum.sum(ys) / m}" end diff --git a/Task/Unbias-a-random-generator/Haskell/unbias-a-random-generator-1.hs b/Task/Unbias-a-random-generator/Haskell/unbias-a-random-generator-1.hs new file mode 100644 index 0000000000..0212543388 --- /dev/null +++ b/Task/Unbias-a-random-generator/Haskell/unbias-a-random-generator-1.hs @@ -0,0 +1,6 @@ +import Control.Monad.Random +import Control.Monad +import Text.Printf + +randN :: MonadRandom m => Int -> m Int +randN n = fromList [(0, fromIntegral n-1), (1, 1)] diff --git a/Task/Unbias-a-random-generator/Haskell/unbias-a-random-generator-2.hs b/Task/Unbias-a-random-generator/Haskell/unbias-a-random-generator-2.hs new file mode 100644 index 0000000000..731b0c46b0 --- /dev/null +++ b/Task/Unbias-a-random-generator/Haskell/unbias-a-random-generator-2.hs @@ -0,0 +1,4 @@ +unbiased :: (MonadRandom m, Eq x) => m x -> m x +unbiased g = do x <- g + y <- g + if x /= y then return y else unbiased g diff --git a/Task/Unbias-a-random-generator/Haskell/unbias-a-random-generator-3.hs b/Task/Unbias-a-random-generator/Haskell/unbias-a-random-generator-3.hs new file mode 100644 index 0000000000..3ca231b46b --- /dev/null +++ b/Task/Unbias-a-random-generator/Haskell/unbias-a-random-generator-3.hs @@ -0,0 +1,8 @@ +main = forM_ [3..6] showCounts + where + showCounts b = do + r1 <- counts (randN b) + r2 <- counts (unbiased (randN b)) + printf "n = %d biased: %d%% unbiased: %d%%\n" b r1 r2 + + counts g = (`div` 100) . length . filter (== 1) <$> replicateM 10000 g diff --git a/Task/Unbias-a-random-generator/Haskell/unbias-a-random-generator.hs b/Task/Unbias-a-random-generator/Haskell/unbias-a-random-generator.hs deleted file mode 100644 index fc8717c819..0000000000 --- a/Task/Unbias-a-random-generator/Haskell/unbias-a-random-generator.hs +++ /dev/null @@ -1,29 +0,0 @@ -import Control.Monad -import Random -import Data.IORef -import Text.Printf - -randN :: Integer -> IO Bool -randN n = randomRIO (1,n) >>= return . (== 1) - -unbiased :: Integer -> IO Bool -unbiased n = do - a <- randN n - b <- randN n - if a /= b then return a else unbiased n - -main :: IO () -main = forM_ [3..6] $ \n -> do - cb <- newIORef 0 - cu <- newIORef 0 - replicateM_ trials $ do - b <- randN n - u <- unbiased n - when b $ modifyIORef cb (+ 1) - when u $ modifyIORef cu (+ 1) - tb <- readIORef cb - tu <- readIORef cu - printf "%d: %5.2f%% %5.2f%%\n" n - (100 * fromIntegral tb / fromIntegral trials :: Double) - (100 * fromIntegral tu / fromIntegral trials :: Double) - where trials = 50000 diff --git a/Task/Unbias-a-random-generator/Perl-6/unbias-a-random-generator.pl6 b/Task/Unbias-a-random-generator/Perl-6/unbias-a-random-generator.pl6 index 5dbb96b7f7..d284b648ad 100644 --- a/Task/Unbias-a-random-generator/Perl-6/unbias-a-random-generator.pl6 +++ b/Task/Unbias-a-random-generator/Perl-6/unbias-a-random-generator.pl6 @@ -16,5 +16,5 @@ for 3 .. 6 -> $n { @fixed[ unbiased($n) ]++; } printf "N=%d randN: %s, %4.1f%% unbiased: %s, %4.1f%%\n", - $n, map { .perl, .[1] * 100 / $iterations }, $(@raw), $(@fixed); + $n, map { .perl, .[1] * 100 / $iterations }, @raw, @fixed; } diff --git a/Task/Unbias-a-random-generator/PowerShell/unbias-a-random-generator-1.psh b/Task/Unbias-a-random-generator/PowerShell/unbias-a-random-generator-1.psh new file mode 100644 index 0000000000..86e6355137 --- /dev/null +++ b/Task/Unbias-a-random-generator/PowerShell/unbias-a-random-generator-1.psh @@ -0,0 +1,15 @@ +function randN ( [int]$N ) + { + [int]( ( Get-Random -Maximum $N ) -eq 0 ) + } + +function unbiased ( [int]$N ) + { + do { + $X = randN $N + $Y = randN $N + } + While ( $X -eq $Y ) + + return $X + } diff --git a/Task/Unbias-a-random-generator/PowerShell/unbias-a-random-generator-2.psh b/Task/Unbias-a-random-generator/PowerShell/unbias-a-random-generator-2.psh new file mode 100644 index 0000000000..d95cd1dec3 --- /dev/null +++ b/Task/Unbias-a-random-generator/PowerShell/unbias-a-random-generator-2.psh @@ -0,0 +1,15 @@ +$Tests = 1000 +ForEach ( $N in 3..6 ) + { + $Biased = 0 + $Unbiased = 0 + + ForEach ( $Test in 1..$Tests ) + { + $Biased += randN $N + $Unbiased += unbiased $N + } + [pscustomobject]@{ N = $N + "Biased Ones out of $Test" = $Biased + "Unbiased Ones out of $Test" = $Unbiased } + } diff --git a/Task/Unbias-a-random-generator/REXX/unbias-a-random-generator.rexx b/Task/Unbias-a-random-generator/REXX/unbias-a-random-generator.rexx index 168c5857f8..e853a18087 100644 --- a/Task/Unbias-a-random-generator/REXX/unbias-a-random-generator.rexx +++ b/Task/Unbias-a-random-generator/REXX/unbias-a-random-generator.rexx @@ -1,21 +1,20 @@ -/*REXX program generates unbiased random numbers and displays the results. */ -parse arg # R seed . /*get optional parameters from the CL. */ -if #=='' | #==',' then #=1000 /*# the number of SAMPLES to be used.*/ -if R=='' | R==',' then R=6 /*R the high number for the range. */ -if seed\=='' then call random ,,seed /*Not specified? Use for RANDOM seed. */ -w=12; pad=left('',5) /*width of columnar output; indentation*/ -dash='─'; @b='biased'; @ub='un'@b /*literals for the SAY column headers. */ -say pad c('N',5) c(@b) c(@b'%') c(@ub) c(@ub"%") c('samples') /*6 col header.*/ +/*REXX program generates unbiased random numbers and displays the results to terminal.*/ +parse arg # R seed . /*get optional parameters from the CL. */ +if #=='' | #=="," then #=1000 /*# the number of SAMPLES to be used.*/ +if R=='' | R=="," then R=6 /*R the high number for the range. */ +if datatype(seed, 'W') then call random ,,seed /*Not specified? Use for RANDOM seed. */ +w=12; pad=left('',5) /*width of columnar output; indentation*/ +dash='─'; @b="biased"; @ub='un'@b /*literals for the SAY column headers. */ +say pad c('N',5) c(@b) c(@b'%') c(@ub) c(@ub"%") c('samples') /*six column header.*/ dash= - do N=3 to R; b=0; u=0; do j=1 for # - b=b+randN(N) - u=u+unbiased() - end /*j*/ + do N=3 to R; b=0; u=0; do j=1 for #; b=b+randN(N) + u=u+unbiased() + end /*j*/ say pad c(N,5) c(b) pct(b) c(u) pct(u) c(#) end /*N*/ -exit /*stick a fork in it, we're all done. */ -/*───────────────────────────────────one─liner subroutines────────────────────*/ -c: return center(arg(1), word(arg(2) w,1), left(dash,1)) -pct: return c(format(arg(1)/#*100,,2)'%') /*2 decimal digs.*/ -randN: parse arg z; return random(1,z)==z -unbiased: do until x\==randN(N); x=randN(N); end; return x +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +c: return center( arg(1), word(arg(2) w, 1), left(dash, 1) ) +pct: return c( format(arg(1) / # * 100, , 2)'%' ) /*two decimal digits.*/ +randN: parse arg z; return random(1, z)==z +unbiased: do until x\==randN(N); x=randN(N); end /*until*/; return x diff --git a/Task/Undefined-values/00DESCRIPTION b/Task/Undefined-values/00DESCRIPTION index 6bc365095f..92b1dc8b90 100644 --- a/Task/Undefined-values/00DESCRIPTION +++ b/Task/Undefined-values/00DESCRIPTION @@ -1 +1,2 @@ -For languages which have an explicit notion of an undefined value, identify and exercise those language's mechanisms for identifying and manipulating a variable's value's status as being undefined +For languages which have an explicit notion of an undefined value, identify and exercise those language's mechanisms for identifying and manipulating a variable's value's status as being undefined. +

    diff --git a/Task/Undefined-values/PowerShell/undefined-values-1.psh b/Task/Undefined-values/PowerShell/undefined-values-1.psh new file mode 100644 index 0000000000..5628ee69ae --- /dev/null +++ b/Task/Undefined-values/PowerShell/undefined-values-1.psh @@ -0,0 +1,8 @@ +if (Get-Variable -Name noSuchVariable -ErrorAction SilentlyContinue) +{ + $true +} +else +{ + $false +} diff --git a/Task/Undefined-values/PowerShell/undefined-values-2.psh b/Task/Undefined-values/PowerShell/undefined-values-2.psh new file mode 100644 index 0000000000..3804bb5313 --- /dev/null +++ b/Task/Undefined-values/PowerShell/undefined-values-2.psh @@ -0,0 +1 @@ +Get-PSProvider diff --git a/Task/Undefined-values/PowerShell/undefined-values-3.psh b/Task/Undefined-values/PowerShell/undefined-values-3.psh new file mode 100644 index 0000000000..f7bdf3f02b --- /dev/null +++ b/Task/Undefined-values/PowerShell/undefined-values-3.psh @@ -0,0 +1 @@ +Test-Path Variable:\noSuchVariable diff --git a/Task/Undefined-values/PowerShell/undefined-values-4.psh b/Task/Undefined-values/PowerShell/undefined-values-4.psh new file mode 100644 index 0000000000..4146802ccf --- /dev/null +++ b/Task/Undefined-values/PowerShell/undefined-values-4.psh @@ -0,0 +1 @@ +$noSuchVariable -eq $null diff --git a/Task/Unicode-strings/00DESCRIPTION b/Task/Unicode-strings/00DESCRIPTION index 8dc7d74632..c11ec19d98 100644 --- a/Task/Unicode-strings/00DESCRIPTION +++ b/Task/Unicode-strings/00DESCRIPTION @@ -1,18 +1,30 @@ -As the world gets smaller each day, internationalization becomes more and more important. For handling multiple languages, [[Unicode]] is your best friend.
    -It is a very capable tool, but also quite complex compared to older single- -and double-byte character encodings. How well prepared is your programming language for Unicode? Discuss and demonstrate its unicode awareness and capabilities. +As the world gets smaller each day, internationalization becomes more and more important.   For handling multiple languages, [[Unicode]] is your best friend. + +It is a very capable tool, but also quite complex compared to older single- and double-byte character encodings. + +How well prepared is your programming language for Unicode? + + +;Task: +Discuss and demonstrate its unicode awareness and capabilities. + Some suggested topics: +:*   How easy is it to present Unicode strings in source code? +:*   Can Unicode literals be written directly, or be part of identifiers/keywords/etc? +:*   How well can the language communicate with the rest of the world? +:*   Is it good at input/output with Unicode? +:*   Is it convenient to manipulate Unicode strings in the language? +:*   How broad/deep does the language support Unicode? +:*   What encodings (e.g. UTF-8, UTF-16, etc) can be used? +:*   Does it support normalization? -* How easy is it to present Unicode strings in source code? Can Unicode literals be written directly, or be part of identifiers/keywords/etc? -* How well can the language communicate with the rest of the world? Is it good at input/output with Unicode? -* Is it convenient to manipulate Unicode strings in the language? -* How broad/deep does the language support Unicode? What encodings (e.g. UTF-8, UTF-16, etc) can be used? Normalization? -'''Note''' This task is a bit unusual in that it encourages general discussion -rather than clever coding. +;Note: +This task is a bit unusual in that it encourages general discussion rather than clever coding. -See also: -* [[Unicode variable names]] -* [[Terminal control/Display an extended character]] +;See also: +*   [[Unicode variable names]] +*   [[Terminal control/Display an extended character]] +

    diff --git a/Task/Unicode-strings/Elena/unicode-strings.elena b/Task/Unicode-strings/Elena/unicode-strings.elena new file mode 100644 index 0000000000..2ed7a05ca3 --- /dev/null +++ b/Task/Unicode-strings/Elena/unicode-strings.elena @@ -0,0 +1,10 @@ +#import system. + +#symbol program = +[ + #var 四十二 := "♥♦♣♠". // UTF8 string + #var строка := "Привет"w. // UTF16 string + + console writeLine:строка. + console writeLine:四十二. +]. diff --git a/Task/Unicode-strings/Vala/unicode-strings.vala b/Task/Unicode-strings/Vala/unicode-strings.vala new file mode 100644 index 0000000000..9d826d185d --- /dev/null +++ b/Task/Unicode-strings/Vala/unicode-strings.vala @@ -0,0 +1 @@ +stdout.printf ("UTF-8 encoded string. Let's go to a café!"); diff --git a/Task/Unicode-variable-names/00DESCRIPTION b/Task/Unicode-variable-names/00DESCRIPTION index ca392f6ba9..11cbc2bd13 100644 --- a/Task/Unicode-variable-names/00DESCRIPTION +++ b/Task/Unicode-variable-names/00DESCRIPTION @@ -7,3 +7,4 @@ ;Cf.: * [[Case-sensitivity of identifiers]] +

    diff --git a/Task/Unicode-variable-names/Elena/unicode-variable-names.elena b/Task/Unicode-variable-names/Elena/unicode-variable-names.elena new file mode 100644 index 0000000000..888d14c087 --- /dev/null +++ b/Task/Unicode-variable-names/Elena/unicode-variable-names.elena @@ -0,0 +1,9 @@ +#import system. + +#symbol program = +[ + #var Δ := 1. + Δ := Δ + 1. + + console writeLine:Δ. +]. diff --git a/Task/Unicode-variable-names/Forth/unicode-variable-names.fth b/Task/Unicode-variable-names/Forth/unicode-variable-names.fth index b947eb1b5f..b547a8517c 100644 --- a/Task/Unicode-variable-names/Forth/unicode-variable-names.fth +++ b/Task/Unicode-variable-names/Forth/unicode-variable-names.fth @@ -1,3 +1,4 @@ variable ∆ -5 ∆ ! +1 ∆ ! +1 ∆ +! ∆ @ . diff --git a/Task/Unicode-variable-names/PowerShell/unicode-variable-names.psh b/Task/Unicode-variable-names/PowerShell/unicode-variable-names.psh new file mode 100644 index 0000000000..631a0cdbf1 --- /dev/null +++ b/Task/Unicode-variable-names/PowerShell/unicode-variable-names.psh @@ -0,0 +1,3 @@ +$Δ = 2 +$π = 3.14 +$π*$Δ diff --git a/Task/Unicode-variable-names/REXX/unicode-variable-names.rexx b/Task/Unicode-variable-names/REXX/unicode-variable-names.rexx new file mode 100644 index 0000000000..450ec0abf1 --- /dev/null +++ b/Task/Unicode-variable-names/REXX/unicode-variable-names.rexx @@ -0,0 +1,5 @@ +/*REXX program (using the R4 REXX interpreter) which uses a Greek delta char).*/ +'chcp' 1253 "> NUL" /*ensure we're using correct code page.*/ +Δ=1 /*define delta (variable name Δ) to 1*/ +Δ=Δ+1 /*bump the delta REXX variable by unity*/ +say 'Δ=' Δ /*stick a fork in it, we're all done. */ diff --git a/Task/Unicode-variable-names/Ruby/unicode-variable-names.rb b/Task/Unicode-variable-names/Ruby/unicode-variable-names.rb new file mode 100644 index 0000000000..047ff94a71 --- /dev/null +++ b/Task/Unicode-variable-names/Ruby/unicode-variable-names.rb @@ -0,0 +1,3 @@ +Δ = 1 +Δ += 1 +puts Δ # => 2 diff --git a/Task/Universal-Turing-machine/00DESCRIPTION b/Task/Universal-Turing-machine/00DESCRIPTION index dd2e06669d..95da12ea6d 100644 --- a/Task/Universal-Turing-machine/00DESCRIPTION +++ b/Task/Universal-Turing-machine/00DESCRIPTION @@ -5,10 +5,12 @@ Indeed one way to definitively prove that a language is [[wp:Turing_completeness|turing-complete]] is to implement a universal Turing machine in it. -'''The task''' -For this task you would simulate such a machine capable +;Task: + +Simulate such a machine capable of taking the definition of any other Turing machine and executing it. + Of course, you will not have an infinite tape, but you should emulate this as much as is possible. @@ -18,6 +20,7 @@ To test your universal Turing machine (and prove your programming language is Turing complete!), you should execute the following two Turing machines based on the following definitions. + '''Simple incrementer''' * '''States:''' q0, qf * '''Initial state:''' q0 @@ -28,8 +31,10 @@ based on the following definitions. ** (q0, 1, 1, right, q0) ** (q0, B, 1, stay, qf) +
    The input for this machine should be a tape of 1 1 1 + '''Three-state busy beaver''' * '''States:''' a, b, c, halt * '''Initial state:''' a @@ -44,8 +49,10 @@ The input for this machine should be a tape of 1 1 1 ** (c, 0, 1, left, b) ** (c, 1, 1, stay, halt) +
    The input for this machine should be an empty tape. + '''Bonus:''' '''5-state, 2-symbol probable Busy Beaver machine from Wikipedia''' @@ -66,6 +73,8 @@ The input for this machine should be an empty tape. ** (E, 0, 1, stay, H) ** (E, 1, 0, left, A) +
    The input for this machine should be an empty tape. This machine runs for more than 47 millions steps. +

    diff --git a/Task/Universal-Turing-machine/C/universal-turing-machine.c b/Task/Universal-Turing-machine/C/universal-turing-machine.c new file mode 100644 index 0000000000..167504569b --- /dev/null +++ b/Task/Universal-Turing-machine/C/universal-turing-machine.c @@ -0,0 +1,231 @@ +#include +#include +#include +#include + +enum { + LEFT, + RIGHT, + STAY +}; + +typedef struct { + int state1; + int symbol1; + int symbol2; + int dir; + int state2; +} transition_t; + +typedef struct tape_t tape_t; +struct tape_t { + int symbol; + tape_t *left; + tape_t *right; +}; + +typedef struct { + int states_len; + char **states; + int final_states_len; + int *final_states; + int symbols_len; + char *symbols; + int blank; + int state; + int tape_len; + tape_t *tape; + int transitions_len; + transition_t ***transitions; +} turing_t; + +int state_index (turing_t *t, char *state) { + int i; + for (i = 0; i < t->states_len; i++) { + if (!strcmp(t->states[i], state)) { + return i; + } + } + return 0; +} + +int symbol_index (turing_t *t, char symbol) { + int i; + for (i = 0; i < t->symbols_len; i++) { + if (t->symbols[i] == symbol) { + return i; + } + } + return 0; +} + +void move (turing_t *t, int dir) { + tape_t *orig = t->tape; + if (dir == RIGHT) { + if (orig && orig->right) { + t->tape = orig->right; + } + else { + t->tape = calloc(1, sizeof (tape_t)); + t->tape->symbol = t->blank; + if (orig) { + t->tape->left = orig; + orig->right = t->tape; + } + } + } + else if (dir == LEFT) { + if (orig && orig->left) { + t->tape = orig->left; + } + else { + t->tape = calloc(1, sizeof (tape_t)); + t->tape->symbol = t->blank; + if (orig) { + t->tape->right = orig; + orig->left = t->tape; + } + } + } +} + +turing_t *create (int states_len, ...) { + va_list args; + va_start(args, states_len); + turing_t *t = malloc(sizeof (turing_t)); + t->states_len = states_len; + t->states = malloc(states_len * sizeof (char *)); + int i; + for (i = 0; i < states_len; i++) { + t->states[i] = va_arg(args, char *); + } + t->final_states_len = va_arg(args, int); + t->final_states = malloc(t->final_states_len * sizeof (int)); + for (i = 0; i < t->final_states_len; i++) { + t->final_states[i] = state_index(t, va_arg(args, char *)); + } + t->symbols_len = va_arg(args, int); + t->symbols = malloc(t->symbols_len); + for (i = 0; i < t->symbols_len; i++) { + t->symbols[i] = va_arg(args, int); + } + t->blank = symbol_index(t, va_arg(args, int)); + t->state = state_index(t, va_arg(args, char *)); + t->tape_len = va_arg(args, int); + t->tape = NULL; + for (i = 0; i < t->tape_len; i++) { + move(t, RIGHT); + t->tape->symbol = symbol_index(t, va_arg(args, int)); + } + if (!t->tape_len) { + move(t, RIGHT); + } + while (t->tape->left) { + t->tape = t->tape->left; + } + t->transitions_len = va_arg(args, int); + t->transitions = malloc(t->states_len * sizeof (transition_t **)); + for (i = 0; i < t->states_len; i++) { + t->transitions[i] = malloc(t->symbols_len * sizeof (transition_t *)); + } + for (i = 0; i < t->transitions_len; i++) { + transition_t *tran = malloc(sizeof (transition_t)); + tran->state1 = state_index(t, va_arg(args, char *)); + tran->symbol1 = symbol_index(t, va_arg(args, int)); + tran->symbol2 = symbol_index(t, va_arg(args, int)); + tran->dir = va_arg(args, int); + tran->state2 = state_index(t, va_arg(args, char *)); + t->transitions[tran->state1][tran->symbol1] = tran; + } + va_end(args); + return t; +} + +void print_state (turing_t *t) { + printf("%-10s ", t->states[t->state]); + tape_t *tape = t->tape; + while (tape->left) { + tape = tape->left; + } + while (tape) { + if (tape == t->tape) { + printf("[%c]", t->symbols[tape->symbol]); + } + else { + printf(" %c ", t->symbols[tape->symbol]); + } + tape = tape->right; + } + printf("\n"); +} + +void run (turing_t *t) { + int i; + while (1) { + print_state(t); + for (i = 0; i < t->final_states_len; i++) { + if (t->final_states[i] == t->state) { + return; + } + } + transition_t *tran = t->transitions[t->state][t->tape->symbol]; + t->tape->symbol = tran->symbol2; + move(t, tran->dir); + t->state = tran->state2; + } +} + +int main () { + printf("Simple incrementer\n"); + turing_t *t = create( + /* states */ 2, "q0", "qf", + /* final_states */ 1, "qf", + /* symbols */ 2, 'B', '1', + /* blank */ 'B', + /* initial_state */ "q0", + /* initial_tape */ 3, '1', '1', '1', + /* transitions */ 2, + "q0", '1', '1', RIGHT, "q0", + "q0", 'B', '1', STAY, "qf" + ); + run(t); + printf("\nThree-state busy beaver\n"); + t = create( + /* states */ 4, "a", "b", "c", "halt", + /* final_states */ 1, "halt", + /* symbols */ 2, '0', '1', + /* blank */ '0', + /* initial_state */ "a", + /* initial_tape */ 0, + /* transitions */ 6, + "a", '0', '1', RIGHT, "b", + "a", '1', '1', LEFT, "c", + "b", '0', '1', LEFT, "a", + "b", '1', '1', RIGHT, "b", + "c", '0', '1', LEFT, "b", + "c", '1', '1', STAY, "halt" + ); + run(t); + return 0; + printf("\nFive-state two-symbol probable busy beaver\n"); + t = create( + /* states */ 6, "A", "B", "C", "D", "E", "H", + /* final_states */ 1, "H", + /* symbols */ 2, '0', '1', + /* blank */ '0', + /* initial_state */ "A", + /* initial_tape */ 0, + /* transitions */ 10, + "A", '0', '1', RIGHT, "B", + "A", '1', '1', LEFT, "C", + "B", '0', '1', RIGHT, "C", + "B", '1', '1', RIGHT, "B", + "C", '0', '1', RIGHT, "D", + "C", '1', '0', LEFT, "E", + "D", '0', '1', LEFT, "A", + "D", '1', '1', LEFT, "D", + "E", '0', '1', STAY, "H", + "E", '1', '0', LEFT, "A" + ); + run(t); +} diff --git a/Task/Universal-Turing-machine/Fortran/universal-turing-machine-1.f b/Task/Universal-Turing-machine/Fortran/universal-turing-machine-1.f new file mode 100644 index 0000000000..e7a378ccf5 --- /dev/null +++ b/Task/Universal-Turing-machine/Fortran/universal-turing-machine-1.f @@ -0,0 +1,5 @@ + 200 I = STATE*NSYMBOL - ICHAR(TAPE(HEAD)) !Index the transition. + TAPE(HEAD) = MARK(I) !Do it. Possibly not changing the symbol. + HEAD = HEAD + MOVE(I) !Possibly not moving the head. + STATE = ICHAR(NEXT(I)) !Hopefully, something has changed! + IF (STATE.GT.0) GO TO 200 !Otherwise, we might loop forever... diff --git a/Task/Universal-Turing-machine/Fortran/universal-turing-machine-2.f b/Task/Universal-Turing-machine/Fortran/universal-turing-machine-2.f new file mode 100644 index 0000000000..1dc9422636 --- /dev/null +++ b/Task/Universal-Turing-machine/Fortran/universal-turing-machine-2.f @@ -0,0 +1,188 @@ + PROGRAM U !Reads a specification of a Turing machine, and executes it. +Careful! Reserves a symbol #0 to represent blank tape as a blank. + INTEGER MANY,FIRST,LAST !Some sizes must be decided upon. + PARAMETER (MANY = 66, FIRST = 1, LAST = 666) !These should do. + INTEGER HERE(MANY) + CHARACTER*1 MARK(MANY) !The transition table. + INTEGER*1 MOVE(MANY) !Three related arrays. + CHARACTER*1 NEXT(MANY) !All with the same indexing. + CHARACTER*1 TAPE(FIRST:LAST)!Notionally, no final bound, in both directions - a potential infinity.. + INTEGER STATE !Execution starts with state 1. + INTEGER HEAD !And the tape read/write head at position 1. + INTEGER STEP !And we might as well keep count. + INTEGER OFFSET !An affine shift. + INTEGER NSTATE !Counts can be helpful. + INTEGER NSYMBOL !The count of recognised symbols. + INTEGER S,S1 !Symbol numbers. + CHARACTER*1 RS,WS !Input scanning: read symbol, write symbol. + CHARACTER*1 SYMBOL(0:MANY) !I reserve SYMBOL(0). + CHARACTER*(MANY) SYMBOLS !Up to 255, for single character variables. + EQUIVALENCE (SYMBOL(1),SYMBOLS) !Individually or collectively. + INTEGER I,J,K,L,IT !Assistants. + INTEGER LONG !Now for some text scanning. + PARAMETER (LONG = 80) !This should suffice. + CHARACTER*(LONG) ALINE !A scratchpad. + REAL T0,T1 !Some CPU time attempts. + INTEGER KBD,MSG,INF !Some I/O unit numbers. + + KBD = 5 !Standard input. + MSG = 6 !Standard output + INF = 10 !Suitable for a disc file. + OPEN (INF,FILE = "TestAdd1.dat",ACTION="READ") !Go for one. + READ (INF,1) ALINE !The first line is to be a heding. + 1 FORMAT (A) !Just plain text. + WRITE (MSG,2) ALINE !Reveal it. + 2 FORMAT ("Turing machine simulation for... ",A) !Announce the plan. + READ (INF,*) SYMBOLS !Allows a quoted string. + NSYMBOL = LEN_TRIM(SYMBOLS) !How many symbols? (Trailing spaces will be lost) + WRITE (MSG,3) NSYMBOL,SYMBOLS(1:NSYMBOL) !They will be symbol number 0, 1, ..., NSYMBOL - 1. + 3 FORMAT (I0," symbols: >",A,"<") !And this is their count. + IF (NSYMBOL.LE.1) STOP "Expect at least two symbols!" + SYMBOL(0) = " " !My special state meaning "never before seen". + NSYMBOL = NSYMBOL + 1 !So, one more is in actual use. + NSTATE = 0 !As for states, I haven't seen any. + MOVE = -66 !This should cause trouble and be noticed! + MARK = CHAR(0) !In case a state is omitted. + NEXT = CHAR(0) !Like, mention state seven, but omit mention of state six. + HERE = 0 !Clear the counts. + +Collate the transition table. + 10 READ (INF,*) STATE !Read this once, rather than for every transition. + IF (STATE.LE.0) GO TO 20 !Ah, finished. + WRITE (MSG,11) STATE !But they can come in any order. + NSTATE = MAX(STATE,NSTATE)!And I'd like to know how many. + 11 FORMAT ("Entry: Read Write Move Next. For state ",I0) !Prepare a nice heading. + IF (STATE.LE.0) STOP "Positive STATE numbers only!" !It may not be followed. + IF (STATE*NSYMBOL.GT.MANY) STOP"My transition table is too small!" !But the value of STATE is shown. + DO S = 0,NSYMBOL - 1 !Initialise the transitions for STATE. + IT = STATE*NSYMBOL - S !Finger the one for S. + MARK(IT) = CHAR(S) !No change to what's under the head. + NEXT(IT) = CHAR(0) !And this stops the run. + END DO !Just in case a symbol's number is omitted. + DO S = 1,NSYMBOL - 1 !A transition for every symbol must be given or the read process will get out of step. + READ(INF,*) RS,WS,K,L !Read symbol, write symbol, move, next. + I = INDEX(SYMBOLS(1:NSYMBOL - 1),RS) !Convert the character to a symbol number. + J = INDEX(SYMBOLS(1:NSYMBOL - 1),WS) !To enable decorative glyphs, not just digits. + IF (I.LE.0) STOP "Unrecognised read symbol!" !This really should be more helpful. + IF (J.LE.0) STOP "Unrecognised write symbol!" !By reading into ALINE and showing it, etc. + IT = STATE*NSYMBOL - I !Locate the entry for the state x symbol pair. + MARK(IT) = CHAR(J) !The value to be written. + MOVE(IT) = K !The movement of the tape head. + NEXT(IT) = CHAR(L) !The next state. + IF (I.EQ.1) S1 = IT !This transition will be duplicated. SYMBOL(1) is for blank tape. + END DO !On to the next symbol's transition. +Copy SYMBOL(1)'s transition to the transition for the secret extra, SYMBOL(0). + IT = STATE*NSYMBOL !Finger the interpolated entry for SYMBOL(0). + MARK(IT) = MARK(S1) !Thus will SYMBOL(0), shown as a space, be overwritten. + MOVE(IT) = MOVE(S1) !And SYMBOL(0) treated + NEXT(IT) = NEXT(S1) !Exactly as if it were SYMBOL(1). +Cast forth the transition table for STATE, not mentioning SYMBOL(0) - but see label 911. + DO S = 1,NSYMBOL - 1 !Roll them out in the order as given in SYMBOL. + IT = STATE*NSYMBOL - S !But the entry number will be odd. + WRITE (ALINE,12) IT,SYMBOL(S), !The character's code value is irrelevant. + 1 SYMBOL(ICHAR(MARK(IT))),MOVE(IT),ICHAR(NEXT(IT)) !Append the details just read. + 12 FORMAT (I5,":",2X,'"',A1,'"',3X'"',A1,'"',I5,I5,I13) !Revealing the symbols, not their number. + IF (MOVE(IT).GT.0) ALINE(21:21) = "+" !I want a leading + for positive, not zero. + WRITE (MSG,1) ALINE(1:27) !The SP format code is unhelpful for zero. + END DO !Hopefully, I'm still in sync with the input. + GO TO 10 !Perhaps another state follows. + +Chew tape. The initial state is some sequence of symbols, starting at TAPE(1). + 20 TAPE = CHAR(0) !Set every cell to zero. Not blank. + OFFSET = 12 !Affine shift. The numerical value of HEAD is not seen. + READ (INF,1) ALINE !Get text, for the tape's initial state. + L = LEN_TRIM(ALINE) !Last non-blank. Flexible format this isn't. + DO I = 1,L !Step through cells 1 to L. + TAPE(I + OFFSET - 1) = CHAR(INDEX(SYMBOLS,ALINE(I:I))) !Character code to symbol number. + END DO !Rather than reading as I1. + CLOSE (INF) !Finished with the input, and not much checking either. + WRITE (MSG,*) !Take a breath. +Cast forth a heading.. + WRITE (MSG,99) !Announce. + 99 FORMAT ("Starts with State 1 and the tape head at 1.") !Positioned for OFFSET = 12. + ALINE = " Step: Head State|Tape..." !Prepare a heading for the trace. + L = 18 + OFFSET*2 !Locate the start position. + ALINE(L - 1:L + 1) = ""!No underlining, no overprinting, no colour (neither background nor foreground). Sigh. + WRITE (MSG,1) ALINE !Take that! + CALL CPU_TIME(T0) !Start the clock. + HEAD = OFFSET !This is counted as position one. + STATE = 1 !The initial state. + STEP = 0 !No steps yet. + +Chase through the transitions. Could check that HEAD is within bounds FIRST:LAST. + 100 IF (STEP.GE.200) GO TO 200 !Perhaps an extended campaign. + STEP = STEP + 1 !Otherwise, here we go. + DO I = 1,LONG/2 !Scan TAPE(1:LONG/2). + IT = 2*I - 1 !Allowing two positions each. + ALINE(IT:IT) = " " !So a leading space. + ALINE(IT + 1:IT + 1) = SYMBOL(ICHAR(TAPE(I))) !And the indicated symbol. + END DO !On to the enxt. + I = HEAD*2 !The head's location in the display span. + IF (I.GT.1 .AND. I.LT.LONG) THEN !Within range? + IF (ALINE(I:I).EQ.SYMBOL(0)) ALINE(I:I) = SYMBOL(1) !Yes. Am I looking at a new cell? + ALINE(I - 1:I - 1) = "<" !Bracket the head's cell. + ALINE(I + 1:I + 1) = ">" !In ALINE. + END IF !So much for showing the head's position. + WRITE (MSG,102) STEP,HEAD - OFFSET + 1,STATE,ALINE !Splot the state. + 102 FORMAT (I5,":",I5,I6,"|",A) !Aligns with FORMAT 99. + I = STATE*NSYMBOL - ICHAR(TAPE(HEAD)) !For this STATE and the symbol under TAPE(HEAD) + HERE(I) = HERE(I) + 1 !Count my visits. + TAPE(HEAD) = MARK(I) !Place the new symbol. + HEAD = HEAD + MOVE(I) !Move the head. + IF (HEAD.LT.FIRST .OR. HEAD.GT.LAST) GO TO 110 !Check the bounds. + STATE = ICHAR(NEXT(I)) !The new state. + IF (STATE.GT.0) GO TO 100 !Go to it. +Cease. + I = HEAD*2 !Locate HEAD within ALINE. + IF (I.GT.1 .AND. I.LT.LONG) ALINE(I:I) = SYMBOL(ICHAR(TAPE(HEAD))) !The only change. + WRITE (MSG,103) HEAD - OFFSET + 1,STATE,ALINE !Show. + 103 FORMAT ("HALT!",I6,I6,"|",A) !But, no step count to start with. See FORMAT 102. + GO TO 900 !Done. +Can't continue! Insufficient tape, alas. + 110 WRITE (MSG,*) "Insufficient tape!" !Oh dear. + GO TO 900 !Give in. + +Change into high gear: no trace and no test thereof neither. + 200 STEP = STEP + 1 !So, advance. + IF (MOD(STEP,10000000).EQ.0) WRITE (MSG,201) STEP !Ah, still some timewasting. + 201 FORMAT ("Step ",I0) !No screen action is rather discouraging. + I = STATE*NSYMBOL - ICHAR(TAPE(HEAD)) !Index the transition. + HERE(I) = HERE(I) + 1 !Another visit. + TAPE(HEAD) = MARK(I) !Do it. Possibly not changing the symbol. + HEAD = HEAD + MOVE(I) !Possibly not moving the head. + IF (HEAD.LT.FIRST .OR. HEAD.GT.LAST) GO TO 110 !But checking the bounds just in case. + STATE = ICHAR(NEXT(I)) !Hopefully, something has changed! + IF (STATE.GT.0) GO TO 200 !Otherwise, we might loop forever... + +Closedown. + 900 CALL CPU_TIME(T1) !Where did it all go? + WRITE (MSG,901) STEP,STATE !Announce the ending. + 901 FORMAT ("After step ",I0,", state = ",I0,".") !Thus. + DO I = FIRST,LAST !Scan the tape. + IF (ICHAR(TAPE(I)).NE.0) EXIT !This is the whole point of SYMBOL(0). + END DO !So that the bounds + DO J = LAST,FIRST,-1 !Of tape access + IF (ICHAR(TAPE(J)).NE.0) EXIT !(and placement of the initial state) + END DO !Can be found without tedious ongoing MIN and MAX. + WRITE (MSG,902) HEAD - OFFSET + 1, !Tediously, + 1 I - OFFSET + 1, !Reverse the offset + 2 J - OFFSET + 1 !So as to seem that HEAD = 1, to start with. + 902 FORMAT ("The head is at position ",I0, !Now announce the results. + 1 " and wandered over ",I0," to ",I0) !This will affect the dimension chosen for TAPE. + T1 = T1 - T0 !Some time may have been accurately measured. + IF (T1.GT.0.1) WRITE (MSG,903) T1 !And this may be sort of correct. + 903 FORMAT ("CPU time",F9.3) !Though distinct from elapsed time. +Curious about the usage of the transition table? + 910 WRITE (MSG,911) !Possibly not, + 911 FORMAT (/,35X,"Usage.") !But here it comes. + DO STATE = 1,NSTATE !For every state + WRITE (MSG,11) STATE !Name the state, as before. + DO S = 0,NSYMBOL - 1 !But this time, roll every symbol. + IT = STATE*NSYMBOL - S !Including my "secret" symbol. + WRITE (ALINE,12) IT,SYMBOL(S), !The same sequence, + 1 SYMBOL(ICHAR(MARK(IT))),MOVE(IT),ICHAR(NEXT(IT)),HERE(IT) !But with an addendum here. + IF (MOVE(IT).GT.0) ALINE(21:21) = "+" !SIGN(i,i) gives -1, 0, +1 but -60 for -60. + WRITE (MSG,1) ALINE(1:40) !When what I want is -1. SIGN(1,i) doesn't give zero. + END DO !On to the next symbol in the order as supplied. + END DO !And the next state, in numbers order. + END !That was fun. diff --git a/Task/Universal-Turing-machine/JavaScript/universal-turing-machine.js b/Task/Universal-Turing-machine/JavaScript/universal-turing-machine.js new file mode 100644 index 0000000000..f7ef54afcf --- /dev/null +++ b/Task/Universal-Turing-machine/JavaScript/universal-turing-machine.js @@ -0,0 +1,45 @@ +function tm(d,s,e,i,b,t,... r) { + document.write(d, '
    ') + if (i<0||i>=t.length) return + write('*',s,i,t=t.split('')) + var p={}; r.forEach(e=>((s,r,w,m,n)=>{p[s+'.'+r]={w,n,m:[0,1,-1][1+'RL'.indexOf(m)]}})(... e.split(/[ .:,]+/))) + for (var n=1; s!=e; n+=1) { + with (p[s+'.'+t[i]]) t[i]=w,s=n,i+=m + if (i==-1) i=0,t.unshift(b) + else if (i==t.length) t[i]=b + write(n,s,i,t) + } + document.write('
    ') + function write(n, s, i, t) { + t = t.join('') + t = t.substring(0,i) + '' + t.charAt(i) + '' + t.substr(i+1) + document.write((' '+n).slice(-3).replace(/ /g,' '), ': ', s, ' [', t.replace(b,' ','g'), ']', '
    ') + } +} + +tm( 'Unary incrementer', +// s e i b t + 'a', 'h', 0, 'B', '111', +// s.r: w, m, n + 'a.1: 1, L, a', + 'a.B: 1, S, h' +) + +tm( 'Unary adder', + 1, 0, 0, '0', '1110111', + '1.1: 0, R, 2', // write 0 rigth goto 2 + '2.0: 0, S, 0', // if (0) halt + '2.1: 0, R, 3', // write 0 rigth goto 3 + '3.1: 1, R, 3', // while (1) rigth + '3.0: 1, S, 0', // write 1 halt +) + +tm( 'Three-state busy beaver', + 1, 0, 0, '0', '0', + '1.0: 1, R, 2', + '1.1: 1, R, 0', + '2.0: 0, R, 3', + '2.1: 1, R, 2', + '3.0: 1, L, 3', + '3.1: 1, L, 1' +) diff --git a/Task/Universal-Turing-machine/Lua/universal-turing-machine.lua b/Task/Universal-Turing-machine/Lua/universal-turing-machine.lua new file mode 100644 index 0000000000..6c85792b9f --- /dev/null +++ b/Task/Universal-Turing-machine/Lua/universal-turing-machine.lua @@ -0,0 +1,84 @@ +-- Machine definitions +local incrementer = { + name = "Simple incrementer", + initState = "q0", + endState = "qf", + blank = "B", + rules = { + {"q0", "1", "1", "right", "q0"}, + {"q0", "B", "1", "stay", "qf"} + } +} + +local threeStateBB = { + name = "Three-state busy beaver", + initState = "a", + endState = "halt", + blank = "0", + rules = { + {"a", "0", "1", "right", "b"}, + {"a", "1", "1", "left", "c"}, + {"b", "0", "1", "left", "a"}, + {"b", "1", "1", "right", "b"}, + {"c", "0", "1", "left", "b"}, + {"c", "1", "1", "stay", "halt"} + } +} + +local fiveStateBB = { + name = "Five-state busy beaver", + initState = "A", + endState = "H", + blank = "0", + rules = { + {"A", "0", "1", "right", "B"}, + {"A", "1", "1", "left", "C"}, + {"B", "0", "1", "right", "C"}, + {"B", "1", "1", "right", "B"}, + {"C", "0", "1", "right", "D"}, + {"C", "1", "0", "left", "E"}, + {"D", "0", "1", "left", "A"}, + {"D", "1", "1", "left", "D"}, + {"E", "0", "1", "stay", "H"}, + {"E", "1", "0", "left", "A"} + } +} + +-- Display a representation of the tape and machine state on the screen +function show (state, headPos, tape) + local leftEdge = 1 + while tape[leftEdge - 1] do leftEdge = leftEdge - 1 end + io.write(" " .. state .. "\t| ") + for pos = leftEdge, #tape do + if pos == headPos then io.write("[" .. tape[pos] .. "] ") else io.write(" " .. tape[pos] .. " ") end + end + print() +end + +-- Simulate a turing machine +function UTM (machine, tape, countOnly) + local state, headPos, counter = machine.initState, 1, 0 + print("\n\n" .. machine.name) + print(string.rep("=", #machine.name) .. "\n") + if not countOnly then print(" State", "| Tape [head]\n---------------------") end + repeat + if not tape[headPos] then tape[headPos] = machine.blank end + if not countOnly then show(state, headPos, tape) end + for _, rule in ipairs(machine.rules) do + if rule[1] == state and rule[2] == tape[headPos] then + tape[headPos] = rule[3] + if rule[4] == "left" then headPos = headPos - 1 end + if rule[4] == "right" then headPos = headPos + 1 end + state = rule[5] + break + end + end + counter = counter + 1 + until state == machine.endState + if countOnly then print("Steps taken: " .. counter) else show(state, headPos, tape) end +end + +-- Main procedure +UTM(incrementer, {"1", "1", "1"}) +UTM(threeStateBB, {}) +UTM(fiveStateBB, {}, "countOnly") diff --git a/Task/Universal-Turing-machine/NetLogo/universal-turing-machine.netlogo b/Task/Universal-Turing-machine/NetLogo/universal-turing-machine.netlogo new file mode 100644 index 0000000000..94fd4d0271 --- /dev/null +++ b/Task/Universal-Turing-machine/NetLogo/universal-turing-machine.netlogo @@ -0,0 +1,373 @@ +;; "A Turing Turtle": a Turing Machine implemented in NetLogo +;; by Dan Dewey 1/16/2016 +;; +;; This NetLogo code implements a Turing Machine, see, e.g., +;; http://en.wikipedia.org/wiki/Turing_machine +;; The Turing machine fits nicely into the NetLogo paradigm in which +;; there are agents (aka the turtles), that move around +;; in a world of "patches" (2D cells). +;; Here, a single agent represents the Turing machine read/write head +;; and the patches represent the Turing tape values via their colors. +;; The 2D array of patches is treated as a single long 1D tape in an +;; obvious way. + +;; This program is presented as a NetLogo example on the page: +;; http://rosettacode.org/wiki/Universal_Turing_machine +;; This file may be larger than others on that page, note however +;; that I include many comments in the code and I have made no +;; effort to 'condense' the code, prefering clarity over compactness. +;; A demo and discussion of this program is on the web page: +;; http://sites.google.com/site/dan3deweyscspaimsportfolio/extra-turing-machine +;; The Copy example machine was taken from: +;; http://en.wikipedia.org/wiki/Turing_machine_examples +;; The "Busy Beaver" machines encoded below were taken from: +;; http://www.logique.jussieu.fr/~michel/ha.html + +;; The implementation here allows 3 symbols (blank, 0, 1) on the tape +;; and 3 head motions (left, stay, right). + +;; The 2D world is nominally set to be 29x29, going from (-14,-14) to +;; (14,14) from lower left to upper right and with (0,0) at the center. +;; This gives a total Turing tape length of 29^2 = 841 cells, sufficient for the +;; "Lazy" Beaver 5,2 example. +;; Since the max-pxcor variable is used in the code below (as opposed to +;; a hard-coded number), the effective tape size can be changed by +;; changing the size of the 2D world with the Settings... button on the interface. + +;; The "Info" tab of the NetLogo interface contains some further comments. +;; - - - - - - - + + +;; - - - - - - - - - - - Global/Agent variables +;; These three 2D arrays (lists of lists) encode the Turing Machine rules: +;; WhatToWrite: -1 (Blank), 0, 1 +;; HowToMove: -1 (left), 0(stay), 1 (right) +;; NextState: 0 to N-1, negative value goes to a halt state. +;; The above are a function of the current state and the current tape (patch) value. +;; MachineState is used by the turtle to pass the current state of the Turing machine +;; (or the halt code) to the observer. +globals [ WhatToWrite HowToMove NextState MachineState + ;; some other golobals of secondary importance... + ;; set different patch colors to record the Turing tape values + BlankColor ZeroColor OneColor + ;; a delay constant to slow down the operation + RealTimePerTick ] + +;; We'll have one turtle which is the Turing machine read/write head +;; it will keep track of the current Turing state in its own MyState value +turtles-own [ MyState ] + + +;; - - - - - - - - - - - +to Setup ;; sets up the world + clear-all ;; clears the world first + + ;; Try to not have (too many) ad hoc numbers in the code, + ;; collect and set various values here especially if they might be used in multiple places: + ;; The colors for Blank, Zero and One : (user can can change as desired) + set BlankColor 2 ;; dark gray + set OneColor green + set ZeroColor red + ;; slow it down for the humans to watch + set RealTimePerTick 0.2 ;; have simulation go at nice realtime speed + + create-turtles 1 ;; create the one Turing turtle + [ ;; set default parameters + set size 2 ;; set a nominal size + set color yellow ;; color of border + ;; set the starting location, some Turing programs will adjust this if needed: + setxy 0 0 ;; -1 * max-pxcor -1 * max-pxcor + set shape "square2empty" ;; edited version of "square 2" to have clear in middle + + ;; set the starting state - always 0 + set MyState 0 + set MachineState 0 ;; the turtle will update this global value from now on + ] + + ;; Define the Turing machine rules with 2D lists. + ;; Based on the selection made on interface panel, setting the string Turing_Program_Selection. + ;; This routine has all the Turing 'programs' in it - it's at the very bottom of this file. + LoadTuringProgram + + ;; the environment, e.g. the Turing tape + ask patches + [ + ;; all patches are set to the blank color + set pcolor BlankColor + ] + + ;; keep track of time; each tick is a Turing step + reset-ticks +end + + +;; - - - - - - - - - - - - - - - - +to Go ;; this repeatedly does steps + + ;; The turtle does the main work + ask turtles + [ + DoOneStep + wait RealTimePerTick + ] + + tick + + ;; The Turing turtle will die if it tries to go beyond the cells, + ;; in that case (no turtles left) we'll stop. + ;; Also stop if the MachineState has been set to a negative number (a halt state). + if ((count turtles = 0) or (MachineState < 0)) + [ stop ] + +end + +to DoOneStep + ;; have the turtle do one Turing step + ;; First, 'read the tape', i.e., based on the patch color here: + let tapeValue GetTapeValue + + ;; using the tapeValue and MyState, get the desired actions here: + ;; (the item commands extract the appropriate value from the list-of-lists) + let myWrite item (tapeValue + 1) (item MyState WhatToWrite) + let myMove item (tapeValue + 1) (item MyState HowToMove) + let myNextState item (tapeValue + 1) (item MyState NextState) + + ;; Write to the tape as appropriate + SetTapeValue myWrite + + ;; Move as appropriate + if (myMove = 1) [MoveForward] + if (myMove = -1) [MoveBackward] + + ;; Go to the next state; check if it is a halt state. + ;; Update the global MachineState value + set MachineState myNextState + ifelse (myNextState < 0) + [ + ;; It's a halt state. The negative MachineState will signal the stop. + ;; Go back to the starting state so it can be re-run if desired. + set MyState 0] + [ + ;; Not a halt state, so change to the desired next state + set MyState myNextState + ] +end + +to MoveForward + ;; move the turtle forward one cell, including line wrapping. + set heading 90 + ifelse (xcor = max-pxcor) + [set xcor -1 * max-pxcor + ;; and go up a row if possible... otherwise die + ifelse ycor = max-pxcor + [ die ] ;; tape too short - a somewhat crude end of things ;-) + [set ycor ycor + 1] + ] + [jump 1] +end + +to MoveBackward + ;; move the turtle backward one cell, including line-wrapping. + set heading -90 + ifelse (xcor = -1 * max-pxcor) + [ + set xcor max-pxcor + ;; and go down a row... or die + ifelse ycor = -1 * max-pxcor + [ die ] ;; tape too short - a somewhat crude end of things ;-) + [set ycor ycor - 1] + ] + [jump 1] +end + +to-report GetTapeValue + ;; report the tape color equivalent value + if (pcolor = ZeroColor) [report 0] + if (pcolor = OneColor) [report 1] + report -1 +end + +to SetTapeValue [ value ] + ;; write the appropriate color on the tape + ifelse (value = 1) + [set pcolor OneColor] + [ ifelse (value = 0) + [set pcolor ZeroColor][set pcolor BlankColor]] +end + + +;; - - - - - OK, here are the data for the various Turing programs... +;; Note that besdes settting the rules (array values) these sections can also +;; include commands to clear the tape, position the r/w head, adjust wait time, etc. +to LoadTuringProgram + + ;; A template of the rules structure: a list of lists + ;; E.g. values are given for States 0 to 4, when looking at Blank, Zero, One: + ;; For 2-symbol machines use Blank(-1) and One(1) and ignore the middle values (never see zero). + ;; Normal Halt will be state -1, the -9 default shows an unexpected halt. + ;; state 0 state 1 state 2 state 3 state 4 + set WhatToWrite (list (list -1 0 1) (list -1 0 1) (list -1 0 1) (list -1 0 1) (list -1 0 1) ) + set HowToMove (list (list 0 0 0) (list 0 0 0) (list 0 0 0) (list 0 0 0) (list 0 0 0) ) + set NextState(list (list -9 -9 -9) (list -9 -9 -9) (list -9 -9 -9) (list -9 -9 -9) (list -9 -9 -9) ) + + ;; Fill the rules based on the selected case + if (Turing_Program_Selection = "Simple Incrementor") + [ + ;; simple Incrementor - this is from the RosettaCode Universal Turing Machine page - very simple! + set WhatToWrite (list (list 1 0 1) ) + set HowToMove (list (list 0 0 1) ) + set NextState (list (list -1 -9 0) ) + ] + + ;; Fill the rules based on the selected case + if (Turing_Program_Selection = "Incrementor w/Return") + [ + ;; modified Incrementor: it returns to the first 1 on the left. + ;; This version allows the "Copy Ones to right" program to directly follow it. + ;; move right append one back to beginning + set WhatToWrite (list (list -1 0 1) (list 1 0 1) (list -1 0 1) ) + set HowToMove (list (list 1 0 1) (list 0 0 1) (list 1 0 -1) ) + set NextState (list (list 1 -9 1) (list 2 -9 1) (list -1 -9 2) ) + ] + + ;; Fill the rules based on the selected case + if (Turing_Program_Selection = "Copy Ones to right") + [ + ;; "Copy" from Wiki "Turing machine examples" page; slight mod so that it ends on first 1 + ;; of the copy allowing Copy to be re-executed to create another copy. + ;; Has 5 states and uses Blank and 1 to make a copy of a string of ones; + ;; this can be run after runs of the "Incrementor w/Return". + ;; state 0 state 1 state 2 state 3 state 4 + set WhatToWrite (list (list -1 0 -1) (list -1 0 1) (list 1 0 1) (list -1 0 1) (list 1 0 1) ) + set HowToMove (list (list 1 0 1) (list 1 0 1) (list -1 0 1) (list -1 0 -1) (list 1 0 -1) ) + set NextState (list (list -1 -9 1) (list 2 -9 1) (list 3 -9 2) (list 4 -9 3) (list 0 -9 4) ) + ] + + ;; Fill the rules based on the selected case + if (Turing_Program_Selection = "Binary Counter") + [ + ;; Count in binary - can start on a blank space. + ;; States: start carry-1 back-to-beginning + set WhatToWrite (list (list 1 1 0) (list 1 1 0) (list -1 0 1) ) + set HowToMove (list (list 0 0 -1) (list 0 0 -1) (list -1 1 1) ) + set NextState (list (list -1 -1 1) (list 2 2 1) (list -1 2 2) ) + ;; Select line above from these two: + ;; can either count by 1 each time it is run: + ;; set NextState (list (list -1 -1 1) (list 2 2 1) (list -1 2 2) ) + ;; or count forever once started: + ;; set NextState (list (list 0 0 1) (list 2 2 1) (list 0 2 2) ) + set RealTimePerTick 0.2 + ] + + if (Turing_Program_Selection = "Busy-Beaver 3-State, 2-Sym") + [ + ;; from the RosettaCode.org Universal Turing Machine page + ;; state name: a b c + set WhatToWrite (list (list 1 0 1) (list 1 0 1) (list 1 0 1) (list -1 0 1) (list -1 0 1) ) + set HowToMove (list (list 1 0 -1) (list -1 0 1) (list -1 0 0) (list 0 0 0) (list 0 0 0) ) + set NextState (list (list 1 -9 2) (list 0 -9 1) (list 1 -9 -1) (list -9 -9 -9) (list -9 -9 -9) ) + ;; Clear the tape + ask Patches [set pcolor BlankColor] + ] + + ;; should output 13 ones and take 107 steps to do it... + if (Turing_Program_Selection = "Busy-Beaver 4-State, 2-Sym") + [ + ;; from the RosettaCode.org Universal Turing Machine page + ;; state name: A B C D + set WhatToWrite (list (list 1 0 1) (list 1 0 -1) (list 1 0 1) (list 1 0 -1) (list -1 0 1) ) + set HowToMove (list (list 1 0 -1) (list -1 0 -1) (list 1 0 -1) (list 1 0 1) (list 0 0 0) ) + set NextState (list (list 1 -9 1) (list 0 -9 2) (list -1 -9 3) (list 3 -9 0) (list -9 -9 -9) ) + ;; Clear the tape + ask Patches [set pcolor BlankColor] + ] + + ;; This takes 38 steps to write 9 ones/zeroes + if (Turing_Program_Selection = "Busy-Beaver 2-State, 3-Sym") + [ + ;; A B + set WhatToWrite (list (list 0 1 0) (list 1 1 0) (list -1 0 1) (list -1 0 1) (list -1 0 1) ) + set HowToMove (list (list 1 -1 1) (list -1 1 -1) (list 0 0 0) (list 0 0 0) (list 0 0 0) ) + set NextState(list (list 1 1 -1) (list 0 1 1) (list -9 -9 -9) (list -9 -9 -9) (list -9 -9 -9) ) + ;; Clear the tape + ask Patches [set pcolor BlankColor] + ] + + ;; This only makes 501 ones and stops after 134,467 steps -- it does do that !!! + if (Turing_Program_Selection = "Lazy-Beaver 5-State, 2-Sym") + [ + ;; from the RosettaCode.org Universal Turing Machine page + ;; state name: A0 B1 C2 D3 E4 + set WhatToWrite (list (list 1 0 -1) (list 1 0 1) (list 1 0 -1) (list -1 0 1) (list 1 0 1) ) + set HowToMove (list (list 1 0 -1) (list 1 0 1) (list -1 0 1) (list 1 0 1) (list -1 0 1) ) + set NextState (list (list 1 -9 2) (list 2 -9 3) (list 0 -9 1) (list 4 -9 -1) (list 2 -9 0) ) + ;; Clear the tape + ask Patches [set pcolor BlankColor] + ;; Looks like it goes much more forward than back on the tape + ;; so start the head just a row from the bottom: + ask turtles [setxy 0 -1 * max-pxcor + 1] + ;; and go faster + set RealTimePerTick 0.02 + ] + + ;; The rest have large outputs and run for a long time, so I haven't confirmed + ;; that they work as advertised... + + ;; This is the 5,2 record holder: 4098 ones in 47,176,870 steps. + ;; With max-pxcor of 14 and offset r/w head start (below), this will + ;; run off the tape at about 150,000+steps... + if (Turing_Program_Selection = "Busy-Beaver 5-State, 2-Sym") + [ + ;; from the RosettaCode.org Universal Turing Machine page + ;; state name: A B C D E + set WhatToWrite (list (list 1 0 1) (list 1 0 1) (list 1 0 -1) (list 1 0 1) (list 1 0 -1) ) + set HowToMove (list (list 1 0 -1) (list 1 0 1) (list 1 0 -1) (list -1 0 -1) (list 1 0 -1) ) + set NextState (list (list 1 -9 2) (list 2 -9 1) (list 3 -9 4) (list 0 -9 3) (list -1 -9 0) ) + ;; Clear the tape + ask Patches [set pcolor BlankColor] + ;; Writes more backward than forward, so start a few rows from the top: + ask turtles [setxy 0 max-pxcor - 3] + ;; and go faster + set RealTimePerTick 0.02 + ] + + if (Turing_Program_Selection = "Lazy-Beaver 3-State, 3-Sym") + [ + ;; This should write 5600 ones/zeros and take 29,403,894 steps. + ;; Ran it to 175,000+ steps and only covered 1/2 of the cells (w/max-pxcor = 14)... + ;; state name: A B C + set WhatToWrite (list (list 0 1 0) (list 1 -1 0) (list 0 1 0) (list -1 0 1) (list -1 0 1) ) + set HowToMove (list (list 1 1 -1) (list -1 1 1) (list 1 -1 1) (list 0 0 0) (list 0 0 0) ) + set NextState (list (list 1 0 0) (list 2 2 1) (list -1 0 1) (list -9 -9 -9) (list -9 -9 -9) ) + ;; Clear the tape + ask Patches [set pcolor BlankColor] + ;; It goes much more forward than back on the tape + ;; so start the head just a row from the bottom: + ask turtles [setxy 0 -1 * max-pxcor + 1] + ;; and go faster + set RealTimePerTick 0.02 + ] + + if (Turing_Program_Selection = "Busy-Beaver 3-State, 3-Sym") + [ + ;; This should write 374,676,383 ones/zeros and take 119,112,334,170,342,540 (!!!) steps. + ;; Rn it to ~ 175,000 steps covering about 2/3 of the max-pxcor=14 cells. + ;; state name: A B C + set WhatToWrite (list (list 0 1 0) (list -1 1 0) (list 0 0 0) (list -1 0 1) (list -1 0 1) ) + set HowToMove (list (list 1 -1 -1) (list -1 1 -1) (list 1 1 1) (list 0 0 0) (list 0 0 0) ) + set NextState (list (list 1 0 2) (list 0 1 1) (list -1 0 2) (list -9 -9 -9) (list -9 -9 -9) ) + ;; Clear the tape + ask Patches [set pcolor BlankColor] + ;; Writes more backward than forward, so start a rowish from the top: + ask turtles [setxy 0 max-pxcor - 1] + ;; and go faster + set RealTimePerTick 0.02 + ] + + ;; in all cases reset the machine state to 0: + ask turtles [set MyState 0] + set MachineState 0 + ;; and the ticks + reset-ticks + +end diff --git a/Task/Universal-Turing-machine/REXX/universal-turing-machine-1.rexx b/Task/Universal-Turing-machine/REXX/universal-turing-machine-1.rexx index 3332148d59..dc78bbdb8e 100644 --- a/Task/Universal-Turing-machine/REXX/universal-turing-machine-1.rexx +++ b/Task/Universal-Turing-machine/REXX/universal-turing-machine-1.rexx @@ -1,41 +1,45 @@ -/*REXX pgm executes a Turing machine based on initial state, tape, rules*/ -state = 'q0' /*initial Turing machine state. */ -term = 'qf' /*a state that is used for halt. */ -blank = 'B' /*this character is a true blank.*/ -call turing_rule 'q0 1 1 right q0' /*define a rule for the machine. */ -call turing_rule 'q0 B 1 stay qf' /* " " " " " " */ -call turing_init 1 1 1 /*initialize tape to string(s). */ -call turing_machine /*go invoke the Turning machine. */ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────TURING_MACHINE subroutine───────────*/ -turing_machine: !=1; bot=1; top=1 /*start at the tape location 1. */ -say /*might as well show a blank line*/ - do cycle=1 until state==term /*do Turing machine instructions.*/ - do k=1 for rules /*process the Turning mach. rules*/ - parse var rule.k rState rTape rWrite rMove rNext . /*pick pieces*/ - if state\==rState | @.!\==rTape then iterate /*wrong rule?*/ - @.!=rWrite /*right rule; write it ──► tape.*/ - if rMove== 'left' then !=!-1 /*Move left? Then subtract one.*/ - if rMove=='right' then !=!+1 /*Move right? Then add one.*/ - bot=min(bot,!); top=max(top,!) /*find the tape bottom and top.*/ - state=rNext /*use this for the next state. */ - iterate cycle /*go process another instruction.*/ - end /*k*/ - say '***error!*** unknown state:' state; leave /*oops.*/ - end /*cycle*/ -$= /*start with empty string (tape).*/ - do t=bot to top; _=@.t; if _==blank then _=' ' /*translate?*/ - $=$ || pad || _ /*build chr by chr, maybe pad it.*/ - end /*t*/ /* [↑] build the tape's contents.*/ -if $='' then $= "[tape is blank.]" /*make an empty tape visible.*/ -say 'Turning machine used' rules "rules in" cycle 'cycles, tape is:' $ -return -/*──────────────────────────────────TURING_INIT subroutine──────────────*/ -turing_init: @.=blank; parse arg x - do j=1 for words(x); @.j=word(x,j); end /*j*/ -return -/*──────────────────────────────────TURING_RULE subroutine──────────────*/ -turing_rule: if symbol('RULES')=="LIT" then rules=0; rules=rules+1 -pad=left('',length(word(arg(1),2))\==1) /*used if any symbol's length>1.*/ -rule.rules=arg(1); say right('rule' rules,20) "═══►" rule.rules -return +/*REXX program executes a Turing machine based on initial state, tape, and rules. */ +state = 'q0' /*the initial Turing machine state. */ +term = 'qf' /*a state that is used for a halt. */ +blank = 'B' /*this character is a "true" blank. */ +call Turing_rule 'q0 1 1 right q0' /*define a rule for the Turing machine.*/ +call Turing_rule 'q0 B 1 stay qf' /* " " " " " " " */ +call Turing_init 1 1 1 /*initialize the tape to some string(s)*/ +call TM /*go and invoke the Turning machine. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +TM: !=1; bot=1; top=1; @er= '***error***' /*start at the tape location 1. */ + say /*might as well display a blank line. */ + do cycle=1 until state==term /*process Turing machine instructions.*/ + do k=1 for rules /* " " " rules. */ + parse var rule.k rState rTape rWrite rMove rNext . /*pick pieces. */ + if state\==rState | @.!\==rTape then iterate /*wrong rule ? */ + @.!=rWrite /*right rule; write it ───► the tape. */ + if rMove== 'left' then !=!-1 /*Are we moving left? Then subtract 1*/ + if rMove=='right' then !=!+1 /* " " " right? " add 1*/ + bot=min(bot, !); top=max(top, !) /*find the tape bottom and top. */ + state=rNext /*use this for the next state. */ + iterate cycle /*go process another TM instruction. */ + end /*k*/ + say @er 'unknown state:' state; leave /*oops, we have an unknown state error.*/ + end /*cycle*/ + $= /*start with empty string (the tape). */ + do t=bot to top; _=@.t + if _==blank then _=' ' /*do we need to translate a true blank?*/ + $=$ || pad || _ /*construct char by char, maybe pad it.*/ + end /*t*/ /* [↑] construct the tape's contents.*/ + L=length($) + if L==0 then $= "[tape is blank.]" /*make an empty tape visible to user.*/ + if L>1000 then $=left($, 1000) ... /*truncate tape to 1k bytes, append ···*/ + say "tape's contents:" $ /*show the tape's contents (or 1st 1k).*/ + say "tape's length: " L /* " " " length. */ + say 'Turning machine used ' rules " rules in " cycle ' cycles.' + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +Turing_init: @.=blank; parse arg x; do j=1 for words(x); @.j=word(x,j); end /*j*/ + return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +Turing_rule: if symbol('RULES')=="LIT" then rules=0; rules=rules+1 + pad=left('', length( word( arg(1),2 ) ) \==1 ) /*padding for rule*/ + rule.rules=arg(1); say right('rule' rules, 20) "═══►" rule.rules + return diff --git a/Task/Universal-Turing-machine/REXX/universal-turing-machine-2.rexx b/Task/Universal-Turing-machine/REXX/universal-turing-machine-2.rexx index 5214339e8b..a11dc079a2 100644 --- a/Task/Universal-Turing-machine/REXX/universal-turing-machine-2.rexx +++ b/Task/Universal-Turing-machine/REXX/universal-turing-machine-2.rexx @@ -1,15 +1,15 @@ -/*REXX pgm executes a Turing machine based on initial state, tape, rules*/ -state = 'a' /*initial Turing machine state. */ -term = 'halt' /*a state that is used for halt. */ -blank = 0 /*this character is a true blank.*/ -call turing_rule 'a 0 1 right b' /*define a rule for the machine. */ -call turing_rule 'a 1 1 left c' /* " " " " " " */ -call turing_rule 'b 0 1 left a' /* " " " " " " */ -call turing_rule 'b 1 1 right b' /* " " " " " " */ -call turing_rule 'c 0 1 left b' /* " " " " " " */ -call turing_rule 'c 1 1 stay halt' /* " " " " " " */ -call turing_init /*initialize tape to string(s). */ -call turing_machine /*go invoke the Turning machine. */ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────TURING_MACHINE subroutine───────────*/ -turing_machine ∙∙∙ +/*REXX program executes a Turing machine based on initial state, tape, and rules. */ +state = 'a' /*the initial Turing machine state. */ +term = 'halt' /*a state that is used for a halt. */ +blank = 0 /*this character is a "true" blank. */ +call Turing_rule 'a 0 1 right b' /*define a rule for the Turing machine.*/ +call Turing_rule 'a 1 1 left c' /* " " " " " " " */ +call Turing_rule 'b 0 1 left a' /* " " " " " " " */ +call Turing_rule 'b 1 1 right b' /* " " " " " " " */ +call Turing_rule 'c 0 1 left b' /* " " " " " " " */ +call Turing_rule 'c 1 1 stay halt' /* " " " " " " " */ +call Turing_init /*initialize the tape to some string(s)*/ +call TM /*go and invoke the Turning machine. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +TM: ∙∙∙ diff --git a/Task/Universal-Turing-machine/REXX/universal-turing-machine-3.rexx b/Task/Universal-Turing-machine/REXX/universal-turing-machine-3.rexx index 3712274242..96fa2c2780 100644 --- a/Task/Universal-Turing-machine/REXX/universal-turing-machine-3.rexx +++ b/Task/Universal-Turing-machine/REXX/universal-turing-machine-3.rexx @@ -1,19 +1,19 @@ -/*REXX pgm executes a Turing machine based on initial state, tape, rules*/ -state = 'A' /*initial Turing machine state. */ -term = 'H' /*a state that is used for halt. */ -blank = 0 /*this character is a true blank.*/ -call turing_rule 'A 0 1 right B' /*define a rule for the machine. */ -call turing_rule 'A 1 1 left C' /* " " " " " " */ -call turing_rule 'B 0 1 right C' /* " " " " " " */ -call turing_rule 'B 1 1 right B' /* " " " " " " */ -call turing_rule 'C 0 1 right D' /* " " " " " " */ -call turing_rule 'C 1 1 left E' /* " " " " " " */ -call turing_rule 'D 0 1 left A' /* " " " " " " */ -call turing_rule 'D 1 1 left D' /* " " " " " " */ -call turing_rule 'E 0 1 stay H' /* " " " " " " */ -call turing_rule 'E 1 1 left A' /* " " " " " " */ -call turing_init /*initialize tape to string(s). */ -call turing_machine /*go invoke the Turning machine. */ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────TURING_MACHINE subroutine───────────*/ -turing_machine ∙∙∙ +/*REXX program executes a Turing machine based on initial state, tape, and rules. */ +state = 'A' /*initialize the Turing machine state.*/ +term = 'H' /*a state that is used for the halt. */ +blank = 0 /*this character is a "true" blank. */ +call Turing_rule 'A 0 1 right B' /*define a rule for the Turing machine.*/ +call Turing_rule 'A 1 1 left C' /* " " " " " " " */ +call Turing_rule 'B 0 1 right C' /* " " " " " " " */ +call Turing_rule 'B 1 1 right B' /* " " " " " " " */ +call Turing_rule 'C 0 1 right D' /* " " " " " " " */ +call Turing_rule 'C 1 0 left E' /* " " " " " " " */ +call Turing_rule 'D 0 1 left A' /* " " " " " " " */ +call Turing_rule 'D 1 1 left D' /* " " " " " " " */ +call Turing_rule 'E 0 1 stay H' /* " " " " " " " */ +call Turing_rule 'E 1 0 left A' /* " " " " " " " */ +call Turing_init /*initialize the tape to some string(s)*/ +call TM /*go and invoke the Turning machine. */ +exit /*stick a fork in it, we're done.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +TM: ∙∙∙ diff --git a/Task/Universal-Turing-machine/REXX/universal-turing-machine-4.rexx b/Task/Universal-Turing-machine/REXX/universal-turing-machine-4.rexx index 43996a20db..2ad15625ca 100644 --- a/Task/Universal-Turing-machine/REXX/universal-turing-machine-4.rexx +++ b/Task/Universal-Turing-machine/REXX/universal-turing-machine-4.rexx @@ -1,23 +1,23 @@ -/*REXX pgm executes a Turing machine based on initial state, tape, rules*/ -state = 'A' /*initial Turing machine state. */ -term = 'halt' /*a state that is used for halt. */ -blank = 0 /*this character is a true blank.*/ -call turing_rule 'A 1 1 right A' /*define a rule for the machine. */ -call turing_rule 'A 2 3 right B' /* " " " " " " */ -call turing_rule 'A 0 0 left E' /* " " " " " " */ -call turing_rule 'B 1 1 right B' /* " " " " " " */ -call turing_rule 'B 2 2 right B' /* " " " " " " */ -call turing_rule 'B 0 0 left C' /* " " " " " " */ -call turing_rule 'C 1 2 left D' /* " " " " " " */ -call turing_rule 'C 2 2 left C' /* " " " " " " */ -call turing_rule 'C 3 2 left E' /* " " " " " " */ -call turing_rule 'D 1 1 left D' /* " " " " " " */ -call turing_rule 'D 2 2 left D' /* " " " " " " */ -call turing_rule 'D 3 1 right A' /* " " " " " " */ -call turing_rule 'E 1 1 left E' /* " " " " " " */ -call turing_rule 'E 0 0 right halt' /* " " " " " " */ -call turing_init 1 2 2 1 2 2 1 2 1 2 1 2 1 2 /*init. tape to string(s). */ -call turing_machine /*go invoke the Turning machine. */ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────TURING_MACHINE subroutine───────────*/ -turing_machine ∙∙∙ +/*REXX program executes a Turing machine based on initial state, tape, and rules. */ +state = 'A' /*the initial Turing machine state. */ +term = 'halt' /*a state that is used for the halt. */ +blank = 0 /*this character is a "true" blank. */ +call Turing_rule 'A 1 1 right A' /*define a rule for the Turing machine.*/ +call Turing_rule 'A 2 3 right B' /* " " " " " " " */ +call Turing_rule 'A 0 0 left E' /* " " " " " " " */ +call Turing_rule 'B 1 1 right B' /* " " " " " " " */ +call Turing_rule 'B 2 2 right B' /* " " " " " " " */ +call Turing_rule 'B 0 0 left C' /* " " " " " " " */ +call Turing_rule 'C 1 2 left D' /* " " " " " " " */ +call Turing_rule 'C 2 2 left C' /* " " " " " " " */ +call Turing_rule 'C 3 2 left E' /* " " " " " " " */ +call Turing_rule 'D 1 1 left D' /* " " " " " " " */ +call Turing_rule 'D 2 2 left D' /* " " " " " " " */ +call Turing_rule 'D 3 1 right A' /* " " " " " " " */ +call Turing_rule 'E 1 1 left E' /* " " " " " " " */ +call Turing_rule 'E 0 0 right halt' /* " " " " " " " */ +call Turing_init 1 2 2 1 2 2 1 2 1 2 1 2 1 2 /*initialize the tape to some string(s)*/ +call TM /*go and invoke the Turning machine. */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +TM: ∙∙∙ diff --git a/Task/Unix-ls/00DESCRIPTION b/Task/Unix-ls/00DESCRIPTION index f841775c89..095135f229 100644 --- a/Task/Unix-ls/00DESCRIPTION +++ b/Task/Unix-ls/00DESCRIPTION @@ -1,17 +1,32 @@ -Write a program that will list everything in the current folder, similar to the Unix utility “ls” [http://man7.org/linux/man-pages/man1/ls.1.html] (or the Windows terminal command “DIR”). The output must be sorted, but printing extended details and producing multi-column output is not required. +;Task: +Write a program that will list everything in the current folder,   similar to: +:::*   the Unix utility   “ls”   [http://man7.org/linux/man-pages/man1/ls.1.html]       or +:::*   the Windows terminal command   “DIR” + +
    +The output must be sorted, but printing extended details and producing multi-column output is not required. + ;Example output For the list of paths: -
    /foo/bar
    +
    +/foo/bar
     /foo/bar/1
     /foo/bar/2
     /foo/bar/a
    -/foo/bar/b
    +/foo/bar/b +
    -When the program is executed in `/foo`, it should print: -
    bar
    -and when the program is executed in `/foo/bar`, it should print: -
    1
    +
    +When the program is executed in   `/foo`,   it should print:
    +
    +bar
    +
    +and when the program is executed in   `/foo/bar`,   it should print: +
    +1
     2
     a
    -b
    +b +
    +

    diff --git a/Task/Unix-ls/Common-Lisp/unix-ls.lisp b/Task/Unix-ls/Common-Lisp/unix-ls.lisp new file mode 100644 index 0000000000..6c6a0a9a0c --- /dev/null +++ b/Task/Unix-ls/Common-Lisp/unix-ls.lisp @@ -0,0 +1,12 @@ +(defun files-list (&optional (path ".")) + (let* ((dir (concatenate 'string path "/")) + (abs-path (car (directory dir))) + (file-pattern (concatenate 'string dir "*")) + (subdir-pattern (concatenate 'string file-pattern "/"))) + (remove-duplicates + (mapcar (lambda (p) (enough-namestring p abs-path)) + (mapcan #'directory (list file-pattern subdir-pattern))) + :test #'string-equal))) + +(defun ls (&optional (path ".")) + (format t "~{~a~%~}" (sort (files-list path) #'string-lessp))) diff --git a/Task/Unix-ls/Elixir/unix-ls.elixir b/Task/Unix-ls/Elixir/unix-ls.elixir new file mode 100644 index 0000000000..5550e3ed82 --- /dev/null +++ b/Task/Unix-ls/Elixir/unix-ls.elixir @@ -0,0 +1,11 @@ +iex(1)> ls = fn dir -> File.ls!(dir) |> Enum.each(&IO.puts &1) end +#Function<6.54118792/1 in :erl_eval.expr/5> +iex(2)> ls.("foo") +bar +:ok +iex(3)> ls.("foo/bar") +1 +2 +a +b +:ok diff --git a/Task/Unix-ls/Fortran/unix-ls-1.f b/Task/Unix-ls/Fortran/unix-ls-1.f new file mode 100644 index 0000000000..609e360b6a --- /dev/null +++ b/Task/Unix-ls/Fortran/unix-ls-1.f @@ -0,0 +1,18 @@ + PROGRAM LS !Names the files in the current directory. + USE DFLIB !Mysterious library. + TYPE(FILE$INFO) INFO !With mysterious content. + NAMELIST /HIC/INFO !This enables annotated output. + INTEGER MARK,L !Assistants. + + MARK = FILE$FIRST !Starting state. +Call for the next file. + 10 L = GETFILEINFOQQ("*",INFO,MARK) !Mystery routine returns the length of the file name. + IF (MARK.EQ.FILE$ERROR) THEN !Or possibly, not. + WRITE (6,*) "Error!",L !Something went wrong. + WRITE (6,HIC) !Reveal INFO, annotated. + STOP "That wasn't nice." !Quite. + ELSE IF (IAND(INFO.PERMIT,FILE$DIR) .EQ. 0) THEN !Not a directory. + IF (L.GT.0) WRITE (6,*) INFO.NAME(1:L) !The object of the exercise! + END IF !So much for that entry. + IF (MARK.NE.FILE$LAST) GO TO 10 !Lastness is discovered after the last file is fingered. + END !If FILE$LAST is not reached, "system resources may be lost." diff --git a/Task/Unix-ls/Fortran/unix-ls-2.f b/Task/Unix-ls/Fortran/unix-ls-2.f new file mode 100644 index 0000000000..953c0bb712 --- /dev/null +++ b/Task/Unix-ls/Fortran/unix-ls-2.f @@ -0,0 +1,16 @@ + INTERFACE + INTEGER*4 FUNCTION GETFILEINFOQQ(FILES, BUFFER,dwHANDLE) +!DEC$ ATTRIBUTES DEFAULT :: GETFILEINFOQQ + CHARACTER*(*) FILES + STRUCTURE / FILE$INFO / + INTEGER*4 CREATION ! Creation time (-1 on FAT) + INTEGER*4 LASTWRITE ! Last write to file + INTEGER*4 LASTACCESS ! Last access (-1 on FAT) + INTEGER*4 LENGTH ! Length of file + INTEGER*2 PERMIT ! File access mode + CHARACTER*255 NAME ! File name + END STRUCTURE + RECORD / FILE$INFO / BUFFER + INTEGER*4 dwHANDLE + END FUNCTION + END INTERFACE diff --git a/Task/Unix-ls/J/unix-ls.j b/Task/Unix-ls/J/unix-ls.j index 7aedd3780c..ba1c3baa63 100644 --- a/Task/Unix-ls/J/unix-ls.j +++ b/Task/Unix-ls/J/unix-ls.j @@ -1,2 +1,2 @@ - dir '*' NB. includes properties - > 1 dir '*' NB. plain filename as per task + dir '' NB. includes properties + >1 1 dir '' NB. plain filename as per task diff --git a/Task/Unix-ls/Lua/unix-ls.lua b/Task/Unix-ls/Lua/unix-ls.lua new file mode 100644 index 0000000000..a424ab5b09 --- /dev/null +++ b/Task/Unix-ls/Lua/unix-ls.lua @@ -0,0 +1,2 @@ +require("lfs") +for file in lfs.dir(".") do print(file) end diff --git a/Task/Unix-ls/Perl/unix-ls-1.pl b/Task/Unix-ls/Perl/unix-ls-1.pl new file mode 100644 index 0000000000..0bc8ea9a68 --- /dev/null +++ b/Task/Unix-ls/Perl/unix-ls-1.pl @@ -0,0 +1,5 @@ +opendir my $handle, '.' or die "Couldnt open current directory: $!"; +while (readdir $handle) { + print "$_\n"; +} +closedir $handle; diff --git a/Task/Unix-ls/Perl/unix-ls-2.pl b/Task/Unix-ls/Perl/unix-ls-2.pl new file mode 100644 index 0000000000..9947d4b291 --- /dev/null +++ b/Task/Unix-ls/Perl/unix-ls-2.pl @@ -0,0 +1 @@ +print "$_\n" for glob '*'; diff --git a/Task/Unix-ls/Perl/unix-ls-3.pl b/Task/Unix-ls/Perl/unix-ls-3.pl new file mode 100644 index 0000000000..dcdb3accec --- /dev/null +++ b/Task/Unix-ls/Perl/unix-ls-3.pl @@ -0,0 +1 @@ +print "$_\n" for glob '* .*'; # If you want to include dot files diff --git a/Task/Unix-ls/PicoLisp/unix-ls.l b/Task/Unix-ls/PicoLisp/unix-ls.l new file mode 100644 index 0000000000..efb633ee15 --- /dev/null +++ b/Task/Unix-ls/PicoLisp/unix-ls.l @@ -0,0 +1,2 @@ +(for F (sort (dir)) + (prinl F) ) diff --git a/Task/Unix-ls/Run-BASIC/unix-ls.run b/Task/Unix-ls/Run-BASIC/unix-ls.run new file mode 100644 index 0000000000..cef17c6f0c --- /dev/null +++ b/Task/Unix-ls/Run-BASIC/unix-ls.run @@ -0,0 +1,13 @@ +files #f, DefaultDir$ + "\*.*" ' RunBasic Default directory.. Can be any directroy +print "rowcount: ";#f ROWCOUNT() ' how many rows in directory +#f DATEFORMAT("mm/dd/yy") 'set format of file date or not +#f TIMEFORMAT("hh:mm:ss") 'set format of file time or not +count = #f rowcount() +for i = 1 to count ' loop thru the row count +print "info: ";#f nextfile$() ' file info +print "name: ";#f NAME$() ' Name of file +print "size: ";#f SIZE() ' size +print "date: ";#f DATE$() ' date +print "time: ";#f TIME$() ' time +print "isdir: ";#f ISDIR() ' 1 = is a directory +next diff --git a/Task/Unix-ls/S-lang/unix-ls.slang b/Task/Unix-ls/S-lang/unix-ls.slang new file mode 100644 index 0000000000..3e71011c6b --- /dev/null +++ b/Task/Unix-ls/S-lang/unix-ls.slang @@ -0,0 +1,3 @@ +variable d = listdir(getcwd()), p; +foreach p (array_sort(d)) + () = printf("%s\n", d[p] ); diff --git a/Task/Update-a-configuration-file/00DESCRIPTION b/Task/Update-a-configuration-file/00DESCRIPTION index e84f097502..e9c1fe491c 100644 --- a/Task/Update-a-configuration-file/00DESCRIPTION +++ b/Task/Update-a-configuration-file/00DESCRIPTION @@ -32,6 +32,7 @@ The task is to manipulate the configuration file as follows: * Change the numberofbananas parameter to 1024 * Enable (or create if it does not exist in the file) a parameter for numberofstrawberries with a value of 62000 +
    Note that configuration option names are not case sensitive. This means that changes should be effected, regardless of the case. Options should always be disabled by prefixing them with a semicolon. @@ -44,9 +45,11 @@ For the purpose of this task, the revised file should contain appropriate entrie The update should rewrite configuration option names in capital letters. However lines beginning with hashes and any parameter data must not be altered (eg the banana for favourite fruit must not become capitalized). The update process should also replace double semicolon prefixes with just a single semicolon (unless it is uncommenting the option, in which case it should remove all leading semicolons). -Any lines beginning with a semicolon or groups of semicolons, but no following option should be removed, as should any leading or trailing whitespace on the lines. Whitespace between the option and paramters should consist only of a single -space, and any non ascii extended characters, tabs characters, or control codes +Any lines beginning with a semicolon or groups of semicolons, but no following option should be removed, as should any leading or trailing whitespace on the lines. Whitespace between the option and parameters should consist only of a single +space, and any non-ASCII extended characters, tabs characters, or control codes (other than end of line markers), should also be removed. -'''See also:''' + +;Related tasks * [[Read a configuration file]] +

    diff --git a/Task/Update-a-configuration-file/BASIC/update-a-configuration-file.basic b/Task/Update-a-configuration-file/BASIC/update-a-configuration-file.basic new file mode 100644 index 0000000000..7a730f9688 --- /dev/null +++ b/Task/Update-a-configuration-file/BASIC/update-a-configuration-file.basic @@ -0,0 +1,680 @@ +' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' +' Read a Configuration File V1.0 ' +' ' +' Developed by A. David Garza Marín in VB-DOS for ' +' RosettaCode. December 2, 2016. ' +' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' + +' OPTION EXPLICIT ' For VB-DOS, PDS 7.1 +' OPTION _EXPLICIT ' For QB64 + +' SUBs and FUNCTIONs +DECLARE SUB AppendCommentToConfFile (WhichFile AS STRING, WhichComment AS STRING, LeaveALine AS INTEGER) +DECLARE SUB setNValToVarArr (WhichVariable AS STRING, WhichIndex AS INTEGER, WhatValue AS DOUBLE) +DECLARE SUB setSValToVar (WhichVariable AS STRING, WhatValue AS STRING) +DECLARE SUB setSValToVarArr (WhichVariable AS STRING, WhichIndex AS INTEGER, WhatValue AS STRING) +DECLARE SUB doModifyArrValueFromConfFile (WhichFile AS STRING, WhichVariable AS STRING, WhichIndex AS INTEGER, WhatValue AS STRING, Separator AS STRING, ToComment AS INTEGER) +DECLARE SUB doModifyValueFromConfFile (WhichFile AS STRING, WhichVariable AS STRING, WhatValue AS STRING, Separator AS STRING, ToComment AS INTEGER) +DECLARE FUNCTION CreateConfFile% (WhichFile AS STRING) +DECLARE FUNCTION ErrorMessage$ (WhichError AS INTEGER) +DECLARE FUNCTION FileExists% (WhichFile AS STRING) +DECLARE FUNCTION FindVarPos% (WhichVariable AS STRING) +DECLARE FUNCTION FindVarPosArr% (WhichVariable AS STRING, WhichIndex AS INTEGER) +DECLARE FUNCTION getArrayVariable$ (WhichVariable AS STRING, WhichIndex AS INTEGER) +DECLARE FUNCTION getVariable$ (WhichVariable AS STRING) +DECLARE FUNCTION getVarType% (WhatValue AS STRING) +DECLARE FUNCTION GetDummyFile$ (WhichFile AS STRING) +DECLARE FUNCTION HowManyElementsInTheArray% (WhichVariable AS STRING) +DECLARE FUNCTION IsItAnArray% (WhichVariable AS STRING) +DECLARE FUNCTION IsItTheVariableImLookingFor% (TextToAnalyze AS STRING, WhichVariable AS STRING) +DECLARE FUNCTION NewValueForTheVariable$ (WhichVariable AS STRING, WhichIndex AS INTEGER, WhatValue AS STRING, Separator AS STRING) +DECLARE FUNCTION ReadConfFile% (NameOfConfFile AS STRING) +DECLARE FUNCTION YorN$ () + +' Register for values located +TYPE regVarValue + VarName AS STRING * 20 + VarType AS INTEGER ' 1=String, 2=Integer, 3=Real, 4=Comment + VarValue AS STRING * 30 +END TYPE + +' Var +DIM rVarValue() AS regVarValue, iErr AS INTEGER, i AS INTEGER, iHMV AS INTEGER +DIM iArrayElements AS INTEGER, iWhichElement AS INTEGER, iCommentStat AS INTEGER +DIM iAnArray AS INTEGER, iSave AS INTEGER +DIM otherfamily(1 TO 2) AS STRING +DIM sVar AS STRING, sVal AS STRING, sComment AS STRING +CONST ConfFileName = "config2.fil" +CONST False = 0, True = NOT False + +' ------------------- Main Program ------------------------ +DO + CLS + ERASE rVarValue + PRINT "This program reads a configuration file and shows the result." + PRINT + PRINT "Default file name: "; ConfFileName + PRINT + iErr = ReadConfFile(ConfFileName) + IF iErr = 0 THEN + iHMV = UBOUND(rVarValue) + PRINT "Variables found in file:" + FOR i = 1 TO iHMV + PRINT RTRIM$(rVarValue(i).VarName); " = "; RTRIM$(rVarValue(i).VarValue); " ("; + SELECT CASE rVarValue(i).VarType + CASE 0: PRINT "Undefined"; + CASE 1: PRINT "String"; + CASE 2: PRINT "Integer"; + CASE 3: PRINT "Real"; + CASE 4: PRINT "Is a commented variable"; + END SELECT + PRINT ")" + NEXT i + PRINT + + INPUT "Type the variable name to modify (Blank=End)"; sVar + sVar = RTRIM$(LTRIM$(sVar)) + IF LEN(sVar) > 0 THEN + i = FindVarPos%(sVar) + IF i > 0 THEN ' Variable found + iAnArray = IsItAnArray%(sVar) + IF iAnArray THEN + iArrayElements = HowManyElementsInTheArray%(sVar) + PRINT "This is an array of"; iArrayElements; " elements." + INPUT "Which one do you want to modify (Default=1)"; iWhichElement + IF iWhichElement = 0 THEN iWhichElement = 1 + ELSE + iArrayElements = 1 + iWhichElement = 1 + END IF + PRINT "The current value of the variable is: " + IF iAnArray THEN + PRINT sVar; "("; iWhichElement; ") = "; RTRIM$(rVarValue(i + (iWhichElement - 1)).VarValue) + ELSE + PRINT sVar; " = "; RTRIM$(rVarValue(i + (iWhichElement - 1)).VarValue) + END IF + ELSE + PRINT "The variable was not found. It will be added." + END IF + PRINT + INPUT "Please, set the new value for the variable (Blank=Unmodified)"; sVal + sVal = RTRIM$(LTRIM$(sVal)) + IF i > 0 THEN + IF rVarValue(i + (iWhichElement - 1)).VarType = 4 THEN + PRINT "Do you want to remove the comment status to the variable? (Y/N)" + iCommentStat = NOT (YorN = "Y") + iCommentStat = ABS(iCommentStat) ' Gets 0 (Toggle) or 1 (Leave unmodified) + iSave = (iCommentStat = 0) + ELSE + PRINT "Do you want to toggle the variable as a comment? (Y/N)" + iCommentStat = (YorN = "Y") ' Gets 0 (Uncommented) or -1 (Toggle as a Comment) + iSave = iCommentStat + END IF + END IF + + ' Now, update or add the variable to the conf file + IF i > 0 THEN + IF sVal = "" THEN + sVal = RTRIM$(rVarValue(i).VarValue) + END IF + ELSE + PRINT "The variable will be added to the configuration file." + PRINT "Do you want to add a remark for it? (Y/N)" + IF YorN$ = "Y" THEN + LINE INPUT "Please, write your remark: ", sComment + sComment = LTRIM$(RTRIM$(sComment)) + IF sComment <> "" THEN + AppendCommentToConfFile ConfFileName, sComment, True + END IF + END IF + END IF + + ' Verifies if the variable will be modified, and applies the modification + IF sVal <> "" OR iSave THEN + IF iWhichElement > 1 THEN + setSValToVarArr sVar, iWhichElement, sVal + doModifyArrValueFromConfFile ConfFileName, sVar, iWhichElement, sVal, " ", iCommentStat + ELSE + setSValToVar sVar, sVal + doModifyValueFromConfFile ConfFileName, sVar, sVal, " ", iCommentStat + END IF + END IF + + END IF + ELSE + PRINT ErrorMessage$(iErr) + END IF + PRINT + PRINT "Do you want to add or modify another variable? (Y/N)" +LOOP UNTIL YorN$ = "N" +' --------- End of Main Program ----------------------- +PRINT +PRINT "End of program." +END + +FileError: + iErr = ERR +RESUME NEXT + +SUB AppendCommentToConfFile (WhichFile AS STRING, WhichComment AS STRING, LeaveALine AS INTEGER) + ' Parameters: + ' WhichFile: Name of the file where a comment will be appended. + ' WhichComment: A comment. It is suggested to add a comment no larger than 75 characters. + ' This procedure adds a # at the beginning of the string if there is no # + ' sign on it in order to ensure it will be added as a comment. + + ' Var + DIM iFil AS INTEGER + + iFil = FileExists%(WhichFile) + IF NOT iFil THEN + iFil = CreateConfFile%(WhichFile) ' Here, iFil is used as dummy to save memory + END IF + + IF iFil THEN ' Everything is Ok + iFil = FREEFILE ' Now, iFil is used to be the ID of the file + WhichComment = LTRIM$(RTRIM$(WhichComment)) + + IF LEFT$(WhichComment, 1) <> "#" THEN ' Is it in comment format? + WhichComment = "# " + WhichComment + END IF + + ' Append the comment to the file + OPEN WhichFile FOR APPEND AS #iFil + IF LeaveALine THEN + PRINT #iFil, "" + END IF + PRINT #iFil, WhichComment + CLOSE #iFil + END IF + +END SUB + +FUNCTION CreateConfFile% (WhichFile AS STRING) + ' Var + DIM iFile AS INTEGER + + ON ERROR GOTO FileError + + iFile = FREEFILE + OPEN WhichFile FOR OUTPUT AS #iFile + CLOSE iFile + + ON ERROR GOTO 0 + + CreateConfFile = FileExists%(WhichFile) +END FUNCTION + +SUB doModifyArrValueFromConfFile (WhichFile AS STRING, WhichVariable AS STRING, WhichIndex AS INTEGER, WhatValue AS STRING, Separator AS STRING, ToComment AS INTEGER) + ' Parameters: + ' WhichFile: The name of the Configuration File. It can include the full path. + ' WhichVariable: The name of the variable to be modified or added to the conf file. + ' WhichIndex: The index number of the element to be modified in a matrix (Default=1) + ' WhatValue: The new value to set in the variable specified in WhichVariable. + ' Separator: The separator between the variable name and its value in the conf file. Defaults to a space " ". + ' ToComment: A value to set or remove the comment mode of a variable: -1=Toggle to Comment, 0=Toggle to not comment, 1=Leave as it is. + + ' Var + DIM iFile AS INTEGER, iFile2 AS INTEGER, iError AS INTEGER + DIM iMod AS INTEGER, iIsComment AS INTEGER + DIM sLine AS STRING, sDummyFile AS STRING, sChar AS STRING + + ' If conf file doesn't exists, create one. + iError = 0 + iMod = 0 + IF NOT FileExists%(WhichFile) THEN + iError = CreateConfFile%(WhichFile) + END IF + + IF NOT iError THEN ' File exists or it was created + Separator = RTRIM$(LTRIM$(Separator)) + IF Separator = "" THEN + Separator = " " ' Defaults to Space + END IF + sDummyFile = GetDummyFile$(WhichFile) + + ' It is assumed a text file + iFile = FREEFILE + OPEN WhichFile FOR INPUT AS #iFile + + iFile2 = FREEFILE + OPEN sDummyFile FOR OUTPUT AS #iFile2 + + ' Goes through the file to find the variable + DO WHILE NOT EOF(iFile) + LINE INPUT #iFile, sLine + sLine = RTRIM$(LTRIM$(sLine)) + sChar = LEFT$(sLine, 1) + iIsComment = (sChar = ";") + IF iIsComment THEN ' Variable is commented + sLine = LTRIM$(MID$(sLine, 2)) + END IF + + IF sChar <> "#" AND LEN(sLine) > 0 THEN ' Is not a comment? + IF IsItTheVariableImLookingFor%(sLine, WhichVariable) THEN + sLine = NewValueForTheVariable$(WhichVariable, WhichIndex, WhatValue, Separator) + iMod = True + IF ToComment = True THEN + sLine = "; " + sLine + END IF + ELSEIF iIsComment THEN + sLine = "; " + sLine + END IF + + END IF + + PRINT #iFile2, sLine + LOOP + + ' Reviews if a modification was done, if not, then it will + ' add the variable to the file. + IF NOT iMod THEN + sLine = NewValueForTheVariable$(WhichVariable, 1, WhatValue, Separator) + PRINT #iFile2, sLine + END IF + CLOSE iFile2, iFile + + ' Removes the conf file and sets the dummy file as the conf file + KILL WhichFile + NAME sDummyFile AS WhichFile + END IF + +END SUB + +SUB doModifyValueFromConfFile (WhichFile AS STRING, WhichVariable AS STRING, WhatValue AS STRING, Separator AS STRING, ToComment AS INTEGER) + ' To see details of parameters, please see doModifyArrValueFromConfFile + doModifyArrValueFromConfFile WhichFile, WhichVariable, 1, WhatValue, Separator, ToComment +END SUB + +FUNCTION ErrorMessage$ (WhichError AS INTEGER) + ' Var + DIM sError AS STRING + + SELECT CASE WhichError + CASE 0: sError = "Everything went ok." + CASE 1: sError = "Configuration file doesn't exist." + CASE 2: sError = "There are no variables in the given file." + END SELECT + + ErrorMessage$ = sError +END FUNCTION + +FUNCTION FileExists% (WhichFile AS STRING) + ' Var + DIM iFile AS INTEGER + DIM iItExists AS INTEGER + SHARED iErr AS INTEGER + + ON ERROR GOTO FileError + iFile = FREEFILE + iErr = 0 + OPEN WhichFile FOR BINARY AS #iFile + IF iErr = 0 THEN + iItExists = LOF(iFile) > 0 + CLOSE #iFile + + IF NOT iItExists THEN + KILL WhichFile + END IF + END IF + ON ERROR GOTO 0 + FileExists% = iItExists + +END FUNCTION + +FUNCTION FindVarPos% (WhichVariable AS STRING) + ' Will find the position of the variable + FindVarPos% = FindVarPosArr%(WhichVariable, 1) +END FUNCTION + +FUNCTION FindVarPosArr% (WhichVariable AS STRING, WhichIndex AS INTEGER) + ' Var + DIM i AS INTEGER, iHMV AS INTEGER, iCount AS INTEGER, iPos AS INTEGER + DIM sVar AS STRING, sVal AS STRING, sWV AS STRING + SHARED rVarValue() AS regVarValue + + ' Looks for a variable name and returns its position + iHMV = UBOUND(rVarValue) + sWV = UCASE$(LTRIM$(RTRIM$(WhichVariable))) + sVal = "" + iCount = 0 + DO + i = i + 1 + sVar = UCASE$(RTRIM$(rVarValue(i).VarName)) + IF sVar = sWV THEN + iCount = iCount + 1 + IF iCount = WhichIndex THEN + iPos = i + END IF + END IF + LOOP UNTIL i >= iHMV OR iPos > 0 + + FindVarPosArr% = iPos +END FUNCTION + +FUNCTION getArrayVariable$ (WhichVariable AS STRING, WhichIndex AS INTEGER) + ' Var + DIM i AS INTEGER + DIM sVal AS STRING + SHARED rVarValue() AS regVarValue + + i = FindVarPosArr%(WhichVariable, WhichIndex) + sVal = "" + IF i > 0 THEN + sVal = RTRIM$(rVarValue(i).VarValue) + END IF + + ' Found it or not, it will return the result. + ' If the result is "" then it didn't found the requested variable. + getArrayVariable$ = sVal + +END FUNCTION + +FUNCTION GetDummyFile$ (WhichFile AS STRING) + ' Var + DIM i AS INTEGER, j AS INTEGER + + ' Gets the path specified in WhichFile + i = 1 + DO + j = INSTR(i, WhichFile, "\") + IF j > 0 THEN i = j + 1 + LOOP UNTIL j = 0 + + GetDummyFile$ = LEFT$(WhichFile, i - 1) + "$dummyf$.tmp" +END FUNCTION + +FUNCTION getVariable$ (WhichVariable AS STRING) + ' Var + DIM i AS INTEGER, iHMV AS INTEGER + DIM sVal AS STRING + + ' For a single variable, looks in the first (and only) + ' element of the array that contains the name requested. + sVal = getArrayVariable$(WhichVariable, 1) + + getVariable$ = sVal +END FUNCTION + +FUNCTION getVarType% (WhatValue AS STRING) + ' Var + DIM sValue AS STRING, dValue AS DOUBLE, iType AS INTEGER + + sValue = RTRIM$(WhatValue) + iType = 0 + IF LEN(sValue) > 0 THEN + IF ASC(LEFT$(sValue, 1)) < 48 OR ASC(LEFT$(sValue, 1)) > 57 THEN + iType = 1 ' String + ELSE + dValue = VAL(sValue) + IF CLNG(dValue) = dValue THEN + iType = 2 ' Integer + ELSE + iType = 3 ' Real + END IF + END IF + END IF + + getVarType% = iType +END FUNCTION + +FUNCTION HowManyElementsInTheArray% (WhichVariable AS STRING) + ' Var + DIM i AS INTEGER, iHMV AS INTEGER, iCount AS INTEGER, iPos AS INTEGER, iQuit AS INTEGER + DIM sVar AS STRING, sVal AS STRING, sWV AS STRING + SHARED rVarValue() AS regVarValue + + ' Looks for a variable name and returns its value + iHMV = UBOUND(rVarValue) + sWV = UCASE$(LTRIM$(RTRIM$(WhichVariable))) + sVal = "" + + ' Look for all instances of WhichVariable in the + ' list. This is because elements of an array will not alwasy + ' be one after another, but alternate. + FOR i = 1 TO iHMV + sVar = UCASE$(RTRIM$(rVarValue(i).VarName)) + IF sVar = sWV THEN + iCount = iCount + 1 + END IF + NEXT i + + HowManyElementsInTheArray = iCount +END FUNCTION + +FUNCTION IsItAnArray% (WhichVariable AS STRING) + ' Returns if a Variable is an Array + IsItAnArray% = (HowManyElementsInTheArray%(WhichVariable) > 1) + +END FUNCTION + +FUNCTION IsItTheVariableImLookingFor% (TextToAnalyze AS STRING, WhichVariable AS STRING) + ' Var + DIM sVar AS STRING, sDT AS STRING, sDV AS STRING + DIM iSep AS INTEGER + + sDT = UCASE$(RTRIM$(LTRIM$(TextToAnalyze))) + sDV = UCASE$(RTRIM$(LTRIM$(WhichVariable))) + iSep = INSTR(sDT, "=") + IF iSep = 0 THEN iSep = INSTR(sDT, " ") + IF iSep > 0 THEN + sVar = RTRIM$(LEFT$(sDT, iSep - 1)) + ELSE + sVar = sDT + END IF + + ' It will return True or False + IsItTheVariableImLookingFor% = (sVar = sDV) +END FUNCTION + +FUNCTION NewValueForTheVariable$ (WhichVariable AS STRING, WhichIndex AS INTEGER, WhatValue AS STRING, Separator AS STRING) + ' Var + DIM iItem AS INTEGER, iItems AS INTEGER, iFirstItem AS INTEGER + DIM i AS INTEGER, iCount AS INTEGER, iHMV AS INTEGER + DIM sLine AS STRING, sVar AS STRING, sVar2 AS STRING + SHARED rVarValue() AS regVarValue + + IF IsItAnArray%(WhichVariable) THEN + iItems = HowManyElementsInTheArray(WhichVariable) + iFirstItem = FindVarPosArr%(WhichVariable, 1) + ELSE + iItems = 1 + iFirstItem = FindVarPos%(WhichVariable) + END IF + iItem = FindVarPosArr%(WhichVariable, WhichIndex) + sLine = "" + sVar = UCASE$(WhichVariable) + iHMV = UBOUND(rVarValue) + + IF iItem > 0 THEN + i = iFirstItem + DO + sVar2 = UCASE$(RTRIM$(rVarValue(i).VarName)) + + IF sVar = sVar2 THEN ' Does it found an element of the array? + iCount = iCount + 1 + IF LEN(sLine) > 0 THEN ' Add a comma + sLine = sLine + ", " + END IF + IF i = iItem THEN + sLine = sLine + WhatValue + ELSE + sLine = sLine + RTRIM$(rVarValue(i).VarValue) + END IF + END IF + i = i + 1 + LOOP UNTIL i > iHMV OR iCount = iItems + + sLine = WhichVariable + Separator + sLine + ELSE + sLine = WhichVariable + Separator + WhatValue + END IF + + NewValueForTheVariable$ = sLine +END FUNCTION + +FUNCTION ReadConfFile% (NameOfConfFile AS STRING) + ' Var + DIM iFile AS INTEGER, iType AS INTEGER, iVar AS INTEGER, iHMV AS INTEGER + DIM iVal AS INTEGER, iCurVar AS INTEGER, i AS INTEGER, iErr AS INTEGER + DIM dValue AS DOUBLE, iIsComment AS INTEGER + DIM sLine AS STRING, sVar AS STRING, sValue AS STRING + SHARED rVarValue() AS regVarValue + + ' This procedure reads a configuration file with variables + ' and values separated by the equal sign (=) or a space. + ' It needs the FileExists% function. + ' Lines begining with # or blank will be ignored. + IF FileExists%(NameOfConfFile) THEN + iFile = FREEFILE + REDIM rVarValue(1 TO 10) AS regVarValue + OPEN NameOfConfFile FOR INPUT AS #iFile + WHILE NOT EOF(iFile) + LINE INPUT #iFile, sLine + sLine = RTRIM$(LTRIM$(sLine)) + IF LEN(sLine) > 0 THEN ' Does it have any content? + IF LEFT$(sLine, 1) <> "#" THEN ' Is not a comment? + iIsComment = (LEFT$(sLine, 1) = ";") + IF iIsComment THEN ' It is a commented variable + sLine = LTRIM$(MID$(sLine, 2)) + END IF + iVar = INSTR(sLine, "=") ' Is there an equal sign? + IF iVar = 0 THEN iVar = INSTR(sLine, " ") ' if not then is there a space? + + GOSUB AddASpaceForAVariable + iCurVar = iHMV + IF iVar > 0 THEN ' Is a variable and a value + rVarValue(iHMV).VarName = LEFT$(sLine, iVar - 1) + ELSE ' Is just a variable name + rVarValue(iHMV).VarName = sLine + rVarValue(iHMV).VarValue = "" + END IF + + IF iVar > 0 THEN ' Get the value(s) + sLine = LTRIM$(MID$(sLine, iVar + 1)) + DO ' Look for commas + iVal = INSTR(sLine, ",") + IF iVal > 0 THEN ' There is a comma + rVarValue(iHMV).VarValue = RTRIM$(LEFT$(sLine, iVal - 1)) + GOSUB AddASpaceForAVariable + rVarValue(iHMV).VarName = rVarValue(iHMV - 1).VarName ' Repeats the variable name + sLine = LTRIM$(MID$(sLine, iVal + 1)) + END IF + LOOP UNTIL iVal = 0 + rVarValue(iHMV).VarValue = sLine + + END IF + + ' Determine the variable type of each variable found in this step + FOR i = iCurVar TO iHMV + IF iIsComment THEN + rVarValue(i).VarType = 4 ' Is a comment + ELSE + GOSUB DetermineVariableType + END IF + NEXT i + + END IF + END IF + WEND + CLOSE iFile + IF iHMV > 0 THEN + REDIM PRESERVE rVarValue(1 TO iHMV) AS regVarValue + iErr = 0 ' Everything ran ok. + ELSE + REDIM rVarValue(1 TO 1) AS regVarValue + iErr = 2 ' No variables found in configuration file + END IF + ELSE + iErr = 1 ' File doesn't exist + END IF + + ReadConfFile = iErr + +EXIT FUNCTION + +AddASpaceForAVariable: + iHMV = iHMV + 1 + + IF UBOUND(rVarValue) < iHMV THEN ' Are there space for a new one? + REDIM PRESERVE rVarValue(1 TO iHMV + 9) AS regVarValue + END IF +RETURN + +DetermineVariableType: + sValue = RTRIM$(rVarValue(i).VarValue) + IF LEN(sValue) > 0 THEN + IF ASC(LEFT$(sValue, 1)) < 48 OR ASC(LEFT$(sValue, 1)) > 57 THEN + rVarValue(i).VarType = 1 ' String + ELSE + dValue = VAL(sValue) + IF CLNG(dValue) = dValue THEN + rVarValue(i).VarType = 2 ' Integer + ELSE + rVarValue(i).VarType = 3 ' Real + END IF + END IF + END IF +RETURN + +END FUNCTION + +SUB setNValToVar (WhichVariable AS STRING, WhatValue AS DOUBLE) + ' Sets a numeric value to a variable + setNValToVarArr WhichVariable, 1, WhatValue +END SUB + +SUB setNValToVarArr (WhichVariable AS STRING, WhichIndex AS INTEGER, WhatValue AS DOUBLE) + ' Sets a numeric value to a variable array + ' Var + DIM sVal AS STRING + sVal = FORMAT$(WhatValue) + setSValToVarArr WhichVariable, WhichIndex, sVal +END SUB + +SUB setSValToVar (WhichVariable AS STRING, WhatValue AS STRING) + ' Sets a string value to a variable + setSValToVarArr WhichVariable, 1, WhatValue +END SUB + +SUB setSValToVarArr (WhichVariable AS STRING, WhichIndex AS INTEGER, WhatValue AS STRING) + ' Sets a string value to a variable array + ' Var + DIM i AS INTEGER + DIM sVar AS STRING + SHARED rVarValue() AS regVarValue + + i = FindVarPosArr%(WhichVariable, WhichIndex) + IF i = 0 THEN ' Should add the variable + IF UBOUND(rVarValue) > 0 THEN + sVar = RTRIM$(rVarValue(1).VarName) + IF sVar <> "" THEN + i = UBOUND(rVarValue) + 1 + REDIM PRESERVE rVarValue(1 TO i) AS regVarValue + ELSE + i = 1 + END IF + ELSE + REDIM rVarValue(1 TO i) AS regVarValue + END IF + rVarValue(i).VarName = WhichVariable + END IF + + ' Sets the new value to the variable + rVarValue(i).VarValue = WhatValue + rVarValue(i).VarType = getVarType%(WhatValue) +END SUB + +FUNCTION YorN$ () + ' Var + DIM sYorN AS STRING + + DO + sYorN = UCASE$(INPUT$(1)) + IF INSTR("YN", sYorN) = 0 THEN + BEEP + END IF + LOOP UNTIL sYorN = "Y" OR sYorN = "N" + + YorN$ = sYorN +END FUNCTION diff --git a/Task/Update-a-configuration-file/Fortran/update-a-configuration-file-1.f b/Task/Update-a-configuration-file/Fortran/update-a-configuration-file-1.f new file mode 100644 index 0000000000..f7dcec445e --- /dev/null +++ b/Task/Update-a-configuration-file/Fortran/update-a-configuration-file-1.f @@ -0,0 +1,25 @@ + PROGRAM TEST !Define some data aggregates, then write and read them. + CHARACTER*28 FAVOURITEFRUIT + LOGICAL NEEDSPEELING + LOGICAL SEEDSREMOVED + INTEGER NUMBEROFBANANAS + NAMELIST /FRUIT/ FAVOURITEFRUIT,NEEDSPEELING,SEEDSREMOVED, + 1 NUMBEROFBANANAS + INTEGER F !An I/O unit number. + F = 10 !This will do. + +Create an example file to show its format. + OPEN(F,FILE="Basket.txt",STATUS="REPLACE",ACTION="WRITE", !First, prepare a recipient file. + 1 DELIM="QUOTE") !CHARACTER variables will be enquoted. + FAVOURITEFRUIT = "Banana" + NEEDSPEELING = .TRUE. + SEEDSREMOVED = .FALSE. + NUMBEROFBANANAS = 48 + WRITE (F,FRUIT) !Write the lot in one go. + CLOSE (F) !Finished with output. +Can now read from the file. + OPEN(F,FILE="Basket.txt",STATUS="OLD",ACTION="READ", !Get it back. + 1 DELIM="QUOTE") + READ (F,FRUIT) !Read who knows what. + WRITE (6,FRUIT) + END diff --git a/Task/Update-a-configuration-file/Fortran/update-a-configuration-file-2.f b/Task/Update-a-configuration-file/Fortran/update-a-configuration-file-2.f new file mode 100644 index 0000000000..8b64935e32 --- /dev/null +++ b/Task/Update-a-configuration-file/Fortran/update-a-configuration-file-2.f @@ -0,0 +1,33 @@ + MODULE MONKEYFODDER + INTEGER FIELD !An I/O unit number. + CHARACTER*28 FAVOURITEFRUIT + LOGICAL NEEDSPEELING + INTEGER NUMBEROFBANANAS + CONTAINS + SUBROUTINE GETVALS(FNAME) !Reads values from some file. + CHARACTER*(*) FNAME !The file name. + LOGICAL SEEDSREMOVED !This variable is no longer wanted. + NAMELIST /FRUIT/ FAVOURITEFRUIT,NEEDSPEELING,SEEDSREMOVED, !But still appears in this list. + 1 NUMBEROFBANANAS + OPEN(FIELD,FILE=FNAME,STATUS="OLD",ACTION="READ", !Hopefully, the file exists. + 1 DELIM="QUOTE") !Expect quoting for CHARACTER variables. + READ (FIELD,FRUIT,ERR = 666) !Read who knows what. + 666 CLOSE (FIELD) !Ignoring any misformats. + END SUBROUTINE GETVALS !A proper routine would offer error messages. + + SUBROUTINE PUTVALS(FNAME) !Writes values to some file. + CHARACTER*(*) FNAME !The file name. + NAMELIST /FRUIT/ FAVOURITEFRUIT,NEEDSPEELING,NUMBEROFBANANAS + OPEN(FIELD,FILE=FNAME,STATUS="REPLACE",ACTION="WRITE", !Prepare a recipient file. + 1 DELIM="QUOTE") !CHARACTER variables will be enquoted. + WRITE (FIELD,FRUIT) !Write however much is needed. + CLOSE (FIELD) !Finished for now. + END SUBROUTINE PUTVALS + END MODULE MONKEYFODDER + + PROGRAM TEST !Updates the file created by an earlier version. + USE MONKEYFODDER + FIELD = 10 !This will do. + CALL GETVALS("Basket.txt") !Read the values, allowing for the previous version. + CALL PUTVALS("Basket.txt") !Save the values, as per the new version. + END diff --git a/Task/Update-a-configuration-file/Haskell/update-a-configuration-file-1.hs b/Task/Update-a-configuration-file/Haskell/update-a-configuration-file-1.hs new file mode 100644 index 0000000000..d2abb4bef3 --- /dev/null +++ b/Task/Update-a-configuration-file/Haskell/update-a-configuration-file-1.hs @@ -0,0 +1,2 @@ +import Data.Char (toUpper) +import qualified System.IO.Strict as S diff --git a/Task/Update-a-configuration-file/Haskell/update-a-configuration-file-2.hs b/Task/Update-a-configuration-file/Haskell/update-a-configuration-file-2.hs new file mode 100644 index 0000000000..bf1318f78d --- /dev/null +++ b/Task/Update-a-configuration-file/Haskell/update-a-configuration-file-2.hs @@ -0,0 +1,27 @@ +data INI = INI { entries :: [Entry] } deriving Show + +data Entry = Comment String + | Field String String + | Flag String Bool + | EmptyLine + +instance Show Entry where + show entry = case entry of + Comment text -> "# " ++ text + Field f v -> f ++ " " ++ v + Flag f True -> f + Flag f False -> "; " ++ f + EmptyLine -> "" + +instance Read Entry where + readsPrec _ s = [(interprete (clean " " s), "")] + where + clean chs = dropWhile (`elem` chs) + interprete ('#' : text) = Comment text + interprete (';' : f)= flag (clean " ;" f) False + interprete entry = case words entry of + [] -> EmptyLine + [f] -> flag f True + f : v -> field f (unwords v) + field f = Field (toUpper <$> f) + flag f = Flag (toUpper <$> f) diff --git a/Task/Update-a-configuration-file/Haskell/update-a-configuration-file-3.hs b/Task/Update-a-configuration-file/Haskell/update-a-configuration-file-3.hs new file mode 100644 index 0000000000..4dbc2621a0 --- /dev/null +++ b/Task/Update-a-configuration-file/Haskell/update-a-configuration-file-3.hs @@ -0,0 +1,19 @@ +setValue :: String -> String -> INI -> INI +setValue f v = INI . replaceOn (eqv f) (Field f v) . entries + +setFlag :: String -> Bool -> INI -> INI +setFlag f v = INI . replaceOn (eqv f) (Flag f v) . entries + +enable f = setFlag f True +disable f = setFlag f False + +eqv f entry = (toUpper <$> f) == (toUpper <$> field entry) + where field (Field f _) = f + field (Flag f _) = f + field _ = "" + +replaceOn p x lst = prev ++ x : post + where + (prev,post) = case break p lst of + (lst, []) -> (lst, []) + (lst, _:xs) -> (lst, xs) diff --git a/Task/Update-a-configuration-file/Haskell/update-a-configuration-file-4.hs b/Task/Update-a-configuration-file/Haskell/update-a-configuration-file-4.hs new file mode 100644 index 0000000000..ad4106ee79 --- /dev/null +++ b/Task/Update-a-configuration-file/Haskell/update-a-configuration-file-4.hs @@ -0,0 +1,14 @@ +readIni :: String -> IO INI +readIni file = INI . map read . lines <$> S.readFile file + +writeIni :: String -> INI -> IO () +writeIni file = writeFile file . unlines . map show . entries + +updateIni :: String -> (INI -> INI) -> IO () +updateIni file f = readIni file >>= writeIni file . f + +main = updateIni "test.ini" $ + disable "NeedsPeeling" . + enable "SeedsRemoved" . + setValue "NumberOfBananas" "1024" . + setValue "NumberOfStrawberries" "62000" diff --git a/Task/Update-a-configuration-file/Perl-6/update-a-configuration-file.pl6 b/Task/Update-a-configuration-file/Perl-6/update-a-configuration-file.pl6 index 0d91f72fa8..b743a51268 100644 --- a/Task/Update-a-configuration-file/Perl-6/update-a-configuration-file.pl6 +++ b/Task/Update-a-configuration-file/Perl-6/update-a-configuration-file.pl6 @@ -27,7 +27,7 @@ sub MAIN ($file, *%changes) { say $out: format-line .key, |(.value ~~ Bool ?? (Nil, .value) !! (.value, True)) for %changes; - run 'mv', $tmpfile, $file; # work-around for NYI `move $tmpfile, $file;` + move $tmpfile, $file; } END { unlink $tmpfile if $tmpfile.IO.e } diff --git a/Task/Update-a-configuration-file/PowerShell/update-a-configuration-file-1.psh b/Task/Update-a-configuration-file/PowerShell/update-a-configuration-file-1.psh new file mode 100644 index 0000000000..101d67c157 --- /dev/null +++ b/Task/Update-a-configuration-file/PowerShell/update-a-configuration-file-1.psh @@ -0,0 +1,107 @@ +function Update-ConfigurationFile +{ + [CmdletBinding()] + Param + ( + [Parameter(Mandatory=$false, + Position=0)] + [ValidateScript({Test-Path $_})] + [string] + $Path = ".\config.txt", + + [Parameter(Mandatory=$false)] + [string] + $FavouriteFruit, + + [Parameter(Mandatory=$false)] + [int] + $NumberOfBananas, + + [Parameter(Mandatory=$false)] + [int] + $NumberOfStrawberries, + + [Parameter(Mandatory=$false)] + [ValidateSet("On", "Off")] + [string] + $NeedsPeeling, + + [Parameter(Mandatory=$false)] + [ValidateSet("On", "Off")] + [string] + $SeedsRemoved + ) + + [string[]]$lines = Get-Content $Path + + Clear-Content $Path + + if (-not ($lines | Select-String -Pattern "^\s*NumberOfStrawberries" -Quiet)) + { + "", "# How many strawberries we have", "NumberOfStrawberries 0" | ForEach-Object {$lines += $_} + } + + foreach ($line in $lines) + { + $line = $line -replace "^\s*","" ## Strip leading whitespace + + if ($line -match "[;].*\s*") {continue} ## Strip semicolons + + switch -Regex ($line) + { + "(^$)|(^#\s.*)" ## Blank line or comment + { + $line = $line + } + "^FavouriteFruit\s*.*" ## Parameter FavouriteFruit + { + if ($FavouriteFruit) + { + $line = "FAVOURITEFRUIT $FavouriteFruit" + } + } + "^NumberOfBananas\s*.*" ## Parameter NumberOfBananas + { + if ($NumberOfBananas) + { + $line = "NUMBEROFBANANAS $NumberOfBananas" + } + } + "^NumberOfStrawberries\s*.*" ## Parameter NumberOfStrawberries + { + if ($NumberOfStrawberries) + { + $line = "NUMBEROFSTRAWBERRIES $NumberOfStrawberries" + } + } + ".*NeedsPeeling\s*.*" ## Parameter NeedsPeeling + { + if ($NeedsPeeling -eq "On") + { + $line = "NEEDSPEELING" + } + elseif ($NeedsPeeling -eq "Off") + { + $line = "; NEEDSPEELING" + } + } + ".*SeedsRemoved\s*.*" ## Parameter SeedsRemoved + { + if ($SeedsRemoved -eq "On") + { + $line = "SEEDSREMOVED" + } + elseif ($SeedsRemoved -eq "Off") + { + $line = "; SEEDSREMOVED" + } + } + Default ## Whatever... + { + $line = $line + } + } + + Add-Content $Path -Value $line -Force + } +} diff --git a/Task/Update-a-configuration-file/PowerShell/update-a-configuration-file-2.psh b/Task/Update-a-configuration-file/PowerShell/update-a-configuration-file-2.psh new file mode 100644 index 0000000000..417ba7c22b --- /dev/null +++ b/Task/Update-a-configuration-file/PowerShell/update-a-configuration-file-2.psh @@ -0,0 +1,3 @@ +Update-ConfigurationFile -NumberOfStrawberries 62000 -NumberOfBananas 1024 -SeedsRemoved On -NeedsPeeling Off + +Invoke-Item -Path ".\config.txt" diff --git a/Task/Update-a-configuration-file/REXX/update-a-configuration-file-1.rexx b/Task/Update-a-configuration-file/REXX/update-a-configuration-file-1.rexx index 3807496df4..efe057ffd7 100644 --- a/Task/Update-a-configuration-file/REXX/update-a-configuration-file-1.rexx +++ b/Task/Update-a-configuration-file/REXX/update-a-configuration-file-1.rexx @@ -1,45 +1,45 @@ -/*REXX pgm shows how to update a configuration file (4 specific tasks).*/ -parse arg iFID oFID . /*obtain optional input file─id. */ -if iFID=='' | iFID==',' then iFID= 'UPDATECF.TXT' /*use default? */ -if oFID=='' | oFID==',' then oFID='\TEMP\UPDATECF.$$$' /*use default? */ -call lineout iFID; call lineout oFID /*close the input & output files.*/ -$.=0 /*placeholder of options found. */ -call dos 'ERASE' oFID /*erase a file (with no err MSGs)*/ -changed=0 /*nothing changed in file so far.*/ - /* [↓] read the entire cfg file.*/ - do rec=0 while lines(iFID)\==0 /*read a record; bump record cnt.*/ - z=linein(iFID); zz=space(z) /*get rec; del extraneous blanks.*/ - say '───────── record:' z /*echo the record just read──►con*/ - a=left(zz,1); _=space(translate(zz,,';')) /*_ is used to elide multi;*/ - if zz=='' | a=='#' then do; call cpy z; iterate; end /*blank|comment*/ - if _=='' then do; changed=1; iterate; end /*elide any ; empty records*/ - parse upper var z op . /*obtain the option from the rec.*/ - /* [↓] OP may have leading or */ - if a==';' then do; parse upper var z 2 op . /*trailing blanks.*/ - if op='SEEDSREMOVED' then call new space(substr(z,2)) - call cpy z; $.op=1 /*write the Z record to output.*/ - iterate /*rec*/ /*··· and go read the next record*/ +/*REXX program demonstrates how to update a configuration file (four specific tasks).*/ +parse arg iFID oFID . /*obtain optional arguments from the CL*/ +if iFID=='' | iFID=="," then iFID= 'UPDATECF.TXT' /*Not given? Then use default.*/ +if oFID=='' | oFID=="," then oFID='\TEMP\UPDATECF.$$$' /* " " " " " */ +call lineout iFID; call lineout oFID /*close the input and the output files.*/ +$.=0 /*placeholder of the options detected. */ +call dos 'ERASE' oFID /*erase a file (with no error message).*/ +changed=0 /*nothing changed in the file (so far).*/ + /* [↓] read the entire config file. */ + do rec=0 while lines(iFID)\==0 /*read a record; bump the record count.*/ + z=linein(iFID); zz=space(z) /*get record; elide extraneous blanks.*/ + say '───────── record:' z /*echo the record just read ──► console*/ + a=left(zz,1); _=space( translate(zz, ,';') ) /*_: is used to elide multiple ";" */ + if zz=='' | a=='#' then do; call cpy z; iterate; end /*blank or a comment.*/ + if _=='' then do; changed=1; iterate; end /*elide any semicolons; empty records.*/ + parse upper var z op . /*obtain the option from the record. */ + /* [↓] option may have leading or ···*/ + if a==';' then do; parse upper var z 2 op . /*trailing blanks.*/ + if op='SEEDSREMOVED' then call new space( substr(z, 2) ) + call cpy z; $.op=1 /*write the Z record to the output file*/ + iterate /*rec*/ /* ··· and then go read the next record*/ end - if $.op then do; changed=1; iterate; end /*option already defined?*/ - $.op=1 /* [↑] Yes? Delete it.*/ - if op=='NEEDSPEELING' then call new ';' z - if op=='NUMBEROFBANANAS' then call new op 1024 - if op=='NUMBEROFSTRAWBERRIES' then call new op 62000 - call cpy z /*write the Z record to output.*/ + if $.op then do; changed=1; iterate; end /*is the option already defined? */ + $.op=1 /* [↑] Yes? Then delete it. */ + if op=='NEEDSPEELING' then call new ";" z + if op=='NUMBEROFBANANAS' then call new op 1024 + if op=='NUMBEROFSTRAWBERRIES' then call new op 62000 + call cpy z /*write the Z record to the output file*/ end /*rec*/ - nos='NUMBEROFSTRAWBERRIES' /* [↓] NOS option need updating?*/ -if \$.nos then do; call new nos 62000; call cpy z; end /*update opt.*/ -call lineout iFID; call lineout oFID /*close the input & output files.*/ -if rec==0 then do; say "ERROR: input file wasn't found:" iFID; exit; end -if changed then do /*possibly overwrite input file. */ - call dos 'XCOPY' oFID iFID '/y /q',">nul" /*quietly*/ - say; say center('output file', 79, "▒") /*title. */ - call dos 'TYPE' oFID /*display output file's content. */ + nos='NUMBEROFSTRAWBERRIES' /* [↓] Does NOS option need updating? */ +if \$.nos then do; call new nos 62000; call cpy z; end /*update option.*/ +call lineout iFID; call lineout oFID /*close the input and the output files.*/ +if rec==0 then do; say "ERROR: input file wasn't found:" iFID; exit; end +if changed then do /*possibly overwrite the input file. */ + call dos 'XCOPY' oFID iFID '/y /q',">nul" /*quietly*/ + say; say center('output file', 79, "▒") /*title. */ + call dos 'TYPE' oFID /*display content of the output file. */ end -call dos 'ERASE' oFID /*erase a file (with no err msg)*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────one─line subroutines────────────────*/ -cpy: call lineout oFID,arg(1); return /*write one line of text───►oFID.*/ -dos: ''arg(1) word(arg(2) "2>nul",1); return /*execute a DOS command.*/ -new: z=arg(1); changed=1; return /*use new Z, indicate changed rec*/ +call dos 'ERASE' oFID /*erase a file (with no error message).*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +cpy: call lineout oFID, arg(1); return /*write one line of text ───► oFID. */ +dos: ''arg(1) word(arg(2) "2>nul",1); return /*execute a DOS command (quietly). */ +new: z=arg(1); changed=1; return /*use new Z, indicate changed record. */ diff --git a/Task/Use-another-language-to-call-a-function/PARI-GP/use-another-language-to-call-a-function-1.pari b/Task/Use-another-language-to-call-a-function/PARI-GP/use-another-language-to-call-a-function-1.pari new file mode 100644 index 0000000000..6226b253a5 --- /dev/null +++ b/Task/Use-another-language-to-call-a-function/PARI-GP/use-another-language-to-call-a-function-1.pari @@ -0,0 +1 @@ +Strchr(Vecsmall(apply(k->if(k>96&&k<123,(k-84)%26+97,if(k>64&&k<91,(k-52)%26+65,k)),Vec(Vecsmall(s))))) diff --git a/Task/Use-another-language-to-call-a-function/PARI-GP/use-another-language-to-call-a-function-2.pari b/Task/Use-another-language-to-call-a-function/PARI-GP/use-another-language-to-call-a-function-2.pari new file mode 100644 index 0000000000..a4e6b18dc4 --- /dev/null +++ b/Task/Use-another-language-to-call-a-function/PARI-GP/use-another-language-to-call-a-function-2.pari @@ -0,0 +1,22 @@ +#include + +#define PARI_SECRET "s=\"Urer V nz\";Strchr(Vecsmall(apply(k->if(k>96&&k<123,(k-84)%26+97,if(k>64&&k<91,(k-52)%26+65,k)),Vec(Vecsmall(s)))))" + +int Query(char *Data, size_t *Length) +{ + int rc = 0; + GEN result; + + pari_init(1000000, 2); + + result = geval(strtoGENstr(PARI_SECRET)); /* solve the secret */ + + if (result) { + strncpy(Data, GSTR(result), *Length); /* return secret */ + rc = 1; + } + + pari_close(); + + return rc; +} diff --git a/Task/User-input-Text/Ada/user-input-text-3.ada b/Task/User-input-Text/Ada/user-input-text-3.ada new file mode 100644 index 0000000000..5acd579b0a --- /dev/null +++ b/Task/User-input-Text/Ada/user-input-text-3.ada @@ -0,0 +1,15 @@ +with Ada.Text_IO, Ada.Integer_Text_IO; + +procedure User_Input is + I : Integer; +begin + Ada.Text_IO.Put ("Enter a string: "); + declare + S : String := Ada.Text_IO.Get_Line; + begin + Ada.Text_IO.Put_Line (S); + end; + Ada.Text_IO.Put ("Enter an integer: "); + Ada.Integer_Text_IO.Get(I); + Ada.Text_IO.Put_Line (Integer'Image(I)); +end User_Input; diff --git a/Task/User-input-Text/Ada/user-input-text-4.ada b/Task/User-input-Text/Ada/user-input-text-4.ada new file mode 100644 index 0000000000..608186c7a5 --- /dev/null +++ b/Task/User-input-Text/Ada/user-input-text-4.ada @@ -0,0 +1,18 @@ +with + Ada.Text_IO, + Ada.Integer_Text_IO, + Ada.Strings.Unbounded, + Ada.Text_IO.Unbounded_IO; + +procedure User_Input2 is + S : Ada.Strings.Unbounded.Unbounded_String; + I : Integer; +begin + Ada.Text_IO.Put("Enter a string: "); + S := Ada.Strings.Unbounded.To_Unbounded_String(Ada.Text_IO.Get_Line); + Ada.Text_IO.Put_Line(Ada.Strings.Unbounded.To_String(S)); + Ada.Text_IO.Unbounded_IO.Put_Line(S); + Ada.Text_IO.Put("Enter an integer: "); + Ada.Integer_Text_IO.Get(I); + Ada.Text_IO.Put_Line(Integer'Image(I)); +end User_Input2; diff --git a/Task/User-input-Text/Elena/user-input-text.elena b/Task/User-input-Text/Elena/user-input-text.elena new file mode 100644 index 0000000000..6711fe7947 --- /dev/null +++ b/Task/User-input-Text/Elena/user-input-text.elena @@ -0,0 +1,8 @@ +#import system. +#import extensions. + +#symbol program = +[ + #var num := console write:"Enter an integer: " readLine:(Integer new). + #var word := console write:"Enter a String: " readLine. +]. diff --git a/Task/User-input-Text/Maple/user-input-text.maple b/Task/User-input-Text/Maple/user-input-text.maple new file mode 100644 index 0000000000..168b8d0db9 --- /dev/null +++ b/Task/User-input-Text/Maple/user-input-text.maple @@ -0,0 +1,2 @@ +printf("String:"); string_value := readline(); +printf("Integer: "); int_value := parse(readline()); diff --git a/Task/User-input-Text/Rust/user-input-text.rust b/Task/User-input-Text/Rust/user-input-text.rust new file mode 100644 index 0000000000..a9c54a260a --- /dev/null +++ b/Task/User-input-Text/Rust/user-input-text.rust @@ -0,0 +1,32 @@ +use std::io::{self, Write}; +use std::fmt::Display; +use std::process; + +fn main() { + let s = grab_input("Give me a string") + .unwrap_or_else(|e| exit_err(&e, e.raw_os_error().unwrap_or(-1))); + + println!("You entered: {}", s.trim()); + + let n: i32 = grab_input("Give me an integer") + .unwrap_or_else(|e| exit_err(&e, e.raw_os_error().unwrap_or(-1))) + .trim() + .parse() + .unwrap_or_else(|e| exit_err(&e, 2)); + + println!("You entered: {}", n); +} + +fn grab_input(msg: &str) -> io::Result { + let mut buf = String::new(); + print!("{}: ", msg); + try!(io::stdout().flush()); + + try!(io::stdin().read_line(&mut buf)); + Ok(buf) +} + +fn exit_err(msg: T, code: i32) -> ! { + let _ = writeln!(&mut io::stderr(), "Error: {}", msg); + process::exit(code) +} diff --git a/Task/Vampire-number/00DESCRIPTION b/Task/Vampire-number/00DESCRIPTION index d48fafcd19..0e125d3b33 100644 --- a/Task/Vampire-number/00DESCRIPTION +++ b/Task/Vampire-number/00DESCRIPTION @@ -2,12 +2,22 @@ A [[wp:Vampire_number|vampire number]] is a natural number with an even number o * they each contain half the number of the digits of the original number * together they consist of exactly the same digits as the original number * at most one of them has a trailing zero -An example of a Vampire number and its fangs: 1260 : (21, 60) -;Task description: + +
    +An example of a Vampire number and its fangs: 1260 : (21, 60) + + +;Task: # Print the first 25 Vampire numbers and their fangs. -# Check if the following numbers are Vampire numbers and, if so, print them and their fangs: 16758243290880, 24959017348650, 14593825548650 -Note that a Vampire number can have more than 1 pair of fangs. -;See also: +# Check if the following numbers are Vampire numbers and, if so, print them and their fangs: + 16758243290880, 24959017348650, 14593825548650 + +
    +Note that a Vampire number can have more than one pair of fangs. + + +;See also: * [http://www.numberphile.com/videos/vampire_numbers.html numberphile.com]. * [http://users.cybercity.dk/~dsl522332/math/vampires/ Vampire search algorithm] * [[oeis:A014575|Vampire numbers on OEIS]] +

    diff --git a/Task/Vampire-number/Elixir/vampire-number.elixir b/Task/Vampire-number/Elixir/vampire-number.elixir new file mode 100644 index 0000000000..a19b31cba2 --- /dev/null +++ b/Task/Vampire-number/Elixir/vampire-number.elixir @@ -0,0 +1,42 @@ +defmodule Vampire do + def factor_pairs(n) do + first = trunc(n / :math.pow(10, div(char_len(n), 2))) + last = :math.sqrt(n) |> round + for i <- first .. last, rem(n, i) == 0, do: {i, div(n, i)} + end + + def vampire_factors(n) do + if rem(char_len(n), 2) == 1 do + [] + else + half = div(length(to_char_list(n)), 2) + sorted = Enum.sort(String.codepoints("#{n}")) + Enum.filter(factor_pairs(n), fn {a, b} -> + char_len(a) == half && char_len(b) == half && + Enum.count([a, b], fn x -> rem(x, 10) == 0 end) != 2 && + Enum.sort(String.codepoints("#{a}#{b}")) == sorted + end) + end + end + + defp char_len(n), do: length(to_char_list(n)) + + def task do + Enum.reduce_while(Stream.iterate(1, &(&1+1)), 1, fn n, acc -> + case vampire_factors(n) do + [] -> {:cont, acc} + vf -> IO.puts "#{n}:\t#{inspect vf}" + if acc < 25, do: {:cont, acc+1}, else: {:halt, acc+1} + end + end) + IO.puts "" + Enum.each([16758243290880, 24959017348650, 14593825548650], fn n -> + case vampire_factors(n) do + [] -> IO.puts "#{n} is not a vampire number!" + vf -> IO.puts "#{n}:\t#{inspect vf}" + end + end) + end +end + +Vampire.task diff --git a/Task/Vampire-number/Perl-6/vampire-number.pl6 b/Task/Vampire-number/Perl-6/vampire-number.pl6 index 0998a764c0..de4665996b 100644 --- a/Task/Vampire-number/Perl-6/vampire-number.pl6 +++ b/Task/Vampire-number/Perl-6/vampire-number.pl6 @@ -1,8 +1,19 @@ -my @vampires := gather for 1 .. * -> $start, $end { - map { - my @fangs = is_vampire($_); - take "$_: { @fangs.join(', ') }" if @fangs.elems - }, 10 ** $start .. 10 ** $end +sub is_vampire (Int $num) { + my $digits = $num.comb.sort; + my @fangs; + for vfactors($num) -> $this { + my $that = $num div $this; + @fangs.push("$this x $that") if + !($this %% 10 && $that %% 10) and + ($this ~ $that).comb.sort eq $digits; + } + return @fangs; +} + +constant @vampires = gather for 1 .. * -> $n { + next if $n.log(10).floor %% 2; + my @fangs = is_vampire($n); + take "$n: { @fangs.join(', ') }" if @fangs.elems; } say "\nFirst 25 Vampire Numbers:\n"; @@ -21,18 +32,6 @@ for 16758243290880, 24959017348650, 14593825548650 { } } -sub is_vampire (Int $num) { - my $digits = $num.comb.sort; - my @fangs; - for vfactors($num) -> $this { - my $that = $num div $this; - @fangs.push("$this x $that") if - !($this %% 10 && $that %% 10) and - ($this ~ $that).comb.sort eq $digits; - } - return @fangs; -} - sub vfactors (Int $n) { map { $_ if $n %% $_ }, 10**$n.sqrt.log(10).floor .. $n.sqrt.ceiling; } diff --git a/Task/Van-der-Corput-sequence/00DESCRIPTION b/Task/Van-der-Corput-sequence/00DESCRIPTION index a26c68ecc5..9a215fd7db 100644 --- a/Task/Van-der-Corput-sequence/00DESCRIPTION +++ b/Task/Van-der-Corput-sequence/00DESCRIPTION @@ -39,14 +39,17 @@ A ''hint'' at a way to generate members of the sequence is to modify a routine u the above showing that 11 in decimal is 1\times 2^3 + 0\times 2^2 + 1\times 2^1 + 1\times 2^0.
    Reflected this would become .1101 or 1\times 2^{-1} + 1\times 2^{-2} + 0\times 2^{-3} + 1\times 2^{-4} -'''Task Description''' +;Task description: * Create a function/method/routine that given ''n'', generates the ''n'''th term of the van der Corput sequence in base 2. * Use the function to compute ''and display'' the first ten members of the sequence. (The first member of the sequence is for ''n''=0). * As a stretch goal/extra credit, compute and show members of the sequence for bases other than 2. -''See also'' + + +;See also: * [http://www.puc-rio.br/marco.ind/quasi_mc.html#low_discrep The Basic Low Discrepancy Sequences] * [[Non-decimal radices/Convert]] * [[wp:Van der Corput sequence|Van der Corput sequence]] +

    diff --git a/Task/Van-der-Corput-sequence/Elixir/van-der-corput-sequence.elixir b/Task/Van-der-Corput-sequence/Elixir/van-der-corput-sequence.elixir index 6c0585e88c..56399bd19d 100644 --- a/Task/Van-der-Corput-sequence/Elixir/van-der-corput-sequence.elixir +++ b/Task/Van-der-Corput-sequence/Elixir/van-der-corput-sequence.elixir @@ -1,19 +1,34 @@ defmodule Van_der_corput do - def sequence( n ), do: sequence( n, 2 ) - - def sequence( 0, _base ), do: 0.0 - def sequence( n, base ) do - List.to_float( '0.' ++ ( for x <- sequence_loop(n, base), do: Integer.to_char_list(x) ) |> List.flatten ) + def sequence( n, base \\ 2 ) do + "0." <> (Integer.to_string(n, base) |> String.reverse ) end - def sequence_loop( 0, _base ), do: [] - def sequence_loop( n, base ) do - new_n = div(n, base) - digit = rem(n, base) - [digit | sequence_loop( new_n, base )] + def float( n, base \\ 2 ) do + Integer.digits(n, base) |> Enum.reduce(0, fn i,acc -> (i + acc) / base end) end + + def fraction( n, base \\ 2 ) do + str = Integer.to_string(n, base) |> String.reverse + denominator = Enum.reduce(1..String.length(str), 1, fn _,acc -> acc*base end) + reduction( String.to_integer(str, base), denominator ) + end + + defp reduction( 0, _ ), do: "0" + defp reduction( numerator, denominator ) do + gcd = gcd( numerator, denominator ) + "#{ div(numerator, gcd) }/#{ div(denominator, gcd) }" + end + + defp gcd( a, 0 ), do: a + defp gcd( a, b ), do: gcd( b, rem(a, b) ) end -Enum.each(2..5, fn base -> - IO.puts "Base #{base}: #{inspect Enum.map(0..9, fn x -> Van_der_corput.sequence(x, base) end)}" +funs = [ {"Float(Base):", &Van_der_corput.sequence/2}, + {"Float(Decimal):", &Van_der_corput.float/2 }, + {"Fraction:", &Van_der_corput.fraction/2} ] +Enum.each(funs, fn {title, fun} -> + IO.puts title + Enum.each(2..5, fn base -> + IO.puts " Base #{ base }: #{ Enum.map_join(0..9, ", ", &fun.(&1, base)) }" + end) end) diff --git a/Task/Van-der-Corput-sequence/Perl-6/van-der-corput-sequence-4.pl6 b/Task/Van-der-Corput-sequence/Perl-6/van-der-corput-sequence-4.pl6 index 169d45a9ed..8b39d21152 100644 --- a/Task/Van-der-Corput-sequence/Perl-6/van-der-corput-sequence-4.pl6 +++ b/Task/Van-der-Corput-sequence/Perl-6/van-der-corput-sequence-4.pl6 @@ -1,7 +1,7 @@ sub vdc($value, $base = 2) { - my @values := $value, { $_ div $base } ... 0; - my @denoms := $base, { $_ * $base } ... *; - [+] do for @values Z @denoms -> $v, $d { + my @values = $value, { $_ div $base } ... 0; + my @denoms = $base, { $_ * $base } ... *; + [+] do for (flat @values Z @denoms) -> $v, $d { $v mod $base / $d; } } diff --git a/Task/Van-der-Corput-sequence/REXX/van-der-corput-sequence-1.rexx b/Task/Van-der-Corput-sequence/REXX/van-der-corput-sequence-1.rexx index e47b243714..ac3d927a47 100644 --- a/Task/Van-der-Corput-sequence/REXX/van-der-corput-sequence-1.rexx +++ b/Task/Van-der-Corput-sequence/REXX/van-der-corput-sequence-1.rexx @@ -1,16 +1,16 @@ -/*REXX pgm converts an integer (or a range)──►van der Corput # in base 2*/ -numeric digits 1000 /*handle anything the user wants.*/ -parse arg a b . /*obtain the number(s) [maybe]. */ -if a=='' then do; a=0; b=10; end /*if none specified, use defaults*/ -if b=='' then b=a /*assume a "range" of a single #.*/ +/*REXX program converts an integer (or a range) ──► a Van der Corput number in base 2.*/ +numeric digits 1000 /*handle almost anything the user wants*/ +parse arg a b . /*obtain the optional arguments from CL*/ +if a=='' then parse value 0 10 with a b /*Not specified? Then use the defaults*/ +if b=='' then b=a /*assume a range for a single number.*/ - do j=a to b /*traipse through the range. */ - _=vdC(abs(j)) /*convert ABS value of integer.*/ - leading=substr('-',2+sign(j)) /*if needed, elide leading sign.*/ - say leading || _ /*show number (with leading - ?)*/ + do j=a to b /*traipse through the range of numbers.*/ + _=VdC( abs(j) ) /*convert absolute value of an integer.*/ + leading=substr('-', 2 + sign(j) ) /*if needed, elide the leading sign. */ + say leading || _ /*show number, with leading minus sign?*/ end /*j*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────VDC [van der Corput] subroutine─────*/ -vdC: procedure; y=x2b(d2x(arg(1)))+0 /*convert to hex, then binary. */ -if y==0 then return 0 /*handle special case of zero. */ - else return '.'reverse(y) /*heavy lifting by REXX*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +VdC: procedure; y=x2b( d2x( arg(1) ) ) + 0 /*convert to hexadecimal, then binary.*/ + if y==0 then return 0 /*handle the special case of zero. */ + else return '.'reverse(y) /*heavy lifting is performed by REXX. */ diff --git a/Task/Van-der-Corput-sequence/REXX/van-der-corput-sequence-2.rexx b/Task/Van-der-Corput-sequence/REXX/van-der-corput-sequence-2.rexx index d50bd38f90..47e31ce713 100644 --- a/Task/Van-der-Corput-sequence/REXX/van-der-corput-sequence-2.rexx +++ b/Task/Van-der-Corput-sequence/REXX/van-der-corput-sequence-2.rexx @@ -1,56 +1,52 @@ -/*REXX pgm converts an integer (or a range) ──► van der Corput number */ -/*in base 2, or optionally, any other base up to and including base 90.*/ -numeric digits 1000 /*handle anything the user wants.*/ -parse arg a b r . /*obtain the number(s) [maybe]. */ -if a=='' then do; a=0; b=10; end /*if none specified, use defaults*/ -if b=='' then b=a /*assume a "range" of a single #.*/ -if r=='' then r=2 /*assume a radix (base) of 2. */ -z= /*placeholder for a list of nums.*/ - - do j=a to b /*traipse through the range. */ - _=vdC(abs(j), abs(r)) /*convert ABS value of integer.*/ - _=substr('-', 2+sign(j))_ /*if needed, keep leading - sign.*/ - if r>0 then say _ /*if positive base, just show it.*/ - else z=z _ /* ··· else build a list· */ +/*REXX program converts an integer (or a range) ──► a Van der Corput number, */ +/*─────────────── in base 2, or optionally, any other base up to and including base 90.*/ +numeric digits 1000 /*handle almost anything the user wants*/ +parse arg a b r . /*obtain optional arguments from the CL*/ +if a=='' | a=="," then parse value 0 10 with a b /*Not specified? Then use the defaults*/ +if b=='' | b=="," then b=a /* " " " " " " */ +if r=='' | r=="," then r=2 /* " " " " " " */ +z= /*a placeholder for a list of numbers. */ + do j=a to b /*traipse through the range of integers*/ + _=VdC( abs(j), abs(r) ) /*convert the ABSolute value of integer*/ + _=substr('-', 2+sign(j) )_ /*if needed, keep the leading - sign.*/ + if r>0 then say _ /*if positive base, then just show it. */ + else z=z _ /* ··· else append (build) a list. */ end /*j*/ -if z\=='' then say strip(z) /*if list wanted, then show it. */ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────BASE subroutine (up to base 90)─────*/ -base: procedure; parse arg x,toB,inB /*get a number, toBase, inBase */ -/*┌────────────────────────────────────────────────────────────────────┐ -┌─┘ Input to this subroutine (all must be positive whole numbers): └─┐ -│ │ -│ x (is required). │ -│ toBase the base to convert X to. │ -│ inBase the base X is expressed in. │ -│ │ -│ toBase or inBase can be omitted which causes the default of │ -└─┐ 10 to be used. The limits of both are: 2 ──► 90. ┌─┘ - └────────────────────────────────────────────────────────────────────┘*/ -@abc='abcdefghijklmnopqrstuvwxyz' /*Latin lowercase alphabet chars.*/ -@abcU=@abc; upper @abcU /*go whole hog and extend chars. */ -@@@=0123456789 || @abc || @abcU /*prefix 'em with numeric digits.*/ -@@@=@@@'<>[]{}()?~!@#$%^&*_+-=|\/;:~' /*add some special chars as well,*/ - /*spec. chars should be viewable.*/ -numeric digits 1000 /*what the hey, support biggies. */ -maxB=length(@@@) /*max base (radix) supported here*/ -parse arg x,toB,inB /*get a number, toBase, inBase */ -if toB=='' then toB=10 /*if skipped, assume default (10)*/ -if inB=='' then inB=10 /* " " " " " */ -/*══════════════════════════════════convert X from base inB ──► base 10.*/ -#=0; do j=1 for length(x) - _=substr(x,j,1) /*pick off a "digit" from X. */ - v=pos(_,@@@) /*get the value of this "digits".*/ - if v==0 | v>inB then call erd x,j,inB /*illegal "digit" ? */ - #=#*inB + v - 1 /*construct new num, dig by dig. */ - end /*j*/ -/*══════════════════════════════════convert # from base 10 ──► base toB.*/ -y=; do while #>=toB /*deconstruct the new number (#).*/ - y=substr(@@@,(#//toB)+1,1)y /* construct the output number. */ - #=# % toB /*··· and whittle # down also. */ - end /*while*/ +if z\=='' then say strip(z) /*if a list is wanted, then display it.*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +base: procedure; parse arg x, toB, inB /*get a number, toBase, and inBase. */ + /*┌───────────────────────────────────────────────────────────────────┐ + ┌─┘ Input to this function: x (is required & must be an integer).└─┐ + │ toBase the base to convert X to. │ + │ inBase the base X is expressed in. │ + │ │ + │ toBase or inBase can be omitted which causes the default of 10 │ + └─┐ to be used. Both have a limit of: 2 ──► 90.┌─┘ + └───────────────────────────────────────────────────────────────────┘*/ + @abc= 'abcdefghijklmnopqrstuvwxyz' /*the Latin lowercase alphabet chars. */ + @abcU=@abc; upper @abcU /*go whole hog and extend characters. */ + @@@= 0123456789 || @abc || @abcU /*prefix them with some numeric digits.*/ + @@@= @@@'<>[]{}()?~!@#$%^&*_+-=|\/;:`' /*add some special characters as well, */ + /*special characters should be viewable*/ + numeric digits 1000 /*what the hey, support biggy numbers.*/ + maxB=length(@@@) /*maximum base (radix) supported here. */ + if toB=='' then toB=10 /*if skipped, then assume default (10)*/ + if inB=='' then inB=10 /* " " " " " " */ + #=0 /* [↓] convert base inB X ──► base 10*/ + do j=1 for length(x) + _=substr(x, j, 1) /*pick off a "digit" (numeral) from X.*/ + v=pos(_, @@@) /*get the value of this "digit"/numeral*/ + if v==0|v>inB then call erd x,j,inB /*is it an illegal "digit" (numeral) ? */ + #=#*inB + v - 1 /*construct new number, digit by digit.*/ + end /*j*/ + y= /* [↓] convert base 10 # ──► base toB.*/ + do while #>=toB /*deconstruct the new number (#). */ + y=substr(@@@, #//toB + 1, 1)y /* construct the output number, ··· */ + #=# % toB /* ··· and also whittle down #. */ + end /*while*/ -return substr(@@@,#+1,1)y -/*──────────────────────────────────VDC [van der Corput] subroutine─────*/ -vdC: return '.'reverse(base(arg(1),arg(2))) /*convert, reverse, append.*/ + return substr(@@@, #+1, 1)y +/*──────────────────────────────────────────────────────────────────────────────────────*/ +VdC: return '.'reverse(base(arg(1), arg(2))) /*convert the #, reverse the #, append.*/ diff --git a/Task/Variable-length-quantity/TXR/variable-length-quantity.txr b/Task/Variable-length-quantity/TXR/variable-length-quantity.txr index ee98bf537f..44ed910759 100644 --- a/Task/Variable-length-quantity/TXR/variable-length-quantity.txr +++ b/Task/Variable-length-quantity/TXR/variable-length-quantity.txr @@ -1,22 +1,20 @@ -@(do - ;; show the utf8 bytes from byte stream as hex - (defun put-utf8 (str : stream) - (set stream (or stream *stdout*)) - (for ((s (make-string-byte-input-stream str)) byte) - ((set byte (get-byte s))) - ((format stream "\\x~,02x" byte)))) +;; show the utf8 bytes from byte stream as hex +(defun put-utf8 (str : stream) + (set stream (or stream *stdout*)) + (for ((s (make-string-byte-input-stream str)) byte) + ((set byte (get-byte s))) + ((format stream "\\x~,02x" byte)))) - ;; print - (put-utf8 (tostring 0)) - (put-line "") - (put-utf8 (tostring 42)) - (put-line "") - (put-utf8 (tostring #x200000)) - (put-line "") - (put-utf8 (tostring #x1fffff)) - (put-line "") +;; print +(put-utf8 (tostring 0)) +(put-line "") +(put-utf8 (tostring 42)) +(put-line "") +(put-utf8 (tostring #x200000)) +(put-line "") +(put-utf8 (tostring #x1fffff)) +(put-line "") - ;; print to string and recover - - (format t "~a\n" (read (tostring #x200000))) - (format t "~a\n" (read (tostring #x1f0000)))) +;; print to string and recover +(format t "~a\n" (read (tostring #x200000))) +(format t "~a\n" (read (tostring #x1f0000))) diff --git a/Task/Variable-size-Get/00DESCRIPTION b/Task/Variable-size-Get/00DESCRIPTION index 6215b56361..0888f912c1 100644 --- a/Task/Variable-size-Get/00DESCRIPTION +++ b/Task/Variable-size-Get/00DESCRIPTION @@ -1,6 +1,7 @@ {{omit from|AWK}} {{omit from|Clojure}} -{{omit from|E}} +{{omit from|E}}ruby + {{omit from|gnuplot}} {{omit from|Groovy}} {{omit from|GUISS|Does not have variables.}} diff --git a/Task/Variable-size-Get/COBOL/variable-size-get.cobol b/Task/Variable-size-Get/COBOL/variable-size-get.cobol new file mode 100644 index 0000000000..ca8c9b1d2a --- /dev/null +++ b/Task/Variable-size-Get/COBOL/variable-size-get.cobol @@ -0,0 +1,61 @@ + identification division. + program-id. variable-size-get. + + environment division. + configuration section. + repository. + function all intrinsic. + + data division. + working-storage section. + 01 bc-len constant as length of binary-char. + 01 fd-34-len constant as length of float-decimal-34. + + 77 fixed-character pic x(13). + 77 fixed-national pic n(13). + 77 fixed-nine pic s9(5). + 77 fixed-separate pic s9(5) sign trailing separate. + 77 computable-field pic s9(5) usage computational-5. + 77 formatted-field pic +z(4),9. + + 77 binary-field usage binary-double. + 01 pointer-item usage pointer. + + 01 group-item. + 05 first-inner pic x occurs 0 to 3 times depending on odo. + 05 second-inner pic x occurs 0 to 5 times depending on odo-2. + 01 odo usage index value 2. + 01 odo-2 usage index value 4. + + procedure division. + sample-main. + display "Size of:" + display "BINARY-CHAR : " bc-len + display " bc-len constant : " byte-length(bc-len) + display "FLOAT-DECIMAL-34 : " fd-34-len + display " fd-34-len constant : " byte-length(fd-34-len) + + display "PIC X(13) field : " length of fixed-character + display "PIC N(13) field : " length of fixed-national + + display "PIC S9(5) field : " length of fixed-nine + display "PIC S9(5) sign separate : " length of fixed-separate + display "PIC S9(5) COMP-5 : " length of computable-field + + display "ALPHANUMERIC-EDITED : " length(formatted-field) + + display "BINARY-DOUBLE field : " byte-length(binary-field) + display "POINTER field : " length(pointer-item) + >>IF P64 IS SET + display " sizeof(char *) > 4" + >>ELSE + display " sizeof(char *) = 4" + >>END-IF + + display "Complex ODO at 2 and 4 : " length of group-item + set odo down by 1. + set odo-2 up by 1. + display "Complex ODO at 1 and 5 : " length(group-item) + + goback. + end program variable-size-get. diff --git a/Task/Variable-size-Get/Elixir/variable-size-get.elixir b/Task/Variable-size-Get/Elixir/variable-size-get.elixir new file mode 100644 index 0000000000..e7abb84d8f --- /dev/null +++ b/Task/Variable-size-Get/Elixir/variable-size-get.elixir @@ -0,0 +1,22 @@ +list = [1,2,3] +IO.puts length(list) #=> 3 + +tuple = {1,2,3,4} +IO.puts tuple_size(tuple) #=> 4 + +string = "Elixir" +IO.puts String.length(string) #=> 6 +IO.puts byte_size(string) #=> 6 +IO.puts bit_size(string) #=> 48 + +utf8 = "○×△" +IO.puts String.length(utf8) #=> 3 +IO.puts byte_size(utf8) #=> 8 +IO.puts bit_size(utf8) #=> 64 + +bitstring = <<3 :: 2>> +IO.puts byte_size(bitstring) #=> 1 +IO.puts bit_size(bitstring) #=> 2 + +map = Map.new([{:b, 1}, {:a, 2}]) +IO.puts map_size(map) #=> 2 diff --git a/Task/Variable-size-Set/00DESCRIPTION b/Task/Variable-size-Set/00DESCRIPTION index f293e894c6..2c86bce72b 100644 --- a/Task/Variable-size-Set/00DESCRIPTION +++ b/Task/Variable-size-Set/00DESCRIPTION @@ -1 +1,3 @@ +;Task: Demonstrate how to specify the minimum size of a variable or a data type. +

    diff --git a/Task/Variable-size-Set/Haskell/variable-size-set.hs b/Task/Variable-size-Set/Haskell/variable-size-set.hs new file mode 100644 index 0000000000..4fd686ef8b --- /dev/null +++ b/Task/Variable-size-Set/Haskell/variable-size-set.hs @@ -0,0 +1,16 @@ +import Data.Int +import Foreign.Storable + +task name value = putStrLn $ name ++ ": " ++ show (sizeOf value) ++ " byte(s)" + +main = do + let i8 = 0::Int8 + let i16 = 0::Int16 + let i32 = 0::Int32 + let i64 = 0::Int64 + let int = 0::Int + task "Int8" i8 + task "Int16" i16 + task "Int32" i32 + task "Int64" i64 + task "Int" int diff --git a/Task/Variable-size-Set/PureBasic/variable-size-set.purebasic b/Task/Variable-size-Set/PureBasic/variable-size-set.purebasic new file mode 100644 index 0000000000..1e8b685500 --- /dev/null +++ b/Task/Variable-size-Set/PureBasic/variable-size-set.purebasic @@ -0,0 +1,40 @@ +EnableExplicit + +Structure AllTypes + b.b + a.a + w.w + u.u + c.c ; character type : 1 byte on x86, 2 bytes on x64 + l.l + i.i ; integer type : 4 bytes on x86, 8 bytes on x64 + q.q + f.f + d.d + s.s ; pointer to string on heap : pointer size same as integer + z.s{2} ; fixed length string of 2 characters, stored inline +EndStructure + +If OpenConsole() + Define at.AllTypes + PrintN("Size of types in bytes (x64)") + PrintN("") + PrintN("byte = " + SizeOf(at\b)) + PrintN("ascii = " + SizeOf(at\a)) + PrintN("word = " + SizeOf(at\w)) + PrintN("unicode = " + SizeOf(at\u)) + PrintN("character = " + SizeOf(at\c)) + PrintN("long = " + SizeOf(at\l)) + PrintN("integer = " + SizeOf(at\i)) + PrintN("quod = " + SizeOf(at\q)) + PrintN("float = " + SizeOf(at\f)) + PrintN("double = " + SizeOf(at\d)) + PrintN("string = " + SizeOf(at\s)) + PrintN("string{2} = " + SizeOf(at\z)) + PrintN("---------------") + PrintN("AllTypes = " + SizeOf(at)) + PrintN("") + PrintN("Press any key to close the console") + Repeat: Delay(10) : Until Inkey() <> "" + CloseConsole() +EndIf diff --git a/Task/Variables/00DESCRIPTION b/Task/Variables/00DESCRIPTION index 366cec74bc..15b2752085 100644 --- a/Task/Variables/00DESCRIPTION +++ b/Task/Variables/00DESCRIPTION @@ -1 +1,10 @@ -Demonstrate the language's methods of variable declaration, initialization, assignment, datatypes, scope, referencing, and other variable related facilities. +;Task: +Demonstrate a language's methods of: +:::*   variable declaration +:::*   initialization +:::*   assignment +:::*   datatypes +:::*   scope +:::*   referencing,     and +:::*   other variable related facilities +

    diff --git a/Task/Variables/360-Assembly/variables-1.360 b/Task/Variables/360-Assembly/variables-1.360 new file mode 100644 index 0000000000..6920b8e9b6 --- /dev/null +++ b/Task/Variables/360-Assembly/variables-1.360 @@ -0,0 +1,6 @@ +* value of F + L 2,F assigment r2=f +* reference (or address) of F + LA 3,F reference r3=@f +* referencing (or indexing) of reg3 (r3->f) + L 4,0(3) referencing r4=%r3=%@f=f diff --git a/Task/Variables/360-Assembly/variables-2.360 b/Task/Variables/360-Assembly/variables-2.360 new file mode 100644 index 0000000000..2912f11540 --- /dev/null +++ b/Task/Variables/360-Assembly/variables-2.360 @@ -0,0 +1,24 @@ +* declarations length +C DS C character 1 +X DS X character hexa 1 +B DS B character bin 1 +H DS H half word 2 +F DS F full word 4 +E DS F single float 4 +D DS D double float 8 +L DS L extended float 16 +S DS CL12 string 12 +P DS PL16 packed decimal 16 +Z DS ZL32 zoned decimal 32 +* declarations + initialization +CI DC C'7' character 1 +XI DC X'F7' character hexa 1 +BI DC B'11110111' character bin 1 +HI DC H'7' half word 2 +FI DC F'7' full word 4 +EI DC F'7.8E3' single float 4 +DI DC D'7.8E3' double float 8 +LI DC L'7.8E3' extended float 16 +SI DC CL12'789' string 12 +PI DC PL16'7' packed decimal 16 +ZI DC ZL32'7' zoned decimal 32 diff --git a/Task/Variables/Ada/variables.ada b/Task/Variables/Ada/variables.ada index caaf892e70..a83520430a 100644 --- a/Task/Variables/Ada/variables.ada +++ b/Task/Variables/Ada/variables.ada @@ -1,7 +1,19 @@ -declare +Name: declare -- a local declaration block has an optional name + A : constant Integer := 42; -- Create a constant X : String := "Hello"; -- Create and initialize a local variable - Y : Integer; -- Create an uninitialized variable + Y : Integer; -- Create an uninitialized variable Z : Integer renames Y: -- Rename Y (creates a view) + function F (X: Integer) return Integer is + -- Inside, all declarations outside are visible when not hidden: X, Y, Z are global with respect to F. + X: Integer := Z; -- hides the outer X which however can be refered to by Name.X + begin + ... + end F; -- locally declared variables stop to exist here begin Y := 1; -- Assign variable -end; -- End of the scope + declare + X: Float := -42.0E-10; -- hides the outer X (can be referred to Name.X like in F) + begin + ... + end; +end Name; -- End of the scope diff --git a/Task/Variables/Elena/variables.elena b/Task/Variables/Elena/variables.elena new file mode 100644 index 0000000000..59ebd9bed2 --- /dev/null +++ b/Task/Variables/Elena/variables.elena @@ -0,0 +1,8 @@ +#symbol program = +[ + #var c. // declaring variable. default value is $nil + #var a := 3. // declaring and initializing variables + #var b := "my string" length. + + c := b + a. // assigning variable +]. diff --git a/Task/Variables/Forth/variables-4.fth b/Task/Variables/Forth/variables-4.fth new file mode 100644 index 0000000000..cfc51ccd13 --- /dev/null +++ b/Task/Variables/Forth/variables-4.fth @@ -0,0 +1,3 @@ +VARIABLE X 999 X ! \ create variable x, store 999 in X +VARIABLE Y -999 Y ! \ create variable y, store -999 in Y +2VARIABLE W 140569874. W 2! \ create and assign a double precision variable diff --git a/Task/Variables/MATLAB/variables-1.m b/Task/Variables/MATLAB/variables-1.m index 43269922f0..38e876c001 100644 --- a/Task/Variables/MATLAB/variables-1.m +++ b/Task/Variables/MATLAB/variables-1.m @@ -8,8 +8,8 @@ u32 = uint32(5);% unsigned 4 byte integers i64 = int64(5); % signed 8 byte integer u64 = uint64(5);% unsigned 8 byte integer - f32 = float32(5); % single precission floating point number - f64 = float64(5); % double precission floating point number , float 64 is the default data type. + f32 = float32(5); % single precision floating point number + f64 = float64(5); % double precision floating point number , float 64 is the default data type. c = 4+5i; % complex number colvec = [1;2;4]; % column vector diff --git a/Task/Variables/Maple/variables-1.maple b/Task/Variables/Maple/variables-1.maple new file mode 100644 index 0000000000..5c03136684 --- /dev/null +++ b/Task/Variables/Maple/variables-1.maple @@ -0,0 +1,3 @@ +a := 1: +print ("a is "||a); + "a is 1" diff --git a/Task/Variables/Maple/variables-2.maple b/Task/Variables/Maple/variables-2.maple new file mode 100644 index 0000000000..67c01e0994 --- /dev/null +++ b/Task/Variables/Maple/variables-2.maple @@ -0,0 +1,10 @@ +b; +f := proc() + local b := 3; + print("b is "||b); +end proc: +f(); +print("b is "||b); + b + "b is 3" + "b is b" diff --git a/Task/Variables/Maple/variables-3.maple b/Task/Variables/Maple/variables-3.maple new file mode 100644 index 0000000000..845cd9dad2 --- /dev/null +++ b/Task/Variables/Maple/variables-3.maple @@ -0,0 +1,11 @@ +f := proc() + global c; + c := 3; + print("a is "||a); + print("c is "||c); +end proc: +f(); +print("c is "||c); + "a is 1" + "c is 3" + "c is 3" diff --git a/Task/Variables/Maple/variables-4.maple b/Task/Variables/Maple/variables-4.maple new file mode 100644 index 0000000000..8d0b01e8c6 --- /dev/null +++ b/Task/Variables/Maple/variables-4.maple @@ -0,0 +1,5 @@ +print ("a is "||a); +a := 4: +print ("a is "||a); + "a is 1" + "a is 4" diff --git a/Task/Variables/Maple/variables-5.maple b/Task/Variables/Maple/variables-5.maple new file mode 100644 index 0000000000..43ba9f80c2 --- /dev/null +++ b/Task/Variables/Maple/variables-5.maple @@ -0,0 +1,11 @@ +print ("a is "||a); +type(a, integer); +a := "Hello World": +print ("a is "||a); +type(a, integer); +type(a, string); + "a is 4" + true + "a is Hello World" + false + true diff --git a/Task/Variables/Maple/variables-6.maple b/Task/Variables/Maple/variables-6.maple new file mode 100644 index 0000000000..86f538ae74 --- /dev/null +++ b/Task/Variables/Maple/variables-6.maple @@ -0,0 +1,3 @@ +`This is a variable` := 1: +print(`This is a variable`); + 1 diff --git a/Task/Variables/Maple/variables-7.maple b/Task/Variables/Maple/variables-7.maple new file mode 100644 index 0000000000..eb184003f0 --- /dev/null +++ b/Task/Variables/Maple/variables-7.maple @@ -0,0 +1,14 @@ +print ("a is "||a); +type(a, string); +print("c is "||c); +a := 'a': +print ("a is "||a); +type(a, symbol); +unassign('c'); +print("c is "||c); + "a is Hello World" + true + "c is 3" + "a is a" + true + "c is c" diff --git a/Task/Variables/Prolog/variables-1.pro b/Task/Variables/Prolog/variables-1.pro new file mode 100644 index 0000000000..97fcb3b0eb --- /dev/null +++ b/Task/Variables/Prolog/variables-1.pro @@ -0,0 +1,2 @@ +mortal(X) :- man(X). +man(socrates). diff --git a/Task/Variables/Prolog/variables-2.pro b/Task/Variables/Prolog/variables-2.pro new file mode 100644 index 0000000000..8852a76944 --- /dev/null +++ b/Task/Variables/Prolog/variables-2.pro @@ -0,0 +1,2 @@ +student(X,Y) :- taught(Y,X). +taught(socrates,plato). diff --git a/Task/Variables/Prolog/variables-3.pro b/Task/Variables/Prolog/variables-3.pro new file mode 100644 index 0000000000..bbf2089893 --- /dev/null +++ b/Task/Variables/Prolog/variables-3.pro @@ -0,0 +1,6 @@ +?- mortal(socrates). +yes +?- student(X,socrates). +X=plato +?- student(socrates,X). +no diff --git a/Task/Variables/Prolog/variables-4.pro b/Task/Variables/Prolog/variables-4.pro new file mode 100644 index 0000000000..99c02cd28a --- /dev/null +++ b/Task/Variables/Prolog/variables-4.pro @@ -0,0 +1,2 @@ +?- mortal(zeus). +no diff --git a/Task/Variables/Prolog/variables-5.pro b/Task/Variables/Prolog/variables-5.pro new file mode 100644 index 0000000000..d8abc3191a --- /dev/null +++ b/Task/Variables/Prolog/variables-5.pro @@ -0,0 +1 @@ +mortal(X) :- man(Y). diff --git a/Task/Variadic-function/00DESCRIPTION b/Task/Variadic-function/00DESCRIPTION index 6b00216cf5..a0883648ae 100644 --- a/Task/Variadic-function/00DESCRIPTION +++ b/Task/Variadic-function/00DESCRIPTION @@ -1,4 +1,12 @@ -Create a function which takes in a variable number of arguments and prints each one on its own line. Also show, if possible in your language, how to call the function on a list of arguments constructed at runtime. -Functions of this type are also known as [[wp:Variadic_function|Variadic Functions]]. +;Task: +Create a function which takes in a variable number of arguments and prints each one on its own line. -Related: [[Call a function]] +Also show, if possible in your language, how to call the function on a list of arguments constructed at runtime. + + +Functions of this type are also known as   [[wp:Variadic_function|Variadic Functions]]. + + +;Related task: +*   [[Call a function]] +

    diff --git a/Task/Variadic-function/00META.yaml b/Task/Variadic-function/00META.yaml index 659c8686af..e316a9ad81 100644 --- a/Task/Variadic-function/00META.yaml +++ b/Task/Variadic-function/00META.yaml @@ -1,2 +1,4 @@ --- +category: +- Functions and subroutines note: Basic language learning diff --git a/Task/Variadic-function/AppleScript/variadic-function.applescript b/Task/Variadic-function/AppleScript/variadic-function.applescript new file mode 100644 index 0000000000..c9f37f6b4e --- /dev/null +++ b/Task/Variadic-function/AppleScript/variadic-function.applescript @@ -0,0 +1,95 @@ +use framework "Foundation" + +-- positionalArgs :: [a] -> String +on positionalArgs(xs) + + -- follow each argument with a line feed + map(my putStrLn, xs) as string +end positionalArgs + +-- namedArgs :: Record -> String +on namedArgs(rec) + script showKVpair + on lambda(k) + my putStrLn(k & " -> " & keyValue(rec, k)) + end lambda + end script + + -- follow each argument name and value with line feed + map(showKVpair, allKeys(rec)) as string +end namedArgs + +-- TEST +on run + intercalate(linefeed, ¬ + {positionalArgs(["alpha", "beta", "gamma", "delta"]), ¬ + namedArgs({epsilon:27, zeta:48, eta:81, theta:8, iota:1})}) + + --> "alpha + -- beta + -- gamma + -- delta + -- + -- epsilon -> 27 + -- eta -> 81 + -- iota -> 1 + -- zeta -> 48 + -- theta -> 8 + -- " +end run + + +-- GENERIC FUNCTIONS + +-- putStrLn :: a -> String +on putStrLn(a) + (a as string) & linefeed +end putStrLn + +-- 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 + +-- intercalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate + +-- allKeys :: Record -> [String] +on allKeys(rec) + (current application's NSDictionary's dictionaryWithDictionary:rec)'s allKeys() as list +end allKeys + +-- keyValue :: Record -> String -> Maybe String +on keyValue(rec, strKey) + set ca to current application + set v to (ca's NSDictionary's dictionaryWithDictionary:rec)'s objectForKey:strKey + if v is not missing value then + item 1 of ((ca's NSArray's arrayWithObject:v) as list) + else + missing value + end if +end keyValue + +-- 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 diff --git a/Task/Variadic-function/BASIC/variadic-function-2.basic b/Task/Variadic-function/BASIC/variadic-function-2.basic index 394499d08a..8bdaebbcec 100644 --- a/Task/Variadic-function/BASIC/variadic-function-2.basic +++ b/Task/Variadic-function/BASIC/variadic-function-2.basic @@ -33,7 +33,7 @@ printAll_string (4, a, b, c) Print ' empty keyboard buffer -While InKey <> "" : Var _key_ = InKey : Wend +While InKey <> "" : Wend Print : Print "hit any key to end program" Sleep End diff --git a/Task/Variadic-function/BASIC/variadic-function-3.basic b/Task/Variadic-function/BASIC/variadic-function-3.basic new file mode 100644 index 0000000000..b954530ae6 --- /dev/null +++ b/Task/Variadic-function/BASIC/variadic-function-3.basic @@ -0,0 +1,13 @@ +100 DEF PROC printAll DATA +110 DO UNTIL ITEM()=0 +120 IF ITEM()=1 THEN + READ a$ + PRINT a$ +130 ELSE + READ num + PRINT num +140 LOOP +150 END PROC + +200 printAll 3.1415, 1.4142, 2.71828 +210 printAll "Mary", "had", "a", "little", "lamb", diff --git a/Task/Variadic-function/COBOL/variadic-function.cobol b/Task/Variadic-function/COBOL/variadic-function.cobol new file mode 100644 index 0000000000..e09996d38e --- /dev/null +++ b/Task/Variadic-function/COBOL/variadic-function.cobol @@ -0,0 +1,58 @@ + program-id. dsp-str is external. + data division. + linkage section. + 1 cnt comp-5 pic 9(4). + 1 str pic x. + procedure division using by value cnt + by reference str delimited repeated 1 to 5. + end program dsp-str. + + program-id. variadic. + procedure division. + call "dsp-str" using 4 "The" "quick" "brown" "fox" + stop run + . + end program variadic. + + program-id. dsp-str. + data division. + working-storage section. + 1 i comp-5 pic 9(4). + 1 len comp-5 pic 9(4). + 1 wk-string pic x(20). + linkage section. + 1 cnt comp-5 pic 9(4). + 1 str1 pic x(20). + 1 str2 pic x(20). + 1 str3 pic x(20). + 1 str4 pic x(20). + 1 str5 pic x(20). + procedure division using cnt str1 str2 str3 str4 str5. + if cnt < 1 or > 5 + display "Invalid number of parameters" + stop run + end-if + perform varying i from 1 by 1 + until i > cnt + evaluate i + when 1 + unstring str1 delimited low-value + into wk-string count in len + when 2 + unstring str2 delimited low-value + into wk-string count in len + when 3 + unstring str3 delimited low-value + into wk-string count in len + when 4 + unstring str4 delimited low-value + into wk-string count in len + when 5 + unstring str5 delimited low-value + into wk-string count in len + end-evaluate + display wk-string (1:len) + end-perform + exit program + . + end program dsp-str. diff --git a/Task/Variadic-function/PHP/variadic-function-1.php b/Task/Variadic-function/PHP/variadic-function-1.php index 9eaa03f447..65d87ad39f 100644 --- a/Task/Variadic-function/PHP/variadic-function-1.php +++ b/Task/Variadic-function/PHP/variadic-function-1.php @@ -1,3 +1,4 @@ + diff --git a/Task/Variadic-function/PHP/variadic-function-2.php b/Task/Variadic-function/PHP/variadic-function-2.php index 8834cfb8dc..ba5f55d24e 100644 --- a/Task/Variadic-function/PHP/variadic-function-2.php +++ b/Task/Variadic-function/PHP/variadic-function-2.php @@ -1,2 +1,4 @@ + diff --git a/Task/Variadic-function/PHP/variadic-function-3.php b/Task/Variadic-function/PHP/variadic-function-3.php new file mode 100644 index 0000000000..4f409d327a --- /dev/null +++ b/Task/Variadic-function/PHP/variadic-function-3.php @@ -0,0 +1,9 @@ + diff --git a/Task/Variadic-function/PHP/variadic-function-4.php b/Task/Variadic-function/PHP/variadic-function-4.php new file mode 100644 index 0000000000..21c3b18d3c --- /dev/null +++ b/Task/Variadic-function/PHP/variadic-function-4.php @@ -0,0 +1,4 @@ + diff --git a/Task/Vector-products/00DESCRIPTION b/Task/Vector-products/00DESCRIPTION index 50e60d617c..f1fd9689c2 100644 --- a/Task/Vector-products/00DESCRIPTION +++ b/Task/Vector-products/00DESCRIPTION @@ -1,30 +1,45 @@ -Define a vector having three dimensions as being represented by an ordered collection of three numbers: (X, Y, Z). If you imagine a graph with the x and y axis being at right angles to each other and having a third, z axis coming out of the page, then a triplet of numbers, (X, Y, Z) would represent a point in the region, and a vector from the origin to the point. +A vector is defined as having three dimensions as being represented by an ordered collection of three numbers:   (X, Y, Z). -Given vectors A = (a1, a2, a3); B = (b1, b2, b3); and C = (c1, c2, c3); then the following common vector products are defined: -* '''The dot product''' -: A • B = a1b1 + a2b2 + a3b3; a scalar quantity -* '''The cross product''' -: A x B = (a2b3 - a3b2, a3b1 - a1b3, a1b2 - a2b1); a vector quantity -* '''The scalar triple product''' -: A • (B x C); a scalar quantity -* '''The vector triple product''' -: A x (B x C); a vector quantity +If you imagine a graph with the   '''x'''   and   '''y'''   axis being at right angles to each other and having a third,   '''z'''   axis coming out of the page, then a triplet of numbers,   (X, Y, Z)   would represent a point in the region,   and a vector from the origin to the point. -;Task description -Given the three vectors: a = (3, 4, 5); b = (4, 3, 5); c = (-5, -12, -13): +Given the vectors: + A = (a1, a2, a3) + B = (b1, b2, b3) + C = (c1, c2, c3) +then the following common vector products are defined: +* '''The dot product'''       (a scalar quantity) +:::: A • B = a1b1   +   a2b2   +   a3b3 +* '''The cross product'''       (a vector quantity) +:::: A x B = (a2b3  -   a3b2,     a3b1   -   a1b3,     a1b2   -   a2b1) +* '''The scalar triple product'''       (a scalar quantity) +:::: A • (B x C) +* '''The vector triple product'''       (a vector quantity) +:::: A x (B x C) + + +;Task: +Given the three vectors: + a = ( 3, 4, 5) + b = ( 4, 3, 5) + c = (-5, -12, -13) # Create a named function/subroutine/method to compute the dot product of two vectors. # Create a function to compute the cross product of two vectors. # Optionally create a function to compute the scalar triple product of three vectors. # Optionally create a function to compute the vector triple product of three vectors. # Compute and display: a • b # Compute and display: a x b -# Compute and display: a • b x c, the scaler triple product. +# Compute and display: a • b x c, the scalar triple product. # Compute and display: a x b x c, the vector triple product. -;References: -* [[Dot product]] here on RC. -* A starting page on Wolfram Mathworld is {{Wolfram|Vector|Mulitplication}}. -* Wikipedias [[wp:Dot product|dot product]], [[wp:Cross product|cross product]] and [[wp:Triple product|triple product]] entries. -;C.f. -* [[Quaternion type]] +;References: +*   A starting page on Wolfram MathWorld is   {{Wolfram|Vector|Multiplication}}. +*   Wikipedia   [[wp:Dot product|dot product]], +:   Wikipedia   [[wp:Cross product|cross product]] +:   Wikipedia   [[wp:Triple product|triple product]] entries. + + +;Related tasks: +*   [[Dot product]] +*   [[Quaternion type]] +

    diff --git a/Task/Vector-products/Elixir/vector-products.elixir b/Task/Vector-products/Elixir/vector-products.elixir new file mode 100644 index 0000000000..8f69dd0988 --- /dev/null +++ b/Task/Vector-products/Elixir/vector-products.elixir @@ -0,0 +1,21 @@ +defmodule Vector do + def dot_product({a1,a2,a3}, {b1,b2,b3}), do: a1*b1 + a2*b2 + a3*b3 + + def cross_product({a1,a2,a3}, {b1,b2,b3}), do: {a2*b3 - a3*b2, a3*b1 - a1*b3, a1*b2 - a2*b1} + + def scalar_triple_product(a, b, c), do: dot_product(a, cross_product(b, c)) + + def vector_triple_product(a, b, c), do: cross_product(a, cross_product(b, c)) +end + +a = {3, 4, 5} +b = {4, 3, 5} +c = {-5, -12, -13} + +IO.puts "a = #{inspect a}" +IO.puts "b = #{inspect b}" +IO.puts "c = #{inspect c}" +IO.puts "a . b = #{inspect Vector.dot_product(a, b)}" +IO.puts "a x b = #{inspect Vector.cross_product(a, b)}" +IO.puts "a . (b x c) = #{inspect Vector.scalar_triple_product(a, b, c)}" +IO.puts "a x (b x c) = #{inspect Vector.vector_triple_product(a, b, c)}" diff --git a/Task/Vector-products/Java/vector-products.java b/Task/Vector-products/Java/vector-products-1.java similarity index 100% rename from Task/Vector-products/Java/vector-products.java rename to Task/Vector-products/Java/vector-products-1.java diff --git a/Task/Vector-products/Java/vector-products-2.java b/Task/Vector-products/Java/vector-products-2.java new file mode 100644 index 0000000000..ce4f94071c --- /dev/null +++ b/Task/Vector-products/Java/vector-products-2.java @@ -0,0 +1,62 @@ +import java.util.Arrays; +import java.util.stream.IntStream; + +public class VectorsOp { + // Vector dot product using Java SE 8 stream abilities + // the method first create an array of size values, + // and map the product of each vectors components in a new array (method map()) + // and transform the array to a scalr by summing all elements (method reduce) + // the method parallel is there for optimization + private static int dotProduct(int[] v1, int[] v2,int length) { + + int result = IntStream.range(0, length) + .parallel() + .map( id -> v1[id] * v2[id]) + .reduce(0, Integer::sum); + + return result; + } + + // Vector Cross product using Java SE 8 stream abilities + // here we map in a new array where each element is equal to the cross product + // With Stream is is easier to handle N dimensions vectors + private static int[] crossProduct(int[] v1, int[] v2,int length) { + + int result[] = new int[length] ; + //result[0] = v1[1] * v2[2] - v1[2]*v2[1] ; + //result[1] = v1[2] * v2[0] - v1[0]*v2[2] ; + // result[2] = v1[0] * v2[1] - v1[1]*v2[0] ; + + result = IntStream.range(0, length) + .parallel() + .map( i -> v1[(i+1)%length] * v2[(i+2)%length] - v1[(i+2)%length]*v2[(i+1)%length]) + .toArray(); + + return result; + } + + public static void main (String[] args) + { + int[] vect1 = {3, 4, 5}; + int[] vect2 = {4, 3, 5}; + int[] vect3 = {-5, -12, -13}; + + System.out.println("dot product =:" + dotProduct(vect1,vect2,3)); + + int[] prodvect = new int[3]; + prodvect = crossProduct(vect1,vect2,3); + System.out.println("cross product =:[" + prodvect[0] + "," + + prodvect[1] + "," + + prodvect[2] + "]"); + + prodvect = crossProduct(vect2,vect3,3); + System.out.println("scalar product =:" + dotProduct(vect1,prodvect,3)); + + prodvect = crossProduct(vect1,prodvect,3); + + System.out.println("triple product =:[" + prodvect[0] + "," + + prodvect[1] + "," + + prodvect[2] + "]"); + + } +} diff --git a/Task/Vector-products/Perl-6/vector-products.pl6 b/Task/Vector-products/Perl-6/vector-products.pl6 index e5f4898a71..d17942e4f2 100644 --- a/Task/Vector-products/Perl-6/vector-products.pl6 +++ b/Task/Vector-products/Perl-6/vector-products.pl6 @@ -13,7 +13,7 @@ my @a = <3 4 5>; my @b = <4 3 5>; my @c = <-5 -12 -13>; -say (:@a, :@b, :@c).perl; +say (:@a, :@b, :@c); say "a ⋅ b = { @a ⋅ @b }"; say "a ⨯ b = <{ @a ⨯ @b }>"; say "a ⋅ (b ⨯ c) = { scalar-triple-product(@a, @b, @c) }"; diff --git a/Task/Vector-products/R/vector-products.r b/Task/Vector-products/R/vector-products.r index 581fb55776..c6740a1df2 100644 --- a/Task/Vector-products/R/vector-products.r +++ b/Task/Vector-products/R/vector-products.r @@ -1,10 +1,57 @@ -a <- c( 3.0, 4.0, 5.0) -b <- c( 4.0, 3.0, 5.0) +#=============================================================== +# Vector products +# R implementation +#=============================================================== -cross <- function(a, b) - c(a[2]*b[3] - a[3]*b[2], - a[3]*b[1] - a[1]*b[3], - a[1]*b[2] - a[2]*b[1]) +a <- c(3, 4, 5) +b <- c(4, 3, 5) +c <- c(-5, -12, -13) -cross(a, b) -# [1] 5 5 -7 +#--------------------------------------------------------------- +# Dot product +#--------------------------------------------------------------- + +dotp <- function(x, y) { + if (length(x) == length(y)) { + sum(x*y) + } +} + +#--------------------------------------------------------------- +# Cross product +#--------------------------------------------------------------- + +crossp <- function(x, y) { + if (length(x) == 3 && length(y) == 3) { + c(x[2]*y[3] - x[3]*y[2], x[3]*y[1] - x[1]*y[3], x[1]*y[2] - x[2]*y[1]) + } +} + +#--------------------------------------------------------------- +# Scalar triple product +#--------------------------------------------------------------- + +scalartriplep <- function(x, y, z) { + if (length(x) == 3 && length(y) == 3 && length(z) == 3) { + dotp(x, crossp(y, z)) + } +} + +#--------------------------------------------------------------- +# Vector triple product +#--------------------------------------------------------------- + +vectortriplep <- function(x, y, z) { + if (length(x) == 3 && length(y) == 3 && length(z) == 3) { + crosssp(x, crossp(y, z)) + } +} + +#--------------------------------------------------------------- +# Compute and print +#--------------------------------------------------------------- + +cat("a . b =", dotp(a, b)) +cat("a x b =", crossp(a, b)) +cat("a . (b x c) =", scalartriplep(a, b, c)) +cat("a x (b x c) =", vectortriplep(a, b, c)) diff --git a/Task/Vector-products/REXX/vector-products.rexx b/Task/Vector-products/REXX/vector-products.rexx index 74dda1bb68..d35eb32d33 100644 --- a/Task/Vector-products/REXX/vector-products.rexx +++ b/Task/Vector-products/REXX/vector-products.rexx @@ -1,29 +1,24 @@ -/*REXX program computes the products: the dot product, */ -/* the cross product, */ -/* the scalar triple product, and*/ -/* the vector triple product. */ - -a = 3 4 5 /*positive numbers don't need " */ -b = 4 3 5 -c = "-5 -12 -13" - -call tellV 'vector A =',a /*show the A vector, aligned #s*/ -call tellV 'vector B =',b /*show the B vector, aligned #s*/ -call tellV 'vector C =',c /*show the C vector, aligned #s*/ +/*REXX program computes the products: dot, cross, scalar triple, and vector triple.*/ + a= 3 4 5 + b= 4 3 5 /*positive numbers don't need quotes. */ + c= "-5 -12 -13" +call tellV 'vector A =', a /*show the A vector, aligned numbers.*/ +call tellV 'vector B =', b /* " " B " " " */ +call tellV 'vector C =', c /* " " C " " " */ say -call tellV ' dot product [A∙B] =',dot(a,b) -call tellV 'cross product [AxB] =',cross(a,b) -call tellV 'scalar triple product [A∙(BxC)] =',dot(a,cross(b,c)) -call tellV 'vector triple product [Ax(BxC)] =',cross(a,cross(b,c)) -exit /*stick a fork in it, we're done.*/ -/*─────────────────────────────────────cross subroutine─────────────────*/ -cross: procedure; parse arg x1 x2 x3,y1 y2 y3 /*the CROSS product.*/ - return x2*y3-x3*y2 x3*y1-x1*y3 x1*y2-x2*y1 /*a vector quantity.*/ -/*─────────────────────────────────────dot subroutine───────────────────*/ -dot: procedure; parse arg x1 x2 x3,y1 y2 y3 /*the DOT product.*/ - return x1*y1 + x2*y2 + x3*y3 /*a scaler quantity.*/ -/*─────────────────────────────────────tellV subroutine─────────────────*/ -tellV: procedure; parse arg name,x y z /*display the vector*/ - w=max(4,length(x),length(y),length(z)) /*max width of nums.*/ - say right(name,40) right(x,w) right(y,w) right(z,w) +call tellV ' dot product [A∙B] =', dot(a, b) +call tellV 'cross product [AxB] =', cross(a, b) +call tellV 'scalar triple product [A∙(BxC)] =', dot(a, cross(b, c) ) +call tellV 'vector triple product [Ax(BxC)] =', cross(a, cross(b, c) ) +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +cross: procedure; parse arg x1 x2 x3,y1 y2 y3 /*the CROSS product.*/ + return x2*y3-x3*y2 x3*y1-x1*y3 x1*y2-x2*y1 /*a vector quantity. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +dot: procedure; parse arg x1 x2 x3,y1 y2 y3 /*the DOT product.*/ + return x1*y1 + x2*y2 + x3*y3 /*a scalar quantity. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +tellV: procedure; parse arg name,x y z /*display the vector. */ + w=max(4, length(x), length(y), length(z)) /*max width of numbers*/ + say right(name, 40) right(x,w) right(y,w) right(z,w) /*enforce alignment. */ return diff --git a/Task/Vector-products/Ruby/vector-products.rb b/Task/Vector-products/Ruby/vector-products.rb index 574aa061c3..e6586ea4a5 100644 --- a/Task/Vector-products/Ruby/vector-products.rb +++ b/Task/Vector-products/Ruby/vector-products.rb @@ -1,15 +1,6 @@ require 'matrix' class Vector - def cross_product(v) - unless size == 3 && v.size == 3 - raise ArgumentError, "Vectors must have size 3" - end - Vector[self[1] * v[2] - self[2] * v[1], - self[2] * v[0] - self[0] * v[2], - self[0] * v[1] - self[1] * v[0]] - end - def scalar_triple_product(b, c) self.inner_product(b.cross_product c) end diff --git a/Task/Verify-distribution-uniformity-Chi-squared-test/Elixir/verify-distribution-uniformity-chi-squared-test.elixir b/Task/Verify-distribution-uniformity-Chi-squared-test/Elixir/verify-distribution-uniformity-chi-squared-test.elixir new file mode 100644 index 0000000000..f5707b7b86 --- /dev/null +++ b/Task/Verify-distribution-uniformity-Chi-squared-test/Elixir/verify-distribution-uniformity-chi-squared-test.elixir @@ -0,0 +1,63 @@ +defmodule Verify do + defp gammaInc_Q(a, x) do + a1 = a-1 + f0 = fn t -> :math.pow(t, a1) * :math.exp(-t) end + df0 = fn t -> (a1-t) * :math.pow(t, a-2) * :math.exp(-t) end + y = while_loop(f0, x, a1) + n = trunc(y / 3.0e-4) + h = y / n + hh = 0.5 * h + sum = Enum.reduce(n-1 .. 0, 0, fn j,sum -> + t = h * j + sum + f0.(t) + hh * df0.(t) + end) + h * sum / gamma_spounge(a, make_coef) + end + + defp while_loop(f, x, y) do + if f.(y)*(x-y) > 2.0e-8 and y < x, do: while_loop(f, x, y+0.3), else: min(x, y) + end + + @a 12 + defp make_coef do + coef0 = [:math.sqrt(2.0 * :math.pi)] + {_, coef} = Enum.reduce(1..@a-1, {1.0, coef0}, fn k,{k1_factrl,c} -> + h = :math.exp(@a-k) * :math.pow(@a-k, k-0.5) / k1_factrl + {-k1_factrl*k, [h | c]} + end) + Enum.reverse(coef) |> List.to_tuple + end + + defp gamma_spounge(z, coef) do + accm = Enum.reduce(1..@a-1, elem(coef,0), fn k,res -> res + elem(coef,k) / (z+k) end) + accm * :math.exp(-(z+@a)) * :math.pow(z+@a, z+0.5) / z + end + + def chi2UniformDistance(dataSet) do + expected = Enum.sum(dataSet) / length(dataSet) + Enum.reduce(dataSet, 0, fn d,sum -> sum + (d-expected)*(d-expected) end) / expected + end + + def chi2Probability(dof, distance) do + 1.0 - gammaInc_Q(0.5*dof, 0.5*distance) + end + + def chi2IsUniform(dataSet, significance\\0.05) do + dof = length(dataSet) - 1 + dist = chi2UniformDistance(dataSet) + chi2Probability(dof, dist) > significance + end +end + +dsets = [ [ 199809, 200665, 199607, 200270, 199649 ], + [ 522573, 244456, 139979, 71531, 21461 ] ] + +Enum.each(dsets, fn ds -> + IO.puts "Data set:#{inspect ds}" + dof = length(ds) - 1 + IO.puts " degrees of freedom: #{dof}" + distance = Verify.chi2UniformDistance(ds) + :io.fwrite " distance: ~.4f~n", [distance] + :io.fwrite " probability: ~.4f~n", [Verify.chi2Probability(dof, distance)] + :io.fwrite " uniform? ~s~n", [(if Verify.chi2IsUniform(ds), do: "Yes", else: "No")] +end) diff --git a/Task/Verify-distribution-uniformity-Chi-squared-test/Java/verify-distribution-uniformity-chi-squared-test.java b/Task/Verify-distribution-uniformity-Chi-squared-test/Java/verify-distribution-uniformity-chi-squared-test.java new file mode 100644 index 0000000000..b08996b27c --- /dev/null +++ b/Task/Verify-distribution-uniformity-Chi-squared-test/Java/verify-distribution-uniformity-chi-squared-test.java @@ -0,0 +1,38 @@ +import static java.lang.Math.pow; +import java.util.Arrays; +import static java.util.Arrays.stream; +import org.apache.commons.math3.special.Gamma; + +public class Test { + + static double x2Dist(double[] data) { + double avg = stream(data).sum() / data.length; + double sqs = stream(data).reduce(0, (a, b) -> a + pow((b - avg), 2)); + return sqs / avg; + } + + static double x2Prob(double dof, double distance) { + return Gamma.regularizedGammaQ(dof / 2, distance / 2); + } + + static boolean x2IsUniform(double[] data, double significance) { + return x2Prob(data.length - 1.0, x2Dist(data)) > significance; + } + + public static void main(String[] a) { + double[][] dataSets = {{199809, 200665, 199607, 200270, 199649}, + {522573, 244456, 139979, 71531, 21461}}; + + System.out.printf(" %4s %12s %12s %8s %s%n", + "dof", "distance", "probability", "Uniform?", "dataset"); + + for (double[] ds : dataSets) { + int dof = ds.length - 1; + double dist = x2Dist(ds); + double prob = x2Prob(dof, dist); + System.out.printf("%4d %12.3f %12.8f %5s %6s%n", + dof, dist, prob, x2IsUniform(ds, 0.05) ? "YES" : "NO", + Arrays.toString(ds)); + } + } +} diff --git a/Task/Verify-distribution-uniformity-Naive/00DESCRIPTION b/Task/Verify-distribution-uniformity-Naive/00DESCRIPTION index 7acaef09fb..98626dbc20 100644 --- a/Task/Verify-distribution-uniformity-Naive/00DESCRIPTION +++ b/Task/Verify-distribution-uniformity-Naive/00DESCRIPTION @@ -1,7 +1,10 @@ This task is an adjunct to [[Seven-sided dice from five-sided dice]]. + +;Ttask: Create a function to check that the random integers returned from a small-integer generator function have uniform distribution. + The function should take as arguments: * The function (or object) producing random integers. * The number of times to call the integer generator. @@ -15,3 +18,4 @@ Show the distribution checker working when the produced distribution is flat eno See also: *[[Verify distribution uniformity/Chi-squared test]] +

    diff --git a/Task/Verify-distribution-uniformity-Naive/Elixir/verify-distribution-uniformity-naive.elixir b/Task/Verify-distribution-uniformity-Naive/Elixir/verify-distribution-uniformity-naive.elixir index 08c101775a..10d40caa59 100644 --- a/Task/Verify-distribution-uniformity-Naive/Elixir/verify-distribution-uniformity-naive.elixir +++ b/Task/Verify-distribution-uniformity-Naive/Elixir/verify-distribution-uniformity-naive.elixir @@ -1,23 +1,22 @@ defmodule VerifyDistribution do - def naive( generator, times, delta_percent \\ 3 ) do - dict = Enum.reduce( List.duplicate(generator, times), Map.new, fn f,d -> update_counter(f,d) end ) - values = for x <- Dict.keys(dict), do: Dict.get(dict, x) - average = Enum.sum( values ) / Dict.size( dict ) + def naive( generator, times, delta_percent ) do + dict = Enum.reduce( List.duplicate(generator, times), Map.new, &update_counter/2 ) + values = Map.values(dict) + average = Enum.sum( values ) / map_size( dict ) delta = average * (delta_percent / 100) fun = fn {_key, value} -> abs(value - average) > delta end too_large_dict = Enum.filter( dict, fun ) - return( Dict.size(too_large_dict), too_large_dict, average, delta_percent ) + return( length(too_large_dict), too_large_dict, average, delta_percent ) end def return( 0, _too_large_dict, _average, _delta ), do: :ok def return( _n, too_large_dict, average, delta ) do - {:error, {Dict.to_list(too_large_dict), :failed_expected_average, average, 'with_delta_%', delta}} + {:error, {too_large_dict, :failed_expected_average, average, 'with_delta_%', delta}} end - def update_counter( fun, dict ), do: Dict.update( dict, fun.(), 1, fn(val) -> val+1 end ) + def update_counter( fun, dict ), do: Map.update( dict, fun.(), 1, &(&1+1) ) end -:random.seed(:erlang.now) fun = fn -> Dice.dice7 end IO.inspect VerifyDistribution.naive( fun, 100000, 3 ) IO.inspect VerifyDistribution.naive( fun, 100, 3 ) diff --git a/Task/Verify-distribution-uniformity-Naive/Java/verify-distribution-uniformity-naive.java b/Task/Verify-distribution-uniformity-Naive/Java/verify-distribution-uniformity-naive.java new file mode 100644 index 0000000000..396f7a0dfa --- /dev/null +++ b/Task/Verify-distribution-uniformity-Naive/Java/verify-distribution-uniformity-naive.java @@ -0,0 +1,29 @@ +import static java.lang.Math.abs; +import java.util.*; +import java.util.function.IntSupplier; + +public class Test { + + static void distCheck(IntSupplier f, int nRepeats, double delta) { + Map counts = new HashMap<>(); + + for (int i = 0; i < nRepeats; i++) + counts.compute(f.getAsInt(), (k, v) -> v == null ? 1 : v + 1); + + double target = nRepeats / (double) counts.size(); + int deltaCount = (int) (delta / 100.0 * target); + + counts.forEach((k, v) -> { + if (abs(target - v) >= deltaCount) + System.out.printf("distribution potentially skewed " + + "for '%s': '%d'%n", k, v); + }); + + counts.keySet().stream().sorted().forEach(k + -> System.out.printf("%d %d%n", k, counts.get(k))); + } + + public static void main(String[] a) { + distCheck(() -> (int) (Math.random() * 5) + 1, 1_000_000, 1); + } +} diff --git a/Task/Verify-distribution-uniformity-Naive/REXX/verify-distribution-uniformity-naive.rexx b/Task/Verify-distribution-uniformity-Naive/REXX/verify-distribution-uniformity-naive.rexx index fbc8d5f1d7..161b3a0a80 100644 --- a/Task/Verify-distribution-uniformity-Naive/REXX/verify-distribution-uniformity-naive.rexx +++ b/Task/Verify-distribution-uniformity-Naive/REXX/verify-distribution-uniformity-naive.rexx @@ -1,33 +1,33 @@ -/*REXX pgm simulates a number of trials of a random digit and show it's skew %*/ -parse arg f t d s . /*obtain arguments (options) from C.L. */ -if f=='' | f==',' then f='RANDOM' /*function not specified? Use default.*/ -if t=='' | t==',' then t=1000000 /*times " " " " */ -if d=='' | d==',' then d=1/2 /*delta% " " " " */ -if s\=='' then call random ,,s /*use some RAND seed for repeatability.*/ -highDig=9 /*use this var for the highest digit. */ -!.=0 /*initialize all possible random trials*/ - do t /* [↓] perform a bunch of trials. */ - if f=='RANDOM' then ?=random(0,highDig) /*random function.*/ - else interpret '?='f"(0,"highDig')' /* user function.*/ - !.?=!.?+1 /*bump the counter*/ - end /*t*/ /* [↑] store trials ───► pigeonholes. */ - /* [↓] compute the digit's skewness. */ -g=t/(1+highDig) /*calculate number of each digit throw.*/ -OK?='OK skewed' /*words to show "skewed" or if "OK".*/ -w=max(8,length(t)) /*maximum length of number of trials.*/ -pad=left('',9) /*this is used for output indentation. */ -say pad 'digit' center("hits",w) ' skew ' "skew%" 'result' /*header. */ -say pad '─────' center('',w,'─') '──────' "─────" '──────' /*separator.*/ - /** [↑] show header and the separator.*/ - do k=0 to highDig /*process each of the possible digits. */ - skew=g-!.k /*calculate the skew for the digit. */ - skewPC=(1-(g-abs(skew))/g)*100 /* " " " percentage for dig*/ - ok=center(word(ok?,1+(skewPC>d)),6) /*it's gotta be one of skewed or xx%*/ - say pad center(k,5) right(!.k,w) right(skew,6) format(skewPC,,3) ok - end /*k*/ +/*REXX program simulates a number of trials of a random digit and show it's skew %. */ +parse arg f t d s . /*obtain arguments (options) from C.L. */ +if f=='' | f=="," then f='RANDOM' /*function not specified? Use default.*/ +if t=='' | t=="," then t=1000000 /*times " " " " */ +if d=='' | d=="," then d=1/2 /*delta% " " " " */ +if s\=='' then call random ,,s /*use some RAND seed for repeatability.*/ +highDig=9 /*use this var for the highest digit. */ +!.=0 /*initialize all possible random trials*/ + do t /* [↓] perform a bunch of trials. */ + if f=='RANDOM' then ?=random(0,highDig) /*use the RANDOM BIF function.*/ + else interpret '?='f"(0,"highDig')' /*use the (specified) " */ + !.?=!.?+1 /*bump the invocation counter.*/ + end /*t*/ /* [↑] store trials ───► pigeonholes. */ + /* [↓] compute the digit's skewness. */ +g=t / (1+highDig) /*calculate number of each digit throw.*/ +OK?= 'OK skewed' /*words to show "skewed" or if "OK".*/ +w=max(8, length(t)) /*maximum length of number of trials.*/ +pad=left('', 9) /*this is used for output indentation. */ +say pad 'digit' center("hits",w) ' skew ' "skew%" 'result' /*header. */ +say pad '─────' center('',w,'─') '──────' "─────" '──────' /*separator.*/ + /** [↑] show header and the separator.*/ + do k=0 to highDig /*process each of the possible digits. */ + skew=g-!.k /*calculate the skew for the digit. */ + skewPC=(1- (g-abs(skew)) / g) * 100 /* " " " percentage for dig*/ + ok=center(word(ok?, 1 + (skewPC>d)), 6) /*it's gotta be one of skewed or xx%*/ + say pad center(k,5) right(!.k,w) right(skew,6) format(skewPC,,3) ok + end /*k*/ -say pad '─────' center('',w,'─') '──────' "─────" '──────' /*separator. */ -y=5+1+w+1+6+1+6+1+6 /*the width. */ -say pad center(" (with " t ' trials)',y) /*# trials. */ -say pad center(" (skewed when exceeds " d'%)',y) /*skewed note*/ - /*stick a fork in it, we're all done. */ +say pad '─────' center('',w,'─') '──────' "─────" '──────' /*separator. */ +y=5+1+w+1+6+1+6+1+6 /*the width. */ +say pad center(" (with " t ' trials)',y) /*# trials. */ +say pad center(" (skewed when exceeds " d'%)',y) /*skewed note.*/ + /*stick a fork in it, we're all done. */ diff --git a/Task/Vigen-re-cipher-Cryptanalysis/Julia/vigen-re-cipher-cryptanalysis.julia b/Task/Vigen-re-cipher-Cryptanalysis/Julia/vigen-re-cipher-cryptanalysis.julia index 1e2073fa84..5b637a018e 100644 --- a/Task/Vigen-re-cipher-Cryptanalysis/Julia/vigen-re-cipher-cryptanalysis.julia +++ b/Task/Vigen-re-cipher-Cryptanalysis/Julia/vigen-re-cipher-cryptanalysis.julia @@ -48,7 +48,7 @@ const letters = Dict{Char, Float32}( 'X' => 0.150, 'Q' => 0.095, 'Z' => 0.074) -const digraphs = Dict{String, Float32}( +const digraphs = Dict{AbstractString, Float32}( "TH" => 15.2, "HE" => 12.8, "IN" => 9.4, @@ -88,7 +88,7 @@ const digraphs = Dict{String, Float32}( "RA" => 0.4, "LD" => 0.2, "UR" => 0.2) -const trigraphs = Dict{String, Float32}( +const trigraphs = Dict{AbstractString, Float32}( "THE" => 18.1, "AND" => 7.3, "ING" => 7.2, diff --git a/Task/Vigen-re-cipher/00DESCRIPTION b/Task/Vigen-re-cipher/00DESCRIPTION index 8d853ef2f6..3b3fafda0e 100644 --- a/Task/Vigen-re-cipher/00DESCRIPTION +++ b/Task/Vigen-re-cipher/00DESCRIPTION @@ -1,16 +1,17 @@ {{omit from|GUISS|would need to install an application that could do this}} {{omit from|Openscad}} -Implement a [[wp:Vigen%C3%A8re_cipher|Vigenère cypher]], -both encryption and decryption. +;Task: +Implement a   [[wp:Vigen%C3%A8re_cipher|Vigenère cypher]],   both encryption and decryption. The program should handle keys and text of unequal length, and should capitalize everything and discard non-alphabetic characters.
    (If your program handles non-alphabetic characters in another way, make a note of it.) -;See also: -* [[Caesar cipher]] -* [[Rot-13]] -* [[Substitution Cipher]] -
    + +;Related tasks: +*   [[Caesar cipher]] +*   [[Rot-13]] +*   [[Substitution Cipher]] +

    diff --git a/Task/Vigen-re-cipher/C/vigen-re-cipher.c b/Task/Vigen-re-cipher/C/vigen-re-cipher.c index 36760f589e..d0dcd2105e 100644 --- a/Task/Vigen-re-cipher/C/vigen-re-cipher.c +++ b/Task/Vigen-re-cipher/C/vigen-re-cipher.c @@ -1,56 +1,113 @@ #include #include #include +#include #include +#include -void upper_case(char *src) +#define NUMLETTERS 26 +#define BUFSIZE 4096 + +char *get_input(void); + +int main(int argc, char *argv[]) { - while (*src != '\0') { - if (islower(*src)) *src &= ~0x20; - src++; + char const usage[] = "Usage: vinigere [-d] key"; + char sign = 1; + char const plainmsg[] = "Plain text: "; + char const cryptmsg[] = "Cipher text: "; + bool encrypt = true; + int opt; + + while ((opt = getopt(argc, argv, "d")) != -1) { + switch (opt) { + case 'd': + sign = -1; + encrypt = false; + break; + default: + fprintf(stderr, "Unrecogized command line argument:'-%i'\n", opt); + fprintf(stderr, "\n%s\n", usage); + return 1; } -} + } -char* encipher(const char *src, char *key, int is_encode) -{ - int i, klen, slen; - char *dest; + if (argc - optind != 1) { + fprintf(stderr, "%s requires one argument and one only\n", argv[0]); + fprintf(stderr, "\n%s\n", usage); + return 1; + } - dest = strdup(src); - upper_case(dest); - upper_case(key); - /* strip out non-letters */ - for (i = 0, slen = 0; dest[slen] != '\0'; slen++) - if (isupper(dest[slen])) - dest[i++] = dest[slen]; + // Convert argument into array of shifts + char const *const restrict key = argv[optind]; + size_t const keylen = strlen(key); + char shifts[keylen]; - dest[slen = i] = '\0'; /* null pad it, make it safe to use */ - - klen = strlen(key); - for (i = 0; i < slen; i++) { - if (!isupper(dest[i])) continue; - dest[i] = 'A' + (is_encode - ? dest[i] - 'A' + key[i % klen] - 'A' - : dest[i] - key[i % klen] + 26) % 26; + char const *restrict plaintext = NULL; + for (size_t i = 0; i < keylen; i++) { + if (!(isalpha(key[i]))) { + fprintf(stderr, "Invalid key\n"); + return 2; } + char const charcase = (isupper(key[i])) ? 'A' : 'a'; + // If decrypting, shifts will be negative. + // This line would turn "bacon" into {1, 0, 2, 14, 13} + shifts[i] = (key[i] - charcase) * sign; + } - return dest; + do { + fflush(stdout); + // Print "Plain text: " if encrypting and "Cipher text: " if + // decrypting + printf("%s", (encrypt) ? plainmsg : cryptmsg); + plaintext = get_input(); + if (plaintext == NULL) { + fprintf(stderr, "Error getting input\n"); + return 4; + } + } while (strcmp(plaintext, "") == 0); // Reprompt if entry is empty + + size_t const plainlen = strlen(plaintext); + + char* const restrict ciphertext = calloc(plainlen + 1, sizeof *ciphertext); + if (ciphertext == NULL) { + fprintf(stderr, "Memory error\n"); + return 5; + } + + for (size_t i = 0, j = 0; i < plainlen; i++) { + // Skip non-alphabetical characters + if (!(isalpha(plaintext[i]))) { + ciphertext[i] = plaintext[i]; + continue; + } + // Check case + char const charcase = (isupper(plaintext[i])) ? 'A' : 'a'; + // Wrapping conversion algorithm + ciphertext[i] = ((plaintext[i] + shifts[j] - charcase + NUMLETTERS) % NUMLETTERS) + charcase; + j = (j+1) % keylen; + } + ciphertext[plainlen] = '\0'; + printf("%s%s\n", (encrypt) ? cryptmsg : plainmsg, ciphertext); + + free(ciphertext); + // Silence warnings about const not being maintained in cast to void* + free((char*) plaintext); + return 0; } +char *get_input(void) { -int main() -{ - const char *str = "Beware the Jabberwock, my son! The jaws that bite, " - "the claws that catch!"; - const char *cod, *dec; - char key[] = "VIGENERECIPHER"; + char *const restrict buf = malloc(BUFSIZE * sizeof (char)); + if (buf == NULL) { + return NULL; + } - printf("Text: %s\n", str); - printf("key: %s\n", key); + fgets(buf, BUFSIZE, stdin); - cod = encipher(str, key, 1); printf("Code: %s\n", cod); - dec = encipher(cod, key, 0); printf("Back: %s\n", dec); + // Get rid of newline + size_t const len = strlen(buf); + if (buf[len - 1] == '\n') buf[len - 1] = '\0'; - /* free(dec); free(cod); */ /* nah */ - return 0; + return buf; } diff --git a/Task/Vigen-re-cipher/Elixir/vigen-re-cipher.elixir b/Task/Vigen-re-cipher/Elixir/vigen-re-cipher.elixir new file mode 100644 index 0000000000..7e57634d4d --- /dev/null +++ b/Task/Vigen-re-cipher/Elixir/vigen-re-cipher.elixir @@ -0,0 +1,28 @@ +defmodule VigenereCipher do + @base ?A + @size ?Z - @base + 1 + + def encrypt(text, key), do: crypt(text, key, 1) + + def decrypt(text, key), do: crypt(text, key, -1) + + defp crypt(text, key, dir) do + text = String.upcase(text) |> String.replace(~r/[^A-Z]/, "") |> to_char_list + key_iterator = String.upcase(key) |> String.replace(~r/[^A-Z]/, "") |> to_char_list + |> Enum.map(fn c -> (c - @base) * dir end) |> Stream.cycle + Enum.zip(text, key_iterator) + |> Enum.reduce('', fn {char, offset}, ciphertext -> + [rem(char - @base + offset + @size, @size) + @base | ciphertext] + end) + |> Enum.reverse |> List.to_string + end +end + +plaintext = "Beware the Jabberwock, my son! The jaws that bite, the claws that catch!" +key = "Vigenere cipher" +ciphertext = VigenereCipher.encrypt(plaintext, key) +recovered = VigenereCipher.decrypt(ciphertext, key) + +IO.puts "Original: #{plaintext}" +IO.puts "Encrypted: #{ciphertext}" +IO.puts "Decrypted: #{recovered}" diff --git a/Task/Vigen-re-cipher/JavaScript/vigen-re-cipher.js b/Task/Vigen-re-cipher/JavaScript/vigen-re-cipher.js index 5f063220ad..1af5f2f0e6 100644 --- a/Task/Vigen-re-cipher/JavaScript/vigen-re-cipher.js +++ b/Task/Vigen-re-cipher/JavaScript/vigen-re-cipher.js @@ -1,29 +1,24 @@ -Vigenère -
    
    -
    +console.log(enc);
    +console.log(dec);
    diff --git a/Task/Vigen-re-cipher/PowerShell/vigen-re-cipher.psh b/Task/Vigen-re-cipher/PowerShell/vigen-re-cipher.psh
    new file mode 100644
    index 0000000000..22261acdba
    --- /dev/null
    +++ b/Task/Vigen-re-cipher/PowerShell/vigen-re-cipher.psh
    @@ -0,0 +1,85 @@
    +# Author: D. Cudnohufsky
    +function Get-VigenereCipher
    +{
    +    Param
    +    (
    +        [Parameter(Mandatory=$true)]
    +        [string] $Text,
    +
    +        [Parameter(Mandatory=$true)]
    +        [string] $Key,
    +
    +        [switch] $Decode
    +    )
    +
    +    begin
    +    {
    +        $map = [char]'A'..[char]'Z'
    +    }
    +
    +    process
    +    {
    +        $Key = $Key -replace '[^a-zA-Z]',''
    +        $Text = $Text -replace '[^a-zA-Z]',''
    +
    +        $keyChars = $Key.toUpper().ToCharArray()
    +        $Chars = $Text.toUpper().ToCharArray()
    +
    +        function encode
    +        {
    +
    +            param
    +            (
    +                $Char,
    +                $keyChar,
    +                $Alpha = [char]'A'..[char]'Z'
    +            )
    +
    +            $charIndex = $Alpha.IndexOf([int]$Char)
    +            $keyIndex = $Alpha.IndexOf([int]$keyChar)
    +            $NewIndex = ($charIndex + $KeyIndex) - $Alpha.Length
    +            $Alpha[$NewIndex]
    +
    +        }
    +
    +        function decode
    +        {
    +
    +            param
    +            (
    +                $Char,
    +                $keyChar,
    +                $Alpha = [char]'A'..[char]'Z'
    +            )
    +
    +            $charIndex = $Alpha.IndexOf([int]$Char)
    +            $keyIndex = $Alpha.IndexOf([int]$keyChar)
    +            $int = $charIndex - $keyIndex
    +            if ($int -lt 0) { $NewIndex = $int + $Alpha.Length }
    +            else { $NewIndex = $int }
    +            $Alpha[$NewIndex]
    +        }
    +
    +        while ( $keyChars.Length -lt $Chars.Length )
    +        {
    +            $keyChars = $keyChars + $keyChars
    +        }
    +
    +        for ( $i = 0; $i -lt $Chars.Length; $i++ )
    +        {
    +
    +            if ( [int]$Chars[$i] -in $map -and [int]$keyChars[$i] -in $map )
    +            {
    +                if ($Decode) {$Chars[$i] = decode $Chars[$i] $keyChars[$i] $map}
    +                else {$Chars[$i] = encode $Chars[$i] $keyChars[$i] $map}
    +
    +                $Chars[$i] = [char]$Chars[$i]
    +                [string]$OutText += $Chars[$i]
    +            }
    +
    +        }
    +
    +        $OutText
    +        $OutText = $null
    +    }
    +}
    diff --git a/Task/Vigen-re-cipher/Python/vigen-re-cipher-1.py b/Task/Vigen-re-cipher/Python/vigen-re-cipher-1.py
    index 599c33b90e..9135e6d979 100644
    --- a/Task/Vigen-re-cipher/Python/vigen-re-cipher-1.py
    +++ b/Task/Vigen-re-cipher/Python/vigen-re-cipher-1.py
    @@ -4,16 +4,16 @@ def encrypt(message, key):
     
         # convert to uppercase.
         # strip out non-alpha characters.
    -    message = filter(lambda _: _.isalpha(), message.upper())
    +    message = filter(str.isalpha, message.upper())
     
         # single letter encrpytion.
    -    def enc(c,k): return chr(((ord(k) + ord(c)) % 26) + ord('A'))
    +    def enc(c,k): return chr(((ord(k) + ord(c) - 2*ord('A')) % 26) + ord('A'))
     
         return "".join(starmap(enc, zip(message, cycle(key))))
     
     def decrypt(message, key):
     
         # single letter decryption.
    -    def dec(c,k): return chr(((ord(c) - ord(k)) % 26) + ord('A'))
    +    def dec(c,k): return chr(((ord(c) - ord(k) - 2*ord('A')) % 26) + ord('A'))
     
         return "".join(starmap(dec, zip(message, cycle(key))))
    diff --git a/Task/Vigen-re-cipher/REXX/vigen-re-cipher-1.rexx b/Task/Vigen-re-cipher/REXX/vigen-re-cipher-1.rexx
    index 9a0a94ce48..05d254fe6d 100644
    --- a/Task/Vigen-re-cipher/REXX/vigen-re-cipher-1.rexx
    +++ b/Task/Vigen-re-cipher/REXX/vigen-re-cipher-1.rexx
    @@ -1,31 +1,29 @@
    -/*REXX program encrypts uppercased text using the  Vigenère  cypher.    */
    +/*REXX program  encrypts  (and displays)  uppercased text  using  the  Vigenère  cypher.*/
     @.1 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
     L=length(@.1)
    -                         do j=2 to L;    jm=j-1;    q=@.jm
    -                         @.j=substr(q,2,L-1)left(q,1)
    +                         do j=2  to L;                        jm=j-1;    q=@.jm
    +                         @.j=substr(q, 2, L-1)left(q, 1)
                              end   /*j*/
     
    -cypher = space('WHOOP DE DOO    NO BIG DEAL HERE OR THERE',0)
    +cypher = space('WHOOP DE DOO    NO BIG DEAL HERE OR THERE', 0)
     oMsg   = 'People solve problems by trial and error; judgement helps pick the trial.'
     oMsgU  = oMsg;    upper oMsgU
    -cypher_=copies(cypher,length(oMsg)%length(cypher))
    +cypher_= copies(cypher, length(oMsg) % length(cypher) )
     say '   original text =' oMsg
                              xMsg=Ncypher(oMsgU)
     say '   cyphered text =' xMsg
                              bMsg=Dcypher(xMsg)
     say 're-cyphered text =' bMsg
     exit
    -/*───────────────────────────────Ncypher subroutine─────────────────────*/
    -Ncypher:  parse arg stuff;     #=1;   nMsg=
    -   do i=1 for length(stuff);   x=substr(stuff,i,1)    /*pick off 1 char.*/
    -   if \datatype(x,'U') then iterate    /*not a letter?   Then ignore it.*/
    -   j=pos(x,@.1);   nMsg=nMsg || substr(@.j,pos(substr(cypher_,#,1),@.1),1)
    -   #=#+1                               /*bump the character counter.    */
    -   end
    -return nMsg
    -/*───────────────────────────────Dcypher subroutine──────────────────────*/
    -Dcypher:  parse arg stuff;     #=1;   dMsg=
    -   do i=1 for length(stuff);   x=substr(cypher_,i,1)  /*pick off 1 char.*/
    -   j=pos(x,@.1);   dMsg=dMsg || substr(@.1, pos(substr(stuff,i,1),@.j),1)
    -   end
    -return dMsg
    +/*──────────────────────────────────────────────────────────────────────────────────────*/
    +Ncypher:  parse arg x;    nMsg=;       #=1      /*unsupported char? ↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓*/
    +              do i=1  for length(x);   j=pos(substr(x,i,1), @.1);   if j==0  then iterate
    +              nMsg=nMsg || substr(@.j, pos( substr( cypher_, #, 1), @.1), 1);     #=#+1
    +              end   /*j*/
    +          return nMsg
    +/*──────────────────────────────────────────────────────────────────────────────────────*/
    +Dcypher:  parse arg x;    dMsg=
    +              do i=1  for length(x);   j=pos(substr(cypher_, i, 1), @.1)
    +              dMsg=dMsg || substr(@.1, pos( substr(x, i, 1), @.j), 1)
    +              end   /*j*/
    +          return dMsg
    diff --git a/Task/Vigen-re-cipher/REXX/vigen-re-cipher-2.rexx b/Task/Vigen-re-cipher/REXX/vigen-re-cipher-2.rexx
    index 4d3c0be53c..67d65f04b2 100644
    --- a/Task/Vigen-re-cipher/REXX/vigen-re-cipher-2.rexx
    +++ b/Task/Vigen-re-cipher/REXX/vigen-re-cipher-2.rexx
    @@ -1,30 +1,29 @@
    -/*REXX program encrypts uppercased text using the  Vigenère  cypher.    */
    -@abc='abcdefghijklmnopqrstuvwxyz';    @abcU=@abc;    upper @abcU
    +/*REXX program  encrypts  (and displays)  most text  using  the  Vigenère  cypher.      */
    +@abc= 'abcdefghijklmnopqrstuvwxyz';       @abcU=@abc;    upper @abcU
     @.1 = @abcU || @abc'0123456789~`!@#$%^&*()_-+={}|[]\:;<>?,./" '''
     L=length(@.1)
    -                         do j=2 to length(@.1);    jm=j-1;    q=@.jm
    -                         @.j=substr(q,2,length(@.1)-1)left(q,1)
    +                         do j=2  to length(@.1);                jm=j-1;   q=@.jm
    +                         @.j=substr(q, 2, L-1)left(q, 1)
                              end   /*j*/
     
    -cypher = space('WHOOP DE DOO    NO BIG DEAL HERE OR THERE',0)
    +cypher = space('WHOOP DE DOO    NO BIG DEAL HERE OR THERE', 0)
     oMsg   = 'Making things easy is just knowing the shortcuts. --- Gerard J. Schildberger'
    -cypher_=copies(cypher,length(oMsg)%length(cypher))
    +cypher_= copies(cypher, length(oMsg) % length(cypher) )
     say '   original text =' oMsg
                              xMsg=Ncypher(oMsg)
     say '   cyphered text =' xMsg
                              bMsg=Dcypher(xMsg)
     say 're-cyphered text =' bMsg
     exit
    -/*───────────────────────────────Ncypher subroutine─────────────────────*/
    -Ncypher:  parse arg stuff;     #=1;     nMsg=
    -   do i=1 for length(stuff);   x=substr(stuff,i,1)    /*pick off 1 char.*/
    -   j=pos(x,@.1); if j==0 then iterate  /*character not supported? Ignore*/
    -   nMsg=nMsg || substr(@.j,pos(substr(cypher_,#,1),@.1),1);   #=#+1
    -   end    /*j*/
    -return nMsg
    -/*───────────────────────────────Dcypher subroutine──────────────────────*/
    -Dcypher:  parse arg stuff;     #=1;   dMsg=
    -   do i=1 for length(stuff);   x=substr(cypher_,i,1)  /*pick off 1 char.*/
    -   j=pos(x,@.1);   dMsg=dMsg || substr(@.1, pos(substr(stuff,i,1),@.j),1)
    -   end    /*j*/
    -return dMsg
    +/*──────────────────────────────────────────────────────────────────────────────────────*/
    +Ncypher:  parse arg x;    nMsg=;       #=1      /*unsupported char? ↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓*/
    +              do i=1  for length(x);   j=pos(substr(x,i,1), @.1);   if j==0  then iterate
    +              nMsg=nMsg || substr(@.j, pos( substr( cypher_, #, 1), @.1), 1);     #=#+1
    +              end   /*j*/
    +          return nMsg
    +/*──────────────────────────────────────────────────────────────────────────────────────*/
    +Dcypher:  parse arg x;    dMsg=
    +              do i=1  for length(x);   j=pos(substr(cypher_, i, 1), @.1)
    +              dMsg=dMsg || substr(@.1, pos( substr(x, i, 1), @.j), 1)
    +              end   /*j*/
    +          return dMsg
    diff --git a/Task/Vigen-re-cipher/Scala/vigen-re-cipher-2.scala b/Task/Vigen-re-cipher/Scala/vigen-re-cipher-2.scala
    index 2efebb51e5..860688354d 100644
    --- a/Task/Vigen-re-cipher/Scala/vigen-re-cipher-2.scala
    +++ b/Task/Vigen-re-cipher/Scala/vigen-re-cipher-2.scala
    @@ -1,52 +1,28 @@
    -class Vigenere(val key: String) {
    +object Vigenere {
    +
    +  val key = "LEMON"
    +  val chars = 'A' to 'Z'
     
       private def rotate(p: Int, s: IndexedSeq[Char]) = s.drop(p) ++ s.take(p)
    +  val vSquare = (for (i <- Range(0, 25)) yield rotate(i, chars)).flatten
     
    -  private val chars = 'A' to 'Z'
    +  def encrypt(s: String) = enrOrDecode(0, s.toUpperCase, encode)
    +  def decrypt(s: String) = enrOrDecode(0, s.toUpperCase, decode)
     
    -  private val vSquare = (chars ++
    -                rotate(1, chars) ++
    -                rotate(2, chars) ++
    -                rotate(3, chars) ++
    -                rotate(4, chars) ++
    -                rotate(5, chars) ++
    -                rotate(6, chars) ++
    -                rotate(7, chars) ++
    -                rotate(8, chars) ++
    -                rotate(9, chars) ++
    -                rotate(10, chars) ++
    -                rotate(11, chars) ++
    -                rotate(12, chars) ++
    -                rotate(13, chars) ++
    -                rotate(14, chars) ++
    -                rotate(15, chars) ++
    -                rotate(16, chars) ++
    -                rotate(17, chars) ++
    -                rotate(18, chars) ++
    -                rotate(19, chars) ++
    -                rotate(20, chars) ++
    -                rotate(21, chars) ++
    -                rotate(22, chars) ++
    -                rotate(23, chars) ++
    -                rotate(24, chars) ++
    -                rotate(25, chars))
    -
    -  private var encIndex = -1
    -  private var decIndex = -1
    -
    -  def encode(c: Char) = {
    -    encIndex += 1
    -    if (encIndex == key.length) encIndex = 0
    -    if (chars.contains(c)) vSquare((c - 'A') * 26 + key(encIndex) - 'A') else c
    +  private def enrOrDecode(i: Int , in: String, op:(Char, Int) => Char): String = {
    +    if (in.length == 0) in else {
    +      val index = if (i == key.length) 0 else i
    +      (if (chars.contains(in.head)) op(in.head, index) else in.head) + enrOrDecode(index + 1, in.tail, op)
    +    }
       }
     
    -  def decode(c: Char) = {
    -    decIndex += 1
    -    if (decIndex == key.length) decIndex = 0
    -    if (chars.contains(c)) {
    -      val baseIndex = (key(decIndex) - 'A') * 26
    +  private def encode(c: Char, index: Int): Char = {
    +    vSquare((c - 'A') * 26 + key(index) - 'A')
    +  }
    +
    +  private def decode(c: Char, index: Int) = {
    +      val baseIndex = (key(index) - 'A') * 26
           val nextIndex = vSquare.indexOf(c, baseIndex)
           chars(nextIndex - baseIndex)
    -    } else c
       }
     }
    diff --git a/Task/Vigen-re-cipher/Scala/vigen-re-cipher-3.scala b/Task/Vigen-re-cipher/Scala/vigen-re-cipher-3.scala
    index 310e4a5c50..e9bfc6128c 100644
    --- a/Task/Vigen-re-cipher/Scala/vigen-re-cipher-3.scala
    +++ b/Task/Vigen-re-cipher/Scala/vigen-re-cipher-3.scala
    @@ -1,6 +1,6 @@
    -val text = "ATTACKATDAWN"
    -val myVigenere = new Vigenere("LEMON")
    -val encoded = text.map(c => myVigenere.encode(c))
    -println("Plaintext => " + text)
    -println("Ciphertext => " + encoded)
    -println("Decrypted => " + encoded.map(c => myVigenere.decode(c)))
    +val text = "Beware the Jabberwock, my son! The jaws that bite, the claws that catch!"
    +val encoded = Vigenere.encrypt(text)
    +val decoded = Vigenere.decrypt(text)
    +println("Plain text => " + text)
    +println("Cipher text => " + encoded)
    +println("Decrypted => " + decoded)
    diff --git a/Task/Visualize-a-tree/00DESCRIPTION b/Task/Visualize-a-tree/00DESCRIPTION
    index a403c5b58b..583290109a 100644
    --- a/Task/Visualize-a-tree/00DESCRIPTION
    +++ b/Task/Visualize-a-tree/00DESCRIPTION
    @@ -1,3 +1,18 @@
    -A tree structure (i.e. a rooted, connected acyclic graph) is often used in programming.  It's often helpful to visually examine such a structure.  There are many ways to represent trees to a reader, such as indented text (à la unix tree command), nested HTML tables, hierarchical GUI widgets, 2D or 3D images, etc.
    +A tree structure   (i.e. a rooted, connected acyclic graph)   is often used in programming.
     
    -'''Task''': Write a program to produce a visual representation of some tree.  The content of the tree doesn't matter, nor does the output format, the only requirement being that the output is human friendly. Make do with the vague term "friendly" the best you can.
    +It's often helpful to visually examine such a structure.
    +
    +There are many ways to represent trees to a reader, such as:
    +:::*   indented text   (à la unix  tree  command)
    +:::*   nested HTML tables
    +:::*   hierarchical GUI widgets
    +:::*   2D   or   3D   images
    +:::*   etc.
    +
    +;Task:
    +Write a program to produce a visual representation of some tree.
    +
    +The content of the tree doesn't matter, nor does the output format, the only requirement being that the output is human friendly.
    +
    +Make do with the vague term "friendly" the best you can.
    +

    diff --git a/Task/Visualize-a-tree/ALGOL-68/visualize-a-tree.alg b/Task/Visualize-a-tree/ALGOL-68/visualize-a-tree.alg new file mode 100644 index 0000000000..f043061bd5 --- /dev/null +++ b/Task/Visualize-a-tree/ALGOL-68/visualize-a-tree.alg @@ -0,0 +1,103 @@ +# outputs nested html tables to visualise a tree # + +# mode representing nodes of the tree # +MODE NODE = STRUCT( STRING value, REF NODE child, REF NODE sibling ); +REF NODE nil node = NIL; + +# tags etc. # +STRING table = "" + , elbat = "
    " + , tr = "" + , rt = "" + , td = "" + nbsp + value OF tree + nbsp + + dt + nl + + rt + nl + ; + IF child count > 0 + THEN + # the node has branches # + REF NODE child := child OF tree; + INT child number := 1; + INT mid child = ( child count + 1 ) OVER 2; + child := child OF tree; + result +:= tr + nl; + WHILE child ISNT nil node + DO + result +:= td + ">" + nl + + IF CHILDCOUNT child < 1 THEN nbsp + value OF child + nbsp ELSE TOHTML child FI + + dt + nl; + child := sibling OF child + OD; + result +:= rt + nl + FI; + result +:= elbat + nl + FI # TOHTML # ; + +# test the tree visualisation # + +# returns a new node with the specified value and no child or siblings # +PROC new node = ( STRING value )REF NODE: HEAP NODE := NODE( value, nil node, nil node ); +# appends a sibling node to the node n, returns the sibling # +OP +:= = ( REF NODE n, REF NODE sibling node )REF NODE: + BEGIN + REF NODE sibling := n; + WHILE REF NODE( sibling OF sibling ) ISNT nil node + DO + sibling := sibling OF sibling + OD; + sibling OF sibling := sibling node + END # +:= # ; +# appends a new sibling node to the node n, returns the sibling # +OP +:= = ( REF NODE n, STRING sibling value )REF NODE: n +:= new node( sibling value ); +# adds a child node to the node n, returns the child # +OP /:= = ( REF NODE n, REF NODE child node )REF NODE: child OF n := child node; +# adda a new child node to the node n, returns the child # +OP /:= = ( REF NODE n, STRING child value )REF NODE: n /:= new node( child value ); + +NODE animals := new node( "animals" ); +NODE fish := new node( "fish" ); +NODE reptiles := new node( "reptiles" ); +NODE mammals := new node( "mammals" ); +NODE primates := new node( "primates" ); +NODE sharks := new node( "sharks" ); +sharks /:= "great-white" +:= "hammer-head"; +fish /:= "cod" +:= sharks +:= "piranha"; +reptiles /:= "iguana" +:= "brontosaurus"; +primates /:= "gorilla" +:= "lemur"; +mammals /:= "sloth" +:= "horse" +:= "bison" +:= primates; +animals /:= fish +:= reptiles +:= mammals; + +print( ( TOHTML animals ) ) diff --git a/Task/Visualize-a-tree/Elena/visualize-a-tree.elena b/Task/Visualize-a-tree/Elena/visualize-a-tree.elena new file mode 100644 index 0000000000..d8a2158d2d --- /dev/null +++ b/Task/Visualize-a-tree/Elena/visualize-a-tree.elena @@ -0,0 +1,62 @@ +#import system. +#import system'routines. +#import extensions. + +#class Node +{ + #field theValue. + #field theChildren. + + #constructor new : value &children:children + [ + theValue := value. + theChildren := children toArray. + ] + + #constructor new : value + <= new:value &children:nil. + + #constructor new &children:children + <= new:emptyLiteralValue &children:children. + + #constructor new : value &child:child + <= new:value &children:(Array new &object:child). + + #method get = theValue. + + #method children = theChildren. +} + +#class(extension)treeOp +{ + #method writeTree:node:prefix &subject:childrenProp + [ + #var children := node::childrenProp get. + #var length := children length. + children zip:(RangeEnumerator new &from:1 &to:length) &eachPair:(:child:index) + [ + self writeLine:prefix:"|". + self writeLine:prefix:"+---":(child get). + #var nodeLine := prefix + (index==length)iif:" ":"| ". + + self writeTree:child:nodeLine &subject:childrenProp. + ]. + ^ self. + ] + + #method writeTree:node &subject:childrenProp + = self writeTree:node:"" &subject:childrenProp. +} + +#symbol program = +[ + #var tree := Node new &children: + ( + Node new:"a" &children: + ( + Node new:"c" &child:(Node new:"d"), + Node new:"d" + ), + Node new:"b"). + console writeTree:tree &subject:%children. +]. diff --git a/Task/Visualize-a-tree/Perl-6/visualize-a-tree.pl6 b/Task/Visualize-a-tree/Perl-6/visualize-a-tree.pl6 index dc3712b0c3..f51f768d09 100644 --- a/Task/Visualize-a-tree/Perl-6/visualize-a-tree.pl6 +++ b/Task/Visualize-a-tree/Perl-6/visualize-a-tree.pl6 @@ -20,4 +20,4 @@ sub visualize-tree($tree, &label, &children, # example tree built up of pairs my $tree = root=>[a=>[a1=>[a11=>[]]],b=>[b1=>[b11=>[]],b2=>[],b3=>[]]]; -.say for visualize-tree($tree, *.key, *.value.list); +.map({.join("\n")}).join("\n").say for visualize-tree($tree, *.key, *.value.list); diff --git a/Task/Visualize-a-tree/Rust/visualize-a-tree.rust b/Task/Visualize-a-tree/Rust/visualize-a-tree.rust new file mode 100644 index 0000000000..f017a12c0e --- /dev/null +++ b/Task/Visualize-a-tree/Rust/visualize-a-tree.rust @@ -0,0 +1,166 @@ +extern crate rustc_serialize; +extern crate term_painter; + +use rustc_serialize::json; +use std::fmt::{Debug, Display, Formatter, Result}; +use term_painter::ToStyle; +use term_painter::Color::*; + +type NodePtr = Option; + +#[derive(Debug, PartialEq, Clone, Copy)] +enum Side { + Left, + Right, + Up, +} + +#[derive(Debug, PartialEq, Clone, Copy)] +enum DisplayElement { + TrunkSpace, + SpaceLeft, + SpaceRight, + SpaceSpace, + Root, +} + +impl DisplayElement { + fn string(&self) -> String { + match *self { + DisplayElement::TrunkSpace => " │ ".to_string(), + DisplayElement::SpaceRight => " ┌───".to_string(), + DisplayElement::SpaceLeft => " └───".to_string(), + DisplayElement::SpaceSpace => " ".to_string(), + DisplayElement::Root => "├──".to_string(), + } + } +} + +#[derive(Debug, Clone, Copy, RustcDecodable, RustcEncodable)] +struct Node { + key: K, + value: V, + left: NodePtr, + right: NodePtr, + up: NodePtr, +} + +impl Node { + pub fn get_ptr(&self, side: Side) -> NodePtr { + match side { + Side::Up => self.up, + Side::Left => self.left, + _ => self.right, + } + } +} + +#[derive(Debug, RustcDecodable, RustcEncodable)] +struct Tree { + root: NodePtr, + store: Vec>, +} + +impl Tree { + pub fn get_node(&self, np: NodePtr) -> Node { + assert!(np.is_some()); + self.store[np.unwrap()] + } + + pub fn get_pointer(&self, np: NodePtr, side: Side) -> NodePtr { + assert!(np.is_some()); + self.store[np.unwrap()].get_ptr(side) + } + + // Prints the tree with root p. The idea is to do an in-order traversal + // (reverse in-order in this case, where right is on top), and print nodes as they + // are visited, one per line. Each invocation of display() gets its own copy + // of the display element vector e, which is grown with either whitespace or + // a trunk element, then modified in its last and possibly second-to-last + // characters in context. + fn display(&self, p: NodePtr, side: Side, e: &Vec, f: &mut Formatter) { + if p.is_none() { + return; + } + + let mut elems = e.clone(); + let node = self.get_node(p); + let mut tail = DisplayElement::SpaceSpace; + if node.up != self.root { + // If the direction is switching, I need the trunk element to appear in the lines + // printed before that node is visited. + if side == Side::Left && node.right.is_some() { + elems.push(DisplayElement::TrunkSpace); + } else { + elems.push(DisplayElement::SpaceSpace); + } + } + let hindex = elems.len() - 1; + self.display(node.right, Side::Right, &elems, f); + + if p == self.root { + elems[hindex] = DisplayElement::Root; + tail = DisplayElement::TrunkSpace; + } else if side == Side::Right { + // Right subtree finished + elems[hindex] = DisplayElement::SpaceRight; + // Prepare trunk element in case there is a left subtree + tail = DisplayElement::TrunkSpace; + } else if side == Side::Left { + elems[hindex] = DisplayElement::SpaceLeft; + let parent = self.get_node(node.up); + if parent.up.is_some() && self.get_pointer(parent.up, Side::Right) == node.up { + // Direction switched, need trunk element starting with this node/line + elems[hindex - 1] = DisplayElement::TrunkSpace; + } + } + + // Visit node => print accumulated elements. Each node gets a line and each line gets a + // node. + for e in elems.clone() { + let _ = write!(f, "{}", e.string()); + } + let _ = write!(f, + "{key:>width$} ", + key = Green.bold().paint(node.key), + width = 2); + let _ = write!(f, + "{value:>width$}\n", + value = Blue.bold().paint(format!("{:.*}", 2, node.value)), + width = 4); + + // Overwrite last element before continuing traversal + elems[hindex] = tail; + + self.display(node.left, Side::Left, &elems, f); + } +} + +impl Display for Tree { + fn fmt(&self, f: &mut Formatter) -> Result { + if self.root.is_none() { + write!(f, "[empty]") + } else { + let mut v: Vec = Vec::new(); + self.display(self.root, Side::Up, &mut v, f); + Ok(()) + } + } +} + +/// Decodes and prints a previously generated tree. +fn main() { + let encoded = r#"{"root":0,"store":[{"key":0,"value":0.45,"left":1,"right":3, + "up":null},{"key":-8,"value":-0.94,"left":7,"right":2,"up":0}, {"key":-1, + "value":0.15,"left":8,"right":null,"up":1},{"key":7, "value":-0.29,"left":4, + "right":9,"up":0},{"key":5,"value":0.80,"left":5,"right":null,"up":3}, + {"key":4,"value":-0.85,"left":6,"right":null,"up":4},{"key":3,"value":-0.46, + "left":null,"right":null,"up":5},{"key":-10,"value":-0.85,"left":null, + "right":13,"up":1},{"key":-6,"value":-0.42,"left":null,"right":10,"up":2}, + {"key":9,"value":0.63,"left":12,"right":null,"up":3},{"key":-3,"value":-0.83, + "left":null,"right":11,"up":8},{"key":-2,"value":0.75,"left":null,"right":null, + "up":10},{"key":8,"value":-0.48,"left":null,"right":null,"up":9},{"key":-9, + "value":0.53,"left":null,"right":null,"up":7}]}"#; + let tree: Tree = json::decode(&encoded).unwrap(); + println!("{}", tree); +} diff --git a/Task/Voronoi-diagram/Delphi/voronoi-diagram.delphi b/Task/Voronoi-diagram/Delphi/voronoi-diagram.delphi new file mode 100644 index 0000000000..9e46be8da5 --- /dev/null +++ b/Task/Voronoi-diagram/Delphi/voronoi-diagram.delphi @@ -0,0 +1,105 @@ +procedure TForm1.Voronoi; +const + p = 3; + cells = 100; + size = 1000; + +var + aCanvas : TCanvas; + px, py: array of integer; + color: array of Tcolor; + Img: TBitmap; + lastColor:Integer; + auxList: TList; + poligonlist : TDictionary>; + pointarray : array of TPoint; + + n,i,x,y,k,j: Integer; + d1,d2: double; + + function distance(x1,x2,y1,y2 :Integer) : Double; + begin + result := sqrt((x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2)); ///Euclidian + // result := abs(x1 - x2) + abs(y1 - y2); // Manhattan + // result := power(power(abs(x1 - x2), p) + power(abs(y1 - y2), p), (1 / p)); // Minkovski + end; + +begin + + poligonlist := TDictionary>.create; + + n := 0; + Randomize; + + img := TBitmap.Create; + img.Width :=1000; + img.Height :=1000; + + setlength(px,cells); + setlength(py,cells); + setlength(color,cells); + + for i:= 0 to cells-1 do + begin + px[i] := Random(size); + py[i] := Random(size); + + color[i] := Random(16777215); + auxList := TList.Create; + poligonlist.Add(i,auxList); + end; + + for x := 0 to size - 1 do + begin + lastColor:= 0; + for y := 0 to size - 1 do + begin + n:= 0; + + for i := 0 to cells - 1 do + begin + d1:= distance(px[i], x, py[i], y); + d2:= distance(px[n], x, py[n], y); + + if d1 < d2 then + begin + n := i; + end; + end; + if n <> lastColor then + begin + poligonlist[n].Add(Point(x,y)); + poligonlist[lastColor].Add(Point(x,y)); + lastColor := n; + end; + end; + + poligonlist[n].Add(Point(x,y)); + poligonlist[lastColor].Add(Point(x,y)); + lastColor := n; + end; + + for j := 0 to cells -1 do + begin + + SetLength(pointarray, poligonlist[j].Count); + for I := 0 to poligonlist[j].Count - 1 do + begin + if Odd(i) then + pointarray[i] := poligonlist[j].Items[i]; + end; + for I := 0 to poligonlist[j].Count - 1 do + begin + if not Odd(i) then + pointarray[i] := poligonlist[j].Items[i]; + end; + Img.Canvas.Pen.Color := color[j]; + Img.Canvas.Brush.Color := color[j]; + Img.Canvas.Polygon(pointarray); + + Img.Canvas.Pen.Color := clBlack; + Img.Canvas.Brush.Color := clBlack; + Img.Canvas.Rectangle(px[j] -2, py[j] -2, px[j] +2, py[j] +2); + end; + Canvas.Draw(0,0, img); +end; diff --git a/Task/Voronoi-diagram/Lua/voronoi-diagram.lua b/Task/Voronoi-diagram/Lua/voronoi-diagram.lua index 0c3feef394..08ea1b04f3 100644 --- a/Task/Voronoi-diagram/Lua/voronoi-diagram.lua +++ b/Task/Voronoi-diagram/Lua/voronoi-diagram.lua @@ -1,77 +1,77 @@ -function love.load() - love.math.setRandomSeed(os.time()) --set the random seed - keys = {} --an empty table where we will store key presses - number_cells = 50 --the number of cells we want in our diagram - --draw the voronoi diagram to a canvas - voronoiDiagram = generateVoronoi(love.window.getWidth(), love.window.getHeight(), number_cells) +function love.load( ) + love.math.setRandomSeed( os.time( ) ) --set the random seed + keys = { } --an empty table where we will store key presses + number_cells = 50 --the number of cells we want in our diagram + --draw the voronoi diagram to a canvas + voronoiDiagram = generateVoronoi( love.graphics.getWidth( ), love.graphics.getHeight( ), number_cells ) end -function hypot(x,y) - return math.sqrt(x*x + y*y) +function hypot( x, y ) + return math.sqrt( x*x + y*y ) end -function generateVoronoi(width, height, num_cells) - canvas = love.graphics.newCanvas(width, height) - local imgx = canvas:getWidth() - local imgy = canvas:getHeight() - local nx = {} - local ny = {} - local nr = {} - local ng = {} - local nb = {} - for a = 1, num_cells do - table.insert(nx, love.math.random(0,imgx)) - table.insert(ny, love.math.random(0,imgy)) - table.insert(nr, love.math.random(0,255)) - table.insert(ng, love.math.random(0,255)) - table.insert(nb, love.math.random(0,255)) - end - love.graphics.setColor({255,255,255}) - love.graphics.setCanvas(canvas) - for y = 1, imgy do +function generateVoronoi( width, height, num_cells ) + canvas = love.graphics.newCanvas( width, height ) + local imgx = canvas:getWidth( ) + local imgy = canvas:getHeight( ) + local nx = { } + local ny = { } + local nr = { } + local ng = { } + local nb = { } + for a = 1, num_cells do + table.insert( nx, love.math.random( 0, imgx ) ) + table.insert( ny, love.math.random( 0, imgy ) ) + table.insert( nr, love.math.random( 0, 255 ) ) + table.insert( ng, love.math.random( 0, 255 ) ) + table.insert( nb, love.math.random( 0, 255 ) ) + end + love.graphics.setColor( { 255, 255, 255 } ) + love.graphics.setCanvas( canvas ) + for y = 1, imgy do for x = 1, imgx do - dmin = hypot(imgx-1, imgy-1) - j = -1 - for i = 1, num_cells do - d = hypot(nx[i]-x, ny[i]-y) + dmin = hypot( imgx-1, imgy-1 ) + j = -1 + for i = 1, num_cells do + d = hypot( nx[i]-x, ny[i]-y ) if d < dmin then dmin = d - j = i + j = i end - end - love.graphics.setColor({nr[j], ng[j], nb[j]}) - love.graphics.point(x, y) + end + love.graphics.setColor( { nr[j], ng[j], nb[j] } ) + love.graphics.points( x, y ) end - end - --reset color - love.graphics.setColor({255,255,255}) - --draw points - for b = 1, num_cells do - love.graphics.point(nx[b], ny[b]) - end - love.graphics.setCanvas() - return canvas + end + --reset color + love.graphics.setColor( { 255, 255, 255 } ) + --draw points + for b = 1, num_cells do + love.graphics.points( nx[b], ny[b] ) + end + love.graphics.setCanvas( ) + return canvas end - + --RENDER -function love.draw() - --reset color - love.graphics.setColor({255,255,255}) - --draw diagram - love.graphics.draw(voronoiDiagram) - --draw drop shadow text - love.graphics.setColor({0,0,0}) - love.graphics.print("space: regenerate\nesc: quit",1,1) - --draw text - love.graphics.setColor({200,200,0}) - love.graphics.print("space: regenerate\nesc: quit") +function love.draw( ) + --reset color + love.graphics.setColor( { 255, 255, 255 } ) + --draw diagram + love.graphics.draw( voronoiDiagram ) + --draw drop shadow text + love.graphics.setColor( { 0, 0, 0 } ) + love.graphics.print( "space: regenerate\nesc: quit", 1, 1 ) + --draw text + love.graphics.setColor( { 200, 200, 0 } ) + love.graphics.print( "space: regenerate\nesc: quit" ) end --CONTROL -function love.keyreleased(key) - if key == ' ' then - voronoiDiagram = generateVoronoi(love.window.getWidth(), love.window.getHeight(), number_cells) - elseif key == 'escape' then - love.event.quit() - end +function love.keyreleased( key ) + if key == 'space' then + voronoiDiagram = generateVoronoi( love.graphics.getWidth( ), love.graphics.getHeight( ), number_cells ) + elseif key == 'escape' then + love.event.quit( ) + end end diff --git a/Task/Walk-a-directory-Non-recursively/00DESCRIPTION b/Task/Walk-a-directory-Non-recursively/00DESCRIPTION index f3bf25ca81..bcb129c069 100644 --- a/Task/Walk-a-directory-Non-recursively/00DESCRIPTION +++ b/Task/Walk-a-directory-Non-recursively/00DESCRIPTION @@ -1,5 +1,14 @@ -Walk a given directory and print the ''names'' of files matching a given pattern. (How is "pattern" defined? substring match? DOS pattern? BASH pattern? ZSH pattern? Perl regular expression?) +;Task: +Walk a given directory and print the ''names'' of files matching a given pattern. -'''Note:''' This task is for non-recursive methods. These tasks should read a ''single directory'', not an entire directory tree. For code examples that read entire directory trees, see [[Walk Directory Tree]] +(How is "pattern" defined? substring match? DOS pattern? BASH pattern? ZSH pattern? Perl regular expression?) + + +'''Note:''' This task is for non-recursive methods.   These tasks should read a ''single directory'', not an entire directory tree. '''Note:''' Please be careful when running any code presented here. + + +;Related task: +*   [[Walk Directory Tree]]   (read entire directory tree). +

    diff --git a/Task/Walk-a-directory-Non-recursively/Elixir/walk-a-directory-non-recursively.elixir b/Task/Walk-a-directory-Non-recursively/Elixir/walk-a-directory-non-recursively.elixir new file mode 100644 index 0000000000..1c7eae0650 --- /dev/null +++ b/Task/Walk-a-directory-Non-recursively/Elixir/walk-a-directory-non-recursively.elixir @@ -0,0 +1,5 @@ +# current directory +IO.inspect File.ls! + +dir = "/users/public" +IO.inspect File.ls!(dir) diff --git a/Task/Walk-a-directory-Non-recursively/Perl-6/walk-a-directory-non-recursively.pl6 b/Task/Walk-a-directory-Non-recursively/Perl-6/walk-a-directory-non-recursively.pl6 index 0e19598c8b..5b24815662 100644 --- a/Task/Walk-a-directory-Non-recursively/Perl-6/walk-a-directory-non-recursively.pl6 +++ b/Task/Walk-a-directory-Non-recursively/Perl-6/walk-a-directory-non-recursively.pl6 @@ -1 +1 @@ -.say for dir(".", :test(/foo/)) +.say for dir ".", :test(/foo/); diff --git a/Task/Walk-a-directory-Non-recursively/Python/walk-a-directory-non-recursively-1.py b/Task/Walk-a-directory-Non-recursively/Python/walk-a-directory-non-recursively-1.py index 9cc4baef6e..9fad9d1e3c 100644 --- a/Task/Walk-a-directory-Non-recursively/Python/walk-a-directory-non-recursively-1.py +++ b/Task/Walk-a-directory-Non-recursively/Python/walk-a-directory-non-recursively-1.py @@ -1,3 +1,3 @@ import glob for filename in glob.glob('/foo/bar/*.mp3'): - print filename + print(filename) diff --git a/Task/Walk-a-directory-Non-recursively/Python/walk-a-directory-non-recursively-2.py b/Task/Walk-a-directory-Non-recursively/Python/walk-a-directory-non-recursively-2.py index 72501f62cc..8f0fcbf0f5 100644 --- a/Task/Walk-a-directory-Non-recursively/Python/walk-a-directory-non-recursively-2.py +++ b/Task/Walk-a-directory-Non-recursively/Python/walk-a-directory-non-recursively-2.py @@ -1,4 +1,4 @@ import os for filename in os.listdir('/foo/bar'): if filename.endswith('.mp3'): - print filename + print(filename) diff --git a/Task/Walk-a-directory-Non-recursively/Run-BASIC/walk-a-directory-non-recursively.run b/Task/Walk-a-directory-Non-recursively/Run-BASIC/walk-a-directory-non-recursively.run new file mode 100644 index 0000000000..7ef5c15f00 --- /dev/null +++ b/Task/Walk-a-directory-Non-recursively/Run-BASIC/walk-a-directory-non-recursively.run @@ -0,0 +1,12 @@ +files #g, DefaultDir$ + "\*.jpg" ' find all jpg files + +if #g HASANSWER() then + count = #g rowcount() ' get count of files + for i = 1 to count + if #g hasanswer() then 'retrieve info for next file + #g nextfile$() 'print name of file + print #g NAME$() + end if + next +end if +wait diff --git a/Task/Walk-a-directory-Recursively/00DESCRIPTION b/Task/Walk-a-directory-Recursively/00DESCRIPTION index ea4158d255..b18e56ce5d 100644 --- a/Task/Walk-a-directory-Recursively/00DESCRIPTION +++ b/Task/Walk-a-directory-Recursively/00DESCRIPTION @@ -1,5 +1,13 @@ +;Task: Walk a given directory ''tree'' and print files matching a given pattern. -'''Note:''' This task is for recursive methods. These tasks should read an entire directory tree, not a ''single directory''. For code examples that read a ''single directory'', see [[Walk a directory/Non-recursively]]. + +'''Note:''' This task is for recursive methods.   These tasks should read an entire directory tree, not a ''single directory''. + '''Note:''' Please be careful when running any code examples found here. + + +;Related task: +*   [[Walk a directory/Non-recursively]]   (read a ''single directory''). +

    diff --git a/Task/Walk-a-directory-Recursively/Common-Lisp/walk-a-directory-recursively-1.lisp b/Task/Walk-a-directory-Recursively/Common-Lisp/walk-a-directory-recursively-1.lisp index dd2534d093..9502faa933 100644 --- a/Task/Walk-a-directory-Recursively/Common-Lisp/walk-a-directory-recursively-1.lisp +++ b/Task/Walk-a-directory-Recursively/Common-Lisp/walk-a-directory-recursively-1.lisp @@ -1,5 +1,9 @@ -(defun mapc-directory-tree (fn directory) +(ql:quickload :cl-fad) +(defun mapc-directory-tree (fn directory &key (depth-first-p t)) (dolist (entry (cl-fad:list-directory directory)) + (unless depth-first-p + (funcall fn entry)) (when (cl-fad:directory-pathname-p entry) (mapc-directory-tree fn entry)) - (funcall fn entry))) + (when depth-first-p + (funcall fn entry)))) diff --git a/Task/Walk-a-directory-Recursively/Elixir/walk-a-directory-recursively.elixir b/Task/Walk-a-directory-Recursively/Elixir/walk-a-directory-recursively.elixir new file mode 100644 index 0000000000..3ddd7dc2d5 --- /dev/null +++ b/Task/Walk-a-directory-Recursively/Elixir/walk-a-directory-recursively.elixir @@ -0,0 +1,10 @@ +defmodule Walk_directory do + def recursive(dir \\ ".") do + Enum.each(File.ls!(dir), fn file -> + IO.puts fname = "#{dir}/#{file}" + if File.dir?(fname), do: recursive(fname) + end) + end +end + +Walk_directory.recursive diff --git a/Task/Walk-a-directory-Recursively/Emacs-Lisp/walk-a-directory-recursively.l b/Task/Walk-a-directory-Recursively/Emacs-Lisp/walk-a-directory-recursively.l new file mode 100644 index 0000000000..e87b7d552c --- /dev/null +++ b/Task/Walk-a-directory-Recursively/Emacs-Lisp/walk-a-directory-recursively.l @@ -0,0 +1,2 @@ +ELISP> (directory-files-recursively "/tmp/el" "\\.el$") +("/tmp/el/1/c.el" "/tmp/el/a.el" "/tmp/el/b.el") diff --git a/Task/Walk-a-directory-Recursively/Go/walk-a-directory-recursively.go b/Task/Walk-a-directory-Recursively/Go/walk-a-directory-recursively.go index dc62858604..f34d57f1c7 100644 --- a/Task/Walk-a-directory-Recursively/Go/walk-a-directory-recursively.go +++ b/Task/Walk-a-directory-Recursively/Go/walk-a-directory-recursively.go @@ -11,7 +11,7 @@ func VisitFile(fp string, fi os.FileInfo, err error) error { fmt.Println(err) // can't walk here, return nil // but continue walking elsewhere } - if !!fi.IsDir() { + if fi.IsDir() { return nil // not a file. ignore. } matched, err := filepath.Match("*.mp3", fi.Name()) diff --git a/Task/Walk-a-directory-Recursively/Groovy/walk-a-directory-recursively.groovy b/Task/Walk-a-directory-Recursively/Groovy/walk-a-directory-recursively-1.groovy similarity index 100% rename from Task/Walk-a-directory-Recursively/Groovy/walk-a-directory-recursively.groovy rename to Task/Walk-a-directory-Recursively/Groovy/walk-a-directory-recursively-1.groovy diff --git a/Task/Walk-a-directory-Recursively/Groovy/walk-a-directory-recursively-2.groovy b/Task/Walk-a-directory-Recursively/Groovy/walk-a-directory-recursively-2.groovy new file mode 100644 index 0000000000..500f51f676 --- /dev/null +++ b/Task/Walk-a-directory-Recursively/Groovy/walk-a-directory-recursively-2.groovy @@ -0,0 +1 @@ +new File('.').eachFileRecurse ~/.*\.txt/, { println it } diff --git a/Task/Walk-a-directory-Recursively/Groovy/walk-a-directory-recursively-3.groovy b/Task/Walk-a-directory-Recursively/Groovy/walk-a-directory-recursively-3.groovy new file mode 100644 index 0000000000..0a3d815dcf --- /dev/null +++ b/Task/Walk-a-directory-Recursively/Groovy/walk-a-directory-recursively-3.groovy @@ -0,0 +1 @@ +new File('.').eachFileRecurse FILES, ~/.*\.txt/, { println it } diff --git a/Task/Walk-a-directory-Recursively/Groovy/walk-a-directory-recursively-4.groovy b/Task/Walk-a-directory-Recursively/Groovy/walk-a-directory-recursively-4.groovy new file mode 100644 index 0000000000..8a98eb4167 --- /dev/null +++ b/Task/Walk-a-directory-Recursively/Groovy/walk-a-directory-recursively-4.groovy @@ -0,0 +1,5 @@ +new File('.').traverse( + type : FILES, + nameFilter : ~/.*\.txt/, + preDir : { if (it.name == '.svn') return SKIP_SUBTREE }, +) { println it } diff --git a/Task/Walk-a-directory-Recursively/Haskell/walk-a-directory-recursively.hs b/Task/Walk-a-directory-Recursively/Haskell/walk-a-directory-recursively-1.hs similarity index 100% rename from Task/Walk-a-directory-Recursively/Haskell/walk-a-directory-recursively.hs rename to Task/Walk-a-directory-Recursively/Haskell/walk-a-directory-recursively-1.hs diff --git a/Task/Walk-a-directory-Recursively/Haskell/walk-a-directory-recursively-2.hs b/Task/Walk-a-directory-Recursively/Haskell/walk-a-directory-recursively-2.hs new file mode 100644 index 0000000000..77e5c0865b --- /dev/null +++ b/Task/Walk-a-directory-Recursively/Haskell/walk-a-directory-recursively-2.hs @@ -0,0 +1,73 @@ +########################### +# A sequential solution # +########################### + +procedure main() +every write(!getdirs(".")) # writes out all directories from the current directory down +end + +procedure getdirs(s) #: return a list of directories beneath the directory 's' +local D,d,f + +if ( stat(s).mode ? ="d" ) & ( d := open(s) ) then { + D := [s] + while f := read(d) do + if not ( ".." ? =f ) then # skip . and .. + D |||:= getdirs(s || "/" ||f) + close(d) + return D + } +end + +######################### +# A threaded solution # +######################### + +import threads + +global n, # number of the concurrently running threads + maxT, # Max number of concurrent threads ("soft limit") + tot_threads # the total number of threads created in the program + +procedure main(argv) + target := argv[1] | stop("Usage: tdir [dir name] [#threads]. #threads default to 2* the number of cores in the machine.") + tot_threads := n := 1 + maxT := ( integer(argv[2])| + (&features? if ="CPU cores " then cores := integer(tab(0)) * 2) | # available cores * 2 + 4) # default to 4 threads + t := milliseconds() + L := getdirs(target) # writes out all directories from the current directory down + write((*\L)| 0, " directories in ", milliseconds() - t, + " ms using ", maxT, "-concurrent/", tot_threads, "-total threads" ) +end + +procedure getdirs(s) # return a list of directories beneath the directory 's' +local D,d,f, thrd + +if ( stat(s).mode ? ="d" ) & ( d := open(s) ) then { + D := [s] + while f := read(d) do + if not ( ".." ? =f ) then # skip . and .. + if n>=maxT then # max thread count reached + D |||:= getdirs(s || "/" ||f) + else # spawn a new thread for this directory + {/thrd:=[]; n +:= 1; put(thrd, thread getdirs(s || "/" ||f))} + + close(d) + + if \thrd then{ # If I have threads, collect their results + tot_threads +:= *thrd + n -:= 1 # allow new threads to be spawned while I'm waiting/collecting results + every wait(th := !thrd) do { # wait for the thread to finish + n -:= 1 + D |||:= <@th # If the thread produced a result, it is going to be + # stored in its "outbox", <@th in this case serves as + # a deferred return since the thread was created by + # thread getdirs(s || "/" ||f) + # this is similar to co-expression activation semantics + } + n +:= 1 + } + return D + } +end diff --git a/Task/Walk-a-directory-Recursively/IDL/walk-a-directory-recursively.idl b/Task/Walk-a-directory-Recursively/IDL/walk-a-directory-recursively.idl new file mode 100644 index 0000000000..965dac6580 --- /dev/null +++ b/Task/Walk-a-directory-Recursively/IDL/walk-a-directory-recursively.idl @@ -0,0 +1 @@ +result = file_search( directory, '*.txt', count=cc ) diff --git a/Task/Walk-a-directory-Recursively/MATLAB/walk-a-directory-recursively.m b/Task/Walk-a-directory-Recursively/MATLAB/walk-a-directory-recursively.m index a783edae27..df461bd93b 100644 --- a/Task/Walk-a-directory-Recursively/MATLAB/walk-a-directory-recursively.m +++ b/Task/Walk-a-directory-Recursively/MATLAB/walk-a-directory-recursively.m @@ -1,7 +1,7 @@ function walk_a_directory_recursively(d, pattern) f = dir(fullfile(d,pattern)); for k = 1:length(f) - printf('%s\n',fullfile(d,f(k).name)); + fprintf('%s\n',fullfile(d,f(k).name)); end; f = dir(d); diff --git a/Task/Walk-a-directory-Recursively/OCaml/walk-a-directory-recursively.ocaml b/Task/Walk-a-directory-Recursively/OCaml/walk-a-directory-recursively.ocaml index d8df9fe444..a21cb12e9e 100644 --- a/Task/Walk-a-directory-Recursively/OCaml/walk-a-directory-recursively.ocaml +++ b/Task/Walk-a-directory-Recursively/OCaml/walk-a-directory-recursively.ocaml @@ -4,7 +4,8 @@ open Unix let walk_directory_tree dir pattern = - let select str = Str.string_match (Str.regexp pattern) str 0 in + let re = Str.regexp pattern in (* pre-compile the regexp *) + let select str = Str.string_match re str 0 in let rec walk acc = function | [] -> (acc) | dir::tail -> diff --git a/Task/Walk-a-directory-Recursively/Perl-6/walk-a-directory-recursively-1.pl6 b/Task/Walk-a-directory-Recursively/Perl-6/walk-a-directory-recursively-1.pl6 new file mode 100644 index 0000000000..33af63e1a1 --- /dev/null +++ b/Task/Walk-a-directory-Recursively/Perl-6/walk-a-directory-recursively-1.pl6 @@ -0,0 +1,3 @@ +use File::Find; + +.say for find dir => '.', name => /'.txt' $/; diff --git a/Task/Walk-a-directory-Recursively/Perl-6/walk-a-directory-recursively-2.pl6 b/Task/Walk-a-directory-Recursively/Perl-6/walk-a-directory-recursively-2.pl6 new file mode 100644 index 0000000000..59778c12f2 --- /dev/null +++ b/Task/Walk-a-directory-Recursively/Perl-6/walk-a-directory-recursively-2.pl6 @@ -0,0 +1,8 @@ +sub find-files ($dir, Mu :$test) { + gather for dir $dir -> $path { + if $path.basename ~~ $test { take $path } + if $path.d { .take for find-files $path, :$test }; + } +} + +.put for find-files '.', test => /'.txt' $/; diff --git a/Task/Walk-a-directory-Recursively/Perl-6/walk-a-directory-recursively-3.pl6 b/Task/Walk-a-directory-Recursively/Perl-6/walk-a-directory-recursively-3.pl6 new file mode 100644 index 0000000000..788c2fdf3e --- /dev/null +++ b/Task/Walk-a-directory-Recursively/Perl-6/walk-a-directory-recursively-3.pl6 @@ -0,0 +1,5 @@ +sub find-files ($dir, :$pattern) { + run('find', $dir, '-iname', $pattern, '-print0', :out, :nl«\0»).out.lines; +} + +.say for find-files '.', pattern => '*.txt'; diff --git a/Task/Walk-a-directory-Recursively/Perl-6/walk-a-directory-recursively.pl6 b/Task/Walk-a-directory-Recursively/Perl-6/walk-a-directory-recursively.pl6 deleted file mode 100644 index 0a8aa5fa70..0000000000 --- a/Task/Walk-a-directory-Recursively/Perl-6/walk-a-directory-recursively.pl6 +++ /dev/null @@ -1,3 +0,0 @@ -use File::Find; - -.say for find(dir => '.').grep(/foo/); diff --git a/Task/Walk-a-directory-Recursively/Perl/walk-a-directory-recursively-1.pl b/Task/Walk-a-directory-Recursively/Perl/walk-a-directory-recursively-1.pl new file mode 100644 index 0000000000..773a578ab3 --- /dev/null +++ b/Task/Walk-a-directory-Recursively/Perl/walk-a-directory-recursively-1.pl @@ -0,0 +1,5 @@ +use File::Find qw(find); +my $dir = '.'; +my $pattern = 'foo'; +my $callback = sub { print $File::Find::name, "\n" if /$pattern/ }; +find $callback, $dir; diff --git a/Task/Walk-a-directory-Recursively/Perl/walk-a-directory-recursively-2.pl b/Task/Walk-a-directory-Recursively/Perl/walk-a-directory-recursively-2.pl new file mode 100644 index 0000000000..4a693ad2ee --- /dev/null +++ b/Task/Walk-a-directory-Recursively/Perl/walk-a-directory-recursively-2.pl @@ -0,0 +1,13 @@ +sub shellquote { "'".(shift =~ s/'/'\\''/gr). "'" } + +sub find_files { + my $dir = shellquote(shift); + my $test = shellquote(shift); + + local $/ = "\0"; + open my $pipe, "find $dir -iname $test -print0 |" or die "find: $!.\n"; + while (<$pipe>) { print "$_\n"; } # Here you could do something else with each file path, other than simply printing it. + close $pipe; +} + +find_files('.', '*.mp3'); diff --git a/Task/Walk-a-directory-Recursively/Perl/walk-a-directory-recursively.pl b/Task/Walk-a-directory-Recursively/Perl/walk-a-directory-recursively.pl deleted file mode 100644 index dd9c47ed8f..0000000000 --- a/Task/Walk-a-directory-Recursively/Perl/walk-a-directory-recursively.pl +++ /dev/null @@ -1,4 +0,0 @@ -use File::Find qw(find); -my $dir = '.'; -my $pattern = 'foo'; -find sub {print $File::Find::name if /$pattern/}, $dir; diff --git a/Task/Walk-a-directory-Recursively/REXX/walk-a-directory-recursively-1.rexx b/Task/Walk-a-directory-Recursively/REXX/walk-a-directory-recursively-1.rexx new file mode 100644 index 0000000000..dfc26983f0 --- /dev/null +++ b/Task/Walk-a-directory-Recursively/REXX/walk-a-directory-recursively-1.rexx @@ -0,0 +1,18 @@ +/*REXX program shows all files in a directory tree that match a given search criteria.*/ +parse arg xdir; if xdir='' then xdir='\' /*Any DIR specified? Then use default.*/ +@.=0 /*default result in case ADDRESS fails.*/ +dirCmd= 'DIR /b /s' /*the DOS command to do heavy lifting. */ +trace off /*suppress REXX error message for fails*/ +address system dirCmd xdir with output stem @. /*issue the DOS DIR command with option*/ +if rc\==0 then do /*did the DOS DIR command get an error?*/ + say '***error!*** from DIR' xDIR /*error message that shows "que pasa". */ + say 'return code=' rc /*show the return code from DOS DIR.*/ + exit rc /*exit with " " " " " */ + end /* [↑] bad ADDRESS cmd (from DOS DIR)*/ +#=@.rc /*the number of @. entries generated.*/ +if #==0 then #=' no ' /*use a better word choice for 0 (zero)*/ +say center('directory ' xdir " has " # ' matching entries.', 79, "─") + + do j=1 for #; say @.j /*show all the files that met criteria.*/ + end /*j*/ +exit @.0+rc /*stick a fork in it, we're all done. */ diff --git a/Task/Walk-a-directory-Recursively/REXX/walk-a-directory-recursively-2.rexx b/Task/Walk-a-directory-Recursively/REXX/walk-a-directory-recursively-2.rexx new file mode 100644 index 0000000000..05558edb0e --- /dev/null +++ b/Task/Walk-a-directory-Recursively/REXX/walk-a-directory-recursively-2.rexx @@ -0,0 +1 @@ +'dir /s /b "%windir%\System32\*.exe"' diff --git a/Task/Walk-a-directory-Recursively/REXX/walk-a-directory-recursively.rexx b/Task/Walk-a-directory-Recursively/REXX/walk-a-directory-recursively.rexx deleted file mode 100644 index 12f237fc85..0000000000 --- a/Task/Walk-a-directory-Recursively/REXX/walk-a-directory-recursively.rexx +++ /dev/null @@ -1,17 +0,0 @@ -/*REXX program shows files in a single directory that match a criteria.*/ -parse arg xdir; if xdir='' then xdir='\' /*Any DIR? Use default.*/ -@.=0 /*default in case ADDRESS fails. */ -trace off /*suppress REXX err msg for fails*/ -address system 'DIR' xdir '/b' with output stem @. /*issue the DIR cmd.*/ -if rc\==0 then do /*an error happened?*/ - say '***error!*** from DIR' xDIR /*indicate que pasa.*/ - say 'return code=' rc /*show the Ret Code.*/ - exit rc /*exit with the RC.*/ - end /* [↑] bad address.*/ -#=@.rc /*number of entries.*/ -if #==0 then #=' no ' /*use a word, ¬zero.*/ -say center('directory ' xdir " has " # ' matching entries.',79,'─') - - do j=1 for #; say @.j; end /*show files that met criteria. */ - -exit @.0+rc /*stick a fork in it, we're done.*/ diff --git a/Task/Web-scraping/00DESCRIPTION b/Task/Web-scraping/00DESCRIPTION index c7d058df39..415ccc0a18 100644 --- a/Task/Web-scraping/00DESCRIPTION +++ b/Task/Web-scraping/00DESCRIPTION @@ -9,13 +9,15 @@ {{omit from|PostScript|no network access}} {{omit from|Retro|Does not have network access.}} {{omit from|ZX Spectrum Basic|Does not have network access.}} -Create a program that downloads the time from this URL: [http://tycho.usno.navy.mil/cgi-bin/timer.pl http://tycho.usno.navy.mil/cgi-bin/timer.pl] and then prints the current UTC time by extracting just the UTC time from the web page's [[HTML]]. + +;Task: +Create a program that downloads the time from this URL:   [http://tycho.usno.navy.mil/cgi-bin/timer.pl http://tycho.usno.navy.mil/cgi-bin/timer.pl]   and then prints the current UTC time by extracting just the UTC time from the web page's [[HTML]]. + If possible, only use libraries that come at no ''extra'' monetary cost with the programming language and that are widely available and popular such as [http://www.cpan.org/ CPAN] for Perl or [[Boost]] for C++. +

    diff --git a/Task/Web-scraping/Julia/web-scraping-1.julia b/Task/Web-scraping/Julia/web-scraping-1.julia index 2e73921cff..170b7f8b4c 100644 --- a/Task/Web-scraping/Julia/web-scraping-1.julia +++ b/Task/Web-scraping/Julia/web-scraping-1.julia @@ -8,12 +8,12 @@ function getusnotime() @sprintf "get(%s)\n => %s" url err end isa(s, Requests.Response) || return (s, false) - t = match(r"
    (.*UTC)", s.data) - isa(t, RegexMatch) || return (@sprintf("raw html:\n %s", s.data), false) - return (t.captures[1], true) + t = match(r"(?<=
    )(.*?UTC)", readall(s)) + isa(t, RegexMatch) || return (@sprintf("raw html:\n %s", readall(s)), false) + return (t.match, true) end -(t, issuccess) = getusnotime() +(t, issuccess) = getusnotime(); if issuccess println("The USNO time is ", t) diff --git a/Task/Web-scraping/Lua/web-scraping.lua b/Task/Web-scraping/Lua/web-scraping.lua new file mode 100644 index 0000000000..0b4c0587d6 --- /dev/null +++ b/Task/Web-scraping/Lua/web-scraping.lua @@ -0,0 +1,14 @@ +local http = require("socket.http") -- Debian package is 'lua-socket' + +function scrapeTime (pageAddress, timeZone) + local page = http.request(pageAddress) + if not page then return "Cannot connect" end + for line in page:gmatch("[^
    ]*") do + if line:match(timeZone) then + return line:match("%d+:%d+:%d+") + end + end +end + +local url = "http://tycho.usno.navy.mil/cgi-bin/timer.pl" +print(scrapeTime(url, "UTC")) diff --git a/Task/Web-scraping/Perl-6/web-scraping.pl6 b/Task/Web-scraping/Perl-6/web-scraping.pl6 index ea3955e702..9d67496f26 100644 --- a/Task/Web-scraping/Perl-6/web-scraping.pl6 +++ b/Task/Web-scraping/Perl-6/web-scraping.pl6 @@ -1,3 +1,3 @@ use HTTP::Client; # https://github.com/supernovus/perl6-http-client/ my $site = "http://tycho.usno.navy.mil/cgi-bin/timer.pl"; -HTTP::Client.new.get($site).match(/'
    '( .+? UTC )/)[0].say +HTTP::Client.new.get($site).content.match(/'
    '( .+? UTC )/)[0].say diff --git a/Task/Web-scraping/TXR/web-scraping-1.txr b/Task/Web-scraping/TXR/web-scraping-1.txr index 3140c86324..9ed2cb2034 100644 --- a/Task/Web-scraping/TXR/web-scraping-1.txr +++ b/Task/Web-scraping/TXR/web-scraping-1.txr @@ -1,4 +1,4 @@ -@(next `!wget -c http://tycho.usno.navy.mil/cgi-bin/timer.pl -O - 2> /dev/null`) +@(next @(open-command "wget -c http://tycho.usno.navy.mil/cgi-bin/timer.pl -O - 2> /dev/null")) diff --git a/Task/Web-scraping/TXR/web-scraping-2.txr b/Task/Web-scraping/TXR/web-scraping-2.txr index d8a3d96907..4ea1bccc58 100644 --- a/Task/Web-scraping/TXR/web-scraping-2.txr +++ b/Task/Web-scraping/TXR/web-scraping-2.txr @@ -1,4 +1,4 @@ -@(next `!wget -c http://tycho.usno.navy.mil/cgi-bin/timer.pl -O - 2> /dev/null`) +@(next @(open-command "wget -c http://tycho.usno.navy.mil/cgi-bin/timer.pl -O - 2> /dev/null")) @(skip)
    @time@\ UTC@(skip) @(output) diff --git a/Task/Web-scraping/Tcl/web-scraping.tcl b/Task/Web-scraping/Tcl/web-scraping-1.tcl similarity index 100% rename from Task/Web-scraping/Tcl/web-scraping.tcl rename to Task/Web-scraping/Tcl/web-scraping-1.tcl diff --git a/Task/Web-scraping/Tcl/web-scraping-2.tcl b/Task/Web-scraping/Tcl/web-scraping-2.tcl new file mode 100644 index 0000000000..3486edd224 --- /dev/null +++ b/Task/Web-scraping/Tcl/web-scraping-2.tcl @@ -0,0 +1,2 @@ +set data [exec curl -s http://tycho.usno.navy.mil/cgi-bin/timer.pl] +puts [lrange [lsearch -glob -inline [split $data
    ] *UTC*] 0 3] diff --git a/Task/Web-scraping/UNIX-Shell/web-scraping.sh b/Task/Web-scraping/UNIX-Shell/web-scraping-1.sh similarity index 100% rename from Task/Web-scraping/UNIX-Shell/web-scraping.sh rename to Task/Web-scraping/UNIX-Shell/web-scraping-1.sh diff --git a/Task/Web-scraping/UNIX-Shell/web-scraping-2.sh b/Task/Web-scraping/UNIX-Shell/web-scraping-2.sh new file mode 100644 index 0000000000..4898fb4a4c --- /dev/null +++ b/Task/Web-scraping/UNIX-Shell/web-scraping-2.sh @@ -0,0 +1,3 @@ +#!/usr/bin/tcsh -f +set page = `wget -q -O- "http://tycho.usno.navy.mil/cgi-bin/timer.pl"` +echo `awk -v s="${page[22]}" 'BEGIN{print substr(s,5,length(s))}'` ${page[23]} ${page[24]} diff --git a/Task/Window-creation-X11/00DESCRIPTION b/Task/Window-creation-X11/00DESCRIPTION index 6069cd7655..3888eca372 100644 --- a/Task/Window-creation-X11/00DESCRIPTION +++ b/Task/Window-creation-X11/00DESCRIPTION @@ -1 +1,5 @@ -Create a simple X11 application, using an X11 protocol library such as Xlib or XCB, that draws a box and "Hello World" in a window. Implementations of this task should ''avoid using a toolkit'' as much as possible. +;Task: +Create a simple '''X11''' application,   using an '''X11''' protocol library such as Xlib or XCB,   that draws a box and   "Hello World"   in a window. + +Implementations of this task should   ''avoid using a toolkit''   as much as possible. +

    diff --git a/Task/Window-creation-X11/COBOL/window-creation-x11.cobol b/Task/Window-creation-X11/COBOL/window-creation-x11.cobol new file mode 100644 index 0000000000..8912e8c54b --- /dev/null +++ b/Task/Window-creation-X11/COBOL/window-creation-x11.cobol @@ -0,0 +1,175 @@ + identification division. + program-id. x11-hello. + installation. cobc -x x11-hello.cob -lX11 + remarks. Use of private data is likely not cross platform. + + data division. + working-storage section. + 01 msg. + 05 filler value z"S'up, Earth?". + 01 msg-len usage binary-long value 12. + + 01 x-display usage pointer. + 01 x-window usage binary-c-long. + + *> GnuCOBOL does not evaluate C macros, need to peek at opaque + *> data from Xlib.h + *> some padding is added, due to this comment in the header + *> "there is more to this structure, but it is private to Xlib" + 01 x-display-private based. + 05 x-ext-data usage pointer sync. + 05 private1 usage pointer. + 05 x-fd usage binary-long. + 05 private2 usage binary-long. + 05 proto-major-version usage binary-long. + 05 proto-minor-version usage binary-long. + 05 vendor usage pointer sync. + 05 private3 usage pointer. + 05 private4 usage pointer. + 05 private5 usage pointer. + 05 private6 usage binary-long. + 05 allocator usage program-pointer sync. + 05 byte-order usage binary-long. + 05 bitmap-unit usage binary-long. + 05 bitmap-pad usage binary-long. + 05 bitmap-bit-order usage binary-long. + 05 nformats usage binary-long. + 05 screen-format usage pointer sync. + 05 private8 usage binary-long. + 05 x-release usage binary-long. + 05 private9 usage pointer sync. + 05 private10 usage pointer sync. + 05 qlen usage binary-long. + 05 last-request-read usage binary-c-long unsigned sync. + 05 request usage binary-c-long unsigned sync. + 05 private11 usage pointer sync. + 05 private12 usage pointer. + 05 private13 usage pointer. + 05 private14 usage pointer. + 05 max-request-size usage binary-long unsigned. + 05 x-db usage pointer sync. + 05 private15 usage program-pointer sync. + 05 display-name usage pointer. + 05 default-screen usage binary-long. + 05 nscreens usage binary-long. + 05 screens usage pointer sync. + 05 motion-buffer usage binary-c-long unsigned. + 05 private16 usage binary-c-long unsigned. + 05 min-keycode usage binary-long. + 05 max-keycode usage binary-long. + 05 private17 usage pointer sync. + 05 private18 usage pointer. + 05 private19 usage binary-long. + 05 x-defaults usage pointer sync. + 05 filler pic x(256). + + 01 x-screen-private based. + 05 scr-ext-data usage pointer sync. + 05 display-back usage pointer. + 05 root usage binary-c-long. + 05 x-width usage binary-long. + 05 x-height usage binary-long. + 05 m-width usage binary-long. + 05 m-height usage binary-long. + 05 x-ndepths usage binary-long. + 05 depths usage pointer sync. + 05 root-depth usage binary-long. + 05 root-visual usage pointer sync. + 05 default-gc usage pointer. + 05 cmap usage pointer. + 05 white-pixel usage binary-c-long unsigned sync. + 05 black-pixel usage binary-c-long unsigned. + 05 max-maps usage binary-long. + 05 min-maps usage binary-long. + 05 backing-store usage binary-long. + 05 save_unders usage binary-char. + 05 root-input-mask usage binary-c-long sync. + 05 filler pic x(256). + + 01 event. + 05 e-type usage binary-long. + 05 filler pic x(188). + 05 filler pic x(256). + 01 Expose constant as 12. + 01 KeyPress constant as 2. + + *> ExposureMask or-ed with KeyPressMask, from X.h + 01 event-mask usage binary-c-long value 32769. + + *> make the box around the message wide enough for the font + 01 x-char-struct. + 05 lbearing usage binary-short. + 05 rbearing usage binary-short. + 05 string-width usage binary-short. + 05 ascent usage binary-short. + 05 descent usage binary-short. + 05 attributes usage binary-short unsigned. + 01 font-direction usage binary-long. + 01 font-ascent usage binary-long. + 01 font-descent usage binary-long. + + 01 XGContext usage binary-c-long. + 01 box-width usage binary-long. + 01 box-height usage binary-long. + + *> *************************************************************** + procedure division. + + call "XOpenDisplay" using by reference null returning x-display + on exception + display function module-id " Error: " + "no XOpenDisplay linkage, requires libX11" + upon syserr + stop run returning 1 + end-call + if x-display equal null then + display function module-id " Error: " + "XOpenDisplay returned null" upon syserr + stop run returning 1 + end-if + set address of x-display-private to x-display + + if screens equal null then + display function module-id " Error: " + "XOpenDisplay associated screen null" upon syserr + stop run returning 1 + end-if + set address of x-screen-private to screens + + call "XCreateSimpleWindow" using + by value x-display root 10 10 200 50 1 + black-pixel white-pixel + returning x-window + call "XStoreName" using + by value x-display x-window by reference msg + + call "XSelectInput" using by value x-display x-window event-mask + + call "XMapWindow" using by value x-display x-window + + call "XGContextFromGC" using by value default-gc + returning XGContext + call "XQueryTextExtents" using by value x-display XGContext + by reference msg by value msg-len + by reference font-direction font-ascent font-descent + x-char-struct + compute box-width = string-width + 8 + compute box-height = font-ascent + font-descent + 8 + + perform forever + call "XNextEvent" using by value x-display by reference event + if e-type equal Expose then + call "XDrawRectangle" using + by value x-display x-window default-gc 5 5 + box-width box-height + call "XDrawString" using + by value x-display x-window default-gc 10 20 + by reference msg by value msg-len + end-if + if e-type equal KeyPress then exit perform end-if + end-perform + + call "XCloseDisplay" using by value x-display + + goback. + end program x11-hello. diff --git a/Task/Window-creation-X11/Groovy/window-creation-x11.groovy b/Task/Window-creation-X11/Groovy/window-creation-x11.groovy new file mode 100644 index 0000000000..81c605f610 --- /dev/null +++ b/Task/Window-creation-X11/Groovy/window-creation-x11.groovy @@ -0,0 +1,31 @@ +import javax.swing.* +import java.awt.* +import java.awt.event.WindowAdapter +import java.awt.event.WindowEvent +import java.awt.geom.Rectangle2D + +class WindowCreation extends JApplet implements Runnable { + void paint(Graphics g) { + (g as Graphics2D).with { + setStroke(new BasicStroke(2.0f)) + drawString("Hello Groovy!", 20, 20) + setPaint(Color.blue) + draw(new Rectangle2D.Double(10d, 50d, 30d, 30d)) + } + } + + void run() { + new JFrame("Groovy Window Demo").with { + addWindowListener(new WindowAdapter() { + void windowClosing(WindowEvent e) { + System.exit(0) + } + }) + + getContentPane().add("Center", new WindowCreation()) + pack() + setSize(new Dimension(150, 150)) + setVisible(true) + } + } +} diff --git a/Task/Window-creation/Go/window-creation-1.go b/Task/Window-creation/Go/window-creation-1.go index b01aaee6e1..85bcceddbe 100644 --- a/Task/Window-creation/Go/window-creation-1.go +++ b/Task/Window-creation/Go/window-creation-1.go @@ -1,14 +1,15 @@ package main -import "gtk" +import ( + "github.com/mattn/go-gtk/glib" + "github.com/mattn/go-gtk/gtk" +) func main() { gtk.Init(nil) - window := gtk.Window(gtk.GTK_WINDOW_TOPLEVEL) - window.Connect("destroy", func(*gtk.CallbackContext) { - gtk.MainQuit() - }, - "") + window := gtk.NewWindow(gtk.WINDOW_TOPLEVEL) + window.Connect("destroy", + func(*glib.CallbackContext) { gtk.MainQuit() }, "") window.Show() gtk.Main() } diff --git a/Task/Window-creation/Go/window-creation-2.go b/Task/Window-creation/Go/window-creation-2.go index dc2086034f..8951b106b8 100644 --- a/Task/Window-creation/Go/window-creation-2.go +++ b/Task/Window-creation/Go/window-creation-2.go @@ -1,22 +1,22 @@ package main import ( - "sdl" - "fmt" + "log" + + "github.com/veandco/go-sdl2/sdl" ) func main() { - if sdl.Init(sdl.INIT_VIDEO) != 0 { - fmt.Println(sdl.GetError()) - return + window, err := sdl.CreateWindow("RC Window Creation", + sdl.WINDOWPOS_UNDEFINED, sdl.WINDOWPOS_UNDEFINED, + 320, 200, 0) + if err != nil { + log.Fatal(err) } - defer sdl.Quit() - - if sdl.SetVideoMode(200, 200, 32, 0) == nil { - fmt.Println(sdl.GetError()) - return - } - - for e := new(sdl.Event); e.Wait() && e.Type != sdl.QUIT; { + for { + if _, ok := sdl.WaitEvent().(*sdl.QuitEvent); ok { + break + } } + window.Destroy() } diff --git a/Task/Window-creation/Kotlin/window-creation.kotlin b/Task/Window-creation/Kotlin/window-creation.kotlin index 9b2000ba58..4695b430e9 100644 --- a/Task/Window-creation/Kotlin/window-creation.kotlin +++ b/Task/Window-creation/Kotlin/window-creation.kotlin @@ -1,8 +1,9 @@ import javax.swing.JFrame fun main(args : Array) { - val w = JFrame("Title") - w.setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE) - w.setSize(800, 600) - w.setVisible(true) + JFrame("Title").apply { + setSize(800, 600) + defaultCloseOperation = JFrame.EXIT_ON_CLOSE + isVisible = true + } } diff --git a/Task/Wireworld/00DESCRIPTION b/Task/Wireworld/00DESCRIPTION index 32a4dff237..3ba7a717a4 100644 --- a/Task/Wireworld/00DESCRIPTION +++ b/Task/Wireworld/00DESCRIPTION @@ -1,11 +1,12 @@ {{omit from|GUISS}} + [[wp:Wireworld|Wireworld]] is a cellular automaton with some similarities to [[Conway's Game of Life]]. It is capable of doing sophisticated computations with appropriate programs (it is actually [[wp:Turing-complete|Turing complete]]), and is much simpler to program for. -A wireworld arena consists of a cartesian grid of cells, +A Wireworld arena consists of a Cartesian grid of cells, each of which can be in one of four states. All cell transitions happen simultaneously. @@ -37,7 +38,9 @@ The cell transition rules are this: | otherwise |} -To implement this task, create a program that reads a wireworld program from a file and displays an animation of the processing. Here is a sample description file (using "H" for an electron head, "t" for a tail, "." for a conductor and a space for empty) you may wish to test with, which demonstrates two cycle-3 generators and an inhibit gate: + +;Task: +Create a program that reads a Wireworld program from a file and displays an animation of the processing. Here is a sample description file (using "H" for an electron head, "t" for a tail, "." for a conductor and a space for empty) you may wish to test with, which demonstrates two cycle-3 generators and an inhibit gate:
     tH.........
     .   .
    @@ -46,3 +49,4 @@ tH.........
     Ht.. ......
     
    While text-only implementations of this task are possible, mapping cells to pixels is advisable if you wish to be able to display large designs. The logic is not significantly more complex. +

    diff --git a/Task/Wireworld/Elixir/wireworld.elixir b/Task/Wireworld/Elixir/wireworld.elixir new file mode 100644 index 0000000000..758cdfe85e --- /dev/null +++ b/Task/Wireworld/Elixir/wireworld.elixir @@ -0,0 +1,84 @@ +defmodule Wireworld do + @empty " " + @head "H" + @tail "t" + @conductor "." + @neighbours (for x<- -1..1, y <- -1..1, do: {x,y}) -- [{0,0}] + + def set_up(string) do + lines = String.split(string, "\n", trim: true) + grid = Enum.with_index(lines) + |> Enum.flat_map(fn {line,i} -> + String.codepoints(line) + |> Enum.with_index + |> Enum.map(fn {char,j} -> {{i, j}, char} end) + end) + |> Enum.into(Map.new) + width = Enum.map(lines, fn line -> String.length(line) end) |> Enum.max + height = length(lines) + {grid, width, height} + end + + # to string + defp to_s(grid, width, height) do + Enum.map_join(0..height-1, fn i -> + Enum.map_join(0..width-1, fn j -> Map.get(grid, {i,j}, @empty) end) <> "\n" + end) + end + + # transition all cells simultaneously + defp transition(grid) do + Enum.into(grid, Map.new, fn {{x, y}, state} -> + {{x, y}, transition_cell(grid, state, x, y)} + end) + end + + # how to transition a single cell + defp transition_cell(grid, current, x, y) do + case current do + @empty -> @empty + @head -> @tail + @tail -> @conductor + _ -> if neighbours_with_state(grid, x, y) in 1..2, do: @head, else: @conductor + end + end + + # given a position in the grid, find the neighbour cells with a particular state + def neighbours_with_state(grid, x, y) do + Enum.count(@neighbours, fn {dx,dy} -> Map.get(grid, {x+dx, y+dy}) == @head end) + end + + # run a simulation up to a limit of transitions, or until a recurring + # pattern is found + # This will print text to the console + def run(string, iterations\\25) do + {grid, width, height} = set_up(string) + Enum.reduce(0..iterations, {grid, %{}}, fn count,{grd, seen} -> + IO.puts "Generation : #{count}" + IO.puts to_s(grd, width, height) + + if seen[grd] do + IO.puts "I've seen this grid before... after #{count} iterations" + exit(:normal) + else + {transition(grd), Map.put(seen, grd, count)} + end + end) + IO.puts "ran through #{iterations} iterations" + end +end + +# this is the "2 Clock generators and an XOR gate" example from the wikipedia page +text = """ + ......tH +. ...... + ...Ht... . + .... + . ..... + .... + tH...... . +. ...... + ...Ht... +""" + +Wireworld.run(text) diff --git a/Task/Wireworld/GML/wireworld-1.gml b/Task/Wireworld/GML/wireworld-1.gml new file mode 100644 index 0000000000..fa1bd9408d --- /dev/null +++ b/Task/Wireworld/GML/wireworld-1.gml @@ -0,0 +1,99 @@ +//Create event +/* +Wireworld first declares constants and then reads a wireworld from a textfile. +In order to implement wireworld in GML a single array is used. +To make it behave properly, there need to be states that are 'in-between' two states: +0 = empty +1 = conductor from previous state +2 = electronhead from previous state +5 = electronhead that was a conductor in the previous state +3 = electrontail from previous state +4 = electrontail that was a head in the previous state +*/ +empty = 0; +conduc = 1; +eHead = 2; +eTail = 3; +eHead_to_eTail = 4; +coduc_to_eHead = 5; +working = true;//not currently used, but setting it to false stops wireworld. (can be used to pause) +toroidalMode = false; +factor = 3;//this is used for the display. 3 means a single pixel is multiplied by three in size. + +var tempx,tempy ,fileid, tempstring, gridid, listid, maxwidth, stringlength; +tempx = 0; +tempy = 0; +tempstring = ""; +maxwidth = 0; + +//the next piece of code loads the textfile containing a wireworld. +//the program will not work correctly if there is no textfile. +if file_exists("WW.txt") +{ +fileid = file_text_open_read("WW.txt"); +gridid = ds_grid_create(0,0); +listid = ds_list_create(); + while !file_text_eof(fileid) + { + tempstring = file_text_read_string(fileid); + stringlength = string_length(tempstring); + ds_list_add(listid,stringlength); + if maxwidth < stringlength + { + ds_grid_resize(gridid,stringlength,ds_grid_height(gridid) + 1) + maxwidth = stringlength + } + else + { + ds_grid_resize(gridid,maxwidth,ds_grid_height(gridid) + 1) + } + + for (i = 1; i <= stringlength; i +=1) + { + switch (string_char_at(tempstring,i)) + { + case ' ': ds_grid_set(gridid,tempx,tempy,empty); break; + case '.': ds_grid_set(gridid,tempx,tempy,conduc); break; + case 'H': ds_grid_set(gridid,tempx,tempy,eHead); break; + case 't': ds_grid_set(gridid,tempx,tempy,eTail); break; + default: break; + } + tempx += 1; + } + file_text_readln(fileid); + tempy += 1; + tempx = 0; + } +file_text_close(fileid); +//fill the 'open' parts of the grid +tempy = 0; + repeat(ds_list_size(listid)) + { + tempx = ds_list_find_value(listid,tempy); + repeat(maxwidth - tempx) + { + ds_grid_set(gridid,tempx,tempy,empty); + tempx += 1; + } + tempy += 1; + } +boardwidth = ds_grid_width(gridid); +boardheight = ds_grid_height(gridid); +//the contents of the grid are put in a array, because arrays are faster. +//the grid was needed because arrays cannot be resized properly. +tempx = 0; +tempy = 0; + repeat(boardheight) + { + repeat(boardwidth) + { + board[tempx,tempy] = ds_grid_get(gridid,tempx,tempy); + tempx += 1; + } + tempy += 1; + tempx = 0; + } +//the following code clears memory +ds_grid_destroy(gridid); +ds_list_destroy(listid); +} diff --git a/Task/Wireworld/GML/wireworld-2.gml b/Task/Wireworld/GML/wireworld-2.gml new file mode 100644 index 0000000000..53bba5e11f --- /dev/null +++ b/Task/Wireworld/GML/wireworld-2.gml @@ -0,0 +1,218 @@ +//Step event +/* +This step event executes each 1/speed seconds. +It checks everything on the board using an x and a y through two repeat loops. +The variables westN,northN,eastN,southN, resemble the space left, up, right and down respectively, +seen from the current x & y. +1 -> 5 (conductor is changing to head) +2 -> 4 (head is changing to tail) +3 -> 1 (tail became conductor) +*/ + +var tempx,tempy,assignhold,westN,northN,eastN,southN,neighbouringHeads,T; +tempx = 0; +tempy = 0; +westN = 0; +northN = 0; +eastN = 0; +southN = 0; +neighbouringHeads = 0; +T = 0; + +if working = 1 +{ + repeat(boardheight) + { + repeat(boardwidth) + { + switch board[tempx,tempy] + { + case empty: assignhold = empty; break; + case conduc: + neighbouringHeads = 0; + if toroidalMode = true //this is disabled, but otherwise lets wireworld behave toroidal. + { + if tempx=0 + { + westN = boardwidth -1; + } + else + { + westN = tempx-1; + } + if tempy=0 + { + northN = boardheight -1; + } + else + { + northN = tempy-1; + } + if tempx=boardwidth -1 + { + eastN = 0; + } + else + { + eastN = tempx+1; + } + if tempy=boardheight -1 + { + southN = 0; + } + else + { + southN = tempy+1; + } + + T=board[westN,northN]; + if T=eHead or T=eHead_to_eTail + { + neighbouringHeads += 1; + } + T=board[tempx,northN]; + if T=eHead or T=eHead_to_eTail + { + neighbouringHeads += 1; + } + T=board[eastN,northN]; + if T=eHead or T=eHead_to_eTail + { + neighbouringHeads += 1; + } + T=board[westN,tempy]; + if T=eHead or T=eHead_to_eTail + { + neighbouringHeads += 1; + } + T=board[eastN,tempy]; + if T=eHead or T=eHead_to_eTail + { + neighbouringHeads += 1; + } + T=board[westN,southN]; + if T=eHead or T=eHead_to_eTail + { + neighbouringHeads += 1; + } + T=board[tempx,southN]; + if T=eHead or T=eHead_to_eTail + { + neighbouringHeads += 1; + } + T=board[eastN,southN]; + if T=eHead or T=eHead_to_eTail + { + neighbouringHeads += 1; + } + } + else//this is the default mode that works for the provided example. + {//the next code checks whether coordinates fall outside the array borders. + //and counts all the neighbouring electronheads. + if tempx=0 + { + westN = -1; + } + else + { + westN = tempx - 1; + T=board[westN,tempy]; + if T=eHead or T=eHead_to_eTail + { + neighbouringHeads += 1; + } + } + if tempy=0 + { + northN = -1; + } + else + { + northN = tempy - 1; + T=board[tempx,northN]; + if T=eHead or T=eHead_to_eTail + { + neighbouringHeads += 1; + } + } + if tempx = boardwidth -1 + { + eastN = -1; + } + else + { + eastN = tempx + 1; + T=board[eastN,tempy]; + if T=eHead or T=eHead_to_eTail + { + neighbouringHeads += 1; + } + } + if tempy = boardheight -1 + { + southN = -1; + } + else + { + southN = tempy + 1; + T=board[tempx,southN]; + if T=eHead or T=eHead_to_eTail + { + neighbouringHeads += 1; + } + } + + if westN != -1 and northN != -1 + { + T=board[westN,northN]; + if T=eHead or T=eHead_to_eTail + { + neighbouringHeads += 1; + } + } + if eastN != -1 and northN != -1 + { + T=board[eastN,northN]; + if T=eHead or T=eHead_to_eTail + { + neighbouringHeads += 1; + } + } + if westN != -1 and southN != -1 + { + T=board[westN,southN]; + if T=eHead or T=eHead_to_eTail + { + neighbouringHeads += 1; + } + } + if eastN != -1 and southN != -1 + { + T=board[eastN,southN]; + if T=eHead or T=eHead_to_eTail + { + neighbouringHeads += 1; + } + } + } + if neighbouringHeads = 1 or neighbouringHeads = 2 + { + assignhold = coduc_to_eHead; + } + else + { + assignhold = conduc; + } + break; + + case eHead: assignhold = eHead_to_eTail; break; + case eTail: assignhold = conduc; break; + default: break; + } + board[tempx,tempy] = assignhold; + tempx += 1; + } + tempy += 1; + tempx = 0; + } +} diff --git a/Task/Wireworld/GML/wireworld-3.gml b/Task/Wireworld/GML/wireworld-3.gml new file mode 100644 index 0000000000..acf5fcfd38 --- /dev/null +++ b/Task/Wireworld/GML/wireworld-3.gml @@ -0,0 +1,62 @@ +//Draw event +/* +This event occurs whenever the screen is refreshed. +It checks everything on the board using an x and a y through two repeat loops and draws it. +It is an important step, because all board values are changed to the normal versions: +5 -> 2 (conductor changed to head) +4 -> 3 (head changed to tail) +*/ +//draw sprites and text first + +//now draw wireworld +var tempx,tempy; +tempx = 0; +tempy = 0; + +repeat(boardheight) +{ + repeat(boardwidth) + { + switch board[tempx,tempy] + { + case empty: + //draw_point_color(tempx,tempy,c_black); + draw_set_color(c_black); + draw_rectangle(tempx*factor,tempy*factor,(tempx+1)*factor-1,(tempy+1)*factor-1,false); + break; + case conduc: + //draw_point_color(tempx,tempy,c_yellow); + draw_set_color(c_yellow); + draw_rectangle(tempx*factor,tempy*factor,(tempx+1)*factor-1,(tempy+1)*factor-1,false); + break; + case eHead: + //draw_point_color(tempx,tempy,c_red); + draw_set_color(c_blue); + draw_rectangle(tempx*factor,tempy*factor,(tempx+1)*factor-1,(tempy+1)*factor-1,false); + draw_rectangle_color(tempx*factor,tempy*factor,(tempx+1)*factor-1,(tempy+1)*factor-1,c_red,c_red,c_red,c_red,false); + break; + case eTail: + //draw_point_color(tempx,tempy,c_blue); + draw_set_color(c_red); + draw_rectangle(tempx*factor,tempy*factor,(tempx+1)*factor-1,(tempy+1)*factor-1,false); + break; + case coduc_to_eHead: + //draw_point_color(tempx,tempy,c_red); + draw_set_color(c_blue); + draw_rectangle(tempx*factor,tempy*factor,(tempx+1)*factor-1,(tempy+1)*factor-1,false); + board[tempx,tempy] = eHead; + break; + case eHead_to_eTail: + //draw_point_color(tempx,tempy,c_blue); + draw_set_color(c_red); + draw_rectangle(tempx*factor,tempy*factor,(tempx+1)*factor-1,(tempy+1)*factor-1,false); + board[tempx,tempy] = eTail; + break; + default: break; + } + tempx += 1 + } +tempy += 1; +tempx = 0; +} +draw_set_color(c_black); diff --git a/Task/Wireworld/REXX/wireworld.rexx b/Task/Wireworld/REXX/wireworld.rexx index 8724bbbc9d..ab2becd027 100644 --- a/Task/Wireworld/REXX/wireworld.rexx +++ b/Task/Wireworld/REXX/wireworld.rexx @@ -1,61 +1,60 @@ -/*REXX program displays a wire world cartesian grid of four─state cells. */ -signal on halt /*handle any cell growth interruptus. */ -parse arg iFID . '(' generations rows cols bare head tail wire clearScreen reps -if iFID=='' then iFID='WIREWORLD.TXT' /*should default input file be used? */ - blank = 'BLANK' /*the "name" for a blank. */ -generations = p(generations 100 ) /*number generations allowed. */ - rows = p(rows 3 ) /*the number of cell rows. */ - cols = p(cols 3 ) /* " " " " cols. */ - bare = pickChar(bare blank ) /*an empty cell character. */ -clearScreen = p(clearScreen 0 ) /*1 means to clear the screen*/ - head = pickchar(head 'H' ) /*pick the char for the head.*/ - tail = pickchar(tail 't' ) /* " " " " " tail.*/ - wire = pickchar(wire . ) /* " " " " " wire.*/ - reps = p(reps 2 ) /*stop program if two repeats.*/ -fents=max(linesize()-1,cols) /*the fence width used after displaying*/ -#reps=0; $.=bare /*at start, universe is new and barren.*/ -gens=abs(generations) /*use for convenience (and short name).*/ - /* [↓] read the input file. */ - do r=1 while lines(iFID)\==0 /*keep reading until the End─Of─File. */ - q=strip(linein(iFID),'T') /*get single line from the input file. */ - _=length(q) /*obtain the length of this (input) row*/ - cols=max(cols,_) /*calculate the maximum number of cols.*/ - do c=1 for _; $.r.c=substr(q,c,1); end /*assign the row cells.*/ +/*REXX program displays a wire world Cartesian grid of four─state cells. */ +signal on halt /*handle any cell growth interruptus. */ +parse arg iFID . '(' generations rows cols bare head tail wire clearScreen reps +if iFID=='' then iFID="WIREWORLD.TXT" /*should default input file be used? */ + blank = 'BLANK' /*the "name" for a blank. */ +generations = p(generations 100 ) /*number generations that are allowed. */ + rows = p(rows 3 ) /*the number of cell rows. */ + cols = p(cols 3 ) /* " " " " columns. */ + bare = pickChar(bare blank ) /*an empty cell character. */ +clearScreen = p(clearScreen 0 ) /*1 means to clear the screen. */ + head = pickChar(head 'H' ) /*pick the character for the head. */ + tail = pickChar(wire . ) /* " " " " " wire. */ + reps = p(reps 2 ) /*stop program if there are 2 repeats.*/ +fents=max(linesize()-1,cols) /*the fence width used after displaying*/ +#reps=0; $.=bare /*at start, universe is new and barren.*/ +gens=abs(generations) /*use for convenience (and short name).*/ + /* [↓] read the input file. */ + do r=1 while lines(iFID)\==0 /*keep reading until the End─Of─File. */ + q=strip(linein(iFID), 'T') /*get single line from the input file. */ + _=length(q) /*obtain the length of this (input) row*/ + cols=max(cols, _) /*calculate the maximum number of cols.*/ + do c=1 for _; $.r.c=substr(q, c, 1); end /*assign the row cells.*/ end /*r*/ -rows=r-1 /*adjust the row number (from DO loop).*/ -life=0; !.=0; call showCells /*display initial state of the cells. */ - /*watch cells evolve, 4 possible states*/ - do life=1 for gens; @.=bare /*perform for the number of generations*/ +rows=r-1 /*adjust the row number (from DO loop).*/ +life=0; !.=0; call showCells /*display initial state of the cells. */ + /*watch cells evolve, 4 possible states*/ + do life=1 for gens; @.=bare /*perform for the number of generations*/ - do r=1 for rows /*process each of the rows.*/ - do c=1 for cols; ?=$.r.c; ??=? /* " " " " cols.*/ - select /*determine type of cell. */ + do r=1 for rows /*process each of the rows. */ + do c=1 for cols; ?=$.r.c; ??=? /* " " " " columns. */ + select /*determine the type of cell. */ when ?==head then ??=tail when ?==tail then ??=wire - when ?==wire then do; n=hood(); if n==1|n==2 then ??=head; end + when ?==wire then do; n=hood(); if n==1 | n==2 then ??=head; end otherwise nop end /*select*/ @.r.c=?? end /*c*/ end /*r*/ - call assign$ /*assign alternate cells ──► real world*/ + call assign$ /*assign alternate cells ──► real world*/ if generations>0 | life==gens then call showCells end /*life*/ - /*stop watching the universe (or life).*/ -halt: if life-1\==gens then say 'The ~~~Wireworld~~~ program was interrupted.' -done: exit /*stick a fork in it, we are all done.*/ -/*────────────────────────────────────────────────────────────────────────────*/ -showCells: if clearScreen then 'CLS' /*◄──change this for the OS.*/ - call showRows /*show rows in proper order.*/ - say right(copies('═',fents)life,fents) /*display a bunch of cells. */ - if _=='' then signal done /*No life? Then stop run. */ - if !._ then #reps=#reps+1 /*detected repeated pattern.*/ - !._=1 /*it is now existence state.*/ - if reps\==0 & #reps<=reps then return /*so far, so good, no reps. */ + /*stop watching the universe (or life).*/ +halt: if life-1\==gens then say 'The ~~~Wireworld~~~ program was interrupted.' +done: exit /*stick a fork in it, we are all done.*/ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +showCells: if clearScreen then 'CLS' /*◄──change this for the OS.*/ + call showRows /*show rows in proper order.*/ + say right(copies('═',fents)life,fents) /*display a bunch of cells. */ + if _=='' then signal done /*No life? Then stop run. */ + if !._ then #reps=#reps+1 /*detected repeated pattern.*/ + !._=1 /*it is now existence state.*/ + if reps\==0 & #reps<=reps then return /*so far, so good, no reps. */ say '"Wireworld" repeated itself' reps "times, program is stopping." - signal done /*exit program, we're done. */ -/*───────────────────────────────one─liner subroutines─────────────────────────────────────────────────────────────────────*/ + signal done /*exit program, we're done. */ +/*─────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/ $: parse arg _row,_col; return ($._row._col==head) assign$: do r=1 for rows; do c=1 for cols; $.r.c=@.r.c; end; end; return err: say; say center(' error! ',max(40,linesize()%2),"*"); say; do j=1 for arg(); say arg(j); say; end; say; exit 13 diff --git a/Task/Wireworld/Standard-ML/wireworld.ml b/Task/Wireworld/Standard-ML/wireworld.ml new file mode 100644 index 0000000000..61e1156eea --- /dev/null +++ b/Task/Wireworld/Standard-ML/wireworld.ml @@ -0,0 +1,46 @@ +(* Maximilian Wuttke 12.04.2016 *) + +type world = char vector vector + +fun getstate (w:world, (x, y)) = (Vector.sub (Vector.sub (w, y), x)) handle Subscript => #" " + +fun conductor (w:world, (x, y)) = + let + val s = [getstate (w, (x-1, y-1)) = #"H", getstate (w, (x-1, y)) = #"H", getstate (w, (x-1, y+1)) = #"H", + getstate (w, (x, y-1)) = #"H", getstate (w, (x, y+1)) = #"H", + getstate (w, (x+1, y-1)) = #"H", getstate (w, (x+1, y)) = #"H", getstate (w, (x+1, y+1)) = #"H"] + (* Count `true` in s *) + val count = List.length (List.filter (fn x => x=true) s) + in + if count = 1 orelse count = 2 then #"H" else #"." + end + +fun translate (w:world, (x, y)) = + case getstate (w, (x, y)) of + #" " => #" " + | #"H" => #"t" + | #"t" => #"." + | #"." => conductor (w, (x, y)) + | s => s + +fun next_world (w : world) = Vector.mapi (fn (y, row) => Vector.mapi (fn (x, _) => translate (w, (x, y))) row) w + + +(* Test *) + +(* makes a list of strings into a world *) +fun make_world (rows : string list) : world = + Vector.fromList (map (fn (row : string) => Vector.fromList (explode row)) rows) + + +(* word_str reverses make_world *) +fun vec_str (r:char vector) = implode (List.tabulate (Vector.length r, fn x => Vector.sub (r, x))) +fun world_str (w:world) = List.tabulate (Vector.length w, fn y => vec_str (Vector.sub (w, y))) +fun print_world (w:world) = (map (fn row_str => print (row_str ^ "\n")) (world_str w); ()) + +val test = make_world [ + "tH.........", + ". . ", + " ... ", + ". . ", + "Ht.. ......"] diff --git a/Task/Word-wrap/00DESCRIPTION b/Task/Word-wrap/00DESCRIPTION index e2c521c1eb..b752873e1c 100644 --- a/Task/Word-wrap/00DESCRIPTION +++ b/Task/Word-wrap/00DESCRIPTION @@ -1,15 +1,20 @@ Even today, with proportional fonts and complex layouts, there are still [[Template:Lines_too_long|cases]] where you need to wrap text at a specified column. + +;Basic task: The basic task is to wrap a paragraph of text in a simple way in your language. If there is a way to do this that is built-in, trivial, or provided in a standard library, show that. Otherwise implement the [http://en.wikipedia.org/wiki/Word_wrap#Minimum_length minimum length greedy algorithm from Wikipedia.] Show your routine working on a sample of text at two different wrap columns. -'''Extra credit!''' Wrap text using a more sophisticated algorithm such as the Knuth and Plass TeX algorithm. + +;Extra credit: +Wrap text using a more sophisticated algorithm such as the Knuth and Plass TeX algorithm. If your language provides this, you get easy extra credit, but you ''must reference documentation'' indicating that the algorithm is something better than a simple minimimum length algorithm. If you have both basic and extra credit solutions, show an example where the two algorithms give different results. +

    diff --git a/Task/Word-wrap/Common-Lisp/word-wrap.lisp b/Task/Word-wrap/Common-Lisp/word-wrap.lisp new file mode 100644 index 0000000000..2a2b363217 --- /dev/null +++ b/Task/Word-wrap/Common-Lisp/word-wrap.lisp @@ -0,0 +1,13 @@ +;; Greedy wrap line + +(defun greedy-wrap (str width) + (setq str (concatenate 'string str " ")) ; add sentinel + (do* ((len (length str)) + (lines nil) + (begin-curr-line 0) + (prev-space 0 pos-space) + (pos-space (position #\Space str) (when (< (1+ prev-space) len) (position #\Space str :start (1+ prev-space)))) ) + ((null pos-space) (progn (push (subseq str begin-curr-line (1- len)) lines) (nreverse lines)) ) + (when (> (- pos-space begin-curr-line) width) + (push (subseq str begin-curr-line prev-space) lines) + (setq begin-curr-line (1+ prev-space)) ))) diff --git a/Task/Word-wrap/Fortran/word-wrap-1.f b/Task/Word-wrap/Fortran/word-wrap-1.f new file mode 100644 index 0000000000..c5bf6fa0be --- /dev/null +++ b/Task/Word-wrap/Fortran/word-wrap-1.f @@ -0,0 +1,5 @@ + CHARACTER*12345 TEXT + ... + DO I = 0,120 + WRITE (6,*) TEXT(I*80 + 1:(I + 1)*80) + END DO diff --git a/Task/Word-wrap/Fortran/word-wrap-2.f b/Task/Word-wrap/Fortran/word-wrap-2.f new file mode 100644 index 0000000000..064a7e2968 --- /dev/null +++ b/Task/Word-wrap/Fortran/word-wrap-2.f @@ -0,0 +1,125 @@ + MODULE RIVERRUN !Schemes for re-flowing wads of text to a specified line length. + INTEGER BL,BLIMIT,BM !Fingers for the scratchpad. + PARAMETER (BLIMIT = 222) !This should be enough for normal widths. + CHARACTER*(BLIMIT) BUMF !The scratchpad, accumulating text. + INTEGER OUTBUMF !Output unit number. + DATA OUTBUMF/0/ !Thus detect inadequate initialisation. + PRIVATE BL,BLIMIT,BM !These names are not so unusual + PRIVATE BUMF,OUTBUMF !That no other routine will use them. + CONTAINS + INTEGER FUNCTION LSTNB(TEXT) !Sigh. Last Not Blank. +Concocted yet again by R.N.McLean (whom God preserve) December MM. +Code checking reveals that the Compaq compiler generates a copy of the string and then finds the length of that when using the latter-day intrinsic LEN_TRIM. Madness! +Can't DO WHILE (L.GT.0 .AND. TEXT(L:L).LE.' ') !Control chars. regarded as spaces. +Curse the morons who think it good that the compiler MIGHT evaluate logical expressions fully. +Crude GO TO rather than a DO-loop, because compilers use a loop counter as well as updating the index variable. +Comparison runs of GNASH showed a saving of ~3% in its mass-data reading through the avoidance of DO in LSTNB alone. +Crappy code for character comparison of varying lengths is avoided by using ICHAR which is for single characters only. +Checking the indexing of CHARACTER variables for bounds evoked astounding stupidities, such as calculating the length of TEXT(L:L) by subtracting L from L! +Comparison runs of GNASH showed a saving of ~25-30% in its mass data scanning for this, involving all its two-dozen or so single-character comparisons, not just in LSTNB. + CHARACTER*(*),INTENT(IN):: TEXT !The bumf. If there must be copy-in, at least there need not be copy back. + INTEGER L !The length of the bumf. + L = LEN(TEXT) !So, what is it? + 1 IF (L.LE.0) GO TO 2 !Are we there yet? + IF (ICHAR(TEXT(L:L)).GT.ICHAR(" ")) GO TO 2 !Control chars are regarded as spaces also. + L = L - 1 !Step back one. + GO TO 1 !And try again. + 2 LSTNB = L !The last non-blank, possibly zero. + RETURN !Unsafe to use LSTNB as a variable. + END FUNCTION LSTNB !Compilers can bungle it. + + SUBROUTINE STARTFLOW(OUT,WIDTH) !Preparation. + INTEGER OUT !Output device. + INTEGER WIDTH !Width limit. + OUTBUMF = OUT !Save these + BM = WIDTH !So that they don't have to be specified every time. + IF (BM.GT.BLIMIT) STOP "Too wide!" !Alas, can't show the values BLIMIT and WIDTH. + BL = 0 !No text already waiting in BUMF + END SUBROUTINE STARTFLOW!Simple enough. + + SUBROUTINE FLOW(TEXT) !Add to the ongoing BUMF. + CHARACTER*(*) TEXT !The text to append. + INTEGER TL !Its last non-blank. + INTEGER T1,T2 !Fingers to TEXT. + INTEGER L !A length. + IF (OUTBUMF.LT.0) STOP "Call STARTFLOW first!" !Paranoia. + TL = LSTNB(TEXT) !No trailing spaces, please. + IF (TL.LE.0) THEN !A blank (or null) line? + CALL FLUSH !Thus end the paragraph. + RETURN !Perhaps more text will follow, later. + END IF !Curse the (possible) full evaluation of .OR. expressions! + IF (TEXT(1:1).LE." ") CALL FLUSH !This can't be checked above in case LEN(TEXT) = 0. +Chunks of TEXT are to be appended to BUMF. + T1 = 1 !Start at the start, blank or not. + 10 IF (BL.GT.0) THEN !If there is text waiting in BUMF, + BL = BL + 1 !Then this latest text is to be appended + BUMF(BL:BL) = " " !After one space. + END IF !So much for the join. +Consider the amount of text to be placed, TEXT(T1:TL) + L = TL - T1 + 1 !Length of text to be placed. + IF (BM - BL .GE. L) THEN !Sufficient space available? + BUMF(BL + 1:BM + L) = TEXT(T1:TL) !Yes. Copy all the remaining text. + BL = BL + L !Advance the finger. + IF (BL .GE. BM - 1) CALL FLUSH !If there is no space for an addendum. + RETURN !Done. + END IF !Otherwise, there is an overhang. +Calculate the available space up to the end of a line. BUMF(BL + 1:BM) + L = BM - BL !The number of characters available in BUMF. + T2 = T1 + L !Finger the first character beyond the take. + IF (TEXT(T2:T2) .LE. " ") GO TO 12 !A splitter character? Happy chance! + T2 = T2 - 1 !Thus the last character of TEXT that could be placed in BUMF. + 11 IF (TEXT(T2:T2) .GT. " ") THEN !Are we looking at a space yet? + T2 = T2 - 1 !No. step back one. + IF (T2 .GT. T1) GO TO 11 !And try again, if possible. + IF (L .LE. 6) THEN !No splitter found. For short appendage space, + CALL FLUSH !Starting a new line gives more scope. + GO TO 10 !At the cost of spaces at the end. + END IF !But splitting words is unsavoury too. + T2 = T1 + L - 1 !Alas, no split found. + END IF !So the end-of-line will force a split. + L = T2 - T1 + 1 !The length I settle on. + 12 BUMF(BL + 1:BL + L) = TEXT(T1:T1 + L - 1) !I could add a hyphen at the arbitrary chop... + BL = BL + L !The last placed. + CALL FLUSH !The line being full. +Consider what the flushed line didn't take. TEXT(T1 + L:TL) + T1 = T1 + L !Advance to fresh grist. + 13 IF (T1.GT.TL) RETURN !Perhaps there is no more. No compound testing, alas. + IF (TEXT(T1:T1).LE." ") THEN !Does a space follow a line split? + T1 = T1 + 1 !Yes. It would appear as a leading space in the output. + GO TO 13 !But the line split stands in for all that. + END IF !So, speed past all such. + IF (T1.LE.TL) GO TO 10!Does anything remain? + RETURN !Nope. + CONTAINS !A convenience. + SUBROUTINE FLUSH !Save on repetition. + IF (BL.GT.0) WRITE (OUTBUMF,"(A)") BUMF(1:BL) !Roll the bumf, if any. + BL = 0 !And be ready for more. + END SUBROUTINE FLUSH !Thus avoid the verbosity of repeated begin ... end blocks. + END SUBROUTINE FLOW !Invoke with one large blob, or, pieces. + END MODULE RIVERRUN !Flush the tail end with a null text. + + PROGRAM TEST + USE RIVERRUN + INTEGER MSG,IN + CHARACTER*222 BUMF + MSG = 6 + IN = 10 + CALL STARTFLOW(MSG,36) + CALL FLOW("Fifteen men on a dead man's chest!") + CALL FLOW(" Yo ho ho and a bottle of rum!") + CALL FLOW("Drink and the devil have done for the rest!") + CALL FLOW(" Yo ho ho and a bottle of rum!") + CALL FLOW("") + WRITE (MSG,*) +Chew into my source file for a second example. + OPEN (IN,FILE="TextFlow.for",ACTION = "READ") + 1 READ (IN,2) BUMF + 2 FORMAT (A) + IF (BUMF(1:1).NE."C") GO TO 1 !No comment block yet. + CALL STARTFLOW(MSG,66) !Found it! + 3 CALL FLOW(BUMF) !Roll its text. + READ (IN,2) BUMF !Grab another line. + IF (BUMF(1:1).EQ."C") GO TO 3 !And if a comment, append. + CALL FLOW("") + CLOSE (IN) + END diff --git a/Task/Word-wrap/JavaScript/word-wrap-4.js b/Task/Word-wrap/JavaScript/word-wrap-4.js new file mode 100644 index 0000000000..77131ebdf1 --- /dev/null +++ b/Task/Word-wrap/JavaScript/word-wrap-4.js @@ -0,0 +1,23 @@ +(function (width) { + 'use strict'; + + function wrapByRegex(n, s) { + return s.match( + RegExp('.{1,' + n + '}(\\s|$)', 'g') + ) + .join('\n'); + } + + return wrapByRegex(width, +'Even today, with proportional fonts and compl\ +ex layouts, there are still cases where you ne\ +ed to wrap text at a specified column. The bas\ +ic task is to wrap a paragraph of text in a si\ +mple way in your language. If there is a way t\ +o do this that is built-in, trivial, or provid\ +ed in a standard library, show that. Otherwise\ + implement the minimum length greedy algorithm\ + from Wikipedia.' + ) + +})(60); diff --git a/Task/Word-wrap/JavaScript/word-wrap-5.js b/Task/Word-wrap/JavaScript/word-wrap-5.js new file mode 100644 index 0000000000..51267fde42 --- /dev/null +++ b/Task/Word-wrap/JavaScript/word-wrap-5.js @@ -0,0 +1,56 @@ +/** + * [wordwrap description] + * @param {[type]} text [description] + * @param {Number} width [description] + * @param {String} br [description] + * @param {Boolean} cut [description] + * @return {[type]} [description] + */ +function wordwrap(text, width = 80, br = '\n', cut = false) { + // Приводим к uint + // 0..2^32-1 либо 0..2^64-1 + width >>>= 0; + // Длина текста меньше или равна максимальной + if (0 === width || text.length <= width) { + return text; + } + // Разбиваем текст на строки + return text.split('\n').map(line => { + if (line.length <= width) { + return line; + } + // Разбиваем строку на слова + let words = line.split(' '); + // Если требуется, то обрезаем длинные слова + if (cut) { + let temp = []; + for (const word of words) { + if (word.length > width) { + let i = 0; + const length = word.length; + while (i < length) { + temp.push(word.slice(i, Math.min(i + width, length))); + i += width; + } + } else { + temp.push(word); + } + } + words = temp; + } + // console.log(words); + // Собираем новую строку + let wrapped = words.shift(); + let spaceLeft = width - wrapped.length; + for (const word of words) { + if (word.length + 1 > spaceLeft) { + wrapped += br + word; + spaceLeft = width - word.length; + } else { + wrapped += ' ' + word; + spaceLeft -= 1 + word.length; + } + } + return wrapped; + }).join('\n'); // Объединяем элементы массива по LF +} diff --git a/Task/Word-wrap/JavaScript/word-wrap-6.js b/Task/Word-wrap/JavaScript/word-wrap-6.js new file mode 100644 index 0000000000..39abc9c2e4 --- /dev/null +++ b/Task/Word-wrap/JavaScript/word-wrap-6.js @@ -0,0 +1 @@ +console.log(wordwrap("The quick brown fox jumped over the lazy dog.", 20, "
    \n")); diff --git a/Task/Word-wrap/PowerShell/word-wrap.psh b/Task/Word-wrap/PowerShell/word-wrap-1.psh similarity index 100% rename from Task/Word-wrap/PowerShell/word-wrap.psh rename to Task/Word-wrap/PowerShell/word-wrap-1.psh diff --git a/Task/Word-wrap/PowerShell/word-wrap-2.psh b/Task/Word-wrap/PowerShell/word-wrap-2.psh new file mode 100644 index 0000000000..f1e03ed9b1 --- /dev/null +++ b/Task/Word-wrap/PowerShell/word-wrap-2.psh @@ -0,0 +1,52 @@ +function Out-WordWrap +{ + [CmdletBinding()] + [OutputType([string])] + Param + ( + [Parameter(Mandatory=$true, + ValueFromPipeline=$true, + Position=0)] + [string] + $Text, + + [Parameter(Mandatory=$false, + Position=1)] + [ValidateRange(16,160)] + [int] + $Width = 80 + ) + + Begin + { + function New-WordWrap ([string]$Text, [int]$Width) + { + [string[]]$words = $Text.Split() + [string]$output = "" + [int]$remaining = $Width + + foreach ($word in $words) + { + if($word.Length + 1 -gt $remaining) + { + $output += "`n$word " + $remaining = $Width - ($word.Length + 1) + } + else + { + $output += "$word " + $remaining -= $word.Length + 1 + } + } + + return "$output`n" + } + } + Process + { + foreach ($paragraph in $Text) + { + New-WordWrap -Text $paragraph -Width $Width + } + } +} diff --git a/Task/Word-wrap/PowerShell/word-wrap-3.psh b/Task/Word-wrap/PowerShell/word-wrap-3.psh new file mode 100644 index 0000000000..2d2c8e832c --- /dev/null +++ b/Task/Word-wrap/PowerShell/word-wrap-3.psh @@ -0,0 +1,12 @@ +[string[]]$paragraphs = "Rebum everti delicata an vel, quo ut temporibus interpretaris, mea debet mnesarchum disputando ad. Id has dolorum contentiones, mel ea noster adipisci. Id persius appareat eos, aeque dolorum fastidii eam in. Partem assentior contentiones ut mea. Cu augue facilis fabellas cum, vix eu sanctus denique imperdiet, appareat percipit qui ex.", + "Nihil discere phaedrum at duo, no eum adhuc autem error. Quo aliquam delicata contentiones et, in sed ferri legimus sententiae, nihil solet docendi id eum. Ius ut meliore vulputate adipiscing, sea cu virtute praesent. Euripidis instructior est eu. Veri cotidieque ex vel, aliquam eruditi nusquam sea ne, eu wisi ubique ullamcorper est. Qui doctus epicuri ei. Cum esse detracto concludaturque ea, veri erant per ad, vide ancillae principes ius id.", + "Id disputando signiferumque nam, mei illud aeterno ut. Facilisis evertitur mei at. Qui in wisi fugit, eirmod comprehensam duo ei. Ea mel omnium nusquam, causae consequat appellantur per te.", + "Denique deseruisse ea his. Mundi scripta adolescens te ius, cum error persius cotidieque cu. Nobis apeirian ad his. Ius omnes gloriatur at, has eu tamquam inciderint, ubique commodo pro ad. Ex veri ceteros quo, duo an labores adolescens. Sed id quod verterem prodesset, magna eloquentiam ea eum.", + "Qui sanctus oportere quaerendum ex, usu vivendo accusamus posidonium an. Quo cu graece reprimique. Ea cum purto quando referrentur, tritani perfecto ne sit. Ne sit iusto ludus, ea ius eruditi dissentiunt, fabellas disputando eu vix. Te vim eripuit debitis tincidunt, in vim nonumes consetetur.", + "Affert exerci aperiri pri ea. Ut dicant essent corrumpit sit. Sea saepe nullam referrentur ut, vis dolores perfecto cu. At nam inimicus evertitur vulputate.", + "Dolor volutpat praesent vix ne, at soluta oblique admodum eum. Duis adipisci mea in, nam ut tota choro theophrastus. Ex scripta definitiones mei, augue doctus ne sed, munere posidonium eum id. Ad graeco audire per.", + "Sale salutatus et mei, mea elit illud adipiscing ei, cum ea sumo melius forensibus. Eu inani iusto oporteat eum, ei vix iisque saperet detraxit. Fabulas perpetua similique eam ne, noster corpora dissentiet qui ex, et qui integre graecis. Eripuit nonumes deterruisset an pro, ei ferri similique cum. Odio dolores inciderint ei vim, an est dolorum delicata temporibus, eu mea quis accumsan. Vel stet affert option at.", + "In gubergren voluptaria reprimique pro, option fuisset id est. Rebum delicata ad sea, ex vidit errem vis, mei at duis dicam sensibus. Nibh debet iudicabit has no, vim te dicit libris possim. Debet viderer consequuntur ea pro. Ex dicat iriure scripta pro.", + "An dicat diceret eligendi duo. Est cu equidem deterruisset, usu ad regione equidem, vim amet vero possim ex. Theophrastus conclusionemque ad quo, inimicus deseruisse voluptatibus eum et. Duis delectus mandamus an mei, usu timeam nostrum suscipiantur id." + +$paragraphs | Out-WordWrap -Width 100 diff --git a/Task/Word-wrap/REXX/word-wrap-1.rexx b/Task/Word-wrap/REXX/word-wrap-1.rexx index ac7babbf6e..1ffcdbb622 100644 --- a/Task/Word-wrap/REXX/word-wrap-1.rexx +++ b/Task/Word-wrap/REXX/word-wrap-1.rexx @@ -1,17 +1,18 @@ -/*REXX pgm reads a file and displays it (with word wrap to the screen). */ -parse arg iFID width /*get optional arguments from CL.*/ -@= /*nullify the text (so far). */ - do j=0 while lines(iFID)\==0 /*read from the file until E-O-F.*/ - @=@ linein(iFID) /*append the file's text to @ */ - end /*j*/ -$=word(@,1) - do k=2 for words(@)-1; x=word(@,k) /*parse until text (@) exhausted.*/ - _=$ x /*append it to the money and see.*/ - if length(_)>width then do /*words exceeded the width? */ - say $ /*display what we got so far. */ - _=x /*overflow for the next line. */ - end - $=_ /*append this word to the output.*/ - end /*k*/ -if $\=='' then say $ /*handle any residual words. */ - /*stick a fork in it, we're done.*/ +/*REXX program reads a file and displays it to the screen (with word wrap). */ +parse arg iFID width . /*obtain optional arguments from the CL*/ +if iFID=='' | iFID=="," then iFID='LAWS.TXT' /*Not specified? Then use the default.*/ +if width=='' | width=="," then width=linesize() /* " " " " " " */ +@= /*number of words in the file (so far).*/ + do while lines(iFID)\==0 /*read from the file until End-Of-File.*/ + @=@ linein(iFID) /*get a record (line of text). */ + end /*while*/ +$=word(@,1) /*initialize $ with the first word. */ + do k=2 for words(@)-1; x=word(@,k) /*parse until text (@) exhausted. */ + _=$ x /*append it to the $ list and test. */ + if length(_)>width then do; say $ /*this word a bridge too far? > w. */ + _=x /*assign this word to the next line. */ + end + $=_ /*new words (on a line) are OK so far.*/ + end /*m*/ +if $\=='' then say $ /*handle any residual words (overflow).*/ + /*stick a fork in it, we're all done. */ diff --git a/Task/Word-wrap/REXX/word-wrap-2.rexx b/Task/Word-wrap/REXX/word-wrap-2.rexx index 670294c99d..327ea7e72f 100644 --- a/Task/Word-wrap/REXX/word-wrap-2.rexx +++ b/Task/Word-wrap/REXX/word-wrap-2.rexx @@ -1,48 +1,42 @@ -/*REXX pgm reads a file and displays it (with word wrap to the screen).*/ -parse arg iFID width justify _ . /*get optional CL args.*/ -if iFID='' |iFID==',' then iFID ='LAWS.TXT' /*default input file ID*/ -if width==''|width==',' then width=linesize() /*Default? Use linesize*/ -if width==0 then width=80 /*indeterminable width.*/ -if right(width,1)=='%' then do /*handle % of width. */ - width=translate(width,,'%') /*remove the %*/ - width=linesize() * translate(width,,"%")%100 - end -if justify==''|justify==',' then justify='Left' /*Default? Use LEFT */ -just=left(justify,1) /*only use first char of JUSTIFY.*/ -upper just /*be able to handle mixed case. */ -if pos(just,'BCLR')==0 then call err "JUSTIFY (3rd arg) is illegal:" justify -if _\=='' then call err "too many arguments specified." _ -if \datatype(width,'W') then call err "WIDTH (2nd arg) isn't an integer:" width -n=0 /*number of words in the file. */ - do j=0 while lines(iFID)\==0 /*read from the file until E-O-F.*/ - _=linein(iFID) /*get a record (line of text). */ - do words(_) /*extract some words (maybe not).*/ - n=n+1; parse var _ @.n _ /*get & assign next word in text.*/ - end /*DO words(_)*/ - end /*j*/ +/*REXX program reads a file and displays it to the screen (with word wrap). */ +parse arg iFID width justify _ . /*obtain optional arguments from the CL*/ +if iFID=='' | iFID=="," then iFID ='LAWS.TXT' /*Not specified? Then use the defaul.t*/ +if width=='' |width=="," then width=linesize() /* " " " " " " */ +if right(width, 1)=='%' then width=linesize() * translate(width, , "%") % 100 +if justify==''|justify=="," then justify='Left' /*Default? Then use the default: LEFT */ +just=left(justify, 1) /*only use first char of JUSTIFY. */ +upper just /*be able to handle mixed case. */ +if pos(just, 'BCLR')==0 then call err "JUSTIFY (3rd arg) is illegal:" justify +if _\=='' then call err "too many arguments specified." _ +if \datatype(width,'W') then call err "WIDTH (2nd arg) isn't an integer:" width +n=0 /*the number of words in the file. */ + do j=0 while lines(iFID)\==0 /*read from the file until End-Of-File.*/ + _=linein(iFID) /*get a record (line of text). */ + do until _==''; n=n+1 /*extract some words (or maybe not). */ + parse var _ @.n _ /*obtain and assign next word in text. */ + end /*DO until*/ /*parse 'til the line of text is null. */ + end /*j*/ if j==0 then call err 'file' iFID "not found." if n==0 then call err 'file' iFID "is empty (or has no words)" -$=@.1 /*init da money bag with 1st word*/ - do m=2 for n-1; x=@.m /*parse until text (@) exhausted.*/ - _=$ x /*append it to the money and see.*/ - if length(_)>width then call tell /*this word a bridge too far? >w*/ - $=_ /*the new words are OK so far. */ - end /*m*/ -call tell /*handle any residual words. */ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────ERR subroutine──────────────────────*/ -err: say; say '***error!***'; say; say arg(1); say; say; exit 13 -/*──────────────────────────────────TELL subroutine─────────────────────*/ -tell: if $=='' then return /*first word may be too long. */ -if just=='L' then $= strip($) /*left ◄────────*/ - else do - w=max(width,length($)) /*don't truncate long words.*/ - select - when just=='R' then $= right($,w) /*──────► right */ - when just=='B' then $=justify($,w) /*◄────both────►*/ - when just=='C' then $= center($,w) /* ◄centered► */ - end /*select*/ - end -say $ /*show and tell, or write──►file?*/ -_=x /*handle any word overflow. */ -return /*go back and keep truckin'. */ +$=@.1 /*initialize $ string with first word*/ + do m=2 for n-1; x=@.m /*parse until text (@) is exhausted. */ + _=$ x /*append it to the $ string and test.*/ + if length(_)>width then call tell /*this word a bridge too far? > w */ + $=_ /*the new words are OK (so far). */ + end /*m*/ +call tell /*handle any residual words (if any). */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +err: say; say '***error***'; say; say arg(1); say; say; exit 13 +/*──────────────────────────────────────────────────────────────────────────────────────*/ +tell: if $=='' then return /* [↓] the first word may be too long.*/ + w=max(width, length($) ) /*don't truncate long words (> w). */ + select + when just=='L' then $= strip($) /*left ◄──────── */ + when just=='R' then $= right($,w) /*──────► right */ + when just=='B' then $=justify($,w) /*◄────both────► */ + when just=='C' then $= center($,w) /* ◄centered► */ + end /*select*/ + say $ /*display the line of words to terminal*/ + _=x /*handle any word overflow. */ + return /*go back and keep truckin'. */ diff --git a/Task/Word-wrap/Ruby/word-wrap.rb b/Task/Word-wrap/Ruby/word-wrap.rb index cf58450f51..f3403b9ef2 100644 --- a/Task/Word-wrap/Ruby/word-wrap.rb +++ b/Task/Word-wrap/Ruby/word-wrap.rb @@ -1,11 +1,11 @@ class String def wrap(width) - txt = gsub(/\s+/, " ") + txt = gsub("\n", " ") para = [] i = 0 - while i < txt.length + while i < length j = i + width - j -= 1 while txt[j] != " " + j -= 1 while j != txt.length && j > i + 1 && !(txt[j] =~ /\s/) para << txt[i ... j] i = j + 1 end diff --git a/Task/Write-float-arrays-to-a-text-file/00DESCRIPTION b/Task/Write-float-arrays-to-a-text-file/00DESCRIPTION index bed6a93489..7eda073276 100644 --- a/Task/Write-float-arrays-to-a-text-file/00DESCRIPTION +++ b/Task/Write-float-arrays-to-a-text-file/00DESCRIPTION @@ -3,6 +3,7 @@ {{omit from|Retro|No floating point in standard VM}} {{omit from|UNIX Shell}} +;Task: Write two equal-sized numerical arrays 'x' and 'y' to a two-column text file named 'filename'. @@ -23,3 +24,4 @@ The file is: 1e+011 3.1623e+005 This task is intended as a subtask for [[Measure relative performance of sorting algorithms implementations]]. +

    diff --git a/Task/Write-float-arrays-to-a-text-file/Elixir/write-float-arrays-to-a-text-file.elixir b/Task/Write-float-arrays-to-a-text-file/Elixir/write-float-arrays-to-a-text-file.elixir new file mode 100644 index 0000000000..d32f4ff505 --- /dev/null +++ b/Task/Write-float-arrays-to-a-text-file/Elixir/write-float-arrays-to-a-text-file.elixir @@ -0,0 +1,22 @@ +defmodule Write_float_arrays do + def task(xs, ys, fname, precision\\[]) do + xprecision = Keyword.get(precision, :x, 2) + yprecision = Keyword.get(precision, :y, 3) + format = "~.#{xprecision}g\t~.#{yprecision}g~n" + File.open!(fname, [:write], fn file -> + Enum.zip(xs, ys) + |> Enum.each(fn {x, y} -> :io.fwrite file, format, [x, y] end) + end) + end +end + +x = [1.0, 2.0, 3.0, 1.0e11] +y = for n <- x, do: :math.sqrt(n) +fname = "filename.txt" + +Write_float_arrays.task(x, y, fname) +IO.puts File.read!(fname) + +precision = [x: 3, y: 5] +Write_float_arrays.task(x, y, fname, precision) +IO.puts File.read!(fname) diff --git a/Task/Write-float-arrays-to-a-text-file/Mercury/write-float-arrays-to-a-text-file.mercury b/Task/Write-float-arrays-to-a-text-file/Mercury/write-float-arrays-to-a-text-file.mercury new file mode 100644 index 0000000000..eb39eb0f3e --- /dev/null +++ b/Task/Write-float-arrays-to-a-text-file/Mercury/write-float-arrays-to-a-text-file.mercury @@ -0,0 +1,29 @@ +:- module write_float_arrays. +:- interface. + +:- import_module io. + +:- pred main(io::di, io::uo) is det. +:- implementation. + +:- import_module float, list, math, string. + +main(!IO) :- + io.open_output("filename", OpenFileResult, !IO), + ( + OpenFileResult = ok(File), + X = [1.0, 2.0, 3.0, 1e11], + list.foldl_corresponding(write_dat(File, 3, 5), X, map(sqrt, X), !IO), + io.close_output(File, !IO) + ; + OpenFileResult = error(IO_Error), + io.stderr_stream(Stderr, !IO), + io.format(Stderr, "error: %s\n", [s(io.error_message(IO_Error))], !IO), + io.set_exit_status(1, !IO) + ). + +:- pred write_dat(text_output_stream::in, int::in, int::in, float::in, + float::in, io::di, io::uo) is det. + +write_dat(File, XPrec, YPrec, X, Y, !IO) :- + io.format(File, "%.*g\t%.*g\n", [i(XPrec), f(X), i(YPrec), f(Y)], !IO). diff --git a/Task/Write-float-arrays-to-a-text-file/Perl/write-float-arrays-to-a-text-file-1.pl b/Task/Write-float-arrays-to-a-text-file/Perl/write-float-arrays-to-a-text-file-1.pl new file mode 100644 index 0000000000..5398fd7927 --- /dev/null +++ b/Task/Write-float-arrays-to-a-text-file/Perl/write-float-arrays-to-a-text-file-1.pl @@ -0,0 +1,18 @@ +use autodie; + +sub writedat { + my ($filename, $x, $y, $xprecision, $yprecision) = @_; + + open my $fh, ">", $filename; + + for my $i (0 .. $#$x) { + printf $fh "%.*g\t%.*g\n", $xprecision||3, $x->[$i], $yprecision||5, $y->[$i]; + } + + close $fh; +} + +my @x = (1, 2, 3, 1e11); +my @y = map sqrt, @x; + +writedat("sqrt.dat", \@x, \@y); diff --git a/Task/Write-float-arrays-to-a-text-file/Perl/write-float-arrays-to-a-text-file-2.pl b/Task/Write-float-arrays-to-a-text-file/Perl/write-float-arrays-to-a-text-file-2.pl new file mode 100644 index 0000000000..11cd7d9d24 --- /dev/null +++ b/Task/Write-float-arrays-to-a-text-file/Perl/write-float-arrays-to-a-text-file-2.pl @@ -0,0 +1,19 @@ +use autodie; +use List::MoreUtils qw(each_array); + +sub writedat { + my ($filename, $x, $y, $xprecision, $yprecision) = @_; + open my $fh, ">", $filename; + + my $ea = each_array(@$x, @$y); + while ( my ($i, $j) = $ea->() ) { + printf $fh "%.*g\t%.*g\n", $xprecision||3, $i, $yprecision||5, $j; + } + + close $fh; +} + +my @x = (1, 2, 3, 1e11); +my @y = map sqrt, @x; + +writedat("sqrt.dat", \@x, \@y); diff --git a/Task/Write-float-arrays-to-a-text-file/Perl/write-float-arrays-to-a-text-file.pl b/Task/Write-float-arrays-to-a-text-file/Perl/write-float-arrays-to-a-text-file.pl deleted file mode 100644 index f4b69b3152..0000000000 --- a/Task/Write-float-arrays-to-a-text-file/Perl/write-float-arrays-to-a-text-file.pl +++ /dev/null @@ -1,11 +0,0 @@ -sub writedat { - my ($filename, $x, $y, $xprecision, $yprecision) = @_; - open FH, ">", $filename or die "Can't open file: $!"; - printf FH "%.*g\t%.*g\n", $xprecision||3, $x->[$_], $yprecision||5, $y->[$_] for 0 .. $#$x; - close FH; -} - -my @x = (1, 2, 3, 1e11); -my @y = map sqrt, @x; - -writedat("sqrt.dat", \@x, \@y); diff --git a/Task/Write-float-arrays-to-a-text-file/PowerShell/write-float-arrays-to-a-text-file.psh b/Task/Write-float-arrays-to-a-text-file/PowerShell/write-float-arrays-to-a-text-file.psh new file mode 100644 index 0000000000..d61894e381 --- /dev/null +++ b/Task/Write-float-arrays-to-a-text-file/PowerShell/write-float-arrays-to-a-text-file.psh @@ -0,0 +1,8 @@ +$x = @(1, 2, 3, 1e11) +$y = @(1, 1.4142135623730951, 1.7320508075688772, 316227.76601683791) +$xprecision = 3 +$yprecision = 5 +$arr = foreach($i in 0..($x.count-1)) { + [pscustomobject]@{x = "{0:g$xprecision}" -f $x[$i]; y = "{0:g$yprecision}" -f $y[$i]} +} +$arr | format-table -HideTableHeaders > filename.txt diff --git a/Task/Write-float-arrays-to-a-text-file/REXX/write-float-arrays-to-a-text-file.rexx b/Task/Write-float-arrays-to-a-text-file/REXX/write-float-arrays-to-a-text-file.rexx index 53c877e41c..e9cfb2ee5f 100644 --- a/Task/Write-float-arrays-to-a-text-file/REXX/write-float-arrays-to-a-text-file.rexx +++ b/Task/Write-float-arrays-to-a-text-file/REXX/write-float-arrays-to-a-text-file.rexx @@ -1,29 +1,27 @@ -/*REXX program writes two arrays to a file with limited precision, */ -numeric digits 1000 /* ··· but allow a huge # of digits. */ -outfid = 'OUTPUT.TXT' /*file name structure is OS dependent*/ - x. = ; y. = - x.1 = 1 ; y.1 = 1 - x.2 = 2 ; y.2 = 1.4142135623730951 - x.3 = 3 ; y.3 = 1.7320508075688772 - x.4 = 1e11 ; y.4 = 316227.76601683791 -xPrecision = 3 /*precision for the X numbers. */ -yPrecision = 5 /* " " " Y " */ -padding=left('',4) /*number of blanks between cols. */ - do j=1 while x.j\=='' /*process all numbers.*/ - x.j=req_way(x.j, xPrecision) /*format the X numbers*/ - y.j=req_way(y.j, yPrecision) /* " " Y " */ - aLine=translate(x.j || padding || y.j, 'e', "E") - say aLine /*display to terminal.*/ - call lineout outfid,aLine /*write to disk file. */ - end /*j*/ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────REQ_WAY (required) subroutine───────*/ -req_way: procedure; parse arg a,p; numeric digits p; a=format(a,,p) -parse var a mantissa 'E' expon /*obtain the exponent digits. */ -parse var mantissa int '.' fract /* " " integer & fraction. */ -fract=strip(fract, 'T', 0) /*strip trailing zeros from frac.*/ -if fract\=='' then fract='.'fract /*if fraction digits, add decimal*/ -if expon\=='' then expon='E'expon /* " exponent " " an E */ -a=int || fract || expon /*format # according to the rules*/ -if datatype(a,'W') then return format(arg(1)/1,,0) /*whole number? */ - return format(arg(1)/1,,,3,0) /*use 3 dec digs*/ +/*REXX program writes two arrays to a file with a specified (limited) precision. */ +numeric digits 1000 /*allow use of a huge number of digits.*/ +oFID= 'filename' /*name of the output File IDentifier.*/ +x.=; y.=; x.1= 1 ; y.1= 1 + x.2= 2 ; y.2= 1.4142135623730951 + x.3= 3 ; y.3= 1.7320508075688772 + x.4= 1e11 ; y.4= 316227.76601683791 +xPrecision= 3 /*the precision for the X numbers. */ +yPrecision= 5 /* " " " " Y " */ + do j=1 while x.j\=='' /*process and reformat all the numbers.*/ + newX=rule(x.j, xPrecision) /*format X numbers with new precision*/ + newY=rule(y.j, yPrecision) /* " Y " " " " */ + aLine=translate(newX || left('',4) || newY, "e", 'E') + say aLine /*display re─formatted numbers ──► term*/ + call lineout oFID, aLine /*write " " " disk*/ + end /*j*/ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +rule: procedure; parse arg z 1 oz,p; numeric digits p; z=format(z,,p) + parse var z mantissa 'E' exponent /*get the dec dig exponent*/ + parse var mantissa int '.' fraction /* " integer and fraction*/ + fraction=strip(fraction, 'T', 0) /*strip trailing zeroes.*/ + if fraction\=='' then fraction="."fraction /*any fractional digits ? */ + if exponent\=='' then exponent="E"exponent /*in exponential format ? */ + z=int || fraction || exponent /*format # (as per rules)*/ + if datatype(z,'W') then return format(oz/1,,0) /*is it a whole number ? */ + return format(oz/1,,,3,0) /*3 dec. digs in exponent.*/ diff --git a/Task/Write-language-name-in-3D-ASCII/00DESCRIPTION b/Task/Write-language-name-in-3D-ASCII/00DESCRIPTION index 30ff01a9a6..c24b48a033 100644 --- a/Task/Write-language-name-in-3D-ASCII/00DESCRIPTION +++ b/Task/Write-language-name-in-3D-ASCII/00DESCRIPTION @@ -1,6 +1,11 @@ {{omit from|GUISS}} {{omit from|TUSCRIPT}} -The task is to write the language's name in 3D ASCII. + +;Task: +Write/display a language's name in '''3D''' ASCII. + + (We can leave the definition of "3D ASCII" fuzzy, so long as the result is interesting or amusing, not a cheap hack to satisfy the task.) +

    diff --git a/Task/Write-language-name-in-3D-ASCII/360-Assembly/write-language-name-in-3d-ascii.360 b/Task/Write-language-name-in-3D-ASCII/360-Assembly/write-language-name-in-3d-ascii.360 new file mode 100644 index 0000000000..a3e93075e1 --- /dev/null +++ b/Task/Write-language-name-in-3D-ASCII/360-Assembly/write-language-name-in-3d-ascii.360 @@ -0,0 +1,13 @@ +THREED CSECT + STM 14,12,12(13) + BALR 12,0 + USING *,12 + XPRNT =CL23'0 ####. #. ###.',23 + XPRNT =CL24'1 #. #. #. #.',24 + XPRNT =CL24'1 ##. # ##. #. #.',24 + XPRNT =CL24'1 #. #. #. #. #.',24 + XPRNT =CL23'1 ####. ###. ###.',23 + LM 14,12,12(13) + BR 14 + LTORG + END diff --git a/Task/Write-language-name-in-3D-ASCII/BASIC/write-language-name-in-3d-ascii-8.basic b/Task/Write-language-name-in-3D-ASCII/BASIC/write-language-name-in-3d-ascii-8.basic new file mode 100644 index 0000000000..8e1201899b --- /dev/null +++ b/Task/Write-language-name-in-3D-ASCII/BASIC/write-language-name-in-3d-ascii-8.basic @@ -0,0 +1,18 @@ +5 PAPER 0: CLS +10 LET d=0: INK 1: GO SUB 40 +20 LET d=1: INK 6: GO SUB 40 +30 STOP +40 RESTORE +50 FOR n=1 TO 5 +60 READ a$ +70 FOR j=1 TO LEN a$ +80 PRINT AT n+7,j+5+d; +90 IF a$(j)="X" THEN PRINT CHR$ 143: REM Equivalent to 219 in ASCII extended for IBM PC +100 NEXT j +110 NEXT n +120 RETURN +130 DATA "XXX XXXX XXX X XXX" +140 DATA "X X X X X X X " +150 DATA "XXX XXXX XXX X X " +160 DATA "X X X X X X X " +170 DATA "XXX X X XXX X XXX" diff --git a/Task/Write-language-name-in-3D-ASCII/Forth/write-language-name-in-3d-ascii-1.fth b/Task/Write-language-name-in-3D-ASCII/Forth/write-language-name-in-3d-ascii-1.fth new file mode 100644 index 0000000000..2854b9bccc --- /dev/null +++ b/Task/Write-language-name-in-3D-ASCII/Forth/write-language-name-in-3d-ascii-1.fth @@ -0,0 +1,17 @@ +\ Rossetta Code Write language name in 3D ASCII +\ Simple Method + +: l1 ." /\\\\\\\\\\\\\ /\\\\ /\\\\\\\ /\\\\\\\\\\\\\ /\\\ /\\\" CR ; +: l2 ." \/\\\///////// /\\\//\\\ /\\\/////\\\ \//////\\\//// \/\\\ \/\\\" CR ; +: l3 ." \/\\\ /\\\/ \///\\\ \/\\\ \/\\\ \/\\\ \/\\\ \/\\\" CR ; +: l4 ." \/\\\\\\\\\ /\\\ \//\\\ \/\\\\\\\\\/ \/\\\ \/\\\\\\\\\\\\\" CR ; +: l5 ." \/\\\///// \/\\\ \/\\\ \/\\\////\\\ \/\\\ \/\\\///////\\\" CR ; +: l6 ." \/\\\ \//\\\ /\\\ \/\\\ \//\\\ \/\\\ \/\\\ \/\\\" CR ; +: l7 ." \/\\\ \///\\\ /\\\ \/\\\ \//\\\ \/\\\ \/\\\ \/\\\" CR ; +: l8 ." \/\\\ \///\\\\/ \/\\\ \//\\\ \/\\\ \/\\\ \/\\\" CR ; +: l9 ." \/// \//// \/// \/// \/// \/// \///" CR ; + +: "FORTH" cr L1 L2 L3 L4 L5 L6 L7 L8 l9 ; + +( test at the console ) +page "forth" diff --git a/Task/Write-language-name-in-3D-ASCII/Forth/write-language-name-in-3d-ascii-2.fth b/Task/Write-language-name-in-3D-ASCII/Forth/write-language-name-in-3d-ascii-2.fth new file mode 100644 index 0000000000..1d6d1dae89 --- /dev/null +++ b/Task/Write-language-name-in-3D-ASCII/Forth/write-language-name-in-3d-ascii-2.fth @@ -0,0 +1,101 @@ +\ Original code: "Short phrases with BIG Characters by Wil Baden 2003-02-23 +\ Modified BFox for simple 3D presentation 2015-07-14 + +\ Forth is a very low level language but by using primitive operations +\ we create new words in the language to solve the problem. + +\ This solution coverts an acsii string to big text characters + +HEX +: toUpper ( char -- char ) 05F and ; + + +: w, ( n -- ) CSWAP , ; \ compile 'n', a 16 bit integer, into memory in the correct order + + +CREATE Banner-Matrix + 0000 w, 0000 w, 0000 w, 0000 w, 2020 w, 2020 w, 2000 w, 2000 w, + 5050 w, 5000 w, 0000 w, 0000 w, 5050 w, F850 w, F850 w, 5000 w, + 2078 w, A070 w, 28F0 w, 2000 w, C0C8 w, 1020 w, 4098 w, 1800 w, + 40A0 w, A040 w, A890 w, 6800 w, 3030 w, 1020 w, 0000 w, 0000 w, + 2040 w, 8080 w, 8040 w, 2000 w, 2010 w, 0808 w, 0810 w, 2000 w, + 20A8 w, 7020 w, 70A8 w, 2000 w, 0020 w, 2070 w, 2020 w, 0000 w, + 0000 w, 0030 w, 3010 w, 2000 w, 0000 w, 0070 w, 0000 w, 0000 w, + 0000 w, 0000 w, 0030 w, 3000 w, 0008 w, 1020 w, 4080 w, 0000 w, + + 7088 w, 98A8 w, C888 w, 7000 w, 2060 w, 2020 w, 2020 w, 7000 w, + 7088 w, 0830 w, 4080 w, F800 w, F810 w, 2030 w, 0888 w, 7000 w, + 1030 w, 5090 w, F810 w, 1000 w, F880 w, F008 w, 0888 w, 7000 w, + 3840 w, 80F0 w, 8888 w, 7000 w, F808 w, 1020 w, 4040 w, 4000 , + 7088 w, 8870 w, 8888 w, 7000 w, 7088 w, 8878 w, 0810 w, E000 w, + 0060 w, 6000 w, 6060 w, 0000 w, 0060 w, 6000 w, 6060 w, 4000 w, + 1020 w, 4080 w, 4020 w, 1000 w, 0000 w, F800 w, F800 w, 0000 w, + 4020 w, 1008 w, 1020 w, 4000 w, 7088 w, 1020 w, 2000 w, 2000 w, + + 7088 w, A8B8 w, B080 w, 7800 w, 2050 w, 8888 w, F888 w, 8800 w, + F088 w, 88F0 w, 8888 w, F000 w, 7088 w, 8080 w, 8088 w, 7000 w, + F048 w, 4848 w, 4848 w, F000 w, F880 w, 80F0 w, 8080 w, F800 w, + F880 w, 80F0 w, 8080 w, 8000 w, 7880 w, 8080 w, 9888 w, 7800 w, + 8888 w, 88F8 w, 8888 w, 8800 w, 7020 w, 2020 w, 2020 w, 7000 w, + 0808 w, 0808 w, 0888 w, 7800 w, 8890 w, A0C0 w, A090 w, 8800 w, + 8080 w, 8080 w, 8080 w, F800 w, 88D8 w, A8A8 w, 8888 w, 8800 w, + 8888 w, C8A8 w, 9888 w, 8800 w, 7088 w, 8888 w, 8888 w, 7000 w, + + F088 w, 88F0 w, 8080 w, 8000 w, 7088 w, 8888 w, A890 w, 6800 w, + F088 w, 88F0 w, A090 w, 8800 w, 7088 w, 8070 w, 0888 w, 7000 w, + F820 w, 2020 w, 2020 w, 2000 w, 8888 w, 8888 w, 8888 w, 7000 w, + 8888 w, 8888 w, 8850 w, 2000 w, 8888 w, 88A8 w, A8D8 w, 8800 w, + 8888 w, 5020 w, 5088 w, 8800 w, 8888 w, 5020 w, 2020 w, 2000 w, + F808 w, 1020 w, 4080 w, F800 w, 7840 w, 4040 w, 4040 w, 7800 w, + 0080 w, 4020 w, 1008 w, 0000 w, F010 w, 1010 w, 1010 w, F000 w, + 0000 w, 2050 w, 8800 w, 0000 w, 0000 w, 0000 w, 0000 w, 00F8 w, + + +: >col ( char -- ndx ) \ convert ascii char into column index in the matrix + toupper BL - 0 MAX ; \ Space char (BL) = 0. Index is clipped to 0 as minimum value + + +: ]banner-matrix ( row ascii -- addr ) \ convert Banner-matrix memory to a 2 dimensional matrix + >col 8 * Banner-matrix + + ; + + +: PLACE ( str len addr -- ) \ store a string with length at addr + 2DUP 2>R 1+ SWAP MOVE 2R> C! ; + +synonym len c@ \ fetch the 1st char of a counted string to return the length + +: BIT? ( byte bit# -- -1 | 0) \ given a byte and bit# on stack, return true or false flag + 1 swap lshift AND ; + +DECIMAL + +variable bannerstr 5 allot \ memory for the character string + +\ Font selection characters stored as counted strings +: STARFONT S" *" bannerstr PLACE ; +: HASHFONT S" ##" bannerstr PLACE ; +: 3DFONT S" _/" bannerstr PLACE ; + + +: .BIGCHAR ( matrix-byte -- ) + 2 7 \ we use bits 7 to 2 + DO + dup I bit? \ check bit I in the matrix-byte on stack + IF bannerstr count TYPE \ if BIT=TRUE + ELSE bannerstr len SPACES \ if BIT=false + THEN + -1 +LOOP \ loop backwards + DROP ; \ drop the matrix-byte + +: BANNER ( str len -- ) + 8 0 + DO CR \ str len + 2dup + BOUNDS \ calc. begin & end addresses of string + DO + J I C@ ]Banner-Matrix C@ .BIGCHAR + LOOP \ str len + LOOP + 2DROP ; \ drop str & len + +\ test the solution in the Forth console diff --git a/Task/Write-language-name-in-3D-ASCII/Python/write-language-name-in-3d-ascii.py b/Task/Write-language-name-in-3D-ASCII/Python/write-language-name-in-3d-ascii-1.py similarity index 100% rename from Task/Write-language-name-in-3D-ASCII/Python/write-language-name-in-3d-ascii.py rename to Task/Write-language-name-in-3D-ASCII/Python/write-language-name-in-3d-ascii-1.py diff --git a/Task/Write-language-name-in-3D-ASCII/Python/write-language-name-in-3d-ascii-2.py b/Task/Write-language-name-in-3D-ASCII/Python/write-language-name-in-3d-ascii-2.py new file mode 100644 index 0000000000..2226ca86a7 --- /dev/null +++ b/Task/Write-language-name-in-3D-ASCII/Python/write-language-name-in-3d-ascii-2.py @@ -0,0 +1,36 @@ +l = 20 +h = 11 + +table = [ + """ .----------------. .----------------. .----------------. .----------------. .----------------. .----------------. .----------------. .----------------. .----------------. .----------------. .----------------. .----------------. .----------------. .-----------------. .----------------. .----------------. .----------------. .----------------. .----------------. .----------------. .----------------. .----------------. .----------------. .----------------. .----------------. .----------------. .----------------. .----------------. """, + """| .--------------. || .--------------. || .--------------. || .--------------. || .--------------. || .--------------. || .--------------. || .--------------. || .--------------. || .--------------. || .--------------. || .--------------. || .--------------. || .--------------. || .--------------. || .--------------. || .--------------. || .--------------. || .--------------. || .--------------. || .--------------. || .--------------. || .--------------. || .--------------. || .--------------. || .--------------. || .--------------. || .--------------. |""", + """| | __ | || | ______ | || | ______ | || | ________ | || | _________ | || | _________ | || | ______ | || | ____ ____ | || | _____ | || | _____ | || | ___ ____ | || | _____ | || | ____ ____ | || | ____ _____ | || | ____ | || | ______ | || | ___ | || | _______ | || | _______ | || | _________ | || | _____ _____ | || | ____ ____ | || | _____ _____ | || | ____ ____ | || | ____ ____ | || | ________ | || | ______ | || | | |""", + """| | / \ | || | |_ _ \ | || | .' ___ | | || | |_ ___ `. | || | |_ ___ | | || | |_ ___ | | || | .' ___ | | || | |_ || _| | || | |_ _| | || | |_ _| | || | |_ ||_ _| | || | |_ _| | || ||_ \ / _|| || ||_ \|_ _| | || | .' `. | || | |_ __ \ | || | .' '. | || | |_ __ \ | || | / ___ | | || | | _ _ | | || ||_ _||_ _|| || ||_ _| |_ _| | || ||_ _||_ _|| || | |_ _||_ _| | || | |_ _||_ _| | || | | __ _| | || | / _ __ `. | || | | |""", + """| | / /\ \ | || | | |_) | | || | / .' \_| | || | | | `. \ | || | | |_ \_| | || | | |_ \_| | || | / .' \_| | || | | |__| | | || | | | | || | | | | || | | |_/ / | || | | | | || | | \/ | | || | | \ | | | || | / .--. \ | || | | |__) | | || | / .-. \ | || | | |__) | | || | | (__ \_| | || | |_/ | | \_| | || | | | | | | || | \ \ / / | || | | | /\ | | | || | \ \ / / | || | \ \ / / | || | |_/ / / | || | |_/____) | | || | | |""", + """| | / ____ \ | || | | __'. | || | | | | || | | | | | | || | | _| _ | || | | _| | || | | | ____ | || | | __ | | || | | | | || | _ | | | || | | __'. | || | | | _ | || | | |\ /| | | || | | |\ \| | | || | | | | | | || | | ___/ | || | | | | | | || | | __ / | || | '.___`-. | || | | | | || | | ' ' | | || | \ \ / / | || | | |/ \| | | || | > `' < | || | \ \/ / | || | .'.' _ | || | / ___.' | || | | |""", + """| | _/ / \ \_ | || | _| |__) | | || | \ `.___.'\ | || | _| |___.' / | || | _| |___/ | | || | _| |_ | || | \ `.___] _| | || | _| | | |_ | || | _| |_ | || | | |_' | | || | _| | \ \_ | || | _| |__/ | | || | _| |_\/_| |_ | || | _| |_\ |_ | || | \ `--' / | || | _| |_ | || | \ `-' \_ | || | _| | \ \_ | || | |`\____) | | || | _| |_ | || | \ `--' / | || | \ ' / | || | | /\ | | || | _/ /'`\ \_ | || | _| |_ | || | _/ /__/ | | || | |_| | || | | |""", + """| ||____| |____|| || | |_______/ | || | `._____.' | || | |________.' | || | |_________| | || | |_____| | || | `._____.' | || | |____||____| | || | |_____| | || | `.___.' | || | |____||____| | || | |________| | || ||_____||_____|| || ||_____|\____| | || | `.____.' | || | |_____| | || | `.___.\__| | || | |____| |___| | || | |_______.' | || | |_____| | || | `.__.' | || | \_/ | || | |__/ \__| | || | |____||____| | || | |______| | || | |________| | || | (_) | || | | |""", + """| | | || | | || | | || | | || | | || | | || | | || | | || | | || | | || | | || | | || | | || | | || | | || | | || | | || | | || | | || | | || | | || | | || | | || | | || | | || | | || | | || | | |""", + """| '--------------' || '--------------' || '--------------' || '--------------' || '--------------' || '--------------' || '--------------' || '--------------' || '--------------' || '--------------' || '--------------' || '--------------' || '--------------' || '--------------' || '--------------' || '--------------' || '--------------' || '--------------' || '--------------' || '--------------' || '--------------' || '--------------' || '--------------' || '--------------' || '--------------' || '--------------' || '--------------' || '--------------' |""", + """ '----------------' '----------------' '----------------' '----------------' '----------------' '----------------' '----------------' '----------------' '----------------' '----------------' '----------------' '----------------' '----------------' '----------------' '----------------' '----------------' '----------------' '----------------' '----------------' '----------------' '----------------' '----------------' '----------------' '----------------' '----------------' '----------------' '----------------' '----------------' """ + ] + +if __name__ == '__main__': + t = raw_input("Enter the text to convert :\n") + if not t : + t = "PYTHON" + + for i in range(h): + txt = "" + for char in t: + # get dec value of T + if char.isalpha(): + val = ord(char.upper()) - 65 + elif char == " ": + val= 27 + else: + val = 26 + begin = val*l + end = val*l + l + txt += table[i][begin:end] + print txt diff --git a/Task/Write-language-name-in-3D-ASCII/REXX/write-language-name-in-3d-ascii-3.rexx b/Task/Write-language-name-in-3D-ASCII/REXX/write-language-name-in-3d-ascii-3.rexx index 6564735310..52b6ec0bd8 100644 --- a/Task/Write-language-name-in-3D-ASCII/REXX/write-language-name-in-3d-ascii-3.rexx +++ b/Task/Write-language-name-in-3D-ASCII/REXX/write-language-name-in-3d-ascii-3.rexx @@ -1,17 +1,17 @@ -/*REXX pgm draws a "3D" image of text representation (any char except / & \).*/ -#=7; @.1 = '@@@@ ' - @.2 = '@ @ ' - @.3 = '@ @ @@@@ @ @ @ @ ' - @.4 = '@@@@ @ @ @ @ @ ' - @.5 = '@ @ @@@ @ @ ' - @.6 = '@ @ @ @ @ @ @ ' - @.7 = '@ @ @@@@ @ @ @ @ ' - do j=1 for #; x=left(strip(@.j),1) /* [↓] display the (above) text lines.*/ - $.1 = changestr( " " , @.j, ' ' ) ; $.2 = $.1 +/*REXX pgm draws a "3D" image of text representation; any character except / and \ */ +#=7; @.1 = '@@@@ ' + @.2 = '@ @ ' + @.3 = '@ @ @@@@ @ @ @ @ ' + @.4 = '@@@@ @ @ @ @ @ ' + @.5 = '@ @ @@@ @ @ ' + @.6 = '@ @ @ @ @ @ @ ' + @.7 = '@ @ @@@@ @ @ @ @ ' + do j=1 for #; x=left(strip(@.j),1) /* [↓] display the (above) text lines.*/ + $.1 = changestr( " " , @.j, ' ' ) ; $.2 = $.1 $.1 = changestr( x , $.1, '///' )" " $.2 = changestr( x , $.2, '\\\' )" " $.1 = changestr( "/ ", $.1, '/\' ) $.2 = changestr( "\ ", $.2, '\/' ) - do k=1 for 2; say strip(left('',#-j)$.k,'T') /*LEFT does indentation*/ - end /*k*/ /* [↓] display a line and its shadow.*/ - end /*j*/ /*stick a fork in it, we're all done. */ + do k=1 for 2; say strip(left('',#-j)$.k,"T") /*the LEFT BIF does indentation.*/ + end /*k*/ /* [↓] display a line and its shadow.*/ + end /*j*/ /*stick a fork in it, we're all done. */ diff --git a/Task/Write-language-name-in-3D-ASCII/SQL/write-language-name-in-3d-ascii.sql b/Task/Write-language-name-in-3D-ASCII/SQL/write-language-name-in-3d-ascii.sql new file mode 100644 index 0000000000..7b5c1a33ae --- /dev/null +++ b/Task/Write-language-name-in-3D-ASCII/SQL/write-language-name-in-3d-ascii.sql @@ -0,0 +1,7 @@ +select ' SSS\ ' as s, ' QQQ\ ' as q, 'L\ ' as l from dual +union all select 'S \|', 'Q Q\ ', 'L | ' from dual +union all select '\SSS ', 'Q Q |', 'L | ' from dual +union all select ' \ S\', 'Q Q Q |', 'L | ' from dual +union all select ' SSS |', '\QQQ\\|', 'LLLL\' from dual +union all select ' \__\/', ' \_Q_/ ', '\___\' from dual +union all select ' ', ' \\ ', ' ' from dual; diff --git a/Task/Write-to-Windows-event-log/00DESCRIPTION b/Task/Write-to-Windows-event-log/00DESCRIPTION index 1a5b271da1..973fdd0b02 100644 --- a/Task/Write-to-Windows-event-log/00DESCRIPTION +++ b/Task/Write-to-Windows-event-log/00DESCRIPTION @@ -1 +1,3 @@ +;Task: Write script status to the Windows Event Log +

    diff --git a/Task/XML-DOM-serialization/Bracmat/xml-dom-serialization-1.bracmat b/Task/XML-DOM-serialization/Bracmat/xml-dom-serialization-1.bracmat new file mode 100644 index 0000000000..13ce2fa663 --- /dev/null +++ b/Task/XML-DOM-serialization/Bracmat/xml-dom-serialization-1.bracmat @@ -0,0 +1,8 @@ +( ("?"."xml version=\"1.0\" ") + \n + (root.,"\n " (element.," + Some text here + ") \n) + : ?xml +& out$(toML$!xml) +); diff --git a/Task/XML-DOM-serialization/Bracmat/xml-dom-serialization-2.bracmat b/Task/XML-DOM-serialization/Bracmat/xml-dom-serialization-2.bracmat new file mode 100644 index 0000000000..609f35d48b --- /dev/null +++ b/Task/XML-DOM-serialization/Bracmat/xml-dom-serialization-2.bracmat @@ -0,0 +1,4 @@ +( ("?"."xml version=\"1.0\"") (root.,(element.,"Some text here")) + : ?xml +& out$(toML$!xml) +); diff --git a/Task/XML-DOM-serialization/Lua/xml-dom-serialization.lua b/Task/XML-DOM-serialization/Lua/xml-dom-serialization.lua new file mode 100644 index 0000000000..b14821ca57 --- /dev/null +++ b/Task/XML-DOM-serialization/Lua/xml-dom-serialization.lua @@ -0,0 +1,6 @@ +require("LuaXML") +local dom = xml.new("root") +local element = xml.new("element") +table.insert(element, "Some text here") +dom:append(element) +dom:save("dom.xml") diff --git a/Task/XML-Input/Fortran/xml-input-1.f b/Task/XML-Input/Fortran/xml-input-1.f new file mode 100644 index 0000000000..6c062064bf --- /dev/null +++ b/Task/XML-Input/Fortran/xml-input-1.f @@ -0,0 +1,33 @@ +program tixi_rosetta + use tixi + implicit none + integer :: i + character (len=100) :: xml_file_name + integer :: handle + integer :: error + character(len=100) :: name, xml_attr + xml_file_name = 'rosetta.xml' + + call tixi_open_document( xml_file_name, handle, error ) + i = 1 + do + xml_attr = '/Students/Student['//int2char(i)//']' + call tixi_get_text_attribute( handle, xml_attr,'Name', name, error ) + if(error /= 0) exit + write(*,*) name + i = i + 1 + enddo + + call tixi_close_document( handle, error ) + + contains + + function int2char(i) result(res) + character(:),allocatable :: res + integer,intent(in) :: i + character(range(i)+2) :: tmp + write(tmp,'(i0)') i + res = trim(tmp) + end function int2char + +end program tixi_rosetta diff --git a/Task/XML-Input/Fortran/xml-input-2.f b/Task/XML-Input/Fortran/xml-input-2.f new file mode 100644 index 0000000000..467c5865f9 --- /dev/null +++ b/Task/XML-Input/Fortran/xml-input-2.f @@ -0,0 +1,29 @@ +program fox_rosetta + use FoX_dom + use FoX_sax + implicit none + integer :: i + type(Node), pointer :: doc => null() + type(Node), pointer :: p1 => null() + type(Node), pointer :: p2 => null() + type(NodeList), pointer :: pointList => null() + character(len=100) :: name + + doc => parseFile("rosetta.xml") + if(.not. associated(doc)) stop "error doc" + + p1 => item(getElementsByTagName(doc, "Students"), 0) + if(.not. associated(p1)) stop "error p1" + ! write(*,*) getNodeName(p1) + + pointList => getElementsByTagname(p1, "Student") + ! write(*,*) getLength(pointList), "Student elements" + + do i = 0, getLength(pointList) - 1 + p2 => item(pointList, i) + call extractDataAttribute(p2, "Name", name) + write(*,*) name + enddo + + call destroy(doc) +end program fox_rosetta diff --git a/Task/XML-Input/REXX/xml-input-2.rexx b/Task/XML-Input/REXX/xml-input-2.rexx index 41e3652830..fe08e878ac 100644 --- a/Task/XML-Input/REXX/xml-input-2.rexx +++ b/Task/XML-Input/REXX/xml-input-2.rexx @@ -1,6 +1,85 @@ -April -Bob -Chad -Dave -Rover -Émily +/*REXX program to extract student names from an XML string(s). */ +g.= +g.1=' ' +g.2=' ' +g.3=' ' +g.4=' ' +g.5=' ' +g.6=' ' +g.7=' ' +g.8=' ' +g.9=' ' + + do j=1 while g.j\=='' + g.j=space(g.j) + parse var g.j 'Name="' studname '"' + if studname=='' then iterate + if pos('&',studname)\==0 then studname=xmlTranE(studname) + say studname + end /*j*/ +exit /*stick a fork in it, we're done.*/ +/*──────────────────────────────────XML_ subroutine─────────────────────*/ +xml_: parse arg ,_ /*tran an XML entity (&xxxx;) */ +xmlEntity! = '&'_";" +if pos(xmlEntity!,x)\==0 then x=changestr(xmlEntity!,x,arg(1)) +if left(_,2)=='#x' then do + xmlEntity!='&'left(_,3)translate(substr(_,4))";" + x=changestr(xmlEntity!,x,arg(1)) + end +return x +/*──────────────────────────────────XMLTRANE subroutine─────────────────*/ +xmlTranE: procedure; parse arg x /*Following are most of the chars in*/ + /*the DOS (under Windows) codepage. */ +x=XML_('♥',"hearts") ; x=XML_('â',"ETH") ; x=XML_('ƒ',"fnof") ; x=XML_('═',"boxH") +x=XML_('♦',"diams") ; x=XML_('â','#x00e2') ; x=XML_('á',"aacute"); x=XML_('╬',"boxVH") +x=XML_('♣',"clubs") ; x=XML_('â','#x00e9') ; x=XML_('á','#x00e1'); x=XML_('╧',"boxHu") +x=XML_('♠',"spades") ; x=XML_('ä',"auml") ; x=XML_('í',"iacute"); x=XML_('╨',"boxhU") +x=XML_('♂',"male") ; x=XML_('ä','#x00e4') ; x=XML_('í','#x00ed'); x=XML_('╤',"boxHd") +x=XML_('♀',"female") ; x=XML_('à',"agrave") ; x=XML_('ó',"oacute"); x=XML_('╥',"boxhD") +x=XML_('☼',"#x263c") ; x=XML_('à','#x00e0') ; x=XML_('ó','#x00f3'); x=XML_('╙',"boxUr") +x=XML_('↕',"UpDownArrow") ; x=XML_('å',"aring") ; x=XML_('ú',"uacute"); x=XML_('╘',"boxuR") +x=XML_('¶',"para") ; x=XML_('å','#x00e5') ; x=XML_('ú','#x00fa'); x=XML_('╒',"boxdR") +x=XML_('§',"sect") ; x=XML_('ç',"ccedil") ; x=XML_('ñ',"ntilde"); x=XML_('╓',"boxDr") +x=XML_('↑',"uarr") ; x=XML_('ç','#x00e7') ; x=XML_('ñ','#x00f1'); x=XML_('╫',"boxVh") +x=XML_('↑',"uparrow") ; x=XML_('ê',"ecirc") ; x=XML_('Ñ',"Ntilde"); x=XML_('╪',"boxvH") +x=XML_('↑',"ShortUpArrow") ; x=XML_('ê','#x00ea') ; x=XML_('Ñ','#x00d1'); x=XML_('┘',"boxul") +x=XML_('↓',"darr") ; x=XML_('ë',"euml") ; x=XML_('¿',"iquest"); x=XML_('┌',"boxdr") +x=XML_('↓',"downarrow") ; x=XML_('ë','#x00eb') ; x=XML_('⌐',"bnot") ; x=XML_('█',"block") +x=XML_('↓',"ShortDownArrow") ; x=XML_('è',"egrave") ; x=XML_('¬',"not") ; x=XML_('▄',"lhblk") +x=XML_('←',"larr") ; x=XML_('è','#x00e8') ; x=XML_('½',"frac12"); x=XML_('▀',"uhblk") +x=XML_('←',"leftarrow") ; x=XML_('ï',"iuml") ; x=XML_('½',"half") ; x=XML_('α',"alpha") +x=XML_('←',"ShortLeftArrow") ; x=XML_('ï','#x00ef') ; x=XML_('¼',"frac14"); x=XML_('ß',"beta") +x=XML_('1c'x,"rarr") ; x=XML_('î',"icirc") ; x=XML_('¡',"iexcl") ; x=XML_('ß',"szlig") +x=XML_('1c'x,"rightarrow") ; x=XML_('î','#x00ee') ; x=XML_('«',"laqru") ; x=XML_('ß','#x00df') +x=XML_('1c'x,"ShortRightArrow"); x=XML_('ì',"igrave") ; x=XML_('»',"raqru") ; x=XML_('Γ',"Gamma") +x=XML_('!',"excl") ; x=XML_('ì','#x00ec') ; x=XML_('░',"blk12") ; x=XML_('π',"pi") +x=XML_('"',"apos") ; x=XML_('Ä',"Auml") ; x=XML_('▒',"blk14") ; x=XML_('Σ',"Sigma") +x=XML_('$',"dollar") ; x=XML_('Ä','#x00c4') ; x=XML_('▓',"blk34") ; x=XML_('σ',"sigma") +x=XML_("'","quot") ; x=XML_('Å',"Aring") ; x=XML_('│',"boxv") ; x=XML_('µ',"mu") +x=XML_('*',"ast") ; x=XML_('Å','#x00c5') ; x=XML_('┤',"boxvl") ; x=XML_('τ',"tau") +x=XML_('/',"sol") ; x=XML_('É',"Eacute") ; x=XML_('╡',"boxvL") ; x=XML_('Φ',"phi") +x=XML_(':',"colon") ; x=XML_('É','#x00c9') ; x=XML_('╢',"boxVl") ; x=XML_('Θ',"Theta") +x=XML_('<',"lt") ; x=XML_('æ',"aelig") ; x=XML_('╖',"boxDl") ; x=XML_('δ',"delta") +x=XML_('=',"equals") ; x=XML_('æ','#x00e6') ; x=XML_('╕',"boxdL") ; x=XML_('∞',"infin") +x=XML_('>',"gt") ; x=XML_('Æ',"AElig") ; x=XML_('╣',"boxVL") ; x=XML_('φ',"Phi") +x=XML_('?',"quest") ; x=XML_('Æ','#x00c6') ; x=XML_('║',"boxV") ; x=XML_('ε',"epsilon") +x=XML_('@',"commat") ; x=XML_('ô',"ocirc") ; x=XML_('╗',"boxDL") ; x=XML_('∩',"cap") +x=XML_('[',"lbrack") ; x=XML_('ô','#x00f4') ; x=XML_('╝',"boxUL") ; x=XML_('≡',"equiv") +x=XML_('\',"bsol") ; x=XML_('ö',"ouml") ; x=XML_('╜',"boxUl") ; x=XML_('±',"plusmn") +x=XML_(']',"rbrack") ; x=XML_('ö','#x00f6') ; x=XML_('╛',"boxuL") ; x=XML_('±',"pm") +x=XML_('^',"Hat") ; x=XML_('ò',"ograve") ; x=XML_('┐',"boxdl") ; x=XML_('±',"PlusMinus") +x=XML_('`',"grave") ; x=XML_('ò','#x00f2') ; x=XML_('└',"boxur") ; x=XML_('≥',"ge") +x=XML_('{',"lbrace") ; x=XML_('û',"ucirc") ; x=XML_('┴',"bottom"); x=XML_('≤',"le") +x=XML_('{',"lcub") ; x=XML_('û','#x00fb') ; x=XML_('┴',"boxhu") ; x=XML_('÷',"div") +x=XML_('|',"vert") ; x=XML_('ù',"ugrave") ; x=XML_('┬',"boxhd") ; x=XML_('÷',"divide") +x=XML_('|',"verbar") ; x=XML_('ù','#x00f9') ; x=XML_('├',"boxvr") ; x=XML_('≈',"approx") +x=XML_('}',"rbrace") ; x=XML_('ÿ',"yuml") ; x=XML_('─',"boxh") ; x=XML_('∙',"bull") +x=XML_('}',"rcub") ; x=XML_('ÿ','#x00ff') ; x=XML_('┼',"boxvh") ; x=XML_('°',"deg") +x=XML_('Ç',"Ccedil") ; x=XML_('Ö',"Ouml") ; x=XML_('╞',"boxvR") ; x=XML_('·',"middot") +x=XML_('Ç','#x00c7') ; x=XML_('Ö','#x00d6') ; x=XML_('╟',"boxVr") ; x=XML_('·',"middledot") +x=XML_('ü',"uuml") ; x=XML_('Ü',"Uuml") ; x=XML_('╚',"boxUR") ; x=XML_('·',"centerdot") +x=XML_('ü','#x00fc') ; x=XML_('Ü','#x00dc') ; x=XML_('╔',"boxDR") ; x=XML_('·',"CenterDot") +x=XML_('é',"eacute") ; x=XML_('¢',"cent") ; x=XML_('╩',"boxHU") ; x=XML_('√',"radic") +x=XML_('é','#x00e9') ; x=XML_('£',"pound") ; x=XML_('╦',"boxHD") ; x=XML_('²',"sup2") +x=XML_('â',"acirc") ; x=XML_('¥',"yen") ; x=XML_('╠',"boxVR") ; x=XML_('■',"squart ") +return x diff --git a/Task/XML-Output/ALGOL-68/xml-output-1.alg b/Task/XML-Output/ALGOL-68/xml-output-1.alg new file mode 100644 index 0000000000..1161768cd6 --- /dev/null +++ b/Task/XML-Output/ALGOL-68/xml-output-1.alg @@ -0,0 +1,46 @@ +# returns a translation of str suitable for attribute values and content in an XML document # +OP TOXMLSTRING = ( STRING str )STRING: + BEGIN + STRING result := ""; + FOR pos FROM LWB str TO UPB str DO + CHAR c = str[ pos ]; + result +:= IF c = "<" THEN "<" + ELIF c = ">" THEN ">" + ELIF c = "&" THEN "&" + ELIF c = "'" THEN "'" + ELIF c = """" THEN """ + ELSE c + FI + OD; + result + END; # TOXMLSTRING # + +# generate a CharacterRemarks XML document from the characters and remarks # +# the number of elements in characters and remrks must be equal - this is not checked # +# the element is not generated # +PROC generate character remarks document = ( []STRING characters, remarks )STRING: + BEGIN + STRING result := ""; + INT remark pos := LWB remarks; + FOR char pos FROM LWB characters TO UPB characters DO + result +:= "" + + TOXMLSTRING remarks[ remark pos ] + + "" + + REPR 10 + ; + remark pos +:= 1 + OD; + result +:= ""; + result + END; # generate character remarks document # + +# test the generation # +print( ( generate character remarks document( ( "April", "Tam O'Shanter", "Emily" ) + , ( "Bubbly: I'm > Tam and <= Emily" + , "Burns: ""When chapman billies leave the street ..." + , "Short & shrift" + ) + ) + , newline + ) + ) diff --git a/Task/XML-Output/ALGOL-68/xml-output-2.alg b/Task/XML-Output/ALGOL-68/xml-output-2.alg new file mode 100644 index 0000000000..fc1f4a4e3f --- /dev/null +++ b/Task/XML-Output/ALGOL-68/xml-output-2.alg @@ -0,0 +1,4 @@ +Bubbly: I'm > Tam and <= Emily +Burns: "When chapman billies leave the street ... +Short & shrift + diff --git a/Task/XML-Output/Lua/xml-output-1.lua b/Task/XML-Output/Lua/xml-output-1.lua new file mode 100644 index 0000000000..e196aba20c --- /dev/null +++ b/Task/XML-Output/Lua/xml-output-1.lua @@ -0,0 +1,13 @@ +require("LuaXML") + +function addNode(parent, nodeName, key, value, content) + local node = xml.new(nodeName) + table.insert(node, content) + parent:append(node)[key] = value +end + +root = xml.new("CharacterRemarks") +addNode(root, "Character", "name", "April", "Bubbly: I'm > Tam and <= Emily") +addNode(root, "Character", "name", "Tam O'Shanter", 'Burns: "When chapman billies leave the street ..."') +addNode(root, "Character", "name", "Emily", "Short & shrift") +print(root) diff --git a/Task/XML-Output/Lua/xml-output-2.lua b/Task/XML-Output/Lua/xml-output-2.lua new file mode 100644 index 0000000000..50fd159995 --- /dev/null +++ b/Task/XML-Output/Lua/xml-output-2.lua @@ -0,0 +1,5 @@ + + Bubbly: I'm > Tam and <= Emily + Burns: "When chapman billies leave the street ..." + Short & shrift + diff --git a/Task/XML-Output/Lua/xml-output-3.lua b/Task/XML-Output/Lua/xml-output-3.lua new file mode 100644 index 0000000000..c8e73b70f2 --- /dev/null +++ b/Task/XML-Output/Lua/xml-output-3.lua @@ -0,0 +1,2 @@ +xmlStr = xml.str(root):gsub("'", "'"):gsub(""", '"') +print(xmlStr) diff --git a/Task/XML-Output/Lua/xml-output-4.lua b/Task/XML-Output/Lua/xml-output-4.lua new file mode 100644 index 0000000000..bca3e0a2ac --- /dev/null +++ b/Task/XML-Output/Lua/xml-output-4.lua @@ -0,0 +1,5 @@ + + Bubbly: I'm > Tam and <= Emily + Burns: "When chapman billies leave the street ..." + Short & shrift + diff --git a/Task/XML-Output/PureBasic/xml-output.purebasic b/Task/XML-Output/PureBasic/xml-output.purebasic index 6feafa3b0a..e54481f7e7 100644 --- a/Task/XML-Output/PureBasic/xml-output.purebasic +++ b/Task/XML-Output/PureBasic/xml-output.purebasic @@ -1,34 +1,59 @@ +DataSection + dataItemCount: + Data.i 3 + + names: + Data.s "April", "Tam O'Shanter", "Emily" + + remarks: + Data.s "Bubbly: I'm > Tam and <= Emily", + ~"Burns: \"When chapman billies leave the street ...\"", + "Short & shrift" +EndDataSection + Structure characteristic name.s remark.s EndStructure + NewList didel.characteristic() -If ReadFile(0, GetCurrentDirectory()+"names.txt") - While Eof(0) = 0 - AddElement(didel()) - didel()\name = ReadString(0) - Wend - CloseFile(0) -EndIf +Define item.s, numberOfItems, i + +Restore dataItemCount +Read.i numberOfItems + +;add names +Restore names +For i = 1 To numberOfItems + AddElement(didel()) + Read.s item + didel()\name = item +Next + +;add remarks ResetList(didel()) FirstElement(didel()) -If ReadFile(0, GetCurrentDirectory()+"remarks.txt") - While Eof(0) = 0 - didel()\remark = ReadString(0) - NextElement(didel()) - Wend - CloseFile(0) -EndIf +Restore remarks: +For i = 1 To numberOfItems + Read.s item + didel()\remark = item + NextElement(didel()) +Next + +Define xml, mainNode, itemNode ResetList(didel()) FirstElement(didel()) - xml = CreateXML(#PB_Any) - mainNode = CreateXMLNode(RootXMLNode(xml)) - SetXMLNodeName(mainNode, "CharacterRemarks") - ForEach didel() - item = CreateXMLNode(mainNode) - SetXMLNodeName(item, "Character") - SetXMLAttribute(item, "name", didel()\name) - SetXMLNodeText(item, didel()\remark) - Next - FormatXML(xml, #PB_XML_ReFormat | #PB_XML_WindowsNewline | #PB_XML_ReIndent) - SaveXML(xml, "demo.xml") +xml = CreateXML(#PB_Any) +mainNode = CreateXMLNode(RootXMLNode(xml), "CharacterRemarks") +ForEach didel() + itemNode = CreateXMLNode(mainNode, "Character") + SetXMLAttribute(itemNode, "name", didel()\name) + SetXMLNodeText(itemNode, didel()\remark) +Next +FormatXML(xml, #PB_XML_ReFormat | #PB_XML_WindowsNewline | #PB_XML_ReIndent) + +If OpenConsole() + PrintN(ComposeXML(xml, #PB_XML_NoDeclaration)) + Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input() + CloseConsole() +EndIf diff --git a/Task/XML-Output/VBScript/xml-output.vb b/Task/XML-Output/VBScript/xml-output.vb new file mode 100644 index 0000000000..71ce3ae5fe --- /dev/null +++ b/Task/XML-Output/VBScript/xml-output.vb @@ -0,0 +1,17 @@ +Set objXMLDoc = CreateObject("msxml2.domdocument") + +Set objRoot = objXMLDoc.createElement("CharacterRemarks") +objXMLDoc.appendChild objRoot + +Call CreateNode("April","Bubbly: I'm > Tam and <= Emily") +Call CreateNode("Tam O'Shanter","Burns: ""When chapman billies leave the street ...""") +Call CreateNode("Emily","Short & shrift") + +objXMLDoc.save("C:\Temp\Test.xml") + +Function CreateNode(attrib_value,node_value) + Set objNode = objXMLDoc.createElement("Character") + objNode.setAttribute "name", attrib_value + objNode.text = node_value + objRoot.appendChild objNode +End Function diff --git a/Task/XML-XPath/Bracmat/xml-xpath.bracmat b/Task/XML-XPath/Bracmat/xml-xpath.bracmat new file mode 100644 index 0000000000..93ce06470d --- /dev/null +++ b/Task/XML-XPath/Bracmat/xml-xpath.bracmat @@ -0,0 +1,66 @@ +{Retrieve the first "item" element} +( nestML$(get$("doc.xml",X,ML)) + : ? + ( inventory + . ?,? (section.?,? ((item.?):?item) ?) ? + ) + ? +& out$(toML$!item) +) + +{Perform an action on each "price" element (print it out)} +( nestML$(get$("doc.xml",X,ML)) + : ? + ( inventory + . ? + , ? + ( section + . ? + , ? + ( item + . ? + , ? + ( price + . ? + , ?price + & out$!price + & ~ + ) + ? + ) + ? + ) + ? + ) + ? +| +) + +{Get an array of all the "name" elements} +( :?anArray + & nestML$(get$("doc.xml",X,ML)) + : ? + ( inventory + . ? + , ? + ( section + . ? + , ? + ( item + . ? + , ? + ( name + . ? + , ?name + & !anArray !name:?anArray + & ~ + ) + ? + ) + ? + ) + ? + ) + ? +| out$!anArray {Not truly an array, but a list.} +); diff --git a/Task/XML-XPath/PowerShell/xml-xpath-1.psh b/Task/XML-XPath/PowerShell/xml-xpath-1.psh new file mode 100644 index 0000000000..befc630e30 --- /dev/null +++ b/Task/XML-XPath/PowerShell/xml-xpath-1.psh @@ -0,0 +1,31 @@ +$document = [xml]@' + +
    + + Invisibility Cream + 14.50 + Makes you invisible + + + Levitation Salve + 23.99 + Levitate yourself for up to 3 hours per application + +
    +
    + + Blork and Freen Instameal + 4.95 + A tasty meal in a tablet; just add water + + + Grob winglets + 3.56 + Tender winglets of Grob. Just add water + +
    +
    +'@ + +$query = "/inventory/section/item" +$items = $document.SelectNodes($query) diff --git a/Task/XML-XPath/PowerShell/xml-xpath-2.psh b/Task/XML-XPath/PowerShell/xml-xpath-2.psh new file mode 100644 index 0000000000..14276d6140 --- /dev/null +++ b/Task/XML-XPath/PowerShell/xml-xpath-2.psh @@ -0,0 +1 @@ +$items[0] diff --git a/Task/XML-XPath/PowerShell/xml-xpath-3.psh b/Task/XML-XPath/PowerShell/xml-xpath-3.psh new file mode 100644 index 0000000000..d79d15b0f6 --- /dev/null +++ b/Task/XML-XPath/PowerShell/xml-xpath-3.psh @@ -0,0 +1,2 @@ +$namesAndPrices = $items | Select-Object -Property name, price +$namesAndPrices diff --git a/Task/XML-XPath/PowerShell/xml-xpath-4.psh b/Task/XML-XPath/PowerShell/xml-xpath-4.psh new file mode 100644 index 0000000000..22598ab0f4 --- /dev/null +++ b/Task/XML-XPath/PowerShell/xml-xpath-4.psh @@ -0,0 +1 @@ +$items.price diff --git a/Task/XML-XPath/PowerShell/xml-xpath-5.psh b/Task/XML-XPath/PowerShell/xml-xpath-5.psh new file mode 100644 index 0000000000..ec547b81bf --- /dev/null +++ b/Task/XML-XPath/PowerShell/xml-xpath-5.psh @@ -0,0 +1 @@ +$items.name diff --git a/Task/Xiaolin-Wus-line-algorithm/C/xiaolin-wus-line-algorithm-3.c b/Task/Xiaolin-Wus-line-algorithm/C/xiaolin-wus-line-algorithm-3.c new file mode 100644 index 0000000000..af70edec58 --- /dev/null +++ b/Task/Xiaolin-Wus-line-algorithm/C/xiaolin-wus-line-algorithm-3.c @@ -0,0 +1,108 @@ +public class Line + { + private double x0, y0, x1, y1; + private Color foreColor; + private byte lineStyleMask; + private int thickness; + private float globalm; + + public Line(double x0, double y0, double x1, double y1, Color color, byte lineStyleMask, int thickness) + { + this.x0 = x0; + this.y0 = y0; + this.y1 = y1; + this.x1 = x1; + + this.foreColor = color; + + this.lineStyleMask = lineStyleMask; + + this.thickness = thickness; + + } + + private void plot(Bitmap bitmap, double x, double y, double c) + { + int alpha = (int)(c * 255); + if (alpha > 255) alpha = 255; + if (alpha < 0) alpha = 0; + Color color = Color.FromArgb(alpha, foreColor); + if (BitmapDrawHelper.checkIfInside((int)x, (int)y, bitmap)) + { + bitmap.SetPixel((int)x, (int)y, color); + } + } + + int ipart(double x) { return (int)x;} + + int round(double x) {return ipart(x+0.5);} + + double fpart(double x) { + if(x<0) return (1-(x-Math.Floor(x))); + return (x-Math.Floor(x)); + } + + double rfpart(double x) { + return 1-fpart(x); + } + + + public void draw(Bitmap bitmap) { + bool steep = Math.Abs(y1-y0)>Math.Abs(x1-x0); + double temp; + if(steep){ + temp=x0; x0=y0; y0=temp; + temp=x1;x1=y1;y1=temp; + } + if(x0>x1){ + temp = x0;x0=x1;x1=temp; + temp = y0;y0=y1;y1=temp; + } + + double dx = x1-x0; + double dy = y1-y0; + double gradient = dy/dx; + + double xEnd = round(x0); + double yEnd = y0+gradient*(xEnd-x0); + double xGap = rfpart(x0+0.5); + double xPixel1 = xEnd; + double yPixel1 = ipart(yEnd); + + if(steep){ + plot(bitmap, yPixel1, xPixel1, rfpart(yEnd)*xGap); + plot(bitmap, yPixel1+1, xPixel1, fpart(yEnd)*xGap); + }else{ + plot(bitmap, xPixel1,yPixel1, rfpart(yEnd)*xGap); + plot(bitmap, xPixel1, yPixel1+1, fpart(yEnd)*xGap); + } + double intery = yEnd+gradient; + + xEnd = round(x1); + yEnd = y1+gradient*(xEnd-x1); + xGap = fpart(x1+0.5); + double xPixel2 = xEnd; + double yPixel2 = ipart(yEnd); + if(steep){ + plot(bitmap, yPixel2, xPixel2, rfpart(yEnd)*xGap); + plot(bitmap, yPixel2+1, xPixel2, fpart(yEnd)*xGap); + }else{ + plot(bitmap, xPixel2, yPixel2, rfpart(yEnd)*xGap); + plot(bitmap, xPixel2, yPixel2+1, fpart(yEnd)*xGap); + } + + if(steep){ + for(int x=(int)(xPixel1+1);x<=xPixel2-1;x++){ + plot(bitmap, ipart(intery), x, rfpart(intery)); + plot(bitmap, ipart(intery)+1, x, fpart(intery)); + intery+=gradient; + } + }else{ + for(int x=(int)(xPixel1+1);x<=xPixel2-1;x++){ + plot(bitmap, x,ipart(intery), rfpart(intery)); + plot(bitmap, x, ipart(intery)+1, fpart(intery)); + intery+=gradient; + } + } + } + } diff --git a/Task/Xiaolin-Wus-line-algorithm/Java/xiaolin-wus-line-algorithm.java b/Task/Xiaolin-Wus-line-algorithm/Java/xiaolin-wus-line-algorithm.java new file mode 100644 index 0000000000..47a4ed8503 --- /dev/null +++ b/Task/Xiaolin-Wus-line-algorithm/Java/xiaolin-wus-line-algorithm.java @@ -0,0 +1,109 @@ +import java.awt.*; +import static java.lang.Math.*; +import javax.swing.*; + +public class XiaolinWu extends JPanel { + + public XiaolinWu() { + Dimension dim = new Dimension(640, 640); + setPreferredSize(dim); + setBackground(Color.white); + } + + void plot(Graphics2D g, double x, double y, double c) { + g.setColor(new Color(0f, 0f, 0f, (float)c)); + g.fillOval((int) x, (int) y, 2, 2); + } + + int ipart(double x) { + return (int) x; + } + + double fpart(double x) { + return x - floor(x); + } + + double rfpart(double x) { + return 1.0 - fpart(x); + } + + void drawLine(Graphics2D g, double x0, double y0, double x1, double y1) { + + boolean steep = abs(y1 - y0) > abs(x1 - x0); + if (steep) + drawLine(g, y0, x0, y1, x1); + + if (x0 > x1) + drawLine(g, x1, y1, x0, y0); + + double dx = x1 - x0; + double dy = y1 - y0; + double gradient = dy / dx; + + // handle first endpoint + double xend = round(x0); + double yend = y0 + gradient * (xend - x0); + double xgap = rfpart(x0 + 0.5); + double xpxl1 = xend; // this will be used in the main loop + double ypxl1 = ipart(yend); + + if (steep) { + plot(g, ypxl1, xpxl1, rfpart(yend) * xgap); + plot(g, ypxl1 + 1, xpxl1, fpart(yend) * xgap); + } else { + plot(g, xpxl1, ypxl1, rfpart(yend) * xgap); + plot(g, xpxl1, ypxl1 + 1, fpart(yend) * xgap); + } + + // first y-intersection for the main loop + double intery = yend + gradient; + + // handle second endpoint + xend = round(x1); + yend = y1 + gradient * (xend - x1); + xgap = fpart(x1 + 0.5); + double xpxl2 = xend; // this will be used in the main loop + double ypxl2 = ipart(yend); + + if (steep) { + plot(g, ypxl2, xpxl2, rfpart(yend) * xgap); + plot(g, ypxl2 + 1, xpxl2, fpart(yend) * xgap); + } else { + plot(g, xpxl2, ypxl2, rfpart(yend) * xgap); + plot(g, xpxl2, ypxl2 + 1, fpart(yend) * xgap); + } + + // main loop + for (double x = xpxl1 + 1; x <= xpxl2 - 1; x++) { + if (steep) { + plot(g, ipart(intery), x, rfpart(intery)); + plot(g, ipart(intery) + 1, x, fpart(intery)); + } else { + plot(g, x, ipart(intery), rfpart(intery)); + plot(g, x, ipart(intery) + 1, fpart(intery)); + } + intery = intery + gradient; + } + } + + @Override + public void paintComponent(Graphics gg) { + super.paintComponent(gg); + Graphics2D g = (Graphics2D) gg; + + drawLine(g, 550, 170, 50, 435); + } + + public static void main(String[] args) { + SwingUtilities.invokeLater(() -> { + JFrame f = new JFrame(); + f.setDefaultCloseOperation(JFrame.EXIT_ON_CLOSE); + f.setTitle("Xiaolin Wu's line algorithm"); + f.setResizable(false); + f.add(new XiaolinWu(), BorderLayout.CENTER); + f.pack(); + f.setLocationRelativeTo(null); + f.setVisible(true); + }); + } +} diff --git a/Task/Xiaolin-Wus-line-algorithm/REXX/xiaolin-wus-line-algorithm.rexx b/Task/Xiaolin-Wus-line-algorithm/REXX/xiaolin-wus-line-algorithm.rexx index 150289e5e9..3e519b3e65 100644 --- a/Task/Xiaolin-Wus-line-algorithm/REXX/xiaolin-wus-line-algorithm.rexx +++ b/Task/Xiaolin-Wus-line-algorithm/REXX/xiaolin-wus-line-algorithm.rexx @@ -1,82 +1,63 @@ -/*REXX program plots/draws a line using the Xiaolin Wu line algorithm.*/ -background = 'fa'x /*background char: middle-dot. */ - image. = background /*fill the array with middle-dots*/ - plotC = '░▒▓█' /*chars used for plotting points.*/ - EoE = 1000 /*EOE = End Of Earth, er... plot.*/ - do j=-EoE to +EoE /*draw grid from lowest──►highest*/ - image.j.0 = '─' /*draw the horizontal axis. */ - image.0.j = '│' /* " " verical " */ - end /*j*/ -image.0.0 = '┼' /*"draw" the axis origin (char). */ -parse arg xi yi xf yf . /*allow specifying line-end pts. */ -if xi=='' | xi==',' then xi = 1 /*if not specified, use default. */ -if yi=='' | yi==',' then yi = 2 /* " " " " " */ -if xf=='' | xf==',' then xf = 11 /* " " " " " */ -if yf=='' | yf==',' then yf = 12 /* " " " " " */ -minX=0; minY=0 /*used as limits for plotting. */ -maxX=0; maxY=0 /* " " " " " */ -call line_draw xi, yi, xf, yf /*call subroutine and draw line. */ -border = 2 /*allow additional space for plot*/ -minX=minX-border*2; maxX=maxX+border*2 -minY=minY-border ; maxY=maxY+border - do y=maxY by -1 to minY; _= /*build a row*/ - do x=minX to maxX - _=_ || image.x.y - end /*x*/ - say _ /*display row*/ - end /*y*/ -exit /*stick a fork in it, we're done.*/ -/*────────────────────────────────DRAW_LINE subroutine──────────────────*/ -line_draw: procedure expose background image. minX maxX minY maxY plotC -parse arg x1, y1, x2, y2; switchXY=0; dx=x2-x1 - dy=y2-y1 -if abs(dx)
    diff --git a/Task/Y-combinator/AppleScript/y-combinator-1.applescript b/Task/Y-combinator/AppleScript/y-combinator-1.applescript new file mode 100644 index 0000000000..87fe15d7f2 --- /dev/null +++ b/Task/Y-combinator/AppleScript/y-combinator-1.applescript @@ -0,0 +1,99 @@ +-- Y COMBINATOR + +on |Y|(f) + script + on lambda(y) + script + on lambda(arg) + y's lambda(y)'s lambda(arg) + end lambda + end script + + f's lambda(result) + + end lambda + end script + + result's lambda(result) +end |Y| + + +-- TEST +on run + + -- Factorial + script fact + on lambda(f) + script + on lambda(n) + if n = 0 then return 1 + n * (f's lambda(n - 1)) + end lambda + end script + end lambda + end script + + + -- Fibonacci + script fib + on lambda(f) + script + on lambda(n) + if n = 0 then return 0 + if n = 1 then return 1 + (f's lambda(n - 2)) + (f's lambda(n - 1)) + end lambda + end script + end lambda + end script + + {facts:map(|Y|(fact), range(0, 11)), fibs:map(|Y|(fib), range(0, 20))} + + --> {facts:{1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880, 3628800, 39916800}, + --> fibs:{0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, 2584, 4181, 6765}} + +end run + + +--------------------------------------------------------------------------- + + +-- GENERIC FUNCTIONS (FOR TEST) + +-- 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 + +-- range :: Int -> Int -> [Int] +on range(m, n) + if n < m then + set d to -1 + else + set d to 1 + end if + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range + +-- 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 diff --git a/Task/Y-combinator/AppleScript/y-combinator-2.applescript b/Task/Y-combinator/AppleScript/y-combinator-2.applescript new file mode 100644 index 0000000000..8fbe6281d3 --- /dev/null +++ b/Task/Y-combinator/AppleScript/y-combinator-2.applescript @@ -0,0 +1,2 @@ +{facts:{1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880, 3628800, 39916800}, +fibs:{0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, 2584, 4181, 6765}} diff --git a/Task/Y-combinator/AppleScript/y-combinator.applescript b/Task/Y-combinator/AppleScript/y-combinator.applescript deleted file mode 100644 index e6a02c268b..0000000000 --- a/Task/Y-combinator/AppleScript/y-combinator.applescript +++ /dev/null @@ -1,54 +0,0 @@ -to |Y|(f) - script x - to funcall(y) - script - to funcall(arg) - y's funcall(y)'s funcall(arg) - end funcall - end script - f's funcall(result) - end funcall - end script - x's funcall(x) -end |Y| - -script - to funcall(f) - script - to funcall(n) - if n = 0 then return 1 - n * (f's funcall(n - 1)) - end funcall - end script - end funcall -end script -set fact to |Y|(result) - -script - to funcall(f) - script - to funcall(n) - if n = 0 then return 0 - if n = 1 then return 1 - (f's funcall(n - 2)) + (f's funcall(n - 1)) - end funcall - end script - end funcall -end script -set fib to |Y|(result) - -set facts to {} -repeat with i from 0 to 11 - set end of facts to fact's funcall(i) -end repeat - -set fibs to {} -repeat with i from 0 to 20 - set end of fibs to fib's funcall(i) -end repeat - -{facts:facts, fibs:fibs} -(* -{facts:{1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880, 3628800, 39916800}, - fibs:{0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, 2584, 4181, 6765}} -*) diff --git a/Task/Y-combinator/C++/y-combinator-2.cpp b/Task/Y-combinator/C++/y-combinator-2.cpp index 8234777e81..b1442cfe71 100644 --- a/Task/Y-combinator/C++/y-combinator-2.cpp +++ b/Task/Y-combinator/C++/y-combinator-2.cpp @@ -1,6 +1,21 @@ -template -std::function Y (std::function(std::function)> f) { - return [f](A x) { - return f(Y(f))(x); - }; +#include +#include +int main () { + auto y = ([] (auto f) { return + ([] (auto x) { return x (x); } + ([=] (auto y) -> std:: function { return + f ([=] (auto a) { return + (y (y)) (a) ;});}));}); + + auto almost_fib = [] (auto f) { return + [=] (auto n) { return + n < 2? n: f (n - 1) + f (n - 2) ;};}; + auto almost_fac = [] (auto f) { return + [=] (auto n) { return + n <= 1? n: n * f (n - 1); };}; + + auto fib = y (almost_fib); + auto fac = y (almost_fac); + std:: cout << fib (10) << '\n' + << fac (10) << '\n'; } diff --git a/Task/Y-combinator/C++/y-combinator-3.cpp b/Task/Y-combinator/C++/y-combinator-3.cpp index 5aeae9d2fe..8234777e81 100644 --- a/Task/Y-combinator/C++/y-combinator-3.cpp +++ b/Task/Y-combinator/C++/y-combinator-3.cpp @@ -1,13 +1,6 @@ -template -struct YFunctor { - const std::function(std::function)> f; - YFunctor(std::function(std::function)> _f) : f(_f) {} - B operator()(A x) const { - return f(*this)(x); - } -}; - template std::function Y (std::function(std::function)> f) { - return YFunctor(f); + return [f](A x) { + return f(Y(f))(x); + }; } diff --git a/Task/Y-combinator/C++/y-combinator-4.cpp b/Task/Y-combinator/C++/y-combinator-4.cpp new file mode 100644 index 0000000000..5aeae9d2fe --- /dev/null +++ b/Task/Y-combinator/C++/y-combinator-4.cpp @@ -0,0 +1,13 @@ +template +struct YFunctor { + const std::function(std::function)> f; + YFunctor(std::function(std::function)> _f) : f(_f) {} + B operator()(A x) const { + return f(*this)(x); + } +}; + +template +std::function Y (std::function(std::function)> f) { + return YFunctor(f); +} diff --git a/Task/Y-combinator/Forth/y-combinator-1.fth b/Task/Y-combinator/Forth/y-combinator-1.fth new file mode 100644 index 0000000000..f6c5c3617b --- /dev/null +++ b/Task/Y-combinator/Forth/y-combinator-1.fth @@ -0,0 +1,12 @@ +\ Address of an xt. +variable 'xt +\ Make room for an xt. +: xt, ( -- ) here 'xt ! 1 cells allot ; +\ Store xt. +: !xt ( xt -- ) 'xt @ ! ; +\ Compile fetching the xt. +: @xt, ( -- ) 'xt @ postpone literal postpone @ ; +\ Compile the Y combinator. +: y, ( xt1 -- xt2 ) >r :noname @xt, r> compile, postpone ; ; +\ Make a new instance of the Y combinator. +: y ( xt1 -- xt2 ) xt, y, dup !xt ; diff --git a/Task/Y-combinator/Forth/y-combinator-2.fth b/Task/Y-combinator/Forth/y-combinator-2.fth new file mode 100644 index 0000000000..3b00047b30 --- /dev/null +++ b/Task/Y-combinator/Forth/y-combinator-2.fth @@ -0,0 +1,7 @@ +\ Factorial +10 :noname ( u1 xt -- u2 ) over ?dup if 1- swap execute * else 2drop 1 then ; +y execute . 3628800 ok + +\ Fibonacci +10 :noname ( u1 xt -- u2 ) over 2 < if drop else >r 1- dup r@ execute swap 1- r> execute + then ; +y execute . 55 ok diff --git a/Task/Y-combinator/JavaScript/y-combinator-6.js b/Task/Y-combinator/JavaScript/y-combinator-6.js index 116da5816a..8d808056a0 100644 --- a/Task/Y-combinator/JavaScript/y-combinator-6.js +++ b/Task/Y-combinator/JavaScript/y-combinator-6.js @@ -17,4 +17,4 @@ let opentailfact= // Open version of the tail call variant of the factorial function fact=>(n,m=1)=>n<2?m:fact(n-1,n*m); tailfact= // Tail call version of factorial function - Y(parttailfact); + Y(opentailfact); diff --git a/Task/Y-combinator/JavaScript/y-combinator-8.js b/Task/Y-combinator/JavaScript/y-combinator-8.js new file mode 100644 index 0000000000..3b1088b902 --- /dev/null +++ b/Task/Y-combinator/JavaScript/y-combinator-8.js @@ -0,0 +1,2 @@ +var Y = f => (x => x(x))(y => f(x => y(y)(x))); +var fac = Y(f => n => n > 1 ? n * f(n-1) : 1); diff --git a/Task/Y-combinator/Mathematica/y-combinator.math b/Task/Y-combinator/Mathematica/y-combinator.math index 4f5229d641..1a8f85b14e 100644 --- a/Task/Y-combinator/Mathematica/y-combinator.math +++ b/Task/Y-combinator/Mathematica/y-combinator.math @@ -1,3 +1,3 @@ Y = Function[f, #[#] &[Function[g, f[g[g][##] &]]]]; factorial = Y[Function[f, If[# < 1, 1, # f[# - 1]] &]]; -fibonacci = Y[Function[f, If[# < 2, #, f[# - 1] + f[# - 2]] &]; +fibonacci = Y[Function[f, If[# < 2, #, f[# - 1] + f[# - 2]] &]]; diff --git a/Task/Y-combinator/Perl-6/y-combinator-1.pl6 b/Task/Y-combinator/Perl-6/y-combinator-1.pl6 index 2cbf8180f8..df7add01f0 100644 --- a/Task/Y-combinator/Perl-6/y-combinator-1.pl6 +++ b/Task/Y-combinator/Perl-6/y-combinator-1.pl6 @@ -1,4 +1,4 @@ -sub Y (&f) { { .($_) }( -> &y { f({ y(&y)($^arg) }) } ) } +sub Y (&f) { sub (&x) { x(&x) }( sub (&y) { f(sub ($x) { y(&y)($x) }) } ) } sub fac (&f) { sub ($n) { $n < 2 ?? 1 !! $n * f($n - 1) } } sub fib (&f) { sub ($n) { $n < 2 ?? $n !! f($n - 1) + f($n - 2) } } say map Y($_), ^10 for &fac, &fib; diff --git a/Task/Y-combinator/PowerShell/y-combinator.psh b/Task/Y-combinator/PowerShell/y-combinator-1.psh similarity index 100% rename from Task/Y-combinator/PowerShell/y-combinator.psh rename to Task/Y-combinator/PowerShell/y-combinator-1.psh diff --git a/Task/Y-combinator/PowerShell/y-combinator-2.psh b/Task/Y-combinator/PowerShell/y-combinator-2.psh new file mode 100644 index 0000000000..6a3858e478 --- /dev/null +++ b/Task/Y-combinator/PowerShell/y-combinator-2.psh @@ -0,0 +1,48 @@ +$Y = { + param ($f) + + { + param ($x) + + $f.InvokeReturnAsIs({ + param ($y) + + $x.InvokeReturnAsIs($x).InvokeReturnAsIs($y) + }.GetNewClosure()) + + }.InvokeReturnAsIs({ + param ($x) + + $f.InvokeReturnAsIs({ + param ($y) + + $x.InvokeReturnAsIs($x).InvokeReturnAsIs($y) + }.GetNewClosure()) + + }.GetNewClosure()) +} + +$fact = { + param ($f) + + { + param ($n) + + if ($n -eq 0) { 1 } else { $n * $f.InvokeReturnAsIs($n - 1) } + + }.GetNewClosure() +} + +$fib = { + param ($f) + + { + param ($n) + + if ($n -lt 2) { 1 } else { $f.InvokeReturnAsIs($n - 1) + $f.InvokeReturnAsIs($n - 2) } + + }.GetNewClosure() +} + +$Y.invoke($fact).invoke(5) +$Y.invoke($fib).invoke(5) diff --git a/Task/Y-combinator/Rust/y-combinator.rust b/Task/Y-combinator/Rust/y-combinator.rust index c5f3fac444..f9eb38f374 100644 --- a/Task/Y-combinator/Rust/y-combinator.rust +++ b/Task/Y-combinator/Rust/y-combinator.rust @@ -1,27 +1,24 @@ use std::sync::Arc; -use std::boxed::Box; -use std::clone::Clone; //Arc> -#[macro_export] macro_rules! abc { ($x:expr) => (Arc::new(Box::new($x))); } #[derive(Clone)] -pub enum Mu { +enum Mu { Roll(Arc)->T>>), } -pub fn unroll(Mu::Roll(f): Mu) -> Arc)->T>> {f.clone()} +fn unroll(Mu::Roll(f): Mu) -> Arc)->T>> {f.clone()} -pub type Func = ArcB>>; -pub type RecFunc = Arc) -> Func>>; +pub type Func = ArcA>>; +pub type RecFunc = Arc) -> Func>>; -pub fn y(f: RecFunc) -> Func { - let g:Arc>)->Func>> = abc!(move |x : Mu>| -> Func { +pub fn y(f: RecFunc) -> Func { + let g: Arc>)->Func>> = abc!(move |x : Mu>| -> Func { let f = f.clone(); - abc!(move |a:A| -> B { + abc!(move |a:A| -> A { let f = f.clone(); f(unroll(x.clone())(x.clone()))(a) }) @@ -29,16 +26,24 @@ pub fn y(f: RecFunc) -> Func { g(Mu::Roll(g.clone())) } -#[test] -fn fib_test() { - let fib : RecFunc = abc!(|f| abc!(move |x| if (x<2) { 1 } else { f(x-1) + f(x-2)})); - let b = y(fib)(10); - assert_eq!(b, 89); +#[macro_export] +macro_rules! y { + (|$name:ident| $fun:tt) => { + y(abc!(|$name| abc!($fun))) + } } -#[test] -fn fac_test() { - let fac : RecFunc = abc!(|f| abc!(move |x| if (x==0) { 1 } else { f(x-1) * x })); - let c = y(fac)(10); - assert_eq!(c, 3628800); +fn fac(n: u32) -> u32 { + let fn_: Func = y!(|f| (move |x| if x == 0 { 1 } else { f(x-1) * x })); + fn_(n) +} + +fn fib(n: u32) -> u32 { + let fn_: Func = y!(|f| (move |x| if x < 2 { x } else { f(x-1) + f(x-2) })); + fn_(n) +} + +fn main() { + println!("{}", fac(10)); + println!("{}", fib(10)) } diff --git a/Task/Y-combinator/TXR/y-combinator-1.txr b/Task/Y-combinator/TXR/y-combinator-1.txr new file mode 100644 index 0000000000..85084895ac --- /dev/null +++ b/Task/Y-combinator/TXR/y-combinator-1.txr @@ -0,0 +1,13 @@ +;; The Y combinator: +(defun y (f) + [(op @1 @1) + (op f (op [@@1 @@1]))]) + +;; The Y-combinator-based factorial: +(defun fac (f) + (do if (zerop @1) + 1 + (* @1 [f (- @1 1)]))) + +;; Test: +(format t "~s\n" [[y fac] 4]) diff --git a/Task/Y-combinator/TXR/y-combinator-2.txr b/Task/Y-combinator/TXR/y-combinator-2.txr new file mode 100644 index 0000000000..35bd47183a --- /dev/null +++ b/Task/Y-combinator/TXR/y-combinator-2.txr @@ -0,0 +1 @@ +(op foo @1 (op bar @2 @@2)) diff --git a/Task/Y-combinator/TXR/y-combinator.txr b/Task/Y-combinator/TXR/y-combinator.txr deleted file mode 100644 index e12be5ded3..0000000000 --- a/Task/Y-combinator/TXR/y-combinator.txr +++ /dev/null @@ -1,14 +0,0 @@ -@(do - ;; The Y combinator: - (defun y (f) - [(op @1 @1) - (op f (op [@@1 @@1]))]) - - ;; The Y-combinator-based factorial: - (defun fac (f) - (do if (zerop @1) - 1 - (* @1 [f (- @1 1)]))) - - ;; Test: - (format t "~s\n" [[y fac] 4])) diff --git a/Task/Yahoo--search-interface/00DESCRIPTION b/Task/Yahoo--search-interface/00DESCRIPTION index 0a46298f91..9f71333bf2 100644 --- a/Task/Yahoo--search-interface/00DESCRIPTION +++ b/Task/Yahoo--search-interface/00DESCRIPTION @@ -1,2 +1,4 @@ Create a class for searching Yahoo! results. + It must implement a '''Next Page''' method, and read URL, Title and Content from results. +

    diff --git a/Task/Yahoo--search-interface/TXR/yahoo--search-interface.txr b/Task/Yahoo--search-interface/TXR/yahoo--search-interface.txr index aa0a7fde29..2033ea7b90 100644 --- a/Task/Yahoo--search-interface/TXR/yahoo--search-interface.txr +++ b/Task/Yahoo--search-interface/TXR/yahoo--search-interface.txr @@ -6,7 +6,7 @@ @(or) @ (throw error "specify query and page# (from zero)") @(end) -@(next `!wget -O - http://search.yahoo.com/search?p=@QUERY\&b=@{PAGE}1 2> /dev/null`) +@(next (open-command "!wget -O - http://search.yahoo.com/search?p=@QUERY\&b=@{PAGE}1 2> /dev/null")) @(all) @ (coll)
    ]+/>@TITLE@(end) @(and) diff --git a/Task/Yin-and-yang/00DESCRIPTION b/Task/Yin-and-yang/00DESCRIPTION index 411c5d036d..de7940af79 100644 --- a/Task/Yin-and-yang/00DESCRIPTION +++ b/Task/Yin-and-yang/00DESCRIPTION @@ -1,5 +1,7 @@ +{{omit from|GUISS}} + +;Task: Create a function that given a variable representing size, generates a [[wp:File:Yin_and_Yang.svg|Yin and yang]] also known as a [[wp:Taijitu|Taijitu]] symbol scaled to that size. Generate and display the symbol generated for two different (small) sizes. - -{{omit from|GUISS}} +

    diff --git a/Task/Yin-and-yang/REXX/yin-and-yang.rexx b/Task/Yin-and-yang/REXX/yin-and-yang.rexx index ec00b54e7e..0afc9f9c45 100644 --- a/Task/Yin-and-yang/REXX/yin-and-yang.rexx +++ b/Task/Yin-and-yang/REXX/yin-and-yang.rexx @@ -1,31 +1,31 @@ -/*REXX program creates/displays an ASCII art version of the Yin-Yang symbol.*/ -parse arg s1 s2 . /*obtain optional arguments from the CL*/ -if s1=='' | s1==',' then s1=17 /*Not defined? Then use the default. */ -if s2=='' | s2==',' then s2= 8 /* " " " " " " */ -if s1>0 then call yin_yang s1 /*create and display the 1st Yin-Yang. */ -if s2>0 then call yin_yang s2 /* " " " " 2nd " */ -exit /*stick a fork in it, we're all done. */ -/*────────────────────────────────────────────────────────────────────────────*/ -in@: procedure; parse arg cy,r,x,y; return x**2 + (y-cy)**2 <= r**2 -big@: /*in big circle.*/ return in@( 0, r, x, y ) -semi@: /*in semi circle.*/ return in@( r/2, r/2, x, y ) -sBK@: /*in small black circle.*/ return in@( r/2, r/6, x, y ) -sWH@: /*in small white circle.*/ return in@( 0-r/2, r/6, x, y ) -BK_semi@: /*in black semi circle.*/ return in@( 0-r/2, r/2, x, y ) -/*────────────────────────────────────────────────────────────────────────────*/ -yin_yang: procedure; parse arg r; mY=1; mX=2 /*scale multiplier for X,Y axis.*/ -WH='·'; BL='@'; zz=' ' /*define some symbol shading (glyphs). */ +/*REXX program creates and displays an ASCII art version of the Yin-Yang symbol.*/ +parse arg s1 s2 . /*obtain optional arguments from the CL*/ +if s1=='' | s1=="," then s1=17 /*Not defined? Then use the default. */ +if s2=='' | s2=="," then s2= 8 /* " " " " " " */ +if s1>0 then call YinYang s1 /*create and display the 1st Yin-Yang. */ +if s2>0 then call YinYang s2 /* " " " " 2nd " */ +exit /*stick a fork in it, we're all done. */ +/*──────────────────────────────────────────────────────────────────────────────────────*/ +in@: procedure; parse arg cy,r,x,y; return x**2 + (y-cy)**2 <= r**2 +big@: /*in big circle.*/ return in@( 0, r, x, y ) +semi@: /*in semi circle.*/ return in@( r/2, r/2, x, y ) +sBK@: /*in small black circle.*/ return in@( r/2, r/6, x, y ) +sWH@: /*in small white circle.*/ return in@( 0-r/2, r/6, x, y ) +BK_semi@: /*in black semi circle.*/ return in@( 0-r/2, r/2, x, y ) +/*──────────────────────────────────────────────────────────────────────────────────────*/ +YinYang: procedure; parse arg r; mY=1; mX=2 /*scale multiplier for the X, Y axis.*/ + WH='·'; BL="Θ"; zz=' ' /*define some symbol shading (glyphs). */ - do sy=+r*mY by -1 while sy >= -r*mY; $= /*$: is the output line.*/ - do sx=-r*mX by +1 while sx <= +r*mX; x=sx/mX; y=sy/mY - if big@() then if semi@() then if sBK@() then $=$||BL - else $=$||WH - else if BK_semi@() then if sWH@() then $=$||WH - else $=$||BL - else if x<0 then $=$||WH - else $=$||BL - else $=$ || zz - end /*sy*/ - say $ /*display a single line of the symbol. */ - end /*sx*/ -return + do sy=+r*mY by -1 while sy >= -r*mY; $= /*$: is the output line.*/ + do sx=-r*mX by +1 while sx <= +r*mX; x=sx/mX; y=sy/mY + if big@() then if semi@() then if sBK@() then $=$||BL + else $=$||WH + else if BK_semi@() then if sWH@() then $=$||WH + else $=$||BL + else if x<0 then $=$||WH + else $=$||BL + else $=$ || zz + end /*sy*/ + say $ /*display a single line of the symbol. */ + end /*sx*/ + return diff --git a/Task/Zebra-puzzle/00DESCRIPTION b/Task/Zebra-puzzle/00DESCRIPTION index f3db4be68b..b8719bd8a9 100644 --- a/Task/Zebra-puzzle/00DESCRIPTION +++ b/Task/Zebra-puzzle/00DESCRIPTION @@ -1,3 +1,5 @@ +[[File:zebra.png|550px||right]] + The [[wp:Zebra puzzle|Zebra puzzle]], a.k.a. Einstein's Riddle, is a logic puzzle which is to be solved programmatically.
    It has several variants, one of them this: @@ -19,9 +21,13 @@ It has several variants, one of them this: #The Norwegian lives next to the blue house. #They drink water in a house next to the house where they smoke Blend. -The question is, who owns the zebra? +
    The question is, who owns the zebra? Additionally, list the solution for all the houses. Optionally, show the solution is unique. -cf. [[Dinesman's multiple-dwelling problem]], [[Twelve statements]] + +;Related tasks: +*   [[Dinesman's multiple-dwelling problem]] +*   [[Twelve statements]] +

    diff --git a/Task/Zebra-puzzle/Clojure/zebra-puzzle-2.clj b/Task/Zebra-puzzle/Clojure/zebra-puzzle-2.clj index bf3e5ac315..f6381390b3 100644 --- a/Task/Zebra-puzzle/Clojure/zebra-puzzle-2.clj +++ b/Task/Zebra-puzzle/Clojure/zebra-puzzle-2.clj @@ -1,8 +1,7 @@ (ns zebra (:require [clojure.math.combinatorics :as c])) -(defn solve - [] +(defn solve [] (let [arrangements (c/permutations (range 5)) before? #(= (inc %1) %2) after? #(= (dec %1) %2) @@ -35,8 +34,7 @@ (map zipmap [persons colors drinks cigs pets]))))) -(defn -main - [& _] +(defn -main [& _] (doseq [[[persons _ _ _ pets :as solution] i] (map vector (solve) (iterate inc 1)) :let [zebra-house (some #(when (= :zebra (val %)) (key %)) pets)]] diff --git a/Task/Zebra-puzzle/Elixir/zebra-puzzle.elixir b/Task/Zebra-puzzle/Elixir/zebra-puzzle.elixir new file mode 100644 index 0000000000..ebb6c8a546 --- /dev/null +++ b/Task/Zebra-puzzle/Elixir/zebra-puzzle.elixir @@ -0,0 +1,74 @@ +defmodule ZebraPuzzle do + defp adjacent?(n,i,g,e) do + Enum.any?(0..3, fn x -> + (Enum.at(n,x)==i and Enum.at(g,x+1)==e) or (Enum.at(n,x+1)==i and Enum.at(g,x)==e) + end) + end + + defp leftof?(n,i,g,e) do + Enum.any?(0..3, fn x -> Enum.at(n,x)==i and Enum.at(g,x+1)==e end) + end + + defp coincident?(n,i,g,e) do + Enum.with_index(n) |> Enum.any?(fn {x,idx} -> x==i and Enum.at(g,idx)==e end) + end + + def solve(content) do + colours = permutation(content[:Colour]) + pets = permutation(content[:Pet]) + drinks = permutation(content[:Drink]) + smokes = permutation(content[:Smoke]) + Enum.each(permutation(content[:Nationality]), fn nation -> + if hd(nation) == :Norwegian, do: # 10 + Enum.each(colours, fn colour -> + if leftof?(colour, :Green, colour, :White) and # 5 + coincident?(nation, :English, colour, :Red) and # 2 + adjacent?(nation, :Norwegian, colour, :Blue), do: # 15 + Enum.each(pets, fn pet -> + if coincident?(nation, :Swedish, pet, :Dog), do: # 3 + Enum.each(drinks, fn drink -> + if Enum.at(drink,2) == :Milk and # 9 + coincident?(nation, :Danish, drink, :Tea) and # 4 + coincident?(colour, :Green, drink, :Coffee), do: # 6 + Enum.each(smokes, fn smoke -> + if coincident?(smoke, :PallMall, pet, :Birds) and # 7 + coincident?(smoke, :Dunhill, colour, :Yellow) and # 8 + coincident?(smoke, :BlueMaster, drink, :Beer) and # 13 + coincident?(smoke, :Prince, nation, :German) and # 14 + adjacent?(smoke, :Blend, pet, :Cats) and # 11 + adjacent?(smoke, :Blend, drink, :Water) and # 16 + adjacent?(smoke, :Dunhill, pet, :Horse), do: # 12 + print_out(content, transpose([nation, colour, pet, drink, smoke])) + end)end)end)end)end) + end + + defp permutation([]), do: [[]] + defp permutation(list) do + for x <- list, y <- permutation(list -- [x]), do: [x|y] + end + + defp transpose(lists) do + List.zip(lists) |> Enum.map(&Tuple.to_list/1) + end + + defp print_out(content, result) do + width = for {k,v}<-content, do: Enum.map([k|v], &length(to_char_list &1)) |> Enum.max + fmt = Enum.map_join(width, " ", fn w -> "~-#{w}s" end) <> "~n" + nation = Enum.find(result, fn x -> :Zebra in x end) |> hd + IO.puts "The Zebra is owned by the man who is #{nation}\n" + :io.format fmt, Keyword.keys(content) + :io.format fmt, Enum.map(width, fn w -> String.duplicate("-", w) end) + fmt2 = String.replace(fmt, "s", "w", global: false) + Enum.with_index(result) + |> Enum.each(fn {x,i} -> :io.format fmt2, [i+1 | x] end) + end +end + +content = [ House: '', + Nationality: ~w[English Swedish Danish Norwegian German]a, + Colour: ~w[Red Green White Blue Yellow]a, + Pet: ~w[Dog Birds Cats Horse Zebra]a, + Drink: ~w[Tea Coffee Milk Beer Water]a, + Smoke: ~w[PallMall Dunhill BlueMaster Prince Blend]a ] + +ZebraPuzzle.solve(content) diff --git a/Task/Zebra-puzzle/Prolog/zebra-puzzle-2.pro b/Task/Zebra-puzzle/Prolog/zebra-puzzle-2.pro index a5e64c1b05..5f891cf12c 100644 --- a/Task/Zebra-puzzle/Prolog/zebra-puzzle-2.pro +++ b/Task/Zebra-puzzle/Prolog/zebra-puzzle-2.pro @@ -1,28 +1,32 @@ -% populate domain by selecting from it -attrs(H,[N-V|R]):- memberchk( N-X, H), X=V, % unique attribute names - (R=[] -> true ; attrs(H,R)). -one_of(HS,AS) :- member(H,HS), attrs(H,AS). -two_of(HS,G,AS):- call(G,H1,H2,HS), maplist(attrs,[H1,H2],AS). -left_of(A,B,HS):- append(_,[A,B|_],HS). -next_to(A,B,HS):- left_of(A,B,HS) ; left_of(B,A,HS). +zebra( Z, HS):- + length( HS, 5), + member( H1, HS), nation(H1, eng), color(H1, red), + member( H2, HS), nation(H2, swe), owns( H2, dog), + member( H3, HS), nation(H3, dane), drink(H3, tea), + left_of(A,B, HS), color( A, green), color( B, white), + member( H4, HS), drink( H4, coffee), color(H4, green), + member( H5, HS), smoke( H5, palmal), owns( H5, birds), + member( H6, HS), color( H6, yellow), smoke(H6, dunhill), + middle( C, HS), drink( C, milk), + first( D, HS), nation( D, norweg), + next_to(E,F, HS), smoke( E, blend), owns( F, cats), + next_to(G,H, HS), owns( G, horse), smoke( H, dunhill), + member( H7, HS), smoke( H7, bluemas), drink(H7, beer), + member( H8, HS), nation(H8, german), smoke(H8, prince), + next_to(I,J, HS), nation( I, norweg), color( J, blue), + next_to(V,W, HS), drink( W, water), smoke( V, blend), + member( X, HS), owns( X, zebra), nation(X, Z). -zebra(Zebra,Houses):- - Houses = [A,_,C,_,_], % 1 - maplist( one_of(Houses), [ [ nation-englishman, color-red ] % 2 - , [ nation-swede, owns -dog ] % 3 - , [ nation-dane, drink-tea ] % 4 - , [ drink -coffee, color-green ] % 6 - , [ smoke -'Pall Mall', owns -birds ] % 7 - , [ color -yellow, smoke-'Dunhill' ] % 8 - , [ drink -beer, smoke-'Blue Master'] % 13 - , [ nation-german, smoke-'Prince' ] % 14 - ] ), - two_of(Houses, left_of, [[color -green ], [color -white ]]), % 5 - maplist(attrs, [C,A], [[drink -milk ], [nation-norwegian]]), % 9, 10 - maplist(two_of(Houses,next_to), - [ [[smoke -'Blend' ], [owns -cats ]] % 11 - , [[owns -horse ], [smoke-'Dunhill' ]] % 12 - , [[nation-norwegian], [color-blue ]] % 15 - , [[drink -water ], [smoke-'Blend' ]] % 16 - ] ), - one_of(Houses, [ owns-zebra, nation-Zebra]). +left_of( A, B, HS):- append( _, [A,B|_], HS). +next_to( A, B, HS):- left_of( A, B, HS) ; left_of( B, A, HS). +middle( A, [_,_,A,_,_]). +first( A, [A|_]). + +attr( House, Name-Value):- + memberchk( Name-X, House), % unique attribute names + X = Value. % set, validate, or reject +nation(H, V):- attr( H, nation-V). +owns( H, V):- attr( H, owns-V). % select an attribute +smoke( H, V):- attr( H, smoke-V). % from an extensible record +color( H, V):- attr( H, color-V). % of house attributes +drink( H, V):- attr( H, drink-V). % which *is* a house diff --git a/Task/Zebra-puzzle/Prolog/zebra-puzzle-3.pro b/Task/Zebra-puzzle/Prolog/zebra-puzzle-3.pro index 2540a812c4..3c7db79546 100644 --- a/Task/Zebra-puzzle/Prolog/zebra-puzzle-3.pro +++ b/Task/Zebra-puzzle/Prolog/zebra-puzzle-3.pro @@ -1,12 +1,32 @@ -?- time(( zebra(Z,HS), ( maplist(length,HS,_) -> maplist(sort,HS,S), - maplist(writeln,S),nl,writeln(Z) ), false ; true)). +attrs( R, [N-V|T]):- % extensible record, attribute specs + memberchk( N-X, R), % unique attribute names + X = V, % set, validate, or reject + ( T = [] -> true ; attrs( R, T) ). -[color-yellow,drink-water, nation-norwegian, owns-cats, smoke-Dunhill ] -[color-blue, drink-tea, nation-dane, owns-horse, smoke-Blend ] -[color-red, drink-milk, nation-englishman,owns-birds, smoke-Pall Mall ] -[color-green, drink-coffee,nation-german, owns-zebra, smoke-Prince ] -[color-white, drink-beer, nation-swede, owns-dog, smoke-Blue Master] +specs( P, Hs, [Spec1]) :- call(P, A, Hs), attrs(A, Spec1). +specs( P, Hs, [Spec1, Spec2]) :- call(P, A, B, Hs), attrs(A, Spec1), attrs(B, Spec2). -german -% 234,852 inferences, 0.100 CPU in 0.170 seconds (59% CPU, 2345143 Lips) -true. +left_of( A, B, HS):- append( _, [A,B|_], HS). +next_to( A, B, HS):- left_of( A, B, HS) ; left_of( B, A, HS). + +zebra( Zebra, Houses):- % a house *is* a collection of attributes + Houses = [A,_,C,_,_], % 1 + maplist( specs( member, Houses), + [ [[ nation-englishman, color-red ]] % 2 + , [[ nation-swede, owns -dog ]] % 3 + , [[ nation-dane, drink-tea ]] % 4 + , [[ drink -coffee, color-green ]] % 6 + , [[ smoke -'Pall Mall', owns -birds ]] % 7 + , [[ color -yellow, smoke-'Dunhill' ]] % 8 + , [[ drink -beer, smoke-'Blue Master']] % 13 + , [[ nation-german, smoke-'Prince' ]] % 14 + ] ), + specs( left_of, Houses, [[color -green ], [color-white ]]), % 5 + maplist( attrs, [A, C], [[nation-norwegian], [drink-milk ]]), % 10, 9 + maplist( specs( next_to, Houses), + [ [[smoke -'Blend' ], [owns -cats ]] % 11 + , [[owns -horse ], [smoke-'Dunhill' ]] % 12 + , [[nation-norwegian], [color-blue ]] % 15 + , [[drink -water ], [smoke-'Blend' ]] % 16 + ] ), + specs( member, Houses, [[ owns-zebra, nation-Zebra]]). diff --git a/Task/Zebra-puzzle/Prolog/zebra-puzzle-4.pro b/Task/Zebra-puzzle/Prolog/zebra-puzzle-4.pro index f2ea4cc460..8b55242fa7 100644 --- a/Task/Zebra-puzzle/Prolog/zebra-puzzle-4.pro +++ b/Task/Zebra-puzzle/Prolog/zebra-puzzle-4.pro @@ -1,45 +1,12 @@ -:- initialization(main). +?- time(( zebra(Z,HS), ( maplist(length,HS,_) -> maplist(sort,HS,S), + maplist(writeln,S), nl, writeln(Z) ), false ; true)). +[color-yellow,drink-water, nation-norwegian, owns-cats, smoke-Dunhill ] +[color-blue, drink-tea, nation-dane, owns-horse, smoke-Blend ] +[color-red, drink-milk, nation-englishman,owns-birds, smoke-Pall Mall ] +[color-green, drink-coffee,nation-german, owns-zebra, smoke-Prince ] +[color-white, drink-beer, nation-swede, owns-dog, smoke-Blue Master] -zebra(X) :- - houses(Hs), member(h(_,X,zebra,_,_), Hs) - , findall(_, (member(H,Hs), write(H), nl), _), nl - , write('the one who keeps zebra: '), write(X), nl - . - - -houses(Hs) :- - Hs = [_,_,_,_,_] % 1 - , H3 = h(_,_,_,milk,_), Hs = [_,_,H3,_,_] % 9 - , H1 = h(_,nvg,_,_,_ ), Hs = [H1|_] % 10 - - , maplist( flip(member,Hs), - [ h(red,eng,_,_,_) % 2 - , h(_,swe,dog,_,_) % 3 - , h(_,dan,_,tea,_) % 4 - , h(green,_,_,coffe,_) % 6 - , h(_,_,birds,_,pm) % 7 - , h(yellow,_,_,_,dh) % 8 - , h(_,_,_,beer,bm) % 13 - , h(_,ger,_,_,pri) % 14 - ]) - - , infix([ h(green,_,_,_,_) - , h(white,_,_,_,_) ], Hs) % 5 - - , maplist( flip(nextto,Hs), - [ [h(_,_,_,_,bl ), h(_,_,cats,_,_)] % 11 - , [h(_,_,horse,_,_), h(_,_,_,_,dh )] % 12 - , [h(_,nvg,_,_,_ ), h(blue,_,_,_,_)] % 15 - , [h(_,_,_,water,_), h(_,_,_,_,bl )] % 16 - ]) - . - - -flip(F,X,Y) :- call(F,Y,X). - -infix(Xs,Ys) :- append(Xs,_,Zs) , append(_,Zs,Ys). -nextto(P,Xs) :- permutation(P,R), infix(R,Xs). - - -main :- findall(_, (zebra(_), nl), _), halt. +german +% 202,730 inferences, 0.031 CPU in 0.031 seconds (100% CPU, 6497715 Lips) +true. diff --git a/Task/Zebra-puzzle/Prolog/zebra-puzzle-5.pro b/Task/Zebra-puzzle/Prolog/zebra-puzzle-5.pro new file mode 100644 index 0000000000..f2ea4cc460 --- /dev/null +++ b/Task/Zebra-puzzle/Prolog/zebra-puzzle-5.pro @@ -0,0 +1,45 @@ +:- initialization(main). + + +zebra(X) :- + houses(Hs), member(h(_,X,zebra,_,_), Hs) + , findall(_, (member(H,Hs), write(H), nl), _), nl + , write('the one who keeps zebra: '), write(X), nl + . + + +houses(Hs) :- + Hs = [_,_,_,_,_] % 1 + , H3 = h(_,_,_,milk,_), Hs = [_,_,H3,_,_] % 9 + , H1 = h(_,nvg,_,_,_ ), Hs = [H1|_] % 10 + + , maplist( flip(member,Hs), + [ h(red,eng,_,_,_) % 2 + , h(_,swe,dog,_,_) % 3 + , h(_,dan,_,tea,_) % 4 + , h(green,_,_,coffe,_) % 6 + , h(_,_,birds,_,pm) % 7 + , h(yellow,_,_,_,dh) % 8 + , h(_,_,_,beer,bm) % 13 + , h(_,ger,_,_,pri) % 14 + ]) + + , infix([ h(green,_,_,_,_) + , h(white,_,_,_,_) ], Hs) % 5 + + , maplist( flip(nextto,Hs), + [ [h(_,_,_,_,bl ), h(_,_,cats,_,_)] % 11 + , [h(_,_,horse,_,_), h(_,_,_,_,dh )] % 12 + , [h(_,nvg,_,_,_ ), h(blue,_,_,_,_)] % 15 + , [h(_,_,_,water,_), h(_,_,_,_,bl )] % 16 + ]) + . + + +flip(F,X,Y) :- call(F,Y,X). + +infix(Xs,Ys) :- append(Xs,_,Zs) , append(_,Zs,Ys). +nextto(P,Xs) :- permutation(P,R), infix(R,Xs). + + +main :- findall(_, (zebra(_), nl), _), halt. diff --git a/Task/Zebra-puzzle/Python/zebra-puzzle-1.py b/Task/Zebra-puzzle/Python/zebra-puzzle-1.py index 84cb78bf95..9a85be3d8b 100644 --- a/Task/Zebra-puzzle/Python/zebra-puzzle-1.py +++ b/Task/Zebra-puzzle/Python/zebra-puzzle-1.py @@ -1,101 +1,73 @@ -import psyco; psyco.full() +from logpy import * +from logpy.core import lall +import time -class Content: elems= """Beer Coffee Milk Tea Water - Danish English German Norwegian Swedish - Blue Green Red White Yellow - Blend BlueMaster Dunhill PallMall Prince - Bird Cat Dog Horse Zebra""".split() -class Test: elems= "Drink Person Color Smoke Pet".split() -class House: elems= "One Two Three Four Five".split() +def lefto(q, p, list): + # give me q such that q is left of p in list + # zip(list, list[1:]) gives a list of 2-tuples of neighboring combinations + # which can then be pattern-matched against the query + return membero((q,p), zip(list, list[1:])) -for c in (Content, Test, House): - c.values = range(len(c.elems)) - for i, e in enumerate(c.elems): - exec "%s.%s = %d" % (c.__name__, e, i) +def nexto(q, p, list): + # give me q such that q is next to p in list + # match lefto(q, p) OR lefto(p, q) + # requirement of vector args instead of tuples doesn't seem to be documented + return conde([lefto(q, p, list)], [lefto(p, q, list)]) -def finalChecks(M): - def diff(a, b, ca, cb): - for h1 in House.values: - for h2 in House.values: - if M[ca][h1] == a and M[cb][h2] == b: - return h1 - h2 - assert False +houses = var() - return abs(diff(Content.Norwegian, Content.Blue, - Test.Person, Test.Color)) == 1 and \ - diff(Content.Green, Content.White, - Test.Color, Test.Color) == -1 and \ - abs(diff(Content.Horse, Content.Dunhill, - Test.Pet, Test.Smoke)) == 1 and \ - abs(diff(Content.Water, Content.Blend, - Test.Drink, Test.Smoke)) == 1 and \ - abs(diff(Content.Blend, Content.Cat, - Test.Smoke, Test.Pet)) == 1 +zebraRules = lall( + # there are 5 houses + (eq, (var(), var(), var(), var(), var()), houses), + # the Englishman's house is red + (membero, ('Englishman', var(), var(), var(), 'red'), houses), + # the Swede has a dog + (membero, ('Swede', var(), var(), 'dog', var()), houses), + # the Dane drinks tea + (membero, ('Dane', var(), 'tea', var(), var()), houses), + # the Green house is left of the White house + (lefto, (var(), var(), var(), var(), 'green'), + (var(), var(), var(), var(), 'white'), houses), + # coffee is the drink of the green house + (membero, (var(), var(), 'coffee', var(), 'green'), houses), + # the Pall Mall smoker has birds + (membero, (var(), 'Pall Mall', var(), 'birds', var()), houses), + # the yellow house smokes Dunhills + (membero, (var(), 'Dunhill', var(), var(), 'yellow'), houses), + # the middle house drinks milk + (eq, (var(), var(), (var(), var(), 'milk', var(), var()), var(), var()), houses), + # the Norwegian is the first house + (eq, (('Norwegian', var(), var(), var(), var()), var(), var(), var(), var()), houses), + # the Blend smoker is in the house next to the house with cats + (nexto, (var(), 'Blend', var(), var(), var()), + (var(), var(), var(), 'cats', var()), houses), + # the Dunhill smoker is next to the house where they have a horse + (nexto, (var(), 'Dunhill', var(), var(), var()), + (var(), var(), var(), 'horse', var()), houses), + # the Blue Master smoker drinks beer + (membero, (var(), 'Blue Master', 'beer', var(), var()), houses), + # the German smokes Prince + (membero, ('German', 'Prince', var(), var(), var()), houses), + # the Norwegian is next to the blue house + (nexto, ('Norwegian', var(), var(), var(), var()), + (var(), var(), var(), var(), 'blue'), houses), + # the house next to the Blend smoker drinks water + (nexto, (var(), 'Blend', var(), var(), var()), + (var(), var(), 'water', var(), var()), houses), + # one of the houses has a zebra--but whose? + (membero, (var(), var(), var(), 'zebra', var()), houses) +) -def constrained(M, atest): - if atest == Test.Drink: - return M[Test.Drink][House.Three] == Content.Milk - elif atest == Test.Person: - for h in House.values: - if ((M[Test.Person][h] == Content.Norwegian and - h != House.One) or - (M[Test.Person][h] == Content.Danish and - M[Test.Drink][h] != Content.Tea)): - return False - return True - elif atest == Test.Color: - for h in House.values: - if ((M[Test.Person][h] == Content.English and - M[Test.Color][h] != Content.Red) or - (M[Test.Drink][h] == Content.Coffee and - M[Test.Color][h] != Content.Green)): - return False - return True - elif atest == Test.Smoke: - for h in House.values: - if ((M[Test.Color][h] == Content.Yellow and - M[Test.Smoke][h] != Content.Dunhill) or - (M[Test.Smoke][h] == Content.BlueMaster and - M[Test.Drink][h] != Content.Beer) or - (M[Test.Person][h] == Content.German and - M[Test.Smoke][h] != Content.Prince)): - return False - return True - elif atest == Test.Pet: - for h in House.values: - if ((M[Test.Person][h] == Content.Swedish and - M[Test.Pet][h] != Content.Dog) or - (M[Test.Smoke][h] == Content.PallMall and - M[Test.Pet][h] != Content.Bird)): - return False - return finalChecks(M) +t0 = time.time() +solutions = run(0, houses, zebraRules) +t1 = time.time() +dur = t1-t0 -def show(M): - for h in House.values: - print "%5s:" % House.elems[h], - for t in Test.values: - print "%10s" % Content.elems[M[t][h]], - print +count = len(solutions) +zebraOwner = [house for house in solutions[0] if 'zebra' in house][0][0] -def solve(M, t, n): - if n == 1 and constrained(M, t): - if t < 4: - solve(M, Test.values[t + 1], 5) - else: - show(M) - return - - for i in xrange(n): - solve(M, t, n - 1) - M[t][0 if n % 2 else i], M[t][n - 1] = \ - M[t][n - 1], M[t][0 if n % 2 else i] - -def main(): - M = [[None] * len(Test.elems) for _ in xrange(len(House.elems))] - for t in Test.values: - for h in House.values: - M[t][h] = Content.values[t * 5 + h] - - solve(M, Test.Drink, 5) - -main() +print "%i solutions in %.2f seconds" % (count, dur) +print "The %s is the owner of the zebra" % zebraOwner +print "Here are all the houses:" +for line in solutions[0]: + print str(line) diff --git a/Task/Zebra-puzzle/Python/zebra-puzzle-2.py b/Task/Zebra-puzzle/Python/zebra-puzzle-2.py index ee8e55bc04..84cb78bf95 100644 --- a/Task/Zebra-puzzle/Python/zebra-puzzle-2.py +++ b/Task/Zebra-puzzle/Python/zebra-puzzle-2.py @@ -1,89 +1,101 @@ -from itertools import permutations -import psyco -psyco.full() +import psyco; psyco.full() -class Number:elems= "One Two Three Four Five".split() -class Color: elems= "Red Green Blue White Yellow".split() -class Drink: elems= "Milk Coffee Water Beer Tea".split() -class Smoke: elems= "PallMall Dunhill Blend BlueMaster Prince".split() -class Pet: elems= "Dog Cat Zebra Horse Bird".split() -class Nation:elems= "British Swedish Danish Norvegian German".split() +class Content: elems= """Beer Coffee Milk Tea Water + Danish English German Norwegian Swedish + Blue Green Red White Yellow + Blend BlueMaster Dunhill PallMall Prince + Bird Cat Dog Horse Zebra""".split() +class Test: elems= "Drink Person Color Smoke Pet".split() +class House: elems= "One Two Three Four Five".split() -for c in (Number, Color, Drink, Smoke, Pet, Nation): +for c in (Content, Test, House): + c.values = range(len(c.elems)) for i, e in enumerate(c.elems): exec "%s.%s = %d" % (c.__name__, e, i) -def is_possible(number, color, drink, smoke, pet): - if number and number[Nation.Norvegian] != Number.One: - return False - if color and color[Nation.British] != Color.Red: - return False - if drink and drink[Nation.Danish] != Drink.Tea: - return False - if smoke and smoke[Nation.German] != Smoke.Prince: - return False - if pet and pet[Nation.Swedish] != Pet.Dog: - return False +def finalChecks(M): + def diff(a, b, ca, cb): + for h1 in House.values: + for h2 in House.values: + if M[ca][h1] == a and M[cb][h2] == b: + return h1 - h2 + assert False - if not number or not color or not drink or not smoke or not pet: - return True + return abs(diff(Content.Norwegian, Content.Blue, + Test.Person, Test.Color)) == 1 and \ + diff(Content.Green, Content.White, + Test.Color, Test.Color) == -1 and \ + abs(diff(Content.Horse, Content.Dunhill, + Test.Pet, Test.Smoke)) == 1 and \ + abs(diff(Content.Water, Content.Blend, + Test.Drink, Test.Smoke)) == 1 and \ + abs(diff(Content.Blend, Content.Cat, + Test.Smoke, Test.Pet)) == 1 - for i in xrange(5): - if color[i] == Color.Green and drink[i] != Drink.Coffee: - return False - if smoke[i] == Smoke.PallMall and pet[i] != Pet.Bird: - return False - if color[i] == Color.Yellow and smoke[i] != Smoke.Dunhill: - return False - if number[i] == Number.Three and drink[i] != Drink.Milk: - return False - if smoke[i] == Smoke.BlueMaster and drink[i] != Drink.Beer: - return False - if color[i] == Color.Blue and number[i] != Number.Two: - return False +def constrained(M, atest): + if atest == Test.Drink: + return M[Test.Drink][House.Three] == Content.Milk + elif atest == Test.Person: + for h in House.values: + if ((M[Test.Person][h] == Content.Norwegian and + h != House.One) or + (M[Test.Person][h] == Content.Danish and + M[Test.Drink][h] != Content.Tea)): + return False + return True + elif atest == Test.Color: + for h in House.values: + if ((M[Test.Person][h] == Content.English and + M[Test.Color][h] != Content.Red) or + (M[Test.Drink][h] == Content.Coffee and + M[Test.Color][h] != Content.Green)): + return False + return True + elif atest == Test.Smoke: + for h in House.values: + if ((M[Test.Color][h] == Content.Yellow and + M[Test.Smoke][h] != Content.Dunhill) or + (M[Test.Smoke][h] == Content.BlueMaster and + M[Test.Drink][h] != Content.Beer) or + (M[Test.Person][h] == Content.German and + M[Test.Smoke][h] != Content.Prince)): + return False + return True + elif atest == Test.Pet: + for h in House.values: + if ((M[Test.Person][h] == Content.Swedish and + M[Test.Pet][h] != Content.Dog) or + (M[Test.Smoke][h] == Content.PallMall and + M[Test.Pet][h] != Content.Bird)): + return False + return finalChecks(M) - for j in xrange(5): - if (color[i] == Color.Green and - color[j] == Color.White and - number[j] - number[i] != 1): - return False +def show(M): + for h in House.values: + print "%5s:" % House.elems[h], + for t in Test.values: + print "%10s" % Content.elems[M[t][h]], + print - diff = abs(number[i] - number[j]) - if smoke[i] == Smoke.Blend and pet[j] == Pet.Cat and diff != 1: - return False - if pet[i]==Pet.Horse and smoke[j]==Smoke.Dunhill and diff != 1: - return False - if smoke[i]==Smoke.Blend and drink[j]==Drink.Water and diff!=1: - return False +def solve(M, t, n): + if n == 1 and constrained(M, t): + if t < 4: + solve(M, Test.values[t + 1], 5) + else: + show(M) + return - return True - -def show_row(t, data): - print "%6s: %12s%12s%12s%12s%12s" % ( - t.__name__, t.elems[data[0]], - t.elems[data[1]], t.elems[data[2]], - t.elems[data[3]], t.elems[data[4]]) + for i in xrange(n): + solve(M, t, n - 1) + M[t][0 if n % 2 else i], M[t][n - 1] = \ + M[t][n - 1], M[t][0 if n % 2 else i] def main(): - perms = list(permutations(range(5))) + M = [[None] * len(Test.elems) for _ in xrange(len(House.elems))] + for t in Test.values: + for h in House.values: + M[t][h] = Content.values[t * 5 + h] - for number in perms: - if is_possible(number, None, None, None, None): - for color in perms: - if is_possible(number, color, None, None, None): - for drink in perms: - if is_possible(number, color, drink, None, None): - for smoke in perms: - if is_possible(number, color, drink, smoke, None): - for pet in perms: - if is_possible(number, color, drink, smoke, pet): - print "Found a solution:" - show_row(Nation, range(5)) - show_row(Number, number) - show_row(Color, color) - show_row(Drink, drink) - show_row(Smoke, smoke) - show_row(Pet, pet) - print + solve(M, Test.Drink, 5) main() diff --git a/Task/Zebra-puzzle/Python/zebra-puzzle-3.py b/Task/Zebra-puzzle/Python/zebra-puzzle-3.py new file mode 100644 index 0000000000..e0c828c774 --- /dev/null +++ b/Task/Zebra-puzzle/Python/zebra-puzzle-3.py @@ -0,0 +1,51 @@ +from itertools import permutations + +class Number:elems= "One Two Three Four Five".split() +class Color: elems= "Red Green Blue White Yellow".split() +class Drink: elems= "Milk Coffee Water Beer Tea".split() +class Smoke: elems= "PallMall Dunhill Blend BlueMaster Prince".split() +class Pet: elems= "Dog Cat Zebra Horse Bird".split() +class Nation:elems= "British Swedish Danish Norvegian German".split() + +for c in (Number, Color, Drink, Smoke, Pet, Nation): + for i, e in enumerate(c.elems): + exec "%s.%s = %d" % (c.__name__, e, i) + +def show_row(t, data): + print "%6s: %12s%12s%12s%12s%12s" % ( + t.__name__, t.elems[data[0]], + t.elems[data[1]], t.elems[data[2]], + t.elems[data[3]], t.elems[data[4]]) + +def main(): + perms = list(permutations(range(5))) + for number in perms: + if number[Nation.Norvegian] == Number.One: # Constraint 10 + for color in perms: + if color[Nation.British] == Color.Red: # Constraint 2 + if number[color.index(Color.Blue)] == Number.Two: # Constraint 15+10 + if number[color.index(Color.White)] - number[color.index(Color.Green)] == 1: # Constraint 5 + for drink in perms: + if drink[Nation.Danish] == Drink.Tea: # Constraint 4 + if drink[color.index(Color.Green)] == Drink.Coffee: # Constraint 6 + if drink[number.index(Number.Three)] == Drink.Milk: # Constraint 9 + for smoke in perms: + if smoke[Nation.German] == Smoke.Prince: # Constraint 14 + if drink[smoke.index(Smoke.BlueMaster)] == Drink.Beer: # Constraint 13 + if smoke[color.index(Color.Yellow)] == Smoke.Dunhill: # Constraint 8 + if number[smoke.index(Smoke.Blend)] - number[drink.index(Drink.Water)] in (1, -1): # Constraint 16 + for pet in perms: + if pet[Nation.Swedish] == Pet.Dog: # Constraint 3 + if pet[smoke.index(Smoke.PallMall)] == Pet.Bird: # Constraint 7 + if number[pet.index(Pet.Horse)] - number[smoke.index(Smoke.Dunhill)] in (1, -1): # Constraint 12 + if number[smoke.index(Smoke.Blend)] - number[pet.index(Pet.Cat)] in (1, -1): # Constraint 11 + print "Found a solution:" + show_row(Nation, range(5)) + show_row(Number, number) + show_row(Color, color) + show_row(Drink, drink) + show_row(Smoke, smoke) + show_row(Pet, pet) + print + +main() diff --git a/Task/Zebra-puzzle/REXX/zebra-puzzle.rexx b/Task/Zebra-puzzle/REXX/zebra-puzzle.rexx new file mode 100644 index 0000000000..3614621220 --- /dev/null +++ b/Task/Zebra-puzzle/REXX/zebra-puzzle.rexx @@ -0,0 +1,170 @@ +/* REXX --------------------------------------------------------------- +* Solve the Zebra Puzzle +*--------------------------------------------------------------------*/ + oid='zebra.txt'; 'erase' oid + Call mk_perm /* compute all permutations */ + Call encode /* encode the elements of the specifucations */ + /* ex2 .. eg16 the formalized specifications */ + solutions=0 + Call time 'R' + Do nation_i = 1 TO 120 + Nations = perm.nation_i + IF ex10() Then Do + Do color_i = 1 TO 120 + Colors = perm.color_i + IF ex5() & ex2() & ex15() Then Do + Do drink_i = 1 TO 120 + Drinks = perm.drink_i + IF ex9() & ex4() & ex6() Then Do + Do smoke_i = 1 TO 120 + Smokes = perm.smoke_i + IF ex14() & ex13() & ex16() & ex8() Then Do + Do animal_i = 1 TO 120 + Animals = perm.animal_i + IF ex3() & ex7() & ex11() & ex12() Then Do + /* Call out 'Drinks =' Drinks 54321 Wat Tea Mil Cof Bee */ + /* Call out 'Nations=' Nations 41235 Nor Den Eng Ger Swe */ + /* Call out 'Colors =' Colors 51324 Yel Blu Red Gre Whi */ + /* Call out 'Smokes =' Smokes 31452 Dun Ble Pal Pri Blu */ + /* Call out 'Animals=' Animals 24153 Cat Hor Bir Zeb Dog */ + Call out 'House Drink Nation Colour'||, + ' Smoke Animal' + Do i=1 To 5 + di=substr(drinks,i,1) + ni=substr(nations,i,1) + ci=substr(colors,i,1) + si=substr(smokes,i,1) + ai=substr(animals,i,1) + ol.i=right(i,3)' '||left(drink.di,11), + ||left(nation.ni,11), + ||left(color.ci,11), + ||left(smoke.si,11), + ||left(animal.ai,11) + Call out ol.i + End + solutions+=1 + End + End /* animal_i */ + End + End /* smoke_i */ + End + End /* drink_i */ + End + End /* colr_i */ + End + End /* nation_i */ + Say 'Number of solutions =' solutions + Say 'Solved in' time('E') 'seconds' +Exit + +/*------------------------------------------------------------------------------ + #There are five houses. +ex2: #The English man lives in the red house. +ex3: #The Swede has a dog. +ex4: #The Dane drinks tea. +ex5: #The green house is immediately to the left of the white house. +ex6: #They drink coffee in the green house. +ex7: #The man who smokes Pall Mall has birds. +ex8: #In the yellow house they smoke Dunhill. +ex9: #In the middle house they drink milk. +ex10: #The Norwegian lives in the first house. +ex11: #The man who smokes Blend lives in the house next to the house with cats. +ex12: #In a house next to the house where they have a horse, they smoke Dunhill. +ex13: #The man who smokes Blue Master drinks beer. +ex14: #The German smokes Prince. +ex15: #The Norwegian lives next to the blue house. +ex16: #They drink water in a house next to the house where they smoke Blend. +------------------------------------------------------------------------------*/ +ex2: Return pos(England,Nations)=pos(Red,Colors) +ex3: Return pos(Sweden,Nations)=pos(Dog,Animals) +ex4: Return pos(Denmark,Nations)=pos(Tea,Drinks) +ex5: Return pos(Green,Colors)=pos(White,Colors)-1 +ex6: Return pos(Coffee,Drinks)=pos(Green,Colors) +ex7: Return pos(PallMall,Smokes)=pos(Birds,Animals) +ex8: Return pos(Dunhill,Smokes)=pos(Yellow,Colors) +ex9: Return substr(Drinks,3,1)=Milk +ex10: Return left(Nations,1)=Norway +ex11: Return abs(pos(Blend,Smokes)-pos(Cats,Animals))=1 +ex12: Return abs(pos(Dunhill,Smokes)-pos(Horse,Animals))=1 +ex13: Return pos(BlueMaster,Smokes)=pos(Beer,Drinks) +ex14: Return pos(Germany,Nations)=pos(Prince,Smokes) +ex15: Return abs(pos(Norway,Nations)-pos(Blue,Colors))=1 +ex16: Return abs(pos(Blend,Smokes)-pos(Water,Drinks))=1 + +mk_perm: Procedure Expose perm. +/*--------------------------------------------------------------------- +* Make all permutations of 12345 in perm.* +*--------------------------------------------------------------------*/ +perm.=0 +n=5 +Do pop=1 For n + p.pop=pop + End +Call store +Do While nextperm(n,0) + Call store + End +Return + +nextperm: Procedure Expose p. perm. + Parse Arg n,i + nm=n-1 + Do k=nm By-1 For nm + kp=k+1 + If p.k0 Then Do + Do j=i+1 While p.j0 + +store: Procedure Expose p. perm. + z=perm.0+1 + _='' + Do j=1 To 5 + _=_||p.j + End + perm.z=_ + perm.0=z + Return + +encode: + Beer=1 ; Drink.1='Beer' + Coffee=2 ; Drink.2='Coffee' + Milk=3 ; Drink.3='Milk' + Tea=4 ; Drink.4='Tea' + Water=5 ; Drink.5='Water' + Denmark=1 ; Nation.1='Denmark' + England=2 ; Nation.2='England' + Germany=3 ; Nation.3='Germany' + Norway=4 ; Nation.4='Norway' + Sweden=5 ; Nation.5='Sweden' + Blue=1 ; Color.1='Blue' + Green=2 ; Color.2='Green' + Red=3 ; Color.3='Red' + White=4 ; Color.4='White' + Yellow=5 ; Color.5='Yellow' + Blend=1 ; Smoke.1='Blend' + BlueMaster=2 ; Smoke.2='BlueMaster' + Dunhill=3 ; Smoke.3='Dunhill' + PallMall=4 ; Smoke.4='PallMall' + Prince=5 ; Smoke.5='Prince' + Birds=1 ; Animal.1='Birds' + Cats=2 ; Animal.2='Cats' + Dog=3 ; Animal.3='Dog' + Horse=4 ; Animal.4='Horse' + Zebra=5 ; Animal.5='Zebra' + Return + +out: + Say arg(1) + Return lineout(oid,arg(1)) diff --git a/Task/Zebra-puzzle/Ruby/zebra-puzzle.rb b/Task/Zebra-puzzle/Ruby/zebra-puzzle.rb index a473228f3c..2f23c0b1c0 100644 --- a/Task/Zebra-puzzle/Ruby/zebra-puzzle.rb +++ b/Task/Zebra-puzzle/Ruby/zebra-puzzle.rb @@ -1,13 +1,9 @@ -# Solve Zebra Puzzle. -# -# Nigel_Galloway -# August 31st., 2014. -CONTENT = { :House => nil, - :Nationality => [:English, :Swedish, :Danish, :Norwegian, :German], - :Colour => [:Red, :Green, :White, :Blue, :Yellow], - :Pet => [:Dog, :Birds, :Cats, :Horse, :Zebra], - :Drink => [:Tea, :Coffee, :Milk, :Beer, :Water], - :Smoke => [:PallMall, :Dunhill, :BlueMaster, :Prince, :Blend] } +CONTENT = { House: '', + Nationality: %i[English Swedish Danish Norwegian German], + Colour: %i[Red Green White Blue Yellow], + Pet: %i[Dog Birds Cats Horse Zebra], + Drink: %i[Tea Coffee Milk Beer Water], + Smoke: %i[PallMall Dunhill BlueMaster Prince Blend] } def adjacent? (n,i,g,e) (0..3).any?{|x| (n[x]==i and g[x+1]==e) or (n[x+1]==i and g[x]==e)} @@ -21,33 +17,38 @@ def coincident? (n,i,g,e) n.each_index.any?{|x| n[x]==i and g[x]==e} end -def solve +def solve_zebra_puzzle CONTENT[:Nationality].permutation{|nation| - next if nation.first != :Norwegian # 10 + next unless nation.first == :Norwegian # 10 CONTENT[:Colour].permutation{|colour| - next unless leftof?(colour,:Green,colour,:White) # 5 - next unless coincident?(nation,:English,colour,:Red) # 2 - next unless adjacent?(nation,:Norwegian,colour,:Blue) # 15 + next unless leftof?(colour, :Green, colour, :White) # 5 + next unless coincident?(nation, :English, colour, :Red) # 2 + next unless adjacent?(nation, :Norwegian, colour, :Blue) # 15 CONTENT[:Pet].permutation{|pet| - next unless coincident?(nation,:Swedish,pet,:Dog) # 3 + next unless coincident?(nation, :Swedish, pet, :Dog) # 3 CONTENT[:Drink].permutation{|drink| - next if drink[2] != :Milk # 9 - next unless coincident?(nation,:Danish,drink,:Tea) # 4 - next unless coincident?(colour,:Green,drink,:Coffee) # 6 + next unless drink[2] == :Milk # 9 + next unless coincident?(nation, :Danish, drink, :Tea) # 4 + next unless coincident?(colour, :Green, drink, :Coffee) # 6 CONTENT[:Smoke].permutation{|smoke| - next unless coincident?(smoke,:PallMall,pet,:Birds) # 7 - next unless coincident?(smoke,:Dunhill,colour,:Yellow) # 8 - next unless coincident?(smoke,:BlueMaster,drink,:Beer) # 13 - next unless coincident?(smoke,:Prince,nation,:German) # 14 - next unless adjacent?(smoke,:Blend,pet,:Cats) # 11 - next unless adjacent?(smoke,:Blend,drink,:Water) # 16 - next unless adjacent?(smoke,:Dunhill,pet,:Horse) # 12 - return [nation,colour,pet,drink,smoke] + next unless coincident?(smoke, :PallMall, pet, :Birds) # 7 + next unless coincident?(smoke, :Dunhill, colour, :Yellow) # 8 + next unless coincident?(smoke, :BlueMaster, drink, :Beer) # 13 + next unless coincident?(smoke, :Prince, nation, :German) # 14 + next unless adjacent?(smoke, :Blend, pet, :Cats) # 11 + next unless adjacent?(smoke, :Blend, drink, :Water) # 16 + next unless adjacent?(smoke, :Dunhill,pet, :Horse) # 12 + print_out(nation, colour, pet, drink, smoke) } } } } } end -res = solve -width = CONTENT.map{|x| x.flatten.map{|y|y.to_s.size}.max} -fmt = width.map{|w| "%-#{w}s"}.join(" ") -puts "The Zebra is owned by the man who is #{res[0][res[2].find_index(:Zebra)]}","" -puts fmt % CONTENT.keys, fmt % width.map{|w| "-"*w} -res.transpose.each.with_index(1){|x,n| puts fmt % [n,*x]} + +def print_out (nation, colour, pet, drink, smoke) + width = CONTENT.map{|x| x.flatten.map{|y|y.size}.max} + fmt = width.map{|w| "%-#{w}s"}.join(" ") + national = nation[ pet.find_index(:Zebra) ] + puts "The Zebra is owned by the man who is #{national}","" + puts fmt % CONTENT.keys, fmt % width.map{|w| "-"*w} + [nation,colour,pet,drink,smoke].transpose.each.with_index(1){|x,n| puts fmt % [n,*x]} +end + +solve_zebra_puzzle diff --git a/Task/Zebra-puzzle/Scala/zebra-puzzle.scala b/Task/Zebra-puzzle/Scala/zebra-puzzle-1.scala similarity index 100% rename from Task/Zebra-puzzle/Scala/zebra-puzzle.scala rename to Task/Zebra-puzzle/Scala/zebra-puzzle-1.scala diff --git a/Task/Zebra-puzzle/Scala/zebra-puzzle-2.scala b/Task/Zebra-puzzle/Scala/zebra-puzzle-2.scala new file mode 100644 index 0000000000..f7141da1a1 --- /dev/null +++ b/Task/Zebra-puzzle/Scala/zebra-puzzle-2.scala @@ -0,0 +1,85 @@ +import scala.util.Try + +object Einstein extends App { + + // The strategy here is to mount a brute-force attack on the solution space, pruning very aggressively. + // The scala standard `permutations` method is extremely helpful here. It turns out that by pruning + // quickly and smartly we can solve this very quickly (45ms on my machine) compared to days or weeks + // required to fully enumerate the solution space. + + // We set up a for comprehension with an enumerator for each of the 5 variables, with if clauses to + // prune. The hard part is the pruning logic, which is basically just translating the rules to code + // and the data model. The data model is basically Seq[Seq[String]] + + // Rules are encoded as for comprehension filters. There is a natural cascade of rules from + // depending on more or less criteria. The rules about smokes are the most complex and depend + // on the most other factors + + // 4. The green house is just to the left of the white one. + def colorRules(colors: Seq[String]) = Try(colors(colors.indexOf("White") - 1) == "Green").getOrElse(false) + + // 1. The Englishman lives in the red house. + // 9. The Norwegian lives in the first house. + // 14. The Norwegian lives next to the blue house. + def natRules(colors: Seq[String], nats: Seq[String]) = + nats.head == "Norwegian" && colors(nats.indexOf("Brit")) == "Red" && + (Try(colors(nats.indexOf("Norwegian") - 1) == "Blue").getOrElse(false) || + Try(colors(nats.indexOf("Norwegian") + 1) == "Blue").getOrElse(false)) + + // 3. The Dane drinks tea. + // 5. The owner of the green house drinks coffee. + // 8. The man in the center house drinks milk. + def drinkRules(colors: Seq[String], nats: Seq[String], drinks: Seq[String]) = + drinks(nats.indexOf("Dane")) == "Tea" && + drinks(colors.indexOf("Green")) == "Coffee" && + drinks(2) == "Milk" + + // 2. The Swede keeps dogs. + def petRules(nats: Seq[String], pets: Seq[String]) = pets(nats.indexOf("Swede")) == "Dogs" + + // 6. The Pall Mall smoker keeps birds. + // 7. The owner of the yellow house smokes Dunhills. + // 10. The Blend smoker has a neighbor who keeps cats. + // 11. The man who smokes Blue Masters drinks bier. + // 12. The man who keeps horses lives next to the Dunhill smoker. + // 13. The German smokes Prince. + // 15. The Blend smoker has a neighbor who drinks water. + def smokeRules(colors: Seq[String], nats: Seq[String], drinks: Seq[String], pets: Seq[String], smokes: Seq[String]) = + pets(smokes.indexOf("Pall Mall")) == "Birds" && + smokes(colors.indexOf("Yellow")) == "Dunhill" && + (Try(pets(smokes.indexOf("Blend") - 1) == "Cats").getOrElse(false) || + Try(pets(smokes.indexOf("Blend") + 1) == "Cats").getOrElse(false)) && + drinks(smokes.indexOf("BlueMaster")) == "Beer" && + (Try(smokes(pets.indexOf("Horses") - 1) == "Dunhill").getOrElse(false) || + Try(pets(pets.indexOf("Horses") + 1) == "Dunhill").getOrElse(false)) && + smokes(nats.indexOf("German")) == "Prince" && + (Try(drinks(smokes.indexOf("Blend") - 1) == "Water").getOrElse(false) || + Try(drinks(smokes.indexOf("Blend") + 1) == "Water").getOrElse(false)) + + // once the rules are created it, the actual solution is simple: iterate brute force, pruning early. + val solutions = for { + colors <- Seq("Red", "Blue", "White", "Green", "Yellow").permutations if colorRules(colors) + nats <- Seq("Brit", "Swede", "Dane", "Norwegian", "German").permutations if natRules(colors, nats) + drinks <- Seq("Tea", "Coffee", "Milk", "Beer", "Water").permutations if drinkRules(colors, nats, drinks) + pets <- Seq("Dogs", "Birds", "Cats", "Horses", "Fish").permutations if petRules(nats, pets) + smokes <- Seq("BlueMaster", "Blend", "Pall Mall", "Dunhill", "Prince").permutations if smokeRules(colors, nats, drinks, pets, smokes) + } yield Seq(colors, nats, drinks, pets, smokes) + + // There *should* be just one solution... + solutions.foreach { solution => + // so we can pretty-print, find out the maximum strength length of all cells + val maxLen = solution.flatten.map(_.length).max + + def pretty(str: String): String = str + (" " * (maxLen - str.length + 1)) + + // a labels column + val labels = ("" +: Seq("Color", "Nation", "Drink", "Pet", "Smoke").map(_ + ":")).toIterator + + // print each row including a column header + ((1 to 5).map(n => s"House $n") +: solution).map(_.map(pretty)).map(x => (pretty(labels.next) +: x).mkString(" ")).foreach(println) + + println() + println(s"The ${solution(1)(solution(3).indexOf("Fish"))} owns the Fish") + } + +} diff --git a/Task/Zebra-puzzle/Standard-ML/zebra-puzzle.ml b/Task/Zebra-puzzle/Standard-ML/zebra-puzzle.ml new file mode 100644 index 0000000000..c968e75f5a --- /dev/null +++ b/Task/Zebra-puzzle/Standard-ML/zebra-puzzle.ml @@ -0,0 +1,249 @@ +(* Attributes and values *) +val str_attributes = Vector.fromList ["Color", "Nation", "Drink", "Pet", "Smoke"] +val str_colors = Vector.fromList ["Red", "Green", "White", "Yellow", "Blue"] +val str_nations = Vector.fromList ["English", "Swede", "Dane", "German", "Norwegian"] +val str_drinks = Vector.fromList ["Tea", "Coffee", "Milk", "Beer", "Water"] +val str_pets = Vector.fromList ["Dog", "Birds", "Cats", "Horse", "Zebra"] +val str_smokes = Vector.fromList ["PallMall", "Dunhill", "Blend", "BlueMaster", "Prince"] + +val (Color, Nation, Drink, Pet, Smoke) = (0, 1, 2, 3, 4) (* Attributes *) +val (Red, Green, White, Yellow, Blue) = (0, 1, 2, 3, 4) (* Color *) +val (English, Swede, Dane, German, Norwegian) = (0, 1, 2, 3, 4) (* Nation *) +val (Tea, Coffee, Milk, Beer, Water) = (0, 1, 2, 3, 4) (* Drink *) +val (Dog, Birds, Cats, Horse, Zebra) = (0, 1, 2, 3, 4) (* Pet *) +val (PallMall, Dunhill, Blend, BlueMaster, Prince) = (0, 1, 2, 3, 4) (* Smoke *) + +type attr = int +type value = int +type houseno = int + +(* Rules *) +datatype rule = + AttrPairRule of (attr * value) * (attr * value) + | NextToRule of (attr * value) * (attr * value) + | LeftOfRule of (attr * value) * (attr * value) + +(* Conditions *) +val rules = [ +AttrPairRule ((Nation, English), (Color, Red)), (* #02 *) +AttrPairRule ((Nation, Swede), (Pet, Dog)), (* #03 *) +AttrPairRule ((Nation, Dane), (Drink, Tea)), (* #04 *) +LeftOfRule ((Color, Green), (Color, White)), (* #05 *) +AttrPairRule ((Color, Green), (Drink, Coffee)), (* #06 *) +AttrPairRule ((Smoke, PallMall), (Pet, Birds)), (* #07 *) +AttrPairRule ((Smoke, Dunhill), (Color, Yellow)), (* #08 *) +NextToRule ((Smoke, Blend), (Pet, Cats)), (* #11 *) +NextToRule ((Smoke, Dunhill), (Pet, Horse)), (* #12 *) +AttrPairRule ((Smoke, BlueMaster), (Drink, Beer)), (* #13 *) +AttrPairRule ((Nation, German), (Smoke, Prince)), (* #14 *) +NextToRule ((Nation, Norwegian), (Color, Blue)), (* #15 *) +NextToRule ((Smoke, Blend), (Drink, Water))] (* #16 *) + + +type house = value option * value option * value option * value option * value option + +fun houseval ((a, b, c, d, e) : house, 0 : attr) = a + | houseval ((a, b, c, d, e) : house, 1 : attr) = b + | houseval ((a, b, c, d, e) : house, 2 : attr) = c + | houseval ((a, b, c, d, e) : house, 3 : attr) = d + | houseval ((a, b, c, d, e) : house, 4 : attr) = e + | houseval _ = raise Domain + +fun sethouseval ((a, b, c, d, e) : house, 0 : attr, a2 : value option) = (a2, b, c, d, e ) + | sethouseval ((a, b, c, d, e) : house, 1 : attr, b2 : value option) = (a, b2, c, d, e ) + | sethouseval ((a, b, c, d, e) : house, 2 : attr, c2 : value option) = (a, b, c2, d, e ) + | sethouseval ((a, b, c, d, e) : house, 3 : attr, d2 : value option) = (a, b, c, d2, e ) + | sethouseval ((a, b, c, d, e) : house, 4 : attr, e2 : value option) = (a, b, c, d, e2) + | sethouseval _ = raise Domain + +fun getHouseVal houses (no, attr) = houseval (Array.sub (houses, no), attr) +fun setHouseVal houses (no, attr, newval) = + Array.update (houses, no, sethouseval (Array.sub (houses, no), attr, newval)) + + +fun match (house, (rule_attr, rule_val)) = + let + val value = houseval (house, rule_attr) + in + isSome value andalso valOf value = rule_val + end + +fun matchNo houses (no, rule) = + match (Array.sub (houses, no), rule) + +fun compare (house1, house2, ((rule_attr1, rule_val1), (rule_attr2, rule_val2))) = + let + val val1 = houseval (house1, rule_attr1) + val val2 = houseval (house2, rule_attr2) + in + if isSome val1 andalso isSome val2 + then (valOf val1 = rule_val1 andalso valOf val2 <> rule_val2) + orelse + (valOf val1 <> rule_val1 andalso valOf val2 = rule_val2) + else false + end + +fun compareNo houses (no1, no2, rulepair) = + compare (Array.sub (houses, no1), Array.sub (houses, no2), rulepair) + + +fun invalid houses no (AttrPairRule rulepair) = + compareNo houses (no, no, rulepair) + + | invalid houses no (NextToRule rulepair) = + (if no > 0 + then compareNo houses (no, no-1, rulepair) + else true) + andalso + (if no < 4 + then compareNo houses (no, no+1, rulepair) + else true) + + | invalid houses no (LeftOfRule rulepair) = + if no > 0 + then compareNo houses (no-1, no, rulepair) + else matchNo houses (no, #1rulepair) + + +(* + * val checkRulesForNo : house vector -> houseno -> bool + * Check all rules for a house; + * Returns true, when one rule was invalid. + *) +fun checkRulesForNo (houses : house array) no = + let + exception RuleError + in + (map (fn rule => if invalid houses no rule then raise RuleError else ()) rules; + false) + handle RuleError => true + end + +(* + * val checkAll : house vector -> bool + * Check all rules; + * return true if everything is ok. + *) +fun checkAll (houses : house array) = + let + exception RuleError + in + (map (fn no => if checkRulesForNo houses no then raise RuleError else ()) [0,1,2,3,4]; + true) + handle RuleError => false + end + + +(* + * + * House printing for debugging + * + *) + +fun valToString (0, SOME a) = Vector.sub (str_colors, a) + | valToString (1, SOME b) = Vector.sub (str_nations, b) + | valToString (2, SOME c) = Vector.sub (str_drinks, c) + | valToString (3, SOME d) = Vector.sub (str_pets, d) + | valToString (4, SOME e) = Vector.sub (str_smokes, e) + | valToString _ = "-" + +(* + * Note: + * Format needs SML NJ + *) +fun printHouse no ((a, b, c, d, e) : house) = + ( + print (Format.format "%12d" [Format.LEFT (12, Format.INT no)]); + print (Format.format "%12s%12s%12s%12s%12s" + (map (fn (x, y) => Format.LEFT (12, Format.STR (valToString (x, y)))) + [(0,a), (1,b), (2,c), (3,d), (4,e)])); + print ("\n") + ) + +fun printHouses houses = + ( + print (Format.format "%12s" [Format.LEFT (12, Format.STR "House")]); + Vector.map (fn a => print (Format.format "%12s" [Format.LEFT (12, Format.STR a)])) + str_attributes; + print "\n"; + Array.foldli (fn (no, house, _) => printHouse no house) () houses + ) + +(* + * + * Solving + * + *) + +exception SolutionFound + +fun search (houses : house array, used : bool Array2.array) (no : houseno, attr : attr) = + let + val i = ref 0 + val (nextno, nextattr) = if attr < 4 then (no, attr + 1) else (no + 1, 0) + in + if isSome (getHouseVal houses (no, attr)) + then + ( + search (houses, used) (nextno, nextattr) + ) + else + ( + while (!i < 5) + do + ( + if Array2.sub (used, attr, !i) then () + else + ( + Array2.update (used, attr, !i, true); + setHouseVal houses (no, attr, SOME (!i)); + + if checkAll houses then + ( + if no = 4 andalso attr = 4 + then raise SolutionFound + else search (houses, used) (nextno, nextattr) + ) + else (); + Array2.update (used, attr, !i, false) + ); (* else *) + i := !i + 1 + ); (* do *) + setHouseVal houses (no, attr, NONE) + ) (* else *) + end + +fun init () = + let + val unknown : house = (NONE, NONE, NONE, NONE, NONE) + val houses = Array.fromList [unknown, unknown, unknown, unknown, unknown] + val used = Array2.array (5, 5, false) + in + (houses, used) + end + +fun solve () = + let + val (houses, used) = init() + in + setHouseVal houses (2, Drink, SOME Milk); (* #09 *) + Array2.update (used, Drink, Milk, true); + setHouseVal houses (0, Nation, SOME Norwegian); (* #10 *) + Array2.update (used, Nation, Norwegian, true); + (search (houses, used) (0, 0); NONE) + handle SolutionFound => SOME houses + end + +(* + * + * Execution + * + *) + +fun main () = let + val solution = solve() + in + if isSome solution + then printHouses (valOf solution) + else print "No solution found!\n" + end diff --git a/Task/Zeckendorf-number-representation/00DESCRIPTION b/Task/Zeckendorf-number-representation/00DESCRIPTION index 648d4d72f6..3c95bfaa23 100644 --- a/Task/Zeckendorf-number-representation/00DESCRIPTION +++ b/Task/Zeckendorf-number-representation/00DESCRIPTION @@ -1,13 +1,23 @@ Just as numbers can be represented in a positional notation as sums of multiples of the powers of ten (decimal) or two (binary); all the positive integers can be represented as the sum of one or zero times the distinct members of the Fibonacci series. -Recall that the first six distinct Fibonacci numbers are: 1, 2, 3, 5, 8, 13. The decimal number eleven can be written as 0*13 + 1*8 + 0*5 + 1*3 + 0*2 + 0*1 or 010100 in positional notation where the columns represent multiplication by a particular member of the sequence. Leading zeroes are dropped so that 11 decimal becomes 10100. +Recall that the first six distinct Fibonacci numbers are: 1, 2, 3, 5, 8, 13. + +The decimal number eleven can be written as 0*13 + 1*8 + 0*5 + 1*3 + 0*2 + 0*1 or 010100 in positional notation where the columns represent multiplication by a particular member of the sequence. Leading zeroes are dropped so that 11 decimal becomes 10100. 10100 is not the only way to make 11 from the Fibonacci numbers however; 0*13 + 1*8 + 0*5 + 0*3 + 1*2 + 1*1 or 010011 would also represent decimal 11. For a true Zeckendorf number there is the added restriction that ''no two consecutive Fibonacci numbers can be used'' which leads to the former unique solution. -The task is to generate and show here a table of the Zeckendorf number representations of the decimal numbers zero to twenty, in order. See -[http://oeis.org/A014417 OEIS A014417] for the the sequence of required results. -Cf: -* [[Fibonacci sequence]] -* [http://www.youtube.com/watch?v=kQZmZRE0cQY&list=UUoxcjq-8xIDTYp3uz647V5A&index=3&feature=plcp Brown's Criterion - Numberphile] + +;Task: +Generate and show here a table of the Zeckendorf number representations of the decimal numbers zero to twenty, in order. The intention in this task to find the Zeckendorf form of an arbitrary integer. The Zeckendorf form can be iterated by some bit twiddling rather than calculating each value separately but leave that to another separate task. + + +;Also see: +*   [http://oeis.org/A014417 OEIS A014417]   for the the sequence of required results. +*   [http://www.youtube.com/watch?v=kQZmZRE0cQY&list=UUoxcjq-8xIDTYp3uz647V5A&index=3&feature=plcp Brown's Criterion - Numberphile] + + +;Related task: +*   [[Fibonacci sequence]] +

    diff --git a/Task/Zeckendorf-number-representation/ALGOL-68/zeckendorf-number-representation.alg b/Task/Zeckendorf-number-representation/ALGOL-68/zeckendorf-number-representation.alg new file mode 100644 index 0000000000..1ed04a6551 --- /dev/null +++ b/Task/Zeckendorf-number-representation/ALGOL-68/zeckendorf-number-representation.alg @@ -0,0 +1,59 @@ +# print some Zeckendorf number representations # + +# We handle 32-bit numbers, the maximum fibonacci number that can fit in a # +# 32 bit number is F(45) # + +# build a table of 32-bit fibonacci numbers # +[ 45 ]INT fibonacci; +fibonacci[ 1 ] := 1; +fibonacci[ 2 ] := 2; +FOR i FROM 3 TO UPB fibonacci DO fibonacci[ i ] := fibonacci[ i - 1 ] + fibonacci[ i - 2 ] OD; + +# returns the Zeckendorf representation of n or "?" if one cannot be found # +PROC to zeckendorf = ( INT n )STRING: + IF n = 0 THEN + "0" + ELSE + STRING result := ""; + INT f pos := UPB fibonacci; + INT rest := ABS n; + # find the first non-zero Zeckendorf digit # + WHILE f pos > LWB fibonacci AND rest < fibonacci[ f pos ] DO + f pos -:= 1 + OD; + # if we found a digit, build the representation # + IF f pos >= LWB fibonacci THEN + # have a digit # + BOOL skip digit := FALSE; + WHILE f pos >= LWB fibonacci DO + IF rest <= 0 THEN + result +:= "0" + ELIF skip digit THEN + # we used the previous digit # + skip digit := FALSE; + result +:= "0" + ELIF rest < fibonacci[ f pos ] THEN + # can't use the digit at f pos # + skip digit := FALSE; + result +:= "0" + ELSE + # can use this digit # + skip digit := TRUE; + result +:= "1"; + rest -:= fibonacci[ f pos ] + FI; + f pos -:= 1 + OD + FI; + IF rest = 0 THEN + # found a representation # + result + ELSE + # can't find a representation # + "?" + FI + FI; # to zeckendorf # + +FOR i FROM 0 TO 20 DO + print( ( whole( i, -3 ), " ", to zeckendorf( i ), newline ) ) +OD diff --git a/Task/Zeckendorf-number-representation/AppleScript/zeckendorf-number-representation.applescript b/Task/Zeckendorf-number-representation/AppleScript/zeckendorf-number-representation.applescript new file mode 100644 index 0000000000..8ce919879d --- /dev/null +++ b/Task/Zeckendorf-number-representation/AppleScript/zeckendorf-number-representation.applescript @@ -0,0 +1,168 @@ +-- zeckendorf :: Int -> String +on zeckendorf(n) + script f + on lambda(n, x) + if n < x then + [n, 0] + else + [n - x, 1] + end if + end lambda + end script + + if n = 0 then + {0} as string + else + item 2 of mapAccumL(f, n, _reverse(tail(fibUntil(n)))) as string + end if +end zeckendorf + + +-- fibUntil :: Int -> [Int] +on fibUntil(n) + set xs to {} + set limit to n + + script atLimit + property ceiling : limit + on lambda(x) + (item 2 of x) > (atLimit's ceiling) + end lambda + end script + + script nextPair + property series : xs + on lambda([a, b]) + set nextPair's series to nextPair's series & b + [b, a + b] + end lambda + end script + + |until|(atLimit, nextPair, {0, 1}) + return nextPair's series +end fibUntil + + +-- TEST +on run + + intercalate(linefeed, ¬ + map(zeckendorf, range(0, 20))) + +end run + + +-- GENERIC LIBRARY FUNCTIONS + +-- 'The mapAccumL function behaves like a combination of map and foldl; +-- it applies a function to each element of a list, passing an +-- accumulating parameter from left to right, and returning a final +-- value of this accumulator together with the new list.' (see Hoogle) + +-- mapAccumL :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y]) +on mapAccumL(f, acc, xs) + script + on lambda(a, x) + tell mReturn(f) to set pair to lambda(item 1 of a, x) + [item 1 of pair, (item 2 of a) & item 2 of pair] + end lambda + end script + + foldl(result, [acc, []], xs) +end mapAccumL + +-- until :: (a -> Bool) -> (a -> a) -> a -> a +on |until|(p, f, x) + set mp to mReturn(p) + set mf to mReturn(f) + + script + property p : mp's lambda + property f : mf's lambda + + on lambda(v) + repeat until p(v) + set v to f(v) + end repeat + return v + end lambda + end script + + result's lambda(x) +end |until| + +-- 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 + +-- 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 + +-- range :: Int -> Int -> [Int] +on range(m, n) + if n < m then + set d to -1 + else + set d to 1 + end if + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range + +-- intercalate :: Text -> [Text] -> Text +on intercalate(strText, lstText) + set {dlm, my text item delimiters} to {my text item delimiters, strText} + set strJoined to lstText as text + set my text item delimiters to dlm + return strJoined +end intercalate + +-- _reverse :: [a] -> [a] +on _reverse(xs) + if class of xs is text then + (reverse of characters of xs) as text + else + reverse of xs + end if +end _reverse + +-- tail :: [a] -> [a] +on tail(xs) + if length of xs > 1 then + items 2 thru -1 of xs + else + {} + end if +end tail diff --git a/Task/Zeckendorf-number-representation/Befunge/zeckendorf-number-representation.bf b/Task/Zeckendorf-number-representation/Befunge/zeckendorf-number-representation.bf new file mode 100644 index 0000000000..9fdf18891c --- /dev/null +++ b/Task/Zeckendorf-number-representation/Befunge/zeckendorf-number-representation.bf @@ -0,0 +1,7 @@ +45*83p0>:::.0`"0"v +v53210p 39+!:,,9+< +>858+37 *66g"7Y":v +>3g`#@_^ v\g39$< +^8:+1,+5_5<>-:0\`| +v:-\g39_^#:<*:p39< +>0\`:!"0"+#^ ,#$_^ diff --git a/Task/Zeckendorf-number-representation/Elixir/zeckendorf-number-representation-1.elixir b/Task/Zeckendorf-number-representation/Elixir/zeckendorf-number-representation-1.elixir new file mode 100644 index 0000000000..4360cb27d3 --- /dev/null +++ b/Task/Zeckendorf-number-representation/Elixir/zeckendorf-number-representation-1.elixir @@ -0,0 +1,13 @@ +defmodule Zeckendorf do + def number do + Stream.unfold(0, fn n -> zn_loop(n) end) + end + + defp zn_loop(n) do + bin = Integer.to_string(n, 2) + if String.match?(bin, ~r/11/), do: zn_loop(n+1), else: {bin, n+1} + end +end + +Zeckendorf.number |> Enum.take(21) |> Enum.with_index +|> Enum.each(fn {zn, i} -> IO.puts "#{i}: #{zn}" end) diff --git a/Task/Zeckendorf-number-representation/Elixir/zeckendorf-number-representation-2.elixir b/Task/Zeckendorf-number-representation/Elixir/zeckendorf-number-representation-2.elixir new file mode 100644 index 0000000000..a2e1873ac3 --- /dev/null +++ b/Task/Zeckendorf-number-representation/Elixir/zeckendorf-number-representation-2.elixir @@ -0,0 +1,14 @@ +defmodule Zeckendorf do + def number(n) do + fib_loop(n, [2,1]) + |> Enum.reduce({"",n}, fn f,{dig,i} -> + if f <= i, do: {dig<>"1", i-f}, else: {dig<>"0", i} + end) + |> elem(0) |> String.to_integer + end + + defp fib_loop(n, fib) when n < hd(fib), do: fib + defp fib_loop(n, [a,b|_]=fib), do: fib_loop(n, [a+b | fib]) +end + +for i <- 0..20, do: IO.puts "#{i}: #{Zeckendorf.number(i)}" diff --git a/Task/Zeckendorf-number-representation/JavaScript/zeckendorf-number-representation.js b/Task/Zeckendorf-number-representation/JavaScript/zeckendorf-number-representation.js new file mode 100644 index 0000000000..6a5768e08f --- /dev/null +++ b/Task/Zeckendorf-number-representation/JavaScript/zeckendorf-number-representation.js @@ -0,0 +1,61 @@ +(() => { + 'use strict'; + + // zeckendorf :: Int -> String + function zeckendorf(n) { + let f = (n, x) => (n < x ? [n, 0] : [n - x, 1]); + + return (n === 0 ? ( + [0] + ) : mapAccumL(f, n, reverse(tail(fibUntil(n))))[1]) + .join(''); + } + + + // fibUntil :: Int -> [Int] + let fibUntil = n => { + let xs = []; + until( + ([a, b]) => a > n, + ([a, b]) => (xs.push(a), [b, a + b]), [1, 1] + ) + return xs; + } + + // GENERIC FUNCTIONS + + // mapAccumL :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y]) + let mapAccumL = (f, acc, xs) => { + return xs.reduce((a, x) => { + let pair = f(a[0], x); + + return [pair[0], a[1].concat(pair[1])]; + }, [acc, []]); + } + + // until :: (a -> Bool) -> (a -> a) -> a -> a + let until = (p, f, x) => { + let v = x; + while (!p(v)) v = f(v); + return v; + } + + // tail :: [a] -> [a] + let tail = xs => xs.length ? xs.slice(1) : undefined; + + // reverse :: [a] -> [a] + let reverse = xs => xs.slice(0) + .reverse(); + + // range :: Int -> Int -> [Int] + let range = (m, n) => + Array.from({ + length: Math.floor(n - m) + 1 + }, (_, i) => m + i); + + // TEST + return range(0, 20) + .map(zeckendorf) + .join('\n') + +})(); diff --git a/Task/Zeckendorf-number-representation/Logo/zeckendorf-number-representation.logo b/Task/Zeckendorf-number-representation/Logo/zeckendorf-number-representation.logo new file mode 100644 index 0000000000..93aa1faaaf --- /dev/null +++ b/Task/Zeckendorf-number-representation/Logo/zeckendorf-number-representation.logo @@ -0,0 +1,51 @@ +; return the (N+1)th Fibonacci number (1,2,3,5,8,13,...) +to fib m + local "n + make "n sum :m 1 + if [lessequal? :n 0] [output difference fib sum :n 2 fib sum :n 1] + global "_fib + if [not name? "_fib] [ + make "_fib [1 1] + ] + local "length + make "length count :_fib + while [greater? :n :length] [ + make "_fib (lput (sum (last :_fib) (last (butlast :_fib))) :_fib) + make "length sum :length 1 + ] + output item :n :_fib +end + +; return the binary Zeckendorf representation of a nonnegative number +to zeckendorf n + if [less? :n 0] [(throw "error [Number must be nonnegative.])] + (local "i "f "result) + make "i :n + make "f fib :i + while [less? :f :n] [make "i sum :i 1 make "f fib :i] + + make "result "|| + while [greater? :i 0] [ + ifelse [greaterequal? :n :f] [ + make "result lput 1 :result + make "n difference :n :f + ] [ + if [not empty? :result] [ + make "result lput 0 :result + ] + ] + make "i difference :i 1 + make "f fib :i + ] + if [equal? :result "||] [ + make "result 0 + ] + output :result +end + +type zeckendorf 0 +repeat 20 [ + type word "| | zeckendorf repcount +] +print [] +bye diff --git a/Task/Zeckendorf-number-representation/Lua/zeckendorf-number-representation.lua b/Task/Zeckendorf-number-representation/Lua/zeckendorf-number-representation.lua new file mode 100644 index 0000000000..eeaeb44bfc --- /dev/null +++ b/Task/Zeckendorf-number-representation/Lua/zeckendorf-number-representation.lua @@ -0,0 +1,33 @@ +-- Return the distinct Fibonacci numbers not greater than 'n' +function fibsUpTo (n) + local fibList, last, current, nxt = {}, 1, 1 + while current <= n do + table.insert(fibList, current) + nxt = last + current + last = current + current = nxt + end + return fibList +end + +-- Return the Zeckendorf representation of 'n' +function zeckendorf (n) + local fib, zeck = fibsUpTo(n), "" + for pos = #fib, 1, -1 do + if n >= fib[pos] then + zeck = zeck .. "1" + n = n - fib[pos] + else + zeck = zeck .. "0" + end + end + if zeck == "" then return "0" end + return zeck +end + +-- Main procedure +print(" n\t| Zeckendorf(n)") +print(string.rep("-", 23)) +for n = 0, 20 do + print(" " .. n, "| " .. zeckendorf(n)) +end diff --git a/Task/Zeckendorf-number-representation/Perl-6/zeckendorf-number-representation.pl6 b/Task/Zeckendorf-number-representation/Perl-6/zeckendorf-number-representation.pl6 index 1c6f4b78f1..cbd5b7b720 100644 --- a/Task/Zeckendorf-number-representation/Perl-6/zeckendorf-number-representation.pl6 +++ b/Task/Zeckendorf-number-representation/Perl-6/zeckendorf-number-representation.pl6 @@ -2,7 +2,7 @@ printf "%2d: %8s\n", $_, zeckendorf($_) for 0 .. 20; multi zeckendorf(0) { '0' } multi zeckendorf($n is copy) { - constant FIBS = 1,2, *+* ... *; + constant FIBS = (1,2, *+* ... *).cache; [~] map { $n -= $_ if my $digit = $n >= $_; +$digit; diff --git a/Task/Zeckendorf-number-representation/PowerShell/zeckendorf-number-representation-1.psh b/Task/Zeckendorf-number-representation/PowerShell/zeckendorf-number-representation-1.psh new file mode 100644 index 0000000000..b9b4ac7f9d --- /dev/null +++ b/Task/Zeckendorf-number-representation/PowerShell/zeckendorf-number-representation-1.psh @@ -0,0 +1,26 @@ +function Get-ZeckendorfNumber ( $N ) + { + # Calculate relevant portation of Fibonacci series + $Fib = @( 1, 1 ) + While ( $Fib[-1] -lt $N ) { $Fib += $Fib[-1] + $Fib[-2] } + + # Start with 0 + $ZeckendorfNumber = 0 + + # For each number in the relevant portion of Fibonacci series + For ( $i = $Fib.Count - 1; $i -gt 0; $i-- ) + { + # If Fibonacci number is less than or equal to remainder of N + If ( $Fib[$i] -le $N ) + { + # Double Z number and add 1 (equivalent to adding a '1' to the end of a binary number) + $ZeckendorfNumber = $ZeckendorfNumber * 2 + 1 + # Reduce N by Fibonacci number, skip next Fibonacci number + $N -= $Fib[$i--] + } + # If were aren't finished yet, double Z number + # (equivalent to adding a '0' to the end of a binary number) + If ( $i ) { $ZeckendorfNumber *= 2 } + } + return $ZeckendorfNumber + } diff --git a/Task/Zeckendorf-number-representation/PowerShell/zeckendorf-number-representation-2.psh b/Task/Zeckendorf-number-representation/PowerShell/zeckendorf-number-representation-2.psh new file mode 100644 index 0000000000..b725aa0b0b --- /dev/null +++ b/Task/Zeckendorf-number-representation/PowerShell/zeckendorf-number-representation-2.psh @@ -0,0 +1,2 @@ +# Get Zeckendorf numbers through 20, convert to binary for display +0..20 | ForEach { [convert]::ToString( ( Get-ZeckendorfNumber $_ ), 2 ) } diff --git a/Task/Zeckendorf-number-representation/REXX/zeckendorf-number-representation-2.rexx b/Task/Zeckendorf-number-representation/REXX/zeckendorf-number-representation-2.rexx index d147bb60a0..ee78bc4376 100644 --- a/Task/Zeckendorf-number-representation/REXX/zeckendorf-number-representation-2.rexx +++ b/Task/Zeckendorf-number-representation/REXX/zeckendorf-number-representation-2.rexx @@ -1,18 +1,19 @@ -/*REXX program calculates and displays the first N Zeckendorf numbers. */ -numeric digits 100000 /*just in case user gets real ka─razy. */ -parse arg N .; if N=='' then n=20 /*let user specify the upper limit. */ -#=1 2; do until w>N /*build a list of Fibonacci numbers. */ - w=words(#) /*number of words in list of Fibonacci#*/ - #=# (word(#,w-1) +word(#,w)) /*add the last two Fibonacci numbers. */ - end /*until*/ /* [↑] #: contains a Fibonacci list.*/ +/*REXX program calculates and displays the first N Zeckendorf numbers. */ +numeric digits 100000 /*just in case user gets real ka─razy. */ +parse arg N . /*let the user specify the upper limit.*/ +if N=='' | N=="," then n=20; w=length(N) /*Not specified? Then use the default.*/ +@.1=1 /*start the array with 1 and 2. */ +@.2=2; do #=3 until #>=N; p=#-1; pp=#-2 /*build a list of Fibonacci numbers. */ + @.#=@.p + @.pp /*sum the last two Fibonacci numbers. */ + end /*#*/ /* [↑] #: contains a Fibonacci list.*/ - do j=0 to N; parse var j x z /*task: process zero ──► N numbers.*/ - do k=w by -1 for w; _=word(#,k) /*process all the Fibonacci numbers. */ - if x>=_ then do; z=z'1' /*is X>the next Fibonacci #? Append 1.*/ - x=x-_ /*subtract this Fibonacci # from index.*/ + do j=0 to N; parse var j x z /*task: process zero ──► N numbers.*/ + do k=# by -1 for #; _=@.k /*process all the Fibonacci numbers. */ + if x>=_ then do; z=z'1' /*is X>the next Fibonacci #? Append 1.*/ + x=x-_ /*subtract this Fibonacci # from index.*/ end - else z=z'0' /* append zero (0) to the Fibonacci #.*/ + else z=z'0' /*append zero (0) to the Fibonacci #. */ end /*k*/ - say ' Zeckendorf' right(j,length(N)) '= ' right(z+0,30) /*show #.*/ + say ' Zeckendorf' right(j,w) "=" right(z+0,30) /*display a number.*/ end /*j*/ - /*stick a fork in it, we're all done. */ + /*stick a fork in it, we're all done. */ diff --git a/Task/Zeckendorf-number-representation/REXX/zeckendorf-number-representation-3.rexx b/Task/Zeckendorf-number-representation/REXX/zeckendorf-number-representation-3.rexx index 2b5b7e2aa6..a7de686a3e 100644 --- a/Task/Zeckendorf-number-representation/REXX/zeckendorf-number-representation-3.rexx +++ b/Task/Zeckendorf-number-representation/REXX/zeckendorf-number-representation-3.rexx @@ -1,10 +1,11 @@ -/*REXX program calculates and displays the first N Zeckendorf numbers. */ -numeric digits 100000 /*just in case user gets real ka─razy. */ -parse arg N .; if N=='' then n=20 /*let user specify the upper limit. */ -z=0 /*the index of a Zeckendorf number. */ - do j=0 until z>N; _=x2b(d2x(j)) /*task: process zero ──► N. */ - if pos(11,_)\==0 then iterate /*are there two consecutive ones (1s) ?*/ - say ' Zeckendorf' right(z,length(N)) '= ' right(_+0,30) /*show #*/ - z=z+1 /*bump the Zeckendorf number counter.*/ - end /*j*/ /* [↑] compute/display Zeckendorf #s. */ - /*stick a fork in it, we're all done. */ +/*REXX program calculates and displays the first N Zeckendorf numbers. */ +numeric digits 100000 /*just in case user gets real ka─razy. */ +parse arg N . /*let the user specify the upper limit.*/ +if N=='' | N=="," then n=20; w=length(N) /*Not specified? Then use the default.*/ +z=0 /*the index of a Zeckendorf number. */ + do j=0 until z>N; _=x2b( d2x(j) ) /*task: process zero ──► N. */ + if pos(11,_)\==0 then iterate /*are there two consecutive ones (1s) ?*/ + say ' Zeckendorf' right(z,w) "=" right(_+0,30) /*display a number.*/ + z=z+1 /*bump the Zeckendorf number counter.*/ + end /*j*/ /* [↑] compute/display Zeckendorf #s. */ + /*stick a fork in it, we're all done. */ diff --git a/Task/Zero-to-the-zero-power/00DESCRIPTION b/Task/Zero-to-the-zero-power/00DESCRIPTION index 08ba21cbfe..56cc25c918 100644 --- a/Task/Zero-to-the-zero-power/00DESCRIPTION +++ b/Task/Zero-to-the-zero-power/00DESCRIPTION @@ -1,21 +1,25 @@ -Some programming languages are not exactly consistent (with other programming languages) when raising zero to the zeroth power:     00

    +Some programming languages are not exactly consistent   (with other programming languages)   when   ''raising zero to the zeroth power'':     00

    -;Task requirements -Show the results of raising zero to the zeroth power. -If your computer language objects to 0**0 at compile time, -you may also try something like: -x = 0 -y = 0 -z = x**y +;Task: +Show the results of raising   zero   to the   zeroth   power. + + +If your computer language objects to     '''0**0'''     or     '''0^0'''     at compile time,   you may also try something like: + x = 0 + y = 0 + z = x**y + say 'z=' z + -say 'z=' z '''Show the result here.'''
    And of course use any symbols or notation that is supported in your computer language for exponentiation. + ;See also: * The Wiki entry: [[wp:Exponentiation#Zero_to_the_power_of_zero|Zero to the power of zero]]. * The Wiki entry: [[wp:Exponentiation#History_of_differing_points_of_view|History of differing points of view]]. * The MathWorld™ entry: [http://mathworld.wolfram.com/ExponentLaws.html exponent laws]. ** Also, in the above MathWorld™ entry, see formula ('''9'''): x^0=1. * The OEIS entry: [https://oeis.org/wiki/The_special_case_of_zero_to_the_zeroth_power The special case of zero to the zeroth power] +

    diff --git a/Task/Zero-to-the-zero-power/00META.yaml b/Task/Zero-to-the-zero-power/00META.yaml new file mode 100644 index 0000000000..df58a6932c --- /dev/null +++ b/Task/Zero-to-the-zero-power/00META.yaml @@ -0,0 +1,3 @@ +--- +category: +- Simple diff --git a/Task/Zero-to-the-zero-power/APL/zero-to-the-zero-power.apl b/Task/Zero-to-the-zero-power/APL/zero-to-the-zero-power.apl new file mode 100644 index 0000000000..cda96590e9 --- /dev/null +++ b/Task/Zero-to-the-zero-power/APL/zero-to-the-zero-power.apl @@ -0,0 +1,2 @@ + 0*0 +1 diff --git a/Task/Zero-to-the-zero-power/COBOL/zero-to-the-zero-power.cobol b/Task/Zero-to-the-zero-power/COBOL/zero-to-the-zero-power.cobol new file mode 100644 index 0000000000..d77cf6a216 --- /dev/null +++ b/Task/Zero-to-the-zero-power/COBOL/zero-to-the-zero-power.cobol @@ -0,0 +1,9 @@ +identification division. +program-id. zero-power-zero-program. +data division. +working-storage section. +77 n pic 9. +procedure division. + compute n = 0**0. + display n upon console. + stop run. diff --git a/Task/Zero-to-the-zero-power/Forth/zero-to-the-zero-power.fth b/Task/Zero-to-the-zero-power/Forth/zero-to-the-zero-power-1.fth similarity index 100% rename from Task/Zero-to-the-zero-power/Forth/zero-to-the-zero-power.fth rename to Task/Zero-to-the-zero-power/Forth/zero-to-the-zero-power-1.fth diff --git a/Task/Zero-to-the-zero-power/Forth/zero-to-the-zero-power-2.fth b/Task/Zero-to-the-zero-power/Forth/zero-to-the-zero-power-2.fth new file mode 100644 index 0000000000..2b0ef3d86f --- /dev/null +++ b/Task/Zero-to-the-zero-power/Forth/zero-to-the-zero-power-2.fth @@ -0,0 +1 @@ +: ^0 DROP 1 ; diff --git a/Task/Zero-to-the-zero-power/NewLISP/zero-to-the-zero-power.newlisp b/Task/Zero-to-the-zero-power/NewLISP/zero-to-the-zero-power.newlisp new file mode 100644 index 0000000000..11935eac95 --- /dev/null +++ b/Task/Zero-to-the-zero-power/NewLISP/zero-to-the-zero-power.newlisp @@ -0,0 +1 @@ +(pow 0 0) diff --git a/Task/Zero-to-the-zero-power/PHP/zero-to-the-zero-power.php b/Task/Zero-to-the-zero-power/PHP/zero-to-the-zero-power.php index 6745a4383b..5c258bd00b 100644 --- a/Task/Zero-to-the-zero-power/PHP/zero-to-the-zero-power.php +++ b/Task/Zero-to-the-zero-power/PHP/zero-to-the-zero-power.php @@ -1,2 +1,4 @@ diff --git a/Task/Zero-to-the-zero-power/Perl-6/zero-to-the-zero-power.pl6 b/Task/Zero-to-the-zero-power/Perl-6/zero-to-the-zero-power.pl6 index ebf52a6838..18709076c4 100644 --- a/Task/Zero-to-the-zero-power/Perl-6/zero-to-the-zero-power.pl6 +++ b/Task/Zero-to-the-zero-power/Perl-6/zero-to-the-zero-power.pl6 @@ -1 +1,6 @@ -say '0 ** 0 (zero to the zeroth power) ───► ', 0**0 +say ' type n n**n exp(n,n)'; +say '-------- -------- -------- --------'; + +for 0, 0.0, FatRat.new(0), 0e0, 0+0i { + printf "%8s %8s %8s %8s\n", .^name, $_, $_**$_, exp($_,$_); +} diff --git a/Task/Zero-to-the-zero-power/PureBasic/zero-to-the-zero-power.purebasic b/Task/Zero-to-the-zero-power/PureBasic/zero-to-the-zero-power.purebasic new file mode 100644 index 0000000000..9fe3b4156f --- /dev/null +++ b/Task/Zero-to-the-zero-power/PureBasic/zero-to-the-zero-power.purebasic @@ -0,0 +1,7 @@ +If OpenConsole() + PrintN("Zero to the zero power is " + Pow(0,0)) + PrintN("") + PrintN("Press any key to close the console") + Repeat: Delay(10) : Until Inkey() <> "" + CloseConsole() +EndIf diff --git a/Task/Zero-to-the-zero-power/R/zero-to-the-zero-power.r b/Task/Zero-to-the-zero-power/R/zero-to-the-zero-power.r new file mode 100644 index 0000000000..8b74d2a2b2 --- /dev/null +++ b/Task/Zero-to-the-zero-power/R/zero-to-the-zero-power.r @@ -0,0 +1 @@ +print(0^0) diff --git a/Task/Zero-to-the-zero-power/S-lang/zero-to-the-zero-power.slang b/Task/Zero-to-the-zero-power/S-lang/zero-to-the-zero-power.slang new file mode 100644 index 0000000000..ed703abb32 --- /dev/null +++ b/Task/Zero-to-the-zero-power/S-lang/zero-to-the-zero-power.slang @@ -0,0 +1 @@ +print(0^0); diff --git a/Task/Zhang-Suen-thinning-algorithm/00DESCRIPTION b/Task/Zhang-Suen-thinning-algorithm/00DESCRIPTION index fc397bf596..1803e4eae9 100644 --- a/Task/Zhang-Suen-thinning-algorithm/00DESCRIPTION +++ b/Task/Zhang-Suen-thinning-algorithm/00DESCRIPTION @@ -92,3 +92,4 @@ If any pixels were set in this round of either step 1 or step 2 then all steps a ;Reference: * [http://nayefreza.wordpress.com/2013/05/11/zhang-suen-thinning-algorithm-java-implementation/ Zhang-Suen Thinning Algorithm, Java Implementation] by Nayef Reza. * "Character Recognition Systems: A Guide for Students and Practitioners" By Mohamed Cheriet, Nawwaf Kharma, Cheng-Lin Liu, Ching Suen +

    diff --git a/Task/Zhang-Suen-thinning-algorithm/Elixir/zhang-suen-thinning-algorithm.elixir b/Task/Zhang-Suen-thinning-algorithm/Elixir/zhang-suen-thinning-algorithm.elixir new file mode 100644 index 0000000000..b6b5285bbe --- /dev/null +++ b/Task/Zhang-Suen-thinning-algorithm/Elixir/zhang-suen-thinning-algorithm.elixir @@ -0,0 +1,90 @@ +defmodule ZhangSuen do + @neighbours [{-1,0},{-1,1},{0,1},{1,1},{1,0},{1,-1},{0,-1},{-1,-1}] # 8 neighbours + + def thinning(str, black \\ ?#) do + s0 = for {line, i} <- (String.split(str, "\n") |> Enum.with_index), + {c, j} <- (to_char_list(line) |> Enum.with_index), + into: Map.new, + do: {{i,j}, (if c==black, do: 1, else: 0)} + {xrange, yrange} = range(s0) + print(s0, xrange, yrange) + s1 = thinning_loop(s0, xrange, yrange) + print(s1, xrange, yrange) + end + + defp thinning_loop(s0, xrange, yrange) do + s1 = step(s0, xrange, yrange, 1) # Step 1 + s2 = step(s1, xrange, yrange, 0) # Step 2 + if Map.equal?(s0, s2), do: s2, else: thinning_loop(s2, xrange, yrange) + end + + defp step(s, xrange, yrange, g) do + for x <- xrange, y <- yrange, into: Map.new, do: {{x,y}, s[{x,y}] - zs(s,x,y,g)} + end + + defp zs(s, x, y, g) do + if get(s,x,y) == 0 or # P1 + (get(s,x-1,y) + get(s,x,y+1) + get(s,x+g,y-1+g)) == 3 or # P2, P4, P6/P8 + (get(s,x-1+g,y+g) + get(s,x+1,y) + get(s,x,y-1)) == 3 do # P4/P2, P6, P8 + 0 + else + next = for {i,j} <- @neighbours, do: get(s, x+i, y+j) + bp1 = Enum.sum(next) # B(P1) + if bp1 in 2..6 do + ap1 = (next++[hd(next)]) |> Enum.chunk(2,1) |> Enum.count(fn [a,b] -> a " ", 1 => "#"} + defp print(map, xrange, yrange) do + Enum.each(xrange, fn x -> + IO.puts (for y <- yrange, do: @display[map[{x,y}]]) + end) + end +end + +str = """ +........................................................... +.#################...................#############......... +.##################...............################......... +.###################............##################......... +.########.....#######..........###################......... +...######.....#######.........#######.......######......... +...######.....#######........#######....................... +...#################.........#######....................... +...###############...........#######....................... +...#################.........#######....................... +...######....########........#######....................... +...######.....#######........#######....................... +...######.....#######.........#######.......######......... +.########.....#######..........###################......... +.########.....#######..#####....##################.######.. +.########.....#######..#####......################.######.. +.########.....#######..#####.........#############.######.. +........................................................... +""" +ZhangSuen.thinning(str) + +str = """ +00000000000000000000000000000000 +01111111110000000111111110000000 +01110001111000001111001111000000 +01110000111000001110000111000000 +01110001111000001110000000000000 +01111111110000001110000000000000 +01110111100000001110000111000000 +01110011110011101111001111011100 +01110001111011100111111110011100 +00000000000000000000000000000000 +""" +ZhangSuen.thinning(str, ?1) diff --git a/Task/Zhang-Suen-thinning-algorithm/Java/zhang-suen-thinning-algorithm.java b/Task/Zhang-Suen-thinning-algorithm/Java/zhang-suen-thinning-algorithm.java index 22f7c9dfa8..317b6c3d08 100644 --- a/Task/Zhang-Suen-thinning-algorithm/Java/zhang-suen-thinning-algorithm.java +++ b/Task/Zhang-Suen-thinning-algorithm/Java/zhang-suen-thinning-algorithm.java @@ -73,7 +73,7 @@ public class ZhangSuen { grid[p.y][p.x] = ' '; toWhite.clear(); - } while (hasChanged || firstStep); + } while (firstStep || hasChanged); printResult(); } diff --git a/Task/Zhang-Suen-thinning-algorithm/REXX/zhang-suen-thinning-algorithm.rexx b/Task/Zhang-Suen-thinning-algorithm/REXX/zhang-suen-thinning-algorithm.rexx index 0d650ce548..34b1d88a0f 100644 --- a/Task/Zhang-Suen-thinning-algorithm/REXX/zhang-suen-thinning-algorithm.rexx +++ b/Task/Zhang-Suen-thinning-algorithm/REXX/zhang-suen-thinning-algorithm.rexx @@ -1,41 +1,41 @@ -/*REXX pgm thins a NxM char grid using the Zhang-Suen thinning algorithm*/ +/*REXX program thins a NxM character grid using the Zhang-Suen thinning algorithm.*/ parse arg iFID .; if iFID=='' then iFID='ZHANG_SUEN.DAT' -white=' '; @.=white /* [↓] read the input char grid. */ +white=' '; @.=white /* [↓] read the input character grid. */ do row=1 while lines(iFID)\==0; _=linein(iFID) _=translate(_,,.0); cols.row=length(_) do col=1 for cols.row; @.row.col=substr(_,col,1) - end /*col*/ /* [↑] assign whole row of chars*/ + end /*col*/ /* [↑] assign whole row of characters.*/ end /*row*/ -rows=row-1 /* adjust ROWS because of DO loop*/ -call show@ 'input file ' iFID " contents:" /*show the input char grid.*/ +rows=row-1 /*adjust ROWS because of the DO loop. */ +call show@ 'input file ' iFID " contents:" /*display show the input character grid*/ - do until changed==0; changed=0 /*keep slimming until we're done.*/ - do step=1 for 2 /*keep track of step 1 │ step 2.*/ - do r=1 for rows /*process all rows and columns. */ - do c=1 for cols.r; !.r.c=@.r.c /*assign alternate grid.*/ - if r==1|r==rows|c==1|c==cols.r then iterate /*is an edge?*/ - if @.r.c==white then iterate /*White? Then skip it.*/ - call Ps; b=b() /*define Ps and "b". */ - if b<2 | b>6 then iterate /*is B within range?*/ - if a()\==1 then iterate /*count the transitions.*/ /* ╔══╦══╦══╗ */ - if step==1 then if (p2 & p4 & p6) | p4 & p6 & p8 then iterate /* ║p9║p2║p3║ */ - if step==2 then if (p2 & p4 & p8) | p2 & p6 & p8 then iterate /* ╠══╬══╬══╣ */ - !.r.c=white /*set a grid character to white.*/ /* ║p8║p1║p4║ */ - changed=1 /*indicate a char was changed. */ /* ╠══╬══╬══╣ */ - end /*c*/ /* ║p7║p6║p5║ */ - end /*r*/ /* ╚══╩══╩══╝ */ - call copy!2@ /*copy alternate to working grid.*/ + do until changed==0; changed=0 /*keep slimming until we're finished. */ + do step=1 for 2 /*keep track of step one or step two.*/ + do r=1 for rows /*process all the rows and columns. */ + do c=1 for cols.r; !.r.c=@.r.c /*assign an alternate grid. */ + if r==1|r==rows|c==1|c==cols.r then iterate /*is this an edge?*/ + if @.r.c==white then iterate /*Is the character white? Then skip it*/ + call Ps; b=b() /*define Ps and also "b". */ + if b<2 | b>6 then iterate /*is B within the range ? */ + if a()\==1 then iterate /*count the number of transitions. */ /* ╔══╦══╦══╗ */ + if step==1 then if (p2 & p4 & p6) | p4 & p6 & p8 then iterate /* ║p9║p2║p3║ */ + if step==2 then if (p2 & p4 & p8) | p2 & p6 & p8 then iterate /* ╠══╬══╬══╣ */ + !.r.c=white /*set a grid character to white. */ /* ║p8║p1║p4║ */ + changed=1 /*indicate a character was changed. */ /* ╠══╬══╬══╣ */ + end /*c*/ /* ║p7║p6║p5║ */ + end /*r*/ /* ╚══╩══╩══╝ */ + call copy! /*copy the alternate to working grid. */ end /*step*/ end /*until changed==0*/ -call show@ 'slimmed output:' /*display the slimmed char grid. */ -exit /*stick a fork in it, we're done.*/ -/*──────────────────────────────────subroutines─────────────────────────*/ +call show@ 'slimmed output:' /*display the slimmed character grid. */ +exit /*stick a fork in it, we're all done. */ +/*─────────────────────────────────────────────────────────────────────────────────────────────────────────────*/ a: return (\p2==p3&p3)+(\p3==p4&p4)+(\p4==p5&p5)+(\p5==p6&p6)+(\p6==p7&p7)+(\p7==p8&p8)+(\p8==p9&p9)+(\p9==p2&p2) b: return p2 + p3 + p4 + p5 + p6 + p7 + p8 + p9 -copy!2@: do r=1 for rows; do c=1 for cols.r; @.r.c=!.r.c; end;end; return -show@: say; say arg(1); say; do r=1 for rows; _=; do c=1 for cols.r; _=_||@.r.c; end; say _; end; return - -Ps: rm=r-1; rp=r+1; cm=c-1; cp=c+1 /*calculate shortcuts.*/ +copy!: do r=1 for rows; do c=1 for cols.r; @.r.c=!.r.c; end; end; return +show@: say; say arg(1); say; do r=1 for rows; _=; do c=1 for cols.r; _=_ || @.r.c; end; say _; end; return +/*──────────────────────────────────────────────────────────────────────────────────────*/ +Ps: rm=r-1; rp=r+1; cm=c-1; cp=c+1 /*calculate some shortcuts.*/ p2=@.rm.c\==white; p3=@.rm.cp\==white; p4=@.r.cp\==white; p5=@.rp.cp\==white p6=@.rp.c\==white; p7=@.rp.cm\==white; p8=@.r.cm\==white; p9=@.rm.cm\==white; return diff --git a/Task/Zig-zag-matrix/00DESCRIPTION b/Task/Zig-zag-matrix/00DESCRIPTION index 699dbce533..3fc90ce711 100644 --- a/Task/Zig-zag-matrix/00DESCRIPTION +++ b/Task/Zig-zag-matrix/00DESCRIPTION @@ -1,9 +1,14 @@ +;Task: Produce a zig-zag array. -A zig-zag array is a square arrangement of the first N2 integers, where the numbers increase sequentially as you zig-zag along the anti-diagonals of the array.
    -For a graphical representation, see [[wp:Image:JPEG_ZigZag.svg|JPG zigzag]] -(JPG uses such arrays to encode images). -For example, given 5, produce this array: + +A   ''zig-zag''   array is a square arrangement of the first   N2   integers,   where the +
    numbers increase sequentially as you zig-zag along the array's   [https://en.wiktionary.org/wiki/antidiagonal anti-diagonals]. + +For a graphical representation, see   [[wp:Image:JPEG_ZigZag.svg|JPG zigzag]]   (JPG uses such arrays to encode images). + + +For example, given   '''5''',   produce this array:
      0  1  5  6 14
      2  4  7 13 15
    @@ -12,4 +17,13 @@ For example, given 5, produce this array:
     10 18 19 23 24
     
    -;See also [[Spiral matrix]] + +;Related tasks: +*   [[Spiral matrix]] +*   [[Identity_matrix]] +*   [[Ulam_spiral_(for_primes)]] + + +;See also: +*   Wiktionary entry:   [https://en.wiktionary.org/wiki/antidiagonal anti-diagonals] +

    diff --git a/Task/Zig-zag-matrix/ALGOL-W/zig-zag-matrix.alg b/Task/Zig-zag-matrix/ALGOL-W/zig-zag-matrix.alg new file mode 100644 index 0000000000..d60c83f516 --- /dev/null +++ b/Task/Zig-zag-matrix/ALGOL-W/zig-zag-matrix.alg @@ -0,0 +1,58 @@ +begin % zig-zag matrix % + % z is returned holding a zig-zag matrix of order n, z must be at least n x n % + procedure makeZigZag ( integer value n + ; integer array z( *, * ) + ) ; + begin + procedure move ; + begin + if y = n then begin + upRight := not upRight; + x := x + 1 + end + else if x = 1 then begin + upRight := not upRight; + y := y + 1 + end + else begin + x := x - 1; + y := y + 1 + end + end move ; + procedure swapXY ; + begin + integer swap; + swap := x; + x := y; + y := swap; + end swapXY ; + integer x, y; + logical upRight; + % initialise the n x n matrix in z % + for i := 1 until n do for j := 1 until n do z( i, j ) := 0; + % fill in the zig-zag matrix % + x := y := 1; + upRight := true; + for i := 1 until n * n do begin + z( x, y ) := i - 1; + if upRight then move + else begin + swapXY; + move; + swapXY + end; + end; + end makeZigZap ; + + begin + integer array zigZag( 1 :: 10, 1 :: 10 ); + for n := 5 do begin + makeZigZag( n, zigZag ); + for i := 1 until n do begin + write( i_w := 4, s_w := 1, zigZag( i, 1 ) ); + for j := 2 until n do writeon( i_w := 4, s_w := 1, zigZag( i, j ) ); + end + end + end + +end. diff --git a/Task/Zig-zag-matrix/ATS/zig-zag-matrix.ats b/Task/Zig-zag-matrix/ATS/zig-zag-matrix.ats new file mode 100644 index 0000000000..53fa738e02 --- /dev/null +++ b/Task/Zig-zag-matrix/ATS/zig-zag-matrix.ats @@ -0,0 +1,62 @@ +(* ****** ****** *) +// +#include +"share/atspre_define.hats" // defines some names +#include +"share/atspre_staload.hats" // for targeting C +#include +"share/HATS/atspre_staload_libats_ML.hats" // for ... +// +(* ****** ****** *) +// +extern +fun +Zig_zag_matrix(n: int): void +// +(* ****** ****** *) + +fun max(a: int, b: int): int = + if a > b then a else b + +fun movex(n: int, x: int, y: int): int = + if y < n-1 then max(0, x-1) else x+1 + +fun movey(n: int, x: int, y: int): int = + if y < n-1 then y+1 else y + +fun zigzag(n: int, i: int, row: int, x: int, y: int): void = + if i = n*n then () + else + let + val () = (if x = row then begin print i; print ','; end else ()) + //val () = (begin print x; print ' '; print y; print ' '; print i; print ' '; end) + val nextX: int = if ((x+y) % 2) = 0 then movex(n, x, y) else movey(n, y, x) + val nextY: int = if ((x+y) % 2) = 0 then movey(n, x, y) else movex(n, y, x) + in + zigzag(n, i+1, row, nextX, nextY) + end + +implement +Zig_zag_matrix(n) = + let + fun loop(row: int): void = + if row = n then () else + let + val () = zigzag(n, 0, row, 0, 0) + val () = println!(" ") + in + loop(row + 1) + end + in + loop(0) + end + +(* ****** ****** *) + +implement +main0() = () where +{ + val () = Zig_zag_matrix(5) +} (* end of [main0] *) + +(* ****** ****** *) diff --git a/Task/Zig-zag-matrix/Agena/zig-zag-matrix.agena b/Task/Zig-zag-matrix/Agena/zig-zag-matrix.agena new file mode 100644 index 0000000000..c1b5fbf84e --- /dev/null +++ b/Task/Zig-zag-matrix/Agena/zig-zag-matrix.agena @@ -0,0 +1,48 @@ +# zig-zag matrix + +makeZigZag := proc( n :: number ) :: table is + + local move := proc( x :: number, y :: number, upRight :: boolean ) is + if y = n then + upRight := not upRight; + x := x + 1 + elif x = 1 then + upRight := not upRight; + y := y + 1 + else + x := x - 1; + y := y + 1 + fi; + return x, y, upRight + end ; + + # create empty table + local result := []; + for i to n do + result[ i ] := []; + for j to n do result[ i, j ] := 0 od + od; + + # fill the table + local x, y, upRight := 1, 1, true; + for i to n * n do + result[ x, y ] := i - 1; + if upRight then + x, y, upRight := move( x, y, upRight ) + else + y, x, upRight := move( y, x, upRight ) + fi + od; + + return result +end; + +scope + local m := makeZigZag( 5 ); + for i to size m do + for j to size m do + printf( " %3d", m[ i, j ] ) + od; + print() + od +epocs diff --git a/Task/Zig-zag-matrix/AppleScript/zig-zag-matrix-3.applescript b/Task/Zig-zag-matrix/AppleScript/zig-zag-matrix-3.applescript index 1c22824cc4..cdfcf95fbb 100644 --- a/Task/Zig-zag-matrix/AppleScript/zig-zag-matrix-3.applescript +++ b/Task/Zig-zag-matrix/AppleScript/zig-zag-matrix-3.applescript @@ -1,7 +1,159 @@ -" - 0 1 5 6 14 - 2 4 7 13 15 - 3 8 12 16 21 - 9 11 17 20 22 - 10 18 19 23 24 -" +-- zigzagMatrix +on zigzagMatrix(n) + + -- diagonals :: n -> [[n]] + script diagonals + on lambda(n) + script mf + on diags(xs, iCol, iRow) + if (iCol < length of xs) then + if iRow < n then + set iNext to iCol + 1 + else + set iNext to iCol - 1 + end if + + set {headList, tail} to splitAt(iCol, xs) + {headList} & diags(tail, iNext, iRow + 1) + else + {xs} + end if + end diags + end script + + diags(range(0, n * n - 1), 1, 1) of mf + end lambda + end script + + -- oddReversed :: [a] -> Int -> [a] + script oddReversed + on lambda(lst, i) + if i mod 2 = 0 then + lst + else + reverse of lst + end if + end lambda + end script + + rowsFromDiagonals(n, map(oddReversed, lambda(n) of diagonals)) + +end zigzagMatrix + + +-- TEST +on run + + zigzagMatrix(5) + +end run + + + +-- Rows of given length from list of diagonals +-- rowsFromDiagonals :: Int -> [[a]] -> [[a]] +on rowsFromDiagonals(n, lst) + if length of lst > 0 then + + -- lengthOverOne :: [a] -> Bool + script lengthOverOne + on lambda(lst) + length of lst > 1 + end lambda + end script + + set {edge, residue} to splitAt(n, lst) + + {map(my head, edge)} & ¬ + rowsFromDiagonals(n, ¬ + map(my tail, ¬ + filter(lengthOverOne, edge)) & residue) + else + [] + end if +end rowsFromDiagonals + + +--------------------------------------------------------------------------- + +-- GENERIC FUNCTIONS + +-- 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 + +-- 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 + +-- splitAt:: n -> list -> {n items from start of list, rest of list} +-- splitAt :: Int -> [a] -> ([a], [a]) +on splitAt(n, xs) + if n > 0 and n < length of xs then + {items 1 thru n of xs, items (n + 1) thru -1 of xs} + else + if n < 1 then + {{}, xs} + else + {xs, {}} + end if + end if +end splitAt + +-- head :: [a] -> a +on head(xs) + if length of xs > 0 then + item 1 of xs + else + missing value + end if +end head + +-- tail :: [a] -> [a] +on tail(xs) + if length of xs > 1 then + items 2 thru -1 of xs + else + {} + end if +end tail + +-- range :: Int -> Int -> [Int] +on range(m, n) + set d to 1 + if n < m then set d to -1 + set lst to {} + repeat with i from m to n by d + set end of lst to i + end repeat + return lst +end range + +-- 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 diff --git a/Task/Zig-zag-matrix/Elixir/zig-zag-matrix.elixir b/Task/Zig-zag-matrix/Elixir/zig-zag-matrix.elixir index a574ce3985..8414f0bfb8 100644 --- a/Task/Zig-zag-matrix/Elixir/zig-zag-matrix.elixir +++ b/Task/Zig-zag-matrix/Elixir/zig-zag-matrix.elixir @@ -1,13 +1,14 @@ defmodule RC do require Integer def zigzag(n) do - indices = for x <- 1..n, y <- 1..n, do: {x,y} - sorted = Enum.sort_by(indices, fn{x,y}->{x+y, if(Integer.is_even(x+y), do: y, else: x)} end) - sorted2 = Enum.sort(Enum.with_index(sorted)) - Enum.each(sorted2, fn {{_x,y},i} -> - IO.write "#{i} " - if y==n, do: IO.puts "" - end) + fmt = "~#{to_char_list(n*n-1) |> length}w " + (for x <- 1..n, y <- 1..n, do: {x,y}) + |> Enum.sort_by(fn{x,y}->{x+y, if(Integer.is_even(x+y), do: y, else: x)} end) + |> Enum.with_index |> Enum.sort + |> Enum.each(fn {{_x,y},i} -> + :io.format fmt, [i] + if y==n, do: IO.puts "" + end) end end diff --git a/Task/Zig-zag-matrix/JavaScript/zig-zag-matrix.js b/Task/Zig-zag-matrix/JavaScript/zig-zag-matrix-1.js similarity index 100% rename from Task/Zig-zag-matrix/JavaScript/zig-zag-matrix.js rename to Task/Zig-zag-matrix/JavaScript/zig-zag-matrix-1.js diff --git a/Task/Zig-zag-matrix/JavaScript/zig-zag-matrix-2.js b/Task/Zig-zag-matrix/JavaScript/zig-zag-matrix-2.js new file mode 100644 index 0000000000..d6137ccb7a --- /dev/null +++ b/Task/Zig-zag-matrix/JavaScript/zig-zag-matrix-2.js @@ -0,0 +1,97 @@ +(function (n) { + + // Read range of values into a series of 'diagonal rows' + // for a square of given dimension, + // starting at diagonal row i. + // [ + // [0], + // [1, 2], + // [3, 4, 5], + // [6, 7, 8, 9], + // [10, 11, 12, 13, 14], + // [15, 16, 17, 18], + // [19, 20, 21], + // [22, 23], + // [24] + // ] + + // diagonals :: n -> [[n]] + function diagonals(n) { + function diags(xs, iCol, iRow) { + if (iCol < xs.length) { + var xxs = splitAt(iCol, xs); + + return [xxs[0]].concat(diags( + xxs[1], + (iCol + (iRow < n ? 1 : -1)), + iRow + 1 + )); + } else return [xs]; + } + + return diags(range(0, n * n - 1), 1, 1); + } + + + + // Recursively read off n heads from the diagonals (as rows) + // n -> [[n]] -> [[n]] + function nHeads(n, lst) { + var zipEdge = lst.slice(0, n); + + return lst.length ? [zipEdge.map(function (x) { + return x[0]; + })].concat(nHeads(n, [].concat.apply([], zipEdge.map(function ( + x) { + return x.length > 1 ? [x.slice(1)] : []; + })) + .concat(lst.slice(n)))) : []; + } + + // range(intFrom, intTo, optional intStep) + // Int -> Int -> Maybe Int -> [Int] + function range(m, n, delta) { + var d = delta || 1, + blnUp = n > m, + lng = Math.floor((blnUp ? n - m : m - n) / d) + 1, + a = Array(lng), + i = lng; + + if (blnUp) + while (i--) a[i] = (d * i) + m; + else + while (i--) a[i] = m - (d * i); + return a; + } + + // splitAt :: Int -> [a] -> ([a],[a]) + function splitAt(n, xs) { + return [xs.slice(0, n), xs.slice(n)]; + } + + // Recursively take n heads from the alternately reversed diagonals + + // [ [ + // [0], -> [0, 1, 5, 6, 14] and: + // [1, 2], [2], + // [5, 4, 3], [4, 3], + // [6, 7, 8, 9], [7, 8, 9], + // [14, 13, 12, 11, 10], [13, 12, 11, 10], + // [15, 16, 17, 18], [15, 16, 17, 18], + // [21, 20, 19], [21, 20, 19], + // [22, 23], [22, 23], + // [24] [24] + // ] ] + // + // In the next recursion with the remnant on the right, the next + // 5 heads will be [2, 4, 7, 13, 15] - the second row of our zig zag matrix. + // (and so forth) + + + return nHeads(n, diagonals(n) + .map(function (x, i) { + i % 2 || x.reverse(); + return x; + })); + +})(5); diff --git a/Task/Zig-zag-matrix/JavaScript/zig-zag-matrix-3.js b/Task/Zig-zag-matrix/JavaScript/zig-zag-matrix-3.js new file mode 100644 index 0000000000..70d429068f --- /dev/null +++ b/Task/Zig-zag-matrix/JavaScript/zig-zag-matrix-3.js @@ -0,0 +1,5 @@ +[[0, 1, 5, 6, 14], + [2, 4, 7, 13, 15], + [3, 8, 12, 16, 21], + [9, 11, 17, 20, 22], + [10, 18, 19, 23, 24]] diff --git a/Task/Zig-zag-matrix/JavaScript/zig-zag-matrix-4.js b/Task/Zig-zag-matrix/JavaScript/zig-zag-matrix-4.js new file mode 100644 index 0000000000..f957c33526 --- /dev/null +++ b/Task/Zig-zag-matrix/JavaScript/zig-zag-matrix-4.js @@ -0,0 +1,60 @@ +(n => { + + // diagonals :: n -> [[n]] + function diagonals(n) { + let diags = (xs, iCol, iRow) => { + if (iCol < xs.length) { + let xxs = splitAt(iCol, xs); + + return [xxs[0]].concat(diags( + xxs[1], + iCol + (iRow < n ? 1 : -1), + iRow + 1 + )); + } else return [xs]; + } + + return diags(range(0, n * n - 1), 1, 1); + } + + + // Recursively read off n heads of diagonal lists + // rowsFromDiagonals :: n -> [[n]] -> [[n]] + function rowsFromDiagonals(n, lst) { + if (lst.length) { + let [edge, rest] = splitAt(n, lst); + + return [edge.map(x => x[0])] + .concat(rowsFromDiagonals(n, + edge.filter(x => x.length > 1) + .map(x => x.slice(1)) + .concat(rest) + )); + } else return []; + } + + // GENERIC FUNCTIONS + + // splitAt :: Int -> [a] -> ([a],[a]) + function splitAt(n, xs) { + return [xs.slice(0, n), xs.slice(n)]; + } + + // range :: From -> To -> Maybe Step -> [Int] + // range :: Int -> Int -> Maybe Int -> [Int] + function range(m, n, step) { + let d = (step || 1) * (n >= m ? 1 : -1); + + return Array.from({ + length: Math.floor((n - m) / d) + 1 + }, (_, i) => m + (i * d)); + } + + // ZIG-ZAG MATRIX + + return rowsFromDiagonals(n, + diagonals(n) + .map((x, i) => (i % 2 || x.reverse()) && x) + ); + +})(5); diff --git a/Task/Zig-zag-matrix/JavaScript/zig-zag-matrix-5.js b/Task/Zig-zag-matrix/JavaScript/zig-zag-matrix-5.js new file mode 100644 index 0000000000..70d429068f --- /dev/null +++ b/Task/Zig-zag-matrix/JavaScript/zig-zag-matrix-5.js @@ -0,0 +1,5 @@ +[[0, 1, 5, 6, 14], + [2, 4, 7, 13, 15], + [3, 8, 12, 16, 21], + [9, 11, 17, 20, 22], + [10, 18, 19, 23, 24]] diff --git a/Task/Zig-zag-matrix/Julia/zig-zag-matrix-1.julia b/Task/Zig-zag-matrix/Julia/zig-zag-matrix-1.julia index 105985f121..4ce506b0c6 100644 --- a/Task/Zig-zag-matrix/Julia/zig-zag-matrix-1.julia +++ b/Task/Zig-zag-matrix/Julia/zig-zag-matrix-1.julia @@ -1,59 +1,25 @@ -immutable ZigZag - m::Int - n::Int - diag::Array{Int,1} - cmax::Int - numd::Int - lohi::(Int,Int) -end - -function zigzag(m::Int, n::Int) - 0 zz.cmax - -function Base.next(zz::ZigZag, zzs::ZZState) - s = sub2ind((zz.m, zz.n), zzs.cell[1], zzs.cell[2]) - if zzs.dcnt == zzs.dlen - if isodd(zzs.dnum) - if zzs.cell[2] < zz.n - zzs.cell[2] += 1 +function zigzag_matrix(n::Int) + matrix = zeros(Int, n, n) + x, y = 1, 1 + for i = 0:(n*n-1) + matrix[y,x] = i + if (x + y) % 2 == 0 + # Even stripes + if x < n + x += 1 + y -= (y > 1) else - zzs.cell[1] += 1 + y += 1 end else - if zzs.cell[1] < zz.m - zzs.cell[1] += 1 + # Odd stripes + if y < n + x -= (x > 1) + y += 1 else - zzs.cell[2] += 1 + x += 1 end end - zzs.dcnt = 1 - zzs.dnum += 1 - zzs.dir = -zzs.dir - if zzs.dnum <= zz.lohi[1] - zzs.dlen += 1 - elseif zz.lohi[2] < zzs.dnum - zzs.dlen -= 1 - end - else - zzs.cell += zzs.dir*zz.diag - zzs.dcnt += 1 end - zzs.cnt += 1 - return (s, zzs) + return matrix end diff --git a/Task/Zig-zag-matrix/Julia/zig-zag-matrix-2.julia b/Task/Zig-zag-matrix/Julia/zig-zag-matrix-2.julia index de8b6dbdab..105985f121 100644 --- a/Task/Zig-zag-matrix/Julia/zig-zag-matrix-2.julia +++ b/Task/Zig-zag-matrix/Julia/zig-zag-matrix-2.julia @@ -1,24 +1,59 @@ -using Formatting - -function width{T<:Integer}(n::T) - w = ndigits(n) - n < 0 || return w - return w + 1 +immutable ZigZag + m::Int + n::Int + diag::Array{Int,1} + cmax::Int + numd::Int + lohi::(Int,Int) end -function pretty{T<:Integer}(a::Array{T,2}, indent::Int=4) - lo, hi = extrema(a) - w = max(width(lo), width(hi)) - id = " "^indent - fe = FormatExpr(@sprintf(" {:%dd}", w)) - s = id - nrow = size(a)[1] - for i in 1:nrow - for j in a[i,:] - s *= format(fe, j) +function zigzag(m::Int, n::Int) + 0 zz.cmax + +function Base.next(zz::ZigZag, zzs::ZZState) + s = sub2ind((zz.m, zz.n), zzs.cell[1], zzs.cell[2]) + if zzs.dcnt == zzs.dlen + if isodd(zzs.dnum) + if zzs.cell[2] < zz.n + zzs.cell[2] += 1 + else + zzs.cell[1] += 1 + end + else + if zzs.cell[1] < zz.m + zzs.cell[1] += 1 + else + zzs.cell[2] += 1 + end end - i != nrow || continue - s *= "\n"*id + zzs.dcnt = 1 + zzs.dnum += 1 + zzs.dir = -zzs.dir + if zzs.dnum <= zz.lohi[1] + zzs.dlen += 1 + elseif zz.lohi[2] < zzs.dnum + zzs.dlen -= 1 + end + else + zzs.cell += zzs.dir*zz.diag + zzs.dcnt += 1 end - return s + zzs.cnt += 1 + return (s, zzs) end diff --git a/Task/Zig-zag-matrix/Julia/zig-zag-matrix-3.julia b/Task/Zig-zag-matrix/Julia/zig-zag-matrix-3.julia index 9acae7501c..de8b6dbdab 100644 --- a/Task/Zig-zag-matrix/Julia/zig-zag-matrix-3.julia +++ b/Task/Zig-zag-matrix/Julia/zig-zag-matrix-3.julia @@ -1,26 +1,24 @@ -n = 5 -println("The n = ", n, " zig-zag matrix:") -a = zeros(Int, (n, n)) -for (i, s) in enumerate(zigzag(n)) - a[s] = i-1 -end -println(pretty(a)) +using Formatting -m = 3 -println() -println("Generalize to a non-square matrix (", m, "x", n, "):") -a = zeros(Int, (m, n)) -for (i, s) in enumerate(zigzag(m, n)) - a[s] = i-1 +function width{T<:Integer}(n::T) + w = ndigits(n) + n < 0 || return w + return w + 1 end -println(pretty(a)) -p = primes(10^3) -n = 7 -println() -println("An n = ", n, " prime spiral matrix:") -a = zeros(Int, (n, n)) -for (i, s) in enumerate(zigzag(n)) - a[s] = p[i] +function pretty{T<:Integer}(a::Array{T,2}, indent::Int=4) + lo, hi = extrema(a) + w = max(width(lo), width(hi)) + id = " "^indent + fe = FormatExpr(@sprintf(" {:%dd}", w)) + s = id + nrow = size(a)[1] + for i in 1:nrow + for j in a[i,:] + s *= format(fe, j) + end + i != nrow || continue + s *= "\n"*id + end + return s end -println(pretty(a)) diff --git a/Task/Zig-zag-matrix/Julia/zig-zag-matrix-4.julia b/Task/Zig-zag-matrix/Julia/zig-zag-matrix-4.julia new file mode 100644 index 0000000000..9acae7501c --- /dev/null +++ b/Task/Zig-zag-matrix/Julia/zig-zag-matrix-4.julia @@ -0,0 +1,26 @@ +n = 5 +println("The n = ", n, " zig-zag matrix:") +a = zeros(Int, (n, n)) +for (i, s) in enumerate(zigzag(n)) + a[s] = i-1 +end +println(pretty(a)) + +m = 3 +println() +println("Generalize to a non-square matrix (", m, "x", n, "):") +a = zeros(Int, (m, n)) +for (i, s) in enumerate(zigzag(m, n)) + a[s] = i-1 +end +println(pretty(a)) + +p = primes(10^3) +n = 7 +println() +println("An n = ", n, " prime spiral matrix:") +a = zeros(Int, (n, n)) +for (i, s) in enumerate(zigzag(n)) + a[s] = p[i] +end +println(pretty(a)) diff --git a/Task/Zig-zag-matrix/Pascal/zig-zag-matrix-1.pascal b/Task/Zig-zag-matrix/Pascal/zig-zag-matrix-1.pascal new file mode 100644 index 0000000000..ff0f278433 --- /dev/null +++ b/Task/Zig-zag-matrix/Pascal/zig-zag-matrix-1.pascal @@ -0,0 +1,67 @@ +Program zigzag( input, output ); + +const + size = 5; +var + zzarray: array [1..size, 1..size] of integer; + element, i, j: integer; + direction: integer; + width, n: integer; + +begin + i := 1; + j := 1; + direction := 1; + for element := 0 to (size*size) - 1 do + begin + zzarray[i,j] := element; + i := i + direction; + j := j - direction; + if (i = 0) then + begin + direction := -direction; + i := 1; + if (j > size) then + begin + j := size; + i := 2; + end; + end + else if (i > size) then + begin + direction := -direction; + i := size; + j := j + 2; + end + else if (j = 0) then + begin + direction := -direction; + j := 1; + if (i > size) then + begin + j := 2; + i := size; + end; + end + else if (j > size) then + begin + direction := -direction; + j := size; + i := i + 2; + end; + end; + + width := 2; + n := size; + while (n > 0) do + begin + width := width + 1; + n := n div 10; + end; + for j := 1 to size do + begin + for i := 1 to size do + write(zzarray[i,j]:width); + writeln; + end; +end. diff --git a/Task/Zig-zag-matrix/Pascal/zig-zag-matrix-2.pascal b/Task/Zig-zag-matrix/Pascal/zig-zag-matrix-2.pascal new file mode 100644 index 0000000000..f59378a1cb --- /dev/null +++ b/Task/Zig-zag-matrix/Pascal/zig-zag-matrix-2.pascal @@ -0,0 +1,40 @@ +Program zigzag; +{$APPTYPE CONSOLE} + +const + size = 5; + + var + s: array [1..size, 1..size] of integer; + i, j, d, max, n: integer; + +begin + i := 1; + j := 1; + d := -1; + max := 0; + n := 0; + max := size * size; + + for n := 1 to (max div 2)+1 do begin + s[i,j] := n; + s[size - i + 1,size - j + 1] := max - n + 1; + i:=i+d; + j:=j-d; + if i < 1 then begin + inc(i); + d := -d; + end else if j < 1 then begin + inc(j); + d := -d; + end; + end; + + for j := 1 to size do + begin + for i := 1 to size do + write(s[i,j]:4); + writeln; + end; + +end. diff --git a/Task/Zig-zag-matrix/Pascal/zig-zag-matrix.pascal b/Task/Zig-zag-matrix/Pascal/zig-zag-matrix.pascal deleted file mode 100644 index 9dc91cb677..0000000000 --- a/Task/Zig-zag-matrix/Pascal/zig-zag-matrix.pascal +++ /dev/null @@ -1,49 +0,0 @@ -Program zigzag; - -const - size = 5; -var - zzarray: array [1..size, 1..size] of integer; - element, i, j: integer; - direction: integer; - -begin - i := 1; - j := 1; - direction := 1; - for element := 1 to size*size do - begin - zzarray[i,j] := element; - i := i + direction; - j := j - direction; - if (i = 0) then - begin - direction := -direction; - i := i + 1; - end; - if (i = size +1) then - begin - direction := -direction; - i := i - 1; - j := j + 2; - end; - if (j = 0) then - begin - direction := -direction; - j := j + 1; - end; - if (j = size + 1) then - begin - direction := -direction; - j := j - 1; - i := i + 2; - end; - end; - - for j := 1 to size do - begin - for i := 1 to size do - write(zzarray[i,j]:3); - writeln; - end; -end. diff --git a/Task/Zig-zag-matrix/PlainTeX/zig-zag-matrix.tex b/Task/Zig-zag-matrix/PlainTeX/zig-zag-matrix.tex new file mode 100644 index 0000000000..b535e75d99 --- /dev/null +++ b/Task/Zig-zag-matrix/PlainTeX/zig-zag-matrix.tex @@ -0,0 +1,22 @@ +\long\def\antefi#1#2\fi{#2\fi#1} +\def\fornum#1=#2to#3(#4){% + \edef#1{\number\numexpr#2}\edef\fornumtemp{\noexpand\fornumi\expandafter\noexpand\csname fornum\string#1\endcsname + {\number\numexpr#3}{\ifnum\numexpr#4<0 <\else>\fi}{\number\numexpr#4}\noexpand#1}\fornumtemp +} +\long\def\fornumi#1#2#3#4#5#6{\def#1{\unless\ifnum#5#3#2\relax\antefi{#6\edef#5{\number\numexpr#5+(#4)\relax}#1}\fi}#1} +\def\elem(#1,#2){\numexpr(#1+#2)*(#1+#2-1)/2-(\ifodd\numexpr#1+#2\relax#1\else#2\fi)\relax} +\def\zzmat#1{% + \noindent% quit vertical mode + \fornum\yy=1to#1(+1){% + \fornum\xx=1to#1(+1){% + \ifnum\numexpr\xx+\yy\relax<\numexpr#1+2\relax + \hbox to 2em{\hfil\number\elem(\xx,\yy)}% + \else + \hbox to 2em{\hfil\number\numexpr#1*#1-1-\elem(#1+1-\xx,#1+1-\yy)\relax}% + \fi + }% + \par\noindent% next line + quit vertical mode + }\par +} +\zzmat{5} +\bye diff --git a/Task/Zig-zag-matrix/Python/zig-zag-matrix-5.py b/Task/Zig-zag-matrix/Python/zig-zag-matrix-5.py new file mode 100644 index 0000000000..bbed00eb2b --- /dev/null +++ b/Task/Zig-zag-matrix/Python/zig-zag-matrix-5.py @@ -0,0 +1,65 @@ +from __future__ import print_function + +import math + + +def zigzag( dimension): + ''' generate the zigzag indexes for a square array + Exploiting the fact that an array is symmetrical around its + centre + ''' + NUMBER_INDEXES = dimension ** 2 + HALFWAY = NUMBER_INDEXES // 2 + KERNEL_ODD = dimension & 1 + + xy = [0 for _ in range(NUMBER_INDEXES)] + # start at 0,0 + ix = 0 + iy = 0 + # 'fake' that we are going up and right + direction = 1 + # the first index is always 0, so start with the second + # until halfway + for i in range(1, HALFWAY + KERNEL_ODD): + if direction > 0: + # going up and right + if iy == 0: + # are at top + ix += 1 + direction = -1 + else: + ix += 1 + iy -= 1 + else: + # going down and left + if ix == 0: + # are at left + iy += 1 + direction = 1 + else: + ix -= 1 + iy += 1 + # update the index position + xy[iy * dimension + ix] = i + + # have first half, but they are scattered over the list + # so find the zeros to replace + for i in range(1, NUMBER_INDEXES): + if xy[i] == 0 : + xy[i] = NUMBER_INDEXES - 1 - xy[NUMBER_INDEXES - 1 - i] + + return xy + + +def main(dim): + zz = zigzag(dim) + print( 'zigzag of {}:'.format(dim)) + width = int(math.ceil(math.log10(dim**2))) + for j in range(dim): + for i in range(dim): + print('{:{width}}'.format(zz[j * dim + i], width=width), end=' ') + print() + + +if __name__ == '__main__': + main(5) diff --git a/Task/Zig-zag-matrix/REXX/zig-zag-matrix.rexx b/Task/Zig-zag-matrix/REXX/zig-zag-matrix.rexx index 9045e2edae..f3fdb9b51f 100644 --- a/Task/Zig-zag-matrix/REXX/zig-zag-matrix.rexx +++ b/Task/Zig-zag-matrix/REXX/zig-zag-matrix.rexx @@ -1,26 +1,23 @@ -/*REXX program produces and displays a zig─zag matrix (a square array). */ -parse arg n start inc . /*obtain optional arguments from the CL*/ -if n=='' then n=5 /*Not specified? Then use the default.*/ -if start=='' then start=0 /* " " " " " " */ -if inc=='' then inc=1 /* " " " " " " */ -row=1; col=1 /*start with the 1st row, 1st column.*/ -size=n**2 /*size of array.*/ +/*REXX program produces and displays a zig─zag matrix (a square array). */ +parse arg n start inc . /*obtain optional arguments from the CL*/ +if n=='' | n=="," then n=5 /*Not specified? Then use the default.*/ +if start=='' | start=="," then start=0 /* " " " " " " */ +if inc=='' | inc=="," then inc=1 /* " " " " " " */ +row=1; col=1 /*start with the 1st row, 1st column.*/ +size=n**2 /*the size of array. */ do j=start by inc for size; @.row.col=j - if (row+col)//2==0 then do - if col