diff --git a/Lang/AArch64-Assembly/Conways-Game-of-Life b/Lang/AArch64-Assembly/Conways-Game-of-Life new file mode 120000 index 0000000000..048d5e56cd --- /dev/null +++ b/Lang/AArch64-Assembly/Conways-Game-of-Life @@ -0,0 +1 @@ +../../Task/Conways-Game-of-Life/AArch64-Assembly \ No newline at end of file diff --git a/Lang/ALGOL-68/Biorhythms b/Lang/ALGOL-68/Biorhythms new file mode 120000 index 0000000000..b15056dfc9 --- /dev/null +++ b/Lang/ALGOL-68/Biorhythms @@ -0,0 +1 @@ +../../Task/Biorhythms/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Factorial-base-numbers-indexing-permutations-of-a-collection b/Lang/ALGOL-68/Factorial-base-numbers-indexing-permutations-of-a-collection new file mode 120000 index 0000000000..ab36c72f12 --- /dev/null +++ b/Lang/ALGOL-68/Factorial-base-numbers-indexing-permutations-of-a-collection @@ -0,0 +1 @@ +../../Task/Factorial-base-numbers-indexing-permutations-of-a-collection/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/LU-decomposition b/Lang/ALGOL-68/LU-decomposition new file mode 120000 index 0000000000..3453e9548a --- /dev/null +++ b/Lang/ALGOL-68/LU-decomposition @@ -0,0 +1 @@ +../../Task/LU-decomposition/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Mayan-numerals b/Lang/ALGOL-68/Mayan-numerals new file mode 120000 index 0000000000..901b0eac41 --- /dev/null +++ b/Lang/ALGOL-68/Mayan-numerals @@ -0,0 +1 @@ +../../Task/Mayan-numerals/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Subtractive-generator b/Lang/ALGOL-68/Subtractive-generator new file mode 120000 index 0000000000..f90071e31a --- /dev/null +++ b/Lang/ALGOL-68/Subtractive-generator @@ -0,0 +1 @@ +../../Task/Subtractive-generator/ALGOL-68 \ No newline at end of file diff --git a/Lang/ALGOL-68/Vogels-approximation-method b/Lang/ALGOL-68/Vogels-approximation-method new file mode 120000 index 0000000000..9c09f3c2a5 --- /dev/null +++ b/Lang/ALGOL-68/Vogels-approximation-method @@ -0,0 +1 @@ +../../Task/Vogels-approximation-method/ALGOL-68 \ No newline at end of file diff --git a/Lang/AWK/Vampire-number b/Lang/AWK/Vampire-number new file mode 120000 index 0000000000..3b7709e53a --- /dev/null +++ b/Lang/AWK/Vampire-number @@ -0,0 +1 @@ +../../Task/Vampire-number/AWK \ No newline at end of file diff --git a/Lang/Ada/Babylonian-spiral b/Lang/Ada/Babylonian-spiral new file mode 120000 index 0000000000..fd4ac4c6ad --- /dev/null +++ b/Lang/Ada/Babylonian-spiral @@ -0,0 +1 @@ +../../Task/Babylonian-spiral/Ada \ No newline at end of file diff --git a/Lang/BQN/Dutch-national-flag-problem b/Lang/BQN/Dutch-national-flag-problem new file mode 120000 index 0000000000..c24e10da06 --- /dev/null +++ b/Lang/BQN/Dutch-national-flag-problem @@ -0,0 +1 @@ +../../Task/Dutch-national-flag-problem/BQN \ No newline at end of file diff --git a/Lang/EasyLang/Mayan-numerals b/Lang/EasyLang/Mayan-numerals new file mode 120000 index 0000000000..101692428a --- /dev/null +++ b/Lang/EasyLang/Mayan-numerals @@ -0,0 +1 @@ +../../Task/Mayan-numerals/EasyLang \ No newline at end of file diff --git a/Lang/EasyLang/Vogels-approximation-method b/Lang/EasyLang/Vogels-approximation-method new file mode 120000 index 0000000000..576b7c1373 --- /dev/null +++ b/Lang/EasyLang/Vogels-approximation-method @@ -0,0 +1 @@ +../../Task/Vogels-approximation-method/EasyLang \ No newline at end of file diff --git a/Lang/Fish/00-LANG.txt b/Lang/Fish/00-LANG.txt index ae84e9d381..3479165e5a 100644 --- a/Lang/Fish/00-LANG.txt +++ b/Lang/Fish/00-LANG.txt @@ -1,4 +1,3 @@ -{{language}}Fish is an Funge-like esoteric language, consisting of the traditional Funge one-character commands. -A complete specification with a list of implementations can be found at [[eso:Fish|esolangs]]. +{{language}}Fish (properly spelled "><>") is a Funge-like esoteric language, consisting of the traditional Funge one-character commands arranged in a two-dimensional code space. A complete specification with a list of implementations can be found at [[eso:Fish|esolangs]]. [[Category:Esoteric_Languages]] \ No newline at end of file diff --git a/Lang/FreeBASIC/15-puzzle-solver b/Lang/FreeBASIC/15-puzzle-solver new file mode 120000 index 0000000000..aac40387ff --- /dev/null +++ b/Lang/FreeBASIC/15-puzzle-solver @@ -0,0 +1 @@ +../../Task/15-puzzle-solver/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Brace-expansion b/Lang/FreeBASIC/Brace-expansion new file mode 120000 index 0000000000..b08a413ab2 --- /dev/null +++ b/Lang/FreeBASIC/Brace-expansion @@ -0,0 +1 @@ +../../Task/Brace-expansion/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Chat-server b/Lang/FreeBASIC/Chat-server new file mode 120000 index 0000000000..59f06de348 --- /dev/null +++ b/Lang/FreeBASIC/Chat-server @@ -0,0 +1 @@ +../../Task/Chat-server/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Continued-fraction-Arithmetic-G-matrix-ng-continued-fraction-n- b/Lang/FreeBASIC/Continued-fraction-Arithmetic-G-matrix-ng-continued-fraction-n- new file mode 120000 index 0000000000..e2defb3109 --- /dev/null +++ b/Lang/FreeBASIC/Continued-fraction-Arithmetic-G-matrix-ng-continued-fraction-n- @@ -0,0 +1 @@ +../../Task/Continued-fraction-Arithmetic-G-matrix-ng-continued-fraction-n-/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Display-an-outline-as-a-nested-table b/Lang/FreeBASIC/Display-an-outline-as-a-nested-table new file mode 120000 index 0000000000..e1fe23aa03 --- /dev/null +++ b/Lang/FreeBASIC/Display-an-outline-as-a-nested-table @@ -0,0 +1 @@ +../../Task/Display-an-outline-as-a-nested-table/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Echo-server b/Lang/FreeBASIC/Echo-server new file mode 120000 index 0000000000..af11371400 --- /dev/null +++ b/Lang/FreeBASIC/Echo-server @@ -0,0 +1 @@ +../../Task/Echo-server/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Factorial-base-numbers-indexing-permutations-of-a-collection b/Lang/FreeBASIC/Factorial-base-numbers-indexing-permutations-of-a-collection new file mode 120000 index 0000000000..1f2b24105a --- /dev/null +++ b/Lang/FreeBASIC/Factorial-base-numbers-indexing-permutations-of-a-collection @@ -0,0 +1 @@ +../../Task/Factorial-base-numbers-indexing-permutations-of-a-collection/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Hello-world-Web-server b/Lang/FreeBASIC/Hello-world-Web-server new file mode 120000 index 0000000000..25d52ccee6 --- /dev/null +++ b/Lang/FreeBASIC/Hello-world-Web-server @@ -0,0 +1 @@ +../../Task/Hello-world-Web-server/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/History-variables b/Lang/FreeBASIC/History-variables new file mode 120000 index 0000000000..68f4bcd858 --- /dev/null +++ b/Lang/FreeBASIC/History-variables @@ -0,0 +1 @@ +../../Task/History-variables/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Intersecting-number-wheels b/Lang/FreeBASIC/Intersecting-number-wheels new file mode 120000 index 0000000000..42313ae624 --- /dev/null +++ b/Lang/FreeBASIC/Intersecting-number-wheels @@ -0,0 +1 @@ +../../Task/Intersecting-number-wheels/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Jaro-Winkler-distance b/Lang/FreeBASIC/Jaro-Winkler-distance new file mode 120000 index 0000000000..567e61dfba --- /dev/null +++ b/Lang/FreeBASIC/Jaro-Winkler-distance @@ -0,0 +1 @@ +../../Task/Jaro-Winkler-distance/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/K-d-tree b/Lang/FreeBASIC/K-d-tree new file mode 120000 index 0000000000..f6319abaa1 --- /dev/null +++ b/Lang/FreeBASIC/K-d-tree @@ -0,0 +1 @@ +../../Task/K-d-tree/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/LU-decomposition b/Lang/FreeBASIC/LU-decomposition new file mode 120000 index 0000000000..a239ac6c87 --- /dev/null +++ b/Lang/FreeBASIC/LU-decomposition @@ -0,0 +1 @@ +../../Task/LU-decomposition/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Mayan-calendar b/Lang/FreeBASIC/Mayan-calendar new file mode 120000 index 0000000000..4de11e93f6 --- /dev/null +++ b/Lang/FreeBASIC/Mayan-calendar @@ -0,0 +1 @@ +../../Task/Mayan-calendar/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/P-value-correction b/Lang/FreeBASIC/P-value-correction new file mode 120000 index 0000000000..a2f7c2e1e2 --- /dev/null +++ b/Lang/FreeBASIC/P-value-correction @@ -0,0 +1 @@ +../../Task/P-value-correction/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Parse-an-IP-Address b/Lang/FreeBASIC/Parse-an-IP-Address new file mode 120000 index 0000000000..4b51728d74 --- /dev/null +++ b/Lang/FreeBASIC/Parse-an-IP-Address @@ -0,0 +1 @@ +../../Task/Parse-an-IP-Address/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Parsing-RPN-to-infix-conversion b/Lang/FreeBASIC/Parsing-RPN-to-infix-conversion new file mode 120000 index 0000000000..d524880dde --- /dev/null +++ b/Lang/FreeBASIC/Parsing-RPN-to-infix-conversion @@ -0,0 +1 @@ +../../Task/Parsing-RPN-to-infix-conversion/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Parsing-Shunting-yard-algorithm b/Lang/FreeBASIC/Parsing-Shunting-yard-algorithm new file mode 120000 index 0000000000..c598b75c18 --- /dev/null +++ b/Lang/FreeBASIC/Parsing-Shunting-yard-algorithm @@ -0,0 +1 @@ +../../Task/Parsing-Shunting-yard-algorithm/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/QR-decomposition b/Lang/FreeBASIC/QR-decomposition new file mode 120000 index 0000000000..b4e25e341a --- /dev/null +++ b/Lang/FreeBASIC/QR-decomposition @@ -0,0 +1 @@ +../../Task/QR-decomposition/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Rosetta-Code-Find-bare-lang-tags b/Lang/FreeBASIC/Rosetta-Code-Find-bare-lang-tags new file mode 120000 index 0000000000..c9a2ddc646 --- /dev/null +++ b/Lang/FreeBASIC/Rosetta-Code-Find-bare-lang-tags @@ -0,0 +1 @@ +../../Task/Rosetta-Code-Find-bare-lang-tags/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/SOAP b/Lang/FreeBASIC/SOAP new file mode 120000 index 0000000000..927bc2295a --- /dev/null +++ b/Lang/FreeBASIC/SOAP @@ -0,0 +1 @@ +../../Task/SOAP/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Stable-marriage-problem b/Lang/FreeBASIC/Stable-marriage-problem new file mode 120000 index 0000000000..e54d2883a7 --- /dev/null +++ b/Lang/FreeBASIC/Stable-marriage-problem @@ -0,0 +1 @@ +../../Task/Stable-marriage-problem/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/State-name-puzzle b/Lang/FreeBASIC/State-name-puzzle new file mode 120000 index 0000000000..31d5af215a --- /dev/null +++ b/Lang/FreeBASIC/State-name-puzzle @@ -0,0 +1 @@ +../../Task/State-name-puzzle/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Strassens-algorithm b/Lang/FreeBASIC/Strassens-algorithm new file mode 120000 index 0000000000..a5c6e9ef78 --- /dev/null +++ b/Lang/FreeBASIC/Strassens-algorithm @@ -0,0 +1 @@ +../../Task/Strassens-algorithm/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Summarize-and-say-sequence b/Lang/FreeBASIC/Summarize-and-say-sequence new file mode 120000 index 0000000000..c59e649aca --- /dev/null +++ b/Lang/FreeBASIC/Summarize-and-say-sequence @@ -0,0 +1 @@ +../../Task/Summarize-and-say-sequence/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Tarjan b/Lang/FreeBASIC/Tarjan new file mode 120000 index 0000000000..2088963b57 --- /dev/null +++ b/Lang/FreeBASIC/Tarjan @@ -0,0 +1 @@ +../../Task/Tarjan/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Universal-Turing-machine b/Lang/FreeBASIC/Universal-Turing-machine new file mode 120000 index 0000000000..a29b2e6201 --- /dev/null +++ b/Lang/FreeBASIC/Universal-Turing-machine @@ -0,0 +1 @@ +../../Task/Universal-Turing-machine/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Verify-distribution-uniformity-Chi-squared-test b/Lang/FreeBASIC/Verify-distribution-uniformity-Chi-squared-test new file mode 120000 index 0000000000..8088ed160e --- /dev/null +++ b/Lang/FreeBASIC/Verify-distribution-uniformity-Chi-squared-test @@ -0,0 +1 @@ +../../Task/Verify-distribution-uniformity-Chi-squared-test/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Vogels-approximation-method b/Lang/FreeBASIC/Vogels-approximation-method new file mode 120000 index 0000000000..e685ba3d8d --- /dev/null +++ b/Lang/FreeBASIC/Vogels-approximation-method @@ -0,0 +1 @@ +../../Task/Vogels-approximation-method/FreeBASIC \ No newline at end of file diff --git a/Lang/FreeBASIC/Wasteful-equidigital-and-frugal-numbers b/Lang/FreeBASIC/Wasteful-equidigital-and-frugal-numbers new file mode 120000 index 0000000000..7889ec2570 --- /dev/null +++ b/Lang/FreeBASIC/Wasteful-equidigital-and-frugal-numbers @@ -0,0 +1 @@ +../../Task/Wasteful-equidigital-and-frugal-numbers/FreeBASIC \ No newline at end of file diff --git a/Lang/FutureBasic/15-puzzle-solver b/Lang/FutureBasic/15-puzzle-solver new file mode 120000 index 0000000000..db2f936a7e --- /dev/null +++ b/Lang/FutureBasic/15-puzzle-solver @@ -0,0 +1 @@ +../../Task/15-puzzle-solver/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Amb b/Lang/FutureBasic/Amb new file mode 120000 index 0000000000..399b8a70d5 --- /dev/null +++ b/Lang/FutureBasic/Amb @@ -0,0 +1 @@ +../../Task/Amb/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Anonymous-recursion b/Lang/FutureBasic/Anonymous-recursion new file mode 120000 index 0000000000..d52f4bbda0 --- /dev/null +++ b/Lang/FutureBasic/Anonymous-recursion @@ -0,0 +1 @@ +../../Task/Anonymous-recursion/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Arithmetic-geometric-mean b/Lang/FutureBasic/Arithmetic-geometric-mean new file mode 120000 index 0000000000..2894f4733f --- /dev/null +++ b/Lang/FutureBasic/Arithmetic-geometric-mean @@ -0,0 +1 @@ +../../Task/Arithmetic-geometric-mean/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Averages-Mean-angle b/Lang/FutureBasic/Averages-Mean-angle new file mode 120000 index 0000000000..45c7d861f6 --- /dev/null +++ b/Lang/FutureBasic/Averages-Mean-angle @@ -0,0 +1 @@ +../../Task/Averages-Mean-angle/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Averages-Root-mean-square b/Lang/FutureBasic/Averages-Root-mean-square new file mode 120000 index 0000000000..f04b81a3b0 --- /dev/null +++ b/Lang/FutureBasic/Averages-Root-mean-square @@ -0,0 +1 @@ +../../Task/Averages-Root-mean-square/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Barnsley-fern b/Lang/FutureBasic/Barnsley-fern new file mode 120000 index 0000000000..a6da4c722a --- /dev/null +++ b/Lang/FutureBasic/Barnsley-fern @@ -0,0 +1 @@ +../../Task/Barnsley-fern/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Binary-search b/Lang/FutureBasic/Binary-search new file mode 120000 index 0000000000..55e96bcbd8 --- /dev/null +++ b/Lang/FutureBasic/Binary-search @@ -0,0 +1 @@ +../../Task/Binary-search/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Bitmap-B-zier-curves-Cubic b/Lang/FutureBasic/Bitmap-B-zier-curves-Cubic new file mode 120000 index 0000000000..743bf83068 --- /dev/null +++ b/Lang/FutureBasic/Bitmap-B-zier-curves-Cubic @@ -0,0 +1 @@ +../../Task/Bitmap-B-zier-curves-Cubic/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Blum-integer b/Lang/FutureBasic/Blum-integer new file mode 120000 index 0000000000..0ccbf69775 --- /dev/null +++ b/Lang/FutureBasic/Blum-integer @@ -0,0 +1 @@ +../../Task/Blum-integer/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Box-the-compass b/Lang/FutureBasic/Box-the-compass new file mode 120000 index 0000000000..7b89a8413c --- /dev/null +++ b/Lang/FutureBasic/Box-the-compass @@ -0,0 +1 @@ +../../Task/Box-the-compass/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Caesar-cipher b/Lang/FutureBasic/Caesar-cipher new file mode 120000 index 0000000000..c0196256fa --- /dev/null +++ b/Lang/FutureBasic/Caesar-cipher @@ -0,0 +1 @@ +../../Task/Caesar-cipher/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Catamorphism b/Lang/FutureBasic/Catamorphism new file mode 120000 index 0000000000..25e6699616 --- /dev/null +++ b/Lang/FutureBasic/Catamorphism @@ -0,0 +1 @@ +../../Task/Catamorphism/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Chinese-zodiac b/Lang/FutureBasic/Chinese-zodiac new file mode 120000 index 0000000000..df6e098031 --- /dev/null +++ b/Lang/FutureBasic/Chinese-zodiac @@ -0,0 +1 @@ +../../Task/Chinese-zodiac/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Compile-time-calculation b/Lang/FutureBasic/Compile-time-calculation new file mode 120000 index 0000000000..ef10ff644e --- /dev/null +++ b/Lang/FutureBasic/Compile-time-calculation @@ -0,0 +1 @@ +../../Task/Compile-time-calculation/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Composite-numbers-k-with-no-single-digit-factors-whose-factors-are-all-substrings-of-k b/Lang/FutureBasic/Composite-numbers-k-with-no-single-digit-factors-whose-factors-are-all-substrings-of-k new file mode 120000 index 0000000000..2fbac26654 --- /dev/null +++ b/Lang/FutureBasic/Composite-numbers-k-with-no-single-digit-factors-whose-factors-are-all-substrings-of-k @@ -0,0 +1 @@ +../../Task/Composite-numbers-k-with-no-single-digit-factors-whose-factors-are-all-substrings-of-k/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Cumulative-standard-deviation b/Lang/FutureBasic/Cumulative-standard-deviation new file mode 120000 index 0000000000..e51653c2b1 --- /dev/null +++ b/Lang/FutureBasic/Cumulative-standard-deviation @@ -0,0 +1 @@ +../../Task/Cumulative-standard-deviation/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Determine-if-a-string-has-all-the-same-characters b/Lang/FutureBasic/Determine-if-a-string-has-all-the-same-characters new file mode 120000 index 0000000000..94f004e3ea --- /dev/null +++ b/Lang/FutureBasic/Determine-if-a-string-has-all-the-same-characters @@ -0,0 +1 @@ +../../Task/Determine-if-a-string-has-all-the-same-characters/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Dutch-national-flag-problem b/Lang/FutureBasic/Dutch-national-flag-problem new file mode 120000 index 0000000000..a769d7e0d9 --- /dev/null +++ b/Lang/FutureBasic/Dutch-national-flag-problem @@ -0,0 +1 @@ +../../Task/Dutch-national-flag-problem/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Equilibrium-index b/Lang/FutureBasic/Equilibrium-index new file mode 120000 index 0000000000..92d577887f --- /dev/null +++ b/Lang/FutureBasic/Equilibrium-index @@ -0,0 +1 @@ +../../Task/Equilibrium-index/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Evaluate-binomial-coefficients b/Lang/FutureBasic/Evaluate-binomial-coefficients new file mode 120000 index 0000000000..59e49028f9 --- /dev/null +++ b/Lang/FutureBasic/Evaluate-binomial-coefficients @@ -0,0 +1 @@ +../../Task/Evaluate-binomial-coefficients/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Exceptions b/Lang/FutureBasic/Exceptions new file mode 120000 index 0000000000..0e25a15f85 --- /dev/null +++ b/Lang/FutureBasic/Exceptions @@ -0,0 +1 @@ +../../Task/Exceptions/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Exceptions-Catch-an-exception-thrown-in-a-nested-call b/Lang/FutureBasic/Exceptions-Catch-an-exception-thrown-in-a-nested-call new file mode 120000 index 0000000000..fd7f3bd9e7 --- /dev/null +++ b/Lang/FutureBasic/Exceptions-Catch-an-exception-thrown-in-a-nested-call @@ -0,0 +1 @@ +../../Task/Exceptions-Catch-an-exception-thrown-in-a-nested-call/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Flow-control-structures b/Lang/FutureBasic/Flow-control-structures new file mode 120000 index 0000000000..47305c16bf --- /dev/null +++ b/Lang/FutureBasic/Flow-control-structures @@ -0,0 +1 @@ +../../Task/Flow-control-structures/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Forward-difference b/Lang/FutureBasic/Forward-difference new file mode 120000 index 0000000000..8669b1c1f5 --- /dev/null +++ b/Lang/FutureBasic/Forward-difference @@ -0,0 +1 @@ +../../Task/Forward-difference/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Function-composition b/Lang/FutureBasic/Function-composition new file mode 120000 index 0000000000..363444c694 --- /dev/null +++ b/Lang/FutureBasic/Function-composition @@ -0,0 +1 @@ +../../Task/Function-composition/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Fusc-sequence b/Lang/FutureBasic/Fusc-sequence new file mode 120000 index 0000000000..603bccf327 --- /dev/null +++ b/Lang/FutureBasic/Fusc-sequence @@ -0,0 +1 @@ +../../Task/Fusc-sequence/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Host-introspection b/Lang/FutureBasic/Host-introspection new file mode 120000 index 0000000000..c342a7333a --- /dev/null +++ b/Lang/FutureBasic/Host-introspection @@ -0,0 +1 @@ +../../Task/Host-introspection/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/ISBN13-check-digit b/Lang/FutureBasic/ISBN13-check-digit new file mode 120000 index 0000000000..ad5e4cffb4 --- /dev/null +++ b/Lang/FutureBasic/ISBN13-check-digit @@ -0,0 +1 @@ +../../Task/ISBN13-check-digit/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/JortSort b/Lang/FutureBasic/JortSort new file mode 120000 index 0000000000..a21b94121b --- /dev/null +++ b/Lang/FutureBasic/JortSort @@ -0,0 +1 @@ +../../Task/JortSort/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Josephus-problem b/Lang/FutureBasic/Josephus-problem new file mode 120000 index 0000000000..d84fa33d5d --- /dev/null +++ b/Lang/FutureBasic/Josephus-problem @@ -0,0 +1 @@ +../../Task/Josephus-problem/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Last-Friday-of-each-month b/Lang/FutureBasic/Last-Friday-of-each-month new file mode 120000 index 0000000000..a3476e0672 --- /dev/null +++ b/Lang/FutureBasic/Last-Friday-of-each-month @@ -0,0 +1 @@ +../../Task/Last-Friday-of-each-month/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Least-common-multiple b/Lang/FutureBasic/Least-common-multiple new file mode 120000 index 0000000000..23b8dbfe57 --- /dev/null +++ b/Lang/FutureBasic/Least-common-multiple @@ -0,0 +1 @@ +../../Task/Least-common-multiple/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Long-literals-with-continuations b/Lang/FutureBasic/Long-literals-with-continuations new file mode 120000 index 0000000000..09dff817df --- /dev/null +++ b/Lang/FutureBasic/Long-literals-with-continuations @@ -0,0 +1 @@ +../../Task/Long-literals-with-continuations/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Long-year b/Lang/FutureBasic/Long-year new file mode 120000 index 0000000000..ae89f1d742 --- /dev/null +++ b/Lang/FutureBasic/Long-year @@ -0,0 +1 @@ +../../Task/Long-year/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Loops-Increment-loop-index-within-loop-body b/Lang/FutureBasic/Loops-Increment-loop-index-within-loop-body new file mode 120000 index 0000000000..ff81b810cd --- /dev/null +++ b/Lang/FutureBasic/Loops-Increment-loop-index-within-loop-body @@ -0,0 +1 @@ +../../Task/Loops-Increment-loop-index-within-loop-body/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Minimum-multiple-of-m-where-digital-sum-equals-m b/Lang/FutureBasic/Minimum-multiple-of-m-where-digital-sum-equals-m new file mode 120000 index 0000000000..088e4f56af --- /dev/null +++ b/Lang/FutureBasic/Minimum-multiple-of-m-where-digital-sum-equals-m @@ -0,0 +1 @@ +../../Task/Minimum-multiple-of-m-where-digital-sum-equals-m/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Munching-squares b/Lang/FutureBasic/Munching-squares new file mode 120000 index 0000000000..3fb288f688 --- /dev/null +++ b/Lang/FutureBasic/Munching-squares @@ -0,0 +1 @@ +../../Task/Munching-squares/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Nim-game b/Lang/FutureBasic/Nim-game new file mode 120000 index 0000000000..edc10ed0c5 --- /dev/null +++ b/Lang/FutureBasic/Nim-game @@ -0,0 +1 @@ +../../Task/Nim-game/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Nth b/Lang/FutureBasic/Nth new file mode 120000 index 0000000000..10c058fbd2 --- /dev/null +++ b/Lang/FutureBasic/Nth @@ -0,0 +1 @@ +../../Task/Nth/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Own-digits-power-sum b/Lang/FutureBasic/Own-digits-power-sum new file mode 120000 index 0000000000..5cd998b558 --- /dev/null +++ b/Lang/FutureBasic/Own-digits-power-sum @@ -0,0 +1 @@ +../../Task/Own-digits-power-sum/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Palindrome-dates b/Lang/FutureBasic/Palindrome-dates new file mode 120000 index 0000000000..2b72c0230b --- /dev/null +++ b/Lang/FutureBasic/Palindrome-dates @@ -0,0 +1 @@ +../../Task/Palindrome-dates/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Pascals-triangle-Puzzle b/Lang/FutureBasic/Pascals-triangle-Puzzle new file mode 120000 index 0000000000..142f796d16 --- /dev/null +++ b/Lang/FutureBasic/Pascals-triangle-Puzzle @@ -0,0 +1 @@ +../../Task/Pascals-triangle-Puzzle/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Pinstripe-Display b/Lang/FutureBasic/Pinstripe-Display new file mode 120000 index 0000000000..da5d8bc2b0 --- /dev/null +++ b/Lang/FutureBasic/Pinstripe-Display @@ -0,0 +1 @@ +../../Task/Pinstripe-Display/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Playing-cards b/Lang/FutureBasic/Playing-cards new file mode 120000 index 0000000000..965405f346 --- /dev/null +++ b/Lang/FutureBasic/Playing-cards @@ -0,0 +1 @@ +../../Task/Playing-cards/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Regular-expressions b/Lang/FutureBasic/Regular-expressions new file mode 120000 index 0000000000..cd49461444 --- /dev/null +++ b/Lang/FutureBasic/Regular-expressions @@ -0,0 +1 @@ +../../Task/Regular-expressions/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Search-a-list-of-records b/Lang/FutureBasic/Search-a-list-of-records new file mode 120000 index 0000000000..3fefc25b7b --- /dev/null +++ b/Lang/FutureBasic/Search-a-list-of-records @@ -0,0 +1 @@ +../../Task/Search-a-list-of-records/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Sierpinski-triangle b/Lang/FutureBasic/Sierpinski-triangle new file mode 120000 index 0000000000..300049c10c --- /dev/null +++ b/Lang/FutureBasic/Sierpinski-triangle @@ -0,0 +1 @@ +../../Task/Sierpinski-triangle/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Sort-an-array-of-composite-structures b/Lang/FutureBasic/Sort-an-array-of-composite-structures new file mode 120000 index 0000000000..ffd97b8a5e --- /dev/null +++ b/Lang/FutureBasic/Sort-an-array-of-composite-structures @@ -0,0 +1 @@ +../../Task/Sort-an-array-of-composite-structures/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Sort-numbers-lexicographically b/Lang/FutureBasic/Sort-numbers-lexicographically new file mode 120000 index 0000000000..b8d6f91892 --- /dev/null +++ b/Lang/FutureBasic/Sort-numbers-lexicographically @@ -0,0 +1 @@ +../../Task/Sort-numbers-lexicographically/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Spinning-rod-animation-Text b/Lang/FutureBasic/Spinning-rod-animation-Text new file mode 120000 index 0000000000..a0c68e7478 --- /dev/null +++ b/Lang/FutureBasic/Spinning-rod-animation-Text @@ -0,0 +1 @@ +../../Task/Spinning-rod-animation-Text/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Square-but-not-cube b/Lang/FutureBasic/Square-but-not-cube new file mode 120000 index 0000000000..a8c6d02eba --- /dev/null +++ b/Lang/FutureBasic/Square-but-not-cube @@ -0,0 +1 @@ +../../Task/Square-but-not-cube/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Stack b/Lang/FutureBasic/Stack new file mode 120000 index 0000000000..638a183bbc --- /dev/null +++ b/Lang/FutureBasic/Stack @@ -0,0 +1 @@ +../../Task/Stack/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Sudan-function b/Lang/FutureBasic/Sudan-function new file mode 120000 index 0000000000..1f582a9d0d --- /dev/null +++ b/Lang/FutureBasic/Sudan-function @@ -0,0 +1 @@ +../../Task/Sudan-function/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Sum-digits-of-an-integer b/Lang/FutureBasic/Sum-digits-of-an-integer new file mode 120000 index 0000000000..cf8ab32c2c --- /dev/null +++ b/Lang/FutureBasic/Sum-digits-of-an-integer @@ -0,0 +1 @@ +../../Task/Sum-digits-of-an-integer/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Temperature-conversion b/Lang/FutureBasic/Temperature-conversion new file mode 120000 index 0000000000..b60c2baf77 --- /dev/null +++ b/Lang/FutureBasic/Temperature-conversion @@ -0,0 +1 @@ +../../Task/Temperature-conversion/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/Terminal-control-Clear-the-screen b/Lang/FutureBasic/Terminal-control-Clear-the-screen new file mode 120000 index 0000000000..878687a038 --- /dev/null +++ b/Lang/FutureBasic/Terminal-control-Clear-the-screen @@ -0,0 +1 @@ +../../Task/Terminal-control-Clear-the-screen/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/The-Name-Game b/Lang/FutureBasic/The-Name-Game new file mode 120000 index 0000000000..2e6c9ef1a6 --- /dev/null +++ b/Lang/FutureBasic/The-Name-Game @@ -0,0 +1 @@ +../../Task/The-Name-Game/FutureBasic \ No newline at end of file diff --git a/Lang/FutureBasic/User-input-Text b/Lang/FutureBasic/User-input-Text new file mode 120000 index 0000000000..3d0e3bd7f1 --- /dev/null +++ b/Lang/FutureBasic/User-input-Text @@ -0,0 +1 @@ +../../Task/User-input-Text/FutureBasic \ No newline at end of file diff --git a/Lang/GW-BASIC/Colour-pinstripe-Display b/Lang/GW-BASIC/Colour-pinstripe-Display new file mode 120000 index 0000000000..383619acfb --- /dev/null +++ b/Lang/GW-BASIC/Colour-pinstripe-Display @@ -0,0 +1 @@ +../../Task/Colour-pinstripe-Display/GW-BASIC \ No newline at end of file diff --git a/Lang/GW-BASIC/Pinstripe-Display b/Lang/GW-BASIC/Pinstripe-Display new file mode 120000 index 0000000000..282b987dfa --- /dev/null +++ b/Lang/GW-BASIC/Pinstripe-Display @@ -0,0 +1 @@ +../../Task/Pinstripe-Display/GW-BASIC \ No newline at end of file diff --git a/Lang/Isabelle/Bernoulli-numbers b/Lang/Isabelle/Bernoulli-numbers new file mode 120000 index 0000000000..73728f3564 --- /dev/null +++ b/Lang/Isabelle/Bernoulli-numbers @@ -0,0 +1 @@ +../../Task/Bernoulli-numbers/Isabelle \ No newline at end of file diff --git a/Lang/Isabelle/Catalan-numbers b/Lang/Isabelle/Catalan-numbers new file mode 120000 index 0000000000..b2ce7b3a40 --- /dev/null +++ b/Lang/Isabelle/Catalan-numbers @@ -0,0 +1 @@ +../../Task/Catalan-numbers/Isabelle \ No newline at end of file diff --git a/Lang/Jq/Strassens-algorithm b/Lang/Jq/Strassens-algorithm new file mode 120000 index 0000000000..d6ccda4254 --- /dev/null +++ b/Lang/Jq/Strassens-algorithm @@ -0,0 +1 @@ +../../Task/Strassens-algorithm/Jq \ No newline at end of file diff --git a/Lang/LSL/00-LANG.txt b/Lang/LSL/00-LANG.txt index bdb68f1bc2..3025477b27 100644 --- a/Lang/LSL/00-LANG.txt +++ b/Lang/LSL/00-LANG.txt @@ -1,25 +1,42 @@ {{language |hopl=no }} -The [[wp:Linden_Scripting_Language|'''Linden Scripting Language''']], usually just called '''LSL''' for short, is a language developed by [http://en.wikipedia.org/wiki/Linden_Lab Linden Labs] for their [[wp:Second_Life|Second Life]] virtual world. LSL allows Second Life objects to sense, respond to events, and interact with the (virtual) world around them, and the Avatars in that world. +'''LSL''' ([[wp:Linden_Scripting_Language|'''Linden Scripting Language''']]) is the scripting language developed by [http://en.wikipedia.org/wiki/Linden_Lab Linden Labs] for their virtual sandbox world [[wp:Second_Life|Second Life]]. Also [[wp:OpenSimulator|OpenSimulator]] along with other [https://omrg.org Open Metaverse] proprietors run a largely compatible superset version of LSL. LSL scripts allow objects rezzed in-world(in-game) to interact with and manipulate the virtual world around them, but also the internet in limited fashion. LSL has many built-in functions, and the ability for inter script messaging, http POST and GET requests, gui dialog boxes, chat channel messaging, java & C like semantics, is turning complete, etc. + +==In Depth: Syntax Structure== +LSL is C-like with scoping of local varaibles and global; strict typing with type-recasting possible; use of {} to encapsulate function blocks, and ; to denote an execution block, and () to encapsulate parameters, and equivalency from right to left and for assignment myint=1-2, variables can be formed as procedures that return a value. Oprands are the same, but there are no pointers nor triple oprands such as +++. +LSL is not like C in many ways, there are only 3 basic types, and 4 special types of data structures: integer (unsigned 32bit), float (unsigned 32bit), string (max string length varies), key ( a 32bit base16 UUID often treated as a string),vectors (set of three floats, aka a tuple <0.0,0.0,0.0> ); quaternions or rot ( set of four floats <0.0,0.0,0.0,0.0> ); lists (1D array that can contain any of or a mix of types of data), There is no void as a type! Nor is there any keyword for functions. Simply outside of a script's default loop function called a state, one forms a function with it's name(type prams){;} and can be called anywhere else. Over-loading is not valid, nor is under-loading when calling a function or variable-function that returns a value. + +==In Depth: Where & when LSL scripts can run== +Rezzing is dragging and dropping from the user's inventory into to the virtual world space, or being worn as attachments to one's avatar (including HUDs). These aforementioned objects take the form of built-in 3d models of basic shapes commonly known as primitives or just prims, sculpted prims, and user uploaded 3D models. Each object has in-turn it's own inventory where the scripts run. In truth one can link many objects into a meta-object known as a link-set, each linked object retains it's own inventory instance, and running scripts. When an object is derezzed, that is brought back into the user's inventory, or an attached object derezzes when the user logs off the scripts' current status is paused and saved. + +==In Depth: LSL basic script structure== +Each script must contain a default script state, this is very similar to the default loop found with in Arduino Clike programming. It is possible to switch the currently running state of a script to a knew one, and back again, thus ignoring/clearing any callback functions called "events". (However the timer does not get cleared upon state changes). +Each state in LSL scripts can have built in call-back functions known as "event types" which are triggered with interrupt like behavior from a cue that is filled by the current simulator or sim (a sim is world instance, generally a 256x256meter block, although some communication with adjacent sims maybe possible) the script is residing in. Most events are repeatable, but there are logically single fire events such as state_entry, on_rez, on_attach, on_deattach. Aforementioned user functions, variables, + +==Back-ends of LSL with in Second-Life== +In Second-life, one can save & run scripts optionally for the two current back-ends that actually run the code over a server, each with their own pros and cons. +[https://wiki.secondlife.com/wiki/LSO LSO] exists for backward compatibility. LSO saved scripts are interpreted at runtime by the server. LSO scripts take less initial script memory, they are limited to less available memory as well. In rare circumstances LSO may run faster than MONO. However LSO suffers from memory fragmentation slow downs with list connotation (there are some work around). LSO handles the jump to @location in unexpected ways. +Mono saved scripts are compiled under [[wp:Mono_(software)|Mono]] (the most recent) to byte-code ran by the server. + Most scripts will benefit from being set to MONO compilation for greater speed and more available memory, at the cost of higher initial memory used. ==Flavors of LSL== -There are currently three flavors of the LSL language -# LSL compiled under [[wp:Mono_(software)|Mono]] (the most recent) -# The original interpreted version (no longer being developed and only exists for backward compatibility) -# A largely compatible version of LSL that can run in the [[wp:OpenSimulator|OpenSimulator]] virtual world. +# A largely compatible version of LSL that can run in the [[http://opensimulator.org/wiki/OSSL_Script_Library|OpenSimulator]] virtual world. ==Documentation== There are two popular web sites documenting LSL # Second Life's own [http://wiki.secondlife.com/wiki/LSL_Portal LSL Portal] # a user supported [http://lslwiki.net/lslwiki/wakka.php LSL Wiki] -==Libraries== +==Libraries of Scripts== There exists several open source libraries where users share code +* [https://outworldz.com/cgi/freescripts.plx Free LSL Scripts] * [http://community.secondlife.com/t5/LSL-Scripting-Library/bd-p/LSLScriptingLibrary LSL Scripting Library] * [http://wiki.secondlife.com/wiki/Category:LSL_Examples LSL Examples] -* [http://www.free-lsl-scripts.com/cgi/freescripts.plx Free LSL Scripts] * [http://community.secondlife.com/t5/LSL-Scripting/bd-p/LSLScripting LSL Scripting] ==External Editors== -There are also many [http://wiki.secondlife.com/wiki/LSL_Alternate_Editors external editors] for LSL allowing you to write, syntax check, and (to a limited extent) execute LSL outside of the Second Life environment. You will need to sign up at [http://secondlife.com Second Life] and have a Second Life account to execute LSL in the virtual world. Your scripts can exist by themselves in a folder of your inventory, or in an Object in your inventory, but need to be in an Object that is in-world to execute (if an Object containing scripts is taken in to your inventory, the scripts will be suspended and will resume when brought out in to the world again.) \ No newline at end of file +There are also many [http://wiki.secondlife.com/wiki/LSL_Alternate_Editors external editors] for LSL allowing you to write with highlighting, [https://github.com/Feay/LSL-for-Scite api tool-tips], [https://github.com/Makopo/lslint syntax check], and (to a limited extent) +[https://github.com/Sei-Lisa/LSL-compiler compile and execute LSL] outside of the Second Life environment. + +You will need to sign up at [http://secondlife.com Second Life] and have a Second Life account to execute LSL in the virtual world. Your scripts can exist by themselves in a folder of your inventory, or in an Object in your inventory, but need to be in an Object that is in-world to execute (if an Object containing scripts is taken in to your inventory, the scripts will be suspended and will resume when brought out in to the world again.) \ No newline at end of file diff --git a/Lang/LSL/Binary-digits b/Lang/LSL/Binary-digits new file mode 120000 index 0000000000..54627407f6 --- /dev/null +++ b/Lang/LSL/Binary-digits @@ -0,0 +1 @@ +../../Task/Binary-digits/LSL \ No newline at end of file diff --git a/Lang/M2000-Interpreter/00-LANG.txt b/Lang/M2000-Interpreter/00-LANG.txt index ed77df4b81..feda8eeb04 100644 --- a/Lang/M2000-Interpreter/00-LANG.txt +++ b/Lang/M2000-Interpreter/00-LANG.txt @@ -26,7 +26,7 @@ Module's may be Global, or local to other modules. We can define global modules We can change a inner module at the calling of a module, see the example: We call inner Beta in two stages. At the second stage we change inner Theta with Theta2. This is the decoration of Beta with Theta as Theta2. This is a temporary decoration because Beta after execution erase any new identifier including Theta. So each time we call Beta, statement Module Theta make this module unless a decoration stop it. ====English Vocabulary==== -Module Beta { +Module Beta { Module Theta (x){ Print "This is Theta, we get x=";x } @@ -38,8 +38,9 @@ Module Theta2 (x) { } Beta ; Theta as Theta2 + ====Greek Vocabulary==== -Τμήμα Βήτα { +Τμήμα Βήτα { Τμήμα Θήτα (χ){ Τύπωσε "Αυτό είναι το Θήτα, θα πάρουμε το χ=";χ } @@ -54,7 +55,7 @@ Beta ; Theta as Theta2 As we can see from code, some statements are like BASIC, except the use of curly brackets {}. Check the code below. We have a Module (as a Procedure), where we define some functions and some variables, as entities. These entities defined in every call to CheckIt, and erased when execution return from CheckIt. By default every parameter in M2000 pass by value. We define two functions, Alfa() where we set type for parameter x and ExpType$() where we not set type for x, and we wish to return the name of type when we make a call. -Module CheckIt { +Module CheckIt { \\ We can't call something out of this module Function Alfa(X as double) { =X**2 @@ -92,7 +93,7 @@ A statement Input Alfa$ can input characters for a string or for object typed gr Types are strong for values with a name (variables, constants), but weak for items in containers. In a container (Array, Inventory and Stack) we can place anything including other containers. We can bypass the "strong" capability but this isn't a practice for good programming. Internal or variables are of type of Variant, so we can make a reference of A to A$ and we can save a string "1212" and read from A the number 1212. - + Module AKindOfMess { a=10@ Print Type$(a)="Decimal" @@ -131,7 +132,7 @@ Print Error$="" So check this for proper use of types. -Module CheckInt { +Module CheckInt { A%=1212212.12@ Print A% ' 1212212 A%=1212212.52@ @@ -149,18 +150,19 @@ So check this for proper use of types. } CheckInt -So we say about Integer Variables, and no Integer Numeric Type. Like in Basic, M2000 is not case sensitive (except for labels), so A% and a% is the same. We may have A, A$ and A% as three variables, or A(), A%(), A$() as arrays or and functions. We can use name(@ ) to call function and not array if we have each with same name. +So we say about Integer Variables, and no Integer Numeric Type. Like in Basic, M2000 is not case sensitive (except for labels), so A% and a% is the same. We may have A, A$ and A% as three variables, or A(), A%(), A$() as arrays or and functions. We can use name(* ) to call function and not array if we have each with same name. -Dim A(10)=1 +Dim A(10)=1 Def A(x)=x**2 -Print A(3), A(@ 4) +Print A(3), A(* 4) ' change @ to * from later versions + By default all variables are local. M2000 uses heap to store local variables, not stack. We can use global variables, but a local definition hide a global one. We can make global variables for temporary use (at return from module which we define a global, this global erased). A global definition in an already defined global variable with same name, hide for temporary use the old global variable. It is easy to make modules, with modules, functions, variables, arrays. We can use subroutines when we want code in a module or a function to used more than once. We can use local variables inside subroutines. In subroutines we can use module's variables, functions, subroutines. Until here we see something like BASIC, except that variables are local to modules and functions, but can be used by subroutines. Also we have see that we can replace a module in a module when we call it. With this replacement we can use a predefined logic with some "terminals", modules that get parameters and do final things. We can make global modules and functions in local modules and functions, but these exist until creator module or function exit. -M2000 can be used for more advanced programming. Modules and functions can be members of Groups. Groups are values. So a function can return a Group. +M2000 can be used for more advanced programming. Modules and functions can be members of Groups. Groups are values. So a function can return a Group. ===Stack of Values=== Modules and functions get parameters in a stack. Modules get the parent stack with parameters, and functions get a new stack with parameters. Modules return from call and are responsible to clear as needed the stack. Functions drop the stack after the call from an expression. A module can return entities in stack, if we want to do that. We can call a module and pass parameters, and that module can call other module leaving parameters in stack to be read in last module. @@ -170,7 +172,7 @@ In the example below (y) is a Read y for module definition. Early versions of la As we see alfa has no read statement, because before get the first number need to make two modules, and then pop one number and call a module passing current stack, so if choose beta, then the second value feed y from a read y statement. - + module alfa { module beta (y) { print y**3 @@ -195,15 +197,13 @@ function sumall { print sumall(1,2,3,4,5,6,7)=28 - - ===OOP=== Groups are objects for M2000. We can use them as values, and if we want we can use pointers for groups (but we can make a lot of programs without using pointers to groups). Without using pointer, a Group may be local with a name in a Module or can be in a container like array, inventory (a type of map) and stack objects, without name. Groups may have private and public members, may have properties as read only, may get value and return value, and may have operators. Members of Groups can be anything, including other groups. Groups may have events too. We can make groups by using CLASS statement or by using own function which return a Group or a pointer to Group. A special object is the lambda object, which may have a number of closures, and have to faces, a variable and a function: -Module Delta { +Module Delta { \\ Make a group like a lambda \\ A Class make a Global Function \\ (in a group a Class definition make a group member, not a global function) @@ -244,7 +244,7 @@ We can place a lambda function as closure in a lambda function, and we can build a class define a type too. We can make a class from other classes too. We can make inner classes too. - + Form 80,50 \\ counters supposed we provide them from a file global LastCustomerId=100, ReportId=80 @@ -342,7 +342,7 @@ While M { Until now we see modules/functions/subs for procedural programming, Groups for OOP, Groups as lambda functions and lambda functions for functional programming. We can use events for groups and for COM objects, including GUI objects. -Module Beta { +Module Beta { Group WithEvents Alpha { Event "One" Module DoIt (x) { @@ -380,7 +380,7 @@ Until now we see that programming with events can be used in M2000. There is an Modules may have Threads, part of modules that can be executed in intervals, can be halted, or can be released, and can be erased. Each thread has own stack and may have own static variables (Modules and Functions also may have static variables), but can use modules variables and functions/modules/subs. Threads can run concurrent (thread return to task manager after execution of a statement or a block of statements) or sequential (a thread has to exit from interval to start other thread) -Module Zeta { +Module Zeta { k=10 Thread { k++ @@ -399,7 +399,7 @@ Zeta M2000 Interpreter can work with Structures and Buffers. Buffer is a memory block and Structure can define types of memory, and a buffer can hold arrays of structures. Each structure can be made from other structures or arrays of structures, and may have unions. We can use buffers for code execution (writing machine code), using standard buffers (not executable), for data holder. Also we can use Buffers calling external dll and passing by address. -Module Kappa { +Module Kappa { Function Theta(x) { Structure Points_single { x as single diff --git a/Lang/M2000-Interpreter/Associative-array-Merging b/Lang/M2000-Interpreter/Associative-array-Merging new file mode 120000 index 0000000000..e54ba7cbfd --- /dev/null +++ b/Lang/M2000-Interpreter/Associative-array-Merging @@ -0,0 +1 @@ +../../Task/Associative-array-Merging/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Averages-Mean-angle b/Lang/M2000-Interpreter/Averages-Mean-angle new file mode 120000 index 0000000000..5bcc89482d --- /dev/null +++ b/Lang/M2000-Interpreter/Averages-Mean-angle @@ -0,0 +1 @@ +../../Task/Averages-Mean-angle/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Babylonian-spiral b/Lang/M2000-Interpreter/Babylonian-spiral new file mode 120000 index 0000000000..70eeaaf834 --- /dev/null +++ b/Lang/M2000-Interpreter/Babylonian-spiral @@ -0,0 +1 @@ +../../Task/Babylonian-spiral/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Bernoulli-numbers b/Lang/M2000-Interpreter/Bernoulli-numbers new file mode 120000 index 0000000000..91c31cbe94 --- /dev/null +++ b/Lang/M2000-Interpreter/Bernoulli-numbers @@ -0,0 +1 @@ +../../Task/Bernoulli-numbers/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Chinese-zodiac b/Lang/M2000-Interpreter/Chinese-zodiac new file mode 120000 index 0000000000..ba20540cb2 --- /dev/null +++ b/Lang/M2000-Interpreter/Chinese-zodiac @@ -0,0 +1 @@ +../../Task/Chinese-zodiac/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Factors-of-a-Mersenne-number b/Lang/M2000-Interpreter/Factors-of-a-Mersenne-number new file mode 120000 index 0000000000..dcb49d5579 --- /dev/null +++ b/Lang/M2000-Interpreter/Factors-of-a-Mersenne-number @@ -0,0 +1 @@ +../../Task/Factors-of-a-Mersenne-number/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Find-the-last-Sunday-of-each-month b/Lang/M2000-Interpreter/Find-the-last-Sunday-of-each-month new file mode 120000 index 0000000000..14e77f2ff4 --- /dev/null +++ b/Lang/M2000-Interpreter/Find-the-last-Sunday-of-each-month @@ -0,0 +1 @@ +../../Task/Find-the-last-Sunday-of-each-month/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/K-d-tree b/Lang/M2000-Interpreter/K-d-tree new file mode 120000 index 0000000000..5f1e9bff31 --- /dev/null +++ b/Lang/M2000-Interpreter/K-d-tree @@ -0,0 +1 @@ +../../Task/K-d-tree/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Old-lady-swallowed-a-fly b/Lang/M2000-Interpreter/Old-lady-swallowed-a-fly new file mode 120000 index 0000000000..f9fe169db2 --- /dev/null +++ b/Lang/M2000-Interpreter/Old-lady-swallowed-a-fly @@ -0,0 +1 @@ +../../Task/Old-lady-swallowed-a-fly/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Password-generator b/Lang/M2000-Interpreter/Password-generator new file mode 120000 index 0000000000..0b48ccbf39 --- /dev/null +++ b/Lang/M2000-Interpreter/Password-generator @@ -0,0 +1 @@ +../../Task/Password-generator/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Problem-of-Apollonius b/Lang/M2000-Interpreter/Problem-of-Apollonius new file mode 120000 index 0000000000..3c1d7459c0 --- /dev/null +++ b/Lang/M2000-Interpreter/Problem-of-Apollonius @@ -0,0 +1 @@ +../../Task/Problem-of-Apollonius/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Stable-marriage-problem b/Lang/M2000-Interpreter/Stable-marriage-problem new file mode 120000 index 0000000000..1148451e3c --- /dev/null +++ b/Lang/M2000-Interpreter/Stable-marriage-problem @@ -0,0 +1 @@ +../../Task/Stable-marriage-problem/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Statistics-Basic b/Lang/M2000-Interpreter/Statistics-Basic new file mode 120000 index 0000000000..9d5dab6ba7 --- /dev/null +++ b/Lang/M2000-Interpreter/Statistics-Basic @@ -0,0 +1 @@ +../../Task/Statistics-Basic/M2000-Interpreter \ No newline at end of file diff --git a/Lang/M2000-Interpreter/Statistics-Normal-distribution b/Lang/M2000-Interpreter/Statistics-Normal-distribution new file mode 120000 index 0000000000..6018d24b87 --- /dev/null +++ b/Lang/M2000-Interpreter/Statistics-Normal-distribution @@ -0,0 +1 @@ +../../Task/Statistics-Normal-distribution/M2000-Interpreter \ No newline at end of file diff --git a/Lang/MSX-Basic/Colour-pinstripe-Display b/Lang/MSX-Basic/Colour-pinstripe-Display new file mode 120000 index 0000000000..f0497934ea --- /dev/null +++ b/Lang/MSX-Basic/Colour-pinstripe-Display @@ -0,0 +1 @@ +../../Task/Colour-pinstripe-Display/MSX-Basic \ No newline at end of file diff --git a/Lang/MSX-Basic/Pinstripe-Display b/Lang/MSX-Basic/Pinstripe-Display new file mode 120000 index 0000000000..b37582657e --- /dev/null +++ b/Lang/MSX-Basic/Pinstripe-Display @@ -0,0 +1 @@ +../../Task/Pinstripe-Display/MSX-Basic \ No newline at end of file diff --git a/Lang/Mathematica/Prime-numbers-whose-neighboring-pairs-are-tetraprimes b/Lang/Mathematica/Prime-numbers-whose-neighboring-pairs-are-tetraprimes new file mode 120000 index 0000000000..e8da31b0d4 --- /dev/null +++ b/Lang/Mathematica/Prime-numbers-whose-neighboring-pairs-are-tetraprimes @@ -0,0 +1 @@ +../../Task/Prime-numbers-whose-neighboring-pairs-are-tetraprimes/Mathematica \ No newline at end of file diff --git a/Lang/Miranda/Fractran b/Lang/Miranda/Fractran new file mode 120000 index 0000000000..528ab3ee2e --- /dev/null +++ b/Lang/Miranda/Fractran @@ -0,0 +1 @@ +../../Task/Fractran/Miranda \ No newline at end of file diff --git a/Lang/OxygenBasic/Loops-Continue b/Lang/OxygenBasic/Loops-Continue new file mode 120000 index 0000000000..df4c4e529e --- /dev/null +++ b/Lang/OxygenBasic/Loops-Continue @@ -0,0 +1 @@ +../../Task/Loops-Continue/OxygenBasic \ No newline at end of file diff --git a/Lang/PascalABC.NET/Emirp-primes b/Lang/PascalABC.NET/Emirp-primes new file mode 120000 index 0000000000..69e5f4d7f7 --- /dev/null +++ b/Lang/PascalABC.NET/Emirp-primes @@ -0,0 +1 @@ +../../Task/Emirp-primes/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Evolutionary-algorithm b/Lang/PascalABC.NET/Evolutionary-algorithm new file mode 120000 index 0000000000..bc9856dbc0 --- /dev/null +++ b/Lang/PascalABC.NET/Evolutionary-algorithm @@ -0,0 +1 @@ +../../Task/Evolutionary-algorithm/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Exceptions-Catch-an-exception-thrown-in-a-nested-call b/Lang/PascalABC.NET/Exceptions-Catch-an-exception-thrown-in-a-nested-call new file mode 120000 index 0000000000..7cf9286a5e --- /dev/null +++ b/Lang/PascalABC.NET/Exceptions-Catch-an-exception-thrown-in-a-nested-call @@ -0,0 +1 @@ +../../Task/Exceptions-Catch-an-exception-thrown-in-a-nested-call/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Execute-a-system-command b/Lang/PascalABC.NET/Execute-a-system-command new file mode 120000 index 0000000000..7b3f5b40fe --- /dev/null +++ b/Lang/PascalABC.NET/Execute-a-system-command @@ -0,0 +1 @@ +../../Task/Execute-a-system-command/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Exponentiation-order b/Lang/PascalABC.NET/Exponentiation-order new file mode 120000 index 0000000000..7066d9dd6b --- /dev/null +++ b/Lang/PascalABC.NET/Exponentiation-order @@ -0,0 +1 @@ +../../Task/Exponentiation-order/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Exponentiation-with-infix-operators-in-or-operating-on-the-base b/Lang/PascalABC.NET/Exponentiation-with-infix-operators-in-or-operating-on-the-base new file mode 120000 index 0000000000..cc33366128 --- /dev/null +++ b/Lang/PascalABC.NET/Exponentiation-with-infix-operators-in-or-operating-on-the-base @@ -0,0 +1 @@ +../../Task/Exponentiation-with-infix-operators-in-or-operating-on-the-base/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Extend-your-language b/Lang/PascalABC.NET/Extend-your-language new file mode 120000 index 0000000000..ee51376fd1 --- /dev/null +++ b/Lang/PascalABC.NET/Extend-your-language @@ -0,0 +1 @@ +../../Task/Extend-your-language/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Extensible-prime-generator b/Lang/PascalABC.NET/Extensible-prime-generator new file mode 120000 index 0000000000..c255987252 --- /dev/null +++ b/Lang/PascalABC.NET/Extensible-prime-generator @@ -0,0 +1 @@ +../../Task/Extensible-prime-generator/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Factorial-primes b/Lang/PascalABC.NET/Factorial-primes new file mode 120000 index 0000000000..5b7eb12507 --- /dev/null +++ b/Lang/PascalABC.NET/Factorial-primes @@ -0,0 +1 @@ +../../Task/Factorial-primes/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Factorions b/Lang/PascalABC.NET/Factorions new file mode 120000 index 0000000000..8d771f5a56 --- /dev/null +++ b/Lang/PascalABC.NET/Factorions @@ -0,0 +1 @@ +../../Task/Factorions/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Factors-of-a-Mersenne-number b/Lang/PascalABC.NET/Factors-of-a-Mersenne-number new file mode 120000 index 0000000000..3160230a03 --- /dev/null +++ b/Lang/PascalABC.NET/Factors-of-a-Mersenne-number @@ -0,0 +1 @@ +../../Task/Factors-of-a-Mersenne-number/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Fairshare-between-two-and-more b/Lang/PascalABC.NET/Fairshare-between-two-and-more new file mode 120000 index 0000000000..c21d1ab427 --- /dev/null +++ b/Lang/PascalABC.NET/Fairshare-between-two-and-more @@ -0,0 +1 @@ +../../Task/Fairshare-between-two-and-more/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Farey-sequence b/Lang/PascalABC.NET/Farey-sequence new file mode 120000 index 0000000000..cd060f6fa5 --- /dev/null +++ b/Lang/PascalABC.NET/Farey-sequence @@ -0,0 +1 @@ +../../Task/Farey-sequence/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Feigenbaum-constant-calculation b/Lang/PascalABC.NET/Feigenbaum-constant-calculation new file mode 120000 index 0000000000..df0fd85992 --- /dev/null +++ b/Lang/PascalABC.NET/Feigenbaum-constant-calculation @@ -0,0 +1 @@ +../../Task/Feigenbaum-constant-calculation/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Fermat-numbers b/Lang/PascalABC.NET/Fermat-numbers new file mode 120000 index 0000000000..87303a8419 --- /dev/null +++ b/Lang/PascalABC.NET/Fermat-numbers @@ -0,0 +1 @@ +../../Task/Fermat-numbers/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Fibonacci-word b/Lang/PascalABC.NET/Fibonacci-word new file mode 120000 index 0000000000..6accc7df5c --- /dev/null +++ b/Lang/PascalABC.NET/Fibonacci-word @@ -0,0 +1 @@ +../../Task/Fibonacci-word/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Fibonacci-word-fractal b/Lang/PascalABC.NET/Fibonacci-word-fractal new file mode 120000 index 0000000000..32647433c7 --- /dev/null +++ b/Lang/PascalABC.NET/Fibonacci-word-fractal @@ -0,0 +1 @@ +../../Task/Fibonacci-word-fractal/PascalABC.NET \ No newline at end of file diff --git a/Lang/PascalABC.NET/Five-weekends b/Lang/PascalABC.NET/Five-weekends new file mode 120000 index 0000000000..868fa3eedb --- /dev/null +++ b/Lang/PascalABC.NET/Five-weekends @@ -0,0 +1 @@ +../../Task/Five-weekends/PascalABC.NET \ No newline at end of file diff --git a/Lang/Pike/Execute-Brain- b/Lang/Pike/Execute-Brain- new file mode 120000 index 0000000000..dd7ee4c73b --- /dev/null +++ b/Lang/Pike/Execute-Brain- @@ -0,0 +1 @@ +../../Task/Execute-Brain-/Pike \ No newline at end of file diff --git a/Lang/Plain-English/00-LANG.txt b/Lang/Plain-English/00-LANG.txt index ff86a2a8e2..d3044419f6 100644 --- a/Lang/Plain-English/00-LANG.txt +++ b/Lang/Plain-English/00-LANG.txt @@ -43,21 +43,25 @@ and it can do a few other things. To run: -Start up. -Clear the screen. -Use medium letters. Use the fat pen. -Pick a really dark color. -Loop. -Start in the center of the screen. -Turn left 1/32 of the way. -Turn right. Move 2 inches. Turn left. -Write "HELLO WORLD". -Refresh the screen. -Lighten the current color about 20 percent. -Add 1 to a count. If the count is 32, break. -Repeat. -Wait for the escape key. -Shut down. + Start up. + Clear the screen. + Use medium letters. + Use the fat pen. + Pick a really dark color. + Loop. + Start in the center of the screen. + Turn left 1/32 of the way. + Turn right. + Move 2 inches. + Turn left. + Write "HELLO WORLD". + Refresh the screen. + Lighten the current color about 20 percent. + Add 1 to a count. + If the count is 32, break. + Repeat. + Wait for the escape key. + Shut down. Note that standard English punctuation, word types, and sentence structure are all used. @@ -172,8 +176,8 @@ Type reductions proceed, recursively, from left to right, until a match is found To decide if a number is greater than another number: -If the first number is greater than the second number, say yes. -Say no. + If the first number is greater than the second number, say yes. + Say no. '''Function:''' A routine that extracts, calculates, or otherwise derives a value from a passed parameter. Function headers take this form: @@ -187,14 +191,14 @@ Unlike procedures (which are called via imperative sentences) and deciders (whic '''Statements''' From the instruction manual (see link below): -(1) I really only understand five kinds of sentences: -(a) type definitions, which always start with A, AN, or SOME; -(b) global variable definitions, which always start with THE; -(c) routine headers, which always start with TO, which can contain: -(d) conditional statements, which always start with IF; and -(e) imperative statements, which start with anything else. +(1) The compiler really only understand five kinds of sentences: +(a) Type definitions, which always start with A, AN, or SOME; +(b) Global variable definitions, which always start with THE; +(c) Routine headers, which always start with TO, which can contain: +(d) Conditional statements, which always start with IF; and +(e) Imperative statements, which start with anything else. -(2) I treat as a name anything after A, AN, ANOTHER, SOME, or THE, up to: +(2) I treat as a name (that is, a variable, argument, parameter or a type) anything after A, AN, ANOTHER, SOME, or THE, up to: (a) any simple verb, like IS, ARE, CAN, or DO, or (b) any conjunction, like AND or OR, or @@ -211,7 +215,9 @@ From the instruction manual (see link below): The noodle built into Plain English is simply not useful enough by itself, and therefore libraries were created to assist in writing Rosetta Code tasks in Plain English. See also: -https://github.com/Folds/english A work in progress to normalize Plain English into a more standard compiler. For documentation on the language in general, see the instructions.pdf file in the documentation folder. The author objects (see the issues) +https://github.com/Folds/english A work in progress to normalize Plain English into a more standard compiler. +For documentation on the language in general, see the instructions.pdf file in the documentation folder. +The author objects (see the issues) https://forums.parallax.com/discussion/163792/plain-english-programming a long rambling and unproductive (but educational, so productive in that sense) discussion of Plain English with it's author and proponents of a bare metal processor. {| class="wikitable" diff --git a/Lang/QB64/Averages-Mean-angle b/Lang/QB64/Averages-Mean-angle new file mode 120000 index 0000000000..aab53ced3a --- /dev/null +++ b/Lang/QB64/Averages-Mean-angle @@ -0,0 +1 @@ +../../Task/Averages-Mean-angle/QB64 \ No newline at end of file diff --git a/Lang/QB64/Intersecting-number-wheels b/Lang/QB64/Intersecting-number-wheels new file mode 120000 index 0000000000..226a608551 --- /dev/null +++ b/Lang/QB64/Intersecting-number-wheels @@ -0,0 +1 @@ +../../Task/Intersecting-number-wheels/QB64 \ No newline at end of file diff --git a/Lang/QB64/Mayan-calendar b/Lang/QB64/Mayan-calendar new file mode 120000 index 0000000000..13deaa3e8a --- /dev/null +++ b/Lang/QB64/Mayan-calendar @@ -0,0 +1 @@ +../../Task/Mayan-calendar/QB64 \ No newline at end of file diff --git a/Lang/QBasic/Averages-Mean-angle b/Lang/QBasic/Averages-Mean-angle new file mode 120000 index 0000000000..499df28583 --- /dev/null +++ b/Lang/QBasic/Averages-Mean-angle @@ -0,0 +1 @@ +../../Task/Averages-Mean-angle/QBasic \ No newline at end of file diff --git a/Lang/QBasic/Loops-Continue b/Lang/QBasic/Loops-Continue new file mode 120000 index 0000000000..eeea4ac585 --- /dev/null +++ b/Lang/QBasic/Loops-Continue @@ -0,0 +1 @@ +../../Task/Loops-Continue/QBasic \ No newline at end of file diff --git a/Lang/QBasic/Pinstripe-Display b/Lang/QBasic/Pinstripe-Display new file mode 120000 index 0000000000..f245a0ccf2 --- /dev/null +++ b/Lang/QBasic/Pinstripe-Display @@ -0,0 +1 @@ +../../Task/Pinstripe-Display/QBasic \ No newline at end of file diff --git a/Lang/REXX/Goldbachs-comet b/Lang/REXX/Goldbachs-comet new file mode 120000 index 0000000000..ddf76b927f --- /dev/null +++ b/Lang/REXX/Goldbachs-comet @@ -0,0 +1 @@ +../../Task/Goldbachs-comet/REXX \ No newline at end of file diff --git a/Lang/Refal/Arbitrary-precision-integers-included- b/Lang/Refal/Arbitrary-precision-integers-included- new file mode 120000 index 0000000000..f00d324a4e --- /dev/null +++ b/Lang/Refal/Arbitrary-precision-integers-included- @@ -0,0 +1 @@ +../../Task/Arbitrary-precision-integers-included-/Refal \ No newline at end of file diff --git a/Lang/Refal/Fractran b/Lang/Refal/Fractran new file mode 120000 index 0000000000..30b9e7a511 --- /dev/null +++ b/Lang/Refal/Fractran @@ -0,0 +1 @@ +../../Task/Fractran/Refal \ No newline at end of file diff --git a/Lang/Refal/Sierpinski-triangle b/Lang/Refal/Sierpinski-triangle new file mode 120000 index 0000000000..078d645de8 --- /dev/null +++ b/Lang/Refal/Sierpinski-triangle @@ -0,0 +1 @@ +../../Task/Sierpinski-triangle/Refal \ No newline at end of file diff --git a/Lang/Rust/Almkvist-Giullera-formula-for-pi b/Lang/Rust/Almkvist-Giullera-formula-for-pi new file mode 120000 index 0000000000..495c52095c --- /dev/null +++ b/Lang/Rust/Almkvist-Giullera-formula-for-pi @@ -0,0 +1 @@ +../../Task/Almkvist-Giullera-formula-for-pi/Rust \ No newline at end of file diff --git a/Lang/Rust/Biorhythms b/Lang/Rust/Biorhythms new file mode 120000 index 0000000000..8d5ffa21d8 --- /dev/null +++ b/Lang/Rust/Biorhythms @@ -0,0 +1 @@ +../../Task/Biorhythms/Rust \ No newline at end of file diff --git a/Lang/Rust/Stern-Brocot-sequence b/Lang/Rust/Stern-Brocot-sequence new file mode 120000 index 0000000000..72080b645a --- /dev/null +++ b/Lang/Rust/Stern-Brocot-sequence @@ -0,0 +1 @@ +../../Task/Stern-Brocot-sequence/Rust \ No newline at end of file diff --git a/Lang/Rust/Subleq b/Lang/Rust/Subleq new file mode 120000 index 0000000000..cc28544f34 --- /dev/null +++ b/Lang/Rust/Subleq @@ -0,0 +1 @@ +../../Task/Subleq/Rust \ No newline at end of file diff --git a/Lang/Rust/Tropical-algebra-overloading b/Lang/Rust/Tropical-algebra-overloading new file mode 120000 index 0000000000..271296f0b3 --- /dev/null +++ b/Lang/Rust/Tropical-algebra-overloading @@ -0,0 +1 @@ +../../Task/Tropical-algebra-overloading/Rust \ No newline at end of file diff --git a/Lang/Rust/Vogels-approximation-method b/Lang/Rust/Vogels-approximation-method new file mode 120000 index 0000000000..377b0aef0a --- /dev/null +++ b/Lang/Rust/Vogels-approximation-method @@ -0,0 +1 @@ +../../Task/Vogels-approximation-method/Rust \ No newline at end of file diff --git a/Lang/S-BASIC/Determine-if-a-string-has-all-unique-characters b/Lang/S-BASIC/Determine-if-a-string-has-all-unique-characters new file mode 120000 index 0000000000..f2a5cead6b --- /dev/null +++ b/Lang/S-BASIC/Determine-if-a-string-has-all-unique-characters @@ -0,0 +1 @@ +../../Task/Determine-if-a-string-has-all-unique-characters/S-BASIC \ No newline at end of file diff --git a/Lang/SETL/Arbitrary-precision-integers-included- b/Lang/SETL/Arbitrary-precision-integers-included- new file mode 120000 index 0000000000..36386fe719 --- /dev/null +++ b/Lang/SETL/Arbitrary-precision-integers-included- @@ -0,0 +1 @@ +../../Task/Arbitrary-precision-integers-included-/SETL \ No newline at end of file diff --git a/Lang/SETL/Fractran b/Lang/SETL/Fractran new file mode 120000 index 0000000000..20f759abeb --- /dev/null +++ b/Lang/SETL/Fractran @@ -0,0 +1 @@ +../../Task/Fractran/SETL \ No newline at end of file diff --git a/Lang/SETL/Mayan-numerals b/Lang/SETL/Mayan-numerals new file mode 120000 index 0000000000..fd50100876 --- /dev/null +++ b/Lang/SETL/Mayan-numerals @@ -0,0 +1 @@ +../../Task/Mayan-numerals/SETL \ No newline at end of file diff --git a/Lang/SETL/Range-consolidation b/Lang/SETL/Range-consolidation new file mode 120000 index 0000000000..b24d504011 --- /dev/null +++ b/Lang/SETL/Range-consolidation @@ -0,0 +1 @@ +../../Task/Range-consolidation/SETL \ No newline at end of file diff --git a/Lang/Standard-ML/Averages-Mean-angle b/Lang/Standard-ML/Averages-Mean-angle new file mode 120000 index 0000000000..38ef0bd393 --- /dev/null +++ b/Lang/Standard-ML/Averages-Mean-angle @@ -0,0 +1 @@ +../../Task/Averages-Mean-angle/Standard-ML \ No newline at end of file diff --git a/Lang/Standard-ML/Averages-Simple-moving-average b/Lang/Standard-ML/Averages-Simple-moving-average new file mode 120000 index 0000000000..6dd59a5e2f --- /dev/null +++ b/Lang/Standard-ML/Averages-Simple-moving-average @@ -0,0 +1 @@ +../../Task/Averages-Simple-moving-average/Standard-ML \ No newline at end of file diff --git a/Lang/V-(Vlang)/00-LANG.txt b/Lang/V-(Vlang)/00-LANG.txt index dfc23e4e27..d8ee4e2c69 100644 --- a/Lang/V-(Vlang)/00-LANG.txt +++ b/Lang/V-(Vlang)/00-LANG.txt @@ -13,7 +13,7 @@ ''Simple, fast, safe, compiled. For developing maintainable software.''

-'''Note: V is also known as Vlang. There was a language naming collision, so V (Vlang) was chosen.''' +'''Note: V (or Vlang). There was a language naming collision, so V (Vlang) was chosen.''' V (Vlang) is used here on Rosetta Code to disambiguate from the other language called [[:Category:V|V]]. @@ -38,55 +38,41 @@ V language review and documentation are [https://github.com/vlang/v/blob/master/ * More info on the below can be found at [https://modules.vlang.io/ modules used by V] {| class="wikitable" -! No. !! Module name !! !! No. !! Module name +! No. !! Module name !! !! No. !! Module name !! !! No. !! Module name |- -| 1 || [https://rosettacode.org/wiki/Category:Vlang-arrays arrays] || || 2 || [https://rosettacode.org/wiki/Category:Vlang-benchmark benchmark] +| 1 || [https://modules.vlang.io/arrays.html arrays] || || 2 || [https://modules.vlang.io/benchmark.html benchmark] || || 3 || [https://modules.vlang.io/bitfield.html bifield] |- -| 3 || [https://rosettacode.org/wiki/Category:Vlang-bifield bifield] || || 4 || [https://rosettacode.org/wiki/Category:Vlang-cli cli] +| 4 || [https://modules.vlang.io/cli.html cli] || || 5 || [https://modules.vlang.io/clipboard.html clipboard] || || 6 || [https://modules.vlang.io/compress.html compress] |- -| 5 || [https://rosettacode.org/wiki/Category:Vlang-clipboard clipboard] || || 6 || [https://rosettacode.org/wiki/Category:Vlang-compress compress] +| 7 || [https://modules.vlang.io/context.html context] || || 8 || [https://modules.vlang.io/crypto.html crypto] || || 9 || [https://modules.vlang.io/net.websocket.html websocket] |- -| 7 || [https://rosettacode.org/wiki/Category:Vlang-context context] || || 8 || [https://rosettacode.org/wiki/Category:Vlang-crypto crypto] +| 10 || [https://modules.vlang.io/datatypes.html datatypes] || || 11 || [https://modules.vlang.io/main.html main] || || 12 || [https://modules.vlang.io/dl.html dl] |- -| 9 || [https://rosettacode.org/wiki/Category:Vlang-darwin darwin] || || 10 || [https://rosettacode.org/wiki/Category:Vlang-datatypes datatypes] +| 13 || [https://modules.vlang.io/dlmalloc.html dlmalloc] || || 14 || [https://modules.vlang.io/encoding.html encoding] || || 15 || [https://modules.vlang.io/eventbus.html eventbus] |- -| 11 || [https://rosettacode.org/wiki/Category:Vlang-main main] || || 12 || [https://rosettacode.org/wiki/Category:Vlang-dl dl] +| 16 || [https://modules.vlang.io/flag.html flag] || || 17 || [https://modules.vlang.io/fontstash.html fontstash] || || 18 || [https://modules.vlang.io/gg.html gg] |- -| 13 || [https://rosettacode.org/wiki/Category:Vlang-dlmalloc dlmalloc] || || 14 || [https://rosettacode.org/wiki/Category:Vlang-encoding encoding] +| 19 || [https://modules.vlang.io/gx.html gx] || || 20 || [https://modules.vlang.io/hash.html hash] || || 21 || [https://modules.vlang.io/io.html io] |- -| 15 || [https://rosettacode.org/wiki/Category:Vlang-eventbus eventbus] || || 16 || [https://rosettacode.org/wiki/Category:Vlang-flag flag] +| 22 || [https://modules.vlang.io/json.html json] || || 23 || [https://modules.vlang.io/log.html log] || || 24 || [https://modules.vlang.io/math.html math] |- -| 17 || [https://rosettacode.org/wiki/Category:Vlang-fontstash fontstash] || || 18 || [https://rosettacode.org/wiki/Category:Vlang-gg gg] +| 25 || [https://modules.vlang.io/db.mssql.html mssql] || || 26 || [https://modules.vlang.io/db.mysql.html mysql] || || 27 || [https://modules.vlang.io/net.html net] |- -| 19 || [https://rosettacode.org/wiki/Category:Vlang-gx gx] || || 20 || [https://rosettacode.org/wiki/Category:Vlang-crypto hash] +| 28 || [https://modules.vlang.io/orm.html orm] || || 29 || [https://modules.vlang.io/os.html os] || || 30 || [https://modules.vlang.io/pg.html pg] |- -| 21 || [https://rosettacode.org/wiki/Category:Vlang-io io] || || 22 || [https://rosettacode.org/wiki/Category:Vlang-json json] +| 31 || [https://modules.vlang.io/picoev.html picoev] || || 32 || [https://modules.vlang.io/veb.html veb] || || 33 || [https://modules.vlang.io/picohttpparser.html picohttpparser] |- -| 23 || [https://rosettacode.org/wiki/Category:Vlang-log log] || || 24 || [https://rosettacode.org/wiki/Category:Vlang-math math] +| 34 || [https://modules.vlang.io/rand.html rand]|| || 35 || [https://modules.vlang.io/readline.html readline] || || 36 || [https://modules.vlang.io/regex.html regex] |- -| 25 || [https://rosettacode.org/wiki/Category:Vlang-mssql mssql] || || 26 || [https://rosettacode.org/wiki/Category:Vlang-mysql mysql] +| 37 || [https://modules.vlang.io/runtime.html runtime] || || 38 || [https://modules.vlang.io/semver.html semver] || || 39 || [https://modules.vlang.io/sokol.sapp.html sokol.sapp] |- -| 27 || [https://rosettacode.org/wiki/Category:Vlang-net net] || || 28 || [https://rosettacode.org/wiki/Category:Vlang-orm orm] +| 40 || [https://modules.vlang.io/db.sqlite.html sqlite] || || 41 || [https://modules.vlang.io/stbi.html stbi] || || 42 || [https://modules.vlang.io/strconv.html strconv] |- -| 29 || [https://rosettacode.org/wiki/Category:Vlang-os os] || || 30 || [https://rosettacode.org/wiki/Category:Vlang-pg pg] +| 43 || [https://modules.vlang.io/strings.html strings] || || 44 || [https://modules.vlang.io/sync.html sync] || || 45 || [https://modules.vlang.io/szip.html szip] |- -| 31 || [https://rosettacode.org/wiki/Category:Vlang-picoev picoev] || || 32 || [https://rosettacode.org/wiki/Category:Vlang-veb veb] +| 46 || [https://modules.vlang.io/term.html term] || || 47 || [https://modules.vlang.io/time.html time] || || 48 || [https://modules.vlang.io/toml.html toml] |- -| 33 || [https://rosettacode.org/wiki/Category:Vlang-picohttpparser picohttpparser] || || 34 || [https://rosettacode.org/wiki/Category:Vlang-rand rand] +| 49 || [https://modules.vlang.io/vweb.html vweb] || || 50 || [https://modules.vlang.io/wasm.html wasm] || || 51 || [https://modules.vlang.io/maps.html maps] |- -| 35 || [https://rosettacode.org/wiki/Category:Vlang-readline readline] || || 36 || [https://rosettacode.org/wiki/Category:Vlang-regex regex] -|- -| 37 || [https://rosettacode.org/wiki/Category:Vlang-runtime runtime] || || 38 || [https://rosettacode.org/wiki/Category:Vlang-semver semver] -|- -| 39 || [https://rosettacode.org/wiki/Category:Vlang-sokol sokol] || || 40 || [https://rosettacode.org/wiki/Category:Vlang-sqlite sqlite] -|- -| 41 || [https://rosettacode.org/wiki/Category:Vlang-stbi stbi] || || 42 || [https://rosettacode.org/wiki/Category:Vlang-strconv strconv] -|- -| 43 || [https://rosettacode.org/wiki/Category:Vlang-strings strings] || || 44 || [https://rosettacode.org/wiki/Category:Vlang-sync sync] -|- -| 45 || [https://rosettacode.org/wiki/Category:Vlang-szip szip] || || 46 || [https://rosettacode.org/wiki/Category:Vlang-term term] -|- -| 47 || [https://rosettacode.org/wiki/Category:Vlang-time time] || || 48 || [https://rosettacode.org/wiki/Category:Vlang-toml toml] -|- -| 49 || [https://rosettacode.org/wiki/Category:Vlang-vweb vweb] || || 50 || [https://rosettacode.org/wiki/Category:Vlang-wasm wasm] +| 52 || [https://modules.vlang.io/sokol.audio.html sokol.audio] || || 53 || [https://modules.vlang.io/x.ttf.html ttf] || || 54 || [https://modules.vlang.io/x.json2.html json2] |} \ No newline at end of file diff --git a/Lang/V-(Vlang)/Find-the-last-Sunday-of-each-month b/Lang/V-(Vlang)/Find-the-last-Sunday-of-each-month new file mode 120000 index 0000000000..8c3dbc9a79 --- /dev/null +++ b/Lang/V-(Vlang)/Find-the-last-Sunday-of-each-month @@ -0,0 +1 @@ +../../Task/Find-the-last-Sunday-of-each-month/V-(Vlang) \ No newline at end of file diff --git a/Lang/V-(Vlang)/Monads-List-monad b/Lang/V-(Vlang)/Monads-List-monad new file mode 120000 index 0000000000..60c249323a --- /dev/null +++ b/Lang/V-(Vlang)/Monads-List-monad @@ -0,0 +1 @@ +../../Task/Monads-List-monad/V-(Vlang) \ No newline at end of file diff --git a/Lang/V-(Vlang)/Pascals-triangle b/Lang/V-(Vlang)/Pascals-triangle new file mode 120000 index 0000000000..91982b11d4 --- /dev/null +++ b/Lang/V-(Vlang)/Pascals-triangle @@ -0,0 +1 @@ +../../Task/Pascals-triangle/V-(Vlang) \ No newline at end of file diff --git a/Lang/V-(Vlang)/Probabilistic-choice b/Lang/V-(Vlang)/Probabilistic-choice new file mode 120000 index 0000000000..5f44e37240 --- /dev/null +++ b/Lang/V-(Vlang)/Probabilistic-choice @@ -0,0 +1 @@ +../../Task/Probabilistic-choice/V-(Vlang) \ No newline at end of file diff --git a/Lang/V-(Vlang)/Transliterate-English-text-using-the-Greek-alphabet b/Lang/V-(Vlang)/Transliterate-English-text-using-the-Greek-alphabet new file mode 120000 index 0000000000..9c6f1c38d1 --- /dev/null +++ b/Lang/V-(Vlang)/Transliterate-English-text-using-the-Greek-alphabet @@ -0,0 +1 @@ +../../Task/Transliterate-English-text-using-the-Greek-alphabet/V-(Vlang) \ No newline at end of file diff --git a/Lang/V-(Vlang)/Word-frequency b/Lang/V-(Vlang)/Word-frequency new file mode 120000 index 0000000000..7472df9d00 --- /dev/null +++ b/Lang/V-(Vlang)/Word-frequency @@ -0,0 +1 @@ +../../Task/Word-frequency/V-(Vlang) \ No newline at end of file diff --git a/Lang/Visual-Basic-.NET/Execute-Brain- b/Lang/Visual-Basic-.NET/Execute-Brain- new file mode 120000 index 0000000000..40c465e5ff --- /dev/null +++ b/Lang/Visual-Basic-.NET/Execute-Brain- @@ -0,0 +1 @@ +../../Task/Execute-Brain-/Visual-Basic-.NET \ No newline at end of file diff --git a/Lang/XPL0/Count-the-coins b/Lang/XPL0/Count-the-coins new file mode 120000 index 0000000000..7a91396756 --- /dev/null +++ b/Lang/XPL0/Count-the-coins @@ -0,0 +1 @@ +../../Task/Count-the-coins/XPL0 \ No newline at end of file diff --git a/Lang/XPL0/Currency b/Lang/XPL0/Currency new file mode 120000 index 0000000000..05aee1c3b1 --- /dev/null +++ b/Lang/XPL0/Currency @@ -0,0 +1 @@ +../../Task/Currency/XPL0 \ No newline at end of file diff --git a/Lang/XPL0/Gaussian-elimination b/Lang/XPL0/Gaussian-elimination new file mode 120000 index 0000000000..6a178b8f16 --- /dev/null +++ b/Lang/XPL0/Gaussian-elimination @@ -0,0 +1 @@ +../../Task/Gaussian-elimination/XPL0 \ No newline at end of file diff --git a/Lang/XPL0/IBAN b/Lang/XPL0/IBAN new file mode 120000 index 0000000000..ce771b5589 --- /dev/null +++ b/Lang/XPL0/IBAN @@ -0,0 +1 @@ +../../Task/IBAN/XPL0 \ No newline at end of file diff --git a/Lang/XPL0/Left-factorials b/Lang/XPL0/Left-factorials new file mode 120000 index 0000000000..c9ff64d1b6 --- /dev/null +++ b/Lang/XPL0/Left-factorials @@ -0,0 +1 @@ +../../Task/Left-factorials/XPL0 \ No newline at end of file diff --git a/Lang/XPL0/Long-primes b/Lang/XPL0/Long-primes new file mode 120000 index 0000000000..4b515cb676 --- /dev/null +++ b/Lang/XPL0/Long-primes @@ -0,0 +1 @@ +../../Task/Long-primes/XPL0 \ No newline at end of file diff --git a/Lang/XPL0/Modified-random-distribution b/Lang/XPL0/Modified-random-distribution new file mode 120000 index 0000000000..dfbceea492 --- /dev/null +++ b/Lang/XPL0/Modified-random-distribution @@ -0,0 +1 @@ +../../Task/Modified-random-distribution/XPL0 \ No newline at end of file diff --git a/Lang/XPL0/Sierpinski-square-curve b/Lang/XPL0/Sierpinski-square-curve new file mode 120000 index 0000000000..f8060a7322 --- /dev/null +++ b/Lang/XPL0/Sierpinski-square-curve @@ -0,0 +1 @@ +../../Task/Sierpinski-square-curve/XPL0 \ No newline at end of file diff --git a/Lang/XPL0/Subtractive-generator b/Lang/XPL0/Subtractive-generator new file mode 120000 index 0000000000..e69b094ce6 --- /dev/null +++ b/Lang/XPL0/Subtractive-generator @@ -0,0 +1 @@ +../../Task/Subtractive-generator/XPL0 \ No newline at end of file diff --git a/Lang/XPL0/Thieles-interpolation-formula b/Lang/XPL0/Thieles-interpolation-formula new file mode 120000 index 0000000000..fcd209a547 --- /dev/null +++ b/Lang/XPL0/Thieles-interpolation-formula @@ -0,0 +1 @@ +../../Task/Thieles-interpolation-formula/XPL0 \ No newline at end of file diff --git a/Lang/XPL0/World-Cup-group-stage b/Lang/XPL0/World-Cup-group-stage new file mode 120000 index 0000000000..4312a43d55 --- /dev/null +++ b/Lang/XPL0/World-Cup-group-stage @@ -0,0 +1 @@ +../../Task/World-Cup-group-stage/XPL0 \ No newline at end of file diff --git a/Lang/Yabasic/Averages-Mean-angle b/Lang/Yabasic/Averages-Mean-angle new file mode 120000 index 0000000000..ee2478f1ef --- /dev/null +++ b/Lang/Yabasic/Averages-Mean-angle @@ -0,0 +1 @@ +../../Task/Averages-Mean-angle/Yabasic \ No newline at end of file diff --git a/Task/100-doors/00-TASK.txt b/Task/100-doors/00-TASK.txt index fd7471448b..f3737c40a0 100644 --- a/Task/100-doors/00-TASK.txt +++ b/Task/100-doors/00-TASK.txt @@ -20,3 +20,8 @@ Opening only those doors is an   [[task feature::Rosetta Code:optimization| however, as should be obvious, this defeats the intent of comparing implementations across programming languages.

+;Why doesn't syntax highlighting work on this page ?: +Currently, there is a limit on how many <syntaxhighlight> tags can appear on a page, so only the first few languages get highlighting, the rest are shown in monochrome.
+You could try "manual highlighting", possibly using one of the highlighters on [[Syntax highlighting using Mediawiki formatting]] or something similar. + + diff --git a/Task/100-doors/Plain-English/100-doors.plain b/Task/100-doors/Plain-English/100-doors.plain index f6ee5c1b2e..809fe08e73 100644 --- a/Task/100-doors/Plain-English/100-doors.plain +++ b/Task/100-doors/Plain-English/100-doors.plain @@ -6,6 +6,7 @@ Clear the door's flag. Append the door to the doors. Repeat. +A flag thing is a thing with a flag. A door is a flag thing. To go through some doors given a number and some passes: diff --git a/Task/100-doors/YAMLScript/100-doors.ys b/Task/100-doors/YAMLScript/100-doors.ys index 918b5e5f0a..23c45269c2 100644 --- a/Task/100-doors/YAMLScript/100-doors.ys +++ b/Task/100-doors/YAMLScript/100-doors.ys @@ -1,17 +1,14 @@ !yamlscript/v0 defn main(): - say: |- - Open doors after 100 passes: - $(open-doors().join(', ')) - -defn open-doors(): - ? for [d n] map(vector doors() range().drop(1)) - :when d - : n - -defn doors(): - reduce: - fn(doors idx): doors.assoc(idx true) - into []: repeat(100 false) - map \(sqr(_).--): 1 .. 10 + open =: + reduce _ vec([true] * 100) (1 .. 100): + fn(doors i): + loop j i, doors doors: + if j < 100: + recur (j + i).++: + update-in doors [j]: \(doors.$j.!) + else: doors + say: -"Open doors after 100 passes:\ " + + (1 .. 100).map(\(_.--:open && _)) + .filter(a).join(', ') diff --git a/Task/15-puzzle-solver/FreeBASIC/15-puzzle-solver.basic b/Task/15-puzzle-solver/FreeBASIC/15-puzzle-solver.basic new file mode 100644 index 0000000000..4dcdf807c9 --- /dev/null +++ b/Task/15-puzzle-solver/FreeBASIC/15-puzzle-solver.basic @@ -0,0 +1,288 @@ +Randomize Timer + +Dim Shared As Integer Nr(15) = {3, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3} +Dim Shared As Integer Nc(15) = {3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1, 2} +Dim Shared As Integer n, nn +Dim Shared As Integer N0(99), N3(100), N4(99) +Dim Shared As Ulongint N2(99) + +Enum + Ki = 1 + Kg = 8 + Ke = 2 + Kl = 4 +End Enum + +Dim Shared As Integer l = 108, r = 114, u = 117, d = 100 + +Declare Function fY() As Boolean +Declare Function fZ(w As Integer) As Boolean +Declare Function fN() As Boolean + +Sub fI() + Dim As Integer g = (11 - N0(n)) * 4 + Dim As Ulongint a = (N2(n) And (15ULL Shl g)) + N0(n + 1) = N0(n) + 4 + N2(n + 1) = N2(n) - a + (a Shl 16) + N3(n + 1) = d + N4(n + 1) = N4(n) + If Not(Nr((a Shr g)) <= N0(n)\4) Then N4(n + 1) += 1 + n += 1 +End Sub + +Sub fG() + Dim As Integer g = (19 - N0(n)) * 4 + Dim As Ulongint a = (N2(n) And (15ULL Shl g)) + N0(n + 1) = N0(n) - 4 + N2(n + 1) = N2(n) - a + (a Shr 16) + N3(n + 1) = u + N4(n + 1) = N4(n) + If Not(Nr((a Shr g)) >= N0(n)\4) Then N4(n + 1) += 1 + n += 1 +End Sub + +Sub fE() + Dim As Integer g = (14 - N0(n)) * 4 + Dim As Ulongint a = (N2(n) And (15ULL Shl g)) + N0(n + 1) = N0(n) + 1 + N2(n + 1) = N2(n) - a + (a Shl 4) + N3(n + 1) = r + N4(n + 1) = N4(n) + If Not(Nc((a Shr g)) <= (N0(n) Mod 4)) Then N4(n + 1) += 1 + n += 1 +End Sub + +Sub fL() + Dim As Integer g = (16 - N0(n)) * 4 + Dim As Ulongint a = (N2(n) And (15ULL Shl g)) + N0(n + 1) = N0(n) - 1 + N2(n + 1) = N2(n) - a + (a Shr 4) + N3(n + 1) = l + N4(n + 1) = N4(n) + If Not(Nc((a Shr g)) >= (N0(n) Mod 4)) Then N4(n + 1) += 1 + n += 1 +End Sub + +Function fY() As Boolean + If N2(n) = &h123456789abcdef0ULL Then Return True + If N4(n) <= nn Then Return fN() + Return False +End Function + +Function fZ(w As Integer) As Boolean + If (w And Ki) > 0 Then + fI() + If fY() Then Return True + n -= 1 + End If + If (w And Kg) > 0 Then + fG() + If fY() Then Return True + n -= 1 + End If + If (w And Ke) > 0 Then + fE() + If fY() Then Return True + n -= 1 + End If + If (w And Kl) > 0 Then + fL() + If fY() Then Return True + n -= 1 + End If + Return False +End Function + +Function fN() As Boolean + Select Case N0(n) + Case 0 + Select Case N3(n) + Case l: Return fZ(Ki) + Case u: Return fZ(Ke) + Case Else: Return fZ(Ki Or Ke) + End Select + Case 3 + Select Case N3(n) + Case r: Return fZ(Ki) + Case u: Return fZ(Kl) + Case Else: Return fZ(Ki Or Kl) + End Select + Case 1, 2 + Select Case N3(n) + Case l: Return fZ(Ki Or Kl) + Case r: Return fZ(Ki Or Ke) + Case u: Return fZ(Ke Or Kl) + Case Else: Return fZ(Kl Or Ke Or Ki) + End Select + Case 12 + Select Case N3(n) + Case l: Return fZ(Kg) + Case d: Return fZ(Ke) + Case Else: Return fZ(Ke Or Kg) + End Select + Case 15 + Select Case N3(n) + Case r: Return fZ(Kg) + Case d: Return fZ(Kl) + Case Else: Return fZ(Kg Or Kl) + End Select + Case 13, 14 + Select Case N3(n) + Case l: Return fZ(Kg Or Kl) + Case r: Return fZ(Ke Or Kg) + Case d: Return fZ(Ke Or Kl) + Case Else: Return fZ(Kg Or Ke Or Kl) + End Select + Case 4, 8 + Select Case N3(n) + Case l: Return fZ(Ki Or Kg) + Case u: Return fZ(Kg Or Ke) + Case d: Return fZ(Ki Or Ke) + Case Else: Return fZ(Ki Or Kg Or Ke) + End Select + Case 7, 11 + Select Case N3(n) + Case d: Return fZ(Ki Or Kl) + Case u: Return fZ(Kg Or Kl) + Case r: Return fZ(Ki Or Kg) + Case Else: Return fZ(Ki Or Kg Or Kl) + End Select + Case Else + Select Case N3(n) + Case d: Return fZ(Ki Or Ke Or Kl) + Case l: Return fZ(Ki Or Kg Or Kl) + Case r: Return fZ(Ki Or Kg Or Ke) + Case u: Return fZ(Kg Or Ke Or Kl) + Case Else: Return fZ(Ki Or Kg Or Ke Or Kl) + End Select + End Select +End Function + +Sub solve() + If fN() Then + Exit Sub + Else + n = 0 + nn += 1 + solve() + End If +End Sub + +Function createPuzzle(Byval j As Integer) As Ulongint + Dim As Ulongint q = &h123456789abcdef0ULL + Dim As String h = Hex(q, 16) + Dim As Integer z, d, r, u = 0 + While j > 0 ' number of moves to do + Do + d = Int(Rnd * 4) + 1 + Loop While d = u + u = -d + r = Int(Rnd * 3) + 1 + While r > 0 + z = Instr(h, "0") + Select Case d + Case 1 ' -1 + If (z Mod 4) <> 1 Then + Mid(h, z, 1) = Mid(h, z - 1, 1) + Mid(h, z - 1, 1) = "0" + j -= 1 + End If + Case 2 ' +1 + If (z Mod 4) <> 0 Then + Mid(h, z, 1) = Mid(h, z + 1, 1) + Mid(h, z + 1, 1) = "0" + j -= 1 + End If + Case 3 ' -4 + If z >= 5 Then + Mid(h, z, 1) = Mid(h, z - 4, 1) + Mid(h, z - 4, 1) = "0" + j -= 1 + End If + Case 4 ' +4 + If z <= 12 Then + Mid(h, z, 1) = Mid(h, z + 4, 1) + Mid(h, z + 4, 1) = "0" + j -= 1 + End If + End Select + r -= 1 + Wend + Wend + Return Valulng("&h" + h) +End Function + +Sub ShowConfiguration(Byval h As String, i As Integer) + Dim As Integer r, c + Dim x As String + Color 14 + For r = 1 To 4 + For c = 1 To 4 + x = Mid(h, r * 4 - 4 + c, 1) + If x = "0" Then x = " " + Locate r + i, c + c - 1: Print x; + Next + Next + Color 7 +End Sub + +Sub shoWMoves(Byval h As String, Byval s As String, Byval m As Integer, Byval p As Integer) + Dim As Integer j, z, d + ShowConfiguration(h, 12) + For j = 1 To m + d = Asc(Mid(s, j, 1)) + z = Instr(h, "0") + Select Case d + Case l + If (z Mod 4) <> 1 Then + Mid(h, z, 1) = Mid(h, z - 1, 1) + Mid(h, z - 1, 1) = "0" + End If + Case r + If (z Mod 4) <> 0 Then + Mid(h, z, 1) = Mid(h, z + 1, 1) + Mid(h, z + 1, 1) = "0" + End If + Case u + If z >= 5 Then + Mid(h, z, 1) = Mid(h, z - 4, 1) + Mid(h, z - 4, 1) = "0" + End If + Case d + If z <= 12 Then + Mid(h, z, 1) = Mid(h, z + 4, 1) + Mid(h, z + 4, 1) = "0" + End If + End Select + ShowConfiguration(h, 12) + Sleep p + Next + Print +End Sub + +Sub fifteenSolver(Byval g As Ulongint, Byval p As Integer) + Dim As String h, s + Dim As Integer j + Dim As Double t0 = Timer + n = 0 + nn = 0 + h = Hex(g, 16) + Cls + Print "Puzzle: "; Lcase(h) + ShowConfiguration(h, 2) + Print Chr(10) + N0(0) = Instr(h, "0") - 1 + N2(0) = g + solve() + Print Using "Solution found in & moves: "; n; + For j = 1 To n + s &= Chr(N3(j)) + Next + Print s + Print Using !"\nTook ###.######## seconds on i5 @ 3.20 GHz"; Timer - t0 + If p Then showMoves(h, s, n, p) +End Sub + +fifteenSolver(&hfe169b4c0a73d852ULL, 1000) + +Sleep diff --git a/Task/15-puzzle-solver/FutureBasic/15-puzzle-solver.basic b/Task/15-puzzle-solver/FutureBasic/15-puzzle-solver.basic new file mode 100644 index 0000000000..16a309133a --- /dev/null +++ b/Task/15-puzzle-solver/FutureBasic/15-puzzle-solver.basic @@ -0,0 +1,165 @@ +// 15 Puzzle Solver +//https://rosettacode.org/wiki/15_puzzle_solver +// Requires FutureBasic 7.0.30 or later + +begin globals + int Nr(15), Nc(15), n, un, N0(99), N3(99), N4(99) + UInt64 N2(99) +end globals + +def fn fY as BOOL +void def fn fI +void def fn fG +void def fn fE +void def fn fL + +local fn fN1 as BOOL + if ( N3(n) != _"u" && N0(n) / 4 < 3 ) + fn fI + n++ + if ( fn fY ) then return YES + n-- + end if + + if ( N3(n) != _"d" && N0(n) / 4 > 0 ) + fn fG + n++ + if ( fn fY ) then return YES + n-- + end if + + if ( N3(n) != _"l" && N0(n) % 4 < 3 ) + fn fE + n++ + if ( fn fY ) then return YES + n-- + end if + + if ( N3(n) != _"r" && N0(n) %4 > 0 ) + fn fL + n++ + if ( fn fY ) then return YES + n-- + end if +end fn = NO + +void local fn fI + int g = ( 11 - N0(n)) * 4 + UInt64 a = N2(n) & ((UInt64)15 << g) + N0(n + 1) = N0(n) + 4 + N2(n + 1) = N2(n) - a + (a << 16) + N3(n + 1) = _"d" + if ( Nr(a >> g) <= N0(n) / 4 ) + N4(n + 1) = N4(n) + else + N4(n + 1) = N4(n) + 1 + end if +end fn + +void local fn fG + int g = (19 - N0(n)) * 4 + UInt64 a = N2(n) & ((UInt64)15 << g) + N0(n + 1) = N0(n) - 4 + N2(n + 1) = N2(n) - a + (a >> 16) + N3(n + 1) = _"u" + if ( Nr(a >> g) >= N0(n) / 4 ) + N4(n + 1) = N4(n) + else + N4(n + 1) = N4(n) + 1 + end if +end fn + +void local fn fE + int g = (14 - N0(n)) * 4 + UInt64 a = N2(n) & ((UInt64)15 << g) + N0(n + 1) = N0(n) + 1 + N2(n + 1) = N2(n) - a + (a << 4) + N3(n + 1) = _"r" + if ( Nc(a >> g) <= N0(n) % 4 ) + N4(n + 1) = N4(n) + else + N4(n + 1) = N4(n) + 1 + end if +end fn + +void local fn fL + int g = (16 - N0(n)) * 4 + UInt64 a = N2(n) & ((UInt64)15 << g) + N0(n + 1) = N0(n) - 1 + N2(n + 1) = N2(n) - a + (a >> 4) + N3(n + 1) = _"l" + if ( Nc(a >> g) >= N0(n) % 4 ) + N4(n + 1) = N4(n) + else + N4(n + 1) = N4(n) + 1 + end if +end fn + +local fn fY as BOOL + if ( N4(n) < un ) then return fn fN1 + if ( N2(n) == 0x123456789abcdef0 ) + printf @"Solution found in %d moves:",n + for int g = 1 to n + printf @"%c\b",N3(g) + next + print + return YES + end if + if ( N4(n) == un ) then return fn fN1 +end fn = NO + +void local fn Solve( initN as int, initG as UInt64 ) + int tempNr(15) = {3,0,0,0,0,1,1,1,1,2,2,2,2,3,3,3} + int tempNc(15) = {3,0,1,2,3,0,1,2,3,0,1,2,3,0,1,2} + + fn memcpy(@Nr(0),@tempNr(0),sizeof(int)*16) + fn memcpy(@Nc(0),@tempNc(0),sizeof(int)*16) + + n = 0 + un = 0 + + N0(0) = initN + N2(0) = initG + + while ( !fn fY ) + un++ + wend +end fn + + +window 1, @"15 Puzzle Solver" +windowcenter(1) +WindowSetBackgroundColor(1,fn ColorBlack) + +text ,14,fn colorWhite +Print "Puzzle: "; "fe169b4c0a73d852" + +text ,14,fn colorYellow +print +print @"15 14 1 6" +print @" 9 11 4 12" +print @" 0 10 7 3" +print @"13 8 5 2" +print +text ,14,fn colorWhite + +CFStringRef ComputerChip = unix @"sysctl -n machdep.cpu.brand_string" + +CFTimeInterval t : t = fn CACurrentMediaTime +fn Solve( 8, 0xfe169b4c0a73d852 ) +CFTimeInterval CurrentTime = fn CACurrentMediaTime-t + +print +text ,14,fn colorYellow +print +print @" 1 2 3 4" +print @" 5 6 7 8" +print @" 9 10 11 12" +print @"13 14 15 0" +print +text ,14,fn colorWhite + +print : printf @"Compute time: %.3f seconds",(CurrentTime) +print ComputerChip + +HandleEvents diff --git a/Task/24-game/ALGOL-68/24-game.alg b/Task/24-game/ALGOL-68/24-game.alg index 3ba4ed6a03..b74144035a 100644 --- a/Task/24-game/ALGOL-68/24-game.alg +++ b/Task/24-game/ALGOL-68/24-game.alg @@ -40,7 +40,7 @@ BEGIN # play the 24 game - present the user with 4 digits and invite them to # error( "Unexpected """ + curr ch + """" ); 0 FI # factor # ; - PROC term = REAL: + PROC expr term = REAL: BEGIN REAL result := factor; WHILE curr ch = "*" OR curr ch = "/" DO @@ -49,14 +49,14 @@ BEGIN # play the 24 game - present the user with 4 digits and invite them to # IF op = "*" THEN result *:= factor ELSE result /:= factor FI OD; result - END # term # ; + END # expr term # ; PROC expression = REAL: BEGIN - REAL result := term; + REAL result := expr term; WHILE curr ch = "+" OR curr ch = "-" DO CHAR op = curr ch; next ch; - IF op = "+" THEN result +:= term ELSE result -:= term FI + IF op = "+" THEN result +:= expr term ELSE result -:= expr term FI OD; result END # expression # ; @@ -80,7 +80,7 @@ BEGIN # play the 24 game - present the user with 4 digits and invite them to # puzzle digits[ i ] := 0 OD; print( ( "Enter an expression using these digits:" ) ); - FOR i TO 4 DO # pick 4 random digits # + TO 4 DO # pick 4 random digits # INT digit := 1 + ENTIER ( next random * 9 ); IF digit > 9 THEN digit := 9 FI; puzzle digits[ digit ] +:= 1; diff --git a/Task/99-bottles-of-beer/YAMLScript/99-bottles-of-beer-1.ys b/Task/99-bottles-of-beer/YAMLScript/99-bottles-of-beer-1.ys index d951447c6d..2ad5b109ca 100644 --- a/Task/99-bottles-of-beer/YAMLScript/99-bottles-of-beer-1.ys +++ b/Task/99-bottles-of-beer/YAMLScript/99-bottles-of-beer-1.ys @@ -1,7 +1,6 @@ !yamlscript/v0 defn main(number=99): - :: Print the verses to "99 Bottles of Beer" each num (number .. 1): say: | $bottles(num) of beer on the wall, diff --git a/Task/ABC-problem/ALGOL-68/abc-problem.alg b/Task/ABC-problem/ALGOL-68/abc-problem.alg index 524af00c33..11c3a41ade 100644 --- a/Task/ABC-problem/ALGOL-68/abc-problem.alg +++ b/Task/ABC-problem/ALGOL-68/abc-problem.alg @@ -1,21 +1,14 @@ +# ABC problem: # # determine whether we can spell words with a set of blocks # -# construct the list of blocks # -[][]STRING 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" ) - ); - # Returns TRUE if we can spell the word using the blocks, FALSE otherwise # # Returns TRUE for an empty string # -PROC can spell = ( STRING word, [][]STRING blocks )BOOL: +PROC can spell = ( STRING word, [][]STRING block set )BOOL: BEGIN # construct a set of flags to indicate whether the blocks are used # # or not # - [ 1 LWB blocks : 1 UPB blocks ]BOOL used; + [ 1 LWB block set : 1 UPB block set ]BOOL used; FOR block pos FROM LWB used TO UPB used DO used[ block pos ] := FALSE @@ -34,11 +27,11 @@ PROC can spell = ( STRING word, [][]STRING blocks )BOOL: # look through the unused blocks for the current letter # BOOL found := FALSE; - FOR block pos FROM 1 LWB blocks TO 1 UPB blocks + FOR block pos FROM 1 LWB block set TO 1 UPB block set WHILE NOT found DO - IF ( c = blocks[ block pos ][ 1 ][ 1 ] - OR c = blocks[ block pos ][ 2 ][ 1 ] + IF ( c = block set[ block pos ][ 1 ][ 1 ] + OR c = block set[ block pos ][ 2 ][ 1 ] ) AND NOT used[ block pos ] THEN @@ -56,25 +49,33 @@ PROC can spell = ( STRING word, [][]STRING blocks )BOOL: END; # can spell # -main: ( +# main # ( + + [][]STRING abc blocks # construct the list 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" ) + ); # test the can spell procedure # - PROC test can spell = ( STRING word, [][]STRING blocks )VOID: + PROC test can spell = ( STRING word, [][]STRING block set )VOID: write( ( ( "can spell: """ + word + """ -> " - + IF can spell( word, blocks ) THEN "yes" ELSE "no" FI + + IF can spell( word, block set ) THEN "yes" ELSE "no" FI ) , newline ) ); - test can spell( "A", blocks ); - test can spell( "BaRK", blocks ); - test can spell( "BOOK", blocks ); - test can spell( "TREAT", blocks ); - test can spell( "COMMON", blocks ); - test can spell( "SQUAD", blocks ); - test can spell( "CONFUSE", blocks ) + test can spell( "A", abc blocks ); + test can spell( "BaRK", abc blocks ); + test can spell( "BOOK", abc blocks ); + test can spell( "TREAT", abc blocks ); + test can spell( "COMMON", abc blocks ); + test can spell( "SQUAD", abc blocks ); + test can spell( "CONFUSE", abc blocks ) ) diff --git a/Task/AKS-test-for-primes/Phix/aks-test-for-primes-1.phix b/Task/AKS-test-for-primes/Phix/aks-test-for-primes-1.phix new file mode 100644 index 0000000000..da1bc84810 --- /dev/null +++ b/Task/AKS-test-for-primes/Phix/aks-test-for-primes-1.phix @@ -0,0 +1,78 @@ +-- demo/rosetta/AKSprimes.exw +-- Does not work for primes above 67 (56 on 32bit), which is actually beyond the original task anyway. +-- Translated from the C version (with all out-by-1 stuff now eradicated). +with javascript_semantics +constant limit = iff(machine_bits()=32?56:67) +sequence c = repeat(0,limit+1) + +procedure coef(integer n) + c[n+1] = 1 + for i=n to 2 by -1 do + c[i] += c[i-1] + end for +end procedure + +function is_aks_prime(integer n) + coef(n) + for i=2 to n-1 do + if remainder(c[i],n)!=0 then + return false + end if + end for + return true +end function + +procedure show(integer n) + for i=n+1 to 1 by -1 do + object ci = c[i] + if ci=1 then + if remainder(n-i+1,2)=0 then + if i=1 then + if n=0 then + ci = "1" + else + ci = "+1" + end if + else + ci = "" + end if + else + ci = "-1" + end if + else + if remainder(n-i+1,2)=0 then + ci = sprintf("+%d",ci) + else + ci = sprintf("-%d",ci) + end if + end if + if i=1 then -- ie ^0 + printf(1,"%s",{ci}) + elsif i=2 then -- ie ^1 + printf(1,"%sx",{ci}) + else + printf(1,"%sx^%d",{ci,i-1}) + end if + end for +end procedure + +procedure main() + for n=0 to 9 do + coef(n); + printf(1,"(x-1)^%d = ", n); + show(n); + puts(1,'\n'); + end for + + printf(1,"\nprimes (<=%d):",limit); +-- coef(1); -- (needed to reset c, if we want to avoid saying 1 is prime...) + c[2] = 1 -- (this manages "", which is all that call did anyway...) + for n=2 to limit do + if is_aks_prime(n) then + printf(1," %d", n); + end if + end for + puts(1,'\n'); + wait_key() +end procedure +main() diff --git a/Task/AKS-test-for-primes/Phix/aks-test-for-primes-2.phix b/Task/AKS-test-for-primes/Phix/aks-test-for-primes-2.phix new file mode 100644 index 0000000000..f8bd4ad4ab --- /dev/null +++ b/Task/AKS-test-for-primes/Phix/aks-test-for-primes-2.phix @@ -0,0 +1,27 @@ +include mpfr.e +mpz z = mpz_init() +atom t0 = time(), t1 = t0+1 +sequence p = {} +integer maxn = 0 +for n=2 to 10000 do -- (more than we can manage in 10s) + bool nprime = true + for k=1 to n-1 do + mpz_bin_uiui(z,n,k) + if not mpz_divisible_ui_p(z,n) then + nprime = false + exit + end if + end for + if nprime then + p &= n + end if + maxn = n + if time()>t1 then + if time()>t0+10 then progress("") exit end if + progress("checking %d",{n}) + t1 = time()+1 + end if +end for +sequence q = get_primes_le(maxn) +printf(1,"%d primes < %d found, correctly:%t, in %s\n",{length(p),maxn,p=q,elapsed(time()-t0)}) +wait_key() diff --git a/Task/AKS-test-for-primes/Phix/aks-test-for-primes-3.phix b/Task/AKS-test-for-primes/Phix/aks-test-for-primes-3.phix new file mode 100644 index 0000000000..bfa4d0b3d9 --- /dev/null +++ b/Task/AKS-test-for-primes/Phix/aks-test-for-primes-3.phix @@ -0,0 +1,24 @@ +atom t0 = time(), t1 = t0+1 +sequence p = {} +integer maxn = 0 +for n=2 to 10000 do -- (more than we can manage in 10s) + sequence r = {1} + for k=1 to n do + r &= 1 + for l=k to 2 by -1 do + r[l] = remainder(r[l]+r[l-1],n) + end for + end for + if sum(r)=2 then -- ie {1,<==all 0s==>,1} + p &= n + end if + maxn = n + if time()>t1 then + if time()>t0+10 then progress("") exit end if + progress("checking %d",{n}) + t1 = time()+1 + end if +end for +sequence q = get_primes_le(maxn) +printf(1,"%d primes < %d found, correctly:%t, in %s\n",{length(p),maxn,p=q,elapsed(time()-t0)}) +wait_key() diff --git a/Task/AKS-test-for-primes/Phix/aks-test-for-primes.phix b/Task/AKS-test-for-primes/Phix/aks-test-for-primes.phix deleted file mode 100644 index 384e622777..0000000000 --- a/Task/AKS-test-for-primes/Phix/aks-test-for-primes.phix +++ /dev/null @@ -1,82 +0,0 @@ ---> - -- demo/rosetta/AKSprimes.exw - -- Does not work for primes above 53, which is actually beyond the original task anyway. - -- Translated from the C version, just about everything is (working) out-by-1, what fun. - - sequence c = repeat(0,100) - - procedure coef(integer n) - -- out-by-1, ie coef(1)==^0, coef(2)==^1, coef(3)==^2 etc. - c[n] = 1 - for i=n-1 to 2 by -1 do - c[i] = c[i]+c[i-1] - end for - end procedure - - function is_aks_prime(integer n) - coef(n+1); -- (I said it was out-by-1) - for i=2 to n-1 do -- (technically "to n" is more correct) - if remainder(c[i],n)!=0 then - return 0 - end if - end for - return 1 - end function - - procedure show(integer n) - -- (As per coef, this is (working) out-by-1) - object ci - for i=n to 1 by -1 do - ci = c[i] - if ci=1 then - if remainder(n-i,2)=0 then - if i=1 then - if n=1 then - ci = "1" - else - ci = "+1" - end if - else - ci = "" - end if - else - ci = "-1" - end if - else - if remainder(n-i,2)=0 then - ci = sprintf("+%d",ci) - else - ci = sprintf("-%d",ci) - end if - end if - if i=1 then -- ie ^0 - printf(1,"%s",{ci}) - elsif i=2 then -- ie ^1 - printf(1,"%sx",{ci}) - else - printf(1,"%sx^%d",{ci,i-1}) - end if - end for - end procedure - - procedure main() - for n=1 to 10 do -- (0 to 9 really) - coef(n); - printf(1,"(x-1)^%d = ", n-1); - show(n); - puts(1,'\n'); - end for - - puts(1,"\nprimes (<=53):"); - -- coef(2); -- (needed to reset c, if we want to avoid saying 1 is prime...) - c[2] = 1 -- (this manages "", which is all that call did anyway...) - for n = 2 to 53 do - if is_aks_prime(n) then - printf(1," %d", n); - end if - end for - puts(1,'\n'); - if getc(0) then end if - end procedure - main() - - with javascript_semantics - function direct_form_II_transposed_filter(sequence a, b, signal) - sequence result = repeat(0,length(signal)) - for i=1 to length(signal) do - atom tmp = 0 - for j=1 to min(i,length(b)) do tmp += b[j]*signal[i-j+1] end for - for j=2 to min(i,length(a)) do tmp -= a[j]*result[i-j+1] end for - result[i] = tmp/a[1] - end for - return result - end function +with javascript_semantics +function direct_form_II_transposed_filter(sequence a, b, signal) + sequence result = repeat(0,length(signal)) + for i=1 to length(signal) do + atom tmp = 0 + for j=1 to min(i,length(b)) do tmp += b[j]*signal[i-j+1] end for + for j=2 to min(i,length(a)) do tmp -= a[j]*result[i-j+1] end for + result[i] = tmp/a[1] + end for + return result +end function - constant acoef = {1.00000000, -2.77555756e-16, 3.33333333e-01, -1.85037171e-17}, - bcoef = {0.16666667, 0.5, 0.5, 0.16666667}, - signal = {-0.917843918645,0.141984778794,1.20536903482,0.190286794412,-0.662370894973, - -1.00700480494,-0.404707073677,0.800482325044,0.743500089861,1.01090520172, - 0.741527555207,0.277841675195,0.400833448236,-0.2085993586,-0.172842103641, - -0.134316096293,0.0259303398477,0.490105989562,0.549391221511,0.9047198589} +constant acoef = {1.00000000, -2.77555756e-16, 3.33333333e-01, -1.85037171e-17}, + bcoef = {0.16666667, 0.5, 0.5, 0.16666667}, + signal = {-0.917843918645,0.141984778794,1.20536903482,0.190286794412,-0.662370894973, + -1.00700480494,-0.404707073677,0.800482325044,0.743500089861,1.01090520172, + 0.741527555207,0.277841675195,0.400833448236,-0.2085993586,-0.172842103641, + -0.134316096293,0.0259303398477,0.490105989562,0.549391221511,0.9047198589} - pp(direct_form_II_transposed_filter(acoef, bcoef, signal),{pp_FltFmt,"%9.6f",pp_Maxlen,110}) - + print obj + print @"no exception" + end try + + catch ( e ) // handle exception + print : print @"" + print e + end catch + + finally // finally is always executed + print : print @"" + + // ... cleanup + + end finally +end fn + +fn DoSomething + +HandleEvents diff --git a/Task/Exceptions/FutureBasic/exceptions-2.basic b/Task/Exceptions/FutureBasic/exceptions-2.basic new file mode 100644 index 0000000000..203d2eb6c3 --- /dev/null +++ b/Task/Exceptions/FutureBasic/exceptions-2.basic @@ -0,0 +1,15 @@ +void local fn ThrowException + ExceptionRef e = fn ExceptionWithName( @"Oops!", @"Something went wrong", NULL ) + + try + throw e + end try + + catch (e) + print fn ExceptionName( e ), fn ExceptionReason( e ) + end catch +end fn + +fn ThrowException + +HandleEvents diff --git a/Task/Execute-Brain-/ALGOL-68/execute-brain--1.alg b/Task/Execute-Brain-/ALGOL-68/execute-brain--1.alg index c74c21fd7b..6f36b9cea2 100644 --- a/Task/Execute-Brain-/ALGOL-68/execute-brain--1.alg +++ b/Task/Execute-Brain-/ALGOL-68/execute-brain--1.alg @@ -86,11 +86,10 @@ BEGIN # Brain**** -> Algol 68 transpiler # # get the code to transpile and output it as a comment at the start # # of the code # print( ( "CO BF> " ) ); - STRING code list; - read( ( code list, newline ) ); - print( ( newline, code list, newline, "CO", newline ) ); + STRING bf code; + read( ( bf code, newline ) ); + print( ( newline, bf code, newline, "CO", newline ) ); # transpile the code # - generate( code list ) - + generate( bf code ) END diff --git a/Task/Execute-Brain-/Pike/execute-brain-.pike b/Task/Execute-Brain-/Pike/execute-brain-.pike new file mode 100644 index 0000000000..d4cc02b12c --- /dev/null +++ b/Task/Execute-Brain-/Pike/execute-brain-.pike @@ -0,0 +1,39 @@ +string prog = "++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++."; + +void main() { + array tape = allocate(30000); + int p; + int l = strlen(prog); + for (int i = 0; i < l; i++) { + switch (prog[i]) { + case '>': + p++; + break; + case '<': + p--; + break; + case '+': + tape[p]++; + break; + case '-': + tape[p]--; + break; + case '.': + write(sprintf("%c", tape[p])); // ascii only + break; + case ',': + tape[p] = Stdio.stdin.getchar(); + break; + case '[': + if (!tape[p]) + for (int nest = 1; nest;) + prog[--i] == ']' ? nest-- : prog[i] == '[' ? nest++ : 0; + break; + case ']': + if (tape[p]) + for (int nest = 1; nest;) + prog[--i] == '[' ? nest-- : prog[i] == ']' ? nest++ : 0; + break; + } + } +} diff --git a/Task/Execute-Brain-/Visual-Basic-.NET/execute-brain-.vb b/Task/Execute-Brain-/Visual-Basic-.NET/execute-brain-.vb new file mode 100644 index 0000000000..b258dd7b25 --- /dev/null +++ b/Task/Execute-Brain-/Visual-Basic-.NET/execute-brain-.vb @@ -0,0 +1,70 @@ +Imports System + +Module Program + Sub Main(args As String()) + Brainfug("++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.") + End Sub + + Sub Brainfug(code As String, Optional input As String = Nothing) + Dim inp As Integer = 1 ' input pointer if we use an input string + Dim tape(29999) As Integer ' yes, 29999 makes an array of 30000 + Dim p As Integer + For i = 1 To code.Length + Dim c As Char = Mid(code, i, 1) + Select c + Case ">" + p += 1 + Case "<" + p -= 1 + Case "+" + tape(p) += 1 + Case "-" + tape(p) -= 1 + Case "." + Try + Console.Write(Chr(tape(p))) + Catch ex As NotSupportedException + Console.Write(".") + End Try + Case "," + If input Is Nothing then + tape(p) = Console.Read() + Else + Try + tape(p) = AscW(Mid(input, inp, 1)) + Catch ex As ArgumentException + Console.WriteLine("Panic: Out of input!") + Environment.Exit(1) + End Try + inp += 1 + End If + Case "[" + If tape(p) = 0 + Dim nest = 1 + While nest + i += 1 + Select Mid(code, i, 1) + Case "]" + nest -= 1 + Case "[" + nest += 1 + End Select + End While + End If + Case "]" + If tape(p) <> 0 + Dim nest = 1 + While nest + i -= 1 + Select Mid(code, i, 1) + Case "[" + nest -= 1 + Case "]" + nest += 1 + End Select + End While + End If + End Select + Next + End Sub +End Module diff --git a/Task/Execute-a-system-command/PascalABC.NET/execute-a-system-command.pas b/Task/Execute-a-system-command/PascalABC.NET/execute-a-system-command.pas new file mode 100644 index 0000000000..ab758487a0 --- /dev/null +++ b/Task/Execute-a-system-command/PascalABC.NET/execute-a-system-command.pas @@ -0,0 +1,2 @@ +## +exec('cmd.exe','/c dir /p'); diff --git a/Task/Exponentiation-order/PascalABC.NET/exponentiation-order.pas b/Task/Exponentiation-order/PascalABC.NET/exponentiation-order.pas new file mode 100644 index 0000000000..d38b6a0302 --- /dev/null +++ b/Task/Exponentiation-order/PascalABC.NET/exponentiation-order.pas @@ -0,0 +1,4 @@ +## +println('5**3**2 =',5**3**2); +println('(5**3)**2 =',(5**3)**2); +println('5**(3**2) =',5**(3**2)); diff --git a/Task/Exponentiation-with-infix-operators-in-or-operating-on-the-base/PascalABC.NET/exponentiation-with-infix-operators-in-or-operating-on-the-base.pas b/Task/Exponentiation-with-infix-operators-in-or-operating-on-the-base/PascalABC.NET/exponentiation-with-infix-operators-in-or-operating-on-the-base.pas new file mode 100644 index 0000000000..5a551f50f0 --- /dev/null +++ b/Task/Exponentiation-with-infix-operators-in-or-operating-on-the-base/PascalABC.NET/exponentiation-with-infix-operators-in-or-operating-on-the-base.pas @@ -0,0 +1,6 @@ +## +foreach var x in |-5, 5| do + foreach var p in |2, 3| do + writeln('x is ', x:2, ', p is ', p:1, ', ', + '-x**p is ', -x ** p:4, ', -(x)**p is ', -(x) ** p:4, ', ', + '(-x)**p is ', (-x) ** p:4, ', ', '-(x**p) is ', -(x ** p):4); diff --git a/Task/Extend-your-language/M2000-Interpreter/extend-your-language.m2000 b/Task/Extend-your-language/M2000-Interpreter/extend-your-language.m2000 index d3b25c299f..fb9dc63d17 100644 --- a/Task/Extend-your-language/M2000-Interpreter/extend-your-language.m2000 +++ b/Task/Extend-your-language/M2000-Interpreter/extend-your-language.m2000 @@ -21,7 +21,7 @@ ctrl=true for a=1 to 2 for b=1 to 2 Print "a=";a, "b=";b - if2 a=1, b=2, &ctrl : Part { + if2 a=1, b=1, &ctrl : Part { print "both", a, b } as ctrl ifelse1 : Part { diff --git a/Task/Extend-your-language/PascalABC.NET/extend-your-language.pas b/Task/Extend-your-language/PascalABC.NET/extend-your-language.pas new file mode 100644 index 0000000000..4c4c00b38e --- /dev/null +++ b/Task/Extend-your-language/PascalABC.NET/extend-your-language.pas @@ -0,0 +1,24 @@ +const + ifboth = 0; + else1 = 1; + else2 = 2; + else3 = 3; + +function operator **(x, y: boolean): integer; extensionmethod; +begin + if x and y then result := ifboth + else + if x then result := else1 + else + if y then result := else2 + else result := else3 +end; + +begin + case (2 > 1) ** (3 < 2) of + ifboth: 'both are true'.println; + else1: 'the first is true'.println; + else2: 'the second is true'.println; + else3: 'both are false'.println; + end; +end. diff --git a/Task/Extensible-prime-generator/PascalABC.NET/extensible-prime-generator.pas b/Task/Extensible-prime-generator/PascalABC.NET/extensible-prime-generator.pas new file mode 100644 index 0000000000..9c0e34d213 --- /dev/null +++ b/Task/Extensible-prime-generator/PascalABC.NET/extensible-prime-generator.pas @@ -0,0 +1,42 @@ +const + maxi = maxint.Sqrt.Floor; + +function gen_primes: sequence of integer; +begin + yield 2; + var D := new Dictionary; + var q := 3; + while True do + begin + if q not in D then + begin + if q < maxi then // prevent overflow + D[q * q] := q; + yield q; + end + else + begin + var p := D[q]; + D -= q; + var x := q + p + p; + while x in D do x += p + p; + D[x] := p; + end; + q += 2; + end; +end; + +begin + print('The first 20 primes are:'); + gen_primes.Take(20).println; + print('The primes between 100 and 150 are:'); + gen_primes.SkipWhile(x -> x < 100).TakeWhile(x -> x < 150).Println; + print('The number of primes between 7700 and 8000 is:'); + gen_primes.SkipWhile(x -> x < 7700).TakeWhile(x -> x < 8000).count.Println; + print('The 10,000th prime is:'); + gen_primes.Skip(10_000 - 1).First.Println; + print('The 100,000,000th prime is:'); + gen_primes.Skip(100_000_000 - 1).First.Println; + print('The sum of the primes to two million is:'); + gen_primes.Takewhile(x -> x < 2_000_000).select(x -> int64(x)).Sum.Println; +end. diff --git a/Task/FASTA-format/ALGOL-68/fasta-format.alg b/Task/FASTA-format/ALGOL-68/fasta-format.alg index 0af6a2dd55..5324552978 100644 --- a/Task/FASTA-format/ALGOL-68/fasta-format.alg +++ b/Task/FASTA-format/ALGOL-68/fasta-format.alg @@ -8,15 +8,16 @@ BEGIN # read FASTA format data from standard input and write the results to # read( ( line, newline ) ); NOT at eof DO - IF line /= "" THEN # non-empty line # - INT start := LWB line; - BOOL is heading = line[ start ] = ">"; # check for heading line # + IF line /= "" THEN # non-empty line # + INT start pos := LWB line; + BOOL is heading = line[ start pos ] = ">"; # check for heading line # IF is heading THEN print( ( newline ) ); - start +:= 1 + start pos +:= 1 FI; - print( ( line[ start : ] ) ); + print( ( line[ start pos : ] ) ); IF is heading THEN print( ( ": " ) ) FI FI - OD + OD; + print( ( newline ) ) END diff --git a/Task/Factorial-base-numbers-indexing-permutations-of-a-collection/ALGOL-68/factorial-base-numbers-indexing-permutations-of-a-collection.alg b/Task/Factorial-base-numbers-indexing-permutations-of-a-collection/ALGOL-68/factorial-base-numbers-indexing-permutations-of-a-collection.alg new file mode 100644 index 0000000000..49ec974119 --- /dev/null +++ b/Task/Factorial-base-numbers-indexing-permutations-of-a-collection/ALGOL-68/factorial-base-numbers-indexing-permutations-of-a-collection.alg @@ -0,0 +1,130 @@ +BEGIN # factorial base numbers indexing permutations of a collection # + # - translated from the Phix/FreeBASIC samples # + + PROC print sequence = ( []INT s )VOID: + BEGIN + print( ( " " ) ); + IF UPB s >= LWB s THEN + FOR j FROM LWB s TO UPB s DO + print( ( whole( s[ j ], 0 ) ) ) + OD + FI; + print( ( newline ) ) + END # print sequence # ; + + PROC factorial = ( INT n )LONG INT: IF n <= 1 THEN 1 ELSE n * factorial( n - 1 ) FI; + + PROC tagset = ( INT n )[]INT: + BEGIN + [ 1 : n ]INT result; + FOR i TO n DO result[ i ] := i OD; + result + END # tagset # ; + + PROC show cards = ( []INT s )VOID: + BEGIN + STRING cards = "AKQJT98765432", suits = "SHDC"; + FOR i FROM LWB s TO UPB s DO + INT c = s[ i ] - 1; + STRING card = cards[ ( c MOD 13 ) + 1 ] + suits[ ( c OVER 13 ) + 1 ]; + print( ( card, IF i MOD 13 = 0 OR i = UPB s THEN newline ELSE space FI ) ) + OD; + print( ( newline ) ) + END # show cards # ; + + PROC fperm = ( []INT fbn, omega )[]INT: + BEGIN + INT m := 0; + [ LWB omega : UPB omega ]INT result := omega; + FOR i FROM LWB fbn TO UPB fbn DO + INT g = fbn[ i ]; + IF g > 0 THEN + INT tmp = result[ m + g + 1 ]; + FOR j FROM m + g + 1 BY -1 TO m + 2 DO + result[ j ] := result[ j - 1 ] + OD; + result[ m + 1 ] := tmp + FI; + m +:= 1 + OD; + result + END # fperm # ; + + PROC factorial base numbers = ( INT size, BOOL count only )[]INT: + BEGIN + [ 1 : size ]INT res; FOR i TO size DO res[ i ] := 0 OD; + # count the number of results # + INT count := 0; + FOR n FROM 0 WHILE INT radix := 2; + INT k := n; + WHILE k > 0 DO + k OVERAB radix; + radix +:= 1 + OD; + radix <= size + 2 + DO count +:= 1 + OD; + [ 1 : IF count only THEN 0 ELSE count * size FI ]INT results; + FOR i TO UPB results DO results[ i ] := 0 OD; + INT results pos := - size; + IF NOT count only THEN + # want the results, not just a count # + FOR n FROM 0 WHILE INT radix := 2; + INT k := n; + WHILE k > 0 DO + IF NOT count only AND radix <= size + 1 THEN + res[ size - radix + 2 ] := k MOD radix + FI; + k OVERAB radix; + radix +:= 1 + OD; + radix <= size + 2 + DO count +:= 1; + results pos +:= size; + results[ results pos + 1 : results pos + size ] := res + OD + FI; + IF count only THEN count ELSE results FI + END # factorial base numbers # ; + + # Generate random factorial base number sequence # + PROC randfbn51 = []INT: + BEGIN + [ 1 : 51 ]INT fbn51; + FOR i TO 51 DO fbn51[ i ] := ENTIER ( next random * ( 52 - i ) ) + 1 OD; + fbn51 + END # randfbn51 # ; + + BEGIN + INT size = 3; + []INT fbns = factorial base numbers( size, FALSE ); + []INT omega = ( 0, 1, 2, 3 ); + FOR i TO UPB fbns OVER size DO + FOR j TO size DO + print( ( whole( fbns[ ( i - 1 ) * size + j ], 0 ), IF j = size THEN "" ELSE "." FI ) ) + OD; + print( ( " ->" ) ); + [ 1 : size ]INT tmp; + FOR j TO size DO tmp[ j ] := fbns[ ( i - 1 ) * size + j ] OD; + []INT result = fperm( tmp, omega ); + print sequence( result ) + OD; + print( ( newline ) ); + []INT count = factorial base numbers( 10, TRUE ); + print( ( "Permutations generated = ", whole( ( count )[ 1 ], 0 ), newline ) ); + print( ( " compared to 11! which = ", whole( factorial( 11 ), 0 ), newline ) ); + print( ( newline ) ); + [][]INT fbn51s = ( ( 39, 49, 7, 47, 29, 30, 2, 12, 10, 3, 29, 37, 33, 17, 12, 31, 29 + , 34, 17, 25, 2, 4, 25, 4, 1, 14, 20, 6, 21, 18, 1, 1, 1, 4 + , 0, 5, 15, 12, 4, 3, 10, 10, 9, 1, 6, 5, 5, 3, 0, 0, 0 + ) + , ( 51, 48, 16, 22, 3, 0, 19, 34, 29, 1, 36, 30, 12, 32, 12, 29, 30 + , 26, 14, 21, 8, 12, 1, 3, 10, 4, 7, 17, 6, 21, 8, 12, 15, 15 + , 13, 15, 7, 3, 12, 11, 9, 5, 5, 6, 6, 3, 4, 0, 3, 2, 1 + ) + , rand fbn51 + ); + # Show all card arrangements # + FOR i FROM LWB fbn51s TO UPB fbn51s DO show cards( fperm( fbn51s[ i ], tagset( 52 ) ) ) OD + END +END diff --git a/Task/Factorial-base-numbers-indexing-permutations-of-a-collection/FreeBASIC/factorial-base-numbers-indexing-permutations-of-a-collection.basic b/Task/Factorial-base-numbers-indexing-permutations-of-a-collection/FreeBASIC/factorial-base-numbers-indexing-permutations-of-a-collection.basic new file mode 100644 index 0000000000..abd85c0b29 --- /dev/null +++ b/Task/Factorial-base-numbers-indexing-permutations-of-a-collection/FreeBASIC/factorial-base-numbers-indexing-permutations-of-a-collection.basic @@ -0,0 +1,167 @@ +Type Sequence + longi As Integer + dato(1000) As Integer +End Type + +Sub printSequence(s As Sequence) + Print " "; + For i As Integer = 1 To s.longi + Print Chr(8) & s.dato(i); + If i < s.longi Then Print "."; + Next i + Print +End Sub + +Function factorial(n As Integer) As Longint + If n <= 1 Then Return 1 + Return n * factorial(n - 1) +End Function + +Function tagset(n As Integer) As Sequence + Dim As Sequence result + result.longi = n + For i As Integer = 1 To n + result.dato(i) = i + Next i + Return result +End Function + +Sub showCards(s As Sequence) + Const cards = "AKQJT98765432" + Const suits = "SHDC" + + For i As Integer = 1 To s.longi + Dim As Integer c = s.dato(i) - 1 + Dim As String card = Mid(cards, (c Mod 13) + 1, 1) + Mid(suits, (c \ 13) + 1, 1) + Print card; Iif(((i Mod 13) = 0 Or i = s.longi), Chr(10), " "); + Next i + Print +End Sub + +Function fperm(fbn As Sequence, omega As Sequence) As Sequence + Dim As Integer i, g, tmp, j, m = 0 + Dim As Sequence result = omega + + For i = 1 To fbn.longi + g = fbn.dato(i) + If g > 0 Then + tmp = result.dato(m + g + 1) + For j = m + g + 1 To m + 2 Step -1 + result.dato(j) = result.dato(j - 1) + Next j + result.dato(m + 1) = tmp + End If + m += 1 + Next i + + result.longi = omega.longi + Return result +End Function + +Function factorialBaseNumbers(size As Integer, cntOnly As Integer) As Sequence + Dim As Sequence results + Dim As Integer res(1000) + Dim As Integer cnt, n, radix, k, i + + results.longi = 0 + cnt = 0 + n = 0 + Do + radix = 2 + k = n + For i = 1 To size + res(i) = 0 + Next i + + While k > 0 + If cntOnly = 0 Andalso radix <= size + 1 Then + res(size - radix + 2) = k Mod radix + End If + k \= radix + radix += 1 + Wend + + If radix > size + 2 Then Exit Do + + cnt += 1 + If cntOnly = 0 Then + results.longi += 1 + For i = 1 To size + results.dato((results.longi - 1) * size + i) = res(i) + Next i + End If + n += 1 + Loop + + If cntOnly Then + results.longi = 1 + results.dato(1) = cnt + End If + + Return results +End Function + +' Generate random factorial base number sequence +Function randFBN51() As Sequence + Dim As Sequence fbn51 + fbn51.longi = 51 + For i As Integer = 1 To 51 + fbn51.dato(i) = Int(Rnd * (52 - i)) + 1 + Next i + Return fbn51 +End Function + +' Main program +Randomize Timer +Dim As Integer i, j + +Dim As Sequence fbns = factorialBaseNumbers(3, 0) +Dim As Sequence omega +omega.longi = 4 +For i = 0 To 3 + omega.dato(i + 1) = i +Next i + +For i = 1 To fbns.longi + For j = 1 To 3 + Print fbns.dato((i-1)*3 + j) & "."; + Next j + Print Chr(8) & " ->"; + + Dim As Sequence tmp + tmp.longi = 3 + For j = 1 To 3 + tmp.dato(j) = fbns.dato((i-1)*3 + j) + Next j + + Dim As Sequence result = fperm(tmp, omega) + printSequence(result) +Next i + +Print +Dim As Sequence cnt = factorialBaseNumbers(10, 1) +Print "Permutations generated ="; cnt.dato(1) +Print " compared to 11! which ="; factorial(11) + +Print +Dim As Sequence fbn51s(3) + +' First predefined sequence +fbn51s(1).longi = 51 +Data 39,49,7,47,29,30,2,12,10,3,29,37,33,17,12,31,29,34,17,25,2,4,25,4,1,14,20,6,21,18,1,1,1,4,0,5,15,12,4,3,10,10,9,1,6,5,5,3,0,0,0 +For i = 1 To 51: Read fbn51s(1).dato(i): Next + +' Second predefined sequence +fbn51s(2).longi = 51 +Data 51,48,16,22,3,0,19,34,29,1,36,30,12,32,12,29,30,26,14,21,8,12,1,3,10,4,7,17,6,21,8,12,15,15,13,15,7,3,12,11,9,5,5,6,6,3,4,0,3,2,1 +For i = 1 To 51: Read fbn51s(2).dato(i): Next + +' Third random sequence +fbn51s(3) = randFBN51() + +' Show all card arrangements +For i = 1 To 3 + showCards(fperm(fbn51s(i), tagset(52))) +Next i + +Sleep diff --git a/Task/Factorial-primes/PascalABC.NET/factorial-primes.pas b/Task/Factorial-primes/PascalABC.NET/factorial-primes.pas new file mode 100644 index 0000000000..817ecf3506 --- /dev/null +++ b/Task/Factorial-primes/PascalABC.NET/factorial-primes.pas @@ -0,0 +1,42 @@ +function IsPrime(n: int64): boolean; +begin + if (n = 2) or (n = 3) then Result := true + else if (n <= 1) or ((n mod 2) = 0) or ((n mod 3) = 0) then Result := false + else + begin + var i := 5; + Result := False; + while i <= trunc(sqrt(n)) do + begin + if ((n mod i) = 0) or ((n mod (i + 2)) = 0) then exit; + i += 6; + end; + Result := True; + end; +end; + +function Factorial(n: integer): int64; +begin + Result := 1; + for var i := 2 to n do Result *= i; +end; + +begin + var found := 0; + var i := 1; + while found < 10 do + begin + var fact := Factorial(i); + if IsPrime(fact - 1) then + begin + writeln(i:2, '! - 1 = ', fact - 1); + found += 1; + end; + if IsPrime(fact + 1) then + begin + writeln(i:2, '! + 1 = ', fact + 1); + found += 1; + end; + i += 1; + end; +end. diff --git a/Task/Factorions/Jq/factorions.jq b/Task/Factorions/Jq/factorions.jq index 84891c0781..012ec312ee 100644 --- a/Task/Factorions/Jq/factorions.jq +++ b/Task/Factorions/Jq/factorions.jq @@ -29,7 +29,7 @@ def sufficient: .digits += 1 | .value *= $base ) ; -# Show the factorions for all based from 2 through 12: +# Show the factorions for all bases from 2 through 12: (range(2;10) | . as $base | sufficient.value as $max diff --git a/Task/Factorions/PascalABC.NET/factorions.pas b/Task/Factorions/PascalABC.NET/factorions.pas new file mode 100644 index 0000000000..ac69d82c56 --- /dev/null +++ b/Task/Factorions/PascalABC.NET/factorions.pas @@ -0,0 +1,22 @@ +## +var fact := |1| * 12; +for var i := 1 to 11 do fact[i] := i * fact[i - 1]; + +for var b := 9 to 12 do +begin + write('The factorions for base ', b:2, ' are: '); + for var i := 1 to 1_500_000 do + begin + var fact_sum := 0; + var j := i; + while j > 0 do + begin + var d := j mod b; + fact_sum += fact[d]; + j := j div b; + end; + if fact_sum = i then + print(i) + end; + println; +end; diff --git a/Task/Factors-of-a-Mersenne-number/M2000-Interpreter/factors-of-a-mersenne-number.m2000 b/Task/Factors-of-a-Mersenne-number/M2000-Interpreter/factors-of-a-mersenne-number.m2000 new file mode 100644 index 0000000000..d9f148a243 --- /dev/null +++ b/Task/Factors-of-a-Mersenne-number/M2000-Interpreter/factors-of-a-mersenne-number.m2000 @@ -0,0 +1,41 @@ +Module Factors_of_a_Mersenne_number{ + Dim q(1 To 10) + q(1)= 11, 23, 29, 37, 41, 43, 47, 53, 59, 67, 71, 73, 79, 83, 97, 929 + For k = 1 To 10 + If @isPrime(q(k)) Then + long p, r, d, r=q(k) + long long i + d = 2*q(k)+1 + while r>0: r=sint(binary.add(r,r)): end while + Do + i=1 + p=r + While p<>0 + i = i**2@ Mod d + If p<0 Then i*=2 + If i>d Then i-=d + p=sint(binary.add(p,p)) + End While + If i=1 Then Exit + d+=2*q(k) + Always + Print "2^"; q(k); @(6); " - 1 = 0 (mod"; d; ")" + Else + Print q(k); " is not prime" + End If + Next + + Function isPrime(n As long) + If n Mod 2 = 0 Then = n=2 : Exit Function + If n Mod 3 = 0 Then = n=3 : Exit Function + Local d As long = 5 + While d * d <= n + If n Mod d = 0 Then =False: exit function + d += 2 + If n Mod d = 0 Then = False: exit function + d += 4 + End While + =True + End Function +} +Factors_of_a_Mersenne_number diff --git a/Task/Factors-of-a-Mersenne-number/PascalABC.NET/factors-of-a-mersenne-number.pas b/Task/Factors-of-a-Mersenne-number/PascalABC.NET/factors-of-a-mersenne-number.pas new file mode 100644 index 0000000000..32d45238dc --- /dev/null +++ b/Task/Factors-of-a-Mersenne-number/PascalABC.NET/factors-of-a-mersenne-number.pas @@ -0,0 +1,36 @@ +const + q = 929; + +function isPrime(a: integer): boolean; +begin + if a = 2 then + begin result := true; exit end; + if (a < 2) or (a mod 2 = 0) then + begin result := false; exit end; + for var i := 3 to sqrt(a).Floor step 2 do + if a mod i = 0 then + begin result := false; exit end; + result := true; +end; + +begin + if not isPrime(q) then exit; + var r := q; + while r > 0 do r := r shl 1; + var d := 2 * q + 1; + while true do + begin + var i := 1; + var p := r; + while p <> 0 do + begin + i := (i * i) mod d; + if p < 0 then i *= 2; + if i > d then i -= d; + p := p shl 1; + end; + if i <> 1 then d += 2 * q + else break + end; + write('2^', q, ' - 1 = 0 (mod ', d, ')'); +end. diff --git a/Task/Factors-of-a-Mersenne-number/REXX/factors-of-a-mersenne-number-2.rexx b/Task/Factors-of-a-Mersenne-number/REXX/factors-of-a-mersenne-number-2.rexx index 6b25dba13c..0c9b756a9b 100644 --- a/Task/Factors-of-a-Mersenne-number/REXX/factors-of-a-mersenne-number-2.rexx +++ b/Task/Factors-of-a-Mersenne-number/REXX/factors-of-a-mersenne-number-2.rexx @@ -1,10 +1,11 @@ -say 'Factor of a Mersenne number - Using REXX libraries' +include Settings +say 'Factor of a Mersenne Number - Using REXX libraries' parse version version; say version; say call Time('r') numeric digits 300 n = Primes(1000) do i = 1 to n - x = prim.prime.i + x = prim.Prime.i select when (x >= 2 & x <= 83) then call Task x @@ -21,7 +22,7 @@ Task: procedure arg x a = x; a = 'M'a; m = 2**x -do k = 1 by 2*x to ISqrt(m) +do k = 1 by 2*x to Isqrt(m) if Right(k,1) = 5 then iterate k b = k//8 @@ -32,14 +33,15 @@ do k = 1 by 2*x to ISqrt(m) iterate k c = m//k if c = 1 then do - say a 'is composite =' k 'x ...' + say a 'is Composite =' k 'x ...' leave k end end end if c <> 1 then - say a 'is prime' + say a 'is Prime' return include Functions -include Numbers +include Sequences +Include Abend diff --git a/Task/Fairshare-between-two-and-more/PascalABC.NET/fairshare-between-two-and-more.pas b/Task/Fairshare-between-two-and-more/PascalABC.NET/fairshare-between-two-and-more.pas new file mode 100644 index 0000000000..d3d73e75cf --- /dev/null +++ b/Task/Fairshare-between-two-and-more/PascalABC.NET/fairshare-between-two-and-more.pas @@ -0,0 +1,22 @@ +function ThueMorseSequence(terms, baseValue: integer): list; +begin + result := new List; + for var i := 0 to terms - 1 do + begin + var sum := 0; + var n := i; + while (n > 0) do + begin + // Compute the digit sum + sum += n mod baseValue; + n := n div baseValue; + end; + // Compute the digit sum modulo baseValue. + result.Add(sum mod baseValue); + end; +end; + +begin + foreach var baseValue in |2, 3, 5, 11| do + println('Base', baseValue, '=', ThueMorseSequence(25, baseValue)); +end. diff --git a/Task/Farey-sequence/ALGOL-68/farey-sequence.alg b/Task/Farey-sequence/ALGOL-68/farey-sequence.alg index c0e20f9828..8a2e0ac9da 100644 --- a/Task/Farey-sequence/ALGOL-68/farey-sequence.alg +++ b/Task/Farey-sequence/ALGOL-68/farey-sequence.alg @@ -27,7 +27,7 @@ BEGIN # construct some Farey Sequences and calculate their lengths # length FI # farey sequence length # ; # task # - FOR i TO 11 DO farey sequence length( i, TRUE ) OD; + FOR i TO 11 DO VOID( farey sequence length( i, TRUE ) ) OD; FOR n FROM 100 BY 100 TO 1 000 DO print( ( "Farey Sequence of order ", whole( n, -4 ) , " has length: ", whole( farey sequence length( n, FALSE ), -6 ) diff --git a/Task/Farey-sequence/PascalABC.NET/farey-sequence.pas b/Task/Farey-sequence/PascalABC.NET/farey-sequence.pas new file mode 100644 index 0000000000..779923fc7c --- /dev/null +++ b/Task/Farey-sequence/PascalABC.NET/farey-sequence.pas @@ -0,0 +1,20 @@ +function Generate(n: integer): list<(integer, integer)>; +begin + var fractions := new list<(integer, integer)>; + result := new list<(integer, integer)>; + for var den := 1 to n do + for var num := 0 to den do fractions.Add((num, den)); + fractions := fractions.OrderBy(f -> f[0] / f[1]).ToList; + + result.Add(fractions[0]); + for var i := 0 to fractions.Count - 2 do + if fractions[i][0] * fractions[i + 1][1] <> fractions[i][1] * fractions[i + 1][0] then + result.add(fractions[i + 1]); +end; + +begin + for var i := 1 to 11 do + writeln('F', i, ': ', Generate(i).Select(f -> f[0].ToString + '/' + f[1].tostring)); + for var i := 100 to 1000 step 100 do + writeln('F', i, ' has ', Generate(i).Count, ' terms.'); +end. diff --git a/Task/Feigenbaum-constant-calculation/PascalABC.NET/feigenbaum-constant-calculation.pas b/Task/Feigenbaum-constant-calculation/PascalABC.NET/feigenbaum-constant-calculation.pas new file mode 100644 index 0000000000..9d7dc4d382 --- /dev/null +++ b/Task/Feigenbaum-constant-calculation/PascalABC.NET/feigenbaum-constant-calculation.pas @@ -0,0 +1,27 @@ +## +var maxIt := 13; +var maxItJ := 10; +var a1 := 1.0; +var a2 := 0.0; +var d1 := 3.2; +println(' i d'); +for var i := 2 to maxIt do +begin + var a := a1 + (a1 - a2) / d1; + for var j := 1 To maxItJ do + begin + var x := 0.0; + var y := 0.0; + for var k := 1 To 1 shl i do + begin + y := 1.0 - 2.0 * y * x; + x := a - x * x; + end; + a -= x / y; + end; + var d := (a1 - a2) / (a - a1); + writeln(i:2, d:14:10); + d1 := d; + a2 := a1; + a1 := a; +end; diff --git a/Task/Fermat-numbers/ALGOL-68/fermat-numbers.alg b/Task/Fermat-numbers/ALGOL-68/fermat-numbers.alg index 798b42a9a8..42ea37a082 100644 --- a/Task/Fermat-numbers/ALGOL-68/fermat-numbers.alg +++ b/Task/Fermat-numbers/ALGOL-68/fermat-numbers.alg @@ -19,7 +19,7 @@ BEGIN # find and factorise some Fermat numbers: F(n) = 2^(2^n) + 1 # IF is probably prime( n ) THEN n ELIF LONG LONG INT x := 2, y := 2, d := 1; - PROC g = ( LONG LONG INT x )LONG LONG INT: ( ( x * x ) + 1 ) MOD n; + PROC g = ( LONG LONG INT gx )LONG LONG INT: ( ( gx * gx ) + 1 ) MOD n; WHILE d = 1 DO x := g( x ); y := g( g( y ) ); diff --git a/Task/Fermat-numbers/PascalABC.NET/fermat-numbers.pas b/Task/Fermat-numbers/PascalABC.NET/fermat-numbers.pas new file mode 100644 index 0000000000..6d4086960e --- /dev/null +++ b/Task/Fermat-numbers/PascalABC.NET/fermat-numbers.pas @@ -0,0 +1,35 @@ +## +function IsPrime(n: biginteger): boolean; +begin + if (n = 2) or (n = 3) then Result := true + else if (n <= 1) or ((n mod 2) = 0) or ((n mod 3) = 0) then Result := false + else + begin + var i := 5bi; + Result := False; + while i * i < n do + begin + if (n mod i) = 0 then + begin + println(i, n div i); + exit; + end + else if (n mod (i + 2)) = 0 then + begin + println(i + 2, n div (i + 2)); + exit; + end; + i += 6; + end; + Result := True; + end; +end; + +function fermat(n: integer) := power(2bi, int64(power(2, n))) + 1; + +for var n := 0 to 9 do writeln('F', n, ' = ', fermat(n)); +for var n := 0 to 6 do +begin + write('F', n, ' = '); + if isprime(fermat(n)) then println(fermat(n)); +end; diff --git a/Task/Fibonacci-word-fractal/PascalABC.NET/fibonacci-word-fractal.pas b/Task/Fibonacci-word-fractal/PascalABC.NET/fibonacci-word-fractal.pas new file mode 100644 index 0000000000..704bd809f7 --- /dev/null +++ b/Task/Fibonacci-word-fractal/PascalABC.NET/fibonacci-word-fractal.pas @@ -0,0 +1,32 @@ +uses Turtle; + +function fibword(n: integer): string; +begin + var a := '1'.ToString; + result := '0'; + loop n - 2 do + begin + a := result + a; + swap(a, result); + end; +end; + +procedure draw_fractal(w: string; step: real); +begin + foreach var c in w index i do + begin + Forw(step); + if c = '0' then + if i mod 2 = 0 then TurnLeft(90) + else TurnRight(90) + end; +end; + +begin + var w := fibword(20); + var step := 1; + SetWidth(2); + Down; + TurnRight(90); + draw_fractal(w, step); +end. diff --git a/Task/Fibonacci-word/ALGOL-68/fibonacci-word.alg b/Task/Fibonacci-word/ALGOL-68/fibonacci-word.alg index cdeda9d346..abb856955b 100644 --- a/Task/Fibonacci-word/ALGOL-68/fibonacci-word.alg +++ b/Task/Fibonacci-word/ALGOL-68/fibonacci-word.alg @@ -22,7 +22,6 @@ PROC print fibonacci word stats = ( INT max number )VOID: BEGIN - # prints some statistics for a fibonacci word: # # the word number, its length and its entropy # PROC print one words stats = ( INT word @@ -30,75 +29,51 @@ BEGIN , INT ones )VOID: BEGIN - REAL probability := 0; REAL entropy := 0; INT word length = zeros + ones; - IF zeros > 0 THEN # the word contains some zeros # probability := zeros / word length; entropy -:= probability * log( probability ) FI; - IF ones > 0 THEN # the word contains some ones # probability := ones / word length; entropy -:= probability * log( probability ) FI; - # we want entropy in bits so convert to log base 2 # entropy /:= log( 2 ); - - print( ( ( whole( word, -5 ) - + " " - + whole( word length, -12 ) - + " " - + fixed( entropy, -8, 4 ) - ) - , newline - ) - ) - - + print( ( whole( word, -5 ), " ", whole( word length, -12 ) ) ); + print( ( " ", fixed( entropy, -8, 4 ), newline ) ) END; # print one words stats # - INT zeros one = 0; # number of zeros in word 1 # INT ones one = 1; # number of ones in word 1 # INT zeros two = 1; # number of zeros in word 2 # INT ones two = 0; # number of ones in word 2 # - print( ( " word length entropy", newline ) ); - IF max number > 0 THEN # we want at least one number's statistics # print one words stats( 1, zeros one, ones one ); - IF max number > 1 THEN # we want at least 2 number's statistics # print one words stats( 2, zeros two, ones two ); - IF max number > 2 THEN # we want more statistics # - INT zeros n minus 1 := zeros two; INT ones n minus 1 := ones two; INT zeros n minus 2 := zeros one; INT ones n minus 2 := ones one; - FOR word FROM 3 TO max number DO - INT zeros n := zeros n minus 1 + zeros n minus 2; INT ones n := ones n minus 1 + ones n minus 2; - print one words stats( word, zeros n, ones n ); - zeros n minus 2 := zeros n minus 1; ones n minus 2 := ones n minus 1; zeros n minus 1 := zeros n; @@ -107,12 +82,7 @@ BEGIN FI FI FI - END; # print fibonacci word stats # - -main: -( - # print the statistics for the first 37 fibonacci words # - print fibonacci word stats( 37 ) -) +# print the statistics for the first 37 fibonacci words # +print fibonacci word stats( 37 ) diff --git a/Task/Fibonacci-word/PascalABC.NET/fibonacci-word.pas b/Task/Fibonacci-word/PascalABC.NET/fibonacci-word.pas new file mode 100644 index 0000000000..eee6fcebff --- /dev/null +++ b/Task/Fibonacci-word/PascalABC.NET/fibonacci-word.pas @@ -0,0 +1,37 @@ +function entropy(str: string): real; +begin + // ## return the entropy of a fibword string. + if str.length <= 1 then begin result := 0.0; exit end; + var strlen := str.length; + var count0 := str.where(c -> c = '0').count; + var count1 := strlen - count0; + result := -(count0 / strlen * log2(count0 / strlen) + count1 / strlen * log2(count1 / strlen)) +end; + +function fibword(): sequence of string; +begin + // ## Yield the successive fibwords. + var a := '1'.ToString; + var b := '0'.ToString; + yield a; + yield b; + while true do + begin + a := b + a; + swap(a, b); + yield b + end; +end; + +begin + println(' n length entropy'); + println('————————————————————————————————'); + var n := 0; + foreach var str in fibword do + begin + n += 1; + write(n:2, str.length:10, entropy(str):18:14); + if n < 10 then writeln(' ', str) else writeln; + if n = 37 then break + end; +end. diff --git a/Task/File-input-output/FutureBasic/file-input-output.basic b/Task/File-input-output/FutureBasic/file-input-output.basic index 6fc45a678d..f66dbb9cb5 100644 --- a/Task/File-input-output/FutureBasic/file-input-output.basic +++ b/Task/File-input-output/FutureBasic/file-input-output.basic @@ -50,8 +50,6 @@ fn doIt end select end fn - on AppEvent fn DoAppEvent - handleevents diff --git a/Task/Find-the-last-Sunday-of-each-month/ALGOL-68/find-the-last-sunday-of-each-month.alg b/Task/Find-the-last-Sunday-of-each-month/ALGOL-68/find-the-last-sunday-of-each-month.alg index 98c92a6a9c..9fcb7f60bd 100644 --- a/Task/Find-the-last-Sunday-of-each-month/ALGOL-68/find-the-last-sunday-of-each-month.alg +++ b/Task/Find-the-last-Sunday-of-each-month/ALGOL-68/find-the-last-sunday-of-each-month.alg @@ -33,17 +33,18 @@ BEGIN # find the last Sunday in each month of a year # OD; last END # last sundays # ; - # test the last sundays procedure # - INT year = 2021; - []INT last = last sundays( year ); - FOR m pos TO 12 DO - print( ( whole( year, 0 ) - , IF m pos < 10 THEN "-0" ELSE "-1" FI - , whole( m pos MOD 10, 0 ) - , "-" - , whole( last[ m pos ], 0 ) - , newline - ) - ) - OD + BEGIN # test the last sundays procedure # + INT year = 2021; + []INT last = last sundays( year ); + FOR m pos TO 12 DO + print( ( whole( year, 0 ) + , IF m pos < 10 THEN "-0" ELSE "-1" FI + , whole( m pos MOD 10, 0 ) + , "-" + , whole( last[ m pos ], 0 ) + , newline + ) + ) + OD + END END diff --git a/Task/Find-the-last-Sunday-of-each-month/M2000-Interpreter/find-the-last-sunday-of-each-month.m2000 b/Task/Find-the-last-Sunday-of-each-month/M2000-Interpreter/find-the-last-sunday-of-each-month.m2000 new file mode 100644 index 0000000000..8ee65ae040 --- /dev/null +++ b/Task/Find-the-last-Sunday-of-each-month/M2000-Interpreter/find-the-last-sunday-of-each-month.m2000 @@ -0,0 +1,23 @@ +module LastSunday (year as integer=0) { + REM LOCALE 1032 ' Greek + LOCALE 1033 ' US - English + DEF firstdayYear(y)=cdate(0, y-1900,0,2) + DEF lastdayYear(y)=cdate(0, y-1900,12,1) + IF year=0 THEN INPUT "Year (e.g. 2024 or 24):", year + year=ABS(year) + IF year<100 THEN year+=2000 + DATE a=firstdayYear(year), Sunday=1 + DATE a1=lastdayYear(year) + DATE i=a+7-(a-Sunday) mod 7 + DOCUMENT result$="Last Sunday per month for year " + year + {: + } + FOR i=i+7 TO a1 STEP 7 + IF VAL(DATE$(i, LOCALE, "M")) <>VAL(DATE$(i+7, LOCALE, "M")) THEN + result$=FORMAT$("{0:12} {1:-14}",DATE$(i, LOCALE, "MMMM"),DATE$(i, LOCALE, "d")) + { + } + END IF + NEXT + PRINT #-2, result$ + CLIPBOARD result$ +} +LastSunday 2025 diff --git a/Task/Find-the-last-Sunday-of-each-month/V-(Vlang)/find-the-last-sunday-of-each-month.v b/Task/Find-the-last-Sunday-of-each-month/V-(Vlang)/find-the-last-sunday-of-each-month.v new file mode 100644 index 0000000000..109e638118 --- /dev/null +++ b/Task/Find-the-last-Sunday-of-each-month/V-(Vlang)/find-the-last-sunday-of-each-month.v @@ -0,0 +1,24 @@ +import time +import os + +fn main() { + mut year := "" + mut now, mut mdx := time.now(), time.month_days[0] + for year.len != 4 || !year.split("").any(it.is_int()) { + year = os.input("What year to calculate (yyyy): ") + } + println("Last Sunday for each month of ${year}") + println("==================================") + for idx in 1..13 { + mdx = time.month_days[idx - 1] + if idx == 2 && time.is_leap_year(year.int()) {mdx = 29} + for { + now = time.parse("$year-${idx:02}-${mdx} 12:30:00")! + if now.weekday_str() == "Sun" { + println("${time.long_months[idx -1 ]}: ${mdx}") + break + } + mdx-- + } + } +} diff --git a/Task/First-perfect-square-in-base-n-with-n-unique-digits/ALGOL-68/first-perfect-square-in-base-n-with-n-unique-digits.alg b/Task/First-perfect-square-in-base-n-with-n-unique-digits/ALGOL-68/first-perfect-square-in-base-n-with-n-unique-digits.alg index 4cd590746e..540e9b67d6 100644 --- a/Task/First-perfect-square-in-base-n-with-n-unique-digits/ALGOL-68/first-perfect-square-in-base-n-with-n-unique-digits.alg +++ b/Task/First-perfect-square-in-base-n-with-n-unique-digits/ALGOL-68/first-perfect-square-in-base-n-with-n-unique-digits.alg @@ -25,9 +25,7 @@ BEGIN # find the first perfect square in base n with n unique digits n=1..16 # FOR b FROM 2 TO 16 DO all digits := all digits OR dmask[ b - 1 ]; LONG INT root := 1; - FOR i TO b - 1 DO - root *:= b - OD; + TO b - 1 DO root *:= b OD; root := ENTIER long sqrt( root ); BOOL found := FALSE; WHILE NOT found DO diff --git a/Task/Five-weekends/Jq/five-weekends-1.jq b/Task/Five-weekends/Jq/five-weekends-1.jq index 9b9ce0a660..89cc7a31bd 100644 --- a/Task/Five-weekends/Jq/five-weekends-1.jq +++ b/Task/Five-weekends/Jq/five-weekends-1.jq @@ -1,4 +1,4 @@ - Use Zeller's Congruence to determine the day of the week, given +# Use Zeller's Congruence to determine the day of the week, given # year, month and day as integers in the conventional way. # Emit 0 for Saturday, 1 for Sunday, etc. # diff --git a/Task/Five-weekends/PascalABC.NET/five-weekends.pas b/Task/Five-weekends/PascalABC.NET/five-weekends.pas new file mode 100644 index 0000000000..98a7e8d4bd --- /dev/null +++ b/Task/Five-weekends/PascalABC.NET/five-weekends.pas @@ -0,0 +1,27 @@ +uses system; + +const + startYear = 1900; + endYear = 2100; + +begin + var query := new List; + foreach var year in (startyear..endyear) do + foreach var month in (1..12) do + if DateTime.DaysInMonth(year, month) = 31 then + query.Add(new DateTime(year, month, 1)); + query := query.where(d -> d.dayofweek = dayofweek.Friday).ToList; + + println('Count:', query.Count); + println; + println('First five:'); + foreach var date in query.Take(5) do + writeln(date.Year, '-', date.Month); + println; + Println('Last five:'); + foreach var date in query.Skip(query.Count - 5) do + writeln(date.Year, '-', date.Month); + println; + println('Years without 5 weekends:'); + (startyear..endyear).except(query.Select(d -> d.year)).Println +end. diff --git a/Task/FizzBuzz/YAMLScript/fizzbuzz.ys b/Task/FizzBuzz/YAMLScript/fizzbuzz.ys index b328c65d02..7dbb165768 100644 --- a/Task/FizzBuzz/YAMLScript/fizzbuzz.ys +++ b/Task/FizzBuzz/YAMLScript/fizzbuzz.ys @@ -1,39 +1,7 @@ !yamlscript/v0 -defn main(count=100 impl=1): - :: | - Invoke one of the FizzBuzz implementations below. - - usage: ys fizzbuzz.ys [ []] - - fizzbuzz =: "fizzbuzz-$impl" - say: "Running function '$fizzbuzz' with count=$count" - mapv say: - call fizzbuzz: count - -defn fizzbuzz-1(n): - :: Implementation 1 - with 'map' - map _ (1 .. n): - fn(x): - cond: - zero?(x % 15) : 'FizzBuzz' - zero?(x % 5) : 'Buzz' - zero?(x % 3) : 'Fizz' - else : x - -defn fizzbuzz-2(n): - :: Implementation 2 - with 'loop' - loop i 1, l []: - if i <= n: - recur i.++: - conj l: - condp eq 0: - i % 15 :: FizzBuzz - i % 5 :: Buzz - i % 3 :: Fizz - else : i - else: l - -defn fizzbuzz-3(n): - :: Implementation 3 - with 'for' - for x (1 .. n): str(((x % 3).! &&& 'Fizz') ((x % 5).! &&& 'Buzz')) ||| x +defn main(n=100): + each x (1 .. n): !:say + or? _ x: + str ((x % 3).! &&& 'Fizz'): + ((x % 5).! &&& 'Buzz') diff --git a/Task/Flow-control-structures/FutureBasic/flow-control-structures.basic b/Task/Flow-control-structures/FutureBasic/flow-control-structures.basic new file mode 100644 index 0000000000..e1bdbc5e11 --- /dev/null +++ b/Task/Flow-control-structures/FutureBasic/flow-control-structures.basic @@ -0,0 +1,21 @@ +override _allowSubroutines = _true +#build Optimization _buildOptimizationNone + +print "First line." +gosub "sub1" +print "Fifth line." + +HandleEvents + +"sub1" +print "Second line." +gosub "sub2" +print "Fourth line." +goto "skip" +print "we don't get here" +"skip" +return + +"sub2" +print "Third line." +return diff --git a/Task/Floyd-Warshall-algorithm/ALGOL-68/floyd-warshall-algorithm.alg b/Task/Floyd-Warshall-algorithm/ALGOL-68/floyd-warshall-algorithm.alg index 1b23cfac2f..68ed0e7149 100644 --- a/Task/Floyd-Warshall-algorithm/ALGOL-68/floyd-warshall-algorithm.alg +++ b/Task/Floyd-Warshall-algorithm/ALGOL-68/floyd-warshall-algorithm.alg @@ -22,7 +22,7 @@ BEGIN # Floyd-Warshall algorithm - translated from the Lua sample # ) ); WHILE u := nxt[ u - 1, v - 1 ]; - print( ( " -> " +whole( u, 0 ) ) ); + print( ( " -> " + whole( u, 0 ) ) ); u /= v DO SKIP OD; print( ( newline ) ) @@ -34,12 +34,12 @@ BEGIN # Floyd-Warshall algorithm - translated from the Lua sample # PROC floyd warshall = ( [,]INT weights, INT num vertices )VOID: BEGIN - REAL infinity = max real; + REAL infinite = max real; [ 0 : num vertices - 1, 0 : num vertices - 1 ]REAL dist; FOR i FROM LWB dist TO 1 UPB dist DO FOR j FROM 2 LWB dist TO 2 UPB dist DO - dist[ i, j ] := infinity + dist[ i, j ] := infinite OD OD; @@ -59,7 +59,7 @@ BEGIN # Floyd-Warshall algorithm - translated from the Lua sample # FOR k FROM 2 LWB dist TO 2 UPB dist DO FOR i FROM 1 LWB dist TO 1 UPB dist DO FOR j FROM 2 LWB dist TO 2 UPB dist DO - IF dist[ i, k ] /= infinity AND dist[ k, j ] /= infinity THEN + IF dist[ i, k ] /= infinite AND dist[ k, j ] /= infinite THEN IF dist[ i, k ] + dist[ k, j ] < dist[ i, j ] THEN dist[ i, j ] := dist[ i, k ] + dist[ k, j ]; nxt[ i, j ] := nxt[ i, k ] @@ -71,14 +71,14 @@ BEGIN # Floyd-Warshall algorithm - translated from the Lua sample # print result( dist, nxt ) END # floyd warshall # ; - - [,]INT weights = ( ( 1, 3, -2 ) - , ( 2, 1, 4 ) - , ( 2, 3, 3 ) - , ( 3, 4, 2 ) - , ( 4, 2, -1 ) - ); - INT num vertices = 4; - floyd warshall( weights, num vertices ) - + BEGIN + [,]INT weights = ( ( 1, 3, -2 ) + , ( 2, 1, 4 ) + , ( 2, 3, 3 ) + , ( 3, 4, 2 ) + , ( 4, 2, -1 ) + ); + INT num vertices = 4; + floyd warshall( weights, num vertices ) + END END diff --git a/Task/Floyds-triangle/YAMLScript/floyds-triangle.ys b/Task/Floyds-triangle/YAMLScript/floyds-triangle.ys index 94df2abdee..d1619de731 100644 --- a/Task/Floyds-triangle/YAMLScript/floyds-triangle.ys +++ b/Task/Floyds-triangle/YAMLScript/floyds-triangle.ys @@ -9,5 +9,5 @@ defn main(n): conj(rows nums.take(row-n)) else: rows width =: rows:last:last:len - fmt =: \((' ' * (width - len(_))) + _) + fmt =: \((' ' * (width - _:len)) + _) each row rows: say(row.map(fmt):joins) diff --git a/Task/Fortunate-numbers/REXX/fortunate-numbers-2.rexx b/Task/Fortunate-numbers/REXX/fortunate-numbers-2.rexx index 3735dfc520..5d4aa0d250 100644 --- a/Task/Fortunate-numbers/REXX/fortunate-numbers-2.rexx +++ b/Task/Fortunate-numbers/REXX/fortunate-numbers-2.rexx @@ -24,7 +24,7 @@ do i = 1 to x p = prmo.primorial.i do j = 3 by 2 m = m+1 - if IsPrime(p+j) then + if Prime(p+j) then leave j end if work.j = 0 then do @@ -55,6 +55,7 @@ say Format(Time('e'),,3) 'seconds'; say return include Numbers +include Sequences include Functions include Constants include Abend diff --git a/Task/Forward-difference/FutureBasic/forward-difference.basic b/Task/Forward-difference/FutureBasic/forward-difference.basic new file mode 100644 index 0000000000..b9277f5984 --- /dev/null +++ b/Task/Forward-difference/FutureBasic/forward-difference.basic @@ -0,0 +1,26 @@ +include "NSLog.incl" + +CFArrayRef local fn ForwardDifference( arr as CFArrayRef ) + CFMutableArrayRef result = fn MutableArrayNew + for NSUInteger i = 1 to len(arr) - 1 + CFNumberRef diff = @(dblval(arr[i]) - dblval(arr[i-1])) + MutableArrayAddObject( result, diff ) + next +end fn = result + +CFArrayRef local fn NthForwardDifference( arr as CFArrayRef, n as NSInteger ) + if ( len(arr) == 0 ) then return @[] + if ( n == 0 ) then return arr +end fn = fn NthForwardDifference( fn ForwardDifference( arr ), n - 1 ) + +void local fn DoIt + CFArrayRef initialArray = @[@90, @47, @58, @29, @22, @32, @55, @5, @55, @73] + for NSInteger i = 0 to 9 + CFArrayRef diff = fn NthForwardDifference( initialArray, i ) + NSLog(@"[%@]", fn ArrayComponentsJoinedByString( diff, @", " )) + next +end fn + +fn DoIt + +HandleEvents diff --git a/Task/Fractran/ALGOL-68/fractran.alg b/Task/Fractran/ALGOL-68/fractran.alg index c1d894374e..2908205a60 100644 --- a/Task/Fractran/ALGOL-68/fractran.alg +++ b/Task/Fractran/ALGOL-68/fractran.alg @@ -1,6 +1,6 @@ # 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 +# we use Algol 68G's LONG LONG INT with a precision of 200 digits # +PR precision 200 PR # mode to hold fractions # MODE FRACTION = STRUCT( INT numerator, INT denominator ); @@ -9,16 +9,16 @@ MODE FRACTION = STRUCT( INT numerator, INT denominator ); OP / = ( INT a, b )FRACTION: ( a, b ); # mode to define a FRACTRAN progam # -MODE FRACTRAN = STRUCT( FLEX[0]FRACTION data +MODE FRACTRAN = STRUCT( [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: +OP STARTAT = ( REF FRACTRAN f, INT start p )REF FRACTRAN: BEGIN halted OF f := FALSE; - n OF f := start; + n OF f := start p; f END; @@ -39,36 +39,39 @@ OP NEXT = ( REF FRACTRAN f )LONG LONG INT: FI ; # generate and print the sequence of numbers from a FRACTRAN pogram # -PROC print fractran sequence = ( REF FRACTRAN f, INT start, INT limit )VOID: +PROC print fractran sequence = ( REF FRACTRAN f, INT start p, INT limit )VOID: BEGIN - VOID( f STARTAT start ); - print( ( "0: ", whole( start, 0 ) ) ); + VOID( f STARTAT start p ); + print( ( "0: ", whole( start p, 0 ) ) ); FOR i TO limit WHILE VOID( NEXT f ); NOT halted OF f DO - print( ( " " + whole( i, 0 ) + ": " + whole( n OF f, 0 ) ) ) + 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 ); +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 +BEGIN + 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 + primes found +:= 1; + print( ( whole( pos, -12 ), " ", whole( power of 2, -6 ) ) ); + print( ( " (" + whole( n OF pf, 0 ), ")", newline ) ) + FI + OD +END diff --git a/Task/Fractran/Miranda/fractran.miranda b/Task/Fractran/Miranda/fractran.miranda new file mode 100644 index 0000000000..c1f844d524 --- /dev/null +++ b/Task/Fractran/Miranda/fractran.miranda @@ -0,0 +1,80 @@ +main :: [sys_message] +main = [Stdout (lay [show (take 15 (run 2 primeprog)), + show (take 20 fracprimes)])] + +primeprog :: [(num,num)] +primeprog = fromjust (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")) + +fracprimes :: [num] +fracprimes = [fromjust k | k<-map fracprime (run 2 primeprog); isjust k] + +fracprime :: num->maybe num +fracprime = f 0 + where f 1 1 = Nothing + f n 1 = Just n + f n x = Nothing, if x mod 2 ~= 0 + f n x = f (n+1) (x div 2), otherwise + +run :: num->[(num,num)]->[num] +run n prog = [n], if ~isjust n' + = n : run (fromjust n') prog, otherwise + where n' = step n prog + +step :: num->[(num,num)]->maybe num +step x [] = Nothing +step x ((n,d):xs) = Just (x*n div d), if x*n mod d = 0 + = step x xs, otherwise + +maybe * ::= Nothing | Just * + +isjust :: maybe *->bool +isjust (Just x) = True +isjust Nothing = False + +fromjust :: maybe *->* +fromjust (Just x) = x + +prog :: [char]->maybe [(num, num)] +prog xs = Just [], if trim xs = [] + = Nothing, if ~isjust fp \/ ~isjust rp + = Just (fr : fromjust rp), otherwise + where fp = frac xs + Just (fr, xs') = fp + rp = prog xs' + +frac :: [char]->maybe ((num,num), [char]) +frac xs = Nothing, if ~isjust np \/ ~isjust sl \/ ~isjust dp + = Just ((n, d), xs'''), otherwise + where np = numb xs + Just (n, xs') = np + sl = match '/' (trim xs') + Just xs'' = sl + dp = numb xs'' + Just (d, xs''') = dp + +numb :: [char]->maybe (num, [char]) +numb xs = Nothing, if n=[] + = Just (numval n, r), otherwise + where (n, r) = span "0123456789" (trim xs) + +match :: *->[*]->maybe [*] +match m [] = Nothing +match m (m:xs) = Just xs +match m (x:xs) = Nothing + +span :: [*]->[*]->([*],[*]) +span match [] = ([], []) +span match (x:xs) = ([], x:xs), if ~(x $in match) + = (x:r, xs'), otherwise + where (r, xs') = span match xs + +in :: *->[*]->bool +in x [] = False +in x (x:xs) = True +in x (y:xs) = x $in xs + +trim :: [char]->[char] +trim [] = [] +trim (c:xs) = trim xs, if c='\t' \/ c='\n' \/ c=' ' +trim (c:xs) = c:xs diff --git a/Task/Fractran/REXX/fractran-3.rexx b/Task/Fractran/REXX/fractran-3.rexx index 7981a9941e..1614a50f5c 100644 --- a/Task/Fractran/REXX/fractran-3.rexx +++ b/Task/Fractran/REXX/fractran-3.rexx @@ -29,7 +29,7 @@ call Time('r') say 'First' t 'terms of the sequence:' do i = 2 to t do j = 1 to w - if \ IsWhole(n/d.j) then + if \ Whole(n/d.j) then iterate call CharOut ,Right(n,9) if i//10 = 0 then @@ -57,7 +57,7 @@ say 'Prime numbers:' n = 2; p = 0 do i = 2 to 1300000 do j = 1 to w - if \ IsWhole(n/d.j) then + if \ Whole(n/d.j) then iterate j if p.n then do p = p+1 diff --git a/Task/Fractran/Refal/fractran.refal b/Task/Fractran/Refal/fractran.refal new file mode 100644 index 0000000000..e66c789961 --- /dev/null +++ b/Task/Fractran/Refal/fractran.refal @@ -0,0 +1,78 @@ +$ENTRY Go { + , >: e.Prog + = > + >; +}; + +PrimeProgram { + = '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'; +}; + +FracPrimes { + 0 e.X = ; + s.I (e.N) e.P, + : Next e.N2, + : { + T s.N = s.N (e.N2) e.P>; + F = ; + }; +}; + +FracPrime { + (1) 1 = F; + (s.N) 1 = T s.N; + (s.N) e.X, : { + (e.X2) 0 = ) e.X2>; + e.Z = F; + }; + e.X = ; +}; + +FracRun { + 0 e.X = ; + s.I (e.N) e.P, : { + Halt = e.N; + Next e.N2 = e.N (e.N2) e.P>; + }; +}; + +FracStep { + (e.N) = Halt; + (e.N) ((e.Num) e.Denom) e.P, + ) e.Denom>: { + (e.N2) 0 = Next e.N2; + e.X = ; + }; +}; + +Prog { + e.X, : T (e.F) e.R = (e.F) ; + e.X = ; +}; + +Frac { + e.X, : T (e.N) e.X2, + : '/' e.X3, + : T (e.D) e.X4 = + T ((e.N) e.D) e.X4; + e.X = F e.X; +}; + +Num { + e.X, >: { + () e.R = F e.R; + (e.N) e.R = T () e.R; + }; +}; + +Span { + (e.M) (e.S) s.C e.X, e.S: e.1 s.C e.2 = ; + (e.M) (e.S) e.X = (e.M) e.X; + (e.S) e.X = ; +}; + +SkipWs { + s.C e.X, ' \n\t': e.1 s.C e.2 = ; + e.X = e.X; +}; diff --git a/Task/Fractran/SETL/fractran.setl b/Task/Fractran/SETL/fractran.setl new file mode 100644 index 0000000000..05f2b18236 --- /dev/null +++ b/Task/Fractran/SETL/fractran.setl @@ -0,0 +1,52 @@ +program fractran; + p := parse_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" + ); + + print(frac_run_steps(p, 2, 15)); + print(frac_primes(p, 2, 20)); + + proc frac_primes(p, n, nprimes); + primes := []; + loop for i in [1..nprimes] do + loop until n bit_and (n-1) = 0 do + n := frac_step(p, n); + end loop; + primes with:= log n/log 2; + end loop; + return primes; + end proc; + + proc frac_run_steps(p, n, steps); + return [n] + [n := frac_step(p, n) : i in [2..steps]]; + end proc; + + proc frac_step(p, n); + if exists [num, denom] in p | n * num mod denom = 0 then + return n * num div denom; + end if; + return om; + end proc; + + proc rdws(rw s); + span(s, " \t\n"); + end proc; + + proc rdnum(rw s); + rdws(s); + return val span(s, "0123456789"); + end proc; + + proc rdfrac(rw s); + if (num := rdnum(s)) = om then return om; end if; + rdws(s); + if match(s, "/") = "" then return om; end if; + if (denom := rdnum(s)) = om then return om; end if; + return [num, denom]; + end proc; + + proc parse_fractran(s); + return [f := rdfrac(s) : until f=om]; + end proc; +end program; diff --git a/Task/Function-composition/FutureBasic/function-composition.basic b/Task/Function-composition/FutureBasic/function-composition.basic new file mode 100644 index 0000000000..8df8fe887d --- /dev/null +++ b/Task/Function-composition/FutureBasic/function-composition.basic @@ -0,0 +1,14 @@ +double local fn FunctionF( x as double ) +end fn = x + 1.5 + +double local fn FunctionG( x as double ) +end fn = x * x + +double local fn Compose( f as ptr, g as ptr ) + double def fn ff(x1 as double) using f + double def fn fg(x2 as double) using g +end fn = fn ff(fn fg(2.5)) + +print fn Compose( @fn FunctionF, @fn FunctionG ) + +HandleEvents diff --git a/Task/Function-definition/FutureBasic/function-definition.basic b/Task/Function-definition/FutureBasic/function-definition-1.basic similarity index 100% rename from Task/Function-definition/FutureBasic/function-definition.basic rename to Task/Function-definition/FutureBasic/function-definition-1.basic diff --git a/Task/Function-definition/FutureBasic/function-definition-2.basic b/Task/Function-definition/FutureBasic/function-definition-2.basic new file mode 100644 index 0000000000..c6c813c61b --- /dev/null +++ b/Task/Function-definition/FutureBasic/function-definition-2.basic @@ -0,0 +1,8 @@ +window 1 + +long local fn multiply( a as long, b as long ) +end fn = a * b + +print fn multiply( 3, 9 ) + +HandleEvents diff --git a/Task/Function-prototype/FutureBasic/function-prototype.basic b/Task/Function-prototype/FutureBasic/function-prototype.basic index 547ce06eff..9a96932ecb 100644 --- a/Task/Function-prototype/FutureBasic/function-prototype.basic +++ b/Task/Function-prototype/FutureBasic/function-prototype.basic @@ -1,3 +1,4 @@ def fn NoArgs def fn TwoArgs( a as long, b as long ) def fn VarArgs( n as long, ... ) +long def fn Multiply( a as long, b as long ) // function returns a value diff --git a/Task/Fusc-sequence/FutureBasic/fusc-sequence.basic b/Task/Fusc-sequence/FutureBasic/fusc-sequence.basic new file mode 100644 index 0000000000..4f848b700e --- /dev/null +++ b/Task/Fusc-sequence/FutureBasic/fusc-sequence.basic @@ -0,0 +1,40 @@ +_max = 20000000 + +begin globals +NSUInteger f(_max) +end globals + +void local fn Fusc + f(0) = 0 : f(1) = 1 + for NSUInteger n = 2 to _max + if ( n & 1 ) + f(n) = f((n - 1) / 2) + f((n + 1) / 2) + else + f(n) = f(n / 2) + end if + next +end fn + +void local fn DoIt + NSUInteger i, d = 0 + + fn Fusc + + for i = 0 to 60 + print f(i);" "; + if ( i == 32 ) then print + next + + print : print : print @" index\t\t value" + for i = 0 to _max + if ( f(i) >= d ) + printf @"%11lu\t\t%6lu",i,f(i) + if ( d == 0 ) then d = 1 + d *= 10 + end if + next +end fn + +fn DoIt + +HandleEvents diff --git a/Task/Gamma-function/REXX/gamma-function-3.rexx b/Task/Gamma-function/REXX/gamma-function-3.rexx index 0e72ca6abf..37ad3facc1 100644 --- a/Task/Gamma-function/REXX/gamma-function-3.rexx +++ b/Task/Gamma-function/REXX/gamma-function-3.rexx @@ -49,7 +49,7 @@ procedure expose glob. fact. arg x /* Formulas for negative and positive (half)integers */ if x < 0 then do - if IsHalf(x) then do + if Half(x) then do numeric digits Digits()+2 i = Abs(Floor(x)); y = (-1)**i*2**(2*i)*Fact(i)*Sqrt(Pi())/Fact(2*i) numeric digits Digits()-2 @@ -57,9 +57,9 @@ if x < 0 then do end end if x > 0 then do - if IsWhole(x) then + if Whole(x) then return Fact(x-1) - if IsHalf(x) then do + if Half(x) then do numeric digits Digits()+2 i = Floor(x); y = Fact(2*i)*Sqrt(Pi())/(2**(2*i)*Fact(i)) numeric digits Digits()-2 diff --git a/Task/Gapful-numbers/ALGOL-68/gapful-numbers.alg b/Task/Gapful-numbers/ALGOL-68/gapful-numbers.alg index e9f1e423de..55c4cf9bb7 100644 --- a/Task/Gapful-numbers/ALGOL-68/gapful-numbers.alg +++ b/Task/Gapful-numbers/ALGOL-68/gapful-numbers.alg @@ -23,10 +23,10 @@ BEGIN # find some gapful numbers - numbers divisible by f*10 + b # result END; # GAPFUL # # prints a sequence of gapful numbers # - PROC print gapful = ( []INT seq, INT start )VOID: + PROC print gapful = ( []INT seq, INT nstart )VOID: BEGIN print( ( "First ", whole( ( UPB seq + 1 ) - LWB seq, 0 ) - , " gapful numbers starting from ", whole( start, 0 ) + , " gapful numbers starting from ", whole( nstart, 0 ) , ":", newline ) ); diff --git a/Task/Gauss-Jordan-matrix-inversion/ALGOL-68/gauss-jordan-matrix-inversion.alg b/Task/Gauss-Jordan-matrix-inversion/ALGOL-68/gauss-jordan-matrix-inversion.alg index 2b79d01805..14b3603189 100644 --- a/Task/Gauss-Jordan-matrix-inversion/ALGOL-68/gauss-jordan-matrix-inversion.alg +++ b/Task/Gauss-Jordan-matrix-inversion/ALGOL-68/gauss-jordan-matrix-inversion.alg @@ -43,16 +43,17 @@ BEGIN # Gauss-Jordan matrix inversion # OD END # show #; - INT n = 4; - [ 1 : n, 1 : n ]REAL a, b, c; - a := [,]REAL( ( 2, 1, 1, 4 ) - , ( 0, -1, 0, -1 ) - , ( 1, 0, -2, 4 ) - , ( 4, 1, 2, 2 ) - ); - show( "a", a ); - b := inverse( a ); - show( "b", b ); - c := inverse( b ); - show( "c", c ) + BEGIN # test # + [ 1 : 4, 1 : 4 ]REAL a, b, c; + a := [,]REAL( ( 2, 1, 1, 4 ) + , ( 0, -1, 0, -1 ) + , ( 1, 0, -2, 4 ) + , ( 4, 1, 2, 2 ) + ); + show( "a", a ); + b := inverse( a ); + show( "b", b ); + c := inverse( b ); + show( "c", c ) + END END diff --git a/Task/Gaussian-elimination/XPL0/gaussian-elimination.xpl0 b/Task/Gaussian-elimination/XPL0/gaussian-elimination.xpl0 new file mode 100644 index 0000000000..d3f43119aa --- /dev/null +++ b/Task/Gaussian-elimination/XPL0/gaussian-elimination.xpl0 @@ -0,0 +1,43 @@ +proc Gauss(A, B, X, N); \Gaussian elimination returns [X] for [A]*[X] = [B] +real A, B, X; int N; \matrix, vector, output vector, number of rows +int Diag, MaxRow, Row, Col, I; +real Max, Temp; +[for Diag:= 0 to N-1 do \partial pivoting uses largest magnitude coefficient + [MaxRow:= Diag; \ to improve numerical stability + Max:= A(Diag, Diag); + for Row:= Diag+1 to N-1 do + [Temp:= abs(A(Row, Diag)); + if Temp > Max then + [MaxRow:= Row; Max:= Temp]; + ]; + Temp:= A(Diag); A(Diag):= A(MaxRow); A(MaxRow):= Temp; \swap rows + Temp:= B(Diag); B(Diag):= B(MaxRow); B(MaxRow):= Temp; + for Row:= Diag+1 to N-1 do + [Temp:= A(Row, Diag) / A(Diag, Diag); \divide by pivot element + for Col:= Diag+1 to N-1 do + A(Row, Col):= A(Row, Col) - Temp*A(Diag, Col); + A(Row, Diag):= 0.; + B(Row):= B(Row) - Temp*B(Diag); + ]; + ]; \reduced row echelon form +for Row:= N-1 downto 0 do \back substitution makes [X] + [Temp:= B(Row); + for I:= N-1 downto Row+1 do + Temp:= Temp - X(I)*A(Row, I); + X(Row):= Temp / A(Row, Row); + ]; +]; + +real A, B, X(6); +int I; +[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] ]; +B:= [-0.01, 0.61, 0.91, 0.99, 0.60, 0.02]; +Gauss(A, B, X, 6); +for I:= 0 to 6-1 do + [RlOut(0, X(I)); CrLf(0)]; +] diff --git a/Task/General-FizzBuzz/ALGOL-68/general-fizzbuzz.alg b/Task/General-FizzBuzz/ALGOL-68/general-fizzbuzz.alg index 301d6ba2ca..046fa5220b 100644 --- a/Task/General-FizzBuzz/ALGOL-68/general-fizzbuzz.alg +++ b/Task/General-FizzBuzz/ALGOL-68/general-fizzbuzz.alg @@ -1,25 +1,25 @@ BEGIN # generalised FizzBuzz # # prompts for an integer, reads it and returns it # - PROC read integer = ( STRING prompt )INT: + PROC read an integer = ( STRING prompt )INT: BEGIN print( ( prompt ) ); INT result; read( ( result, newline ) ); result - END; # read integer # + END; # read an integer # # prompts for a string, reads it and returns it # - PROC read string = ( STRING prompt )STRING: + PROC read a string = ( STRING prompt )STRING: BEGIN print( ( prompt ) ); STRING result; read( ( result, newline ) ); result - END; # read string # + END; # read a string # # mode to hold a factor and associated text # MODE FBFACTOR = STRUCT( INT factor, STRING text ); #===============================================================# - # quicksort routine for the factors, from the Algol 68 uicksort # - # task sample # + # quicksort routine for the factors # + # - from the Algol 68 task sample # #---------------------------------------------------------------# #--- Swap function ---# PROC swap = (REF[]FBFACTOR array, INT first, INT second) VOID: @@ -51,14 +51,14 @@ BEGIN # generalised FizzBuzz # OP > = ( FBFACTOR a, b )BOOL: factor OF a > factor OF b; #===============================================================# # get the maximum number to consider # - INT max number = read integer( "Numbers reuired: " ); - # number of factors reuired # + INT max number = read an integer( "Numbers required: " ); + # number of factors required # INT max factor = 3; # get the factors and associated words # [ max factor ]FBFACTOR factors; FOR i TO max factor DO - factor OF factors[ i ] := read integer( "Factor " + whole( i, 0 ) + ": " ); - text OF factors [ i ] := read string( "Text for " + whole( factor OF factors[ i ], 0 ) + ": " ) + factor OF factors[ i ] := read an integer( "Factor " + whole( i, 0 ) + ": " ); + text OF factors [ i ] := read a string( "Text for " + whole( factor OF factors[ i ], 0 ) + ": " ) OD; # sort the factors into order # quick( factors, 1, UPB factors ); diff --git a/Task/Generic-swap/Jq/generic-swap-1.jq b/Task/Generic-swap/Jq/generic-swap-1.jq index caf53e505b..102f51f565 100644 --- a/Task/Generic-swap/Jq/generic-swap-1.jq +++ b/Task/Generic-swap/Jq/generic-swap-1.jq @@ -1 +1 @@ -jq -n '1 as $a | 2 as $b | $a as $tmp | $b as $a | $tmp as $b | [$a,$b]' +{a: 1, b: 2} | {a: .b, b: a.} diff --git a/Task/Generic-swap/Jq/generic-swap-4.jq b/Task/Generic-swap/Jq/generic-swap-4.jq new file mode 100644 index 0000000000..caf53e505b --- /dev/null +++ b/Task/Generic-swap/Jq/generic-swap-4.jq @@ -0,0 +1 @@ +jq -n '1 as $a | 2 as $b | $a as $tmp | $b as $a | $tmp as $b | [$a,$b]' diff --git a/Task/Generic-swap/M2000-Interpreter/generic-swap-3.m2000 b/Task/Generic-swap/M2000-Interpreter/generic-swap-3.m2000 new file mode 100644 index 0000000000..0c066ce00a --- /dev/null +++ b/Task/Generic-swap/M2000-Interpreter/generic-swap-3.m2000 @@ -0,0 +1,19 @@ +dim a(10) as byte +a(3)=2 +a(4)=100 +Print a() +swap a(3), a(4) +Print a() +try ok { + a(0)=-1 +} +if not ok then print error$ =" Overflow Byte" +try ok { + a(0)=256 +} +if not ok then print error$ =" Overflow Byte" +a()=a()#rev() +Print a() +Print type$(a(3)) +Print a(10-3-1)=100 +Print a(10-4-1)=2 diff --git a/Task/Goldbachs-comet/REXX/goldbachs-comet.rexx b/Task/Goldbachs-comet/REXX/goldbachs-comet.rexx new file mode 100644 index 0000000000..db599de5d4 --- /dev/null +++ b/Task/Goldbachs-comet/REXX/goldbachs-comet.rexx @@ -0,0 +1,57 @@ +include Settings + +say version; say 'Goldbach''s comet'; say +numeric digits 7 +call GetPrimes +call ShowFirst100 +call ShowMillion +exit + +GetPrimes: +procedure expose prim. +call Time('r') +say 'Collect Primes up to 1000000...' +call Primes(1e6) +say Time('e')/1 'seconds' +say +return + +ShowFirst100: +procedure expose prim. +call Time('r') +say 'First 100 values...' +do i = 4 by 2 to 202 + call Charout ,Right(Goldbach(i),3) + if i//20 = 2 then + say +end +say Time('e')/1 'seconds' +say +return + +ShowMillion: +procedure expose prim. +call Time('r') +say 'G(1000000)...' +say Goldbach(1e6) +say Time('e')/1 'seconds' +say +return + +Goldbach: +procedure expose prim. +arg x +y = 0 +do i = 2 to x%2 + if prim.flag.i then do + j = x-i + if prim.flag.j then do + y = y+1 + end + end +end +return y/1 + +include Abend +include Functions +include Sequences diff --git a/Task/Greedy-algorithm-for-Egyptian-fractions/ALGOL-68/greedy-algorithm-for-egyptian-fractions.alg b/Task/Greedy-algorithm-for-Egyptian-fractions/ALGOL-68/greedy-algorithm-for-egyptian-fractions.alg index 653de829fb..0d7c9e866c 100644 --- a/Task/Greedy-algorithm-for-Egyptian-fractions/ALGOL-68/greedy-algorithm-for-egyptian-fractions.alg +++ b/Task/Greedy-algorithm-for-Egyptian-fractions/ALGOL-68/greedy-algorithm-for-egyptian-fractions.alg @@ -1,4 +1,4 @@ -BEGIN # compute some Egytian fractions # +BEGIN # compute some Egyptian fractions # PR precision 2000 PR # set the number of digits for LONG LONG INT # PROC gcd = ( LONG LONG INT a, b )LONG LONG INT: IF b = 0 THEN @@ -14,7 +14,7 @@ BEGIN # compute some Egytian fractions # MODE LISTOFRATIONAL = STRUCT( RATIONAL element, REF LISTOFRATIONAL next ); REF LISTOFRATIONAL nil list of rational = NIL; OP TOSTRING = ( INT a )STRING: whole( a, 0 ); - OP TOSTRING = ( LONG INT a )STRING: whole( a, 0 ); +CO OP TOSTRING = ( LONG INT a )STRING: whole( a, 0 ); # not needed for the task # CO OP TOSTRING = ( LONG LONG INT a )STRING: whole( a, 0 ); OP TOSTRING = ( RATIONAL a )STRING: IF den OF a = 1 @@ -49,12 +49,12 @@ BEGIN # compute some Egytian fractions # ELSE REF LISTOFRATIONAL result := nil list of rational; REF LISTOFRATIONAL end result := nil list of rational; - PROC add = ( RATIONAL r )VOID: + PROC add = ( RATIONAL rn )VOID: IF end result IS nil list of rational THEN - result := HEAP LISTOFRATIONAL := ( r, nil list of rational ); + result := HEAP LISTOFRATIONAL := ( rn, nil list of rational ); end result := result ELSE - next OF end result := HEAP LISTOFRATIONAL := ( r, nil list of rational ); + next OF end result := HEAP LISTOFRATIONAL := ( rn, nil list of rational ); end result := next OF end result FI ; # add # IF num OF r > den OF r THEN diff --git a/Task/Hailstone-sequence/Scheme/hailstone-sequence.scm b/Task/Hailstone-sequence/Scheme/hailstone-sequence.scm index b0311a38ee..5219a0c4e9 100644 --- a/Task/Hailstone-sequence/Scheme/hailstone-sequence.scm +++ b/Task/Hailstone-sequence/Scheme/hailstone-sequence.scm @@ -1,16 +1,24 @@ (define (collatz n) -(if (= n 1) '(1) -(cons n (collatz (if (even? n) (/ n 2) (+ 1 (* 3 n))))))) + (if (= n 1) + (list 1) + (cons n + (collatz (if (even? n) (/ n 2) (+ 1 (* 3 n))))))) (define (collatz-length n) -(let aux ((n n) (r 1)) (if (= n 1) r -(aux (if (even? n) (/ n 2) (+ 1 (* 3 n))) (+ r 1))))) + (let aux ((n n) (r 1)) + (if (= n 1) + r + (aux (if (even? n) (/ n 2) (+ 1 (* 3 n))) + (+ r 1))))) (define (collatz-max a b) -(let aux ((i a) (j 0) (k 0)) -(if (> i b) (list j k) -(let ((h (collatz-length i))) -(if (> h k) (aux (+ i 1) i h) (aux (+ i 1) j k)))))) + (let aux ((i a) (j 0) (k 0)) + (if (> i b) + (list j k) + (let ((h (collatz-length i))) + (if (> h k) + (aux (+ i 1) i h) + (aux (+ i 1) j k)))))) (collatz 27) ; (27 82 41 124 62 31 94 47 142 71 214 107 322 161 484 242 121 364 182 diff --git a/Task/Hamming-numbers/REXX/hamming-numbers-4.rexx b/Task/Hamming-numbers/REXX/hamming-numbers-4.rexx new file mode 100644 index 0000000000..3d590eb3a0 --- /dev/null +++ b/Task/Hamming-numbers/REXX/hamming-numbers-4.rexx @@ -0,0 +1,73 @@ +include Settings + +say version; say 'Hamming numbers'; say +call Hammings 1e6 +call ShowFirstN 20 +call ShowNth 1691 +call ShowNth 1e6 +call Hammings 1e7 +call ShowNth 1e7 +exit + +Hammings: +procedure expose hamm. +arg xx +call Time('r') +xx = xx/1 +say 'Collect Hamming numbers up to the' xx'th' +/* Ensure enough digits */ +numeric digits 2**(Length(xx)+1) +/* Dijkstra */ +hamm.hamming.1 = 1 +x2 = 2; x3 = 3; x5 = 5; i2 = 1; i3 = 1; i5 = 1 +do yy = 2 + h = x2 + if x3 < h then + h = x3 + if x5 < h then + h = x5 + hamm.hamming.yy = h + if yy = xx then + leave + if x2 = h then do + i2 = i2+1; x2 = hamm.hamming.i2+hamm.hamming.i2 + end + if x3 = h then do + i3 = i3+1; x3 = hamm.hamming.i3+hamm.hamming.i3+hamm.hamming.i3 + end + if x5 = h then do + i5 = i5+1; x5 = hamm.hamming.i5*5 + end +end +hamm.0 = yy +say Time('e')/1 'seconds' +say +return + +ShowFirstN: +procedure expose hamm. +arg xx +call Time('r') +xx = xx/1 +say 'First' xx 'Hamming numbers are' +do i = 1 to xx + call Charout ,Right(hamm.hamming.i,5) + if i//10 = 0 then + say +end +say Time('e')/1 'seconds' +say +return + +ShowNth: +procedure expose hamm. +arg xx +xx = xx/1 +call Time('r') +say xx'th Hamming Number is' +say hamm.hamming.xx '('Length(hamm.hamming.xx) 'digits)' +say Time('e')/1 'seconds' +say +return + +include Abend diff --git a/Task/Harmonic-series/ALGOL-68/harmonic-series.alg b/Task/Harmonic-series/ALGOL-68/harmonic-series.alg index 1746c38513..a050da661d 100644 --- a/Task/Harmonic-series/ALGOL-68/harmonic-series.alg +++ b/Task/Harmonic-series/ALGOL-68/harmonic-series.alg @@ -2,12 +2,12 @@ BEGIN # find some harmonic numbers, Hn is the sum of the reciprocals of 1..n # # returns the first n Harmonic numbers # OP HARMONIC = ( INT n )[]REAL: BEGIN - [ 1 : n ]REAL h; - h[ 1 ] := 1; + [ 1 : n ]REAL hs; + hs[ 1 ] := 1; FOR i FROM 2 TO n DO - h[ i ] := h[ i - 1 ] + ( 1 / i ) + hs[ i ] := hs[ i - 1 ] + ( 1 / i ) OD; - h + hs END # HARMONIC # ; # find the first 20 000 harmonic numbers # []REAL h = HARMONIC 20 000; diff --git a/Task/Harmonic-series/CBASIC/harmonic-series.basic b/Task/Harmonic-series/CBASIC/harmonic-series.basic index a98d0afede..35bb0c4f57 100644 --- a/Task/Harmonic-series/CBASIC/harmonic-series.basic +++ b/Task/Harmonic-series/CBASIC/harmonic-series.basic @@ -1,7 +1,7 @@ limit = 20 h = 0 print "First";limit;"numbers in the harmonic series" -for i = 1 to 20 +for i = 1 to limit h = h + 1 / i print using "## #.#####"; i; h next i diff --git a/Task/Hello-world-Text/C/hello-world-text-1.c b/Task/Hello-world-Text/C/hello-world-text-1.c index 25b7d304c2..172c037a05 100644 --- a/Task/Hello-world-Text/C/hello-world-text-1.c +++ b/Task/Hello-world-Text/C/hello-world-text-1.c @@ -1,8 +1,7 @@ -#include -#include +#include -int main(void) +int main() { - printf("Hello world!\n"); - return EXIT_SUCCESS; + printf("\nHello world!"); + return 0; } diff --git a/Task/Hello-world-Text/C/hello-world-text-2.c b/Task/Hello-world-Text/C/hello-world-text-2.c index ccbb562e43..1ad413c047 100644 --- a/Task/Hello-world-Text/C/hello-world-text-2.c +++ b/Task/Hello-world-Text/C/hello-world-text-2.c @@ -1,8 +1,6 @@ -#include -#include +#include -int main(void) +int main() { - puts("Hello world!"); - return EXIT_SUCCESS; + return printf("\nHello World!"); } diff --git a/Task/Hello-world-Text/C/hello-world-text-3.c b/Task/Hello-world-Text/C/hello-world-text-3.c index 172c037a05..25b7d304c2 100644 --- a/Task/Hello-world-Text/C/hello-world-text-3.c +++ b/Task/Hello-world-Text/C/hello-world-text-3.c @@ -1,7 +1,8 @@ -#include +#include +#include -int main() +int main(void) { - printf("\nHello world!"); - return 0; + printf("Hello world!\n"); + return EXIT_SUCCESS; } diff --git a/Task/Hello-world-Text/C/hello-world-text-4.c b/Task/Hello-world-Text/C/hello-world-text-4.c index 1ad413c047..ccbb562e43 100644 --- a/Task/Hello-world-Text/C/hello-world-text-4.c +++ b/Task/Hello-world-Text/C/hello-world-text-4.c @@ -1,6 +1,8 @@ -#include +#include +#include -int main() +int main(void) { - return printf("\nHello World!"); + puts("Hello world!"); + return EXIT_SUCCESS; } diff --git a/Task/Hello-world-Web-server/FreeBASIC/hello-world-web-server.basic b/Task/Hello-world-Web-server/FreeBASIC/hello-world-web-server.basic new file mode 100644 index 0000000000..cde1d9cf39 --- /dev/null +++ b/Task/Hello-world-Web-server/FreeBASIC/hello-world-web-server.basic @@ -0,0 +1,76 @@ +#include once "windows.bi" +#include once "win/winsock2.bi" + +Type SOCKET As Ulongint + +' Define the response text +Const RESPONSE_TEXT = "Goodbye, World!" +Const CRLF = Chr(13) & Chr(10) + +' Initialize Winsock +Dim As WSADATA wsaData +If WSAStartup(&h0202, @wsaData) Then + Print "Error initializing Winsock" + End 1 +End If + +' Create a socket +Dim As SOCKET serverSocket = WSASocket(AF_INET, SOCK_STREAM, IPPROTO_TCP, NULL, 0, 0) +If serverSocket = INVALID_SOCKET Then + Print "Error creating socket" + WSACleanup() + End 1 +End If + +' Bind the socket to the port +Dim As sockaddr_in serverAddr +With serverAddr + .sin_family = AF_INET + .sin_addr.s_addr = INADDR_ANY + .sin_port = htons(8080) +End With + +' Bind the socket to the port +If bind(serverSocket, Cast(sockaddr Ptr, @serverAddr), Sizeof(sockaddr_in)) = SOCKET_ERROR Then + Print "Error binding socket" + closesocket(serverSocket) + WSACleanup() + End 1 +End If + +' Listen for incoming connections +If listen(serverSocket, SOMAXCONN) = SOCKET_ERROR Then + Print "Error listening on socket" + closesocket(serverSocket) + WSACleanup() + End 1 +End If + +Print "Server is running on http://localhost:8080/" + +' Main server loop +Do + Dim As sockaddr_in clientAddr + Dim As Long clientAddrLen = Sizeof(sockaddr_in) + + Dim As SOCKET clientSocket = accept(serverSocket, Cast(sockaddr Ptr, @clientAddr), @clientAddrLen) + If clientSocket = INVALID_SOCKET Then + Print "Error accepting connection" + Continue Do + End If + + ' Build and send the HTTP response + Dim As String httpResponse = _ + "HTTP/1.1 200 OK" & CRLF & _ + "Content-Length: " & Len(RESPONSE_TEXT) & CRLF & _ + "Content-Type: text/plain" & CRLF & _ + CRLF & _ + RESPONSE_TEXT + + send(clientSocket, Strptr(httpResponse), Len(httpResponse), 0) + closesocket(clientSocket) +Loop + +' Final cleaning +closesocket(serverSocket) +WSACleanup() diff --git a/Task/History-variables/FreeBASIC/history-variables.basic b/Task/History-variables/FreeBASIC/history-variables.basic new file mode 100644 index 0000000000..2c61e3f4d2 --- /dev/null +++ b/Task/History-variables/FreeBASIC/history-variables.basic @@ -0,0 +1,60 @@ +REM integer history variable + +Type HistoryInt + As Integer Ptr values + As Integer cnt + As Integer capacity +End Type + +Function InitHistory() As HistoryInt Ptr + Dim As HistoryInt Ptr hist = Allocate(Sizeof(HistoryInt)) + hist->capacity = 10 + hist->values = Allocate(hist->capacity * Sizeof(Integer)) + hist->cnt = 0 + Return hist +End Function + +Sub SetInt(hist As HistoryInt Ptr, value As Integer) + If hist->cnt >= hist->capacity Then + hist->capacity *= 2 + hist->values = Reallocate(hist->values, hist->capacity * Sizeof(Integer)) + End If + + If hist->cnt = 0 Then + hist->values[hist->cnt] = 0 + hist->cnt += 1 + End If + + hist->values[hist->cnt] = value + hist->cnt += 1 +End Sub + +Sub ShowHistory(hist As HistoryInt Ptr) + For i As Integer = 0 To hist->cnt - 1 + Print hist->values[i] + Next +End Sub + +Function UndoInt(hist As HistoryInt Ptr) As Integer + If hist->cnt <= 1 Then Return hist->values[0] + hist->cnt -= 1 + Return hist->values[hist->cnt - 1] +End Function + +' Main program +Randomize Timer +Dim As HistoryInt Ptr x = InitHistory() + +For i As Integer = 0 To 3 + SetInt(x, Int(Rnd * 50) + 100) +Next + +Print "x history:" +ShowHistory(x) +Print + +For i As Integer = 0 To 3 + Print "undo, x ="; UndoInt(x) +Next + +Sleep diff --git a/Task/History-variables/Phix/history-variables-1.phix b/Task/History-variables/Phix/history-variables-1.phix index 0d84745f09..8270fe1bbe 100644 --- a/Task/History-variables/Phix/history-variables-1.phix +++ b/Task/History-variables/Phix/history-variables-1.phix @@ -1,15 +1,13 @@ ---> - without js -- (desktop/Phix only) - sequence history = {} +without js -- (desktop/Phix only) +sequence history = {} - type hvt(object o) - history = append(history,o) - return true - end type +type hv(object o) + history = append(history,o) + return true +end type - hvt test = 1 - test = 2 - test = 3 - ?{"current",test} - ?{"history",history} - - -- history.e - sequence histories = {} +-- history.e +sequence histories = {} - global function new_history_id(object v) - histories = append(histories,{v}) - return length(histories) - end function +global function new_history_id(object v) + histories = append(histories,{v}) + return length(histories) +end function - global procedure set_hv(integer hv, object v) - histories[hv] = append(histories[hv],v) - end procedure +global procedure set_hv(integer hv, object v) + histories[hv] = append(histories[hv],v) +end procedure - global function get_hv(integer hv) - return histories[hv][$] - end function +global function get_hv(integer hv) + return histories[hv][$] +end function - global function get_hv_full_history(integer hv) - return histories[hv] - end function - - include history.e +with javascript_semantics +include history.e - constant test2 = new_history_id(1) - set_hv(test2, 2) - set_hv(test2, 3) - ?{"current",get_hv(test2)} - ?{"history",get_hv_full_history(test2)} - - function skipping(sequence prisoners, integer step, survivors=1) - integer n = length(prisoners), nn = n, p = 0 - while n>survivors do - integer found = 0 - while found<step do - p = iff(p=nn?1:p+1) - found += prisoners[p]!=-1 - end while - prisoners[p] = -1 - n -= 1 - end while - return remove_all(-1,prisoners) - end function - --?skipping({"Joe","Jack","William","John","James"},2,1) --> {"William"} - - function linked_list(sequence prisoners, integer step, survivors) - integer n = length(prisoners) - sequence links = tagset(n,2)&1 - integer p = n, prvp - while n>survivors do - for i=1 to step do - prvp = p - p = links[p] - end for - prisoners[p] = -1 - links[prvp] = links[p] - n -= 1 - end while - return remove_all(-1,prisoners) - end function - - function sliding_queue(sequence prisoners, integer step, survivors) - integer n = length(prisoners) - while n>survivors do - integer k = remainder(step-1,n)+1 -- (mostly k==step) - prisoners = prisoners[k+1..$]&prisoners[1..k-1] -- rotate, dropping one. - n -= 1 - end while - return prisoners - end function - - function contractacycle(integer n, integer k, s) - sequence living = tagset(n) - integer startPosition = k, i, lasti - while n!=s do -- Keep going round the circle until only s prisoners remain. - integer circleSize = n - if (n < k) then - i = mod(startPosition-1,circleSize) + 1 - living = living[1..i-1]&living[i+1..$] - n -= 1 - lasti = i - else - for i=startPosition to circleSize by k do - living[i] = -1 - n -= 1 - if (n = s) then exit end if -- Not Groovy, see note - lasti = i - end for - living = remove_all(-1,living) - end if - startPosition = lasti + k - circleSize - end while - return living - end function - - function contractalot(integer n, integer k, s) - sequence list = tagset(n) - integer i = 1 - while n>s do - i += k - 1 - if (i > n) then i := mod(i-1, n)+1 end if - list [i..i] = {} - n -= 1 - end while - return list - end function - - function recursive(integer n, k) - return iff(n=1?1:1+mod(k-1+(recursive(n-1, k)),n)) - end function - - function iterative(integer n, k, m=0) - -- Return m-th on the reversed kill list; m=0 is final survivor. - for a = m+1 to n do - m = mod(m+k, a) - end for - return m + 1 -- (make result 1-based) - end function - - function iterative2(integer n,k,s) - integer a = k*(n-s) + 1, - olda = a - atom q = k/(k-1), - nk = n*k - while a <= nk do - olda = a - a = ceil(a*q) - end while - return nk - olda + 1 -- (make result 1-based) - end function - - --demo/rosetta/Josephus.exw - constant show_all = true, - show_slow = false, - show_skipping = false, - show_linkedlist = false, - show_sliding_queue = false, - show_contractacycle = false, - show_contractalot = false, - show_recursive = false, - show_iterative = false, - show_iterative2 = true - - constant TAGSET = #01, - ITER = #02, - ITER2 = #04, - SLOW = #08, - ONES = #10 - - constant tests = {{41,3,1,false}, - {41,3,3,false}, - {5,2,1,false}, - {5,4,1,false}, - {50,2,1,false}, - {60,3,1,false}, - {23482,3343,3,true}, - {23482,3343,1,true}, - {41,3,6,false}} - - procedure test(string name, integer flags) - atom t0 = time() - integer rid = routine_id(name) - for i=1 to length(tests) do - integer {prisoners, step, survivors, slow} = tests[i] - if (not and_bits(flags,ONES) or survivors=1) - and (not slow or show_slow or not and_bits(flags,SLOW)) then - sequence res - if and_bits(flags,ONES) then - -- (recursive does not take a 3rd param) - res = {rid(prisoners,step)} - elsif and_bits(flags,TAGSET) then - res = rid(tagset(prisoners),step,survivors) - elsif and_bits(flags,ITER) then - res = {} - for s=0 to survivors-1 do - res &= rid(prisoners,step,s) - end for - elsif and_bits(flags,ITER2) then - res = {} - for s=prisoners-survivors+1 to prisoners do - res &= rid(prisoners,step,s) - end for - else - res = rid(prisoners,step,survivors) - end if - printf(1,"%s(%d,%d,%d) = %v\n",{name,prisoners,step,survivors,res}) - end if - end for - ?elapsed(time()-t0) - end procedure - if show_all or show_skipping then test("skipping",TAGSET+SLOW) end if - if show_all or show_linkedlist then test("linked_list",TAGSET+SLOW) end if - if show_all or show_sliding_queue then test("sliding_queue",TAGSET+SLOW) end if - if show_all or show_contractacycle then test("contractacycle",SLOW) end if - if show_all or show_contractalot then test("contractalot",NULL) end if - if show_all or show_recursive then test("recursive",ONES) end if - if show_all or show_iterative then test("iterative",ITER) end if - if show_all or show_iterative2 then test("iterative2",ITER2) end if - {"William"} + +-- linked list - used by Arch64 Assembly, Ada, ARM Assembly, Common Lisp[2, probably], Fortran, +-- JavaScript[1] (albeit dbl-lnk), Python[3]. +-- Method: like skipping, all prisoners stay where they are, but +-- the executioner uses the links to speed things up a bit. +function linked_list(sequence prisoners, integer step, survivors) + integer n = length(prisoners) + sequence links = tagset(n,2)&1 + integer p = n, prvp + while n>survivors do + for i=1 to step do + prvp = p + p = links[p] + end for + prisoners[p] = -1 + links[prvp] = links[p] + n -= 1 + end while + return remove_all(-1,prisoners) +end function + +-- sliding queue - used by Clojure, Crystal, D (both), Eiffel, Elixir, Erlang, friendly interactive shell, Go, jq, +-- Perl, PowerShell, PureBasic (albeit one at a time), Quackery, Raku, REBOL, Ruby, Scala, +-- Sidef[1], Tcl, Vlang. +-- Method: all skipped prisoners rejoin the end of the queue which sidles left, +-- executioner stays put until the queue gets too short. +function sliding_queue(sequence prisoners, integer step, survivors) + integer n = length(prisoners) + while n>survivors do + integer k = remainder(step-1,n)+1 -- (mostly k==step) + prisoners = prisoners[k+1..$]&prisoners[1..k-1] -- rotate, dropping one. + n -= 1 + end while + return prisoners +end function + +-- contractacycle - used by AppleScript[2], Groovy +-- Method: executioner walks along killing every k'th prisoner; while he walks back the queue contracts to remove gaps. +-- (once the queue gets too small it obviously reverts to one at a time, a bit more like contractalot below) +function contractacycle(integer n, integer k, s) + sequence living = tagset(n) + integer startPosition = k, i, lasti + while n!=s do -- Keep going round the circle until only s prisoners remain. + integer circleSize = n + if (n < k) then + i = mod(startPosition-1,circleSize) + 1 + living = living[1..i-1]&living[i+1..$] + n -= 1 + lasti = i + else + for i=startPosition to circleSize by k do + living[i] = -1 + n -= 1 + if (n = s) then exit end if -- Not Groovy, see note + lasti = i + end for + living = remove_all(-1,living) + end if + startPosition = lasti + k - circleSize + end while + return living +end function +-- Groovy does not have a n=s test, it probably is entirely unnecessary. The Groovy code is also somewhat neater, +-- always using a loop and remove_all() - while not probihitively expensive, it may check lots of things for -1 +-- that the slicing won't. + +-- contractalot - used by 11L, Arturo, AutoHotkey, C#, C++, Delphi, Frink, Formulae, Java (both), JavaScript[2], +-- Julia[2], Kotlin, Lua, NanoQuery, Nim, Objeck, Oforth, Processing, Python[1], R[2], +-- Rust, Seed7, Swift, VBScript, Vedit, VisualBasic.NET, XPL0, zkl. +-- Method: executioner walks round and round, queue contracts after every kill. +-- Often implemented as execute all prisoners then release last one killed. +function contractalot(integer n, integer k, s) + sequence list = tagset(n) + integer i = 1 + while n>s do + i += k - 1 + if (i > n) then i := mod(i-1, n)+1 end if + list [i..i] = {} + n -= 1 + end while + return list +end function + +-- recursive - used by Emacs Lisp, Icon, Julia[1], PARI/GP, PicoLisp (less the optms.n), Sidef[2] +-- Method: recursive mod maths madness - only handles the lone survivor case. +function recursive(integer n, k) + return iff(n=1?1:1+mod(k-1+(recursive(n-1, k)),n)) +end function + +-- iterative - used by ALGOL 68, ANSI Standard BASIC, AppleScript[1,3(!!)], BASIC(*11), Batch File, C (but not ULL), +-- Common Lisp[1], Craft Basic, Easylang, EDSAC (allegedly), Factor, Forth, FreeBASIC, FTCBASIC, +-- FutureBasic, Modula-2, Python[2], R, Racket, Ring, SequenceL, ZX Spectrum Basic +-- Method: iterative mod maths madness - but hey, it will be extremely fast. +-- Unlike recursive, it can also deliver >1 survivor, one at a time. +function iterative(integer n, k, m=0) + -- Return m-th on the reversed kill list; m=0 is final survivor. + for a = m+1 to n do + m = mod(m+k, a) + end for + return m + 1 -- (make result 1-based) +end function + +-- iterative2 - used by Icon[2] +-- Method: more iterative maths madness +function iterative2(integer n,k,s) + integer a = k*(n-s) + 1, + olda = a + atom q = k/(k-1), + nk = n*k + while a <= nk do + olda = a + a = ceil(a*q) + end while + return nk - olda + 1 -- (make result 1-based) +end function + +-- test driver +--demo/rosetta/Josephus.exw +constant show_all = true, + show_slow = false, + show_skipping = false, + show_linkedlist = false, + show_sliding_queue = false, + show_contractacycle = false, + show_contractalot = false, + show_recursive = false, + show_iterative = false, + show_iterative2 = true + +constant TAGSET = #01, + ITER = #02, + ITER2 = #04, + SLOW = #08, + ONES = #10 + +constant tests = {{41,3,1,false}, + {41,3,3,false}, + {5,2,1,false}, + {5,4,1,false}, + {50,2,1,false}, + {60,3,1,false}, + {23482,3343,3,true}, + {23482,3343,1,true}, + {41,3,6,false}} + +procedure test(string name, integer flags) + atom t0 = time() + integer rid = routine_id(name) + for i=1 to length(tests) do + integer {prisoners, step, survivors, slow} = tests[i] + if (not and_bits(flags,ONES) or survivors=1) + and (not slow or show_slow or not and_bits(flags,SLOW)) then + sequence res + if and_bits(flags,ONES) then + -- (recursive does not take a 3rd param) + res = {rid(prisoners,step)} + elsif and_bits(flags,TAGSET) then + res = rid(tagset(prisoners),step,survivors) + elsif and_bits(flags,ITER) then + res = {} + for s=0 to survivors-1 do + res &= rid(prisoners,step,s) + end for + elsif and_bits(flags,ITER2) then + res = {} + for s=prisoners-survivors+1 to prisoners do + res &= rid(prisoners,step,s) + end for + else + res = rid(prisoners,step,survivors) + end if + printf(1,"%s(%d,%d,%d) = %v\n",{name,prisoners,step,survivors,res}) + end if + end for + ?elapsed(time()-t0) +end procedure +if show_all or show_skipping then test("skipping",TAGSET+SLOW) end if +if show_all or show_linkedlist then test("linked_list",TAGSET+SLOW) end if +if show_all or show_sliding_queue then test("sliding_queue",TAGSET+SLOW) end if +if show_all or show_contractacycle then test("contractacycle",SLOW) end if +if show_all or show_contractalot then test("contractalot",NULL) end if +if show_all or show_recursive then test("recursive",ONES) end if +if show_all or show_iterative then test("iterative",ITER) end if +if show_all or show_iterative2 then test("iterative2",ITER2) end if diff --git a/Task/K-d-tree/FreeBASIC/k-d-tree.basic b/Task/K-d-tree/FreeBASIC/k-d-tree.basic new file mode 100644 index 0000000000..ed87b0222b --- /dev/null +++ b/Task/K-d-tree/FreeBASIC/k-d-tree.basic @@ -0,0 +1,194 @@ +Const NULL As Any Ptr = 0 + +Type Point + coords(2) As Single '3D points +End Type + +Type KdNode + punto As Point + izda As KdNode Ptr + dcha As KdNode Ptr +End Type + +Type KdTree + root As KdNode Ptr + bestNode As KdNode Ptr + bestDist As Single + visited As Integer + dimensions As Integer +End Type + +Function Point_Distance(This As Point, pt As Point) As Single + Dim dist As Single = 0 + For i As Integer = 0 To 2 + Dim d As Single = this.coords(i) - pt.coords(i) + dist += d * d + Next + Return dist +End Function + +Function CreateNode(p As Point) As KdNode Ptr + Dim node As KdNode Ptr = New KdNode + node->punto = p + node->izda = NULL + node->dcha = NULL + Return node +End Function + +Function MakeTree(nodes() As KdNode Ptr, startIdx As Integer, endIdx As Integer, depth As Integer, dimensions As Integer) As KdNode Ptr + If endIdx <= startIdx Then Return NULL + + Dim As Integer midIdx = startIdx + (endIdx - startIdx) \ 2 + Dim As Integer axis = depth Mod dimensions + + For i As Integer = startIdx To endIdx - 1 + For j As Integer = i + 1 To endIdx + If nodes(i)->punto.coords(axis) > nodes(j)->punto.coords(axis) Then + Swap nodes(i), nodes(j) + End If + Next + Next + + nodes(midIdx)->izda = MakeTree(nodes(), startIdx, midIdx, depth + 1, dimensions) + nodes(midIdx)->dcha = MakeTree(nodes(), midIdx + 1, endIdx, depth + 1, dimensions) + + Return nodes(midIdx) +End Function + +Sub SearchNearest(node As KdNode Ptr, punto As Point, depth As Integer, tree As KdTree Ptr) + If node = NULL Then Exit Sub + + tree->visited += 1 + Dim As Single dist = Point_Distance(node->punto, punto) + + If tree->bestNode = NULL Orelse dist < tree->bestDist Then + tree->bestDist = dist + tree->bestNode = node + End If + + If tree->bestDist = 0 Then Exit Sub + + Dim As Integer axis = depth Mod tree->dimensions + Dim As Single dx = node->punto.coords(axis) - punto.coords(axis) + + If dx > 0 Then + SearchNearest(node->izda, punto, depth + 1, tree) + If dx * dx >= tree->bestDist Then Exit Sub + SearchNearest(node->dcha, punto, depth + 1, tree) + Else + SearchNearest(node->dcha, punto, depth + 1, tree) + If dx * dx >= tree->bestDist Then Exit Sub + SearchNearest(node->izda, punto, depth + 1, tree) + End If +End Sub + +Function BuildKdTree(points() As Point, dimensions As Integer) As KdTree Ptr + Dim As KdTree Ptr tree = New KdTree + If tree = NULL Then Return NULL + + tree->dimensions = dimensions + tree->bestDist = 0 + tree->visited = 0 + tree->root = NULL + tree->bestNode = NULL + + Dim nodes(Ubound(points)) As KdNode Ptr + For i As Integer = 0 To Ubound(points) + nodes(i) = CreateNode(points(i)) + If nodes(i) = NULL Then Return NULL + Next + + tree->root = MakeTree(nodes(), 0, Ubound(nodes), 0, dimensions) + Return tree +End Function + +Function FindNearest(tree As KdTree Ptr, punto As Point) As Point + Dim As Point result + + If tree = NULL Orelse tree->root = NULL Then Return result + + tree->bestNode = NULL + tree->visited = 0 + tree->bestDist = 0 + + SearchNearest(tree->root, punto, 0, tree) + + If tree->bestNode <> NULL Then result = tree->bestNode->punto + + Return result +End Function + +Sub TestWikipedia() + Print "Wikipedia example data:" + + Dim As Point points(5) + points(0).coords(0) = 2: points(0).coords(1) = 3 + points(1).coords(0) = 5: points(1).coords(1) = 4 + points(2).coords(0) = 9: points(2).coords(1) = 6 + points(3).coords(0) = 4: points(3).coords(1) = 7 + points(4).coords(0) = 8: points(4).coords(1) = 1 + points(5).coords(0) = 7: points(5).coords(1) = 2 + + Dim As KdTree Ptr tree = BuildKdTree(points(), 2) + If tree = NULL Then + Print "Error creating tree" + End 1 + End If + + Dim As Point searchPoint + searchPoint.coords(0) = 9 + searchPoint.coords(1) = 2 + + Dim As Point nearest = FindNearest(tree, searchPoint) + + Print "Nearest point: (" & nearest.coords(0) & ", " & nearest.coords(1) & ")" + Print "Distance: " & Sqr(tree->bestDist) + Print "Nodes visited: " & tree->visited + + Delete tree +End Sub + +Function RandomDouble(min As Single, max As Single) As Single + Return min + (max - min) * Rnd() +End Function + +Function CreateRandomPoint() As Point + Dim As Point p + p.coords(0) = RandomDouble(0, 1) + p.coords(1) = RandomDouble(0, 1) + p.coords(2) = RandomDouble(0, 1) + Return p +End Function + +Sub TestRandom(count As Integer) + Print "Random data (" & count & " points):" + + Dim As Point points(count-1) + For i As Integer = 0 To count-1 + points(i) = CreateRandomPoint() + Next + + Dim As KdTree Ptr tree = BuildKdTree(points(), 3) + + Dim As Point searchPoint = CreateRandomPoint() + Dim As Point nearest = FindNearest(tree, searchPoint) + + Print "Search point : (" & searchPoint.coords(0) & ", " & searchPoint.coords(1) & ", " & searchPoint.coords(2) & ")" + Print "Nearest point: (" & nearest.coords(0) & ", " & nearest.coords(1) & ", " & nearest.coords(2) & ")" + Print "Distance: " & Sqr(tree->bestDist) + Print "Nodes visited: " & tree->visited + + Delete tree +End Sub + +'Main program +' Original Wikipedia example +TestWikipedia() +Print +' Random tests +Randomize Timer +TestRandom(1000) +Print +TestRandom(10000) + +Sleep diff --git a/Task/K-d-tree/M2000-Interpreter/k-d-tree.m2000 b/Task/K-d-tree/M2000-Interpreter/k-d-tree.m2000 new file mode 100644 index 0000000000..7cb0d366b4 --- /dev/null +++ b/Task/K-d-tree/M2000-Interpreter/k-d-tree.m2000 @@ -0,0 +1,166 @@ +Module k_d { + push random(!381210&): drop + class point { + dim coords(0 to 2) As Single '3D points + remove { + REM ? "Deleted Point("+.coords()#str$(", ")+")" + } + class: + Module Point (a=0, b=0, c=0) { + .coords(0):=a,b,c + } + } + + class KdNode { + punto=pointer() + izda=pointer() + dcha=pointer() + class: + Module KdNode { + .punto<=pointer(point(![])) + } + } + class KdTree { + root=pointer() ' As KdNode Ptr + bestNode=pointer() ' As KdNode Ptr + Single bestDist + Integer visited, dimensions + remove { + .root<=pointer() + REM print "tree deleted" + } + class: + Module KdTree (&nodes(), dimensions As Integer) { + .dimensions<=dimensions + .root<= @MakeTree(0, len(nodes())-1, 0) + Function MakeTree(startIdx As Integer, endIdx As Integer, depth As Integer) + If endIdx <= startIdx Then =pointer(): exit function + local Integer midIdx = startIdx + (endIdx - startIdx) div 2, axis = depth Mod dimensions, i, j + Data startIdx, endIdx-1 + do If Stackitem()>=Stackitem(2) Then Drop 2:if empty then exit else continue + over 2,2 + Read p, r : i = p-1 + For nodes(r) { + x=.punto=>coords(axis) + For j=p to r-1 { + For nodes(j) {If ..punto=>coords(axis)> x Then i++: swap .punto, ..punto + }}:For nodes(i+1){swap .punto, ..punto}:Push i+2, i:shift 3 + } + Always + nodes(midIdx).izda = @MakeTree(startIdx, midIdx, depth + 1) + nodes(midIdx).dcha = @MakeTree(midIdx+1 , endIdx, depth + 1) + ->nodes(midIdx) + End Function + } + } + Function Global FindNearest(tree As *KdTree, punto As *Point) { + Function Point_Distance(Th As *Point, pt As *Point) { + Single dist, d : Integer i + For i = 0 To 2 + d= th=>coords(i) - pt=>coords(i) + dist += d * d + Next + =dist + } + result->point() + + If tree is type null then =result: exit + if tree=>root is type null Then =result: exit + + tree=>bestNode = Pointer() + tree=>visited = 0 + tree=>bestDist = 0 + + SearchNearest(tree=>root, 0, tree) + + If not tree=>bestNode is type null Then result = tree=>bestNode=>punto + + =result + + Sub SearchNearest(node as pointer, depth As Integer, tree As *KdTree) + If node is type null Then Exit Sub + tree=>visited ++ + + local Single dist = Point_Distance(node=>punto, punto) + If tree=>bestNode is type null or dist < tree=>bestDist Then + tree=>bestDist = dist + tree=>bestNode = node + End if + If tree=>bestDist = 0 Then Exit Sub + + Local Integer axis = depth Mod tree=>dimensions + Local Single dx= node=>punto=>coords(axis) - punto=>coords(axis) + If dx > 0 Then + SearchNearest(node=>izda, depth + 1, tree) + If dx * dx >= tree=>bestDist Then Exit Sub + SearchNearest(node=>dcha, depth + 1, tree) + Else + SearchNearest(node=>dcha, depth + 1, tree) + If dx * dx >= tree=>bestDist Then Exit Sub + SearchNearest(node=>izda, depth + 1, tree) + End If + End Sub + } + Module TestWikipedia { + Doc$ <= "Wikipedia example data:"+{ + } + searchPoint->Point(9, 2) + + k=stack:=2,3,5,4,9,6,4,7,8,1,7,2 + 'k=stack:=7, 2, 8, 1, 4, 7, 9, 6, 5, 4, 2, 3 + Feed=Lambda k -> { + if len(k)=0 then =point(): exit + stack k {->KdNode(number, number)} + } + + Dim points(0 to 5)<KdTree(&points(), 2) + nearest=FindNearest(tree, searchPoint) + Doc$ <= "Search point: (" + (searchPoint=>coords(0) )+ ", " + (searchPoint=>coords(1)) + ")"+{ + } + Doc$ <= "Nearest point: (" + (nearest=>coords(0) )+ ", " + (nearest=>coords(1)) + ")"+{ + } + Doc$ <= "Distance: " + (Sqrt(tree=>bestDist))+{ + } + Doc$ <= "Nodes visited: " + (tree=>visited)+{ + } + tree=pointer() + + } + Module TestRandom (count As Integer) { + doc$ <="Random data (" + count + " points):"+{ + } + integer i + searchPoint->Point(rnd, rnd, rnd) + feed =lambda ->{ + ->KdNode(rnd, rnd, rnd) + } + Dim points(count)<KdTree(&points(), 3) + nearest=FindNearest(tree, searchPoint) + Doc$ <= "Search point: (" +searchPoint=>coords()#str$(", ") + ")"+{ + } + Doc$ <= "Nearest point: (" +nearest=>coords()#str$(", ") + ")"+{ + } + Doc$ <= "Distance: " + (Sqrt(tree=>bestDist))+{ + } + Doc$ <= "Nodes visited: " + (tree=>visited)+{ + } + tree=pointer() + } + Global Doc$ + Document Doc$ + TestWikipedia + profiler + TestRandom 1000 + Print timecount + profiler + TestRandom 10000 + Print timecount + Report Doc$ + try{ + clipboard doc$ + } + Save.Doc doc$, "out.txt" +} +k_d diff --git a/Task/Kernighans-large-earthquake-problem/ALGOL-68/kernighans-large-earthquake-problem.alg b/Task/Kernighans-large-earthquake-problem/ALGOL-68/kernighans-large-earthquake-problem.alg index 27cc2b61e9..49f65a5e24 100644 --- a/Task/Kernighans-large-earthquake-problem/ALGOL-68/kernighans-large-earthquake-problem.alg +++ b/Task/Kernighans-large-earthquake-problem/ALGOL-68/kernighans-large-earthquake-problem.alg @@ -45,7 +45,7 @@ ELSE FILE real value; associate( real value, f ); on value error( real value - , ( REF FILE f )BOOL: + , ( REF FILE ef )BOOL: BEGIN # "handle" invalid data # result := 0; diff --git a/Task/Knuth-shuffle/ALGOL-68/knuth-shuffle-2.alg b/Task/Knuth-shuffle/ALGOL-68/knuth-shuffle-2.alg deleted file mode 100644 index 25bc6d8afa..0000000000 --- a/Task/Knuth-shuffle/ALGOL-68/knuth-shuffle-2.alg +++ /dev/null @@ -1,6 +0,0 @@ -main:( - [20]INT a; - FOR i FROM 1 TO 20 DO a[i] := i OD; - knuth shuffle(a); - print(a) -) diff --git a/Task/Knuth-shuffle/ALGOL-68/knuth-shuffle-1.alg b/Task/Knuth-shuffle/ALGOL-68/knuth-shuffle.alg similarity index 69% rename from Task/Knuth-shuffle/ALGOL-68/knuth-shuffle-1.alg rename to Task/Knuth-shuffle/ALGOL-68/knuth-shuffle.alg index f5202e6668..3a977799d1 100644 --- a/Task/Knuth-shuffle/ALGOL-68/knuth-shuffle-1.alg +++ b/Task/Knuth-shuffle/ALGOL-68/knuth-shuffle.alg @@ -12,3 +12,9 @@ PROC knuth shuffle = (REF[]INT a)VOID: a[j] := t OD ); +# main # ( + [20]INT a; + FOR i FROM 1 TO 20 DO a[i] := i OD; + knuth shuffle(a); + print((a, newline)) +) diff --git a/Task/LU-decomposition/ALGOL-68/lu-decomposition.alg b/Task/LU-decomposition/ALGOL-68/lu-decomposition.alg new file mode 100644 index 0000000000..0b4f280798 --- /dev/null +++ b/Task/LU-decomposition/ALGOL-68/lu-decomposition.alg @@ -0,0 +1,112 @@ +BEGIN # LU decomposition - translation of the Kotlin sample # + + OP * = ( [,]REAL this, other )[,]REAL: + IF 1 LWB this /= 2 LWB other OR 1 UPB this /= 2 UPB other + THEN print( ( "Cannot multiply matrices: " ) ); + print( ( "[", whole( 1 LWB this, 0 ), ":", whole( 1 UPB this, 0 ) ) ); + print( ( ",", whole( 2 LWB this, 0 ), ":", whole( 2 UPB this, 0 ), "]" ) ); + print( ( " X " ) ); + print( ( "[", whole( 1 LWB other, 0 ), ":", whole( 1 UPB other, 0 ) ) ); + print( ( ",", whole( 2 LWB other, 0 ), ":", whole( 2 UPB other, 0 ), "]" ) ); + print( ( newline ) ); + stop + ELSE [ 1 LWB this : 1 UPB this, 2 LWB other : 2 UPB other ]REAL result; + FOR i FROM 1 LWB this TO 1 UPB this DO + FOR j FROM 2 LWB other TO 2 UPB other DO + result[ i, j ] := 0; + FOR k FROM 1 LWB other TO 1 UPB other DO + result[ i, j ] +:= this[ i, k ] * other[ k, j ] + OD + OD + OD; + result + FI # * # ; + + OP PIVOTISE = ( [,]REAL m in )[,]REAL: + BEGIN + [,]REAL m = m in[ AT 1, AT 1 ]; + INT n = ( 1 UPB m - 1 LWB m ) + 1; + [ 1 : n, 1 : n ]REAL im; + FOR i TO n DO + FOR j TO n DO im[ i, j ] := 0 OD; + im[ i, i ] := 1 + OD; + FOR i TO n DO + REAL max := ABS m[ i, i ]; + INT row := i; + FOR j FROM i TO n DO + IF ABS m[ j, i ] > max THEN + max := ABS m[ j, i ]; + row := j + FI + OD; + IF i /= row THEN + []REAL t = im[ i, : ]; + im[ i, : ] := im[ row, : ]; + im[ row, : ] := t + FI + OD; + im + END # PIVOTISE # ; + + MODE DECOMPOSITION = STRUCT( [ 1 : 1, 1 : 1 ]REAL l, u, p ); + + OP LU = ( [,]REAL a in )DECOMPOSITION: + BEGIN + [,]REAL a = a in[ AT 1, AT 1 ]; + INT n = ( 1 UPB a in - 1 LWB a in ) + 1; + [ 1 : n, 1 : n ]REAL l, u; + [,]REAL p = PIVOTISE a; + [,]REAL a2 = p * a; + FOR i TO n DO FOR j TO n DO l[ i, j ] := u[ i, j ] := 0 OD OD; + FOR j TO n DO + l[ j, j ] := 1; + FOR i TO j DO + REAL sum := 0; + FOR k TO i DO sum +:= u[ k, j ] * l[ i, k ] OD; + u[ i, j ] := a2[ i, j ] - sum + OD; + FOR i FROM j + 1 TO n DO + REAL sum := 0; + FOR k TO j DO sum +:= u[ k, j ] * l[ i, k ] OD; + l[ i, j ] := ( a2[ i, j ] - sum ) / u[ j, j ] + OD + OD; + DECOMPOSITION( l, u, p ) + END # LU # ; + + PROC show matrix = ( STRING title, [,]REAL m, INT fw, fdp )VOID: + BEGIN + print( ( " ", title, newline ) ); + FOR i FROM 1 LWB m TO 1 UPB m DO + print( ( " " ) ); + FOR j FROM 2 LWB m TO 2 UPB m DO print( ( fixed( m[ i, j ], -fw, fdp ), " " ) ) OD; + print( ( newline ) ) + OD + END # show matrix # ; + + BEGIN # test the LU decomposition operator # + [,]REAL a1 = ( ( 1.0, 3.0, 5.0 ) + , ( 2.0, 4.0, 7.0 ) + , ( 1.0, 1.0, 0.0 ) + ); + DECOMPOSITION d1 = LU a1; + print( ( "EXAMPLE 1:-", newline ) ); + show matrix( "A:", a1, 1, 0 ); + show matrix( "L:", l OF d1, 8, 5 ); + show matrix( "U:", u OF d1, 8, 5 ); + show matrix( "P:", p OF d1, 1, 0 ); + print( ( newline ) ); + [,]REAL a2 = ( ( 11.0, 9.0, 24.0, 2.0 ) + , ( 1.0, 5.0, 2.0, 6.0 ) + , ( 3.0, 17.0, 18.0, 1.0 ) + , ( 2.0, 5.0, 7.0, 1.0 ) + ); + DECOMPOSITION d2 = LU a2; + print( ( "EXAMPLE 2:-", newline ) ); + show matrix( "A:", a2, 2, 0 ); + show matrix( "L:", l OF d2, 8, 5 ); + show matrix( "U:", u OF d2, 8, 5 ); + show matrix( "P:", p OF d2, 1, 0 ) + END +END diff --git a/Task/LU-decomposition/FreeBASIC/lu-decomposition.basic b/Task/LU-decomposition/FreeBASIC/lu-decomposition.basic new file mode 100644 index 0000000000..b36a182334 --- /dev/null +++ b/Task/LU-decomposition/FreeBASIC/lu-decomposition.basic @@ -0,0 +1,100 @@ +Sub pivotize(m() As Double, im() As Double) + Dim As Integer n, i, j + n = Ubound(m) + Redim im(n, n) + + For i = 0 To n + For j = 0 To n + im(i, j) = 0 + Next j + im(i, i) = 1 + Next i + + For i = 0 To n + Dim As Double mx + Dim As Integer fila + mx = Abs(m(i, i)) + fila = i + For j = i To n + If Abs(m(j, i)) > mx Then + mx = Abs(m(j, i)) + fila = j + End If + Next j + If i <> fila Then + For j = 0 To n + Swap im(i, j), im(fila, j) + Next j + End If + Next i +End Sub + +Sub LUdecomposition(a() As Double,l() As Double, u() As Double, p() As Double) + Dim As Integer i, j, k, n + Dim As Double s + n = Ubound(a) + Redim l(n, n), u(n, n), p(n, n) + Dim As Double b(n, n) + pivotize(a(), p()) + + For i = 0 To n + For j = 0 To n + b(i, j) = 0 + For k = 0 To n + b(i, j) += p(i, k) * a(k, j) + Next k + Next j + Next i + + For j = 0 To n + l(j, j) = 1 + For i = 0 To j + s = 0 + For k = 0 To i - 1 + s += u(k, j) * l(i, k) + Next k + u(i, j) = b(i, j) - s + Next i + For i = j + 1 To n + s = 0 + For k = 0 To j - 1 + s += u(k, j) * l(i, k) + Next k + l(i, j) = (b(i, j) - s) / u(j, j) + Next i + Next j +End Sub + +Sub showMatrix(a() As Double) + Dim As Integer i, j + Dim As String As1 + For i = 0 To Ubound(a, 1) + For j = 0 To Ubound(a, 2) + Print Using "###.##### "; a(i, j); + Next j + Print + Next i + Print +End Sub + +Dim As Double A1(2, 2) => {{1, 3, 5}, {2, 4, 7}, {1, 1, 0}} +Dim As Double L1(), U1(), P1() +LUdecomposition(A1(), L1(), U1(), P1()) +Print "L1:" +showMatrix(L1()) +Print "U1:" +showMatrix(U1()) +Print "P1:" +showMatrix(P1()) + +Dim As Double A2(3, 3) => {{11, 9, 24, 2}, {1, 5, 2, 6}, {3, 17, 18, 1}, {2, 5, 7, 1}} +Dim As Double L2(), U2(), P2() +LUdecomposition(A2(), L2(), U2(), P2()) +Print "L2:" +showMatrix(L2()) +Print "U2:" +showMatrix(U2()) +Print "P2:" +showMatrix(P2()) + +Sleep diff --git a/Task/Last-Friday-of-each-month/ALGOL-68/last-friday-of-each-month.alg b/Task/Last-Friday-of-each-month/ALGOL-68/last-friday-of-each-month.alg index e83dd0c9aa..435d911993 100644 --- a/Task/Last-Friday-of-each-month/ALGOL-68/last-friday-of-each-month.alg +++ b/Task/Last-Friday-of-each-month/ALGOL-68/last-friday-of-each-month.alg @@ -35,17 +35,18 @@ BEGIN # find the last Friday in each month of a year # OD; last END # last fridays # ; - # test the last fridays procedure # - INT year = 2021; - []INT last = last fridays( year ); - FOR m pos TO 12 DO - print( ( whole( year, 0 ) - , IF m pos < 10 THEN "-0" ELSE "-1" FI - , whole( m pos MOD 10, 0 ) - , "-" - , whole( last[ m pos ], 0 ) - , newline - ) - ) - OD + BEGIN # test the last fridays procedure # + INT year = 2021; + []INT last = last fridays( year ); + FOR m pos TO 12 DO + print( ( whole( year, 0 ) + , IF m pos < 10 THEN "-0" ELSE "-1" FI + , whole( m pos MOD 10, 0 ) + , "-" + , whole( last[ m pos ], 0 ) + , newline + ) + ) + OD + END END diff --git a/Task/Last-Friday-of-each-month/FutureBasic/last-friday-of-each-month.basic b/Task/Last-Friday-of-each-month/FutureBasic/last-friday-of-each-month.basic new file mode 100644 index 0000000000..05c38e7385 --- /dev/null +++ b/Task/Last-Friday-of-each-month/FutureBasic/last-friday-of-each-month.basic @@ -0,0 +1,41 @@ +include "NSLog.incl" + +void local fn LastFridayOfEachMonthInYear( year as NSInteger ) + CFCalendarRef calendar = fn CalendarCurrent + + for NSInteger month = 1 to 12 + DateComponentsRef components = fn DateComponentsInit + DateComponentsSetMonth( components, month ) + DateComponentsSetYear( components, year ) + DateComponentsSetDay( components, 1 ) + + CFDateRef firstDayOfMonth = fn CalendarDateFromComponents( calendar, components ) + CFRange dayRange = fn CalendarRangeOfUnitInUnit( calendar, NSCalendarUnitDay, NSCalendarUnitMonth, firstDayOfMonth ) + NSInteger numberOfDaysInMonth = dayRange.length + + DateComponentsRef lastDayComponents = fn DateComponentsInit + DateComponentsSetMonth( lastDayComponents, month ) + DateComponentsSetYear( lastDayComponents, year ) + DateComponentsSetDay( lastDayComponents, numberOfDaysInMonth ) + + CFDateRef lastDayOfMonth = fn CalendarDateFromComponents( calendar, lastDayComponents ) + DateComponentsRef lastFridayComponents = fn CalendarComponentsFromDate( calendar, NSCalendarUnitYear + NSCalendarUnitMonth + NSCalendarUnitDay, lastDayOfMonth ) + while ( fn DateComponentsDay( lastFridayComponents ) > 0 ) + DateComponentsSetDay( lastFridayComponents, fn DateComponentsDay( lastFridayComponents ) -1 ) + CFDateRef lastPotentialFriday = fn CalendarDateFromComponents( calendar, lastFridayComponents ) + DateComponentsRef weekdayComponents = fn CalendarComponentsFromDate( calendar, NSCalendarUnitWeekday, lastPotentialFriday ) + if ( fn DateComponentsWeekday( weekdayComponents ) == 6 ) + DateFormatterRef formatter = fn DateFormatterInit + DateFormatterSetDateStyle( formatter, NSDateFormatterMediumStyle ) + NSLog( @"Last Friday: %@", fn DateFormatterStringFromDate( formatter, lastPotentialFriday ) ) + break + end if + wend + next + NSLog( @"\n" ) +end fn + +fn LastFridayOfEachMonthInYear( 2012 ) +fn LastFridayOfEachMonthInYear( 2025 ) + +HandleEvents diff --git a/Task/Last-Friday-of-each-month/M2000-Interpreter/last-friday-of-each-month.m2000 b/Task/Last-Friday-of-each-month/M2000-Interpreter/last-friday-of-each-month.m2000 index fefc73a49c..6ab9e78f67 100644 --- a/Task/Last-Friday-of-each-month/M2000-Interpreter/last-friday-of-each-month.m2000 +++ b/Task/Last-Friday-of-each-month/M2000-Interpreter/last-friday-of-each-month.m2000 @@ -1,24 +1,23 @@ -module lastfriday { - string year - integer y% - input "Year (e.g. 2023):", y% - year=str$(y%,"") - date a="1/1/"+year - date a1="31/12/"+year - double i, b=a, c=a1 - - for i=b to b+6 - if val(date$(i, 1033, "d"))=6 then exit for - next - document result$="Last Friday per month for year " + year + {: +module Lastfriday (year as integer=0) { + REM LOCALE 1032 ' Greek + LOCALE 1033 ' US - English + DEF firstdayYear(y)=cdate(0, y-1900,0,2) + DEF lastdayYear(y)=cdate(0, y-1900,12,1) + IF year=0 THEN INPUT "Year (e.g. 2024 or 24):", year + year=ABS(year) + IF year<100 THEN year+=2000 + DATE a=firstdayYear(year), friday=6 'firstdayYear(1900)+4 + DATE a1=lastdayYear(year) + DATE i=a+7-(a-friday) mod 7 + DOCUMENT result$="Last Friday per month FOR year " + year + {: } - for i=i+7 to c step 7 - if val(date$(i, 1033, "M")) <>val(date$(i+7, 1033, "M")) then - result$=date$(i, 1033, "M"+chr$(9)+"dd") + { + FOR i=i+7 TO a1 STEP 7 + IF VAL(DATE$(i, LOCALE, "M")) <>VAL(DATE$(i+7, LOCALE, "M")) THEN + result$=FORMAT$("{0:12} {1:-14}",DATE$(i, LOCALE, "MMMM"),DATE$(i, LOCALE, "d")) + { } - end if - next - report result$ - clipboard result$ + END IF + NEXT + PRINT #-2, result$ + CLIPBOARD result$ } -lastfriday +Lastfriday 2025 diff --git a/Task/Last-Friday-of-each-month/V-(Vlang)/last-friday-of-each-month.v b/Task/Last-Friday-of-each-month/V-(Vlang)/last-friday-of-each-month.v index b7a9a81554..98f77abecf 100644 --- a/Task/Last-Friday-of-each-month/V-(Vlang)/last-friday-of-each-month.v +++ b/Task/Last-Friday-of-each-month/V-(Vlang)/last-friday-of-each-month.v @@ -2,23 +2,23 @@ import time import os fn main() { - mut year := 0 - mut t := time.now() - year = os.input("Please select a year: ").int() - println("Last Fridays of each month of $year") + mut year := "" + mut now, mut mdx := time.now(), time.month_days[0] + for year.len != 4 || !year.split("").any(it.is_int()) { + year = os.input("What year to calculate (yyyy): ") + } + println("Last Friday for each month of $year") println("==================================") - for i in 1..13 { - mut j := time.month_days[i-1] - if i == 2 { - if time.is_leap_year(year) {j = 29} - } + for idx in 1..13 { + mdx = time.month_days[idx - 1] + if idx == 2 && time.is_leap_year(year.int()) {mdx = 29} for { - t = time.parse('$year-${i:02}-$j 12:30:00')! - if t.weekday_str() == 'Fri' { - println("${time.long_months[i-1]}: $j") + now = time.parse("$year-${idx:02}-${mdx} 12:30:00")! + if now.weekday_str() == "Fri" { + println("${time.long_months[idx - 1]}: ${mdx}") break } - j-- + mdx-- } } } diff --git a/Task/Least-common-multiple/FutureBasic/least-common-multiple.basic b/Task/Least-common-multiple/FutureBasic/least-common-multiple.basic new file mode 100644 index 0000000000..48cf54d10b --- /dev/null +++ b/Task/Least-common-multiple/FutureBasic/least-common-multiple.basic @@ -0,0 +1,9 @@ +int local fn gcd_rec( a as int, b as int ) + if ( b == 0 ) then return a +end fn = fn gcd_rec(b, a % b) + +int def fn lcm( a as int, b as int ) = abs(a * b) / fn gcd_rec(a, b) + +print fn lcm(12,18) + +HandleEvents diff --git a/Task/Left-factorials/Jq/left-factorials-1.jq b/Task/Left-factorials/Jq/left-factorials-1.jq index dfa8c03390..309bb9648b 100644 --- a/Task/Left-factorials/Jq/left-factorials-1.jq +++ b/Task/Left-factorials/Jq/left-factorials-1.jq @@ -3,3 +3,18 @@ def left_factorial: # state: [i!, !i] ([1,0]; .[1] += .[0] | .[0] *= $i) | .[1]; + +# input and gap should be integers +def left_factorial_lengths(gap): + reduce range(1; .+1) as $i + # state: [i!, !i, gap] + ([1, 0, []]; + .[1] = (.[0] + .[1]) + | .[0] = (.[0] * $i) + | (.[1] | tostring | length) as $lf + | if $i % gap == 0 then .[2] += [[$i, $lf]] else . end) + | .[2]; + +((range(0;11), (range(2; 12) * 10)) | "\(.): \(left_factorial)"), + +(10000 | left_factorial_lengths(1000) | .[] | "\(.[0]): length is \(.[1])") diff --git a/Task/Left-factorials/XPL0/left-factorials.xpl0 b/Task/Left-factorials/XPL0/left-factorials.xpl0 new file mode 100644 index 0000000000..5780a1ae7c --- /dev/null +++ b/Task/Left-factorials/XPL0/left-factorials.xpl0 @@ -0,0 +1,45 @@ +include xpllib; \for Big ops +def Size = 36000; + +func BigSize(Num); \Return number of digits in a big number +char Num; +int I; +[for I:= 0 to Size-1 do + if Num(I) # ^0 then return Size-I; +return Size; +]; + +char LFact(Size+1), Sum(Size+1), BigI(Size+1); +int I; +[Int2Big(1, LFact, Size); \LFact:= 1 +Int2Big(0, Sum, Size); \Sum:= 0 +BigOut(0, Sum); CrLf(0); +for I:= 1 to 10 do + [BigAdd(Sum, LFact); \Sum:= Sum + LFact + BigOut(0, Sum); CrLf(0); + Int2Big(I, BigI, Size); + BigMul(LFact, BigI); \LFact:= LFact*I + ]; +CrLf(0); +Int2Big(1, LFact, Size); \LFact:= 1 +Int2Big(0, Sum, Size); \Sum:= 0 +for I:= 1 to 110 do + [BigAdd(Sum, LFact); \Sum:= Sum + LFact + if I >= 20 and rem(I/10) = 0 then + [ChOut(0, ^!); IntOut(0, I); Text(0, " = "); + BigOut(0, Sum); CrLf(0)]; + Int2Big(I, BigI, Size); + BigMul(LFact, BigI); \LFact:= LFact*I + ]; +CrLf(0); +Int2Big(1, LFact, Size); \LFact:= 1 +Int2Big(0, Sum, Size); \Sum:= 0 +for I:= 1 to 10_000 do + [BigAdd(Sum, LFact); \Sum:= Sum + LFact + if I >= 1000 and rem(I/1000) = 0 then + [ChOut(0, ^!); IntOut(0, I); Text(0, " -> "); + IntOut(0, BigSize(Sum)); CrLf(0)]; + Int2Big(I, BigI, Size); + BigMul(LFact, BigI); \LFact:= LFact*I + ]; +] diff --git a/Task/Letter-frequency/V-(Vlang)/letter-frequency.v b/Task/Letter-frequency/V-(Vlang)/letter-frequency.v index 9f98c0c4bf..fcc785524e 100644 --- a/Task/Letter-frequency/V-(Vlang)/letter-frequency.v +++ b/Task/Letter-frequency/V-(Vlang)/letter-frequency.v @@ -1,11 +1,12 @@ import os + struct LetterFreq { rune int freq int } fn main(){ - file := os.read_file('unixdict.txt')? + file := os.read_file('unixdict.txt')! mut freq := map[rune]int{} for c in file { freq[c]++ @@ -24,6 +25,6 @@ fn main(){ return 0 }) for f in lf { - println('${u8(f.rune).ascii_str()} ${f.rune} $f.freq') + println('${u8(f.rune).ascii_str()} ${f.rune} ${f.freq}') } } diff --git a/Task/Literals-Integer/M2000-Interpreter/literals-integer.m2000 b/Task/Literals-Integer/M2000-Interpreter/literals-integer.m2000 index f73c7b9f5b..01d7a091ac 100644 --- a/Task/Literals-Integer/M2000-Interpreter/literals-integer.m2000 +++ b/Task/Literals-Integer/M2000-Interpreter/literals-integer.m2000 @@ -1,7 +1,14 @@ Def ExpType$(x)=Type$(x) Print ExpType$(12345678912345#)="Currency", 12345678912345# Print ExpType$(123456789123456789123456@)="Decimal", 123456789123456789123456@ -Print ExpType$(12&)="Long", 12&, 0xFFFFFFFF&=-1 +Print ExpType$(12&)="Long", 12&, 0xFFFF_FFFF&=-1 Print ExpType$(12%)="Integer", 12%, 0xFFFF%=-1 -\\ used for unsigned integers (but it is double) -Print ExpType$(0xFFFFFFFF)="Double", 0xFFFFFFFF=4294967295 +Print ExpType$(12&&)="Long Long", 12&&, 0xFFFFFFFF_FFFFFFFF&&=-1 + +\\ used for unsigned 32 bit integers (but it is Currency) +Print ExpType$(0xFFFF)="Currency", 0xFFFF=65535 +Print ExpType$(0xFFFFFFFF)="Currency", 0xFFFFFFFF=4294967295 +\\ used for unsigned 64 bit integers (but it is Decimal) +Print ExpType$(0xFFFFFFFF_FFFFFFFF)="Decimal", 0xFFFFFFFF_FFFFFFFF=18446744073709551615@ +Print ExpType$(12ub)="Byte", ExpType$(255ub)="Byte" +Print ExpType$(42000ud)="Date", "27/12/2014"=""+42000ud, date$(42000ud+1)="28/12/2014" diff --git a/Task/Long-literals-with-continuations/FutureBasic/long-literals-with-continuations.basic b/Task/Long-literals-with-continuations/FutureBasic/long-literals-with-continuations.basic new file mode 100644 index 0000000000..5a73de2a15 --- /dev/null +++ b/Task/Long-literals-with-continuations/FutureBasic/long-literals-with-continuations.basic @@ -0,0 +1,31 @@ +void local fn DoIt + CFStringRef elements = @"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 nihonium ¬ + flerovium moscovium livermorium tennessine oganesson" + + CFArrayRef array = fn StringComponentsSeparatedByString( elements, @" " ) + + print @"Last revision: 20230217" + print @"Elements: ";len(array) + print @"Last element: ";array[len(array)-1] +end fn + +fn DoIt + +HandleEvents diff --git a/Task/Long-primes/ALGOL-68/long-primes.alg b/Task/Long-primes/ALGOL-68/long-primes.alg index 5a56ad4552..8d6d540b9d 100644 --- a/Task/Long-primes/ALGOL-68/long-primes.alg +++ b/Task/Long-primes/ALGOL-68/long-primes.alg @@ -13,7 +13,7 @@ BEGIN # find some long primes - primes whose reciprocol have a period of p-1 # OP PERIOD = ( INT n )INT: # returns the period of the reciprocal of n # BEGIN INT r := 1; - FOR i TO n + 1 DO + TO n + 1 DO r *:= 10 MODAB n OD; INT rr = r; diff --git a/Task/Long-primes/XPL0/long-primes.xpl0 b/Task/Long-primes/XPL0/long-primes.xpl0 new file mode 100644 index 0000000000..dc5820cb46 --- /dev/null +++ b/Task/Long-primes/XPL0/long-primes.xpl0 @@ -0,0 +1,64 @@ +include xpllib; \for Print + +func Sieve(Limit, Primes); \Return Primes array and its size +int Limit, Primes; +char C; +int I, P, P2, N; +[C:= Reserve(Limit+1); +for I:= 0 to Limit do C(I):= false; +P:= 3; \no need to process even numbers +P2:= P*P; +while P2 <= Limit do + [I:= P2; + while I <= Limit do + [C(I):= true; I:= I + 2*P]; + repeat P:= P+2 until C(P) = false; + P2:= P*P; + ]; +N:= 0; +for I:= 3 to Limit do + [if C(I) = false then [Primes(N):= I; N:= N+1]; + I:= I+1; + ]; +return N; +]; + +func FindPeriod(N); \Return the period of the reciprocal of N +int N; +int I, R, RR, Period; +[R:= 1; +for I:= 1 to N+1 do + R:= rem((10*R) / N); +RR:= R; +Period:= 0; +repeat R:= rem((10*R) / N); + Period:= Period+1; +until R = RR; +return Period; +]; + +int I, Prime, Count, Index, PrimeCount, LongCount; +int Primes(6500), LongPrimes, Totals(8), Numbers; +[Numbers:= [500, 1000, 2000, 4000, 8000, 16000, 32000, 64000]; +PrimeCount:= Sieve(64000, Primes); +LongPrimes:= Reserve(PrimeCount*IntSize); +LongCount:= 0; +for I:= 0 to PrimeCount-1 do \surely LongCount < PrimeCount + [Prime:= Primes(I); + if FindPeriod(Prime) = Prime-1 then + [LongPrimes(LongCount):= Prime; LongCount:= LongCount+1]; + ]; +Count:= 0; Index:= 0; +for I:= 0 to LongCount-1 do + [if LongPrimes(I) > Numbers(Index) then + [Totals(Index):= Count; Index:= Index+1]; + Count:= Count+1; + ]; +Totals(8-1):= Count; +Print("The long primes up to %d are:\n", Numbers(0)); +for I:= 0 to Totals(0)-1 do + Print("%d ", LongPrimes(I)); +Print("\n\nThe number of long primes up to:\n"); +for I:= 0 to 8-1 do + Print(" %5d is %d\n", Numbers(I), Totals(I)); +] diff --git a/Task/Long-year/FutureBasic/long-year.basic b/Task/Long-year/FutureBasic/long-year.basic new file mode 100644 index 0000000000..d0baa0bff8 --- /dev/null +++ b/Task/Long-year/FutureBasic/long-year.basic @@ -0,0 +1,11 @@ +BOOL local fn IsLongYear( year as int ) + int year1 = year - 1 + int p = (year + (year / 4) - (year / 100) + (year / 400)) % 7 + int p1 = (year1 + (year1 / 4) - (year1 / 100) + (year1 / 400)) % 7 +end fn = p == 4 || p1 == 3 + +for int y = 2000 to 2100 + if ( fn IsLongYear( y ) ) then print y +next + +HandleEvents diff --git a/Task/Longest-common-substring/V-(Vlang)/longest-common-substring.v b/Task/Longest-common-substring/V-(Vlang)/longest-common-substring.v index b307430ce5..98ff6e1c63 100644 --- a/Task/Longest-common-substring/V-(Vlang)/longest-common-substring.v +++ b/Task/Longest-common-substring/V-(Vlang)/longest-common-substring.v @@ -1,5 +1,4 @@ -fn main() -{ +fn main() { println(lcs("thisisatest", "testing123testing")) } @@ -7,11 +6,11 @@ fn lcs(a string, b string) string { mut lengths := map[int]int{} mut output :='' mut greatest_length := 0 - for i, x in a { for j, y in b { if x == y { - if i == 0 || j == 0 {lengths[i * b.len + j] = 1} else {lengths[i * b.len + j] = lengths[(i-1) * b.len + j-1] + 1} + if i == 0 || j == 0 {lengths[i * b.len + j] = 1} + else {lengths[i * b.len + j] = lengths[(i-1) * b.len + j-1] + 1} if lengths[i * b.len + j] > greatest_length { greatest_length = lengths[i * b.len + j] output += x.ascii_str() diff --git a/Task/Loops-Continue/OxygenBasic/loops-continue.basic b/Task/Loops-Continue/OxygenBasic/loops-continue.basic new file mode 100644 index 0000000000..6c921191fc --- /dev/null +++ b/Task/Loops-Continue/OxygenBasic/loops-continue.basic @@ -0,0 +1,15 @@ +uses console + +int i + +for i = 1 to 10 + print str(i); + if i mod 5 = 0 then + printl + continue for + end if + print ", "; +next + +printl cr "Enter ..." +waitkey diff --git a/Task/Loops-Continue/QBasic/loops-continue.basic b/Task/Loops-Continue/QBasic/loops-continue.basic new file mode 100644 index 0000000000..6746bd9eee --- /dev/null +++ b/Task/Loops-Continue/QBasic/loops-continue.basic @@ -0,0 +1,6 @@ +FOR i = 1 TO 10 + PRINT STR$(i); + IF (i MOD 5) THEN PRINT ", "; ELSE PRINT +NEXT i +PRINT +END diff --git a/Task/Loops-For/FutureBasic/loops-for.basic b/Task/Loops-For/FutureBasic/loops-for-1.basic similarity index 100% rename from Task/Loops-For/FutureBasic/loops-for.basic rename to Task/Loops-For/FutureBasic/loops-for-1.basic diff --git a/Task/Loops-For/FutureBasic/loops-for-2.basic b/Task/Loops-For/FutureBasic/loops-for-2.basic new file mode 100644 index 0000000000..c4508d9315 --- /dev/null +++ b/Task/Loops-For/FutureBasic/loops-for-2.basic @@ -0,0 +1,10 @@ +window 1 + +for long i = 1 to 5 + for long j = 1 to i + print @"*"; + next + print +next + +HandleEvents diff --git a/Task/Loops-Foreach/Plain-English/loops-foreach.plain b/Task/Loops-Foreach/Plain-English/loops-foreach.plain index 2c79ec293e..6e6c6fa78b 100644 --- a/Task/Loops-Foreach/Plain-English/loops-foreach.plain +++ b/Task/Loops-Foreach/Plain-English/loops-foreach.plain @@ -1,36 +1,36 @@ To run: -Start up. -Create a list. -Write each entry in the list to the console. -Destroy the list. -Wait for the escape key. -Shut down. + Start up. + Create a list. + Write each entry in the list to the console. + Destroy the list. + Wait for the escape key. + Shut down. An entry is a thing with a number. A list is some entries. To add a number to a list: -Allocate memory for an entry. -Put the number into the entry's number. -Append the entry to the list. + Allocate memory for an entry. + Put the number into the entry's number. + Append the entry to the list. To create a list: -Add 1 to the list. -Add 2 to the list. -Add 3 to the list. -Add 6 to the list. -Add 7 to the list. -Add 9 to the list. + Add 1 to the list. + Add 2 to the list. + Add 3 to the list. + Add 6 to the list. + Add 7 to the list. + Add 9 to the list. To write an entry to the console: -Convert the entry's number to a string. -Write the string to the console. + Convert the entry's number to a string. + Write the string to the console. To write each entry in a list to the console: -Get an entry from the list. -Loop. -If the entry is nil, exit. -Write the entry to the console. -Put the entry's next into the entry. -Repeat. + Get an entry from the list. + Loop. + If the entry is nil, exit. + Write the entry to the console. + Put the entry's next into the entry. + Repeat. diff --git a/Task/Loops-Increment-loop-index-within-loop-body/FutureBasic/loops-increment-loop-index-within-loop-body.basic b/Task/Loops-Increment-loop-index-within-loop-body/FutureBasic/loops-increment-loop-index-within-loop-body.basic new file mode 100644 index 0000000000..83e485b31a --- /dev/null +++ b/Task/Loops-Increment-loop-index-within-loop-body/FutureBasic/loops-increment-loop-index-within-loop-body.basic @@ -0,0 +1,23 @@ +BOOL local fn IsPrime( n as long ) + if ( n == 2 ) then return YES + if ( n < 2 || n % 2 == 0 ) then return NO + for long i = 3 to sqr(n) step 2 + if ( ( n % i ) == 0 ) then return NO + next i +end fn = YES + +void local fn DoIt + long count = 0 + for long i = 42 to LONG_MAX + if ( fn IsPrime( i ) ) + count++ + print count,i + if ( count == 42 ) then break + i += i + end if + next +end fn + +fn DoIt + +HandleEvents diff --git a/Task/Loops-Wrong-ranges/ALGOL-68/loops-wrong-ranges.alg b/Task/Loops-Wrong-ranges/ALGOL-68/loops-wrong-ranges.alg index bd6c637e96..6ec86ff09d 100644 --- a/Task/Loops-Wrong-ranges/ALGOL-68/loops-wrong-ranges.alg +++ b/Task/Loops-Wrong-ranges/ALGOL-68/loops-wrong-ranges.alg @@ -1,20 +1,20 @@ BEGIN - # returns the first n elements of the sequences of values specified by start, stop and increment # - PROC sequence = ( INT n, start, stop, increment )[]INT: + # returns the first n elements of the sequences of values specified by s sstart, s stop and increment # + PROC sequence = ( INT n, s start, s stop, increment )[]INT: BEGIN [ 1 : n ]INT s; FOR j FROM LWB s TO UPB s DO s[ j ] := 0 OD; INT s pos := LWB s - 1; - FOR j FROM start BY increment TO stop WHILE s pos < n DO + FOR j FROM s start BY increment TO s stop WHILE s pos < n DO s[ s pos +:= 1 ] := j OD; s[ LWB s : s pos ] END # sequence # ; # tests the sequence procedure # - PROC test sequence = ( INT start, stop, increment, STRING legend )VOID: + PROC test sequence = ( INT s start, s stop, increment, STRING legend )VOID: BEGIN - []INT s = sequence( 10, start, stop, increment ); + []INT s = sequence( 10, s start, s stop, increment ); print( ( legend, ": " ) ); FOR i FROM LWB s TO UPB s DO print( ( " ", whole( s[ i ], -4 ) ) ) OD; print( ( newline ) ) diff --git a/Task/M-bius-function/REXX/m-bius-function-2.rexx b/Task/M-bius-function/REXX/m-bius-function-2.rexx index 90b38b4233..65f32f2d38 100644 --- a/Task/M-bius-function/REXX/m-bius-function-2.rexx +++ b/Task/M-bius-function/REXX/m-bius-function-2.rexx @@ -37,4 +37,5 @@ else include Functions include Numbers +include Sequences include Abend diff --git a/Task/MAC-vendor-lookup/V-(Vlang)/mac-vendor-lookup.v b/Task/MAC-vendor-lookup/V-(Vlang)/mac-vendor-lookup.v index b0e0dc190d..55037b2dbc 100644 --- a/Task/MAC-vendor-lookup/V-(Vlang)/mac-vendor-lookup.v +++ b/Task/MAC-vendor-lookup/V-(Vlang)/mac-vendor-lookup.v @@ -1,16 +1,16 @@ import net.http import time -const macs = -(' +const macs = (" FC-A1-3E FC:FB:FB:01:FA:21 +xx:12:5 D4:F4:6F:C9:EF:8D -') +") fn main() { - for line in macs.split('\n') { - if line !='' { + for line in macs.split_into_lines() { + if !line.is_blank() { println(mac_lookup(line)) time.sleep(2 * time.second) // considerate delay between attempts } @@ -18,6 +18,6 @@ fn main() { } fn mac_lookup(mac string) string { - resp := http.get("http://api.macvendors.com/" + mac) or {return 'No data from server'} + resp := http.get("http://api.macvendors.com/" + mac) or {return "No data from server"} return resp.body.str() } diff --git a/Task/Magnanimous-numbers/ALGOL-68/magnanimous-numbers.alg b/Task/Magnanimous-numbers/ALGOL-68/magnanimous-numbers.alg index d68e75ba4f..273507c2eb 100644 --- a/Task/Magnanimous-numbers/ALGOL-68/magnanimous-numbers.alg +++ b/Task/Magnanimous-numbers/ALGOL-68/magnanimous-numbers.alg @@ -1,5 +1,6 @@ BEGIN # find some magnanimous numbers - numbers where inserting a + between any # - # digits ab=nd evaluatinf the sum results in a prime in all cases # + # digits ab=nd evaluating the sum results in a prime in all cases # + PR read "primes.incl.a68" PR # include prime utilities # # returns the first n magnanimous numbers # # uses global sieve prime which must include 0 and be large enough # # for all possible sub-sequences of digits # @@ -8,21 +9,23 @@ BEGIN # find some magnanimous numbers - numbers where inserting a + between any [ 1 : n ]INT result; INT m count := 0; FOR i FROM 0 WHILE m count < n DO - # split the number into pairs of digit seuences and check the sums of the pairs are all prime # - INT divisor := 1; + # split the number into pairs of digit sequences # + # and check the sums of the pairs are all prime # + INT divisor := 10; BOOL all prime := TRUE; - WHILE divisor *:= 10; - IF INT front = i OVER divisor; + WHILE IF INT front = i OVER divisor; front = 0 THEN FALSE ELSE all prime := prime[ front + ( i MOD divisor ) ] FI - DO SKIP OD; + DO + divisor *:= 10 + OD; IF all prime THEN result[ m count +:= 1 ] := i FI OD; result END; # MAGNANIMPUS # - # prints part of a seuence of magnanimous numbers # + # prints part of a sequence of magnanimous numbers # PROC print magnanimous = ( []INT m, INT first, INT last, STRING legend )VOID: BEGIN print( ( legend, ":", newline ) ); @@ -31,16 +34,10 @@ BEGIN # find some magnanimous numbers - numbers where inserting a + between any END ; # print magnanimous # # we assume the first 400 magnanimous numbers will be in 0 .. 1 000 000 # # so we will need a sieve of 0 up to 99 999 + 9 # - [ 0 : 99 999 + 9 ]BOOL prime; - prime[ 0 ] := prime[ 1 ] := FALSE; prime[ 2 ] := TRUE; - FOR i FROM 3 BY 2 TO UPB prime DO prime[ i ] := TRUE OD; - FOR i FROM 4 BY 2 TO UPB prime DO prime[ i ] := FALSE OD; - FOR i FROM 3 BY 2 TO ENTIER sqrt( UPB prime ) DO - IF prime[ i ] THEN FOR s FROM i * i BY i + i TO UPB prime DO prime[ s ] := FALSE OD FI - OD; + []BOOL prime = PRIMESIEVE ( 99 999 + 9 ); # construct the sequence of magnanimous numbers # - []INT m = MAGNANIMOUS 400; - print magnanimous( m, 1, 45, "First 45 magnanimous numbers" ); - print magnanimous( m, 241, 250, "Magnanimous numbers 241-250" ); - print magnanimous( m, 391, 400, "Magnanimous numbers 391-400" ) + []INT mns = MAGNANIMOUS 400; + print magnanimous( mns, 1, 45, "First 45 magnanimous numbers" ); + print magnanimous( mns, 241, 250, "Magnanimous numbers 241-250" ); + print magnanimous( mns, 391, 400, "Magnanimous numbers 391-400" ) END diff --git a/Task/Mayan-calendar/FreeBASIC/mayan-calendar.basic b/Task/Mayan-calendar/FreeBASIC/mayan-calendar.basic new file mode 100644 index 0000000000..b3cac2800c --- /dev/null +++ b/Task/Mayan-calendar/FreeBASIC/mayan-calendar.basic @@ -0,0 +1,99 @@ +#include "datetime.bi" + +Type DateResult + As String long_date + As String round_date +End Type + +Function IntToStr(num As Integer, ancho As Integer = 2) As String + Return Right("00" & Str(num), ancho) +End Function + +Function JulianDate(y As Integer, m As Integer, d As Integer) As Long + Dim As Long a = (14 - m) \ 12 + y += 4800 - a + m += 12 * a - 3 + Return d + ((153 * m + 2) \ 5) + 365 * y + (y \ 4) - (y \ 100) + (y \ 400) - 32045 +End Function + +Function g2m(dateStr As String, gtm_correlation As Boolean = True) As DateResult + Dim As DateResult result + + ' Constants and arrays + Dim As Long correlation = Iif(gtm_correlation, 584283, 584285) + + Dim As Long long_count_days(4) = {144000, 7200, 360, 20, 1} + + Dim As String tzolkin_months(19) = { _ + "Imix'", "Ik'", "Ak'bal", "K'an", "Chikchan", "Kimi", "Manik'", "Lamat", _ + "Muluk", "Ok", "Chuwen", "Eb", "Ben", "Hix", "Men", "K'ib'", "Kaban", _ + "Etz'nab'", "Kawak", "Ajaw" } + + Dim As String haad_months(18) = { _ + "Pop", "Wo'", "Sip", "Sotz'", "Sek", "Xul", "Yaxk'in", "Mol", "Ch'en", _ + "Yax", "Sak'", "Keh", "Mak", "K'ank'in", "Muwan", "Pax", "K'ayab", _ + "Kumk'u", "Wayeb'" } + + ' Parse date string (YYYY-MM-DD) + Dim As Integer y = Valint(Mid(dateStr, 1, 4)) + Dim As Integer m = Valint(Mid(dateStr, 6, 2)) + Dim As Integer d = Valint(Mid(dateStr, 9, 2)) + + ' Calculate Julian days + Dim As Long julian_days = JulianDate(y, m, d) + + ' Calculate long count date + Dim As Long remainder = julian_days - correlation + Dim As Integer long_parts(4) + + For i As Integer = 0 To 4 + long_parts(i) = remainder \ long_count_days(i) + remainder Mod= long_count_days(i) + Next + + ' Format long date + result.long_date = "" + For i As Integer = 0 To 4 + If i > 0 Then result.long_date &= "." + result.long_date &= IntToStr(long_parts(i)) + Next + + ' Calculate round calendar date + Dim As Integer tzolkin_month = (julian_days + 16) Mod 20 + Dim As Integer tzolkin_day = ((julian_days + 5) Mod 13) + 1 + + Dim As Integer haab_month = ((julian_days + 65) Mod 365) \ 20 + Dim As String haab_day + Dim As Integer haab_day_num = ((julian_days + 65) Mod 365) Mod 20 + haab_day = Iif(haab_day_num = 0, "Chum", Str(haab_day_num)) + + Dim As Integer lord_number = (julian_days - correlation) Mod 9 + If lord_number = 0 Then lord_number = 9 + + ' Format round date + result.round_date = Trim(Str(tzolkin_day)) & " " & _ + Left(tzolkin_months(tzolkin_month) & Space(10), 10) & _ + Right(Space(4) & Trim(haab_day), 4) & " " & _ + Left(haad_months(haab_month) & Space(8), 8) & _ + Space(7) & "G" & Trim(Str(lord_number)) + + Return result +End Function + +' Main program +Print " Gregorian Long Tzolk'in Haab' Lord of" +Print " Date Count # Name Day Month the Night" +Print "---------- -------------- -------- ------------- ---------" + +Dim As String dates(9) = { _ +"1961-10-06", "1963-11-21", "2004-06-19", "2012-12-18", "2012-12-21", _ +"2019-01-19", "2019-03-27", "2020-02-29", "2020-03-01", "2071-05-16" } + +Dim As DateResult result + +For i As Integer = 0 To 9 + result = g2m(dates(i)) + Print dates(i); " "; result.long_date; " "; result.round_date +Next + +Sleep diff --git a/Task/Mayan-calendar/QB64/mayan-calendar.qb64 b/Task/Mayan-calendar/QB64/mayan-calendar.qb64 new file mode 100644 index 0000000000..951a4c96c6 --- /dev/null +++ b/Task/Mayan-calendar/QB64/mayan-calendar.qb64 @@ -0,0 +1,113 @@ +DECLARE FUNCTION IntToStr$ (num AS LONG, ancho AS INTEGER) +DECLARE FUNCTION JulianDate# (y AS LONG, m AS LONG, d AS LONG) +DECLARE FUNCTION g2m$ (dateStr AS STRING) + +Dim dates(6) As String +dates(0) = "2004-06-19": dates(1) = "2012-12-18": dates(2) = "2012-12-21" +dates(3) = "2019-01-19": dates(4) = "2019-03-27": dates(5) = "2020-02-29" +dates(6) = "2020-03-01" + +Dim i As Integer +For i = 0 To 6 + Print dates(i); " "; g2m$(dates(i)) +Next i +'sleep +End + +Function IntToStr$ (num As Long, ancho As Integer) + IntToStr$ = Right$("00" + LTrim$(Str$(num)), ancho) +End Function + +Function JulianDate# (y As Long, m As Long, d As Long) + Dim a As Long + a = (14 - m) \ 12 + y = y + 4800 - a + m = m + 12 * a - 3 + JulianDate# = d + ((153 * m + 2) \ 5) + 365 * y + (y \ 4) - (y \ 100) + (y \ 400) - 32045 +End Function + +Function g2m$ (dateStr As String) + Dim longDate As String + Dim roundDate As String + Dim correlation As Double + correlation = 584283 'GTM correlation + + Dim longCountDays(4) As Double + longCountDays(0) = 144000: longCountDays(1) = 7200 + longCountDays(2) = 360: longCountDays(3) = 20: longCountDays(4) = 1 + + Dim tzolkinMonths(19) As String + tzolkinMonths(0) = "Imix'": tzolkinMonths(1) = "Ik'" + tzolkinMonths(2) = "Ak'bal": tzolkinMonths(3) = "K'an" + tzolkinMonths(4) = "Chikchan": tzolkinMonths(5) = "Kimi" + tzolkinMonths(6) = "Manik'": tzolkinMonths(7) = "Lamat" + tzolkinMonths(8) = "Muluk": tzolkinMonths(9) = "Ok" + tzolkinMonths(10) = "Chuwen": tzolkinMonths(11) = "Eb" + tzolkinMonths(12) = "Ben": tzolkinMonths(13) = "Hix" + tzolkinMonths(14) = "Men": tzolkinMonths(15) = "K'ib'" + tzolkinMonths(16) = "Kaban": tzolkinMonths(17) = "Etz'nab'" + tzolkinMonths(18) = "Kawak": tzolkinMonths(19) = "Ajaw" + + Dim haadMonths(18) As String + haadMonths(0) = "Pop": haadMonths(1) = "Wo'" + haadMonths(2) = "Sip": haadMonths(3) = "Sotz'" + haadMonths(4) = "Sek": haadMonths(5) = "Xul" + haadMonths(6) = "Yaxk'in": haadMonths(7) = "Mol" + haadMonths(8) = "Ch'en": haadMonths(9) = "Yax" + haadMonths(10) = "Sak'": haadMonths(11) = "Keh" + haadMonths(12) = "Mak": haadMonths(13) = "K'ank'in" + haadMonths(14) = "Muwan": haadMonths(15) = "Pax" + haadMonths(16) = "K'ayab": haadMonths(17) = "Kumk'u" + haadMonths(18) = "Wayeb'" + + Dim y As Long, m As Long, d As Long + y = Val(Mid$(dateStr, 1, 4)) + m = Val(Mid$(dateStr, 6, 2)) + d = Val(Mid$(dateStr, 9, 2)) + + Dim julianDays As Double + julianDays = JulianDate#(y, m, d) + + Dim remainder As Double + remainder = julianDays - correlation + Dim longParts(4) As Long + + For i = 0 To 4 + longParts(i) = Int(remainder / longCountDays(i)) + remainder = remainder - (longParts(i) * longCountDays(i)) + Next i + + longDate = "" + For i = 0 To 4 + If i > 0 Then longDate = longDate + "." + longDate = longDate + IntToStr$(longParts(i), 2) + Next i + + Dim tzolkinMonth As Long, tzolkinDay As Long + Dim haabMonth As Long, haabDayNum As Long + Dim lordNumber As Long + + tzolkinMonth = Int((julianDays + 16) Mod 20) + tzolkinDay = Int(((julianDays + 5) Mod 13)) + 1 + + haabMonth = Int(((julianDays + 65) Mod 365) / 20) + haabDayNum = Int(((julianDays + 65) Mod 365) Mod 20) + + Dim haabDay As String + If haabDayNum = 0 Then + haabDay = "Chum" + Else + haabDay = LTrim$(Str$(haabDayNum)) + End If + + lordNumber = Int((julianDays - correlation) Mod 9) + If lordNumber = 0 Then lordNumber = 9 + + roundDate = LTRIM$(STR$(tzolkinDay)) + " " + _ + tzolkinMonths(tzolkinMonth) + " " + _ + haabDay + " " + _ + haadMonths(haabMonth) + " G" + _ + LTRIM$(STR$(lordNumber)) + + g2m$ = longDate + " " + roundDate +End Function diff --git a/Task/Mayan-numerals/ALGOL-68/mayan-numerals.alg b/Task/Mayan-numerals/ALGOL-68/mayan-numerals.alg new file mode 100644 index 0000000000..3c803d5187 --- /dev/null +++ b/Task/Mayan-numerals/ALGOL-68/mayan-numerals.alg @@ -0,0 +1,68 @@ +BEGIN + # print Mayan numerals # + # Mayan numerals are base-20 positional numbers, each digit consists of # + # four four character lines in a box # + + # converts n to a mayan representation # + OP TOMAYAN = ( INT n )[]STRING: + BEGIN + # cartouche boarders, etc. # + CHAR top left = REPR 201; CHAR top middle = REPR 203; CHAR top right = REPR 187; + CHAR bottom left = REPR 200; CHAR bottom middle = REPR 202; CHAR bottom right = REPR 188; + CHAR vertical = REPR 186; CHAR horizontal = REPR 205; CHAR turtle = "@"; + STRING horizontal edge = horizontal + horizontal + horizontal + horizontal; + # representations of 1, 2, 3 etc. # + []STRING fragment = ( " . ", " .. ", "... ", "....", "----" ); + STRING blanks = " "; STRING zero = " " + turtle + " "; + # build the cartouche # + INT final line = 6; + [ 1 : final line ]STRING result; + IF n < 0 THEN # negative numbers not supported # + FOR i TO final line DO result[ i ] := "?" OD + ELSE # 0 or negative # + FOR i TO final line DO result[ i ] := "" OD; + top right +=: result[ 1 ]; # right edge of the cartouche # + FOR i FROM 2 TO final line - 1 DO vertical +=: result[ i ] OD; + bottom right +=: result[ final line ]; + INT rest := n; # number body # + WHILE + INT digit := rest MOD 20; rest OVERAB 20; + INT f := digit; + horizontal edge +=: result[ 1 ]; + FOR i FROM final line - 1 BY -1 TO 2 DO + IF f >= 5 THEN + fragment[ 5 ] +=: result[ i ] + ELIF f = 0 THEN + IF i = final line - 1 THEN zero ELSE blanks FI +=: result[ i ] + ELSE + fragment[ digit MOD 5 ] +=: result[ i ] + FI; + IF f > 5 THEN f -:= 5 ELSE f := 0 FI + OD; + horizontal edge +=: result[ final line ]; + rest > 0 + DO + # add a separator # + top middle +=:result[ 1 ]; + FOR i FROM 2 TO UPB result - 1 DO vertical +=: result[ i ] OD; + bottom middle +=: result[ final line ] + OD; + top left +=: result[ 1 ]; # left edge of the cartouche # + FOR i FROM 2 TO final line - 1 DO vertical +=: result[ i ] OD; + bottom left +=: result[ final line ] + FI; + result + END # TOMAYAN # ; + # print n as a mayan number # + PROC print mayan = ( INT n )VOID: + BEGIN + []STRING cartouche = TOMAYAN n; + FOR i TO UPB cartouche DO print( ( cartouche[ i ], newline ) ) OD + END # print mayan # ; + + []INT test cases = ( 4 005, 8 017, 326 205, 886 205, 68, 1303 ); + FOR n FROM LWB test cases TO UPB test cases DO + print( ( "Mayan representation of ", whole( test cases[ n ], 0 ), newline ) ); + print mayan( test cases[ n ] ) + OD +END diff --git a/Task/Mayan-numerals/EasyLang/mayan-numerals.easy b/Task/Mayan-numerals/EasyLang/mayan-numerals.easy new file mode 100644 index 0000000000..55ec0fd97a --- /dev/null +++ b/Task/Mayan-numerals/EasyLang/mayan-numerals.easy @@ -0,0 +1,68 @@ +func[] base20 n . + if n < 20 + return [ n ] + . + r[] = base20 (n div 20) + r[] &= n mod 20 + return r[] +. +mayan$[] = [ " " " ∙ " " ∙∙ " "∙∙∙ " "∙∙∙∙" ] +func$[] mayan d . + r$[] = [ mayan$[1] mayan$[1] mayan$[1] mayan$[1] ] + if d = 0 + r$[4] = " Θ " + return r$[] + . + for i = 4 downto 1 + if d >= 5 + r$[i] = "────" + d -= 5 + else + r$[i] = mayan$[d + 1] + break 1 + . + . + return r$[] +. +proc drawma . mayans$[][] . + idx = len mayans$[][] + write "╔" + for i to idx + for j to 4 + write "═" + . + if i < idx + write "╦" + else + print "╗" + . + . + for i to 4 + write "║" + for j to idx + write mayans$[j][i] & "║" + . + print "" + . + write "╚" + for i to idx + for j to 4 + write "═" + . + if i < idx + write "╩" + else + print "╝" + . + . +. +for n in [ 4005 8017 326205 886205 1081439556 ] + print n + digs[] = base20 n + mayans$[][] = [ ] + for d in digs[] + mayans$[][] &= mayan d + . + drawma mayans$[][] + print "" +. diff --git a/Task/Mayan-numerals/SETL/mayan-numerals.setl b/Task/Mayan-numerals/SETL/mayan-numerals.setl new file mode 100644 index 0000000000..74e36127e4 --- /dev/null +++ b/Task/Mayan-numerals/SETL/mayan-numerals.setl @@ -0,0 +1,38 @@ +program mayan_numerals; + loop for n in [4005, 8017, 326205, 886205, 18380658207197784] do + print(str n + ":"); + print(mayan(n)); + end loop; + + proc mayan(n); + carts := [cartouche(d) : d in to_base20(n)]; + topbtm := '+----' * #carts + '+\n'; + lines := [+/['|' + c(l) : c in carts] + '|\n' : l in [1..4]]; + return topbtm +/ lines + topbtm; + end proc; + + proc cartouche(n); + parts := { + [0, ' '], + [1, ' . '], + [2, ' .. '], + [3, '... '], + [4, '....'], + [5, '----'] + }; + + cart := [parts((n-m) min 5 max 0) : m in [15,10,5,0]]; + if n=0 then cart(4) := ' @ '; end if; + return cart; + end proc; + + proc to_base20(n); + if n=0 then return [0]; end if; + ds := []; + loop while n>0 do + ds := [n mod 20] + ds; + n div:= 20; + end loop; + return ds; + end proc; +end program; diff --git a/Task/Meissel-Mertens-constant/REXX/meissel-mertens-constant.rexx b/Task/Meissel-Mertens-constant/REXX/meissel-mertens-constant.rexx index 42ff9bd545..55681c59ee 100644 --- a/Task/Meissel-Mertens-constant/REXX/meissel-mertens-constant.rexx +++ b/Task/Meissel-Mertens-constant/REXX/meissel-mertens-constant.rexx @@ -21,7 +21,7 @@ procedure expose glob. numeric digits Digits()+2 y = 0.5-Ln(2) do n = 3 by 2 to 1000000 - if IsPrime(n) then do + if Prime(n) then do q = 1/n; t = Ln(1-q)+q; y = y+t end end diff --git a/Task/Mertens-function/ALGOL-68/mertens-function.alg b/Task/Mertens-function/ALGOL-68/mertens-function.alg index 479a042e38..cfeea7bcfe 100644 --- a/Task/Mertens-function/ALGOL-68/mertens-function.alg +++ b/Task/Mertens-function/ALGOL-68/mertens-function.alg @@ -9,11 +9,11 @@ BEGIN # compute values of the Mertens function # # Print table # print( ( "The first 99 Mertens numbers are:", newline ) ); print( ( " " ) ); - INT k := 9; + INT left := 9; FOR n TO 99 DO print( ( whole( m[ n ], -3 ) ) ); - IF ( k -:= 1 ) = 0 THEN - k := 10; + IF ( left -:= 1 ) = 0 THEN + left := 10; print( ( newline ) ) FI OD; diff --git a/Task/Minimum-multiple-of-m-where-digital-sum-equals-m/FutureBasic/minimum-multiple-of-m-where-digital-sum-equals-m.basic b/Task/Minimum-multiple-of-m-where-digital-sum-equals-m/FutureBasic/minimum-multiple-of-m-where-digital-sum-equals-m.basic new file mode 100644 index 0000000000..e837dbf2e1 --- /dev/null +++ b/Task/Minimum-multiple-of-m-where-digital-sum-equals-m/FutureBasic/minimum-multiple-of-m-where-digital-sum-equals-m.basic @@ -0,0 +1,30 @@ +int local fn DigitSum( num as int ) + int sum = 0, n = num + while ( n > 0 ) + sum += n % 10 + n /= 10 + wend +end fn = sum + +void local fn DoIt + for int n = 1 to 70 + int m = 1 + while ( 1 ) + if ( fn DigitSum( m * n ) == n ) + printf @"%8d\b",m + if ( n % 10 == 0 ) + print + else + print @" "; + end if + break + end if + m++ + wend + next +end fn + +window 1, @"Minimum multiple of m where digital sum equals m", (0,0,670,200) +fn DoIt + +HandleEvents diff --git a/Task/Modified-random-distribution/ALGOL-68/modified-random-distribution.alg b/Task/Modified-random-distribution/ALGOL-68/modified-random-distribution.alg index f87bdbb776..9fd0fc9832 100644 --- a/Task/Modified-random-distribution/ALGOL-68/modified-random-distribution.alg +++ b/Task/Modified-random-distribution/ALGOL-68/modified-random-distribution.alg @@ -2,13 +2,13 @@ BEGIN # Modified random distribution - translation of the Wren sample # next random; # initialise the random number generator # - PROC rng = ( PROC(REAL)REAL modifier )REAL: + PROC rng = ( PROC(REAL)REAL modifier fn )REAL: BEGIN REAL r1, r2; WHILE r1 := random; r2 := random; - r2 >= modifier( r1 ) + r2 >= modifier fn( r1 ) DO SKIP OD; r1 END # rng # ; @@ -21,7 +21,7 @@ BEGIN # Modified random distribution - translation of the Wren sample # CHAR hist char = "#"; INT hist char size = 125; [ 0 : num bins - 1 ]INT bins ; FOR i FROM LWB bins TO UPB bins DO bins[ i ] := 0 OD; - FOR i FROM 0 TO n DO + FROM 0 TO n DO bins[ ENTIER ( rng( modifier ) / bin size ) ] +:= 1 OD; diff --git a/Task/Modified-random-distribution/XPL0/modified-random-distribution.xpl0 b/Task/Modified-random-distribution/XPL0/modified-random-distribution.xpl0 new file mode 100644 index 0000000000..e6bcbd4ba3 --- /dev/null +++ b/Task/Modified-random-distribution/XPL0/modified-random-distribution.xpl0 @@ -0,0 +1,39 @@ +include xpllib; \for Print + +func real Modifier(X); +real X; +return if X < 0.5 then 2.*(0.5-X) else 2.*(X-0.5); + +func real RGen; +return float(Ran(1_000_000)) / 1e6; + +func real RNG; +real R1, R2; +[loop [R1:= RGen; + R2:= RGen; + if R2 < Modifier(R1) then + return R1; + ]; +]; + +def N = 100_000; +def NUM_BINS = 20; +def HIST_CHAR = ^#; +def HIST_CHAR_SIZE = 125; +def BinSize = 1. / float(NUM_BINS); +int Bins(NUM_BINS), BN, I, J, Hist; +real RN; +[for I:= 0 to N-1 do + [RN:= RNG; + BN:= fix(Floor(RN/BinSize)); + Bins(BN):= Bins(BN)+1; + ]; +Print("Modified random distribution with %,d samples in range [0, 1):\n", N); +Print(" Range Number of samples within that range\n"); +for I:= 0 to NUM_BINS-1 do + [Hist:= Bins(I) / HIST_CHAR_SIZE; + Print("%1.2f ..< %1.2f ", BinSize*float(I), BinSize*float(I+1)); + for J:= 1 to Hist do Print("%c", HIST_CHAR); + Print(" %,d\n", Bins(I)); + ]; +] diff --git a/Task/Monads-List-monad/V-(Vlang)/monads-list-monad.v b/Task/Monads-List-monad/V-(Vlang)/monads-list-monad.v new file mode 100644 index 0000000000..38bf250e8a --- /dev/null +++ b/Task/Monads-List-monad/V-(Vlang)/monads-list-monad.v @@ -0,0 +1,27 @@ +struct Mlist {value []int} + +fn (m Mlist) bind(f fn (lst []int) Mlist) Mlist {return f(m.value)} + +fn unit(lst []int) Mlist {return Mlist{lst}} + +fn increment(lst []int) Mlist { + mut lst2 := lst.clone() + for i, v in lst { + lst2[i] = v + 1 + } + return unit(lst2) +} + +fn double(lst []int) Mlist { + mut lst2 := lst.clone() + for i, v in lst { + lst2[i] = 2 * v + } + return unit(lst2) +} + +fn main() { + ml1 := unit([3, 4, 5]) + ml2 := ml1.bind(increment).bind(double) + println("${ml1.value} -> ${ml2.value}") +} diff --git a/Task/Multiple-regression/ALGOL-68/multiple-regression.alg b/Task/Multiple-regression/ALGOL-68/multiple-regression.alg index 587b22a4f8..2891016c6e 100644 --- a/Task/Multiple-regression/ALGOL-68/multiple-regression.alg +++ b/Task/Multiple-regression/ALGOL-68/multiple-regression.alg @@ -13,28 +13,28 @@ BEGIN # Multiple Regression - trnslation of the VB.NET sample but using the # ); PRIO NEWMATRIX = 1; - OP NEWMATRIX = ( INT rows, INT cols )MATRIX: + OP NEWMATRIX = ( INT m rows, INT m cols )MATRIX: BEGIN MATRIX result; - require( rows > 0, "Need at least one row" ); - row count OF result := rows; - require( cols > 0, "Need at least one column" ); - col count OF result := cols; - data OF result := HEAP[ 1 : rows, 1 : cols ]REAL; - FOR r TO rows DO FOR c TO cols DO ( data OF result )[ r, c ] := 0 OD OD; + require( m rows > 0, "Need at least one row" ); + row count OF result := m rows; + require( m cols > 0, "Need at least one column" ); + col count OF result := m cols; + data OF result := HEAP[ 1 : m rows, 1 : m cols ]REAL; + FOR r TO m rows DO FOR c TO m cols DO ( data OF result )[ r, c ] := 0 OD OD; result END # NEWMATRIX # ; OP NEWMATRIX = ( [,]REAL source )MATRIX: BEGIN MATRIX result; - INT rows = 1 + ( 1 UPB source - 1 LWB source ); - require( rows > 0, "Need at least one row" ); - row count OF result := rows; - INT cols = 1 + ( 2 UPB source - 2 LWB source ); - require( cols > 0, "Need at least one column" ); - col count OF result := cols; - data OF result := HEAP[ 1 : rows, 1 : cols ]REAL := source[ AT 1, AT 1 ]; + INT m rows = 1 + ( 1 UPB source - 1 LWB source ); + require( m rows > 0, "Need at least one row" ); + row count OF result := m rows; + INT m cols = 1 + ( 2 UPB source - 2 LWB source ); + require( m cols > 0, "Need at least one column" ); + col count OF result := m cols; + data OF result := HEAP[ 1 : m rows, 1 : m cols ]REAL := source[ AT 1, AT 1 ]; result END # NEWMATRIX # ; @@ -101,16 +101,16 @@ BEGIN # Multiple Regression - trnslation of the VB.NET sample but using the # m[this row,lead col:] := m[other row,lead col:]; m[other row,lead col:] := swap FI; - FIELD scale = 1/m[this row,lead col]; - IF scale /= 1 THEN + FIELD scalef = 1/m[this row,lead col]; + IF scalef /= 1 THEN m[this row,lead col] := 1; - FOR col FROM lead col+1 TO 2 UPB m DO m[this row,col] *:= scale OD + FOR col FROM lead col+1 TO 2 UPB m DO m[this row,col] *:= scalef OD FI; - FOR other row FROM LWB m TO UPB m DO - IF this row /= other row THEN - REAL scale = m[other row,lead col]; - m[other row,lead col]:=0; - FOR col FROM lead col+1 TO 2 UPB m DO m[other row,col] -:= scale*m[this row,col] OD + FOR other row pos FROM LWB m TO UPB m DO + IF this row /= other row pos THEN + REAL o scale = m[other row pos,lead col]; + m[other row pos,lead col]:=0; + FOR col FROM lead col+1 TO 2 UPB m DO m[other row pos,col] -:= o scale*m[this row,col] OD FI OD; lead col +:= 1 diff --git a/Task/Munching-squares/FutureBasic/munching-squares.basic b/Task/Munching-squares/FutureBasic/munching-squares.basic new file mode 100644 index 0000000000..122f54b73e --- /dev/null +++ b/Task/Munching-squares/FutureBasic/munching-squares.basic @@ -0,0 +1,53 @@ +void local fn HueToRGB( hue as double, sat as double, buffer as ptr ) + double x + int c = 255 * sat + hue /= 60.0 + x = (1 - abs((hue % 2) - 1)) * 255 + + xref p(1) as unsigned char + p = buffer + + select ( fix(hue) ) + case 0 : p(0) = c : p(1) = x : p(2) = 0 + case 1 : p(0) = x : p(1) = c : p(2) = 0 + case 2 : p(0) = 0 : p(1) = c : p(2) = x + case 3 : p(0) = 0 : p(1) = x : p(2) = c + case 4 : p(0) = x : p(1) = 0 : p(2) = c + case 5 : p(0) = c : p(1) = 0 : p(2) = x + end select +end fn + +ImageRef local fn CreateImage + int size = 512, i, j + ptr colors = fn malloc( size * 3 ) + ptr pix = fn malloc( size * size * 3 ) + + for i = 0 to size - 1 + fn HueToRGB( i * 240.0 / size, i * 1.0 / size, (ptr)(colors + 3 * i) ) + next + + for i = 0 to size - 1 + for j = 0 to size - 1 + fn memcpy( pix + ( ( i * size + j ) * 3 ), colors + ( ( i ^^ j ) * 3 ), 3 ) + next + next + + BitmapImageRepRef bitmap = fn BitmapImageRepWithBitmapDataPlanes( @pix, size, size, 8, 3, NO, NO, NSCalibratedRGBColorSpace, 3 * size, 24 ) + ImageRef image = fn ImageWithSize( fn CGSizeMake(size,size) ) + ImageAddRepresentation( image, bitmap ) + + free( colors ) + free( pix ) +end fn = image + +void local fn DoIt + window 1, @"Munching squares", (0,0,512,512) + imageview 1,,, (0,0,512,512) + ViewSetAutoresizingMask( 1, NSViewWidthSizable | NSViewHeightSizable ) + ImageRef image = fn CreateImage + imageview 1,, image +end fn + +fn DoIt + +HandleEvents diff --git a/Task/N-queens-problem/ALGOL-68/n-queens-problem.alg b/Task/N-queens-problem/ALGOL-68/n-queens-problem.alg index 4b35b32487..288ff44b1f 100644 --- a/Task/N-queens-problem/ALGOL-68/n-queens-problem.alg +++ b/Task/N-queens-problem/ALGOL-68/n-queens-problem.alg @@ -1,26 +1,24 @@ +# N-queens problem # INT ofs = 1, # Algol68 normally uses array offset of 1 # dim = 8; # dim X dim chess board # [ofs:dim+ofs-1]INT b; PROC unsafe = (INT y)BOOL:( - INT i, t, x; - x := b[y]; - FOR i TO y - LWB b DO - t := b[y - i]; - IF t = x THEN break true - ELIF t = x - i THEN break true - ELIF t = x + i THEN break true + INT x = b[y]; + BOOL safe := TRUE; + FOR i TO y - LWB b WHILE safe DO + INT t = b[y - i]; + IF t = x THEN safe := FALSE + ELIF t = x - i THEN safe := FALSE + ELIF t = x + i THEN safe := FALSE FI OD; - FALSE EXIT -break true: - TRUE + NOT safe ); INT s := 0; PROC print board = VOID:( - INT x, y; print((new line, "Solution # ", s+:=1, new line)); FOR y FROM LWB b TO UPB b DO FOR x FROM LWB b TO UPB b DO @@ -30,15 +28,12 @@ PROC print board = VOID:( OD ); -main: ( +# main # ( INT y := LWB b; b[LWB b] := LWB b - 1; - FOR i WHILE y >= LWB b DO - WHILE - b[y]+:=1; - # BREAK # IF b[y] <= UPB b THEN unsafe(y) ELSE FALSE FI - DO SKIP OD; - IF b[y] <= UPB b THEN + WHILE y >= LWB b DO + WHILE IF (b[y]+:=1) <= UPB b THEN unsafe(y) ELSE FALSE FI DO SKIP OD; + IF b[y] <= UPB b THEN IF y < UPB b THEN b[y+:=1] := LWB b - 1 ELSE diff --git a/Task/N-queens-problem/Tailspin/n-queens-problem-3.tailspin b/Task/N-queens-problem/Tailspin/n-queens-problem-3.tailspin index c820a635c1..968f6bbe2e 100644 --- a/Task/N-queens-problem/Tailspin/n-queens-problem-3.tailspin +++ b/Task/N-queens-problem/Tailspin/n-queens-problem-3.tailspin @@ -1,4 +1,6 @@ templates queens + data done <=1> local + def n: $; templates getRowColumn when )> do 0 ! @@ -14,8 +16,6 @@ templates queens @queens.freeMins($p.c::raw - $p.r::raw + $n): $p.val::raw; end setRowColumn - data done <=1> - templates placeQueen def c: $; row´1 -> # diff --git a/Task/N-queens-problem/Tailspin/n-queens-problem-4.tailspin b/Task/N-queens-problem/Tailspin/n-queens-problem-4.tailspin new file mode 100644 index 0000000000..f4cdba96da --- /dev/null +++ b/Task/N-queens-problem/Tailspin/n-queens-problem-4.tailspin @@ -0,0 +1,52 @@ +queens templates + done requires <|=1> + failed requires <|=0> + n is $; + getRowColumn templates + when <|?($@queens(freeRows:; $(r:)::raw) matches <|=0>)> do 0 ! + when <|?($@queens(freeMaxs:; $(r:)::raw + $(c:)::raw) matches <|=0>)> do 0 ! + when <|?($@queens(freeMins:; $(c:)::raw - $(r:)::raw + $n) matches <|=0>)> do 0 ! + otherwise 1! + end getRowColumn + + setRowColumn sink + p is $; + @queens(freeRows:; $p(r:)::raw) set $p(val:)::raw; + @queens(freeMaxs:; $p(c:)::raw + $p(r:)::raw) set $p(val:)::raw; + @queens(freeMins:; $p(c:)::raw - $p(r:)::raw + $n) set $p(val:)::raw; + end setRowColumn + + placeQueen templates + {c: $, r: 1} -> # ! + when <|done> do done´1! + when <|{c: <|$n + 1..>}> do done´1! + when <|{r: <|$n + 1..>}> do failed´0 ! + when <|?($ -> getRowColumn matches <|=1>)> do + current is $; + @queens(queenRows:; $(r:)::raw) set $(c:); + {$, val: 0} -> !setRowColumn + {c: $(c:)::raw + 1, r: 1} -> # -> templates + when <|done> do done´1! + otherwise + {$current, val: 1} -> !setRowColumn + {c: $current(c:), r: $current(r:)::raw + 1} ! + end -> # ! + otherwise {c: $(c:), r: $(r:)::raw + 1} -> # ! + end placeQueen + + @ set { freeRows: [1..$n -> 1], + freeMaxs: [1..$n*2 -> 1], + freeMins: [1..$n*2 -> 1], + queenRows: [1..$n -> -1] }; + 1 -> placeQueen -> templates + when <|done> do $@queens(queenRows:) ! + otherwise 'non-existent'! + end! +end queens + +'A solution to the 8 queens problem is $:8 -> queens; +' ! +'A solution to the 4 queens problem is $:4 -> queens; +' ! +'A solution to the 3 queens problem is $:3 -> queens; +' ! diff --git a/Task/Nim-game/FutureBasic/nim-game.basic b/Task/Nim-game/FutureBasic/nim-game.basic new file mode 100644 index 0000000000..75134082cf --- /dev/null +++ b/Task/Nim-game/FutureBasic/nim-game.basic @@ -0,0 +1,30 @@ +void local fn NimGame + window 1, @"Nim game" + + int tokens = 12 + while ( tokens != 0 ) + print @"Tokens remaining: ";tokens + CFStringRef num = inkey @"Take 1 to 3 tokens", @"123" + if ( !num ) then end + + int n = intval(num) + + print @"You took ";n; @" token"; + if ( n > 1 ) then print @"s" else print + tokens -= n + + int c = 4-n + + print @"I took ";c;@" token"; + if ( c > 1 ) then print @"s" else print + + tokens -= c + print + wend + + print @"I win!" +end fn + +fn NimGame + +HandleEvents diff --git a/Task/Nth/ALGOL-68/nth.alg b/Task/Nth/ALGOL-68/nth.alg index c468135b15..7127b891e0 100644 --- a/Task/Nth/ALGOL-68/nth.alg +++ b/Task/Nth/ALGOL-68/nth.alg @@ -1,9 +1,7 @@ # PROC to suffix a number with st, nd, rd or th as appropriate # PROC nth = ( INT number )STRING: BEGIN - INT number mod 100 = number MOD 100; - # RESULT # whole( number, 0 ) + IF number mod 100 >= 10 AND number mod 100 <= 20 @@ -29,21 +27,20 @@ BEGIN FOR test value FROM from TO to DO STRING test result = nth( test value ); - print( ( " "[ 1 : 8 - UPB test result ], nth( test value ) ) ); + print( ( " "[ 1 : 8 - UPB test result ], test result ) ); test count +:= 1; IF test count MOD 8 = 0 THEN print( ( newline ) ) FI OD; + IF test count MOD 8 /= 0 + THEN + print( ( newline ) ) + FI; print( ( newline ) ) END; # test nth # - -main: ( - - test nth( 0, 25 ); - test nth( 250, 265 ); - test nth( 1000, 1025 ) - -) +test nth( 0, 25 ); +test nth( 250, 265 ); +test nth( 1000, 1025 ) diff --git a/Task/Nth/FutureBasic/nth.basic b/Task/Nth/FutureBasic/nth.basic new file mode 100644 index 0000000000..f53b3a13ab --- /dev/null +++ b/Task/Nth/FutureBasic/nth.basic @@ -0,0 +1,28 @@ +CFStringRef local fn Suffix( n as int ) + if ( n % 100 / 10 == 1 ) then exit fn + select ( n % 10 ) + case 1 : return @"st" + case 2 : return @"nd" + case 3 : return @"rd" + end select +end fn = @"th" + +void local fn DoIt + int i + + for i = 0 to 25 + print i;fn Suffix(i);@" "; + next + print + for i = 250 to 265 + print i;fn Suffix(i);@" "; + next + print + for i = 1000 to 1025 + print i;fn Suffix(i);@" "; + next +end fn + +fn DoIt + +HandleEvents diff --git a/Task/Old-lady-swallowed-a-fly/M2000-Interpreter/old-lady-swallowed-a-fly.m2000 b/Task/Old-lady-swallowed-a-fly/M2000-Interpreter/old-lady-swallowed-a-fly.m2000 new file mode 100644 index 0000000000..26de64aba9 --- /dev/null +++ b/Task/Old-lady-swallowed-a-fly/M2000-Interpreter/old-lady-swallowed-a-fly.m2000 @@ -0,0 +1,33 @@ +MODULE LikeBasic { + 010 M$="" + 020 NAME$="" : REM "out.txt" + 030 DIM A$(8), E$(8) + 040 GOSUB 220 + 050 OPEN NAME$ FOR OUTPUT AS #F + 070 FOR N = 0 TO 7: READ A$(N), E$(N): NEXT N : N-- + 080 FOR C = 1 TO N + 090 PRINT #F, "THERE WAS AN OLD LADY WHO SWALLOWED A "+A$(C) + 100 IF C > 1 THEN + 110 PRINT #F, E$(C) + 120 IF C < N THEN + 130 FOR B = C TO 2 + 140 PRINT #F, A$(0);A$(B);" TO CATCH THE ";A$(B-1);MID$(",;",1 - (B = 2),1) + 150 NEXT B + 160 END IF + 170 END IF + 180 IF C < N THEN PRINT #F, E$(1);E$(0) + 190 PRINT #F,"",,"" + 170 NEXT C + 200 CLOSE #F + 210 END + 220 DATA" SHE SWALLOWED A "," - PERHAPS SHE'LL DIE!" + 230 DATA"FLY","I DON'T KNOW WHY SHE SWALLOWED A FLY" + 240 DATA"SPIDER","THAT WRIGGLED AND JIGGLED AND TICKLED INSIDE HER;" + 250 DATA"BIRD","HOW ABSURD TO SWALLOW A BIRD." + 260 DATA"CAT","FANCY THAT TO SWALLOW A CAT!" + 270 DATA"DOG","WHAT A HOG, TO SWALLOW A DOG;" + 280 DATA"COW","I DON'T KNOW HOW SHE SWALLOWED A COW," + 290 DATA"HORSE","SHE'S DEAD, OF COURSE!" + 300 RETURN +} +LikeBasic diff --git a/Task/Own-digits-power-sum/FutureBasic/own-digits-power-sum.basic b/Task/Own-digits-power-sum/FutureBasic/own-digits-power-sum.basic new file mode 100644 index 0000000000..cab98ffd2e --- /dev/null +++ b/Task/Own-digits-power-sum/FutureBasic/own-digits-power-sum.basic @@ -0,0 +1,20 @@ +void local fn DoIt + for long N = 3 to 9 + print N;@" digits:"; + for long curr = 10^(N-1) to 10^N-1 + long sum = 0 + long temp = curr + do + long dig = temp % 10 + temp = temp / 10 + sum += dig ^ N + until temp == 0 + if ( sum == curr ) then printf @"%12ld\b",curr + next + print + next +end fn + +fn DoIt + +HandleEvents diff --git a/Task/P-value-correction/FreeBASIC/p-value-correction.basic b/Task/P-value-correction/FreeBASIC/p-value-correction.basic new file mode 100644 index 0000000000..e74e7775f8 --- /dev/null +++ b/Task/P-value-correction/FreeBASIC/p-value-correction.basic @@ -0,0 +1,301 @@ +#include "string.bi" + +#define MIN(a, b) iif((a) < (b), (a), (b)) + +Enum Direction + UP + DOWN +End Enum + +Type Sequence + As Integer length + As Double values(Any) +End Type + +' Constants for correction types +Dim As String correctionTypes(7) = { _ +"Benjamini-Hochberg", "Benjamini-Yekutieli", "Bonferroni", "Hochberg", _ +"Holm", "Hommel", "Sidak", "Unknown" } + +' Test p-values +Dim Shared As Double test_values(49) = { _ +4.533744e-01, 7.296024e-01, 9.936026e-02, 9.079658e-02, 1.801962e-01, _ +8.752257e-01, 2.922222e-01, 9.115421e-01, 4.355806e-01, 5.324867e-01, _ +4.926798e-01, 5.802978e-01, 3.485442e-01, 7.883130e-01, 2.729308e-01, _ +8.502518e-01, 4.268138e-01, 6.442008e-01, 3.030266e-01, 5.001555e-02, _ +3.194810e-01, 7.892933e-01, 9.991834e-01, 1.745691e-01, 9.037516e-01, _ +1.198578e-01, 3.966083e-01, 1.403837e-02, 7.328671e-01, 6.793476e-02, _ +4.040730e-03, 3.033349e-04, 1.125147e-02, 2.375072e-02, 5.818542e-04, _ +3.075482e-04, 8.251272e-03, 1.356534e-03, 1.360696e-02, 3.764588e-04, _ +1.801145e-05, 2.504456e-07, 3.310253e-02, 9.427839e-03, 8.791153e-04, _ +2.177831e-04, 9.693054e-04, 6.610250e-05, 2.900813e-02, 5.735490e-03 } + +Function minimum(p As Sequence) As Double + Dim m As Double = p.values(0) + For i As Integer = 1 To p.length - 1 + If p.values(i) < m Then m = p.values(i) + Next + Return m +End Function + +Function maximum(p As Sequence) As Double + Dim m As Double = p.values(0) + For i As Integer = 1 To p.length - 1 + If p.values(i) > m Then m = p.values(i) + Next + Return m +End Function + +Sub ratchet(p As Sequence, direcc As Integer) + Dim m As Double = p.values(0) + Dim i As Integer + + If direcc = UP Then + For i = 1 To p.length - 1 + ' Corrected logic: only update if greater than minimum + If p.values(i) > m Then p.values(i) = m + m = p.values(i) + Next + Else + For i = 1 To p.length - 1 + If p.values(i) < m Then p.values(i) = m + m = p.values(i) + Next + End If + + ' Cap at 1.0 + For i = 0 To p.length - 1 + If p.values(i) > 1.0 Then p.values(i) = 1.0 + Next +End Sub + +Function schwartzian(p As Sequence, mult As Sequence, direcc As Integer) As Sequence + Dim As Sequence result + result.length = p.length + Redim result.values(p.length-1) + Dim As Integer i, j + + ' Sort with indices + Dim As Integer indices(p.length-1) + For i = 0 To p.length-1 + indices(i) = i + Next + + ' Sort based on direccection + For i = 0 To p.length-2 + For j = 0 To p.length-2-i + Dim As Boolean cond + If direcc = UP Then + cond = p.values(indices(j)) < p.values(indices(j+1)) + Else + cond = p.values(indices(j)) > p.values(indices(j+1)) + End If + If cond Then Swap indices(j), indices(j+1) + Next + Next + + ' Apply multipliers + For i = 0 To p.length-1 + result.values(i) = p.values(indices(i)) * mult.values(i) + Next + + ratchet(result, direcc) + + ' Restore original order + Dim As Sequence final + final.length = p.length + Redim final.values(p.length-1) + + For i = 0 To p.length-1 + final.values(indices(i)) = result.values(i) + Next + + Return final +End Function + +Function adjust(p As Sequence, method As String) As Sequence + Dim As Sequence result + result.length = p.length + Redim result.values(p.length-1) + + Dim As Sequence mult + mult.length = p.length + Redim mult.values(p.length-1) + + Dim As Integer i + Dim As Double tmp + + Select Case method + Case "Benjamini-Hochberg" + For i = 0 To p.length-1 + mult.values(i) = p.length / (p.length - i) + Next + Return schwartzian(p, mult, UP) + + Case "Benjamini-Yekutieli" + tmp = 0 + For i = 1 To p.length + tmp += 1.0 / i + Next + + For i = 0 To p.length-1 + mult.values(i) = tmp * p.length / (p.length - i) + Next + Return schwartzian(p, mult, UP) + + Case "Bonferroni" + For i = 0 To p.length-1 + result.values(i) = Min(p.values(i) * p.length, 1.0) + Next + Return result + + Case "Hochberg" + For i = 0 To p.length-1 + mult.values(i) = i + 1 + Next + Return schwartzian(p, mult, UP) + + Case "Holm" + For i = 0 To p.length-1 + mult.values(i) = p.length - i + Next + Return schwartzian(p, mult, DOWN) + + Case "Hommel" + Dim As Integer order(p.length-1), j + Dim As Double s(p.length-1) + + ' Sort and get order + For i = 0 To p.length-1 + order(i) = i + Next + For i = 0 To p.length-2 + For j = 0 To p.length-2-i + If p.values(order(j)) > p.values(order(j+1)) Then Swap order(j), order(j+1) + Next + Next + + ' Get sorted values + For i = 0 To p.length-1 + s(i) = p.values(order(i)) + Next + + ' Calculate initial minimum + Dim As Double m(p.length-1) + For i = 0 To p.length-1 + m(i) = s(i) * p.length / (i + 1) + Next + + Dim As Double min_val = m(0) + For i = 1 To p.length-1 + If m(i) < min_val Then min_val = m(i) + Next + + Dim As Double pa(p.length-1), q(p.length-1) + For i = 0 To p.length-1 + pa(i) = min_val + q(i) = min_val + Next + + ' Hommel algorithm + For j = p.length-1 To 2 Step -1 + Dim As Integer lower_count = p.length - j + 1 + Dim As Integer upper_count = j - 1 + + ' Initialize qmin with first upper value + Dim As Double qmin = j * s(p.length - j + 1) / 2.0 + + ' Check remaining upper values + For i = 1 To upper_count-1 + Dim As Double tmp = s(p.length - j + 1 + i) * j / (2.0 + i) + qmin = MIN(qmin, tmp) + Next + + ' Update lower values + For i = 0 To lower_count-1 + q(i) = MIN(s(i) * j, qmin) + Next + + ' Update upper values + For i = lower_count To p.length-1 + q(i) = q(p.length - j) + Next + + ' Update pa with maximum between current and new values + For i = 0 To p.length-1 + If q(i) > pa(i) Then pa(i) = q(i) + Next + Next + + ' Map back to original order + For i = 0 To p.length-1 + result.values(order(i)) = MIN(pa(i), 1.0) + Next + Return result + + Case "Šidák", "Sidak" + For i = 0 To p.length-1 + result.values(i) = 1.0 - (1.0 - p.values(i)) ^ p.length + Next + Return result + + Case Else + result.length = 0 + End Select + + Return result +End Function + +Function formatOutput(values As Sequence) As String + Dim As String result = "" + Dim As Integer i, j + + For i = 0 To values.length -1 Step 5 + result &= "[" & Format(i, "00") & "] " + For j = 0 To 4 + If i + j < values.length Then + result &= Format(values.values(i+j), "0.0000000000") & " " + End If + Next + result &= !"\n" + Next + Return result +End Function + +'Main program +Dim As Sequence p +p.length = 50 +Redim p.values(49) +Dim As Integer i + +' Initialize p-values +For i = 0 To 49 + p.values(i) = test_values(i) +Next + +' Check p-values +If p.length = 0 Orelse minimum(p) < 0 Orelse maximum(p) > 1 Then + Print "p-values must be in range 0.0 to 1.0" + End +End If + +' Apply each correction method +For i = 0 To 7 + Dim As String method = correctionTypes(i) + + Print method + + Dim As Sequence result = adjust(p, method) + + If result.length > 0 Then + Print formatOutput(result) + Else + Print "Sorry, do not know how to do '" & method & "' correction." + Print "Perhaps you want one of these?:" + For j As Integer = 0 To 6 + Print " " & correctionTypes(j) + Next + End If +Next + +Sleep diff --git a/Task/Padovan-n-step-number-sequences/ALGOL-68/padovan-n-step-number-sequences.alg b/Task/Padovan-n-step-number-sequences/ALGOL-68/padovan-n-step-number-sequences.alg index 38f518a27a..d7feced12a 100644 --- a/Task/Padovan-n-step-number-sequences/ALGOL-68/padovan-n-step-number-sequences.alg +++ b/Task/Padovan-n-step-number-sequences/ALGOL-68/padovan-n-step-number-sequences.alg @@ -21,11 +21,11 @@ BEGIN # show some valuies of the Padovan n-step number sequences # r END # padovan sequences # ; # calculate and show the sequences # - [,]INT r = padovan sequences( 8, 15 ); + [,]INT ps = padovan sequences( 8, 15 ); print( ( "Padovan n-step sequences:", newline ) ); - FOR n FROM 1 LWB r TO 1 UPB r DO + FOR n FROM 1 LWB ps TO 1 UPB ps DO print( ( whole( n, 0 ), " |" ) ); - FOR x FROM 2 LWB r TO 2 UPB r DO print( ( " ", whole( r[ n, x ], -3 ) ) ) OD; + FOR x FROM 2 LWB ps TO 2 UPB ps DO print( ( " ", whole( ps[ n, x ], -3 ) ) ) OD; print( ( newline ) ) OD END diff --git a/Task/Palindrome-dates/FutureBasic/palindrome-dates.basic b/Task/Palindrome-dates/FutureBasic/palindrome-dates.basic new file mode 100644 index 0000000000..109cff9e12 --- /dev/null +++ b/Task/Palindrome-dates/FutureBasic/palindrome-dates.basic @@ -0,0 +1,30 @@ +BOOL local fn IsPalindrome( string as CFStringRef ) + CFMutableStringRef tempString = fn MutableStringNew + for long i = len(string) - 1 to 0 step -1 + MutableStringAppendString( tempString, mid(string,i,1) ) + next +end fn = fn StringIsEqual( string, tempString ) + +void local fn DoIt + DateFormatterRef format = fn DateFormatterInit + DateFormatterSetDateFormat( format, @"yyyyMMdd" ) + + DateFormatterRef outputFormat = fn DateFormatterInit + DateFormatterSetDateFormat( outputFormat, @"yyyy-MM-dd" ) + + long count = 0, limit = 15 + CFCalendarRef calendar = fn CalendarCurrent + CFDateRef dt = fn DateInit + + while ( count < limit ) + if ( fn IsPalindrome( fn DateFormatterStringFromDate( format, dt ) ) ) + print fn DateFormatterStringFromDate( outputFormat, dt ) + count ++ + end if + dt = fn CalendarDateByAddingUnit( calendar, NSCalendarUnitDay, 1, dt, 0 ) + wend +end fn + +fn DoIt + +HandleEvents diff --git a/Task/Palindrome-detection/BASIC/palindrome-detection.basic b/Task/Palindrome-detection/BASIC/palindrome-detection.basic index e14e4f498a..c3d6779af0 100644 --- a/Task/Palindrome-detection/BASIC/palindrome-detection.basic +++ b/Task/Palindrome-detection/BASIC/palindrome-detection.basic @@ -68,7 +68,7 @@ END FUNCTION FUNCTION RvrsText$ (WhichText$) ' Var - DIM i%, c$, NewText$, j% + DIM i%, NewText$, j% j% = LEN(WhichText$) FOR i% = 1 TO j% diff --git a/Task/Pancake-numbers/00-TASK.txt b/Task/Pancake-numbers/00-TASK.txt index cd1b078632..37e1a1ab7c 100644 --- a/Task/Pancake-numbers/00-TASK.txt +++ b/Task/Pancake-numbers/00-TASK.txt @@ -10,7 +10,7 @@ Few people know p(20), generously I shall award an extra credit for anyone doing : Note that the original "cheeky partial answer" of [[Pancake_numbers#Phix|Phix]] has since been updated (5/12/2020), and/but just that, with no examples as asked for, ''will'' get your entry marked as incomplete. ;References -# [https://www.bbvaopenmind.com/en/science/mathematics/bill-gates-and-the-pancake-problem Bill Gates and the pancake problem] +# [https://web.archive.org/web/20240525075316/https://www.bbvaopenmind.com/en/science/mathematics/bill-gates-and-the-pancake-problem/ Bill Gates and the pancake problem] # [https://oeis.org/A058986 A058986]

diff --git a/Task/Pancake-numbers/Rust/pancake-numbers.rs b/Task/Pancake-numbers/Rust/pancake-numbers-1.rs similarity index 100% rename from Task/Pancake-numbers/Rust/pancake-numbers.rs rename to Task/Pancake-numbers/Rust/pancake-numbers-1.rs diff --git a/Task/Pancake-numbers/Rust/pancake-numbers-2.rs b/Task/Pancake-numbers/Rust/pancake-numbers-2.rs new file mode 100644 index 0000000000..09908f59b0 --- /dev/null +++ b/Task/Pancake-numbers/Rust/pancake-numbers-2.rs @@ -0,0 +1,45 @@ +use std::collections::HashMap; + +fn pancake_flips(len: usize) -> Option<(Vec, i32)> { + if len < 1 { + return None; + } + let goal_stack: Vec = (1..len as i32 + 1).collect(); + let mut stacks: HashMap, i32> = HashMap::new(); + stacks.insert(goal_stack.clone(), 0); + let mut num_stacks = 1; + let mut new_stacks = stacks.clone(); + for i in 1..1001 { + let mut next_stacks: HashMap, i32> = HashMap::new(); + for (arr, _steps) in &new_stacks { + for pos in 1_usize..(len + 1) { + let mut new_stack = arr[0..pos].to_vec(); + new_stack.reverse(); + new_stack.extend_from_slice(&arr[pos..arr.len()]); + if !stacks.contains_key(&new_stack) { + next_stacks.insert(new_stack.clone(), i); + } + } + } + new_stacks = next_stacks; + stacks.extend(new_stacks.clone().into_iter()); + let perms = stacks.len(); + if perms == num_stacks { + match stacks.into_iter().max_by_key(|p| p.1) { + Some(pair) => return Some(pair), + None => break, + } + } + num_stacks = perms; + } + None +} + +fn main() { + for i in 1..=10 { + match pancake_flips(i) { + Some(p) => println!("pancake({:>2}) = {:<5} example: {:?}", i, p.1, p.0), + None => println!("Error: cannot flip stack with size {i}"), + } + } +} diff --git a/Task/Parse-an-IP-Address/FreeBASIC/parse-an-ip-address.basic b/Task/Parse-an-IP-Address/FreeBASIC/parse-an-ip-address.basic new file mode 100644 index 0000000000..51c30cad3a --- /dev/null +++ b/Task/Parse-an-IP-Address/FreeBASIC/parse-an-ip-address.basic @@ -0,0 +1,175 @@ +Function isNumericString(s As String) As Boolean + For i As Integer = 1 To Len(s) + Dim c As String = Mid(s, i, 1) + If c < "0" Or c > "9" Then Return False + Next + Return True +End Function + +Function isHexString(s As String) As Boolean + For i As Integer = 1 To Len(s) + Dim c As String = Mid(s, i, 1) + If Not ((c >= "0" And c <= "9") Or (c >= "a" And c <= "f") Or (c >= "A" And c <= "F")) Then Return False + Next + Return True +End Function + +Function Split(text As String, delimiter As String, arr() As String) As Integer + If Len(text) = 0 Then Return 0 + + Dim As Integer cnt = 0, posic = 0, lastPos = 0 + Redim arr(8) ' Pre-allocate array with sufficient size + + Do + posic = Instr(lastPos + 1, text, delimiter) + If posic = 0 Then + If lastPos < Len(text) Then + arr(cnt) = Mid(text, lastPos + 1) + cnt += 1 + End If + Exit Do + End If + + arr(cnt) = Mid(text, lastPos + 1, posic - lastPos - 1) + cnt += 1 + lastPos = posic + Loop + + Return cnt +End Function + +Function parseIP(addr As String) As String + Dim As String result = "IP address : " & addr & !"\n" + Dim As String parts(8), ipParts(8) + Dim As Integer cnt, i + Dim As String port = "not specified" + + ' Check if it's an IPv4 address + cnt = Split(addr, ":", parts()) + + ' IPv4 processing + cnt = Split(parts(0), ".", ipParts()) + If cnt = 4 Then + Dim As String hexa = "" + Dim As Boolean valid = True + + For i = 0 To 3 + Dim As Integer value = Valint(ipParts(i)) + If value >= 0 Andalso value <= 255 Then + hexa &= Right("0" & Hex(value), 2) + Else + valid = False + Exit For + End If + Next + + If valid Then + result &= "Address : " & hexa & !"\n" + result &= "Address Space: IPv4" & !"\n" + If Len(parts(1)) > 0 Then + Dim As Integer portVal = Valint(parts(1)) + If portVal >= 0 Andalso portVal <= 65535 Then + result &= "Port : " & parts(1) & !"\n" + End If + Else + result &= "Port : not specified" & !"\n" + End If + Return result + End If + End If + + ' Check if it's an IPv6 address + If Instr(addr, ":") > 0 Then + Dim As String ipv6Addr = addr + + If Left(addr, 1) = "[" Then + Dim As Integer endBracket = Instr(addr, "]") + If endBracket > 0 Then + ipv6Addr = Mid(addr, 2, endBracket - 2) + If endBracket < Len(addr) Then + port = Mid(addr, endBracket + 2) + End If + End If + End If + + ' Special handling for IPv4-mapped IPv6 addresses + If Instr(ipv6Addr, "::ffff:") > 0 Then + Dim As String ipv4Part = Mid(ipv6Addr, Instr(ipv6Addr, "::ffff:") + 7) + cnt = Split(ipv4Part, ".", ipParts()) + + If cnt = 4 Then + Dim As String hexa = "FFFF" + Dim As Boolean valid = True + + For i = 0 To 3 + Dim As Integer value = Valint(ipParts(i)) + If value >= 0 Andalso value <= 255 Then + hexa &= Right("0" & Hex(value), 2) + Else + valid = False + Exit For + End If + Next + + If valid Then + result &= "Address : " & hexa & !"\n" + result &= "Address Space: IPv6" & !"\n" + result &= "Port : " & port & !"\n" + Return result + End If + End If + ' If IPv4 part is invalid, return invalid address + Return result & "Address : Invalid Address" & !"\n" + End If + + cnt = Split(ipv6Addr, ":", ipParts()) + If cnt > 0 Then + Dim As String hexa = "" + Dim As Integer emptyIndex = -1 + + ' Find :: position + For i = 0 To cnt - 1 + If Len(ipParts(i)) = 0 Then + emptyIndex = i + Exit For + End If + Next + + ' Process parts before :: + For i = 0 To emptyIndex - 1 + hexa &= Right("0000" & ipParts(i), 4) + Next + + ' Fill middle with zeros + If emptyIndex >= 0 Then + Dim As Integer zerosNeeded = 8 - (cnt - 1) + hexa &= String(zerosNeeded * 4, "0") + End If + + ' Process parts after :: + For i = emptyIndex + 1 To cnt - 1 + hexa &= Right("0000" & ipParts(i), 4) + Next + + result &= "Address : " & hexa & !"\n" + result &= "Address Space: IPv6" & !"\n" + result &= "Port : " & port & !"\n" + Return result + End If + End If + + Return result & "Address : Invalid Address" & !"\n" +End Function + +' Test cases +Dim As String ipAddresses(0 To ...) = { _ +"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", "::ffff:192.168.173.22", _ +"[::ffff:192.168.173.22]:80", _ +"1::", "::", "256.0.0.0", "::ffff:127.0.0.0.1", "RosettaCode" } + +For i As Byte = 0 To Ubound(ipAddresses) + Print parseIP(ipAddresses(i)) +Next + +Sleep diff --git a/Task/Parsing-RPN-calculator-algorithm/ALGOL-68/parsing-rpn-calculator-algorithm.alg b/Task/Parsing-RPN-calculator-algorithm/ALGOL-68/parsing-rpn-calculator-algorithm.alg index 099cffc8ab..115936b675 100644 --- a/Task/Parsing-RPN-calculator-algorithm/ALGOL-68/parsing-rpn-calculator-algorithm.alg +++ b/Task/Parsing-RPN-calculator-algorithm/ALGOL-68/parsing-rpn-calculator-algorithm.alg @@ -5,7 +5,7 @@ CHAR end of expression character = REPR 12; # evaluates the specified rpn expression # -PROC evaluate = ( STRING rpn expression )VOID: +PROC evaluate rpn = ( STRING rpn expression )VOID: BEGIN [ 256 ]REAL stack; @@ -123,21 +123,15 @@ BEGIN print( ( "Result is: ", fixed( stack[ stack pos ], 12, 8 ), newline ) ) -END; # evaluate # - -main: ( +END; # evaluate rpn # +BEGIN # get the RPN expresson from the user # - STRING rpn expression; - print( ( "Enter expression: " ) ); read( ( rpn expression, newline ) ); - # add a space to terminate the final token and an expression terminator # rpn expression +:= " " + end of expression character; - # execute the expression # - evaluate( rpn expression ) - -) + evaluate rpn( rpn expression ) +END diff --git a/Task/Parsing-RPN-to-infix-conversion/FreeBASIC/parsing-rpn-to-infix-conversion.basic b/Task/Parsing-RPN-to-infix-conversion/FreeBASIC/parsing-rpn-to-infix-conversion.basic new file mode 100644 index 0000000000..28a2f72fdd --- /dev/null +++ b/Task/Parsing-RPN-to-infix-conversion/FreeBASIC/parsing-rpn-to-infix-conversion.basic @@ -0,0 +1,117 @@ +Dim Shared As Boolean showWorkings = True +Dim Shared As String*1 operators(4) = {"^","*","/","+","-"} +Dim Shared As Integer precedence(4) = { 4, 3, 3, 2, 2 } +Dim Shared As Integer rassoc(4) = {Asc("r"), 0 , Asc("l"), 0 , Asc("l")} + +Sub parseRPN(expr As String, expected As String) + Dim As String stack(), ops() + Dim As String lhs, rhs, token, op, res + Dim As Integer lprec, rprec, posic + Dim As Integer i, j, k + + ' Convert expr to ops array without using SPLIT + posic = 1 + While posic <= Len(expr) + token = "" + While posic <= Len(expr) And Mid(expr, posic, 1) <> " " + token &= Mid(expr, posic, 1) + posic += 1 + Wend + If token <> "" Then + Redim Preserve ops(Ubound(ops) + 1) + ops(Ubound(ops)) = token + End If + posic += 1 + Wend + + Print "Postfix input: "; + Print Using ("\ \"); expr; + Print Iif(showWorkings, Chr(10), " "); + + If Ubound(ops) = -1 Then + Print "error" + Exit Sub + End If + + For i = 0 To Ubound(ops) + op = ops(i) + k = -1 + For j = 0 To Ubound(operators) + If op = operators(j) Then + k = j + Exit For + End If + Next + + If k = -1 Then + Redim Preserve stack(Ubound(stack) + 1) + stack(Ubound(stack)) = "9 " & op + Else + If Ubound(stack) < 1 Then + Print "error" + Exit Sub + End If + Dim As String rprec_rhs = stack(Ubound(stack)) + stack(Ubound(stack)) = "" + Redim Preserve stack(Ubound(stack) - 1) + Dim As String lprec_lhs = stack(Ubound(stack)) + lprec = Val(Left(lprec_lhs, 1)) + lhs = Mid(lprec_lhs, 3) + rprec = Val(Left(rprec_rhs, 1)) + rhs = Mid(rprec_rhs, 3) + Dim As Integer prec = precedence(k) + Dim As Integer assoc = rassoc(k) + If lprec < prec Or (lprec = prec And assoc = Asc("r")) Then lhs = "(" & lhs & ")" + If rprec < prec Or (rprec = prec And assoc = Asc("l")) Then rhs = "(" & rhs & ")" + stack(Ubound(stack)) = prec & " " & lhs & " " & op & " " & rhs + End If + + If showWorkings Then + ?"["; + 'Print op; " "; Join(stack, ", ") + Print op; ", [["; stack(0); + For j = 1 To Ubound(stack) + Print "], ["; stack(j); + Next + Print "]]]" + End If + Next + + res = Mid(stack(0), 3) + Print "Infix result: "; res; + Print " ["; Iif(res = expected, "ok", "**ERROR**"); "]" +End Sub + +parseRPN("3 4 2 * 1 5 - 2 3 ^ ^ / +", "3 + 4 * 2 / (1 - 5) ^ 2 ^ 3") +showWorkings = False +parseRPN("1 2 + 3 4 + ^ 5 6 + ^", "((1 + 2) ^ (3 + 4)) ^ (5 + 6)") +parseRPN("1 2 + 3 4 + 5 6 + ^ ^", "(1 + 2) ^ (3 + 4) ^ (5 + 6)") +parseRPN("moon stars mud + * fire soup * ^", "(moon * (stars + mud)) ^ (fire * soup)") +parseRPN("3 4 ^ 2 9 ^ ^ 2 5 ^ ^", "((3 ^ 4) ^ 2 ^ 9) ^ 2 ^ 5") +parseRPN("5 6 * * + +", "error") +parseRPN("", "error") +parseRPN("1 4 + 5 3 + 2 3 * * *", "(1 + 4) * (5 + 3) * 2 * 3") +parseRPN("1 2 * 3 4 * *", "1 * 2 * 3 * 4") +parseRPN("1 2 + 3 4 + +", "1 + 2 + 3 + 4") +parseRPN("1 2 + 3 4 + ^", "(1 + 2) ^ (3 + 4)") +parseRPN("5 6 ^ 7 ^", "(5 ^ 6) ^ 7") +parseRPN("5 4 3 2 ^ ^ ^", "5 ^ 4 ^ 3 ^ 2") +parseRPN("1 2 3 + +", "1 + 2 + 3") +parseRPN("1 2 + 3 +", "1 + 2 + 3") +parseRPN("1 2 3 ^ ^", "1 ^ 2 ^ 3") +parseRPN("1 2 ^ 3 ^", "(1 ^ 2) ^ 3") +parseRPN("1 1 - 3 +", "1 - 1 + 3") +parseRPN("3 1 1 - +", "3 + 1 - 1") +parseRPN("1 2 3 + -", "1 - (2 + 3)") +parseRPN("4 3 2 + +", "4 + 3 + 2") +parseRPN("5 4 3 2 + + +", "5 + 4 + 3 + 2") +parseRPN("5 4 3 2 * * *", "5 * 4 * 3 * 2") +parseRPN("5 4 3 2 + - +", "5 + 4 - (3 + 2)") +parseRPN("3 4 5 * -", "3 - 4 * 5") +parseRPN("3 4 5 - *", "3 * (4 - 5)") +parseRPN("3 4 - 5 *", "(3 - 4) * 5") +parseRPN("4 2 * 1 5 - +", "4 * 2 + 1 - 5") +parseRPN("4 2 * 1 5 - 2 ^ /", "4 * 2 / (1 - 5) ^ 2") +parseRPN("3 4 2 * 1 5 - 2 3 ^ ^ / +", "3 + 4 * 2 / (1 - 5) ^ 2 ^ 3") + +Sleep diff --git a/Task/Parsing-RPN-to-infix-conversion/M2000-Interpreter/parsing-rpn-to-infix-conversion.m2000 b/Task/Parsing-RPN-to-infix-conversion/M2000-Interpreter/parsing-rpn-to-infix-conversion.m2000 index 1dcd80a5b4..44a63690c9 100644 --- a/Task/Parsing-RPN-to-infix-conversion/M2000-Interpreter/parsing-rpn-to-infix-conversion.m2000 +++ b/Task/Parsing-RPN-to-infix-conversion/M2000-Interpreter/parsing-rpn-to-infix-conversion.m2000 @@ -51,6 +51,5 @@ Module Rpn_2_Infix { Print example1, example2, example3 Rem Print #-2, Export$ ClipBoard Export$ - } Rpn_2_Infix diff --git a/Task/Parsing-Shunting-yard-algorithm/FreeBASIC/parsing-shunting-yard-algorithm.basic b/Task/Parsing-Shunting-yard-algorithm/FreeBASIC/parsing-shunting-yard-algorithm.basic new file mode 100644 index 0000000000..ab3e646d63 --- /dev/null +++ b/Task/Parsing-Shunting-yard-algorithm/FreeBASIC/parsing-shunting-yard-algorithm.basic @@ -0,0 +1,121 @@ +Dim Shared As String stack, queue, token +stack = "" +queue = "" +token = "#" + +Function word_(s As String, n As Integer, sep As String = " ") As String + Dim As Integer pio, cnt, posic, i + + pio = 1 : cnt = 0 : posic = 0 + For i = 1 To Len(s) + If Mid(s, i, Len(sep)) = sep Then + cnt += 1 + If cnt = n - 1 Then pio = i + Len(sep) + If cnt = n Then posic = i: Exit For + End If + Next + + If cnt < n Then Return "" + If posic = 0 Then posic = Len(s) + 1 + + Return Mid(s, pio, posic - pio) +End Function + +Sub stackPush(s As String) + stack = s & "|" & stack +End Sub + +Sub queuePush(s As String) + queue = queue & s & "|" +End Sub + +Function queuePop() As String + Dim As String result = word_(queue, 1, "|") + queue = Mid(queue, Instr(queue, "|") + 1) + Return result +End Function + +Function isOperator(op As String) As Boolean + Return Instr("+-*/^", op) <> 0 And Len(op) = 1 +End Function + +Function precedence(op As String) As Integer + If isOperator(op) Then + Return 1 + (Instr("+-*/^", op) <> 0) + (Instr("*/^", op) <> 0) + (Instr("^", op) <> 0) + End If +End Function + +Function stackPop() As String + Dim As String result = word_(stack, 1, "|") + stack = Mid(stack, Instr(stack, "|") + 1) + Return result +End Function + +Function stackPeek() As String + Return word_(stack, 1, "|") +End Function + +Function reverse(s As String) As String + Dim As String result = "" + Dim As String token = "#" + Dim As Integer i = 0 + + While token <> "" + i += 1 + token = word_(s, i, "|") + result = token & " " & result + Wend + + Return result +End Function + +Dim As String test = "3 + 4 * 2 / ( 1 - 5 ) ^ 2 ^ 3" +Print !"Input:\n"; test; !"\nNo", "token", "stack", "queue" + +Dim As Integer i = 0 +Do + i += 1 + token = word_(test, i) + If token = "" Then Exit Do + Print i, token, reverse(stack), queue + + Select Case token + Case "(" + stackPush(token) + + Case ")" + While stackPeek() <> "(" + If stack = "" Then Print "Error: no matching '(' for token "; i: Sleep: End + queuePush(stackPop()) + Wend + Dim As String discard = stackPop() 'discard "(" + + Case Else + If isOperator(token) Then + Dim As String op1 = token + While isOperator(stackPeek()) + Dim As String op2 = stackPeek() + If op2 <> "^" And precedence(op1) = precedence(op2) Then + queuePush(stackPop()) + Else + Exit While + End If + Wend + stackPush(op1) + Else 'number + queuePush(token) + End If + End Select +Loop + +While stack <> "" + If stackPeek() = "(" Then Print "no matching ')'": Sleep:End + queuePush(stackPop()) +Wend + +Print !"\nOutput:" +While queue <> "" + Print queuePop(); " "; +Wend + +Sleep diff --git a/Task/Partition-an-integer-x-into-n-primes/ALGOL-68/partition-an-integer-x-into-n-primes.alg b/Task/Partition-an-integer-x-into-n-primes/ALGOL-68/partition-an-integer-x-into-n-primes.alg index fa836bfa0f..570e8de5e0 100644 --- a/Task/Partition-an-integer-x-into-n-primes/ALGOL-68/partition-an-integer-x-into-n-primes.alg +++ b/Task/Partition-an-integer-x-into-n-primes/ALGOL-68/partition-an-integer-x-into-n-primes.alg @@ -14,9 +14,9 @@ BEGIN # find the lowest n distinct primes that sum to an integer x # [ 1 : 0 ]INT no partition; # empty array - used if can't partition # # returns n partitioned into p primes or an empty array if n can't be # - # partitioned into p primes, the first prime to try is in start # - PROC partition from = ( INT n, p, start )[]INT: - IF p < 1 OR n < 2 OR start < 2 THEN # invalid parameters # + # partitioned into p primes, the first prime to try is in pstart # + PROC partition from = ( INT n, p, pstart )[]INT: + IF p < 1 OR n < 2 OR pstart < 2 THEN # invalid parameters # no partition ELIF p = 1 THEN # partition into 1 prime - n must be prime # IF NOT prime[ n ] THEN no partition ELSE n FI @@ -24,7 +24,7 @@ BEGIN # find the lowest n distinct primes that sum to an integer x # INT half n = n OVER 2; INT p1 := 0, p2 := 0; BOOL found := FALSE; - FOR p pos FROM start TO UPB prime WHILE NOT found AND p pos < half n DO + FOR p pos FROM pstart TO UPB prime WHILE NOT found AND p pos < half n DO IF prime[ p pos ] THEN p1 := p pos; p2 := n - p pos; @@ -37,7 +37,7 @@ BEGIN # find the lowest n distinct primes that sum to an integer x # INT half n = n OVER 2; INT p1 := 0; BOOL found := FALSE; - FOR p pos FROM start TO UPB prime WHILE NOT found AND p pos < half n DO + FOR p pos FROM pstart TO UPB prime WHILE NOT found AND p pos < half n DO IF prime[ p pos ] THEN p1 := p pos; []INT sub partition = partition from( n - p1, p - 1, p pos + 1 ); diff --git a/Task/Pascals-triangle-Puzzle/FutureBasic/pascals-triangle-puzzle.basic b/Task/Pascals-triangle-Puzzle/FutureBasic/pascals-triangle-puzzle.basic new file mode 100644 index 0000000000..cba9ae9ba4 --- /dev/null +++ b/Task/Pascals-triangle-Puzzle/FutureBasic/pascals-triangle-puzzle.basic @@ -0,0 +1,29 @@ +void local fn DoIt + long a, b, c, d, e, f, g, h, x = 0, y, z + do + x++ + e = x + 11 + f = 40 - e + y = f - 11 + g = y + 4 + c = f + g + a = c + 40 + b = 151 - a + d = b - c + h = d - g + z = h - 4 + until ( y == (x + z) ) + + text ,,,, NSTextAlignmentCenter + print + print 151 + print a, b + print 40, c, d + print e, f, g, h + print x, 11, y, 4, z +end fn + +window 1, @"Pascal triangle/Puzzle", (0,0,250,100), NSWindowStyleMaskTitled +fn DoIt + +HandleEvents diff --git a/Task/Pascals-triangle/Haskell/pascals-triangle-10.hs b/Task/Pascals-triangle/Haskell/pascals-triangle-10.hs new file mode 100644 index 0000000000..f67559679c --- /dev/null +++ b/Task/Pascals-triangle/Haskell/pascals-triangle-10.hs @@ -0,0 +1,5 @@ +fac = product . enumFromTo 1 + +binCoef n k = fac n `div` (fac k * fac (n - k)) + +pascal = ((fmap . binCoef) <*> enumFromTo 0) . pred diff --git a/Task/Pascals-triangle/Haskell/pascals-triangle-11.hs b/Task/Pascals-triangle/Haskell/pascals-triangle-11.hs new file mode 100644 index 0000000000..ad74065521 --- /dev/null +++ b/Task/Pascals-triangle/Haskell/pascals-triangle-11.hs @@ -0,0 +1,11 @@ +*Main> putStr $ unlines $ map unwords $ map (map show) $ pascal 10 +1 +1 1 +1 2 1 +1 3 3 1 +1 4 6 4 1 +1 5 10 10 5 1 +1 6 15 20 15 6 1 +1 7 21 35 35 21 7 1 +1 8 28 56 70 56 28 8 1 +1 9 36 84 126 126 84 36 9 1 diff --git a/Task/Pascals-triangle/Haskell/pascals-triangle-6.hs b/Task/Pascals-triangle/Haskell/pascals-triangle-6.hs index 06c3f90de0..1c4db70c8d 100644 --- a/Task/Pascals-triangle/Haskell/pascals-triangle-6.hs +++ b/Task/Pascals-triangle/Haskell/pascals-triangle-6.hs @@ -1,4 +1 @@ -pascal :: [[Integer]] -pascal = - (1 : [ 0 | _ <- head pascal]) - : [zipWith (+) (0:row) row | row <- pascal] +nextRow = (zipWith (+) . (0 :)) <*> (<> [0]) diff --git a/Task/Pascals-triangle/Haskell/pascals-triangle-7.hs b/Task/Pascals-triangle/Haskell/pascals-triangle-7.hs index 15e32d7013..988644f933 100644 --- a/Task/Pascals-triangle/Haskell/pascals-triangle-7.hs +++ b/Task/Pascals-triangle/Haskell/pascals-triangle-7.hs @@ -1,2 +1 @@ -*Pascal> take 5 <$> (take 5 $ triangle) -[[1,0,0,0,0],[1,1,0,0,0],[1,2,1,0,0],[1,3,3,1,0],[1,4,6,4,1]] +nextRow = (zipWith (+) <*> reverse) . (0 :) diff --git a/Task/Pascals-triangle/Haskell/pascals-triangle-8.hs b/Task/Pascals-triangle/Haskell/pascals-triangle-8.hs index f67559679c..06c3f90de0 100644 --- a/Task/Pascals-triangle/Haskell/pascals-triangle-8.hs +++ b/Task/Pascals-triangle/Haskell/pascals-triangle-8.hs @@ -1,5 +1,4 @@ -fac = product . enumFromTo 1 - -binCoef n k = fac n `div` (fac k * fac (n - k)) - -pascal = ((fmap . binCoef) <*> enumFromTo 0) . pred +pascal :: [[Integer]] +pascal = + (1 : [ 0 | _ <- head pascal]) + : [zipWith (+) (0:row) row | row <- pascal] diff --git a/Task/Pascals-triangle/Haskell/pascals-triangle-9.hs b/Task/Pascals-triangle/Haskell/pascals-triangle-9.hs index ad74065521..15e32d7013 100644 --- a/Task/Pascals-triangle/Haskell/pascals-triangle-9.hs +++ b/Task/Pascals-triangle/Haskell/pascals-triangle-9.hs @@ -1,11 +1,2 @@ -*Main> putStr $ unlines $ map unwords $ map (map show) $ pascal 10 -1 -1 1 -1 2 1 -1 3 3 1 -1 4 6 4 1 -1 5 10 10 5 1 -1 6 15 20 15 6 1 -1 7 21 35 35 21 7 1 -1 8 28 56 70 56 28 8 1 -1 9 36 84 126 126 84 36 9 1 +*Pascal> take 5 <$> (take 5 $ triangle) +[[1,0,0,0,0],[1,1,0,0,0],[1,2,1,0,0],[1,3,3,1,0],[1,4,6,4,1]] diff --git a/Task/Pascals-triangle/Phix/pascals-triangle.phix b/Task/Pascals-triangle/Phix/pascals-triangle.phix index c41da206dd..44105b99b3 100644 --- a/Task/Pascals-triangle/Phix/pascals-triangle.phix +++ b/Task/Pascals-triangle/Phix/pascals-triangle.phix @@ -1,14 +1,75 @@ (phixonline)--> - sequence row = {} - for m = 1 to 13 do - row = row & 1 - for n=length(row)-1 to 2 by -1 do - row[n] += row[n-1] + with javascript_semantics + sequence row, rows = {} + + function check(integer i, string name) -- helper routine + string s = join(row,fmt:="%d") + if s!=rows[i+1] then + printf(1,"%s: goes wrong on line %d\n",{name,i+1}) + return false + end if + return true + end function + + procedure sum_prior() -- First method + row = {} -- (using just one row) + for i=0 to 119 do + row &= 1 + for n=length(row)-1 to 2 by -1 do + row[n] += row[n-1] + end for + if not check(i,"sum_prior") then exit end if end for - printf(1,repeat(' ',(13-m)*2)) - for i=1 to length(row) do - printf(1," %3d",row[i]) + end procedure + + procedure algebraic() -- Second method + for i=0 to 119 do + atom c = 1 + row = {1} + for j=0 to i-1 do + -- c *= (i-j)/(j+1) -- NO: precedence differs, and eg 5*(1/5) inexact + c = c*(i-j)/(j+1) -- ..whereas (5*1)/5 is exact + row &= c + end for + if not check(i,"algebraic") then exit end if end for - puts(1,'\n') - end for + end procedure + -- Aside: error with c was self-evident and more relevant when it was an integer, + --- but I made it an atom to get past the 33/63 limits that imposed. + + procedure builtin() -- Third method + for i=0 to 119 do + row = {} + for j=0 to i do + row &= choose(i,j) + end for + if not check(i,"builtin") then exit end if + end for + end procedure + + include mpfr.e + procedure arbitrary_precision() -- Fourth method, but run first + -- perfectly accurate until you + -- run out of memory or patience. + mpz z = mpz_init() + for i=0 to 119 do + row = {} + for j=0 to i do + mpz_bin_uiui(z,i,j) + row = append(row,mpz_get_str(z)) + end for + string s = join(row) + if i<=19 then + printf(1,"%=96s\n",s) + end if + -- to check the others against: + rows = append(rows,s) + end for + printf(1,"\n") + end procedure + + arbitrary_precision() + sum_prior() + algebraic() + builtin() - function my_compare(sequence a, b) - integer c = -compare(length(a),length(b)) -- descending length - if c=0 then - c = compare(lower(a),lower(b)) -- ascending lexical within same length - end if - return c - end function - ?custom_sort(my_compare,{"Here", "are", "some", "sample", "strings", "to", "be", "sorted"}) - - procedure subleq(sequence code) - integer ip := 0 - while ip>=0 do - integer {a,b,c} = code[ip+1..ip+3] - ip += 3 - if a=-1 then - code[b+1] = iff(platform()=JS?'?':getc(0)) - elsif b=-1 then - puts(1,code[a+1]) - else - code[b+1] -= code[a+1] - if code[b+1]<=0 then - ip := c - end if - end if - end while - end procedure +procedure subleq(sequence code) + integer ip := 0 + while ip>=0 do + integer {a,b,c} = code[ip+1..ip+3] + ip += 3 + if a=-1 then + code[b+1] = iff(platform()=JS?'?':getc(0)) + elsif b=-1 then + puts(1,code[a+1]) + else + code[b+1] -= code[a+1] + if code[b+1]<=0 then + ip := c + end if + end if + end while +end procedure - subleq({15, 17, -1, 17, -1, -1, 16, 1, -1, 16, 3, -1, - 15, 15, 0, 0, -1, 72, 101, 108, 108, 111, 44, 32, - 119, 111, 114, 108, 100, 33, 10, 0}) -